From 3662734f806acd818d5e5032319dc748794449cc Mon Sep 17 00:00:00 2001
From: Paulo Matos
Date: Wed, 1 Jul 2026 18:41:36 +0200
Subject: [PATCH] Regenerate expander linklet from Racket v9.2
expander/expander.rktl had not been refreshed since the initial commit
(2023). Regenerate it against Racket v9.2 and add a self-contained script
to reproduce it.
scripts/gen-expander.sh shallow-clones the racket source tag matching the
installed racket, builds zuo, and runs the expander's `expander-src` demod
target using the host racket as the flattening engine (no full Chez/Racket
build). The flattened linklet's exported interface is unchanged (71
exports); only internal definitions differ.
---
expander/expander.rktl | 147630 ++++++++++++++++++-------------------
scripts/gen-expander.sh | 98 +
2 files changed, 72846 insertions(+), 74882 deletions(-)
create mode 100755 scripts/gen-expander.sh
diff --git a/expander/expander.rktl b/expander/expander.rktl
index e05696e..f6cb590 100644
--- a/expander/expander.rktl
+++ b/expander/expander.rktl
@@ -73,51 +73,9 @@
(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-values (call/ec) call-with-escape-continuation)
(define-values
(qq-append)
(lambda (a_0 b_0) (begin (if (list? a_0) (append a_0 b_0) (raise-argument-error 'unquote-splicing "list?" a_0)))))
- (define-values
- (bad-list$1)
- (lambda (who_0 orig-l_0) (begin 'bad-list (raise-arguments-error who_0 "not a proper list" "in" orig-l_0))))
- (define-values
- (member)
- (letrec-values (((member_0)
- (lambda (v_0 orig-l_1 eql?_0)
- (begin
- 'member
- ((letrec-values (((loop_0)
- (lambda (ls_0 turtle_0)
- (begin
- 'loop
- (if (null? ls_0)
- (let-values () #f)
- (if (not (pair? ls_0))
- (let-values () (bad-list$1 'member orig-l_1))
- (if (eql?_0 v_0 (car ls_0))
- (let-values () ls_0)
- (let-values ()
- (let-values (((ls_1) (cdr ls_0)))
- (if (null? ls_1)
- (let-values () #f)
- (if (let-values (((or-part_0) (not (pair? ls_1))))
- (if or-part_0 or-part_0 (eq? ls_1 turtle_0)))
- (let-values () (bad-list$1 'member orig-l_1))
- (if (eql?_0 v_0 (car ls_1))
- (let-values () ls_1)
- (let-values ()
- (loop_0 (cdr ls_1) (cdr turtle_0)))))))))))))))
- loop_0)
- orig-l_1
- orig-l_1)))))
- (case-lambda
- ((v_1 ls_2) (begin (member_0 v_1 ls_2 equal?)))
- ((v_2 ls_3 eql?_1)
- (begin
- (if (if (procedure? eql?_1) (procedure-arity-includes? eql?_1 2) #f)
- (void)
- (raise-argument-error 'member "(procedure-arity-includes/c 2)" eq?))
- (member_0 v_2 ls_3 eql?_1))))))
(define-values (current-parameterization) (lambda () (begin (continuation-mark-set-first #f parameterization-key))))
(define-values
(call-with-parameterization)
@@ -126,32 +84,11 @@
(begin
(if (parameterization? paramz_0)
(void)
- (let-values () (raise-argument-error 'call-with-parameterization "parameterization?" 0 paramz_0 thunk_0)))
+ (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)
- (let-values () (raise-argument-error 'call-with-parameterization "(-> any)" 1 paramz_0 thunk_0)))
+ (raise-argument-error 'call-with-parameterization "(-> any)" 1 paramz_0 thunk_0))
(with-continuation-mark parameterization-key paramz_0 (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-values
- (current-break-parameterization)
- (lambda () (begin (make-break-paramz (continuation-mark-set-first #f break-enabled-key)))))
- (define-values
- (call-with-break-parameterization)
- (lambda (paramz_1 thunk_1)
- (begin
- (begin
- (if (break-paramz? paramz_1)
- (void)
- (let-values ()
- (raise-argument-error 'call-with-break-parameterization "break-parameterization?" 0 paramz_1 thunk_1)))
- (if (if (procedure? thunk_1) (procedure-arity-includes? thunk_1 0) #f)
- (void)
- (let-values () (raise-argument-error 'call-with-parameterization "(-> any)" 1 paramz_1 thunk_1)))
- (begin0
- (with-continuation-mark break-enabled-key (break-paramz-ref paramz_1 0) (begin (check-for-break) (thunk_1)))
- (check-for-break))))))
(define-values
(select-handler/no-breaks)
(lambda (e_0 bpz_0 l_0)
@@ -159,19 +96,18 @@
(with-continuation-mark
break-enabled-key
(make-thread-cell #f)
- ((letrec-values (((loop_1)
+ ((letrec-values (((loop_0)
(lambda (l_1)
(begin
'loop
(if (null? l_1)
- (let-values () (raise e_0))
+ (raise e_0)
(if ((caar l_1) e_0)
- (let-values ()
- (begin0
- ((cdar l_1) e_0)
- (with-continuation-mark break-enabled-key bpz_0 (check-for-break))))
- (let-values () (loop_1 (cdr l_1)))))))))
- loop_1)
+ (begin0
+ ((cdar l_1) e_0)
+ (with-continuation-mark break-enabled-key bpz_0 (check-for-break)))
+ (loop_0 (cdr l_1))))))))
+ loop_0)
l_0)))))
(define-values (false-thread-cell) (make-thread-cell #f))
(define-values (handler-prompt-key) (make-continuation-prompt-tag 'handler-prompt-tag))
@@ -197,31 +133,29 @@
body-thunk_0)))))
(define-values
(call-with-exception-handler)
- (lambda (exnh_0 thunk_2) (begin (begin0 (with-continuation-mark exception-handler-key exnh_0 (thunk_2)) (void)))))
+ (lambda (exnh_0 thunk_1) (begin (begin0 (with-continuation-mark exception-handler-key exnh_0 (thunk_1)) (void)))))
(define-values (not-there) (gensym))
(define-values
(do-hash-update)
- (lambda (who_1 mut?_0 set_0 ht_0 key_0 xform_0 default_0)
+ (lambda (who_0 mut?_0 set_0 ht_0 key_0 xform_0 default_0)
(begin
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values ()
- (begin
- (if (if (hash? ht_0) (if mut?_0 (not (immutable? ht_0)) (immutable? ht_0)) #f)
- (void)
- (let-values ()
- (raise-argument-error
- who_1
- (if mut?_0 "(and/c hash? (not/c immutable?))" "(and/c hash? immutable?)")
- ht_0)))
- (if (if (procedure? xform_0) (procedure-arity-includes? xform_0 1) #f)
- (void)
- (let-values () (raise-argument-error who_1 "(any/c . -> . any/c)" xform_0))))))
- (let-values (((v_3) (hash-ref ht_0 key_0 default_0)))
- (if (eq? v_3 not-there)
- (raise-mismatch-error who_1 "no value found for key: " key_0)
- (set_0 ht_0 key_0 (xform_0 v_3))))))))
+ (begin
+ (if (if (hash? ht_0) (if mut?_0 (not (immutable? ht_0)) (immutable? ht_0)) #f)
+ (void)
+ (raise-argument-error
+ who_0
+ (if mut?_0 "(and/c hash? (not/c immutable?))" "(and/c hash? immutable?)")
+ ht_0))
+ (if (if (procedure? xform_0) (procedure-arity-includes? xform_0 1) #f)
+ (void)
+ (raise-argument-error who_0 "(any/c . -> . any/c)" xform_0))))
+ (let-values (((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)
+ (set_0 ht_0 key_0 (xform_0 v_0))))))))
(define-values
(hash-update)
(case-lambda
@@ -237,7 +171,7 @@
(lambda (ht_5 key_5)
(begin
(begin
- (if (hash? ht_5) (void) (let-values () (raise-argument-error 'hash-has-key? "hash?" 0 ht_5 key_5)))
+ (if (hash? ht_5) (void) (raise-argument-error 'hash-has-key? "hash?" 0 ht_5 key_5))
(not (eq? not-there (hash-ref ht_5 key_5 not-there)))))))
(define-values
(hash-ref!)
@@ -246,20 +180,20 @@
(begin
(if (if (hash? ht_6) (not (immutable? ht_6)) #f)
(void)
- (let-values () (raise-argument-error 'hash-ref! "(and/c hash? (not/c immutable?))" 0 ht_6 key_6 new_0)))
- (let-values (((v_4) (hash-ref ht_6 key_6 not-there)))
- (if (eq? not-there v_4)
+ (raise-argument-error 'hash-ref! "(and/c hash? (not/c immutable?))" 0 ht_6 key_6 new_0))
+ (let-values (((v_1) (hash-ref ht_6 key_6 not-there)))
+ (if (eq? not-there v_1)
(let-values (((n_0) (if (procedure? new_0) (new_0) new_0))) (begin (hash-set! ht_6 key_6 n_0) n_0))
- v_4))))))
+ v_1))))))
(define-values
(path-string?)
(lambda (s_0)
(begin
- (let-values (((or-part_1) (path? s_0)))
- (if or-part_1
- or-part_1
+ (let-values (((or-part_0) (path? s_0)))
+ (if or-part_0
+ or-part_0
(if (string? s_0)
- (let-values (((or-part_2) (relative-path? s_0))) (if or-part_2 or-part_2 (absolute-path? s_0)))
+ (let-values (((or-part_1) (relative-path? s_0))) (if or-part_1 or-part_1 (absolute-path? s_0)))
#f))))))
(define-values (bsbs) (string '#\\ '#\\))
(define-values
@@ -267,106 +201,95 @@
(lambda (s_1)
(begin
(begin
- (if (let-values (((or-part_3) (path-for-some-system? s_1))) (if or-part_3 or-part_3 (path-string? s_1)))
+ (if (let-values (((or-part_2) (path-for-some-system? s_1))) (if or-part_2 or-part_2 (path-string? s_1)))
(void)
- (let-values () (raise-argument-error 'normal-path-case "(or/c path-for-some-system? path-string?)" s_1)))
+ (raise-argument-error* 'normal-case-path 'racket/primitive "(or/c path-for-some-system? path-string?)" s_1))
(if (if (path-for-some-system? s_1) (eq? (path-convention-type s_1) 'windows) (eq? (system-type) 'windows))
- (let-values ()
- (let-values (((bstr_0) (if (string? s_1) #f (path->bytes s_1))))
- (if (if (string? s_1) (regexp-match? '#rx"^[\\][\\][?][\\]" s_1) #f)
- (let-values () (string->path s_1))
- (if (if bstr_0 (regexp-match? '#rx#"^[\\][\\][?][\\]" bstr_0) #f)
- (let-values () s_1)
- (let-values ()
- (let-values (((norm_0)
- (lambda (s_2)
- (begin 'norm (string-locale-downcase (regexp-replace* '#rx"/" s_2 bsbs)))))
- ((norm-tail_0)
- (lambda (s_3)
- (begin
- 'norm-tail
- (if (regexp-match? '#rx"[/\\][. ]+[/\\]*$" s_3)
- s_3
- (regexp-replace* '#rx"(?<=[^ ./\\])[ .]+([/\\]*)$" s_3 "\\1")))))
- ((finish_0) (lambda (bstr_1) (begin 'finish (bytes->path bstr_1 'windows)))))
- (if (string? s_1)
- (let-values () (finish_0 (string->bytes/locale (norm_0 (norm-tail_0 s_1)))))
- (let-values ()
- (let-values (((c_0) (bytes-open-converter "" "UTF-8")))
- (finish_0
- ((letrec-values (((loop_2)
- (lambda (offset_0)
- (begin
- 'loop
- (let-values (((new-bstr_0 used_0 status_0)
- (bytes-convert
- c_0
- bstr_0
- offset_0
- (bytes-length bstr_0))))
- (let-values (((s_4) (bytes->string/locale new-bstr_0)))
- (let-values (((tail-s_0)
- (if (eq? status_0 'complete)
- (norm-tail_0 s_4)
- s_4)))
- (let-values (((done_0)
- (string->bytes/locale (norm_0 tail-s_0))))
- (if (eq? status_0 'complete)
- (let-values () done_0)
- (if (eq? status_0 'aborts)
- (let-values ()
- (bytes-append
- done_0
- (subbytes bstr_0 (+ offset_0 used_0))))
- (let-values ()
- (bytes-append
- done_0
- (subbytes
- bstr_0
- (+ offset_0 used_0)
- (+ offset_0 used_0 1))
- (loop_2 (+ offset_0 used_0 1))))))))))))))
- loop_2)
- 0)))))))))))
- (if (string? s_1) (let-values () (string->path s_1)) (let-values () s_1)))))))
+ (let-values (((bstr_0) (if (string? s_1) #f (path->bytes s_1))))
+ (if (if (string? s_1) (regexp-match? '#rx"^[\\][\\][?][\\]" s_1) #f)
+ (string->path s_1)
+ (if (if bstr_0 (regexp-match? '#rx#"^[\\][\\][?][\\]" bstr_0) #f)
+ s_1
+ (let-values (((norm_0)
+ (lambda (s_2) (begin 'norm (string-locale-downcase (regexp-replace* '#rx"/" s_2 bsbs)))))
+ ((norm-tail_0)
+ (lambda (s_3)
+ (begin
+ 'norm-tail
+ (if (regexp-match? '#rx"[/\\][. ]+[/\\]*$" s_3)
+ s_3
+ (regexp-replace* '#rx"(?<=[^ ./\\])[ .]+([/\\]*)$" s_3 "\\1")))))
+ ((finish_0) (lambda (bstr_1) (begin 'finish (bytes->path bstr_1 'windows)))))
+ (if (string? s_1)
+ (finish_0 (string->bytes/locale (norm_0 (norm-tail_0 s_1))))
+ (let-values (((c_0) (bytes-open-converter "" "UTF-8")))
+ (finish_0
+ ((letrec-values (((loop_1)
+ (lambda (offset_0)
+ (begin
+ 'loop
+ (let-values (((new-bstr_0 used_0 status_0)
+ (bytes-convert c_0 bstr_0 offset_0 (bytes-length bstr_0))))
+ (let-values (((s_4) (bytes->string/locale new-bstr_0)))
+ (let-values (((tail-s_0)
+ (if (eq? status_0 'complete) (norm-tail_0 s_4) s_4)))
+ (let-values (((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)))
+ (bytes-append
+ done_0
+ (subbytes bstr_0 (+ offset_0 used_0) (+ offset_0 used_0 1))
+ (loop_1 (+ offset_0 used_0 1)))))))))))))
+ loop_1)
+ 0))))))))
+ (if (string? s_1) (string->path s_1) s_1))))))
(define-values
(check-extension-call)
- (lambda (s_5 sfx_0 who_2 sep_0 trust-sep?_0)
+ (lambda (s_5 sfx_0 who_1 sep_0 trust-sep?_0)
(begin
(begin
(let-values (((err-msg_0 err-index_0)
(if (not
- (let-values (((or-part_4) (path-for-some-system? s_5)))
- (if or-part_4 or-part_4 (path-string? s_5))))
- (let-values () (values "(or/c path-for-some-system? path-string?)" 0))
- (if (not (let-values (((or-part_5) (string? sfx_0))) (if or-part_5 or-part_5 (bytes? sfx_0))))
- (let-values () (values "(or/c string? bytes?)" 1))
+ (let-values (((or-part_3) (path-for-some-system? s_5)))
+ (if or-part_3 or-part_3 (path-string? s_5))))
+ (values "(or/c path-for-some-system? path-string?)" 0)
+ (if (not (let-values (((or-part_4) (string? sfx_0))) (if or-part_4 or-part_4 (bytes? sfx_0))))
+ (values "(or/c string? bytes?)" 1)
(if (not
- (let-values (((or-part_6) trust-sep?_0))
- (if or-part_6
- or-part_6
- (let-values (((or-part_7) (string? sep_0)))
- (if or-part_7 or-part_7 (bytes? sep_0))))))
- (let-values () (values "(or/c string? bytes?)" 2))
- (let-values () (values #f #f)))))))
+ (let-values (((or-part_5) trust-sep?_0))
+ (if or-part_5
+ or-part_5
+ (let-values (((or-part_6) (string? sep_0)))
+ (if or-part_6 or-part_6 (bytes? sep_0))))))
+ (values "(or/c string? bytes?)" 2)
+ (values #f #f))))))
(if err-msg_0
- (let-values ()
- (if trust-sep?_0
- (raise-argument-error who_2 err-msg_0 err-index_0 s_5 sfx_0)
- (raise-argument-error who_2 err-msg_0 err-index_0 s_5 sfx_0 sep_0)))
+ (if trust-sep?_0
+ (raise-argument-error* who_1 'racket/primitive err-msg_0 err-index_0 s_5 sfx_0)
+ (raise-argument-error* who_1 'racket/primitive err-msg_0 err-index_0 s_5 sfx_0 sep_0))
(void)))
(let-values (((base_0 name_0 dir?_0) (split-path s_5)))
(begin
(if (not base_0)
- (let-values () (raise-mismatch-error who_2 "cannot add an extension to a root path: " s_5))
+ (raise-arguments-error* who_1 'racket/primitive "cannot add an extension to a root path" "path" s_5)
+ (void))
+ (if (let-values (((or-part_7) (eq? name_0 'same))) (if or-part_7 or-part_7 (eq? name_0 'up)))
+ (raise-arguments-error*
+ who_1
+ 'racket/primitive
+ "cannot add an extension to path that ends with a dot element"
+ "path"
+ s_5)
(void))
(values base_0 name_0)))))))
(define-values
(path-adjust-extension)
- (lambda (name_1 sep_1 rest-bytes_0 s_6 sfx_1 trust-sep?_1)
+ (lambda (who_2 sep_1 rest-bytes_0 s_6 sfx_1 trust-sep?_1)
(begin
- (let-values (((base_1 name_2) (check-extension-call s_6 sfx_1 name_1 sep_1 trust-sep?_1)))
- (let-values (((bs_0) (path-element->bytes name_2)))
+ (let-values (((base_1 name_1) (check-extension-call s_6 sfx_1 who_2 sep_1 trust-sep?_1)))
+ (let-values (((bs_0) (path-element->bytes name_1)))
(let-values (((finish_1)
(lambda (i_0 sep_2 i2_0)
(begin
@@ -381,7 +304,7 @@
(path-convention-type s_6)
(system-path-convention-type)))))))
(let-values (((new-name_0)
- (letrec-values (((loop_3)
+ (letrec-values (((loop_2)
(lambda (i_1)
(begin
'loop
@@ -392,8 +315,8 @@
(eq? (char->integer '#\.) (bytes-ref bs_0 i_2))
#f)
(finish_1 i_2 sep_1 (add1 i_2))
- (loop_3 i_2))))))))
- (loop_3 (bytes-length bs_0)))))
+ (loop_2 i_2))))))))
+ (loop_2 (bytes-length bs_0)))))
(if (path-for-some-system? base_1) (build-path base_1 new-name_0) new-name_0))))))))
(define-values
(path-replace-extension)
@@ -412,21 +335,26 @@
(if (let-values (((or-part_8) (path-string? p_0)))
(if or-part_8 or-part_8 (path-for-some-system? p_0)))
(void)
- (let-values ()
- (raise-argument-error 'reroot-path "(or/c path-string? path-for-some-system?)" 0 p_0 root_0)))
+ (raise-argument-error*
+ 'reroot-path
+ 'racket/primitive
+ "(or/c path-string? path-for-some-system?)"
+ 0
+ p_0
+ root_0))
(values))))
(let-values ((()
(begin
(if (let-values (((or-part_9) (path-string? root_0)))
(if or-part_9 or-part_9 (path-for-some-system? root_0)))
(void)
- (let-values ()
- (raise-argument-error
- 'reroot-path
- "(or/c path-string? path-for-some-system?)"
- 1
- p_0
- root_0)))
+ (raise-argument-error*
+ 'reroot-path
+ 'racket/primitive
+ "(or/c path-string? path-for-some-system?)"
+ 1
+ p_0
+ root_0))
(values))))
(let-values (((conv_0)
(if (path-for-some-system? p_0) (path-convention-type p_0) (system-path-convention-type))))
@@ -435,14 +363,14 @@
(if (let-values (((or-part_10) (complete-path? p_0)))
(if or-part_10 or-part_10 (eq? (system-path-convention-type) conv_0)))
(void)
- (let-values ()
- (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))))
+ (raise-arguments-error*
+ 'reroot-path
+ 'racket/primitive
+ "path is not complete and not the platform's convention"
+ "path"
+ p_0
+ "platform convention type"
+ (system-path-convention-type)))
(values))))
(let-values ((()
(begin
@@ -452,42 +380,39 @@
(system-path-convention-type))
conv_0)
(void)
- (let-values ()
- (raise-arguments-error
- 'reroot-path
- "given paths use different conventions"
- "path"
- p_0
- "root path"
- root_0)))
+ (raise-arguments-error*
+ 'reroot-path
+ 'racket/primitive
+ "given paths use different conventions"
+ "path"
+ p_0
+ "root path"
+ root_0))
(values))))
(let-values (((c-p_0)
(normal-case-path
(cleanse-path (if (complete-path? p_0) p_0 (path->complete-path p_0))))))
(let-values (((bstr_2) (path->bytes c-p_0)))
(if (eq? conv_0 'unix)
- (let-values ()
- (if (bytes=? bstr_2 #"/")
- (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 (bytes=? bstr_2 #"/")
+ (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)
- (let-values ()
- (build-path
- root_0
- (bytes->path
- (if (regexp-match? '#rx"^\\\\\\\\[?]\\\\[a-z]:" bstr_2)
- (let-values ()
- (bytes-append #"\\\\?\\REL\\" (subbytes bstr_2 4 5) #"\\" (subbytes bstr_2 6)))
+ (build-path
+ root_0
+ (bytes->path
+ (if (regexp-match? '#rx"^\\\\\\\\[?]\\\\[a-z]:" bstr_2)
+ (bytes-append #"\\\\?\\REL\\" (subbytes bstr_2 4 5) #"\\" (subbytes bstr_2 6))
+ (if (regexp-match? '#rx"^\\\\\\\\[?]\\\\UNC\\\\" bstr_2)
+ (bytes-append #"\\\\?\\REL\\" (subbytes bstr_2 4))
(if (regexp-match? '#rx"^\\\\\\\\[?]\\\\UNC\\\\" bstr_2)
- (let-values () (bytes-append #"\\\\?\\REL\\" (subbytes bstr_2 4)))
- (if (regexp-match? '#rx"^\\\\\\\\[?]\\\\UNC\\\\" bstr_2)
- (let-values () (bytes-append #"\\\\?\\REL\\" (subbytes bstr_2 4)))
- (if (regexp-match? '#rx"^\\\\\\\\" bstr_2)
- (let-values () (bytes-append #"UNC\\" (subbytes bstr_2 2)))
- (if (regexp-match? '#rx"^[a-z]:" bstr_2)
- (let-values () (bytes-append (subbytes bstr_2 0 1) (subbytes bstr_2 2)))
- (void))))))
- conv_0)))
+ (bytes-append #"\\\\?\\REL\\" (subbytes bstr_2 4))
+ (if (regexp-match? '#rx"^\\\\\\\\" bstr_2)
+ (bytes-append #"UNC\\" (subbytes bstr_2 2))
+ (if (regexp-match? '#rx"^[a-z]:" bstr_2)
+ (bytes-append (subbytes bstr_2 0 1) (subbytes bstr_2 2))
+ (void))))))
+ conv_0))
(void)))))))))))))
(define-values (rx:path-list) #f)
(define-values
@@ -496,12 +421,11 @@
(begin
(if rx:path-list
(void)
- (let-values ()
- (set! rx:path-list
- (byte-regexp
- (string->bytes/utf-8
- (let-values (((sep_4) (if (eq? (system-type) 'windows) ";" ":")))
- (format "([^~a]*)~a(.*)" sep_4 sep_4))))))))))
+ (set! rx:path-list
+ (byte-regexp
+ (string->bytes/utf-8
+ (let-values (((sep_4) (if (eq? (system-type) 'windows) ";" ":")))
+ (format "([^~a]*)~a(.*)" sep_4 sep_4)))))))))
(define-values
(cons-path)
(lambda (default_3 s_10 l_2)
@@ -515,33 +439,32 @@
(begin
(if (let-values (((or-part_11) (bytes? s_12))) (if or-part_11 or-part_11 (string? s_12)))
(void)
- (let-values () (raise-argument-error 'path-list-string->path-list "(or/c bytes? string?)" s_12)))
+ (raise-argument-error 'path-list-string->path-list "(or/c bytes? string?)" s_12))
(if (regexp-match? '#rx#"\0" s_12)
- (let-values ()
- (let-values (((label_0) (if (bytes? s_12) "byte string" "string")))
- (raise-arguments-error
- 'path-list-string->path-list
- (format "given ~a contains a nul character" label_0)
- label_0
- s_12)))
+ (let-values (((label_0) (if (bytes? s_12) "byte string" "string")))
+ (raise-arguments-error
+ 'path-list-string->path-list
+ (format "given ~a contains a nul character" label_0)
+ label_0
+ s_12))
(void))
(if (if (list? default_4)
(andmap
- (lambda (p_1) (let-values (((or-part_0) (eq? p_1 'same))) (if or-part_0 or-part_0 path?)))
+ (lambda (p_1) (let-values (((or-part_12) (eq? p_1 'same))) (if or-part_12 or-part_12 path?)))
default_4)
#f)
(void)
- (let-values () (raise-argument-error 'path-list-string->path-list "(listof path?)" default_4)))
+ (raise-argument-error 'path-list-string->path-list "(listof path?)" default_4))
(init-rx:path-list!)
- ((letrec-values (((loop_4)
+ ((letrec-values (((loop_3)
(lambda (s_13)
(begin
'loop
(let-values (((m_0) (regexp-match rx:path-list s_13)))
(if m_0
- (cons-path default_4 (cadr m_0) (loop_4 (caddr m_0)))
+ (cons-path default_4 (cadr m_0) (loop_3 (caddr m_0)))
(cons-path default_4 s_13 null)))))))
- loop_4)
+ loop_3)
(if (string? s_12) (string->bytes/utf-8 s_12) s_12))))))
(define-values
(find-executable-path)
@@ -549,49 +472,46 @@
((program_0 libpath_0 reverse?_0)
(begin
(begin
- (if (path-string? program_0)
- (void)
- (let-values () (raise-argument-error 'find-executable-path "path-string?" program_0)))
- (if (let-values (((or-part_12) (not libpath_0)))
- (if or-part_12 or-part_12 (if (path-string? libpath_0) (relative-path? libpath_0) #f)))
+ (if (path-string? program_0) (void) (raise-argument-error 'find-executable-path "path-string?" program_0))
+ (if (let-values (((or-part_13) (not libpath_0)))
+ (if or-part_13 or-part_13 (if (path-string? libpath_0) (relative-path? libpath_0) #f)))
(void)
- (let-values ()
- (raise-argument-error 'find-executable-path "(or/c #f (and/c path-string? relative-path?))" libpath_0)))
+ (raise-argument-error 'find-executable-path "(or/c #f (and/c path-string? relative-path?))" libpath_0))
(letrec-values (((found-exec_0)
(lambda (exec-name_0)
(begin
'found-exec
(if libpath_0
- (let-values (((base_2 name_3 isdir?_0) (split-path exec-name_0)))
+ (let-values (((base_2 name_2 isdir?_0) (split-path exec-name_0)))
(let-values (((next_0)
(lambda ()
(begin
'next
(let-values (((resolved_0) (resolve-path exec-name_0)))
(if (equal? resolved_0 exec-name_0)
- (let-values () #f)
+ #f
(if (relative-path? resolved_0)
- (let-values () (found-exec_0 (build-path base_2 resolved_0)))
- (let-values () (found-exec_0 resolved_0)))))))))
- (let-values (((or-part_13) (if reverse?_0 (next_0) #f)))
- (if or-part_13
- or-part_13
- (let-values (((or-part_14)
+ (found-exec_0 (build-path base_2 resolved_0))
+ (found-exec_0 resolved_0))))))))
+ (let-values (((or-part_14) (if reverse?_0 (next_0) #f)))
+ (if or-part_14
+ or-part_14
+ (let-values (((or-part_15)
(if (path? base_2)
(let-values (((lib_0) (build-path base_2 libpath_0)))
- (if (let-values (((or-part_15) (directory-exists? lib_0)))
- (if or-part_15 or-part_15 (file-exists? lib_0)))
+ (if (let-values (((or-part_16) (directory-exists? lib_0)))
+ (if or-part_16 or-part_16 (file-exists? lib_0)))
lib_0
#f))
#f)))
- (if or-part_14 or-part_14 (if (not reverse?_0) (next_0) #f)))))))
+ (if or-part_15 or-part_15 (if (not reverse?_0) (next_0) #f)))))))
exec-name_0))))
((try-exec_0)
(lambda (program_1)
(begin
'try-exec
(if (if (relative-path? program_1)
- (let-values (((base_3 name_4 dir?_1) (split-path program_1))) (eq? base_3 'relative))
+ (let-values (((base_3 name_3 dir?_1) (split-path program_1))) (eq? base_3 'relative))
#f)
(let-values (((paths-bstr_0)
(environment-variables-ref (current-environment-variables) #"PATH"))
@@ -602,28 +522,28 @@
(if (eq? (system-type) 'windows)
(cons (bytes->path #".") s_14)
s_14)))))
- ((letrec-values (((loop_5)
+ ((letrec-values (((loop_4)
(lambda (paths_0)
(begin
'loop
(if (null? paths_0)
#f
(let-values (((base_4) (path->complete-path (car paths_0))))
- (let-values (((name_5) (build-path base_4 program_1)))
- (if (file-exists? name_5)
- (found-exec_0 name_5)
- (loop_5 (cdr paths_0))))))))))
- loop_5)
+ (let-values (((name_4) (build-path base_4 program_1)))
+ (if (file-exists? name_4)
+ (found-exec_0 name_4)
+ (loop_4 (cdr paths_0))))))))))
+ loop_4)
(win-add_0 (if paths-bstr_0 (path-list-string->path-list paths-bstr_0 null) null))))
(let-values (((p_2) (path->complete-path program_1)))
(if (file-exists? p_2) (found-exec_0 p_2) #f)))))))
- (let-values (((or-part_4) (try-exec_0 program_0)))
- (if or-part_4
- or-part_4
+ (let-values (((or-part_17) (try-exec_0 program_0)))
+ (if or-part_17
+ or-part_17
(if (eq? 'windows (system-type))
- (let-values (((base_5 name_6 dir?_2) (split-path program_0)))
- (if (path? name_6)
- (if (not (regexp-match? '#rx"[.]" name_6))
+ (let-values (((base_5 name_5 dir?_2) (split-path program_0)))
+ (if (path? name_5)
+ (if (not (regexp-match? '#rx"[.]" name_5))
(try-exec_0 (path-replace-extension program_0 #".exe"))
#f)
#f))
@@ -632,9 +552,9 @@
((program_3) (find-executable-path program_3 #f #f))))
(define-values
(call-with-default-reading-parameterization)
- (lambda (thunk_3)
+ (lambda (thunk_2)
(begin
- (if (if (procedure? thunk_3) (procedure-arity-includes? thunk_3 0) #f)
+ (if (if (procedure? thunk_2) (procedure-arity-includes? thunk_2 0) #f)
(with-continuation-mark
parameterization-key
(extend-parameterization
@@ -677,15 +597,14 @@
#t
1/current-readtable
#f)
- (thunk_3))
- (raise-argument-error 'call-with-default-reading-parameterization "(procedure-arity-includes/c 0)" thunk_3)))))
+ (thunk_2))
+ (raise-argument-error 'call-with-default-reading-parameterization "(procedure-arity-includes/c 0)" thunk_2)))))
(define-values
(prop:keyword-impersonator keyword-impersonator? keyword-impersonator-ref)
(make-struct-type-property 'keyword-impersonator))
(define-values
(keyword-procedure-impersonator-of)
- (lambda (v_5)
- (begin (if (keyword-impersonator? v_5) (let-values () ((keyword-impersonator-ref v_5) v_5)) (let-values () #f)))))
+ (lambda (v_2) (begin (if (keyword-impersonator? v_2) ((keyword-impersonator-ref v_2) v_2) #f))))
(define-values
(struct:keyword-procedure mk-kw-proc keyword-procedure? keyword-procedure-ref keyword-procedure-set!)
(make-struct-type
@@ -704,7 +623,7 @@
(prop:procedure-accessor procedure-accessor? procedure-accessor-ref)
(make-struct-type-property
'procedure
- (lambda (v_6 info-l_0) (if (exact-integer? v_6) (make-struct-field-accessor (list-ref info-l_0 3) v_6) #f))))
+ (lambda (v_3 info-l_0) (if (exact-integer? v_3) (make-struct-field-accessor (list-ref info-l_0 3) v_3) #f))))
(define-values
(new-prop:procedure new-procedure? new-procedure-ref)
(make-struct-type-property
@@ -717,18 +636,51 @@
(lambda (p_3)
(begin
(if (keyword-procedure? p_3)
- (let-values () (values (keyword-procedure-required p_3) (keyword-procedure-allowed p_3)))
+ (values (keyword-procedure-required p_3) (keyword-procedure-allowed p_3))
(if (procedure? p_3)
- (let-values ()
- (if (new-procedure? p_3)
- (let-values (((v_7) (new-procedure-ref p_3)))
- (if (procedure? v_7)
- (procedure-keywords v_7)
- (let-values (((a_1) (procedure-accessor-ref p_3)))
- (if a_1 (procedure-keywords (a_1 p_3)) (values null null)))))
- (values null null)))
- (let-values () (raise-argument-error* 'procedure-keywords 'racket/primitive "procedure?" p_3)))))))
+ (if (new-procedure? p_3)
+ (let-values (((v_4) (new-procedure-ref p_3)))
+ (if (procedure? v_4)
+ (procedure-keywords v_4)
+ (let-values (((a_1) (procedure-accessor-ref p_3)))
+ (if a_1 (procedure-keywords (a_1 p_3)) (values null null)))))
+ (values null null))
+ (raise-argument-error* 'procedure-keywords 'racket/primitive "procedure?" p_3))))))
(define-values (print-values) (lambda vs_0 (begin (begin (for-each (current-print) vs_0) (apply values vs_0)))))
+ (define-values
+ (bad-list$1)
+ (lambda (who_3 orig-l_0) (begin 'bad-list (raise-arguments-error who_3 "not a proper list" "in" orig-l_0))))
+ (define-values
+ (member-impl)
+ (lambda (who_4 v_5 orig-l_1 eql?_0)
+ (begin
+ (letrec-values (((loop_5)
+ (lambda (ls_0 turtle_0)
+ (begin
+ 'loop
+ (if (null? ls_0)
+ #f
+ (if (not (pair? ls_0))
+ (bad-list$1 who_4 orig-l_1)
+ (if (eql?_0 v_5 (car ls_0))
+ ls_0
+ (let-values (((ls_1) (cdr ls_0)))
+ (if (null? ls_1)
+ #f
+ (if (if (not (pair? ls_1)) #t (eq? ls_1 turtle_0))
+ (bad-list$1 who_4 orig-l_1)
+ (if (eql?_0 v_5 (car ls_1)) ls_1 (loop_5 (cdr ls_1) (cdr turtle_0)))))))))))))
+ (loop_5 orig-l_1 orig-l_1)))))
+ (define-values
+ (member)
+ (case-lambda
+ ((v_6 ls_2) (begin (member-impl 'member v_6 ls_2 equal?)))
+ ((v_7 ls_3 eql?_1)
+ (begin
+ (if (if (procedure? eql?_1) (procedure-arity-includes? eql?_1 2) #f)
+ (void)
+ (raise-argument-error 'member "(procedure-arity-includes/c 2)" eql?_1))
+ (member-impl 'member v_7 ls_3 eql?_1)))))
(define-values
(reverse$1)
(lambda (l_3)
@@ -739,1100 +691,943 @@
(void)
(if (list? l_3) (void) (raise-argument-error 'reverse "list?" l_3)))
(letrec-values (((loop_6)
- (lambda (a_2 l_2) (begin 'loop (if (null? l_2) a_2 (loop_6 (cons (car l_2) a_2) (cdr l_2)))))))
+ (lambda (a_2 l_4) (begin 'loop (if (null? l_4) a_2 (loop_6 (cons (car l_4) a_2) (cdr l_4)))))))
(loop_6 null l_3))))))
(define-values
(sort vector-sort vector-sort!)
- (let-values ()
- (let-values (((generic-sort_0)
- (lambda (A_0 less-than?_0 n_1)
- (begin
- 'generic-sort
- (let-values ()
- (let-values ()
- (let-values (((n/2-_0) (unsafe-fxrshift n_1 1)))
- (let-values (((n/2+_0) (unsafe-fx- n_1 n/2-_0)))
- (letrec-values (((copying-mergesort_0)
- (lambda (Alo_0 Blo_0 n_2)
- (begin
- 'copying-mergesort
- (if (unsafe-fx= n_2 1)
- (let-values ()
- (unsafe-vector-set! A_0 Blo_0 (unsafe-vector-ref A_0 Alo_0)))
- (if (unsafe-fx= n_2 2)
- (let-values ()
- (let-values (((x_0) (unsafe-vector-ref A_0 Alo_0))
- ((y_0)
- (unsafe-vector-ref A_0 (unsafe-fx+ Alo_0 1))))
- (if (less-than?_0 y_0 x_0)
- (begin
- (unsafe-vector-set! A_0 Blo_0 y_0)
- (unsafe-vector-set! A_0 (unsafe-fx+ Blo_0 1) x_0))
- (begin
- (unsafe-vector-set! A_0 Blo_0 x_0)
- (unsafe-vector-set! A_0 (unsafe-fx+ Blo_0 1) y_0)))))
- (if (unsafe-fx< n_2 16)
- (let-values ()
- (begin
- (unsafe-vector-set!
- A_0
- Blo_0
- (unsafe-vector-ref A_0 Alo_0))
- ((letrec-values (((iloop_0)
- (lambda (i_4)
+ (let-values (((generic-sort_0)
+ (lambda (A_0 less-than?_0 n_1)
+ (begin
+ 'generic-sort
+ (let-values (((n/2-_0) (unsafe-fxrshift n_1 1)))
+ (let-values (((n/2+_0) (unsafe-fx- n_1 n/2-_0)))
+ (letrec-values (((copying-mergesort_0)
+ (lambda (Alo_0 Blo_0 n_2)
+ (begin
+ 'copying-mergesort
+ (if (unsafe-fx= n_2 1)
+ (unsafe-vector-set! A_0 Blo_0 (unsafe-vector-ref A_0 Alo_0))
+ (if (unsafe-fx= n_2 2)
+ (let-values (((x_0) (unsafe-vector-ref A_0 Alo_0))
+ ((y_0) (unsafe-vector-ref A_0 (unsafe-fx+ Alo_0 1))))
+ (if (less-than?_0 y_0 x_0)
+ (begin
+ (unsafe-vector-set! A_0 Blo_0 y_0)
+ (unsafe-vector-set! A_0 (unsafe-fx+ Blo_0 1) x_0))
+ (begin
+ (unsafe-vector-set! A_0 Blo_0 x_0)
+ (unsafe-vector-set! A_0 (unsafe-fx+ Blo_0 1) y_0))))
+ (if (unsafe-fx< n_2 16)
+ (begin
+ (unsafe-vector-set! A_0 Blo_0 (unsafe-vector-ref A_0 Alo_0))
+ ((letrec-values (((iloop_0)
+ (lambda (i_4)
+ (begin
+ 'iloop
+ (if (unsafe-fx< i_4 n_2)
+ (let-values (((ref-i_0)
+ (unsafe-vector-ref
+ A_0
+ (unsafe-fx+ Alo_0 i_4))))
+ ((letrec-values (((jloop_0)
+ (lambda (j_0)
+ (begin
+ 'jloop
+ (let-values (((ref-j-1_0)
+ (unsafe-vector-ref
+ A_0
+ (unsafe-fx-
+ j_0
+ 1))))
+ (if (if (unsafe-fx<
+ Blo_0
+ j_0)
+ (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_4
+ 1)))))))))
+ jloop_0)
+ (unsafe-fx+ Blo_0 i_4)))
+ (void))))))
+ iloop_0)
+ 1))
+ (let-values (((n/2-_1) (unsafe-fxrshift n_2 1)))
+ (let-values (((n/2+_1) (unsafe-fx- n_2 n/2-_1)))
+ (let-values (((Amid1_0) (unsafe-fx+ Alo_0 n/2-_1))
+ ((Amid2_0) (unsafe-fx+ Alo_0 n/2+_1))
+ ((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-values (((b2_0) (unsafe-fx+ Blo_0 n_2)))
+ ((letrec-values (((loop_7)
+ (lambda (a1_0 b1_0 c1_0)
(begin
- 'iloop
- (if (unsafe-fx< i_4 n_2)
- (let-values ()
- (let-values (((ref-i_0)
- (unsafe-vector-ref
- A_0
- (unsafe-fx+
- Alo_0
- i_4))))
- ((letrec-values (((jloop_0)
- (lambda (j_0)
- (begin
- 'jloop
- (let-values (((ref-j-1_0)
- (unsafe-vector-ref
- A_0
- (unsafe-fx-
- j_0
- 1))))
- (if (if (unsafe-fx<
- Blo_0
- j_0)
- (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_4
- 1)))))))))
- jloop_0)
- (unsafe-fx+ Blo_0 i_4))))
- (void))))))
- iloop_0)
- 1)))
- (let-values ()
- (let-values (((n/2-_1) (unsafe-fxrshift n_2 1)))
- (let-values (((n/2+_1) (unsafe-fx- n_2 n/2-_1)))
- (let-values (((Amid1_0) (unsafe-fx+ Alo_0 n/2-_1))
- ((Amid2_0) (unsafe-fx+ Alo_0 n/2+_1))
- ((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-values (((b2_0) (unsafe-fx+ Blo_0 n_2)))
- ((letrec-values (((loop_7)
- (lambda (a1_0 b1_0 c1_0)
- (begin
- 'loop
- (let-values (((x_1)
- (unsafe-vector-ref
- A_0
- a1_0))
- ((y_1)
- (unsafe-vector-ref
- A_0
- b1_0)))
- (if (not
- (less-than?_0
- y_1
- x_1))
- (begin
- (unsafe-vector-set!
+ 'loop
+ (let-values (((x_1)
+ (unsafe-vector-ref
A_0
- c1_0
- x_1)
- (let-values (((a1_1)
- (unsafe-fx+
- a1_0
- 1))
- ((c1_1)
- (unsafe-fx+
- c1_0
- 1)))
- (if (unsafe-fx<
- c1_1
- b1_0)
- (let-values ()
- (loop_7
- a1_1
- b1_0
- c1_1))
- (void))))
- (begin
- (unsafe-vector-set!
+ a1_0))
+ ((y_1)
+ (unsafe-vector-ref
A_0
- c1_0
- y_1)
- (let-values (((b1_1)
- (unsafe-fx+
- b1_0
- 1))
- ((c1_2)
- (unsafe-fx+
- c1_0
- 1)))
- (if (unsafe-fx<=
- b2_0
- b1_1)
- ((letrec-values (((loop_8)
- (lambda (a1_2
- c1_3)
- (begin
- 'loop
- (if (unsafe-fx<
- c1_3
- b1_1)
- (let-values ()
- (begin
- (unsafe-vector-set!
- A_0
- c1_3
- (unsafe-vector-ref
- A_0
- a1_2))
- (loop_8
- (unsafe-fx+
- a1_2
- 1)
- (unsafe-fx+
- c1_3
- 1))))
- (void))))))
- loop_8)
- a1_0
- c1_2)
- (loop_7
- a1_0
- b1_1
- c1_2))))))))))
- loop_7)
- Amid2_0
- Bmid1_0
- Blo_0))))))))))))))
- (let-values (((Alo_1) 0)
- ((Amid1_1) n/2-_0)
- ((Amid2_1) n/2+_0)
- ((Ahi_0) n_1)
- ((B1lo_0) n_1))
- (begin
- (copying-mergesort_0 Amid1_1 B1lo_0 n/2+_0)
- (if (zero? n/2-_0)
- (void)
- (let-values () (copying-mergesort_0 Alo_1 Amid2_1 n/2-_0)))
- (let-values (((b2_1) Ahi_0))
- ((letrec-values (((loop_9)
- (lambda (a1_3 b1_2 c1_4)
- (begin
- 'loop
- (let-values (((x_2) (unsafe-vector-ref A_0 a1_3))
- ((y_2) (unsafe-vector-ref A_0 b1_2)))
- (if (less-than?_0 x_2 y_2)
- (begin
- (unsafe-vector-set! A_0 c1_4 x_2)
- (let-values (((a1_4) (unsafe-fx+ a1_3 1))
- ((c1_5) (unsafe-fx+ c1_4 1)))
- (if (unsafe-fx< c1_5 b1_2)
- (let-values () (loop_9 a1_4 b1_2 c1_5))
- (void))))
- (begin
- (unsafe-vector-set! A_0 c1_4 y_2)
- (let-values (((b1_3) (unsafe-fx+ b1_2 1))
- ((c1_6) (unsafe-fx+ c1_4 1)))
- (if (unsafe-fx<= b2_1 b1_3)
- ((letrec-values (((loop_10)
- (lambda (a1_5 c1_7)
- (begin
- 'loop
- (if (unsafe-fx< c1_7 b1_3)
- (let-values ()
- (begin
- (unsafe-vector-set!
- A_0
- c1_7
- (unsafe-vector-ref
- A_0
- a1_5))
- (loop_10
- (unsafe-fx+ a1_5 1)
- (unsafe-fx+
- c1_7
- 1))))
- (void))))))
- loop_10)
- a1_3
- c1_6)
- (loop_9 a1_3 b1_3 c1_6))))))))))
- loop_9)
- B1lo_0
- Amid2_1
- Alo_1)))))))))))))
- (let-values (((generic-sort/key_0)
- (lambda (A_1 less-than?_1 n_3 key_7)
- (begin
- 'generic-sort/key
- (let-values ()
- (let-values ()
- (let-values (((n/2-_2) (unsafe-fxrshift n_3 1)))
- (let-values (((n/2+_2) (unsafe-fx- n_3 n/2-_2)))
- (letrec-values (((copying-mergesort_1)
- (lambda (Alo_2 Blo_1 n_4)
- (begin
- 'copying-mergesort
- (if (unsafe-fx= n_4 1)
- (let-values ()
- (unsafe-vector-set! A_1 Blo_1 (unsafe-vector-ref A_1 Alo_2)))
- (if (unsafe-fx= n_4 2)
- (let-values ()
- (let-values (((x_3) (unsafe-vector-ref A_1 Alo_2))
- ((y_3)
- (unsafe-vector-ref A_1 (unsafe-fx+ Alo_2 1))))
- (if (if key_7
- (less-than?_1 (key_7 y_3) (key_7 x_3))
- (less-than?_1 y_3 x_3))
- (begin
- (unsafe-vector-set! A_1 Blo_1 y_3)
- (unsafe-vector-set! A_1 (unsafe-fx+ Blo_1 1) x_3))
- (begin
- (unsafe-vector-set! A_1 Blo_1 x_3)
- (unsafe-vector-set! A_1 (unsafe-fx+ Blo_1 1) y_3)))))
- (if (unsafe-fx< n_4 16)
- (let-values ()
- (begin
- (unsafe-vector-set!
- A_1
- Blo_1
- (unsafe-vector-ref A_1 Alo_2))
- ((letrec-values (((iloop_1)
- (lambda (i_5)
- (begin
- 'iloop
- (if (unsafe-fx< i_5 n_4)
- (let-values ()
- (let-values (((ref-i_1)
- (unsafe-vector-ref
- A_1
- (unsafe-fx+
- Alo_2
- i_5))))
- ((letrec-values (((jloop_1)
- (lambda (j_1)
- (begin
- 'jloop
- (let-values (((ref-j-1_1)
- (unsafe-vector-ref
- A_1
- (unsafe-fx-
- j_1
- 1))))
- (if (if (unsafe-fx<
- Blo_1
- j_1)
- (if key_7
- (less-than?_1
- (key_7
- ref-i_1)
- (key_7
- ref-j-1_1))
- (less-than?_1
- ref-i_1
- ref-j-1_1))
- #f)
- (begin
- (unsafe-vector-set!
- A_1
- j_1
- ref-j-1_1)
- (jloop_1
- (unsafe-fx-
- j_1
- 1)))
+ b1_0)))
+ (if (not (less-than?_0 y_1 x_1))
+ (begin
+ (unsafe-vector-set!
+ A_0
+ c1_0
+ x_1)
+ (let-values (((a1_1)
+ (unsafe-fx+
+ a1_0
+ 1))
+ ((c1_1)
+ (unsafe-fx+
+ c1_0
+ 1)))
+ (if (unsafe-fx< c1_1 b1_0)
+ (loop_7 a1_1 b1_0 c1_1)
+ (void))))
+ (begin
+ (unsafe-vector-set!
+ A_0
+ c1_0
+ y_1)
+ (let-values (((b1_1)
+ (unsafe-fx+
+ b1_0
+ 1))
+ ((c1_2)
+ (unsafe-fx+
+ c1_0
+ 1)))
+ (if (unsafe-fx<= b2_0 b1_1)
+ ((letrec-values (((loop_8)
+ (lambda (a1_2
+ c1_3)
+ (begin
+ 'loop
+ (if (unsafe-fx<
+ c1_3
+ b1_1)
(begin
(unsafe-vector-set!
- A_1
- j_1
- ref-i_1)
- (iloop_1
+ A_0
+ c1_3
+ (unsafe-vector-ref
+ A_0
+ a1_2))
+ (loop_8
(unsafe-fx+
- i_5
- 1)))))))))
- jloop_1)
- (unsafe-fx+ Blo_1 i_5))))
- (void))))))
- iloop_1)
- 1)))
- (let-values ()
- (let-values (((n/2-_3) (unsafe-fxrshift n_4 1)))
- (let-values (((n/2+_3) (unsafe-fx- n_4 n/2-_3)))
- (let-values (((Amid1_2) (unsafe-fx+ Alo_2 n/2-_3))
- ((Amid2_2) (unsafe-fx+ Alo_2 n/2+_3))
- ((Bmid1_1) (unsafe-fx+ Blo_1 n/2-_3)))
- (begin
- (copying-mergesort_1 Amid1_2 Bmid1_1 n/2+_3)
- (copying-mergesort_1 Alo_2 Amid2_2 n/2-_3)
- (let-values (((b2_2) (unsafe-fx+ Blo_1 n_4)))
- ((letrec-values (((loop_11)
- (lambda (a1_6 b1_4 c1_8)
- (begin
- 'loop
- (let-values (((x_4)
- (unsafe-vector-ref
- A_1
- a1_6))
- ((y_4)
- (unsafe-vector-ref
- A_1
- b1_4)))
- (if (not
- (if key_7
- (less-than?_1
- (key_7 y_4)
- (key_7 x_4))
- (less-than?_1
- y_4
- x_4)))
- (begin
- (unsafe-vector-set!
+ a1_2
+ 1)
+ (unsafe-fx+
+ c1_3
+ 1)))
+ (void))))))
+ loop_8)
+ a1_0
+ c1_2)
+ (loop_7
+ a1_0
+ b1_1
+ c1_2))))))))))
+ loop_7)
+ Amid2_0
+ Bmid1_0
+ Blo_0)))))))))))))
+ (let-values (((Alo_1) 0) ((Amid1_1) n/2-_0) ((Amid2_1) n/2+_0) ((Ahi_0) n_1) ((B1lo_0) n_1))
+ (begin
+ (copying-mergesort_0 Amid1_1 B1lo_0 n/2+_0)
+ (if (zero? n/2-_0) (void) (copying-mergesort_0 Alo_1 Amid2_1 n/2-_0))
+ (let-values (((b2_1) Ahi_0))
+ ((letrec-values (((loop_9)
+ (lambda (a1_3 b1_2 c1_4)
+ (begin
+ 'loop
+ (let-values (((x_2) (unsafe-vector-ref A_0 a1_3))
+ ((y_2) (unsafe-vector-ref A_0 b1_2)))
+ (if (less-than?_0 x_2 y_2)
+ (begin
+ (unsafe-vector-set! A_0 c1_4 x_2)
+ (let-values (((a1_4) (unsafe-fx+ a1_3 1))
+ ((c1_5) (unsafe-fx+ c1_4 1)))
+ (if (unsafe-fx< c1_5 b1_2)
+ (loop_9 a1_4 b1_2 c1_5)
+ (void))))
+ (begin
+ (unsafe-vector-set! A_0 c1_4 y_2)
+ (let-values (((b1_3) (unsafe-fx+ b1_2 1))
+ ((c1_6) (unsafe-fx+ c1_4 1)))
+ (if (unsafe-fx<= b2_1 b1_3)
+ ((letrec-values (((loop_10)
+ (lambda (a1_5 c1_7)
+ (begin
+ 'loop
+ (if (unsafe-fx< c1_7 b1_3)
+ (begin
+ (unsafe-vector-set!
+ A_0
+ c1_7
+ (unsafe-vector-ref A_0 a1_5))
+ (loop_10
+ (unsafe-fx+ a1_5 1)
+ (unsafe-fx+ c1_7 1)))
+ (void))))))
+ loop_10)
+ a1_3
+ c1_6)
+ (loop_9 a1_3 b1_3 c1_6))))))))))
+ loop_9)
+ B1lo_0
+ Amid2_1
+ Alo_1)))))))))))
+ (let-values (((generic-sort/key_0)
+ (lambda (A_1 less-than?_1 n_3 key_7)
+ (begin
+ 'generic-sort/key
+ (let-values (((n/2-_2) (unsafe-fxrshift n_3 1)))
+ (let-values (((n/2+_2) (unsafe-fx- n_3 n/2-_2)))
+ (letrec-values (((copying-mergesort_1)
+ (lambda (Alo_2 Blo_1 n_4)
+ (begin
+ 'copying-mergesort
+ (if (unsafe-fx= n_4 1)
+ (unsafe-vector-set! A_1 Blo_1 (unsafe-vector-ref A_1 Alo_2))
+ (if (unsafe-fx= n_4 2)
+ (let-values (((x_3) (unsafe-vector-ref A_1 Alo_2))
+ ((y_3) (unsafe-vector-ref A_1 (unsafe-fx+ Alo_2 1))))
+ (if (if key_7
+ (less-than?_1 (key_7 y_3) (key_7 x_3))
+ (less-than?_1 y_3 x_3))
+ (begin
+ (unsafe-vector-set! A_1 Blo_1 y_3)
+ (unsafe-vector-set! A_1 (unsafe-fx+ Blo_1 1) x_3))
+ (begin
+ (unsafe-vector-set! A_1 Blo_1 x_3)
+ (unsafe-vector-set! A_1 (unsafe-fx+ Blo_1 1) y_3))))
+ (if (unsafe-fx< n_4 16)
+ (begin
+ (unsafe-vector-set! A_1 Blo_1 (unsafe-vector-ref A_1 Alo_2))
+ ((letrec-values (((iloop_1)
+ (lambda (i_5)
+ (begin
+ 'iloop
+ (if (unsafe-fx< i_5 n_4)
+ (let-values (((ref-i_1)
+ (unsafe-vector-ref
+ A_1
+ (unsafe-fx+ Alo_2 i_5))))
+ ((letrec-values (((jloop_1)
+ (lambda (j_1)
+ (begin
+ 'jloop
+ (let-values (((ref-j-1_1)
+ (unsafe-vector-ref
+ A_1
+ (unsafe-fx-
+ j_1
+ 1))))
+ (if (if (unsafe-fx<
+ Blo_1
+ j_1)
+ (if key_7
+ (less-than?_1
+ (key_7
+ ref-i_1)
+ (key_7
+ ref-j-1_1))
+ (less-than?_1
+ ref-i_1
+ ref-j-1_1))
+ #f)
+ (begin
+ (unsafe-vector-set!
+ A_1
+ j_1
+ ref-j-1_1)
+ (jloop_1
+ (unsafe-fx-
+ j_1
+ 1)))
+ (begin
+ (unsafe-vector-set!
+ A_1
+ j_1
+ ref-i_1)
+ (iloop_1
+ (unsafe-fx+
+ i_5
+ 1)))))))))
+ jloop_1)
+ (unsafe-fx+ Blo_1 i_5)))
+ (void))))))
+ iloop_1)
+ 1))
+ (let-values (((n/2-_3) (unsafe-fxrshift n_4 1)))
+ (let-values (((n/2+_3) (unsafe-fx- n_4 n/2-_3)))
+ (let-values (((Amid1_2) (unsafe-fx+ Alo_2 n/2-_3))
+ ((Amid2_2) (unsafe-fx+ Alo_2 n/2+_3))
+ ((Bmid1_1) (unsafe-fx+ Blo_1 n/2-_3)))
+ (begin
+ (copying-mergesort_1 Amid1_2 Bmid1_1 n/2+_3)
+ (copying-mergesort_1 Alo_2 Amid2_2 n/2-_3)
+ (let-values (((b2_2) (unsafe-fx+ Blo_1 n_4)))
+ ((letrec-values (((loop_11)
+ (lambda (a1_6 b1_4 c1_8)
+ (begin
+ 'loop
+ (let-values (((x_4)
+ (unsafe-vector-ref
A_1
- c1_8
- x_4)
- (let-values (((a1_7)
- (unsafe-fx+
- a1_6
- 1))
- ((c1_9)
- (unsafe-fx+
- c1_8
- 1)))
- (if (unsafe-fx<
- c1_9
- b1_4)
- (let-values ()
- (loop_11
- a1_7
- b1_4
- c1_9))
- (void))))
- (begin
- (unsafe-vector-set!
+ a1_6))
+ ((y_4)
+ (unsafe-vector-ref
A_1
- c1_8
- y_4)
- (let-values (((b1_5)
- (unsafe-fx+
- b1_4
- 1))
- ((c1_10)
- (unsafe-fx+
- c1_8
- 1)))
- (if (unsafe-fx<=
- b2_2
- b1_5)
- ((letrec-values (((loop_12)
- (lambda (a1_8
- c1_11)
- (begin
- 'loop
- (if (unsafe-fx<
- c1_11
- b1_5)
- (let-values ()
- (begin
- (unsafe-vector-set!
- A_1
- c1_11
- (unsafe-vector-ref
- A_1
- a1_8))
- (loop_12
- (unsafe-fx+
- a1_8
- 1)
- (unsafe-fx+
- c1_11
- 1))))
- (void))))))
- loop_12)
- a1_6
- c1_10)
- (loop_11
- a1_6
- b1_5
- c1_10))))))))))
- loop_11)
- Amid2_2
- Bmid1_1
- Blo_1))))))))))))))
- (let-values (((Alo_3) 0)
- ((Amid1_3) n/2-_2)
- ((Amid2_3) n/2+_2)
- ((Ahi_1) n_3)
- ((B1lo_1) n_3))
- (begin
- (copying-mergesort_1 Amid1_3 B1lo_1 n/2+_2)
- (if (zero? n/2-_2)
- (void)
- (let-values () (copying-mergesort_1 Alo_3 Amid2_3 n/2-_2)))
- (let-values (((b2_3) Ahi_1))
- ((letrec-values (((loop_13)
- (lambda (a1_9 b1_6 c1_12)
+ b1_4)))
+ (if (not
+ (if key_7
+ (less-than?_1
+ (key_7 y_4)
+ (key_7 x_4))
+ (less-than?_1 y_4 x_4)))
+ (begin
+ (unsafe-vector-set!
+ A_1
+ c1_8
+ x_4)
+ (let-values (((a1_7)
+ (unsafe-fx+
+ a1_6
+ 1))
+ ((c1_9)
+ (unsafe-fx+
+ c1_8
+ 1)))
+ (if (unsafe-fx< c1_9 b1_4)
+ (loop_11 a1_7 b1_4 c1_9)
+ (void))))
+ (begin
+ (unsafe-vector-set!
+ A_1
+ c1_8
+ y_4)
+ (let-values (((b1_5)
+ (unsafe-fx+
+ b1_4
+ 1))
+ ((c1_10)
+ (unsafe-fx+
+ c1_8
+ 1)))
+ (if (unsafe-fx<= b2_2 b1_5)
+ ((letrec-values (((loop_12)
+ (lambda (a1_8
+ c1_11)
+ (begin
+ 'loop
+ (if (unsafe-fx<
+ c1_11
+ b1_5)
+ (begin
+ (unsafe-vector-set!
+ A_1
+ c1_11
+ (unsafe-vector-ref
+ A_1
+ a1_8))
+ (loop_12
+ (unsafe-fx+
+ a1_8
+ 1)
+ (unsafe-fx+
+ c1_11
+ 1)))
+ (void))))))
+ loop_12)
+ a1_6
+ c1_10)
+ (loop_11
+ a1_6
+ b1_5
+ c1_10))))))))))
+ loop_11)
+ Amid2_2
+ Bmid1_1
+ Blo_1)))))))))))))
+ (let-values (((Alo_3) 0) ((Amid1_3) n/2-_2) ((Amid2_3) n/2+_2) ((Ahi_1) n_3) ((B1lo_1) n_3))
+ (begin
+ (copying-mergesort_1 Amid1_3 B1lo_1 n/2+_2)
+ (if (zero? n/2-_2) (void) (copying-mergesort_1 Alo_3 Amid2_3 n/2-_2))
+ (let-values (((b2_3) Ahi_1))
+ ((letrec-values (((loop_13)
+ (lambda (a1_9 b1_6 c1_12)
+ (begin
+ 'loop
+ (let-values (((x_5) (unsafe-vector-ref A_1 a1_9))
+ ((y_5) (unsafe-vector-ref A_1 b1_6)))
+ (if (if key_7
+ (less-than?_1 (key_7 x_5) (key_7 y_5))
+ (less-than?_1 x_5 y_5))
(begin
- 'loop
- (let-values (((x_5) (unsafe-vector-ref A_1 a1_9))
- ((y_5) (unsafe-vector-ref A_1 b1_6)))
- (if (if key_7
- (less-than?_1 (key_7 x_5) (key_7 y_5))
- (less-than?_1 x_5 y_5))
- (begin
- (unsafe-vector-set! A_1 c1_12 x_5)
- (let-values (((a1_10) (unsafe-fx+ a1_9 1))
- ((c1_13) (unsafe-fx+ c1_12 1)))
- (if (unsafe-fx< c1_13 b1_6)
- (let-values () (loop_13 a1_10 b1_6 c1_13))
- (void))))
- (begin
- (unsafe-vector-set! A_1 c1_12 y_5)
- (let-values (((b1_7) (unsafe-fx+ b1_6 1))
- ((c1_14) (unsafe-fx+ c1_12 1)))
- (if (unsafe-fx<= b2_3 b1_7)
- ((letrec-values (((loop_14)
- (lambda (a1_11 c1_15)
- (begin
- 'loop
- (if (unsafe-fx<
- c1_15
- b1_7)
- (let-values ()
- (begin
- (unsafe-vector-set!
- A_1
- c1_15
- (unsafe-vector-ref
- A_1
- a1_11))
- (loop_14
- (unsafe-fx+
- a1_11
- 1)
- (unsafe-fx+
- c1_15
- 1))))
- (void))))))
- loop_14)
- a1_9
- c1_14)
- (loop_13 a1_9 b1_7 c1_14))))))))))
- loop_13)
- B1lo_1
- Amid2_3
- Alo_3)))))))))))))
- (values
- (case-lambda
- ((lst_0 less-than?_2)
- (let-values (((n_5) (length lst_0)))
- (let-values ()
- (if (unsafe-fx= n_5 0)
- (let-values () lst_0)
- (if ((letrec-values (((loop_15)
- (lambda (last_0 next_1)
+ (unsafe-vector-set! A_1 c1_12 x_5)
+ (let-values (((a1_10) (unsafe-fx+ a1_9 1))
+ ((c1_13) (unsafe-fx+ c1_12 1)))
+ (if (unsafe-fx< c1_13 b1_6)
+ (loop_13 a1_10 b1_6 c1_13)
+ (void))))
+ (begin
+ (unsafe-vector-set! A_1 c1_12 y_5)
+ (let-values (((b1_7) (unsafe-fx+ b1_6 1))
+ ((c1_14) (unsafe-fx+ c1_12 1)))
+ (if (unsafe-fx<= b2_3 b1_7)
+ ((letrec-values (((loop_14)
+ (lambda (a1_11 c1_15)
+ (begin
+ 'loop
+ (if (unsafe-fx< c1_15 b1_7)
+ (begin
+ (unsafe-vector-set!
+ A_1
+ c1_15
+ (unsafe-vector-ref
+ A_1
+ a1_11))
+ (loop_14
+ (unsafe-fx+ a1_11 1)
+ (unsafe-fx+ c1_15 1)))
+ (void))))))
+ loop_14)
+ a1_9
+ c1_14)
+ (loop_13 a1_9 b1_7 c1_14))))))))))
+ loop_13)
+ B1lo_1
+ Amid2_3
+ Alo_3)))))))))))
+ (values
+ (case-lambda
+ ((lst_0 less-than?_2)
+ (let-values (((n_5) (length lst_0)))
+ (if (unsafe-fx= n_5 0)
+ lst_0
+ (if ((letrec-values (((loop_15)
+ (lambda (last_0 next_1)
+ (begin
+ 'loop
+ (let-values (((or-part_18) (null? next_1)))
+ (if or-part_18
+ or-part_18
+ (if (not (less-than?_2 (unsafe-car next_1) last_0))
+ (loop_15 (unsafe-car next_1) (unsafe-cdr next_1))
+ #f)))))))
+ loop_15)
+ (car lst_0)
+ (cdr lst_0))
+ lst_0
+ (if (unsafe-fx<= n_5 3)
+ (if (unsafe-fx= n_5 1)
+ lst_0
+ (if (unsafe-fx= n_5 2)
+ (list (cadr lst_0) (car lst_0))
+ (let-values (((a_3) (car lst_0)) ((b_1) (cadr lst_0)) ((c_1) (caddr lst_0)))
+ (if (less-than?_2 b_1 a_3)
+ (if (less-than?_2 c_1 b_1)
+ (list c_1 b_1 a_3)
+ (if (less-than?_2 c_1 a_3) (list b_1 c_1 a_3) (list b_1 a_3 c_1)))
+ (if (less-than?_2 c_1 a_3) (list c_1 a_3 b_1) (list a_3 c_1 b_1))))))
+ (let-values (((vec_0) (make-vector (+ n_5 (ceiling (/ n_5 2))))))
+ (begin
+ ((letrec-values (((loop_16)
+ (lambda (i_6 lst_1)
+ (begin
+ 'loop
+ (if (pair? lst_1)
+ (begin
+ (vector-set! vec_0 i_6 (car lst_1))
+ (loop_16 (add1 i_6) (cdr lst_1)))
+ (void))))))
+ loop_16)
+ 0
+ lst_0)
+ (generic-sort_0 vec_0 less-than?_2 n_5)
+ ((letrec-values (((loop_17)
+ (lambda (i_7 r_0)
+ (begin
+ 'loop
+ (let-values (((i_8) (sub1 i_7)))
+ (if (< i_8 0) r_0 (loop_17 i_8 (cons (vector-ref vec_0 i_8) r_0))))))))
+ loop_17)
+ n_5
+ '()))))))))
+ ((lst_2 less-than?_3 getkey_0)
+ (if (if getkey_0 (not (eq? values getkey_0)) #f)
+ (sort lst_2 less-than?_3 getkey_0 #f)
+ (sort lst_2 less-than?_3)))
+ ((lst_3 less-than?_4 getkey_1 cache-keys?_0)
+ (if (if getkey_1 (not (eq? values getkey_1)) #f)
+ (let-values (((n_6) (length lst_3)))
+ (if (unsafe-fx= n_6 0)
+ lst_3
+ (if cache-keys?_0
+ (let-values (((vec_1) (make-vector (+ n_6 (ceiling (/ n_6 2))))))
+ (begin
+ ((letrec-values (((loop_18)
+ (lambda (i_9 lst_4)
+ (begin
+ 'loop
+ (if (pair? lst_4)
+ (let-values (((x_6) (car lst_4)))
+ (begin
+ (unsafe-vector-set! vec_1 i_9 (cons (getkey_1 x_6) x_6))
+ (loop_18 (unsafe-fx+ i_9 1) (cdr lst_4))))
+ (void))))))
+ loop_18)
+ 0
+ lst_3)
+ (generic-sort/key_0 vec_1 less-than?_4 n_6 unsafe-car)
+ ((letrec-values (((loop_19)
+ (lambda (i_10 r_1)
+ (begin
+ 'loop
+ (let-values (((i_11) (unsafe-fx- i_10 1)))
+ (if (unsafe-fx< i_11 0)
+ r_1
+ (loop_19
+ i_11
+ (cons (unsafe-cdr (unsafe-vector-ref vec_1 i_11)) r_1))))))))
+ loop_19)
+ n_6
+ '())))
+ (if ((letrec-values (((loop_20)
+ (lambda (last_1 next_2)
(begin
'loop
- (let-values (((or-part_16) (null? next_1)))
- (if or-part_16
- or-part_16
- (if (not (less-than?_2 (unsafe-car next_1) last_0))
- (loop_15 (unsafe-car next_1) (unsafe-cdr next_1))
+ (let-values (((or-part_19) (null? next_2)))
+ (if or-part_19
+ or-part_19
+ (if (not
+ (if getkey_1
+ (less-than?_4 (getkey_1 (unsafe-car next_2)) (getkey_1 last_1))
+ (less-than?_4 (unsafe-car next_2) last_1)))
+ (loop_20 (unsafe-car next_2) (unsafe-cdr next_2))
#f)))))))
- loop_15)
- (car lst_0)
- (cdr lst_0))
- (let-values () lst_0)
- (if (unsafe-fx<= n_5 3)
- (let-values ()
- (if (unsafe-fx= n_5 1)
- (let-values () lst_0)
- (if (unsafe-fx= n_5 2)
- (let-values () (list (cadr lst_0) (car lst_0)))
- (let-values ()
- (let-values (((a_3) (car lst_0)) ((b_1) (cadr lst_0)) ((c_1) (caddr lst_0)))
- (if (less-than?_2 b_1 a_3)
- (if (less-than?_2 c_1 b_1)
- (list c_1 b_1 a_3)
- (if (less-than?_2 c_1 a_3) (list b_1 c_1 a_3) (list b_1 a_3 c_1)))
- (if (less-than?_2 c_1 a_3) (list c_1 a_3 b_1) (list a_3 c_1 b_1))))))))
- (let-values ()
- (let-values (((vec_0) (make-vector (+ n_5 (ceiling (/ n_5 2))))))
+ loop_20)
+ (car lst_3)
+ (cdr lst_3))
+ lst_3
+ (if (unsafe-fx<= n_6 3)
+ (if (unsafe-fx= n_6 1)
+ lst_3
+ (if (unsafe-fx= n_6 2)
+ (list (cadr lst_3) (car lst_3))
+ (let-values (((a_4) (car lst_3)) ((b_2) (cadr lst_3)) ((c_2) (caddr lst_3)))
+ (if (if getkey_1 (less-than?_4 (getkey_1 b_2) (getkey_1 a_4)) (less-than?_4 b_2 a_4))
+ (if (if getkey_1 (less-than?_4 (getkey_1 c_2) (getkey_1 b_2)) (less-than?_4 c_2 b_2))
+ (list c_2 b_2 a_4)
+ (if (if getkey_1 (less-than?_4 (getkey_1 c_2) (getkey_1 a_4)) (less-than?_4 c_2 a_4))
+ (list b_2 c_2 a_4)
+ (list b_2 a_4 c_2)))
+ (if (if getkey_1 (less-than?_4 (getkey_1 c_2) (getkey_1 a_4)) (less-than?_4 c_2 a_4))
+ (list c_2 a_4 b_2)
+ (list a_4 c_2 b_2))))))
+ (let-values (((vec_2) (make-vector (+ n_6 (ceiling (/ n_6 2))))))
+ (begin
+ ((letrec-values (((loop_21)
+ (lambda (i_12 lst_5)
+ (begin
+ 'loop
+ (if (pair? lst_5)
+ (begin
+ (vector-set! vec_2 i_12 (car lst_5))
+ (loop_21 (add1 i_12) (cdr lst_5)))
+ (void))))))
+ loop_21)
+ 0
+ lst_3)
+ (generic-sort/key_0 vec_2 less-than?_4 n_6 getkey_1)
+ ((letrec-values (((loop_22)
+ (lambda (i_13 r_2)
+ (begin
+ 'loop
+ (let-values (((i_14) (sub1 i_13)))
+ (if (< i_14 0)
+ r_2
+ (loop_22 i_14 (cons (vector-ref vec_2 i_14) r_2))))))))
+ loop_22)
+ n_6
+ '()))))))))
+ (sort lst_3 less-than?_4))))
+ (case-lambda
+ ((vec_3 less-than?_5 start_0 end_0)
+ (let-values (((n_7) (- end_0 start_0)))
+ (let-values (((dst-vec_0) (make-vector n_7)))
+ (let-values (((dst-start_0) 0))
+ (begin
+ (if (unsafe-fx= n_7 0)
+ (void)
+ (if ((letrec-values (((loop_23)
+ (lambda (prev-val_0 next-index_0)
+ (begin
+ 'loop
+ (let-values (((or-part_20) (unsafe-fx= next-index_0 end_0)))
+ (if or-part_20
+ or-part_20
+ (let-values (((next-val_0) (unsafe-vector-ref vec_3 next-index_0)))
+ (if (not (less-than?_5 next-val_0 prev-val_0))
+ (loop_23 next-val_0 (unsafe-fx+ next-index_0 1))
+ #f))))))))
+ loop_23)
+ (unsafe-vector-ref vec_3 start_0)
+ (unsafe-fx+ start_0 1))
+ (vector-copy! dst-vec_0 dst-start_0 vec_3 start_0 end_0)
+ (if (unsafe-fx<= n_7 3)
+ (begin
+ (vector-copy! dst-vec_0 dst-start_0 vec_3 start_0 end_0)
+ (if (unsafe-fx= n_7 1)
+ (void)
+ (if (unsafe-fx= n_7 2)
+ (let-values (((tmp_0) (unsafe-vector-ref dst-vec_0 (unsafe-fx+ dst-start_0 0))))
+ (begin
+ (unsafe-vector-set!
+ dst-vec_0
+ (unsafe-fx+ dst-start_0 0)
+ (unsafe-vector-ref dst-vec_0 (unsafe-fx+ dst-start_0 1)))
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 1) tmp_0)))
+ (let-values (((a_5) (unsafe-vector-ref dst-vec_0 (unsafe-fx+ dst-start_0 0)))
+ ((b_3) (unsafe-vector-ref dst-vec_0 (unsafe-fx+ dst-start_0 1)))
+ ((c_3) (unsafe-vector-ref dst-vec_0 (unsafe-fx+ dst-start_0 2))))
+ (if (less-than?_5 b_3 a_5)
+ (if (less-than?_5 c_3 b_3)
+ (begin
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 0) c_3)
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 2) a_5))
+ (if (less-than?_5 c_3 a_5)
+ (begin
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 0) b_3)
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 1) c_3)
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 2) a_5))
+ (begin
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 0) b_3)
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 1) a_5))))
+ (if (less-than?_5 c_3 a_5)
+ (begin
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 0) c_3)
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 1) a_5)
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 2) b_3))
+ (begin
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 1) c_3)
+ (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 2) b_3))))))))
+ (let-values (((work-vec_0) (make-vector (+ n_7 (ceiling (/ n_7 2))) #f)))
+ (begin
+ (vector-copy! work-vec_0 0 vec_3 start_0 end_0)
+ (generic-sort_0 work-vec_0 less-than?_5 n_7)
+ (vector-copy! dst-vec_0 dst-start_0 work-vec_0 0 n_7))))))
+ dst-vec_0)))))
+ ((vec_4 less-than?_6 start_1 end_1 getkey_2 cache-keys?_1)
+ (if (if getkey_2 (not (eq? values getkey_2)) #f)
+ (let-values (((n_8) (- end_1 start_1)))
+ (let-values (((dst-vec_1) (make-vector n_8)))
+ (let-values (((dst-start_1) 0))
+ (begin
+ (if (unsafe-fx= n_8 0)
+ (void)
+ (if cache-keys?_1
+ (let-values (((work-vec_1) (make-vector (+ n_8 (ceiling (/ n_8 2))) #t)))
(begin
- ((letrec-values (((loop_16)
- (lambda (i_6 lst_1)
+ ((letrec-values (((loop_24)
+ (lambda (i_15)
(begin
'loop
- (if (pair? lst_1)
- (let-values ()
- (begin
- (vector-set! vec_0 i_6 (car lst_1))
- (loop_16 (add1 i_6) (cdr lst_1))))
+ (if (unsafe-fx< i_15 n_8)
+ (begin
+ (let-values (((x_7)
+ (unsafe-vector-ref vec_4 (unsafe-fx+ i_15 start_1))))
+ (unsafe-vector-set! work-vec_1 i_15 (cons (getkey_2 x_7) x_7)))
+ (loop_24 (unsafe-fx+ i_15 1)))
(void))))))
- loop_16)
- 0
- lst_0)
- (generic-sort_0 vec_0 less-than?_2 n_5)
- ((letrec-values (((loop_17)
- (lambda (i_7 r_0)
+ loop_24)
+ 0)
+ (generic-sort/key_0 work-vec_1 less-than?_6 n_8 unsafe-car)
+ ((letrec-values (((loop_25)
+ (lambda (i_16)
(begin
'loop
- (let-values (((i_8) (sub1 i_7)))
- (if (< i_8 0)
- r_0
- (loop_17 i_8 (cons (vector-ref vec_0 i_8) r_0))))))))
- loop_17)
- n_5
- '()))))))))))
- ((lst_2 less-than?_3 getkey_0)
- (if (if getkey_0 (not (eq? values getkey_0)) #f)
- (sort lst_2 less-than?_3 getkey_0 #f)
- (sort lst_2 less-than?_3)))
- ((lst_3 less-than?_4 getkey_1 cache-keys?_0)
- (if (if getkey_1 (not (eq? values getkey_1)) #f)
- (let-values (((n_6) (length lst_3)))
- (let-values ()
- (if (unsafe-fx= n_6 0)
- (let-values () lst_3)
- (if cache-keys?_0
- (let-values ()
- (let-values (((vec_1) (make-vector (+ n_6 (ceiling (/ n_6 2))))))
- (begin
- ((letrec-values (((loop_18)
- (lambda (i_9 lst_4)
- (begin
- 'loop
- (if (pair? lst_4)
- (let-values ()
- (let-values (((x_6) (car lst_4)))
- (begin
- (unsafe-vector-set! vec_1 i_9 (cons (getkey_1 x_6) x_6))
- (loop_18 (unsafe-fx+ i_9 1) (cdr lst_4)))))
+ (if (unsafe-fx< i_16 n_8)
+ (begin
+ (unsafe-vector-set!
+ dst-vec_1
+ (unsafe-fx+ i_16 dst-start_1)
+ (unsafe-cdr (unsafe-vector-ref work-vec_1 i_16)))
+ (loop_25 (unsafe-fx+ i_16 1)))
(void))))))
- loop_18)
- 0
- lst_3)
- (generic-sort/key_0 vec_1 less-than?_4 n_6 unsafe-car)
- ((letrec-values (((loop_19)
- (lambda (i_10 r_1)
+ loop_25)
+ 0)))
+ (if ((letrec-values (((loop_26)
+ (lambda (prev-val_1 next-index_1)
(begin
'loop
- (let-values (((i_11) (unsafe-fx- i_10 1)))
- (if (unsafe-fx< i_11 0)
- r_1
- (loop_19
- i_11
- (cons (unsafe-cdr (unsafe-vector-ref vec_1 i_11)) r_1))))))))
- loop_19)
- n_6
- '()))))
- (if ((letrec-values (((loop_20)
- (lambda (last_1 next_2)
- (begin
- 'loop
- (let-values (((or-part_17) (null? next_2)))
- (if or-part_17
- or-part_17
- (if (not
- (if getkey_1
- (less-than?_4
- (getkey_1 (unsafe-car next_2))
- (getkey_1 last_1))
- (less-than?_4 (unsafe-car next_2) last_1)))
- (loop_20 (unsafe-car next_2) (unsafe-cdr next_2))
- #f)))))))
- loop_20)
- (car lst_3)
- (cdr lst_3))
- (let-values () lst_3)
- (if (unsafe-fx<= n_6 3)
- (let-values ()
- (if (unsafe-fx= n_6 1)
- (let-values () lst_3)
- (if (unsafe-fx= n_6 2)
- (let-values () (list (cadr lst_3) (car lst_3)))
- (let-values ()
- (let-values (((a_4) (car lst_3)) ((b_2) (cadr lst_3)) ((c_2) (caddr lst_3)))
- (if (if getkey_1 (less-than?_4 (getkey_1 b_2) (getkey_1 a_4)) (less-than?_4 b_2 a_4))
- (if (if getkey_1
- (less-than?_4 (getkey_1 c_2) (getkey_1 b_2))
- (less-than?_4 c_2 b_2))
- (list c_2 b_2 a_4)
- (if (if getkey_1
- (less-than?_4 (getkey_1 c_2) (getkey_1 a_4))
- (less-than?_4 c_2 a_4))
- (list b_2 c_2 a_4)
- (list b_2 a_4 c_2)))
- (if (if getkey_1
- (less-than?_4 (getkey_1 c_2) (getkey_1 a_4))
- (less-than?_4 c_2 a_4))
- (list c_2 a_4 b_2)
- (list a_4 c_2 b_2))))))))
- (let-values ()
- (let-values (((vec_2) (make-vector (+ n_6 (ceiling (/ n_6 2))))))
- (begin
- ((letrec-values (((loop_21)
- (lambda (i_12 lst_5)
- (begin
- 'loop
- (if (pair? lst_5)
- (let-values ()
- (begin
- (vector-set! vec_2 i_12 (car lst_5))
- (loop_21 (add1 i_12) (cdr lst_5))))
- (void))))))
- loop_21)
- 0
- lst_3)
- (generic-sort/key_0 vec_2 less-than?_4 n_6 getkey_1)
- ((letrec-values (((loop_22)
- (lambda (i_13 r_2)
- (begin
- 'loop
- (let-values (((i_14) (sub1 i_13)))
- (if (< i_14 0)
- r_2
- (loop_22 i_14 (cons (vector-ref vec_2 i_14) r_2))))))))
- loop_22)
- n_6
- '()))))))))))
- (sort lst_3 less-than?_4))))
- (case-lambda
- ((vec_3 less-than?_5 start_0 end_0)
- (let-values (((n_7) (- end_0 start_0)))
- (let-values (((dst-vec_0) (make-vector n_7)))
- (let-values (((dst-start_0) 0))
- (begin
- (if (unsafe-fx= n_7 0)
- (let-values () (void))
- (if ((letrec-values (((loop_23)
- (lambda (prev-val_0 next-index_0)
- (begin
- 'loop
- (let-values (((or-part_18) (unsafe-fx= next-index_0 end_0)))
- (if or-part_18
- or-part_18
- (let-values (((next-val_0) (unsafe-vector-ref vec_3 next-index_0)))
- (if (not (less-than?_5 next-val_0 prev-val_0))
- (loop_23 next-val_0 (unsafe-fx+ next-index_0 1))
- #f))))))))
- loop_23)
- (unsafe-vector-ref vec_3 start_0)
- (unsafe-fx+ start_0 1))
- (let-values () (let-values () (vector-copy! dst-vec_0 dst-start_0 vec_3 start_0 end_0)))
- (if (unsafe-fx<= n_7 3)
- (let-values ()
+ (let-values (((or-part_21) (unsafe-fx= next-index_1 end_1)))
+ (if or-part_21
+ or-part_21
+ (let-values (((next-val_1) (unsafe-vector-ref vec_4 next-index_1)))
+ (if (not
+ (if getkey_2
+ (less-than?_6 (getkey_2 next-val_1) (getkey_2 prev-val_1))
+ (less-than?_6 next-val_1 prev-val_1)))
+ (loop_26 next-val_1 (unsafe-fx+ next-index_1 1))
+ #f))))))))
+ loop_26)
+ (unsafe-vector-ref vec_4 start_1)
+ (unsafe-fx+ start_1 1))
+ (vector-copy! dst-vec_1 dst-start_1 vec_4 start_1 end_1)
+ (if (unsafe-fx<= n_8 3)
(begin
- (let-values () (vector-copy! dst-vec_0 dst-start_0 vec_3 start_0 end_0))
- (if (unsafe-fx= n_7 1)
- (let-values () (void))
- (if (unsafe-fx= n_7 2)
- (let-values ()
- (let-values (((tmp_0) (unsafe-vector-ref dst-vec_0 (unsafe-fx+ dst-start_0 0))))
- (begin
- (unsafe-vector-set!
- dst-vec_0
- (unsafe-fx+ dst-start_0 0)
- (unsafe-vector-ref dst-vec_0 (unsafe-fx+ dst-start_0 1)))
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 1) tmp_0))))
- (let-values ()
- (let-values (((a_5) (unsafe-vector-ref dst-vec_0 (unsafe-fx+ dst-start_0 0)))
- ((b_3) (unsafe-vector-ref dst-vec_0 (unsafe-fx+ dst-start_0 1)))
- ((c_3) (unsafe-vector-ref dst-vec_0 (unsafe-fx+ dst-start_0 2))))
- (if (less-than?_5 b_3 a_5)
- (let-values ()
- (if (less-than?_5 c_3 b_3)
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 0) c_3)
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 2) a_5)))
- (if (less-than?_5 c_3 a_5)
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 0) b_3)
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 1) c_3)
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 2) a_5)))
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 0) b_3)
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 1) a_5))))))
- (if (less-than?_5 c_3 a_5)
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 0) c_3)
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 1) a_5)
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 2) b_3)))
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 1) c_3)
- (unsafe-vector-set! dst-vec_0 (unsafe-fx+ dst-start_0 2) b_3)))))))))))
- (let-values ()
- (let-values (((work-vec_0) (make-vector (+ n_7 (ceiling (/ n_7 2))) #f)))
+ (vector-copy! dst-vec_1 dst-start_1 vec_4 start_1 end_1)
+ (if (unsafe-fx= n_8 1)
+ (void)
+ (if (unsafe-fx= n_8 2)
+ (let-values (((tmp_1) (unsafe-vector-ref dst-vec_1 (unsafe-fx+ dst-start_1 0))))
+ (begin
+ (unsafe-vector-set!
+ dst-vec_1
+ (unsafe-fx+ dst-start_1 0)
+ (unsafe-vector-ref dst-vec_1 (unsafe-fx+ dst-start_1 1)))
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 1) tmp_1)))
+ (let-values (((a_6) (unsafe-vector-ref dst-vec_1 (unsafe-fx+ dst-start_1 0)))
+ ((b_4) (unsafe-vector-ref dst-vec_1 (unsafe-fx+ dst-start_1 1)))
+ ((c_4) (unsafe-vector-ref dst-vec_1 (unsafe-fx+ dst-start_1 2))))
+ (if (if getkey_2 (less-than?_6 (getkey_2 b_4) (getkey_2 a_6)) (less-than?_6 b_4 a_6))
+ (if (if getkey_2
+ (less-than?_6 (getkey_2 c_4) (getkey_2 b_4))
+ (less-than?_6 c_4 b_4))
+ (begin
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 0) c_4)
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 2) a_6))
+ (if (if getkey_2
+ (less-than?_6 (getkey_2 c_4) (getkey_2 a_6))
+ (less-than?_6 c_4 a_6))
+ (begin
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 0) b_4)
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 1) c_4)
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 2) a_6))
+ (begin
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 0) b_4)
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 1) a_6))))
+ (if (if getkey_2
+ (less-than?_6 (getkey_2 c_4) (getkey_2 a_6))
+ (less-than?_6 c_4 a_6))
+ (begin
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 0) c_4)
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 1) a_6)
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 2) b_4))
+ (begin
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 1) c_4)
+ (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 2) b_4))))))))
+ (let-values (((work-vec_2) (make-vector (+ n_8 (ceiling (/ n_8 2))) #f)))
(begin
- (vector-copy! work-vec_0 0 vec_3 start_0 end_0)
- (generic-sort_0 work-vec_0 less-than?_5 n_7)
- (vector-copy! dst-vec_0 dst-start_0 work-vec_0 0 n_7)))))))
- dst-vec_0)))))
- ((vec_4 less-than?_6 start_1 end_1 getkey_2 cache-keys?_1)
- (if (if getkey_2 (not (eq? values getkey_2)) #f)
- (let-values (((n_8) (- end_1 start_1)))
- (let-values (((dst-vec_1) (make-vector n_8)))
- (let-values (((dst-start_1) 0))
- (begin
- (if (unsafe-fx= n_8 0)
- (let-values () (void))
- (if cache-keys?_1
- (let-values ()
- (let-values (((work-vec_1) (make-vector (+ n_8 (ceiling (/ n_8 2))) #t)))
+ (vector-copy! work-vec_2 0 vec_4 start_1 end_1)
+ (generic-sort/key_0 work-vec_2 less-than?_6 n_8 getkey_2)
+ (vector-copy! dst-vec_1 dst-start_1 work-vec_2 0 n_8)))))))
+ dst-vec_1))))
+ (vector-sort vec_4 less-than?_6 start_1 end_1))))
+ (case-lambda
+ ((vec_5 less-than?_7 start_2 end_2)
+ (let-values (((n_9) (- end_2 start_2)))
+ (let-values (((dst-vec_2) vec_5))
+ (let-values (((dst-start_2) start_2))
+ (begin
+ (if (unsafe-fx= n_9 0)
+ (void)
+ (if ((letrec-values (((loop_27)
+ (lambda (prev-val_2 next-index_2)
+ (begin
+ 'loop
+ (let-values (((or-part_22) (unsafe-fx= next-index_2 end_2)))
+ (if or-part_22
+ or-part_22
+ (let-values (((next-val_2) (unsafe-vector-ref vec_5 next-index_2)))
+ (if (not (less-than?_7 next-val_2 prev-val_2))
+ (loop_27 next-val_2 (unsafe-fx+ next-index_2 1))
+ #f))))))))
+ loop_27)
+ (unsafe-vector-ref vec_5 start_2)
+ (unsafe-fx+ start_2 1))
+ (void)
+ (if (unsafe-fx<= n_9 3)
+ (if (unsafe-fx= n_9 1)
+ (void)
+ (if (unsafe-fx= n_9 2)
+ (let-values (((tmp_2) (unsafe-vector-ref dst-vec_2 (unsafe-fx+ dst-start_2 0))))
(begin
- ((letrec-values (((loop_24)
- (lambda (i_15)
- (begin
- 'loop
- (if (unsafe-fx< i_15 n_8)
- (let-values ()
- (begin
- (let-values (((x_7)
- (unsafe-vector-ref
- vec_4
- (unsafe-fx+ i_15 start_1))))
- (unsafe-vector-set!
- work-vec_1
- i_15
- (cons (getkey_2 x_7) x_7)))
- (loop_24 (unsafe-fx+ i_15 1))))
- (void))))))
- loop_24)
- 0)
- (generic-sort/key_0 work-vec_1 less-than?_6 n_8 unsafe-car)
- ((letrec-values (((loop_25)
- (lambda (i_16)
- (begin
- 'loop
- (if (unsafe-fx< i_16 n_8)
- (let-values ()
- (begin
- (unsafe-vector-set!
- dst-vec_1
- (unsafe-fx+ i_16 dst-start_1)
- (unsafe-cdr (unsafe-vector-ref work-vec_1 i_16)))
- (loop_25 (unsafe-fx+ i_16 1))))
- (void))))))
- loop_25)
- 0))))
- (if ((letrec-values (((loop_26)
- (lambda (prev-val_1 next-index_1)
- (begin
- 'loop
- (let-values (((or-part_19) (unsafe-fx= next-index_1 end_1)))
- (if or-part_19
- or-part_19
- (let-values (((next-val_1)
- (unsafe-vector-ref vec_4 next-index_1)))
- (if (not
- (if getkey_2
- (less-than?_6
- (getkey_2 next-val_1)
- (getkey_2 prev-val_1))
- (less-than?_6 next-val_1 prev-val_1)))
- (loop_26 next-val_1 (unsafe-fx+ next-index_1 1))
- #f))))))))
- loop_26)
- (unsafe-vector-ref vec_4 start_1)
- (unsafe-fx+ start_1 1))
- (let-values () (let-values () (vector-copy! dst-vec_1 dst-start_1 vec_4 start_1 end_1)))
- (if (unsafe-fx<= n_8 3)
- (let-values ()
- (begin
- (let-values () (vector-copy! dst-vec_1 dst-start_1 vec_4 start_1 end_1))
- (if (unsafe-fx= n_8 1)
- (let-values () (void))
- (if (unsafe-fx= n_8 2)
- (let-values ()
- (let-values (((tmp_1) (unsafe-vector-ref dst-vec_1 (unsafe-fx+ dst-start_1 0))))
- (begin
- (unsafe-vector-set!
- dst-vec_1
- (unsafe-fx+ dst-start_1 0)
- (unsafe-vector-ref dst-vec_1 (unsafe-fx+ dst-start_1 1)))
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 1) tmp_1))))
- (let-values ()
- (let-values (((a_6) (unsafe-vector-ref dst-vec_1 (unsafe-fx+ dst-start_1 0)))
- ((b_4) (unsafe-vector-ref dst-vec_1 (unsafe-fx+ dst-start_1 1)))
- ((c_4) (unsafe-vector-ref dst-vec_1 (unsafe-fx+ dst-start_1 2))))
- (if (if getkey_2
- (less-than?_6 (getkey_2 b_4) (getkey_2 a_6))
- (less-than?_6 b_4 a_6))
- (let-values ()
- (if (if getkey_2
- (less-than?_6 (getkey_2 c_4) (getkey_2 b_4))
- (less-than?_6 c_4 b_4))
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 0) c_4)
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 2) a_6)))
- (if (if getkey_2
- (less-than?_6 (getkey_2 c_4) (getkey_2 a_6))
- (less-than?_6 c_4 a_6))
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 0) b_4)
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 1) c_4)
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 2) a_6)))
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 0) b_4)
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 1) a_6))))))
- (if (if getkey_2
- (less-than?_6 (getkey_2 c_4) (getkey_2 a_6))
- (less-than?_6 c_4 a_6))
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 0) c_4)
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 1) a_6)
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 2) b_4)))
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 1) c_4)
- (unsafe-vector-set! dst-vec_1 (unsafe-fx+ dst-start_1 2) b_4)))))))))))
- (let-values ()
- (let-values (((work-vec_2) (make-vector (+ n_8 (ceiling (/ n_8 2))) #f)))
+ (unsafe-vector-set!
+ dst-vec_2
+ (unsafe-fx+ dst-start_2 0)
+ (unsafe-vector-ref dst-vec_2 (unsafe-fx+ dst-start_2 1)))
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 1) tmp_2)))
+ (let-values (((a_7) (unsafe-vector-ref dst-vec_2 (unsafe-fx+ dst-start_2 0)))
+ ((b_5) (unsafe-vector-ref dst-vec_2 (unsafe-fx+ dst-start_2 1)))
+ ((c_5) (unsafe-vector-ref dst-vec_2 (unsafe-fx+ dst-start_2 2))))
+ (if (less-than?_7 b_5 a_7)
+ (if (less-than?_7 c_5 b_5)
+ (begin
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 0) c_5)
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 2) a_7))
+ (if (less-than?_7 c_5 a_7)
+ (begin
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 0) b_5)
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 1) c_5)
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 2) a_7))
+ (begin
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 0) b_5)
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 1) a_7))))
+ (if (less-than?_7 c_5 a_7)
+ (begin
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 0) c_5)
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 1) a_7)
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 2) b_5))
(begin
- (vector-copy! work-vec_2 0 vec_4 start_1 end_1)
- (generic-sort/key_0 work-vec_2 less-than?_6 n_8 getkey_2)
- (vector-copy! dst-vec_1 dst-start_1 work-vec_2 0 n_8))))))))
- dst-vec_1))))
- (vector-sort vec_4 less-than?_6 start_1 end_1))))
- (case-lambda
- ((vec_5 less-than?_7 start_2 end_2)
- (let-values (((n_9) (- end_2 start_2)))
- (let-values (((dst-vec_2) vec_5))
- (let-values (((dst-start_2) start_2))
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 1) c_5)
+ (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 2) b_5)))))))
+ (let-values (((work-vec_3) (make-vector (+ n_9 (ceiling (/ n_9 2))) #f)))
+ (begin
+ (vector-copy! work-vec_3 0 vec_5 start_2 end_2)
+ (generic-sort_0 work-vec_3 less-than?_7 n_9)
+ (vector-copy! dst-vec_2 dst-start_2 work-vec_3 0 n_9))))))
+ (void))))))
+ ((vec_6 less-than?_8 start_3 end_3 getkey_3 cache-keys?_2)
+ (if (if getkey_3 (not (eq? values getkey_3)) #f)
+ (let-values (((n_10) (- end_3 start_3)))
+ (let-values (((dst-vec_3) vec_6))
+ (let-values (((dst-start_3) start_3))
(begin
- (if (unsafe-fx= n_9 0)
- (let-values () (void))
- (if ((letrec-values (((loop_27)
- (lambda (prev-val_2 next-index_2)
- (begin
- 'loop
- (let-values (((or-part_20) (unsafe-fx= next-index_2 end_2)))
- (if or-part_20
- or-part_20
- (let-values (((next-val_2) (unsafe-vector-ref vec_5 next-index_2)))
- (if (not (less-than?_7 next-val_2 prev-val_2))
- (loop_27 next-val_2 (unsafe-fx+ next-index_2 1))
- #f))))))))
- loop_27)
- (unsafe-vector-ref vec_5 start_2)
- (unsafe-fx+ start_2 1))
- (let-values () (void))
- (if (unsafe-fx<= n_9 3)
- (let-values ()
- (begin
- (void)
- (if (unsafe-fx= n_9 1)
- (let-values () (void))
- (if (unsafe-fx= n_9 2)
- (let-values ()
- (let-values (((tmp_2) (unsafe-vector-ref dst-vec_2 (unsafe-fx+ dst-start_2 0))))
- (begin
- (unsafe-vector-set!
- dst-vec_2
- (unsafe-fx+ dst-start_2 0)
- (unsafe-vector-ref dst-vec_2 (unsafe-fx+ dst-start_2 1)))
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 1) tmp_2))))
- (let-values ()
- (let-values (((a_7) (unsafe-vector-ref dst-vec_2 (unsafe-fx+ dst-start_2 0)))
- ((b_5) (unsafe-vector-ref dst-vec_2 (unsafe-fx+ dst-start_2 1)))
- ((c_5) (unsafe-vector-ref dst-vec_2 (unsafe-fx+ dst-start_2 2))))
- (if (less-than?_7 b_5 a_7)
- (let-values ()
- (if (less-than?_7 c_5 b_5)
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 0) c_5)
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 2) a_7)))
- (if (less-than?_7 c_5 a_7)
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 0) b_5)
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 1) c_5)
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 2) a_7)))
- (let-values ()
+ (if (unsafe-fx= n_10 0)
+ (void)
+ (if cache-keys?_2
+ (let-values (((work-vec_4) (make-vector (+ n_10 (ceiling (/ n_10 2))) #t)))
+ (begin
+ ((letrec-values (((loop_28)
+ (lambda (i_17)
(begin
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 0) b_5)
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 1) a_7))))))
- (if (less-than?_7 c_5 a_7)
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 0) c_5)
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 1) a_7)
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 2) b_5)))
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 1) c_5)
- (unsafe-vector-set! dst-vec_2 (unsafe-fx+ dst-start_2 2) b_5)))))))))))
- (let-values ()
- (let-values (((work-vec_3) (make-vector (+ n_9 (ceiling (/ n_9 2))) #f)))
- (begin
- (vector-copy! work-vec_3 0 vec_5 start_2 end_2)
- (generic-sort_0 work-vec_3 less-than?_7 n_9)
- (vector-copy! dst-vec_2 dst-start_2 work-vec_3 0 n_9)))))))
- (void))))))
- ((vec_6 less-than?_8 start_3 end_3 getkey_3 cache-keys?_2)
- (if (if getkey_3 (not (eq? values getkey_3)) #f)
- (let-values (((n_10) (- end_3 start_3)))
- (let-values (((dst-vec_3) vec_6))
- (let-values (((dst-start_3) start_3))
- (begin
- (if (unsafe-fx= n_10 0)
- (let-values () (void))
- (if cache-keys?_2
- (let-values ()
- (let-values (((work-vec_4) (make-vector (+ n_10 (ceiling (/ n_10 2))) #t)))
- (begin
- ((letrec-values (((loop_28)
- (lambda (i_17)
- (begin
- 'loop
- (if (unsafe-fx< i_17 n_10)
- (let-values ()
- (begin
- (let-values (((x_8)
- (unsafe-vector-ref
- vec_6
- (unsafe-fx+ i_17 start_3))))
- (unsafe-vector-set!
- work-vec_4
- i_17
- (cons (getkey_3 x_8) x_8)))
- (loop_28 (unsafe-fx+ i_17 1))))
- (void))))))
- loop_28)
- 0)
- (generic-sort/key_0 work-vec_4 less-than?_8 n_10 unsafe-car)
- ((letrec-values (((loop_29)
- (lambda (i_18)
- (begin
- 'loop
- (if (unsafe-fx< i_18 n_10)
- (let-values ()
- (begin
- (unsafe-vector-set!
- dst-vec_3
- (unsafe-fx+ i_18 dst-start_3)
- (unsafe-cdr (unsafe-vector-ref work-vec_4 i_18)))
- (loop_29 (unsafe-fx+ i_18 1))))
- (void))))))
- loop_29)
- 0))))
- (if ((letrec-values (((loop_30)
- (lambda (prev-val_3 next-index_3)
- (begin
- 'loop
- (let-values (((or-part_21) (unsafe-fx= next-index_3 end_3)))
- (if or-part_21
- or-part_21
- (let-values (((next-val_3)
- (unsafe-vector-ref vec_6 next-index_3)))
- (if (not
- (if getkey_3
- (less-than?_8
- (getkey_3 next-val_3)
- (getkey_3 prev-val_3))
- (less-than?_8 next-val_3 prev-val_3)))
- (loop_30 next-val_3 (unsafe-fx+ next-index_3 1))
- #f))))))))
- loop_30)
- (unsafe-vector-ref vec_6 start_3)
- (unsafe-fx+ start_3 1))
- (let-values () (void))
- (if (unsafe-fx<= n_10 3)
- (let-values ()
- (begin
- (void)
- (if (unsafe-fx= n_10 1)
- (let-values () (void))
- (if (unsafe-fx= n_10 2)
- (let-values ()
- (let-values (((tmp_3) (unsafe-vector-ref dst-vec_3 (unsafe-fx+ dst-start_3 0))))
- (begin
- (unsafe-vector-set!
- dst-vec_3
- (unsafe-fx+ dst-start_3 0)
- (unsafe-vector-ref dst-vec_3 (unsafe-fx+ dst-start_3 1)))
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 1) tmp_3))))
- (let-values ()
- (let-values (((a_8) (unsafe-vector-ref dst-vec_3 (unsafe-fx+ dst-start_3 0)))
- ((b_6) (unsafe-vector-ref dst-vec_3 (unsafe-fx+ dst-start_3 1)))
- ((c_6) (unsafe-vector-ref dst-vec_3 (unsafe-fx+ dst-start_3 2))))
- (if (if getkey_3
- (less-than?_8 (getkey_3 b_6) (getkey_3 a_8))
- (less-than?_8 b_6 a_8))
- (let-values ()
- (if (if getkey_3
- (less-than?_8 (getkey_3 c_6) (getkey_3 b_6))
- (less-than?_8 c_6 b_6))
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 0) c_6)
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 2) a_8)))
- (if (if getkey_3
- (less-than?_8 (getkey_3 c_6) (getkey_3 a_8))
- (less-than?_8 c_6 a_8))
- (let-values ()
- (begin
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 0) b_6)
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 1) c_6)
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 2) a_8)))
- (let-values ()
+ 'loop
+ (if (unsafe-fx< i_17 n_10)
(begin
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 0) b_6)
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 1) a_8))))))
- (if (if getkey_3
- (less-than?_8 (getkey_3 c_6) (getkey_3 a_8))
- (less-than?_8 c_6 a_8))
- (let-values ()
+ (let-values (((x_8)
+ (unsafe-vector-ref vec_6 (unsafe-fx+ i_17 start_3))))
+ (unsafe-vector-set! work-vec_4 i_17 (cons (getkey_3 x_8) x_8)))
+ (loop_28 (unsafe-fx+ i_17 1)))
+ (void))))))
+ loop_28)
+ 0)
+ (generic-sort/key_0 work-vec_4 less-than?_8 n_10 unsafe-car)
+ ((letrec-values (((loop_29)
+ (lambda (i_18)
(begin
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 0) c_6)
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 1) a_8)
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 2) b_6)))
- (let-values ()
+ 'loop
+ (if (unsafe-fx< i_18 n_10)
+ (begin
+ (unsafe-vector-set!
+ dst-vec_3
+ (unsafe-fx+ i_18 dst-start_3)
+ (unsafe-cdr (unsafe-vector-ref work-vec_4 i_18)))
+ (loop_29 (unsafe-fx+ i_18 1)))
+ (void))))))
+ loop_29)
+ 0)))
+ (if ((letrec-values (((loop_30)
+ (lambda (prev-val_3 next-index_3)
(begin
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 1) c_6)
- (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 2) b_6)))))))))))
- (let-values ()
- (let-values (((work-vec_5) (make-vector (+ n_10 (ceiling (/ n_10 2))) #f)))
+ 'loop
+ (let-values (((or-part_23) (unsafe-fx= next-index_3 end_3)))
+ (if or-part_23
+ or-part_23
+ (let-values (((next-val_3) (unsafe-vector-ref vec_6 next-index_3)))
+ (if (not
+ (if getkey_3
+ (less-than?_8 (getkey_3 next-val_3) (getkey_3 prev-val_3))
+ (less-than?_8 next-val_3 prev-val_3)))
+ (loop_30 next-val_3 (unsafe-fx+ next-index_3 1))
+ #f))))))))
+ loop_30)
+ (unsafe-vector-ref vec_6 start_3)
+ (unsafe-fx+ start_3 1))
+ (void)
+ (if (unsafe-fx<= n_10 3)
+ (if (unsafe-fx= n_10 1)
+ (void)
+ (if (unsafe-fx= n_10 2)
+ (let-values (((tmp_3) (unsafe-vector-ref dst-vec_3 (unsafe-fx+ dst-start_3 0))))
(begin
- (vector-copy! work-vec_5 0 vec_6 start_3 end_3)
- (generic-sort/key_0 work-vec_5 less-than?_8 n_10 getkey_3)
- (vector-copy! dst-vec_3 dst-start_3 work-vec_5 0 n_10))))))))
- (void)))))
- (vector-sort! vec_6 less-than?_8 start_3 end_3)))))))))
+ (unsafe-vector-set!
+ dst-vec_3
+ (unsafe-fx+ dst-start_3 0)
+ (unsafe-vector-ref dst-vec_3 (unsafe-fx+ dst-start_3 1)))
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 1) tmp_3)))
+ (let-values (((a_8) (unsafe-vector-ref dst-vec_3 (unsafe-fx+ dst-start_3 0)))
+ ((b_6) (unsafe-vector-ref dst-vec_3 (unsafe-fx+ dst-start_3 1)))
+ ((c_6) (unsafe-vector-ref dst-vec_3 (unsafe-fx+ dst-start_3 2))))
+ (if (if getkey_3 (less-than?_8 (getkey_3 b_6) (getkey_3 a_8)) (less-than?_8 b_6 a_8))
+ (if (if getkey_3 (less-than?_8 (getkey_3 c_6) (getkey_3 b_6)) (less-than?_8 c_6 b_6))
+ (begin
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 0) c_6)
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 2) a_8))
+ (if (if getkey_3
+ (less-than?_8 (getkey_3 c_6) (getkey_3 a_8))
+ (less-than?_8 c_6 a_8))
+ (begin
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 0) b_6)
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 1) c_6)
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 2) a_8))
+ (begin
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 0) b_6)
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 1) a_8))))
+ (if (if getkey_3 (less-than?_8 (getkey_3 c_6) (getkey_3 a_8)) (less-than?_8 c_6 a_8))
+ (begin
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 0) c_6)
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 1) a_8)
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 2) b_6))
+ (begin
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 1) c_6)
+ (unsafe-vector-set! dst-vec_3 (unsafe-fx+ dst-start_3 2) b_6)))))))
+ (let-values (((work-vec_5) (make-vector (+ n_10 (ceiling (/ n_10 2))) #f)))
+ (begin
+ (vector-copy! work-vec_5 0 vec_6 start_3 end_3)
+ (generic-sort/key_0 work-vec_5 less-than?_8 n_10 getkey_3)
+ (vector-copy! dst-vec_3 dst-start_3 work-vec_5 0 n_10)))))))
+ (void)))))
+ (vector-sort! vec_6 less-than?_8 start_3 end_3))))))))
+ (define-values
+ (1/raise-argument-error)
+ (lambda (who_5 . args_0) (begin 'raise-argument-error (apply raise-argument-error* who_5 'racket/primitive args_0))))
+ (define-values
+ (1/raise-arguments-error)
+ (lambda (who_6 . args_1)
+ (begin 'raise-arguments-error (apply raise-arguments-error* who_6 'racket/primitive args_1))))
+ (define-values
+ (1/raise-range-error)
+ (lambda (who_7 . args_2) (begin 'raise-range-error (apply raise-range-error* who_7 'racket/primitive args_2))))
+ (define-values
+ (struct:do-sequence make-do-sequence do-sequence? do-sequence-ref do-sequence-set!)
+ (make-struct-type 'sequence #f 1 0 #f))
(define-values
(prop:stream stream-via-prop? stream-ref)
(make-struct-type-property
@@ -1853,14 +1648,13 @@
#f)
#f)
(void)
- (let-values ()
- (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_8)))
+ (1/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_8))
(vector->immutable-vector v_8)))
'()
#t))
@@ -1872,8 +1666,139 @@
(begin
(if (if (procedure? v_9) (procedure-arity-includes? v_9 1) #f)
(void)
- (let-values () (raise-argument-error 'guard-for-prop:sequence "(procedure-arity-includes/c 1)" v_9)))
+ (1/raise-argument-error 'guard-for-prop:sequence "(procedure-arity-includes/c 1)" v_9))
v_9))))
+ (define-values
+ (prop:sequence :sequence? :sequence-ref)
+ (make-struct-type-property
+ 'sequence
+ (lambda (v_10 sinfo_0)
+ (begin
+ (if (if (procedure? v_10) (procedure-arity-includes? v_10 1) #f)
+ (void)
+ (1/raise-argument-error 'sequence-property-guard "(procedure-arity-includes/c 1)" v_10))
+ (lambda (self_0)
+ (let-values (((s_15) (v_10 self_0)))
+ (begin
+ (if (sequence? s_15)
+ (void)
+ (raise-mismatch-error
+ 'sequence-generate
+ "procedure (value of prop:sequence) produced a non-sequence: "
+ s_15))
+ s_15)))))))
+ (define-values
+ (stream?)
+ (lambda (v_11) (begin (let-values (((or-part_24) (list? v_11))) (if or-part_24 or-part_24 (stream-via-prop? v_11))))))
+ (define-values
+ (unsafe-stream-not-empty?)
+ (lambda (v_12)
+ (begin
+ (if (null? v_12)
+ #f
+ (let-values (((or-part_25) (pair? v_12)))
+ (if or-part_25 or-part_25 (not ((unsafe-vector-ref (stream-ref v_12) 0) v_12))))))))
+ (define-values
+ (unsafe-stream-first)
+ (lambda (v_13) (begin (if (pair? v_13) (car v_13) ((unsafe-vector-ref (stream-ref v_13) 1) v_13)))))
+ (define-values
+ (unsafe-stream-rest)
+ (lambda (v_14)
+ (begin
+ (if (pair? v_14)
+ (cdr v_14)
+ (let-values (((r_3) ((unsafe-vector-ref (stream-ref v_14) 2) v_14)))
+ (begin
+ (if (stream? r_3) (void) (raise-mismatch-error 'stream-rest-guard "result is not a stream: " r_3))
+ r_3))))))
+ (define-values
+ (sequence?)
+ (lambda (v_15)
+ (begin
+ (let-values (((or-part_26) (exact-nonnegative-integer? v_15)))
+ (if or-part_26
+ or-part_26
+ (let-values (((or-part_27) (do-sequence? v_15)))
+ (if or-part_27
+ or-part_27
+ (let-values (((or-part_28) (sequence-via-prop? v_15)))
+ (if or-part_28
+ or-part_28
+ (let-values (((or-part_29) (stream? v_15)))
+ (if or-part_29
+ or-part_29
+ (let-values (((or-part_30) (mpair? v_15)))
+ (if or-part_30
+ or-part_30
+ (let-values (((or-part_31) (vector? v_15)))
+ (if or-part_31
+ or-part_31
+ (let-values (((or-part_32) (flvector? v_15)))
+ (if or-part_32
+ or-part_32
+ (let-values (((or-part_33) (fxvector? v_15)))
+ (if or-part_33
+ or-part_33
+ (let-values (((or-part_34) (string? v_15)))
+ (if or-part_34
+ or-part_34
+ (let-values (((or-part_35) (bytes? v_15)))
+ (if or-part_35
+ or-part_35
+ (let-values (((or-part_36) (input-port? v_15)))
+ (if or-part_36
+ or-part_36
+ (let-values (((or-part_37) (hash? v_15)))
+ (if or-part_37
+ or-part_37
+ (if (:sequence? v_15)
+ (not (struct-type? v_15))
+ #f))))))))))))))))))))))))))))
+ (define-values
+ (make-sequence)
+ (lambda (who_8 v_16)
+ (begin
+ (if (exact-nonnegative-integer? v_16)
+ (:integer-gen v_16)
+ (if (do-sequence? v_16)
+ (call-with-values
+ (lambda () ((do-sequence-ref v_16 0)))
+ (case-lambda
+ ((pos->vals_0 pos-next_0 init_0 pos-cont?_0 val-cont?_0 all-cont?_0)
+ (values pos->vals_0 #f pos-next_0 init_0 pos-cont?_0 val-cont?_0 all-cont?_0))
+ ((pos->vals_1 pre-pos-next_0 pos-next_1 init_1 pos-cont?_1 val-cont?_1 all-cont?_1)
+ (values pos->vals_1 pre-pos-next_0 pos-next_1 init_1 pos-cont?_1 val-cont?_1 all-cont?_1))))
+ (if (mpair? v_16)
+ (:mlist-gen v_16)
+ (if (list? v_16)
+ (:list-gen v_16)
+ (if (vector? v_16)
+ (:vector-gen v_16 0 (vector-length v_16) 1)
+ (if (flvector? v_16)
+ (:flvector-gen v_16 0 (flvector-length v_16) 1)
+ (if (fxvector? v_16)
+ (:fxvector-gen v_16 0 (fxvector-length v_16) 1)
+ (if (string? v_16)
+ (:string-gen v_16 0 (string-length v_16) 1)
+ (if (bytes? v_16)
+ (:bytes-gen v_16 0 (bytes-length v_16) 1)
+ (if (input-port? v_16)
+ (:input-port-gen v_16)
+ (if (hash? v_16)
+ (:hash-gen v_16 hash-iterate-key+value hash-iterate-first hash-iterate-next)
+ (if (sequence-via-prop? v_16)
+ ((sequence-ref v_16) v_16)
+ (if (:sequence? v_16)
+ (make-sequence who_8 ((:sequence-ref v_16) v_16))
+ (if (stream? v_16)
+ (:stream-gen v_16)
+ (raise
+ (exn:fail:contract
+ (format
+ "for: expected a sequence for ~a, got something else: ~v"
+ (if (= 1 (length who_8)) (car who_8) who_8)
+ v_16)
+ (current-continuation-marks))))))))))))))))))))
(define-values
(struct:range make-range range? range-ref range-set!)
(make-struct-type
@@ -1886,28 +1811,29 @@
(cons
prop:stream
(vector
- (lambda (v_10) (let-values (((cont?_0) (range-ref v_10 2))) (if cont?_0 (not (cont?_0 (range-ref v_10 0))) #f)))
- (lambda (v_11) (range-ref v_11 0))
- (lambda (v_12) (make-range ((range-ref v_12 1) (range-ref v_12 0)) (range-ref v_12 1) (range-ref v_12 2)))))
+ (lambda (v_17) (let-values (((cont?_0) (range-ref v_17 2))) (if cont?_0 (not (cont?_0 (range-ref v_17 0))) #f)))
+ (lambda (v_18) (range-ref v_18 0))
+ (lambda (v_19) (make-range ((range-ref v_19 1) (range-ref v_19 0)) (range-ref v_19 1) (range-ref v_19 2)))))
(cons
prop:gen-sequence
- (lambda (v_13) (values values #f (range-ref v_13 1) (range-ref v_13 0) (range-ref v_13 2) #f #f))))))
+ (lambda (v_20) (values values #f (range-ref v_20 1) (range-ref v_20 0) (range-ref v_20 2) #f #f))))))
(define-values (check-range) (lambda (a_9 b_7 step_0) (begin (check-range-generic 'in-range a_9 b_7 step_0))))
(define-values
(check-range-generic)
- (lambda (who_3 a_10 b_8 step_1)
+ (lambda (who_9 a_10 b_8 step_1)
(begin
(begin
- (if (real? a_10) (void) (let-values () (raise-argument-error who_3 "real?" a_10)))
- (if (real? b_8) (void) (let-values () (raise-argument-error who_3 "real?" b_8)))
- (if (real? step_1) (void) (let-values () (raise-argument-error who_3 "real?" step_1)))))))
+ (if (real? a_10) (void) (1/raise-argument-error who_9 "real?" a_10))
+ (if (real? b_8) (void) (1/raise-argument-error who_9 "real?" b_8))
+ (if (real? step_1) (void) (1/raise-argument-error who_9 "real?" step_1))))))
+ (define-values (:integer-gen) (lambda (v_21) (begin (values values #f add1 0 (lambda (i_19) (< i_19 v_21)) #f #f))))
(define-values
(check-naturals)
(lambda (n_11)
(begin
(if (if (integer? n_11) (if (exact? n_11) (>= n_11 0) #f) #f)
(void)
- (let-values () (raise-argument-error 'in-naturals "exact-nonnegative-integer?" n_11))))))
+ (1/raise-argument-error 'in-naturals "exact-nonnegative-integer?" n_11)))))
(define-values
(struct:list-stream make-list-stream list-stream? list-stream-ref list-stream-set!)
(make-struct-type
@@ -1920,98 +1846,119 @@
(cons
prop:stream
(vector
- (lambda (v_14) (not (pair? (list-stream-ref v_14 0))))
- (lambda (v_15) (car (list-stream-ref v_15 0)))
- (lambda (v_16) (make-list-stream (cdr (list-stream-ref v_16 0))))))
- (cons prop:gen-sequence (lambda (v_17) (values car cdr values (list-stream-ref v_17 0) pair? #f #f))))))
+ (lambda (v_22) (not (pair? (list-stream-ref v_22 0))))
+ (lambda (v_23) (car (list-stream-ref v_23 0)))
+ (lambda (v_24) (make-list-stream (cdr (list-stream-ref v_24 0))))))
+ (cons prop:gen-sequence (lambda (v_25) (values car cdr values (list-stream-ref v_25 0) pair? #f #f))))))
(define-values
(check-list)
- (lambda (l_4) (begin (if (list? l_4) (void) (let-values () (raise-argument-error 'in-list "list?" l_4))))))
+ (lambda (l_5) (begin (if (list? l_5) (void) (1/raise-argument-error 'in-list "list?" l_5)))))
+ (define-values (:list-gen) (lambda (l_6) (begin (values car cdr values l_6 pair? #f #f))))
+ (define-values (:mlist-gen) (lambda (l_7) (begin (values mcar #f mcdr l_7 mpair? #f #f))))
(define-values
- (check-in-hash)
- (lambda (ht_7)
+ (:input-port-gen)
+ (lambda (p_4) (begin (values read-byte #f values p_4 #f (lambda (x_9) (not (eof-object? x_9))) #f))))
+ (define-values
+ (:stream-gen)
+ (lambda (l_8) (begin (values unsafe-stream-first unsafe-stream-rest values l_8 unsafe-stream-not-empty? #f #f))))
+ (define-values
+ (:hash-gen)
+ (case-lambda
+ ((ht_7 -get_0 -first_0 -next_0)
(begin
- (if ((lambda (ht_8) (hash? ht_8)) ht_7) (void) (let-values () (raise-argument-error 'in-hash "hash?" ht_7))))))
+ (values
+ (lambda (pos_0) (-get_0 ht_7 pos_0))
+ #f
+ (lambda (pos_1) (-next_0 ht_7 pos_1))
+ (-first_0 ht_7)
+ (lambda (pos_2) pos_2)
+ #f
+ #f)))
+ ((ht_8 -get_1 -first_1 -next_1 bad-v_0)
+ (values
+ (lambda (pos_3) (-get_1 ht_8 pos_3 bad-v_0))
+ #f
+ (lambda (pos_4) (-next_1 ht_8 pos_4))
+ (-first_1 ht_8)
+ (lambda (pos_5) pos_5)
+ #f
+ #f))))
(define-values
- (check-in-immutable-hash)
+ (check-in-hash)
(lambda (ht_9)
- (begin
- (if ((lambda (ht_10) (if (hash? ht_10) (immutable? ht_10) #f)) ht_9)
- (void)
- (let-values () (raise-argument-error 'in-immutable-hash "(and/c hash? immutable?)" ht_9))))))
+ (begin (if ((lambda (ht_10) (hash? ht_10)) ht_9) (void) (1/raise-argument-error 'in-hash "hash?" ht_9)))))
(define-values
- (check-in-hash-keys)
+ (check-in-immutable-hash)
(lambda (ht_11)
(begin
- (if ((lambda (ht_12) (hash? ht_12)) ht_11)
+ (if ((lambda (ht_12) (if (hash? ht_12) (immutable? ht_12) #f)) ht_11)
(void)
- (let-values () (raise-argument-error 'in-hash-keys "hash?" ht_11))))))
+ (1/raise-argument-error 'in-immutable-hash "(and/c hash? immutable?)" ht_11)))))
(define-values
- (check-in-immutable-hash-keys)
+ (check-in-hash-keys)
(lambda (ht_13)
- (begin
- (if ((lambda (ht_14) (if (hash? ht_14) (immutable? ht_14) #f)) ht_13)
- (void)
- (let-values () (raise-argument-error 'in-immutable-hash-keys "(and/c hash? immutable?)" ht_13))))))
+ (begin (if ((lambda (ht_14) (hash? ht_14)) ht_13) (void) (1/raise-argument-error 'in-hash-keys "hash?" ht_13)))))
(define-values
- (check-in-hash-values)
+ (check-in-immutable-hash-keys)
(lambda (ht_15)
(begin
- (if ((lambda (ht_16) (hash? ht_16)) ht_15)
+ (if ((lambda (ht_16) (if (hash? ht_16) (immutable? ht_16) #f)) ht_15)
(void)
- (let-values () (raise-argument-error 'in-hash-values "hash?" ht_15))))))
+ (1/raise-argument-error 'in-immutable-hash-keys "(and/c hash? immutable?)" ht_15)))))
+ (define-values
+ (check-in-hash-values)
+ (lambda (ht_17)
+ (begin (if ((lambda (ht_18) (hash? ht_18)) ht_17) (void) (1/raise-argument-error 'in-hash-values "hash?" ht_17)))))
(define-values
(check-ranges)
- (lambda (who_4 type-name_0 vec_7 start_4 stop_0 step_2 len_0)
+ (lambda (who_10 type-name_0 vec_7 start_4 stop_0 step_2 len_0)
(begin
(begin
(if (exact-nonnegative-integer? start_4)
(void)
- (let-values () (raise-argument-error who_4 "exact-nonnegative-integer?" start_4)))
- (if (let-values (((or-part_22) (< start_4 len_0))) (if or-part_22 or-part_22 (= len_0 start_4 stop_0)))
+ (1/raise-argument-error who_10 "exact-nonnegative-integer?" start_4))
+ (if (let-values (((or-part_38) (< start_4 len_0))) (if or-part_38 or-part_38 (= len_0 start_4 stop_0)))
(void)
- (let-values () (raise-range-error who_4 type-name_0 "starting " start_4 vec_7 0 (sub1 len_0))))
- (if (exact-integer? stop_0) (void) (let-values () (raise-argument-error who_4 "exact-integer?" stop_0)))
+ (1/raise-range-error who_10 type-name_0 "starting " start_4 vec_7 0 (sub1 len_0)))
+ (if (exact-integer? stop_0) (void) (1/raise-argument-error who_10 "exact-integer?" stop_0))
(if (if (<= -1 stop_0) (<= stop_0 len_0) #f)
(void)
- (let-values () (raise-range-error who_4 type-name_0 "stopping " stop_0 vec_7 -1 len_0)))
+ (1/raise-range-error who_10 type-name_0 "stopping " stop_0 vec_7 -1 len_0))
(if (if (exact-integer? step_2) (not (zero? step_2)) #f)
(void)
- (let-values () (raise-argument-error who_4 "(and/c exact-integer? (not/c zero?))" step_2)))
+ (1/raise-argument-error who_10 "(and/c exact-integer? (not/c zero?))" step_2))
(if (if (< start_4 stop_0) (< step_2 0) #f)
- (let-values ()
- (raise-arguments-error
- who_4
- "starting index less than stopping index, but given a negative step"
- "starting index"
- start_4
- "stopping index"
- stop_0
- "step"
- step_2))
+ (1/raise-arguments-error
+ who_10
+ "starting index less than stopping index, but given a negative step"
+ "starting index"
+ start_4
+ "stopping index"
+ stop_0
+ "step"
+ step_2)
(void))
(if (if (< stop_0 start_4) (> step_2 0) #f)
- (let-values ()
- (raise-arguments-error
- who_4
- "starting index more than stopping index, but given a positive step"
- "starting index"
- start_4
- "stopping index"
- stop_0
- "step"
- step_2))
+ (1/raise-arguments-error
+ who_10
+ "starting index more than stopping index, but given a positive step"
+ "starting index"
+ start_4
+ "stopping index"
+ stop_0
+ "step"
+ step_2)
(void))))))
(define-values
(normalise-inputs)
- (lambda (who_5 type-name_1 vector?_0 unsafe-vector-length_0 vec_8 start_5 stop_1 step_3)
+ (lambda (who_11 type-name_1 vector?_0 unsafe-vector-length_0 vec_8 start_5 stop_1 step_3)
(begin
(begin
- (if (vector?_0 vec_8) (void) (let-values () (raise-argument-error who_5 type-name_1 vec_8)))
+ (if (vector?_0 vec_8) (void) (1/raise-argument-error who_11 (string-append type-name_1 "?") vec_8))
(let-values (((len_1) (unsafe-vector-length_0 vec_8)))
(let-values (((stop*_0) (if stop_1 stop_1 len_1)))
(begin
- (check-ranges who_5 type-name_1 vec_8 start_5 stop*_0 step_3 len_1)
+ (check-ranges who_11 type-name_1 vec_8 start_5 stop*_0 step_3 len_1)
(values vec_8 start_5 stop*_0 step_3))))))))
(define-values
(unsafe-normalise-inputs)
@@ -2020,17 +1967,79 @@
(values
vec_9
start_6
- (let-values (((or-part_23) stop_2)) (if or-part_23 or-part_23 (unsafe-vector-length_1 vec_9)))
+ (let-values (((or-part_39) stop_2)) (if or-part_39 or-part_39 (unsafe-vector-length_1 vec_9)))
step_4))))
+ (define-values
+ (:vector-gen)
+ (lambda (v_26 start_7 stop_3 step_5)
+ (begin
+ (values
+ (lambda (i_20) (unsafe-vector-ref v_26 i_20))
+ #f
+ (if (= step_5 1) add1 (lambda (i_21) (+ i_21 step_5)))
+ start_7
+ (if (> step_5 0) (lambda (i_22) (< i_22 stop_3)) (lambda (i_23) (> i_23 stop_3)))
+ #f
+ #f))))
(define-values
(check-vector)
- (lambda (v_18) (begin (if (vector? v_18) (void) (let-values () (raise-argument-error 'in-vector "vector" v_18))))))
+ (lambda (v_27)
+ (begin (if (vector? v_27) (void) (1/raise-argument-error 'in-vector (string-append "vector" "?") v_27)))))
+ (define-values
+ (:string-gen)
+ (lambda (v_28 start_8 stop_4 step_6)
+ (begin
+ (values
+ (lambda (i_24) (string-ref v_28 i_24))
+ #f
+ (if (= step_6 1) add1 (lambda (i_25) (+ i_25 step_6)))
+ start_8
+ (if (> step_6 0) (lambda (i_26) (< i_26 stop_4)) (lambda (i_27) (> i_27 stop_4)))
+ #f
+ #f))))
(define-values
(check-string)
- (lambda (v_19) (begin (if (string? v_19) (void) (let-values () (raise-argument-error 'in-string "string" v_19))))))
+ (lambda (v_29)
+ (begin (if (string? v_29) (void) (1/raise-argument-error 'in-string (string-append "string" "?") v_29)))))
+ (define-values
+ (:bytes-gen)
+ (lambda (v_30 start_9 stop_5 step_7)
+ (begin
+ (values
+ (lambda (i_28) (unsafe-bytes-ref v_30 i_28))
+ #f
+ (if (= step_7 1) add1 (lambda (i_29) (+ i_29 step_7)))
+ start_9
+ (if (> step_7 0) (lambda (i_30) (< i_30 stop_5)) (lambda (i_31) (> i_31 stop_5)))
+ #f
+ #f))))
(define-values
(check-bytes)
- (lambda (v_20) (begin (if (bytes? v_20) (void) (let-values () (raise-argument-error 'in-bytes "bytes" v_20))))))
+ (lambda (v_31) (begin (if (bytes? v_31) (void) (1/raise-argument-error 'in-bytes (string-append "bytes" "?") v_31)))))
+ (define-values
+ (:flvector-gen)
+ (lambda (v_32 start_10 stop_6 step_8)
+ (begin
+ (values
+ (lambda (i_32) (unsafe-flvector-ref v_32 i_32))
+ #f
+ (if (= step_8 1) add1 (lambda (i_33) (+ i_33 step_8)))
+ start_10
+ (if (> step_8 0) (lambda (i_34) (< i_34 stop_6)) (lambda (i_35) (> i_35 stop_6)))
+ #f
+ #f))))
+ (define-values
+ (:fxvector-gen)
+ (lambda (v_33 start_11 stop_7 step_9)
+ (begin
+ (values
+ (lambda (i_36) (unsafe-fxvector-ref v_33 i_36))
+ #f
+ (if (= step_9 1) add1 (lambda (i_37) (+ i_37 step_9)))
+ start_11
+ (if (> step_9 0) (lambda (i_38) (< i_38 stop_7)) (lambda (i_39) (> i_39 stop_7)))
+ #f
+ #f))))
(define-values
(struct:do-stream make-do-stream do-stream? do-stream-ref do-stream-set!)
(make-struct-type
@@ -2043,9 +2052,9 @@
(cons
prop:stream
(vector
- (lambda (v_21) ((do-stream-ref v_21 0)))
- (lambda (v_22) ((do-stream-ref v_22 1)))
- (lambda (v_23) ((do-stream-ref v_23 2))))))))
+ (lambda (v_34) ((do-stream-ref v_34 0)))
+ (lambda (v_35) ((do-stream-ref v_35 1)))
+ (lambda (v_36) ((do-stream-ref v_36 2))))))))
(define-values (empty-stream) (make-do-stream (lambda () #t) void void))
(define-values
(grow-vector)
@@ -2056,30 +2065,29 @@
(begin (vector-copy! new-vec_0 0 vec_10 0 n_12) new-vec_0))))))
(define-values
(shrink-vector)
- (lambda (vec_11 i_19)
- (begin (let-values (((new-vec_1) (make-vector i_19))) (begin (vector-copy! new-vec_1 0 vec_11 0 i_19) new-vec_1)))))
+ (lambda (vec_11 i_40)
+ (begin (let-values (((new-vec_1) (make-vector i_40))) (begin (vector-copy! new-vec_1 0 vec_11 0 i_40) new-vec_1)))))
(define-values
(map2)
(let-values (((map_0)
(case-lambda
- ((f_0 l_5)
+ ((f_0 l_9)
(begin
'map
(if (if (variable-reference-from-unsafe? (#%variable-reference))
#t
- (if (procedure? f_0) (if (procedure-arity-includes? f_0 1) (list? l_5) #f) #f))
- ((letrec-values (((loop_0)
- (lambda (l_6)
+ (if (procedure? f_0) (if (procedure-arity-includes? f_0 1) (list? l_9) #f) #f))
+ ((letrec-values (((loop_31)
+ (lambda (l_10)
(begin
'loop
- (if (null? l_6)
- (let-values () null)
- (let-values ()
- (let-values (((r_3) (cdr l_6)))
- (cons (f_0 (car l_6)) (loop_0 r_3)))))))))
- loop_0)
- l_5)
- (gen-map f_0 (list l_5)))))
+ (if (null? l_10)
+ null
+ (let-values (((r_4) (cdr l_10)))
+ (cons (f_0 (car l_10)) (loop_31 r_4))))))))
+ loop_31)
+ l_9)
+ (gen-map f_0 (list l_9)))))
((f_1 l1_0 l2_0)
(if (if (variable-reference-from-unsafe? (#%variable-reference))
#t
@@ -2088,43 +2096,41 @@
(if (list? l1_0) (if (list? l2_0) (= (length l1_0) (length l2_0)) #f) #f)
#f)
#f))
- ((letrec-values (((loop_31)
+ ((letrec-values (((loop_32)
(lambda (l1_1 l2_1)
(begin
'loop
(if (null? l1_1)
- (let-values () null)
- (let-values ()
- (let-values (((r1_0) (cdr l1_1)) ((r2_0) (cdr l2_1)))
- (cons (f_1 (car l1_1) (car l2_1)) (loop_31 r1_0 r2_0)))))))))
- loop_31)
+ null
+ (let-values (((r1_0) (cdr l1_1)) ((r2_0) (cdr l2_1)))
+ (cons (f_1 (car l1_1) (car l2_1)) (loop_32 r1_0 r2_0))))))))
+ loop_32)
l1_0
l2_0)
(gen-map f_1 (list l1_0 l2_0))))
- ((f_2 l_7 . args_0) (gen-map f_2 (cons l_7 args_0))))))
+ ((f_2 l_11 . args_3) (gen-map f_2 (cons l_11 args_3))))))
map_0))
(define-values
(for-each2)
(let-values (((for-each_0)
(case-lambda
- ((f_3 l_8)
+ ((f_3 l_12)
(begin
'for-each
(if (if (variable-reference-from-unsafe? (#%variable-reference))
#t
- (if (procedure? f_3) (if (procedure-arity-includes? f_3 1) (list? l_8) #f) #f))
- ((letrec-values (((loop_5)
- (lambda (l_9)
+ (if (procedure? f_3) (if (procedure-arity-includes? f_3 1) (list? l_12) #f) #f))
+ ((letrec-values (((loop_33)
+ (lambda (l_13)
(begin
'loop
- (if (null? l_9)
- (let-values () (void))
- (let-values ()
- (let-values (((r_4) (cdr l_9)))
- (begin (f_3 (car l_9)) (loop_5 r_4)))))))))
- loop_5)
- l_8)
- (gen-for-each f_3 (list l_8)))))
+ (if (null? l_13)
+ (void)
+ (let-values (((r_5) (cdr l_13)))
+ (begin (f_3 (car l_13)) (loop_33 r_5))))))))
+ loop_33)
+ l_12)
+ (gen-for-each f_3 (list l_12)))))
((f_4 l1_2 l2_2)
(if (if (variable-reference-from-unsafe? (#%variable-reference))
#t
@@ -2133,45 +2139,43 @@
(if (list? l1_2) (if (list? l2_2) (= (length l1_2) (length l2_2)) #f) #f)
#f)
#f))
- ((letrec-values (((loop_32)
+ ((letrec-values (((loop_34)
(lambda (l1_3 l2_3)
(begin
'loop
(if (null? l1_3)
- (let-values () (void))
- (let-values ()
- (let-values (((r1_1) (cdr l1_3)) ((r2_1) (cdr l2_3)))
- (begin (f_4 (car l1_3) (car l2_3)) (loop_32 r1_1 r2_1)))))))))
- loop_32)
+ (void)
+ (let-values (((r1_1) (cdr l1_3)) ((r2_1) (cdr l2_3)))
+ (begin (f_4 (car l1_3) (car l2_3)) (loop_34 r1_1 r2_1))))))))
+ loop_34)
l1_2
l2_2)
(gen-for-each f_4 (list l1_2 l2_2))))
- ((f_5 l_10 . args_1) (gen-for-each f_5 (cons l_10 args_1))))))
+ ((f_5 l_14 . args_4) (gen-for-each f_5 (cons l_14 args_4))))))
for-each_0))
(define-values
(andmap2)
(let-values (((andmap_0)
(case-lambda
- ((f_6 l_11)
+ ((f_6 l_15)
(begin
'andmap
(if (if (variable-reference-from-unsafe? (#%variable-reference))
#t
- (if (procedure? f_6) (if (procedure-arity-includes? f_6 1) (list? l_11) #f) #f))
- (if (null? l_11)
+ (if (procedure? f_6) (if (procedure-arity-includes? f_6 1) (list? l_15) #f) #f))
+ (if (null? l_15)
#t
- ((letrec-values (((loop_33)
- (lambda (l_12)
+ ((letrec-values (((loop_35)
+ (lambda (l_16)
(begin
'loop
- (if (null? (cdr l_12))
- (let-values () (f_6 (car l_12)))
- (let-values ()
- (let-values (((r_5) (cdr l_12)))
- (if (f_6 (car l_12)) (loop_33 r_5) #f))))))))
- loop_33)
- l_11))
- (gen-andmap f_6 (list l_11)))))
+ (if (null? (cdr l_16))
+ (f_6 (car l_16))
+ (let-values (((r_6) (cdr l_16)))
+ (if (f_6 (car l_16)) (loop_35 r_6) #f)))))))
+ loop_35)
+ l_15))
+ (gen-andmap f_6 (list l_15)))))
((f_7 l1_4 l2_4)
(if (if (variable-reference-from-unsafe? (#%variable-reference))
#t
@@ -2182,46 +2186,44 @@
#f))
(if (null? l1_4)
#t
- ((letrec-values (((loop_34)
+ ((letrec-values (((loop_36)
(lambda (l1_5 l2_5)
(begin
'loop
(if (null? (cdr l1_5))
- (let-values () (f_7 (car l1_5) (car l2_5)))
- (let-values ()
- (let-values (((r1_2) (cdr l1_5)) ((r2_2) (cdr l2_5)))
- (if (f_7 (car l1_5) (car l2_5)) (loop_34 r1_2 r2_2) #f))))))))
- loop_34)
+ (f_7 (car l1_5) (car l2_5))
+ (let-values (((r1_2) (cdr l1_5)) ((r2_2) (cdr l2_5)))
+ (if (f_7 (car l1_5) (car l2_5)) (loop_36 r1_2 r2_2) #f)))))))
+ loop_36)
l1_4
l2_4))
(gen-andmap f_7 (list l1_4 l2_4))))
- ((f_8 l_13 . args_2) (gen-andmap f_8 (cons l_13 args_2))))))
+ ((f_8 l_17 . args_5) (gen-andmap f_8 (cons l_17 args_5))))))
andmap_0))
(define-values
(ormap2)
(let-values (((ormap_0)
(case-lambda
- ((f_9 l_14)
+ ((f_9 l_18)
(begin
'ormap
(if (if (variable-reference-from-unsafe? (#%variable-reference))
#t
- (if (procedure? f_9) (if (procedure-arity-includes? f_9 1) (list? l_14) #f) #f))
- (if (null? l_14)
+ (if (procedure? f_9) (if (procedure-arity-includes? f_9 1) (list? l_18) #f) #f))
+ (if (null? l_18)
#f
- ((letrec-values (((loop_35)
- (lambda (l_15)
+ ((letrec-values (((loop_37)
+ (lambda (l_19)
(begin
'loop
- (if (null? (cdr l_15))
- (let-values () (f_9 (car l_15)))
- (let-values ()
- (let-values (((r_6) (cdr l_15)))
- (let-values (((or-part_24) (f_9 (car l_15))))
- (if or-part_24 or-part_24 (loop_35 r_6))))))))))
- loop_35)
- l_14))
- (gen-ormap f_9 (list l_14)))))
+ (if (null? (cdr l_19))
+ (f_9 (car l_19))
+ (let-values (((r_7) (cdr l_19)))
+ (let-values (((or-part_40) (f_9 (car l_19))))
+ (if or-part_40 or-part_40 (loop_37 r_7)))))))))
+ loop_37)
+ l_18))
+ (gen-ormap f_9 (list l_18)))))
((f_10 l1_6 l2_6)
(if (if (variable-reference-from-unsafe? (#%variable-reference))
#t
@@ -2232,147 +2234,138 @@
#f))
(if (null? l1_6)
#f
- ((letrec-values (((loop_36)
+ ((letrec-values (((loop_38)
(lambda (l1_7 l2_7)
(begin
'loop
(if (null? (cdr l1_7))
- (let-values () (f_10 (car l1_7) (car l2_7)))
- (let-values ()
- (let-values (((r1_3) (cdr l1_7)) ((r2_3) (cdr l2_7)))
- (let-values (((or-part_25) (f_10 (car l1_7) (car l2_7))))
- (if or-part_25 or-part_25 (loop_36 r1_3 r2_3))))))))))
- loop_36)
+ (f_10 (car l1_7) (car l2_7))
+ (let-values (((r1_3) (cdr l1_7)) ((r2_3) (cdr l2_7)))
+ (let-values (((or-part_41) (f_10 (car l1_7) (car l2_7))))
+ (if or-part_41 or-part_41 (loop_38 r1_3 r2_3)))))))))
+ loop_38)
l1_6
l2_6))
(gen-ormap f_10 (list l1_6 l2_6))))
- ((f_11 l_16 . args_3) (gen-ormap f_11 (cons l_16 args_3))))))
+ ((f_11 l_20 . args_6) (gen-ormap f_11 (cons l_20 args_6))))))
ormap_0))
(define-values
(check-args)
- (lambda (who_6 f_12 ls_4)
+ (lambda (who_12 f_12 ls_4)
(begin
(begin
- (if (procedure? f_12) (void) (let-values () (raise-argument-error who_6 "procedure?" f_12)))
- ((letrec-values (((loop_37)
- (lambda (prev-len_0 ls_5 i_20)
+ (if (procedure? f_12) (void) (raise-argument-error who_12 "procedure?" f_12))
+ ((letrec-values (((loop_39)
+ (lambda (prev-len_0 ls_5 i_41)
(begin
'loop
(if (null? ls_5)
(void)
- (let-values ()
- (let-values (((l_17) (car ls_5)))
- (begin
- (if (list? l_17) (void) (let-values () (raise-argument-error who_6 "list?" l_17)))
- (let-values (((len_2) (length l_17)))
- (begin
- (if (if prev-len_0 (not (= len_2 prev-len_0)) #f)
- (let-values ()
- (raise-arguments-error
- who_6
- "all lists must have same size"
- "first list length"
- prev-len_0
- "other list length"
- len_2
- "procedure"
- f_12))
- (void))
- (loop_37 len_2 (cdr ls_5) (add1 i_20))))))))))))
- loop_37)
+ (let-values (((l_21) (car ls_5)))
+ (begin
+ (if (list? l_21) (void) (raise-argument-error who_12 "list?" l_21))
+ (let-values (((len_2) (length l_21)))
+ (begin
+ (if (if prev-len_0 (not (= len_2 prev-len_0)) #f)
+ (raise-arguments-error
+ who_12
+ "all lists must have same size"
+ "first list length"
+ prev-len_0
+ "other list length"
+ len_2
+ "procedure"
+ f_12)
+ (void))
+ (loop_39 len_2 (cdr ls_5) (add1 i_41)))))))))))
+ loop_39)
#f
ls_4
1)
(if (procedure-arity-includes? f_12 (length ls_4))
(void)
- (let-values ()
- (let-values (((required-keywords_0 optional-keywords_0) (procedure-keywords f_12)))
- (apply
- raise-arguments-error
- who_6
- (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"))
- "given procedure"
- (unquoted-printing-string
- (let-values (((or-part_26)
- (let-values (((n_13) (object-name f_12))) (if (symbol? n_13) (symbol->string n_13) #f))))
- (if or-part_26 or-part_26 "#")))
- (append
- (let-values (((a_11) (procedure-arity f_12)))
- (if (pair? required-keywords_0)
- (let-values () null)
- (if (integer? a_11)
- (let-values () (list "expected" a_11))
- (if (arity-at-least? a_11)
- (let-values ()
- (list
- "expected"
- (unquoted-printing-string
- (string-append "at least " (number->string (arity-at-least-value a_11))))))
- (let-values () null)))))
- (if (pair? required-keywords_0) (let-values () null) (let-values () (list "given" (length ls_4))))
+ (let-values (((required-keywords_0 optional-keywords_0) (procedure-keywords f_12)))
+ (apply
+ raise-arguments-error
+ who_12
+ (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"))
+ "given procedure"
+ (unquoted-printing-string
+ (let-values (((or-part_42)
+ (let-values (((n_13) (object-name f_12))) (if (symbol? n_13) (symbol->string n_13) #f))))
+ (if or-part_42 or-part_42 "#")))
+ (append
+ (let-values (((a_11) (procedure-arity f_12)))
(if (pair? required-keywords_0)
- (let-values ()
- (list
- "required keywords"
- (unquoted-printing-string
- (apply
- string-append
- (cdr
- ((letrec-values (((loop_38)
- (lambda (kws_0)
- (begin
- 'loop
- (if (null? kws_0)
- (let-values () null)
- (let-values ()
- (list*
- " "
- (string-append "#:" (keyword->string (car kws_0)))
- (loop_38 (cdr kws_0)))))))))
- loop_38)
- required-keywords_0))))))
- (let-values () null))
- (let-values (((w_0) (quotient (error-print-width) (length ls_4))))
- (if (> w_0 10)
- (list
- "argument lists..."
- (unquoted-printing-string
- (apply
- string-append
- ((letrec-values (((loop_39)
- (lambda (ls_6)
- (begin
- 'loop
- (if (null? ls_6)
- (let-values () null)
- (let-values ()
- (cons
- (string-append "\n " ((error-value->string-handler) (car ls_6) w_0))
- (loop_39 (cdr ls_6)))))))))
- loop_39)
- ls_4))))
- null)))))))))))
+ null
+ (if (integer? a_11)
+ (list "expected" a_11)
+ (if (arity-at-least? a_11)
+ (list
+ "expected"
+ (unquoted-printing-string
+ (string-append "at least " (number->string (arity-at-least-value a_11)))))
+ null))))
+ (if (pair? required-keywords_0) null (list "given" (length ls_4)))
+ (if (pair? required-keywords_0)
+ (list
+ "required keywords"
+ (unquoted-printing-string
+ (apply
+ string-append
+ (cdr
+ ((letrec-values (((loop_40)
+ (lambda (kws_0)
+ (begin
+ 'loop
+ (if (null? kws_0)
+ null
+ (list*
+ " "
+ (string-append "#:" (keyword->string (car kws_0)))
+ (loop_40 (cdr kws_0))))))))
+ loop_40)
+ required-keywords_0)))))
+ null)
+ (let-values (((w_0) (quotient (error-print-width) (length ls_4))))
+ (if (> w_0 10)
+ (list
+ "argument lists..."
+ (unquoted-printing-string
+ (apply
+ string-append
+ ((letrec-values (((loop_41)
+ (lambda (ls_6)
+ (begin
+ 'loop
+ (if (null? ls_6)
+ null
+ (cons
+ (string-append "\n " ((error-value->string-handler) (car ls_6) w_0))
+ (loop_41 (cdr ls_6))))))))
+ loop_41)
+ ls_4))))
+ null))))))))))
(define-values
(gen-map)
(lambda (f_13 ls_7)
(begin
(begin
(if (variable-reference-from-unsafe? (#%variable-reference)) #t (check-args 'map f_13 ls_7))
- ((letrec-values (((loop_40)
+ ((letrec-values (((loop_42)
(lambda (ls_8)
(begin
'loop
(if (null? (car ls_8))
- (let-values () null)
- (let-values ()
- (let-values (((next-ls_0) (map2 cdr ls_8)))
- (cons (apply f_13 (map2 car ls_8)) (loop_40 next-ls_0)))))))))
- loop_40)
+ null
+ (let-values (((next-ls_0) (map2 cdr ls_8)))
+ (cons (apply f_13 (map2 car ls_8)) (loop_42 next-ls_0))))))))
+ loop_42)
ls_7)))))
(define-values
(gen-for-each)
@@ -2380,16 +2373,15 @@
(begin
(begin
(if (variable-reference-from-unsafe? (#%variable-reference)) #t (check-args 'for-each f_14 ls_9))
- ((letrec-values (((loop_41)
+ ((letrec-values (((loop_43)
(lambda (ls_10)
(begin
'loop
(if (null? (car ls_10))
(void)
- (let-values ()
- (let-values (((next-ls_1) (map2 cdr ls_10)))
- (begin (apply f_14 (map2 car ls_10)) (loop_41 next-ls_1)))))))))
- loop_41)
+ (let-values (((next-ls_1) (map2 cdr ls_10)))
+ (begin (apply f_14 (map2 car ls_10)) (loop_43 next-ls_1))))))))
+ loop_43)
ls_9)))))
(define-values
(gen-andmap)
@@ -2397,18 +2389,17 @@
(begin
(begin
(if (variable-reference-from-unsafe? (#%variable-reference)) #t (check-args 'andmap f_15 ls_11))
- ((letrec-values (((loop_42)
+ ((letrec-values (((loop_44)
(lambda (ls_12)
(begin
'loop
(if (null? (car ls_12))
- (let-values () #t)
+ #t
(if (null? (cdar ls_12))
- (let-values () (apply f_15 (map2 car ls_12)))
- (let-values ()
- (let-values (((next-ls_2) (map2 cdr ls_12)))
- (if (apply f_15 (map2 car ls_12)) (loop_42 next-ls_2) #f)))))))))
- loop_42)
+ (apply f_15 (map2 car ls_12))
+ (let-values (((next-ls_2) (map2 cdr ls_12)))
+ (if (apply f_15 (map2 car ls_12)) (loop_44 next-ls_2) #f))))))))
+ loop_44)
ls_11)))))
(define-values
(gen-ormap)
@@ -2416,19 +2407,18 @@
(begin
(begin
(if (variable-reference-from-unsafe? (#%variable-reference)) #t (check-args 'ormap f_16 ls_13))
- ((letrec-values (((loop_43)
+ ((letrec-values (((loop_45)
(lambda (ls_14)
(begin
'loop
(if (null? (car ls_14))
- (let-values () #f)
+ #f
(if (null? (cdar ls_14))
- (let-values () (apply f_16 (map2 car ls_14)))
- (let-values ()
- (let-values (((next-ls_3) (map2 cdr ls_14)))
- (let-values (((or-part_27) (apply f_16 (map2 car ls_14))))
- (if or-part_27 or-part_27 (loop_43 next-ls_3)))))))))))
- loop_43)
+ (apply f_16 (map2 car ls_14))
+ (let-values (((next-ls_3) (map2 cdr ls_14)))
+ (let-values (((or-part_43) (apply f_16 (map2 car ls_14))))
+ (if or-part_43 or-part_43 (loop_45 next-ls_3))))))))))
+ loop_45)
ls_13)))))
(define-values
(hash-keys)
@@ -2437,17 +2427,17 @@
(begin
'hash-keys
(if try-order?_0
- (hash-map h_0 (lambda (k_0 v_24) k_0) #t)
- ((letrec-values (((loop_44)
- (lambda (pos_0)
+ (hash-map h_0 (lambda (k_0 v_37) k_0) #t)
+ ((letrec-values (((loop_46)
+ (lambda (pos_6)
(begin
'loop
- (if pos_0
- (let-values (((k_1) (hash-iterate-key h_0 pos_0 unsafe-undefined))
- ((r_4) (loop_44 (hash-iterate-next h_0 pos_0))))
- (if (eq? k_1 unsafe-undefined) r_4 (cons k_1 r_4)))
+ (if pos_6
+ (let-values (((k_1) (hash-iterate-key h_0 pos_6 unsafe-undefined))
+ ((r_8) (loop_46 (hash-iterate-next h_0 pos_6))))
+ (if (eq? k_1 unsafe-undefined) r_8 (cons k_1 r_8)))
null)))))
- loop_44)
+ loop_46)
(hash-iterate-first h_0)))))))
(let-values (((hash-keys_1)
(case-lambda
@@ -2455,13 +2445,11 @@
(begin
'hash-keys
(begin
- (if (hash? h_1) (void) (let-values () (raise-argument-error 'hash-keys "hash?" 0 h_1)))
+ (if (hash? h_1) (void) (raise-argument-error 'hash-keys "hash?" 0 h_1))
(hash-keys_0 h_1 #f))))
((h_2 try-order?_1)
(begin
- (if (hash? h_2)
- (void)
- (let-values () (raise-argument-error 'hash-keys "hash?" 0 h_2 try-order?_1)))
+ (if (hash? h_2) (void) (raise-argument-error 'hash-keys "hash?" 0 h_2 try-order?_1))
(hash-keys_0 h_2 try-order?_1))))))
hash-keys_1)))
(define-values
@@ -2471,48 +2459,36 @@
'hash-copy-clear
(let-values (((table_0) table3_0))
(let-values (((kind_0) kind1_0))
- (let-values ()
- (begin
- (if (hash? table_0) (void) (let-values () (raise-argument-error 'hash-copy-clear "hash?" table_0)))
- (if (memq kind_0 '(#f immutable mutable weak ephemeron))
- (void)
- (let-values ()
- (raise-argument-error 'hash-copy-clear "(or/c #f 'immutable 'mutable 'weak 'ephemeron)" kind_0)))
- (if (if kind_0 (eq? 'immutable kind_0) (immutable? table_0))
- (let-values ()
+ (begin
+ (if (hash? table_0) (void) (raise-argument-error 'hash-copy-clear "hash?" table_0))
+ (if (memq kind_0 '(#f immutable mutable weak ephemeron))
+ (void)
+ (raise-argument-error 'hash-copy-clear "(or/c #f 'immutable 'mutable 'weak 'ephemeron)" kind_0))
+ (if (if kind_0 (eq? 'immutable kind_0) (immutable? table_0))
+ (if (hash-equal? table_0)
+ (hash)
+ (if (hash-equal-always? table_0)
+ (hashalw)
+ (if (hash-eqv? table_0) (hasheqv) (if (hash-eq? table_0) (hasheq) (void)))))
+ (if (if kind_0 (eq? 'weak kind_0) (hash-weak? table_0))
+ (if (hash-equal? table_0)
+ (make-weak-hash)
+ (if (hash-equal-always? table_0)
+ (make-weak-hashalw)
+ (if (hash-eqv? table_0) (make-weak-hasheqv) (if (hash-eq? table_0) (make-weak-hasheq) (void)))))
+ (if (if kind_0 (eq? 'ephemeron kind_0) (hash-ephemeron? table_0))
(if (hash-equal? table_0)
- (let-values () (hash))
+ (make-ephemeron-hash)
(if (hash-equal-always? table_0)
- (let-values () (hashalw))
+ (make-ephemeron-hashalw)
(if (hash-eqv? table_0)
- (let-values () (hasheqv))
- (if (hash-eq? table_0) (let-values () (hasheq)) (void))))))
- (if (if kind_0 (eq? 'weak kind_0) (hash-weak? table_0))
- (let-values ()
- (if (hash-equal? table_0)
- (let-values () (make-weak-hash))
- (if (hash-equal-always? table_0)
- (let-values () (make-weak-hashalw))
- (if (hash-eqv? table_0)
- (let-values () (make-weak-hasheqv))
- (if (hash-eq? table_0) (let-values () (make-weak-hasheq)) (void))))))
- (if (if kind_0 (eq? 'ephemeron kind_0) (hash-ephemeron? table_0))
- (let-values ()
- (if (hash-equal? table_0)
- (let-values () (make-ephemeron-hash))
- (if (hash-equal-always? table_0)
- (let-values () (make-ephemeron-hashalw))
- (if (hash-eqv? table_0)
- (let-values () (make-ephemeron-hasheqv))
- (if (hash-eq? table_0) (let-values () (make-ephemeron-hasheq)) (void))))))
- (let-values ()
- (if (hash-equal? table_0)
- (let-values () (make-hash))
- (if (hash-equal-always? table_0)
- (let-values () (make-hashalw))
- (if (hash-eqv? table_0)
- (let-values () (make-hasheqv))
- (if (hash-eq? table_0) (let-values () (make-hasheq)) (void))))))))))))))))
+ (make-ephemeron-hasheqv)
+ (if (hash-eq? table_0) (make-ephemeron-hasheq) (void)))))
+ (if (hash-equal? table_0)
+ (make-hash)
+ (if (hash-equal-always? table_0)
+ (make-hashalw)
+ (if (hash-eqv? table_0) (make-hasheqv) (if (hash-eq? table_0) (make-hasheq) (void))))))))))))))
(define-values
(hash-map/copy.1)
(lambda (kind5_0 table7_0 f8_0)
@@ -2521,98 +2497,78 @@
(let-values (((table_1) table7_0))
(let-values (((f_17) f8_0))
(let-values (((kind_1) kind5_0))
- (let-values ()
+ (let-values ((()
+ (begin
+ (if (hash? table_1) (void) (raise-argument-error 'hash-map/copy "hash?" table_1))
+ (values))))
(let-values ((()
(begin
- (if (hash? table_1)
+ (if (if (procedure? f_17) (procedure-arity-includes? f_17 2) #f)
(void)
- (let-values () (raise-argument-error 'hash-map/copy "hash?" table_1)))
+ (raise-argument-error 'hash-map/copy "(procedure-arity-includes/c 2)" f_17))
(values))))
(let-values ((()
(begin
- (if (if (procedure? f_17) (procedure-arity-includes? f_17 2) #f)
+ (if (memq kind_1 '(#f immutable mutable weak ephemeron))
(void)
- (let-values ()
- (raise-argument-error 'hash-map/copy "(procedure-arity-includes/c 2)" f_17)))
+ (raise-argument-error
+ 'hash-map/copy
+ "(or/c #f 'immutable 'mutable 'weak 'ephemeron)"
+ kind_1))
(values))))
- (let-values ((()
- (begin
- (if (memq kind_1 '(#f immutable mutable weak ephemeron))
- (void)
- (let-values ()
- (raise-argument-error
- 'hash-map/copy
- "(or/c #f 'immutable 'mutable 'weak 'ephemeron)"
- kind_1)))
- (values))))
- (let-values (((acc_0)
- (let-values (((table10_0) table_1) ((kind11_0) kind_1))
- (hash-copy-clear.1 kind11_0 table10_0))))
- (if (immutable? acc_0)
- (let-values ()
- (let-values (((ht_17) table_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_17)))
- ((letrec-values (((for-loop_0)
- (lambda (acc_1 i_21)
- (begin
- 'for-loop
- (if i_21
- (let-values (((k1_0 v1_0) (hash-iterate-key+value ht_17 i_21)))
- (let-values (((acc_2)
- (let-values (((acc_3) acc_1))
- (let-values (((acc_4)
- (let-values ()
- (let-values (((k2_0 v2_0)
- (f_17 k1_0 v1_0)))
- (hash-set acc_3 k2_0 v2_0)))))
- (values acc_4)))))
- (if (not #f)
- (for-loop_0 acc_2 (hash-iterate-next ht_17 i_21))
- acc_2)))
- acc_1)))))
- for-loop_0)
- acc_0
- (hash-iterate-first ht_17)))))
- (let-values ()
+ (let-values (((acc_0)
+ (let-values (((table10_0) table_1) ((kind11_0) kind_1))
+ (hash-copy-clear.1 kind11_0 table10_0))))
+ (if (immutable? acc_0)
+ (let-values (((acc_1) (let-values (((acc_2) acc_0)) acc_2)))
+ (let-values (((ht_19) table_1))
(begin
- (let-values (((ht_18) table_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_18)))
- ((letrec-values (((for-loop_1)
- (lambda (i_22)
- (begin
- 'for-loop
- (if i_22
- (let-values (((k1_1 v1_1) (hash-iterate-key+value ht_18 i_22)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((k2_1 v2_1)
- (f_17
- k1_1
- v1_1)))
- (hash-set!
- acc_0
- k2_1
- v2_1)))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_1 (hash-iterate-next ht_18 i_22))
- (values))))
- (values))))))
- for-loop_1)
- (hash-iterate-first ht_18))))
- (void)
- acc_0))))))))))))))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_19))
+ ((letrec-values (((for-loop_0)
+ (lambda (acc_3 i_42)
+ (begin
+ 'for-loop
+ (if i_42
+ (let-values (((k1_0 v1_0) (hash-iterate-key+value ht_19 i_42)))
+ (let-values (((acc_4)
+ (let-values (((acc_5)
+ (let-values (((k2_0 v2_0)
+ (f_17 k1_0 v1_0)))
+ (hash-set acc_3 k2_0 v2_0))))
+ (values acc_5))))
+ (if (not #f)
+ (for-loop_0 acc_4 (hash-iterate-next ht_19 i_42))
+ acc_4)))
+ acc_3)))))
+ for-loop_0)
+ acc_1
+ (hash-iterate-first ht_19)))))
+ (begin
+ (let-values (((ht_20) table_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_20))
+ ((letrec-values (((for-loop_1)
+ (lambda (i_43)
+ (begin
+ 'for-loop
+ (if i_43
+ (let-values (((k1_1 v1_1) (hash-iterate-key+value ht_20 i_43)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((k2_1 v2_1)
+ (f_17 k1_1 v1_1)))
+ (hash-set! acc_0 k2_1 v2_1))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_1 (hash-iterate-next ht_20 i_43))
+ (values))))
+ (values))))))
+ for-loop_1)
+ (hash-iterate-first ht_20))))
+ (void)
+ acc_0))))))))))))
(define-values
(sort.1)
(lambda (cache-keys?2_0 key1_0 lst5_0 less?6_0)
@@ -2622,16 +2578,15 @@
(let-values (((less?_0) less?6_0))
(let-values (((getkey_4) key1_0))
(let-values (((cache-keys?_3) cache-keys?2_0))
- (let-values ()
- (begin
- (if (list? lst_6) (void) (let-values () (raise-argument-error 'sort "list?" lst_6)))
- (if (if (procedure? less?_0) (procedure-arity-includes? less?_0 2) #f)
- (void)
- (let-values () (raise-argument-error 'sort "(any/c any/c . -> . any/c)" less?_0)))
- (if (if getkey_4 (not (if (procedure? getkey_4) (procedure-arity-includes? getkey_4 1) #f)) #f)
- (let-values () (raise-argument-error 'sort "(any/c . -> . any/c)" getkey_4))
- (void))
- (if getkey_4 (sort lst_6 less?_0 getkey_4 cache-keys?_3) (sort lst_6 less?_0)))))))))))
+ (begin
+ (if (list? lst_6) (void) (raise-argument-error 'sort "list?" lst_6))
+ (if (if (procedure? less?_0) (procedure-arity-includes? less?_0 2) #f)
+ (void)
+ (raise-argument-error 'sort "(any/c any/c . -> . any/c)" less?_0))
+ (if (if getkey_4 (not (if (procedure? getkey_4) (procedure-arity-includes? getkey_4 1) #f)) #f)
+ (raise-argument-error 'sort "(any/c . -> . any/c)" getkey_4)
+ (void))
+ (if getkey_4 (sort lst_6 less?_0 getkey_4 cache-keys?_3) (sort lst_6 less?_0))))))))))
(define-values
(filter)
(lambda (f_18 list_0)
@@ -2639,19 +2594,23 @@
(begin
(if (if (procedure? f_18) (procedure-arity-includes? f_18 1) #f)
(void)
- (let-values () (raise-argument-error 'filter "(any/c . -> . any/c)" f_18)))
- (if (list? list_0) (void) (let-values () (raise-argument-error 'filter "list?" list_0)))
- ((letrec-values (((loop_7)
- (lambda (l_18 result_0)
+ (raise-argument-error 'filter "(any/c . -> . any/c)" f_18))
+ (if (list? list_0) (void) (raise-argument-error 'filter "list?" list_0))
+ ((letrec-values (((loop_47)
+ (lambda (l_22 result_0)
(begin
'loop
- (if (null? l_18)
+ (if (null? l_22)
(reverse$1 result_0)
- (loop_7 (cdr l_18) (if (f_18 (car l_18)) (cons (car l_18) result_0) result_0)))))))
- loop_7)
+ (loop_47 (cdr l_22) (if (f_18 (car l_22)) (cons (car l_22) result_0) result_0)))))))
+ loop_47)
list_0
null)))))
(define-values (binary-or-text-desc) "(or/c 'binary 'text)")
+ (define-values
+ (raise-argument-error$1)
+ (lambda (who_13 what_0 v_38)
+ (begin 'raise-argument-error (raise-argument-error* who_13 'racket/primitive what_0 v_38))))
(define-values
(open-input-file.1)
(lambda (for-module?2_0 mode1_0 path5_0)
@@ -2660,15 +2619,12 @@
(let-values (((path_0) path5_0))
(let-values (((mode_0) mode1_0))
(let-values (((for-module?_0) for-module?2_0))
- (let-values ()
- (begin
- (if (path-string? path_0)
- (void)
- (let-values () (raise-argument-error 'open-input-file "path-string?" path_0)))
- (if (memq mode_0 '(binary text))
- (void)
- (let-values () (raise-argument-error 'open-input-file binary-or-text-desc mode_0)))
- (open-input-file path_0 mode_0 (if for-module?_0 'module 'none))))))))))
+ (begin
+ (if (path-string? path_0) (void) (raise-argument-error$1 'open-input-file "path-string?" path_0))
+ (if (memq mode_0 '(binary text))
+ (void)
+ (raise-argument-error$1 'open-input-file binary-or-text-desc mode_0))
+ (open-input-file path_0 mode_0 (if for-module?_0 'module 'none)))))))))
(define-values
(with-input-from-file.1)
(lambda (mode43_0 path45_0 proc46_0)
@@ -2677,18 +2633,15 @@
(let-values (((path_1) path45_0))
(let-values (((proc_0) proc46_0))
(let-values (((mode_1) mode43_0))
- (let-values ()
- (begin
- (if (path-string? path_1)
- (void)
- (let-values () (raise-argument-error 'with-input-from-file "path-string?" path_1)))
- (if (if (procedure? proc_0) (procedure-arity-includes? proc_0 0) #f)
- (void)
- (let-values () (raise-argument-error 'with-input-from-file "(-> any)" proc_0)))
- (if (memq mode_1 '(binary text))
- (void)
- (let-values () (raise-argument-error 'with-input-from-file binary-or-text-desc mode_1)))
- (with-input-from-file path_1 proc_0 mode_1)))))))))
+ (begin
+ (if (path-string? path_1) (void) (raise-argument-error$1 'with-input-from-file "path-string?" path_1))
+ (if (if (procedure? proc_0) (procedure-arity-includes? proc_0 0) #f)
+ (void)
+ (raise-argument-error$1 'with-input-from-file "(-> any)" proc_0))
+ (if (memq mode_1 '(binary text))
+ (void)
+ (raise-argument-error$1 'with-input-from-file binary-or-text-desc mode_1))
+ (with-input-from-file path_1 proc_0 mode_1))))))))
(define-values
(call-with-input-file*.1)
(lambda (mode59_0 path61_0 proc62_0)
@@ -2697,25 +2650,23 @@
(let-values (((path_2) path61_0))
(let-values (((proc_1) proc62_0))
(let-values (((mode_2) mode59_0))
- (let-values ()
- (begin
- (if (path-string? path_2)
- (void)
- (let-values () (raise-argument-error 'call-with-input-file* "path-string?" path_2)))
- (if (if (procedure? proc_1) (procedure-arity-includes? proc_1 1) #f)
- (void)
- (let-values () (raise-argument-error 'call-with-input-file* "(input-port? . -> . any)" proc_1)))
- (if (memq mode_2 '(binary text))
- (void)
- (let-values () (raise-argument-error 'call-with-input-file* binary-or-text-desc mode_2)))
- (let-values (((p_4) (open-input-file path_2 mode_2)))
- (dynamic-wind void (lambda () (proc_1 p_4)) (lambda () (close-input-port p_4))))))))))))
+ (begin
+ (if (path-string? path_2) (void) (raise-argument-error$1 'call-with-input-file* "path-string?" path_2))
+ (if (if (procedure? proc_1) (procedure-arity-includes? proc_1 1) #f)
+ (void)
+ (raise-argument-error$1 'call-with-input-file* "(input-port? . -> . any)" proc_1))
+ (if (memq mode_2 '(binary text))
+ (void)
+ (raise-argument-error$1 'call-with-input-file* binary-or-text-desc mode_2))
+ (let-values (((p_5) (open-input-file path_2 mode_2)))
+ (dynamic-wind void (lambda () (proc_1 p_5)) (lambda () (close-input-port p_5)))))))))))
(define-values
(print-value-columns)
(make-parameter
+inf.0
(lambda (c_7)
- (if (let-values (((or-part_1) (eqv? c_7 +inf.0))) (if or-part_1 or-part_1 (if (exact-integer? c_7) (> c_7 5) #f)))
+ (if (let-values (((or-part_44) (eqv? c_7 +inf.0)))
+ (if or-part_44 or-part_44 (if (exact-integer? c_7) (> c_7 5) #f)))
c_7
(raise-argument-error 'print-value-columns "(or/c +inf.0 (and/c exact-integer? (>/c 5)))" c_7)))
'print-value-columns))
@@ -2726,392 +2677,249 @@
(set)
(case-lambda
(() (begin the-empty-hash))
- (l_19
- (let-values (((lst_7) l_19))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_7)))
- ((letrec-values (((for-loop_2)
- (lambda (s_15 lst_8)
- (begin
- 'for-loop
- (if (pair? lst_8)
- (let-values (((e_2) (unsafe-car lst_8)) ((rest_0) (unsafe-cdr lst_8)))
- (let-values (((s_16)
- (let-values (((s_17) s_15))
- (let-values (((s_18) (let-values () (hash-set s_17 e_2 #t))))
- (values s_18)))))
- (if (not #f) (for-loop_2 s_16 rest_0) s_16)))
- s_15)))))
- for-loop_2)
- the-empty-hash
- lst_7))))))
+ (l_23
+ (let-values (((s_16) (let-values (((s_17) the-empty-hash)) s_17)))
+ (let-values (((lst_7) l_23))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_7))
+ ((letrec-values (((for-loop_2)
+ (lambda (s_18 lst_8)
+ (begin
+ 'for-loop
+ (if (pair? lst_8)
+ (let-values (((e_2) (unsafe-car lst_8)) ((rest_0) (unsafe-cdr lst_8)))
+ (let-values (((s_19) (let-values (((s_20) (hash-set s_18 e_2 #t))) (values s_20))))
+ (if (not #f) (for-loop_2 s_19 rest_0) s_19)))
+ s_18)))))
+ for-loop_2)
+ s_16
+ lst_7)))))))
(define-values
(seteq)
(case-lambda
(() (begin the-empty-hasheq))
- (l_17
- (let-values (((lst_9) l_17))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_9)))
- ((letrec-values (((for-loop_3)
- (lambda (s_19 lst_10)
- (begin
- 'for-loop
- (if (pair? lst_10)
- (let-values (((e_3) (unsafe-car lst_10)) ((rest_1) (unsafe-cdr lst_10)))
- (let-values (((s_20)
- (let-values (((s_21) s_19))
- (let-values (((s_22) (let-values () (hash-set s_21 e_3 #t))))
- (values s_22)))))
- (if (not #f) (for-loop_3 s_20 rest_1) s_20)))
- s_19)))))
- for-loop_3)
- the-empty-hasheq
- lst_9))))))
+ (l_24
+ (let-values (((s_21) (let-values (((s_22) the-empty-hasheq)) s_22)))
+ (let-values (((lst_9) l_24))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_9))
+ ((letrec-values (((for-loop_3)
+ (lambda (s_23 lst_10)
+ (begin
+ 'for-loop
+ (if (pair? lst_10)
+ (let-values (((e_3) (unsafe-car lst_10)) ((rest_1) (unsafe-cdr lst_10)))
+ (let-values (((s_24) (let-values (((s_25) (hash-set s_23 e_3 #t))) (values s_25))))
+ (if (not #f) (for-loop_3 s_24 rest_1) s_24)))
+ s_23)))))
+ for-loop_3)
+ s_21
+ lst_9)))))))
(define-values (seteqv) (lambda () (begin the-empty-hasheqv)))
- (define-values (set?) (lambda (s_23) (begin (hash? s_23))))
- (define-values (set-empty?) (lambda (s_24) (begin (zero? (hash-count s_24)))))
- (define-values (set-member?) (lambda (s_25 e_4) (begin (hash-ref s_25 e_4 #f))))
- (define-values (set-count) (lambda (s_26) (begin (hash-count s_26))))
- (define-values (set-add) (lambda (s_27 e_5) (begin (hash-set s_27 e_5 #t))))
- (define-values (set-remove) (lambda (s_28 e_6) (begin (hash-remove s_28 e_6))))
- (define-values (set-first) (lambda (s_29) (begin (hash-iterate-key s_29 (hash-iterate-first s_29)))))
+ (define-values (set?) (lambda (s_26) (begin (hash? s_26))))
+ (define-values (set-empty?) (lambda (s_27) (begin (zero? (hash-count s_27)))))
+ (define-values (set-member?) (lambda (s_28 e_4) (begin (hash-ref s_28 e_4 #f))))
+ (define-values (set-count) (lambda (s_29) (begin (hash-count s_29))))
+ (define-values (set-add) (lambda (s_30 e_5) (begin (hash-set s_30 e_5 #t))))
+ (define-values (set-remove) (lambda (s_31 e_6) (begin (hash-remove s_31 e_6))))
+ (define-values (set-first) (lambda (s_32) (begin (hash-iterate-key s_32 (hash-iterate-first s_32)))))
(define-values (subset?) (lambda (s1_0 s2_0) (begin (hash-keys-subset? s1_0 s2_0))))
(define-values
(set=?)
(lambda (s1_1 s2_1)
(begin
- (let-values (((or-part_28) (eq? s1_1 s2_1)))
- (if or-part_28 or-part_28 (if (= (hash-count s1_1) (hash-count s2_1)) (hash-keys-subset? s1_1 s2_1) #f))))))
+ (let-values (((or-part_45) (eq? s1_1 s2_1)))
+ (if or-part_45 or-part_45 (if (= (hash-count s1_1) (hash-count s2_1)) (hash-keys-subset? s1_1 s2_1) #f))))))
(define-values
(set-subtract)
(lambda (s1_2 s2_2)
(begin
- (let-values (((ht_19) s2_2))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_19)))
- ((letrec-values (((for-loop_4)
- (lambda (s1_3 i_23)
- (begin
- 'for-loop
- (if i_23
- (let-values (((k_2) (unsafe-immutable-hash-iterate-key ht_19 i_23)))
- (let-values (((s1_4)
- (let-values (((s1_5) s1_3))
- (let-values (((s1_6) (let-values () (hash-remove s1_5 k_2))))
- (values s1_6)))))
- (if (not #f)
- (for-loop_4 s1_4 (unsafe-immutable-hash-iterate-next ht_19 i_23))
- s1_4)))
- s1_3)))))
- for-loop_4)
- s1_2
- (unsafe-immutable-hash-iterate-first ht_19)))))))
- (define-values
- (set-union)
- (lambda (s1_7 s2_3)
- (begin
- (if (< (set-count s1_7) (set-count s2_3))
- (set-union s2_3 s1_7)
- (let-values (((ht_20) s2_3))
+ (let-values (((s1_3) (let-values (((s1_4) s1_2)) s1_4)))
+ (let-values (((ht_21) s2_2))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_20)))
- ((letrec-values (((for-loop_5)
- (lambda (s1_8 i_24)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash-keys ht_21))
+ ((letrec-values (((for-loop_4)
+ (lambda (s1_5 i_44)
(begin
'for-loop
- (if i_24
- (let-values (((k_3) (unsafe-immutable-hash-iterate-key ht_20 i_24)))
- (let-values (((s1_9)
- (let-values (((s1_10) s1_8))
- (let-values (((s1_11) (let-values () (hash-set s1_10 k_3 #t))))
- (values s1_11)))))
+ (if i_44
+ (let-values (((k_2) (unsafe-immutable-hash-iterate-key ht_21 i_44)))
+ (let-values (((s1_6)
+ (let-values (((s1_7) (hash-remove s1_5 k_2))) (values s1_7))))
(if (not #f)
- (for-loop_5 s1_9 (unsafe-immutable-hash-iterate-next ht_20 i_24))
- s1_9)))
- s1_8)))))
- for-loop_5)
- s1_7
- (unsafe-immutable-hash-iterate-first ht_20))))))))
+ (for-loop_4 s1_6 (unsafe-immutable-hash-iterate-next ht_21 i_44))
+ s1_6)))
+ s1_5)))))
+ for-loop_4)
+ s1_3
+ (unsafe-immutable-hash-iterate-first ht_21))))))))
+ (define-values
+ (set-union)
+ (lambda (s1_8 s2_3)
+ (begin
+ (if (< (set-count s1_8) (set-count s2_3))
+ (set-union s2_3 s1_8)
+ (let-values (((s1_9) (let-values (((s1_10) s1_8)) s1_10)))
+ (let-values (((ht_22) s2_3))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash-keys ht_22))
+ ((letrec-values (((for-loop_5)
+ (lambda (s1_11 i_45)
+ (begin
+ 'for-loop
+ (if i_45
+ (let-values (((k_3) (unsafe-immutable-hash-iterate-key ht_22 i_45)))
+ (let-values (((s1_12)
+ (let-values (((s1_13) (hash-set s1_11 k_3 #t))) (values s1_13))))
+ (if (not #f)
+ (for-loop_5 s1_12 (unsafe-immutable-hash-iterate-next ht_22 i_45))
+ s1_12)))
+ s1_11)))))
+ for-loop_5)
+ s1_9
+ (unsafe-immutable-hash-iterate-first ht_22)))))))))
(define-values
(set-intersect)
- (lambda (s1_12 s2_4)
+ (lambda (s1_14 s2_4)
(begin
- (if (< (set-count s1_12) (set-count s2_4))
- (set-intersect s2_4 s1_12)
- (let-values (((ht_21) s2_4))
+ (if (< (set-count s1_14) (set-count s2_4))
+ (set-intersect s2_4 s1_14)
+ (let-values (((s_33) (let-values (((s_34) s2_4)) s_34)))
+ (let-values (((ht_23) s2_4))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash-keys ht_23))
+ ((letrec-values (((for-loop_6)
+ (lambda (s_35 i_46)
+ (begin
+ 'for-loop
+ (if i_46
+ (let-values (((k_4) (unsafe-immutable-hash-iterate-key ht_23 i_46)))
+ (let-values (((s_36)
+ (let-values (((s_37)
+ (if (hash-ref s1_14 k_4 #f)
+ s_35
+ (hash-remove s_35 k_4))))
+ (values s_37))))
+ (if (not #f)
+ (for-loop_6 s_36 (unsafe-immutable-hash-iterate-next ht_23 i_46))
+ s_36)))
+ s_35)))))
+ for-loop_6)
+ s_33
+ (unsafe-immutable-hash-iterate-first ht_23)))))))))
+ (define-values
+ (set-partition)
+ (lambda (s_38 pred_0 empty-y-set_0 empty-n-set_0)
+ (begin
+ (let-values (((y_6) (let-values (((y_7) empty-y-set_0)) y_7)) ((n_14) (let-values (((n_15) empty-n-set_0)) n_15)))
+ (let-values (((ht_24) s_38))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_21)))
- ((letrec-values (((for-loop_6)
- (lambda (s_30 i_25)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash-keys ht_24))
+ ((letrec-values (((for-loop_7)
+ (lambda (y_8 n_16 i_47)
(begin
'for-loop
- (if i_25
- (let-values (((k_4) (unsafe-immutable-hash-iterate-key ht_21 i_25)))
- (let-values (((s_31)
- (let-values (((s_32) s_30))
- (let-values (((s_33)
- (let-values ()
- (if (hash-ref s1_12 k_4 #f)
- s_32
- (hash-remove s_32 k_4)))))
- (values s_33)))))
+ (if i_47
+ (let-values (((v_39) (unsafe-immutable-hash-iterate-key ht_24 i_47)))
+ (let-values (((y_9 n_17)
+ (let-values (((y_10 n_18)
+ (if (pred_0 v_39)
+ (values (set-add y_8 v_39) n_16)
+ (values y_8 (set-add n_16 v_39)))))
+ (values y_10 n_18))))
(if (not #f)
- (for-loop_6 s_31 (unsafe-immutable-hash-iterate-next ht_21 i_25))
- s_31)))
- s_30)))))
- for-loop_6)
- s2_4
- (unsafe-immutable-hash-iterate-first ht_21))))))))
- (define-values
- (set-partition)
- (lambda (s_34 pred_0 empty-y-set_0 empty-n-set_0)
- (begin
- (let-values (((ht_22) s_34))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_22)))
- ((letrec-values (((for-loop_7)
- (lambda (y_6 n_14 i_26)
- (begin
- 'for-loop
- (if i_26
- (let-values (((v_25) (unsafe-immutable-hash-iterate-key ht_22 i_26)))
- (let-values (((y_7 n_15)
- (let-values (((y_8) y_6) ((n_16) n_14))
- (let-values (((y_9 n_17)
- (let-values ()
- (if (pred_0 v_25)
- (values (set-add y_8 v_25) n_16)
- (values y_8 (set-add n_16 v_25))))))
- (values y_9 n_17)))))
- (if (not #f)
- (for-loop_7 y_7 n_15 (unsafe-immutable-hash-iterate-next ht_22 i_26))
- (values y_7 n_15))))
- (values y_6 n_14))))))
- for-loop_7)
- empty-y-set_0
- empty-n-set_0
- (unsafe-immutable-hash-iterate-first ht_22)))))))
+ (for-loop_7 y_9 n_17 (unsafe-immutable-hash-iterate-next ht_24 i_47))
+ (values y_9 n_17))))
+ (values y_8 n_16))))))
+ for-loop_7)
+ y_6
+ n_14
+ (unsafe-immutable-hash-iterate-first ht_24))))))))
(define-values
(set->list)
- (lambda (s_35)
+ (lambda (s_39)
(begin
(reverse$1
- (let-values (((ht_23) s_35))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_23)))
- ((letrec-values (((for-loop_8)
- (lambda (fold-var_0 i_27)
- (begin
- 'for-loop
- (if i_27
- (let-values (((k_5) (unsafe-immutable-hash-iterate-key ht_23 i_27)))
- (let-values (((fold-var_1)
- (let-values (((fold-var_2) fold-var_0))
- (let-values (((fold-var_3)
- (let-values ()
- (cons (let-values () k_5) fold-var_2))))
- (values fold-var_3)))))
- (if (not #f)
- (for-loop_8 fold-var_1 (unsafe-immutable-hash-iterate-next ht_23 i_27))
- fold-var_1)))
- fold-var_0)))))
- for-loop_8)
- null
- (unsafe-immutable-hash-iterate-first ht_23))))))))
+ (let-values (((fold-var_0) (let-values (((fold-var_1) null)) fold-var_1)))
+ (let-values (((ht_25) s_39))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash-keys ht_25))
+ ((letrec-values (((for-loop_8)
+ (lambda (fold-var_2 i_48)
+ (begin
+ 'for-loop
+ (if i_48
+ (let-values (((k_5) (unsafe-immutable-hash-iterate-key ht_25 i_48)))
+ (let-values (((fold-var_3)
+ (let-values (((fold-var_4) (cons k_5 fold-var_2)))
+ (values fold-var_4))))
+ (if (not #f)
+ (for-loop_8 fold-var_3 (unsafe-immutable-hash-iterate-next ht_25 i_48))
+ fold-var_3)))
+ fold-var_2)))))
+ for-loop_8)
+ fold-var_0
+ (unsafe-immutable-hash-iterate-first ht_25)))))))))
(define-values
(list->set)
- (lambda (l_20)
+ (lambda (l_25)
(begin
- (let-values (((lst_11) l_20))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_11)))
- ((letrec-values (((for-loop_9)
- (lambda (table_2 lst_12)
- (begin
- 'for-loop
- (if (pair? lst_12)
- (let-values (((k_6) (unsafe-car lst_12)) ((rest_2) (unsafe-cdr lst_12)))
- (let-values (((table_3)
- (let-values (((table_4) table_2))
- (let-values (((table_5)
- (let-values ()
- (let-values (((key_8 val_0)
- (let-values ()
- (values (let-values () k_6) #t))))
- (hash-set table_4 key_8 val_0)))))
- (values table_5)))))
- (if (not #f) (for-loop_9 table_3 rest_2) table_3)))
- table_2)))))
- for-loop_9)
- '#hash()
- lst_11))))))
+ (let-values (((table_2) (let-values (((table_3) '#hash())) table_3)))
+ (let-values (((lst_11) l_25))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_11))
+ ((letrec-values (((for-loop_9)
+ (lambda (table_4 lst_12)
+ (begin
+ 'for-loop
+ (if (pair? lst_12)
+ (let-values (((k_6) (unsafe-car lst_12)) ((rest_2) (unsafe-cdr lst_12)))
+ (let-values (((table_5)
+ (let-values (((table_6)
+ (let-values (((key_8 val_0) (values k_6 #t)))
+ (hash-set table_4 key_8 val_0))))
+ (values table_6))))
+ (if (not #f) (for-loop_9 table_5 rest_2) table_5)))
+ table_4)))))
+ for-loop_9)
+ table_2
+ lst_11)))))))
(define-values
(list->seteq)
- (lambda (l_21)
+ (lambda (l_26)
(begin
- (let-values (((lst_13) l_21))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_13)))
- ((letrec-values (((for-loop_10)
- (lambda (table_6 lst_14)
- (begin
- 'for-loop
- (if (pair? lst_14)
- (let-values (((k_7) (unsafe-car lst_14)) ((rest_3) (unsafe-cdr lst_14)))
- (let-values (((table_7)
- (let-values (((table_8) table_6))
- (let-values (((table_9)
- (let-values ()
- (let-values (((key_9 val_1)
- (let-values ()
- (values (let-values () k_7) #t))))
- (hash-set table_8 key_9 val_1)))))
- (values table_9)))))
- (if (not #f) (for-loop_10 table_7 rest_3) table_7)))
- table_6)))))
- for-loop_10)
- '#hasheq()
- lst_13))))))
- (define-values (start-atomic) (lambda () (begin (unsafe-start-atomic))))
- (define-values (end-atomic) (lambda () (begin (unsafe-end-atomic))))
- (define-values (start-breakable-atomic) (lambda () (begin (unsafe-start-breakable-atomic))))
- (define-values (end-breakable-atomic) (lambda () (begin (unsafe-end-breakable-atomic))))
+ (let-values (((table_7) (let-values (((table_8) '#hasheq())) table_8)))
+ (let-values (((lst_13) l_26))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_13))
+ ((letrec-values (((for-loop_10)
+ (lambda (table_9 lst_14)
+ (begin
+ 'for-loop
+ (if (pair? lst_14)
+ (let-values (((k_7) (unsafe-car lst_14)) ((rest_3) (unsafe-cdr lst_14)))
+ (let-values (((table_10)
+ (let-values (((table_11)
+ (let-values (((key_9 val_1) (values k_7 #t)))
+ (hash-set table_9 key_9 val_1))))
+ (values table_11))))
+ (if (not #f) (for-loop_10 table_10 rest_3) table_10)))
+ table_9)))))
+ for-loop_10)
+ table_7
+ lst_13)))))))
+ (define-values (make-uninterruptible-lock) (lambda () (begin (unsafe-make-uninterruptible-lock))))
+ (define-values (uninterruptible-lock-acquire) (lambda (lock_0) (begin (unsafe-uninterruptible-lock-acquire lock_0))))
+ (define-values (uninterruptible-lock-release) (lambda (lock_1) (begin (unsafe-uninterruptible-lock-release lock_1))))
(define-values (cell.1$11) (unsafe-make-place-local #f))
- (define-values
- (entered-err-string-handler)
- (lambda (s_36 n_18) (begin (call-as-nonatomic (lambda () ((error-value->string-handler) s_36 n_18))))))
- (define-values (cell.2$5) (unsafe-make-place-local #f))
- (define-values (cell.3$2) (unsafe-make-place-local #f))
+ (define-values (cell.2$9) (unsafe-make-place-local #f))
+ (define-values (cell.3$3) (unsafe-make-place-local #f))
(define-values (cell.4$2) (unsafe-make-place-local 0))
- (define-values (exited-key) (gensym 'as-exit))
- (define-values (lock-tag) (make-continuation-prompt-tag 'lock))
- (define-values
- (call-as-atomic)
- (lambda (f_19)
- (begin
- (begin
- (if (if (procedure? f_19) (procedure-arity-includes? f_19 0) #f)
- (void)
- (let-values () (raise-type-error 'call-as-atomic "procedure (arity 0)" f_19)))
- (if (eq? (unsafe-place-local-ref cell.1$11) (current-thread))
- (let-values ()
- (dynamic-wind
- (lambda ()
- (begin
- (start-breakable-atomic)
- (unsafe-place-local-set! cell.4$2 (add1 (unsafe-place-local-ref cell.4$2)))))
- f_19
- (lambda ()
- (begin
- (unsafe-place-local-set! cell.4$2 (sub1 (unsafe-place-local-ref cell.4$2)))
- (end-breakable-atomic)))))
- (let-values ()
- (with-continuation-mark
- exited-key
- #f
- (call-with-continuation-prompt
- (lambda ()
- (dynamic-wind
- (lambda () (begin (start-breakable-atomic) (unsafe-place-local-set! cell.1$11 (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
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first #f parameterization-key)
- error-value->string-handler
- entered-err-string-handler)
- (let-values ()
- (with-continuation-mark
- break-enabled-key
- (make-thread-cell #f)
- (begin
- (check-for-break)
- (let-values ()
- (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_19))))))))
- (lambda ()
- (begin
- (unsafe-place-local-set! cell.1$11 #f)
- (unsafe-place-local-set! cell.2$5 #f)
- (unsafe-place-local-set! cell.3$2 #f)
- (end-breakable-atomic)))))
- lock-tag
- (lambda (t_0) (t_0))))))))))
(define-values
- (call-as-nonatomic)
- (lambda (f_17)
- (begin
- (begin
- (if (if (procedure? f_17) (procedure-arity-includes? f_17 0) #f)
- (void)
- (let-values () (raise-type-error 'call-as-nonatomic "procedure (arity 0)" f_17)))
- (if (eq? (unsafe-place-local-ref cell.1$11) (current-thread))
- (void)
- (let-values () (error 'call-as-nonatomic "not in atomic area for ~e" f_17)))
- (let-values (((paramz_2) (unsafe-place-local-ref cell.2$5))
- ((break-paramz_0) (unsafe-place-local-ref cell.3$2))
- ((extra-depth_0) (unsafe-place-local-ref cell.4$2)))
- (with-continuation-mark
- exited-key
- #t
- (call-with-parameterization
- paramz_2
- (lambda ()
- (call-with-break-parameterization
- break-paramz_0
- (lambda ()
- (dynamic-wind
- (lambda ()
- (begin
- (unsafe-place-local-set! cell.1$11 #f)
- (unsafe-place-local-set! cell.4$2 0)
- (end-breakable-atomic)
- ((letrec-values (((loop_45)
- (lambda (i_28)
- (begin
- 'loop
- (if (zero? i_28)
- (void)
- (let-values () (begin (end-breakable-atomic) (loop_45 (sub1 i_28)))))))))
- loop_45)
- extra-depth_0)))
- f_17
- (lambda ()
- (begin
- (start-breakable-atomic)
- (unsafe-place-local-set! cell.2$5 paramz_2)
- (unsafe-place-local-set! cell.3$2 break-paramz_0)
- ((letrec-values (((loop_38)
- (lambda (i_29)
- (begin
- 'loop
- (if (zero? i_29)
- (void)
- (let-values ()
- (begin (start-breakable-atomic) (loop_38 (sub1 i_29)))))))))
- loop_38)
- extra-depth_0)
- (unsafe-place-local-set! cell.4$2 extra-depth_0)
- (unsafe-place-local-set! cell.1$11 (current-thread)))))))))))))))
- (define-values (not-an-fX.1) (lambda (who_7 v_26) (begin 'not-an-fX (raise-argument-error who_7 "fixnum?" v_26))))
+ (check-fxvector)
+ (lambda (v_40)
+ (begin (if (fxvector? v_40) (void) (1/raise-argument-error 'in-fxvector* (string-append "fxvector" "?") v_40)))))
+ (define-values (not-an-fX.1) (lambda (who_14 v_41) (begin 'not-an-fX (raise-argument-error who_14 "fixnum?" v_41))))
(define-values (prop:serialize serialize? serialize-ref) (make-struct-type-property 'serialize))
(define-values
(prop:serialize-fill! serialize-fill!? serialize-fill!-ref)
@@ -3123,56 +2931,77 @@
(define-values
(prop:binding-reach-scopes binding-reach-scopes? binding-reach-scopes-ref)
(make-struct-type-property 'binding-reach-scopes))
+ (define-values
+ (prop:binding-shift-report binding-shift-report? binding-shift-report-ref)
+ (make-struct-type-property 'binding-shift-report))
(define-values
(log-performance?)
(if (environment-variables-ref (current-environment-variables) #"PLT_EXPANDER_TIMES") #t #f))
(define-values (cell.1$10) (unsafe-make-place-local #f))
- (define-values (cell.2$4) (unsafe-make-place-local (make-hasheq)))
- (define-values (performance-place-init!) (lambda () (begin (unsafe-place-local-set! cell.2$4 (make-hasheq)))))
+ (define-values (cell.2$8) (unsafe-make-place-local (make-hasheq)))
+ (define-values (performance-place-init!) (lambda () (begin (unsafe-place-local-set! cell.2$8 (make-hasheq)))))
(define-values
(struct:region
region1.1
region?
region-path
region-start
+ region-start-gc
region-start-memory
region-as-nested
+ region-as-nested-gc
region-as-nested-memory
set-region-start!
+ set-region-start-gc!
set-region-start-memory!
set-region-as-nested!
+ set-region-as-nested-gc!
set-region-as-nested-memory!)
(let-values (((struct:_0 make-_0 ?_0 -ref_0 -set!_0)
- (let-values ()
- (let-values () (make-struct-type 'region #f 5 0 #f null (current-inspector) #f '(0) #f 'region)))))
+ (make-struct-type 'region #f 7 0 #f null (current-inspector) #f '(0) #f 'region)))
(values
struct:_0
make-_0
?_0
(make-struct-field-accessor -ref_0 0 'path)
(make-struct-field-accessor -ref_0 1 'start)
- (make-struct-field-accessor -ref_0 2 'start-memory)
- (make-struct-field-accessor -ref_0 3 'as-nested)
- (make-struct-field-accessor -ref_0 4 'as-nested-memory)
+ (make-struct-field-accessor -ref_0 2 'start-gc)
+ (make-struct-field-accessor -ref_0 3 'start-memory)
+ (make-struct-field-accessor -ref_0 4 'as-nested)
+ (make-struct-field-accessor -ref_0 5 'as-nested-gc)
+ (make-struct-field-accessor -ref_0 6 'as-nested-memory)
(make-struct-field-mutator -set!_0 1 'start)
- (make-struct-field-mutator -set!_0 2 'start-memory)
- (make-struct-field-mutator -set!_0 3 'as-nested)
- (make-struct-field-mutator -set!_0 4 'as-nested-memory))))
- (define-values
- (struct:stat stat2.1 stat? stat-msecs stat-memory stat-count set-stat-msecs! set-stat-memory! set-stat-count!)
+ (make-struct-field-mutator -set!_0 2 'start-gc)
+ (make-struct-field-mutator -set!_0 3 'start-memory)
+ (make-struct-field-mutator -set!_0 4 'as-nested)
+ (make-struct-field-mutator -set!_0 5 'as-nested-gc)
+ (make-struct-field-mutator -set!_0 6 'as-nested-memory))))
+ (define-values
+ (struct:stat
+ stat2.1
+ stat?
+ stat-msecs
+ stat-msecs-gc
+ stat-memory
+ stat-count
+ set-stat-msecs!
+ set-stat-msecs-gc!
+ set-stat-memory!
+ set-stat-count!)
(let-values (((struct:_1 make-_1 ?_1 -ref_1 -set!_1)
- (let-values ()
- (let-values () (make-struct-type 'stat #f 3 0 #f null (current-inspector) #f '() #f 'stat)))))
+ (make-struct-type 'stat #f 4 0 #f null (current-inspector) #f '() #f 'stat)))
(values
struct:_1
make-_1
?_1
(make-struct-field-accessor -ref_1 0 'msecs)
- (make-struct-field-accessor -ref_1 1 'memory)
- (make-struct-field-accessor -ref_1 2 'count)
+ (make-struct-field-accessor -ref_1 1 'msecs-gc)
+ (make-struct-field-accessor -ref_1 2 'memory)
+ (make-struct-field-accessor -ref_1 3 'count)
(make-struct-field-mutator -set!_1 0 'msecs)
- (make-struct-field-mutator -set!_1 1 'memory)
- (make-struct-field-mutator -set!_1 2 'count))))
+ (make-struct-field-mutator -set!_1 1 'msecs-gc)
+ (make-struct-field-mutator -set!_1 2 'memory)
+ (make-struct-field-mutator -set!_1 3 'count))))
(define-values (stat-key) (gensym))
(define-values
(start-performance-region)
@@ -3183,7 +3012,7 @@
(cons
(region1.1
(if (unsafe-place-local-ref cell.1$10)
- ((letrec-values (((loop_46)
+ ((letrec-values (((loop_48)
(lambda (path_4 enclosing-path_0)
(begin
'loop
@@ -3193,16 +3022,18 @@
(if (if (eq? '_ (car path_4)) (pair? enclosing-path_0) #f)
(car enclosing-path_0)
(car path_4))
- (loop_46
+ (loop_48
(cdr path_4)
(if (pair? enclosing-path_0) (cdr enclosing-path_0) null))))))))
- loop_46)
+ loop_48)
path_3
(region-path (car (unsafe-place-local-ref cell.1$10))))
path_3)
(current-inexact-monotonic-milliseconds)
+ (current-gc-milliseconds)
(current-memory-use 'cumulative)
0.0
+ 0
0)
(unsafe-place-local-ref cell.1$10))))))
(define-values
@@ -3210,655 +3041,659 @@
(lambda ()
(begin
(let-values (((now_0) (current-inexact-monotonic-milliseconds)))
- (let-values (((now-memory_0) (current-memory-use 'cumulative)))
- (let-values (((r_7) (car (unsafe-place-local-ref cell.1$10))))
- (let-values ((()
- (begin
- (unsafe-place-local-set! cell.1$10 (cdr (unsafe-place-local-ref cell.1$10)))
- (values))))
- (let-values (((full-delta_0) (- now_0 (region-start r_7))))
- (let-values (((delta_0) (- full-delta_0 (region-as-nested r_7))))
- (let-values (((full-delta-memory_0) (- now-memory_0 (region-start-memory r_7))))
- (let-values (((delta-memory_0) (- full-delta-memory_0 (region-as-nested-memory r_7))))
- (begin
- ((letrec-values (((loop_47)
- (lambda (accums_0 path_5)
- (begin
- 'loop
- (let-values (((key_10) (car path_5)))
- (let-values (((accum_0)
- (let-values (((or-part_26) (hash-ref accums_0 key_10 #f)))
- (if or-part_26
- or-part_26
- (let-values (((accum_1) (make-hasheq)))
- (begin
- (hash-set! accums_0 key_10 accum_1)
- accum_1))))))
- (let-values (((s_37)
- (let-values (((or-part_29)
- (hash-ref accum_0 stat-key #f)))
- (if or-part_29
- or-part_29
- (let-values (((s_21) (stat2.1 0.0 0 0)))
- (begin
- (hash-set! accum_0 stat-key s_21)
- s_21))))))
- (begin
- (set-stat-msecs! s_37 (+ delta_0 (stat-msecs s_37)))
- (set-stat-memory! s_37 (+ delta-memory_0 (stat-memory s_37)))
- (if (null? (cdr path_5))
- (let-values () (set-stat-count! s_37 (add1 (stat-count s_37))))
- (void))
- (if (null? (cdr path_5))
- (void)
- (let-values () (loop_47 accum_0 (cdr path_5))))))))))))
- loop_47)
- (unsafe-place-local-ref cell.2$4)
- (region-path r_7))
- (if (unsafe-place-local-ref cell.1$10)
- (let-values ()
+ (let-values (((now-gc_0) (current-gc-milliseconds)))
+ (let-values (((now-memory_0) (current-memory-use 'cumulative)))
+ (let-values (((r_9) (car (unsafe-place-local-ref cell.1$10))))
+ (let-values ((()
(begin
- (set-region-as-nested!
- (car (unsafe-place-local-ref cell.1$10))
- (+ (region-as-nested (car (unsafe-place-local-ref cell.1$10))) full-delta_0))
- (set-region-as-nested-memory!
- (car (unsafe-place-local-ref cell.1$10))
- (+
- (region-as-nested-memory (car (unsafe-place-local-ref cell.1$10)))
- full-delta-memory_0))))
- (void))))))))))))))
+ (unsafe-place-local-set! cell.1$10 (cdr (unsafe-place-local-ref cell.1$10)))
+ (values))))
+ (let-values (((full-delta_0) (- now_0 (region-start r_9))))
+ (let-values (((delta_0) (- full-delta_0 (region-as-nested r_9))))
+ (let-values (((full-delta-gc_0) (- now-gc_0 (region-start-gc r_9))))
+ (let-values (((delta-gc_0) (- full-delta-gc_0 (region-as-nested-gc r_9))))
+ (let-values (((full-delta-memory_0) (- now-memory_0 (region-start-memory r_9))))
+ (let-values (((delta-memory_0) (- full-delta-memory_0 (region-as-nested-memory r_9))))
+ (begin
+ ((letrec-values (((loop_49)
+ (lambda (accums_0 path_5)
+ (begin
+ 'loop
+ (let-values (((key_10) (car path_5)))
+ (let-values (((accum_0)
+ (let-values (((or-part_46)
+ (hash-ref accums_0 key_10 #f)))
+ (if or-part_46
+ or-part_46
+ (let-values (((accum_1) (make-hasheq)))
+ (begin
+ (hash-set! accums_0 key_10 accum_1)
+ accum_1))))))
+ (let-values (((s_40)
+ (let-values (((or-part_47)
+ (hash-ref accum_0 stat-key #f)))
+ (if or-part_47
+ or-part_47
+ (let-values (((s_41) (stat2.1 0.0 0 0 0)))
+ (begin
+ (hash-set! accum_0 stat-key s_41)
+ s_41))))))
+ (begin
+ (set-stat-msecs! s_40 (+ delta_0 (stat-msecs s_40)))
+ (set-stat-msecs-gc!
+ s_40
+ (+ delta-gc_0 (stat-msecs-gc s_40)))
+ (set-stat-memory!
+ s_40
+ (+ delta-memory_0 (stat-memory s_40)))
+ (if (null? (cdr path_5))
+ (set-stat-count! s_40 (add1 (stat-count s_40)))
+ (void))
+ (if (null? (cdr path_5))
+ (void)
+ (loop_49 accum_0 (cdr path_5)))))))))))
+ loop_49)
+ (unsafe-place-local-ref cell.2$8)
+ (region-path r_9))
+ (if (unsafe-place-local-ref cell.1$10)
+ (begin
+ (set-region-as-nested!
+ (car (unsafe-place-local-ref cell.1$10))
+ (+ (region-as-nested (car (unsafe-place-local-ref cell.1$10))) full-delta_0))
+ (set-region-as-nested-gc!
+ (car (unsafe-place-local-ref cell.1$10))
+ (+ (region-as-nested-gc (car (unsafe-place-local-ref cell.1$10))) full-delta-gc_0))
+ (set-region-as-nested-memory!
+ (car (unsafe-place-local-ref cell.1$10))
+ (+
+ (region-as-nested-memory (car (unsafe-place-local-ref cell.1$10)))
+ full-delta-memory_0)))
+ (void)))))))))))))))))
(call-with-values
(lambda ()
(if log-performance?
- (let-values ()
- (void
- (plumber-add-flush!
- (current-plumber)
- (lambda (h_3)
- (let-values (((whole-len_0)
- (lambda (s_38)
+ (void
+ (plumber-add-flush!
+ (current-plumber)
+ (lambda (h_3)
+ (let-values (((whole-len_0)
+ (lambda (s_42)
+ (begin
+ 'whole-len
+ (caar
+ (let-values (((or-part_48) (regexp-match-positions '#rx"[.]" s_42)))
+ (if or-part_48 or-part_48 '(0))))))))
+ (let-values (((kb_0)
+ (lambda (b_9)
(begin
- 'whole-len
- (caar
- (let-values (((or-part_30) (regexp-match-positions '#rx"[.]" s_38)))
- (if or-part_30 or-part_30 '(0))))))))
- (let-values (((kb_0)
- (lambda (b_9)
- (begin
- 'kb
- (let-values (((s_29) (number->string (quotient b_9 1024))))
- (list->string
- (let-values (((lst_15) (reverse$1 (string->list s_29))) ((start_7) 0))
+ 'kb
+ (let-values (((s_43) (number->string (quotient b_9 1024))))
+ (list->string
+ (let-values (((l_27) (let-values (((l_28) null)) l_28)))
+ (let-values (((lst_15) (reverse$1 (string->list s_43))) ((start_12) 0))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_15)))
+ (check-list lst_15))
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-naturals start_7)))
+ (check-naturals start_12))
((letrec-values (((for-loop_11)
- (lambda (l_22 lst_16 pos_1)
+ (lambda (l_29 lst_16 pos_7)
(begin
'for-loop
(if (if (pair? lst_16) #t #f)
(let-values (((c_8) (unsafe-car lst_16))
((rest_4) (unsafe-cdr lst_16))
- ((i_30) pos_1))
- (let-values (((l_23)
- (let-values (((l_24) l_22))
- (let-values (((l_25)
- (let-values ()
- (if (if (positive?
- i_30)
- (zero?
- (modulo i_30 3))
- #f)
- (let-values ()
- (list*
- c_8
- '#\,
- l_24))
- (let-values ()
- (cons
- c_8
- l_24))))))
- (values l_25)))))
+ ((i_49) pos_7))
+ (let-values (((l_30)
+ (let-values (((l_31)
+ (if (if (positive? i_49)
+ (zero?
+ (modulo i_49 3))
+ #f)
+ (list* c_8 '#\, l_29)
+ (cons c_8 l_29))))
+ (values l_31))))
(if (not #f)
- (for-loop_11 l_23 rest_4 (+ pos_1 1))
- l_23)))
- l_22)))))
+ (for-loop_11 l_30 rest_4 (+ pos_7 1))
+ l_30)))
+ l_29)))))
for-loop_11)
- null
+ l_27
lst_15
- start_7)))))))))
- (let-values (((label-max-len_0 value-max-len_0 memory-max-len_0 count-max-len_0)
- ((letrec-values (((loop_48)
+ start_12))))))))))
+ (let-values (((stat-msecs-nongc_0)
+ (lambda (v_42) (begin 'stat-msecs-nongc (- (stat-msecs v_42) (stat-msecs-gc v_42))))))
+ (let-values (((label-max-len_0 value-max-len_0 value-gc-max-len_0 memory-max-len_0 count-max-len_0)
+ ((letrec-values (((loop_50)
(lambda (accums_1
label-len_0
value-len_0
+ value-gc-len_0
memory-len_0
count-len_0
indent_0)
(begin
'loop
- (let-values (((ht_24) accums_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_24)))
- ((letrec-values (((for-loop_12)
- (lambda (label-len_1
- value-len_1
- memory-len_1
- count-len_1
- i_31)
- (begin
- 'for-loop
- (if i_31
- (let-values (((k_8 v_27)
- (hash-iterate-key+value
- ht_24
- i_31)))
- (let-values (((label-len_2
- value-len_2
- memory-len_2
- count-len_2)
- (let-values (((label-len_3)
- label-len_1)
- ((value-len_3)
- value-len_1)
- ((memory-len_3)
- memory-len_1)
- ((count-len_3)
- count-len_1))
- (let-values (((label-len_4
- value-len_4
- memory-len_4
- count-len_4)
- (let-values ()
- (if (eq?
- k_8
- stat-key)
- (let-values ()
- (values
- label-len_3
- (max
- value-len_3
- (whole-len_0
- (format
- "~a"
- (stat-msecs
- v_27))))
- (max
- memory-len_3
- (string-length
- (format
- "~a"
- (kb_0
- (stat-memory
- v_27)))))
- (max
- count-len_3
- (string-length
- (format
- "~a"
- (stat-count
- v_27))))))
- (let-values ()
- (loop_48
- v_27
- (max
- label-len_3
- (+
- indent_0
- (string-length
- (format
- "~a"
- k_8))))
- value-len_3
- memory-len_3
- count-len_3
- (+
- 2
- indent_0)))))))
+ (let-values (((label-len_1)
+ (let-values (((label-len_2) label-len_0))
+ label-len_2))
+ ((value-len_1)
+ (let-values (((value-len_2) value-len_0))
+ value-len_2))
+ ((value-gc-len_1)
+ (let-values (((value-gc-len_2) value-gc-len_0))
+ value-gc-len_2))
+ ((memory-len_1)
+ (let-values (((memory-len_2) memory-len_0))
+ memory-len_2))
+ ((count-len_1)
+ (let-values (((count-len_2) count-len_0))
+ count-len_2)))
+ (let-values (((ht_26) accums_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash ht_26))
+ ((letrec-values (((for-loop_12)
+ (lambda (label-len_3
+ value-len_3
+ value-gc-len_3
+ memory-len_3
+ count-len_3
+ i_50)
+ (begin
+ 'for-loop
+ (if i_50
+ (let-values (((k_8 v_43)
+ (hash-iterate-key+value
+ ht_26
+ i_50)))
+ (let-values (((label-len_4
+ value-len_4
+ value-gc-len_4
+ memory-len_4
+ count-len_4)
+ (let-values (((label-len_5
+ value-len_5
+ value-gc-len_5
+ memory-len_5
+ count-len_5)
+ (if (eq?
+ k_8
+ stat-key)
+ (values
+ label-len_3
+ (max
+ value-len_3
+ (whole-len_0
+ (format
+ "~a"
+ (stat-msecs-nongc_0
+ v_43))))
+ (max
+ value-gc-len_3
+ (string-length
+ (format
+ "~a"
+ (stat-msecs-gc
+ v_43))))
+ (max
+ memory-len_3
+ (string-length
+ (format
+ "~a"
+ (kb_0
+ (stat-memory
+ v_43)))))
+ (max
+ count-len_3
+ (string-length
+ (format
+ "~a"
+ (stat-count
+ v_43)))))
+ (loop_50
+ v_43
+ (max
+ label-len_3
+ (+
+ indent_0
+ (string-length
+ (format
+ "~a"
+ k_8))))
+ value-len_3
+ value-gc-len_3
+ memory-len_3
+ count-len_3
+ (+
+ 2
+ indent_0)))))
(values
- label-len_4
- value-len_4
- memory-len_4
- count-len_4)))))
- (if (not #f)
- (for-loop_12
- label-len_2
- value-len_2
- memory-len_2
- count-len_2
- (hash-iterate-next ht_24 i_31))
- (values
- label-len_2
- value-len_2
- memory-len_2
- count-len_2))))
- (values
- label-len_1
- value-len_1
- memory-len_1
- count-len_1))))))
- for-loop_12)
- label-len_0
- value-len_0
- memory-len_0
- count-len_0
- (hash-iterate-first ht_24))))))))
- loop_48)
- (unsafe-place-local-ref cell.2$4)
+ label-len_5
+ value-len_5
+ value-gc-len_5
+ memory-len_5
+ count-len_5))))
+ (if (not #f)
+ (for-loop_12
+ label-len_4
+ value-len_4
+ value-gc-len_4
+ memory-len_4
+ count-len_4
+ (hash-iterate-next ht_26 i_50))
+ (values
+ label-len_4
+ value-len_4
+ value-gc-len_4
+ memory-len_4
+ count-len_4))))
+ (values
+ label-len_3
+ value-len_3
+ value-gc-len_3
+ memory-len_3
+ count-len_3))))))
+ for-loop_12)
+ label-len_1
+ value-len_1
+ value-gc-len_1
+ memory-len_1
+ count-len_1
+ (hash-iterate-first ht_26)))))))))
+ loop_50)
+ (unsafe-place-local-ref cell.2$8)
6
5
+ 2
4
5
2)))
(begin
- (let-values (((l_26) (current-logger)))
- (if (log-level? l_26 'error (logger-name l_26))
- (let-values ()
- (log-message
- l_26
- 'error
- (format
- "REGION ~aMSECS ~aMEMK ~aCOUNT"
- (make-string (- (+ label-max-len_0 value-max-len_0) 11) '#\space)
- (make-string (- memory-max-len_0 4) '#\space)
- (make-string (- count-max-len_0 5) '#\space))
- (current-continuation-marks)))
+ (let-values (((l_32) (current-logger)))
+ (if (log-level? l_32 'error (logger-name l_32))
+ (log-message
+ l_32
+ 'error
+ (format
+ "REGION ~aMSECS ~a+GC ~aMEMK ~aCOUNT"
+ (make-string (- (+ label-max-len_0 value-max-len_0) 11) '#\space)
+ (make-string (- value-gc-max-len_0 2) '#\space)
+ (make-string (- memory-max-len_0 4) '#\space)
+ (make-string (- count-max-len_0 5) '#\space))
+ (current-continuation-marks))
(void)))
- ((letrec-values (((loop_49)
- (lambda (name_7 accums_2 indent_1 newline?_0)
+ ((letrec-values (((loop_51)
+ (lambda (name_6 accums_2 indent_1 newline?_0)
(begin
'loop
(let-values ((()
(begin
- (if name_7
- (let-values ()
- (let-values (((v_28) (hash-ref accums_2 stat-key)))
- (let-values (((l_27) (current-logger)))
- (if (log-level? l_27 'error (logger-name l_27))
- (let-values ()
- (log-message
- l_27
- 'error
- (format
- "~a~a ~a~a ~a~a ~a~a"
- indent_1
- name_7
- (make-string
- (+
- (-
- label-max-len_0
- (string-length (format "~a" name_7))
- (string-length indent_1))
- (-
- value-max-len_0
- (whole-len_0
- (format "~a" (stat-msecs v_28)))))
- '#\space)
- (regexp-replace
- '#rx"[.](..).*"
- (format "~a00" (stat-msecs v_28))
- ".\\1")
- (make-string
- (-
- memory-max-len_0
- (string-length
- (format "~a" (kb_0 (stat-memory v_28)))))
- '#\space)
- (kb_0 (stat-memory v_28))
- (make-string
- (-
- count-max-len_0
- (string-length
- (format "~a" (stat-count v_28))))
- '#\space)
- (stat-count v_28))
- (current-continuation-marks)))
- (void)))))
+ (if name_6
+ (let-values (((v_44) (hash-ref accums_2 stat-key)))
+ (let-values (((l_33) (current-logger)))
+ (if (log-level? l_33 'error (logger-name l_33))
+ (log-message
+ l_33
+ 'error
+ (format
+ "~a~a ~a~a ~a~a ~a~a ~a~a"
+ indent_1
+ name_6
+ (make-string
+ (+
+ (-
+ label-max-len_0
+ (string-length (format "~a" name_6))
+ (string-length indent_1))
+ (-
+ value-max-len_0
+ (whole-len_0
+ (format "~a" (stat-msecs-nongc_0 v_44)))))
+ '#\space)
+ (regexp-replace
+ '#rx"[.](..).*"
+ (format "~a00" (stat-msecs-nongc_0 v_44))
+ ".\\1")
+ (make-string
+ (-
+ value-gc-max-len_0
+ (string-length
+ (format "~a" (stat-msecs-gc v_44))))
+ '#\space)
+ (format "~a" (stat-msecs-gc v_44))
+ (make-string
+ (-
+ memory-max-len_0
+ (string-length
+ (format "~a" (kb_0 (stat-memory v_44)))))
+ '#\space)
+ (kb_0 (stat-memory v_44))
+ (make-string
+ (-
+ count-max-len_0
+ (string-length (format "~a" (stat-count v_44))))
+ '#\space)
+ (stat-count v_44))
+ (current-continuation-marks))
+ (void))))
(void))
(values))))
(let-values (((keys_0)
(let-values (((temp5_0)
(reverse$1
- (let-values (((ht_25) accums_2))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash-keys ht_25)))
- ((letrec-values (((for-loop_13)
- (lambda (fold-var_4 i_32)
- (begin
- 'for-loop
- (if i_32
- (let-values (((k_9)
- (hash-iterate-key
- ht_25
- i_32)))
- (let-values (((fold-var_2)
- (let-values (((fold-var_3)
- fold-var_4))
+ (let-values (((fold-var_5)
+ (let-values (((fold-var_6) null))
+ fold-var_6)))
+ (let-values (((ht_27) accums_2))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash-keys ht_27))
+ ((letrec-values (((for-loop_13)
+ (lambda (fold-var_7
+ i_51)
+ (begin
+ 'for-loop
+ (if i_51
+ (let-values (((k_9)
+ (hash-iterate-key
+ ht_27
+ i_51)))
+ (let-values (((fold-var_8)
(if (not
(eq?
k_9
stat-key))
- (let-values (((fold-var_5)
- fold-var_3))
- (let-values (((fold-var_6)
- (let-values ()
- (cons
- (let-values ()
- k_9)
- fold-var_5))))
- (values
- fold-var_6)))
- fold-var_3))))
- (if (not #f)
- (for-loop_13
- fold-var_2
- (hash-iterate-next
- ht_25
- i_32))
- fold-var_2)))
- fold-var_4)))))
- for-loop_13)
- null
- (hash-iterate-first ht_25))))))
+ (let-values (((fold-var_9)
+ (cons
+ k_9
+ fold-var_7)))
+ (values
+ fold-var_9))
+ fold-var_7)))
+ (if (not #f)
+ (for-loop_13
+ fold-var_8
+ (hash-iterate-next
+ ht_27
+ i_51))
+ fold-var_8)))
+ fold-var_7)))))
+ for-loop_13)
+ fold-var_5
+ (hash-iterate-first ht_27)))))))
((>6_0) >)
((temp7_0)
(lambda (key_11)
- (stat-msecs
+ (stat-msecs-nongc_0
(hash-ref
(hash-ref accums_2 key_11)
stat-key)))))
(sort.1 #f temp7_0 temp5_0 >6_0))))
(begin
- (let-values (((lst_17) keys_0) ((start_8) 0))
+ (let-values (((lst_17) keys_0) ((start_13) 0))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_17)))
+ (check-list lst_17))
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-naturals start_8)))
+ (check-naturals start_13))
((letrec-values (((for-loop_14)
- (lambda (lst_18 pos_2)
+ (lambda (lst_18 pos_8)
(begin
'for-loop
(if (if (pair? lst_18) #t #f)
(let-values (((k_10) (unsafe-car lst_18))
((rest_5) (unsafe-cdr lst_18))
- ((i_33) pos_2))
+ ((i_52) pos_8))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (begin
- (if (if newline?_0
- (positive?
- i_33)
- #f)
- (let-values ()
- (let-values (((l_28)
- (current-logger)))
- (if (log-level?
- l_28
- 'error
- (logger-name
- l_28))
- (let-values ()
- (log-message
- l_28
- 'error
- ""
- (current-continuation-marks)))
- (void))))
- (void))
- (loop_49
- k_10
- (hash-ref
- accums_2
- k_10)
- (string-append
- indent_1
- " ")
- #f)))
- (values)))))
- (values)))))
+ (let-values ((()
+ (begin
+ (begin
+ (if (if newline?_0
+ (positive?
+ i_52)
+ #f)
+ (let-values (((l_34)
+ (current-logger)))
+ (if (log-level?
+ l_34
+ 'error
+ (logger-name
+ l_34))
+ (log-message
+ l_34
+ 'error
+ ""
+ (current-continuation-marks))
+ (void)))
+ (void))
+ (loop_51
+ k_10
+ (hash-ref
+ accums_2
+ k_10)
+ (string-append
+ indent_1
+ " ")
+ #f))
+ (values))))
+ (values))))
(if (not #f)
- (for-loop_14 rest_5 (+ pos_2 1))
+ (for-loop_14 rest_5 (+ pos_8 1))
(values))))
(values))))))
for-loop_14)
lst_17
- start_8)))
+ start_13)))
(void))))))))
- loop_49)
+ loop_51)
#f
- (unsafe-place-local-ref cell.2$4)
+ (unsafe-place-local-ref cell.2$8)
""
#t)))))))))
(void)))
print-values)
(define-values
(1/module-path?)
- (lambda (v_29)
+ (lambda (v_45)
(begin
'module-path?
- (let-values (((or-part_1) (if (pair? v_29) (if (eq? (car v_29) 'submod) (submodule-module-path? v_29) #f) #f)))
- (if or-part_1 or-part_1 (root-module-path? v_29))))))
+ (let-values (((or-part_49) (if (pair? v_45) (if (eq? (car v_45) 'submod) (submodule-module-path? v_45) #f) #f)))
+ (if or-part_49 or-part_49 (root-module-path? v_45))))))
(define-values
(root-module-path?)
- (lambda (v_30)
- (begin
- (let-values (((or-part_12) (path? v_30)))
- (if or-part_12
- or-part_12
- (let-values (((or-part_3) (if (string? v_30) (string-module-path? v_30) #f)))
- (if or-part_3
- or-part_3
- (let-values (((or-part_31) (if (symbol? v_30) (symbol-module-path? v_30) #f)))
- (if or-part_31
- or-part_31
- (if (pair? v_30)
- (let-values (((tmp_4) (car v_30)))
+ (lambda (v_46)
+ (begin
+ (let-values (((or-part_50) (path? v_46)))
+ (if or-part_50
+ or-part_50
+ (let-values (((or-part_51) (if (string? v_46) (string-module-path? v_46) #f)))
+ (if or-part_51
+ or-part_51
+ (let-values (((or-part_52) (if (symbol? v_46) (symbol-module-path? v_46) #f)))
+ (if or-part_52
+ or-part_52
+ (if (pair? v_46)
+ (let-values (((tmp_4) (car v_46)))
(if (equal? tmp_4 'quote)
- (let-values () (if (pair? (cdr v_30)) (if (symbol? (cadr v_30)) (null? (cddr v_30)) #f) #f))
+ (if (pair? (cdr v_46)) (if (symbol? (cadr v_46)) (null? (cddr v_46)) #f) #f)
(if (equal? tmp_4 'lib)
- (let-values () (lib-module-path? v_30))
+ (lib-module-path? v_46)
(if (equal? tmp_4 'file)
- (let-values ()
- (if (pair? (cdr v_30))
- (if (string? (cadr v_30)) (if (path-string? (cadr v_30)) (null? (cddr v_30)) #f) #f)
- #f))
- (if (equal? tmp_4 'planet)
- (let-values () (planet-module-path? v_30))
- (let-values () #f))))))
+ (if (pair? (cdr v_46))
+ (if (string? (cadr v_46)) (if (path-string? (cadr v_46)) (null? (cddr v_46)) #f) #f)
+ #f)
+ (if (equal? tmp_4 'planet) (planet-module-path? v_46) #f)))))
#f))))))))))
(define-values
(submodule-module-path?)
- (lambda (v_31)
- (begin
- (if (pair? (cdr v_31))
- (if (list? v_31)
- (if (let-values (((or-part_32) (equal? (cadr v_31) "..")))
- (if or-part_32
- or-part_32
- (let-values (((or-part_33) (equal? (cadr v_31) ".")))
- (if or-part_33 or-part_33 (root-module-path? (cadr v_31))))))
- (let-values (((lst_19) (cddr v_31)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_19)))
- ((letrec-values (((for-loop_15)
- (lambda (result_1 lst_20)
- (begin
- 'for-loop
- (if (pair? lst_20)
- (let-values (((e_7) (unsafe-car lst_20)) ((rest_6) (unsafe-cdr lst_20)))
- (let-values (((result_2)
- (let-values ()
- (let-values (((result_3)
- (let-values ()
- (let-values ()
- (let-values (((or-part_34)
- (equal? e_7 "..")))
- (if or-part_34
- or-part_34
- (symbol? e_7)))))))
- (values result_3)))))
- (if (if (not ((lambda x_9 (not result_2)) e_7)) (not #f) #f)
- (for-loop_15 result_2 rest_6)
- result_2)))
- result_1)))))
- for-loop_15)
- #t
- lst_19)))
+ (lambda (v_47)
+ (begin
+ (if (pair? (cdr v_47))
+ (if (list? v_47)
+ (if (let-values (((or-part_53) (equal? (cadr v_47) "..")))
+ (if or-part_53
+ or-part_53
+ (let-values (((or-part_54) (equal? (cadr v_47) ".")))
+ (if or-part_54 or-part_54 (root-module-path? (cadr v_47))))))
+ (let-values (((result_1) (let-values (((result_2) #t)) result_2)))
+ (let-values (((lst_19) (cddr v_47)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_19))
+ ((letrec-values (((for-loop_15)
+ (lambda (result_3 lst_20)
+ (begin
+ 'for-loop
+ (if (pair? lst_20)
+ (let-values (((e_7) (unsafe-car lst_20)) ((rest_6) (unsafe-cdr lst_20)))
+ (let-values (((result_4)
+ (let-values (((result_5)
+ (let-values (((or-part_55) (equal? e_7 "..")))
+ (if or-part_55 or-part_55 (symbol? e_7)))))
+ (values result_5))))
+ (if (if (not ((lambda x_10 (not result_4)) e_7)) (not #f) #f)
+ (for-loop_15 result_4 rest_6)
+ result_4)))
+ result_3)))))
+ for-loop_15)
+ result_1
+ lst_19))))
#f)
#f)
#f))))
(define-values
(string-module-path?)
- (lambda (v_24)
+ (lambda (v_48)
(begin
- (let-values (((v11_0) v_24) ((temp12_0) #t) ((temp13_0) #t) ((temp14_0) #t))
+ (let-values (((v11_0) v_48) ((temp12_0) #t) ((temp13_0) #t) ((temp14_0) #t))
(module-path-string?.1 temp12_0 temp14_0 #f temp13_0 v11_0)))))
(define-values
(symbol-module-path?)
- (lambda (v_32)
- (begin (let-values (((temp15_0) (symbol->string v_32))) (module-path-string?.1 #f #f #f #f temp15_0)))))
+ (lambda (v_49)
+ (begin (let-values (((temp15_0) (symbol->string v_49))) (module-path-string?.1 #f #f #f #f temp15_0)))))
(define-values
(lib-module-path?)
- (lambda (v_33)
+ (lambda (v_50)
(begin
- (if (list? v_33)
- (if (pair? (cdr v_33))
- ((letrec-values (((loop_50)
- (lambda (v_34 first?_0)
+ (if (list? v_50)
+ (if (pair? (cdr v_50))
+ ((letrec-values (((loop_52)
+ (lambda (v_51 first?_0)
(begin
'loop
- (let-values (((or-part_35) (null? v_34)))
- (if or-part_35
- or-part_35
- (if (string? (car v_34))
- (if (let-values (((temp16_0) (car v_34))
+ (let-values (((or-part_56) (null? v_51)))
+ (if or-part_56
+ or-part_56
+ (if (string? (car v_51))
+ (if (let-values (((temp16_0) (car v_51))
((first?17_0) first?_0)
((first?18_0) first?_0))
(module-path-string?.1 #f first?18_0 #f first?17_0 temp16_0))
- (loop_50 (cdr v_34) #f)
+ (loop_52 (cdr v_51) #f)
#f)
#f)))))))
- loop_50)
- (cdr v_33)
+ loop_52)
+ (cdr v_50)
#t)
#f)
#f))))
(define-values
(planet-module-path?)
- (lambda (v_35)
+ (lambda (v_52)
(begin
- (if (list? v_35)
- (let-values (((tmp_5) (length v_35)))
+ (if (list? v_52)
+ (let-values (((tmp_5) (length v_52)))
(if (equal? tmp_5 1)
- (let-values () #f)
+ #f
(if (equal? tmp_5 2)
- (let-values ()
- (let-values (((e_8) (cadr v_35)))
- (if (string? e_8)
- (let-values ()
- (let-values (((e19_0) e_8) ((temp20_0) #t) ((temp21_0) #t))
- (module-path-string?.1 #f temp21_0 temp20_0 #f e19_0)))
- (if (symbol? e_8)
- (let-values ()
- (let-values (((temp22_0) (symbol->string e_8)) ((temp23_0) #t))
- (module-path-string?.1 #f #f temp23_0 #f temp22_0)))
- (let-values () #f)))))
- (let-values ()
- (let-values (((file_0) (cadr v_35)))
- (let-values (((pkg_0) (caddr v_35)))
- (let-values (((subs_0) (cdddr v_35)))
- (if file_0
- (if (let-values (((file24_0) file_0) ((temp25_0) #t) ((temp26_0) #t))
- (module-path-string?.1 #f temp26_0 #f temp25_0 file24_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-values (((or-part_36) (null? (cddr pkg_0))))
- (if or-part_36
- or-part_36
- (let-values (((or-part_37) (planet-version-number? (caddr pkg_0))))
- (if or-part_37
- or-part_37
- (let-values (((or-part_38) (null? (cddr pkg_0))))
- (if or-part_38
- or-part_38
- (planet-version-minor-spec? (cadddr pkg_0))))))))
- #f)
+ (let-values (((e_8) (cadr v_52)))
+ (if (string? e_8)
+ (let-values (((e19_0) e_8) ((temp20_0) #t) ((temp21_0) #t))
+ (module-path-string?.1 #f temp21_0 temp20_0 #f e19_0))
+ (if (symbol? e_8)
+ (let-values (((temp22_0) (symbol->string e_8)) ((temp23_0) #t))
+ (module-path-string?.1 #f #f temp23_0 #f temp22_0))
+ #f)))
+ (let-values (((file_0) (cadr v_52)))
+ (let-values (((pkg_0) (caddr v_52)))
+ (let-values (((subs_0) (cdddr v_52)))
+ (if file_0
+ (if (let-values (((file24_0) file_0) ((temp25_0) #t) ((temp26_0) #t))
+ (module-path-string?.1 #f temp26_0 #f temp25_0 file24_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-values (((or-part_57) (null? (cddr pkg_0))))
+ (if or-part_57
+ or-part_57
+ (let-values (((or-part_58) (planet-version-number? (caddr pkg_0))))
+ (if or-part_58
+ or-part_58
+ (let-values (((or-part_59) (null? (cddr pkg_0))))
+ (if or-part_59
+ or-part_59
+ (planet-version-minor-spec? (cadddr pkg_0))))))))
#f)
#f)
#f)
+ #f)
+ (let-values (((result_6) (let-values (((result_7) #t)) result_7)))
(let-values (((lst_21) subs_0))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_21)))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_21))
((letrec-values (((for-loop_16)
- (lambda (result_4 lst_22)
+ (lambda (result_8 lst_22)
(begin
'for-loop
(if (pair? lst_22)
(let-values (((sub_0) (unsafe-car lst_22))
((rest_7) (unsafe-cdr lst_22)))
- (let-values (((result_5)
- (let-values ()
- (let-values (((result_6)
- (let-values ()
- (let-values ()
- (let-values (((sub27_0)
- sub_0))
- (module-path-string?.1
- #f
- #f
- #f
- #f
- sub27_0))))))
- (values result_6)))))
- (if (if (not ((lambda x_10 (not result_5)) sub_0))
+ (let-values (((result_9)
+ (let-values (((result_10)
+ (let-values (((sub27_0) sub_0))
+ (module-path-string?.1
+ #f
+ #f
+ #f
+ #f
+ sub27_0))))
+ (values result_10))))
+ (if (if (not ((lambda x_11 (not result_9)) sub_0))
(not #f)
#f)
- (for-loop_16 result_5 rest_7)
- result_5)))
- result_4)))))
+ (for-loop_16 result_9 rest_7)
+ result_9)))
+ result_8)))))
for-loop_16)
- #t
- lst_21)))
- #f)
+ result_6
+ lst_21))))
#f)
- #f))))))))
+ #f)
+ #f)))))))
#f))))
- (define-values (planet-version-number?) (lambda (v_36) (begin (exact-nonnegative-integer? v_36))))
+ (define-values (planet-version-number?) (lambda (v_53) (begin (exact-nonnegative-integer? v_53))))
(define-values
(planet-version-minor-spec?)
- (lambda (v_37)
- (begin
- (let-values (((or-part_39) (planet-version-number? v_37)))
- (if or-part_39
- or-part_39
- (if (pair? v_37)
- (if (list? v_37)
- (if (= 2 (length v_37))
- (let-values (((tmp_6) (car v_37)))
+ (lambda (v_54)
+ (begin
+ (let-values (((or-part_60) (planet-version-number? v_54)))
+ (if or-part_60
+ or-part_60
+ (if (pair? v_54)
+ (if (list? v_54)
+ (if (= 2 (length v_54))
+ (let-values (((tmp_6) (car v_54)))
(if (if (equal? tmp_6 '=) #t (if (equal? tmp_6 '+) #t (equal? tmp_6 '-)))
- (let-values () (planet-version-number? (cadr v_37)))
- (let-values () (if (planet-version-number? (car v_37)) (planet-version-number? (cadr v_37)) #f))))
+ (planet-version-number? (cadr v_54))
+ (if (planet-version-number? (car v_54)) (planet-version-number? (cadr v_54)) #f)))
#f)
#f)
#f))))))
@@ -3867,220 +3702,162 @@
(lambda (dots-dir-ok?2_0 file-end-ok?4_0 for-planet?1_0 just-file-ok?3_0 v9_0)
(begin
'module-path-string?
- (let-values (((v_38) v9_0))
+ (let-values (((v_55) v9_0))
(let-values (((for-planet?_0) for-planet?1_0))
(let-values (((dots-dir-ok?_0) dots-dir-ok?2_0))
(let-values (((just-file-ok?_0) just-file-ok?3_0))
(let-values (((file-end-ok?_0) file-end-ok?4_0))
- (let-values ()
- (let-values (((len_3) (string-length v_38)))
- (if (positive? len_3)
- (if (not (char=? '#\/ (string-ref v_38 0)))
- (if (not (char=? '#\/ (string-ref v_38 (sub1 len_3))))
- (let-values (((start-package-version-pos_0 end-package-version-pos_0)
- (if for-planet?_0 (check-planet-part v_38 len_3) (values 0 0))))
- (if start-package-version-pos_0
- ((letrec-values (((loop_51)
- (lambda (i_34 prev-was-slash?_0 saw-slash?_0 saw-dot?_0)
- (begin
- 'loop
- (if (not (negative? i_34))
- (let-values ()
- (let-values (((c_9) (string-ref v_38 i_34)))
- (if (char=? c_9 '#\/)
- (let-values ()
- (if (not prev-was-slash?_0)
- (loop_51 (sub1 i_34) #t #t saw-dot?_0)
- #f))
- (if (char=? c_9 '#\.)
- (let-values ()
- (if (if (< (add1 i_34) len_3)
- (if (not
- (char=? (string-ref v_38 (add1 i_34)) '#\/))
- (not
- (char=? (string-ref v_38 (add1 i_34)) '#\.))
- #f)
- #f)
- (if (not saw-slash?_0)
- (loop_51 (sub1 i_34) #f saw-slash?_0 #t)
- #f)
- (loop_51 (sub1 i_34) #f saw-slash?_0 saw-dot?_0)))
- (if (let-values (((or-part_40) (plain-char? c_9)))
- (if or-part_40
- or-part_40
- (if (char=? c_9 '#\%)
- (if (< (+ i_34 2) len_3)
- (hex-sequence? v_38 (add1 i_34))
- #f)
- #f)))
- (let-values ()
- (loop_51 (sub1 i_34) #f saw-slash?_0 saw-dot?_0))
- (if (if (>= i_34 start-package-version-pos_0)
- (< i_34 end-package-version-pos_0)
+ (let-values (((len_3) (string-length v_55)))
+ (if (positive? len_3)
+ (if (not (char=? '#\/ (string-ref v_55 0)))
+ (if (not (char=? '#\/ (string-ref v_55 (sub1 len_3))))
+ (let-values (((start-package-version-pos_0 end-package-version-pos_0)
+ (if for-planet?_0 (check-planet-part v_55 len_3) (values 0 0))))
+ (if start-package-version-pos_0
+ ((letrec-values (((loop_53)
+ (lambda (i_53 prev-was-slash?_0 saw-slash?_0 saw-dot?_0)
+ (begin
+ 'loop
+ (if (not (negative? i_53))
+ (let-values (((c_9) (string-ref v_55 i_53)))
+ (if (char=? c_9 '#\/)
+ (if (not prev-was-slash?_0)
+ (loop_53 (sub1 i_53) #t #t saw-dot?_0)
+ #f)
+ (if (char=? c_9 '#\.)
+ (if (if dots-dir-ok?_0
+ (let-values (((post-c_0)
+ (if (< (add1 i_53) len_3)
+ (if (char=?
+ (string-ref v_55 (add1 i_53))
+ '#\/)
+ 0
+ (if (char=?
+ (string-ref v_55 (add1 i_53))
+ '#\.)
+ 1
+ 2))
+ 0))
+ ((pre-c_0)
+ (if (> i_53 0)
+ (if (char=?
+ (string-ref v_55 (sub1 i_53))
+ '#\/)
+ 0
+ (if (char=?
+ (string-ref v_55 (sub1 i_53))
+ '#\.)
+ 1
+ 2))
+ 0)))
+ (<= (+ post-c_0 pre-c_0) 1))
+ #f)
+ (loop_53 (sub1 i_53) #f saw-slash?_0 saw-dot?_0)
+ (if (not saw-slash?_0)
+ (loop_53 (sub1 i_53) #f saw-slash?_0 #t)
+ #f))
+ (if (let-values (((or-part_61) (plain-char? c_9)))
+ (if or-part_61
+ or-part_61
+ (if (char=? c_9 '#\%)
+ (if (< (+ i_53 2) len_3)
+ (hex-sequence? v_55 (add1 i_53))
#f)
- (let-values ()
- (loop_51 (sub1 i_34) #f saw-slash?_0 saw-dot?_0))
- (let-values () #f)))))))
- (let-values ()
- (if (not
- (if (not just-file-ok?_0)
- (if saw-dot?_0 (not saw-slash?_0) #f)
- #f))
- (let-values (((or-part_41) dots-dir-ok?_0))
- (if or-part_41
- or-part_41
- ((letrec-values (((loop_40)
- (lambda (i_35)
- (begin
- 'loop
- (if (= i_35 len_3)
- (let-values () #t)
- (if (char=?
- (string-ref v_38 i_35)
- '#\.)
- (let-values ()
- (if (not
- (let-values (((or-part_42)
- (=
- len_3
- (add1
- i_35))))
- (if or-part_42
- or-part_42
- (char=?
- (string-ref
- v_38
- (add1 i_35))
- '#\/))))
- (if (not
- (if (char=?
- (string-ref
- v_38
- (add1 i_35))
- '#\.)
- (let-values (((or-part_30)
- (=
- len_3
- (+
- i_35
- 2))))
- (if or-part_30
- or-part_30
- (char=?
- (string-ref
- v_38
- (+ i_35 2))
- '#\/)))
- #f))
- (loop_40
- ((letrec-values (((loop_52)
- (lambda (i_36)
- (begin
- 'loop
- (if (char=?
- '#\.
- (string-ref
- v_38
- i_36))
- (loop_52
- (add1
- i_36))
- i_36)))))
- loop_52)
- i_35))
- #f)
- #f))
- (let-values ()
- (loop_40 (add1 i_35)))))))))
- loop_40)
- 0)))
- #f)))))))
- loop_51)
- (sub1 len_3)
- #f
- (not file-end-ok?_0)
- #f)
- #f))
- #f)
+ #f)))
+ (loop_53 (sub1 i_53) #f saw-slash?_0 saw-dot?_0)
+ (if (if (>= i_53 start-package-version-pos_0)
+ (< i_53 end-package-version-pos_0)
+ #f)
+ (loop_53 (sub1 i_53) #f saw-slash?_0 saw-dot?_0)
+ #f)))))
+ (let-values (((or-part_62) just-file-ok?_0))
+ (if or-part_62
+ or-part_62
+ (not (if saw-dot?_0 (not saw-slash?_0) #f)))))))))
+ loop_53)
+ (sub1 len_3)
+ #f
+ (not file-end-ok?_0)
+ #f)
+ #f))
#f)
- #f)))))))))))
+ #f)
+ #f))))))))))
(define-values
(planet-user/pkg-string?)
- (lambda (v_39)
+ (lambda (v_56)
(begin
- (if (string? v_39)
- (let-values (((len_4) (string-length v_39)))
+ (if (string? v_56)
+ (let-values (((len_4) (string-length v_56)))
(if (positive? len_4)
- (let-values (((vec_12 len_5)
- (let-values (((vec_13) v_39))
- (begin (check-string vec_13) (values vec_13 (unsafe-string-length vec_13)))))
- ((start_9) 0))
- (begin
- #f
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-naturals start_9)))
- ((letrec-values (((for-loop_17)
- (lambda (result_7 pos_3 pos_4)
- (begin
- 'for-loop
- (if (if (unsafe-fx< pos_3 len_5) #t #f)
- (let-values (((c_10) (string-ref vec_12 pos_3)) ((i_37) pos_4))
- (let-values (((result_8)
- (let-values ()
- (let-values (((result_9)
- (let-values ()
- (let-values ()
- (let-values (((or-part_43)
- (plain-char? c_10)))
- (if or-part_43
- or-part_43
- (let-values (((or-part_44)
- (char=? '#\. c_10)))
- (if or-part_44
- or-part_44
- (if (char=? '#\% c_10)
- (if (< i_37 (- len_4 2))
- (hex-sequence? v_39 (add1 i_37))
- #f)
- #f)))))))))
- (values result_9)))))
- (if (if (not ((lambda x_11 (not result_8)) c_10))
- (if (not ((lambda x_12 (not result_8)) i_37)) (not #f) #f)
- #f)
- (for-loop_17 result_8 (unsafe-fx+ 1 pos_3) (+ pos_4 1))
- result_8)))
- result_7)))))
- for-loop_17)
- #t
- 0
- start_9)))
+ (let-values (((result_11) (let-values (((result_12) #t)) result_12)))
+ (let-values (((vec_12 len_5)
+ (let-values (((vec_13) v_56))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-string vec_13))
+ (values vec_13 (unsafe-string-length vec_13)))))
+ ((start_14) 0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-naturals start_14))
+ ((letrec-values (((for-loop_17)
+ (lambda (result_13 pos_9 pos_10)
+ (begin
+ 'for-loop
+ (if (if (unsafe-fx< pos_9 len_5) #t #f)
+ (let-values (((c_10) (string-ref vec_12 pos_9)) ((i_54) pos_10))
+ (let-values (((result_14)
+ (let-values (((result_15)
+ (let-values (((or-part_63) (plain-char? c_10)))
+ (if or-part_63
+ or-part_63
+ (let-values (((or-part_64)
+ (char=? '#\. c_10)))
+ (if or-part_64
+ or-part_64
+ (if (char=? '#\% c_10)
+ (if (< i_54 (- len_4 2))
+ (hex-sequence? v_56 (add1 i_54))
+ #f)
+ #f)))))))
+ (values result_15))))
+ (if (if (not ((lambda x_12 (not result_14)) c_10))
+ (if (not ((lambda x_13 (not result_14)) i_54)) (not #f) #f)
+ #f)
+ (for-loop_17 result_14 (unsafe-fx+ 1 pos_9) (+ pos_10 1))
+ result_14)))
+ result_13)))))
+ for-loop_17)
+ result_11
+ 0
+ start_14))))
#f))
#f))))
(define-values
(plain-char?)
(lambda (c_11)
(begin
- (let-values (((or-part_45) (char<=? '#\a c_11 '#\z)))
- (if or-part_45
- or-part_45
- (let-values (((or-part_46) (char<=? '#\A c_11 '#\Z)))
- (if or-part_46
- or-part_46
- (let-values (((or-part_47) (char<=? '#\0 c_11 '#\9)))
- (if or-part_47
- or-part_47
- (let-values (((or-part_48) (char=? '#\- c_11)))
- (if or-part_48
- or-part_48
- (let-values (((or-part_49) (char=? '#\_ c_11)))
- (if or-part_49 or-part_49 (char=? '#\+ c_11))))))))))))))
+ (let-values (((or-part_65) (char<=? '#\a c_11 '#\z)))
+ (if or-part_65
+ or-part_65
+ (let-values (((or-part_66) (char<=? '#\A c_11 '#\Z)))
+ (if or-part_66
+ or-part_66
+ (let-values (((or-part_67) (char<=? '#\0 c_11 '#\9)))
+ (if or-part_67
+ or-part_67
+ (let-values (((or-part_68) (char=? '#\- c_11)))
+ (if or-part_68
+ or-part_68
+ (let-values (((or-part_69) (char=? '#\_ c_11)))
+ (if or-part_69 or-part_69 (char=? '#\+ c_11))))))))))))))
(define-values
(hex-sequence?)
- (lambda (s_39 i_38)
+ (lambda (s_44 i_55)
(begin
- (let-values (((c1_16) (string-ref s_39 i_38)))
- (let-values (((c2_0) (string-ref s_39 (add1 i_38))))
+ (let-values (((c1_16) (string-ref s_44 i_55)))
+ (let-values (((c2_0) (string-ref s_44 (add1 i_55))))
(if (hex-char? c1_16)
(if (hex-char? c2_0)
(let-values (((c_12) (integer->char (+ (* (hex-char->integer c1_16) 16) (hex-char->integer c2_0)))))
@@ -4090,22 +3867,22 @@
(define-values
(hex-char?)
(lambda (c_13)
- (begin (let-values (((or-part_50) (char<=? '#\a c_13 '#\f))) (if or-part_50 or-part_50 (char<=? '#\0 c_13 '#\9))))))
+ (begin (let-values (((or-part_70) (char<=? '#\a c_13 '#\f))) (if or-part_70 or-part_70 (char<=? '#\0 c_13 '#\9))))))
(define-values
(hex-char->integer)
(lambda (c_14)
(begin
(if (char<=? '#\a c_14 '#\f)
- (let-values () (- (char->integer c_14) (+ 10 (char->integer '#\a))))
+ (- (char->integer c_14) (+ 10 (char->integer '#\a)))
(if (char<=? '#\A c_14 '#\F)
- (let-values () (- (char->integer c_14) (+ 10 (char->integer '#\A))))
- (let-values () (- (char->integer c_14) (char->integer '#\0))))))))
+ (- (char->integer c_14) (+ 10 (char->integer '#\A)))
+ (- (char->integer c_14) (char->integer '#\0)))))))
(define-values
(check-planet-part)
- (lambda (v_40 len_6)
+ (lambda (v_57 len_6)
(begin
(let-values (((start-package-version-pos_1 end-package-version-pos_1 colon1-pos_0 colon2-pos_0)
- ((letrec-values (((loop_53)
+ ((letrec-values (((loop_54)
(lambda (j_2
start-package-version-pos_2
end-package-version-pos_2
@@ -4114,54 +3891,47 @@
(begin
'loop
(if (= j_2 len_6)
- (let-values ()
- (values
- start-package-version-pos_2
- (let-values (((or-part_51) end-package-version-pos_2))
- (if or-part_51 or-part_51 j_2))
- colon1-pos_1
- colon2-pos_1))
- (let-values ()
- (let-values (((tmp_7) (string-ref v_40 j_2)))
- (if (equal? tmp_7 '#\/)
- (let-values ()
- (loop_53
- (add1 j_2)
- (let-values (((or-part_52) start-package-version-pos_2))
- (if or-part_52 or-part_52 (add1 j_2)))
- (if start-package-version-pos_2
- (let-values (((or-part_53) end-package-version-pos_2))
- (if or-part_53 or-part_53 j_2))
- #f)
- colon1-pos_1
- colon2-pos_1))
- (if (equal? tmp_7 '#\:)
- (let-values ()
- (if colon2-pos_1
- (let-values () (values #f #f #f #f))
- (if colon1-pos_1
- (let-values ()
- (loop_53
- (add1 j_2)
- start-package-version-pos_2
- end-package-version-pos_2
- colon1-pos_1
- j_2))
- (let-values ()
- (loop_53
- (add1 j_2)
- start-package-version-pos_2
- end-package-version-pos_2
- j_2
- #f)))))
- (let-values ()
- (loop_53
+ (values
+ start-package-version-pos_2
+ (let-values (((or-part_71) end-package-version-pos_2))
+ (if or-part_71 or-part_71 j_2))
+ colon1-pos_1
+ colon2-pos_1)
+ (let-values (((tmp_7) (string-ref v_57 j_2)))
+ (if (equal? tmp_7 '#\/)
+ (loop_54
+ (add1 j_2)
+ (let-values (((or-part_72) start-package-version-pos_2))
+ (if or-part_72 or-part_72 (add1 j_2)))
+ (if start-package-version-pos_2
+ (let-values (((or-part_73) end-package-version-pos_2))
+ (if or-part_73 or-part_73 j_2))
+ #f)
+ colon1-pos_1
+ colon2-pos_1)
+ (if (equal? tmp_7 '#\:)
+ (if colon2-pos_1
+ (values #f #f #f #f)
+ (if colon1-pos_1
+ (loop_54
(add1 j_2)
start-package-version-pos_2
end-package-version-pos_2
colon1-pos_1
- colon2-pos_1)))))))))))
- loop_53)
+ j_2)
+ (loop_54
+ (add1 j_2)
+ start-package-version-pos_2
+ end-package-version-pos_2
+ j_2
+ #f)))
+ (loop_54
+ (add1 j_2)
+ start-package-version-pos_2
+ end-package-version-pos_2
+ colon1-pos_1
+ colon2-pos_1)))))))))
+ loop_54)
0
#f
#f
@@ -4169,172 +3939,149 @@
#f)))
(if (if start-package-version-pos_1
(if (> end-package-version-pos_1 start-package-version-pos_1)
- (let-values (((or-part_54) (not colon2-pos_0)))
- (if or-part_54 or-part_54 (< (add1 colon2-pos_0) end-package-version-pos_1)))
+ (let-values (((or-part_74) (not colon2-pos_0)))
+ (if or-part_74 or-part_74 (< (add1 colon2-pos_0) end-package-version-pos_1)))
#f)
#f)
- (let-values ()
- (if colon1-pos_0
- (let-values ()
- (let-values (((colon1-end_0)
- (let-values (((or-part_55) colon2-pos_0))
- (if or-part_55 or-part_55 end-package-version-pos_1))))
- (if (if (integer-sequence? v_40 (add1 colon1-pos_0) colon1-end_0)
- (let-values (((or-part_56) (not colon2-pos_0)))
- (if or-part_56
- or-part_56
- (let-values (((tmp_8) (string-ref v_40 (add1 colon2-pos_0))))
- (if (equal? tmp_8 '#\=)
- (let-values () (integer-sequence? v_40 (+ 2 colon2-pos_0) end-package-version-pos_1))
- (if (if (equal? tmp_8 '#\>) #t (equal? tmp_8 '#\<))
- (let-values ()
- (if (if (< (+ 2 colon2-pos_0) end-package-version-pos_1)
- (char=? '#\= (string-ref v_40 (+ colon2-pos_0 2)))
- #f)
- (let-values ()
- (integer-sequence? v_40 (+ 3 colon2-pos_0) end-package-version-pos_1))
- (let-values ()
- (integer-sequence? v_40 (+ 2 colon2-pos_0) end-package-version-pos_1))))
- (let-values ()
- (integer-range-sequence? v_40 (add1 colon2-pos_0) end-package-version-pos_1)))))))
- #f)
- (let-values () (values colon1-pos_0 end-package-version-pos_1))
- (let-values () (values #f #f)))))
- (let-values () (values 0 0))))
- (let-values () (values #f #f)))))))
+ (if colon1-pos_0
+ (let-values (((colon1-end_0)
+ (let-values (((or-part_75) colon2-pos_0))
+ (if or-part_75 or-part_75 end-package-version-pos_1))))
+ (if (if (integer-sequence? v_57 (add1 colon1-pos_0) colon1-end_0)
+ (let-values (((or-part_76) (not colon2-pos_0)))
+ (if or-part_76
+ or-part_76
+ (let-values (((tmp_8) (string-ref v_57 (add1 colon2-pos_0))))
+ (if (equal? tmp_8 '#\=)
+ (integer-sequence? v_57 (+ 2 colon2-pos_0) end-package-version-pos_1)
+ (if (if (equal? tmp_8 '#\>) #t (equal? tmp_8 '#\<))
+ (if (if (< (+ 2 colon2-pos_0) end-package-version-pos_1)
+ (char=? '#\= (string-ref v_57 (+ colon2-pos_0 2)))
+ #f)
+ (integer-sequence? v_57 (+ 3 colon2-pos_0) end-package-version-pos_1)
+ (integer-sequence? v_57 (+ 2 colon2-pos_0) end-package-version-pos_1))
+ (integer-range-sequence? v_57 (add1 colon2-pos_0) end-package-version-pos_1))))))
+ #f)
+ (values colon1-pos_0 end-package-version-pos_1)
+ (values #f #f)))
+ (values 0 0))
+ (values #f #f))))))
(define-values
(integer-sequence?)
- (lambda (s_40 start_10 end_4)
+ (lambda (s_45 start_15 end_4)
(begin
- (if (< start_10 end_4)
- (let-values (((start_11) start_10) ((end_5) end_4) ((inc_0) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_11 end_5 inc_0)))
- ((letrec-values (((for-loop_18)
- (lambda (result_10 pos_5)
- (begin
- 'for-loop
- (if (< pos_5 end_5)
- (let-values (((i_39) pos_5))
- (let-values (((result_11)
- (let-values ()
- (let-values (((result_12)
- (let-values ()
- (let-values ()
- (char<=? '#\0 (string-ref s_40 i_39) '#\9)))))
- (values result_12)))))
- (if (if (not ((lambda x_13 (not result_11)) i_39)) (not #f) #f)
- (for-loop_18 result_11 (+ pos_5 inc_0))
- result_11)))
- result_10)))))
- for-loop_18)
- #t
- start_11)))
+ (if (< start_15 end_4)
+ (let-values (((result_16) (let-values (((result_17) #t)) result_17)))
+ (let-values (((start_16) start_15) ((end_5) end_4) ((inc_0) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-range start_16 end_5 inc_0))
+ ((letrec-values (((for-loop_18)
+ (lambda (result_18 pos_11)
+ (begin
+ 'for-loop
+ (if (< pos_11 end_5)
+ (let-values (((i_56) pos_11))
+ (let-values (((result_19)
+ (let-values (((result_20)
+ (char<=? '#\0 (string-ref s_45 i_56) '#\9)))
+ (values result_20))))
+ (if (if (not ((lambda x_14 (not result_19)) i_56)) (not #f) #f)
+ (for-loop_18 result_19 (+ pos_11 inc_0))
+ result_19)))
+ result_18)))))
+ for-loop_18)
+ result_16
+ start_16))))
#f))))
(define-values
(integer-range-sequence?)
- (lambda (s_41 start_12 end_6)
+ (lambda (s_46 start_17 end_6)
(begin
- (if (< start_12 end_6)
- (if (let-values (((start_13) start_12) ((end_7) end_6) ((inc_1) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_13 end_7 inc_1)))
- ((letrec-values (((for-loop_19)
- (lambda (result_13 pos_6)
- (begin
- 'for-loop
- (if (< pos_6 end_7)
- (let-values (((i_40) pos_6))
- (let-values (((result_14)
- (let-values ()
- (let-values (((result_15)
- (let-values ()
- (let-values ()
- (let-values (((c_15)
- (string-ref s_41 i_40)))
- (let-values (((or-part_57)
- (char=? c_15 '#\-)))
- (if or-part_57
- or-part_57
- (char<=? '#\0 c_15 '#\9))))))))
- (values result_15)))))
- (if (if (not ((lambda x_1 (not result_14)) i_40)) (not #f) #f)
- (for-loop_19 result_14 (+ pos_6 inc_1))
- result_14)))
- result_13)))))
- for-loop_19)
- #t
- start_13)))
+ (if (< start_17 end_6)
+ (if (let-values (((result_21) (let-values (((result_22) #t)) result_22)))
+ (let-values (((start_18) start_17) ((end_7) end_6) ((inc_1) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_18 end_7 inc_1))
+ ((letrec-values (((for-loop_19)
+ (lambda (result_23 pos_12)
+ (begin
+ 'for-loop
+ (if (< pos_12 end_7)
+ (let-values (((i_57) pos_12))
+ (let-values (((result_24)
+ (let-values (((result_25)
+ (let-values (((c_15) (string-ref s_46 i_57)))
+ (let-values (((or-part_77)
+ (char=? c_15 '#\-)))
+ (if or-part_77
+ or-part_77
+ (char<=? '#\0 c_15 '#\9))))))
+ (values result_25))))
+ (if (if (not ((lambda x_15 (not result_24)) i_57)) (not #f) #f)
+ (for-loop_19 result_24 (+ pos_12 inc_1))
+ result_24)))
+ result_23)))))
+ for-loop_19)
+ result_21
+ start_18))))
(>=
1
- (let-values (((start_14) start_12) ((end_8) end_6) ((inc_2) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_14 end_8 inc_2)))
- ((letrec-values (((for-loop_20)
- (lambda (result_16 pos_7)
- (begin
- 'for-loop
- (if (< pos_7 end_8)
- (let-values (((i_41) pos_7))
- (let-values (((result_17)
- (let-values (((result_18) result_16))
- (let-values (((result_19)
- (let-values ()
- (+
- result_18
- (let-values ()
- (if (char=? (string-ref s_41 i_41) '#\-)
- 1
- 0))))))
- (values result_19)))))
- (if (not #f) (for-loop_20 result_17 (+ pos_7 inc_2)) result_17)))
- result_16)))))
- for-loop_20)
- 0
- start_14))))
+ (let-values (((result_26) (let-values (((result_27) 0)) result_27)))
+ (let-values (((start_19) start_17) ((end_8) end_6) ((inc_2) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-range start_19 end_8 inc_2))
+ ((letrec-values (((for-loop_20)
+ (lambda (result_28 pos_13)
+ (begin
+ 'for-loop
+ (if (< pos_13 end_8)
+ (let-values (((i_58) pos_13))
+ (let-values (((result_29)
+ (let-values (((result_30)
+ (+
+ result_28
+ (if (char=? (string-ref s_46 i_58) '#\-) 1 0))))
+ (values result_30))))
+ (if (not #f) (for-loop_20 result_29 (+ pos_13 inc_2)) result_29)))
+ result_28)))))
+ for-loop_20)
+ result_26
+ start_19)))))
#f)
#f))))
(define-values
(struct:weak-intern-table weak-intern-table1.1 weak-intern-table? weak-intern-table-box)
(let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'weak-intern-table
- #f
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'weak-intern-table)))))
+ (make-struct-type
+ 'weak-intern-table
+ #f
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'weak-intern-table)))
(values struct:_2 make-_2 ?_2 (make-struct-field-accessor -ref_2 0 'box))))
(define-values
(struct:table table2.1 table? table-ht table-count table-prune-at)
(let-values (((struct:_3 make-_3 ?_3 -ref_3 -set!_3)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'table
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'table)))))
+ (make-struct-type
+ 'table
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'table)))
(values
struct:_3
make-_3
@@ -4345,360 +4092,329 @@
(define-values (make-weak-intern-table) (lambda () (begin (weak-intern-table1.1 (box (table2.1 (hasheqv) 0 128))))))
(define-values
(weak-intern!)
- (lambda (tt_0 v_2)
+ (lambda (tt_0 v_58)
(begin
(let-values (((b_10) (weak-intern-table-box tt_0)))
- (let-values (((t_1) (unbox b_10)))
- (let-values (((code_0) (equal-hash-code v_2)))
- (let-values (((vals_0) (hash-ref (table-ht t_1) code_0 null)))
- (let-values (((or-part_58)
- (let-values (((lst_23) vals_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_23)))
- ((letrec-values (((for-loop_21)
- (lambda (result_20 lst_24)
- (begin
- 'for-loop
- (if (pair? lst_24)
- (let-values (((b_11) (unsafe-car lst_24))
- ((rest_8) (unsafe-cdr lst_24)))
- (let-values (((result_21)
- (let-values ()
- (let-values (((result_22)
- (let-values ()
- (let-values ()
- (let-values (((bv_0)
- (weak-box-value
- b_11)))
- (if (equal? bv_0 v_2)
- bv_0
- #f))))))
- (values result_22)))))
- (if (if (not ((lambda x_14 result_21) b_11)) (not #f) #f)
- (for-loop_21 result_21 rest_8)
- result_21)))
- result_20)))))
- for-loop_21)
- #f
- lst_23)))))
- (if or-part_58
- or-part_58
- (let-values (((pruned-t_0) (if (= (table-count t_1) (table-prune-at t_1)) (prune-table t_1) t_1)))
- (let-values (((ht_26) (table-ht pruned-t_0)))
+ (let-values (((t_0) (unbox b_10)))
+ (let-values (((code_0) (equal-hash-code v_58)))
+ (let-values (((vals_0) (hash-ref (table-ht t_0) code_0 null)))
+ (let-values (((or-part_78)
+ (let-values (((result_31) (let-values (((result_32) #f)) result_32)))
+ (let-values (((lst_23) vals_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_23))
+ ((letrec-values (((for-loop_21)
+ (lambda (result_33 lst_24)
+ (begin
+ 'for-loop
+ (if (pair? lst_24)
+ (let-values (((b_11) (unsafe-car lst_24))
+ ((rest_8) (unsafe-cdr lst_24)))
+ (let-values (((result_34)
+ (let-values (((result_35)
+ (let-values (((bv_0)
+ (weak-box-value
+ b_11)))
+ (if (equal? bv_0 v_58)
+ bv_0
+ #f))))
+ (values result_35))))
+ (if (if (not ((lambda x_16 result_34) b_11)) (not #f) #f)
+ (for-loop_21 result_34 rest_8)
+ result_34)))
+ result_33)))))
+ for-loop_21)
+ result_31
+ lst_23))))))
+ (if or-part_78
+ or-part_78
+ (let-values (((pruned-t_0) (if (= (table-count t_0) (table-prune-at t_0)) (prune-table t_0) t_0)))
+ (let-values (((ht_28) (table-ht pruned-t_0)))
(let-values (((new-t_0)
(table2.1
- (hash-set ht_26 code_0 (cons (make-weak-box v_2) (hash-ref ht_26 code_0 null)))
+ (hash-set ht_28 code_0 (cons (make-weak-box v_58) (hash-ref ht_28 code_0 null)))
(add1 (table-count pruned-t_0))
(table-prune-at pruned-t_0))))
- (let-values (((or-part_35) (if (box-cas! b_10 t_1 new-t_0) v_2 #f)))
- (if or-part_35 or-part_35 (weak-intern! tt_0 v_2)))))))))))))))
+ (let-values (((or-part_79) (if (box-cas! b_10 t_0 new-t_0) v_58 #f)))
+ (if or-part_79 or-part_79 (weak-intern! tt_0 v_58)))))))))))))))
(define-values
(prune-table)
- (lambda (t_2)
+ (lambda (t_1)
(begin
(let-values (((new-ht_0)
- (let-values (((ht_27) (table-ht t_2)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_27)))
- ((letrec-values (((for-loop_22)
- (lambda (table_10 i_42)
- (begin
- 'for-loop
- (if i_42
- (let-values (((k_11 vals_1) (hash-iterate-key+value ht_27 i_42)))
- (let-values (((table_11)
- (let-values (((table_12) table_10))
+ (let-values (((table_12) (let-values (((table_13) '#hash())) table_13)))
+ (let-values (((ht_29) (table-ht t_1)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_29))
+ ((letrec-values (((for-loop_22)
+ (lambda (table_14 i_59)
+ (begin
+ 'for-loop
+ (if i_59
+ (let-values (((k_11 vals_1) (hash-iterate-key+value ht_29 i_59)))
+ (let-values (((table_15)
(let-values (((id*_0)
(reverse$1
- (let-values (((lst_25) vals_1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_25)))
- ((letrec-values (((for-loop_23)
- (lambda (fold-var_7
- lst_26)
- (begin
- 'for-loop
- (if (pair?
- lst_26)
- (let-values (((b_12)
- (unsafe-car
- lst_26))
- ((rest_9)
- (unsafe-cdr
- lst_26)))
- (let-values (((fold-var_8)
- (let-values (((fold-var_9)
- fold-var_7))
+ (let-values (((fold-var_10)
+ (let-values (((fold-var_11)
+ null))
+ fold-var_11)))
+ (let-values (((lst_25) vals_1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_25))
+ ((letrec-values (((for-loop_23)
+ (lambda (fold-var_12
+ lst_26)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_26)
+ (let-values (((b_12)
+ (unsafe-car
+ lst_26))
+ ((rest_9)
+ (unsafe-cdr
+ lst_26)))
+ (let-values (((fold-var_13)
(if (weak-box-value
b_12)
- (let-values (((fold-var_10)
- fold-var_9))
- (let-values (((fold-var_11)
- (let-values ()
- (cons
- (let-values ()
- b_12)
- fold-var_10))))
- (values
- fold-var_11)))
- fold-var_9))))
- (if (not
- #f)
- (for-loop_23
- fold-var_8
- rest_9)
- fold-var_8)))
- fold-var_7)))))
- for-loop_23)
- null
- lst_25))))))
- (begin
- #t
- ((letrec-values (((for-loop_24)
- (lambda (table_13)
- (begin
- 'for-loop
- (let-values (((new-vals_0)
- id*_0))
- (let-values (((table_14)
- (let-values (((table_15)
- table_13))
- (let-values (((table_16)
- table_15))
- (if (pair?
- new-vals_0)
- (let-values (((table_0)
- table_16))
- (let-values (((table_17)
- (let-values ()
- (let-values (((key_12
- val_2)
- (let-values ()
- (values
- k_11
- new-vals_0))))
- (hash-set
- table_0
- key_12
- val_2)))))
- (values
- table_17)))
- table_16)))))
- table_14))))))
- for-loop_24)
- table_12))))))
- (if (not #f)
- (for-loop_22 table_11 (hash-iterate-next ht_27 i_42))
- table_11)))
- table_10)))))
- for-loop_22)
- '#hash()
- (hash-iterate-first ht_27))))))
+ (let-values (((fold-var_14)
+ (cons
+ b_12
+ fold-var_12)))
+ (values
+ fold-var_14))
+ fold-var_12)))
+ (if (not
+ #f)
+ (for-loop_23
+ fold-var_13
+ rest_9)
+ fold-var_13)))
+ fold-var_12)))))
+ for-loop_23)
+ fold-var_10
+ lst_25)))))))
+ ((letrec-values (((for-loop_24)
+ (lambda (table_16)
+ (begin
+ 'for-loop
+ (let-values (((new-vals_0)
+ id*_0))
+ (let-values (((table_17)
+ (if (pair?
+ new-vals_0)
+ (let-values (((table_18)
+ (let-values (((key_12
+ val_2)
+ (values
+ k_11
+ new-vals_0)))
+ (hash-set
+ table_16
+ key_12
+ val_2))))
+ (values
+ table_18))
+ table_16)))
+ table_17))))))
+ for-loop_24)
+ table_14))))
+ (if (not #f)
+ (for-loop_22 table_15 (hash-iterate-next ht_29 i_59))
+ table_15)))
+ table_14)))))
+ for-loop_22)
+ table_12
+ (hash-iterate-first ht_29)))))))
(let-values (((count_0)
- (let-values (((ht_28) new-ht_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_28)))
- ((letrec-values (((for-loop_25)
- (lambda (result_23 i_43)
- (begin
- 'for-loop
- (if i_43
- (let-values (((k_12 vals_2) (hash-iterate-key+value ht_28 i_43)))
- (let-values (((result_24)
- (let-values (((result_25) result_23))
- (let-values (((result_26)
- (let-values ()
- (+
- result_25
- (let-values () (length vals_2))))))
- (values result_26)))))
- (if (not #f)
- (for-loop_25 result_24 (hash-iterate-next ht_28 i_43))
- result_24)))
- result_23)))))
- for-loop_25)
- 0
- (hash-iterate-first ht_28))))))
+ (let-values (((result_36) (let-values (((result_37) 0)) result_37)))
+ (let-values (((ht_30) new-ht_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_30))
+ ((letrec-values (((for-loop_25)
+ (lambda (result_38 i_60)
+ (begin
+ 'for-loop
+ (if i_60
+ (let-values (((k_12 vals_2) (hash-iterate-key+value ht_30 i_60)))
+ (let-values (((result_39)
+ (let-values (((result_40)
+ (+ result_38 (length vals_2))))
+ (values result_40))))
+ (if (not #f)
+ (for-loop_25 result_39 (hash-iterate-next ht_30 i_60))
+ result_39)))
+ result_38)))))
+ for-loop_25)
+ result_36
+ (hash-iterate-first ht_30)))))))
(table2.1 new-ht_0 count_0 (max 128 (* 2 count_0))))))))
(define-values
(struct:resolved-module-path resolved-module-path1.1 1/resolved-module-path? 1/resolved-module-path-name)
(let-values (((struct:_4 make-_4 ?_4 -ref_4 -set!_4)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'resolved-module-path
- #f
- 1
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:serialize
- (lambda (r_4 ser-push!_0 state_0)
- (begin
- (ser-push!_0 'tag '#:resolved-module-path)
- (ser-push!_0 (1/resolved-module-path-name r_4)))))
- (cons
- prop:custom-write
- (lambda (r_8 port_0 mode_3)
- (begin
- (if mode_3 (let-values () (write-string "#" port_0)) (void)))))
- (cons
- prop:equal+hash
- (list
- (lambda (a_12 b_13 eql?_2)
- (eql?_2 (1/resolved-module-path-name a_12) (1/resolved-module-path-name b_13)))
- (lambda (a_13 hash-code_0) (hash-code_0 (1/resolved-module-path-name a_13)))
- (lambda (a_14 hash-code_1) (hash-code_1 (1/resolved-module-path-name a_14))))))
- (current-inspector)
- #f
- '(0)
- #f
- 'resolved-module-path)))))
+ (make-struct-type
+ 'resolved-module-path
+ #f
+ 1
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:serialize
+ (lambda (r_10 ser-push!_0 state_0)
+ (begin
+ (ser-push!_0 'tag '#:resolved-module-path)
+ (ser-push!_0 (1/resolved-module-path-name r_10)))))
+ (cons
+ prop:custom-write
+ (lambda (r_11 port_0 mode_3)
+ (begin
+ (if mode_3 (write-string "#" port_0) (void)))))
+ (cons
+ prop:equal+hash
+ (list
+ (lambda (a_12 b_13 eql?_2)
+ (eql?_2 (1/resolved-module-path-name a_12) (1/resolved-module-path-name b_13)))
+ (lambda (a_13 hash-code_0) (hash-code_0 (1/resolved-module-path-name a_13)))
+ (lambda (a_14 hash-code_1) (hash-code_1 (1/resolved-module-path-name a_14))))))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'resolved-module-path)))
(values struct:_4 make-_4 ?_4 (make-struct-field-accessor -ref_4 0 'name))))
(define-values
(format-resolved-module-path-name)
- (lambda (p_5)
+ (lambda (p_6)
(begin
- (if (path? p_5)
- (let-values () (string-append "\"" (path->string p_5) "\""))
- (if (symbol? p_5)
- (let-values () (format-symbol p_5))
- (let-values () (format-submod (format-resolved-module-path-name (car p_5)) (cdr p_5))))))))
+ (if (path? p_6)
+ (string-append "\"" (path->string p_6) "\"")
+ (if (symbol? p_6)
+ (format-symbol p_6)
+ (format-submod (format-resolved-module-path-name (car p_6)) (cdr p_6)))))))
(define-values
(format-symbol)
- (lambda (p_6) (begin (format "'~s~a" p_6 (if (symbol-interned? p_6) "" (format "[~a]" (eq-hash-code p_6)))))))
+ (lambda (p_7) (begin (format "'~s~a" p_7 (if (symbol-interned? p_7) "" (format "[~a]" (eq-hash-code p_7)))))))
(define-values
(format-submod)
- (lambda (base_1 syms_0)
+ (lambda (base_6 syms_0)
(begin
(format
"(submod ~a~a)"
- base_1
+ base_6
(apply
string-append
(reverse$1
- (let-values (((lst_27) syms_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_27)))
- ((letrec-values (((for-loop_26)
- (lambda (fold-var_12 lst_25)
- (begin
- 'for-loop
- (if (pair? lst_25)
- (let-values (((i_44) (unsafe-car lst_25)) ((rest_10) (unsafe-cdr lst_25)))
- (let-values (((fold-var_13)
- (let-values (((fold-var_14) fold-var_12))
- (let-values (((fold-var_15)
- (let-values ()
- (cons
- (let-values () (format " ~s" i_44))
- fold-var_14))))
- (values fold-var_15)))))
- (if (not #f) (for-loop_26 fold-var_13 rest_10) fold-var_13)))
- fold-var_12)))))
- for-loop_26)
- null
- lst_27)))))))))
+ (let-values (((fold-var_15) (let-values (((fold-var_16) null)) fold-var_16)))
+ (let-values (((lst_27) syms_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_27))
+ ((letrec-values (((for-loop_26)
+ (lambda (fold-var_17 lst_28)
+ (begin
+ 'for-loop
+ (if (pair? lst_28)
+ (let-values (((i_61) (unsafe-car lst_28)) ((rest_10) (unsafe-cdr lst_28)))
+ (let-values (((fold-var_18)
+ (let-values (((fold-var_19)
+ (cons (format " ~s" i_61) fold-var_17)))
+ (values fold-var_19))))
+ (if (not #f) (for-loop_26 fold-var_18 rest_10) fold-var_18)))
+ fold-var_17)))))
+ for-loop_26)
+ fold-var_15
+ lst_27))))))))))
(define-values
(safe-resolved-module-path-name)
(let-values (((resolved-module-path-name_0)
- (lambda (v_41)
+ (lambda (v_59)
(begin
'resolved-module-path-name
(begin
- (if (1/resolved-module-path? v_41)
+ (if (1/resolved-module-path? v_59)
(void)
- (let-values () (raise-argument-error 'resolved-module-path-name "resolved-module-path?" v_41)))
- (1/resolved-module-path-name v_41))))))
+ (raise-argument-error 'resolved-module-path-name "resolved-module-path?" v_59))
+ (1/resolved-module-path-name v_59))))))
resolved-module-path-name_0))
(define-values
(resolved-module-path-root-name)
- (lambda (r_9)
- (begin (let-values (((name_8) (1/resolved-module-path-name r_9))) (if (pair? name_8) (car name_8) name_8)))))
+ (lambda (r_12)
+ (begin (let-values (((name_7) (1/resolved-module-path-name r_12))) (if (pair? name_7) (car name_7) name_7)))))
(define-values (resolved-module-paths) (make-weak-intern-table))
(define-values
(1/make-resolved-module-path)
- (lambda (p_7)
+ (lambda (p_8)
(begin
'make-resolved-module-path
(begin
- (if (let-values (((or-part_38) (symbol? p_7)))
- (if or-part_38
- or-part_38
- (let-values (((or-part_59) (if (path? p_7) (complete-path? p_7) #f)))
- (if or-part_59
- or-part_59
- (if (pair? p_7)
- (if (pair? (cdr p_7))
- (if (list? p_7)
- (if (let-values (((or-part_60) (symbol? (car p_7))))
- (if or-part_60 or-part_60 (if (path? (car p_7)) (complete-path? (car p_7)) #f)))
- (let-values (((lst_28) (cdr p_7)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_28)))
- ((letrec-values (((for-loop_27)
- (lambda (result_27 lst_29)
- (begin
- 'for-loop
- (if (pair? lst_29)
- (let-values (((s_42) (unsafe-car lst_29))
- ((rest_11) (unsafe-cdr lst_29)))
- (let-values (((result_6)
- (let-values ()
- (let-values (((result_23)
- (let-values ()
- (let-values ()
- (symbol? s_42)))))
- (values result_23)))))
- (if (if (not ((lambda x_15 (not result_6)) s_42))
- (not #f)
- #f)
- (for-loop_27 result_6 rest_11)
- result_6)))
- result_27)))))
- for-loop_27)
- #t
- lst_28)))
+ (if (let-values (((or-part_80) (symbol? p_8)))
+ (if or-part_80
+ or-part_80
+ (let-values (((or-part_81) (if (path? p_8) (complete-path? p_8) #f)))
+ (if or-part_81
+ or-part_81
+ (if (pair? p_8)
+ (if (pair? (cdr p_8))
+ (if (list? p_8)
+ (if (let-values (((or-part_82) (symbol? (car p_8))))
+ (if or-part_82 or-part_82 (if (path? (car p_8)) (complete-path? (car p_8)) #f)))
+ (let-values (((result_41) (let-values (((result_42) #t)) result_42)))
+ (let-values (((lst_29) (cdr p_8)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_29))
+ ((letrec-values (((for-loop_27)
+ (lambda (result_43 lst_30)
+ (begin
+ 'for-loop
+ (if (pair? lst_30)
+ (let-values (((s_47) (unsafe-car lst_30))
+ ((rest_11) (unsafe-cdr lst_30)))
+ (let-values (((result_44)
+ (let-values (((result_45) (symbol? s_47)))
+ (values result_45))))
+ (if (if (not ((lambda x_17 (not result_44)) s_47))
+ (not #f)
+ #f)
+ (for-loop_27 result_44 rest_11)
+ result_44)))
+ result_43)))))
+ for-loop_27)
+ result_41
+ lst_29))))
#f)
#f)
#f)
#f)))))
(void)
- (let-values ()
- (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_7)))
- (weak-intern! resolved-module-paths (resolved-module-path1.1 p_7))))))
+ (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_8))
+ (weak-intern! resolved-module-paths (resolved-module-path1.1 p_8))))))
(define-values
(resolved-module-path->module-path)
- (lambda (r_10)
+ (lambda (r_13)
(begin
- (let-values (((name_9) (1/resolved-module-path-name r_10)))
- (let-values (((root-name_0) (if (pair? name_9) (car name_9) name_9)))
+ (let-values (((name_8) (1/resolved-module-path-name r_13)))
+ (let-values (((root-name_0) (if (pair? name_8) (car name_8) name_8)))
(let-values (((root-mod-path_0) (if (path? root-name_0) root-name_0 (list 'quote root-name_0))))
- (if (pair? name_9) (list* 'submod root-mod-path_0 (cdr name_9)) root-mod-path_0)))))))
+ (if (pair? name_8) (list* 'submod root-mod-path_0 (cdr name_8)) root-mod-path_0)))))))
(define-values
(struct:module-path-index
module-path-index2.1
@@ -4710,142 +4426,120 @@
set-module-path-index-resolved!
set-module-path-index-shift-cache!)
(let-values (((struct:_5 make-_5 ?_5 -ref_5 -set!_5)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'module-path-index
- #f
- 4
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:custom-write
- (lambda (r_11 port_1 mode_4)
- (begin
- (write-string "#" port_1))))
- (cons
- prop:equal+hash
- (list
- (lambda (a_15 b_9 eql?_3)
- (if (eql?_3 (module-path-index-path a_15) (module-path-index-path b_9))
- (eql?_3 (module-path-index-base a_15) (module-path-index-base b_9))
- #f))
- (lambda (a_16 hash-code_2)
- (+ (hash-code_2 (module-path-index-path a_16)) (hash-code_2 (module-path-index-base a_16))))
- (lambda (a_17 hash-code_3)
- (+
- (hash-code_3 (module-path-index-path a_17))
- (hash-code_3 (module-path-index-base a_17)))))))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'module-path-index)))))
+ (make-struct-type
+ 'module-path-index
+ #f
+ 4
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:custom-write
+ (lambda (r_14 port_1 mode_4)
+ (begin
+ (write-string "#" port_1))))
+ (cons
+ prop:equal+hash
+ (list
+ (lambda (a_15 b_14 eql?_3)
+ (if (eql?_3 (module-path-index-path a_15) (module-path-index-path b_14))
+ (eql?_3 (module-path-index-base a_15) (module-path-index-base b_14))
+ #f))
+ (lambda (a_16 hash-code_2)
+ (+ (hash-code_2 (module-path-index-path a_16)) (hash-code_2 (module-path-index-base a_16))))
+ (lambda (a_17 hash-code_3)
+ (+ (hash-code_3 (module-path-index-path a_17)) (hash-code_3 (module-path-index-base a_17)))))))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'module-path-index)))
(values
struct:_5
make-_5
@@ -4860,8 +4554,8 @@
(define-values
(deserialize-module-path-index)
(case-lambda
- ((path_6 base_6) (begin (1/module-path-index-join path_6 base_6)))
- ((name_10) (make-self-module-path-index (1/make-resolved-module-path name_10)))
+ ((path_6 base_7) (begin (module-path-index-join* path_6 base_7)))
+ ((name_9) (make-self-module-path-index (1/make-resolved-module-path name_9)))
(() top-level-module-path-index)))
(define-values
(1/module-path-index-resolve)
@@ -4872,62 +4566,47 @@
(let-values (((mpi_0) mpi5_0))
(let-values (((load?_0) load?3_0))
(let-values (((stx_0) stx4_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (1/module-path-index? mpi_0)
- (void)
- (let-values ()
- (raise-argument-error 'module-path-index-resolve "module-path-index?" mpi_0)))
- (let-values (((or-part_61) (module-path-index-resolved mpi_0)))
- (if or-part_61
- or-part_61
- (if (module-path-index-path mpi_0)
- (let-values ()
- (let-values (((mod-name_0)
- (begin
- (if log-performance?
- (let-values () (start-performance-region 'eval 'resolver))
- (void))
- (begin0
- (let-values ()
- ((1/current-module-name-resolver)
- (module-path-index-path mpi_0)
- (module-path-index-resolve/maybe
- (module-path-index-base mpi_0)
- load?_0)
- stx_0
- load?_0))
- (if log-performance?
- (let-values () (end-performance-region))
- (void))))))
- (begin
- (if (1/resolved-module-path? mod-name_0)
- (void)
- (let-values ()
- (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! mpi_0 mod-name_0)
- mod-name_0)))
- (let-values ()
- (raise-arguments-error
- 'module-path-index-resolve
- "\"self\" index has no resolution"
- "module path index"
- mpi_0))))))))))))))))
+ (begin
+ (if (1/module-path-index? mpi_0)
+ (void)
+ (raise-argument-error 'module-path-index-resolve "module-path-index?" mpi_0))
+ (let-values (((or-part_83) (module-path-index-resolved mpi_0)))
+ (if or-part_83
+ or-part_83
+ (if (module-path-index-path mpi_0)
+ (let-values (((mod-name_0)
+ (begin
+ (if log-performance?
+ (start-performance-region 'eval 'resolver)
+ (void))
+ (begin0
+ ((1/current-module-name-resolver)
+ (module-path-index-path mpi_0)
+ (module-path-index-resolve/maybe
+ (module-path-index-base mpi_0)
+ load?_0)
+ stx_0
+ load?_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! mpi_0 mod-name_0)
+ mod-name_0))
+ (raise-arguments-error
+ 'module-path-index-resolve
+ "\"self\" index has no resolution"
+ "module path index"
+ mpi_0))))))))))))
(case-lambda
((mpi_1) (begin 'module-path-index-resolve (module-path-index-resolve_0 mpi_1 #f #f)))
((mpi_2 load?_1 stx4_1) (module-path-index-resolve_0 mpi_2 load?_1 stx4_1))
((mpi_3 load?3_1) (module-path-index-resolve_0 mpi_3 load?3_1 #f)))))
- (define-values
- (module-path-index-fresh)
- (lambda (mpi_4)
- (begin
- (let-values (((path_7 base_7) (1/module-path-index-split mpi_4))) (1/module-path-index-join path_7 base_7)))))
(define-values
(1/module-path-index-join)
(let-values (((module-path-index-join_0)
@@ -4937,433 +4616,440 @@
(let-values (((mod-path_0) mod-path7_0))
(let-values (((base_8) base8_0))
(let-values (((submod_0) submod6_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if ((lambda (x_16)
- (let-values (((or-part_62) (not x_16)))
- (if or-part_62 or-part_62 (1/module-path? x_16))))
- mod-path_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'module-path-index-join
- "(or/c #f module-path?)"
- mod-path_0)))
- (if (let-values (((or-part_63) (not base_8)))
- (if or-part_63
- or-part_63
- (let-values (((or-part_64) (1/resolved-module-path? base_8)))
- (if or-part_64 or-part_64 (1/module-path-index? base_8)))))
- (void)
- (let-values ()
- (raise-argument-error
- 'module-path-index-join
- "(or/c #f resolved-module-path? module-path-index?)"
- base_8)))
- (if (let-values (((or-part_65) (not submod_0)))
- (if or-part_65
- or-part_65
- (if (pair? submod_0) (if (list? submod_0) (andmap2 symbol? submod_0) #f) #f)))
- (void)
- (let-values ()
- (raise-argument-error
- 'module-path-index-join
- "(or/c #f (non-empty-listof symbol?))"
- submod_0)))
- (if (if (not mod-path_0) base_8 #f)
- (let-values ()
- (raise-arguments-error
- 'module-path-index-join
- "cannot combine #f path with non-#f base"
- "given base"
- base_8))
- (void))
- (if (if submod_0 mod-path_0 #f)
- (let-values ()
- (raise-arguments-error
- 'module-path-index-join
- "cannot combine #f submodule list with non-#f module path"
- "given module path"
- mod-path_0
- "given submodule list"
- submod_0))
- (void))
- (if submod_0
- (let-values ()
- (make-self-module-path-index
- (1/make-resolved-module-path (cons generic-module-name submod_0))))
- (let-values ()
- (let-values (((keep-base_0)
- ((letrec-values (((loop_55)
- (lambda (mod-path_1)
- (begin
- 'loop
- (if (path? mod-path_1)
- (let-values () #f)
- (if (if (pair? mod-path_1)
- (eq? 'quote (car mod-path_1))
- #f)
- (let-values () #f)
- (if (symbol? mod-path_1)
- (let-values () #f)
- (if (if (pair? mod-path_1)
- (eq? 'submod (car mod-path_1))
- #f)
- (let-values ()
- (loop_55 (cadr mod-path_1)))
- (let-values () base_8)))))))))
- loop_55)
- mod-path_0)))
- (module-path-index2.1 mod-path_0 keep-base_0 #f empty-shift-cache)))))))))))))))
+ (begin
+ (if ((lambda (x_18)
+ (let-values (((or-part_84) (not x_18)))
+ (if or-part_84 or-part_84 (1/module-path? x_18))))
+ mod-path_0)
+ (void)
+ (raise-argument-error 'module-path-index-join "(or/c #f module-path?)" mod-path_0))
+ (if (let-values (((or-part_85) (not base_8)))
+ (if or-part_85
+ or-part_85
+ (let-values (((or-part_86) (1/resolved-module-path? base_8)))
+ (if or-part_86 or-part_86 (1/module-path-index? base_8)))))
+ (void)
+ (raise-argument-error
+ 'module-path-index-join
+ "(or/c #f resolved-module-path? module-path-index?)"
+ base_8))
+ (if (let-values (((or-part_87) (not submod_0)))
+ (if or-part_87
+ or-part_87
+ (if (pair? submod_0) (if (list? submod_0) (andmap2 symbol? submod_0) #f) #f)))
+ (void)
+ (raise-argument-error
+ 'module-path-index-join
+ "(or/c #f (non-empty-listof symbol?))"
+ submod_0))
+ (if (if (not mod-path_0) base_8 #f)
+ (raise-arguments-error
+ 'module-path-index-join
+ "cannot combine #f path with non-#f base"
+ "given base"
+ base_8)
+ (void))
+ (if (if submod_0 mod-path_0 #f)
+ (raise-arguments-error
+ 'module-path-index-join
+ "cannot combine #f submodule list with non-#f module path"
+ "given module path"
+ mod-path_0
+ "given submodule list"
+ submod_0)
+ (void))
+ (if submod_0
+ (make-self-module-path-index
+ (1/make-resolved-module-path (cons generic-module-name submod_0)))
+ (module-path-index-join* mod-path_0 base_8))))))))))
(case-lambda
- ((mod-path_2 base_9) (begin 'module-path-index-join (module-path-index-join_0 mod-path_2 base_9 #f)))
- ((mod-path_3 base_10 submod6_1) (module-path-index-join_0 mod-path_3 base_10 submod6_1)))))
+ ((mod-path_1 base_9) (begin 'module-path-index-join (module-path-index-join_0 mod-path_1 base_9 #f)))
+ ((mod-path_2 base_10 submod6_1) (module-path-index-join_0 mod-path_2 base_10 submod6_1)))))
+ (define-values
+ (module-path-index-join*)
+ (lambda (mod-path_3 base_11)
+ (begin
+ (let-values (((keep-base_0)
+ ((letrec-values (((loop_57)
+ (lambda (mod-path_4)
+ (begin
+ 'loop
+ (if (path? mod-path_4)
+ #f
+ (if (if (pair? mod-path_4) (eq? 'quote (car mod-path_4)) #f)
+ #f
+ (if (symbol? mod-path_4)
+ #f
+ (if (if (pair? mod-path_4) (eq? 'lib (car mod-path_4)) #f)
+ #f
+ (if (if (pair? mod-path_4) (eq? 'submod (car mod-path_4)) #f)
+ (loop_57 (cadr mod-path_4))
+ base_11)))))))))
+ loop_57)
+ mod-path_3)))
+ (module-path-index2.1 mod-path_3 keep-base_0 #f empty-shift-cache)))))
(define-values
(module-path-index-resolve/maybe)
- (lambda (base_11 load?_2)
- (begin (if (1/module-path-index? base_11) (1/module-path-index-resolve base_11 load?_2) base_11))))
+ (lambda (base_12 load?_2)
+ (begin (if (1/module-path-index? base_12) (1/module-path-index-resolve base_12 load?_2) base_12))))
(define-values
(1/module-path-index-split)
- (lambda (mpi_5)
+ (lambda (mpi_4)
(begin
'module-path-index-split
- (let-values ()
- (let-values ()
- (begin
- (if (1/module-path-index? mpi_5)
- (void)
- (let-values () (raise-argument-error 'module-path-index-split "module-path-index?" mpi_5)))
- (values (module-path-index-path mpi_5) (module-path-index-base mpi_5))))))))
+ (begin
+ (if (1/module-path-index? mpi_4)
+ (void)
+ (raise-argument-error 'module-path-index-split "module-path-index?" mpi_4))
+ (values (module-path-index-path mpi_4) (module-path-index-base mpi_4))))))
(define-values
(1/module-path-index-submodule)
- (lambda (mpi_6)
+ (lambda (mpi_5)
(begin
'module-path-index-submodule
- (let-values ()
- (let-values ()
- (begin
- (if (1/module-path-index? mpi_6)
- (void)
- (let-values () (raise-argument-error 'module-path-index-submodule "module-path-index?" mpi_6)))
- (if (not (module-path-index-path mpi_6))
- (let-values (((r_13) (module-path-index-resolved mpi_6)))
- (if r_13 (let-values (((p_8) (1/resolved-module-path-name r_13))) (if (pair? p_8) (cdr p_8) #f)) #f))
- #f)))))))
+ (begin
+ (if (1/module-path-index? mpi_5)
+ (void)
+ (raise-argument-error 'module-path-index-submodule "module-path-index?" mpi_5))
+ (if (not (module-path-index-path mpi_5))
+ (let-values (((r_16) (module-path-index-resolved mpi_5)))
+ (if r_16 (let-values (((p_9) (1/resolved-module-path-name r_16))) (if (pair? p_9) (cdr p_9) #f)) #f))
+ #f)))))
(define-values
(make-self-module-path-index)
(case-lambda
- ((name_11) (begin (module-path-index2.1 #f #f name_11 empty-shift-cache)))
- ((name_12 enclosing_0)
+ ((name_10) (begin (module-path-index2.1 #f #f name_10 empty-shift-cache)))
+ ((name_11 enclosing_0)
(make-self-module-path-index
- (let-values (((name20_0) name_12) ((temp21_1) (if enclosing_0 (1/module-path-index-resolve enclosing_0) #f)))
+ (let-values (((name20_0) name_11) ((temp21_1) (if enclosing_0 (1/module-path-index-resolve enclosing_0) #f)))
(build-module-name.1 unsafe-undefined name20_0 temp21_1))))))
(define-values (cell.1$9) (unsafe-make-place-local (make-weak-hash)))
+ (define-values (cell.2$7) (unsafe-make-place-local (make-uninterruptible-lock)))
(define-values (generic-module-name) '|expanded module|)
- (define-values (module-path-place-init!) (lambda () (begin (unsafe-place-local-set! cell.1$9 (make-weak-hash)))))
+ (define-values
+ (module-path-place-init!)
+ (lambda ()
+ (begin
+ (begin
+ (unsafe-place-local-set! cell.1$9 (make-weak-hash))
+ (unsafe-place-local-set! cell.2$7 (make-uninterruptible-lock))))))
(define-values
(make-generic-self-module-path-index)
- (lambda (self_0)
+ (lambda (self_1)
(begin
- (let-values (((r_14) (resolved-module-path-to-generic-resolved-module-path (module-path-index-resolved self_0))))
+ (let-values (((r_17) (resolved-module-path-to-generic-resolved-module-path (module-path-index-resolved self_1))))
(begin
- (start-atomic)
+ (uninterruptible-lock-acquire (unsafe-place-local-ref cell.2$7))
(begin0
- (let-values (((or-part_50)
- (let-values (((e_9) (hash-ref (unsafe-place-local-ref cell.1$9) r_14 #f)))
+ (let-values (((or-part_88)
+ (let-values (((e_9) (hash-ref (unsafe-place-local-ref cell.1$9) r_17 #f)))
(if e_9 (ephemeron-value e_9) #f))))
- (if or-part_50
- or-part_50
- (let-values (((mpi_7) (module-path-index2.1 #f #f r_14 empty-shift-cache)))
- (begin (hash-set! (unsafe-place-local-ref cell.1$9) r_14 (make-ephemeron r_14 mpi_7)) mpi_7))))
- (end-atomic)))))))
+ (if or-part_88
+ or-part_88
+ (let-values (((mpi_6) (module-path-index2.1 #f #f r_17 empty-shift-cache)))
+ (begin (hash-set! (unsafe-place-local-ref cell.1$9) r_17 (make-ephemeron r_17 mpi_6)) mpi_6))))
+ (uninterruptible-lock-release (unsafe-place-local-ref cell.2$7))))))))
(define-values
(resolved-module-path-to-generic-resolved-module-path)
- (lambda (r_15)
+ (lambda (r_18)
(begin
- (let-values (((name_13) (1/resolved-module-path-name r_15)))
+ (let-values (((name_12) (1/resolved-module-path-name r_18)))
(1/make-resolved-module-path
- (if (symbol? name_13) generic-module-name (cons generic-module-name (cdr name_13))))))))
+ (if (symbol? name_12) generic-module-name (cons generic-module-name (cdr name_12))))))))
(define-values
(imitate-generic-module-path-index!)
- (lambda (mpi_8)
+ (lambda (mpi_7)
(begin
- (let-values (((r_16) (module-path-index-resolved mpi_8)))
- (if r_16
- (let-values ()
- (set-module-path-index-resolved! mpi_8 (resolved-module-path-to-generic-resolved-module-path r_16)))
+ (let-values (((r_19) (module-path-index-resolved mpi_7)))
+ (if r_19
+ (set-module-path-index-resolved! mpi_7 (resolved-module-path-to-generic-resolved-module-path r_19))
(void))))))
+ (define-values
+ (module-path-index-shift*)
+ (lambda (mpi_8 from-mpi_0 to-mpi_0 freshen-cache_0)
+ (begin
+ (if (eq? mpi_8 from-mpi_0)
+ to-mpi_0
+ (let-values (((base_13) (module-path-index-base mpi_8)))
+ (let-values (((result-mpi_0)
+ (if (not base_13)
+ mpi_8
+ (let-values (((shifted-base_0)
+ (module-path-index-shift* base_13 from-mpi_0 to-mpi_0 freshen-cache_0)))
+ (if (eq? shifted-base_0 base_13)
+ mpi_8
+ (let-values (((cond-val_0)
+ (shift-cache-ref (module-path-index-shift-cache shifted-base_0) mpi_8)))
+ (if cond-val_0
+ cond-val_0
+ (let-values (((shifted-mpi_0)
+ (module-path-index-join*
+ (module-path-index-path mpi_8)
+ shifted-base_0)))
+ (begin (shift-cache-set! shifted-base_0 shifted-mpi_0) shifted-mpi_0)))))))))
+ (begin
+ (if (if freshen-cache_0 (not (hash-ref freshen-cache_0 result-mpi_0 #f)) #f)
+ (let-values (((result-base_0) (module-path-index-base result-mpi_0)))
+ (let-values (((fresh-base_0) (hash-ref freshen-cache_0 result-base_0 #f)))
+ (let-values (((fresh-mpi_0)
+ (module-path-index2.1
+ (module-path-index-path result-mpi_0)
+ (let-values (((or-part_89) fresh-base_0)) (if or-part_89 or-part_89 result-base_0))
+ #f
+ empty-shift-cache)))
+ (begin
+ (if fresh-base_0 (shift-cache-set! fresh-base_0 fresh-mpi_0) (void))
+ (hash-set! freshen-cache_0 result-mpi_0 fresh-mpi_0)))))
+ (void))
+ result-mpi_0)))))))
(define-values
(module-path-index-shift)
- (lambda (mpi_9 from-mpi_0 to-mpi_0)
+ (lambda (mpi_9 from-mpi_1 to-mpi_1) (begin (module-path-index-shift* mpi_9 from-mpi_1 to-mpi_1 #f))))
+ (define-values
+ (module-path-index-shift/resolved)
+ (lambda (mpi_10 from-mpi_2 to-mpi_2 freshen-cache_1 rp_0)
(begin
- (if (eq? mpi_9 from-mpi_0)
- (let-values () to-mpi_0)
- (let-values ()
- (let-values (((base_12) (module-path-index-base mpi_9)))
- (if (not base_12)
- (let-values () mpi_9)
- (let-values ()
- (let-values (((shifted-base_0) (module-path-index-shift base_12 from-mpi_0 to-mpi_0)))
- (if (eq? shifted-base_0 base_12)
- (let-values () mpi_9)
- (let-values (((c1_17) (shift-cache-ref (module-path-index-shift-cache shifted-base_0) mpi_9)))
- (if c1_17
- c1_17
- (let-values ()
- (let-values (((shifted-mpi_0)
- (module-path-index2.1
- (module-path-index-path mpi_9)
- shifted-base_0
- #f
- empty-shift-cache)))
- (begin (shift-cache-set! shifted-base_0 shifted-mpi_0) shifted-mpi_0)))))))))))))))
+ (let-values (((new-mpi_0) (module-path-index-shift* mpi_10 from-mpi_2 to-mpi_2 freshen-cache_1)))
+ (let-values (((fresh-mpi_1) (hash-ref freshen-cache_1 new-mpi_0)))
+ (begin
+ (if rp_0
+ (if (module-path-index-resolved fresh-mpi_1) (void) (set-module-path-index-resolved! fresh-mpi_1 rp_0))
+ (void))
+ fresh-mpi_1))))))
(define-values
(shift-cache-ref)
- (lambda (cache_0 mpi_10)
+ (lambda (cache_0 mpi_11)
(begin
- (let-values (((lst_32) cache_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_32)))
- ((letrec-values (((for-loop_29)
- (lambda (result_28 lst_33)
- (begin
- 'for-loop
- (if (pair? lst_33)
- (let-values (((wb_0) (unsafe-car lst_33)) ((rest_13) (unsafe-cdr lst_33)))
- (let-values (((result_29)
- (let-values ()
- (let-values (((result_30)
- (let-values ()
- (let-values ()
- (let-values (((v_43) (weak-box-value wb_0)))
- (if v_43
- (if (equal?
- (module-path-index-path v_43)
- (module-path-index-path mpi_10))
- v_43
- #f)
- #f))))))
- (values result_30)))))
- (if (if (not ((lambda x_17 result_29) wb_0)) (not #f) #f)
- (for-loop_29 result_29 rest_13)
- result_29)))
- result_28)))))
- for-loop_29)
- #f
- lst_32))))))
+ (let-values (((result_46) (let-values (((result_47) #f)) result_47)))
+ (let-values (((lst_33) cache_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_33))
+ ((letrec-values (((for-loop_29)
+ (lambda (result_48 lst_34)
+ (begin
+ 'for-loop
+ (if (pair? lst_34)
+ (let-values (((wb_0) (unsafe-car lst_34)) ((rest_13) (unsafe-cdr lst_34)))
+ (let-values (((result_49)
+ (let-values (((result_50)
+ (let-values (((v_61) (weak-box-value wb_0)))
+ (if v_61
+ (if (equal?
+ (module-path-index-path v_61)
+ (module-path-index-path mpi_11))
+ v_61
+ #f)
+ #f))))
+ (values result_50))))
+ (if (if (not ((lambda x_19 result_49) wb_0)) (not #f) #f)
+ (for-loop_29 result_49 rest_13)
+ result_49)))
+ result_48)))))
+ for-loop_29)
+ result_46
+ lst_33)))))))
(define-values
(shift-cache-set!)
- (lambda (base_13 v_44)
+ (lambda (base_14 v_62)
(begin
(let-values (((new-cache_0)
(cons
- (make-weak-box v_44)
- ((letrec-values (((loop_56)
- (lambda (n_19 l_30)
+ (make-weak-box v_62)
+ ((letrec-values (((loop_58)
+ (lambda (n_19 l_36)
(begin
'loop
- (if (null? l_30)
- (let-values () null)
+ (if (null? l_36)
+ null
(if (eqv? n_19 0)
- (let-values () null)
- (if (not (weak-box-value (car l_30)))
- (let-values () (loop_56 n_19 (cdr l_30)))
- (let-values ()
- (let-values (((r_17) (loop_56 (fx- n_19 1) (cdr l_30))))
- (if (eq? r_17 (cdr l_30)) l_30 (cons (car l_30) r_17)))))))))))
- loop_56)
+ null
+ (if (not (weak-box-value (car l_36)))
+ (loop_58 n_19 (cdr l_36))
+ (let-values (((r_20) (loop_58 (fx- n_19 1) (cdr l_36))))
+ (if (eq? r_20 (cdr l_36)) l_36 (cons (car l_36) r_20))))))))))
+ loop_58)
32
- (module-path-index-shift-cache base_13)))))
- (set-module-path-index-shift-cache! base_13 new-cache_0)))))
+ (module-path-index-shift-cache base_14)))))
+ (set-module-path-index-shift-cache! base_14 new-cache_0)))))
(define-values (top-level-module-path-index) (make-self-module-path-index (1/make-resolved-module-path 'top-level)))
- (define-values (top-level-module-path-index?) (lambda (mpi_11) (begin (eq? top-level-module-path-index mpi_11))))
- (define-values (non-self-module-path-index?) (lambda (mpi_12) (begin (if (module-path-index-path mpi_12) #t #f))))
+ (define-values (top-level-module-path-index?) (lambda (mpi_12) (begin (eq? top-level-module-path-index mpi_12))))
+ (define-values (non-self-module-path-index?) (lambda (mpi_13) (begin (if (module-path-index-path mpi_13) #t #f))))
+ (define-values
+ (non-self-derived-module-path-index?)
+ (lambda (mpi_14)
+ (begin
+ (if (non-self-module-path-index? mpi_14)
+ (let-values (((base_15) (module-path-index-base mpi_14)))
+ (let-values (((or-part_90) (not base_15)))
+ (if or-part_90 or-part_90 (non-self-derived-module-path-index? base_15))))
+ #f))))
(define-values
(inside-module-context?)
- (lambda (mpi_13 inside-mpi_0)
+ (lambda (mpi_15 inside-mpi_0)
(begin
- (let-values (((or-part_66) (eq? mpi_13 inside-mpi_0)))
- (if or-part_66
- or-part_66
- (if (1/module-path-index? mpi_13)
+ (let-values (((or-part_91) (eq? mpi_15 inside-mpi_0)))
+ (if or-part_91
+ or-part_91
+ (if (1/module-path-index? mpi_15)
(if (1/module-path-index? inside-mpi_0)
- (if (module-path-index-resolved mpi_13)
- (eq? (module-path-index-resolved mpi_13) (module-path-index-resolved inside-mpi_0))
+ (if (module-path-index-resolved mpi_15)
+ (eq? (module-path-index-resolved mpi_15) (module-path-index-resolved inside-mpi_0))
#f)
#f)
#f))))))
(define-values
(core-module-name-resolver)
(case-lambda
- ((name_14 from-namespace_0) (begin (void)))
- ((p_9 enclosing_1 source-stx-stx_0 load?_3)
+ ((name_13 from-namespace_0) (begin (void)))
+ ((p_10 enclosing_1 source-stx-stx_0 load?_3)
(begin
- (if (1/module-path? p_9)
- (void)
- (let-values () (raise-argument-error 'core-module-name-resolver "module-path?" p_9)))
- (if (let-values (((or-part_67) (not enclosing_1)))
- (if or-part_67 or-part_67 (1/resolved-module-path? enclosing_1)))
+ (if (1/module-path? p_10) (void) (raise-argument-error 'core-module-name-resolver "module-path?" p_10))
+ (if (let-values (((or-part_92) (not enclosing_1)))
+ (if or-part_92 or-part_92 (1/resolved-module-path? enclosing_1)))
(void)
- (let-values () (raise-argument-error 'core-module-name-resolver "resolved-module-path?" enclosing_1)))
- (if (if (list? p_9) (if (= (length p_9) 2) (if (eq? 'quote (car p_9)) (symbol? (cadr p_9)) #f) #f) #f)
- (let-values () (1/make-resolved-module-path (cadr p_9)))
- (if (if (list? p_9) (if (eq? 'submod (car p_9)) (equal? ".." (cadr p_9)) #f) #f)
- (let-values ()
- (let-values (((lst_34) (cdr p_9)))
+ (raise-argument-error 'core-module-name-resolver "resolved-module-path?" enclosing_1))
+ (if (if (list? p_10) (if (= (length p_10) 2) (if (eq? 'quote (car p_10)) (symbol? (cadr p_10)) #f) #f) #f)
+ (1/make-resolved-module-path (cadr p_10))
+ (if (if (list? p_10) (if (eq? 'submod (car p_10)) (equal? ".." (cadr p_10)) #f) #f)
+ (let-values (((enclosing_2) (let-values (((enclosing_3) enclosing_1)) enclosing_3)))
+ (let-values (((lst_35) (cdr p_10)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_34)))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_35))
((letrec-values (((for-loop_30)
- (lambda (enclosing_2 lst_35)
+ (lambda (enclosing_4 lst_36)
(begin
'for-loop
- (if (pair? lst_35)
- (let-values (((s_43) (unsafe-car lst_35)) ((rest_14) (unsafe-cdr lst_35)))
- (let-values (((enclosing_3)
- (let-values (((enclosing_4) enclosing_2))
- (let-values (((enclosing_5)
- (let-values ()
- (let-values (((s22_0) s_43)
- ((enclosing23_0) enclosing_4)
- ((p24_0) p_9))
- (build-module-name.1
- p24_0
- s22_0
- enclosing23_0)))))
- (values enclosing_5)))))
- (if (not #f) (for-loop_30 enclosing_3 rest_14) enclosing_3)))
- enclosing_2)))))
+ (if (pair? lst_36)
+ (let-values (((s_48) (unsafe-car lst_36)) ((rest_14) (unsafe-cdr lst_36)))
+ (let-values (((enclosing_5)
+ (let-values (((enclosing_6)
+ (let-values (((s22_0) s_48)
+ ((enclosing23_0) enclosing_4)
+ ((p24_0) p_10))
+ (build-module-name.1
+ p24_0
+ s22_0
+ enclosing23_0))))
+ (values enclosing_6))))
+ (if (not #f) (for-loop_30 enclosing_5 rest_14) enclosing_5)))
+ enclosing_4)))))
for-loop_30)
- enclosing_1
- lst_34))))
- (if (if (list? p_9) (if (eq? 'submod (car p_9)) (equal? "." (cadr p_9)) #f) #f)
- (let-values ()
- (let-values (((lst_36) (cddr p_9)))
+ enclosing_2
+ lst_35))))
+ (if (if (list? p_10) (if (eq? 'submod (car p_10)) (equal? "." (cadr p_10)) #f) #f)
+ (let-values (((enclosing_7) (let-values (((enclosing_8) enclosing_1)) enclosing_8)))
+ (let-values (((lst_37) (cddr p_10)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_36)))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_37))
((letrec-values (((for-loop_31)
- (lambda (enclosing_6 lst_37)
+ (lambda (enclosing_9 lst_38)
(begin
'for-loop
- (if (pair? lst_37)
- (let-values (((s_44) (unsafe-car lst_37)) ((rest_15) (unsafe-cdr lst_37)))
- (let-values (((enclosing_7)
- (let-values (((enclosing_8) enclosing_6))
- (let-values (((enclosing_9)
- (let-values ()
- (let-values (((s25_0) s_44)
- ((enclosing26_0) enclosing_8)
- ((p27_0) p_9))
- (build-module-name.1
- p27_0
- s25_0
- enclosing26_0)))))
- (values enclosing_9)))))
- (if (not #f) (for-loop_31 enclosing_7 rest_15) enclosing_7)))
- enclosing_6)))))
+ (if (pair? lst_38)
+ (let-values (((s_49) (unsafe-car lst_38)) ((rest_15) (unsafe-cdr lst_38)))
+ (let-values (((enclosing_10)
+ (let-values (((enclosing_11)
+ (let-values (((s25_0) s_49)
+ ((enclosing26_0) enclosing_9)
+ ((p27_0) p_10))
+ (build-module-name.1
+ p27_0
+ s25_0
+ enclosing26_0))))
+ (values enclosing_11))))
+ (if (not #f) (for-loop_31 enclosing_10 rest_15) enclosing_10)))
+ enclosing_9)))))
for-loop_31)
- enclosing_1
- lst_36))))
- (if (if (list? p_9) (eq? 'submod (car p_9)) #f)
- (let-values ()
- (let-values (((base_14) ((1/current-module-name-resolver) (cadr p_9) enclosing_1 #f #f)))
- (let-values (((lst_38) (cddr p_9)))
+ enclosing_7
+ lst_37))))
+ (if (if (list? p_10) (eq? 'submod (car p_10)) #f)
+ (let-values (((base_16) ((1/current-module-name-resolver) (cadr p_10) enclosing_1 #f #f)))
+ (let-values (((enclosing_12) (let-values (((enclosing_13) base_16)) enclosing_13)))
+ (let-values (((lst_39) (cddr p_10)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_38)))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_39))
((letrec-values (((for-loop_32)
- (lambda (enclosing_10 lst_39)
+ (lambda (enclosing_14 lst_40)
(begin
'for-loop
- (if (pair? lst_39)
- (let-values (((s_45) (unsafe-car lst_39)) ((rest_16) (unsafe-cdr lst_39)))
- (let-values (((enclosing_11)
- (let-values (((enclosing_12) enclosing_10))
- (let-values (((enclosing_13)
- (let-values ()
- (let-values (((s28_0) s_45)
- ((enclosing29_0)
- enclosing_12)
- ((p30_0) p_9))
- (build-module-name.1
- p30_0
- s28_0
- enclosing29_0)))))
- (values enclosing_13)))))
- (if (not #f) (for-loop_32 enclosing_11 rest_16) enclosing_11)))
- enclosing_10)))))
+ (if (pair? lst_40)
+ (let-values (((s_50) (unsafe-car lst_40)) ((rest_16) (unsafe-cdr lst_40)))
+ (let-values (((enclosing_15)
+ (let-values (((enclosing_16)
+ (let-values (((s28_0) s_50)
+ ((enclosing29_0) enclosing_14)
+ ((p30_0) p_10))
+ (build-module-name.1
+ p30_0
+ s28_0
+ enclosing29_0))))
+ (values enclosing_16))))
+ (if (not #f) (for-loop_32 enclosing_15 rest_16) enclosing_15)))
+ enclosing_14)))))
for-loop_32)
- base_14
- lst_38)))))
- (let-values () (error 'core-module-name-resolver "not a supported module path: ~v" p_9))))))))))
+ enclosing_12
+ lst_39)))))
+ (error 'core-module-name-resolver "not a supported module path: ~v" p_10)))))))))
(define-values
(build-module-name.1)
(lambda (original9_0 name11_0 enclosing12_0)
(begin
'build-module-name
- (let-values (((name_15) name11_0))
- (let-values (((enclosing_14) enclosing12_0))
- (let-values (((orig-name_0) (if (eq? original9_0 unsafe-undefined) name_15 original9_0)))
- (let-values ()
- (let-values (((enclosing-module-name_0) (if enclosing_14 (1/resolved-module-path-name enclosing_14) #f)))
- (1/make-resolved-module-path
+ (let-values (((name_14) name11_0))
+ (let-values (((enclosing_17) enclosing12_0))
+ (let-values (((orig-name_0) (if (eq? original9_0 unsafe-undefined) name_14 original9_0)))
+ (let-values (((enclosing-module-name_0) (if enclosing_17 (1/resolved-module-path-name enclosing_17) #f)))
+ (1/make-resolved-module-path
+ (if (equal? name_14 "..")
+ (if (not (pair? 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)))))
(if (not enclosing-module-name_0)
- (let-values () name_15)
- (if (symbol? enclosing-module-name_0)
- (let-values () (list enclosing-module-name_0 name_15))
- (if (equal? name_15 "..")
- (let-values ()
- (if (symbol? enclosing-module-name_0)
- (let-values () (error "too many \"..\"s:" orig-name_0))
- (if (= 2 (length enclosing-module-name_0))
- (let-values () (car enclosing-module-name_0))
- (let-values () (reverse$1 (cdr (reverse$1 enclosing-module-name_0)))))))
- (let-values () (append enclosing-module-name_0 (list name_15)))))))))))))))
+ name_14
+ (if (pair? enclosing-module-name_0)
+ (append enclosing-module-name_0 (list name_14))
+ (list enclosing-module-name_0 name_14))))))))))))
(define-values
(1/current-module-name-resolver)
(make-parameter
core-module-name-resolver
- (lambda (v_45)
+ (lambda (v_63)
(begin
- (if (if (procedure? v_45) (if (procedure-arity-includes? v_45 2) (procedure-arity-includes? v_45 4) #f) #f)
+ (if (if (procedure? v_63) (if (procedure-arity-includes? v_63 2) (procedure-arity-includes? v_63 4) #f) #f)
(void)
- (let-values ()
- (raise-argument-error
- 'current-module-name-resolver
- "(and/c (procedure-arity-includes/c 2) (procedure-arity-includes/c 4))"
- v_45)))
- v_45))
+ (raise-argument-error
+ 'current-module-name-resolver
+ "(and/c (procedure-arity-includes/c 2) (procedure-arity-includes/c 4))"
+ v_63))
+ v_63))
'current-module-name-resolver))
(define-values
(1/current-module-declare-name)
(make-parameter
#f
- (lambda (r_18)
+ (lambda (r_21)
(begin
- (if (let-values (((or-part_68) (not r_18))) (if or-part_68 or-part_68 (1/resolved-module-path? r_18)))
+ (if (let-values (((or-part_93) (not r_21))) (if or-part_93 or-part_93 (1/resolved-module-path? r_21)))
(void)
- (let-values () (raise-argument-error 'current-module-declare-name "(or/c #f resolved-module-path?)" r_18)))
- r_18))
+ (raise-argument-error 'current-module-declare-name "(or/c #f resolved-module-path?)" r_21))
+ r_21))
'current-module-declare-name))
(define-values
(1/current-module-declare-source)
(make-parameter
#f
- (lambda (s_46)
+ (lambda (s_51)
(begin
- (if (let-values (((or-part_69) (not s_46)))
- (if or-part_69
- or-part_69
- (let-values (((or-part_70) (symbol? s_46)))
- (if or-part_70 or-part_70 (if (path? s_46) (complete-path? s_46) #f)))))
+ (if (let-values (((or-part_94) (not s_51)))
+ (if or-part_94
+ or-part_94
+ (let-values (((or-part_95) (symbol? s_51)))
+ (if or-part_95 or-part_95 (if (path? s_51) (complete-path? s_51) #f)))))
(void)
- (let-values ()
- (raise-argument-error 'current-module-declare-source "(or/c #f symbol? (and/c path? complete-path?))" s_46)))
- s_46))
+ (raise-argument-error 'current-module-declare-source "(or/c #f symbol? (and/c path? complete-path?))" s_51))
+ s_51))
'current-module-declare-source))
(define-values
(substitute-module-declare-name)
@@ -5379,20 +5065,18 @@
(define-values
(struct:promise promise1.1 promise? promise-val promise-status set-promise-val! set-promise-status!)
(let-values (((struct:_6 make-_6 ?_6 -ref_6 -set!_6)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'promise
- #f
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '()
- #f
- 'promise)))))
+ (make-struct-type
+ 'promise
+ #f
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '()
+ #f
+ 'promise)))
(values
struct:_6
make-_6
@@ -5403,40 +5087,39 @@
(make-struct-field-mutator -set!_6 1 'status))))
(define-values
(force)
- (lambda (v_46)
+ (lambda (v_64)
(begin
- (if (promise? v_46)
- (let-values ()
- (let-values (((s_47) (promise-status v_46)))
- (if (not s_47)
- (let-values ()
- (let-values (((result_31) ((promise-val v_46))))
- (begin (set-promise-val! v_46 result_31) (set-promise-status! v_46 #t) result_31)))
- (let-values () (promise-val v_46)))))
- (let-values () v_46)))))
+ (if (promise? v_64)
+ (let-values (((s_52) (promise-status v_64)))
+ (if (not s_52)
+ (let-values (((result_51) ((promise-val v_64))))
+ (begin (set-promise-val! v_64 result_51) (set-promise-status! v_64 #t) result_51))
+ (promise-val v_64)))
+ v_64))))
(define-values
(phase?)
- (lambda (v_29) (begin (let-values (((or-part_1) (not v_29))) (if or-part_1 or-part_1 (exact-integer? v_29))))))
- (define-values (interned-symbol?) (lambda (v_30) (begin (if (symbol? v_30) (symbol-interned? v_30) #f))))
+ (lambda (v_65) (begin (let-values (((or-part_96) (not v_65))) (if or-part_96 or-part_96 (exact-integer? v_65))))))
+ (define-values (interned-symbol?) (lambda (v_66) (begin (if (symbol? v_66) (symbol-interned? v_66) #f))))
(define-values
(space?)
- (lambda (v_0) (begin (let-values (((or-part_3) (not v_0))) (if or-part_3 or-part_3 (interned-symbol? v_0))))))
+ (lambda (v_67) (begin (let-values (((or-part_97) (not v_67))) (if or-part_97 or-part_97 (interned-symbol? v_67))))))
(define-values
(phase+space?)
- (lambda (v_47)
+ (lambda (v_68)
(begin
- (let-values (((or-part_71) (phase? v_47)))
- (if or-part_71 or-part_71 (if (pair? v_47) (if (interned-symbol? (cdr v_47)) (phase? (car v_47)) #f) #f))))))
+ (let-values (((or-part_98) (phase? v_68)))
+ (if or-part_98 or-part_98 (if (pair? v_68) (if (interned-symbol? (cdr v_68)) (phase? (car v_68)) #f) #f))))))
(define-values
(phase+space-shift?)
- (lambda (v_48)
- (begin
- (let-values (((or-part_0) (phase? v_48)))
- (if or-part_0
- or-part_0
- (if (pair? v_48)
- (if (let-values (((or-part_72) (not (cdr v_48)))) (if or-part_72 or-part_72 (interned-symbol? (cdr v_48))))
- (phase? (car v_48))
+ (lambda (v_69)
+ (begin
+ (let-values (((or-part_99) (phase? v_69)))
+ (if or-part_99
+ or-part_99
+ (if (pair? v_69)
+ (if (let-values (((or-part_100) (not (cdr v_69))))
+ (if or-part_100 or-part_100 (interned-symbol? (cdr v_69))))
+ (phase? (car v_69))
#f)
#f))))))
(define-values
@@ -5459,7 +5142,7 @@
(if (pair? p+s_1) (cdr p+s_1) #f)))))
(define-values
(phase+space+$1)
- (lambda (p+s_2 s_48)
+ (lambda (p+s_2 s_53)
(begin
'phase+space+
(begin
@@ -5467,20 +5150,17 @@
(void)
(begin
(if (phase+space? p+s_2) (void) (raise-argument-error 'phase+space+ "phase+space?" p+s_2))
- (if (phase+space-shift? s_48) (void) (raise-argument-error 'phase+space+ "phase+space-shift?" s_48))))
+ (if (phase+space-shift? s_53) (void) (raise-argument-error 'phase+space+ "phase+space-shift?" s_53))))
(let-values (((p1_0) (if (pair? p+s_2) (car p+s_2) p+s_2))
- ((p2_0) (if (pair? s_48) (car s_48) s_48))
+ ((p2_0) (if (pair? s_53) (car s_53) s_53))
((sp1_0) (if (pair? p+s_2) (cdr p+s_2) #f)))
- (let-values (((p_10) (if p1_0 (if p2_0 (+ p1_0 p2_0) #f) #f)) ((sp_0) (if (pair? s_48) (cdr s_48) sp1_0)))
- (if sp_0 (cons p_10 sp_0) p_10)))))))
- (define-values (phase+) (lambda (a_18 b_14) (begin (if a_18 (if b_14 (+ a_18 b_14) #f) #f))))
- (define-values (phase-) (lambda (a_2 b_15) (begin (if a_2 (if b_15 (- a_2 b_15) #f) #f))))
- (define-values
- (phase)
- (lambda (a_19 b_16)
- (begin (if (not b_16) (let-values () #f) (if (not a_19) (let-values () #t) (let-values () (< a_19 b_16)))))))
- (define-values (zero-phase?) (lambda (a_20) (begin (eq? a_20 0))))
- (define-values (label-phase?) (lambda (a_21) (begin (not a_21))))
+ (let-values (((p_11) (if p1_0 (if p2_0 (+ p1_0 p2_0) #f) #f)) ((sp_0) (if (pair? s_53) (cdr s_53) sp1_0)))
+ (if sp_0 (cons p_11 sp_0) p_11)))))))
+ (define-values (phase+) (lambda (a_18 b_15) (begin (if a_18 (if b_15 (+ a_18 b_15) #f) #f))))
+ (define-values (phase-) (lambda (a_19 b_16) (begin (if a_19 (if b_16 (- a_19 b_16) #f) #f))))
+ (define-values (phase) (lambda (a_20 b_17) (begin (if (not b_17) #f (if (not a_20) #t (< a_20 b_17))))))
+ (define-values (zero-phase?) (lambda (a_21) (begin (eq? a_21 0))))
+ (define-values (label-phase?) (lambda (a_22) (begin (not a_22))))
(define-values (phase?-string) "phase?")
(define-values (make-small-hasheq) (lambda () (begin (box '#hasheq()))))
(define-values (make-small-hasheqv) (lambda () (begin (box '#hasheqv()))))
@@ -5496,72 +5176,87 @@
serialize-state1.1
serialize-state?
serialize-state-reachable-scopes
+ serialize-state-implicitly-reachable-scopes
+ serialize-state-all-reachable-scopes
serialize-state-bindings-intern
serialize-state-bulk-bindings-intern
serialize-state-scopes
serialize-state-shifted-multi-scopes
serialize-state-multi-scope-tables
serialize-state-mpi-shifts
+ serialize-state-drop-shifts?
serialize-state-context-triples
serialize-state-props
serialize-state-interned-props
serialize-state-syntax-context
serialize-state-sharing-syntaxes
serialize-state-preserve-prop-keys
- serialize-state-keep-provides?)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'serialize-state
- #f
- 14
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6 7 8 9 10 11 12 13)
- #f
- 'serialize-state)))))
+ serialize-state-keep-provides?
+ serialize-state-map-binding-symbol)
+ (let-values (((struct:_7 make-_7 ?_7 -ref_7 -set!_7)
+ (make-struct-type
+ 'serialize-state
+ #f
+ 18
+ 0
+ #f
+ (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)
+ #f
+ 'serialize-state)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'reachable-scopes)
- (make-struct-field-accessor -ref_2 1 'bindings-intern)
- (make-struct-field-accessor -ref_2 2 'bulk-bindings-intern)
- (make-struct-field-accessor -ref_2 3 'scopes)
- (make-struct-field-accessor -ref_2 4 'shifted-multi-scopes)
- (make-struct-field-accessor -ref_2 5 'multi-scope-tables)
- (make-struct-field-accessor -ref_2 6 'mpi-shifts)
- (make-struct-field-accessor -ref_2 7 'context-triples)
- (make-struct-field-accessor -ref_2 8 'props)
- (make-struct-field-accessor -ref_2 9 'interned-props)
- (make-struct-field-accessor -ref_2 10 'syntax-context)
- (make-struct-field-accessor -ref_2 11 'sharing-syntaxes)
- (make-struct-field-accessor -ref_2 12 'preserve-prop-keys)
- (make-struct-field-accessor -ref_2 13 'keep-provides?))))
- (define-values
+ struct:_7
+ make-_7
+ ?_7
+ (make-struct-field-accessor -ref_7 0 'reachable-scopes)
+ (make-struct-field-accessor -ref_7 1 'implicitly-reachable-scopes)
+ (make-struct-field-accessor -ref_7 2 'all-reachable-scopes)
+ (make-struct-field-accessor -ref_7 3 'bindings-intern)
+ (make-struct-field-accessor -ref_7 4 'bulk-bindings-intern)
+ (make-struct-field-accessor -ref_7 5 'scopes)
+ (make-struct-field-accessor -ref_7 6 'shifted-multi-scopes)
+ (make-struct-field-accessor -ref_7 7 'multi-scope-tables)
+ (make-struct-field-accessor -ref_7 8 'mpi-shifts)
+ (make-struct-field-accessor -ref_7 9 'drop-shifts?)
+ (make-struct-field-accessor -ref_7 10 'context-triples)
+ (make-struct-field-accessor -ref_7 11 'props)
+ (make-struct-field-accessor -ref_7 12 'interned-props)
+ (make-struct-field-accessor -ref_7 13 'syntax-context)
+ (make-struct-field-accessor -ref_7 14 'sharing-syntaxes)
+ (make-struct-field-accessor -ref_7 15 'preserve-prop-keys)
+ (make-struct-field-accessor -ref_7 16 'keep-provides?)
+ (make-struct-field-accessor -ref_7 17 'map-binding-symbol))))
+ (define-values
(make-serialize-state)
- (lambda (reachable-scopes_0 preserve-prop-keys_0 keep-provides?_0)
+ (lambda (reachable-scopes_0
+ implicitly-reachable-scopes_0
+ preserve-prop-keys_0
+ keep-provides?_0
+ drop-shifts?_0
+ map-binding-symbol_0)
(begin
(let-values (((state_1)
(serialize-state1.1
reachable-scopes_0
+ implicitly-reachable-scopes_0
+ (set-union reachable-scopes_0 implicitly-reachable-scopes_0)
(make-hasheq)
(make-hasheq)
(make-hash)
(make-hash)
(make-hasheq)
(make-hasheq)
+ drop-shifts?_0
(make-hasheq)
(make-hasheq)
(make-hash)
(box null)
(make-hasheq)
preserve-prop-keys_0
- keep-provides?_0)))
+ keep-provides?_0
+ map-binding-symbol_0)))
(let-values (((empty-seteq_0) (seteq)))
(begin
(hash-set! (serialize-state-scopes state_1) empty-seteq_0 empty-seteq_0)
@@ -5572,93 +5267,90 @@
(intern-scopes)
(lambda (scs_0 state_2)
(begin
- (let-values (((or-part_14) (hash-ref (serialize-state-scopes state_2) scs_0 #f)))
- (if or-part_14 or-part_14 (begin (hash-set! (serialize-state-scopes state_2) scs_0 scs_0) scs_0))))))
+ (let-values (((or-part_101) (hash-ref (serialize-state-scopes state_2) scs_0 #f)))
+ (if or-part_101 or-part_101 (begin (hash-set! (serialize-state-scopes state_2) scs_0 scs_0) scs_0))))))
(define-values
(intern-shifted-multi-scopes)
(lambda (sms_0 state_3)
(begin
- (let-values (((or-part_73) (hash-ref (serialize-state-shifted-multi-scopes state_3) sms_0 #f)))
- (if or-part_73
- or-part_73
+ (let-values (((or-part_102) (hash-ref (serialize-state-shifted-multi-scopes state_3) sms_0 #f)))
+ (if or-part_102
+ or-part_102
(begin (hash-set! (serialize-state-shifted-multi-scopes state_3) sms_0 sms_0) sms_0))))))
(define-values
(intern-mpi-shifts)
(lambda (mpi-shifts_0 state_4)
(begin
(if (null? mpi-shifts_0)
- (let-values () null)
- (let-values ()
- (let-values (((tail_0) (intern-mpi-shifts (cdr mpi-shifts_0) state_4)))
- (let-values (((tail-table_0)
- (let-values (((or-part_74) (hash-ref (serialize-state-mpi-shifts state_4) tail_0 #f)))
- (if or-part_74
- or-part_74
- (let-values (((ht_29) (make-hasheq)))
- (begin (hash-set! (serialize-state-mpi-shifts state_4) tail_0 ht_29) ht_29))))))
- (let-values (((or-part_75) (hash-ref tail-table_0 (car mpi-shifts_0) #f)))
- (if or-part_75
- or-part_75
- (let-values (((v_49) (cons (car mpi-shifts_0) tail_0)))
- (begin (hash-set! tail-table_0 (car mpi-shifts_0) v_49) v_49)))))))))))
+ null
+ (let-values (((tail_0) (intern-mpi-shifts (cdr mpi-shifts_0) state_4)))
+ (let-values (((tail-table_0)
+ (let-values (((or-part_103) (hash-ref (serialize-state-mpi-shifts state_4) tail_0 #f)))
+ (if or-part_103
+ or-part_103
+ (let-values (((ht_31) (make-hasheq)))
+ (begin (hash-set! (serialize-state-mpi-shifts state_4) tail_0 ht_31) ht_31))))))
+ (let-values (((or-part_104) (hash-ref tail-table_0 (car mpi-shifts_0) #f)))
+ (if or-part_104
+ or-part_104
+ (let-values (((v_70) (cons (car mpi-shifts_0) tail_0)))
+ (begin (hash-set! tail-table_0 (car mpi-shifts_0) v_70) v_70))))))))))
(define-values
(intern-context-triple)
(lambda (scs_1 sms_1 mpi-shifts_1 state_5)
(begin
(let-values (((scs-ht_0)
- (let-values (((or-part_7) (hash-ref (serialize-state-context-triples state_5) scs_1 #f)))
- (if or-part_7
- or-part_7
- (let-values (((ht_30) (make-hasheq)))
- (begin (hash-set! (serialize-state-context-triples state_5) scs_1 ht_30) ht_30))))))
+ (let-values (((or-part_105) (hash-ref (serialize-state-context-triples state_5) scs_1 #f)))
+ (if or-part_105
+ or-part_105
+ (let-values (((ht_32) (make-hasheq)))
+ (begin (hash-set! (serialize-state-context-triples state_5) scs_1 ht_32) ht_32))))))
(let-values (((sms-ht_0)
- (let-values (((or-part_35) (hash-ref scs-ht_0 sms_1 #f)))
- (if or-part_35
- or-part_35
- (let-values (((ht_31) (make-hasheq))) (begin (hash-set! scs-ht_0 sms_1 ht_31) ht_31))))))
- (let-values (((or-part_76) (hash-ref sms-ht_0 mpi-shifts_1 #f)))
- (if or-part_76
- or-part_76
+ (let-values (((or-part_106) (hash-ref scs-ht_0 sms_1 #f)))
+ (if or-part_106
+ or-part_106
+ (let-values (((ht_33) (make-hasheq))) (begin (hash-set! scs-ht_0 sms_1 ht_33) ht_33))))))
+ (let-values (((or-part_107) (hash-ref sms-ht_0 mpi-shifts_1 #f)))
+ (if or-part_107
+ or-part_107
(let-values (((vec_14) (vector-immutable scs_1 sms_1 mpi-shifts_1)))
(begin (hash-set! sms-ht_0 mpi-shifts_1 vec_14) vec_14)))))))))
(define-values
(intern-properties)
(lambda (all-props_0 get-preserved-props_0 state_6)
(begin
- (let-values (((v_50) (hash-ref (serialize-state-props state_6) all-props_0 'no)))
- (if (eq? v_50 'no)
- (let-values ()
- (let-values (((preserved-props_0) (get-preserved-props_0)))
- (let-values (((p_11)
- (if (zero? (hash-count preserved-props_0))
- (let-values () #f)
- (let-values (((c1_18)
- (hash-ref (serialize-state-interned-props state_6) preserved-props_0 #f)))
- (if c1_18
- ((lambda (p_12) p_12) c1_18)
- (let-values ()
- (begin
- (hash-set!
- (serialize-state-interned-props state_6)
- preserved-props_0
- preserved-props_0)
- preserved-props_0)))))))
- (begin (hash-set! (serialize-state-props state_6) all-props_0 p_11) p_11))))
- (let-values () v_50))))))
+ (let-values (((v_71) (hash-ref (serialize-state-props state_6) all-props_0 'no)))
+ (if (eq? v_71 'no)
+ (let-values (((preserved-props_0) (get-preserved-props_0)))
+ (let-values (((p_12)
+ (if (zero? (hash-count preserved-props_0))
+ #f
+ (let-values (((cond-val_1)
+ (hash-ref (serialize-state-interned-props state_6) preserved-props_0 #f)))
+ (if cond-val_1
+ ((lambda (p_13) p_13) cond-val_1)
+ (begin
+ (hash-set!
+ (serialize-state-interned-props state_6)
+ preserved-props_0
+ preserved-props_0)
+ preserved-props_0))))))
+ (begin (hash-set! (serialize-state-props state_6) all-props_0 p_12) p_12)))
+ v_71)))))
(define-values
(push-syntax-context!)
- (lambda (state_7 v_51)
- (begin (let-values (((b_17) (serialize-state-syntax-context state_7))) (set-box! b_17 (cons v_51 (unbox b_17)))))))
+ (lambda (state_7 v_72)
+ (begin (let-values (((b_18) (serialize-state-syntax-context state_7))) (set-box! b_18 (cons v_72 (unbox b_18)))))))
(define-values
(get-syntax-context)
(lambda (state_8)
(begin
- (let-values (((b_18) (serialize-state-syntax-context state_8)))
- (if (null? (unbox b_18)) #f (car (unbox b_18)))))))
+ (let-values (((b_19) (serialize-state-syntax-context state_8)))
+ (if (null? (unbox b_19)) #f (car (unbox b_19)))))))
(define-values
(pop-syntax-context!)
(lambda (state_9)
- (begin (let-values (((b_19) (serialize-state-syntax-context state_9))) (set-box! b_19 (cdr (unbox b_19)))))))
+ (begin (let-values (((b_20) (serialize-state-syntax-context state_9))) (set-box! b_20 (cdr (unbox b_20)))))))
(define-values (root-tag) (unsafe-root-continuation-prompt-tag))
(define-values (default-val.1$2) #f)
(define-values
@@ -5666,28 +5358,26 @@
(lambda () (begin (continuation-mark-set-first #f current-module-code-inspector default-val.1$2 root-tag))))
(define-values
(immutable-prefab-struct-key)
- (lambda (v_29)
- (begin (let-values (((k_13) (prefab-struct-key v_29))) (if k_13 (if (all-fields-immutable?$1 k_13) k_13 #f) #f)))))
+ (lambda (v_73)
+ (begin (let-values (((k_13) (prefab-struct-key v_73))) (if k_13 (if (all-fields-immutable?$1 k_13) k_13 #f) #f)))))
(define-values
(prefab-key-all-fields-immutable?)
(lambda (k_14)
(begin
(begin
- (if (prefab-key? k_14)
- (void)
- (let-values () (raise-argument-error 'prefab-key-all-fields-immutable? "prefab-key?" k_14)))
+ (if (prefab-key? k_14) (void) (raise-argument-error 'prefab-key-all-fields-immutable? "prefab-key?" k_14))
(all-fields-immutable?$1 k_14)))))
(define-values
(all-fields-immutable?$1)
(lambda (k_15)
(begin
'all-fields-immutable?
- (let-values (((or-part_3) (symbol? k_15)))
- (if or-part_3
- or-part_3
- (let-values (((or-part_31) (null? k_15)))
- (if or-part_31
- or-part_31
+ (let-values (((or-part_108) (symbol? k_15)))
+ (if or-part_108
+ or-part_108
+ (let-values (((or-part_109) (null? k_15)))
+ (if or-part_109
+ or-part_109
(let-values (((rk_0) (cdr k_15)))
(let-values (((rk_1) (if (if (pair? rk_0) (exact-integer? (car rk_0)) #f) (cdr rk_0) rk_0)))
(let-values (((rk_2)
@@ -5700,142 +5390,127 @@
(define-values (all-fields-immutable?) (lambda (k_16) (begin (prefab-key-all-fields-immutable? k_16))))
(define-values
(datum-map-slow)
- (lambda (tail?_0 s_7 f_20 seen_0 known-pairs_0)
+ (lambda (tail?_0 s_54 f_19 seen_0 known-pairs_0)
(begin
- ((letrec-values (((loop_57)
- (lambda (tail?_1 s_9 prev-seen_0)
+ ((letrec-values (((loop_59)
+ (lambda (tail?_1 s_55 prev-seen_0)
(begin
'loop
(let-values (((seen_1)
- (if (if prev-seen_0 (datum-has-elements? s_9) #f)
- (let-values ()
- (if (hash-ref prev-seen_0 s_9 #f)
- (let-values () ((hash-ref prev-seen_0 'cycle-fail) s_9))
- (let-values () (hash-set prev-seen_0 s_9 #t))))
- (let-values () prev-seen_0))))
- (if (null? s_9)
- (let-values () (f_20 tail?_1 s_9))
- (if (pair? s_9)
- (let-values ()
- (if (if known-pairs_0 (if tail?_1 (hash-ref known-pairs_0 s_9 #f) #f) #f)
- (let-values () s_9)
- (let-values ()
- (f_20
- tail?_1
- (cons
- (loop_57 #f (car s_9) seen_1)
- (loop_57 (if tail?_1 (fx+ 1 tail?_1) 1) (cdr s_9) seen_1))))))
- (if (let-values (((or-part_77) (symbol? s_9)))
- (if or-part_77
- or-part_77
- (let-values (((or-part_78) (boolean? s_9)))
- (if or-part_78 or-part_78 (number? s_9)))))
- (let-values () (f_20 #f s_9))
- (if (vector? s_9)
- (let-values ()
- (f_20
- #f
- (vector->immutable-vector
- (let-values (((len_7) (vector-length s_9)))
- (begin
- (if (exact-nonnegative-integer? len_7)
- (void)
- (let-values ()
- (raise-argument-error
- 'for/vector
- "exact-nonnegative-integer?"
- len_7)))
- (let-values (((v_52) (make-vector len_7 0)))
- (begin
- (if (zero? len_7)
- (void)
- (let-values ()
- (let-values (((vec_15 len_8)
- (let-values (((vec_16) s_9))
- (begin
- (check-vector vec_16)
- (values
- vec_16
- (unsafe-vector-length vec_16))))))
- (begin
- #f
- ((letrec-values (((for-loop_33)
- (lambda (i_43 pos_8)
- (begin
- 'for-loop
- (if (unsafe-fx< pos_8 len_8)
- (let-values (((e_10)
- (unsafe-vector-ref
- vec_15
- pos_8)))
- (let-values (((i_46)
- (let-values (((i_47)
- i_43))
- (let-values (((i_48)
- (let-values ()
- (begin
- (unsafe-vector*-set!
- v_52
- i_47
- (let-values ()
- (loop_57
- #f
- e_10
- seen_1)))
- (unsafe-fx+
- 1
- i_47)))))
- (values i_48)))))
- (if (if (not
- ((lambda x_18
- (unsafe-fx=
- i_46
- len_7))
- e_10))
- (not #f)
- #f)
- (for-loop_33
- i_46
- (unsafe-fx+ 1 pos_8))
- i_46)))
- i_43)))))
- for-loop_33)
- 0
- 0)))))
- v_52)))))))
- (if (box? s_9)
- (let-values () (f_20 #f (box-immutable (loop_57 #f (unbox s_9) seen_1))))
- (let-values (((c1_19) (immutable-prefab-struct-key s_9)))
- (if c1_19
+ (if (if prev-seen_0 (datum-has-elements? s_55) #f)
+ (if (hash-ref prev-seen_0 s_55 #f)
+ ((hash-ref prev-seen_0 'cycle-fail) s_55)
+ (hash-set prev-seen_0 s_55 #t))
+ prev-seen_0)))
+ (if (null? s_55)
+ (f_19 tail?_1 s_55)
+ (if (pair? s_55)
+ (if (if known-pairs_0 (if tail?_1 (hash-ref known-pairs_0 s_55 #f) #f) #f)
+ s_55
+ (f_19
+ tail?_1
+ (cons
+ (loop_59 #f (car s_55) seen_1)
+ (loop_59 (if tail?_1 (fx+ 1 tail?_1) 1) (cdr s_55) seen_1))))
+ (if (let-values (((or-part_110) (symbol? s_55)))
+ (if or-part_110
+ or-part_110
+ (let-values (((or-part_111) (boolean? s_55)))
+ (if or-part_111 or-part_111 (number? s_55)))))
+ (f_19 #f s_55)
+ (if (vector? s_55)
+ (f_19
+ #f
+ (vector->immutable-vector
+ (let-values (((len_7) (vector-length s_55)))
+ (begin
+ (if (exact-nonnegative-integer? len_7)
+ (void)
+ (1/raise-argument-error 'for/vector "exact-nonnegative-integer?" len_7))
+ (let-values (((v_74) (make-vector len_7 0)))
+ (begin
+ (if (zero? len_7)
+ (void)
+ (let-values (((i_63) (let-values (((i_64) 0)) i_64)))
+ (let-values (((vec_15 len_8)
+ (let-values (((vec_16) s_55))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-vector vec_16))
+ (values vec_16 (unsafe-vector-length vec_16))))))
+ ((letrec-values (((for-loop_33)
+ (lambda (i_65 pos_14)
+ (begin
+ 'for-loop
+ (if (unsafe-fx< pos_14 len_8)
+ (let-values (((e_10)
+ (unsafe-vector-ref
+ vec_15
+ pos_14)))
+ (let-values (((i_66)
+ (let-values (((i_67)
+ (begin
+ (unsafe-vector*-set!
+ v_74
+ i_65
+ (loop_59
+ #f
+ e_10
+ seen_1))
+ (unsafe-fx+
+ 1
+ i_65))))
+ (values i_67))))
+ (if (if (not
+ ((lambda x_20
+ (unsafe-fx= i_66 len_7))
+ e_10))
+ (not #f)
+ #f)
+ (for-loop_33
+ i_66
+ (unsafe-fx+ 1 pos_14))
+ i_66)))
+ i_65)))))
+ for-loop_33)
+ i_63
+ 0))))
+ v_74))))))
+ (if (box? s_55)
+ (f_19 #f (box-immutable (loop_59 #f (unbox s_55) seen_1)))
+ (let-values (((cond-val_2) (immutable-prefab-struct-key s_55)))
+ (if cond-val_2
((lambda (key_15)
- (f_20
+ (f_19
#f
(apply
make-prefab-struct
key_15
(reverse$1
- (let-values (((v*_0 start*_0 stop*_1 step*_0)
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (unsafe-normalise-inputs
- unsafe-vector-length
- (struct->vector s_9)
- 1
- #f
- 1)
- (normalise-inputs
- 'in-vector
- "vector"
- (lambda (x_19) (vector? x_19))
- (lambda (x_20) (unsafe-vector-length x_20))
- (struct->vector s_9)
- 1
- #f
- 1))))
- (begin
- #t
+ (let-values (((fold-var_25)
+ (let-values (((fold-var_26) null)) fold-var_26)))
+ (let-values (((v*_0 start*_0 stop*_1 step*_0)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (unsafe-normalise-inputs
+ unsafe-vector-length
+ (struct->vector s_55)
+ 1
+ #f
+ 1)
+ (normalise-inputs
+ 'in-vector
+ "vector"
+ (lambda (x_21) (vector? x_21))
+ (lambda (x_22) (unsafe-vector-length x_22))
+ (struct->vector s_55)
+ 1
+ #f
+ 1))))
((letrec-values (((for-loop_34)
- (lambda (fold-var_20 idx_0)
+ (lambda (fold-var_27 idx_0)
(begin
'for-loop
(if (unsafe-fx< idx_0 stop*_1)
@@ -5843,235 +5518,217 @@
(unsafe-vector-ref
v*_0
idx_0)))
- (let-values (((fold-var_21)
- (let-values (((fold-var_22)
- fold-var_20))
- (let-values (((fold-var_16)
- (let-values ()
- (cons
- (let-values ()
- (loop_57
- #f
- e_11
- seen_1))
- fold-var_22))))
- (values
- fold-var_16)))))
+ (let-values (((fold-var_28)
+ (let-values (((fold-var_29)
+ (cons
+ (loop_59
+ #f
+ e_11
+ seen_1)
+ fold-var_27)))
+ (values fold-var_29))))
(if (not #f)
(for-loop_34
- fold-var_21
+ fold-var_28
(unsafe-fx+ idx_0 1))
- fold-var_21)))
- fold-var_20)))))
+ fold-var_28)))
+ fold-var_27)))))
for-loop_34)
- null
+ fold-var_25
start*_0)))))))
- c1_19)
- (if (if (hash? s_9) (immutable? s_9) #f)
- (let-values ()
- (f_20
- #f
- (let-values (((s6_0) s_9)
- ((temp7_1)
- (lambda (k_17 v_53)
- (values k_17 (loop_57 #f v_53 seen_1))))
- ((temp8_0) 'immutable))
- (hash-map/copy.1 temp8_0 s6_0 temp7_1))))
- (let-values () (f_20 #f s_9)))))))))))))))
- loop_57)
+ cond-val_2)
+ (if (if (hash? s_55) (immutable? s_55) #f)
+ (f_19
+ #f
+ (let-values (((s6_0) s_55)
+ ((temp7_1)
+ (lambda (k_17 v_75)
+ (values k_17 (loop_59 #f v_75 seen_1))))
+ ((temp8_0) 'immutable))
+ (hash-map/copy.1 temp8_0 s6_0 temp7_1)))
+ (f_19 #f s_55))))))))))))))
+ loop_59)
tail?_0
- s_7
+ s_54
seen_0))))
(define-values
(datum-has-elements?)
(lambda (d_0)
(begin
- (let-values (((or-part_79) (pair? d_0)))
- (if or-part_79
- or-part_79
- (let-values (((or-part_80) (vector? d_0)))
- (if or-part_80
- or-part_80
- (let-values (((or-part_81) (box? d_0)))
- (if or-part_81
- or-part_81
- (let-values (((or-part_82) (immutable-prefab-struct-key d_0)))
- (if or-part_82
- or-part_82
+ (let-values (((or-part_112) (pair? d_0)))
+ (if or-part_112
+ or-part_112
+ (let-values (((or-part_113) (vector? d_0)))
+ (if or-part_113
+ or-part_113
+ (let-values (((or-part_114) (box? d_0)))
+ (if or-part_114
+ or-part_114
+ (let-values (((or-part_115) (immutable-prefab-struct-key d_0)))
+ (if or-part_115
+ or-part_115
(if (hash? d_0) (if (immutable? d_0) (positive? (hash-count d_0)) #f) #f))))))))))))
(define-values
(struct:preserved-property-value
preserved-property-value1.1
preserved-property-value?
preserved-property-value-content)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'preserved-property-value
- #f
- 1
- 0
- #f
- null
- (current-inspector)
- #f
- '(0)
- #f
- 'preserved-property-value)))))
- (values struct:_2 make-_2 ?_2 (make-struct-field-accessor -ref_2 0 'content))))
+ (let-values (((struct:_8 make-_8 ?_8 -ref_8 -set!_8)
+ (make-struct-type
+ 'preserved-property-value
+ #f
+ 1
+ 0
+ #f
+ null
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'preserved-property-value)))
+ (values struct:_8 make-_8 ?_8 (make-struct-field-accessor -ref_8 0 'content))))
(define-values
(plain-property-value)
- (lambda (v_54) (begin (if (preserved-property-value? v_54) (preserved-property-value-content v_54) v_54))))
+ (lambda (v_76) (begin (if (preserved-property-value? v_76) (preserved-property-value-content v_76) v_76))))
(define-values
(check-value-to-preserve)
- (lambda (v_55 syntax?_0)
+ (lambda (v_77 syntax?_0)
(begin
(let-values (((check-preserve_0)
- (lambda (tail?_2 v_56)
+ (lambda (tail?_2 v_78)
(begin
'check-preserve
(begin
- (if (let-values (((or-part_14) (null? v_56)))
- (if or-part_14
- or-part_14
- (let-values (((or-part_83) (boolean? v_56)))
- (if or-part_83
- or-part_83
- (let-values (((or-part_15) (symbol? v_56)))
- (if or-part_15
- or-part_15
- (let-values (((or-part_73) (number? v_56)))
- (if or-part_73
- or-part_73
- (let-values (((or-part_84) (char? v_56)))
- (if or-part_84
- or-part_84
- (let-values (((or-part_58) (string? v_56)))
- (if or-part_58
- or-part_58
- (let-values (((or-part_34) (bytes? v_56)))
- (if or-part_34
- or-part_34
- (let-values (((or-part_85) (regexp? v_56)))
- (if or-part_85
- or-part_85
- (let-values (((or-part_74) (syntax?_0 v_56)))
- (if or-part_74
- or-part_74
- (let-values (((or-part_86) (pair? v_56)))
- (if or-part_86
- or-part_86
- (let-values (((or-part_75) (vector? v_56)))
- (if or-part_75
- or-part_75
- (let-values (((or-part_87) (box? v_56)))
- (if or-part_87
- or-part_87
- (let-values (((or-part_88) (hash? v_56)))
- (if or-part_88
- or-part_88
+ (if (let-values (((or-part_116) (null? v_78)))
+ (if or-part_116
+ or-part_116
+ (let-values (((or-part_117) (boolean? v_78)))
+ (if or-part_117
+ or-part_117
+ (let-values (((or-part_118) (symbol? v_78)))
+ (if or-part_118
+ or-part_118
+ (let-values (((or-part_119) (number? v_78)))
+ (if or-part_119
+ or-part_119
+ (let-values (((or-part_120) (char? v_78)))
+ (if or-part_120
+ or-part_120
+ (let-values (((or-part_121) (string? v_78)))
+ (if or-part_121
+ or-part_121
+ (let-values (((or-part_122) (bytes? v_78)))
+ (if or-part_122
+ or-part_122
+ (let-values (((or-part_123) (regexp? v_78)))
+ (if or-part_123
+ or-part_123
+ (let-values (((or-part_124) (syntax?_0 v_78)))
+ (if or-part_124
+ or-part_124
+ (let-values (((or-part_125) (pair? v_78)))
+ (if or-part_125
+ or-part_125
+ (let-values (((or-part_126) (vector? v_78)))
+ (if or-part_126
+ or-part_126
+ (let-values (((or-part_127) (box? v_78)))
+ (if or-part_127
+ or-part_127
+ (let-values (((or-part_128) (hash? v_78)))
+ (if or-part_128
+ or-part_128
(immutable-prefab-struct-key
- v_56)))))))))))))))))))))))))))
+ v_78)))))))))))))))))))))))))))
(void)
- (let-values ()
- (raise-arguments-error
- 'write
- "disallowed value in preserved syntax property"
- "value"
- v_56)))
- v_56)))))
- (let-values (((s_49) v_55)
- ((f_21) check-preserve_0)
+ (raise-arguments-error 'write "disallowed value in preserved syntax property" "value" v_78))
+ v_78)))))
+ (let-values (((s_56) v_77)
+ ((f_20) check-preserve_0)
((gf_0) check-preserve_0)
((seen_2) disallow-cycles$1)
((known-pairs_1) #f))
- ((letrec-values (((loop_58)
- (lambda (tail?_3 s_50 prev-depth_0)
+ ((letrec-values (((loop_60)
+ (lambda (tail?_3 s_57 prev-depth_0)
(begin
'loop
(let-values (((depth_0) (fx+ 1 prev-depth_0)))
(if (if seen_2 (fx> depth_0 32) #f)
- (let-values ()
- (datum-map-slow
- tail?_3
- s_50
- (lambda (tail?_4 s_51) (gf_0 tail?_4 s_51))
- seen_2
- known-pairs_1))
- (if (null? s_50)
- (let-values () (f_21 tail?_3 s_50))
- (if (pair? s_50)
- (let-values ()
- (f_21
- tail?_3
- (cons (loop_58 #f (car s_50) depth_0) (loop_58 1 (cdr s_50) depth_0))))
- (if (symbol? s_50)
- (let-values () (f_21 #f s_50))
- (if (boolean? s_50)
- (let-values () (f_21 #f s_50))
- (if (number? s_50)
- (let-values () (f_21 #f s_50))
- (if (let-values (((or-part_89) (vector? s_50)))
- (if or-part_89
- or-part_89
- (let-values (((or-part_90) (box? s_50)))
- (if or-part_90
- or-part_90
- (let-values (((or-part_91) (prefab-struct-key s_50)))
- (if or-part_91 or-part_91 (hash? s_50)))))))
- (let-values ()
- (datum-map-slow
- tail?_3
- s_50
- (lambda (tail?_5 s_52) (gf_0 tail?_5 s_52))
- seen_2
- known-pairs_1))
- (let-values () (gf_0 #f s_50))))))))))))))
- loop_58)
+ (datum-map-slow
+ tail?_3
+ s_57
+ (lambda (tail?_4 s_58) (gf_0 tail?_4 s_58))
+ seen_2
+ known-pairs_1)
+ (if (null? s_57)
+ (f_20 tail?_3 s_57)
+ (if (pair? s_57)
+ (f_20
+ tail?_3
+ (cons (loop_60 #f (car s_57) depth_0) (loop_60 1 (cdr s_57) depth_0)))
+ (if (symbol? s_57)
+ (f_20 #f s_57)
+ (if (boolean? s_57)
+ (f_20 #f s_57)
+ (if (number? s_57)
+ (f_20 #f s_57)
+ (if (let-values (((or-part_129) (vector? s_57)))
+ (if or-part_129
+ or-part_129
+ (let-values (((or-part_130) (box? s_57)))
+ (if or-part_130
+ or-part_130
+ (let-values (((or-part_131) (prefab-struct-key s_57)))
+ (if or-part_131 or-part_131 (hash? s_57)))))))
+ (datum-map-slow
+ tail?_3
+ s_57
+ (lambda (tail?_5 s_59) (gf_0 tail?_5 s_59))
+ seen_2
+ known-pairs_1)
+ (gf_0 #f s_57)))))))))))))
+ loop_60)
#f
- s_49
+ s_56
0))))))
(define-values
(disallow-cycles$1)
(hash
'cycle-fail
- (lambda (v_57) (raise-arguments-error 'write "disallowed cycle in preserved syntax property" "at" v_57))))
+ (lambda (v_79) (raise-arguments-error 'write "disallowed cycle in preserved syntax property" "at" v_79))))
(define-values
(taint?)
- (lambda (v_29) (begin (let-values (((or-part_1) (not v_29))) (if or-part_1 or-part_1 (symbol? v_29))))))
+ (lambda (v_80) (begin (let-values (((or-part_132) (not v_80))) (if or-part_132 or-part_132 (symbol? v_80))))))
(define-values
(tainted-for-content)
- (lambda (v_30) (begin (if (datum-has-elements? v_30) 'tainted/need-propagate 'tainted))))
- (define-values (taint-needs-propagate?) (lambda (t_3) (begin (eq? t_3 'tainted/need-propagate))))
- (define-values (taint-propagated) (lambda (t_4) (begin (if (eq? t_4 'tainted/need-propagate) 'tainted t_4))))
+ (lambda (v_81) (begin (if (datum-has-elements? v_81) 'tainted/need-propagate 'tainted))))
+ (define-values (taint-needs-propagate?) (lambda (t_2) (begin (eq? t_2 'tainted/need-propagate))))
+ (define-values (taint-propagated) (lambda (t_3) (begin (if (eq? t_3 'tainted/need-propagate) 'tainted t_3))))
(define-values
(struct:modified-content
modified-content1.1
modified-content?
modified-content-content
modified-content-scope-propagations+taint)
- (let-values (((struct:_7 make-_7 ?_7 -ref_7 -set!_7)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'modified-content
- #f
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'modified-content)))))
+ (let-values (((struct:_9 make-_9 ?_9 -ref_9 -set!_9)
+ (make-struct-type
+ 'modified-content
+ #f
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'modified-content)))
(values
- struct:_7
- make-_7
- ?_7
- (make-struct-field-accessor -ref_7 0 'content)
- (make-struct-field-accessor -ref_7 1 'scope-propagations+taint))))
+ struct:_9
+ make-_9
+ ?_9
+ (make-struct-field-accessor -ref_9 0 'content)
+ (make-struct-field-accessor -ref_9 1 'scope-propagations+taint))))
(define-values
(struct:syntax
syntax2.1
@@ -6084,288 +5741,251 @@
syntax-props
syntax-inspector
set-syntax-content*!)
- (let-values (((struct:_8 make-_8 ?_8 -ref_8 -set!_8)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'syntax
- #f
- 7
- 0
- #f
- (list
- (cons prop:sealed #t)
- (cons prop:authentic #t)
- (cons
- prop:reach-scopes
- (lambda (s_53 bulk-shifts_0 reach_0)
- (let-values (((content*_0) (syntax-content* s_53)))
- (let-values ((()
- (begin
- (reach_0
- (if (modified-content? content*_0)
- (let-values (((prop_0)
- (modified-content-scope-propagations+taint content*_0)))
- (if (propagation?$1 prop_0)
- ((propagation-ref prop_0) s_53)
- (modified-content-content content*_0)))
- content*_0)
- bulk-shifts_0)
- (values))))
- (let-values (((shifts_0)
- (if bulk-shifts_0 (append bulk-shifts_0 (syntax-mpi-shifts s_53)) #f)))
+ (let-values (((struct:_10 make-_10 ?_10 -ref_10 -set!_10)
+ (make-struct-type
+ 'syntax
+ #f
+ 7
+ 0
+ #f
+ (list
+ (cons prop:sealed #t)
+ (cons prop:authentic #t)
+ (cons
+ prop:reach-scopes
+ (lambda (s_60 bulk-shifts_0 reach_0)
+ (let-values (((content*_0) (syntax-content* s_60)))
+ (let-values ((()
+ (begin
+ (reach_0
+ (if (modified-content? content*_0)
+ (let-values (((prop_0)
+ (modified-content-scope-propagations+taint content*_0)))
+ (if (propagation?$1 prop_0)
+ ((propagation-ref prop_0) s_60)
+ (modified-content-content content*_0)))
+ content*_0)
+ bulk-shifts_0)
+ (values))))
+ (let-values (((shifts_0)
+ (if bulk-shifts_0 (append bulk-shifts_0 (syntax-mpi-shifts s_60)) #f)))
+ (begin
+ (reach_0 (syntax-scopes s_60) shifts_0)
+ (reach_0 (syntax-shifted-multi-scopes s_60) shifts_0)
+ (let-values (((ht_34) (syntax-props s_60)))
(begin
- (reach_0 (syntax-scopes s_53) shifts_0)
- (reach_0 (syntax-shifted-multi-scopes s_53) shifts_0)
- (let-values (((ht_32) (syntax-props s_53)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash ht_32)))
- ((letrec-values (((for-loop_35)
- (lambda (i_49)
- (begin
- 'for-loop
- (if i_49
- (let-values (((k_18 v_58)
- (unsafe-immutable-hash-iterate-key+value
- ht_32
- i_49)))
- (let-values ((()
- (let-values ()
- (if (preserved-property-value? v_58)
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (reach_0
- (plain-property-value
- v_58)
- bulk-shifts_0))
- (values)))))
- (values)))
- (values)))))
- (if (not #f)
- (for-loop_35
- (unsafe-immutable-hash-iterate-next ht_32 i_49))
- (values))))
- (values))))))
- for-loop_35)
- (unsafe-immutable-hash-iterate-first ht_32))))
- (void)
- (reach_0 (syntax-srcloc$1 s_53) bulk-shifts_0)))))))
- (cons
- prop:serialize
- (lambda (s_54 ser-push!_1 state_10)
- (let-values (((content*_1) (syntax-content* s_54)))
- (let-values (((content_0)
- (if (modified-content? content*_1)
- (let-values (((prop_1)
- (modified-content-scope-propagations+taint content*_1)))
- (if (propagation?$1 prop_1)
- ((propagation-ref prop_1) s_54)
- (modified-content-content content*_1)))
- content*_1)))
- (let-values (((properties_0)
- (intern-properties
- (syntax-props s_54)
- (lambda ()
- (let-values (((preserve-keys_0)
- (serialize-state-preserve-prop-keys state_10)))
- (let-values (((ht_33) (syntax-props s_54)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_33)))
- ((letrec-values (((for-loop_36)
- (lambda (table_18 i_50)
- (begin
- 'for-loop
- (if i_50
- (let-values (((k_19 v_59)
- (hash-iterate-key+value
- ht_33
- i_50)))
- (let-values (((table_19)
- (let-values (((table_20)
- table_18))
- (if (let-values (((or-part_65)
- (preserved-property-value?
- v_59)))
- (if or-part_65
- or-part_65
- (hash-ref
- preserve-keys_0
- k_19
- #f)))
- (let-values (((table_21)
- table_20))
- (let-values (((table_22)
- (let-values ()
- (let-values (((key_16
- val_4)
- (let-values ()
- (values
- k_19
- (check-value-to-preserve
- (plain-property-value
- v_59)
- syntax?$1)))))
- (hash-set
- table_21
- key_16
- val_4)))))
- (values table_22)))
- table_20))))
- (if (not #f)
- (for-loop_36
- table_19
- (hash-iterate-next ht_33 i_50))
- table_19)))
- table_18)))))
- for-loop_36)
- '#hasheq()
- (hash-iterate-first ht_33))))))
- state_10)))
- (let-values (((taint_0) (syntax-taintness s_54)))
- (let-values (((context-triple_0)
- (intern-context-triple
- (intern-scopes (syntax-scopes s_54) state_10)
- (intern-shifted-multi-scopes
- (syntax-shifted-multi-scopes s_54)
- state_10)
- (intern-mpi-shifts (syntax-mpi-shifts s_54) state_10)
- state_10)))
- (let-values (((stx-state_0) (get-syntax-context state_10)))
- (if (let-values (((or-part_92) properties_0)) (if or-part_92 or-part_92 taint_0))
- (let-values ()
- (begin
- (ser-push!_1 'tag '#:syntax+props)
- (push-syntax-context! state_10 #f)
- (ser-push!_1 content_0)
- (pop-syntax-context! state_10)
- (ser-push!_1 'reference context-triple_0)
- (ser-push!_1 'reference (syntax-srcloc$1 s_54))
- (ser-push!_1 properties_0)
- (ser-push!_1 taint_0)
- (if stx-state_0
- (let-values () (set-syntax-state-all-sharing?! stx-state_0 #f))
- (void))))
- (let-values ()
- (let-values (((sharing-mode_0)
- (hash-ref
- (serialize-state-sharing-syntaxes state_10)
- s_54
- 'unknown)))
- (begin
- (if (eq? sharing-mode_0 'share)
- (let-values ()
- (begin
- (ser-push!_1 'tag '#:datum->syntax)
- (ser-push!_1 (syntax->datum$1 s_54))))
- (if (eq? sharing-mode_0 'unknown)
- (let-values ()
- (let-values ((() (begin (ser-push!_1 'tag '#:syntax) (values))))
- (let-values (((this-state_0)
- (if (no-pair-syntax-in-cdr? content_0)
- (syntax-state17.1
- #t
- context-triple_0
- (syntax-srcloc$1 s_54))
- #f)))
- (let-values ((()
- (begin
- (push-syntax-context! state_10 this-state_0)
- (values))))
- (let-values ((() (begin (ser-push!_1 content_0) (values))))
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash ht_34))
+ ((letrec-values (((for-loop_35)
+ (lambda (i_68)
+ (begin
+ 'for-loop
+ (if i_68
+ (let-values (((k_18 v_82)
+ (unsafe-immutable-hash-iterate-key+value
+ ht_34
+ i_68)))
(let-values ((()
- (begin
- (pop-syntax-context! state_10)
+ (if (preserved-property-value? v_82)
+ (let-values ((()
+ (begin
+ (reach_0
+ (plain-property-value v_82)
+ bulk-shifts_0)
+ (values))))
+ (values))
(values))))
- (let-values (((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_10)
- s_54
- (if (datum-has-elements? content_0)
- new-sharing-mode_0
- 'none))
- (if (if stx-state_0 (eq? new-sharing-mode_0 'none) #f)
- (let-values ()
- (set-syntax-state-all-sharing?! stx-state_0 #f))
- (void))))))))))
- (let-values ()
- (begin
- (ser-push!_1 'tag '#:syntax)
- (push-syntax-context! state_10 #f)
- (ser-push!_1 content_0)
- (pop-syntax-context! state_10)))))
- (ser-push!_1 'reference context-triple_0)
- (ser-push!_1 'reference (syntax-srcloc$1 s_54))
- (if stx-state_0
- (let-values ()
- (if (if (eq?
- context-triple_0
- (syntax-state-context-triple stx-state_0))
- (equal? (syntax-srcloc$1 s_54) (syntax-state-srcloc stx-state_0))
- #f)
- (void)
- (let-values () (set-syntax-state-all-sharing?! stx-state_0 #f))))
- (void))))))))))))))
- (cons
- prop:custom-write
- (lambda (s_55 port_2 mode_5)
- (let-values ((() (begin (write-string "#syntax)
+ (ser-push!_1 (syntax->datum$1 s_61)))
+ (if (eq? sharing-mode_0 'unknown)
+ (let-values ((() (begin (ser-push!_1 'tag '#:syntax) (values))))
+ (let-values (((this-state_0)
+ (if (no-pair-syntax-in-cdr? content_0)
+ (syntax-state17.1
+ #t
+ context-triple_0
+ (syntax-srcloc$1 s_61))
+ #f)))
+ (let-values ((()
+ (begin
+ (push-syntax-context! state_10 this-state_0)
+ (values))))
+ (let-values ((() (begin (ser-push!_1 content_0) (values))))
+ (let-values ((() (begin (pop-syntax-context! state_10) (values))))
+ (let-values (((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_10)
+ s_61
+ (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
- (if srcloc_0
- (let-values ()
- (let-values (((srcloc-str_0) (srcloc->string srcloc_0)))
- (if srcloc-str_0
- (let-values () (fprintf port_2 ":~a" srcloc-str_0))
- (void))))
- (void))
- (values))))
- (let-values (((width_0) (print-syntax-width)))
- (begin
- (if (eqv? width_0 0)
- (let-values () (void))
- (if (eqv? width_0 +inf.0)
- (let-values () (fprintf port_2 " ~s" (syntax->datum$1 s_55)))
- (let-values ()
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first #f parameterization-key)
- error-print-width
- width_0)
- (let-values () (fprintf port_2 " ~.s" (syntax->datum$1 s_55)))))))
- (write-string ">" port_2)))))))))
- (current-inspector)
- #f
- '(1 2 3 4 5 6)
- #f
- 'syntax)))))
+ (ser-push!_1 'tag '#:syntax)
+ (push-syntax-context! state_10 #f)
+ (ser-push!_1 content_0)
+ (pop-syntax-context! state_10))))
+ (ser-push!_1 'reference context-triple_0)
+ (ser-push!_1 'reference (syntax-srcloc$1 s_61))
+ (if stx-state_0
+ (if (if (eq? context-triple_0 (syntax-state-context-triple stx-state_0))
+ (equal? (syntax-srcloc$1 s_61) (syntax-state-srcloc stx-state_0))
+ #f)
+ (void)
+ (set-syntax-state-all-sharing?! stx-state_0 #f))
+ (void)))))))))))))
+ (cons
+ prop:custom-write
+ (lambda (s_62 port_2 mode_5)
+ (let-values ((() (begin (write-string "#string srcloc_0)))
+ (if srcloc-str_0 (fprintf port_2 ":~a" srcloc-str_0) (void)))
+ (void))
+ (values))))
+ (let-values (((width_0) (print-syntax-width)))
+ (begin
+ (if (eqv? width_0 0)
+ (void)
+ (if (eqv? width_0 +inf.0)
+ (fprintf port_2 " ~s" (syntax->datum$1 s_62))
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first #f parameterization-key)
+ error-print-width
+ width_0)
+ (fprintf port_2 " ~.s" (syntax->datum$1 s_62)))))
+ (write-string ">" port_2)))))))))
+ (current-inspector)
+ #f
+ '(1 2 3 4 5 6)
+ #f
+ 'syntax)))
(values
- struct:_8
- make-_8
- ?_8
- (make-struct-field-accessor -ref_8 0 'content*)
- (make-struct-field-accessor -ref_8 1 'scopes)
- (make-struct-field-accessor -ref_8 2 'shifted-multi-scopes)
- (make-struct-field-accessor -ref_8 3 'mpi-shifts)
- (make-struct-field-accessor -ref_8 4 'srcloc)
- (make-struct-field-accessor -ref_8 5 'props)
- (make-struct-field-accessor -ref_8 6 'inspector)
- (make-struct-field-mutator -set!_8 0 'content*))))
+ struct:_10
+ make-_10
+ ?_10
+ (make-struct-field-accessor -ref_10 0 'content*)
+ (make-struct-field-accessor -ref_10 1 'scopes)
+ (make-struct-field-accessor -ref_10 2 'shifted-multi-scopes)
+ (make-struct-field-accessor -ref_10 3 'mpi-shifts)
+ (make-struct-field-accessor -ref_10 4 'srcloc)
+ (make-struct-field-accessor -ref_10 5 'props)
+ (make-struct-field-accessor -ref_10 6 'inspector)
+ (make-struct-field-mutator -set!_10 0 'content*))))
(define-values (prop:propagation propagation?$1 propagation-ref) (make-struct-type-property 'propagation))
(define-values
(prop:propagation-taint propagation-taint? propagation-taint-ref)
@@ -6375,26 +5995,25 @@
(make-struct-type-property 'propagation-set-taint))
(define-values
(syntax-content)
- (lambda (s_56)
+ (lambda (s_63)
(begin
- (let-values (((content*_2) (syntax-content* s_56)))
+ (let-values (((content*_2) (syntax-content* s_63)))
(if (modified-content? content*_2) (modified-content-content content*_2) content*_2)))))
(define-values
(syntax-taintness)
- (lambda (s_57)
+ (lambda (s_64)
(begin
- (let-values (((content*_3) (syntax-content* s_57)))
+ (let-values (((content*_3) (syntax-content* s_64)))
(if (modified-content? content*_3)
- (let-values ()
- (let-values (((v_60) (modified-content-scope-propagations+taint content*_3)))
- (if (taint? v_60) v_60 ((propagation-taint-ref v_60) v_60))))
- (let-values () #f))))))
+ (let-values (((v_84) (modified-content-scope-propagations+taint content*_3)))
+ (if (taint? v_84) v_84 ((propagation-taint-ref v_84) v_84)))
+ #f)))))
(define-values (syntax-content*-cas!) (lambda (stx_1 old_0 new_1) (begin (unsafe-struct*-cas! stx_1 0 old_0 new_1))))
(define-values
(re-modify-content)
- (lambda (s_58 d_1)
+ (lambda (s_65 d_1)
(begin
- (let-values (((content*_4) (syntax-content* s_58)))
+ (let-values (((content*_4) (syntax-content* s_65)))
(if (modified-content? content*_4)
(modified-content1.1 d_1 (modified-content-scope-propagations+taint content*_4))
d_1)))))
@@ -6405,86 +6024,83 @@
(define-values
(empty-syntax)
(syntax2.1 #f empty-scopes empty-shifted-multi-scopes empty-mpi-shifts #f empty-props #f))
- (define-values (identifier?) (lambda (s_59) (begin (if (syntax?$1 s_59) (symbol? (syntax-content s_59)) #f))))
- (define-values (syntax-identifier?) (lambda (s_60) (begin (symbol? (syntax-content s_60)))))
+ (define-values (identifier?) (lambda (s_66) (begin (if (syntax?$1 s_66) (symbol? (syntax-content s_66)) #f))))
+ (define-values (syntax-identifier?) (lambda (s_67) (begin (symbol? (syntax-content s_67)))))
(define-values
(syntax->datum$1)
- (lambda (s_61)
+ (lambda (s_68)
(begin
'syntax->datum
- (let-values (((s_62) s_61)
- ((f_22) (lambda (tail?_6 x_21) (begin 'f x_21)))
- ((d->s_0) (lambda (s_63 d_2) (begin 'd->s d_2)))
+ (let-values (((s_69) s_68)
+ ((f_21) (lambda (tail?_6 x_23) (begin 'f x_23)))
+ ((d->s_0) (lambda (s_70 d_2) (begin 'd->s d_2)))
((s-e_0) syntax-content)
((seen_3) #f))
- ((letrec-values (((loop_59)
- (lambda (s_64)
+ ((letrec-values (((loop_61)
+ (lambda (s_71)
(begin
'loop
- (let-values (((s_65) s_64)
- ((f_23) f_22)
+ (let-values (((s_72) s_71)
+ ((f_22) f_21)
((gf_1)
- (lambda (tail?_7 v_61)
+ (lambda (tail?_7 v_85)
(begin
'gf
- (if (syntax?$1 v_61)
- (let-values () (d->s_0 v_61 (loop_59 (s-e_0 v_61))))
- (let-values () (f_22 tail?_7 v_61))))))
+ (if (syntax?$1 v_85)
+ (d->s_0 v_85 (loop_61 (s-e_0 v_85)))
+ (f_21 tail?_7 v_85)))))
((seen_4) seen_3)
((known-pairs_2) #f))
- ((letrec-values (((loop_60)
- (lambda (tail?_8 s_66 prev-depth_1)
+ ((letrec-values (((loop_62)
+ (lambda (tail?_8 s_73 prev-depth_1)
(begin
'loop
(let-values (((depth_1) (fx+ 1 prev-depth_1)))
(if (if seen_4 (fx> depth_1 32) #f)
- (let-values ()
- (datum-map-slow
- tail?_8
- s_66
- (lambda (tail?_9 s_67) (gf_1 tail?_9 s_67))
- seen_4
- known-pairs_2))
- (if (null? s_66)
- (let-values () (f_23 tail?_8 s_66))
- (if (pair? s_66)
- (let-values ()
- (f_23
- tail?_8
- (cons
- (loop_60 #f (car s_66) depth_1)
- (loop_60 1 (cdr s_66) depth_1))))
- (if (symbol? s_66)
- (let-values () (f_23 #f s_66))
- (if (boolean? s_66)
- (let-values () (f_23 #f s_66))
- (if (number? s_66)
- (let-values () (f_23 #f s_66))
- (if (let-values (((or-part_93) (vector? s_66)))
- (if or-part_93
- or-part_93
- (let-values (((or-part_94) (box? s_66)))
- (if or-part_94
- or-part_94
- (let-values (((or-part_95)
- (prefab-struct-key s_66)))
- (if or-part_95
- or-part_95
- (hash? s_66)))))))
- (let-values ()
- (datum-map-slow
- tail?_8
- s_66
- (lambda (tail?_10 s_68) (gf_1 tail?_10 s_68))
- seen_4
- known-pairs_2))
- (let-values () (gf_1 #f s_66))))))))))))))
- loop_60)
+ (datum-map-slow
+ tail?_8
+ s_73
+ (lambda (tail?_9 s_74) (gf_1 tail?_9 s_74))
+ seen_4
+ known-pairs_2)
+ (if (null? s_73)
+ (f_22 tail?_8 s_73)
+ (if (pair? s_73)
+ (f_22
+ tail?_8
+ (cons
+ (loop_62 #f (car s_73) depth_1)
+ (loop_62 1 (cdr s_73) depth_1)))
+ (if (symbol? s_73)
+ (f_22 #f s_73)
+ (if (boolean? s_73)
+ (f_22 #f s_73)
+ (if (number? s_73)
+ (f_22 #f s_73)
+ (if (let-values (((or-part_135) (vector? s_73)))
+ (if or-part_135
+ or-part_135
+ (let-values (((or-part_136) (box? s_73)))
+ (if or-part_136
+ or-part_136
+ (let-values (((or-part_137)
+ (prefab-struct-key s_73)))
+ (if or-part_137
+ or-part_137
+ (hash? s_73)))))))
+ (datum-map-slow
+ tail?_8
+ s_73
+ (lambda (tail?_10 s_75) (gf_1 tail?_10 s_75))
+ seen_4
+ known-pairs_2)
+ (gf_1 #f s_73)))))))))))))
+ loop_62)
#f
- s_65
+ s_72
0))))))
- loop_59)
- s_62)))))
+ loop_61)
+ s_69)))))
(define-values (cell.1$8) (unsafe-make-place-local (make-weak-hasheq)))
(define-values
(immediate-datum->syntax)
@@ -6501,16 +6117,14 @@
props_0
(if insp_0
(if stx-c_0
- (let-values (((a_22) insp_0) ((b_20) (syntax-inspector stx-c_0)))
- (if (eq? a_22 b_20)
- (let-values () a_22)
- (if (not a_22)
- (let-values () #f)
- (if (not b_20)
- (let-values () #f)
- (if (inspector-superior? a_22 b_20)
- (let-values () b_20)
- (if (inspector-superior? b_20 a_22) (let-values () a_22) (let-values () #f)))))))
+ (let-values (((a_23) insp_0) ((b_21) (syntax-inspector stx-c_0)))
+ (if (eq? a_23 b_21)
+ a_23
+ (if (not a_23)
+ #f
+ (if (not b_21)
+ #f
+ (if (inspector-superior? a_23 b_21) b_21 (if (inspector-superior? b_21 a_23) a_23 #f))))))
#f)
#f)))))
(define-values
@@ -6520,154 +6134,134 @@
(begin
'datum->syntax
(let-values (((stx-c_1) stx-c5_0))
- (let-values (((s_69) s6_1))
+ (let-values (((s_76) s6_1))
(let-values (((stx-l_1) stx-l3_0))
(let-values (((stx-p_0) stx-p4_0))
- (let-values ()
- (if (syntax?$1 s_69)
- (let-values () s_69)
- (let-values ()
- (let-values (((insp_1) (current-module-code-inspector)))
- (let-values (((wrap_0)
- (lambda (content_2)
- (begin
- 'wrap
- (let-values (((content_3) (datum-intern-literal content_2)))
- (immediate-datum->syntax
- stx-c_1
- content_3
- stx-l_1
- empty-props
- insp_1))))))
- (let-values (((result-s_0)
- (let-values (((s_70) s_69)
- ((f_24)
- (lambda (tail?_11 x_22)
+ (if (syntax?$1 s_76)
+ s_76
+ (let-values (((insp_1) (current-module-code-inspector)))
+ (let-values (((wrap_0)
+ (lambda (content_2)
+ (begin
+ 'wrap
+ (let-values (((content_3) (datum-intern-literal content_2)))
+ (immediate-datum->syntax
+ stx-c_1
+ content_3
+ stx-l_1
+ empty-props
+ insp_1))))))
+ (let-values (((result-s_0)
+ (let-values (((s_77) s_76)
+ ((f_23)
+ (lambda (tail?_11 x_24)
+ (begin
+ 'f
+ (if tail?_11
(begin
- 'f
- (if tail?_11
- (let-values ()
- (begin
- (if (if (fx> tail?_11 32)
- (fx=
- 0
- (fxand tail?_11 (fx- tail?_11 1)))
- #f)
- (let-values ()
- (hash-set!
- (unsafe-place-local-ref cell.1$8)
- x_22
- #t))
- (void))
- x_22))
- (let-values () (wrap_0 x_22))))))
- ((s->_0) (lambda (s_71) (begin 's-> s_71)))
- ((seen_5) disallow-cycles)
- ((known-pairs_3) (unsafe-place-local-ref cell.1$8)))
- (let-values (((s_72) s_70)
- ((f_25) f_24)
- ((gf_2)
- (lambda (tail?_12 v_62)
- (begin
- 'gf
- (if (syntax?$1 v_62)
- (let-values () (s->_0 v_62))
- (let-values () (f_24 tail?_12 v_62))))))
- ((seen_6) seen_5)
- ((known-pairs_4) known-pairs_3))
- ((letrec-values (((loop_61)
- (lambda (tail?_13 s_73 prev-depth_2)
- (begin
- 'loop
- (let-values (((depth_2)
- (fx+ 1 prev-depth_2)))
- (if (if seen_6 (fx> depth_2 32) #f)
- (let-values ()
- (datum-map-slow
- tail?_13
- s_73
- (lambda (tail?_14 s_74)
- (gf_2 tail?_14 s_74))
- seen_6
- known-pairs_4))
- (if (null? s_73)
- (let-values () (f_25 tail?_13 s_73))
- (if (pair? s_73)
- (let-values ()
- (f_25
- tail?_13
- (cons
- (loop_61
- #f
- (car s_73)
- depth_2)
- (loop_61
- 1
- (cdr s_73)
- depth_2))))
- (if (symbol? s_73)
- (let-values () (f_25 #f s_73))
- (if (boolean? s_73)
- (let-values () (f_25 #f s_73))
- (if (number? s_73)
- (let-values ()
- (f_25 #f s_73))
- (if (let-values (((or-part_96)
- (vector?
- s_73)))
- (if or-part_96
- or-part_96
- (let-values (((or-part_97)
- (box?
- s_73)))
- (if or-part_97
- or-part_97
- (let-values (((or-part_98)
- (prefab-struct-key
- s_73)))
- (if or-part_98
- or-part_98
- (hash?
- s_73)))))))
- (let-values ()
- (datum-map-slow
- tail?_13
- s_73
- (lambda (tail?_15 s_75)
- (gf_2 tail?_15 s_75))
- seen_6
- known-pairs_4))
- (let-values ()
- (gf_2
- #f
- s_73))))))))))))))
- loop_61)
- #f
- s_72
- 0)))))
- (if (if stx-p_0 (not (eq? (syntax-props stx-p_0) empty-props)) #f)
- (let-values (((the-struct_0) result-s_0))
- (if (syntax?$1 the-struct_0)
- (let-values (((props20_0) (syntax-props stx-p_0)))
- (syntax2.1
- (syntax-content* the-struct_0)
- (syntax-scopes the-struct_0)
- (syntax-shifted-multi-scopes the-struct_0)
- (syntax-mpi-shifts the-struct_0)
- (syntax-srcloc$1 the-struct_0)
- props20_0
- (syntax-inspector the-struct_0)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_0)))
- result-s_0)))))))))))))))
+ (if (if (fx> tail?_11 32)
+ (fx= 0 (fxand tail?_11 (fx- tail?_11 1)))
+ #f)
+ (hash-set!
+ (unsafe-place-local-ref cell.1$8)
+ x_24
+ #t)
+ (void))
+ x_24)
+ (wrap_0 x_24)))))
+ ((s->_0) (lambda (s_78) (begin 's-> s_78)))
+ ((seen_5) disallow-cycles)
+ ((known-pairs_3) (unsafe-place-local-ref cell.1$8)))
+ (let-values (((s_79) s_77)
+ ((f_24) f_23)
+ ((gf_2)
+ (lambda (tail?_12 v_86)
+ (begin
+ 'gf
+ (if (syntax?$1 v_86)
+ (s->_0 v_86)
+ (f_23 tail?_12 v_86)))))
+ ((seen_6) seen_5)
+ ((known-pairs_4) known-pairs_3))
+ ((letrec-values (((loop_63)
+ (lambda (tail?_13 s_80 prev-depth_2)
+ (begin
+ 'loop
+ (let-values (((depth_2) (fx+ 1 prev-depth_2)))
+ (if (if seen_6 (fx> depth_2 32) #f)
+ (datum-map-slow
+ tail?_13
+ s_80
+ (lambda (tail?_14 s_81)
+ (gf_2 tail?_14 s_81))
+ seen_6
+ known-pairs_4)
+ (if (null? s_80)
+ (f_24 tail?_13 s_80)
+ (if (pair? s_80)
+ (f_24
+ tail?_13
+ (cons
+ (loop_63 #f (car s_80) depth_2)
+ (loop_63 1 (cdr s_80) depth_2)))
+ (if (symbol? s_80)
+ (f_24 #f s_80)
+ (if (boolean? s_80)
+ (f_24 #f s_80)
+ (if (number? s_80)
+ (f_24 #f s_80)
+ (if (let-values (((or-part_138)
+ (vector?
+ s_80)))
+ (if or-part_138
+ or-part_138
+ (let-values (((or-part_139)
+ (box?
+ s_80)))
+ (if or-part_139
+ or-part_139
+ (let-values (((or-part_140)
+ (prefab-struct-key
+ s_80)))
+ (if or-part_140
+ or-part_140
+ (hash?
+ s_80)))))))
+ (datum-map-slow
+ tail?_13
+ s_80
+ (lambda (tail?_15 s_82)
+ (gf_2 tail?_15 s_82))
+ seen_6
+ known-pairs_4)
+ (gf_2 #f s_80)))))))))))))
+ loop_63)
+ #f
+ s_79
+ 0)))))
+ (if (if stx-p_0 (not (eq? (syntax-props stx-p_0) empty-props)) #f)
+ (let-values (((the-struct_0) result-s_0))
+ (if (syntax?$1 the-struct_0)
+ (let-values (((props20_0) (syntax-props stx-p_0)))
+ (syntax2.1
+ (syntax-content* the-struct_0)
+ (syntax-scopes the-struct_0)
+ (syntax-shifted-multi-scopes the-struct_0)
+ (syntax-mpi-shifts the-struct_0)
+ (syntax-srcloc$1 the-struct_0)
+ props20_0
+ (syntax-inspector the-struct_0)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_0)))
+ result-s_0)))))))))))))
(case-lambda
- ((stx-c_2 s_76) (begin 'datum->syntax (datum->syntax_0 stx-c_2 s_76 #f #f)))
- ((stx-c_3 s_77 stx-l_2 stx-p4_1) (datum->syntax_0 stx-c_3 s_77 stx-l_2 stx-p4_1))
- ((stx-c_4 s_78 stx-l3_1) (datum->syntax_0 stx-c_4 s_78 stx-l3_1 #f)))))
+ ((stx-c_2 s_83) (begin 'datum->syntax (datum->syntax_0 stx-c_2 s_83 #f #f)))
+ ((stx-c_3 s_84 stx-l_2 stx-p4_1) (datum->syntax_0 stx-c_3 s_84 stx-l_2 stx-p4_1))
+ ((stx-c_4 s_85 stx-l3_1) (datum->syntax_0 stx-c_4 s_85 stx-l3_1 #f)))))
(define-values
(disallow-cycles)
(hasheq
'cycle-fail
- (lambda (s_79) (raise-arguments-error 'datum->syntax "cannot create syntax from cyclic datum" "datum" s_79))))
+ (lambda (s_86) (raise-arguments-error 'datum->syntax "cannot create syntax from cyclic datum" "datum" s_86))))
(define-values (syntax-place-init!) (lambda () (begin (unsafe-place-local-set! cell.1$8 (make-weak-hasheq)))))
(define-values
(struct:syntax-state
@@ -6677,47 +6271,42 @@
syntax-state-context-triple
syntax-state-srcloc
set-syntax-state-all-sharing?!)
- (let-values (((struct:_9 make-_9 ?_9 -ref_9 -set!_9)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'syntax-state
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(1 2)
- #f
- 'syntax-state)))))
- (values
- struct:_9
- make-_9
- ?_9
- (make-struct-field-accessor -ref_9 0 'all-sharing?)
- (make-struct-field-accessor -ref_9 1 'context-triple)
- (make-struct-field-accessor -ref_9 2 'srcloc)
- (make-struct-field-mutator -set!_9 0 'all-sharing?))))
+ (let-values (((struct:_11 make-_11 ?_11 -ref_11 -set!_11)
+ (make-struct-type
+ 'syntax-state
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(1 2)
+ #f
+ 'syntax-state)))
+ (values
+ struct:_11
+ make-_11
+ ?_11
+ (make-struct-field-accessor -ref_11 0 'all-sharing?)
+ (make-struct-field-accessor -ref_11 1 'context-triple)
+ (make-struct-field-accessor -ref_11 2 'srcloc)
+ (make-struct-field-mutator -set!_11 0 'all-sharing?))))
(define-values
(no-pair-syntax-in-cdr?)
(lambda (content_4)
(begin
(if (pair? content_4)
- (let-values ()
- ((letrec-values (((loop_62)
- (lambda (content_5)
- (begin
- 'loop
- (if (if (syntax?$1 content_5) (pair? (syntax-content content_5)) #f)
- (let-values () #f)
- (if (pair? content_5)
- (let-values () (loop_62 (cdr content_5)))
- (let-values () #t)))))))
- loop_62)
- (cdr content_4)))
- (let-values () #t)))))
+ ((letrec-values (((loop_64)
+ (lambda (content_5)
+ (begin
+ 'loop
+ (if (if (syntax?$1 content_5) (pair? (syntax-content content_5)) #f)
+ #f
+ (if (pair? content_5) (loop_64 (cdr content_5)) #t))))))
+ loop_64)
+ (cdr content_4))
+ #t))))
(define-values
(deserialize-syntax)
(lambda (content_6 context-triple_1 srcloc_1 props_1 taint_1 inspector_0)
@@ -6729,98 +6318,93 @@
(vector*-ref context-triple_1 2)
srcloc_1
(if props_1
- (let-values (((ht_34) props_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash ht_34)))
- ((letrec-values (((for-loop_37)
- (lambda (table_23 i_51)
- (begin
- 'for-loop
- (if i_51
- (let-values (((k_20 v_63) (unsafe-immutable-hash-iterate-key+value ht_34 i_51)))
- (let-values (((table_24)
- (let-values (((table_25) table_23))
- (let-values (((table_26)
- (let-values ()
- (let-values (((key_17 val_5)
- (let-values ()
- (values
- k_20
- (preserved-property-value1.1
- v_63)))))
- (hash-set table_25 key_17 val_5)))))
- (values table_26)))))
- (if (not #f)
- (for-loop_37 table_24 (unsafe-immutable-hash-iterate-next ht_34 i_51))
- table_24)))
- table_23)))))
- for-loop_37)
- '#hasheq()
- (unsafe-immutable-hash-iterate-first ht_34))))
+ (let-values (((table_24) (let-values (((table_25) '#hasheq())) table_25)))
+ (let-values (((ht_36) props_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash ht_36))
+ ((letrec-values (((for-loop_37)
+ (lambda (table_26 i_70)
+ (begin
+ 'for-loop
+ (if i_70
+ (let-values (((k_20 v_87) (unsafe-immutable-hash-iterate-key+value ht_36 i_70)))
+ (let-values (((table_27)
+ (let-values (((table_28)
+ (let-values (((key_17 val_5)
+ (values
+ k_20
+ (preserved-property-value1.1
+ v_87))))
+ (hash-set table_26 key_17 val_5))))
+ (values table_28))))
+ (if (not #f)
+ (for-loop_37 table_27 (unsafe-immutable-hash-iterate-next ht_36 i_70))
+ table_27)))
+ table_26)))))
+ for-loop_37)
+ table_24
+ (unsafe-immutable-hash-iterate-first ht_36)))))
empty-props)
inspector_0))))
(define-values
(deserialize-datum->syntax)
(lambda (content_7 context-triple_2 srcloc_2 inspector_1)
(begin
- (let-values (((s_80) (deserialize-syntax #f context-triple_2 srcloc_2 #f #f inspector_1)))
- (datum->syntax$1 s_80 content_7 s_80 s_80)))))
+ (let-values (((s_87) (deserialize-syntax #f context-triple_2 srcloc_2 #f #f inspector_1)))
+ (datum->syntax$1 s_87 content_7 s_87 s_87)))))
(define-values
(struct:full-binding full-binding1.1 full-binding? full-binding-frame-id full-binding-free=id)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'full-binding
- #f
- 2
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons prop:binding-reach-scopes (lambda (b_21) (binding-free=id b_21))))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'full-binding)))))
+ (let-values (((struct:_12 make-_12 ?_12 -ref_12 -set!_12)
+ (make-struct-type
+ 'full-binding
+ #f
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t) (cons prop:binding-reach-scopes (lambda (b_22) (binding-free=id b_22))))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'full-binding)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'frame-id)
- (make-struct-field-accessor -ref_2 1 'free=id))))
- (define-values (binding-frame-id) (lambda (b_22) (begin (if (full-binding? b_22) (full-binding-frame-id b_22) #f))))
- (define-values (binding-free=id) (lambda (b_23) (begin (if (full-binding? b_23) (full-binding-free=id b_23) #f))))
+ struct:_12
+ make-_12
+ ?_12
+ (make-struct-field-accessor -ref_12 0 'frame-id)
+ (make-struct-field-accessor -ref_12 1 'free=id))))
+ (define-values (binding-frame-id) (lambda (b_23) (begin (if (full-binding? b_23) (full-binding-frame-id b_23) #f))))
+ (define-values (binding-free=id) (lambda (b_24) (begin (if (full-binding? b_24) (full-binding-free=id b_24) #f))))
(define-values (cell.1$7) (unsafe-make-place-local (make-weak-hash)))
- (define-values (phase+space-place-init!) (lambda () (begin (unsafe-place-local-set! cell.1$7 (make-weak-hash)))))
+ (define-values (cell.2$6) (unsafe-make-place-local (make-uninterruptible-lock)))
+ (define-values
+ (phase+space-place-init!)
+ (lambda ()
+ (begin
+ (begin
+ (unsafe-place-local-set! cell.1$7 (make-weak-hash))
+ (unsafe-place-local-set! cell.2$6 (make-uninterruptible-lock))))))
(define-values
(intern)
(lambda (new-key_0)
(begin
- (let-values ((() (begin (start-atomic) (values))))
+ (let-values ((() (begin (uninterruptible-lock-acquire (unsafe-place-local-ref cell.2$6)) (values))))
(let-values (((old-key_0) (hash-ref-key (unsafe-place-local-ref cell.1$7) new-key_0 #f)))
(begin
- (if old-key_0 (void) (let-values () (hash-set! (unsafe-place-local-ref cell.1$7) new-key_0 #t)))
- (end-atomic)
- (let-values (((or-part_74) old-key_0)) (if or-part_74 or-part_74 new-key_0))))))))
- (define-values (space+) (lambda (s_14 s-level_0) (begin (if (eq? s-level_0 '#:none) s_14 s-level_0))))
+ (if old-key_0 (void) (hash-set! (unsafe-place-local-ref cell.1$7) new-key_0 #t))
+ (uninterruptible-lock-release (unsafe-place-local-ref cell.2$6))
+ (let-values (((or-part_141) old-key_0)) (if or-part_141 or-part_141 new-key_0))))))))
+ (define-values (space+) (lambda (s_88 s-level_0) (begin (if (eq? s-level_0 '#:none) s_88 s-level_0))))
(define-values
(intern-phase+space)
(case-lambda
- ((phase_0 space_0)
- (begin (if (not space_0) (let-values () phase_0) (let-values () (intern (cons phase_0 space_0))))))
+ ((phase_0 space_0) (begin (if (not space_0) phase_0 (intern (cons phase_0 space_0)))))
((phase+space_0) (intern phase+space_0))))
(define-values
(intern-phase+space-shift)
(case-lambda
((phase-level_0 space-level_0)
- (begin
- (if (eq? space-level_0 '#:none)
- (let-values () phase-level_0)
- (let-values () (intern (cons phase-level_0 space-level_0))))))
+ (begin (if (eq? space-level_0 '#:none) phase-level_0 (intern (cons phase-level_0 space-level_0)))))
((phase+space-shift_0) (intern phase+space-shift_0))))
(define-values (phase+space-shift-phase-level) (lambda (level_0) (begin (if (pair? level_0) (car level_0) level_0))))
(define-values (phase+space+) (lambda (p+s_3 level_1) (begin (intern-phase+space (phase+space+$1 p+s_3 level_1)))))
@@ -6828,20 +6412,19 @@
(define-values (phase+space-shift?-string) "phase+space-shift?")
(define-values
(phase+space)
- (lambda (a_13 b_24)
+ (lambda (a_24 b_25)
(begin
- (let-values (((phase-a_0) (phase+space-phase a_13)))
- (let-values (((phase-b_0) (phase+space-phase b_24)))
- (let-values (((or-part_89) (phase phase-a_0 phase-b_0)))
- (if or-part_89
- or-part_89
+ (let-values (((phase-a_0) (phase+space-phase a_24)))
+ (let-values (((phase-b_0) (phase+space-phase b_25)))
+ (let-values (((or-part_142) (phase phase-a_0 phase-b_0)))
+ (if or-part_142
+ or-part_142
(if (eqv? phase-a_0 phase-b_0)
- (let-values ()
- (let-values (((space-a_0) (phase+space-space a_13)))
- (let-values (((space-b_0) (phase+space-space b_24)))
- (let-values (((or-part_99) (not space-a_0)))
- (if or-part_99 or-part_99 (if space-b_0 (symbol space-a_0 space-b_0) #f))))))
- (let-values () #f)))))))))
+ (let-values (((space-a_0) (phase+space-space a_24)))
+ (let-values (((space-b_0) (phase+space-space b_25)))
+ (let-values (((or-part_143) (not space-a_0)))
+ (if or-part_143 or-part_143 (if space-b_0 (symbol space-a_0 space-b_0) #f)))))
+ #f))))))))
(define-values
(make-module-binding.1)
(lambda (extra-inspector7_0
@@ -6869,39 +6452,36 @@
(let-values (((free=id_0) free=id6_0))
(let-values (((extra-inspector_0) extra-inspector7_0))
(let-values (((extra-nominal-bindings_0) extra-nominal-bindings8_0))
- (let-values ()
- (if (let-values (((or-part_86) frame-id_0))
- (if or-part_86
- or-part_86
- (let-values (((or-part_75) free=id_0))
- (if or-part_75
- or-part_75
- (let-values (((or-part_87) extra-inspector_0))
- (if or-part_87
- or-part_87
- (not
- (if (eqv? nominal-phase+space_0 phase_1)
- (if (eq? nominal-sym_0 sym_0)
- (if (eqv? nominal-require-phase+space-shift_0 0)
- (null? extra-nominal-bindings_0)
- #f)
+ (if (let-values (((or-part_144) frame-id_0))
+ (if or-part_144
+ or-part_144
+ (let-values (((or-part_145) free=id_0))
+ (if or-part_145
+ or-part_145
+ (let-values (((or-part_146) extra-inspector_0))
+ (if or-part_146
+ or-part_146
+ (not
+ (if (eqv? nominal-phase+space_0 phase_1)
+ (if (eq? nominal-sym_0 sym_0)
+ (if (eqv? nominal-require-phase+space-shift_0 0)
+ (null? extra-nominal-bindings_0)
#f)
- #f))))))))
- (let-values ()
- (full-module-binding45.1
- frame-id_0
- free=id_0
- module_0
- phase_1
- sym_0
- nominal-module_0
- nominal-phase+space_0
- nominal-sym_0
- nominal-require-phase+space-shift_0
- extra-inspector_0
- extra-nominal-bindings_0))
- (let-values ()
- (simple-module-binding46.1 module_0 phase_1 sym_0 nominal-module_0))))))))))))))))))
+ #f)
+ #f))))))))
+ (full-module-binding45.1
+ frame-id_0
+ free=id_0
+ module_0
+ phase_1
+ sym_0
+ nominal-module_0
+ nominal-phase+space_0
+ nominal-sym_0
+ nominal-require-phase+space-shift_0
+ extra-inspector_0
+ extra-nominal-bindings_0)
+ (simple-module-binding46.1 module_0 phase_1 sym_0 nominal-module_0))))))))))))))))
(define-values
(module-binding-update.1)
(lambda (extra-inspector30_0
@@ -6918,69 +6498,67 @@
b43_0)
(begin
'module-binding-update
- (let-values (((b_9) b43_0))
- (let-values (((module_1) (if (eq? module21_0 unsafe-undefined) (module-binding-module b_9) module21_0)))
- (let-values (((phase_2) (if (eq? phase22_0 unsafe-undefined) (module-binding-phase b_9) phase22_0)))
- (let-values (((sym_1) (if (eq? sym23_0 unsafe-undefined) (module-binding-sym b_9) sym23_0)))
+ (let-values (((b_26) b43_0))
+ (let-values (((module_1) (if (eq? module21_0 unsafe-undefined) (module-binding-module b_26) module21_0)))
+ (let-values (((phase_2) (if (eq? phase22_0 unsafe-undefined) (module-binding-phase b_26) phase22_0)))
+ (let-values (((sym_1) (if (eq? sym23_0 unsafe-undefined) (module-binding-sym b_26) sym23_0)))
(let-values (((nominal-module_1)
(if (eq? nominal-module24_0 unsafe-undefined)
- (module-binding-nominal-module b_9)
+ (module-binding-nominal-module b_26)
nominal-module24_0)))
(let-values (((nominal-phase+space_1)
(if (eq? nominal-phase+space25_0 unsafe-undefined)
- (module-binding-nominal-phase+space b_9)
+ (module-binding-nominal-phase+space b_26)
nominal-phase+space25_0)))
(let-values (((nominal-sym_1)
(if (eq? nominal-sym26_0 unsafe-undefined)
- (module-binding-nominal-sym b_9)
+ (module-binding-nominal-sym b_26)
nominal-sym26_0)))
(let-values (((nominal-require-phase+space-shift_1)
(if (eq? nominal-require-phase+space-shift27_0 unsafe-undefined)
- (module-binding-nominal-require-phase+space-shift b_9)
+ (module-binding-nominal-require-phase+space-shift b_26)
nominal-require-phase+space-shift27_0)))
(let-values (((frame-id_1)
- (if (eq? frame-id28_0 unsafe-undefined) (binding-frame-id b_9) frame-id28_0)))
+ (if (eq? frame-id28_0 unsafe-undefined) (binding-frame-id b_26) frame-id28_0)))
(let-values (((free=id_1)
- (if (eq? free=id29_0 unsafe-undefined) (binding-free=id b_9) free=id29_0)))
+ (if (eq? free=id29_0 unsafe-undefined) (binding-free=id b_26) free=id29_0)))
(let-values (((extra-inspector_1)
(if (eq? extra-inspector30_0 unsafe-undefined)
- (module-binding-extra-inspector b_9)
+ (module-binding-extra-inspector b_26)
extra-inspector30_0)))
(let-values (((extra-nominal-bindings_1)
(if (eq? extra-nominal-bindings31_0 unsafe-undefined)
- (module-binding-extra-nominal-bindings b_9)
+ (module-binding-extra-nominal-bindings b_26)
extra-nominal-bindings31_0)))
- (let-values ()
- (let-values (((module47_0) module_1)
- ((phase48_0) phase_2)
- ((sym49_0) sym_1)
- ((nominal-module50_0) nominal-module_1)
- ((nominal-phase+space51_0) nominal-phase+space_1)
- ((nominal-sym52_0) nominal-sym_1)
- ((nominal-require-phase+space-shift53_0)
- nominal-require-phase+space-shift_1)
- ((frame-id54_0) frame-id_1)
- ((free=id55_0) free=id_1)
- ((extra-inspector56_0) extra-inspector_1)
- ((extra-nominal-bindings57_0) extra-nominal-bindings_1))
- (make-module-binding.1
- extra-inspector56_0
- extra-nominal-bindings57_0
- frame-id54_0
- free=id55_0
- nominal-module50_0
- nominal-phase+space51_0
- nominal-require-phase+space-shift53_0
- nominal-sym52_0
- module47_0
- phase48_0
- sym49_0))))))))))))))))))
+ (let-values (((module47_0) module_1)
+ ((phase48_0) phase_2)
+ ((sym49_0) sym_1)
+ ((nominal-module50_0) nominal-module_1)
+ ((nominal-phase+space51_0) nominal-phase+space_1)
+ ((nominal-sym52_0) nominal-sym_1)
+ ((nominal-require-phase+space-shift53_0) nominal-require-phase+space-shift_1)
+ ((frame-id54_0) frame-id_1)
+ ((free=id55_0) free=id_1)
+ ((extra-inspector56_0) extra-inspector_1)
+ ((extra-nominal-bindings57_0) extra-nominal-bindings_1))
+ (make-module-binding.1
+ extra-inspector56_0
+ extra-nominal-bindings57_0
+ frame-id54_0
+ free=id55_0
+ nominal-module50_0
+ nominal-phase+space51_0
+ nominal-require-phase+space-shift53_0
+ nominal-sym52_0
+ module47_0
+ phase48_0
+ sym49_0)))))))))))))))))
(define-values
(module-binding?)
- (lambda (b_25)
+ (lambda (b_27)
(begin
- (let-values (((or-part_100) (simple-module-binding? b_25)))
- (if or-part_100 or-part_100 (full-module-binding? b_25))))))
+ (let-values (((or-part_147) (simple-module-binding? b_27)))
+ (if or-part_147 or-part_147 (full-module-binding? b_27))))))
(define-values
(struct:full-module-binding
full-module-binding45.1
@@ -6994,72 +6572,106 @@
full-module-binding-nominal-require-phase+space-shift
full-module-binding-extra-inspector
full-module-binding-extra-nominal-bindings)
- (let-values (((struct:_10 make-_10 ?_10 -ref_10 -set!_10)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'full-module-binding
- struct:full-binding
- 9
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:serialize
- (lambda (b_20 ser-push!_2 state_11)
- (let-values (((simplified-b_0)
- (if (full-binding-frame-id b_20)
- (let-values (((b59_0) b_20) ((temp60_0) #f))
- (module-binding-update.1
- unsafe-undefined
- unsafe-undefined
- temp60_0
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- b59_0))
- b_20)))
- (if (full-module-binding? simplified-b_0)
- (let-values ()
+ (let-values (((struct:_13 make-_13 ?_13 -ref_13 -set!_13)
+ (make-struct-type
+ 'full-module-binding
+ struct:full-binding
+ 9
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:binding-shift-report
+ (lambda (b_28 bulk-shifts_1 report-shifts_0)
+ (begin
+ (report-shifts_0 (full-module-binding-module b_28) bulk-shifts_1)
+ (report-shifts_0 (full-module-binding-nominal-module b_28) bulk-shifts_1)
+ (let-values (((lst_41) (full-module-binding-extra-nominal-bindings b_28)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_41))
+ ((letrec-values (((for-loop_38)
+ (lambda (lst_42)
+ (begin
+ 'for-loop
+ (if (pair? lst_42)
+ (let-values (((b_29) (unsafe-car lst_42))
+ ((rest_17) (unsafe-cdr lst_42)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (if (binding-shift-report? b_29)
+ ((binding-shift-report-ref b_29)
+ b_29
+ bulk-shifts_1
+ report-shifts_0)
+ (void))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_38 rest_17) (values))))
+ (values))))))
+ for-loop_38)
+ lst_41)))
+ (void))))
+ (cons
+ prop:serialize
+ (lambda (b_30 ser-push!_2 state_11)
+ (let-values (((simplified-b_0)
+ (if (full-binding-frame-id b_30)
+ (let-values (((b59_0) b_30) ((temp60_0) #f))
+ (module-binding-update.1
+ unsafe-undefined
+ unsafe-undefined
+ temp60_0
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ b59_0))
+ b_30)))
+ (if (full-module-binding? simplified-b_0)
+ (let-values ((() (begin (ser-push!_2 'tag '#:module-binding) (values))))
+ (let-values ((() (begin (ser-push!_2 (full-module-binding-module b_30)) (values))))
+ (let-values (((sym_2 phase_3)
+ ((serialize-state-map-binding-symbol state_11)
+ (full-module-binding-module b_30)
+ (full-module-binding-sym b_30)
+ (full-module-binding-phase b_30))))
(begin
- (ser-push!_2 'tag '#:module-binding)
- (ser-push!_2 (full-module-binding-module b_20))
- (ser-push!_2 (full-module-binding-sym b_20))
- (ser-push!_2 (full-module-binding-phase b_20))
- (ser-push!_2 (full-module-binding-nominal-module b_20))
- (ser-push!_2 (full-module-binding-nominal-phase+space b_20))
- (ser-push!_2 (full-module-binding-nominal-sym b_20))
- (ser-push!_2 (full-module-binding-nominal-require-phase+space-shift b_20))
- (ser-push!_2 (full-binding-free=id b_20))
- (if (full-module-binding-extra-inspector b_20)
+ (ser-push!_2 sym_2)
+ (ser-push!_2 phase_3)
+ (ser-push!_2 (full-module-binding-nominal-module b_30))
+ (ser-push!_2 (full-module-binding-nominal-phase+space b_30))
+ (ser-push!_2 (full-module-binding-nominal-sym b_30))
+ (ser-push!_2 (full-module-binding-nominal-require-phase+space-shift b_30))
+ (ser-push!_2 (full-binding-free=id b_30))
+ (if (full-module-binding-extra-inspector b_30)
(ser-push!_2 'tag '#:inspector)
(ser-push!_2 #f))
- (ser-push!_2 (full-module-binding-extra-nominal-bindings b_20))))
- (let-values () (ser-push!_2 simplified-b_0)))))))
- #f
- #f
- '(0 1 2 3 4 5 6 7 8)
- #f
- 'full-module-binding)))))
+ (ser-push!_2 (full-module-binding-extra-nominal-bindings b_30))))))
+ (ser-push!_2 simplified-b_0))))))
+ #f
+ #f
+ '(0 1 2 3 4 5 6 7 8)
+ #f
+ 'full-module-binding)))
(values
- struct:_10
- make-_10
- ?_10
- (make-struct-field-accessor -ref_10 0 'module)
- (make-struct-field-accessor -ref_10 1 'phase)
- (make-struct-field-accessor -ref_10 2 'sym)
- (make-struct-field-accessor -ref_10 3 'nominal-module)
- (make-struct-field-accessor -ref_10 4 'nominal-phase+space)
- (make-struct-field-accessor -ref_10 5 'nominal-sym)
- (make-struct-field-accessor -ref_10 6 'nominal-require-phase+space-shift)
- (make-struct-field-accessor -ref_10 7 'extra-inspector)
- (make-struct-field-accessor -ref_10 8 'extra-nominal-bindings))))
+ struct:_13
+ make-_13
+ ?_13
+ (make-struct-field-accessor -ref_13 0 'module)
+ (make-struct-field-accessor -ref_13 1 'phase)
+ (make-struct-field-accessor -ref_13 2 'sym)
+ (make-struct-field-accessor -ref_13 3 'nominal-module)
+ (make-struct-field-accessor -ref_13 4 'nominal-phase+space)
+ (make-struct-field-accessor -ref_13 5 'nominal-sym)
+ (make-struct-field-accessor -ref_13 6 'nominal-require-phase+space-shift)
+ (make-struct-field-accessor -ref_13 7 'extra-inspector)
+ (make-struct-field-accessor -ref_13 8 'extra-nominal-bindings))))
(define-values
(struct:simple-module-binding
simple-module-binding46.1
@@ -7068,44 +6680,53 @@
simple-module-binding-phase
simple-module-binding-sym
simple-module-binding-nominal-module)
- (let-values (((struct:_11 make-_11 ?_11 -ref_11 -set!_11)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'simple-module-binding
- #f
- 4
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:serialize
- (lambda (b_26 ser-push!_3 state_12)
- (begin
- (ser-push!_3 'tag '#:simple-module-binding)
- (ser-push!_3 (simple-module-binding-module b_26))
- (ser-push!_3 (simple-module-binding-sym b_26))
- (ser-push!_3 (simple-module-binding-phase b_26))
- (ser-push!_3 (simple-module-binding-nominal-module b_26))))))
- #f
- #f
- '(0 1 2 3)
- #f
- 'simple-module-binding)))))
+ (let-values (((struct:_14 make-_14 ?_14 -ref_14 -set!_14)
+ (make-struct-type
+ 'simple-module-binding
+ #f
+ 4
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:binding-shift-report
+ (lambda (b_31 bulk-shifts_2 report-shifts_1)
+ (begin
+ (report-shifts_1 (simple-module-binding-module b_31) bulk-shifts_2)
+ (report-shifts_1 (simple-module-binding-nominal-module b_31) bulk-shifts_2))))
+ (cons
+ prop:serialize
+ (lambda (b_32 ser-push!_3 state_12)
+ (let-values ((() (begin (ser-push!_3 'tag '#:simple-module-binding) (values))))
+ (let-values ((() (begin (ser-push!_3 (simple-module-binding-module b_32)) (values))))
+ (let-values (((sym_3 phase_4)
+ ((serialize-state-map-binding-symbol state_12)
+ (simple-module-binding-module b_32)
+ (simple-module-binding-sym b_32)
+ (simple-module-binding-phase b_32))))
+ (begin
+ (ser-push!_3 sym_3)
+ (ser-push!_3 phase_4)
+ (ser-push!_3 (simple-module-binding-nominal-module b_32)))))))))
+ #f
+ #f
+ '(0 1 2 3)
+ #f
+ 'simple-module-binding)))
(values
- struct:_11
- make-_11
- ?_11
- (make-struct-field-accessor -ref_11 0 'module)
- (make-struct-field-accessor -ref_11 1 'phase)
- (make-struct-field-accessor -ref_11 2 'sym)
- (make-struct-field-accessor -ref_11 3 'nominal-module))))
+ struct:_14
+ make-_14
+ ?_14
+ (make-struct-field-accessor -ref_14 0 'module)
+ (make-struct-field-accessor -ref_14 1 'phase)
+ (make-struct-field-accessor -ref_14 2 'sym)
+ (make-struct-field-accessor -ref_14 3 'nominal-module))))
(define-values
(deserialize-full-module-binding)
(lambda (module_2
- sym_2
- phase_3
+ sym_4
+ phase_5
nominal-module_2
nominal-phase+space_2
nominal-sym_2
@@ -7115,8 +6736,8 @@
extra-nominal-bindings_2)
(begin
(let-values (((module62_0) module_2)
- ((phase63_0) phase_3)
- ((sym64_0) sym_2)
+ ((phase63_0) phase_5)
+ ((sym64_0) sym_4)
((nominal-module65_0) nominal-module_2)
((temp66_0) (intern-phase+space nominal-phase+space_2))
((nominal-sym67_0) nominal-sym_2)
@@ -7138,70 +6759,151 @@
sym64_0)))))
(define-values
(deserialize-simple-module-binding)
- (lambda (module_3 sym_3 phase_4 nominal-module_3)
- (begin (simple-module-binding46.1 module_3 phase_4 sym_3 nominal-module_3))))
+ (lambda (module_3 sym_5 phase_6 nominal-module_3)
+ (begin (simple-module-binding46.1 module_3 phase_6 sym_5 nominal-module_3))))
+ (define-values
+ (module-binding-maybe-intern)
+ (lambda (v_88 interns_0 map-binding-symbol_1 mpi->index_0)
+ (begin
+ (let-values (((key_18)
+ (if (simple-module-binding? v_88)
+ (let-values (((sym_6 phase_7)
+ (map-binding-symbol_1
+ (simple-module-binding-module v_88)
+ (simple-module-binding-sym v_88)
+ (simple-module-binding-phase v_88))))
+ (list
+ (mpi->index_0 (simple-module-binding-module v_88))
+ phase_7
+ sym_6
+ (mpi->index_0 (simple-module-binding-nominal-module v_88))))
+ (if (full-module-binding? v_88)
+ (let-values (((sym_7 phase_8)
+ (map-binding-symbol_1
+ (full-module-binding-module v_88)
+ (full-module-binding-sym v_88)
+ (full-module-binding-phase v_88))))
+ (list
+ (mpi->index_0 (full-module-binding-module v_88))
+ phase_8
+ sym_7
+ (mpi->index_0 (full-module-binding-nominal-module v_88))
+ (full-module-binding-nominal-phase+space v_88)
+ (full-module-binding-nominal-sym v_88)
+ (full-module-binding-nominal-require-phase+space-shift v_88)
+ (full-module-binding-extra-inspector v_88)
+ (reverse$1
+ (let-values (((fold-var_30) (let-values (((fold-var_31) null)) fold-var_31)))
+ (let-values (((pos->vals_2
+ pos-pre-inc_0
+ pos-next_2
+ init_2
+ pos-cont?_2
+ val-cont?_2
+ all-cont?_2)
+ (make-sequence '(b) (full-module-binding-extra-nominal-bindings v_88))))
+ ((letrec-values (((for-loop_39)
+ (lambda (fold-var_32 pos_15)
+ (begin
+ 'for-loop
+ (if (if pos-cont?_2 (pos-cont?_2 pos_15) #t)
+ (let-values (((b_33 all-cont?/pos_0)
+ (let-values (((b_34) (pos->vals_2 pos_15)))
+ (values
+ b_34
+ (if all-cont?_2
+ (lambda (pos_16) (all-cont?_2 pos_16 b_34))
+ #f))))
+ ((pos_17)
+ (if pos-pre-inc_0 (pos-pre-inc_0 pos_15) pos_15)))
+ (if (if val-cont?_2 (val-cont?_2 b_33) #t)
+ (let-values (((fold-var_33)
+ (let-values (((fold-var_34)
+ (cons
+ (let-values (((or-part_148)
+ (module-binding-maybe-intern
+ b_33
+ interns_0
+ map-binding-symbol_1
+ mpi->index_0)))
+ (if or-part_148
+ or-part_148
+ b_33))
+ fold-var_32)))
+ (values fold-var_34))))
+ (if (if (if all-cont?/pos_0 (all-cont?/pos_0 pos_17) #t)
+ (not #f)
+ #f)
+ (for-loop_39 fold-var_33 (pos-next_2 pos_17))
+ fold-var_33))
+ fold-var_32))
+ fold-var_32)))))
+ for-loop_39)
+ fold-var_30
+ init_2))))))
+ (void)))))
+ (let-values (((new-v_0) (hash-ref interns_0 key_18 #f)))
+ (if (not new-v_0) (begin (hash-set! interns_0 key_18 v_88) #f) (if (eq? new-v_0 v_88) #f new-v_0)))))))
(define-values
(module-binding-module)
- (lambda (b_27)
- (begin (if (simple-module-binding? b_27) (simple-module-binding-module b_27) (full-module-binding-module b_27)))))
+ (lambda (b_35)
+ (begin (if (simple-module-binding? b_35) (simple-module-binding-module b_35) (full-module-binding-module b_35)))))
(define-values
(module-binding-phase)
- (lambda (b_28)
- (begin (if (simple-module-binding? b_28) (simple-module-binding-phase b_28) (full-module-binding-phase b_28)))))
+ (lambda (b_36)
+ (begin (if (simple-module-binding? b_36) (simple-module-binding-phase b_36) (full-module-binding-phase b_36)))))
(define-values
(module-binding-sym)
- (lambda (b_29)
- (begin (if (simple-module-binding? b_29) (simple-module-binding-sym b_29) (full-module-binding-sym b_29)))))
+ (lambda (b_37)
+ (begin (if (simple-module-binding? b_37) (simple-module-binding-sym b_37) (full-module-binding-sym b_37)))))
(define-values
(module-binding-nominal-module)
- (lambda (b_30)
+ (lambda (b_38)
(begin
- (if (simple-module-binding? b_30)
- (simple-module-binding-nominal-module b_30)
- (full-module-binding-nominal-module b_30)))))
+ (if (simple-module-binding? b_38)
+ (simple-module-binding-nominal-module b_38)
+ (full-module-binding-nominal-module b_38)))))
(define-values
(module-binding-nominal-phase+space)
- (lambda (b_31)
+ (lambda (b_39)
(begin
- (if (simple-module-binding? b_31)
- (simple-module-binding-phase b_31)
- (full-module-binding-nominal-phase+space b_31)))))
+ (if (simple-module-binding? b_39)
+ (simple-module-binding-phase b_39)
+ (full-module-binding-nominal-phase+space b_39)))))
(define-values
(module-binding-nominal-sym)
- (lambda (b_32)
- (begin (if (simple-module-binding? b_32) (simple-module-binding-sym b_32) (full-module-binding-nominal-sym b_32)))))
+ (lambda (b_40)
+ (begin (if (simple-module-binding? b_40) (simple-module-binding-sym b_40) (full-module-binding-nominal-sym b_40)))))
(define-values
(module-binding-nominal-require-phase+space-shift)
- (lambda (b_33)
- (begin (if (simple-module-binding? b_33) 0 (full-module-binding-nominal-require-phase+space-shift b_33)))))
+ (lambda (b_41)
+ (begin (if (simple-module-binding? b_41) 0 (full-module-binding-nominal-require-phase+space-shift b_41)))))
(define-values
(module-binding-extra-inspector)
- (lambda (b_34) (begin (if (simple-module-binding? b_34) #f (full-module-binding-extra-inspector b_34)))))
+ (lambda (b_42) (begin (if (simple-module-binding? b_42) #f (full-module-binding-extra-inspector b_42)))))
(define-values
(module-binding-extra-nominal-bindings)
- (lambda (b_35) (begin (if (simple-module-binding? b_35) null (full-module-binding-extra-nominal-bindings b_35)))))
+ (lambda (b_43) (begin (if (simple-module-binding? b_43) null (full-module-binding-extra-nominal-bindings b_43)))))
(define-values
(struct:like-ambiguous-binding like-ambiguous-binding1.1 like-ambiguous-binding?)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'like-ambiguous-binding
- #f
- 0
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:serialize
- (lambda (b_21 ser-push!_4 state_13) (ser-push!_4 'tag '#:like-ambiguous-binding))))
- #f
- #f
- '()
- #f
- 'like-ambiguous-binding)))))
- (values struct:_2 make-_2 ?_2)))
+ (let-values (((struct:_15 make-_15 ?_15 -ref_15 -set!_15)
+ (make-struct-type
+ 'like-ambiguous-binding
+ #f
+ 0
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:serialize
+ (lambda (b_44 ser-push!_4 state_13) (ser-push!_4 'tag '#:like-ambiguous-binding))))
+ #f
+ #f
+ '()
+ #f
+ 'like-ambiguous-binding)))
+ (values struct:_15 make-_15 ?_15)))
(define-values (empty-binding-table) '#hasheq())
(define-values
(struct:table-with-bulk-bindings
@@ -7210,71 +6912,67 @@
table-with-bulk-bindings-syms
table-with-bulk-bindings-syms/serialize
table-with-bulk-bindings-bulk-bindings)
- (let-values (((struct:_12 make-_12 ?_12 -ref_12 -set!_12)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'table-with-bulk-bindings
- #f
- 3
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:serialize
- (lambda (twbb_0 ser-push!_5 state_14)
- (begin
- (ser-push!_5 'tag '#:table-with-bulk-bindings)
- (ser-push!_5 (table-with-bulk-bindings-syms/serialize twbb_0))
- (ser-push!_5 (table-with-bulk-bindings-bulk-bindings twbb_0))))))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'table-with-bulk-bindings)))))
+ (let-values (((struct:_16 make-_16 ?_16 -ref_16 -set!_16)
+ (make-struct-type
+ 'table-with-bulk-bindings
+ #f
+ 3
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:serialize
+ (lambda (twbb_0 ser-push!_5 state_14)
+ (begin
+ (ser-push!_5 'tag '#:table-with-bulk-bindings)
+ (ser-push!_5 (table-with-bulk-bindings-syms/serialize twbb_0))
+ (ser-push!_5 (table-with-bulk-bindings-bulk-bindings twbb_0))))))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'table-with-bulk-bindings)))
(values
- struct:_12
- make-_12
- ?_12
- (make-struct-field-accessor -ref_12 0 'syms)
- (make-struct-field-accessor -ref_12 1 'syms/serialize)
- (make-struct-field-accessor -ref_12 2 'bulk-bindings))))
+ struct:_16
+ make-_16
+ ?_16
+ (make-struct-field-accessor -ref_16 0 'syms)
+ (make-struct-field-accessor -ref_16 1 'syms/serialize)
+ (make-struct-field-accessor -ref_16 2 'bulk-bindings))))
(define-values
(deserialize-table-with-bulk-bindings)
(lambda (syms_1 bulk-bindings_0) (begin (table-with-bulk-bindings1.1 syms_1 syms_1 bulk-bindings_0))))
(define-values
(struct:bulk-binding-at bulk-binding-at2.1 bulk-binding-at? bulk-binding-at-scopes bulk-binding-at-bulk)
- (let-values (((struct:_13 make-_13 ?_13 -ref_13 -set!_13)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'bulk-binding-at
- #f
- 2
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons prop:reach-scopes (lambda (sms_2 extra-scopes_0 reach_1) (error "shouldn't get here")))
- (cons
- prop:serialize
- (lambda (bba_0 ser-push!_6 state_15)
- (begin
- (ser-push!_6 'tag '#:bulk-binding-at)
- (ser-push!_6 (bulk-binding-at-scopes bba_0))
- (ser-push!_6 (bulk-binding-at-bulk bba_0))))))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'bulk-binding-at)))))
+ (let-values (((struct:_17 make-_17 ?_17 -ref_17 -set!_17)
+ (make-struct-type
+ 'bulk-binding-at
+ #f
+ 2
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons prop:reach-scopes (lambda (sms_2 extra-scopes_0 reach_1) (error "shouldn't get here")))
+ (cons
+ prop:serialize
+ (lambda (bba_0 ser-push!_6 state_15)
+ (begin
+ (ser-push!_6 'tag '#:bulk-binding-at)
+ (ser-push!_6 (bulk-binding-at-scopes bba_0))
+ (ser-push!_6 (bulk-binding-at-bulk bba_0))))))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'bulk-binding-at)))
(values
- struct:_13
- make-_13
- ?_13
- (make-struct-field-accessor -ref_13 0 'scopes)
- (make-struct-field-accessor -ref_13 1 'bulk))))
+ struct:_17
+ make-_17
+ ?_17
+ (make-struct-field-accessor -ref_17 0 'scopes)
+ (make-struct-field-accessor -ref_17 1 'bulk))))
(define-values (deserialize-bulk-binding-at) (lambda (scopes_0 bulk_0) (begin (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-values
@@ -7283,83 +6981,83 @@
bulk-binding-class?
bulk-binding-class-get-symbols
bulk-binding-class-create
- bulk-binding-class-modname)
- (let-values (((struct:_14 make-_14 ?_14 -ref_14 -set!_14)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'bulk-binding-class
- #f
- 3
- 0
- #f
- null
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'bulk-binding-class)))))
+ bulk-binding-class-modname
+ bulk-binding-class-report-shifts)
+ (let-values (((struct:_18 make-_18 ?_18 -ref_18 -set!_18)
+ (make-struct-type
+ 'bulk-binding-class
+ #f
+ 4
+ 0
+ #f
+ null
+ (current-inspector)
+ #f
+ '(0 1 2 3)
+ #f
+ 'bulk-binding-class)))
(values
- struct:_14
- make-_14
- ?_14
- (make-struct-field-accessor -ref_14 0 'get-symbols)
- (make-struct-field-accessor -ref_14 1 'create)
- (make-struct-field-accessor -ref_14 2 'modname))))
+ struct:_18
+ make-_18
+ ?_18
+ (make-struct-field-accessor -ref_18 0 'get-symbols)
+ (make-struct-field-accessor -ref_18 1 'create)
+ (make-struct-field-accessor -ref_18 2 'modname)
+ (make-struct-field-accessor -ref_18 3 'report-shifts))))
(define-values
(bulk-binding-symbols)
- (lambda (b_36 s_81 extra-shifts_0)
+ (lambda (b_45 s_89 extra-shifts_0)
(begin
- ((bulk-binding-class-get-symbols (bulk-binding-ref b_36))
- b_36
- (append extra-shifts_0 (if s_81 (syntax-mpi-shifts s_81) null))))))
- (define-values (bulk-binding-create) (lambda (b_37) (begin (bulk-binding-class-create (bulk-binding-ref b_37)))))
+ ((bulk-binding-class-get-symbols (bulk-binding-ref b_45))
+ b_45
+ (append extra-shifts_0 (if s_89 (syntax-mpi-shifts s_89) null))))))
+ (define-values (bulk-binding-create) (lambda (b_46) (begin (bulk-binding-class-create (bulk-binding-ref b_46)))))
(define-values
(force-bulk-bindings)
- (lambda (b_38 bulk-shifts_1)
+ (lambda (b_47 bulk-shifts_3)
(begin
- (let-values (((modname-ht_0) (car bulk-shifts_1)))
- (let-values (((extra-shifts_1) (cdr bulk-shifts_1)))
+ (let-values (((modname-ht_0) (car bulk-shifts_3)))
+ (let-values (((extra-shifts_1) (cdr bulk-shifts_3)))
(begin
- (hash-set! modname-ht_0 b_38 ((bulk-binding-class-modname (bulk-binding-ref b_38)) b_38 extra-shifts_1))
- (bulk-binding-symbols b_38 #f extra-shifts_1)))))))
+ (hash-set! modname-ht_0 b_47 ((bulk-binding-class-modname (bulk-binding-ref b_47)) b_47 extra-shifts_1))
+ (bulk-binding-symbols b_47 #f extra-shifts_1)))))))
+ (define-values
+ (bulk-binding-report-shifts)
+ (lambda (b_48 bulk-shifts_4 report-shifts_2)
+ (begin ((bulk-binding-class-report-shifts (bulk-binding-ref b_48)) b_48 bulk-shifts_4 report-shifts_2))))
(define-values (binding-table-empty?) (lambda (bt_0) (begin (if (hash? bt_0) (zero? (hash-count bt_0)) #f))))
(define-values
(binding-table-add)
- (lambda (bt_1 scopes_1 sym_4 binding_0 just-for-nominal?_0)
+ (lambda (bt_1 scopes_1 sym_8 binding_0 just-for-nominal?_0)
(begin
(if (hash? bt_1)
- (let-values () (hash-set bt_1 sym_4 (hash-set (hash-ref bt_1 sym_4 '#hash()) scopes_1 binding_0)))
- (let-values ()
- (let-values (((new-syms_0)
- (binding-table-add
- (table-with-bulk-bindings-syms bt_1)
- scopes_1
- sym_4
- binding_0
- just-for-nominal?_0)))
- (let-values (((new-syms/serialize_0)
- (if just-for-nominal?_0
- (let-values () (table-with-bulk-bindings-syms/serialize bt_1))
- (if (eq?
- (table-with-bulk-bindings-syms bt_1)
- (table-with-bulk-bindings-syms/serialize bt_1))
- (let-values () new-syms_0)
- (let-values ()
- (binding-table-add
- (table-with-bulk-bindings-syms/serialize bt_1)
- scopes_1
- sym_4
- binding_0
- #f))))))
- (let-values (((the-struct_1) bt_1))
- (if (table-with-bulk-bindings? the-struct_1)
- (let-values (((syms35_0) new-syms_0) ((syms/serialize36_0) new-syms/serialize_0))
- (table-with-bulk-bindings1.1
- syms35_0
- syms/serialize36_0
- (table-with-bulk-bindings-bulk-bindings the-struct_1)))
- (raise-argument-error 'struct-copy "table-with-bulk-bindings?" the-struct_1))))))))))
+ (hash-set bt_1 sym_8 (hash-set (hash-ref bt_1 sym_8 '#hash()) scopes_1 binding_0))
+ (let-values (((new-syms_0)
+ (binding-table-add
+ (table-with-bulk-bindings-syms bt_1)
+ scopes_1
+ sym_8
+ binding_0
+ just-for-nominal?_0)))
+ (let-values (((new-syms/serialize_0)
+ (if just-for-nominal?_0
+ (table-with-bulk-bindings-syms/serialize bt_1)
+ (if (eq? (table-with-bulk-bindings-syms bt_1) (table-with-bulk-bindings-syms/serialize bt_1))
+ new-syms_0
+ (binding-table-add
+ (table-with-bulk-bindings-syms/serialize bt_1)
+ scopes_1
+ sym_8
+ binding_0
+ #f)))))
+ (let-values (((the-struct_1) bt_1))
+ (if (table-with-bulk-bindings? the-struct_1)
+ (let-values (((syms45_0) new-syms_0) ((syms/serialize46_0) new-syms/serialize_0))
+ (table-with-bulk-bindings1.1
+ syms45_0
+ syms/serialize46_0
+ (table-with-bulk-bindings-bulk-bindings the-struct_1)))
+ (raise-argument-error 'struct-copy "table-with-bulk-bindings?" the-struct_1)))))))))
(define-values
(prop:implicitly-reachable implicitly-reachable? implicitly-reachable-ref)
(make-struct-type-property 'implicitly-reachable))
@@ -7372,34 +7070,31 @@
(let-values (((scopes_2) scopes7_0))
(let-values (((bulk_1) bulk8_0))
(let-values (((shadow-except_0) shadow-except4_0))
- (let-values ()
- (if (table-with-bulk-bindings? bt_2)
- (let-values ()
- (let-values (((new-syms_1)
- (let-values (((temp37_0) (table-with-bulk-bindings-syms bt_2))
- ((scopes38_0) scopes_2)
- ((bulk39_0) bulk_1)
- ((shadow-except40_0) shadow-except_0))
- (remove-matching-bindings.1 shadow-except40_0 temp37_0 scopes38_0 bulk39_0))))
- (let-values (((new-syms/serialize_1)
- (if (eq?
- (table-with-bulk-bindings-syms bt_2)
- (table-with-bulk-bindings-syms/serialize bt_2))
- new-syms_1
- (let-values (((temp41_0) (table-with-bulk-bindings-syms/serialize bt_2))
- ((scopes42_0) scopes_2)
- ((bulk43_0) bulk_1)
- ((shadow-except44_0) shadow-except_0))
- (remove-matching-bindings.1 shadow-except44_0 temp41_0 scopes42_0 bulk43_0)))))
- (table-with-bulk-bindings1.1
- new-syms_1
- new-syms/serialize_1
- (cons (bulk-binding-at2.1 scopes_2 bulk_1) (table-with-bulk-bindings-bulk-bindings bt_2))))))
- (let-values ()
- (let-values (((temp45_0) (table-with-bulk-bindings1.1 bt_2 bt_2 null))
- ((scopes46_0) scopes_2)
- ((bulk47_0) bulk_1))
- (binding-table-add-bulk.1 #f temp45_0 scopes46_0 bulk47_0))))))))))))
+ (if (table-with-bulk-bindings? bt_2)
+ (let-values (((new-syms_1)
+ (let-values (((temp47_0) (table-with-bulk-bindings-syms bt_2))
+ ((scopes48_0) scopes_2)
+ ((bulk49_0) bulk_1)
+ ((shadow-except50_0) shadow-except_0))
+ (remove-matching-bindings.1 shadow-except50_0 temp47_0 scopes48_0 bulk49_0))))
+ (let-values (((new-syms/serialize_1)
+ (if (eq?
+ (table-with-bulk-bindings-syms bt_2)
+ (table-with-bulk-bindings-syms/serialize bt_2))
+ new-syms_1
+ (let-values (((temp51_0) (table-with-bulk-bindings-syms/serialize bt_2))
+ ((scopes52_0) scopes_2)
+ ((bulk53_0) bulk_1)
+ ((shadow-except54_0) shadow-except_0))
+ (remove-matching-bindings.1 shadow-except54_0 temp51_0 scopes52_0 bulk53_0)))))
+ (table-with-bulk-bindings1.1
+ new-syms_1
+ new-syms/serialize_1
+ (cons (bulk-binding-at2.1 scopes_2 bulk_1) (table-with-bulk-bindings-bulk-bindings bt_2)))))
+ (let-values (((temp55_0) (table-with-bulk-bindings1.1 bt_2 bt_2 null))
+ ((scopes56_0) scopes_2)
+ ((bulk57_0) bulk_1))
+ (binding-table-add-bulk.1 #f temp55_0 scopes56_0 bulk57_0))))))))))
(define-values
(remove-matching-bindings.1)
(lambda (except10_0 syms12_0 scopes13_0 bulk14_0)
@@ -7409,130 +7104,117 @@
(let-values (((scopes_3) scopes13_0))
(let-values (((bulk_2) bulk14_0))
(let-values (((except_0) except10_0))
- (let-values ()
- (let-values (((bulk-symbols_0) (bulk-binding-symbols bulk_2 #f null)))
- (if (< (hash-count syms_2) (hash-count bulk-symbols_0))
- (let-values ()
- (let-values (((ht_35) syms_2))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash ht_35)))
- ((letrec-values (((for-loop_38)
- (lambda (syms_3 i_52)
- (begin
- 'for-loop
- (if i_52
- (let-values (((sym_5 sym-bindings_0)
- (unsafe-immutable-hash-iterate-key+value ht_35 i_52)))
- (let-values (((syms_4)
- (let-values (((syms_5) syms_3))
- (let-values (((syms_6)
- (let-values ()
- (if (hash-ref
- bulk-symbols_0
- sym_5
- #f)
- (let-values (((syms48_0) syms_5)
- ((sym49_1) sym_5)
- ((sym-bindings50_0)
- sym-bindings_0)
- ((scopes51_0)
- scopes_3)
- ((except52_0)
- except_0))
- (remove-matching-binding.1
- except52_0
- syms48_0
- sym49_1
- sym-bindings50_0
- scopes51_0))
- syms_5))))
- (values syms_6)))))
- (if (not #f)
- (for-loop_38
- syms_4
- (unsafe-immutable-hash-iterate-next ht_35 i_52))
- syms_4)))
- syms_3)))))
- for-loop_38)
- syms_2
- (unsafe-immutable-hash-iterate-first ht_35)))))
- (let-values ()
- (let-values (((ht_36) bulk-symbols_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_36)))
- ((letrec-values (((for-loop_39)
- (lambda (syms_7 i_53)
- (begin
- 'for-loop
- (if i_53
- (let-values (((sym_6) (unsafe-immutable-hash-iterate-key ht_36 i_53)))
- (let-values (((syms_8)
- (let-values (((syms_9) syms_7))
- (let-values (((syms_10)
- (let-values ()
- (let-values (((sym-bindings_1)
- (hash-ref
- syms_9
- sym_6
- #f)))
- (if sym-bindings_1
- (let-values (((syms53_0) syms_9)
- ((sym54_0) sym_6)
- ((sym-bindings55_0)
- sym-bindings_1)
- ((scopes56_0)
- scopes_3)
- ((except57_0)
- except_0))
- (remove-matching-binding.1
- except57_0
- syms53_0
- sym54_0
- sym-bindings55_0
- scopes56_0))
- syms_9)))))
- (values syms_10)))))
- (if (not #f)
- (for-loop_39
- syms_8
- (unsafe-immutable-hash-iterate-next ht_36 i_53))
- syms_8)))
- syms_7)))))
- for-loop_39)
- syms_2
- (unsafe-immutable-hash-iterate-first ht_36)))))))))))))))
+ (let-values (((bulk-symbols_0) (bulk-binding-symbols bulk_2 #f null)))
+ (if (< (hash-count syms_2) (hash-count bulk-symbols_0))
+ (let-values (((syms_3) (let-values (((syms_4) syms_2)) syms_4)))
+ (let-values (((ht_37) syms_2))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash ht_37))
+ ((letrec-values (((for-loop_40)
+ (lambda (syms_5 i_71)
+ (begin
+ 'for-loop
+ (if i_71
+ (let-values (((sym_9 sym-bindings_0)
+ (unsafe-immutable-hash-iterate-key+value ht_37 i_71)))
+ (let-values (((syms_6)
+ (let-values (((syms_7)
+ (if (hash-ref bulk-symbols_0 sym_9 #f)
+ (let-values (((syms58_0) syms_5)
+ ((sym59_0) sym_9)
+ ((sym-bindings60_0)
+ sym-bindings_0)
+ ((scopes61_0) scopes_3)
+ ((except62_0) except_0))
+ (remove-matching-binding.1
+ except62_0
+ syms58_0
+ sym59_0
+ sym-bindings60_0
+ scopes61_0))
+ syms_5)))
+ (values syms_7))))
+ (if (not #f)
+ (for-loop_40
+ syms_6
+ (unsafe-immutable-hash-iterate-next ht_37 i_71))
+ syms_6)))
+ syms_5)))))
+ for-loop_40)
+ syms_3
+ (unsafe-immutable-hash-iterate-first ht_37)))))
+ (let-values (((syms_8) (let-values (((syms_9) syms_2)) syms_9)))
+ (let-values (((ht_38) bulk-symbols_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_38))
+ ((letrec-values (((for-loop_41)
+ (lambda (syms_10 i_72)
+ (begin
+ 'for-loop
+ (if i_72
+ (let-values (((sym_10) (unsafe-immutable-hash-iterate-key ht_38 i_72)))
+ (let-values (((syms_11)
+ (let-values (((syms_12)
+ (let-values (((sym-bindings_1)
+ (hash-ref
+ syms_10
+ sym_10
+ #f)))
+ (if sym-bindings_1
+ (let-values (((syms63_0) syms_10)
+ ((sym64_1) sym_10)
+ ((sym-bindings65_0)
+ sym-bindings_1)
+ ((scopes66_0) scopes_3)
+ ((except67_0) except_0))
+ (remove-matching-binding.1
+ except67_0
+ syms63_0
+ sym64_1
+ sym-bindings65_0
+ scopes66_0))
+ syms_10))))
+ (values syms_12))))
+ (if (not #f)
+ (for-loop_41
+ syms_11
+ (unsafe-immutable-hash-iterate-next ht_38 i_72))
+ syms_11)))
+ syms_10)))))
+ for-loop_41)
+ syms_8
+ (unsafe-immutable-hash-iterate-first ht_38))))))))))))))
(define-values
(remove-matching-binding.1)
(lambda (except16_0 syms18_0 sym19_1 sym-bindings20_0 scopes21_0)
(begin
'remove-matching-binding
- (let-values (((syms_11) syms18_0))
- (let-values (((sym_7) sym19_1))
+ (let-values (((syms_13) syms18_0))
+ (let-values (((sym_11) sym19_1))
(let-values (((sym-bindings_2) sym-bindings20_0))
(let-values (((scopes_4) scopes21_0))
(let-values (((except_1) except16_0))
- (let-values ()
- (if (if except_1
- (let-values (((b_39) (hash-ref sym-bindings_2 scopes_4 #f)))
- (let-values (((or-part_57)
- (if (module-binding? b_39) (eq? except_1 (module-binding-module b_39)) #f)))
- (if or-part_57 or-part_57 (like-ambiguous-binding? b_39))))
- #f)
- (let-values () syms_11)
- (let-values () (hash-set syms_11 sym_7 (hash-remove sym-bindings_2 scopes_4)))))))))))))
+ (if (if except_1
+ (let-values (((b_49) (hash-ref sym-bindings_2 scopes_4 #f)))
+ (let-values (((or-part_149)
+ (if (module-binding? b_49) (eq? except_1 (module-binding-module b_49)) #f)))
+ (if or-part_149 or-part_149 (like-ambiguous-binding? b_49))))
+ #f)
+ syms_13
+ (hash-set syms_13 sym_11 (hash-remove sym-bindings_2 scopes_4)))))))))))
(define-values
(next-state-in-full-binding-table)
(lambda (sym-ht_0 sym-i_0)
(begin
(if sym-i_0
- (let-values (((ht_37) (hash-iterate-value sym-ht_0 sym-i_0)))
- (let-values (((i_54) (hash-iterate-first ht_37)))
- (if i_54
- (cons (vector sym-i_0 (hash-iterate-key sym-ht_0 sym-i_0) ht_37) i_54)
+ (let-values (((ht_39) (hash-iterate-value sym-ht_0 sym-i_0)))
+ (let-values (((i_73) (hash-iterate-first ht_39)))
+ (if i_73
+ (cons (vector sym-i_0 (hash-iterate-key sym-ht_0 sym-i_0) ht_39) i_73)
(next-state-in-full-binding-table sym-ht_0 (hash-iterate-next sym-ht_0 sym-i_0)))))
'(#f . #f)))))
(define-values
@@ -7540,382 +7222,527 @@
(lambda (exactly?24_0 only-interned?23_0 table27_0 scs28_0 s29_0 extra-shifts30_0)
(begin
'binding-table-symbols
- (let-values (((table_27) table27_0))
+ (let-values (((table_29) table27_0))
(let-values (((scs_2) scs28_0))
- (let-values (((s_82) s29_0))
+ (let-values (((s_90) s29_0))
(let-values (((extra-shifts_2) extra-shifts30_0))
(let-values (((only-interned?_0) only-interned?23_0))
(let-values (((exactly?_0) exactly?24_0))
- (let-values ()
- (let-values (((ht_38 bulk-bindings_1)
- (if (hash? table_27)
- (values table_27 null)
- (values
- (table-with-bulk-bindings-syms table_27)
- (table-with-bulk-bindings-bulk-bindings table_27)))))
- (set-union
- (let-values (((ht_39) ht_38))
+ (let-values (((ht_40 bulk-bindings_1)
+ (if (hash? table_29)
+ (values table_29 null)
+ (values
+ (table-with-bulk-bindings-syms table_29)
+ (table-with-bulk-bindings-bulk-bindings table_29)))))
+ (set-union
+ (let-values (((table_30) (let-values (((table_31) '#hasheq())) table_31)))
+ (let-values (((ht_41) ht_40))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_39)))
- ((letrec-values (((for-loop_40)
- (lambda (table_28 i_55)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_41))
+ ((letrec-values (((for-loop_42)
+ (lambda (table_32 i_74)
(begin
'for-loop
- (if i_55
- (let-values (((sym_8 at-sym_0) (hash-iterate-key+value ht_39 i_55)))
- (let-values (((table_29)
- (let-values (((table_30) table_28))
- (if (let-values (((or-part_101)
- (not only-interned?_0)))
- (if or-part_101
- or-part_101
- (symbol-interned? sym_8)))
- (let-values (((table_31) table_30))
- (if (let-values (((ht_40) at-sym_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash-keys ht_40)))
- ((letrec-values (((for-loop_41)
- (lambda (result_32
- i_56)
- (begin
- 'for-loop
- (if i_56
- (let-values (((an-scs_0)
- (hash-iterate-key
- ht_40
- i_56)))
- (let-values (((result_33)
- (let-values ()
- (let-values (((result_34)
- (let-values ()
- (let-values ()
- (if exactly?_0
- (set=?
- an-scs_0
- scs_2)
- (subset?
- an-scs_0
- scs_2))))))
- (values
- result_34)))))
- (if (if (not
- ((lambda x_23
- result_33)
- an-scs_0))
- (not
- #f)
- #f)
- (for-loop_41
- result_33
- (hash-iterate-next
- ht_40
- i_56))
- result_33)))
- result_32)))))
- for-loop_41)
- #f
- (hash-iterate-first ht_40))))
- (let-values (((table_32) table_31))
- (let-values (((table_33)
- (let-values ()
- (let-values (((key_18
- val_6)
- (let-values ()
- (values
- (let-values ()
- sym_8)
- #t))))
- (hash-set
- table_32
- key_18
- val_6)))))
- (values table_33)))
- table_31))
- table_30))))
+ (if i_74
+ (let-values (((sym_12 at-sym_0) (hash-iterate-key+value ht_41 i_74)))
+ (let-values (((table_33)
+ (if (let-values (((or-part_150)
+ (not only-interned?_0)))
+ (if or-part_150
+ or-part_150
+ (symbol-interned? sym_12)))
+ (if (let-values (((result_52)
+ (let-values (((result_53) #f))
+ result_53)))
+ (let-values (((ht_42) at-sym_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash-keys ht_42))
+ ((letrec-values (((for-loop_43)
+ (lambda (result_54
+ i_75)
+ (begin
+ 'for-loop
+ (if i_75
+ (let-values (((an-scs_0)
+ (hash-iterate-key
+ ht_42
+ i_75)))
+ (let-values (((result_55)
+ (let-values (((result_56)
+ (if exactly?_0
+ (set=?
+ an-scs_0
+ scs_2)
+ (subset?
+ an-scs_0
+ scs_2))))
+ (values
+ result_56))))
+ (if (if (not
+ ((lambda x_25
+ result_55)
+ an-scs_0))
+ (not
+ #f)
+ #f)
+ (for-loop_43
+ result_55
+ (hash-iterate-next
+ ht_42
+ i_75))
+ result_55)))
+ result_54)))))
+ for-loop_43)
+ result_52
+ (hash-iterate-first ht_42)))))
+ (let-values (((table_34)
+ (let-values (((key_19 val_6)
+ (values sym_12 #t)))
+ (hash-set
+ table_32
+ key_19
+ val_6))))
+ (values table_34))
+ table_32)
+ table_32)))
(if (not #f)
- (for-loop_40 table_29 (hash-iterate-next ht_39 i_55))
- table_29)))
- table_28)))))
- for-loop_40)
- '#hasheq()
- (hash-iterate-first ht_39))))
- (let-values (((lst_40) bulk-bindings_1))
+ (for-loop_42 table_33 (hash-iterate-next ht_41 i_74))
+ table_33)))
+ table_32)))))
+ for-loop_42)
+ table_30
+ (hash-iterate-first ht_41)))))
+ (let-values (((table_35) (let-values (((table_36) '#hasheq())) table_36)))
+ (let-values (((lst_43) bulk-bindings_1))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_40)))
- ((letrec-values (((for-loop_42)
- (lambda (table_34 lst_41)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_43))
+ ((letrec-values (((for-loop_44)
+ (lambda (table_37 lst_44)
(begin
'for-loop
- (if (pair? lst_41)
- (let-values (((bba_1) (unsafe-car lst_41))
- ((rest_17) (unsafe-cdr lst_41)))
- (let-values (((table_35)
- (let-values (((table_24) table_34))
- (let-values (((table_25) table_24))
- (if (if exactly?_0
- (set=?
- (bulk-binding-at-scopes bba_1)
- scs_2)
- (subset?
- (bulk-binding-at-scopes bba_1)
- scs_2))
- (let-values (((ht_41)
- (bulk-binding-symbols
- (bulk-binding-at-bulk bba_1)
- s_82
- extra-shifts_2)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash-keys ht_41)))
- ((letrec-values (((for-loop_43)
- (lambda (table_36 i_57)
- (begin
- 'for-loop
- (if i_57
- (let-values (((sym_9)
- (hash-iterate-key
- ht_41
- i_57)))
- (let-values (((table_37)
- (let-values (((table_38)
- table_36))
- (let-values (((table_39)
- table_38))
- (if (let-values (((or-part_102)
- (not
- only-interned?_0)))
- (if or-part_102
- or-part_102
- (symbol-interned?
- sym_9)))
- (let-values (((table_40)
- table_39))
- (let-values (((table_41)
- (let-values ()
- (let-values (((key_19
- val_7)
- (let-values ()
- (values
- (let-values ()
- sym_9)
- #t))))
- (hash-set
- table_40
- key_19
- val_7)))))
- (values
- table_41)))
- table_39)))))
- (if (not #f)
- (for-loop_43
- table_37
- (hash-iterate-next
- ht_41
- i_57))
- table_37)))
- table_36)))))
- for-loop_43)
- table_25
- (hash-iterate-first ht_41))))
- table_25)))))
- (if (not #f) (for-loop_42 table_35 rest_17) table_35)))
- table_34)))))
- for-loop_42)
- '#hasheq()
- lst_40)))))))))))))))
+ (if (pair? lst_44)
+ (let-values (((bba_1) (unsafe-car lst_44))
+ ((rest_18) (unsafe-cdr lst_44)))
+ (let-values (((table_38)
+ (if (if exactly?_0
+ (set=? (bulk-binding-at-scopes bba_1) scs_2)
+ (subset? (bulk-binding-at-scopes bba_1) scs_2))
+ (let-values (((ht_43)
+ (bulk-binding-symbols
+ (bulk-binding-at-bulk bba_1)
+ s_90
+ extra-shifts_2)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash-keys ht_43))
+ ((letrec-values (((for-loop_45)
+ (lambda (table_39 i_76)
+ (begin
+ 'for-loop
+ (if i_76
+ (let-values (((sym_13)
+ (hash-iterate-key
+ ht_43
+ i_76)))
+ (let-values (((table_40)
+ (if (let-values (((or-part_151)
+ (not
+ only-interned?_0)))
+ (if or-part_151
+ or-part_151
+ (symbol-interned?
+ sym_13)))
+ (let-values (((table_41)
+ (let-values (((key_20
+ val_7)
+ (values
+ sym_13
+ #t)))
+ (hash-set
+ table_39
+ key_20
+ val_7))))
+ (values
+ table_41))
+ table_39)))
+ (if (not #f)
+ (for-loop_45
+ table_40
+ (hash-iterate-next
+ ht_43
+ i_76))
+ table_40)))
+ table_39)))))
+ for-loop_45)
+ table_37
+ (hash-iterate-first ht_43))))
+ table_37)))
+ (if (not #f) (for-loop_44 table_38 rest_18) table_38)))
+ table_37)))))
+ for-loop_44)
+ table_35
+ lst_43)))))))))))))))
+ (define-values
+ (binding-table-interned-scope-keys.1)
+ (lambda (exactly?32_0 table34_0 scs35_0 sym36_0 s37_0 extra-shifts38_0 interned-scope?39_0 interned-scope-key40_0)
+ (begin
+ 'binding-table-interned-scope-keys
+ (let-values (((table_42) table34_0))
+ (let-values (((scs_3) scs35_0))
+ (let-values (((sym_14) sym36_0))
+ (let-values (((s_91) s37_0))
+ (let-values (((extra-shifts_3) extra-shifts38_0))
+ (let-values (((interned-scope?_0) interned-scope?39_0))
+ (let-values (((interned-scope-key_0) interned-scope-key40_0))
+ (let-values (((exactly?_1) exactly?32_0))
+ (let-values (((ht_44 bulk-bindings_2)
+ (if (hash? table_42)
+ (values table_42 null)
+ (values
+ (table-with-bulk-bindings-syms table_42)
+ (table-with-bulk-bindings-bulk-bindings table_42)))))
+ (set-union
+ (let-values (((table_43) (let-values (((table_44) '#hasheq())) table_44)))
+ (let-values (((ht_45) (hash-ref ht_44 sym_14 '#hasheq())))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash-keys ht_45))
+ ((letrec-values (((for-loop_46)
+ (lambda (table_45 i_77)
+ (begin
+ 'for-loop
+ (if i_77
+ (let-values (((an-scs_1) (hash-iterate-key ht_45 i_77)))
+ (let-values (((table_46)
+ (let-values (((ht_46) an-scs_1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_46))
+ ((letrec-values (((for-loop_47)
+ (lambda (table_47 i_78)
+ (begin
+ 'for-loop
+ (if i_78
+ (let-values (((sc_0)
+ (unsafe-immutable-hash-iterate-key
+ ht_46
+ i_78)))
+ (let-values (((table_48)
+ (if (if (interned-scope?_0
+ sc_0)
+ (if (not
+ (set-member?
+ scs_3
+ sc_0))
+ (if exactly?_1
+ (set=?
+ an-scs_1
+ (set-add
+ scs_3
+ sc_0))
+ (subset?
+ an-scs_1
+ (set-add
+ scs_3
+ sc_0)))
+ #f)
+ #f)
+ (let-values (((table_49)
+ (let-values (((key_21
+ val_8)
+ (values
+ (interned-scope-key_0
+ sc_0)
+ #t)))
+ (hash-set
+ table_47
+ key_21
+ val_8))))
+ (values
+ table_49))
+ table_47)))
+ (if (not #f)
+ (for-loop_47
+ table_48
+ (unsafe-immutable-hash-iterate-next
+ ht_46
+ i_78))
+ table_48)))
+ table_47)))))
+ for-loop_47)
+ table_45
+ (unsafe-immutable-hash-iterate-first
+ ht_46))))))
+ (if (not #f)
+ (for-loop_46 table_46 (hash-iterate-next ht_45 i_77))
+ table_46)))
+ table_45)))))
+ for-loop_46)
+ table_43
+ (hash-iterate-first ht_45)))))
+ (let-values (((table_50) (let-values (((table_51) '#hasheq())) table_51)))
+ (let-values (((lst_45) bulk-bindings_2))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_45))
+ ((letrec-values (((for-loop_48)
+ (lambda (table_52 lst_46)
+ (begin
+ 'for-loop
+ (if (pair? lst_46)
+ (let-values (((bba_2) (unsafe-car lst_46))
+ ((rest_19) (unsafe-cdr lst_46)))
+ (let-values (((table_53)
+ (if (hash-ref
+ (bulk-binding-symbols
+ (bulk-binding-at-bulk bba_2)
+ s_91
+ extra-shifts_3)
+ sym_14
+ #f)
+ (let-values (((an-scs_2)
+ (bulk-binding-at-scopes bba_2)))
+ (let-values (((ht_47) an-scs_2))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_47))
+ ((letrec-values (((for-loop_49)
+ (lambda (table_54 i_79)
+ (begin
+ 'for-loop
+ (if i_79
+ (let-values (((sc_1)
+ (unsafe-immutable-hash-iterate-key
+ ht_47
+ i_79)))
+ (let-values (((table_55)
+ (if (if (interned-scope?_0
+ sc_1)
+ (if (not
+ (set-member?
+ scs_3
+ sc_1))
+ (if exactly?_1
+ (set=?
+ an-scs_2
+ (set-add
+ scs_3
+ sc_1))
+ (subset?
+ an-scs_2
+ (set-add
+ scs_3
+ sc_1)))
+ #f)
+ #f)
+ (let-values (((table_56)
+ (let-values (((key_22
+ val_9)
+ (values
+ (interned-scope-key_0
+ sc_1)
+ #t)))
+ (hash-set
+ table_54
+ key_22
+ val_9))))
+ (values
+ table_56))
+ table_54)))
+ (if (not #f)
+ (for-loop_49
+ table_55
+ (unsafe-immutable-hash-iterate-next
+ ht_47
+ i_79))
+ table_55)))
+ table_54)))))
+ for-loop_49)
+ table_52
+ (unsafe-immutable-hash-iterate-first
+ ht_47)))))
+ table_52)))
+ (if (not #f) (for-loop_48 table_53 rest_19) table_53)))
+ table_52)))))
+ for-loop_48)
+ table_50
+ lst_45)))))))))))))))))
(define-values
(binding-table-prune-to-reachable)
(lambda (bt_3 state_16)
(begin
- (let-values (((or-part_103) (hash-ref (serialize-state-bindings-intern state_16) bt_3 #f)))
- (if or-part_103
- or-part_103
- (let-values (((reachable-scopes_1) (serialize-state-reachable-scopes state_16)))
+ (let-values (((or-part_152) (hash-ref (serialize-state-bindings-intern state_16) bt_3 #f)))
+ (if or-part_152
+ or-part_152
+ (let-values (((reachable-scopes_1) (serialize-state-all-reachable-scopes state_16)))
(let-values (((new-syms_2)
- (let-values (((ht_42) (if (hash? bt_3) bt_3 (table-with-bulk-bindings-syms/serialize bt_3))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash ht_42)))
- ((letrec-values (((for-loop_44)
- (lambda (table_42 i_58)
- (begin
- 'for-loop
- (if i_58
- (let-values (((sym_10 bindings-for-sym_0)
- (unsafe-immutable-hash-iterate-key+value
- ht_42
- i_58)))
- (let-values (((table_43)
- (let-values (((table_44) table_42))
+ (let-values (((table_57) (let-values (((table_58) '#hasheq())) table_58)))
+ (let-values (((ht_48)
+ (if (hash? bt_3) bt_3 (table-with-bulk-bindings-syms/serialize bt_3))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash ht_48))
+ ((letrec-values (((for-loop_50)
+ (lambda (table_59 i_80)
+ (begin
+ 'for-loop
+ (if i_80
+ (let-values (((sym_15 bindings-for-sym_0)
+ (unsafe-immutable-hash-iterate-key+value
+ ht_48
+ i_80)))
+ (let-values (((table_60)
(let-values (((id*_1)
- (let-values (((ht_43)
- bindings-for-sym_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
+ (let-values (((table_61)
+ (let-values (((table_62)
+ '#hash()))
+ table_62)))
+ (let-values (((ht_49)
+ bindings-for-sym_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
(check-in-immutable-hash
- ht_43)))
- ((letrec-values (((for-loop_45)
- (lambda (table_45
- i_59)
- (begin
- 'for-loop
- (if i_59
- (let-values (((scopes_5
- binding_1)
- (unsafe-immutable-hash-iterate-key+value
- ht_43
- i_59)))
- (let-values (((table_46)
- (let-values (((table_47)
- table_45))
+ ht_49))
+ ((letrec-values (((for-loop_51)
+ (lambda (table_63
+ i_81)
+ (begin
+ 'for-loop
+ (if i_81
+ (let-values (((scopes_5
+ binding_1)
+ (unsafe-immutable-hash-iterate-key+value
+ ht_49
+ i_81)))
+ (let-values (((table_64)
(if (subset?
scopes_5
reachable-scopes_1)
- (let-values (((table_48)
- table_47))
- (let-values (((table_49)
- (let-values ()
- (let-values (((key_20
- val_8)
- (let-values ()
- (values
- (intern-scopes
- scopes_5
- state_16)
- binding_1))))
- (hash-set
- table_48
- key_20
- val_8)))))
- (values
- table_49)))
- table_47))))
- (if (not
- #f)
- (for-loop_45
- table_46
- (unsafe-immutable-hash-iterate-next
- ht_43
- i_59))
- table_46)))
- table_45)))))
- for-loop_45)
- '#hash()
- (unsafe-immutable-hash-iterate-first
- ht_43))))))
- (begin
- #t
- ((letrec-values (((for-loop_46)
- (lambda (table_50)
- (begin
- 'for-loop
- (let-values (((new-bindings-for-sym_0)
- id*_1))
- (let-values (((table_51)
- (let-values (((table_52)
- table_50))
- (let-values (((table_53)
- table_52))
- (if (positive?
- (hash-count
- new-bindings-for-sym_0))
- (let-values (((table_54)
- table_53))
- (let-values (((table_55)
- (let-values ()
- (let-values (((key_21
- val_9)
- (let-values ()
- (values
- sym_10
- new-bindings-for-sym_0))))
- (hash-set
- table_54
- key_21
- val_9)))))
- (values
- table_55)))
- table_53)))))
- table_51))))))
- for-loop_46)
- table_44))))))
- (if (not #f)
- (for-loop_44
- table_43
- (unsafe-immutable-hash-iterate-next ht_42 i_58))
- table_43)))
- table_42)))))
- for-loop_44)
- '#hasheq()
- (unsafe-immutable-hash-iterate-first ht_42))))))
+ (let-values (((table_65)
+ (let-values (((key_23
+ val_10)
+ (values
+ (intern-scopes
+ scopes_5
+ state_16)
+ binding_1)))
+ (hash-set
+ table_63
+ key_23
+ val_10))))
+ (values
+ table_65))
+ table_63)))
+ (if (not
+ #f)
+ (for-loop_51
+ table_64
+ (unsafe-immutable-hash-iterate-next
+ ht_49
+ i_81))
+ table_64)))
+ table_63)))))
+ for-loop_51)
+ table_61
+ (unsafe-immutable-hash-iterate-first
+ ht_49)))))))
+ ((letrec-values (((for-loop_52)
+ (lambda (table_66)
+ (begin
+ 'for-loop
+ (let-values (((new-bindings-for-sym_0)
+ id*_1))
+ (let-values (((table_67)
+ (if (positive?
+ (hash-count
+ new-bindings-for-sym_0))
+ (let-values (((table_68)
+ (let-values (((key_24
+ val_11)
+ (values
+ sym_15
+ new-bindings-for-sym_0)))
+ (hash-set
+ table_66
+ key_24
+ val_11))))
+ (values
+ table_68))
+ table_66)))
+ table_67))))))
+ for-loop_52)
+ table_59))))
+ (if (not #f)
+ (for-loop_50
+ table_60
+ (unsafe-immutable-hash-iterate-next ht_48 i_80))
+ table_60)))
+ table_59)))))
+ for-loop_50)
+ table_57
+ (unsafe-immutable-hash-iterate-first ht_48)))))))
(let-values (((new-bulk-bindings_0)
(if (hash? bt_3)
null
(reverse$1
- (let-values (((lst_42) (table-with-bulk-bindings-bulk-bindings bt_3)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_42)))
- ((letrec-values (((for-loop_47)
- (lambda (fold-var_23 lst_43)
- (begin
- 'for-loop
- (if (pair? lst_43)
- (let-values (((bba_2) (unsafe-car lst_43))
- ((rest_18) (unsafe-cdr lst_43)))
- (let-values (((fold-var_24)
- (let-values (((fold-var_25) fold-var_23))
+ (let-values (((fold-var_35) (let-values (((fold-var_36) null)) fold-var_36)))
+ (let-values (((lst_47) (table-with-bulk-bindings-bulk-bindings bt_3)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_47))
+ ((letrec-values (((for-loop_53)
+ (lambda (fold-var_37 lst_48)
+ (begin
+ 'for-loop
+ (if (pair? lst_48)
+ (let-values (((bba_3) (unsafe-car lst_48))
+ ((rest_20) (unsafe-cdr lst_48)))
+ (let-values (((fold-var_38)
(if (subset?
- (bulk-binding-at-scopes bba_2)
+ (bulk-binding-at-scopes bba_3)
reachable-scopes_1)
- (let-values (((fold-var_26) fold-var_25))
- (let-values (((fold-var_27)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((the-struct_2)
- bba_2))
- (if (bulk-binding-at?
- the-struct_2)
- (let-values (((scopes58_0)
- (intern-scopes
- (bulk-binding-at-scopes
- bba_2)
- state_16)))
- (bulk-binding-at2.1
- scopes58_0
- (bulk-binding-at-bulk
- the-struct_2)))
- (raise-argument-error
- 'struct-copy
- "bulk-binding-at?"
- the-struct_2))))
- fold-var_26))))
- (values fold-var_27)))
- fold-var_25))))
- (if (not #f)
- (for-loop_47 fold-var_24 rest_18)
- fold-var_24)))
- fold-var_23)))))
- for-loop_47)
- null
- lst_42)))))))
+ (let-values (((fold-var_39)
+ (cons
+ (let-values (((the-struct_2)
+ bba_3))
+ (if (bulk-binding-at?
+ the-struct_2)
+ (let-values (((scopes68_0)
+ (intern-scopes
+ (bulk-binding-at-scopes
+ bba_3)
+ state_16)))
+ (bulk-binding-at2.1
+ scopes68_0
+ (bulk-binding-at-bulk
+ the-struct_2)))
+ (raise-argument-error
+ 'struct-copy
+ "bulk-binding-at?"
+ the-struct_2)))
+ fold-var_37)))
+ (values fold-var_39))
+ fold-var_37)))
+ (if (not #f)
+ (for-loop_53 fold-var_38 rest_20)
+ fold-var_38)))
+ fold-var_37)))))
+ for-loop_53)
+ fold-var_35
+ lst_47))))))))
(let-values (((new-bt_0)
(if (pair? new-bulk-bindings_0)
(table-with-bulk-bindings1.1 new-syms_2 new-syms_2 new-bulk-bindings_0)
@@ -7923,373 +7750,356 @@
(begin (hash-set! (serialize-state-bulk-bindings-intern state_16) bt_3 new-bt_0) new-bt_0))))))))))
(define-values
(binding-table-register-reachable)
- (lambda (bt_4 get-reachable-scopes_0 bulk-shifts_2 reach_2 register-trigger_0)
+ (lambda (bt_4 get-reachable-scopes_0 bulk-shifts_5 reach_2 register-trigger_0 reach-implicitly_0 report-shifts_3)
(begin
(begin
- (let-values (((ht_44) (if (hash? bt_4) bt_4 (table-with-bulk-bindings-syms/serialize bt_4))))
+ (let-values (((ht_50) (if (hash? bt_4) bt_4 (table-with-bulk-bindings-syms/serialize bt_4))))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash ht_44)))
- ((letrec-values (((for-loop_48)
- (lambda (i_60)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash ht_50))
+ ((letrec-values (((for-loop_54)
+ (lambda (i_82)
(begin
'for-loop
- (if i_60
- (let-values (((sym_11 bindings-for-sym_1)
- (unsafe-immutable-hash-iterate-key+value ht_44 i_60)))
+ (if i_82
+ (let-values (((sym_16 bindings-for-sym_1)
+ (unsafe-immutable-hash-iterate-key+value ht_50 i_82)))
(let-values ((()
- (let-values ()
- (let-values (((ht_45) bindings-for-sym_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash ht_45)))
- ((letrec-values (((for-loop_49)
- (lambda (i_61)
- (begin
- 'for-loop
- (if i_61
- (let-values (((scopes_6 binding_2)
- (unsafe-immutable-hash-iterate-key+value
- ht_45
- i_61)))
- (let-values ((()
- (let-values ()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((v_64)
- (if (binding-reach-scopes?
- binding_2)
- ((binding-reach-scopes-ref
- binding_2)
- binding_2)
- #f)))
- (scopes-register-reachable
- scopes_6
- v_64
- get-reachable-scopes_0
- bulk-shifts_2
- reach_2
- register-trigger_0)))
- (values)))))
- (values))))))
- (if (not #f)
- (for-loop_49
- (unsafe-immutable-hash-iterate-next
- ht_45
- i_61))
- (values))))
- (values))))))
- for-loop_49)
- (unsafe-immutable-hash-iterate-first ht_45)))))))
+ (let-values (((ht_51) bindings-for-sym_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash ht_51))
+ ((letrec-values (((for-loop_55)
+ (lambda (i_83)
+ (begin
+ 'for-loop
+ (if i_83
+ (let-values (((scopes_6 binding_2)
+ (unsafe-immutable-hash-iterate-key+value
+ ht_51
+ i_83)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values ((()
+ (begin
+ (if (if report-shifts_3
+ (binding-shift-report?
+ binding_2)
+ #f)
+ ((binding-shift-report-ref
+ binding_2)
+ binding_2
+ bulk-shifts_5
+ report-shifts_3)
+ (void))
+ (values))))
+ (let-values (((v_89)
+ (if (binding-reach-scopes?
+ binding_2)
+ ((binding-reach-scopes-ref
+ binding_2)
+ binding_2)
+ #f)))
+ (scopes-register-reachable
+ scopes_6
+ v_89
+ get-reachable-scopes_0
+ bulk-shifts_5
+ reach_2
+ register-trigger_0
+ reach-implicitly_0)))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_55
+ (unsafe-immutable-hash-iterate-next
+ ht_51
+ i_83))
+ (values))))
+ (values))))))
+ for-loop_55)
+ (unsafe-immutable-hash-iterate-first ht_51))))))
(if (not #f)
- (for-loop_48 (unsafe-immutable-hash-iterate-next ht_44 i_60))
+ (for-loop_54 (unsafe-immutable-hash-iterate-next ht_50 i_82))
(values))))
(values))))))
- for-loop_48)
- (unsafe-immutable-hash-iterate-first ht_44))))
+ for-loop_54)
+ (unsafe-immutable-hash-iterate-first ht_50))))
(void)
(if (table-with-bulk-bindings? bt_4)
- (let-values ()
- (begin
- (let-values (((lst_44) (table-with-bulk-bindings-bulk-bindings bt_4)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_44)))
- ((letrec-values (((for-loop_50)
- (lambda (lst_45)
- (begin
- 'for-loop
- (if (pair? lst_45)
- (let-values (((bba_3) (unsafe-car lst_45)) ((rest_19) (unsafe-cdr lst_45)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (begin
- (if bulk-shifts_2
- (let-values ()
- (force-bulk-bindings
- (bulk-binding-at-bulk bba_3)
- bulk-shifts_2))
- (void))
- (scopes-register-reachable
- (bulk-binding-at-scopes bba_3)
- #f
- get-reachable-scopes_0
- bulk-shifts_2
- reach_2
- register-trigger_0)))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_50 rest_19) (values))))
- (values))))))
- for-loop_50)
- lst_44)))
- (void)))
+ (begin
+ (let-values (((lst_49) (table-with-bulk-bindings-bulk-bindings bt_4)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_49))
+ ((letrec-values (((for-loop_56)
+ (lambda (lst_50)
+ (begin
+ 'for-loop
+ (if (pair? lst_50)
+ (let-values (((bba_4) (unsafe-car lst_50)) ((rest_21) (unsafe-cdr lst_50)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (begin
+ (if bulk-shifts_5
+ (force-bulk-bindings
+ (bulk-binding-at-bulk bba_4)
+ bulk-shifts_5)
+ (void))
+ (if report-shifts_3
+ (bulk-binding-report-shifts
+ (bulk-binding-at-bulk bba_4)
+ bulk-shifts_5
+ report-shifts_3)
+ (void))
+ (scopes-register-reachable
+ (bulk-binding-at-scopes bba_4)
+ #f
+ get-reachable-scopes_0
+ bulk-shifts_5
+ reach_2
+ register-trigger_0
+ reach-implicitly_0))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_56 rest_21) (values))))
+ (values))))))
+ for-loop_56)
+ lst_49)))
+ (void))
(void))))))
(define-values
(scopes-register-reachable)
- (lambda (scopes_7 v_65 get-reachable-scopes_1 bulk-shifts_3 reach_3 register-trigger_1)
+ (lambda (scopes_7 v_90 get-reachable-scopes_1 bulk-shifts_6 reach_3 register-trigger_1 reach-implicitly_1)
(begin
(let-values (((reachable-scopes_2) (get-reachable-scopes_1)))
(if (subset? scopes_7 reachable-scopes_2)
- (let-values () (reach_3 v_65 bulk-shifts_3))
- (let-values ()
- (let-values (((pending-scopes_0)
- (let-values (((ht_46) scopes_7))
+ (reach_3 v_90 bulk-shifts_6)
+ (let-values (((pending-scopes_0)
+ (let-values (((table_69) (let-values (((table_70) '#hasheq())) table_70)))
+ (let-values (((ht_52) scopes_7))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-in-immutable-hash-keys ht_46)))
- ((letrec-values (((for-loop_51)
- (lambda (table_56 i_62)
+ (check-in-immutable-hash-keys ht_52))
+ ((letrec-values (((for-loop_57)
+ (lambda (table_71 i_84)
(begin
'for-loop
- (if i_62
- (let-values (((sc_0)
- (unsafe-immutable-hash-iterate-key ht_46 i_62)))
- (let-values (((table_57)
- (let-values (((table_58) table_56))
- (if (let-values (((or-part_104)
- (set-member?
- reachable-scopes_2
- sc_0)))
- (if or-part_104
- or-part_104
- (implicitly-reachable? sc_0)))
- table_58
- (let-values (((table_59) table_58))
- (let-values (((table_60)
- (let-values ()
- (let-values (((key_22
- val_10)
- (let-values ()
- (values
- (let-values ()
- sc_0)
- #t))))
- (hash-set
- table_59
- key_22
- val_10)))))
- (values table_60)))))))
+ (if i_84
+ (let-values (((sc_2)
+ (unsafe-immutable-hash-iterate-key ht_52 i_84)))
+ (let-values (((table_72)
+ (if (let-values (((or-part_153)
+ (set-member?
+ reachable-scopes_2
+ sc_2)))
+ (if or-part_153
+ or-part_153
+ (implicitly-reachable? sc_2)))
+ table_71
+ (let-values (((table_73)
+ (let-values (((key_25 val_12)
+ (values sc_2 #t)))
+ (hash-set
+ table_71
+ key_25
+ val_12))))
+ (values table_73)))))
(if (not #f)
- (for-loop_51
- table_57
- (unsafe-immutable-hash-iterate-next ht_46 i_62))
- table_57)))
- table_56)))))
- for-loop_51)
- '#hasheq()
- (unsafe-immutable-hash-iterate-first ht_46))))))
- (let-values (((check-trigger_0)
- (lambda (reach_4)
- (begin
- 'check-trigger
- (if (zero? (hash-count pending-scopes_0))
- (let-values ()
+ (for-loop_57
+ table_72
+ (unsafe-immutable-hash-iterate-next ht_52 i_84))
+ table_72)))
+ table_71)))))
+ for-loop_57)
+ table_69
+ (unsafe-immutable-hash-iterate-first ht_52)))))))
+ (let-values (((check-trigger_0)
+ (lambda (reach_4)
+ (begin
+ 'check-trigger
+ (if (zero? (hash-count pending-scopes_0))
+ (begin
+ (reach_4 v_90 bulk-shifts_6)
+ (let-values (((ht_53) scopes_7))
(begin
- (reach_4 v_65 bulk-shifts_3)
- (let-values (((ht_47) scopes_7))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_47)))
- ((letrec-values (((for-loop_52)
- (lambda (i_63)
- (begin
- 'for-loop
- (if i_63
- (let-values (((sc_1)
- (unsafe-immutable-hash-iterate-key
- ht_47
- i_63)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (if (implicitly-reachable?
- sc_1)
- (let-values ()
- (reach_4
- sc_1
- bulk-shifts_3))
- (void)))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_52
- (unsafe-immutable-hash-iterate-next
- ht_47
- i_63))
- (values))))
- (values))))))
- for-loop_52)
- (unsafe-immutable-hash-iterate-first ht_47))))
- (void)))
- (void))))))
- (begin
- (let-values (((ht_48) pending-scopes_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_48)))
- ((letrec-values (((for-loop_53)
- (lambda (i_64)
- (begin
- 'for-loop
- (if i_64
- (let-values (((sc_2) (unsafe-immutable-hash-iterate-key ht_48 i_64)))
- (let-values ((()
- (let-values ()
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_53))
+ ((letrec-values (((for-loop_58)
+ (lambda (i_85)
+ (begin
+ 'for-loop
+ (if i_85
+ (let-values (((sc_3)
+ (unsafe-immutable-hash-iterate-key
+ ht_53
+ i_85)))
(let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (register-trigger_1
- sc_2
- (lambda (reach_5)
- (begin
- (set! pending-scopes_0
- (hash-remove
- pending-scopes_0
- sc_2))
- (check-trigger_0 reach_5)))))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_53 (unsafe-immutable-hash-iterate-next ht_48 i_64))
- (values))))
- (values))))))
- for-loop_53)
- (unsafe-immutable-hash-iterate-first ht_48))))
- (void)
- (check-trigger_0 reach_3))))))))))
- (define-values
- (taint-content)
- (lambda (d_3)
- (begin
- (let-values (((s_3) d_3)
- ((f_26) (lambda (tail?_16 x_24) (begin 'f x_24)))
- ((s->_1)
- (lambda (sub-s_0)
- (begin
- 's->
- (if (syntax-taintness sub-s_0)
- (let-values () sub-s_0)
- (let-values ()
- (let-values (((stx_2) sub-s_0))
- (let-values (((t_5) (tainted-for-content (syntax-content sub-s_0))))
- (let-values (((content*_5) (syntax-content* stx_2)))
- (let-values (((content_8)
- (if (modified-content? content*_5)
- (modified-content-content content*_5)
- content*_5)))
- (let-values (((p_13)
- (if (modified-content? content*_5)
- (modified-content-scope-propagations+taint content*_5)
- #f)))
- (let-values (((the-struct_3) stx_2))
- (if (syntax?$1 the-struct_3)
- (let-values (((content*1_0)
- (let-values (((new-p_0)
- (if (taint? p_13)
- t_5
- ((propagation-set-taint-ref p_13) p_13 t_5))))
- (if new-p_0
- (modified-content1.1 content_8 new-p_0)
- content_8))))
- (syntax2.1
- content*1_0
- (syntax-scopes the-struct_3)
- (syntax-shifted-multi-scopes the-struct_3)
- (syntax-mpi-shifts the-struct_3)
- (syntax-srcloc$1 the-struct_3)
- (syntax-props the-struct_3)
- (syntax-inspector the-struct_3)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_3)))))))))))))
- ((seen_7) #f)
- ((known-pairs_5) #f))
- (let-values (((s_49) s_3)
- ((f_21) f_26)
- ((gf_0)
- (lambda (tail?_17 v_66)
- (begin
- 'gf
- (if (syntax?$1 v_66) (let-values () (s->_1 v_66)) (let-values () (f_26 tail?_17 v_66))))))
- ((seen_2) seen_7)
- ((known-pairs_1) known-pairs_5))
- ((letrec-values (((loop_63)
- (lambda (tail?_18 s_83 prev-depth_3)
+ (let-values ((()
+ (begin
+ (if (implicitly-reachable?
+ sc_3)
+ (if (not bulk-shifts_6)
+ (reach_4
+ sc_3
+ bulk-shifts_6)
+ (reach-implicitly_1
+ sc_3))
+ (void))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_58
+ (unsafe-immutable-hash-iterate-next ht_53 i_85))
+ (values))))
+ (values))))))
+ for-loop_58)
+ (unsafe-immutable-hash-iterate-first ht_53))))
+ (void))
+ (void))))))
+ (begin
+ (let-values (((ht_54) pending-scopes_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_54))
+ ((letrec-values (((for-loop_59)
+ (lambda (i_86)
+ (begin
+ 'for-loop
+ (if i_86
+ (let-values (((sc_4) (unsafe-immutable-hash-iterate-key ht_54 i_86)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (register-trigger_1
+ sc_4
+ (lambda (reach_5)
+ (begin
+ (set! pending-scopes_0
+ (hash-remove pending-scopes_0 sc_4))
+ (check-trigger_0 reach_5))))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_59 (unsafe-immutable-hash-iterate-next ht_54 i_86))
+ (values))))
+ (values))))))
+ for-loop_59)
+ (unsafe-immutable-hash-iterate-first ht_54))))
+ (void)
+ (check-trigger_0 reach_3)))))))))
+ (define-values
+ (taint-content)
+ (lambda (d_3)
+ (begin
+ (let-values (((s_92) d_3)
+ ((f_25) (lambda (tail?_16 x_26) (begin 'f x_26)))
+ ((s->_1)
+ (lambda (sub-s_0)
+ (begin
+ 's->
+ (if (syntax-taintness sub-s_0)
+ sub-s_0
+ (let-values (((stx_2) sub-s_0))
+ (let-values (((t_4) (tainted-for-content (syntax-content sub-s_0))))
+ (let-values (((content*_5) (syntax-content* stx_2)))
+ (let-values (((content_8)
+ (if (modified-content? content*_5)
+ (modified-content-content content*_5)
+ content*_5)))
+ (let-values (((p_14)
+ (if (modified-content? content*_5)
+ (modified-content-scope-propagations+taint content*_5)
+ #f)))
+ (let-values (((the-struct_3) stx_2))
+ (if (syntax?$1 the-struct_3)
+ (let-values (((content*1_0)
+ (let-values (((new-p_0)
+ (if (taint? p_14)
+ t_4
+ ((propagation-set-taint-ref p_14) p_14 t_4))))
+ (if new-p_0
+ (modified-content1.1 content_8 new-p_0)
+ content_8))))
+ (syntax2.1
+ content*1_0
+ (syntax-scopes the-struct_3)
+ (syntax-shifted-multi-scopes the-struct_3)
+ (syntax-mpi-shifts the-struct_3)
+ (syntax-srcloc$1 the-struct_3)
+ (syntax-props the-struct_3)
+ (syntax-inspector the-struct_3)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_3))))))))))))
+ ((seen_7) #f)
+ ((known-pairs_5) #f))
+ (let-values (((s_93) s_92)
+ ((f_26) f_25)
+ ((gf_3)
+ (lambda (tail?_17 v_91) (begin 'gf (if (syntax?$1 v_91) (s->_1 v_91) (f_25 tail?_17 v_91)))))
+ ((seen_8) seen_7)
+ ((known-pairs_6) known-pairs_5))
+ ((letrec-values (((loop_65)
+ (lambda (tail?_18 s_94 prev-depth_3)
(begin
'loop
(let-values (((depth_3) (fx+ 1 prev-depth_3)))
- (if (if seen_2 (fx> depth_3 32) #f)
- (let-values ()
- (datum-map-slow
- tail?_18
- s_83
- (lambda (tail?_19 s_84) (gf_0 tail?_19 s_84))
- seen_2
- known-pairs_1))
- (if (null? s_83)
- (let-values () (f_21 tail?_18 s_83))
- (if (pair? s_83)
- (let-values ()
- (f_21
- tail?_18
- (cons (loop_63 #f (car s_83) depth_3) (loop_63 1 (cdr s_83) depth_3))))
- (if (symbol? s_83)
- (let-values () (f_21 #f s_83))
- (if (boolean? s_83)
- (let-values () (f_21 #f s_83))
- (if (number? s_83)
- (let-values () (f_21 #f s_83))
- (if (let-values (((or-part_91) (vector? s_83)))
- (if or-part_91
- or-part_91
- (let-values (((or-part_99) (box? s_83)))
- (if or-part_99
- or-part_99
- (let-values (((or-part_105) (prefab-struct-key s_83)))
- (if or-part_105 or-part_105 (hash? s_83)))))))
- (let-values ()
- (datum-map-slow
- tail?_18
- s_83
- (lambda (tail?_20 s_85) (gf_0 tail?_20 s_85))
- seen_2
- known-pairs_1))
- (let-values () (gf_0 #f s_83))))))))))))))
- loop_63)
+ (if (if seen_8 (fx> depth_3 32) #f)
+ (datum-map-slow
+ tail?_18
+ s_94
+ (lambda (tail?_19 s_95) (gf_3 tail?_19 s_95))
+ seen_8
+ known-pairs_6)
+ (if (null? s_94)
+ (f_26 tail?_18 s_94)
+ (if (pair? s_94)
+ (f_26
+ tail?_18
+ (cons (loop_65 #f (car s_94) depth_3) (loop_65 1 (cdr s_94) depth_3)))
+ (if (symbol? s_94)
+ (f_26 #f s_94)
+ (if (boolean? s_94)
+ (f_26 #f s_94)
+ (if (number? s_94)
+ (f_26 #f s_94)
+ (if (let-values (((or-part_154) (vector? s_94)))
+ (if or-part_154
+ or-part_154
+ (let-values (((or-part_155) (box? s_94)))
+ (if or-part_155
+ or-part_155
+ (let-values (((or-part_156) (prefab-struct-key s_94)))
+ (if or-part_156 or-part_156 (hash? s_94)))))))
+ (datum-map-slow
+ tail?_18
+ s_94
+ (lambda (tail?_20 s_96) (gf_3 tail?_20 s_96))
+ seen_8
+ known-pairs_6)
+ (gf_3 #f s_94)))))))))))))
+ loop_65)
#f
- s_49
+ s_93
0))))))
- (define-values (syntax-tainted?$1) (lambda (s_86) (begin 'syntax-tainted? (if (syntax-taintness s_86) #t #f))))
- (define-values (syntax-clean?) (lambda (s_87) (begin (not (syntax-taintness s_87)))))
+ (define-values (syntax-tainted?$1) (lambda (s_97) (begin 'syntax-tainted? (if (syntax-taintness s_97) #t #f))))
+ (define-values (syntax-clean?) (lambda (s_98) (begin (not (syntax-taintness s_98)))))
(define-values
(syntax-taint$1)
- (lambda (s_88)
+ (lambda (s_99)
(begin
'syntax-taint
- (if (syntax-taintness s_88)
- s_88
- (let-values (((stx_3) s_88))
- (let-values (((t_6) (tainted-for-content (syntax-content s_88))))
+ (if (syntax-taintness s_99)
+ s_99
+ (let-values (((stx_3) s_99))
+ (let-values (((t_5) (tainted-for-content (syntax-content s_99))))
(let-values (((content*_6) (syntax-content* stx_3)))
(let-values (((content_9)
(if (modified-content? content*_6) (modified-content-content content*_6) content*_6)))
- (let-values (((p_14)
+ (let-values (((p_15)
(if (modified-content? content*_6)
(modified-content-scope-propagations+taint content*_6)
#f)))
@@ -8297,7 +8107,7 @@
(if (syntax?$1 the-struct_4)
(let-values (((content*2_0)
(let-values (((new-p_1)
- (if (taint? p_14) t_6 ((propagation-set-taint-ref p_14) p_14 t_6))))
+ (if (taint? p_15) t_5 ((propagation-set-taint-ref p_15) p_15 t_5))))
(if new-p_1 (modified-content1.1 content_9 new-p_1) content_9))))
(syntax2.1
content*2_0
@@ -8310,161 +8120,135 @@
(raise-argument-error 'struct-copy "syntax?" the-struct_4))))))))))))
(define-values
(syntax-property$1)
- (let-values ()
- (let-values ()
- (case-lambda
- ((s_89 key_23)
- (begin
- 'syntax-property
- (let-values ((()
- (begin
- (if (syntax?$1 s_89)
- (void)
- (let-values () (raise-argument-error 'syntax-property "syntax?" s_89)))
- (values))))
- (let-values (((v_0) (hash-ref (syntax-props s_89) key_23 #f)))
- (let-values (((plain-v_0) (plain-property-value v_0)))
- (if (syntax-taintness s_89) (taint-content plain-v_0) plain-v_0))))))
- ((s_12 key_24 val_11)
- (let-values ((()
- (begin
- (if (syntax?$1 s_12)
- (void)
- (let-values () (raise-argument-error 'syntax-property "syntax?" s_12)))
- (values))))
- (let-values (((pval_0) (if (eq? key_24 'paren-shape) (preserved-property-value1.1 val_11) val_11)))
- (let-values (((the-struct_5) s_12))
- (if (syntax?$1 the-struct_5)
- (let-values (((props2_0) (hash-set (syntax-props s_12) key_24 pval_0)))
- (syntax2.1
- (syntax-content* the-struct_5)
- (syntax-scopes the-struct_5)
- (syntax-shifted-multi-scopes the-struct_5)
- (syntax-mpi-shifts the-struct_5)
- (syntax-srcloc$1 the-struct_5)
- props2_0
- (syntax-inspector the-struct_5)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_5))))))
- ((s_90 key_25 val_12 preserved?_0)
- (let-values ((()
- (begin
- (if (syntax?$1 s_90)
+ (case-lambda
+ ((s_100 key_26)
+ (begin
+ 'syntax-property
+ (let-values ((()
+ (begin
+ (if (syntax?$1 s_100) (void) (raise-argument-error 'syntax-property "syntax?" s_100))
+ (values))))
+ (let-values (((v_92) (hash-ref (syntax-props s_100) key_26 #f)))
+ (let-values (((plain-v_0) (plain-property-value v_92)))
+ (if (syntax-taintness s_100) (taint-content plain-v_0) plain-v_0))))))
+ ((s_101 key_27 val_13)
+ (let-values ((()
+ (begin
+ (if (syntax?$1 s_101) (void) (raise-argument-error 'syntax-property "syntax?" s_101))
+ (values))))
+ (let-values (((pval_0) (if (eq? key_27 'paren-shape) (preserved-property-value1.1 val_13) val_13)))
+ (let-values (((the-struct_5) s_101))
+ (if (syntax?$1 the-struct_5)
+ (let-values (((props2_0) (hash-set (syntax-props s_101) key_27 pval_0)))
+ (syntax2.1
+ (syntax-content* the-struct_5)
+ (syntax-scopes the-struct_5)
+ (syntax-shifted-multi-scopes the-struct_5)
+ (syntax-mpi-shifts the-struct_5)
+ (syntax-srcloc$1 the-struct_5)
+ props2_0
+ (syntax-inspector the-struct_5)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_5))))))
+ ((s_102 key_28 val_14 preserved?_0)
+ (let-values ((()
+ (begin
+ (if (syntax?$1 s_102) (void) (raise-argument-error 'syntax-property "syntax?" s_102))
+ (values))))
+ (let-values ((()
+ (begin
+ (if preserved?_0
+ (if (if (symbol? key_28) (symbol-interned? key_28) #f)
(void)
- (let-values () (raise-argument-error 'syntax-property "syntax?" s_90)))
- (values))))
- (let-values ((()
- (begin
- (if preserved?_0
- (let-values ()
- (if (if (symbol? key_25) (symbol-interned? key_25) #f)
- (void)
- (let-values ()
- (raise-arguments-error
- 'syntax-property
- "key for a preserved property must be an interned symbol"
- "given key"
- key_25
- "given value"
- val_12))))
- (void))
- (values))))
- (let-values (((pval_1) (if preserved?_0 (preserved-property-value1.1 val_12) val_12)))
- (let-values (((the-struct_6) s_90))
- (if (syntax?$1 the-struct_6)
- (let-values (((props3_0) (hash-set (syntax-props s_90) key_25 pval_1)))
- (syntax2.1
- (syntax-content* the-struct_6)
- (syntax-scopes the-struct_6)
- (syntax-shifted-multi-scopes the-struct_6)
- (syntax-mpi-shifts the-struct_6)
- (syntax-srcloc$1 the-struct_6)
- props3_0
- (syntax-inspector the-struct_6)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_6)))))))))))
+ (raise-arguments-error
+ 'syntax-property
+ "key for a preserved property must be an interned symbol"
+ "given key"
+ key_28
+ "given value"
+ val_14))
+ (void))
+ (values))))
+ (let-values (((pval_1) (if preserved?_0 (preserved-property-value1.1 val_14) val_14)))
+ (let-values (((the-struct_6) s_102))
+ (if (syntax?$1 the-struct_6)
+ (let-values (((props3_0) (hash-set (syntax-props s_102) key_28 pval_1)))
+ (syntax2.1
+ (syntax-content* the-struct_6)
+ (syntax-scopes the-struct_6)
+ (syntax-shifted-multi-scopes the-struct_6)
+ (syntax-mpi-shifts the-struct_6)
+ (syntax-srcloc$1 the-struct_6)
+ props3_0
+ (syntax-inspector the-struct_6)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_6)))))))))
(define-values
(1/syntax-property-preserved?)
- (lambda (s_4 key_26)
+ (lambda (s_103 key_29)
(begin
'syntax-property-preserved?
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_4) (void) (let-values () (raise-argument-error 'syntax-property-preserved? "syntax?" s_4)))
- (if (if (symbol? key_26) (symbol-interned? key_26) #f)
- (void)
- (let-values ()
- (raise-argument-error 'syntax-property-preserved? "(and/c symbol? symbol-interned?)" key_26)))
- (preserved-property-value? (hash-ref (syntax-props s_4) key_26 #f))))))))
+ (begin
+ (if (syntax?$1 s_103) (void) (raise-argument-error 'syntax-property-preserved? "syntax?" s_103))
+ (if (if (symbol? key_29) (symbol-interned? key_29) #f)
+ (void)
+ (raise-argument-error 'syntax-property-preserved? "(and/c symbol? symbol-interned?)" key_29))
+ (preserved-property-value? (hash-ref (syntax-props s_103) key_29 #f))))))
(define-values
(1/syntax-property-symbol-keys)
- (lambda (s_5)
+ (lambda (s_104)
(begin
'syntax-property-symbol-keys
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_5) (void) (let-values () (raise-argument-error 'syntax-property-symbol-keys "syntax" s_5)))
- (reverse$1
- (let-values (((ht_49) (syntax-props s_5)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash ht_49)))
- ((letrec-values (((for-loop_54)
- (lambda (fold-var_28 i_65)
- (begin
- 'for-loop
- (if i_65
- (let-values (((k_21 v_67)
- (unsafe-immutable-hash-iterate-key+value ht_49 i_65)))
- (let-values (((fold-var_29)
- (let-values (((fold-var_30) fold-var_28))
- (if (if (symbol? k_21) (symbol-interned? k_21) #f)
- (let-values (((fold-var_31) fold-var_30))
- (let-values (((fold-var_32)
- (let-values ()
- (cons
- (let-values () k_21)
- fold-var_31))))
- (values fold-var_32)))
- fold-var_30))))
- (if (not #f)
- (for-loop_54 fold-var_29 (unsafe-immutable-hash-iterate-next ht_49 i_65))
- fold-var_29)))
- fold-var_28)))))
- for-loop_54)
- null
- (unsafe-immutable-hash-iterate-first ht_49)))))))))))
+ (begin
+ (if (syntax?$1 s_104) (void) (raise-argument-error 'syntax-property-symbol-keys "syntax" s_104))
+ (reverse$1
+ (let-values (((fold-var_40) (let-values (((fold-var_41) null)) fold-var_41)))
+ (let-values (((ht_55) (syntax-props s_104)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash ht_55))
+ ((letrec-values (((for-loop_60)
+ (lambda (fold-var_42 i_87)
+ (begin
+ 'for-loop
+ (if i_87
+ (let-values (((k_21 v_93) (unsafe-immutable-hash-iterate-key+value ht_55 i_87)))
+ (let-values (((fold-var_43)
+ (if (if (symbol? k_21) (symbol-interned? k_21) #f)
+ (let-values (((fold-var_44) (cons k_21 fold-var_42)))
+ (values fold-var_44))
+ fold-var_42)))
+ (if (not #f)
+ (for-loop_60 fold-var_43 (unsafe-immutable-hash-iterate-next ht_55 i_87))
+ fold-var_43)))
+ fold-var_42)))))
+ for-loop_60)
+ fold-var_40
+ (unsafe-immutable-hash-iterate-first ht_55))))))))))
(define-values
(1/syntax-property-remove)
- (lambda (s_50 key_27)
+ (lambda (s_105 key_30)
(begin
'syntax-property-remove
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_50) (void) (let-values () (raise-argument-error 'syntax-property-remove "syntax?" s_50)))
- (if (hash-has-key? (syntax-props s_50) key_27)
- (let-values (((the-struct_7) s_50))
- (if (syntax?$1 the-struct_7)
- (let-values (((props7_0) (hash-remove (syntax-props s_50) key_27)))
- (syntax2.1
- (syntax-content* the-struct_7)
- (syntax-scopes the-struct_7)
- (syntax-shifted-multi-scopes the-struct_7)
- (syntax-mpi-shifts the-struct_7)
- (syntax-srcloc$1 the-struct_7)
- props7_0
- (syntax-inspector the-struct_7)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_7)))
- s_50)))))))
- (define-values (syntax-has-property?) (lambda (from-s_0 key_28) (begin (hash-ref (syntax-props from-s_0) key_28 #f))))
+ (begin
+ (if (syntax?$1 s_105) (void) (raise-argument-error 'syntax-property-remove "syntax?" s_105))
+ (if (hash-has-key? (syntax-props s_105) key_30)
+ (let-values (((the-struct_7) s_105))
+ (if (syntax?$1 the-struct_7)
+ (let-values (((props7_0) (hash-remove (syntax-props s_105) key_30)))
+ (syntax2.1
+ (syntax-content* the-struct_7)
+ (syntax-scopes the-struct_7)
+ (syntax-shifted-multi-scopes the-struct_7)
+ (syntax-mpi-shifts the-struct_7)
+ (syntax-srcloc$1 the-struct_7)
+ props7_0
+ (syntax-inspector the-struct_7)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_7)))
+ s_105)))))
+ (define-values (syntax-has-property?) (lambda (from-s_0 key_31) (begin (hash-ref (syntax-props from-s_0) key_31 #f))))
(define-values
(struct:fallback fallback1.1 fallback? fallback-search-list)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values () (make-struct-type 'fallback #f 1 0 #f null 'prefab #f '(0) #f 'fallback)))))
- (values struct:_2 make-_2 ?_2 (make-struct-field-accessor -ref_2 0 'search-list))))
+ (let-values (((struct:_19 make-_19 ?_19 -ref_19 -set!_19)
+ (make-struct-type 'fallback #f 1 0 #f null 'prefab #f '(0) #f 'fallback)))
+ (values struct:_19 make-_19 ?_19 (make-struct-field-accessor -ref_19 0 'search-list))))
(define-values
(fallback-first)
(lambda (smss_0) (begin (if (fallback? smss_0) (car (fallback-search-list smss_0)) smss_0))))
@@ -8472,8 +8256,8 @@
(fallback-rest)
(lambda (smss_1)
(begin
- (let-values (((l_31) (cdr (fallback-search-list smss_1))))
- (if (null? (cdr l_31)) (car l_31) (fallback1.1 l_31))))))
+ (let-values (((l_37) (cdr (fallback-search-list smss_1))))
+ (if (null? (cdr l_37)) (car l_37) (fallback1.1 l_37))))))
(define-values
(fallback-push)
(lambda (smss_2 smss/maybe-fallback_0)
@@ -8489,7 +8273,7 @@
(lambda (smss_3 f_27)
(begin
(if (fallback? smss_3)
- (let-values (((l_32) (fallback-search-list smss_3))) (fallback1.1 (cons (f_27 (car l_32)) (cdr l_32))))
+ (let-values (((l_38) (fallback-search-list smss_3))) (fallback1.1 (cons (f_27 (car l_38)) (cdr l_38))))
(f_27 smss_3)))))
(define-values
(fallback-map)
@@ -8498,28 +8282,24 @@
(if (fallback? smss_4)
(fallback1.1
(reverse$1
- (let-values (((lst_46) (fallback-search-list smss_4)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_46)))
- ((letrec-values (((for-loop_55)
- (lambda (fold-var_33 lst_23)
- (begin
- 'for-loop
- (if (pair? lst_23)
- (let-values (((smss_5) (unsafe-car lst_23)) ((rest_20) (unsafe-cdr lst_23)))
- (let-values (((fold-var_34)
- (let-values (((fold-var_35) fold-var_33))
- (let-values (((fold-var_36)
- (let-values ()
- (cons
- (let-values () (f_28 smss_5))
- fold-var_35))))
- (values fold-var_36)))))
- (if (not #f) (for-loop_55 fold-var_34 rest_20) fold-var_34)))
- fold-var_33)))))
- for-loop_55)
- null
- lst_46)))))
+ (let-values (((fold-var_45) (let-values (((fold-var_46) null)) fold-var_46)))
+ (let-values (((lst_51) (fallback-search-list smss_4)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_51))
+ ((letrec-values (((for-loop_61)
+ (lambda (fold-var_47 lst_52)
+ (begin
+ 'for-loop
+ (if (pair? lst_52)
+ (let-values (((smss_5) (unsafe-car lst_52)) ((rest_22) (unsafe-cdr lst_52)))
+ (let-values (((fold-var_48)
+ (let-values (((fold-var_49) (cons (f_28 smss_5) fold-var_47)))
+ (values fold-var_49))))
+ (if (not #f) (for-loop_61 fold-var_48 rest_22) fold-var_48)))
+ fold-var_47)))))
+ for-loop_61)
+ fold-var_45
+ lst_51))))))
(f_28 smss_4)))))
(define-values
(fallback->list)
@@ -8530,156 +8310,144 @@
(define-values
(clear-resolve-cache!)
(case-lambda
- ((sym_12)
+ ((sym_17)
(begin
(let-values (((c_16) (weak-box-value (unbox* (unsafe-place-local-ref cell.1$6)))))
- (begin
- (if c_16 (let-values () (hash-remove! c_16 sym_12)) (void))
- (set-box*! (unsafe-place-local-ref cell.2$3) #f)))))
+ (begin (if c_16 (hash-remove! c_16 sym_17) (void)) (set-box*! (unsafe-place-local-ref cell.2$5) #f)))))
(()
- (let-values (((c_11) (weak-box-value (unbox* (unsafe-place-local-ref cell.1$6)))))
- (begin (if c_11 (let-values () (hash-clear! c_11)) (void)) (set-box*! (unsafe-place-local-ref cell.2$3) #f))))))
+ (let-values (((c_17) (weak-box-value (unbox* (unsafe-place-local-ref cell.1$6)))))
+ (begin (if c_17 (hash-clear! c_17) (void)) (set-box*! (unsafe-place-local-ref cell.2$5) #f))))))
(define-values
(struct:entry entry1.1 entry? entry-scs entry-smss entry-phase entry-binding)
- (let-values (((struct:_15 make-_15 ?_15 -ref_15 -set!_15)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'entry
- #f
- 4
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3)
- #f
- 'entry)))))
+ (let-values (((struct:_20 make-_20 ?_20 -ref_20 -set!_20)
+ (make-struct-type
+ 'entry
+ #f
+ 4
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3)
+ #f
+ 'entry)))
(values
- struct:_15
- make-_15
- ?_15
- (make-struct-field-accessor -ref_15 0 'scs)
- (make-struct-field-accessor -ref_15 1 'smss)
- (make-struct-field-accessor -ref_15 2 'phase)
- (make-struct-field-accessor -ref_15 3 'binding))))
+ struct:_20
+ make-_20
+ ?_20
+ (make-struct-field-accessor -ref_20 0 'scs)
+ (make-struct-field-accessor -ref_20 1 'smss)
+ (make-struct-field-accessor -ref_20 2 'phase)
+ (make-struct-field-accessor -ref_20 3 'binding))))
(define-values
(resolve-cache-get)
- (lambda (sym_13 phase_5 scs_3 smss_7)
- (begin
- (let-values (((c_13) (weak-box-value (unbox* (unsafe-place-local-ref cell.1$6)))))
- (if c_13
- (let-values (((v_68) (hash-ref c_13 sym_13 #f)))
- (if v_68
- (if (eqv? phase_5 (entry-phase v_68))
- (if (set=? scs_3 (entry-scs v_68)) (if (set=? smss_7 (entry-smss v_68)) (entry-binding v_68) #f) #f)
+ (lambda (sym_18 phase_9 scs_4 smss_7)
+ (begin
+ (let-values (((c_18) (weak-box-value (unbox* (unsafe-place-local-ref cell.1$6)))))
+ (if c_18
+ (let-values (((v_94) (hash-ref c_18 sym_18 #f)))
+ (if v_94
+ (if (eqv? phase_9 (entry-phase v_94))
+ (if (set=? scs_4 (entry-scs v_94)) (if (set=? smss_7 (entry-smss v_94)) (entry-binding v_94) #f) #f)
#f)
#f))
#f)))))
(define-values
(resolve-cache-set!)
- (lambda (sym_14 phase_6 scs_4 smss_8 b_40)
+ (lambda (sym_19 phase_10 scs_5 smss_8 b_50)
(begin
(let-values (((wb_1) (unbox* (unsafe-place-local-ref cell.1$6))))
- (let-values (((c_17) (weak-box-value wb_1)))
- (if (not c_17)
- (let-values ()
- (begin
- (box-cas! (unsafe-place-local-ref cell.1$6) wb_1 (make-weak-box (make-hasheq)))
- (resolve-cache-set! sym_14 phase_6 scs_4 smss_8 b_40)))
- (let-values () (hash-set! c_17 sym_14 (entry1.1 scs_4 smss_8 phase_6 b_40)))))))))
+ (let-values (((c_19) (weak-box-value wb_1)))
+ (if (not c_19)
+ (begin
+ (box-cas! (unsafe-place-local-ref cell.1$6) wb_1 (make-weak-box (make-hasheq)))
+ (resolve-cache-set! sym_19 phase_10 scs_5 smss_8 b_50))
+ (hash-set! c_19 sym_19 (entry1.1 scs_5 smss_8 phase_10 b_50))))))))
(define-values (SHIFTED-CACHE-SIZE) 16)
- (define-values (cell.2$3) (unsafe-make-place-local (box #f)))
- (define-values (cell.3$1) (unsafe-make-place-local 0))
+ (define-values (cell.2$5) (unsafe-make-place-local (box #f)))
+ (define-values (cell.3$2) (unsafe-make-place-local 0))
(define-values
(struct:shifted-entry shifted-entry2.1 shifted-entry? shifted-entry-s shifted-entry-phase shifted-entry-binding)
- (let-values (((struct:_16 make-_16 ?_16 -ref_16 -set!_16)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'shifted-entry
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'shifted-entry)))))
+ (let-values (((struct:_21 make-_21 ?_21 -ref_21 -set!_21)
+ (make-struct-type
+ 'shifted-entry
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'shifted-entry)))
(values
- struct:_16
- make-_16
- ?_16
- (make-struct-field-accessor -ref_16 0 's)
- (make-struct-field-accessor -ref_16 1 'phase)
- (make-struct-field-accessor -ref_16 2 'binding))))
+ struct:_21
+ make-_21
+ ?_21
+ (make-struct-field-accessor -ref_21 0 's)
+ (make-struct-field-accessor -ref_21 1 'phase)
+ (make-struct-field-accessor -ref_21 2 'binding))))
(define-values
(shifted-cache-vector)
(lambda ()
(begin
- (let-values (((wb_2) (unbox* (unsafe-place-local-ref cell.2$3))))
- (let-values (((c1_20) (if wb_2 (weak-box-value wb_2) #f)))
- (if c1_20
- ((lambda (vec_17) vec_17) c1_20)
- (let-values ()
- (let-values (((vec_18) (make-vector SHIFTED-CACHE-SIZE #f)))
- (begin (set-box*! (unsafe-place-local-ref cell.2$3) (make-weak-box vec_18)) vec_18)))))))))
+ (let-values (((wb_2) (unbox* (unsafe-place-local-ref cell.2$5))))
+ (let-values (((cond-val_3) (if wb_2 (weak-box-value wb_2) #f)))
+ (if cond-val_3
+ ((lambda (vec_17) vec_17) cond-val_3)
+ (let-values (((vec_18) (make-vector SHIFTED-CACHE-SIZE #f)))
+ (begin (set-box*! (unsafe-place-local-ref cell.2$5) (make-weak-box vec_18)) vec_18))))))))
(define-values
(resolve+shift-cache-get)
- (lambda (s_91 phase_7)
+ (lambda (s_106 phase_11)
(begin
(let-values (((vec_19) (shifted-cache-vector)))
- (let-values (((vec_20 len_9)
- (let-values (((vec_21) vec_19))
- (begin (check-vector vec_21) (values vec_21 (unsafe-vector-length vec_21))))))
- (begin
- #f
- ((letrec-values (((for-loop_56)
- (lambda (result_35 pos_9)
+ (let-values (((result_57) (let-values (((result_58) #f)) result_58)))
+ (let-values (((vec_20 len_9)
+ (let-values (((vec_21) vec_19))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-vector vec_21))
+ (values vec_21 (unsafe-vector-length vec_21))))))
+ ((letrec-values (((for-loop_62)
+ (lambda (result_59 pos_18)
(begin
'for-loop
- (if (unsafe-fx< pos_9 len_9)
- (let-values (((e_12) (unsafe-vector-ref vec_20 pos_9)))
- (let-values (((result_36)
- (let-values ()
- (let-values (((result_10)
- (let-values ()
- (let-values ()
- (if e_12
- (if (eq? s_91 (shifted-entry-s e_12))
- (if (eqv?
- phase_7
- (shifted-entry-phase e_12))
- (shifted-entry-binding e_12)
- #f)
- #f)
- #f)))))
- (values result_10)))))
- (if (if (not ((lambda x_25 result_36) e_12)) (not #f) #f)
- (for-loop_56 result_36 (unsafe-fx+ 1 pos_9))
- result_36)))
- result_35)))))
- for-loop_56)
- #f
+ (if (unsafe-fx< pos_18 len_9)
+ (let-values (((e_12) (unsafe-vector-ref vec_20 pos_18)))
+ (let-values (((result_60)
+ (let-values (((result_61)
+ (if e_12
+ (if (eq? s_106 (shifted-entry-s e_12))
+ (if (eqv? phase_11 (shifted-entry-phase e_12))
+ (shifted-entry-binding e_12)
+ #f)
+ #f)
+ #f)))
+ (values result_61))))
+ (if (if (not ((lambda x_27 result_60) e_12)) (not #f) #f)
+ (for-loop_62 result_60 (unsafe-fx+ 1 pos_18))
+ result_60)))
+ result_59)))))
+ for-loop_62)
+ result_57
0)))))))
(define-values
(resolve+shift-cache-set!)
- (lambda (s_92 phase_8 b_41)
+ (lambda (s_107 phase_12 b_51)
(begin
(let-values (((vec_22) (shifted-cache-vector)))
- (let-values (((p_15) (unsafe-place-local-ref cell.3$1)))
+ (let-values (((p_16) (unsafe-place-local-ref cell.3$2)))
(begin
- (vector*-set! vec_22 p_15 (shifted-entry2.1 s_92 phase_8 b_41))
- (unsafe-place-local-set! cell.3$1 (fxand (fx+ 1 p_15) (fx- SHIFTED-CACHE-SIZE 1)))))))))
+ (vector*-set! vec_22 p_16 (shifted-entry2.1 s_107 phase_12 b_51))
+ (unsafe-place-local-set! cell.3$2 (fxand (fx+ 1 p_16) (fx- SHIFTED-CACHE-SIZE 1)))))))))
(define-values (NUM-CACHE-SLOTS) 8)
(define-values (make-cached-sets) (lambda () (begin (make-weak-box (make-vector NUM-CACHE-SLOTS #f)))))
(define-values (cell.4$1) (unsafe-make-place-local (make-cached-sets)))
(define-values (cell.5$1) (unsafe-make-place-local 0))
(define-values (make-cached-hashes) (lambda () (begin (make-weak-box (make-vector NUM-CACHE-SLOTS #f)))))
- (define-values (cell.6$1) (unsafe-make-place-local (make-cached-hashes)))
+ (define-values (cell.6) (unsafe-make-place-local (make-cached-hashes)))
(define-values (cell.7) (unsafe-make-place-local 0))
(define-values
(sets-place-init!)
@@ -8687,208 +8455,210 @@
(begin
(begin
(unsafe-place-local-set! cell.4$1 (make-cached-sets))
- (unsafe-place-local-set! cell.6$1 (make-cached-hashes))))))
+ (unsafe-place-local-set! cell.6 (make-cached-hashes))))))
(define-values
(cache-or-reuse-set)
- (lambda (s_41)
+ (lambda (s_108)
(begin
(let-values (((vec_23)
- (let-values (((or-part_106) (weak-box-value (unsafe-place-local-ref cell.4$1))))
- (if or-part_106
- or-part_106
+ (let-values (((or-part_157) (weak-box-value (unsafe-place-local-ref cell.4$1))))
+ (if or-part_157
+ or-part_157
(let-values (((vec_24) (make-vector NUM-CACHE-SLOTS #f)))
(begin (unsafe-place-local-set! cell.4$1 (make-weak-box vec_24)) vec_24))))))
- (let-values (((or-part_107)
- (let-values (((vec_25 len_10)
- (let-values (((vec_26) vec_23))
- (begin (check-vector vec_26) (values vec_26 (unsafe-vector-length vec_26))))))
- (begin
- #f
- ((letrec-values (((for-loop_57)
- (lambda (result_37 pos_10)
+ (let-values (((or-part_158)
+ (let-values (((result_62) (let-values (((result_63) #f)) result_63)))
+ (let-values (((vec_25 len_10)
+ (let-values (((vec_26) vec_23))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-vector vec_26))
+ (values vec_26 (unsafe-vector-length vec_26))))))
+ ((letrec-values (((for-loop_63)
+ (lambda (result_64 pos_19)
(begin
'for-loop
- (if (unsafe-fx< pos_10 len_10)
- (let-values (((s2_5) (unsafe-vector-ref vec_25 pos_10)))
- (let-values (((result_15)
- (let-values ()
- (let-values (((result_38)
- (let-values ()
- (let-values ()
- (if s2_5
- (if (set=? s_41 s2_5) s2_5 #f)
- #f)))))
- (values result_38)))))
- (if (if (not ((lambda x_1 result_15) s2_5)) (not #f) #f)
- (for-loop_57 result_15 (unsafe-fx+ 1 pos_10))
- result_15)))
- result_37)))))
- for-loop_57)
- #f
+ (if (unsafe-fx< pos_19 len_10)
+ (let-values (((s2_5) (unsafe-vector-ref vec_25 pos_19)))
+ (let-values (((result_65)
+ (let-values (((result_66)
+ (if s2_5
+ (if (set=? s_108 s2_5) s2_5 #f)
+ #f)))
+ (values result_66))))
+ (if (if (not ((lambda x_28 result_65) s2_5)) (not #f) #f)
+ (for-loop_63 result_65 (unsafe-fx+ 1 pos_19))
+ result_65)))
+ result_64)))))
+ for-loop_63)
+ result_62
0)))))
- (if or-part_107
- or-part_107
+ (if or-part_158
+ or-part_158
(begin
- (vector*-set! vec_23 (unsafe-place-local-ref cell.5$1) s_41)
+ (vector*-set! vec_23 (unsafe-place-local-ref cell.5$1) s_108)
(unsafe-place-local-set!
cell.5$1
(fxand (fx+ 1 (unsafe-place-local-ref cell.5$1)) (fx- NUM-CACHE-SLOTS 1)))
- s_41)))))))
+ s_108)))))))
(define-values
(cache-or-reuse-hash)
- (lambda (s_93)
+ (lambda (s_109)
(begin
(let-values (((vec_27)
- (let-values (((or-part_108) (weak-box-value (unsafe-place-local-ref cell.6$1))))
- (if or-part_108
- or-part_108
+ (let-values (((or-part_159) (weak-box-value (unsafe-place-local-ref cell.6))))
+ (if or-part_159
+ or-part_159
(let-values (((vec_28) (make-vector NUM-CACHE-SLOTS #f)))
- (begin (unsafe-place-local-set! cell.6$1 (make-weak-box vec_28)) vec_28))))))
- (let-values (((or-part_109)
- (let-values (((vec_29 len_11)
- (let-values (((vec_30) vec_27))
- (begin (check-vector vec_30) (values vec_30 (unsafe-vector-length vec_30))))))
- (begin
- #f
- ((letrec-values (((for-loop_58)
- (lambda (result_19 pos_11)
+ (begin (unsafe-place-local-set! cell.6 (make-weak-box vec_28)) vec_28))))))
+ (let-values (((or-part_160)
+ (let-values (((result_67) (let-values (((result_68) #f)) result_68)))
+ (let-values (((vec_29 len_11)
+ (let-values (((vec_30) vec_27))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-vector vec_30))
+ (values vec_30 (unsafe-vector-length vec_30))))))
+ ((letrec-values (((for-loop_64)
+ (lambda (result_69 pos_20)
(begin
'for-loop
- (if (unsafe-fx< pos_11 len_11)
- (let-values (((s2_6) (unsafe-vector-ref vec_29 pos_11)))
- (let-values (((result_39)
- (let-values ()
- (let-values (((result_40)
- (let-values ()
- (let-values ()
- (if s2_6
- (if (equal? s_93 s2_6) s2_6 #f)
- #f)))))
- (values result_40)))))
- (if (if (not ((lambda x_26 result_39) s2_6)) (not #f) #f)
- (for-loop_58 result_39 (unsafe-fx+ 1 pos_11))
- result_39)))
- result_19)))))
- for-loop_58)
- #f
+ (if (unsafe-fx< pos_20 len_11)
+ (let-values (((s2_6) (unsafe-vector-ref vec_29 pos_20)))
+ (let-values (((result_70)
+ (let-values (((result_71)
+ (if s2_6
+ (if (equal? s_109 s2_6) s2_6 #f)
+ #f)))
+ (values result_71))))
+ (if (if (not ((lambda x_29 result_70) s2_6)) (not #f) #f)
+ (for-loop_64 result_70 (unsafe-fx+ 1 pos_20))
+ result_70)))
+ result_69)))))
+ for-loop_64)
+ result_67
0)))))
- (if or-part_109
- or-part_109
+ (if or-part_160
+ or-part_160
(begin
- (vector*-set! vec_27 (unsafe-place-local-ref cell.7) s_93)
+ (vector*-set! vec_27 (unsafe-place-local-ref cell.7) s_109)
(unsafe-place-local-set! cell.7 (fxand (fx+ 1 (unsafe-place-local-ref cell.7)) (fx- NUM-CACHE-SLOTS 1)))
- s_93)))))))
+ s_109)))))))
(define-values (cache-place-init!) (lambda () (begin (begin (resolve-cache-place-init!) (sets-place-init!)))))
(define-values
(struct:scope scope1.1 scope? scope-id scope-kind scope-binding-table set-scope-binding-table!)
- (let-values (((struct:_17 make-_17 ?_17 -ref_17 -set!_17)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'scope
- #f
- 3
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:scope-with-bindings
- (lambda (s_94 get-reachable-scopes_2 extra-shifts_3 reach_6 register-trigger_2)
- (binding-table-register-reachable
- (scope-binding-table s_94)
- get-reachable-scopes_2
- extra-shifts_3
- reach_6
- register-trigger_2)))
- (cons prop:reach-scopes (lambda (s_95 extra-shifts_4 reach_7) (void)))
- (cons
- prop:serialize-fill!
- (lambda (s_96 ser-push!_7 state_17)
- (if (binding-table-empty? (scope-binding-table s_96))
- (let-values () (ser-push!_7 'tag #f))
- (let-values ()
- (begin
- (ser-push!_7 'tag '#:scope-fill!)
- (ser-push!_7 (binding-table-prune-to-reachable (scope-binding-table s_96) state_17)))))))
- (cons
- prop:serialize
- (lambda (s_97 ser-push!_8 state_18)
- (begin
- (if (set-member? (serialize-state-reachable-scopes state_18) s_97)
- (void)
- (let-values () (error "internal error: found supposedly unreachable scope")))
- (if (eq? s_97 top-level-common-scope)
- (let-values () (ser-push!_8 'tag '#:scope))
- (let-values ()
- (begin (ser-push!_8 'tag '#:scope+kind) (ser-push!_8 (scope-kind s_97))))))))
- (cons
- prop:custom-write
- (lambda (sc_3 port_3 mode_6)
- (begin
- (write-string "#" port_3)))))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'scope)))))
+ (let-values (((struct:_22 make-_22 ?_22 -ref_22 -set!_22)
+ (make-struct-type
+ 'scope
+ #f
+ 3
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:scope-with-bindings
+ (lambda (s_110
+ get-reachable-scopes_2
+ extra-shifts_4
+ reach_6
+ register-trigger_2
+ reach-implicitly_2
+ report-shifts_4)
+ (binding-table-register-reachable
+ (scope-binding-table s_110)
+ get-reachable-scopes_2
+ extra-shifts_4
+ reach_6
+ register-trigger_2
+ reach-implicitly_2
+ report-shifts_4)))
+ (cons prop:reach-scopes (lambda (s_111 extra-shifts_5 reach_7) (void)))
+ (cons
+ prop:serialize-fill!
+ (lambda (s_112 ser-push!_7 state_17)
+ (if (binding-table-empty? (scope-binding-table s_112))
+ (ser-push!_7 'tag #f)
+ (begin
+ (ser-push!_7 'tag '#:scope-fill!)
+ (ser-push!_7 (binding-table-prune-to-reachable (scope-binding-table s_112) state_17))))))
+ (cons
+ prop:serialize
+ (lambda (s_113 ser-push!_8 state_18)
+ (begin
+ (if (set-member? (serialize-state-reachable-scopes state_18) s_113)
+ (void)
+ (error "internal error: found supposedly unreachable scope"))
+ (if (eq? s_113 top-level-common-scope)
+ (ser-push!_8 'tag '#:scope)
+ (begin (ser-push!_8 'tag '#:scope+kind) (ser-push!_8 (scope-kind s_113)))))))
+ (cons
+ prop:custom-write
+ (lambda (sc_5 port_3 mode_6)
+ (begin
+ (write-string "#" port_3)))))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'scope)))
(values
- struct:_17
- make-_17
- ?_17
- (make-struct-field-accessor -ref_17 0 'id)
- (make-struct-field-accessor -ref_17 1 'kind)
- (make-struct-field-accessor -ref_17 2 'binding-table)
- (make-struct-field-mutator -set!_17 2 'binding-table))))
+ struct:_22
+ make-_22
+ ?_22
+ (make-struct-field-accessor -ref_22 0 'id)
+ (make-struct-field-accessor -ref_22 1 'kind)
+ (make-struct-field-accessor -ref_22 2 'binding-table)
+ (make-struct-field-mutator -set!_22 2 'binding-table))))
(define-values
(deserialize-scope)
(case-lambda
(() (begin top-level-common-scope))
((kind_2) (scope1.1 (new-deserialize-scope-id!) kind_2 empty-binding-table))))
- (define-values (deserialize-scope-fill!) (lambda (s_98 bt_5) (begin (set-scope-binding-table! s_98 bt_5))))
+ (define-values (deserialize-scope-fill!) (lambda (s_114 bt_5) (begin (set-scope-binding-table! s_114 bt_5))))
(define-values
(struct:interned-scope interned-scope2.1 interned-scope? interned-scope-key)
- (let-values (((struct:_18 make-_18 ?_18 -ref_18 -set!_18)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'interned-scope
- struct:scope
- 1
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:serialize
- (lambda (s_19 ser-push!_9 state_19)
- (begin
- (if (set-member? (serialize-state-reachable-scopes state_19) s_19)
- (void)
- (let-values () (error "internal error: found supposedly unreachable scope")))
- (ser-push!_9 'tag '#:interned-scope)
- (ser-push!_9 (interned-scope-key s_19)))))
- (cons
- prop:custom-write
- (lambda (sc_4 port_4 mode_7)
- (begin
- (write-string "#" port_4)))))
- (current-inspector)
- #f
- '(0)
- #f
- 'interned-scope)))))
- (values struct:_18 make-_18 ?_18 (make-struct-field-accessor -ref_18 0 'key))))
+ (let-values (((struct:_23 make-_23 ?_23 -ref_23 -set!_23)
+ (make-struct-type
+ 'interned-scope
+ struct:scope
+ 1
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:serialize
+ (lambda (s_115 ser-push!_9 state_19)
+ (begin
+ (if (set-member? (serialize-state-reachable-scopes state_19) s_115)
+ (void)
+ (error "internal error: found supposedly unreachable scope"))
+ (ser-push!_9 'tag '#:interned-scope)
+ (ser-push!_9 (interned-scope-key s_115)))))
+ (cons
+ prop:custom-write
+ (lambda (sc_6 port_4 mode_7)
+ (begin
+ (write-string "#" port_4)))))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'interned-scope)))
+ (values struct:_23 make-_23 ?_23 (make-struct-field-accessor -ref_23 0 'key))))
(define-values
(struct:multi-scope
multi-scope3.1
@@ -8898,137 +8668,135 @@
multi-scope-scopes
multi-scope-shifted
multi-scope-label-shifted)
- (let-values (((struct:_19 make-_19 ?_19 -ref_19 -set!_19)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'multi-scope
- #f
- 5
- 0
- #f
- (list
- (cons prop:sealed #t)
- (cons prop:authentic #t)
- (cons
- prop:scope-with-bindings
- (lambda (ms_0 get-reachable-scopes_3 bulk-shifts_4 reach_8 register-trigger_3)
+ (let-values (((struct:_24 make-_24 ?_24 -ref_24 -set!_24)
+ (make-struct-type
+ 'multi-scope
+ #f
+ 5
+ 0
+ #f
+ (list
+ (cons prop:sealed #t)
+ (cons prop:authentic #t)
+ (cons
+ prop:scope-with-bindings
+ (lambda (ms_0
+ get-reachable-scopes_3
+ bulk-shifts_7
+ reach_8
+ register-trigger_3
+ reach-implicitly_3
+ report-shifts_5)
+ (begin
+ (let-values (((ht_56) (unbox (multi-scope-scopes ms_0))))
(begin
- (let-values (((ht_50) (unbox (multi-scope-scopes ms_0))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash-values ht_50)))
- ((letrec-values (((for-loop_59)
- (lambda (i_66)
- (begin
- 'for-loop
- (if i_66
- (let-values (((sc_5) (hash-iterate-value ht_50 i_66)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (if (binding-table-empty?
- (scope-binding-table
- sc_5))
- (void)
- (let-values ()
- (reach_8
- sc_5
- bulk-shifts_4))))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_59 (hash-iterate-next ht_50 i_66))
- (values))))
- (values))))))
- for-loop_59)
- (hash-iterate-first ht_50))))
- (void))))
- (cons prop:reach-scopes (lambda (s_99 extra-shifts_5 reach_9) (void)))
- (cons
- prop:serialize
- (lambda (ms_1 ser-push!_10 state_20)
- (let-values ((() (begin (ser-push!_10 'tag '#:multi-scope) (values))))
- (let-values ((() (begin (ser-push!_10 (multi-scope-name ms_1)) (values))))
- (let-values (((multi-scope-tables_0) (serialize-state-multi-scope-tables state_20)))
- (ser-push!_10
- (let-values (((or-part_110)
- (hash-ref multi-scope-tables_0 (multi-scope-scopes ms_1) #f)))
- (if or-part_110
- or-part_110
- (let-values (((ht_51)
- (let-values (((ht_52) (unbox (multi-scope-scopes ms_1))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_52)))
- ((letrec-values (((for-loop_60)
- (lambda (table_61 i_49)
- (begin
- 'for-loop
- (if i_49
- (let-values (((phase_9 sc_6)
- (hash-iterate-key+value
- ht_52
- i_49)))
- (let-values (((table_62)
- (let-values (((table_63)
- table_61))
- (if (set-member?
- (serialize-state-reachable-scopes
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash-values ht_56))
+ ((letrec-values (((for-loop_65)
+ (lambda (i_88)
+ (begin
+ 'for-loop
+ (if i_88
+ (let-values (((sc_7) (hash-iterate-value ht_56 i_88)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (if (binding-table-empty?
+ (scope-binding-table sc_7))
+ (void)
+ (reach_8 sc_7 bulk-shifts_7))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_65 (hash-iterate-next ht_56 i_88))
+ (values))))
+ (values))))))
+ for-loop_65)
+ (hash-iterate-first ht_56))))
+ (void))))
+ (cons prop:reach-scopes (lambda (s_116 extra-shifts_6 reach_9) (void)))
+ (cons
+ prop:serialize
+ (lambda (ms_1 ser-push!_10 state_20)
+ (let-values ((() (begin (ser-push!_10 'tag '#:multi-scope) (values))))
+ (let-values ((() (begin (ser-push!_10 (multi-scope-name ms_1)) (values))))
+ (let-values (((multi-scope-tables_0) (serialize-state-multi-scope-tables state_20)))
+ (ser-push!_10
+ (let-values (((or-part_161) (hash-ref multi-scope-tables_0 (multi-scope-scopes ms_1) #f)))
+ (if or-part_161
+ or-part_161
+ (let-values (((ht_57)
+ (let-values (((table_74)
+ (let-values (((table_75) '#hasheqv())) table_75)))
+ (let-values (((ht_58) (unbox (multi-scope-scopes ms_1))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash ht_58))
+ ((letrec-values (((for-loop_66)
+ (lambda (table_76 i_89)
+ (begin
+ 'for-loop
+ (if i_89
+ (let-values (((phase_13 sc_8)
+ (hash-iterate-key+value
+ ht_58
+ i_89)))
+ (let-values (((table_77)
+ (if (let-values (((or-part_162)
+ (set-member?
+ (serialize-state-reachable-scopes
+ state_20)
+ sc_8)))
+ (if or-part_162
+ or-part_162
+ (set-member?
+ (serialize-state-implicitly-reachable-scopes
state_20)
- sc_6)
- (let-values (((table_64)
- table_63))
- (let-values (((table_65)
- (let-values ()
- (let-values (((key_29
- val_13)
- (let-values ()
- (values
- phase_9
- sc_6))))
- (hash-set
- table_64
- key_29
- val_13)))))
- (values
- table_65)))
- table_63))))
- (if (not #f)
- (for-loop_60
- table_62
- (hash-iterate-next ht_52 i_49))
- table_62)))
- table_61)))))
- for-loop_60)
- '#hasheqv()
- (hash-iterate-first ht_52))))))
- (begin
- (hash-set! multi-scope-tables_0 (multi-scope-scopes ms_1) ht_51)
- ht_51)))))))))))
- (current-inspector)
- #f
- '(0 1 2 3 4)
- #f
- 'multi-scope)))))
+ sc_8)))
+ (let-values (((table_78)
+ (let-values (((key_32
+ val_15)
+ (values
+ phase_13
+ sc_8)))
+ (hash-set
+ table_76
+ key_32
+ val_15))))
+ (values table_78))
+ table_76)))
+ (if (not #f)
+ (for-loop_66
+ table_77
+ (hash-iterate-next ht_58 i_89))
+ table_77)))
+ table_76)))))
+ for-loop_66)
+ table_74
+ (hash-iterate-first ht_58)))))))
+ (begin
+ (hash-set! multi-scope-tables_0 (multi-scope-scopes ms_1) ht_57)
+ ht_57)))))))))))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4)
+ #f
+ 'multi-scope)))
(values
- struct:_19
- make-_19
- ?_19
- (make-struct-field-accessor -ref_19 0 'id)
- (make-struct-field-accessor -ref_19 1 'name)
- (make-struct-field-accessor -ref_19 2 'scopes)
- (make-struct-field-accessor -ref_19 3 'shifted)
- (make-struct-field-accessor -ref_19 4 'label-shifted))))
+ struct:_24
+ make-_24
+ ?_24
+ (make-struct-field-accessor -ref_24 0 'id)
+ (make-struct-field-accessor -ref_24 1 'name)
+ (make-struct-field-accessor -ref_24 2 'scopes)
+ (make-struct-field-accessor -ref_24 3 'shifted)
+ (make-struct-field-accessor -ref_24 4 'label-shifted))))
(define-values
(deserialize-multi-scope)
- (lambda (name_16 scopes_8)
- (begin (multi-scope3.1 (new-deserialize-scope-id!) name_16 (box scopes_8) (box (hasheqv)) (box (hash))))))
+ (lambda (name_15 scopes_8)
+ (begin (multi-scope3.1 (new-deserialize-scope-id!) name_15 (box scopes_8) (box (hasheqv)) (box (hash))))))
(define-values
(struct:representative-scope
representative-scope4.1
@@ -9037,272 +8805,295 @@
representative-scope-phase
set-representative-scope-owner!
set-representative-scope-phase!)
- (let-values (((struct:_20 make-_20 ?_20 -ref_20 -set!_20)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'representative-scope
- struct:scope
- 2
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons prop:implicitly-reachable #t)
- (cons
- prop:reach-scopes
- (lambda (s_32 bulk-shifts_5 reach_10)
- (reach_10 (representative-scope-owner s_32) bulk-shifts_5)))
- (cons
- prop:serialize-fill!
- (lambda (s_100 ser-push!_11 state_21)
- (begin
- (ser-push!_11 'tag '#:representative-scope-fill!)
- (ser-push!_11 (binding-table-prune-to-reachable (scope-binding-table s_100) state_21))
- (ser-push!_11 (representative-scope-owner s_100)))))
- (cons
- prop:serialize
- (lambda (s_101 ser-push!_12 state_22)
- (begin
- (ser-push!_12 'tag '#:representative-scope)
- (ser-push!_12 (scope-kind s_101))
- (ser-push!_12 (representative-scope-phase s_101)))))
- (cons
- prop:custom-write
- (lambda (sc_7 port_5 mode_8)
+ (let-values (((struct:_25 make-_25 ?_25 -ref_25 -set!_25)
+ (make-struct-type
+ 'representative-scope
+ struct:scope
+ 2
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons prop:implicitly-reachable #t)
+ (cons
+ prop:reach-scopes
+ (lambda (s_117 bulk-shifts_8 reach_10) (reach_10 (representative-scope-owner s_117) bulk-shifts_8)))
+ (cons
+ prop:serialize-fill!
+ (lambda (s_118 ser-push!_11 state_21)
+ (begin
+ (ser-push!_11 'tag '#:representative-scope-fill!)
+ (if (set-member? (serialize-state-reachable-scopes state_21) s_118)
+ (ser-push!_11 (binding-table-prune-to-reachable (scope-binding-table s_118) state_21))
+ (ser-push!_11 empty-binding-table))
+ (ser-push!_11 (representative-scope-owner s_118)))))
+ (cons
+ prop:serialize
+ (lambda (s_119 ser-push!_12 state_22)
+ (begin
+ (ser-push!_12 'tag '#:representative-scope)
+ (ser-push!_12 (scope-kind s_119))
+ (ser-push!_12 (representative-scope-phase s_119)))))
+ (cons
+ prop:custom-write
+ (lambda (sc_9 port_5 mode_8)
+ (begin
+ (write-string "#" port_5)))))
- (current-inspector)
- #f
- '()
- #f
- 'representative-scope)))))
+ (write-string "=" port_5)
+ (display (multi-scope-id (representative-scope-owner sc_9)) port_5))
+ (void))
+ (write-string "@" port_5)
+ (display (representative-scope-phase sc_9) port_5)
+ (write-string ">" port_5)))))
+ (current-inspector)
+ #f
+ '()
+ #f
+ 'representative-scope)))
(values
- struct:_20
- make-_20
- ?_20
- (make-struct-field-accessor -ref_20 0 'owner)
- (make-struct-field-accessor -ref_20 1 'phase)
- (make-struct-field-mutator -set!_20 0 'owner)
- (make-struct-field-mutator -set!_20 1 'phase))))
+ struct:_25
+ make-_25
+ ?_25
+ (make-struct-field-accessor -ref_25 0 'owner)
+ (make-struct-field-accessor -ref_25 1 'phase)
+ (make-struct-field-mutator -set!_25 0 'owner)
+ (make-struct-field-mutator -set!_25 1 'phase))))
(define-values
(deserialize-representative-scope)
- (lambda (kind_3 phase_10)
- (begin (let-values (((v_28) (representative-scope4.1 (new-deserialize-scope-id!) kind_3 #f #f phase_10))) v_28))))
+ (lambda (kind_3 phase_14)
+ (begin (let-values (((v_95) (representative-scope4.1 (new-deserialize-scope-id!) kind_3 #f #f phase_14))) v_95))))
(define-values
(deserialize-representative-scope-fill!)
- (lambda (s_102 bt_6 owner_0)
- (begin (begin (deserialize-scope-fill! s_102 bt_6) (set-representative-scope-owner! s_102 owner_0)))))
+ (lambda (s_120 bt_6 owner_0)
+ (begin (begin (deserialize-scope-fill! s_120 bt_6) (set-representative-scope-owner! s_120 owner_0)))))
(define-values
(struct:shifted-multi-scope
shifted-multi-scope5.1
shifted-multi-scope?
shifted-multi-scope-phase
shifted-multi-scope-multi-scope)
- (let-values (((struct:_15 make-_15 ?_15 -ref_15 -set!_15)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'shifted-multi-scope
- #f
- 2
- 0
- #f
- (list
- (cons prop:sealed #t)
- (cons prop:authentic #t)
- (cons
- prop:reach-scopes
- (lambda (sms_3 bulk-shifts_6 reach_11)
- (reach_11 (shifted-multi-scope-multi-scope sms_3) bulk-shifts_6)))
- (cons
- prop:serialize
- (lambda (sms_4 ser-push!_13 state_23)
- (begin
- (ser-push!_13 'tag '#:shifted-multi-scope)
- (ser-push!_13 (shifted-multi-scope-phase sms_4))
- (ser-push!_13 (shifted-multi-scope-multi-scope sms_4)))))
- (cons
- prop:custom-write
- (lambda (sms_5 port_6 mode_9)
- (begin
- (write-string "#" port_6)))))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'shifted-multi-scope)))))
+ (let-values (((struct:_26 make-_26 ?_26 -ref_26 -set!_26)
+ (make-struct-type
+ 'shifted-multi-scope
+ #f
+ 2
+ 0
+ #f
+ (list
+ (cons prop:sealed #t)
+ (cons prop:authentic #t)
+ (cons
+ prop:reach-scopes
+ (lambda (sms_3 bulk-shifts_9 reach_11)
+ (reach_11 (shifted-multi-scope-multi-scope sms_3) bulk-shifts_9)))
+ (cons
+ prop:serialize
+ (lambda (sms_4 ser-push!_13 state_23)
+ (begin
+ (ser-push!_13 'tag '#:shifted-multi-scope)
+ (ser-push!_13 (shifted-multi-scope-phase sms_4))
+ (ser-push!_13 (shifted-multi-scope-multi-scope sms_4)))))
+ (cons
+ prop:custom-write
+ (lambda (sms_5 port_6 mode_9)
+ (begin
+ (write-string "#" port_6)))))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'shifted-multi-scope)))
(values
- struct:_15
- make-_15
- ?_15
- (make-struct-field-accessor -ref_15 0 'phase)
- (make-struct-field-accessor -ref_15 1 'multi-scope))))
+ struct:_26
+ make-_26
+ ?_26
+ (make-struct-field-accessor -ref_26 0 'phase)
+ (make-struct-field-accessor -ref_26 1 'multi-scope))))
(define-values
(deserialize-shifted-multi-scope)
- (lambda (phase_11 multi-scope_0) (begin (intern-shifted-multi-scope phase_11 multi-scope_0))))
+ (lambda (phase_15 multi-scope_0) (begin (intern-shifted-multi-scope phase_15 multi-scope_0))))
(define-values
(intern-shifted-multi-scope)
- (lambda (phase_12 multi-scope_1)
+ (lambda (phase_16 multi-scope_1)
(begin
(letrec-values (((transaction-loop_0)
- (lambda (boxed-table_0 key_30 make_0)
+ (lambda (boxed-table_0 key_33 make_0)
(begin
'transaction-loop
- (let-values (((or-part_111) (hash-ref (unbox boxed-table_0) phase_12 #f)))
- (if or-part_111
- or-part_111
- (let-values (((val_14) (make_0)))
+ (let-values (((or-part_163) (hash-ref (unbox boxed-table_0) phase_16 #f)))
+ (if or-part_163
+ or-part_163
+ (let-values (((val_16) (make_0)))
(let-values (((current_0) (unbox boxed-table_0)))
- (let-values (((next_3) (hash-set current_0 key_30 val_14)))
+ (let-values (((next_3) (hash-set current_0 key_33 val_16)))
(if (box-cas! boxed-table_0 current_0 next_3)
- val_14
- (transaction-loop_0 boxed-table_0 key_30 make_0)))))))))))
- (if (phase? phase_12)
- (let-values ()
- (let-values (((or-part_52) (hash-ref (unbox (multi-scope-shifted multi-scope_1)) phase_12 #f)))
- (if or-part_52
- or-part_52
- (transaction-loop_0
- (multi-scope-shifted multi-scope_1)
- phase_12
- (lambda () (shifted-multi-scope5.1 phase_12 multi-scope_1))))))
- (let-values ()
- (let-values (((or-part_53) (hash-ref (unbox (multi-scope-label-shifted multi-scope_1)) phase_12 #f)))
- (if or-part_53
- or-part_53
- (transaction-loop_0
- (multi-scope-label-shifted multi-scope_1)
- phase_12
- (lambda () (shifted-multi-scope5.1 phase_12 multi-scope_1)))))))))))
+ val_16
+ (transaction-loop_0 boxed-table_0 key_33 make_0)))))))))))
+ (if (phase? phase_16)
+ (let-values (((or-part_164) (hash-ref (unbox (multi-scope-shifted multi-scope_1)) phase_16 #f)))
+ (if or-part_164
+ or-part_164
+ (transaction-loop_0
+ (multi-scope-shifted multi-scope_1)
+ phase_16
+ (lambda () (shifted-multi-scope5.1 phase_16 multi-scope_1)))))
+ (let-values (((or-part_165) (hash-ref (unbox (multi-scope-label-shifted multi-scope_1)) phase_16 #f)))
+ (if or-part_165
+ or-part_165
+ (transaction-loop_0
+ (multi-scope-label-shifted multi-scope_1)
+ phase_16
+ (lambda () (shifted-multi-scope5.1 phase_16 multi-scope_1))))))))))
(define-values
(struct:shifted-to-label-phase shifted-to-label-phase6.1 shifted-to-label-phase? shifted-to-label-phase-from)
- (let-values (((struct:_21 make-_21 ?_21 -ref_21 -set!_21)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'shifted-to-label-phase
- #f
- 1
- 0
- #f
- null
- 'prefab
- #f
- '(0)
- #f
- 'shifted-to-label-phase)))))
- (values struct:_21 make-_21 ?_21 (make-struct-field-accessor -ref_21 0 'from))))
- (define-values (cell.1$5) (unsafe-make-place-local 0))
+ (let-values (((struct:_27 make-_27 ?_27 -ref_27 -set!_27)
+ (make-struct-type 'shifted-to-label-phase #f 1 0 #f null 'prefab #f '(0) #f 'shifted-to-label-phase)))
+ (values struct:_27 make-_27 ?_27 (make-struct-field-accessor -ref_27 0 'from))))
+ (define-values (cell.1$5) (unsafe-make-place-local (box 0)))
(define-values
(new-scope-id!)
(lambda ()
(begin
- (begin
- (unsafe-place-local-set! cell.1$5 (add1 (unsafe-place-local-ref cell.1$5)))
- (unsafe-place-local-ref cell.1$5)))))
+ (let-values (((c_20) (unbox* (unsafe-place-local-ref cell.1$5))))
+ (if (box-cas! (unsafe-place-local-ref cell.1$5) c_20 (add1 c_20)) (add1 c_20) (new-scope-id!))))))
(define-values (new-deserialize-scope-id!) (lambda () (begin (- (new-scope-id!)))))
- (define-values (deserialized-scope-id?) (lambda (scope-id_0) (begin (negative? scope-id_0))))
+ (define-values
+ (make-representative-scope-id)
+ (lambda (scope-id_0 phase_17)
+ (begin
+ (if (eqv? phase_17 0)
+ (+ scope-id_0 1/2)
+ (if (not phase_17)
+ (+ scope-id_0 7/8)
+ (if (> phase_17 0) (+ scope-id_0 (/ 1 (+ 2 phase_17))) (+ scope-id_0 1/2 (/ 1 (- 2 phase_17)))))))))
(define-values (top-level-common-scope) (scope1.1 0 'module empty-binding-table))
(define-values (new-scope) (lambda (kind_4) (begin (scope1.1 (new-scope-id!) kind_4 empty-binding-table))))
- (define-values (cell.2$2) (unsafe-make-place-local (make-ephemeron-hasheq)))
+ (define-values (cell.2$4) (unsafe-make-place-local (make-ephemeron-hasheq)))
+ (define-values (cell.3$1) (unsafe-make-place-local (make-uninterruptible-lock)))
(define-values
(interned-scope-symbols)
- (lambda () (begin (call-as-atomic (lambda () (hash-keys (unsafe-place-local-ref cell.2$2)))))))
+ (lambda ()
+ (begin
+ (let-values ((() (begin (uninterruptible-lock-acquire (unsafe-place-local-ref cell.3$1)) (values))))
+ (let-values (((keys_1) (hash-keys (unsafe-place-local-ref cell.2$4))))
+ (begin (uninterruptible-lock-release (unsafe-place-local-ref cell.3$1)) keys_1))))))
(define-values
(interned-scopes)
(lambda ()
(begin
- (call-as-atomic
- (lambda ()
- (let-values (((ht_53) (unsafe-place-local-ref cell.2$2)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash-values ht_53)))
- ((letrec-values (((for-loop_61)
- (lambda (table_66 i_67)
- (begin
- 'for-loop
- (if i_67
- (let-values (((s_103) (hash-iterate-value ht_53 i_67)))
- (let-values (((table_67)
- (let-values (((table_68) table_66))
- (let-values (((table_69)
- (let-values ()
- (let-values (((key_31 val_15)
- (let-values ()
- (values
- (let-values () s_103)
- #t))))
- (hash-set table_68 key_31 val_15)))))
- (values table_69)))))
- (if (not #f) (for-loop_61 table_67 (hash-iterate-next ht_53 i_67)) table_67)))
- table_66)))))
- for-loop_61)
- '#hasheq()
- (hash-iterate-first ht_53)))))))))
- (define-values (scope-place-init!) (lambda () (begin (unsafe-place-local-set! cell.2$2 (make-ephemeron-hasheq)))))
+ (let-values ((() (begin (uninterruptible-lock-acquire (unsafe-place-local-ref cell.3$1)) (values))))
+ (let-values (((scs_6)
+ (let-values (((table_79) (let-values (((table_80) '#hasheq())) table_80)))
+ (let-values (((ht_59) (unsafe-place-local-ref cell.2$4)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash-values ht_59))
+ ((letrec-values (((for-loop_67)
+ (lambda (table_81 i_90)
+ (begin
+ 'for-loop
+ (if i_90
+ (let-values (((s_121) (hash-iterate-value ht_59 i_90)))
+ (let-values (((table_82)
+ (let-values (((table_83)
+ (let-values (((key_34 val_17)
+ (values s_121 #t)))
+ (hash-set table_81 key_34 val_17))))
+ (values table_83))))
+ (if (not #f)
+ (for-loop_67 table_82 (hash-iterate-next ht_59 i_90))
+ table_82)))
+ table_81)))))
+ for-loop_67)
+ table_79
+ (hash-iterate-first ht_59)))))))
+ (begin (uninterruptible-lock-release (unsafe-place-local-ref cell.3$1)) scs_6))))))
+ (define-values
+ (scope-place-init!)
+ (lambda ()
+ (begin
+ (begin
+ (unsafe-place-local-set! cell.2$4 (make-ephemeron-hasheq))
+ (unsafe-place-local-set! cell.3$1 (make-uninterruptible-lock))))))
(define-values
(make-interned-scope)
- (lambda (sym_15)
+ (lambda (sym_20)
(begin
(let-values (((make_1)
(lambda ()
- (begin 'make (interned-scope2.1 (- (new-scope-id!)) 'interned empty-binding-table sym_15)))))
- (call-as-atomic
- (lambda ()
- (let-values (((or-part_66) (hash-ref! (unsafe-place-local-ref cell.2$2) sym_15 #f)))
- (if or-part_66
- or-part_66
- (let-values (((new_2) (make_1)))
- (begin (hash-set! (unsafe-place-local-ref cell.2$2) sym_15 new_2) new_2))))))))))
+ (begin 'make (interned-scope2.1 (- (new-scope-id!)) 'interned empty-binding-table sym_20)))))
+ (let-values (((cond-val_4) (hash-ref (unsafe-place-local-ref cell.2$4) sym_20 #f)))
+ (if cond-val_4
+ ((lambda (s_122) s_122) cond-val_4)
+ (let-values (((new_2) (make_1)))
+ (let-values ((() (begin (uninterruptible-lock-acquire (unsafe-place-local-ref cell.3$1)) (values))))
+ (let-values (((s_123)
+ (let-values (((or-part_166) (hash-ref (unsafe-place-local-ref cell.2$4) sym_20 #f)))
+ (if or-part_166
+ or-part_166
+ (begin (hash-set! (unsafe-place-local-ref cell.2$4) sym_20 new_2) new_2)))))
+ (begin (uninterruptible-lock-release (unsafe-place-local-ref cell.3$1)) s_123))))))))))
+ (define-values
+ (syntax-has-interned-scope?)
+ (lambda (s_124)
+ (begin
+ (let-values (((result_72) (let-values (((result_73) #f)) result_73)))
+ (let-values (((ht_60) (syntax-scopes s_124)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash-keys ht_60))
+ ((letrec-values (((for-loop_68)
+ (lambda (result_74 i_91)
+ (begin
+ 'for-loop
+ (if i_91
+ (let-values (((sc_10) (unsafe-immutable-hash-iterate-key ht_60 i_91)))
+ (let-values (((result_75)
+ (let-values (((result_76) (interned-scope? sc_10)))
+ (values result_76))))
+ (if (if (not ((lambda x_30 result_75) sc_10)) (not #f) #f)
+ (for-loop_68 result_75 (unsafe-immutable-hash-iterate-next ht_60 i_91))
+ result_75)))
+ result_74)))))
+ for-loop_68)
+ result_72
+ (unsafe-immutable-hash-iterate-first ht_60))))))))
(define-values
(new-multi-scope)
(let-values (((new-multi-scope_0)
(lambda (name7_0)
(begin
'new-multi-scope
- (let-values (((name_17) name7_0))
- (let-values ()
- (intern-shifted-multi-scope
- 0
- (multi-scope3.1 (new-scope-id!) name_17 (box (hasheqv)) (box (hasheqv)) (box (hash))))))))))
+ (let-values (((name_16) name7_0))
+ (intern-shifted-multi-scope
+ 0
+ (multi-scope3.1 (new-scope-id!) name_16 (box (hasheqv)) (box (hasheqv)) (box (hash)))))))))
(case-lambda (() (begin (new-multi-scope_0 #f))) ((name7_1) (new-multi-scope_0 name7_1)))))
(define-values
(multi-scope-to-scope-at-phase)
- (lambda (ms_2 phase_13)
+ (lambda (ms_2 phase_18)
(begin
(let-values (((scopes_9) (unbox (multi-scope-scopes ms_2))))
- (let-values (((or-part_67) (hash-ref scopes_9 phase_13 #f)))
- (if or-part_67
- or-part_67
- (let-values (((s_69)
+ (let-values (((or-part_167) (hash-ref scopes_9 phase_18 #f)))
+ (if or-part_167
+ or-part_167
+ (let-values (((s_125)
(representative-scope4.1
- (if (deserialized-scope-id? (multi-scope-id ms_2))
- (new-deserialize-scope-id!)
- (new-scope-id!))
+ (make-representative-scope-id (multi-scope-id ms_2) phase_18)
'module
empty-binding-table
ms_2
- phase_13)))
- (if (box-cas! (multi-scope-scopes ms_2) scopes_9 (hash-set scopes_9 phase_13 s_69))
- s_69
- (multi-scope-to-scope-at-phase ms_2 phase_13)))))))))
+ phase_18)))
+ (if (box-cas! (multi-scope-scopes ms_2) scopes_9 (hash-set scopes_9 phase_18 s_125))
+ s_125
+ (multi-scope-to-scope-at-phase ms_2 phase_18)))))))))
(define-values (scope>?) (lambda (sc1_0 sc2_0) (begin (> (scope-id sc1_0) (scope-id sc2_0)))))
(define-values (scope) (lambda (sc1_1 sc2_1) (begin (< (scope-id sc1_1) (scope-id sc2_1)))))
(define-values
@@ -9314,315 +9105,292 @@
(if (eq? ms1_0 ms2_0)
(let-values (((p1_1) (shifted-multi-scope-phase sms1_0)) ((p2_1) (shifted-multi-scope-phase sms2_0)))
(if (shifted-to-label-phase? p1_1)
- (let-values ()
- (if (shifted-to-label-phase? p2_1)
- (let-values () (phase (shifted-to-label-phase-from p1_1) (shifted-to-label-phase-from p2_1)))
- (let-values () #f)))
- (if (shifted-to-label-phase? p2_1) (let-values () #t) (let-values () (phase p1_1 p2_1)))))
+ (if (shifted-to-label-phase? p2_1)
+ (phase (shifted-to-label-phase-from p1_1) (shifted-to-label-phase-from p2_1))
+ #f)
+ (if (shifted-to-label-phase? p2_1) #t (phase p1_1 p2_1))))
(< (multi-scope-id ms1_0) (multi-scope-id ms2_0))))))))
(define-values
(syntax-propagated-content*)
- (lambda (s_104)
+ (lambda (s_126)
(begin
- (let-values (((content*_7) (syntax-content* s_104)))
+ (let-values (((content*_7) (syntax-content* s_126)))
(if (not (modified-content? content*_7))
- (let-values () content*_7)
- (let-values ()
- (let-values (((prop_2) (modified-content-scope-propagations+taint content*_7)))
- (if (let-values (((or-part_112) (propagation? prop_2)))
- (if or-part_112 or-part_112 (taint-needs-propagate? prop_2)))
- (let-values ()
- (let-values (((content_10) (modified-content-content content*_7)))
- (let-values (((new-content_0)
- (if (propagation? prop_2)
- (let-values ()
- (let-values (((s_105) content_10)
- ((f_29) (lambda (tail?_13 x_27) (begin 'f x_27)))
- ((s->_2)
- (lambda (sub-s_1)
- (begin
- 's->
- (let-values (((sub-content*_0) (syntax-content* sub-s_1)))
- (let-values (((sub-content_0)
- (if (modified-content? sub-content*_0)
- (modified-content-content sub-content*_0)
- sub-content*_0)))
- (let-values (((scope-propagations+taint_0)
- (propagation-merge
- sub-content_0
+ content*_7
+ (let-values (((prop_2) (modified-content-scope-propagations+taint content*_7)))
+ (if (let-values (((or-part_168) (propagation? prop_2)))
+ (if or-part_168 or-part_168 (taint-needs-propagate? prop_2)))
+ (let-values (((content_10) (modified-content-content content*_7)))
+ (let-values (((new-content_0)
+ (if (propagation? prop_2)
+ (let-values (((s_127) content_10)
+ ((f_29) (lambda (tail?_21 x_31) (begin 'f x_31)))
+ ((s->_2)
+ (lambda (sub-s_1)
+ (begin
+ 's->
+ (let-values (((sub-content*_0) (syntax-content* sub-s_1)))
+ (let-values (((sub-content_0)
+ (if (modified-content? sub-content*_0)
+ (modified-content-content sub-content*_0)
+ sub-content*_0)))
+ (let-values (((scope-propagations+taint_0)
+ (propagation-merge
+ sub-content_0
+ prop_2
+ (if (modified-content? sub-content*_0)
+ (modified-content-scope-propagations+taint
+ sub-content*_0)
+ #f)
+ (syntax-scopes sub-s_1)
+ (syntax-shifted-multi-scopes sub-s_1)
+ (syntax-mpi-shifts sub-s_1))))
+ (let-values (((the-struct_8) sub-s_1))
+ (if (syntax?$1 the-struct_8)
+ (let-values (((scopes41_0)
+ (propagation-apply
prop_2
- (if (modified-content? sub-content*_0)
- (modified-content-scope-propagations+taint
- sub-content*_0)
- #f)
(syntax-scopes sub-s_1)
+ s_126))
+ ((shifted-multi-scopes42_0)
+ (propagation-apply-shifted
+ prop_2
(syntax-shifted-multi-scopes sub-s_1)
- (syntax-mpi-shifts sub-s_1))))
- (let-values (((the-struct_8) sub-s_1))
- (if (syntax?$1 the-struct_8)
- (let-values (((scopes41_0)
- (propagation-apply
- prop_2
- (syntax-scopes sub-s_1)
- s_104))
- ((shifted-multi-scopes42_0)
- (propagation-apply-shifted
- prop_2
- (syntax-shifted-multi-scopes sub-s_1)
- s_104))
- ((mpi-shifts43_0)
- (propagation-apply-mpi-shifts
- prop_2
- (syntax-mpi-shifts sub-s_1)
- s_104))
- ((inspector44_0)
- (propagation-apply-inspector
- prop_2
- (syntax-inspector sub-s_1)))
- ((content*45_0)
- (if scope-propagations+taint_0
- (modified-content1.1
- sub-content_0
- scope-propagations+taint_0)
- sub-content_0)))
- (syntax2.1
- content*45_0
- scopes41_0
- shifted-multi-scopes42_0
- mpi-shifts43_0
- (syntax-srcloc$1 the-struct_8)
- (syntax-props the-struct_8)
- inspector44_0))
- (raise-argument-error
- 'struct-copy
- "syntax?"
- the-struct_8)))))))))
- ((seen_8) #f)
- ((known-pairs_6) #f))
- (let-values (((s_106) s_105)
- ((f_30) f_29)
- ((gf_3)
- (lambda (tail?_21 v_69)
+ s_126))
+ ((mpi-shifts43_0)
+ (propagation-apply-mpi-shifts
+ prop_2
+ (syntax-mpi-shifts sub-s_1)
+ s_126))
+ ((inspector44_0)
+ (propagation-apply-inspector
+ prop_2
+ (syntax-inspector sub-s_1)))
+ ((content*45_0)
+ (if scope-propagations+taint_0
+ (modified-content1.1
+ sub-content_0
+ scope-propagations+taint_0)
+ sub-content_0)))
+ (syntax2.1
+ content*45_0
+ scopes41_0
+ shifted-multi-scopes42_0
+ mpi-shifts43_0
+ (syntax-srcloc$1 the-struct_8)
+ (syntax-props the-struct_8)
+ inspector44_0))
+ (raise-argument-error
+ 'struct-copy
+ "syntax?"
+ the-struct_8)))))))))
+ ((seen_9) #f)
+ ((known-pairs_7) #f))
+ (let-values (((s_128) s_127)
+ ((f_30) f_29)
+ ((gf_4)
+ (lambda (tail?_22 v_96)
+ (begin 'gf (if (syntax?$1 v_96) (s->_2 v_96) (f_29 tail?_22 v_96)))))
+ ((seen_10) seen_9)
+ ((known-pairs_8) known-pairs_7))
+ ((letrec-values (((loop_66)
+ (lambda (tail?_23 s_129 prev-depth_4)
(begin
- 'gf
- (if (syntax?$1 v_69)
- (let-values () (s->_2 v_69))
- (let-values () (f_29 tail?_21 v_69))))))
- ((seen_9) seen_8)
- ((known-pairs_7) known-pairs_6))
- ((letrec-values (((loop_64)
- (lambda (tail?_22 s_107 prev-depth_4)
- (begin
- 'loop
- (let-values (((depth_4) (fx+ 1 prev-depth_4)))
- (if (if seen_9 (fx> depth_4 32) #f)
- (let-values ()
- (datum-map-slow
- tail?_22
- s_107
- (lambda (tail?_23 s_108) (gf_3 tail?_23 s_108))
- seen_9
- known-pairs_7))
- (if (null? s_107)
- (let-values () (f_30 tail?_22 s_107))
- (if (pair? s_107)
- (let-values ()
- (f_30
- tail?_22
- (cons
- (loop_64 #f (car s_107) depth_4)
- (loop_64 1 (cdr s_107) depth_4))))
- (if (symbol? s_107)
- (let-values () (f_30 #f s_107))
- (if (boolean? s_107)
- (let-values () (f_30 #f s_107))
- (if (number? s_107)
- (let-values () (f_30 #f s_107))
- (if (let-values (((or-part_113)
- (vector? s_107)))
- (if or-part_113
- or-part_113
- (let-values (((or-part_114)
- (box? s_107)))
- (if or-part_114
- or-part_114
- (let-values (((or-part_115)
- (prefab-struct-key
- s_107)))
- (if or-part_115
- or-part_115
- (hash? s_107)))))))
- (let-values ()
- (datum-map-slow
- tail?_22
- s_107
- (lambda (tail?_24 s_109)
- (gf_3 tail?_24 s_109))
- seen_9
- known-pairs_7))
- (let-values ()
- (gf_3 #f s_107))))))))))))))
- loop_64)
- #f
- s_106
- 0))))
- (let-values ()
- (let-values (((s_110) content_10)
- ((f_31) (lambda (tail?_25 x_28) (begin 'f x_28)))
- ((s->_3)
- (lambda (sub-s_2)
- (begin
- 's->
- (let-values (((stx_4) sub-s_2))
- (let-values (((t_7)
- (tainted-for-content (syntax-content sub-s_2))))
- (let-values (((content*_8) (syntax-content* stx_4)))
- (let-values (((content_11)
- (if (modified-content? content*_8)
- (modified-content-content content*_8)
- content*_8)))
- (let-values (((p_16)
- (if (modified-content? content*_8)
- (modified-content-scope-propagations+taint
- content*_8)
- #f)))
- (let-values (((the-struct_9) stx_4))
- (if (syntax?$1 the-struct_9)
- (let-values (((content*46_0)
- (let-values (((new-p_2)
- (if (taint? p_16)
- t_7
- ((propagation-set-taint-ref
- p_16)
- p_16
- t_7))))
- (if new-p_2
- (modified-content1.1
- content_11
- new-p_2)
- content_11))))
- (syntax2.1
- content*46_0
- (syntax-scopes the-struct_9)
- (syntax-shifted-multi-scopes the-struct_9)
- (syntax-mpi-shifts the-struct_9)
- (syntax-srcloc$1 the-struct_9)
- (syntax-props the-struct_9)
- (syntax-inspector the-struct_9)))
- (raise-argument-error
- 'struct-copy
- "syntax?"
- the-struct_9)))))))))))
- ((seen_10) #f)
- ((known-pairs_8) #f))
- (let-values (((s_111) s_110)
- ((f_32) f_31)
- ((gf_4)
- (lambda (tail?_26 v_70)
+ 'loop
+ (let-values (((depth_4) (fx+ 1 prev-depth_4)))
+ (if (if seen_10 (fx> depth_4 32) #f)
+ (datum-map-slow
+ tail?_23
+ s_129
+ (lambda (tail?_24 s_130) (gf_4 tail?_24 s_130))
+ seen_10
+ known-pairs_8)
+ (if (null? s_129)
+ (f_30 tail?_23 s_129)
+ (if (pair? s_129)
+ (f_30
+ tail?_23
+ (cons
+ (loop_66 #f (car s_129) depth_4)
+ (loop_66 1 (cdr s_129) depth_4)))
+ (if (symbol? s_129)
+ (f_30 #f s_129)
+ (if (boolean? s_129)
+ (f_30 #f s_129)
+ (if (number? s_129)
+ (f_30 #f s_129)
+ (if (let-values (((or-part_169)
+ (vector? s_129)))
+ (if or-part_169
+ or-part_169
+ (let-values (((or-part_170)
+ (box? s_129)))
+ (if or-part_170
+ or-part_170
+ (let-values (((or-part_171)
+ (prefab-struct-key
+ s_129)))
+ (if or-part_171
+ or-part_171
+ (hash? s_129)))))))
+ (datum-map-slow
+ tail?_23
+ s_129
+ (lambda (tail?_25 s_131)
+ (gf_4 tail?_25 s_131))
+ seen_10
+ known-pairs_8)
+ (gf_4 #f s_129)))))))))))))
+ loop_66)
+ #f
+ s_128
+ 0)))
+ (let-values (((s_132) content_10)
+ ((f_31) (lambda (tail?_26 x_32) (begin 'f x_32)))
+ ((s->_3)
+ (lambda (sub-s_2)
+ (begin
+ 's->
+ (let-values (((stx_4) sub-s_2))
+ (let-values (((t_6) (tainted-for-content (syntax-content sub-s_2))))
+ (let-values (((content*_8) (syntax-content* stx_4)))
+ (let-values (((content_11)
+ (if (modified-content? content*_8)
+ (modified-content-content content*_8)
+ content*_8)))
+ (let-values (((p_17)
+ (if (modified-content? content*_8)
+ (modified-content-scope-propagations+taint
+ content*_8)
+ #f)))
+ (let-values (((the-struct_9) stx_4))
+ (if (syntax?$1 the-struct_9)
+ (let-values (((content*46_0)
+ (let-values (((new-p_2)
+ (if (taint? p_17)
+ t_6
+ ((propagation-set-taint-ref
+ p_17)
+ p_17
+ t_6))))
+ (if new-p_2
+ (modified-content1.1
+ content_11
+ new-p_2)
+ content_11))))
+ (syntax2.1
+ content*46_0
+ (syntax-scopes the-struct_9)
+ (syntax-shifted-multi-scopes the-struct_9)
+ (syntax-mpi-shifts the-struct_9)
+ (syntax-srcloc$1 the-struct_9)
+ (syntax-props the-struct_9)
+ (syntax-inspector the-struct_9)))
+ (raise-argument-error
+ 'struct-copy
+ "syntax?"
+ the-struct_9)))))))))))
+ ((seen_11) #f)
+ ((known-pairs_9) #f))
+ (let-values (((s_133) s_132)
+ ((f_32) f_31)
+ ((gf_5)
+ (lambda (tail?_27 v_97)
+ (begin 'gf (if (syntax?$1 v_97) (s->_3 v_97) (f_31 tail?_27 v_97)))))
+ ((seen_12) seen_11)
+ ((known-pairs_10) known-pairs_9))
+ ((letrec-values (((loop_67)
+ (lambda (tail?_28 s_134 prev-depth_5)
(begin
- 'gf
- (if (syntax?$1 v_70)
- (let-values () (s->_3 v_70))
- (let-values () (f_31 tail?_26 v_70))))))
- ((seen_11) seen_10)
- ((known-pairs_9) known-pairs_8))
- ((letrec-values (((loop_65)
- (lambda (tail?_27 s_112 prev-depth_5)
- (begin
- 'loop
- (let-values (((depth_5) (fx+ 1 prev-depth_5)))
- (if (if seen_11 (fx> depth_5 32) #f)
- (let-values ()
- (datum-map-slow
- tail?_27
- s_112
- (lambda (tail?_28 s_113) (gf_4 tail?_28 s_113))
- seen_11
- known-pairs_9))
- (if (null? s_112)
- (let-values () (f_32 tail?_27 s_112))
- (if (pair? s_112)
- (let-values ()
- (f_32
- tail?_27
- (cons
- (loop_65 #f (car s_112) depth_5)
- (loop_65 1 (cdr s_112) depth_5))))
- (if (symbol? s_112)
- (let-values () (f_32 #f s_112))
- (if (boolean? s_112)
- (let-values () (f_32 #f s_112))
- (if (number? s_112)
- (let-values () (f_32 #f s_112))
- (if (let-values (((or-part_116)
- (vector? s_112)))
- (if or-part_116
- or-part_116
- (let-values (((or-part_117)
- (box? s_112)))
- (if or-part_117
- or-part_117
- (let-values (((or-part_118)
- (prefab-struct-key
- s_112)))
- (if or-part_118
- or-part_118
- (hash? s_112)))))))
- (let-values ()
- (datum-map-slow
- tail?_27
- s_112
- (lambda (tail?_29 s_114)
- (gf_4 tail?_29 s_114))
- seen_11
- known-pairs_9))
- (let-values ()
- (gf_4 #f s_112))))))))))))))
- loop_65)
- #f
- s_111
- 0)))))))
- (let-values (((new-taint_0)
- (taint-propagated (if (propagation? prop_2) (propagation-taint prop_2) prop_2))))
- (let-values (((new-content*_0)
- (if new-taint_0 (modified-content1.1 new-content_0 new-taint_0) new-content_0)))
- (if (syntax-content*-cas! s_104 content*_7 new-content*_0)
- new-content*_0
- (syntax-propagated-content* s_104)))))))
- (let-values () content*_7)))))))))
+ 'loop
+ (let-values (((depth_5) (fx+ 1 prev-depth_5)))
+ (if (if seen_12 (fx> depth_5 32) #f)
+ (datum-map-slow
+ tail?_28
+ s_134
+ (lambda (tail?_29 s_135) (gf_5 tail?_29 s_135))
+ seen_12
+ known-pairs_10)
+ (if (null? s_134)
+ (f_32 tail?_28 s_134)
+ (if (pair? s_134)
+ (f_32
+ tail?_28
+ (cons
+ (loop_67 #f (car s_134) depth_5)
+ (loop_67 1 (cdr s_134) depth_5)))
+ (if (symbol? s_134)
+ (f_32 #f s_134)
+ (if (boolean? s_134)
+ (f_32 #f s_134)
+ (if (number? s_134)
+ (f_32 #f s_134)
+ (if (let-values (((or-part_172)
+ (vector? s_134)))
+ (if or-part_172
+ or-part_172
+ (let-values (((or-part_173)
+ (box? s_134)))
+ (if or-part_173
+ or-part_173
+ (let-values (((or-part_174)
+ (prefab-struct-key
+ s_134)))
+ (if or-part_174
+ or-part_174
+ (hash? s_134)))))))
+ (datum-map-slow
+ tail?_28
+ s_134
+ (lambda (tail?_30 s_136)
+ (gf_5 tail?_30 s_136))
+ seen_12
+ known-pairs_10)
+ (gf_5 #f s_134)))))))))))))
+ loop_67)
+ #f
+ s_133
+ 0))))))
+ (let-values (((new-taint_0)
+ (taint-propagated (if (propagation? prop_2) (propagation-taint prop_2) prop_2))))
+ (let-values (((new-content*_0)
+ (if new-taint_0 (modified-content1.1 new-content_0 new-taint_0) new-content_0)))
+ (if (syntax-content*-cas! s_126 content*_7 new-content*_0)
+ new-content*_0
+ (syntax-propagated-content* s_126))))))
+ content*_7)))))))
(define-values
(syntax-e$1)
- (lambda (s_115)
+ (lambda (s_137)
(begin
'syntax-e
- (let-values (((e_13) (syntax-content* s_115)))
+ (let-values (((e_13) (syntax-content* s_137)))
(if (symbol? e_13)
- (let-values () e_13)
- (let-values ()
- (let-values (((content*_9) (syntax-propagated-content* s_115)))
- (if (modified-content? content*_9) (modified-content-content content*_9) content*_9))))))))
+ e_13
+ (let-values (((content*_9) (syntax-propagated-content* s_137)))
+ (if (modified-content? content*_9) (modified-content-content content*_9) content*_9)))))))
(define-values
(generalize-scope)
- (lambda (sc_8)
+ (lambda (sc_11)
(begin
- (if (representative-scope? sc_8)
- (intern-shifted-multi-scope (representative-scope-phase sc_8) (representative-scope-owner sc_8))
- sc_8))))
+ (if (representative-scope? sc_11)
+ (intern-shifted-multi-scope (representative-scope-phase sc_11) (representative-scope-owner sc_11))
+ sc_11))))
(define-values
(add-scope)
- (lambda (s_116 sc_9)
+ (lambda (s_138 sc_12)
(begin
- (let-values (((s_117) s_116) ((sc_10) (generalize-scope sc_9)) ((op_0) set-add) ((prop-op_0) propagation-add))
- (let-values (((content*_10) (syntax-content* s_117)))
+ (let-values (((s_139) s_138) ((sc_13) (generalize-scope sc_12)) ((op_0) set-add) ((prop-op_0) propagation-add))
+ (let-values (((content*_10) (syntax-content* s_139)))
(let-values (((content_12)
(if (modified-content? content*_10) (modified-content-content content*_10) content*_10)))
- (if (shifted-multi-scope? sc_10)
- (let-values (((the-struct_10) s_117))
+ (if (shifted-multi-scope? sc_13)
+ (let-values (((the-struct_10) s_139))
(if (syntax?$1 the-struct_10)
(let-values (((shifted-multi-scopes47_0)
(fallback-update-first
- (syntax-shifted-multi-scopes s_117)
- (lambda (smss_9) (op_0 (fallback-first smss_9) sc_10))))
+ (syntax-shifted-multi-scopes s_139)
+ (lambda (smss_9) (op_0 (fallback-first smss_9) sc_13))))
((content*48_0)
(if (datum-has-elements? content_12)
(let-values (((prop_3)
@@ -9630,10 +9398,10 @@
(if (modified-content? content*_10)
(modified-content-scope-propagations+taint content*_10)
#f)
- sc_10
- (syntax-scopes s_117)
- (syntax-shifted-multi-scopes s_117)
- (syntax-mpi-shifts s_117))))
+ sc_13
+ (syntax-scopes s_139)
+ (syntax-shifted-multi-scopes s_139)
+ (syntax-mpi-shifts s_139))))
(if prop_3 (modified-content1.1 content_12 prop_3) content_12))
content*_10)))
(syntax2.1
@@ -9645,9 +9413,9 @@
(syntax-props the-struct_10)
(syntax-inspector the-struct_10)))
(raise-argument-error 'struct-copy "syntax?" the-struct_10)))
- (let-values (((the-struct_11) s_117))
+ (let-values (((the-struct_11) s_139))
(if (syntax?$1 the-struct_11)
- (let-values (((scopes49_0) (op_0 (syntax-scopes s_117) sc_10))
+ (let-values (((scopes49_0) (op_0 (syntax-scopes s_139) sc_13))
((content*50_0)
(if (datum-has-elements? content_12)
(let-values (((prop_4)
@@ -9655,10 +9423,10 @@
(if (modified-content? content*_10)
(modified-content-scope-propagations+taint content*_10)
#f)
- sc_10
- (syntax-scopes s_117)
- (syntax-shifted-multi-scopes s_117)
- (syntax-mpi-shifts s_117))))
+ sc_13
+ (syntax-scopes s_139)
+ (syntax-shifted-multi-scopes s_139)
+ (syntax-mpi-shifts s_139))))
(if prop_4 (modified-content1.1 content_12 prop_4) content_12))
content*_10)))
(syntax2.1
@@ -9672,44 +9440,43 @@
(raise-argument-error 'struct-copy "syntax?" the-struct_11))))))))))
(define-values
(add-scopes)
- (lambda (s_118 scs_5)
+ (lambda (s_140 scs_7)
(begin
- (let-values (((lst_47) scs_5))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_47)))
- ((letrec-values (((for-loop_62)
- (lambda (s_119 lst_48)
- (begin
- 'for-loop
- (if (pair? lst_48)
- (let-values (((sc_11) (unsafe-car lst_48)) ((rest_21) (unsafe-cdr lst_48)))
- (let-values (((s_120)
- (let-values (((s_121) s_119))
- (let-values (((s_122) (let-values () (add-scope s_121 sc_11))))
- (values s_122)))))
- (if (not #f) (for-loop_62 s_120 rest_21) s_120)))
- s_119)))))
- for-loop_62)
- s_118
- lst_47))))))
+ (let-values (((s_141) (let-values (((s_142) s_140)) s_142)))
+ (let-values (((lst_53) scs_7))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_53))
+ ((letrec-values (((for-loop_69)
+ (lambda (s_143 lst_54)
+ (begin
+ 'for-loop
+ (if (pair? lst_54)
+ (let-values (((sc_14) (unsafe-car lst_54)) ((rest_23) (unsafe-cdr lst_54)))
+ (let-values (((s_144)
+ (let-values (((s_145) (add-scope s_143 sc_14))) (values s_145))))
+ (if (not #f) (for-loop_69 s_144 rest_23) s_144)))
+ s_143)))))
+ for-loop_69)
+ s_141
+ lst_53)))))))
(define-values
(remove-scope)
- (lambda (s_123 sc_12)
+ (lambda (s_146 sc_15)
(begin
- (let-values (((s_124) s_123)
- ((sc_13) (generalize-scope sc_12))
+ (let-values (((s_147) s_146)
+ ((sc_16) (generalize-scope sc_15))
((op_1) set-remove)
((prop-op_1) propagation-remove))
- (let-values (((content*_11) (syntax-content* s_124)))
+ (let-values (((content*_11) (syntax-content* s_147)))
(let-values (((content_13)
(if (modified-content? content*_11) (modified-content-content content*_11) content*_11)))
- (if (shifted-multi-scope? sc_13)
- (let-values (((the-struct_12) s_124))
+ (if (shifted-multi-scope? sc_16)
+ (let-values (((the-struct_12) s_147))
(if (syntax?$1 the-struct_12)
(let-values (((shifted-multi-scopes51_0)
(fallback-update-first
- (syntax-shifted-multi-scopes s_124)
- (lambda (smss_10) (op_1 (fallback-first smss_10) sc_13))))
+ (syntax-shifted-multi-scopes s_147)
+ (lambda (smss_10) (op_1 (fallback-first smss_10) sc_16))))
((content*52_0)
(if (datum-has-elements? content_13)
(let-values (((prop_5)
@@ -9717,10 +9484,10 @@
(if (modified-content? content*_11)
(modified-content-scope-propagations+taint content*_11)
#f)
- sc_13
- (syntax-scopes s_124)
- (syntax-shifted-multi-scopes s_124)
- (syntax-mpi-shifts s_124))))
+ sc_16
+ (syntax-scopes s_147)
+ (syntax-shifted-multi-scopes s_147)
+ (syntax-mpi-shifts s_147))))
(if prop_5 (modified-content1.1 content_13 prop_5) content_13))
content*_11)))
(syntax2.1
@@ -9732,9 +9499,9 @@
(syntax-props the-struct_12)
(syntax-inspector the-struct_12)))
(raise-argument-error 'struct-copy "syntax?" the-struct_12)))
- (let-values (((the-struct_13) s_124))
+ (let-values (((the-struct_13) s_147))
(if (syntax?$1 the-struct_13)
- (let-values (((scopes53_0) (op_1 (syntax-scopes s_124) sc_13))
+ (let-values (((scopes53_0) (op_1 (syntax-scopes s_147) sc_16))
((content*54_0)
(if (datum-has-elements? content_13)
(let-values (((prop_6)
@@ -9742,10 +9509,10 @@
(if (modified-content? content*_11)
(modified-content-scope-propagations+taint content*_11)
#f)
- sc_13
- (syntax-scopes s_124)
- (syntax-shifted-multi-scopes s_124)
- (syntax-mpi-shifts s_124))))
+ sc_16
+ (syntax-scopes s_147)
+ (syntax-shifted-multi-scopes s_147)
+ (syntax-mpi-shifts s_147))))
(if prop_6 (modified-content1.1 content_13 prop_6) content_13))
content*_11)))
(syntax2.1
@@ -9759,44 +9526,43 @@
(raise-argument-error 'struct-copy "syntax?" the-struct_13))))))))))
(define-values
(remove-scopes)
- (lambda (s_125 scs_6)
+ (lambda (s_148 scs_8)
(begin
- (let-values (((lst_49) scs_6))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_49)))
- ((letrec-values (((for-loop_63)
- (lambda (s_126 lst_50)
- (begin
- 'for-loop
- (if (pair? lst_50)
- (let-values (((sc_14) (unsafe-car lst_50)) ((rest_22) (unsafe-cdr lst_50)))
- (let-values (((s_127)
- (let-values (((s_128) s_126))
- (let-values (((s_129) (let-values () (remove-scope s_128 sc_14))))
- (values s_129)))))
- (if (not #f) (for-loop_63 s_127 rest_22) s_127)))
- s_126)))))
- for-loop_63)
- s_125
- lst_49))))))
+ (let-values (((s_149) (let-values (((s_150) s_148)) s_150)))
+ (let-values (((lst_55) scs_8))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_55))
+ ((letrec-values (((for-loop_70)
+ (lambda (s_151 lst_56)
+ (begin
+ 'for-loop
+ (if (pair? lst_56)
+ (let-values (((sc_17) (unsafe-car lst_56)) ((rest_24) (unsafe-cdr lst_56)))
+ (let-values (((s_152)
+ (let-values (((s_153) (remove-scope s_151 sc_17))) (values s_153))))
+ (if (not #f) (for-loop_70 s_152 rest_24) s_152)))
+ s_151)))))
+ for-loop_70)
+ s_149
+ lst_55)))))))
(define-values
(set-flip)
- (lambda (s_130 e_14) (begin (if (set-member? s_130 e_14) (set-remove s_130 e_14) (set-add s_130 e_14)))))
+ (lambda (s_154 e_14) (begin (if (set-member? s_154 e_14) (set-remove s_154 e_14) (set-add s_154 e_14)))))
(define-values
(flip-scope)
- (lambda (s_131 sc_15)
+ (lambda (s_155 sc_18)
(begin
- (let-values (((s_132) s_131) ((sc_16) (generalize-scope sc_15)) ((op_2) set-flip) ((prop-op_2) propagation-flip))
- (let-values (((content*_12) (syntax-content* s_132)))
+ (let-values (((s_156) s_155) ((sc_19) (generalize-scope sc_18)) ((op_2) set-flip) ((prop-op_2) propagation-flip))
+ (let-values (((content*_12) (syntax-content* s_156)))
(let-values (((content_14)
(if (modified-content? content*_12) (modified-content-content content*_12) content*_12)))
- (if (shifted-multi-scope? sc_16)
- (let-values (((the-struct_14) s_132))
+ (if (shifted-multi-scope? sc_19)
+ (let-values (((the-struct_14) s_156))
(if (syntax?$1 the-struct_14)
(let-values (((shifted-multi-scopes55_0)
(fallback-update-first
- (syntax-shifted-multi-scopes s_132)
- (lambda (smss_11) (op_2 (fallback-first smss_11) sc_16))))
+ (syntax-shifted-multi-scopes s_156)
+ (lambda (smss_11) (op_2 (fallback-first smss_11) sc_19))))
((content*56_0)
(if (datum-has-elements? content_14)
(let-values (((prop_7)
@@ -9804,10 +9570,10 @@
(if (modified-content? content*_12)
(modified-content-scope-propagations+taint content*_12)
#f)
- sc_16
- (syntax-scopes s_132)
- (syntax-shifted-multi-scopes s_132)
- (syntax-mpi-shifts s_132))))
+ sc_19
+ (syntax-scopes s_156)
+ (syntax-shifted-multi-scopes s_156)
+ (syntax-mpi-shifts s_156))))
(if prop_7 (modified-content1.1 content_14 prop_7) content_14))
content*_12)))
(syntax2.1
@@ -9819,9 +9585,9 @@
(syntax-props the-struct_14)
(syntax-inspector the-struct_14)))
(raise-argument-error 'struct-copy "syntax?" the-struct_14)))
- (let-values (((the-struct_15) s_132))
+ (let-values (((the-struct_15) s_156))
(if (syntax?$1 the-struct_15)
- (let-values (((scopes57_0) (op_2 (syntax-scopes s_132) sc_16))
+ (let-values (((scopes57_0) (op_2 (syntax-scopes s_156) sc_19))
((content*58_0)
(if (datum-has-elements? content_14)
(let-values (((prop_8)
@@ -9829,10 +9595,10 @@
(if (modified-content? content*_12)
(modified-content-scope-propagations+taint content*_12)
#f)
- sc_16
- (syntax-scopes s_132)
- (syntax-shifted-multi-scopes s_132)
- (syntax-mpi-shifts s_132))))
+ sc_19
+ (syntax-scopes s_156)
+ (syntax-shifted-multi-scopes s_156)
+ (syntax-mpi-shifts s_156))))
(if prop_8 (modified-content1.1 content_14 prop_8) content_14))
content*_12)))
(syntax2.1
@@ -9846,29 +9612,28 @@
(raise-argument-error 'struct-copy "syntax?" the-struct_15))))))))))
(define-values
(flip-scopes)
- (lambda (s_133 scs_7)
+ (lambda (s_157 scs_9)
(begin
- (let-values (((lst_51) scs_7))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_51)))
- ((letrec-values (((for-loop_49)
- (lambda (s_134 lst_52)
- (begin
- 'for-loop
- (if (pair? lst_52)
- (let-values (((sc_17) (unsafe-car lst_52)) ((rest_23) (unsafe-cdr lst_52)))
- (let-values (((s_135)
- (let-values (((s_136) s_134))
- (let-values (((s_137) (let-values () (flip-scope s_136 sc_17))))
- (values s_137)))))
- (if (not #f) (for-loop_49 s_135 rest_23) s_135)))
- s_134)))))
- for-loop_49)
- s_133
- lst_51))))))
+ (let-values (((s_158) (let-values (((s_159) s_157)) s_159)))
+ (let-values (((lst_57) scs_9))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_57))
+ ((letrec-values (((for-loop_71)
+ (lambda (s_160 lst_58)
+ (begin
+ 'for-loop
+ (if (pair? lst_58)
+ (let-values (((sc_20) (unsafe-car lst_58)) ((rest_25) (unsafe-cdr lst_58)))
+ (let-values (((s_161)
+ (let-values (((s_162) (flip-scope s_160 sc_20))) (values s_162))))
+ (if (not #f) (for-loop_71 s_161 rest_25) s_161)))
+ s_160)))))
+ for-loop_71)
+ s_158
+ lst_57)))))))
(define-values
(push-scope)
- (lambda (s_138 sms_6)
+ (lambda (s_163 sms_6)
(begin
(let-values (((smss/maybe-fallbacks59_0) #f))
(let-values (((prev-result_0) #f))
@@ -9877,34 +9642,29 @@
(begin
'push
(if (eq? smss/maybe-fallbacks59_0 smss/maybe-fallbacks_0)
- (let-values () prev-result_0)
- (let-values ()
- (let-values (((r_19)
- (let-values ()
- (let-values (((smss_12) (fallback-first smss/maybe-fallbacks_0)))
- (if (set-empty? smss_12)
- (let-values () (set-add smss_12 sms_6))
- (if (set-member? smss_12 sms_6)
- (let-values () smss/maybe-fallbacks_0)
- (let-values ()
- (fallback-push
- (set-add smss_12 sms_6)
- smss/maybe-fallbacks_0))))))))
- (begin
- (set! smss/maybe-fallbacks59_0 smss/maybe-fallbacks_0)
- (set! prev-result_0 r_19)
- r_19))))))))
- (let-values (((s_139) s_138)
- ((f_33) (lambda (tail?_30 x_29) (begin 'f x_29)))
+ prev-result_0
+ (let-values (((r_22)
+ (let-values (((smss_12) (fallback-first smss/maybe-fallbacks_0)))
+ (if (set-empty? smss_12)
+ (set-add smss_12 sms_6)
+ (if (set-member? smss_12 sms_6)
+ smss/maybe-fallbacks_0
+ (fallback-push (set-add smss_12 sms_6) smss/maybe-fallbacks_0))))))
+ (begin
+ (set! smss/maybe-fallbacks59_0 smss/maybe-fallbacks_0)
+ (set! prev-result_0 r_22)
+ r_22)))))))
+ (let-values (((s_164) s_163)
+ ((f_33) (lambda (tail?_31 x_33) (begin 'f x_33)))
((d->s_1)
- (lambda (s_140 d_4)
+ (lambda (s_165 d_4)
(begin
'd->s
- (let-values (((the-struct_16) s_140))
+ (let-values (((the-struct_16) s_165))
(if (syntax?$1 the-struct_16)
- (let-values (((content*60_0) (re-modify-content s_140 d_4))
+ (let-values (((content*60_0) (re-modify-content s_165 d_4))
((shifted-multi-scopes61_0)
- (push_0 (syntax-shifted-multi-scopes s_140))))
+ (push_0 (syntax-shifted-multi-scopes s_165))))
(syntax2.1
content*60_0
(syntax-scopes the-struct_16)
@@ -9915,79 +9675,76 @@
(syntax-inspector the-struct_16)))
(raise-argument-error 'struct-copy "syntax?" the-struct_16))))))
((s-e_1) syntax-e$1)
- ((seen_12) #f))
- ((letrec-values (((loop_66)
- (lambda (s_141)
+ ((seen_13) #f))
+ ((letrec-values (((loop_68)
+ (lambda (s_166)
(begin
'loop
- (let-values (((s_142) s_141)
+ (let-values (((s_167) s_166)
((f_34) f_33)
- ((gf_5)
- (lambda (tail?_31 v_71)
+ ((gf_6)
+ (lambda (tail?_32 v_98)
(begin
'gf
- (if (syntax?$1 v_71)
- (let-values () (d->s_1 v_71 (loop_66 (s-e_1 v_71))))
- (let-values () (f_33 tail?_31 v_71))))))
- ((seen_13) seen_12)
- ((known-pairs_10) #f))
- ((letrec-values (((loop_67)
- (lambda (tail?_32 s_143 prev-depth_6)
+ (if (syntax?$1 v_98)
+ (d->s_1 v_98 (loop_68 (s-e_1 v_98)))
+ (f_33 tail?_32 v_98)))))
+ ((seen_14) seen_13)
+ ((known-pairs_11) #f))
+ ((letrec-values (((loop_69)
+ (lambda (tail?_33 s_168 prev-depth_6)
(begin
'loop
(let-values (((depth_6) (fx+ 1 prev-depth_6)))
- (if (if seen_13 (fx> depth_6 32) #f)
- (let-values ()
- (datum-map-slow
- tail?_32
- s_143
- (lambda (tail?_33 s_144) (gf_5 tail?_33 s_144))
- seen_13
- known-pairs_10))
- (if (null? s_143)
- (let-values () (f_34 tail?_32 s_143))
- (if (pair? s_143)
- (let-values ()
- (f_34
- tail?_32
- (cons
- (loop_67 #f (car s_143) depth_6)
- (loop_67 1 (cdr s_143) depth_6))))
- (if (symbol? s_143)
- (let-values () (f_34 #f s_143))
- (if (boolean? s_143)
- (let-values () (f_34 #f s_143))
- (if (number? s_143)
- (let-values () (f_34 #f s_143))
- (if (let-values (((or-part_119)
- (vector? s_143)))
- (if or-part_119
- or-part_119
- (let-values (((or-part_120)
- (box? s_143)))
- (if or-part_120
- or-part_120
- (let-values (((or-part_121)
+ (if (if seen_14 (fx> depth_6 32) #f)
+ (datum-map-slow
+ tail?_33
+ s_168
+ (lambda (tail?_34 s_169) (gf_6 tail?_34 s_169))
+ seen_14
+ known-pairs_11)
+ (if (null? s_168)
+ (f_34 tail?_33 s_168)
+ (if (pair? s_168)
+ (f_34
+ tail?_33
+ (cons
+ (loop_69 #f (car s_168) depth_6)
+ (loop_69 1 (cdr s_168) depth_6)))
+ (if (symbol? s_168)
+ (f_34 #f s_168)
+ (if (boolean? s_168)
+ (f_34 #f s_168)
+ (if (number? s_168)
+ (f_34 #f s_168)
+ (if (let-values (((or-part_175)
+ (vector? s_168)))
+ (if or-part_175
+ or-part_175
+ (let-values (((or-part_176)
+ (box? s_168)))
+ (if or-part_176
+ or-part_176
+ (let-values (((or-part_177)
(prefab-struct-key
- s_143)))
- (if or-part_121
- or-part_121
- (hash? s_143)))))))
- (let-values ()
- (datum-map-slow
- tail?_32
- s_143
- (lambda (tail?_34 s_145)
- (gf_5 tail?_34 s_145))
- seen_13
- known-pairs_10))
- (let-values () (gf_5 #f s_143))))))))))))))
- loop_67)
+ s_168)))
+ (if or-part_177
+ or-part_177
+ (hash? s_168)))))))
+ (datum-map-slow
+ tail?_33
+ s_168
+ (lambda (tail?_35 s_170)
+ (gf_6 tail?_35 s_170))
+ seen_14
+ known-pairs_11)
+ (gf_6 #f s_168)))))))))))))
+ loop_69)
#f
- s_142
+ s_167
0))))))
- loop_66)
- s_139))))))))
+ loop_68)
+ s_164))))))))
(define-values
(struct:propagation
propagation12.1
@@ -9999,45 +9756,43 @@
propagation-add-mpi-shifts
propagation-inspector
propagation-taint)
- (let-values (((struct:_22 make-_22 ?_22 -ref_22 -set!_22)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'propagation
- #f
- 7
- 0
- #f
- (list
- (cons prop:sealed #t)
- (cons prop:authentic #t)
- (cons prop:propagation-set-taint (lambda (p_17 v_72) (propagation-set-taint p_17 v_72)))
- (cons prop:propagation-taint (lambda (p_18) (propagation-taint p_18)))
- (cons prop:propagation syntax-e$1))
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6)
- #f
- 'propagation)))))
+ (let-values (((struct:_28 make-_28 ?_28 -ref_28 -set!_28)
+ (make-struct-type
+ 'propagation
+ #f
+ 7
+ 0
+ #f
+ (list
+ (cons prop:sealed #t)
+ (cons prop:authentic #t)
+ (cons prop:propagation-set-taint (lambda (p_18 v_99) (propagation-set-taint p_18 v_99)))
+ (cons prop:propagation-taint (lambda (p_19) (propagation-taint p_19)))
+ (cons prop:propagation syntax-e$1))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 6)
+ #f
+ 'propagation)))
(values
- struct:_22
- make-_22
- ?_22
- (make-struct-field-accessor -ref_22 0 'prev-scs)
- (make-struct-field-accessor -ref_22 1 'prev-smss)
- (make-struct-field-accessor -ref_22 2 'scope-ops)
- (make-struct-field-accessor -ref_22 3 'prev-mss)
- (make-struct-field-accessor -ref_22 4 'add-mpi-shifts)
- (make-struct-field-accessor -ref_22 5 'inspector)
- (make-struct-field-accessor -ref_22 6 'taint))))
+ struct:_28
+ make-_28
+ ?_28
+ (make-struct-field-accessor -ref_28 0 'prev-scs)
+ (make-struct-field-accessor -ref_28 1 'prev-smss)
+ (make-struct-field-accessor -ref_28 2 'scope-ops)
+ (make-struct-field-accessor -ref_28 3 'prev-mss)
+ (make-struct-field-accessor -ref_28 4 'add-mpi-shifts)
+ (make-struct-field-accessor -ref_28 5 'inspector)
+ (make-struct-field-accessor -ref_28 6 'taint))))
(define-values
(propagation-add)
- (lambda (prop_9 sc_18 prev-scs_0 prev-smss_0 prev-mss_0)
+ (lambda (prop_9 sc_21 prev-scs_0 prev-smss_0 prev-mss_0)
(begin
(if (propagation? prop_9)
(let-values (((the-struct_17) prop_9))
(if (propagation? the-struct_17)
- (let-values (((scope-ops63_0) (hash-set (propagation-scope-ops prop_9) sc_18 'add)))
+ (let-values (((scope-ops63_0) (hash-set (propagation-scope-ops prop_9) sc_21 'add)))
(propagation12.1
(propagation-prev-scs the-struct_17)
(propagation-prev-smss the-struct_17)
@@ -10047,15 +9802,15 @@
(propagation-inspector the-struct_17)
(propagation-taint the-struct_17)))
(raise-argument-error 'struct-copy "propagation?" the-struct_17)))
- (propagation12.1 prev-scs_0 prev-smss_0 (hasheq sc_18 'add) prev-mss_0 #f #f prop_9)))))
+ (propagation12.1 prev-scs_0 prev-smss_0 (hasheq sc_21 'add) prev-mss_0 #f #f prop_9)))))
(define-values
(propagation-remove)
- (lambda (prop_10 sc_19 prev-scs_1 prev-smss_1 prev-mss_1)
+ (lambda (prop_10 sc_22 prev-scs_1 prev-smss_1 prev-mss_1)
(begin
(if (propagation? prop_10)
(let-values (((the-struct_18) prop_10))
(if (propagation? the-struct_18)
- (let-values (((scope-ops64_0) (hash-set (propagation-scope-ops prop_10) sc_19 'remove)))
+ (let-values (((scope-ops64_0) (hash-set (propagation-scope-ops prop_10) sc_22 'remove)))
(propagation12.1
(propagation-prev-scs the-struct_18)
(propagation-prev-smss the-struct_18)
@@ -10065,43 +9820,40 @@
(propagation-inspector the-struct_18)
(propagation-taint the-struct_18)))
(raise-argument-error 'struct-copy "propagation?" the-struct_18)))
- (propagation12.1 prev-scs_1 prev-smss_1 (hasheq sc_19 'remove) prev-mss_1 #f #f prop_10)))))
+ (propagation12.1 prev-scs_1 prev-smss_1 (hasheq sc_22 'remove) prev-mss_1 #f #f prop_10)))))
(define-values
(propagation-flip)
- (lambda (prop_11 sc_20 prev-scs_2 prev-smss_2 prev-mss_2)
+ (lambda (prop_11 sc_23 prev-scs_2 prev-smss_2 prev-mss_2)
(begin
(if (propagation? prop_11)
(let-values (((ops_0) (propagation-scope-ops prop_11)))
- (let-values (((current-op_0) (hash-ref ops_0 sc_20 #f)))
+ (let-values (((current-op_0) (hash-ref ops_0 sc_23 #f)))
(if (if (eq? current-op_0 'flip)
(if (= 1 (hash-count ops_0))
(if (not (propagation-inspector prop_11)) (not (propagation-add-mpi-shifts prop_11)) #f)
#f)
#f)
- (let-values () (propagation-taint prop_11))
- (let-values ()
- (let-values (((the-struct_19) prop_11))
- (if (propagation? the-struct_19)
- (let-values (((scope-ops65_0)
- (if (eq? current-op_0 'flip)
- (hash-remove ops_0 sc_20)
- (hash-set
- ops_0
- sc_20
- (let-values (((tmp_9) current-op_0))
- (if (equal? tmp_9 'add)
- (let-values () 'remove)
- (if (equal? tmp_9 'remove) (let-values () 'add) (let-values () 'flip))))))))
- (propagation12.1
- (propagation-prev-scs the-struct_19)
- (propagation-prev-smss the-struct_19)
- scope-ops65_0
- (propagation-prev-mss the-struct_19)
- (propagation-add-mpi-shifts the-struct_19)
- (propagation-inspector the-struct_19)
- (propagation-taint the-struct_19)))
- (raise-argument-error 'struct-copy "propagation?" the-struct_19)))))))
- (propagation12.1 prev-scs_2 prev-smss_2 (hasheq sc_20 'flip) prev-mss_2 #f #f prop_11)))))
+ (propagation-taint prop_11)
+ (let-values (((the-struct_19) prop_11))
+ (if (propagation? the-struct_19)
+ (let-values (((scope-ops65_0)
+ (if (eq? current-op_0 'flip)
+ (hash-remove ops_0 sc_23)
+ (hash-set
+ ops_0
+ sc_23
+ (let-values (((tmp_9) current-op_0))
+ (if (equal? tmp_9 'add) 'remove (if (equal? tmp_9 'remove) 'add 'flip)))))))
+ (propagation12.1
+ (propagation-prev-scs the-struct_19)
+ (propagation-prev-smss the-struct_19)
+ scope-ops65_0
+ (propagation-prev-mss the-struct_19)
+ (propagation-add-mpi-shifts the-struct_19)
+ (propagation-inspector the-struct_19)
+ (propagation-taint the-struct_19)))
+ (raise-argument-error 'struct-copy "propagation?" the-struct_19))))))
+ (propagation12.1 prev-scs_2 prev-smss_2 (hasheq sc_23 'flip) prev-mss_2 #f #f prop_11)))))
(define-values
(propagation-mpi-shift)
(lambda (prop_12 add_0 inspector_2 prev-scs_3 prev-smss_3 prev-mss_3)
@@ -10113,10 +9865,10 @@
(let-values (((base-add_0) (propagation-add-mpi-shifts prop_12)))
(if (if add_0 base-add_0 #f)
(lambda (mss_0) (begin 'add-mpi-shifts66 (add_0 (base-add_0 mss_0))))
- (let-values (((or-part_122) add_0)) (if or-part_122 or-part_122 base-add_0)))))
+ (let-values (((or-part_178) add_0)) (if or-part_178 or-part_178 base-add_0)))))
((inspector67_0)
- (let-values (((or-part_123) (propagation-inspector prop_12)))
- (if or-part_123 or-part_123 inspector_2))))
+ (let-values (((or-part_179) (propagation-inspector prop_12)))
+ (if or-part_179 or-part_179 inspector_2))))
(propagation12.1
(propagation-prev-scs the-struct_20)
(propagation-prev-smss the-struct_20)
@@ -10129,140 +9881,115 @@
(propagation12.1 prev-scs_3 prev-smss_3 '#hasheq() prev-mss_3 add_0 inspector_2 prop_12)))))
(define-values
(propagation-apply)
- (lambda (prop_13 scs_8 parent-s_0)
+ (lambda (prop_13 scs_10 parent-s_0)
(begin
- (if (eq? (propagation-prev-scs prop_13) scs_8)
- (let-values () (syntax-scopes parent-s_0))
- (let-values ()
- (let-values (((new-scs_0)
- (let-values (((ht_4) (propagation-scope-ops prop_13)))
+ (if (eq? (propagation-prev-scs prop_13) scs_10)
+ (syntax-scopes parent-s_0)
+ (let-values (((new-scs_0)
+ (let-values (((scs_11) (let-values (((scs_12) scs_10)) scs_12)))
+ (let-values (((ht_61) (propagation-scope-ops prop_13)))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-in-immutable-hash ht_4)))
- ((letrec-values (((for-loop_64)
- (lambda (scs_9 i_68)
+ (check-in-immutable-hash ht_61))
+ ((letrec-values (((for-loop_72)
+ (lambda (scs_13 i_92)
(begin
'for-loop
- (if i_68
- (let-values (((sc_21 op_3)
- (unsafe-immutable-hash-iterate-key+value ht_4 i_68)))
- (let-values (((scs_10)
- (let-values (((scs_11) scs_9))
- (if (not (shifted-multi-scope? sc_21))
- (let-values (((scs_12) scs_11))
- (let-values (((scs_13)
- (let-values ()
- (let-values (((tmp_10) op_3))
- (if (equal? tmp_10 'add)
- (let-values ()
- (set-add scs_12 sc_21))
- (if (equal?
- tmp_10
- 'remove)
- (let-values ()
- (set-remove
- scs_12
- sc_21))
- (let-values ()
- (set-flip
- scs_12
- sc_21))))))))
- (values scs_13)))
- scs_11))))
+ (if i_92
+ (let-values (((sc_24 op_3)
+ (unsafe-immutable-hash-iterate-key+value ht_61 i_92)))
+ (let-values (((scs_14)
+ (if (not (shifted-multi-scope? sc_24))
+ (let-values (((scs_15)
+ (let-values (((tmp_10) op_3))
+ (if (equal? tmp_10 'add)
+ (set-add scs_13 sc_24)
+ (if (equal? tmp_10 'remove)
+ (set-remove scs_13 sc_24)
+ (set-flip scs_13 sc_24))))))
+ (values scs_15))
+ scs_13)))
(if (not #f)
- (for-loop_64
- scs_10
- (unsafe-immutable-hash-iterate-next ht_4 i_68))
- scs_10)))
- scs_9)))))
- for-loop_64)
- scs_8
- (unsafe-immutable-hash-iterate-first ht_4))))))
- (if (set=? new-scs_0 (syntax-scopes parent-s_0))
- (syntax-scopes parent-s_0)
- (cache-or-reuse-set new-scs_0))))))))
+ (for-loop_72
+ scs_14
+ (unsafe-immutable-hash-iterate-next ht_61 i_92))
+ scs_14)))
+ scs_13)))))
+ for-loop_72)
+ scs_11
+ (unsafe-immutable-hash-iterate-first ht_61)))))))
+ (if (set=? new-scs_0 (syntax-scopes parent-s_0))
+ (syntax-scopes parent-s_0)
+ (cache-or-reuse-set new-scs_0)))))))
(define-values
(propagation-apply-shifted)
(lambda (prop_14 smss_13 parent-s_1)
(begin
(if (eq? (propagation-prev-smss prop_14) smss_13)
- (let-values () (syntax-shifted-multi-scopes parent-s_1))
- (let-values ()
- (let-values (((new-smss_0)
- (let-values (((ht_54) (propagation-scope-ops prop_14)))
+ (syntax-shifted-multi-scopes parent-s_1)
+ (let-values (((new-smss_0)
+ (let-values (((smss_14) (let-values (((smss_15) smss_13)) smss_15)))
+ (let-values (((ht_62) (propagation-scope-ops prop_14)))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-in-immutable-hash ht_54)))
- ((letrec-values (((for-loop_65)
- (lambda (smss_14 i_69)
+ (check-in-immutable-hash ht_62))
+ ((letrec-values (((for-loop_73)
+ (lambda (smss_16 i_93)
(begin
'for-loop
- (if i_69
+ (if i_93
(let-values (((sms_7 op_4)
- (unsafe-immutable-hash-iterate-key+value ht_54 i_69)))
- (let-values (((smss_15)
- (let-values (((smss_16) smss_14))
- (if (shifted-multi-scope? sms_7)
- (let-values (((smss_17) smss_16))
- (let-values (((smss_18)
- (let-values ()
- (fallback-update-first
- smss_17
- (lambda (smss_19)
- (let-values (((tmp_0)
- op_4))
- (if (equal? tmp_0 'add)
- (let-values ()
- (set-add
- smss_19
- sms_7))
- (if (equal?
- tmp_0
- 'remove)
- (let-values ()
- (set-remove
- smss_19
- sms_7))
- (let-values ()
- (set-flip
- smss_19
- sms_7))))))))))
- (values smss_18)))
- smss_16))))
+ (unsafe-immutable-hash-iterate-key+value ht_62 i_93)))
+ (let-values (((smss_17)
+ (if (shifted-multi-scope? sms_7)
+ (let-values (((smss_18)
+ (fallback-update-first
+ smss_16
+ (lambda (smss_19)
+ (let-values (((tmp_11) op_4))
+ (if (equal? tmp_11 'add)
+ (set-add smss_19 sms_7)
+ (if (equal? tmp_11 'remove)
+ (set-remove smss_19 sms_7)
+ (set-flip
+ smss_19
+ sms_7))))))))
+ (values smss_18))
+ smss_16)))
(if (not #f)
- (for-loop_65
- smss_15
- (unsafe-immutable-hash-iterate-next ht_54 i_69))
- smss_15)))
- smss_14)))))
- for-loop_65)
- smss_13
- (unsafe-immutable-hash-iterate-first ht_54))))))
- (let-values (((parent-smss_0) (syntax-shifted-multi-scopes parent-s_1)))
- (if (if (set? new-smss_0) (if (set? parent-smss_0) (set=? new-smss_0 parent-smss_0) #f) #f)
- parent-smss_0
- (cache-or-reuse-hash new-smss_0)))))))))
+ (for-loop_73
+ smss_17
+ (unsafe-immutable-hash-iterate-next ht_62 i_93))
+ smss_17)))
+ smss_16)))))
+ for-loop_73)
+ smss_14
+ (unsafe-immutable-hash-iterate-first ht_62)))))))
+ (let-values (((parent-smss_0) (syntax-shifted-multi-scopes parent-s_1)))
+ (if (if (set? new-smss_0) (if (set? parent-smss_0) (set=? new-smss_0 parent-smss_0) #f) #f)
+ parent-smss_0
+ (cache-or-reuse-hash new-smss_0))))))))
(define-values
(propagation-apply-mpi-shifts)
(lambda (prop_15 mss_1 parent-s_2)
(begin
(if (eq? (propagation-prev-mss prop_15) mss_1)
- (let-values () (syntax-mpi-shifts parent-s_2))
- (let-values () (let-values (((add_1) (propagation-add-mpi-shifts prop_15))) (if add_1 (add_1 mss_1) mss_1)))))))
+ (syntax-mpi-shifts parent-s_2)
+ (let-values (((add_1) (propagation-add-mpi-shifts prop_15))) (if add_1 (add_1 mss_1) mss_1))))))
(define-values
(propagation-apply-inspector)
- (lambda (prop_16 i_70)
- (begin (let-values (((or-part_124) i_70)) (if or-part_124 or-part_124 (propagation-inspector prop_16))))))
+ (lambda (prop_16 i_94)
+ (begin (let-values (((or-part_180) i_94)) (if or-part_180 or-part_180 (propagation-inspector prop_16))))))
(define-values
(propagation-set-taint)
- (lambda (prop_17 t_8)
+ (lambda (prop_17 t_7)
(begin
(if (propagation? prop_17)
(let-values (((the-struct_21) prop_17))
(if (propagation? the-struct_21)
- (let-values (((taint68_0) t_8))
+ (let-values (((taint68_0) t_7))
(propagation12.1
(propagation-prev-scs the-struct_21)
(propagation-prev-smss the-struct_21)
@@ -10272,493 +9999,440 @@
(propagation-inspector the-struct_21)
taint68_0))
(raise-argument-error 'struct-copy "propagation?" the-struct_21)))
- t_8))))
+ t_7))))
(define-values
(propagation-merge)
(lambda (content_15 prop_18 base-prop_0 prev-scs_4 prev-smss_4 prev-mss_4)
(begin
(if (not (datum-has-elements? content_15))
- (let-values () (if (propagation-taint prop_18) 'tainted base-prop_0))
+ (if (propagation-taint prop_18) 'tainted base-prop_0)
(if (not (propagation? base-prop_0))
- (let-values ()
- (if (if (eq? (propagation-prev-scs prop_18) prev-scs_4)
- (if (eq? (propagation-prev-smss prop_18) prev-smss_4)
- (if (eq? (propagation-prev-mss prop_18) prev-mss_4)
- (eq? (propagation-taint prop_18) base-prop_0)
- #f)
- #f)
+ (if (if (eq? (propagation-prev-scs prop_18) prev-scs_4)
+ (if (eq? (propagation-prev-smss prop_18) prev-smss_4)
+ (if (eq? (propagation-prev-mss prop_18) prev-mss_4) (eq? (propagation-taint prop_18) base-prop_0) #f)
#f)
- (let-values () prop_18)
- (let-values ()
- (propagation12.1
- prev-scs_4
- prev-smss_4
- (propagation-scope-ops prop_18)
- prev-mss_4
- (propagation-add-mpi-shifts prop_18)
- (propagation-inspector prop_18)
- (if (propagation-taint prop_18) 'tainted/need-propagate base-prop_0)))))
- (let-values ()
- (let-values (((new-ops_0)
- (let-values (((ht_55) (propagation-scope-ops prop_18)))
+ #f)
+ prop_18
+ (propagation12.1
+ prev-scs_4
+ prev-smss_4
+ (propagation-scope-ops prop_18)
+ prev-mss_4
+ (propagation-add-mpi-shifts prop_18)
+ (propagation-inspector prop_18)
+ (if (propagation-taint prop_18) 'tainted/need-propagate base-prop_0)))
+ (let-values (((new-ops_0)
+ (let-values (((ops_1) (let-values (((ops_2) (propagation-scope-ops base-prop_0))) ops_2)))
+ (let-values (((ht_63) (propagation-scope-ops prop_18)))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-in-immutable-hash ht_55)))
- ((letrec-values (((for-loop_66)
- (lambda (ops_1 i_71)
+ (check-in-immutable-hash ht_63))
+ ((letrec-values (((for-loop_74)
+ (lambda (ops_3 i_95)
(begin
'for-loop
- (if i_71
- (let-values (((sc_22 op_5)
+ (if i_95
+ (let-values (((sc_25 op_5)
(unsafe-immutable-hash-iterate-key+value
- ht_55
- i_71)))
- (let-values (((ops_2)
- (let-values (((ops_3) ops_1))
- (let-values (((ops_4)
- (let-values ()
- (let-values (((tmp_11) op_5))
- (if (equal? tmp_11 'add)
- (let-values ()
- (hash-set
- ops_3
- sc_22
- 'add))
- (if (equal? tmp_11 'remove)
- (let-values ()
+ ht_63
+ i_95)))
+ (let-values (((ops_4)
+ (let-values (((ops_5)
+ (let-values (((tmp_12) op_5))
+ (if (equal? tmp_12 'add)
+ (hash-set ops_3 sc_25 'add)
+ (if (equal? tmp_12 'remove)
+ (hash-set ops_3 sc_25 'remove)
+ (let-values (((current-op_1)
+ (hash-ref
+ ops_3
+ sc_25
+ #f)))
+ (let-values (((tmp_13)
+ current-op_1))
+ (if (equal? tmp_13 'add)
(hash-set
ops_3
- sc_22
- 'remove))
- (let-values ()
- (let-values (((current-op_1)
- (hash-ref
- ops_3
- sc_22
- #f)))
- (let-values (((tmp_12)
- current-op_1))
- (if (equal?
- tmp_12
- 'add)
- (let-values ()
- (hash-set
- ops_3
- sc_22
- 'remove))
- (if (equal?
- tmp_12
- 'remove)
- (let-values ()
- (hash-set
- ops_3
- sc_22
- 'add))
- (if (equal?
- tmp_12
- 'flip)
- (let-values ()
- (hash-remove
- ops_3
- sc_22))
- (let-values ()
- (hash-set
- ops_3
- sc_22
- 'flip))))))))))))))
- (values ops_4)))))
+ sc_25
+ 'remove)
+ (if (equal?
+ tmp_13
+ 'remove)
+ (hash-set
+ ops_3
+ sc_25
+ 'add)
+ (if (equal?
+ tmp_13
+ 'flip)
+ (hash-remove
+ ops_3
+ sc_25)
+ (hash-set
+ ops_3
+ sc_25
+ 'flip)))))))))))
+ (values ops_5))))
(if (not #f)
- (for-loop_66
- ops_2
- (unsafe-immutable-hash-iterate-next ht_55 i_71))
- ops_2)))
- ops_1)))))
- for-loop_66)
- (propagation-scope-ops base-prop_0)
- (unsafe-immutable-hash-iterate-first ht_55))))))
- (let-values (((add_2) (propagation-add-mpi-shifts prop_18)))
- (let-values (((base-add_1) (propagation-add-mpi-shifts base-prop_0)))
- (let-values (((new-taint_1)
- (if (let-values (((or-part_125) (propagation-taint prop_18)))
- (if or-part_125 or-part_125 (propagation-taint base-prop_0)))
- 'tainted/need-propagate
- (propagation-taint base-prop_0))))
- (if (if (zero? (hash-count new-ops_0))
- (if (not add_2)
- (if (not base-add_1)
- (if (not (propagation-inspector prop_18)) (not (propagation-inspector base-prop_0)) #f)
- #f)
+ (for-loop_74
+ ops_4
+ (unsafe-immutable-hash-iterate-next ht_63 i_95))
+ ops_4)))
+ ops_3)))))
+ for-loop_74)
+ ops_1
+ (unsafe-immutable-hash-iterate-first ht_63)))))))
+ (let-values (((add_2) (propagation-add-mpi-shifts prop_18)))
+ (let-values (((base-add_1) (propagation-add-mpi-shifts base-prop_0)))
+ (let-values (((new-taint_1)
+ (if (let-values (((or-part_181) (propagation-taint prop_18)))
+ (if or-part_181 or-part_181 (propagation-taint base-prop_0)))
+ 'tainted/need-propagate
+ (propagation-taint base-prop_0))))
+ (if (if (zero? (hash-count new-ops_0))
+ (if (not add_2)
+ (if (not base-add_1)
+ (if (not (propagation-inspector prop_18)) (not (propagation-inspector base-prop_0)) #f)
#f)
#f)
- new-taint_1
- (let-values (((the-struct_22) base-prop_0))
- (if (propagation? the-struct_22)
- (let-values (((scope-ops69_0) new-ops_0)
- ((add-mpi-shifts70_0)
- (if (if add_2 base-add_1 #f)
- (lambda (mss_2) (begin 'add-mpi-shifts70 (add_2 (base-add_1 mss_2))))
- (let-values (((or-part_126) add_2)) (if or-part_126 or-part_126 base-add_1))))
- ((inspector71_0)
- (let-values (((or-part_127) (propagation-inspector base-prop_0)))
- (if or-part_127 or-part_127 (propagation-inspector prop_18))))
- ((taint72_0) new-taint_1))
- (propagation12.1
- (propagation-prev-scs the-struct_22)
- (propagation-prev-smss the-struct_22)
- scope-ops69_0
- (propagation-prev-mss the-struct_22)
- add-mpi-shifts70_0
- inspector71_0
- taint72_0))
- (raise-argument-error 'struct-copy "propagation?" the-struct_22))))))))))))))
+ #f)
+ new-taint_1
+ (let-values (((the-struct_22) base-prop_0))
+ (if (propagation? the-struct_22)
+ (let-values (((scope-ops69_0) new-ops_0)
+ ((add-mpi-shifts70_0)
+ (if (if add_2 base-add_1 #f)
+ (lambda (mss_2) (begin 'add-mpi-shifts70 (add_2 (base-add_1 mss_2))))
+ (let-values (((or-part_182) add_2)) (if or-part_182 or-part_182 base-add_1))))
+ ((inspector71_0)
+ (let-values (((or-part_183) (propagation-inspector base-prop_0)))
+ (if or-part_183 or-part_183 (propagation-inspector prop_18))))
+ ((taint72_0) new-taint_1))
+ (propagation12.1
+ (propagation-prev-scs the-struct_22)
+ (propagation-prev-smss the-struct_22)
+ scope-ops69_0
+ (propagation-prev-mss the-struct_22)
+ add-mpi-shifts70_0
+ inspector71_0
+ taint72_0))
+ (raise-argument-error 'struct-copy "propagation?" the-struct_22)))))))))))))
(define-values
(shift-multi-scope)
(lambda (sms_8 delta_1)
(begin
(if (zero-phase? delta_1)
- (let-values () sms_8)
+ sms_8
(if (label-phase? delta_1)
- (let-values ()
- (if (shifted-to-label-phase? (shifted-multi-scope-phase sms_8))
- (let-values () #f)
- (let-values ()
- (intern-shifted-multi-scope
- (shifted-to-label-phase6.1 (phase- 0 (shifted-multi-scope-phase sms_8)))
- (shifted-multi-scope-multi-scope sms_8)))))
(if (shifted-to-label-phase? (shifted-multi-scope-phase sms_8))
- (let-values () sms_8)
- (let-values ()
- (intern-shifted-multi-scope
- (phase+ delta_1 (shifted-multi-scope-phase sms_8))
- (shifted-multi-scope-multi-scope sms_8)))))))))
+ #f
+ (intern-shifted-multi-scope
+ (shifted-to-label-phase6.1 (phase- 0 (shifted-multi-scope-phase sms_8)))
+ (shifted-multi-scope-multi-scope sms_8)))
+ (if (shifted-to-label-phase? (shifted-multi-scope-phase sms_8))
+ (let-values (((from_0) (shifted-to-label-phase-from (shifted-multi-scope-phase sms_8))))
+ (intern-shifted-multi-scope
+ (shifted-to-label-phase6.1 (phase+ delta_1 from_0))
+ (shifted-multi-scope-multi-scope sms_8)))
+ (intern-shifted-multi-scope
+ (phase+ delta_1 (shifted-multi-scope-phase sms_8))
+ (shifted-multi-scope-multi-scope sms_8))))))))
(define-values
(syntax-shift-phase-level$1)
- (lambda (s_146 phase_14)
+ (lambda (s_171 phase_19)
(begin
'syntax-shift-phase-level
- (if (eqv? phase_14 0)
- s_146
- (let-values ()
- (let-values (((smss73_0) #f))
- (let-values (((prev-result_1) #f))
- (let-values (((shift-all_0)
- (lambda (smss_20)
+ (if (eqv? phase_19 0)
+ s_171
+ (let-values (((smss73_0) #f))
+ (let-values (((prev-result_1) #f))
+ (let-values (((shift-all_0)
+ (lambda (smss_20)
+ (begin
+ 'shift-all
+ (if (eq? smss73_0 smss_20)
+ prev-result_1
+ (let-values (((r_23)
+ (fallback-map
+ smss_20
+ (lambda (smss_21)
+ (let-values (((table_84)
+ (let-values (((table_85) '#hasheq())) table_85)))
+ (let-values (((ht_64) smss_21))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_64))
+ ((letrec-values (((for-loop_75)
+ (lambda (table_86 i_96)
+ (begin
+ 'for-loop
+ (if i_96
+ (let-values (((sms_9)
+ (unsafe-immutable-hash-iterate-key
+ ht_64
+ i_96)))
+ (let-values (((table_87)
+ (let-values (((id*_2)
+ (shift-multi-scope
+ sms_9
+ phase_19)))
+ ((letrec-values (((for-loop_76)
+ (lambda (table_88)
+ (begin
+ 'for-loop
+ (let-values (((new-sms_0)
+ id*_2))
+ (let-values (((table_89)
+ (if new-sms_0
+ (let-values (((table_90)
+ (let-values (((key_35
+ val_18)
+ (values
+ new-sms_0
+ #t)))
+ (hash-set
+ table_88
+ key_35
+ val_18))))
+ (values
+ table_90))
+ table_88)))
+ table_89))))))
+ for-loop_76)
+ table_86))))
+ (if (not #f)
+ (for-loop_75
+ table_87
+ (unsafe-immutable-hash-iterate-next
+ ht_64
+ i_96))
+ table_87)))
+ table_86)))))
+ for-loop_75)
+ table_84
+ (unsafe-immutable-hash-iterate-first ht_64)))))))))
+ (begin (set! smss73_0 smss_20) (set! prev-result_1 r_23) r_23)))))))
+ (let-values (((s_172) s_171)
+ ((f_35) (lambda (tail?_36 d_5) (begin 'f d_5)))
+ ((d->s_2)
+ (lambda (s_173 d_6)
(begin
- 'shift-all
- (if (eq? smss73_0 smss_20)
- (let-values () prev-result_1)
- (let-values ()
- (let-values (((r_20)
- (let-values ()
- (fallback-map
- smss_20
- (lambda (smss_21)
- (let-values (((ht_56) smss_21))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_56)))
- ((letrec-values (((for-loop_67)
- (lambda (table_70 i_72)
- (begin
- 'for-loop
- (if i_72
- (let-values (((sms_9)
- (unsafe-immutable-hash-iterate-key
- ht_56
- i_72)))
- (let-values (((table_71)
- (let-values (((table_72)
- table_70))
- (let-values (((id*_2)
- (shift-multi-scope
- sms_9
- phase_14)))
- (begin
- #t
- ((letrec-values (((for-loop_68)
- (lambda (table_73)
- (begin
- 'for-loop
- (let-values (((new-sms_0)
- id*_2))
- (let-values (((table_74)
- (let-values (((table_75)
- table_73))
- (let-values (((table_76)
- table_75))
- (if new-sms_0
- (let-values (((table_77)
- table_76))
- (let-values (((table_78)
- (let-values ()
- (let-values (((key_32
- val_16)
- (let-values ()
- (values
- (let-values ()
- new-sms_0)
- #t))))
- (hash-set
- table_77
- key_32
- val_16)))))
- (values
- table_78)))
- table_76)))))
- table_74))))))
- for-loop_68)
- table_72))))))
- (if (not #f)
- (for-loop_67
- table_71
- (unsafe-immutable-hash-iterate-next
- ht_56
- i_72))
- table_71)))
- table_70)))))
- for-loop_67)
- '#hasheq()
- (unsafe-immutable-hash-iterate-first ht_56)))))))))
- (begin (set! smss73_0 smss_20) (set! prev-result_1 r_20) r_20))))))))
- (let-values (((s_147) s_146)
- ((f_35) (lambda (tail?_35 d_5) (begin 'f d_5)))
- ((d->s_2)
- (lambda (s_148 d_6)
- (begin
- 'd->s
- (let-values (((the-struct_23) s_148))
- (if (syntax?$1 the-struct_23)
- (let-values (((content*74_0) (re-modify-content s_148 d_6))
- ((shifted-multi-scopes75_0)
- (shift-all_0 (syntax-shifted-multi-scopes s_148))))
- (syntax2.1
- content*74_0
- (syntax-scopes the-struct_23)
- shifted-multi-scopes75_0
- (syntax-mpi-shifts the-struct_23)
- (syntax-srcloc$1 the-struct_23)
- (syntax-props the-struct_23)
- (syntax-inspector the-struct_23)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_23))))))
- ((s-e_2) syntax-e$1)
- ((seen_14) #f))
- ((letrec-values (((loop_68)
- (lambda (s_149)
- (begin
- 'loop
- (let-values (((s_150) s_149)
- ((f_36) f_35)
- ((gf_6)
- (lambda (tail?_36 v_73)
- (begin
- 'gf
- (if (syntax?$1 v_73)
- (let-values () (d->s_2 v_73 (loop_68 (s-e_2 v_73))))
- (let-values () (f_35 tail?_36 v_73))))))
- ((seen_15) seen_14)
- ((known-pairs_11) #f))
- ((letrec-values (((loop_69)
- (lambda (tail?_37 s_151 prev-depth_7)
- (begin
- 'loop
- (let-values (((depth_7) (fx+ 1 prev-depth_7)))
- (if (if seen_15 (fx> depth_7 32) #f)
- (let-values ()
- (datum-map-slow
- tail?_37
- s_151
- (lambda (tail?_38 s_152) (gf_6 tail?_38 s_152))
- seen_15
- known-pairs_11))
- (if (null? s_151)
- (let-values () (f_36 tail?_37 s_151))
- (if (pair? s_151)
- (let-values ()
- (f_36
- tail?_37
- (cons
- (loop_69 #f (car s_151) depth_7)
- (loop_69 1 (cdr s_151) depth_7))))
- (if (symbol? s_151)
- (let-values () (f_36 #f s_151))
- (if (boolean? s_151)
- (let-values () (f_36 #f s_151))
- (if (number? s_151)
- (let-values () (f_36 #f s_151))
- (if (let-values (((or-part_128)
- (vector? s_151)))
- (if or-part_128
- or-part_128
- (let-values (((or-part_129)
- (box? s_151)))
- (if or-part_129
- or-part_129
- (let-values (((or-part_130)
- (prefab-struct-key
- s_151)))
- (if or-part_130
- or-part_130
- (hash? s_151)))))))
- (let-values ()
- (datum-map-slow
- tail?_37
- s_151
- (lambda (tail?_39 s_153)
- (gf_6 tail?_39 s_153))
- seen_15
- known-pairs_11))
- (let-values ()
- (gf_6 #f s_151))))))))))))))
- loop_69)
- #f
- s_150
- 0))))))
- loop_68)
- s_147))))))))))
+ 'd->s
+ (let-values (((the-struct_23) s_173))
+ (if (syntax?$1 the-struct_23)
+ (let-values (((content*74_0) (re-modify-content s_173 d_6))
+ ((shifted-multi-scopes75_0)
+ (shift-all_0 (syntax-shifted-multi-scopes s_173))))
+ (syntax2.1
+ content*74_0
+ (syntax-scopes the-struct_23)
+ shifted-multi-scopes75_0
+ (syntax-mpi-shifts the-struct_23)
+ (syntax-srcloc$1 the-struct_23)
+ (syntax-props the-struct_23)
+ (syntax-inspector the-struct_23)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_23))))))
+ ((s-e_2) syntax-e$1)
+ ((seen_15) #f))
+ ((letrec-values (((loop_70)
+ (lambda (s_174)
+ (begin
+ 'loop
+ (let-values (((s_175) s_174)
+ ((f_36) f_35)
+ ((gf_7)
+ (lambda (tail?_37 v_100)
+ (begin
+ 'gf
+ (if (syntax?$1 v_100)
+ (d->s_2 v_100 (loop_70 (s-e_2 v_100)))
+ (f_35 tail?_37 v_100)))))
+ ((seen_16) seen_15)
+ ((known-pairs_12) #f))
+ ((letrec-values (((loop_71)
+ (lambda (tail?_38 s_176 prev-depth_7)
+ (begin
+ 'loop
+ (let-values (((depth_7) (fx+ 1 prev-depth_7)))
+ (if (if seen_16 (fx> depth_7 32) #f)
+ (datum-map-slow
+ tail?_38
+ s_176
+ (lambda (tail?_39 s_177) (gf_7 tail?_39 s_177))
+ seen_16
+ known-pairs_12)
+ (if (null? s_176)
+ (f_36 tail?_38 s_176)
+ (if (pair? s_176)
+ (f_36
+ tail?_38
+ (cons
+ (loop_71 #f (car s_176) depth_7)
+ (loop_71 1 (cdr s_176) depth_7)))
+ (if (symbol? s_176)
+ (f_36 #f s_176)
+ (if (boolean? s_176)
+ (f_36 #f s_176)
+ (if (number? s_176)
+ (f_36 #f s_176)
+ (if (let-values (((or-part_184)
+ (vector? s_176)))
+ (if or-part_184
+ or-part_184
+ (let-values (((or-part_185)
+ (box? s_176)))
+ (if or-part_185
+ or-part_185
+ (let-values (((or-part_186)
+ (prefab-struct-key
+ s_176)))
+ (if or-part_186
+ or-part_186
+ (hash? s_176)))))))
+ (datum-map-slow
+ tail?_38
+ s_176
+ (lambda (tail?_40 s_178)
+ (gf_7 tail?_40 s_178))
+ seen_16
+ known-pairs_12)
+ (gf_7 #f s_176)))))))))))))
+ loop_71)
+ #f
+ s_175
+ 0))))))
+ loop_70)
+ s_172)))))))))
(define-values
(shifted-multi-scope-add-binding-phases)
(lambda (sms_10 phases_0)
(begin
(let-values (((ms_3) (shifted-multi-scope-multi-scope sms_10)))
- (let-values (((phase_15) (shifted-multi-scope-phase sms_10)))
- (if (shifted-to-label-phase? phase_15)
- (let-values () (set-add phases_0 #f))
- (let-values ()
- (let-values (((ht_57) (unbox (multi-scope-scopes ms_3))))
+ (let-values (((phase_20) (shifted-multi-scope-phase sms_10)))
+ (if (shifted-to-label-phase? phase_20)
+ (set-add phases_0 #f)
+ (let-values (((phases_1) (let-values (((phases_2) phases_0)) phases_2)))
+ (let-values (((ht_65) (unbox (multi-scope-scopes ms_3))))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash-keys ht_57)))
- ((letrec-values (((for-loop_69)
- (lambda (phases_1 i_73)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash-keys ht_65))
+ ((letrec-values (((for-loop_77)
+ (lambda (phases_3 i_97)
(begin
'for-loop
- (if i_73
- (let-values (((ph_0) (hash-iterate-key ht_57 i_73)))
- (let-values (((phases_2)
- (let-values (((phases_3) phases_1))
- (let-values (((phases_4)
- (let-values ()
- (if (label-phase? ph_0)
- (set-add phases_3 #f)
- (set-add
- phases_3
- (phase- phase_15 ph_0))))))
- (values phases_4)))))
+ (if i_97
+ (let-values (((ph_0) (hash-iterate-key ht_65 i_97)))
+ (let-values (((phases_4)
+ (let-values (((phases_5)
+ (if (label-phase? ph_0)
+ (set-add phases_3 #f)
+ (set-add phases_3 (phase- phase_20 ph_0)))))
+ (values phases_5))))
(if (not #f)
- (for-loop_69 phases_2 (hash-iterate-next ht_57 i_73))
- phases_2)))
- phases_1)))))
- for-loop_69)
- phases_0
- (hash-iterate-first ht_57)))))))))))
+ (for-loop_77 phases_4 (hash-iterate-next ht_65 i_97))
+ phases_4)))
+ phases_3)))))
+ for-loop_77)
+ phases_1
+ (hash-iterate-first ht_65)))))))))))
(define-values
(syntax-swap-scopes)
- (lambda (s_154 src-scopes_0 dest-scopes_0)
+ (lambda (s_179 src-scopes_0 dest-scopes_0)
(begin
(if (equal? src-scopes_0 dest-scopes_0)
- s_154
+ s_179
(let-values (((src-smss_0 src-scs_0)
(set-partition
- (let-values (((ht_58) src-scopes_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_58)))
- ((letrec-values (((for-loop_70)
- (lambda (table_79 i_74)
- (begin
- 'for-loop
- (if i_74
- (let-values (((sc_23)
- (unsafe-immutable-hash-iterate-key ht_58 i_74)))
- (let-values (((table_80)
- (let-values (((table_81) table_79))
- (let-values (((table_82)
- (let-values ()
- (let-values (((key_33 val_17)
- (let-values ()
- (values
- (let-values ()
- (generalize-scope
- sc_23))
- #t))))
- (hash-set
- table_81
- key_33
- val_17)))))
- (values table_82)))))
- (if (not #f)
- (for-loop_70
- table_80
- (unsafe-immutable-hash-iterate-next ht_58 i_74))
- table_80)))
- table_79)))))
- for-loop_70)
- '#hasheq()
- (unsafe-immutable-hash-iterate-first ht_58))))
+ (let-values (((table_91) (let-values (((table_92) '#hasheq())) table_92)))
+ (let-values (((ht_66) src-scopes_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_66))
+ ((letrec-values (((for-loop_78)
+ (lambda (table_93 i_98)
+ (begin
+ 'for-loop
+ (if i_98
+ (let-values (((sc_26)
+ (unsafe-immutable-hash-iterate-key ht_66 i_98)))
+ (let-values (((table_94)
+ (let-values (((table_95)
+ (let-values (((key_36 val_19)
+ (values
+ (generalize-scope
+ sc_26)
+ #t)))
+ (hash-set
+ table_93
+ key_36
+ val_19))))
+ (values table_95))))
+ (if (not #f)
+ (for-loop_78
+ table_94
+ (unsafe-immutable-hash-iterate-next ht_66 i_98))
+ table_94)))
+ table_93)))))
+ for-loop_78)
+ table_91
+ (unsafe-immutable-hash-iterate-first ht_66)))))
shifted-multi-scope?
(seteq)
(seteq)))
((dest-smss_0 dest-scs_0)
(set-partition
- (let-values (((ht_59) dest-scopes_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_59)))
- ((letrec-values (((for-loop_71)
- (lambda (table_83 i_75)
- (begin
- 'for-loop
- (if i_75
- (let-values (((sc_24)
- (unsafe-immutable-hash-iterate-key ht_59 i_75)))
- (let-values (((table_84)
- (let-values (((table_85) table_83))
- (let-values (((table_86)
- (let-values ()
- (let-values (((key_34 val_18)
- (let-values ()
- (values
- (let-values ()
- (generalize-scope
- sc_24))
- #t))))
- (hash-set
- table_85
- key_34
- val_18)))))
- (values table_86)))))
- (if (not #f)
- (for-loop_71
- table_84
- (unsafe-immutable-hash-iterate-next ht_59 i_75))
- table_84)))
- table_83)))))
- for-loop_71)
- '#hasheq()
- (unsafe-immutable-hash-iterate-first ht_59))))
+ (let-values (((table_96) (let-values (((table_97) '#hasheq())) table_97)))
+ (let-values (((ht_67) dest-scopes_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_67))
+ ((letrec-values (((for-loop_79)
+ (lambda (table_98 i_99)
+ (begin
+ 'for-loop
+ (if i_99
+ (let-values (((sc_27)
+ (unsafe-immutable-hash-iterate-key ht_67 i_99)))
+ (let-values (((table_99)
+ (let-values (((table_100)
+ (let-values (((key_37 val_20)
+ (values
+ (generalize-scope
+ sc_27)
+ #t)))
+ (hash-set
+ table_98
+ key_37
+ val_20))))
+ (values table_100))))
+ (if (not #f)
+ (for-loop_79
+ table_99
+ (unsafe-immutable-hash-iterate-next ht_67 i_99))
+ table_99)))
+ table_98)))))
+ for-loop_79)
+ table_96
+ (unsafe-immutable-hash-iterate-first ht_67)))))
shifted-multi-scope?
(seteq)
(seteq))))
(let-values (((scs76_0) #f))
(let-values (((prev-result_2) #f))
(let-values (((swap-scs_0)
- (lambda (scs_14)
+ (lambda (scs_16)
(begin
'swap-scs
- (if (eq? scs76_0 scs_14)
- (let-values () prev-result_2)
- (let-values ()
- (let-values (((r_21)
- (let-values ()
- (if (subset? src-scs_0 scs_14)
- (set-union (set-subtract scs_14 src-scs_0) dest-scs_0)
- scs_14))))
- (begin (set! scs76_0 scs_14) (set! prev-result_2 r_21) r_21))))))))
+ (if (eq? scs76_0 scs_16)
+ prev-result_2
+ (let-values (((r_24)
+ (if (subset? src-scs_0 scs_16)
+ (set-union (set-subtract scs_16 src-scs_0) dest-scs_0)
+ scs_16)))
+ (begin (set! scs76_0 scs_16) (set! prev-result_2 r_24) r_24)))))))
(let-values (((smss77_0) #f))
(let-values (((prev-result_3) #f))
(let-values (((swap-smss_0)
@@ -10766,29 +10440,27 @@
(begin
'swap-smss
(if (eq? smss77_0 smss_22)
- (let-values () prev-result_3)
- (let-values ()
- (let-values (((r_22)
- (let-values ()
- (fallback-update-first
- smss_22
- (lambda (smss_23)
- (if (subset? src-smss_0 smss_23)
- (set-union (set-subtract smss_23 src-smss_0) dest-smss_0)
- smss_23))))))
- (begin (set! smss77_0 smss_22) (set! prev-result_3 r_22) r_22))))))))
- (let-values (((s_155) s_154)
- ((f_37) (lambda (tail?_40 d_7) (begin 'f d_7)))
+ prev-result_3
+ (let-values (((r_25)
+ (fallback-update-first
+ smss_22
+ (lambda (smss_23)
+ (if (subset? src-smss_0 smss_23)
+ (set-union (set-subtract smss_23 src-smss_0) dest-smss_0)
+ smss_23)))))
+ (begin (set! smss77_0 smss_22) (set! prev-result_3 r_25) r_25)))))))
+ (let-values (((s_180) s_179)
+ ((f_37) (lambda (tail?_41 d_7) (begin 'f d_7)))
((d->s_3)
- (lambda (s_156 d_8)
+ (lambda (s_181 d_8)
(begin
'd->s
- (let-values (((the-struct_24) s_156))
+ (let-values (((the-struct_24) s_181))
(if (syntax?$1 the-struct_24)
- (let-values (((content*78_0) (re-modify-content s_156 d_8))
- ((scopes79_0) (swap-scs_0 (syntax-scopes s_156)))
+ (let-values (((content*78_0) (re-modify-content s_181 d_8))
+ ((scopes79_0) (swap-scs_0 (syntax-scopes s_181)))
((shifted-multi-scopes80_0)
- (swap-smss_0 (syntax-shifted-multi-scopes s_156))))
+ (swap-smss_0 (syntax-shifted-multi-scopes s_181))))
(syntax2.1
content*78_0
scopes79_0
@@ -10799,179 +10471,166 @@
(syntax-inspector the-struct_24)))
(raise-argument-error 'struct-copy "syntax?" the-struct_24))))))
((s-e_3) syntax-e$1)
- ((seen_16) #f))
- ((letrec-values (((loop_70)
- (lambda (s_157)
+ ((seen_17) #f))
+ ((letrec-values (((loop_72)
+ (lambda (s_182)
(begin
'loop
- (let-values (((s_158) s_157)
+ (let-values (((s_183) s_182)
((f_38) f_37)
- ((gf_7)
- (lambda (tail?_41 v_74)
+ ((gf_8)
+ (lambda (tail?_42 v_101)
(begin
'gf
- (if (syntax?$1 v_74)
- (let-values () (d->s_3 v_74 (loop_70 (s-e_3 v_74))))
- (let-values () (f_37 tail?_41 v_74))))))
- ((seen_17) seen_16)
- ((known-pairs_12) #f))
- ((letrec-values (((loop_71)
- (lambda (tail?_42 s_159 prev-depth_8)
+ (if (syntax?$1 v_101)
+ (d->s_3 v_101 (loop_72 (s-e_3 v_101)))
+ (f_37 tail?_42 v_101)))))
+ ((seen_18) seen_17)
+ ((known-pairs_13) #f))
+ ((letrec-values (((loop_73)
+ (lambda (tail?_43 s_184 prev-depth_8)
(begin
'loop
(let-values (((depth_8) (fx+ 1 prev-depth_8)))
- (if (if seen_17 (fx> depth_8 32) #f)
- (let-values ()
- (datum-map-slow
- tail?_42
- s_159
- (lambda (tail?_43 s_160)
- (gf_7 tail?_43 s_160))
- seen_17
- known-pairs_12))
- (if (null? s_159)
- (let-values () (f_38 tail?_42 s_159))
- (if (pair? s_159)
- (let-values ()
- (f_38
- tail?_42
- (cons
- (loop_71 #f (car s_159) depth_8)
- (loop_71 1 (cdr s_159) depth_8))))
- (if (symbol? s_159)
- (let-values () (f_38 #f s_159))
- (if (boolean? s_159)
- (let-values () (f_38 #f s_159))
- (if (number? s_159)
- (let-values () (f_38 #f s_159))
- (if (let-values (((or-part_131)
- (vector? s_159)))
- (if or-part_131
- or-part_131
- (let-values (((or-part_132)
- (box? s_159)))
- (if or-part_132
- or-part_132
- (let-values (((or-part_133)
+ (if (if seen_18 (fx> depth_8 32) #f)
+ (datum-map-slow
+ tail?_43
+ s_184
+ (lambda (tail?_44 s_185)
+ (gf_8 tail?_44 s_185))
+ seen_18
+ known-pairs_13)
+ (if (null? s_184)
+ (f_38 tail?_43 s_184)
+ (if (pair? s_184)
+ (f_38
+ tail?_43
+ (cons
+ (loop_73 #f (car s_184) depth_8)
+ (loop_73 1 (cdr s_184) depth_8)))
+ (if (symbol? s_184)
+ (f_38 #f s_184)
+ (if (boolean? s_184)
+ (f_38 #f s_184)
+ (if (number? s_184)
+ (f_38 #f s_184)
+ (if (let-values (((or-part_187)
+ (vector? s_184)))
+ (if or-part_187
+ or-part_187
+ (let-values (((or-part_188)
+ (box? s_184)))
+ (if or-part_188
+ or-part_188
+ (let-values (((or-part_189)
(prefab-struct-key
- s_159)))
- (if or-part_133
- or-part_133
- (hash? s_159)))))))
- (let-values ()
- (datum-map-slow
- tail?_42
- s_159
- (lambda (tail?_44 s_161)
- (gf_7 tail?_44 s_161))
- seen_17
- known-pairs_12))
- (let-values ()
- (gf_7 #f s_159))))))))))))))
- loop_71)
+ s_184)))
+ (if or-part_189
+ or-part_189
+ (hash? s_184)))))))
+ (datum-map-slow
+ tail?_43
+ s_184
+ (lambda (tail?_45 s_186)
+ (gf_8 tail?_45 s_186))
+ seen_18
+ known-pairs_13)
+ (gf_8 #f s_184)))))))))))))
+ loop_73)
#f
- s_158
+ s_183
0))))))
- loop_70)
- s_155)))))))))))))
+ loop_72)
+ s_180)))))))))))))
(define-values
(syntax-scope-set)
- (lambda (s_162 phase_16)
- (begin (scope-set-at-fallback s_162 (fallback-first (syntax-shifted-multi-scopes s_162)) phase_16))))
+ (lambda (s_187 phase_21)
+ (begin (scope-set-at-fallback s_187 (fallback-first (syntax-shifted-multi-scopes s_187)) phase_21))))
(define-values
(scope-set-at-fallback)
- (lambda (s_163 smss_24 phase_17)
+ (lambda (s_188 smss_24 phase_22)
(begin
- (let-values (((ht_60) smss_24))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_60)))
- ((letrec-values (((for-loop_72)
- (lambda (scopes_10 i_76)
- (begin
- 'for-loop
- (if i_76
- (let-values (((sms_11) (unsafe-immutable-hash-iterate-key ht_60 i_76)))
- (let-values (((scopes_11)
- (let-values (((scopes_12) scopes_10))
- (if (let-values (((or-part_134) (label-phase? phase_17)))
- (if or-part_134
- or-part_134
+ (let-values (((scopes_10) (let-values (((scopes_11) (syntax-scopes s_188))) scopes_11)))
+ (let-values (((ht_68) smss_24))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash-keys ht_68))
+ ((letrec-values (((for-loop_80)
+ (lambda (scopes_12 i_100)
+ (begin
+ 'for-loop
+ (if i_100
+ (let-values (((sms_11) (unsafe-immutable-hash-iterate-key ht_68 i_100)))
+ (let-values (((scopes_13)
+ (if (let-values (((or-part_190) (label-phase? phase_22)))
+ (if or-part_190
+ or-part_190
(not
(shifted-to-label-phase?
(shifted-multi-scope-phase sms_11)))))
- (let-values (((scopes_13) scopes_12))
- (let-values (((scopes_14)
- (let-values ()
- (set-add
- scopes_13
- (multi-scope-to-scope-at-phase
- (shifted-multi-scope-multi-scope sms_11)
- (let-values (((ph_1)
- (shifted-multi-scope-phase
- sms_11)))
- (if (shifted-to-label-phase? ph_1)
- (shifted-to-label-phase-from ph_1)
- (phase- ph_1 phase_17))))))))
- (values scopes_14)))
- scopes_12))))
- (if (not #f)
- (for-loop_72 scopes_11 (unsafe-immutable-hash-iterate-next ht_60 i_76))
- scopes_11)))
- scopes_10)))))
- for-loop_72)
- (syntax-scopes s_163)
- (unsafe-immutable-hash-iterate-first ht_60)))))))
+ (let-values (((scopes_14)
+ (set-add
+ scopes_12
+ (multi-scope-to-scope-at-phase
+ (shifted-multi-scope-multi-scope sms_11)
+ (let-values (((ph_1)
+ (shifted-multi-scope-phase sms_11)))
+ (if (shifted-to-label-phase? ph_1)
+ (shifted-to-label-phase-from ph_1)
+ (phase- ph_1 phase_22)))))))
+ (values scopes_14))
+ scopes_12)))
+ (if (not #f)
+ (for-loop_80 scopes_13 (unsafe-immutable-hash-iterate-next ht_68 i_100))
+ scopes_13)))
+ scopes_12)))))
+ for-loop_80)
+ scopes_10
+ (unsafe-immutable-hash-iterate-first ht_68))))))))
(define-values
(find-max-scope)
(lambda (scopes_15)
(begin
(begin
- (if (set-empty? scopes_15) (let-values () (error "cannot bind in empty scope set")) (void))
- (let-values (((ht_61) scopes_15))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_61)))
- ((letrec-values (((for-loop_73)
- (lambda (max-sc_0 i_77)
- (begin
- 'for-loop
- (if i_77
- (let-values (((sc_25) (unsafe-immutable-hash-iterate-key ht_61 i_77)))
- (let-values (((max-sc_1)
- (let-values (((max-sc_2) max-sc_0))
- (let-values (((max-sc_3)
- (let-values ()
- (if (scope>? sc_25 max-sc_2) sc_25 max-sc_2))))
- (values max-sc_3)))))
- (if (not #f)
- (for-loop_73 max-sc_1 (unsafe-immutable-hash-iterate-next ht_61 i_77))
- max-sc_1)))
- max-sc_0)))))
- for-loop_73)
- (set-first scopes_15)
- (unsafe-immutable-hash-iterate-first ht_61))))))))
+ (if (set-empty? scopes_15) (error "cannot bind in empty scope set") (void))
+ (let-values (((max-sc_0) (let-values (((max-sc_1) (set-first scopes_15))) max-sc_1)))
+ (let-values (((ht_69) scopes_15))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash-keys ht_69))
+ ((letrec-values (((for-loop_81)
+ (lambda (max-sc_2 i_101)
+ (begin
+ 'for-loop
+ (if i_101
+ (let-values (((sc_28) (unsafe-immutable-hash-iterate-key ht_69 i_101)))
+ (let-values (((max-sc_3)
+ (let-values (((max-sc_4)
+ (if (scope>? sc_28 max-sc_2) sc_28 max-sc_2)))
+ (values max-sc_4))))
+ (if (not #f)
+ (for-loop_81 max-sc_3 (unsafe-immutable-hash-iterate-next ht_69 i_101))
+ max-sc_3)))
+ max-sc_2)))))
+ for-loop_81)
+ max-sc_0
+ (unsafe-immutable-hash-iterate-first ht_69)))))))))
(define-values
(add-binding-in-scopes!.1)
(lambda (just-for-nominal?13_0 scopes15_0 sym16_0 binding17_0)
(begin
'add-binding-in-scopes!
(let-values (((scopes_16) scopes15_0))
- (let-values (((sym_16) sym16_0))
+ (let-values (((sym_21) sym16_0))
(let-values (((binding_3) binding17_0))
(let-values (((just-for-nominal?_1) just-for-nominal?13_0))
- (let-values ()
- (let-values (((max-sc_4) (find-max-scope scopes_16)))
- (let-values (((bt_7)
- (binding-table-add
- (scope-binding-table max-sc_4)
- scopes_16
- sym_16
- binding_3
- just-for-nominal?_1)))
- (begin (set-scope-binding-table! max-sc_4 bt_7) (clear-resolve-cache! sym_16))))))))))))
+ (let-values (((max-sc_5) (find-max-scope scopes_16)))
+ (let-values (((bt_7)
+ (binding-table-add
+ (scope-binding-table max-sc_5)
+ scopes_16
+ sym_21
+ binding_3
+ just-for-nominal?_1)))
+ (begin (set-scope-binding-table! max-sc_5 bt_7) (clear-resolve-cache! sym_21)))))))))))
(define-values
(add-bulk-binding-in-scopes!.1)
(lambda (shadow-except19_0 scopes21_1 bulk-binding22_0)
@@ -10980,589 +10639,542 @@
(let-values (((scopes_17) scopes21_1))
(let-values (((bulk-binding_0) bulk-binding22_0))
(let-values (((shadow-except_1) shadow-except19_0))
- (let-values ()
- (let-values (((max-sc_5) (find-max-scope scopes_17)))
- (let-values (((bt_8)
- (let-values (((temp81_0) (scope-binding-table max-sc_5))
- ((scopes82_0) scopes_17)
- ((bulk-binding83_0) bulk-binding_0)
- ((shadow-except84_0) shadow-except_1))
- (binding-table-add-bulk.1 shadow-except84_0 temp81_0 scopes82_0 bulk-binding83_0))))
- (begin (set-scope-binding-table! max-sc_5 bt_8) (clear-resolve-cache!)))))))))))
+ (let-values (((max-sc_6) (find-max-scope scopes_17)))
+ (let-values (((bt_8)
+ (let-values (((temp81_0) (scope-binding-table max-sc_6))
+ ((scopes82_0) scopes_17)
+ ((bulk-binding83_0) bulk-binding_0)
+ ((shadow-except84_0) shadow-except_1))
+ (binding-table-add-bulk.1 shadow-except84_0 temp81_0 scopes82_0 bulk-binding83_0))))
+ (begin (set-scope-binding-table! max-sc_6 bt_8) (clear-resolve-cache!))))))))))
(define-values
(syntax-any-macro-scopes?)
- (lambda (s_164)
+ (lambda (s_189)
(begin
- (let-values (((ht_62) (syntax-scopes s_164)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_62)))
- ((letrec-values (((for-loop_74)
- (lambda (result_41 i_78)
- (begin
- 'for-loop
- (if i_78
- (let-values (((sc_26) (unsafe-immutable-hash-iterate-key ht_62 i_78)))
- (let-values (((result_42)
- (let-values ()
- (let-values (((result_43)
- (let-values ()
- (let-values () (eq? (scope-kind sc_26) 'macro)))))
- (values result_43)))))
- (if (if (not ((lambda x_30 result_42) sc_26)) (not #f) #f)
- (for-loop_74 result_42 (unsafe-immutable-hash-iterate-next ht_62 i_78))
- result_42)))
- result_41)))))
- for-loop_74)
- #f
- (unsafe-immutable-hash-iterate-first ht_62)))))))
+ (let-values (((result_77) (let-values (((result_78) #f)) result_78)))
+ (let-values (((ht_70) (syntax-scopes s_189)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash-keys ht_70))
+ ((letrec-values (((for-loop_82)
+ (lambda (result_79 i_102)
+ (begin
+ 'for-loop
+ (if i_102
+ (let-values (((sc_29) (unsafe-immutable-hash-iterate-key ht_70 i_102)))
+ (let-values (((result_80)
+ (let-values (((result_81) (eq? (scope-kind sc_29) 'macro)))
+ (values result_81))))
+ (if (if (not ((lambda x_34 result_80) sc_29)) (not #f) #f)
+ (for-loop_82 result_80 (unsafe-immutable-hash-iterate-next ht_70 i_102))
+ result_80)))
+ result_79)))))
+ for-loop_82)
+ result_77
+ (unsafe-immutable-hash-iterate-first ht_70))))))))
(define-values
(resolve.1)
(lambda (ambiguous-value24_0 exactly?25_0 extra-shifts27_0 get-scopes?26_0 s32_0 phase33_0)
(begin
'resolve
- (let-values (((s_165) s32_0))
- (let-values (((phase_18) phase33_0))
+ (let-values (((s_190) s32_0))
+ (let-values (((phase_23) phase33_0))
(let-values (((ambiguous-value_0) ambiguous-value24_0))
- (let-values (((exactly?_1) exactly?25_0))
+ (let-values (((exactly?_2) exactly?25_0))
(let-values (((get-scopes?_0) get-scopes?26_0))
- (let-values (((extra-shifts_6) extra-shifts27_0))
- (let-values ()
- (let-values (((sym_17) (syntax-content s_165)))
- ((letrec-values (((fallback-loop_0)
- (lambda (smss_25)
- (begin
- 'fallback-loop
- (let-values (((c1_21)
- (if (not exactly?_1)
- (if (not get-scopes?_0)
- (resolve-cache-get
- sym_17
- phase_18
- (syntax-scopes s_165)
- (fallback-first smss_25))
- #f)
- #f)))
- (if c1_21
- ((lambda (b_42)
- (if (eq? b_42 '#:none)
- (let-values ()
- (if (fallback? smss_25)
- (fallback-loop_0 (fallback-rest smss_25))
- #f))
- (let-values () b_42)))
- c1_21)
- (let-values ()
- (let-values (((scopes_18)
- (scope-set-at-fallback
- s_165
- (fallback-first smss_25)
- phase_18)))
- (let-values (((best-scopes_0 best-binding_0)
- (let-values (((ht_63) scopes_18))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-immutable-hash-keys ht_63)))
- ((letrec-values (((for-loop_75)
- (lambda (best-scopes_1
- best-binding_1
- i_79)
- (begin
- 'for-loop
- (if i_79
- (let-values (((sc_27)
- (unsafe-immutable-hash-iterate-key
- ht_63
- i_79)))
- (let-values (((best-scopes_2
- best-binding_2)
- (let-values (((ht_64
- bulk-bindings_2)
- (let-values (((table_87)
- (scope-binding-table
- sc_27)))
- (if (hash?
- table_87)
- (values
- (hash-ref
- table_87
- sym_17
- '#hash())
- null)
- (values
- (hash-ref
- (table-with-bulk-bindings-syms
- table_87)
- sym_17
- '#hash())
- (table-with-bulk-bindings-bulk-bindings
- table_87)))))
- ((s_166)
- s_165)
- ((extra-shifts_7)
- extra-shifts_6))
- (begin
- #t
- ((letrec-values (((for-loop_76)
- (lambda (best-scopes_3
- best-binding_3
- i_80)
- (begin
- 'for-loop
- (if (not
- (null?
- i_80))
- (let-values (((b-scopes_0)
- (if (pair?
- i_80)
- (let-values ()
- (bulk-binding-at-scopes
- (car
- i_80)))
- (let-values ()
- (hash-iterate-key
- ht_64
- i_80))))
- ((binding_4)
- (if (pair?
- i_80)
- (let-values ()
- (let-values (((bulk_3)
- (bulk-binding-at-bulk
- (car
- i_80))))
- (let-values (((b-info_0)
- (if (symbol-interned?
- sym_17)
- (hash-ref
- (bulk-binding-symbols
- bulk_3
- s_166
- extra-shifts_7)
- sym_17
- #f)
- #f)))
- (if b-info_0
- ((bulk-binding-create
- bulk_3)
- bulk_3
- b-info_0
- sym_17)
- #f))))
- (let-values ()
- (hash-iterate-value
- ht_64
- i_80)))))
- (let-values (((best-scopes_4
- best-binding_4)
- (let-values (((best-scopes_5)
- best-scopes_3)
- ((best-binding_5)
- best-binding_3))
- (if (if b-scopes_0
- (if binding_4
- (subset?
- b-scopes_0
- scopes_18)
- #f)
- #f)
- (let-values (((best-scopes_6)
- best-scopes_5)
- ((best-binding_6)
- best-binding_5))
- (let-values (((best-scopes_7
- best-binding_7)
- (let-values ()
- (if (pair?
- best-scopes_6)
- (let-values ()
- (if (let-values (((lst_53)
- best-scopes_6))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_53)))
- ((letrec-values (((for-loop_77)
- (lambda (result_44
- lst_54)
- (begin
- 'for-loop
- (if (pair?
- lst_54)
- (let-values (((amb-scopes_0)
- (unsafe-car
- lst_54))
- ((rest_24)
- (unsafe-cdr
- lst_54)))
- (let-values (((result_45)
- (let-values ()
- (let-values (((result_46)
- (let-values ()
- (let-values ()
- (subset?
- amb-scopes_0
- b-scopes_0)))))
- (values
- result_46)))))
- (if (if (not
- ((lambda x_31
- (not
- result_45))
- amb-scopes_0))
- (not
- #f)
- #f)
- (for-loop_77
- result_45
- rest_24)
- result_45)))
- result_44)))))
- for-loop_77)
- #t
- lst_53)))
- (let-values ()
- (values
- b-scopes_0
- binding_4))
- (let-values ()
- (values
- (cons
- b-scopes_0
- best-scopes_6)
- #f))))
- (if (not
- best-scopes_6)
- (let-values ()
- (values
- b-scopes_0
- binding_4))
- (if (subset?
- b-scopes_0
- best-scopes_6)
- (let-values ()
- (values
- best-scopes_6
- best-binding_6))
- (if (subset?
- best-scopes_6
- b-scopes_0)
- (let-values ()
- (values
- b-scopes_0
- binding_4))
- (let-values ()
- (values
- (list
- best-scopes_6
- b-scopes_0)
- #f)))))))))
- (values
- best-scopes_7
- best-binding_7)))
- (values
- best-scopes_5
- best-binding_5)))))
- (if (not
- #f)
- (for-loop_76
- best-scopes_4
- best-binding_4
- (if (pair?
- i_80)
- (let-values ()
- (cdr
- i_80))
- (let-values ()
- (let-values (((or-part_135)
- (hash-iterate-next
- ht_64
- i_80)))
- (if or-part_135
- or-part_135
- bulk-bindings_2)))))
- (values
- best-scopes_4
- best-binding_4))))
- (values
- best-scopes_3
- best-binding_3))))))
- for-loop_76)
- best-scopes_1
- best-binding_1
- (let-values (((or-part_136)
- (hash-iterate-first
- ht_64)))
- (if or-part_136
- or-part_136
- bulk-bindings_2)))))))
- (if (not #f)
- (for-loop_75
- best-scopes_2
- best-binding_2
- (unsafe-immutable-hash-iterate-next
- ht_63
- i_79))
- (values
- best-scopes_2
- best-binding_2))))
- (values
- best-scopes_1
- best-binding_1))))))
- for-loop_75)
- #f
- #f
- (unsafe-immutable-hash-iterate-first ht_63))))))
- (if (pair? best-scopes_0)
- (let-values ()
- (if (fallback? smss_25)
- (fallback-loop_0 (fallback-rest smss_25))
- ambiguous-value_0))
- (if best-scopes_0
- (let-values ()
- (begin
- (resolve-cache-set!
- sym_17
- phase_18
- (syntax-scopes s_165)
- (fallback-first smss_25)
- best-binding_0)
- (if (let-values (((or-part_137) (not exactly?_1)))
- (if or-part_137
- or-part_137
- (eqv?
- (set-count scopes_18)
- (set-count best-scopes_0))))
- (if get-scopes?_0 best-scopes_0 best-binding_0)
- #f)))
- (let-values ()
- (begin
- (resolve-cache-set!
- sym_17
- phase_18
- (syntax-scopes s_165)
- (fallback-first smss_25)
- '#:none)
- (if (fallback? smss_25)
- (fallback-loop_0 (fallback-rest smss_25))
- #f))))))))))))))
- fallback-loop_0)
- (syntax-shifted-multi-scopes s_165)))))))))))))
+ (let-values (((extra-shifts_7) extra-shifts27_0))
+ (let-values (((sym_22) (syntax-content s_190)))
+ ((letrec-values (((fallback-loop_0)
+ (lambda (smss_25)
+ (begin
+ 'fallback-loop
+ (let-values (((cond-val_5)
+ (if (not exactly?_2)
+ (if (not get-scopes?_0)
+ (resolve-cache-get
+ sym_22
+ phase_23
+ (syntax-scopes s_190)
+ (fallback-first smss_25))
+ #f)
+ #f)))
+ (if cond-val_5
+ ((lambda (b_52)
+ (if (eq? b_52 '#:none)
+ (if (fallback? smss_25) (fallback-loop_0 (fallback-rest smss_25)) #f)
+ b_52))
+ cond-val_5)
+ (let-values (((scopes_18)
+ (scope-set-at-fallback
+ s_190
+ (fallback-first smss_25)
+ phase_23)))
+ (let-values (((best-scopes_0 best-binding_0)
+ (let-values (((best-scopes_1)
+ (let-values (((best-scopes_2) #f))
+ best-scopes_2))
+ ((best-binding_1)
+ (let-values (((best-binding_2) #f))
+ best-binding_2)))
+ (let-values (((ht_71) scopes_18))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_71))
+ ((letrec-values (((for-loop_83)
+ (lambda (best-scopes_3
+ best-binding_3
+ i_103)
+ (begin
+ 'for-loop
+ (if i_103
+ (let-values (((sc_30)
+ (unsafe-immutable-hash-iterate-key
+ ht_71
+ i_103)))
+ (let-values (((best-scopes_4
+ best-binding_4)
+ (let-values (((ht_72
+ bulk-bindings_3)
+ (let-values (((table_101)
+ (scope-binding-table
+ sc_30)))
+ (if (hash?
+ table_101)
+ (values
+ (hash-ref
+ table_101
+ sym_22
+ '#hash())
+ null)
+ (values
+ (hash-ref
+ (table-with-bulk-bindings-syms
+ table_101)
+ sym_22
+ '#hash())
+ (table-with-bulk-bindings-bulk-bindings
+ table_101)))))
+ ((s_191)
+ s_190)
+ ((extra-shifts_8)
+ extra-shifts_7))
+ (begin
+ #t
+ ((letrec-values (((for-loop_84)
+ (lambda (best-scopes_5
+ best-binding_5
+ i_104)
+ (begin
+ 'for-loop
+ (if (not
+ (null?
+ i_104))
+ (let-values (((b-scopes_0)
+ (if (pair?
+ i_104)
+ (bulk-binding-at-scopes
+ (car
+ i_104))
+ (hash-iterate-key
+ ht_72
+ i_104)))
+ ((binding_4)
+ (if (pair?
+ i_104)
+ (let-values (((bulk_3)
+ (bulk-binding-at-bulk
+ (car
+ i_104))))
+ (let-values (((b-info_0)
+ (if (symbol-interned?
+ sym_22)
+ (hash-ref
+ (bulk-binding-symbols
+ bulk_3
+ s_191
+ extra-shifts_8)
+ sym_22
+ #f)
+ #f)))
+ (if b-info_0
+ ((bulk-binding-create
+ bulk_3)
+ bulk_3
+ b-info_0
+ sym_22)
+ #f)))
+ (hash-iterate-value
+ ht_72
+ i_104))))
+ (let-values (((best-scopes_6
+ best-binding_6)
+ (if (if b-scopes_0
+ (if binding_4
+ (subset?
+ b-scopes_0
+ scopes_18)
+ #f)
+ #f)
+ (let-values (((best-scopes_7
+ best-binding_7)
+ (if (pair?
+ best-scopes_5)
+ (if (let-values (((result_82)
+ (let-values (((result_83)
+ #t))
+ result_83)))
+ (let-values (((lst_59)
+ best-scopes_5))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_59))
+ ((letrec-values (((for-loop_85)
+ (lambda (result_84
+ lst_60)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_60)
+ (let-values (((amb-scopes_0)
+ (unsafe-car
+ lst_60))
+ ((rest_26)
+ (unsafe-cdr
+ lst_60)))
+ (let-values (((result_85)
+ (let-values (((result_86)
+ (subset?
+ amb-scopes_0
+ b-scopes_0)))
+ (values
+ result_86))))
+ (if (if (not
+ ((lambda x_35
+ (not
+ result_85))
+ amb-scopes_0))
+ (not
+ #f)
+ #f)
+ (for-loop_85
+ result_85
+ rest_26)
+ result_85)))
+ result_84)))))
+ for-loop_85)
+ result_82
+ lst_59))))
+ (values
+ b-scopes_0
+ binding_4)
+ (values
+ (cons
+ b-scopes_0
+ best-scopes_5)
+ #f))
+ (if (not
+ best-scopes_5)
+ (values
+ b-scopes_0
+ binding_4)
+ (if (subset?
+ b-scopes_0
+ best-scopes_5)
+ (values
+ best-scopes_5
+ best-binding_5)
+ (if (subset?
+ best-scopes_5
+ b-scopes_0)
+ (values
+ b-scopes_0
+ binding_4)
+ (values
+ (list
+ best-scopes_5
+ b-scopes_0)
+ #f)))))))
+ (values
+ best-scopes_7
+ best-binding_7))
+ (values
+ best-scopes_5
+ best-binding_5))))
+ (if (not
+ #f)
+ (for-loop_84
+ best-scopes_6
+ best-binding_6
+ (if (pair?
+ i_104)
+ (cdr
+ i_104)
+ (let-values (((or-part_191)
+ (hash-iterate-next
+ ht_72
+ i_104)))
+ (if or-part_191
+ or-part_191
+ bulk-bindings_3))))
+ (values
+ best-scopes_6
+ best-binding_6))))
+ (values
+ best-scopes_5
+ best-binding_5))))))
+ for-loop_84)
+ best-scopes_3
+ best-binding_3
+ (let-values (((or-part_192)
+ (hash-iterate-first
+ ht_72)))
+ (if or-part_192
+ or-part_192
+ bulk-bindings_3)))))))
+ (if (not #f)
+ (for-loop_83
+ best-scopes_4
+ best-binding_4
+ (unsafe-immutable-hash-iterate-next
+ ht_71
+ i_103))
+ (values
+ best-scopes_4
+ best-binding_4))))
+ (values
+ best-scopes_3
+ best-binding_3))))))
+ for-loop_83)
+ best-scopes_1
+ best-binding_1
+ (unsafe-immutable-hash-iterate-first ht_71)))))))
+ (if (pair? best-scopes_0)
+ (if (fallback? smss_25)
+ (fallback-loop_0 (fallback-rest smss_25))
+ ambiguous-value_0)
+ (if best-scopes_0
+ (begin
+ (resolve-cache-set!
+ sym_22
+ phase_23
+ (syntax-scopes s_190)
+ (fallback-first smss_25)
+ best-binding_0)
+ (if (let-values (((or-part_193) (not exactly?_2)))
+ (if or-part_193
+ or-part_193
+ (eqv? (set-count scopes_18) (set-count best-scopes_0))))
+ (if get-scopes?_0 best-scopes_0 best-binding_0)
+ #f))
+ (begin
+ (resolve-cache-set!
+ sym_22
+ phase_23
+ (syntax-scopes s_190)
+ (fallback-first smss_25)
+ '#:none)
+ (if (fallback? smss_25)
+ (fallback-loop_0 (fallback-rest smss_25))
+ #f))))))))))))
+ fallback-loop_0)
+ (syntax-shifted-multi-scopes s_190))))))))))))
(define-values
(bound-identifier=?$1)
- (lambda (a_23 b_43 phase_19)
+ (lambda (a_25 b_53 phase_24)
(begin
'bound-identifier=?
- (if (eq? (syntax-e$1 a_23) (syntax-e$1 b_43))
- (equal? (syntax-scope-set a_23 phase_19) (syntax-scope-set b_43 phase_19))
+ (if (eq? (syntax-e$1 a_25) (syntax-e$1 b_53))
+ (equal? (syntax-scope-set a_25 phase_24) (syntax-scope-set b_53 phase_24))
#f))))
(define-values
(local-binding?)
- (lambda (b_44)
- (begin (let-values (((or-part_1) (full-local-binding? b_44))) (if or-part_1 or-part_1 (symbol? b_44))))))
+ (lambda (b_54)
+ (begin (let-values (((or-part_194) (full-local-binding? b_54))) (if or-part_194 or-part_194 (symbol? b_54))))))
(define-values
(struct:full-local-binding full-local-binding1.1 full-local-binding? full-local-binding-key)
- (let-values (((struct:_23 make-_23 ?_23 -ref_23 -set!_23)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'full-local-binding
- struct:full-binding
- 1
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:serialize
- (lambda (b_23 ser-push!_14 state_24)
- (begin
- (ser-push!_14 'tag '#:local-binding)
- (ser-push!_14 (full-local-binding-key b_23))
- (ser-push!_14 (full-binding-free=id b_23))))))
- (current-inspector)
- #f
- '(0)
- #f
- 'full-local-binding)))))
- (values struct:_23 make-_23 ?_23 (make-struct-field-accessor -ref_23 0 'key))))
+ (let-values (((struct:_29 make-_29 ?_29 -ref_29 -set!_29)
+ (make-struct-type
+ 'full-local-binding
+ struct:full-binding
+ 1
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:serialize
+ (lambda (b_55 ser-push!_14 state_24)
+ (begin
+ (ser-push!_14 'tag '#:local-binding)
+ (ser-push!_14 (full-local-binding-key b_55))
+ (ser-push!_14 (full-binding-free=id b_55))))))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'full-local-binding)))
+ (values struct:_29 make-_29 ?_29 (make-struct-field-accessor -ref_29 0 'key))))
(define-values
(deserialize-full-local-binding)
- (lambda (key_35 free=id_3) (begin (full-local-binding1.1 #f free=id_3 key_35))))
+ (lambda (key_38 free=id_3) (begin (full-local-binding1.1 #f free=id_3 key_38))))
(define-values
(make-local-binding.1)
(lambda (frame-id2_0 free=id3_0 key6_0)
(begin
'make-local-binding
- (let-values (((key_36) key6_0))
+ (let-values (((key_39) key6_0))
(let-values (((frame-id_2) frame-id2_0))
(let-values (((free=id_4) free=id3_0))
- (let-values ()
- (if (if (not frame-id_2) (not free=id_4) #f)
- (let-values () key_36)
- (let-values () (full-local-binding1.1 frame-id_2 free=id_4 key_36))))))))))
+ (if (if (not frame-id_2) (not free=id_4) #f)
+ key_39
+ (full-local-binding1.1 frame-id_2 free=id_4 key_39))))))))
(define-values
(local-binding-update.1)
(lambda (frame-id9_0 free=id10_0 key8_0 b14_0)
(begin
'local-binding-update
- (let-values (((b_45) b14_0))
- (let-values (((key_37) (if (eq? key8_0 unsafe-undefined) (local-binding-key b_45) key8_0)))
- (let-values (((frame-id_3) (if (eq? frame-id9_0 unsafe-undefined) (binding-frame-id b_45) frame-id9_0)))
- (let-values (((free=id_5) (if (eq? free=id10_0 unsafe-undefined) (binding-free=id b_45) free=id10_0)))
- (let-values ()
- (let-values (((key17_0) key_37) ((frame-id18_0) frame-id_3) ((free=id19_0) free=id_5))
- (make-local-binding.1 frame-id18_0 free=id19_0 key17_0))))))))))
+ (let-values (((b_56) b14_0))
+ (let-values (((key_40) (if (eq? key8_0 unsafe-undefined) (local-binding-key b_56) key8_0)))
+ (let-values (((frame-id_3) (if (eq? frame-id9_0 unsafe-undefined) (binding-frame-id b_56) frame-id9_0)))
+ (let-values (((free=id_5) (if (eq? free=id10_0 unsafe-undefined) (binding-free=id b_56) free=id10_0)))
+ (let-values (((key17_0) key_40) ((frame-id18_0) frame-id_3) ((free=id19_0) free=id_5))
+ (make-local-binding.1 frame-id18_0 free=id19_0 key17_0)))))))))
(define-values
(local-binding-key)
- (lambda (b_46) (begin (if (full-local-binding? b_46) (full-local-binding-key b_46) b_46))))
+ (lambda (b_57) (begin (if (full-local-binding? b_57) (full-local-binding-key b_57) b_57))))
(define-values
(1/prop:rename-transformer 1/rename-transformer? rename-transformer-value)
(make-struct-type-property
'rename-transformer
- (lambda (v_29 info_0)
+ (lambda (v_102 info_0)
(let-values ((()
(begin
- (if (let-values (((or-part_12) (exact-nonnegative-integer? v_29)))
- (if or-part_12
- or-part_12
- (let-values (((or-part_3) (identifier? v_29)))
- (if or-part_3 or-part_3 (if (procedure? v_29) (procedure-arity-includes? v_29 1) #f)))))
+ (if (let-values (((or-part_195) (exact-nonnegative-integer? v_102)))
+ (if or-part_195
+ or-part_195
+ (let-values (((or-part_196) (identifier? v_102)))
+ (if or-part_196
+ or-part_196
+ (if (procedure? v_102) (procedure-arity-includes? v_102 1) #f)))))
(void)
- (let-values ()
- (raise-argument-error
- 'guard-for-prop:rename-transformer
- (string-append
- "(or/c exact-nonnegative-integer?\n"
- " identifier?\n"
- " (procedure-arity-includes? proc 1))")
- v_29)))
+ (raise-argument-error
+ 'guard-for-prop:rename-transformer
+ (string-append
+ "(or/c exact-nonnegative-integer?\n"
+ " identifier?\n"
+ " (procedure-arity-includes? proc 1))")
+ v_102))
(values))))
(let-values ((()
(begin
- (if (exact-nonnegative-integer? v_29)
- (let-values ()
- (begin
- (if (<= v_29 (list-ref info_0 1))
- (void)
- (let-values ()
- (raise-arguments-error
- 'guard-for-prop:rename-transformer
- "field index >= initialized-field count for structure type"
- "field index"
- v_29
- "initialized-field count"
- (list-ref info_0 1))))
- (if (member v_29 (list-ref info_0 5))
- (void)
- (let-values ()
- (raise-arguments-error
- 'guard-for-prop:rename-transformer
- "field index not declared immutable"
- "field index"
- v_29)))))
+ (if (exact-nonnegative-integer? v_102)
+ (begin
+ (if (<= v_102 (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_102
+ "initialized-field count"
+ (list-ref info_0 1)))
+ (if (member v_102 (list-ref info_0 5))
+ (void)
+ (raise-arguments-error
+ 'guard-for-prop:rename-transformer
+ "field index not declared immutable"
+ "field index"
+ v_102)))
(void))
(values))))
(let-values (((ref_0) (list-ref info_0 3)))
- (if (identifier? v_29)
- (let-values () (lambda (t_9) v_29))
- (if (integer? v_29)
- (let-values ()
- (lambda (t_10)
- (let-values (((val_11) (ref_0 t_10 v_29)))
- (if (identifier? val_11) val_11 (datum->syntax$1 #f '?)))))
- (let-values ()
- (lambda (t_11)
- (let-values (((id_0) (call-with-continuation-barrier (lambda () (v_29 t_11)))))
- (begin
- (if (identifier? id_0)
- (void)
- (let-values ()
- (raise-arguments-error
- 'prop:rename-transformer
- "contract violation for given value; expected an identifier"
- "given"
- id_0)))
- id_0))))))))))))
+ (if (identifier? v_102)
+ (lambda (t_8) v_102)
+ (if (integer? v_102)
+ (lambda (t_9)
+ (let-values (((val_21) (ref_0 t_9 v_102))) (if (identifier? val_21) val_21 (datum->syntax$1 #f '?))))
+ (lambda (t_10)
+ (let-values (((id_0) (call-with-continuation-barrier (lambda () (v_102 t_10)))))
+ (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-values
(struct:id-rename-transformer id-rename-transformer1.1 id-rename-transformer? id-rename-transformer-id)
- (let-values (((struct:_24 make-_24 ?_24 -ref_24 -set!_24)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'rename-transformer
- #f
- 1
- 0
- #f
- (list (cons 1/prop:rename-transformer 0))
- (current-inspector)
- #f
- '(0)
- #f
- 'id-rename-transformer)))))
- (values struct:_24 make-_24 ?_24 (make-struct-field-accessor -ref_24 0 'id))))
- (define-values
- (1/make-rename-transformer)
+ (let-values (((struct:_30 make-_30 ?_30 -ref_30 -set!_30)
+ (make-struct-type
+ 'rename-transformer
+ #f
+ 1
+ 0
+ #f
+ (list (cons 1/prop:rename-transformer 0))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'id-rename-transformer)))
+ (values struct:_30 make-_30 ?_30 (make-struct-field-accessor -ref_30 0 'id))))
+ (define-values
+ (1/make-rename-transformer)
(lambda (id_1)
(begin
'make-rename-transformer
(begin
- (if (identifier? id_1)
- (void)
- (let-values () (raise-argument-error 'make-rename-transformer "identifier?" id_1)))
+ (if (identifier? id_1) (void) (raise-argument-error 'make-rename-transformer "identifier?" id_1))
(id-rename-transformer1.1 id_1)))))
(define-values
(1/rename-transformer-target)
- (lambda (t_12) (begin 'rename-transformer-target ((rename-transformer-value t_12) t_12))))
+ (lambda (t_11) (begin 'rename-transformer-target ((rename-transformer-value t_11) t_11))))
(define-values
(free-identifier=?$1)
- (lambda (a_18 b_14 a-phase_0 b-phase_0)
+ (lambda (a_26 b_58 a-phase_0 b-phase_0)
(begin
'free-identifier=?
(let-values (((ab_0)
(toplevel-as-symbol
- (let-values (((a46_0) a_18) ((a-phase47_0) a-phase_0) ((temp48_0) #t))
+ (let-values (((a46_0) a_26) ((a-phase47_0) a-phase_0) ((temp48_0) #t))
(resolve+shift.1 #f #f null unsafe-undefined temp48_0 a46_0 a-phase47_0)))))
(let-values (((bb_0)
(toplevel-as-symbol
- (let-values (((b49_0) b_14) ((b-phase50_0) b-phase_0) ((temp51_0) #t))
- (resolve+shift.1 #f #f null unsafe-undefined temp51_0 b49_0 b-phase50_0)))))
- (if (let-values (((or-part_83) (symbol? ab_0))) (if or-part_83 or-part_83 (symbol? bb_0)))
- (let-values () (eq? ab_0 bb_0))
- (let-values () (same-binding? ab_0 bb_0))))))))
+ (let-values (((b49_0) b_58) ((b-phase50_0) b-phase_0) ((temp51_1) #t))
+ (resolve+shift.1 #f #f null unsafe-undefined temp51_1 b49_0 b-phase50_0)))))
+ (if (let-values (((or-part_197) (symbol? ab_0))) (if or-part_197 or-part_197 (symbol? bb_0)))
+ (eq? ab_0 bb_0)
+ (same-binding? ab_0 bb_0)))))))
(define-values
(toplevel-as-symbol)
- (lambda (b_47)
+ (lambda (b_59)
(begin
- (if (if (module-binding? b_47) (top-level-module-path-index? (module-binding-module b_47)) #f)
- (module-binding-sym b_47)
- b_47))))
+ (if (if (module-binding? b_59) (top-level-module-path-index? (module-binding-module b_59)) #f)
+ (module-binding-sym b_59)
+ b_59))))
(define-values
(same-binding?)
(lambda (ab_1 bb_1)
(begin
(if (module-binding? ab_1)
- (let-values ()
- (if (module-binding? bb_1)
- (if (eq? (module-binding-sym ab_1) (module-binding-sym bb_1))
- (if (eqv? (module-binding-phase ab_1) (module-binding-phase bb_1))
- (eq?
- (1/module-path-index-resolve (module-binding-module ab_1))
- (1/module-path-index-resolve (module-binding-module bb_1)))
- #f)
+ (if (module-binding? bb_1)
+ (if (eq? (module-binding-sym ab_1) (module-binding-sym bb_1))
+ (if (eqv? (module-binding-phase ab_1) (module-binding-phase bb_1))
+ (eq?
+ (1/module-path-index-resolve (module-binding-module ab_1))
+ (1/module-path-index-resolve (module-binding-module bb_1)))
#f)
- #f))
+ #f)
+ #f)
(if (local-binding? ab_1)
- (let-values () (if (local-binding? bb_1) (eq? (local-binding-key ab_1) (local-binding-key bb_1)) #f))
- (let-values () (error "bad binding" ab_1)))))))
+ (if (local-binding? bb_1) (eq? (local-binding-key ab_1) (local-binding-key bb_1)) #f)
+ (error "bad binding" ab_1))))))
(define-values
(same-binding-nominals?)
(lambda (ab_2 bb_2)
@@ -11578,43 +11190,41 @@
#f))))
(define-values
(identifier-binding-symbol$1)
- (lambda (id_2 phase_20)
+ (lambda (id_2 phase_25)
(begin
'identifier-binding-symbol
- (let-values (((b_48)
- (let-values (((id52_0) id_2) ((phase53_0) phase_20) ((temp54_0) #t))
+ (let-values (((b_60)
+ (let-values (((id52_0) id_2) ((phase53_0) phase_25) ((temp54_0) #t))
(resolve+shift.1 #f #f null unsafe-undefined temp54_0 id52_0 phase53_0))))
- (if (symbol? b_48)
- (let-values () b_48)
- (if (module-binding? b_48)
- (let-values () (module-binding-sym b_48))
- (if (local-binding? b_48) (let-values () (local-binding-key b_48)) (let-values () (syntax-e$1 id_2)))))))))
+ (if (symbol? b_60)
+ b_60
+ (if (module-binding? b_60)
+ (module-binding-sym b_60)
+ (if (local-binding? b_60) (local-binding-key b_60) (syntax-e$1 id_2))))))))
(define-values
(identifier-binding.1)
(lambda (exactly?1_0 id4_0 phase5_0 top-level-symbol?3_0)
(begin
'identifier-binding
(let-values (((id_3) id4_0))
- (let-values (((phase_21) phase5_0))
+ (let-values (((phase_26) phase5_0))
(let-values (((top-level-symbol?_0) top-level-symbol?3_0))
- (let-values (((exactly?_2) exactly?1_0))
- (let-values ()
- (let-values (((b_24)
- (let-values (((id55_0) id_3) ((phase56_0) phase_21) ((exactly?57_0) exactly?_2))
- (resolve+shift.1 #f exactly?57_0 null unsafe-undefined #f id55_0 phase56_0))))
- (if (module-binding? b_24)
- (let-values ()
- (if (top-level-module-path-index? (module-binding-module b_24))
- (if top-level-symbol?_0 (list (module-binding-nominal-sym b_24)) #f)
- (list
- (module-binding-module b_24)
- (module-binding-sym b_24)
- (module-binding-nominal-module b_24)
- (module-binding-nominal-sym b_24)
- (module-binding-phase b_24)
- (module-binding-nominal-require-phase+space-shift b_24)
- (module-binding-nominal-phase+space b_24))))
- (if (local-binding? b_24) (let-values () 'lexical) (let-values () #f))))))))))))
+ (let-values (((exactly?_3) exactly?1_0))
+ (let-values (((b_61)
+ (let-values (((id55_0) id_3) ((phase56_0) phase_26) ((exactly?57_0) exactly?_3))
+ (resolve+shift.1 #f exactly?57_0 null unsafe-undefined #f id55_0 phase56_0))))
+ (if (module-binding? b_61)
+ (if (top-level-module-path-index? (module-binding-module b_61))
+ (if top-level-symbol?_0 (list (module-binding-nominal-sym b_61)) #f)
+ (list
+ (module-binding-module b_61)
+ (module-binding-sym b_61)
+ (module-binding-nominal-module b_61)
+ (module-binding-nominal-sym b_61)
+ (module-binding-phase b_61)
+ (module-binding-nominal-require-phase+space-shift b_61)
+ (module-binding-nominal-phase+space b_61)))
+ (if (local-binding? b_61) 'lexical #f))))))))))
(define-values
(identifier-distinct-binding$1)
(let-values (((identifier-distinct-binding_0)
@@ -11623,400 +11233,373 @@
'identifier-distinct-binding
(let-values (((id_4) id8_0))
(let-values (((other-id_0) other-id9_0))
- (let-values (((phase_22) phase10_0))
+ (let-values (((phase_27) phase10_0))
(let-values (((top-level-symbol?_1) top-level-symbol?7_0))
- (let-values ()
- (let-values (((scs_15)
- (let-values (((id58_0) id_4) ((phase59_0) phase_22) ((temp60_1) #t))
- (resolve.1 #f #f null temp60_1 id58_0 phase59_0))))
- (if (not scs_15)
- (let-values () #f)
- (let-values ()
- (let-values (((other-scs_0) (syntax-scope-set other-id_0 phase_22)))
- (if (not (subset? scs_15 other-scs_0))
- (let-values (((id61_0) id_4)
- ((phase62_0) phase_22)
- ((top-level-symbol?63_0) top-level-symbol?_1))
- (identifier-binding.1 #f id61_0 phase62_0 top-level-symbol?63_0))
- #f))))))))))))))
+ (let-values (((scs_17)
+ (let-values (((id58_0) id_4) ((phase59_0) phase_27) ((temp60_1) #t))
+ (resolve.1 #f #f null temp60_1 id58_0 phase59_0))))
+ (if (not scs_17)
+ #f
+ (let-values (((other-scs_0) (syntax-scope-set other-id_0 phase_27)))
+ (if (not (subset? scs_17 other-scs_0))
+ (let-values (((id61_0) id_4)
+ ((phase62_0) phase_27)
+ ((top-level-symbol?63_0) top-level-symbol?_1))
+ (identifier-binding.1 #f id61_0 phase62_0 top-level-symbol?63_0))
+ #f))))))))))))
(case-lambda
- ((id_5 other-id_1 phase_23)
- (begin 'identifier-distinct-binding (identifier-distinct-binding_0 id_5 other-id_1 phase_23 #f)))
- ((id_6 other-id_2 phase_24 top-level-symbol?7_1)
- (identifier-distinct-binding_0 id_6 other-id_2 phase_24 top-level-symbol?7_1)))))
+ ((id_5 other-id_1 phase_28)
+ (begin 'identifier-distinct-binding (identifier-distinct-binding_0 id_5 other-id_1 phase_28 #f)))
+ ((id_6 other-id_2 phase_29 top-level-symbol?7_1)
+ (identifier-distinct-binding_0 id_6 other-id_2 phase_29 top-level-symbol?7_1)))))
(define-values
(identifier-binding-uses-scope?)
- (lambda (id_7 scope_0 phase_25)
+ (lambda (id_7 scope_0 phase_30)
(begin
- (let-values (((scs_16)
- (let-values (((id64_0) id_7) ((phase65_0) phase_25) ((temp66_1) #t))
+ (let-values (((scs_18)
+ (let-values (((id64_0) id_7) ((phase65_0) phase_30) ((temp66_1) #t))
(resolve.1 #f #f null temp66_1 id64_0 phase65_0))))
- (if scs_16 (set-member? scs_16 scope_0) #f)))))
+ (if scs_18 (set-member? scs_18 scope_0) #f)))))
(define-values
(maybe-install-free=id!)
- (lambda (val_19 id_8 phase_2)
+ (lambda (val_22 id_8 phase_31)
(begin
- (if (1/rename-transformer? val_19)
- (let-values ()
- (let-values (((free=id_6) (1/rename-transformer-target val_19)))
- (if (syntax-property$1 free=id_6 'not-free-identifier=?)
- (void)
- (let-values ()
- (let-values (((b_49)
- (let-values (((id70_0) id_8) ((phase71_0) phase_2) ((temp72_0) #t) ((temp73_0) #t))
- (resolve+shift.1 #f temp72_0 null temp73_0 #f id70_0 phase71_0))))
- (let-values (((temp67_0) (syntax-scope-set id_8 phase_2))
- ((temp68_1) (syntax-e$1 id_8))
- ((temp69_0) (binding-set-free=id b_49 free=id_6)))
- (add-binding-in-scopes!.1 #f temp67_0 temp68_1 temp69_0)))))))
+ (if (1/rename-transformer? val_22)
+ (let-values (((free=id_6) (1/rename-transformer-target val_22)))
+ (if (syntax-property$1 free=id_6 'not-free-identifier=?)
+ (void)
+ (let-values (((b_62)
+ (let-values (((id70_0) id_8) ((phase71_0) phase_31) ((temp72_0) #t) ((temp73_0) #t))
+ (resolve+shift.1 #f temp72_0 null temp73_0 #f id70_0 phase71_0))))
+ (let-values (((temp67_0) (syntax-scope-set id_8 phase_31))
+ ((temp68_1) (syntax-e$1 id_8))
+ ((temp69_0) (binding-set-free=id b_62 free=id_6)))
+ (add-binding-in-scopes!.1 #f temp67_0 temp68_1 temp69_0)))))
(void)))))
(define-values
(binding-set-free=id)
- (lambda (b_50 free=id_7)
- (begin
- (if (module-binding? b_50)
- (let-values ()
- (let-values (((b74_0) b_50) ((free=id75_0) free=id_7))
- (module-binding-update.1
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- free=id75_0
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- b74_0)))
- (if (local-binding? b_50)
- (let-values ()
- (let-values (((b76_0) b_50) ((free=id77_0) free=id_7))
- (local-binding-update.1 unsafe-undefined free=id77_0 unsafe-undefined b76_0)))
- (let-values () (error "bad binding for free=id:" b_50)))))))
+ (lambda (b_63 free=id_7)
+ (begin
+ (if (module-binding? b_63)
+ (let-values (((b74_0) b_63) ((free=id75_0) free=id_7))
+ (module-binding-update.1
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ free=id75_0
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ b74_0))
+ (if (local-binding? b_63)
+ (let-values (((b76_0) b_63) ((free=id77_0) free=id_7))
+ (local-binding-update.1 unsafe-undefined free=id77_0 unsafe-undefined b76_0))
+ (error "bad binding for free=id:" b_63))))))
(define-values
(struct:non-source-shift non-source-shift11.1 non-source-shift? non-source-shift-from non-source-shift-to)
- (let-values (((struct:_25 make-_25 ?_25 -ref_25 -set!_25)
- (let-values ()
- (let-values ()
- (make-struct-type 'non-source-shift #f 2 0 #f null 'prefab #f '(0 1) #f 'non-source-shift)))))
+ (let-values (((struct:_31 make-_31 ?_31 -ref_31 -set!_31)
+ (make-struct-type 'non-source-shift #f 2 0 #f null 'prefab #f '(0 1) #f 'non-source-shift)))
(values
- struct:_25
- make-_25
- ?_25
- (make-struct-field-accessor -ref_25 0 'from)
- (make-struct-field-accessor -ref_25 1 'to))))
- (define-values (shift-from) (lambda (s_167) (begin (if (pair? s_167) (car s_167) (non-source-shift-from s_167)))))
- (define-values (shift-to) (lambda (s_168) (begin (if (pair? s_168) (cdr s_168) (non-source-shift-to s_168)))))
+ struct:_31
+ make-_31
+ ?_31
+ (make-struct-field-accessor -ref_31 0 'from)
+ (make-struct-field-accessor -ref_31 1 'to))))
+ (define-values (shift-from) (lambda (s_192) (begin (if (pair? s_192) (car s_192) (non-source-shift-from s_192)))))
+ (define-values (shift-to) (lambda (s_193) (begin (if (pair? s_193) (cdr s_193) (non-source-shift-to s_193)))))
(define-values
(syntax-module-path-index-shift.1)
(lambda (non-source?12_0 s15_0 from-mpi16_0 to-mpi17_0 inspector14_0)
(begin
'syntax-module-path-index-shift
- (let-values (((s_31) s15_0))
- (let-values (((from-mpi_1) from-mpi16_0))
- (let-values (((to-mpi_1) to-mpi17_0))
+ (let-values (((s_194) s15_0))
+ (let-values (((from-mpi_3) from-mpi16_0))
+ (let-values (((to-mpi_3) to-mpi17_0))
(let-values (((inspector_3) inspector14_0))
(let-values (((non-source?_0) non-source?12_0))
- (let-values ()
- (if (eq? from-mpi_1 to-mpi_1)
- (let-values () (if inspector_3 (syntax-set-inspector s_31 inspector_3) s_31))
- (let-values ()
- (let-values (((shift_0)
- (if non-source?_0
- (non-source-shift11.1 from-mpi_1 to-mpi_1)
- (cons from-mpi_1 to-mpi_1))))
- (let-values (((content*_13) (syntax-content* s_31)))
- (let-values (((content_16)
- (if (modified-content? content*_13)
- (modified-content-content content*_13)
- content*_13)))
- (let-values (((the-struct_25) s_31))
- (if (syntax?$1 the-struct_25)
- (let-values (((mpi-shifts79_0) (shift-cons shift_0 (syntax-mpi-shifts s_31)))
- ((inspector80_0)
- (let-values (((or-part_138) (syntax-inspector s_31)))
- (if or-part_138 or-part_138 inspector_3)))
- ((content*81_0)
- (if (datum-has-elements? content_16)
- (modified-content1.1
- content_16
- (propagation-mpi-shift
- (if (modified-content? content*_13)
- (modified-content-scope-propagations+taint content*_13)
- #f)
- (lambda (s_169) (shift-cons shift_0 s_169))
- inspector_3
- (syntax-scopes s_31)
- (syntax-shifted-multi-scopes s_31)
- (syntax-mpi-shifts s_31)))
- content*_13)))
- (syntax2.1
- content*81_0
- (syntax-scopes the-struct_25)
- (syntax-shifted-multi-scopes the-struct_25)
- mpi-shifts79_0
- (syntax-srcloc$1 the-struct_25)
- (syntax-props the-struct_25)
- inspector80_0))
- (raise-argument-error 'struct-copy "syntax?" the-struct_25)))))))))))))))))
+ (if (eq? from-mpi_3 to-mpi_3)
+ (if inspector_3 (syntax-set-inspector s_194 inspector_3) s_194)
+ (let-values (((shift_0)
+ (if non-source?_0
+ (non-source-shift11.1 from-mpi_3 to-mpi_3)
+ (cons from-mpi_3 to-mpi_3))))
+ (let-values (((content*_13) (syntax-content* s_194)))
+ (let-values (((content_16)
+ (if (modified-content? content*_13)
+ (modified-content-content content*_13)
+ content*_13)))
+ (let-values (((the-struct_25) s_194))
+ (if (syntax?$1 the-struct_25)
+ (let-values (((mpi-shifts79_0) (shift-cons shift_0 (syntax-mpi-shifts s_194)))
+ ((inspector80_0)
+ (let-values (((or-part_198) (syntax-inspector s_194)))
+ (if or-part_198 or-part_198 inspector_3)))
+ ((content*81_0)
+ (if (datum-has-elements? content_16)
+ (modified-content1.1
+ content_16
+ (propagation-mpi-shift
+ (if (modified-content? content*_13)
+ (modified-content-scope-propagations+taint content*_13)
+ #f)
+ (lambda (s_195) (shift-cons shift_0 s_195))
+ inspector_3
+ (syntax-scopes s_194)
+ (syntax-shifted-multi-scopes s_194)
+ (syntax-mpi-shifts s_194)))
+ content*_13)))
+ (syntax2.1
+ content*81_0
+ (syntax-scopes the-struct_25)
+ (syntax-shifted-multi-scopes the-struct_25)
+ mpi-shifts79_0
+ (syntax-srcloc$1 the-struct_25)
+ (syntax-props the-struct_25)
+ inspector80_0))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_25)))))))))))))))
(define-values
(shift-cons)
(lambda (shift_1 shifts_1)
(begin
(if (if (pair? shifts_1) (eq? (shift-from shift_1) (shift-from (car shifts_1))) #f)
- (let-values () shifts_1)
- (let-values () (cons shift_1 shifts_1))))))
+ shifts_1
+ (cons shift_1 shifts_1)))))
+ (define-values
+ (binding-free=id-phase)
+ (lambda (immediate-b_0) (begin (if (module-binding? immediate-b_0) (module-binding-phase immediate-b_0) 0))))
(define-values
(resolve+shift.1)
(lambda (ambiguous-value19_0 exactly?20_0 extra-shifts23_0 immediate?21_0 unbound-sym?22_0 s29_1 phase30_0)
(begin
'resolve+shift
- (let-values (((s_40) s29_1))
- (let-values (((phase_26) phase30_0))
+ (let-values (((s_196) s29_1))
+ (let-values (((phase_32) phase30_0))
(let-values (((ambiguous-value_1) ambiguous-value19_0))
- (let-values (((exactly?_3) exactly?20_0))
- (let-values (((immediate?_0) (if (eq? immediate?21_0 unsafe-undefined) exactly?_3 immediate?21_0)))
+ (let-values (((exactly?_4) exactly?20_0))
+ (let-values (((immediate?_0) (if (eq? immediate?21_0 unsafe-undefined) exactly?_4 immediate?21_0)))
(let-values (((unbound-sym?_0) unbound-sym?22_0))
- (let-values (((extra-shifts_8) extra-shifts23_0))
- (let-values ()
- (let-values (((can-cache?_0)
- (if (not exactly?_3) (if (not immediate?_0) (null? extra-shifts_8) #f) #f)))
- (let-values (((c1_22) (if can-cache?_0 (resolve+shift-cache-get s_40 phase_26) #f)))
- (if c1_22
- ((lambda (b_51) (if (eq? b_51 '#:none) (if unbound-sym?_0 (syntax-content s_40) #f) b_51))
- c1_22)
- (let-values ()
- (let-values (((immediate-b_0)
- (let-values (((s82_0) s_40)
- ((phase83_0) phase_26)
- ((ambiguous-value84_0) ambiguous-value_1)
- ((exactly?85_0) exactly?_3)
- ((extra-shifts86_0) extra-shifts_8))
- (resolve.1
- ambiguous-value84_0
- exactly?85_0
- extra-shifts86_0
- #f
- s82_0
- phase83_0))))
- (let-values (((b_41)
- (if (if immediate-b_0
- (if (not immediate?_0) (binding-free=id immediate-b_0) #f)
- #f)
- (let-values (((temp87_0) (binding-free=id immediate-b_0))
- ((phase88_0) phase_26)
- ((temp89_0)
- (append extra-shifts_8 (syntax-mpi-shifts s_40)))
- ((ambiguous-value90_0) ambiguous-value_1)
- ((exactly?91_0) exactly?_3)
- ((unbound-sym?92_0) unbound-sym?_0))
- (resolve+shift.1
- ambiguous-value90_0
- exactly?91_0
- temp89_0
- unsafe-undefined
- unbound-sym?92_0
- temp87_0
- phase88_0))
- immediate-b_0)))
- (if (module-binding? b_41)
- (let-values ()
- (let-values (((mpi-shifts_2) (syntax-mpi-shifts s_40)))
- (if (null? mpi-shifts_2)
- (let-values () b_41)
- (let-values ()
- (let-values (((mod_0) (module-binding-module b_41)))
- (let-values (((shifted-mod_0) (apply-syntax-shifts mod_0 mpi-shifts_2)))
- (let-values (((nominal-mod_0) (module-binding-nominal-module b_41)))
- (let-values (((shifted-nominal-mod_0)
- (if (eq? mod_0 nominal-mod_0)
- shifted-mod_0
- (apply-syntax-shifts nominal-mod_0 mpi-shifts_2))))
- (let-values (((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_41))
- (null?
- (module-binding-extra-nominal-bindings
- b_41))
- #f)
- #f)
- #f)
- b_41
- (let-values (((b93_0) b_41)
- ((shifted-mod94_0) shifted-mod_0)
- ((shifted-nominal-mod95_0)
- shifted-nominal-mod_0)
- ((temp96_0)
- (if (binding-free=id b_41)
- (let-values (((temp98_0)
- (binding-free=id
- b_41))
- ((s99_0) s_40))
- (syntax-transfer-shifts.1
- #f
- temp98_0
- s99_0
- #f))
- #f))
- ((temp97_0)
- (reverse$1
- (let-values (((lst_55)
- (module-binding-extra-nominal-bindings
- b_41)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_55)))
- ((letrec-values (((for-loop_78)
- (lambda (fold-var_37
- lst_56)
- (begin
- 'for-loop
- (if (pair?
- lst_56)
- (let-values (((b_52)
- (unsafe-car
- lst_56))
- ((rest_25)
- (unsafe-cdr
- lst_56)))
- (let-values (((fold-var_38)
- (let-values (((fold-var_39)
- fold-var_37))
- (let-values (((fold-var_40)
- (let-values ()
- (cons
- (let-values ()
- (apply-syntax-shifts-to-binding
- b_52
- mpi-shifts_2))
- fold-var_39))))
- (values
- fold-var_40)))))
- (if (not
- #f)
- (for-loop_78
- fold-var_38
- rest_25)
- fold-var_38)))
- fold-var_37)))))
- for-loop_78)
- null
- lst_55))))))
- (module-binding-update.1
- unsafe-undefined
- temp97_0
- unsafe-undefined
- temp96_0
- shifted-mod94_0
- shifted-nominal-mod95_0
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- b93_0)))))
- (begin
- (if can-cache?_0
- (let-values ()
- (resolve+shift-cache-set! s_40 phase_26 result-b_0))
- (void))
- result-b_0))))))))))
- (if (like-ambiguous-binding? b_41)
- (let-values () (if unbound-sym?_0 (syntax-content s_40) ambiguous-value_1))
- (let-values ()
- (begin
- (if can-cache?_0
- (let-values ()
- (resolve+shift-cache-set!
- s_40
- phase_26
- (let-values (((or-part_139) b_41))
- (if or-part_139 or-part_139 '#:none))))
- (void))
- (let-values (((or-part_140) b_41))
- (if or-part_140
- or-part_140
- (if unbound-sym?_0 (syntax-content s_40) #f))))))))))))))))))))))))
+ (let-values (((extra-shifts_9) extra-shifts23_0))
+ (let-values (((can-cache?_0)
+ (if (not exactly?_4) (if (not immediate?_0) (null? extra-shifts_9) #f) #f)))
+ (let-values (((cond-val_6) (if can-cache?_0 (resolve+shift-cache-get s_196 phase_32) #f)))
+ (if cond-val_6
+ ((lambda (b_64) (if (eq? b_64 '#:none) (if unbound-sym?_0 (syntax-content s_196) #f) b_64))
+ cond-val_6)
+ (let-values (((immediate-b_1)
+ (let-values (((s82_0) s_196)
+ ((phase83_0) phase_32)
+ ((ambiguous-value84_0) ambiguous-value_1)
+ ((exactly?85_0) exactly?_4)
+ ((extra-shifts86_0) extra-shifts_9))
+ (resolve.1
+ ambiguous-value84_0
+ exactly?85_0
+ extra-shifts86_0
+ #f
+ s82_0
+ phase83_0))))
+ (let-values (((b_65)
+ (if (if immediate-b_1
+ (if (not immediate?_0) (binding-free=id immediate-b_1) #f)
+ #f)
+ (let-values (((temp87_0) (binding-free=id immediate-b_1))
+ ((temp88_0) (binding-free=id-phase immediate-b_1))
+ ((temp89_0) (append extra-shifts_9 (syntax-mpi-shifts s_196)))
+ ((ambiguous-value90_0) ambiguous-value_1)
+ ((exactly?91_0) exactly?_4)
+ ((unbound-sym?92_0) unbound-sym?_0))
+ (resolve+shift.1
+ ambiguous-value90_0
+ exactly?91_0
+ temp89_0
+ unsafe-undefined
+ unbound-sym?92_0
+ temp87_0
+ temp88_0))
+ immediate-b_1)))
+ (if (module-binding? b_65)
+ (let-values (((mpi-shifts_2) (syntax-mpi-shifts s_196)))
+ (if (null? mpi-shifts_2)
+ b_65
+ (let-values (((mod_0) (module-binding-module b_65)))
+ (let-values (((shifted-mod_0) (apply-syntax-shifts mod_0 mpi-shifts_2)))
+ (let-values (((nominal-mod_0) (module-binding-nominal-module b_65)))
+ (let-values (((shifted-nominal-mod_0)
+ (if (eq? mod_0 nominal-mod_0)
+ shifted-mod_0
+ (apply-syntax-shifts nominal-mod_0 mpi-shifts_2))))
+ (let-values (((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_65))
+ (null? (module-binding-extra-nominal-bindings b_65))
+ #f)
+ #f)
+ #f)
+ b_65
+ (let-values (((b93_0) b_65)
+ ((shifted-mod94_0) shifted-mod_0)
+ ((shifted-nominal-mod95_0)
+ shifted-nominal-mod_0)
+ ((temp96_0)
+ (if (binding-free=id b_65)
+ (let-values (((temp98_0)
+ (binding-free=id b_65))
+ ((s99_0) s_196))
+ (syntax-transfer-shifts.1
+ #f
+ temp98_0
+ s99_0
+ #f))
+ #f))
+ ((temp97_0)
+ (reverse$1
+ (let-values (((fold-var_50)
+ (let-values (((fold-var_51)
+ null))
+ fold-var_51)))
+ (let-values (((lst_61)
+ (module-binding-extra-nominal-bindings
+ b_65)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_61))
+ ((letrec-values (((for-loop_86)
+ (lambda (fold-var_52
+ lst_62)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_62)
+ (let-values (((b_66)
+ (unsafe-car
+ lst_62))
+ ((rest_27)
+ (unsafe-cdr
+ lst_62)))
+ (let-values (((fold-var_53)
+ (let-values (((fold-var_54)
+ (cons
+ (apply-syntax-shifts-to-binding
+ b_66
+ mpi-shifts_2)
+ fold-var_52)))
+ (values
+ fold-var_54))))
+ (if (not
+ #f)
+ (for-loop_86
+ fold-var_53
+ rest_27)
+ fold-var_53)))
+ fold-var_52)))))
+ for-loop_86)
+ fold-var_50
+ lst_61)))))))
+ (module-binding-update.1
+ unsafe-undefined
+ temp97_0
+ unsafe-undefined
+ temp96_0
+ shifted-mod94_0
+ shifted-nominal-mod95_0
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ b93_0)))))
+ (begin
+ (if can-cache?_0
+ (resolve+shift-cache-set! s_196 phase_32 result-b_0)
+ (void))
+ result-b_0))))))))
+ (if (like-ambiguous-binding? b_65)
+ (if unbound-sym?_0 (syntax-content s_196) ambiguous-value_1)
+ (begin
+ (if can-cache?_0
+ (resolve+shift-cache-set!
+ s_196
+ phase_32
+ (let-values (((or-part_199) b_65)) (if or-part_199 or-part_199 '#:none)))
+ (void))
+ (let-values (((or-part_200) b_65))
+ (if or-part_200
+ or-part_200
+ (if unbound-sym?_0 (syntax-content s_196) #f)))))))))))))))))))))
(define-values
(apply-syntax-shifts)
- (lambda (mpi_14 shifts_2)
+ (lambda (mpi_16 shifts_2)
(begin
(if (null? shifts_2)
- (let-values () mpi_14)
- (let-values ()
- (let-values (((shifted-mpi_1) (apply-syntax-shifts mpi_14 (cdr shifts_2))))
- (let-values (((shift_2) (car shifts_2)))
- (module-path-index-shift shifted-mpi_1 (shift-from shift_2) (shift-to shift_2)))))))))
+ mpi_16
+ (let-values (((shifted-mpi_1) (apply-syntax-shifts mpi_16 (cdr shifts_2))))
+ (let-values (((shift_2) (car shifts_2)))
+ (module-path-index-shift shifted-mpi_1 (shift-from shift_2) (shift-to shift_2))))))))
(define-values
(apply-syntax-shifts-to-binding)
- (lambda (b_53 shifts_3)
+ (lambda (b_67 shifts_3)
(begin
(if (null? shifts_3)
- (let-values () b_53)
- (let-values ()
- (let-values (((shifted-b_0) (apply-syntax-shifts-to-binding b_53 (cdr shifts_3))))
- (let-values (((shift_3) (car shifts_3)))
- (binding-module-path-index-shift shifted-b_0 (shift-from shift_3) (shift-to shift_3)))))))))
+ b_67
+ (let-values (((shifted-b_0) (apply-syntax-shifts-to-binding b_67 (cdr shifts_3))))
+ (let-values (((shift_3) (car shifts_3)))
+ (binding-module-path-index-shift shifted-b_0 (shift-from shift_3) (shift-to shift_3))))))))
(define-values
(binding-module-path-index-shift)
- (lambda (b_54 from-mpi_2 to-mpi_2)
+ (lambda (b_68 from-mpi_4 to-mpi_4)
(begin
- (if (module-binding? b_54)
- (let-values ()
- (let-values (((b100_0) b_54)
- ((temp101_0) (module-path-index-shift (module-binding-module b_54) from-mpi_2 to-mpi_2))
- ((temp102_0) (module-path-index-shift (module-binding-nominal-module b_54) from-mpi_2 to-mpi_2))
- ((temp103_0)
- (reverse$1
- (let-values (((lst_57) (module-binding-extra-nominal-bindings b_54)))
+ (if (module-binding? b_68)
+ (let-values (((b100_0) b_68)
+ ((temp101_0) (module-path-index-shift (module-binding-module b_68) from-mpi_4 to-mpi_4))
+ ((temp102_0) (module-path-index-shift (module-binding-nominal-module b_68) from-mpi_4 to-mpi_4))
+ ((temp103_0)
+ (reverse$1
+ (let-values (((fold-var_55) (let-values (((fold-var_56) null)) fold-var_56)))
+ (let-values (((lst_63) (module-binding-extra-nominal-bindings b_68)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_57)))
- ((letrec-values (((for-loop_79)
- (lambda (fold-var_41 lst_58)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_63))
+ ((letrec-values (((for-loop_87)
+ (lambda (fold-var_57 lst_64)
(begin
'for-loop
- (if (pair? lst_58)
- (let-values (((b_55) (unsafe-car lst_58))
- ((rest_26) (unsafe-cdr lst_58)))
- (let-values (((fold-var_42)
- (let-values (((fold-var_43) fold-var_41))
- (let-values (((fold-var_44)
- (let-values ()
- (cons
- (let-values ()
- (binding-module-path-index-shift
- b_55
- from-mpi_2
- to-mpi_2))
- fold-var_43))))
- (values fold-var_44)))))
- (if (not #f) (for-loop_79 fold-var_42 rest_26) fold-var_42)))
- fold-var_41)))))
- for-loop_79)
- null
- lst_57))))))
- (module-binding-update.1
- unsafe-undefined
- temp103_0
- unsafe-undefined
- unsafe-undefined
- temp101_0
- temp102_0
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- b100_0)))
- (let-values () b_54)))))
+ (if (pair? lst_64)
+ (let-values (((b_69) (unsafe-car lst_64))
+ ((rest_28) (unsafe-cdr lst_64)))
+ (let-values (((fold-var_58)
+ (let-values (((fold-var_59)
+ (cons
+ (binding-module-path-index-shift
+ b_69
+ from-mpi_4
+ to-mpi_4)
+ fold-var_57)))
+ (values fold-var_59))))
+ (if (not #f) (for-loop_87 fold-var_58 rest_28) fold-var_58)))
+ fold-var_57)))))
+ for-loop_87)
+ fold-var_55
+ lst_63)))))))
+ (module-binding-update.1
+ unsafe-undefined
+ temp103_0
+ unsafe-undefined
+ unsafe-undefined
+ temp101_0
+ temp102_0
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ b100_0))
+ b_68))))
(define-values
(syntax-transfer-shifts.1)
(lambda (non-source?32_0 to-s35_0 from-s36_0 inspector34_0)
@@ -12026,12 +11609,11 @@
(let-values (((from-s_1) from-s36_0))
(let-values (((inspector_4) inspector34_0))
(let-values (((non-source?_1) non-source?32_0))
- (let-values ()
- (let-values (((to-s104_0) to-s_0)
- ((temp105_0) (syntax-mpi-shifts from-s_1))
- ((inspector106_0) inspector_4)
- ((non-source?107_0) non-source?_1))
- (syntax-add-shifts.1 non-source?107_0 to-s104_0 temp105_0 inspector106_0))))))))))
+ (let-values (((to-s104_0) to-s_0)
+ ((temp105_0) (syntax-mpi-shifts from-s_1))
+ ((inspector106_0) inspector_4)
+ ((non-source?107_0) non-source?_1))
+ (syntax-add-shifts.1 non-source?107_0 to-s104_0 temp105_0 inspector106_0)))))))))
(define-values
(syntax-add-shifts.1)
(lambda (non-source?38_0 to-s41_0 shifts42_0 inspector40_0)
@@ -12041,65 +11623,58 @@
(let-values (((shifts_4) shifts42_0))
(let-values (((inspector_5) inspector40_0))
(let-values (((non-source?_2) non-source?38_0))
- (let-values ()
- (if (if (null? shifts_4) inspector_5 #f)
- (let-values () (syntax-set-inspector to-s_1 inspector_5))
- (let-values ()
- (let-values (((lst_59) (reverse$1 shifts_4)) ((start_15) 0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_59)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-naturals start_15)))
- ((letrec-values (((for-loop_80)
- (lambda (s_170 lst_60 pos_12)
- (begin
- 'for-loop
- (if (if (pair? lst_60) #t #f)
- (let-values (((shift_4) (unsafe-car lst_60))
- ((rest_27) (unsafe-cdr lst_60))
- ((i_81) pos_12))
- (let-values (((s_127)
- (let-values (((s_128) s_170))
- (let-values (((s_129)
- (let-values ()
- (let-values (((s108_0) s_128)
- ((temp109_0)
- (shift-from shift_4))
- ((temp110_0)
- (shift-to shift_4))
- ((temp111_0)
- (if (zero? i_81)
- inspector_5
- #f))
- ((non-source?112_0)
- non-source?_2))
- (syntax-module-path-index-shift.1
- non-source?112_0
- s108_0
- temp109_0
- temp110_0
- temp111_0)))))
- (values s_129)))))
- (if (not #f) (for-loop_80 s_127 rest_27 (+ pos_12 1)) s_127)))
- s_170)))))
- for-loop_80)
- to-s_1
- lst_59
- start_15)))))))))))))
+ (if (if (null? shifts_4) inspector_5 #f)
+ (syntax-set-inspector to-s_1 inspector_5)
+ (let-values (((s_197) (let-values (((s_198) to-s_1)) s_198)))
+ (let-values (((lst_65) (reverse$1 shifts_4)) ((start_20) 0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_65))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-naturals start_20))
+ ((letrec-values (((for-loop_88)
+ (lambda (s_199 lst_66 pos_21)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_66) #t #f)
+ (let-values (((shift_4) (unsafe-car lst_66))
+ ((rest_29) (unsafe-cdr lst_66))
+ ((i_105) pos_21))
+ (let-values (((s_200)
+ (let-values (((s_201)
+ (let-values (((s108_0) s_199)
+ ((temp109_0)
+ (shift-from shift_4))
+ ((temp110_0)
+ (shift-to shift_4))
+ ((temp111_0)
+ (if (zero? i_105)
+ inspector_5
+ #f))
+ ((non-source?112_0)
+ non-source?_2))
+ (syntax-module-path-index-shift.1
+ non-source?112_0
+ s108_0
+ temp109_0
+ temp110_0
+ temp111_0))))
+ (values s_201))))
+ (if (not #f) (for-loop_88 s_200 rest_29 (+ pos_21 1)) s_200)))
+ s_199)))))
+ for-loop_88)
+ s_197
+ lst_65
+ start_20))))))))))))
(define-values
(syntax-set-inspector)
- (lambda (s_171 insp_2)
+ (lambda (s_202 insp_2)
(begin
- (let-values (((content*_14) (syntax-content* s_171)))
+ (let-values (((content*_14) (syntax-content* s_202)))
(let-values (((content_17)
(if (modified-content? content*_14) (modified-content-content content*_14) content*_14)))
- (let-values (((the-struct_26) s_171))
+ (let-values (((the-struct_26) s_202))
(if (syntax?$1 the-struct_26)
(let-values (((inspector113_0)
- (let-values (((or-part_141) (syntax-inspector s_171))) (if or-part_141 or-part_141 insp_2)))
+ (let-values (((or-part_201) (syntax-inspector s_202))) (if or-part_201 or-part_201 insp_2)))
((content*114_0)
(if (datum-has-elements? content_17)
(modified-content1.1
@@ -12110,9 +11685,9 @@
#f)
#f
insp_2
- (syntax-scopes s_171)
- (syntax-shifted-multi-scopes s_171)
- (syntax-mpi-shifts s_171)))
+ (syntax-scopes s_202)
+ (syntax-shifted-multi-scopes s_202)
+ (syntax-mpi-shifts s_202)))
content*_14)))
(syntax2.1
content*114_0
@@ -12129,76 +11704,64 @@
(lambda (s45_0 source?44_0)
(begin
'syntax-source-module
- (let-values (((s_172) s45_0))
+ (let-values (((s_203) s45_0))
(let-values (((source?_0) source?44_0))
- (let-values ()
- (begin
- (if (syntax?$1 s_172)
- (void)
- (let-values () (raise-argument-error 'syntax-track-origin "syntax?" s_172)))
- (let-values (((lst_61) (reverse$1 (syntax-mpi-shifts s_172))))
+ (begin
+ (if (syntax?$1 s_203) (void) (raise-argument-error 'syntax-track-origin "syntax?" s_203))
+ (let-values (((result_87) (let-values (((result_88) #f)) result_88)))
+ (let-values (((lst_67) (reverse$1 (syntax-mpi-shifts s_203))))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_61)))
- ((letrec-values (((for-loop_81)
- (lambda (result_47 lst_62)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_67))
+ ((letrec-values (((for-loop_89)
+ (lambda (result_89 lst_68)
(begin
'for-loop
- (if (pair? lst_62)
- (let-values (((shift_5) (unsafe-car lst_62))
- ((rest_28) (unsafe-cdr lst_62)))
- (let-values (((result_48)
- (let-values (((result_49) result_47))
- (if (non-source-shift? shift_5)
- result_49
- (let-values ()
- (let-values (((result_50)
- (let-values ()
- (let-values ()
- (let-values (((from-mpi_3)
- (car
- shift_5)))
- (let-values (((path_8
- base_15)
- (1/module-path-index-split
- from-mpi_3)))
- (if (not path_8)
- (if (module-path-index-resolved
- from-mpi_3)
- (let-values (((mpi_15)
- (apply-syntax-shifts
- from-mpi_3
- (syntax-mpi-shifts
- s_172))))
- (if source?_0
- (1/resolved-module-path-name
- (1/module-path-index-resolve
- mpi_15
- #f))
- mpi_15))
- #f)
- #f)))))))
- (values result_50)))))))
- (if (if (not ((lambda x_32 result_48) shift_5)) (not #f) #f)
- (for-loop_81 result_48 rest_28)
- result_48)))
- result_47)))))
- for-loop_81)
- #f
- lst_61)))))))))))
+ (if (pair? lst_68)
+ (let-values (((shift_5) (unsafe-car lst_68))
+ ((rest_30) (unsafe-cdr lst_68)))
+ (let-values (((result_90)
+ (if (non-source-shift? shift_5)
+ result_89
+ (let-values (((result_91)
+ (let-values (((from-mpi_5)
+ (car shift_5)))
+ (let-values (((path_7 base_17)
+ (1/module-path-index-split
+ from-mpi_5)))
+ (if (not path_7)
+ (if (module-path-index-resolved
+ from-mpi_5)
+ (let-values (((mpi_17)
+ (apply-syntax-shifts
+ from-mpi_5
+ (syntax-mpi-shifts
+ s_203))))
+ (if source?_0
+ (1/resolved-module-path-name
+ (1/module-path-index-resolve
+ mpi_17
+ #f))
+ mpi_17))
+ #f)
+ #f)))))
+ (values result_91)))))
+ (if (if (not ((lambda x_36 result_90) shift_5)) (not #f) #f)
+ (for-loop_89 result_90 rest_30)
+ result_90)))
+ result_89)))))
+ for-loop_89)
+ result_87
+ lst_67)))))))))))
(case-lambda
- ((s_173) (begin 'syntax-source-module (syntax-source-module_0 s_173 #f)))
- ((s_174 source?44_1) (syntax-source-module_0 s_174 source?44_1)))))
+ ((s_204) (begin 'syntax-source-module (syntax-source-module_0 s_204 #f)))
+ ((s_205 source?44_1) (syntax-source-module_0 s_205 source?44_1)))))
(define-values
(1/identifier-prune-to-source-module)
(lambda (id_9)
(begin
'identifier-prune-to-source-module
(begin
- (if (identifier? id_9)
- (void)
- (let-values () (raise-argument-error 'identifier-prune-to-source-module "identifier?" id_9)))
+ (if (identifier? id_9) (void) (raise-argument-error 'identifier-prune-to-source-module "identifier?" id_9))
(let-values (((the-struct_27) (datum->syntax$1 #f (syntax-e$1 id_9) id_9 id_9)))
(if (syntax?$1 the-struct_27)
(let-values (((mpi-shifts115_0) (syntax-mpi-shifts id_9)))
@@ -12213,40 +11776,38 @@
(raise-argument-error 'struct-copy "syntax?" the-struct_27)))))))
(define-values
(struct:provided provided1.1 provided? provided-binding provided-protected? provided-syntax?)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'provided
- #f
- 3
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:serialize
- (lambda (p_19 ser-push!_4 state_13)
- (begin
- (ser-push!_4 'tag '#:provided)
- (ser-push!_4 (provided-binding p_19))
- (ser-push!_4 (provided-protected? p_19))
- (ser-push!_4 (provided-syntax? p_19))))))
- #f
- #f
- '(0 1 2)
- #f
- 'provided)))))
+ (let-values (((struct:_32 make-_32 ?_32 -ref_32 -set!_32)
+ (make-struct-type
+ 'provided
+ #f
+ 3
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:serialize
+ (lambda (p_20 ser-push!_15 state_25)
+ (begin
+ (ser-push!_15 'tag '#:provided)
+ (ser-push!_15 (provided-binding p_20))
+ (ser-push!_15 (provided-protected? p_20))
+ (ser-push!_15 (provided-syntax? p_20))))))
+ #f
+ #f
+ '(0 1 2)
+ #f
+ 'provided)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'binding)
- (make-struct-field-accessor -ref_2 1 'protected?)
- (make-struct-field-accessor -ref_2 2 'syntax?))))
- (define-values (provided-as-binding) (lambda (v_48) (begin (if (provided? v_48) (provided-binding v_48) v_48))))
- (define-values (provided-as-protected?) (lambda (v_75) (begin (if (provided? v_75) (provided-protected? v_75) #f))))
- (define-values (provided-as-transformer?) (lambda (v_1) (begin (if (provided? v_1) (provided-syntax? v_1) #f))))
+ struct:_32
+ make-_32
+ ?_32
+ (make-struct-field-accessor -ref_32 0 'binding)
+ (make-struct-field-accessor -ref_32 1 'protected?)
+ (make-struct-field-accessor -ref_32 2 'syntax?))))
+ (define-values (provided-as-binding) (lambda (v_103) (begin (if (provided? v_103) (provided-binding v_103) v_103))))
+ (define-values (provided-as-protected?) (lambda (v_104) (begin (if (provided? v_104) (provided-protected? v_104) #f))))
+ (define-values (provided-as-transformer?) (lambda (v_105) (begin (if (provided? v_105) (provided-syntax? v_105) #f))))
(define-values
(deserialize-provided)
(lambda (binding_5 protected?_0 syntax?_1) (begin (provided1.1 binding_5 protected?_0 syntax?_1))))
@@ -12256,39 +11817,38 @@
(begin
'provide-binding-to-require-binding
(let-values (((binding/p_0) binding/p9_0))
- (let-values (((sym_18) sym10_0))
- (let-values (((self_1) self1_0))
- (let-values (((mpi_16) mpi2_0))
+ (let-values (((sym_23) sym10_0))
+ (let-values (((self_2) self1_0))
+ (let-values (((mpi_18) mpi2_0))
(let-values (((provide-phase+space_0) provide-phase+space3_0))
(let-values (((phase+space-shift_1) phase+space-shift4_0))
- (let-values ()
- (let-values (((binding_6) (provided-as-binding binding/p_0)))
- (let-values (((from-mod_0) (module-binding-module binding_6)))
- (let-values (((binding15_0) binding_6)
- ((temp16_1) (module-path-index-shift from-mod_0 self_1 mpi_16))
- ((mpi17_0) mpi_16)
- ((provide-phase+space18_0) provide-phase+space_0)
- ((sym19_2) sym_18)
- ((phase+space-shift20_0) phase+space-shift_1)
- ((temp21_2) #f)
- ((temp22_1)
- (if (not (provided-as-protected? binding/p_0))
- (module-binding-extra-inspector binding_6)
- #f))
- ((null23_0) null))
- (module-binding-update.1
- temp22_1
- null23_0
- temp21_2
- unsafe-undefined
- temp16_1
- mpi17_0
- provide-phase+space18_0
- phase+space-shift20_0
- sym19_2
- unsafe-undefined
- unsafe-undefined
- binding15_0))))))))))))))
+ (let-values (((binding_6) (provided-as-binding binding/p_0)))
+ (let-values (((from-mod_0) (module-binding-module binding_6)))
+ (let-values (((binding15_0) binding_6)
+ ((temp16_1) (module-path-index-shift from-mod_0 self_2 mpi_18))
+ ((mpi17_0) mpi_18)
+ ((provide-phase+space18_0) provide-phase+space_0)
+ ((sym19_2) sym_23)
+ ((phase+space-shift20_0) phase+space-shift_1)
+ ((temp21_2) #f)
+ ((temp22_1)
+ (if (not (provided-as-protected? binding/p_0))
+ (module-binding-extra-inspector binding_6)
+ #f))
+ ((null23_0) null))
+ (module-binding-update.1
+ temp22_1
+ null23_0
+ temp21_2
+ unsafe-undefined
+ temp16_1
+ mpi17_0
+ provide-phase+space18_0
+ phase+space-shift20_0
+ sym19_2
+ unsafe-undefined
+ unsafe-undefined
+ binding15_0)))))))))))))
(define-values
(struct:bulk-binding
bulk-binding12.1
@@ -12303,241 +11863,277 @@
bulk-binding-bulk-binding-registry
set-bulk-binding-provides!
set-bulk-binding-self!)
- (let-values (((struct:_26 make-_26 ?_26 -ref_26 -set!_26)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'bulk-binding
- #f
- 8
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:serialize
- (lambda (b_56 ser-push!_7 state_17)
- (begin
- (if (if (serialize-state-keep-provides? state_17)
- ((serialize-state-keep-provides? state_17) b_56)
- #f)
- (let-values ()
- (begin
- (ser-push!_7 'tag '#:bulk-binding+provides)
- (ser-push!_7 (bulk-binding-provides b_56))
- (ser-push!_7 (bulk-binding-self b_56))))
- (let-values () (ser-push!_7 'tag '#:bulk-binding)))
- (ser-push!_7 (bulk-binding-prefix b_56))
- (ser-push!_7 (bulk-binding-excepts b_56))
- (ser-push!_7 (bulk-binding-mpi b_56))
- (ser-push!_7 (bulk-binding-provide-phase+space b_56))
- (ser-push!_7 (bulk-binding-phase+space-shift b_56))
- (ser-push!_7 'tag '#:bulk-binding-registry))))
- (cons
- prop:bulk-binding
- (bulk-binding-class3.1
- (lambda (b_57 mpi-shifts_3)
- (let-values (((or-part_142) (bulk-binding-provides b_57)))
- (if or-part_142
- or-part_142
- (let-values (((mod-name_1) (bulk-binding-module-name b_57 mpi-shifts_3)))
- (let-values ((()
- (begin
- (if (bulk-binding-bulk-binding-registry b_57)
- (void)
- (let-values ()
+ (let-values (((struct:_33 make-_33 ?_33 -ref_33 -set!_33)
+ (make-struct-type
+ 'bulk-binding
+ #f
+ 8
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:serialize
+ (lambda (b_70 ser-push!_16 state_26)
+ (let-values (((clear-registry?_0)
+ (if (let-values (((or-part_202) (not (bulk-binding-bulk-binding-registry b_70))))
+ (if or-part_202
+ or-part_202
+ (if (serialize-state-keep-provides? state_26)
+ ((serialize-state-keep-provides? state_26) b_70)
+ #f)))
+ (begin
+ (ser-push!_16 'tag '#:bulk-binding+provides)
+ (ser-push!_16 (bulk-binding-provides b_70))
+ (ser-push!_16 (bulk-binding-self b_70))
+ #t)
+ (begin (ser-push!_16 'tag '#:bulk-binding) #f))))
+ (begin
+ (ser-push!_16 (bulk-binding-prefix b_70))
+ (ser-push!_16 (bulk-binding-excepts b_70))
+ (ser-push!_16 (bulk-binding-mpi b_70))
+ (ser-push!_16 (bulk-binding-provide-phase+space b_70))
+ (ser-push!_16 (bulk-binding-phase+space-shift b_70))
+ (if clear-registry?_0 (ser-push!_16 #f) (ser-push!_16 'tag '#:bulk-binding-registry))))))
+ (cons
+ prop:bulk-binding
+ (bulk-binding-class3.1
+ (lambda (b_71 mpi-shifts_3)
+ (let-values (((or-part_203) (bulk-binding-provides b_71)))
+ (if or-part_203
+ or-part_203
+ (let-values (((mod-name_1) (bulk-binding-module-name b_71 mpi-shifts_3)))
+ (let-values ((()
+ (begin
+ (if (bulk-binding-bulk-binding-registry b_71)
+ (void)
+ (error
+ "namespace mismatch: no bulk-binding registry available:"
+ mod-name_1))
+ (values))))
+ (let-values (((table_102)
+ (bulk-binding-registry-table (bulk-binding-bulk-binding-registry b_71))))
+ (let-values (((bulk-provide_0) (hash-ref table_102 mod-name_1 #f)))
+ (let-values ((()
+ (begin
+ (if bulk-provide_0
+ (void)
(error
- "namespace mismatch: no bulk-binding registry available:"
- mod-name_1)))
- (values))))
- (let-values (((table_88)
- (bulk-binding-registry-table
- (bulk-binding-bulk-binding-registry b_57))))
- (let-values (((bulk-provide_0) (hash-ref table_88 mod-name_1 #f)))
- (let-values ((()
- (begin
- (if bulk-provide_0
- (void)
- (let-values ()
- (error
- "namespace mismatch: bulk bindings not found in registry for module:"
- mod-name_1)))
- (values))))
- (let-values ((()
- (begin
- (set-bulk-binding-self! b_57 (bulk-provide-self bulk-provide_0))
- (values))))
- (let-values (((provides_0)
- (hash-ref
- (bulk-provide-provides bulk-provide_0)
- (bulk-binding-provide-phase+space b_57)
- '#hasheq())))
- (let-values (((excepts_0) (bulk-binding-excepts b_57)))
- (let-values (((prefix_0) (bulk-binding-prefix b_57)))
- (let-values (((adjusted-provides_0)
- (if (let-values (((or-part_143) prefix_0))
- (if or-part_143
- or-part_143
- (positive? (hash-count excepts_0))))
- (let-values ()
- (bulk-provides-add-prefix-remove-exceptions
- provides_0
- prefix_0
- excepts_0))
- (let-values () provides_0))))
+ "namespace mismatch: bulk bindings not found in registry for module:"
+ mod-name_1))
+ (values))))
+ (let-values ((()
(begin
- (set-bulk-binding-provides! b_57 adjusted-provides_0)
- adjusted-provides_0))))))))))))))
- (lambda (b_58 binding_7 sym_4)
- (let-values (((binding25_0) binding_7)
- ((temp26_1)
- (if (bulk-binding-prefix b_58)
- (string->symbol
- (substring
- (symbol->string sym_4)
- (string-length (symbol->string (bulk-binding-prefix b_58)))))
- sym_4))
- ((temp27_0) (bulk-binding-self b_58))
- ((temp28_0) (bulk-binding-mpi b_58))
- ((temp29_0) (bulk-binding-provide-phase+space b_58))
- ((temp30_0) (bulk-binding-phase+space-shift b_58)))
- (provide-binding-to-require-binding.1
- temp28_0
- temp30_0
- temp29_0
- temp27_0
- binding25_0
- temp26_1)))
- (lambda (b_59 mpi-shifts_4) (bulk-binding-module-name b_59 mpi-shifts_4)))))
- (current-inspector)
- #f
- '(1 2 4 5 6 7)
- #f
- 'bulk-binding)))))
- (values
- struct:_26
- make-_26
- ?_26
- (make-struct-field-accessor -ref_26 0 'provides)
- (make-struct-field-accessor -ref_26 1 'prefix)
- (make-struct-field-accessor -ref_26 2 'excepts)
- (make-struct-field-accessor -ref_26 3 'self)
- (make-struct-field-accessor -ref_26 4 'mpi)
- (make-struct-field-accessor -ref_26 5 'provide-phase+space)
- (make-struct-field-accessor -ref_26 6 'phase+space-shift)
- (make-struct-field-accessor -ref_26 7 'bulk-binding-registry)
- (make-struct-field-mutator -set!_26 0 'provides)
- (make-struct-field-mutator -set!_26 3 'self))))
- (define-values
- (deserialize-bulk-binding)
- (lambda (prefix_1 excepts_1 mpi_17 provide-phase+space_1 phase-level_1 bulk-binding-registry_0)
- (begin
- (bulk-binding12.1
- #f
- prefix_1
- excepts_1
- #f
- mpi_17
- (intern-phase+space provide-phase+space_1)
- phase-level_1
- bulk-binding-registry_0))))
+ (set-bulk-binding-self! b_71 (bulk-provide-self bulk-provide_0))
+ (values))))
+ (let-values (((provides_0)
+ (hash-ref
+ (bulk-provide-provides bulk-provide_0)
+ (bulk-binding-provide-phase+space b_71)
+ '#hasheq())))
+ (let-values (((excepts_0) (bulk-binding-excepts b_71)))
+ (let-values (((prefix_0) (bulk-binding-prefix b_71)))
+ (let-values (((adjusted-provides_0)
+ (if (let-values (((or-part_204) prefix_0))
+ (if or-part_204
+ or-part_204
+ (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_71 adjusted-provides_0)
+ adjusted-provides_0))))))))))))))
+ (lambda (b_72 binding_7 sym_24)
+ (let-values (((binding25_0) binding_7)
+ ((temp26_1)
+ (if (bulk-binding-prefix b_72)
+ (string->symbol
+ (substring
+ (symbol->string sym_24)
+ (string-length (symbol->string (bulk-binding-prefix b_72)))))
+ sym_24))
+ ((temp27_0) (bulk-binding-self b_72))
+ ((temp28_0) (bulk-binding-mpi b_72))
+ ((temp29_0) (bulk-binding-provide-phase+space b_72))
+ ((temp30_0) (bulk-binding-phase+space-shift b_72)))
+ (provide-binding-to-require-binding.1
+ temp28_0
+ temp30_0
+ temp29_0
+ temp27_0
+ binding25_0
+ temp26_1)))
+ (lambda (b_73 mpi-shifts_4) (bulk-binding-module-name b_73 mpi-shifts_4))
+ (lambda (b_74 bulk-shifts_10 report-shifts_6)
+ (let-values ((() (begin (report-shifts_6 (bulk-binding-mpi b_74) bulk-shifts_10) (values))))
+ (let-values (((more-bulk-shifts_0)
+ (append
+ bulk-shifts_10
+ (list (cons (bulk-binding-self b_74) (bulk-binding-mpi b_74))))))
+ (let-values ((()
+ (begin (report-shifts_6 (bulk-binding-self b_74) more-bulk-shifts_0) (values))))
+ (let-values (((provides_1) (bulk-binding-provides b_74)))
+ (if provides_1
+ (begin
+ (let-values (((ht_73) provides_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash-values ht_73))
+ ((letrec-values (((for-loop_90)
+ (lambda (i_106)
+ (begin
+ 'for-loop
+ (if i_106
+ (let-values (((binding/p_1)
+ (hash-iterate-value ht_73 i_106)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((binding_8)
+ (provided-as-binding
+ binding/p_1)))
+ (if (binding-shift-report?
+ binding_8)
+ ((binding-shift-report-ref
+ binding_8)
+ binding_8
+ more-bulk-shifts_0
+ report-shifts_6)
+ (void)))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_90 (hash-iterate-next ht_73 i_106))
+ (values))))
+ (values))))))
+ for-loop_90)
+ (hash-iterate-first ht_73))))
+ (void))
+ (void))))))))))
+ (current-inspector)
+ #f
+ '(1 2 4 5 6 7)
+ #f
+ 'bulk-binding)))
+ (values
+ struct:_33
+ make-_33
+ ?_33
+ (make-struct-field-accessor -ref_33 0 'provides)
+ (make-struct-field-accessor -ref_33 1 'prefix)
+ (make-struct-field-accessor -ref_33 2 'excepts)
+ (make-struct-field-accessor -ref_33 3 'self)
+ (make-struct-field-accessor -ref_33 4 'mpi)
+ (make-struct-field-accessor -ref_33 5 'provide-phase+space)
+ (make-struct-field-accessor -ref_33 6 'phase+space-shift)
+ (make-struct-field-accessor -ref_33 7 'bulk-binding-registry)
+ (make-struct-field-mutator -set!_33 0 'provides)
+ (make-struct-field-mutator -set!_33 3 'self))))
+ (define-values
+ (deserialize-bulk-binding)
+ (lambda (prefix_1 excepts_1 mpi_19 provide-phase+space_1 phase-level_1 bulk-binding-registry_0)
+ (begin
+ (bulk-binding12.1
+ #f
+ prefix_1
+ excepts_1
+ #f
+ mpi_19
+ (intern-phase+space provide-phase+space_1)
+ phase-level_1
+ bulk-binding-registry_0))))
(define-values
(deserialize-bulk-binding+provides)
- (lambda (provides_1 self_2 prefix_2 excepts_2 mpi_18 provide-phase+space_2 phase-level_2 bulk-binding-registry_1)
+ (lambda (provides_2 self_3 prefix_2 excepts_2 mpi_20 provide-phase+space_2 phase-level_2 bulk-binding-registry_1)
(begin
(bulk-binding12.1
- provides_1
+ provides_2
prefix_2
excepts_2
- self_2
- mpi_18
+ self_3
+ mpi_20
(intern-phase+space provide-phase+space_2)
phase-level_2
bulk-binding-registry_1))))
(define-values
(bulk-provides-add-prefix-remove-exceptions)
- (lambda (provides_2 prefix_3 excepts_3)
+ (lambda (provides_3 prefix_3 excepts_3)
(begin
- (let-values (((ht_65) provides_2))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-in-hash ht_65)))
- ((letrec-values (((for-loop_82)
- (lambda (table_89 i_82)
- (begin
- 'for-loop
- (if i_82
- (let-values (((sym_19 val_20) (hash-iterate-key+value ht_65 i_82)))
- (let-values (((table_90)
- (let-values (((table_61) table_89))
- (if (hash-ref excepts_3 sym_19 #f)
- table_61
- (let-values (((table_91) table_61))
- (if (symbol-interned? sym_19)
- (let-values (((table_92) table_91))
- (let-values (((table_93)
- (let-values ()
- (let-values (((key_38 val_21)
- (let-values ()
- (values
- (if prefix_3
- (string->symbol
- (format
- "~a~a"
- prefix_3
- sym_19))
- sym_19)
- val_20))))
- (hash-set table_92 key_38 val_21)))))
- (values table_93)))
- table_91))))))
- (if (not #f) (for-loop_82 table_90 (hash-iterate-next ht_65 i_82)) table_90)))
- table_89)))))
- for-loop_82)
- '#hash()
- (hash-iterate-first ht_65)))))))
+ (let-values (((table_103) (let-values (((table_104) '#hash())) table_104)))
+ (let-values (((ht_74) provides_3))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_74))
+ ((letrec-values (((for-loop_91)
+ (lambda (table_105 i_107)
+ (begin
+ 'for-loop
+ (if i_107
+ (let-values (((sym_25 val_23) (hash-iterate-key+value ht_74 i_107)))
+ (let-values (((table_106)
+ (if (hash-ref excepts_3 sym_25 #f)
+ table_105
+ (if (symbol-interned? sym_25)
+ (let-values (((table_107)
+ (let-values (((key_41 val_24)
+ (values
+ (if prefix_3
+ (string->symbol
+ (format "~a~a" prefix_3 sym_25))
+ sym_25)
+ val_23)))
+ (hash-set table_105 key_41 val_24))))
+ (values table_107))
+ table_105))))
+ (if (not #f)
+ (for-loop_91 table_106 (hash-iterate-next ht_74 i_107))
+ table_106)))
+ table_105)))))
+ for-loop_91)
+ table_103
+ (hash-iterate-first ht_74))))))))
(define-values
(bulk-binding-module-name)
- (lambda (b_60 mpi-shifts_5)
- (begin (1/module-path-index-resolve (apply-syntax-shifts (bulk-binding-mpi b_60) mpi-shifts_5)))))
+ (lambda (b_75 mpi-shifts_5)
+ (begin (1/module-path-index-resolve (apply-syntax-shifts (bulk-binding-mpi b_75) mpi-shifts_5)))))
(define-values
(struct:bulk-provide bulk-provide13.1 bulk-provide? bulk-provide-self bulk-provide-provides)
- (let-values (((struct:_27 make-_27 ?_27 -ref_27 -set!_27)
- (let-values ()
- (let-values ()
- (make-struct-type 'bulk-provide #f 2 0 #f null (current-inspector) #f '(0 1) #f 'bulk-provide)))))
+ (let-values (((struct:_34 make-_34 ?_34 -ref_34 -set!_34)
+ (make-struct-type 'bulk-provide #f 2 0 #f null (current-inspector) #f '(0 1) #f 'bulk-provide)))
(values
- struct:_27
- make-_27
- ?_27
- (make-struct-field-accessor -ref_27 0 'self)
- (make-struct-field-accessor -ref_27 1 'provides))))
+ struct:_34
+ make-_34
+ ?_34
+ (make-struct-field-accessor -ref_34 0 'self)
+ (make-struct-field-accessor -ref_34 1 'provides))))
(define-values
(struct:bulk-binding-registry bulk-binding-registry14.1 bulk-binding-registry? bulk-binding-registry-table)
- (let-values (((struct:_28 make-_28 ?_28 -ref_28 -set!_28)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'bulk-binding-registry
- #f
- 1
- 0
- #f
- null
- (current-inspector)
- #f
- '(0)
- #f
- 'bulk-binding-registry)))))
- (values struct:_28 make-_28 ?_28 (make-struct-field-accessor -ref_28 0 'table))))
+ (let-values (((struct:_35 make-_35 ?_35 -ref_35 -set!_35)
+ (make-struct-type
+ 'bulk-binding-registry
+ #f
+ 1
+ 0
+ #f
+ null
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'bulk-binding-registry)))
+ (values struct:_35 make-_35 ?_35 (make-struct-field-accessor -ref_35 0 'table))))
(define-values (make-bulk-binding-registry) (lambda () (begin (bulk-binding-registry14.1 (make-hasheq)))))
(define-values
(register-bulk-provide!)
- (lambda (bulk-binding-registry_2 mod-name_2 self_3 provides_3)
+ (lambda (bulk-binding-registry_2 mod-name_2 self_4 provides_4)
(begin
(hash-set!
(bulk-binding-registry-table bulk-binding-registry_2)
mod-name_2
- (bulk-provide13.1 self_3 provides_3)))))
+ (bulk-provide13.1 self_4 provides_4)))))
(define-values
(registered-bulk-provide?)
(lambda (bulk-binding-registry_3 mod-name_3)
@@ -12551,29 +12147,27 @@
root-expand-context/outer-post-expansion
root-expand-context/outer-use-site-scopes
root-expand-context/outer-frame-id)
- (let-values (((struct:_29 make-_29 ?_29 -ref_29 -set!_29)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'root-expand-context
- #f
- 4
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3)
- #f
- 'root-expand-context/outer)))))
+ (let-values (((struct:_36 make-_36 ?_36 -ref_36 -set!_36)
+ (make-struct-type
+ 'root-expand-context
+ #f
+ 4
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3)
+ #f
+ 'root-expand-context/outer)))
(values
- struct:_29
- make-_29
- ?_29
- (make-struct-field-accessor -ref_29 0 'inner)
- (make-struct-field-accessor -ref_29 1 'post-expansion)
- (make-struct-field-accessor -ref_29 2 'use-site-scopes)
- (make-struct-field-accessor -ref_29 3 'frame-id))))
+ struct:_36
+ make-_36
+ ?_36
+ (make-struct-field-accessor -ref_36 0 'inner)
+ (make-struct-field-accessor -ref_36 1 'post-expansion)
+ (make-struct-field-accessor -ref_36 2 'use-site-scopes)
+ (make-struct-field-accessor -ref_36 3 'frame-id))))
(define-values
(struct:root-expand-context/inner
root-expand-context/inner2.1
@@ -12585,32 +12179,30 @@
root-expand-context/inner-defined-syms
root-expand-context/inner-counter
root-expand-context/inner-lift-key)
- (let-values (((struct:_30 make-_30 ?_30 -ref_30 -set!_30)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'root-expand-context/inner
- #f
- 7
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6)
- #f
- 'root-expand-context/inner)))))
+ (let-values (((struct:_37 make-_37 ?_37 -ref_37 -set!_37)
+ (make-struct-type
+ 'root-expand-context/inner
+ #f
+ 7
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 6)
+ #f
+ 'root-expand-context/inner)))
(values
- struct:_30
- make-_30
- ?_30
- (make-struct-field-accessor -ref_30 0 'self-mpi)
- (make-struct-field-accessor -ref_30 1 'module-scopes)
- (make-struct-field-accessor -ref_30 2 'top-level-bind-scope)
- (make-struct-field-accessor -ref_30 3 'all-scopes-stx)
- (make-struct-field-accessor -ref_30 4 'defined-syms)
- (make-struct-field-accessor -ref_30 5 'counter)
- (make-struct-field-accessor -ref_30 6 'lift-key))))
+ struct:_37
+ make-_37
+ ?_37
+ (make-struct-field-accessor -ref_37 0 'self-mpi)
+ (make-struct-field-accessor -ref_37 1 'module-scopes)
+ (make-struct-field-accessor -ref_37 2 'top-level-bind-scope)
+ (make-struct-field-accessor -ref_37 3 'all-scopes-stx)
+ (make-struct-field-accessor -ref_37 4 'defined-syms)
+ (make-struct-field-accessor -ref_37 5 'counter)
+ (make-struct-field-accessor -ref_37 6 'lift-key))))
(define-values
(root-expand-context/make)
(lambda (self-mpi_0
@@ -12638,32 +12230,32 @@
frame-id_4))))
(define-values
(root-expand-context-post-expansion)
- (lambda (v_67) (begin (root-expand-context/outer-post-expansion v_67))))
+ (lambda (v_106) (begin (root-expand-context/outer-post-expansion v_106))))
(define-values
(root-expand-context-use-site-scopes)
- (lambda (v_33) (begin (root-expand-context/outer-use-site-scopes v_33))))
- (define-values (root-expand-context-frame-id) (lambda (v_76) (begin (root-expand-context/outer-frame-id v_76))))
+ (lambda (v_107) (begin (root-expand-context/outer-use-site-scopes v_107))))
+ (define-values (root-expand-context-frame-id) (lambda (v_108) (begin (root-expand-context/outer-frame-id v_108))))
(define-values
(root-expand-context-self-mpi)
- (lambda (v_34) (begin (root-expand-context/inner-self-mpi (root-expand-context/outer-inner v_34)))))
+ (lambda (v_109) (begin (root-expand-context/inner-self-mpi (root-expand-context/outer-inner v_109)))))
(define-values
(root-expand-context-module-scopes)
- (lambda (v_66) (begin (root-expand-context/inner-module-scopes (root-expand-context/outer-inner v_66)))))
+ (lambda (v_110) (begin (root-expand-context/inner-module-scopes (root-expand-context/outer-inner v_110)))))
(define-values
(root-expand-context-top-level-bind-scope)
- (lambda (v_77) (begin (root-expand-context/inner-top-level-bind-scope (root-expand-context/outer-inner v_77)))))
+ (lambda (v_111) (begin (root-expand-context/inner-top-level-bind-scope (root-expand-context/outer-inner v_111)))))
(define-values
(root-expand-context-all-scopes-stx)
- (lambda (v_78) (begin (root-expand-context/inner-all-scopes-stx (root-expand-context/outer-inner v_78)))))
+ (lambda (v_112) (begin (root-expand-context/inner-all-scopes-stx (root-expand-context/outer-inner v_112)))))
(define-values
(root-expand-context-defined-syms)
- (lambda (v_79) (begin (root-expand-context/inner-defined-syms (root-expand-context/outer-inner v_79)))))
+ (lambda (v_113) (begin (root-expand-context/inner-defined-syms (root-expand-context/outer-inner v_113)))))
(define-values
(root-expand-context-counter)
- (lambda (v_80) (begin (root-expand-context/inner-counter (root-expand-context/outer-inner v_80)))))
+ (lambda (v_114) (begin (root-expand-context/inner-counter (root-expand-context/outer-inner v_114)))))
(define-values
(root-expand-context-lift-key)
- (lambda (v_81) (begin (root-expand-context/inner-lift-key (root-expand-context/outer-inner v_81)))))
+ (lambda (v_115) (begin (root-expand-context/inner-lift-key (root-expand-context/outer-inner v_115)))))
(define-values
(make-root-expand-context.1)
(lambda (all-scopes-stx7_0 initial-scopes4_0 outside-scope5_0 post-expansion-scope6_0 self-mpi3_0)
@@ -12678,42 +12270,40 @@
(new-multi-scope 'top-level)
post-expansion-scope6_0)))
(let-values (((all-scopes-stx_1) all-scopes-stx7_0))
- (let-values ()
- (let-values (((module-scopes_1) (list* post-expansion-scope_0 outside-scope_0 initial-scopes_0)))
- (root-expand-context/make
- self-mpi_1
- module-scopes_1
- post-expansion-scope_0
- (new-scope 'module)
- (let-values (((or-part_144) all-scopes-stx_1))
- (if or-part_144 or-part_144 (add-scopes empty-syntax module-scopes_1)))
- (box null)
- (make-hasheqv)
- (string->uninterned-symbol "root-frame")
- (box 0)
- (generate-lift-key))))))))))))
+ (let-values (((module-scopes_1) (list* post-expansion-scope_0 outside-scope_0 initial-scopes_0)))
+ (root-expand-context/make
+ self-mpi_1
+ module-scopes_1
+ post-expansion-scope_0
+ (new-scope 'module)
+ (let-values (((or-part_205) all-scopes-stx_1))
+ (if or-part_205 or-part_205 (add-scopes empty-syntax module-scopes_1)))
+ (box null)
+ (make-hasheqv)
+ (string->uninterned-symbol "root-frame")
+ (box 0)
+ (generate-lift-key)))))))))))
(define-values
(apply-post-expansion)
- (lambda (pe_0 s_36)
+ (lambda (pe_0 s_206)
(begin
(if (not pe_0)
- (let-values () s_36)
+ s_206
(if (shifted-multi-scope? pe_0)
- (let-values () (push-scope s_36 pe_0))
+ (push-scope s_206 pe_0)
(if (pair? pe_0)
- (let-values ()
- (let-values (((temp16_2) (push-scope s_36 (car pe_0))) ((temp17_0) (cdr pe_0)))
- (syntax-add-shifts.1 #f temp16_2 temp17_0 #f)))
- (let-values () (pe_0 s_36))))))))
+ (let-values (((temp16_2) (push-scope s_206 (car pe_0))) ((temp17_0) (cdr pe_0)))
+ (syntax-add-shifts.1 #f temp16_2 temp17_0 #f))
+ (pe_0 s_206)))))))
(define-values
(post-expansion-scope)
(lambda (pe_1)
(begin
(if (shifted-multi-scope? pe_1)
- (let-values () pe_1)
+ pe_1
(if (pair? pe_1)
- (let-values () (car pe_1))
- (let-values () (error 'post-expansion-scope "internal error: cannot extract scope from ~s" pe_1)))))))
+ (car pe_1)
+ (error 'post-expansion-scope "internal error: cannot extract scope from ~s" pe_1))))))
(define-values
(root-expand-context-encode-for-module)
(lambda (ctx_0 orig-self_0 new-self_0)
@@ -12728,34 +12318,34 @@
((new-self20_0) new-self_0))
(syntax-module-path-index-shift.1 #f temp18_0 orig-self19_0 new-self20_0 #f))
(add-scopes empty-syntax (unbox (root-expand-context-use-site-scopes ctx_0)))
- (let-values (((ht_66) (root-expand-context-defined-syms ctx_0)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-in-hash ht_66)))
- ((letrec-values (((for-loop_83)
- (lambda (table_94 i_83)
- (begin
- 'for-loop
- (if i_83
- (let-values (((phase_27 ht_67) (hash-iterate-key+value ht_66 i_83)))
- (let-values (((table_95)
- (let-values (((table_96) table_94))
- (let-values (((table_97)
- (let-values ()
- (let-values (((key_39 val_22)
- (let-values ()
- (values phase_27 ht_67))))
- (hash-set table_96 key_39 val_22)))))
- (values table_97)))))
- (if (not #f) (for-loop_83 table_95 (hash-iterate-next ht_66 i_83)) table_95)))
- table_94)))))
- for-loop_83)
- '#hasheqv()
- (hash-iterate-first ht_66))))
+ (let-values (((table_108) (let-values (((table_109) '#hasheqv())) table_109)))
+ (let-values (((ht_75) (root-expand-context-defined-syms ctx_0)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_75))
+ ((letrec-values (((for-loop_92)
+ (lambda (table_110 i_108)
+ (begin
+ 'for-loop
+ (if i_108
+ (let-values (((phase_33 ht_76) (hash-iterate-key+value ht_75 i_108)))
+ (let-values (((table_111)
+ (let-values (((table_112)
+ (let-values (((key_42 val_25)
+ (values phase_33 ht_76)))
+ (hash-set table_110 key_42 val_25))))
+ (values table_112))))
+ (if (not #f)
+ (for-loop_92 table_111 (hash-iterate-next ht_75 i_108))
+ table_111)))
+ table_110)))))
+ for-loop_92)
+ table_108
+ (hash-iterate-first ht_75)))))
(root-expand-context-frame-id ctx_0)
(unbox (root-expand-context-counter ctx_0)))))))
(define-values
(root-expand-context-decode-for-module)
- (lambda (vec-s_0 self_2)
+ (lambda (vec-s_0 self_5)
(begin
(let-values (((vec_31) (if (syntax?$1 vec-s_0) (syntax-e$1 vec-s_0) #f)))
(begin
@@ -12777,9 +12367,9 @@
#f)
#f)
(void)
- (let-values () (error 'root-expand-context-decode-for-module "bad encoding: ~s" vec-s_0)))
+ (error 'root-expand-context-decode-for-module "bad encoding: ~s" vec-s_0))
(root-expand-context/make
- self_2
+ self_5
(extract-scope-list (vector-ref vec_31 0))
(cons (extract-scope (vector-ref vec_31 1)) (extract-shifts (vector-ref vec_31 1)))
(new-scope 'module)
@@ -12791,80 +12381,78 @@
(generate-lift-key)))))))
(define-values
(defined-syms-hash?)
- (lambda (v_82)
+ (lambda (v_116)
(begin
- (let-values (((ht_68) v_82))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-in-hash ht_68)))
- ((letrec-values (((for-loop_11)
- (lambda (result_51 i_84)
- (begin
- 'for-loop
- (if i_84
- (let-values (((phase_28 ht-s_0) (hash-iterate-key+value ht_68 i_84)))
- (let-values (((result_52)
- (let-values ()
- (let-values (((result_53)
- (let-values ()
- (let-values ()
- (if (phase? phase_28)
- (if (hash? (syntax-e$1 ht-s_0))
- (let-values (((ht_69) (syntax-e$1 ht-s_0)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_69)))
- ((letrec-values (((for-loop_84)
- (lambda (result_54 i_85)
- (begin
- 'for-loop
- (if i_85
- (let-values (((sym_20
- id_10)
- (hash-iterate-key+value
- ht_69
- i_85)))
- (let-values (((result_55)
- (let-values ()
- (let-values (((result_56)
- (let-values ()
- (let-values ()
- (if (symbol?
- sym_20)
- (identifier?
- id_10)
- #f)))))
- (values
- result_56)))))
- (if (if (not
- ((lambda x_33
- (not
- result_55))
- sym_20
- id_10))
- (not #f)
- #f)
- (for-loop_84
- result_55
- (hash-iterate-next
- ht_69
- i_85))
- result_55)))
- result_54)))))
- for-loop_84)
- #t
- (hash-iterate-first ht_69))))
- #f)
- #f)))))
- (values result_53)))))
- (if (if (not ((lambda x_34 (not result_52)) phase_28 ht-s_0)) (not #f) #f)
- (for-loop_11 result_52 (hash-iterate-next ht_68 i_84))
- result_52)))
- result_51)))))
- for-loop_11)
- #t
- (hash-iterate-first ht_68)))))))
+ (let-values (((result_92) (let-values (((result_93) #t)) result_93)))
+ (let-values (((ht_77) v_116))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_77))
+ ((letrec-values (((for-loop_93)
+ (lambda (result_94 i_109)
+ (begin
+ 'for-loop
+ (if i_109
+ (let-values (((phase_34 ht-s_0) (hash-iterate-key+value ht_77 i_109)))
+ (let-values (((result_95)
+ (let-values (((result_96)
+ (if (phase? phase_34)
+ (if (hash? (syntax-e$1 ht-s_0))
+ (let-values (((result_97)
+ (let-values (((result_98) #t))
+ result_98)))
+ (let-values (((ht_78) (syntax-e$1 ht-s_0)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash ht_78))
+ ((letrec-values (((for-loop_94)
+ (lambda (result_99 i_110)
+ (begin
+ 'for-loop
+ (if i_110
+ (let-values (((sym_26
+ id_10)
+ (hash-iterate-key+value
+ ht_78
+ i_110)))
+ (let-values (((result_100)
+ (let-values (((result_101)
+ (if (symbol?
+ sym_26)
+ (identifier?
+ id_10)
+ #f)))
+ (values
+ result_101))))
+ (if (if (not
+ ((lambda x_37
+ (not
+ result_100))
+ sym_26
+ id_10))
+ (not #f)
+ #f)
+ (for-loop_94
+ result_100
+ (hash-iterate-next
+ ht_78
+ i_110))
+ result_100)))
+ result_99)))))
+ for-loop_94)
+ result_97
+ (hash-iterate-first ht_78)))))
+ #f)
+ #f)))
+ (values result_96))))
+ (if (if (not ((lambda x_38 (not result_95)) phase_34 ht-s_0)) (not #f) #f)
+ (for-loop_93 result_95 (hash-iterate-next ht_77 i_109))
+ result_95)))
+ result_94)))))
+ for-loop_93)
+ result_92
+ (hash-iterate-first ht_77))))))))
(define-values
(extract-scope-list)
(lambda (stx_5) (begin (map2 generalize-scope (set->list (syntax-scope-set stx_5 0))))))
@@ -12873,88 +12461,86 @@
(lambda (stx_6) (begin (if (syntax?$1 stx_6) (= 1 (set-count (syntax-scope-set stx_6 0))) #f))))
(define-values
(extract-scope)
- (lambda (stx_7) (begin (let-values (((s_175) (syntax-scope-set stx_7 0))) (generalize-scope (set-first s_175))))))
+ (lambda (stx_7) (begin (let-values (((s_207) (syntax-scope-set stx_7 0))) (generalize-scope (set-first s_207))))))
(define-values (extract-shifts) (lambda (stx_8) (begin (syntax-mpi-shifts stx_8))))
(define-values
(unpack-defined-syms)
- (lambda (v_83)
+ (lambda (v_117)
(begin
(hash-copy
- (let-values (((ht_21) (syntax-e$1 v_83)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-in-hash ht_21)))
- ((letrec-values (((for-loop_6)
- (lambda (table_98 i_25)
- (begin
- 'for-loop
- (if i_25
- (let-values (((phase_29 ht-s_1) (hash-iterate-key+value ht_21 i_25)))
- (let-values (((table_99)
- (let-values (((table_100) table_98))
- (let-values (((table_101)
- (let-values ()
- (let-values (((key_40 val_23)
- (let-values ()
- (values
- phase_29
- (hash-copy
- (let-values (((ht_70)
- (syntax-e$1
- ht-s_1)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash ht_70)))
- ((letrec-values (((for-loop_85)
- (lambda (table_22
- i_86)
- (begin
- 'for-loop
- (if i_86
- (let-values (((sym_21
- id_11)
- (hash-iterate-key+value
- ht_70
- i_86)))
- (let-values (((table_102)
- (let-values (((table_103)
- table_22))
- (let-values (((table_104)
- (let-values ()
- (let-values (((key_41
- val_24)
- (let-values ()
- (values
- sym_21
- id_11))))
- (hash-set
- table_103
- key_41
- val_24)))))
- (values
- table_104)))))
- (if (not
- #f)
- (for-loop_85
- table_102
- (hash-iterate-next
- ht_70
- i_86))
- table_102)))
- table_22)))))
- for-loop_85)
- '#hash()
- (hash-iterate-first
- ht_70)))))))))
- (hash-set table_100 key_40 val_23)))))
- (values table_101)))))
- (if (not #f) (for-loop_6 table_99 (hash-iterate-next ht_21 i_25)) table_99)))
- table_98)))))
- for-loop_6)
- '#hasheqv()
- (hash-iterate-first ht_21))))))))
+ (let-values (((table_113) (let-values (((table_114) '#hasheqv())) table_114)))
+ (let-values (((ht_79) (syntax-e$1 v_117)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_79))
+ ((letrec-values (((for-loop_95)
+ (lambda (table_115 i_111)
+ (begin
+ 'for-loop
+ (if i_111
+ (let-values (((phase_35 ht-s_1) (hash-iterate-key+value ht_79 i_111)))
+ (let-values (((table_116)
+ (let-values (((table_117)
+ (let-values (((key_43 val_26)
+ (values
+ phase_35
+ (hash-copy
+ (let-values (((table_118)
+ (let-values (((table_119)
+ '#hash()))
+ table_119)))
+ (let-values (((ht_80)
+ (syntax-e$1 ht-s_1)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash ht_80))
+ ((letrec-values (((for-loop_96)
+ (lambda (table_120
+ i_112)
+ (begin
+ 'for-loop
+ (if i_112
+ (let-values (((sym_27
+ id_11)
+ (hash-iterate-key+value
+ ht_80
+ i_112)))
+ (let-values (((table_121)
+ (let-values (((table_122)
+ (let-values (((key_44
+ val_27)
+ (values
+ sym_27
+ id_11)))
+ (hash-set
+ table_120
+ key_44
+ val_27))))
+ (values
+ table_122))))
+ (if (not
+ #f)
+ (for-loop_96
+ table_121
+ (hash-iterate-next
+ ht_80
+ i_112))
+ table_121)))
+ table_120)))))
+ for-loop_96)
+ table_118
+ (hash-iterate-first
+ ht_80)))))))))
+ (hash-set table_115 key_43 val_26))))
+ (values table_117))))
+ (if (not #f)
+ (for-loop_95 table_116 (hash-iterate-next ht_79 i_111))
+ table_116)))
+ table_115)))))
+ for-loop_95)
+ table_113
+ (hash-iterate-first ht_79)))))))))
(define-values (1/primitive-table) primitive-table)
(define-values (1/primitive->compiled-position) primitive->compiled-position)
(define-values (1/compiled-position->primitive) compiled-position->primitive)
@@ -12967,6 +12553,8 @@
(define-values (instantiate-linklet$1) instantiate-linklet)
(define-values (linklet-import-variables$1) linklet-import-variables)
(define-values (linklet-export-variables$1) linklet-export-variables)
+ (define-values (1/linklet-add-target-machine-info) linklet-add-target-machine-info)
+ (define-values (1/linklet-summarize-target-machine-info) linklet-summarize-target-machine-info)
(define-values (1/instance?) instance?)
(define-values (1/make-instance) make-instance)
(define-values (1/instance-name) instance-name)
@@ -12977,6 +12565,7 @@
(define-values (1/instance-unset-variable!) instance-unset-variable!)
(define-values (1/instance-describe-variable!) instance-describe-variable!)
(define-values (1/linklet-virtual-machine-bytes) linklet-virtual-machine-bytes)
+ (define-values (1/linklet-cross-machine-type) linklet-cross-machine-type)
(define-values (1/write-linklet-bundle-hash) write-linklet-bundle-hash)
(define-values (1/read-linklet-bundle-hash) read-linklet-bundle-hash)
(define-values (1/variable-reference?) variable-reference?)
@@ -12986,75 +12575,60 @@
(void
(if 1/variable-reference-constant?
(void)
- (let-values () (error "broken '#%linklet primitive table; maybe you need to use \"bootstrap-run.rkt\""))))
+ (error "broken '#%linklet primitive table; maybe you need to use \"bootstrap-run.rkt\"")))
(define-values
(struct:module-registry module-registry1.1 module-registry? module-registry-declarations module-registry-lock-box)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'module-registry
- #f
- 2
- 0
- #f
- null
- (current-inspector)
- #f
- '(0 1)
- #f
- 'module-registry)))))
+ (let-values (((struct:_38 make-_38 ?_38 -ref_38 -set!_38)
+ (make-struct-type 'module-registry #f 2 0 #f null (current-inspector) #f '(0 1) #f 'module-registry)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'declarations)
- (make-struct-field-accessor -ref_2 1 'lock-box))))
+ struct:_38
+ make-_38
+ ?_38
+ (make-struct-field-accessor -ref_38 0 'declarations)
+ (make-struct-field-accessor -ref_38 1 'lock-box))))
(define-values (make-module-registry) (lambda () (begin (module-registry1.1 (make-hasheq) (box #f)))))
(define-values
(registry-call-with-lock)
- (lambda (r_23 proc_2)
+ (lambda (r_26 proc_2)
(begin
- (let-values (((lock-box_0) (module-registry-lock-box r_23)))
- ((letrec-values (((loop_72)
+ (let-values (((lock-box_0) (module-registry-lock-box r_26)))
+ ((letrec-values (((loop_74)
(lambda ()
(begin
'loop
- (let-values (((v_75) (unbox lock-box_0)))
- (if (let-values (((or-part_72) (not v_75)))
- (if or-part_72
- or-part_72
+ (let-values (((v_118) (unbox lock-box_0)))
+ (if (let-values (((or-part_206) (not v_118)))
+ (if or-part_206
+ or-part_206
(sync/timeout
0
- (car v_75)
- (let-values (((or-part_13) (weak-box-value (cdr v_75))))
- (if or-part_13 or-part_13 never-evt)))))
- (let-values ()
- (let-values (((sema_0) (make-semaphore)))
- (let-values (((lock_0)
- (cons
- (semaphore-peek-evt sema_0)
- (make-weak-box (current-thread)))))
- ((dynamic-wind
- void
- (lambda ()
- (if (box-cas! lock-box_0 v_75 lock_0)
- (let-values ()
- (call-with-values
- proc_2
- (lambda results_0 (lambda () (apply values results_0)))))
- (let-values () (lambda () (loop_72)))))
- (lambda () (semaphore-post sema_0)))))))
- (if (eq? (current-thread) (weak-box-value (cdr v_75)))
- (let-values () (proc_2))
- (let-values ()
- (begin
- (sync
- (car v_75)
- (let-values (((or-part_73) (weak-box-value (cdr v_75))))
- (if or-part_73 or-part_73 never-evt)))
- (loop_72))))))))))
- loop_72))))))
+ (car v_118)
+ (let-values (((t_12) (weak-box-value (cdr v_118))))
+ (if (eq? t_12 (current-thread))
+ never-evt
+ (let-values (((or-part_207) t_12))
+ (if or-part_207 or-part_207 always-evt)))))))
+ (let-values (((sema_0) (make-semaphore)))
+ (let-values (((lock_2)
+ (cons (semaphore-peek-evt sema_0) (make-weak-box (current-thread)))))
+ ((dynamic-wind
+ void
+ (lambda ()
+ (if (box-cas! lock-box_0 v_118 lock_2)
+ (call-with-values
+ proc_2
+ (lambda results_0 (lambda () (apply values results_0))))
+ (lambda () (loop_74))))
+ (lambda () (semaphore-post sema_0))))))
+ (if (eq? (current-thread) (weak-box-value (cdr v_118)))
+ (proc_2)
+ (begin
+ (sync
+ (car v_118)
+ (let-values (((or-part_208) (weak-box-value (cdr v_118))))
+ (if or-part_208 or-part_208 always-evt)))
+ (loop_74)))))))))
+ loop_74))))))
(define-values
(struct:namespace
namespace1.1
@@ -13067,96 +12641,89 @@
namespace-phase-to-namespace
namespace-phase-level-to-definitions
namespace-module-registry$1
+ namespace-module-instance-shifted-requires
namespace-bulk-binding-registry
namespace-submodule-declarations
namespace-root-namespace
namespace-declaration-inspector
namespace-inspector
namespace-available-module-instances
+ namespace-available-cross-phase-module-instances
namespace-module-instances
set-namespace-inspector!)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'namespace
- #f
- 15
- 0
- #f
- (list
- (cons prop:authentic #t)
- (cons
- prop:custom-write
- (lambda (ns_0 port_7 mode_10)
- (let-values ((() (begin (write-string "#name ns_0)))
- (void))
- (values))))
- (let-values (((0-phase_0) (namespace-0-phase ns_0)))
- (let-values (((phase-level_3) (phase- (namespace-phase ns_0) 0-phase_0)))
- (begin
- (if (zero-phase? phase-level_3)
- (void)
- (let-values () (fprintf port_7 ":~s" phase-level_3)))
- (if (zero-phase? 0-phase_0)
- (void)
- (let-values ()
- (fprintf port_7 "~a~s" (if (positive? 0-phase_0) "+" "") 0-phase_0)))
- (write-string ">" port_7))))))))))
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6 7 8 9 10 11 13 14)
- #f
- 'namespace)))))
+ (let-values (((struct:_39 make-_39 ?_39 -ref_39 -set!_39)
+ (make-struct-type
+ 'namespace
+ #f
+ 17
+ 0
+ #f
+ (list
+ (cons prop:authentic #t)
+ (cons
+ prop:custom-write
+ (lambda (ns_0 port_7 mode_10)
+ (let-values ((() (begin (write-string "#name ns_0)) (void)) (values))))
+ (let-values (((0-phase_0) (namespace-0-phase ns_0)))
+ (let-values (((phase-level_3) (phase- (namespace-phase ns_0) 0-phase_0)))
+ (begin
+ (if (zero-phase? phase-level_3) (void) (fprintf port_7 ":~s" phase-level_3))
+ (if (zero-phase? 0-phase_0)
+ (void)
+ (fprintf port_7 "~a~s" (if (positive? 0-phase_0) "+" "") 0-phase_0))
+ (write-string ">" port_7))))))))))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 6 7 8 9 10 11 12 14 15 16)
+ #f
+ 'namespace)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'mpi)
- (make-struct-field-accessor -ref_2 1 'source-name)
- (make-struct-field-accessor -ref_2 2 'root-expand-ctx)
- (make-struct-field-accessor -ref_2 3 'phase)
- (make-struct-field-accessor -ref_2 4 '0-phase)
- (make-struct-field-accessor -ref_2 5 'phase-to-namespace)
- (make-struct-field-accessor -ref_2 6 'phase-level-to-definitions)
- (make-struct-field-accessor -ref_2 7 'module-registry)
- (make-struct-field-accessor -ref_2 8 'bulk-binding-registry)
- (make-struct-field-accessor -ref_2 9 'submodule-declarations)
- (make-struct-field-accessor -ref_2 10 'root-namespace)
- (make-struct-field-accessor -ref_2 11 'declaration-inspector)
- (make-struct-field-accessor -ref_2 12 'inspector)
- (make-struct-field-accessor -ref_2 13 'available-module-instances)
- (make-struct-field-accessor -ref_2 14 'module-instances)
- (make-struct-field-mutator -set!_2 12 'inspector))))
+ struct:_39
+ make-_39
+ ?_39
+ (make-struct-field-accessor -ref_39 0 'mpi)
+ (make-struct-field-accessor -ref_39 1 'source-name)
+ (make-struct-field-accessor -ref_39 2 'root-expand-ctx)
+ (make-struct-field-accessor -ref_39 3 'phase)
+ (make-struct-field-accessor -ref_39 4 '0-phase)
+ (make-struct-field-accessor -ref_39 5 'phase-to-namespace)
+ (make-struct-field-accessor -ref_39 6 'phase-level-to-definitions)
+ (make-struct-field-accessor -ref_39 7 'module-registry)
+ (make-struct-field-accessor -ref_39 8 'module-instance-shifted-requires)
+ (make-struct-field-accessor -ref_39 9 'bulk-binding-registry)
+ (make-struct-field-accessor -ref_39 10 'submodule-declarations)
+ (make-struct-field-accessor -ref_39 11 'root-namespace)
+ (make-struct-field-accessor -ref_39 12 'declaration-inspector)
+ (make-struct-field-accessor -ref_39 13 'inspector)
+ (make-struct-field-accessor -ref_39 14 'available-module-instances)
+ (make-struct-field-accessor -ref_39 15 'available-cross-phase-module-instances)
+ (make-struct-field-accessor -ref_39 16 'module-instances)
+ (make-struct-field-mutator -set!_39 13 'inspector))))
(define-values
(struct:definitions definitions2.1 definitions? definitions-variables definitions-transformers)
- (let-values (((struct:_6 make-_6 ?_6 -ref_6 -set!_6)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'definitions
- #f
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'definitions)))))
+ (let-values (((struct:_40 make-_40 ?_40 -ref_40 -set!_40)
+ (make-struct-type
+ 'definitions
+ #f
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'definitions)))
(values
- struct:_6
- make-_6
- ?_6
- (make-struct-field-accessor -ref_6 0 'variables)
- (make-struct-field-accessor -ref_6 1 'transformers))))
- (define-values (make-namespace) (lambda () (begin (let-values () (new-namespace.1 #t unsafe-undefined #f)))))
+ struct:_40
+ make-_40
+ ?_40
+ (make-struct-field-accessor -ref_40 0 'variables)
+ (make-struct-field-accessor -ref_40 1 'transformers))))
+ (define-values (make-namespace) (lambda () (begin (new-namespace.1 #t unsafe-undefined #f))))
(define-values
(new-namespace.1)
(lambda (register?4_0 root-expand-ctx3_0 share-from-ns7_0)
@@ -13174,45 +12741,44 @@
top-level-module-path-index16_0))
root-expand-ctx3_0)))
(let-values (((register?_0) register?4_0))
- (let-values ()
- (let-values (((phase_30) (if share-from-ns_0 (namespace-phase share-from-ns_0) 0)))
- (let-values (((ns_1)
- (namespace1.1
- top-level-module-path-index
- #f
- (box root-expand-ctx_0)
- phase_30
- phase_30
- (make-small-hasheqv)
- (make-small-hasheqv)
- (if share-from-ns_0 (namespace-module-registry$1 share-from-ns_0) (make-module-registry))
- (if share-from-ns_0
- (namespace-bulk-binding-registry share-from-ns_0)
- (make-bulk-binding-registry))
- (make-small-hasheq)
- (if share-from-ns_0
- (let-values (((or-part_4) (namespace-root-namespace share-from-ns_0)))
- (if or-part_4 or-part_4 share-from-ns_0))
- #f)
- #f
- (make-inspector (current-code-inspector))
- (if share-from-ns_0
- (namespace-available-module-instances share-from-ns_0)
- (make-hasheqv))
- (if share-from-ns_0 (namespace-module-instances share-from-ns_0) (make-hasheqv)))))
- (begin
- (if register?_0
- (let-values () (small-hash-set! (namespace-phase-to-namespace ns_1) phase_30 ns_1))
- (void))
- ns_1))))))))))
+ (let-values (((phase_36) (if share-from-ns_0 (namespace-phase share-from-ns_0) 0)))
+ (let-values (((ns_1)
+ (namespace1.1
+ top-level-module-path-index
+ #f
+ (box root-expand-ctx_0)
+ phase_36
+ phase_36
+ (make-small-hasheqv)
+ (make-small-hasheqv)
+ (if share-from-ns_0 (namespace-module-registry$1 share-from-ns_0) (make-module-registry))
+ (if share-from-ns_0
+ (namespace-module-instance-shifted-requires share-from-ns_0)
+ (make-hasheq))
+ (if share-from-ns_0
+ (namespace-bulk-binding-registry share-from-ns_0)
+ (make-bulk-binding-registry))
+ (make-small-hasheq)
+ (if share-from-ns_0
+ (let-values (((or-part_209) (namespace-root-namespace share-from-ns_0)))
+ (if or-part_209 or-part_209 share-from-ns_0))
+ #f)
+ #f
+ (make-inspector (current-code-inspector))
+ (if share-from-ns_0 (namespace-available-module-instances share-from-ns_0) (make-hasheqv))
+ (if share-from-ns_0
+ (namespace-available-cross-phase-module-instances share-from-ns_0)
+ (box null))
+ (if share-from-ns_0 (namespace-module-instances share-from-ns_0) (make-hasheqv)))))
+ (begin
+ (if register?_0 (small-hash-set! (namespace-phase-to-namespace ns_1) phase_36 ns_1) (void))
+ ns_1)))))))))
(define-values
(1/current-namespace)
(make-parameter
(make-namespace)
- (lambda (v_84)
- (begin
- (if (1/namespace? v_84) (void) (let-values () (raise-argument-error 'current-namespace "namespace?" v_84)))
- v_84))
+ (lambda (v_119)
+ (begin (if (1/namespace? v_119) (void) (raise-argument-error 'current-namespace "namespace?" v_119)) v_119))
'current-namespace))
(define-values
(namespace-get-root-expand-ctx)
@@ -13227,30 +12793,30 @@
(namespace-self-mpi/no-top-level)
(lambda (ns_5)
(begin
- (let-values (((mpi_19) (root-expand-context-self-mpi (namespace-get-root-expand-ctx ns_5))))
- (if (if mpi_19 (top-level-module-path-index? mpi_19) #f) #f mpi_19)))))
+ (let-values (((mpi_21) (root-expand-context-self-mpi (namespace-get-root-expand-ctx ns_5))))
+ (if (if mpi_21 (top-level-module-path-index? mpi_21) #f) #f mpi_21)))))
(define-values
(namespace->module)
- (lambda (ns_6 name_18)
+ (lambda (ns_6 name_17)
(begin
- (let-values (((or-part_60) (small-hash-ref (namespace-submodule-declarations ns_6) name_18 #f)))
- (if or-part_60
- or-part_60
- (hash-ref (module-registry-declarations (namespace-module-registry$1 ns_6)) name_18 #f))))))
+ (let-values (((or-part_210) (small-hash-ref (namespace-submodule-declarations ns_6) name_17 #f)))
+ (if or-part_210
+ or-part_210
+ (hash-ref (module-registry-declarations (namespace-module-registry$1 ns_6)) name_17 #f))))))
(define-values
(namespace->namespace-at-phase)
- (lambda (ns_7 phase_31)
+ (lambda (ns_7 phase_37)
(begin
- (let-values (((or-part_78) (small-hash-ref (namespace-phase-to-namespace ns_7) phase_31 #f)))
- (if or-part_78
- or-part_78
+ (let-values (((or-part_211) (small-hash-ref (namespace-phase-to-namespace ns_7) phase_37 #f)))
+ (if or-part_211
+ or-part_211
(let-values (((p-ns_0)
(let-values (((the-struct_28) ns_7))
(if (1/namespace? the-struct_28)
- (let-values (((phase17_0) phase_31)
+ (let-values (((phase17_0) phase_37)
((root-namespace18_0)
- (let-values (((or-part_9) (namespace-root-namespace ns_7)))
- (if or-part_9 or-part_9 ns_7))))
+ (let-values (((or-part_212) (namespace-root-namespace ns_7)))
+ (if or-part_212 or-part_212 ns_7))))
(namespace1.1
(namespace-mpi the-struct_28)
(namespace-source-name the-struct_28)
@@ -13260,41 +12826,40 @@
(namespace-phase-to-namespace the-struct_28)
(namespace-phase-level-to-definitions the-struct_28)
(namespace-module-registry$1 the-struct_28)
+ (namespace-module-instance-shifted-requires the-struct_28)
(namespace-bulk-binding-registry the-struct_28)
(namespace-submodule-declarations the-struct_28)
root-namespace18_0
(namespace-declaration-inspector the-struct_28)
(namespace-inspector the-struct_28)
(namespace-available-module-instances the-struct_28)
+ (namespace-available-cross-phase-module-instances the-struct_28)
(namespace-module-instances the-struct_28)))
(raise-argument-error 'struct-copy "namespace?" the-struct_28)))))
- (begin (small-hash-set! (namespace-phase-to-namespace ns_7) phase_31 p-ns_0) p-ns_0)))))))
+ (begin (small-hash-set! (namespace-phase-to-namespace ns_7) phase_37 p-ns_0) p-ns_0)))))))
(define-values
(namespace->name)
(lambda (ns_8)
(begin
(let-values (((n_21) (namespace-source-name ns_8)))
- (let-values (((s_176)
+ (let-values (((s_208)
(if (not n_21)
- (let-values () 'top-level)
- (if (symbol? n_21)
- (let-values () (format "'~s" n_21))
- (let-values () (string-append "\"" (path->string n_21) "\""))))))
- (let-values (((r_24) (1/resolved-module-path-name (1/module-path-index-resolve (namespace-mpi ns_8)))))
- (if (pair? r_24) (string-append "(submod " s_176 " " (substring (format "~s" (cdr r_24)) 1)) s_176)))))))
+ 'top-level
+ (if (symbol? n_21) (format "'~s" n_21) (string-append "\"" (path->string n_21) "\"")))))
+ (let-values (((r_27) (1/resolved-module-path-name (1/module-path-index-resolve (namespace-mpi ns_8)))))
+ (if (pair? r_27) (string-append "(submod " s_208 " " (substring (format "~s" (cdr r_27)) 1)) s_208)))))))
(define-values
(namespace->definitions)
(lambda (ns_9 phase-level_4)
(begin
(let-values (((d_9) (small-hash-ref (namespace-phase-level-to-definitions ns_9) phase-level_4 #f)))
- (let-values (((or-part_145) d_9))
- (if or-part_145
- or-part_145
- (let-values ()
- (let-values (((p-ns_1)
- (namespace->namespace-at-phase ns_9 (phase+ (namespace-0-phase ns_9) phase-level_4))))
- (let-values (((d_10) (definitions2.1 (1/make-instance (namespace->name p-ns_1) p-ns_1) (make-hasheq))))
- (begin (small-hash-set! (namespace-phase-level-to-definitions ns_9) phase-level_4 d_10) d_10))))))))))
+ (let-values (((or-part_213) d_9))
+ (if or-part_213
+ or-part_213
+ (let-values (((p-ns_1)
+ (namespace->namespace-at-phase ns_9 (phase+ (namespace-0-phase ns_9) phase-level_4))))
+ (let-values (((d_10) (definitions2.1 (1/make-instance (namespace->name p-ns_1) p-ns_1) (make-hasheq))))
+ (begin (small-hash-set! (namespace-phase-level-to-definitions ns_9) phase-level_4 d_10) d_10)))))))))
(define-values
(namespace-set-variable!)
(let-values (((namespace-set-variable!_0)
@@ -13303,85 +12868,82 @@
'namespace-set-variable!
(let-values (((ns_10) ns10_0))
(let-values (((phase-level_5) phase-level11_0))
- (let-values (((name_19) name12_0))
- (let-values (((val_25) val13_0))
+ (let-values (((name_18) name12_0))
+ (let-values (((val_28) val13_0))
(let-values (((as-constant?_0) as-constant?9_0))
- (let-values ()
- (let-values (((d_11) (namespace->definitions ns_10 phase-level_5)))
- (1/instance-set-variable-value!
- (definitions-variables d_11)
- name_19
- val_25
- (if as-constant?_0 'constant #f)))))))))))))
+ (let-values (((d_11) (namespace->definitions ns_10 phase-level_5)))
+ (1/instance-set-variable-value!
+ (definitions-variables d_11)
+ name_18
+ val_28
+ (if as-constant?_0 'constant #f))))))))))))
(case-lambda
- ((ns_11 phase-level_6 name_20 val_26) (begin (namespace-set-variable!_0 ns_11 phase-level_6 name_20 val_26 #f)))
- ((ns_12 phase-level_1 name_21 val_27 as-constant?9_1)
- (namespace-set-variable!_0 ns_12 phase-level_1 name_21 val_27 as-constant?9_1)))))
+ ((ns_11 phase-level_6 name_19 val_29) (begin (namespace-set-variable!_0 ns_11 phase-level_6 name_19 val_29 #f)))
+ ((ns_12 phase-level_7 name_20 val_30 as-constant?9_1)
+ (namespace-set-variable!_0 ns_12 phase-level_7 name_20 val_30 as-constant?9_1)))))
(define-values
(namespace-set-consistent!)
- (lambda (ns_13 phase-level_7 name_22 val_28)
+ (lambda (ns_13 phase-level_8 name_21 val_31)
(begin
- (let-values (((d_12) (namespace->definitions ns_13 phase-level_7)))
- (1/instance-set-variable-value! (definitions-variables d_12) name_22 val_28 'consistent)))))
+ (let-values (((d_12) (namespace->definitions ns_13 phase-level_8)))
+ (1/instance-set-variable-value! (definitions-variables d_12) name_21 val_31 'consistent)))))
(define-values
(namespace-unset-variable!)
- (lambda (ns_14 phase-level_8 name_10)
+ (lambda (ns_14 phase-level_9 name_22)
(begin
- (let-values (((d_13) (namespace->definitions ns_14 phase-level_8)))
- (1/instance-unset-variable! (definitions-variables d_13) name_10)))))
+ (let-values (((d_13) (namespace->definitions ns_14 phase-level_9)))
+ (1/instance-unset-variable! (definitions-variables d_13) name_22)))))
(define-values
(namespace-set-transformer!)
- (lambda (ns_15 phase-level_9 name_23 val_29)
+ (lambda (ns_15 phase-level_10 name_23 val_32)
(begin
- (let-values (((d_14) (namespace->definitions ns_15 (add1 phase-level_9))))
- (hash-set! (definitions-transformers d_14) name_23 val_29)))))
+ (let-values (((d_14) (namespace->definitions ns_15 (if phase-level_10 (add1 phase-level_10) #f))))
+ (hash-set! (definitions-transformers d_14) name_23 val_32)))))
(define-values
(namespace-unset-transformer!)
- (lambda (ns_16 phase-level_10 name_24)
+ (lambda (ns_16 phase-level_11 name_24)
(begin
- (let-values (((d_15) (namespace->definitions ns_16 (add1 phase-level_10))))
+ (let-values (((d_15) (namespace->definitions ns_16 (add1 phase-level_11))))
(hash-remove! (definitions-transformers d_15) name_24)))))
(define-values
(namespace-get-variable)
- (lambda (ns_17 phase-level_11 name_25 fail-k_0)
+ (lambda (ns_17 phase-level_12 name_25 fail-k_0)
(begin
- (let-values (((d_16) (namespace->definitions ns_17 phase-level_11)))
+ (let-values (((d_16) (namespace->definitions ns_17 phase-level_12)))
(1/instance-variable-value (definitions-variables d_16) name_25 fail-k_0)))))
(define-values
(namespace-get-transformer)
- (lambda (ns_18 phase-level_12 name_26 fail-k_1)
+ (lambda (ns_18 phase-level_13 name_26 fail-k_1)
(begin
- (let-values (((d_17) (namespace->definitions ns_18 (add1 phase-level_12))))
+ (let-values (((d_17) (namespace->definitions ns_18 (if phase-level_13 (add1 phase-level_13) #f))))
(hash-ref (definitions-transformers d_17) name_26 fail-k_1)))))
(define-values
(namespace->instance)
(lambda (ns_19 phase-shift_0) (begin (definitions-variables (namespace->definitions ns_19 phase-shift_0)))))
(define-values
(namespace-same-instance?)
- (lambda (a-ns_0 b-ns_0)
+ (lambda (a-ns_0 b-ns_0 phase-level_14)
(begin
(eq?
- (small-hash-ref (namespace-phase-level-to-definitions a-ns_0) 0 'no-a)
- (small-hash-ref (namespace-phase-level-to-definitions b-ns_0) 0 'no-b)))))
+ (small-hash-ref (namespace-phase-level-to-definitions a-ns_0) phase-level_14 'no-a)
+ (small-hash-ref (namespace-phase-level-to-definitions b-ns_0) phase-level_14 'no-b)))))
(define-values (original-property-sym) (gensym 'original))
(define-values
(syntax->list$1)
- (lambda (s_0)
+ (lambda (s_209)
(begin
'syntax->list
- (let-values (((l_33)
- ((letrec-values (((loop_73)
- (lambda (s_1)
+ (let-values (((l_39)
+ ((letrec-values (((loop_75)
+ (lambda (s_210)
(begin
'loop
- (if (pair? s_1)
- (let-values () (cons (car s_1) (loop_73 (cdr s_1))))
- (if (syntax?$1 s_1)
- (let-values () (loop_73 (syntax-e$1 s_1)))
- (let-values () s_1)))))))
- loop_73)
- s_0)))
- (if (list? l_33) l_33 #f)))))
+ (if (pair? s_210)
+ (cons (car s_210) (loop_75 (cdr s_210)))
+ (if (syntax?$1 s_210) (loop_75 (syntax-e$1 s_210)) s_210))))))
+ loop_75)
+ s_209)))
+ (if (list? l_39) l_39 #f)))))
(define-values (missing$1) (gensym))
(define-values
(syntax-track-origin$1)
@@ -13395,255 +12957,234 @@
(if (eq? id1_0 unsafe-undefined)
(if (identifier? old-stx_0)
old-stx_0
- (let-values (((v_31) (syntax-e$1 old-stx_0)))
- (if (pair? v_31) (car v_31) #f)))
+ (let-values (((v_120) (syntax-e$1 old-stx_0)))
+ (if (pair? v_120) (car v_120) #f)))
id1_0)))
- (let-values ()
- (let-values (((old-props_0) (hash-remove (syntax-props old-stx_0) original-property-sym)))
- (if (zero? (hash-count old-props_0))
- (let-values ()
+ (let-values (((old-props_0) (hash-remove (syntax-props old-stx_0) original-property-sym)))
+ (if (zero? (hash-count old-props_0))
+ (if id_12
+ (syntax-property$1
+ new-stx_0
+ 'origin
+ (cons id_12 (hash-ref (syntax-props new-stx_0) 'origin null)))
+ new-stx_0)
+ (let-values (((new-props_0) (syntax-props new-stx_0)))
+ (if (zero? (hash-count new-props_0))
(if id_12
- (syntax-property$1
- new-stx_0
- 'origin
- (cons id_12 (hash-ref (syntax-props new-stx_0) 'origin null)))
- new-stx_0))
- (let-values ()
- (let-values (((new-props_0) (syntax-props new-stx_0)))
- (if (zero? (hash-count new-props_0))
- (let-values ()
- (if id_12
- (let-values ()
- (let-values (((old-origin_0)
- (plain-property-value
- (hash-ref old-props_0 'origin missing$1))))
- (let-values (((origin_0)
- (if (eq? old-origin_0 missing$1)
- (list id_12)
- (cons id_12 old-origin_0))))
- (let-values (((the-struct_29) new-stx_0))
- (if (syntax?$1 the-struct_29)
- (let-values (((props4_0) (hash-set old-props_0 'origin origin_0)))
- (syntax2.1
- (syntax-content* the-struct_29)
- (syntax-scopes the-struct_29)
- (syntax-shifted-multi-scopes the-struct_29)
- (syntax-mpi-shifts the-struct_29)
- (syntax-srcloc$1 the-struct_29)
- props4_0
- (syntax-inspector the-struct_29)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_29))))))
- (let-values ()
- (let-values (((the-struct_30) new-stx_0))
- (if (syntax?$1 the-struct_30)
- (let-values (((props5_0) old-props_0))
- (syntax2.1
- (syntax-content* the-struct_30)
- (syntax-scopes the-struct_30)
- (syntax-shifted-multi-scopes the-struct_30)
- (syntax-mpi-shifts the-struct_30)
- (syntax-srcloc$1 the-struct_30)
- props5_0
- (syntax-inspector the-struct_30)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_30))))))
- (let-values ()
- (let-values (((old-props-with-origin_0)
- (if id_12
- (hash-set
- old-props_0
- 'origin
- (cons id_12 (hash-ref old-props_0 'origin null)))
- old-props_0)))
- (let-values (((updated-props_0)
- (if (<
- (hash-count old-props-with-origin_0)
- (hash-count new-props_0))
- (let-values ()
- (let-values (((ht_71) old-props-with-origin_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash ht_71)))
- ((letrec-values (((for-loop_86)
- (lambda (new-props_1 i_87)
- (begin
- 'for-loop
- (if i_87
- (let-values (((k_22 v_85)
- (unsafe-immutable-hash-iterate-key+value
- ht_71
- i_87)))
- (let-values (((new-props_2)
- (let-values (((new-props_3)
- new-props_1))
- (let-values (((new-props_4)
- (let-values ()
- (let-values (((new-v_0)
- (hash-ref
- new-props_3
- k_22
- missing$1)))
- (hash-set
- new-props_3
- k_22
- (if (eq?
- new-v_0
- missing$1)
- v_85
- (cons/preserve
- new-v_0
- v_85)))))))
- (values
- new-props_4)))))
- (if (not #f)
- (for-loop_86
- new-props_2
- (unsafe-immutable-hash-iterate-next
- ht_71
- i_87))
- new-props_2)))
- new-props_1)))))
- for-loop_86)
- new-props_0
- (unsafe-immutable-hash-iterate-first ht_71)))))
- (let-values ()
- (let-values (((ht_72) new-props_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash ht_72)))
- ((letrec-values (((for-loop_87)
- (lambda (old-props_1 i_88)
- (begin
- 'for-loop
- (if i_88
- (let-values (((k_23 v_77)
- (unsafe-immutable-hash-iterate-key+value
- ht_72
- i_88)))
- (let-values (((old-props_2)
- (let-values (((old-props_3)
- old-props_1))
- (let-values (((old-props_4)
- (let-values ()
- (let-values (((old-v_0)
- (hash-ref
- old-props_3
- k_23
- missing$1)))
- (hash-set
- old-props_3
- k_23
- (if (eq?
- old-v_0
- missing$1)
- v_77
- (cons/preserve
- v_77
- old-v_0)))))))
- (values
- old-props_4)))))
- (if (not #f)
- (for-loop_87
- old-props_2
- (unsafe-immutable-hash-iterate-next
- ht_72
- i_88))
- old-props_2)))
- old-props_1)))))
- for-loop_87)
- old-props-with-origin_0
- (unsafe-immutable-hash-iterate-first ht_72))))))))
- (let-values (((the-struct_31) new-stx_0))
- (if (syntax?$1 the-struct_31)
- (let-values (((props6_0) updated-props_0))
- (syntax2.1
- (syntax-content* the-struct_31)
- (syntax-scopes the-struct_31)
- (syntax-shifted-multi-scopes the-struct_31)
- (syntax-mpi-shifts the-struct_31)
- (syntax-srcloc$1 the-struct_31)
- props6_0
- (syntax-inspector the-struct_31)))
- (raise-argument-error
- 'struct-copy
- "syntax?"
- the-struct_31)))))))))))))))))))
+ (let-values (((old-origin_0)
+ (plain-property-value (hash-ref old-props_0 'origin missing$1))))
+ (let-values (((origin_0)
+ (if (eq? old-origin_0 missing$1)
+ (list id_12)
+ (cons id_12 old-origin_0))))
+ (let-values (((the-struct_29) new-stx_0))
+ (if (syntax?$1 the-struct_29)
+ (let-values (((props4_0) (hash-set old-props_0 'origin origin_0)))
+ (syntax2.1
+ (syntax-content* the-struct_29)
+ (syntax-scopes the-struct_29)
+ (syntax-shifted-multi-scopes the-struct_29)
+ (syntax-mpi-shifts the-struct_29)
+ (syntax-srcloc$1 the-struct_29)
+ props4_0
+ (syntax-inspector the-struct_29)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_29)))))
+ (let-values (((the-struct_30) new-stx_0))
+ (if (syntax?$1 the-struct_30)
+ (let-values (((props5_0) old-props_0))
+ (syntax2.1
+ (syntax-content* the-struct_30)
+ (syntax-scopes the-struct_30)
+ (syntax-shifted-multi-scopes the-struct_30)
+ (syntax-mpi-shifts the-struct_30)
+ (syntax-srcloc$1 the-struct_30)
+ props5_0
+ (syntax-inspector the-struct_30)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_30))))
+ (let-values (((old-props-with-origin_0)
+ (if id_12
+ (hash-set
+ old-props_0
+ 'origin
+ (cons id_12 (hash-ref old-props_0 'origin null)))
+ old-props_0)))
+ (let-values (((updated-props_0)
+ (if (< (hash-count old-props-with-origin_0) (hash-count new-props_0))
+ (let-values (((new-props_1)
+ (let-values (((new-props_2) new-props_0))
+ new-props_2)))
+ (let-values (((ht_81) old-props-with-origin_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash ht_81))
+ ((letrec-values (((for-loop_97)
+ (lambda (new-props_3 i_113)
+ (begin
+ 'for-loop
+ (if i_113
+ (let-values (((k_22 v_121)
+ (unsafe-immutable-hash-iterate-key+value
+ ht_81
+ i_113)))
+ (let-values (((new-props_4)
+ (let-values (((new-props_5)
+ (let-values (((new-v_1)
+ (hash-ref
+ new-props_3
+ k_22
+ missing$1)))
+ (hash-set
+ new-props_3
+ k_22
+ (if (eq?
+ new-v_1
+ missing$1)
+ v_121
+ (cons/preserve
+ new-v_1
+ v_121))))))
+ (values
+ new-props_5))))
+ (if (not #f)
+ (for-loop_97
+ new-props_4
+ (unsafe-immutable-hash-iterate-next
+ ht_81
+ i_113))
+ new-props_4)))
+ new-props_3)))))
+ for-loop_97)
+ new-props_1
+ (unsafe-immutable-hash-iterate-first ht_81)))))
+ (let-values (((old-props_1)
+ (let-values (((old-props_2) old-props-with-origin_0))
+ old-props_2)))
+ (let-values (((ht_82) new-props_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash ht_82))
+ ((letrec-values (((for-loop_98)
+ (lambda (old-props_3 i_114)
+ (begin
+ 'for-loop
+ (if i_114
+ (let-values (((k_23 v_122)
+ (unsafe-immutable-hash-iterate-key+value
+ ht_82
+ i_114)))
+ (let-values (((old-props_4)
+ (let-values (((old-props_5)
+ (let-values (((old-v_0)
+ (hash-ref
+ old-props_3
+ k_23
+ missing$1)))
+ (hash-set
+ old-props_3
+ k_23
+ (if (eq?
+ old-v_0
+ missing$1)
+ v_122
+ (cons/preserve
+ v_122
+ old-v_0))))))
+ (values
+ old-props_5))))
+ (if (not #f)
+ (for-loop_98
+ old-props_4
+ (unsafe-immutable-hash-iterate-next
+ ht_82
+ i_114))
+ old-props_4)))
+ old-props_3)))))
+ for-loop_98)
+ old-props_1
+ (unsafe-immutable-hash-iterate-first ht_82))))))))
+ (let-values (((the-struct_31) new-stx_0))
+ (if (syntax?$1 the-struct_31)
+ (let-values (((props6_0) updated-props_0))
+ (syntax2.1
+ (syntax-content* the-struct_31)
+ (syntax-scopes the-struct_31)
+ (syntax-shifted-multi-scopes the-struct_31)
+ (syntax-mpi-shifts the-struct_31)
+ (syntax-srcloc$1 the-struct_31)
+ props6_0
+ (syntax-inspector the-struct_31)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_31))))))))))))))))
(case-lambda
((new-stx_1 old-stx_1) (begin 'syntax-track-origin (syntax-track-origin_0 new-stx_1 old-stx_1 unsafe-undefined)))
((new-stx_2 old-stx_2 id1_1) (syntax-track-origin_0 new-stx_2 old-stx_2 id1_1)))))
(define-values
(cons/preserve)
- (lambda (a_24 b_61)
+ (lambda (a_27 b_76)
(begin
- (if (let-values (((or-part_146) (preserved-property-value? a_24)))
- (if or-part_146 or-part_146 (preserved-property-value? b_61)))
- (preserved-property-value1.1 (cons (plain-property-value a_24) (plain-property-value b_61)))
- (cons a_24 b_61)))))
+ (if (let-values (((or-part_214) (preserved-property-value? a_27)))
+ (if or-part_214 or-part_214 (preserved-property-value? b_76)))
+ (preserved-property-value1.1 (cons (plain-property-value a_27) (plain-property-value b_76)))
+ (cons a_27 b_76)))))
(define-values
(syntax-track-origin*)
(lambda (old-stxes_0 new-stx_3)
(begin
- (let-values (((lst_63) old-stxes_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_63)))
- ((letrec-values (((for-loop_88)
- (lambda (new-stx_4 lst_64)
- (begin
- 'for-loop
- (if (pair? lst_64)
- (let-values (((old-stx_3) (unsafe-car lst_64)) ((rest_29) (unsafe-cdr lst_64)))
- (let-values (((new-stx_5)
- (let-values (((new-stx_6) new-stx_4))
- (let-values (((new-stx_7)
- (let-values ()
- (syntax-track-origin$1 new-stx_6 old-stx_3))))
- (values new-stx_7)))))
- (if (not #f) (for-loop_88 new-stx_5 rest_29) new-stx_5)))
- new-stx_4)))))
- for-loop_88)
- new-stx_3
- lst_63))))))
+ (let-values (((new-stx_4) (let-values (((new-stx_5) new-stx_3)) new-stx_5)))
+ (let-values (((lst_69) old-stxes_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_69))
+ ((letrec-values (((for-loop_99)
+ (lambda (new-stx_6 lst_70)
+ (begin
+ 'for-loop
+ (if (pair? lst_70)
+ (let-values (((old-stx_3) (unsafe-car lst_70)) ((rest_31) (unsafe-cdr lst_70)))
+ (let-values (((new-stx_7)
+ (let-values (((new-stx_8)
+ (syntax-track-origin$1 new-stx_6 old-stx_3)))
+ (values new-stx_8))))
+ (if (not #f) (for-loop_99 new-stx_7 rest_31) new-stx_7)))
+ new-stx_6)))))
+ for-loop_99)
+ new-stx_4
+ lst_69)))))))
(define-values
(struct:syntax-binding-set syntax-binding-set1.1 1/syntax-binding-set? syntax-binding-set-binds)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'syntax-binding-set
- #f
- 1
- 0
- #f
- null
- (current-inspector)
- #f
- '(0)
- #f
- 'syntax-binding-set)))))
- (values struct:_2 make-_2 ?_2 (make-struct-field-accessor -ref_2 0 'binds))))
+ (let-values (((struct:_41 make-_41 ?_41 -ref_41 -set!_41)
+ (make-struct-type
+ 'syntax-binding-set
+ #f
+ 1
+ 0
+ #f
+ null
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'syntax-binding-set)))
+ (values struct:_41 make-_41 ?_41 (make-struct-field-accessor -ref_41 0 'binds))))
(define-values
(struct:bind bind2.1 bind? bind-sym bind-phase bind-binding)
- (let-values (((struct:_3 make-_3 ?_3 -ref_3 -set!_3)
- (let-values ()
- (let-values () (make-struct-type 'bind #f 3 0 #f null (current-inspector) #f '(0 1 2) #f 'bind)))))
+ (let-values (((struct:_42 make-_42 ?_42 -ref_42 -set!_42)
+ (make-struct-type 'bind #f 3 0 #f null (current-inspector) #f '(0 1 2) #f 'bind)))
(values
- struct:_3
- make-_3
- ?_3
- (make-struct-field-accessor -ref_3 0 'sym)
- (make-struct-field-accessor -ref_3 1 'phase)
- (make-struct-field-accessor -ref_3 2 'binding))))
+ struct:_42
+ make-_42
+ ?_42
+ (make-struct-field-accessor -ref_42 0 'sym)
+ (make-struct-field-accessor -ref_42 1 'phase)
+ (make-struct-field-accessor -ref_42 2 'binding))))
(define-values
(syntax-binding-set-extend$1)
(lambda (bs_2
as-sym_0
as-phase_0
- mpi_20
- sym_22
- phase_32
+ mpi_22
+ sym_28
+ phase_38
nominal-mpi_0
nominal-phase+space_3
nominal-sym_3
@@ -13651,16 +13192,16 @@
inspector_6)
(begin
'syntax-binding-set-extend
- (let-values (((the-struct_3) bs_2))
- (if (1/syntax-binding-set? the-struct_3)
+ (let-values (((the-struct_32) bs_2))
+ (if (1/syntax-binding-set? the-struct_32)
(let-values (((binds5_0)
(cons
(bind2.1
as-sym_0
as-phase_0
- (let-values (((mpi6_0) mpi_20)
- ((phase7_0) phase_32)
- ((sym8_0) sym_22)
+ (let-values (((mpi6_0) mpi_22)
+ ((phase7_0) phase_38)
+ ((sym8_0) sym_28)
((inspector9_0) inspector_6)
((nominal-mpi10_0) nominal-mpi_0)
((nominal-phase+space11_0) nominal-phase+space_3)
@@ -13680,93 +13221,85 @@
sym8_0)))
(syntax-binding-set-binds bs_2))))
(syntax-binding-set1.1 binds5_0))
- (raise-argument-error 'struct-copy "syntax-binding-set?" the-struct_3))))))
+ (raise-argument-error 'struct-copy "syntax-binding-set?" the-struct_32))))))
(define-values
(syntax-binding-set->syntax$1)
(lambda (bs_3 datum_0)
(begin
'syntax-binding-set->syntax
- (let-values (((s_177) (add-scope (datum->syntax$1 #f datum_0) (new-multi-scope 'binding-set))))
+ (let-values (((s_211) (add-scope (datum->syntax$1 #f datum_0) (new-multi-scope 'binding-set))))
(begin
- (let-values (((lst_65) (syntax-binding-set-binds bs_3)))
+ (let-values (((lst_71) (syntax-binding-set-binds bs_3)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_65)))
- ((letrec-values (((for-loop_22)
- (lambda (lst_66)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_71))
+ ((letrec-values (((for-loop_100)
+ (lambda (lst_72)
(begin
'for-loop
- (if (pair? lst_66)
- (let-values (((bind_0) (unsafe-car lst_66)) ((rest_30) (unsafe-cdr lst_66)))
+ (if (pair? lst_72)
+ (let-values (((bind_0) (unsafe-car lst_72)) ((rest_32) (unsafe-cdr lst_72)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((temp14_1)
- (syntax-scope-set
- s_177
- (bind-phase bind_0)))
- ((temp15_1) (bind-sym bind_0))
- ((temp16_3)
- (bind-binding bind_0)))
- (add-binding-in-scopes!.1
- #f
- temp14_1
- temp15_1
- temp16_3)))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_22 rest_30) (values))))
+ (let-values ((()
+ (begin
+ (let-values (((temp14_1)
+ (syntax-scope-set
+ s_211
+ (bind-phase bind_0)))
+ ((temp15_1) (bind-sym bind_0))
+ ((temp16_3) (bind-binding bind_0)))
+ (add-binding-in-scopes!.1
+ #f
+ temp14_1
+ temp15_1
+ temp16_3))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_100 rest_32) (values))))
(values))))))
- for-loop_22)
- lst_65)))
+ for-loop_100)
+ lst_71)))
(void)
- s_177)))))
+ s_211)))))
(define-values
(1/struct:exn:fail:syntax make-exn:fail:syntax$1 1/exn:fail:syntax? 1/exn:fail:syntax-exprs)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'exn:fail:syntax
- struct:exn:fail
- 1
- 0
- #f
- (list
- (cons
- prop:exn:srclocs
- (lambda (e_15) (filter values (map2 syntax-srcloc$1 (1/exn:fail:syntax-exprs e_15))))))
- #f
- #f
- '(0)
- (lambda (str_0 cm_0 exprs_0 info_1)
- (begin
- (if (if (list? exprs_0) (andmap2 syntax?$1 exprs_0) #f)
- (void)
- (let-values () (raise-argument-error 'exn:fail:syntax "(listof syntax?)" exprs_0)))
- (values str_0 cm_0 exprs_0)))
- 'exn:fail:syntax)))))
- (values struct:_2 make-_2 ?_2 (make-struct-field-accessor -ref_2 0 'exprs))))
+ (let-values (((struct:_43 make-_43 ?_43 -ref_43 -set!_43)
+ (make-struct-type
+ 'exn:fail:syntax
+ struct:exn:fail
+ 1
+ 0
+ #f
+ (list
+ (cons
+ prop:exn:srclocs
+ (lambda (e_15) (filter values (map2 syntax-srcloc$1 (1/exn:fail:syntax-exprs e_15))))))
+ #f
+ #f
+ '(0)
+ (lambda (str_0 cm_0 exprs_0 info_1)
+ (begin
+ (if (if (list? exprs_0) (andmap2 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)))
+ (values struct:_43 make-_43 ?_43 (make-struct-field-accessor -ref_43 0 'exprs))))
(define-values
(1/struct:exn:fail:syntax:unbound make-exn:fail:syntax:unbound$1 1/exn:fail:syntax:unbound?)
- (let-values (((struct:_30 make-_30 ?_30 -ref_30 -set!_30)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'exn:fail:syntax:unbound
- 1/struct:exn:fail:syntax
- 0
- 0
- #f
- null
- #f
- #f
- '()
- #f
- 'exn:fail:syntax:unbound)))))
- (values struct:_30 make-_30 ?_30)))
+ (let-values (((struct:_44 make-_44 ?_44 -ref_44 -set!_44)
+ (make-struct-type
+ 'exn:fail:syntax:unbound
+ 1/struct:exn:fail:syntax
+ 0
+ 0
+ #f
+ null
+ #f
+ #f
+ '()
+ #f
+ 'exn:fail:syntax:unbound)))
+ (values struct:_44 make-_44 ?_44)))
(define-values
(raise-syntax-error$1)
(let-values (((raise-syntax-error_0)
@@ -13779,18 +13312,15 @@
(let-values (((sub-expr_0) sub-expr2_0))
(let-values (((extra-sources_0) extra-sources3_0))
(let-values (((message-suffix_0) message-suffix4_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (1/do-raise-syntax-error
- 'raise-syntax-error
- make-exn:fail:syntax$1
- given-name_0
- message_0
- expr_0
- sub-expr_0
- extra-sources_0
- message-suffix_0))))))))))))))
+ (1/do-raise-syntax-error
+ 'raise-syntax-error
+ make-exn:fail:syntax$1
+ given-name_0
+ message_0
+ expr_0
+ sub-expr_0
+ extra-sources_0
+ message-suffix_0)))))))))))
(case-lambda
((given-name_1 message_1) (begin 'raise-syntax-error (raise-syntax-error_0 given-name_1 message_1 #f #f null "")))
((given-name_2 message_2 expr_1 sub-expr_1 extra-sources_1 message-suffix4_1)
@@ -13812,18 +13342,15 @@
(let-values (((sub-expr_3) sub-expr8_0))
(let-values (((extra-sources_2) extra-sources9_0))
(let-values (((message-suffix_1) message-suffix10_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (1/do-raise-syntax-error
- 'raise-unbound-syntax-error
- make-exn:fail:syntax:unbound$1
- given-name_6
- message_6
- expr_4
- sub-expr_3
- extra-sources_2
- message-suffix_1))))))))))))))
+ (1/do-raise-syntax-error
+ 'raise-unbound-syntax-error
+ make-exn:fail:syntax:unbound$1
+ given-name_6
+ message_6
+ expr_4
+ sub-expr_3
+ extra-sources_2
+ message-suffix_1)))))))))))
(case-lambda
((given-name_7 message_7) (begin (raise-unbound-syntax-error_0 given-name_7 message_7 #f #f null "")))
((given-name_8 message_8 expr_5 sub-expr_4 extra-sources_3 message-suffix10_1)
@@ -13835,46 +13362,44 @@
((given-name_11 message_11 expr7_1) (raise-unbound-syntax-error_0 given-name_11 message_11 expr7_1 #f null "")))))
(define-values
(1/do-raise-syntax-error)
- (lambda (who_8 exn:fail:syntax_0 given-name_12 message_12 expr_8 sub-expr_6 extra-sources_4 message-suffix_2)
+ (lambda (who_15 exn:fail:syntax_0 given-name_12 message_12 expr_8 sub-expr_6 extra-sources_4 message-suffix_2)
(begin
'do-raise-syntax-error
(let-values ((()
(begin
- (if ((lambda (x_35)
- (let-values (((or-part_81) (not x_35))) (if or-part_81 or-part_81 (symbol? x_35))))
+ (if ((lambda (x_39)
+ (let-values (((or-part_215) (not x_39))) (if or-part_215 or-part_215 (symbol? x_39))))
given-name_12)
(void)
- (let-values () (raise-argument-error who_8 "(or/c symbol? #f)" given-name_12)))
+ (raise-argument-error who_15 "(or/c symbol? #f)" given-name_12))
(values))))
(let-values ((()
(begin
- (if (string? message_12)
- (void)
- (let-values () (raise-argument-error who_8 "string?" message_12)))
+ (if (string? message_12) (void) (raise-argument-error who_15 "string?" message_12))
(values))))
(let-values ((()
(begin
(if (if (list? extra-sources_4) (andmap2 syntax?$1 extra-sources_4) #f)
(void)
- (let-values () (raise-argument-error who_8 "(listof syntax?)" extra-sources_4)))
+ (raise-argument-error who_15 "(listof syntax?)" extra-sources_4))
(values))))
(let-values ((()
(begin
(if (string? message-suffix_2)
(void)
- (let-values () (raise-argument-error who_8 "string?" message-suffix_2)))
+ (raise-argument-error who_15 "string?" message-suffix_2))
(values))))
(let-values (((name_27)
(format
"~a"
- (let-values (((or-part_82) given-name_12))
- (if or-part_82
- or-part_82
- (let-values (((or-part_147) (extract-form-name expr_8)))
- (if or-part_147 or-part_147 '?)))))))
+ (let-values (((or-part_216) given-name_12))
+ (if or-part_216
+ or-part_216
+ (let-values (((or-part_217) (extract-form-name expr_8)))
+ (if or-part_217 or-part_217 '?)))))))
(let-values (((unbound-message_0)
(let-values (((ids_0) (current-previously-unbound)))
- (let-values (((or-part_28)
+ (let-values (((or-part_218)
(if (pair? ids_0)
(format
"\n after encountering unbound identifier~a (which is possibly the real problem):~a"
@@ -13882,67 +13407,67 @@
(apply
string-append
(reverse$1
- (let-values (((lst_67) ids_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_67)))
- ((letrec-values (((for-loop_89)
- (lambda (fold-var_45 lst_68)
- (begin
- 'for-loop
- (if (pair? lst_68)
- (let-values (((id_13)
- (unsafe-car lst_68))
- ((rest_31)
- (unsafe-cdr lst_68)))
- (let-values (((fold-var_46)
- (let-values (((fold-var_47)
- fold-var_45))
- (let-values (((fold-var_48)
- (let-values ()
- (cons
- (let-values ()
- (format
- "\n ~s"
- (syntax-e$1
- id_13)))
- fold-var_47))))
+ (let-values (((fold-var_60)
+ (let-values (((fold-var_61) null)) fold-var_61)))
+ (let-values (((lst_73) ids_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_73))
+ ((letrec-values (((for-loop_101)
+ (lambda (fold-var_62 lst_74)
+ (begin
+ 'for-loop
+ (if (pair? lst_74)
+ (let-values (((id_13)
+ (unsafe-car lst_74))
+ ((rest_33)
+ (unsafe-cdr lst_74)))
+ (let-values (((fold-var_63)
+ (let-values (((fold-var_64)
+ (cons
+ (format
+ "\n ~s"
+ (syntax-e$1
+ id_13))
+ fold-var_62)))
(values
- fold-var_48)))))
- (if (not #f)
- (for-loop_89 fold-var_46 rest_31)
- fold-var_46)))
- fold-var_45)))))
- for-loop_89)
- null
- lst_67))))))
+ fold-var_64))))
+ (if (not #f)
+ (for-loop_101
+ fold-var_63
+ rest_33)
+ fold-var_63)))
+ fold-var_62)))))
+ for-loop_101)
+ fold-var_60
+ lst_73)))))))
#f)))
- (if or-part_28 or-part_28 "")))))
+ (if or-part_218 or-part_218 "")))))
(let-values (((at-message_0)
- (let-values (((or-part_148)
+ (let-values (((or-part_219)
(if sub-expr_6
(if (error-print-source-location)
(string-append "\n at:" (syntax->string sub-expr_6))
#f)
#f)))
- (if or-part_148 or-part_148 ""))))
+ (if or-part_219 or-part_219 ""))))
(let-values (((in-message_0)
- (let-values (((or-part_61)
+ (let-values (((or-part_220)
(if expr_8
(if (error-print-source-location)
(string-append "\n in:" (syntax->string expr_8))
#f)
#f)))
- (if or-part_61 or-part_61 ""))))
+ (if or-part_220 or-part_220 ""))))
(let-values (((src-loc-str_0)
- (let-values (((or-part_149)
+ (let-values (((or-part_221)
(if (error-print-source-location)
- (let-values (((or-part_150) (extract-source-location sub-expr_6)))
- (if or-part_150 or-part_150 (extract-source-location expr_8)))
+ (let-values (((or-part_222) (extract-source-location sub-expr_6)))
+ (if or-part_222 or-part_222 (extract-source-location expr_8)))
#f)))
- (if or-part_149 or-part_149 ""))))
- (let-values (((e_6)
+ (if or-part_221 or-part_221 ""))))
+ (let-values (((e_16)
(exn:fail:syntax_0
(string-append
src-loc-str_0
@@ -13956,53 +13481,41 @@
(current-continuation-marks)
(map2
syntax-taint$1
- (if (let-values (((or-part_151) sub-expr_6))
- (if or-part_151 or-part_151 expr_8))
+ (if (let-values (((or-part_223) sub-expr_6))
+ (if or-part_223 or-part_223 expr_8))
(let-values (((with-handlers-predicate17_0) exn:fail:contract?)
((with-handlers-handler18_0)
- (lambda (exn_1)
+ (lambda (exn_0)
(begin 'with-handlers-handler18 extra-sources_4))))
(let-values (((bpz_3) (continuation-mark-set-first #f break-enabled-key)))
(call-handled-body
bpz_3
- (lambda (e_16)
+ (lambda (e_17)
(select-handler/no-breaks
- e_16
+ e_17
bpz_3
(list (cons with-handlers-predicate17_0 with-handlers-handler18_0))))
(lambda ()
(cons
(datum->syntax$1
#f
- (let-values (((or-part_152) sub-expr_6))
- (if or-part_152 or-part_152 expr_8)))
+ (let-values (((or-part_224) sub-expr_6))
+ (if or-part_224 or-part_224 expr_8)))
extra-sources_4)))))
extra-sources_4)))))
(begin
- (if (1/exn:fail:syntax? e_6)
- (void)
- (let-values () (raise-result-error who_8 "exn:fail:syntax?" e_6)))
- (raise e_6)))))))))))))))
+ (if (1/exn:fail:syntax? e_16) (void) (raise-result-error who_15 "exn:fail:syntax?" e_16))
+ (raise e_16)))))))))))))))
(define-values
(extract-form-name)
- (lambda (s_167)
- (begin
- (if (syntax?$1 s_167)
- (let-values ()
- (let-values (((e_17) (syntax-e$1 s_167)))
- (if (symbol? e_17)
- (let-values () e_17)
- (if (if (pair? e_17) (identifier? (car e_17)) #f)
- (let-values () (syntax-e$1 (car e_17)))
- (let-values () #f)))))
- (let-values () #f)))))
+ (lambda (s_212) (begin (if (syntax?$1 s_212) ((error-syntax->name-handler) s_212) #f))))
(define-values
(extract-source-location)
- (lambda (s_178)
+ (lambda (s_213)
(begin
- (if (syntax?$1 s_178)
- (if (syntax-srcloc$1 s_178)
- (let-values (((str_1) (srcloc->string (syntax-srcloc$1 s_178)))) (if str_1 (string-append str_1 ": ") #f))
+ (if (syntax?$1 s_213)
+ (if (syntax-srcloc$1 s_213)
+ (let-values (((str_1) (srcloc->string (syntax-srcloc$1 s_213)))) (if str_1 (string-append str_1 ": ") #f))
#f)
#f))))
(define-values
@@ -14010,7 +13523,7 @@
(lambda (expr_9)
(begin
(let-values (((with-handlers-predicate19_0) exn:fail:contract?)
- ((with-handlers-handler20_0) (lambda (exn_2) (begin 'with-handlers-handler20 expr_9))))
+ ((with-handlers-handler20_0) (lambda (exn_1) (begin 'with-handlers-handler20 expr_9))))
(let-values (((bpz_4) (continuation-mark-set-first #f break-enabled-key)))
(call-handled-body
bpz_4
@@ -14021,9 +13534,9 @@
(define-values (set-current-previously-unbound!) (lambda (proc_3) (begin (set! current-previously-unbound proc_3))))
(define-values
(syntax->string)
- (lambda (v_86)
+ (lambda (v_123)
(begin
- (let-values (((str_2) ((error-syntax->string-handler) v_86 (error-print-width))))
+ (let-values (((str_2) ((error-syntax->string-handler) v_123 (error-print-width))))
(if (regexp-match? '#rx"\n" str_2)
(string-append "\n " (regexp-replace* '#rx"\n" str_2 "\n "))
(string-append " " str_2))))))
@@ -14031,93 +13544,130 @@
(install-error-syntax->string-handler!)
(lambda ()
(begin
- (error-syntax->string-handler
- (let-values (((default-error-syntax->string-handler_0)
- (lambda (v_87 len_12)
- (begin
- 'default-error-syntax->string-handler
+ (begin
+ (error-syntax->name-handler
+ (lambda (s_214)
+ (let-values ((()
(begin
- (if (let-values (((or-part_153) (not len_12)))
- (if or-part_153 or-part_153 (exact-nonnegative-integer? len_12)))
+ (if (syntax?$1 s_214)
(void)
- (let-values ()
+ (raise-argument-error 'default-error-syntax->name-handler "syntax?" s_214))
+ (values))))
+ (let-values (((e_19) (syntax-e$1 s_214)))
+ (if (symbol? e_19)
+ e_19
+ (if (if (pair? e_19) (identifier? (car e_19)) #f) (syntax-e$1 (car e_19)) #f))))))
+ (error-syntax->string-handler
+ (let-values (((default-error-syntax->string-handler_0)
+ (lambda (v_124 len_12)
+ (begin
+ 'default-error-syntax->string-handler
+ (begin
+ (if (let-values (((or-part_225) (not len_12)))
+ (if or-part_225 or-part_225 (exact-nonnegative-integer? len_12)))
+ (void)
(raise-argument-error
- 'default-error-value->string-handler
+ 'default-error-syntax->string-handler
"(or/c exact-nonnegative-integer? #f)"
- len_12)))
- (if len_12
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first #f parameterization-key)
- error-print-width
- (max 3 len_12))
- (let-values () (format "~.s" (->datum v_87))))
- (format "~s" (->datum v_87))))))))
- default-error-syntax->string-handler_0)))))
+ len_12))
+ (if len_12
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first #f parameterization-key)
+ error-print-width
+ (max 3 len_12))
+ (format "~.s" (->datum v_124)))
+ (format "~s" (->datum v_124))))))))
+ default-error-syntax->string-handler_0))))))
(define-values
(struct:module-use module-use1.1 module-use? module-use-module module-use-phase)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'module-use
- #f
- 2
- 0
- #f
- (list
- (cons
- prop:equal+hash
- (list
- (lambda (a_20 b_22 eql?_4)
- (let-values (((a-mod_0) (module-use-module a_20)))
- (let-values (((b-mod_0) (module-use-module b_22)))
- (if (eql?_4 a-mod_0 b-mod_0)
- (if (eql?_4 (module-use-phase a_20) (module-use-phase b_22))
- (let-values (((a-path_0 a-base_0) (1/module-path-index-split a-mod_0))
- ((b-path_0 b-base_0) (1/module-path-index-split b-mod_0)))
- (let-values (((or-part_15) a-path_0))
- (if or-part_15
- or-part_15
- (let-values (((or-part_73) b-path_0))
- (if or-part_73
- or-part_73
- (eq?
- (module-path-index-resolved a-mod_0)
- (module-path-index-resolved b-mod_0)))))))
- #f)
- #f))))
- (lambda (a_25 hash-code_4)
- (+ (hash-code_4 (module-use-module a_25)) (hash-code_4 (module-use-phase a_25))))
- (lambda (a_26 hash-code_5)
- (+ (hash-code_5 (module-use-module a_26)) (hash-code_5 (module-use-phase a_26)))))))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'module-use)))))
+ (let-values (((struct:_45 make-_45 ?_45 -ref_45 -set!_45)
+ (make-struct-type
+ 'module-use
+ #f
+ 2
+ 0
+ #f
+ (list
+ (cons
+ prop:equal+hash
+ (list
+ (lambda (a_28 b_77 eql?_4)
+ (let-values (((a-mod_0) (module-use-module a_28)))
+ (let-values (((b-mod_0) (module-use-module b_77)))
+ (if (eql?_4 a-mod_0 b-mod_0)
+ (if (eql?_4 (module-use-phase a_28) (module-use-phase b_77))
+ (let-values (((a-path_0 a-base_0) (1/module-path-index-split a-mod_0))
+ ((b-path_0 b-base_0) (1/module-path-index-split b-mod_0)))
+ (let-values (((or-part_226) a-path_0))
+ (if or-part_226
+ or-part_226
+ (let-values (((or-part_227) b-path_0))
+ (if or-part_227
+ or-part_227
+ (eq?
+ (module-path-index-resolved a-mod_0)
+ (module-path-index-resolved b-mod_0)))))))
+ #f)
+ #f))))
+ (lambda (a_29 hash-code_4)
+ (+ (hash-code_4 (module-use-module a_29)) (hash-code_4 (module-use-phase a_29))))
+ (lambda (a_30 hash-code_5)
+ (+ (hash-code_5 (module-use-module a_30)) (hash-code_5 (module-use-phase a_30)))))))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'module-use)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'module)
- (make-struct-field-accessor -ref_2 1 'phase))))
+ struct:_45
+ make-_45
+ ?_45
+ (make-struct-field-accessor -ref_45 0 'module)
+ (make-struct-field-accessor -ref_45 1 'phase))))
(define-values
- (struct:portal-syntax portal-syntax1.1 1/portal-syntax? 1/portal-syntax-content)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type 'portal-syntax #f 1 0 #f null (current-inspector) #f '(0) #f 'portal-syntax)))))
- (values struct:_2 make-_2 ?_2 (make-struct-field-accessor -ref_2 0 'content))))
+ (struct:portal-syntax portal-syntax1.1 1/portal-syntax? portal-syntax-get-content portal-syntax-pos)
+ (let-values (((struct:_46 make-_46 ?_46 -ref_46 -set!_46)
+ (make-struct-type
+ 'portal-syntax
+ #f
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'portal-syntax)))
+ (values
+ struct:_46
+ make-_46
+ ?_46
+ (make-struct-field-accessor -ref_46 0 'get-content)
+ (make-struct-field-accessor -ref_46 1 'pos))))
(define-values
(1/make-portal-syntax)
(lambda (stx_9)
(begin
'make-portal-syntax
(begin
- (if (syntax?$1 stx_9) (void) (let-values () (raise-argument-error 'make-portal-syntax "syntax?" stx_9)))
- (portal-syntax1.1 stx_9)))))
+ (if (syntax?$1 stx_9) (void) (raise-argument-error 'make-portal-syntax "syntax?" stx_9))
+ (portal-syntax1.1 stx_9 #f)))))
+ (define-values
+ (1/portal-syntax-content)
+ (lambda (p_21)
+ (begin
+ 'portal-syntax-content
+ (let-values ((()
+ (begin
+ (if (1/portal-syntax? p_21)
+ (void)
+ (raise-argument-error 'portal-syntax-content "portal-syntax?" p_21))
+ (values))))
+ (let-values (((pos_22) (portal-syntax-pos p_21)))
+ (if pos_22 ((portal-syntax-get-content p_21) pos_22) (portal-syntax-get-content p_21)))))))
(define-values
(struct:module
module1.1
@@ -14125,6 +13675,8 @@
module-source-name
module-self
module-requires
+ module-recur-requires
+ module-flattened-requires
module-provides
module-access
module-language-info
@@ -14145,48 +13697,48 @@
module-get-all-variables
module-get-portal-syntax-callback
set-module-access!)
- (let-values (((struct:_31 make-_31 ?_31 -ref_31 -set!_31)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'module
- #f
- 22
- 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 20 21)
- #f
- 'module)))))
+ (let-values (((struct:_47 make-_47 ?_47 -ref_47 -set!_47)
+ (make-struct-type
+ 'module
+ #f
+ 24
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)
+ #f
+ 'module)))
(values
- struct:_31
- make-_31
- ?_31
- (make-struct-field-accessor -ref_31 0 'source-name)
- (make-struct-field-accessor -ref_31 1 'self)
- (make-struct-field-accessor -ref_31 2 'requires)
- (make-struct-field-accessor -ref_31 3 'provides)
- (make-struct-field-accessor -ref_31 4 'access)
- (make-struct-field-accessor -ref_31 5 'language-info)
- (make-struct-field-accessor -ref_31 6 'realm)
- (make-struct-field-accessor -ref_31 7 'min-phase-level)
- (make-struct-field-accessor -ref_31 8 'max-phase-level)
- (make-struct-field-accessor -ref_31 9 'phase-level-linklet-info-callback)
- (make-struct-field-accessor -ref_31 10 'force-bulk-binding)
- (make-struct-field-accessor -ref_31 11 'prepare-instance)
- (make-struct-field-accessor -ref_31 12 'instantiate-phase)
- (make-struct-field-accessor -ref_31 13 'primitive?)
- (make-struct-field-accessor -ref_31 14 'is-predefined?)
- (make-struct-field-accessor -ref_31 15 'cross-phase-persistent?)
- (make-struct-field-accessor -ref_31 16 'no-protected?)
- (make-struct-field-accessor -ref_31 17 'inspector)
- (make-struct-field-accessor -ref_31 18 'submodule-names)
- (make-struct-field-accessor -ref_31 19 'supermodule-name)
- (make-struct-field-accessor -ref_31 20 'get-all-variables)
- (make-struct-field-accessor -ref_31 21 'get-portal-syntax-callback)
- (make-struct-field-mutator -set!_31 4 'access))))
+ struct:_47
+ make-_47
+ ?_47
+ (make-struct-field-accessor -ref_47 0 'source-name)
+ (make-struct-field-accessor -ref_47 1 'self)
+ (make-struct-field-accessor -ref_47 2 'requires)
+ (make-struct-field-accessor -ref_47 3 'recur-requires)
+ (make-struct-field-accessor -ref_47 4 'flattened-requires)
+ (make-struct-field-accessor -ref_47 5 'provides)
+ (make-struct-field-accessor -ref_47 6 'access)
+ (make-struct-field-accessor -ref_47 7 'language-info)
+ (make-struct-field-accessor -ref_47 8 'realm)
+ (make-struct-field-accessor -ref_47 9 'min-phase-level)
+ (make-struct-field-accessor -ref_47 10 'max-phase-level)
+ (make-struct-field-accessor -ref_47 11 'phase-level-linklet-info-callback)
+ (make-struct-field-accessor -ref_47 12 'force-bulk-binding)
+ (make-struct-field-accessor -ref_47 13 'prepare-instance)
+ (make-struct-field-accessor -ref_47 14 'instantiate-phase)
+ (make-struct-field-accessor -ref_47 15 'primitive?)
+ (make-struct-field-accessor -ref_47 16 'is-predefined?)
+ (make-struct-field-accessor -ref_47 17 'cross-phase-persistent?)
+ (make-struct-field-accessor -ref_47 18 'no-protected?)
+ (make-struct-field-accessor -ref_47 19 'inspector)
+ (make-struct-field-accessor -ref_47 20 'submodule-names)
+ (make-struct-field-accessor -ref_47 21 'supermodule-name)
+ (make-struct-field-accessor -ref_47 22 'get-all-variables)
+ (make-struct-field-accessor -ref_47 23 'get-portal-syntax-callback)
+ (make-struct-field-mutator -set!_47 6 'access))))
(define-values
(struct:module-linklet-info
module-linklet-info2.1
@@ -14197,449 +13749,515 @@
module-linklet-info-inspector
module-linklet-info-extra-inspector
module-linklet-info-extra-inspectorsss)
- (let-values (((struct:_32 make-_32 ?_32 -ref_32 -set!_32)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'module-linklet-info
- #f
- 6
- 0
- #f
- (list (cons prop:authentic #t))
- #f
- #f
- '(0 1 2 3 4 5)
- #f
- 'module-linklet-info)))))
+ (let-values (((struct:_48 make-_48 ?_48 -ref_48 -set!_48)
+ (make-struct-type
+ 'module-linklet-info
+ #f
+ 6
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ #f
+ #f
+ '(0 1 2 3 4 5)
+ #f
+ 'module-linklet-info)))
(values
- struct:_32
- make-_32
- ?_32
- (make-struct-field-accessor -ref_32 0 'linklet-or-instance)
- (make-struct-field-accessor -ref_32 1 'module-uses)
- (make-struct-field-accessor -ref_32 2 'self)
- (make-struct-field-accessor -ref_32 3 'inspector)
- (make-struct-field-accessor -ref_32 4 'extra-inspector)
- (make-struct-field-accessor -ref_32 5 'extra-inspectorsss))))
+ struct:_48
+ make-_48
+ ?_48
+ (make-struct-field-accessor -ref_48 0 'linklet-or-instance)
+ (make-struct-field-accessor -ref_48 1 'module-uses)
+ (make-struct-field-accessor -ref_48 2 'self)
+ (make-struct-field-accessor -ref_48 3 'inspector)
+ (make-struct-field-accessor -ref_48 4 'extra-inspector)
+ (make-struct-field-accessor -ref_48 5 'extra-inspectorsss))))
(define-values
(make-module.1)
- (lambda (cross-phase-persistent?17_0
- force-bulk-binding-callback10_0
- get-all-variables21_0
- get-portal-syntax-callback22_0
- instantiate-phase-callback9_0
- language-info13_0
- max-phase-level8_0
- min-phase-level7_0
- no-protected?18_0
- phase-level-linklet-info-callback12_0
- predefined?16_0
- prepare-instance-callback11_0
- primitive?15_0
- provides6_0
- realm14_0
+ (lambda (cross-phase-persistent?19_0
+ flattened-requires7_0
+ force-bulk-binding-callback12_0
+ get-all-variables23_0
+ get-portal-syntax-callback24_0
+ instantiate-phase-callback11_0
+ language-info15_0
+ max-phase-level10_0
+ min-phase-level9_0
+ no-protected?20_0
+ phase-level-linklet-info-callback14_0
+ predefined?18_0
+ prepare-instance-callback13_0
+ primitive?17_0
+ provides8_0
+ realm16_0
+ recur-requires6_0
requires5_0
self4_0
source-name3_0
- submodule-names19_0
- supermodule-name20_0)
+ submodule-names21_0
+ supermodule-name22_0)
(begin
'make-module
(let-values (((source-name_0) source-name3_0))
- (let-values (((self_4) self4_0))
+ (let-values (((self_6) self4_0))
(let-values (((requires_0) requires5_0))
- (let-values (((provides_4) provides6_0))
- (let-values (((min-phase-level_0) min-phase-level7_0))
- (let-values (((max-phase-level_0) max-phase-level8_0))
- (let-values (((instantiate-phase_0) instantiate-phase-callback9_0))
- (let-values (((force-bulk-binding_0) force-bulk-binding-callback10_0))
- (let-values (((prepare-instance_0) prepare-instance-callback11_0))
- (let-values (((phase-level-linklet-info-callback_0)
- (if (eq? phase-level-linklet-info-callback12_0 unsafe-undefined)
- (lambda (phase-level_13 ns_20 insp_3)
- (begin 'phase-level-linklet-info-callback #f))
- phase-level-linklet-info-callback12_0)))
- (let-values (((language-info_0) language-info13_0))
- (let-values (((realm_0) realm14_0))
- (let-values (((primitive?_0) primitive?15_0))
- (let-values (((predefined?_0) predefined?16_0))
- (let-values (((cross-phase-persistent?_0)
- (if (eq? cross-phase-persistent?17_0 unsafe-undefined)
- primitive?_0
- cross-phase-persistent?17_0)))
- (let-values (((no-protected?_0) no-protected?18_0))
- (let-values (((submodule-names_0) submodule-names19_0))
- (let-values (((supermodule-name_0) supermodule-name20_0))
- (let-values (((get-all-variables_0)
- (if (eq? get-all-variables21_0 unsafe-undefined)
- (lambda () (begin 'get-all-variables null))
- get-all-variables21_0)))
- (let-values (((get-portal-syntax-callback_0)
- (if (eq? get-portal-syntax-callback22_0 unsafe-undefined)
- (lambda (data-box_0 phase_33 sym_23)
- (begin 'get-portal-syntax-callback #f))
- get-portal-syntax-callback22_0)))
- (let-values ()
- (module1.1
- source-name_0
- self_4
- (fresh-requires requires_0)
- provides_4
- #f
- language-info_0
- realm_0
- min-phase-level_0
- max-phase-level_0
- phase-level-linklet-info-callback_0
- force-bulk-binding_0
- prepare-instance_0
- instantiate-phase_0
- primitive?_0
- predefined?_0
- cross-phase-persistent?_0
- no-protected?_0
- (current-code-inspector)
- submodule-names_0
- supermodule-name_0
- get-all-variables_0
- get-portal-syntax-callback_0)))))))))))))))))))))))))
- (define-values
- (struct:module-instance
- module-instance44.1
- module-instance?
- module-instance-namespace
- module-instance-module
- module-instance-shifted-requires
- module-instance-phase-level-to-state
- module-instance-made-available?
- module-instance-attached?
- module-instance-data-box
- module-instance-portal-syntaxes
- set-module-instance-shifted-requires!
- set-module-instance-made-available?!
- set-module-instance-attached?!)
- (let-values (((struct:_33 make-_33 ?_33 -ref_33 -set!_33)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'module-instance
- #f
- 8
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 3 6 7)
- #f
- 'module-instance)))))
+ (let-values (((recur-requires_0)
+ (if (eq? recur-requires6_0 unsafe-undefined)
+ (reverse$1
+ (let-values (((fold-var_65) (let-values (((fold-var_66) null)) fold-var_66)))
+ (let-values (((lst_75) requires_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_75))
+ ((letrec-values (((for-loop_102)
+ (lambda (fold-var_67 lst_76)
+ (begin
+ 'for-loop
+ (if (pair? lst_76)
+ (let-values (((phase+mps_0) (unsafe-car lst_76))
+ ((rest_34) (unsafe-cdr lst_76)))
+ (let-values (((fold-var_68)
+ (let-values (((fold-var_69)
+ (cons
+ (reverse$1
+ (let-values (((fold-var_70)
+ (let-values (((fold-var_71)
+ null))
+ fold-var_71)))
+ (let-values (((lst_77)
+ (cdr
+ phase+mps_0)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_77))
+ ((letrec-values (((for-loop_103)
+ (lambda (fold-var_72
+ lst_78)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_78)
+ (let-values (((mp_0)
+ (unsafe-car
+ lst_78))
+ ((rest_35)
+ (unsafe-cdr
+ lst_78)))
+ (let-values (((fold-var_73)
+ (let-values (((fold-var_74)
+ (cons
+ #t
+ fold-var_72)))
+ (values
+ fold-var_74))))
+ (if (not
+ #f)
+ (for-loop_103
+ fold-var_73
+ rest_35)
+ fold-var_73)))
+ fold-var_72)))))
+ for-loop_103)
+ fold-var_70
+ lst_77)))))
+ fold-var_67)))
+ (values fold-var_69))))
+ (if (not #f)
+ (for-loop_102 fold-var_68 rest_34)
+ fold-var_68)))
+ fold-var_67)))))
+ for-loop_102)
+ fold-var_65
+ lst_75)))))
+ recur-requires6_0)))
+ (let-values (((flattened-requires_0) flattened-requires7_0))
+ (let-values (((provides_5) provides8_0))
+ (let-values (((min-phase-level_0) min-phase-level9_0))
+ (let-values (((max-phase-level_0) max-phase-level10_0))
+ (let-values (((instantiate-phase_0) instantiate-phase-callback11_0))
+ (let-values (((force-bulk-binding_0) force-bulk-binding-callback12_0))
+ (let-values (((prepare-instance_0) prepare-instance-callback13_0))
+ (let-values (((phase-level-linklet-info-callback_0)
+ (if (eq? phase-level-linklet-info-callback14_0 unsafe-undefined)
+ (lambda (phase-level_15 ns_20 insp_3)
+ (begin 'phase-level-linklet-info-callback #f))
+ phase-level-linklet-info-callback14_0)))
+ (let-values (((language-info_0) language-info15_0))
+ (let-values (((realm_0) realm16_0))
+ (let-values (((primitive?_0) primitive?17_0))
+ (let-values (((predefined?_0) predefined?18_0))
+ (let-values (((cross-phase-persistent?_0)
+ (if (eq? cross-phase-persistent?19_0 unsafe-undefined)
+ primitive?_0
+ cross-phase-persistent?19_0)))
+ (let-values (((no-protected?_0) no-protected?20_0))
+ (let-values (((submodule-names_0) submodule-names21_0))
+ (let-values (((supermodule-name_0) supermodule-name22_0))
+ (let-values (((get-all-variables_0)
+ (if (eq? get-all-variables23_0 unsafe-undefined)
+ (lambda () (begin 'get-all-variables null))
+ get-all-variables23_0)))
+ (let-values (((get-portal-syntax-callback_0)
+ (if (eq? get-portal-syntax-callback24_0 unsafe-undefined)
+ (lambda (data-box_0 phase_39 sym_29)
+ (begin 'get-portal-syntax-callback #f))
+ get-portal-syntax-callback24_0)))
+ (module1.1
+ source-name_0
+ self_6
+ requires_0
+ recur-requires_0
+ flattened-requires_0
+ provides_5
+ #f
+ language-info_0
+ realm_0
+ min-phase-level_0
+ max-phase-level_0
+ phase-level-linklet-info-callback_0
+ force-bulk-binding_0
+ prepare-instance_0
+ instantiate-phase_0
+ primitive?_0
+ predefined?_0
+ cross-phase-persistent?_0
+ no-protected?_0
+ (current-code-inspector)
+ submodule-names_0
+ supermodule-name_0
+ get-all-variables_0
+ get-portal-syntax-callback_0))))))))))))))))))))))))))
+ (define-values
+ (struct:module-instance
+ module-instance48.1
+ module-instance?
+ module-instance-namespace
+ module-instance-module
+ module-instance-shifted-requires
+ module-instance-phase-level-to-state
+ module-instance-made-available?
+ module-instance-attached?
+ module-instance-data-box
+ module-instance-portal-syntaxes
+ set-module-instance-shifted-requires!
+ set-module-instance-made-available?!
+ set-module-instance-attached?!)
+ (let-values (((struct:_49 make-_49 ?_49 -ref_49 -set!_49)
+ (make-struct-type
+ 'module-instance
+ #f
+ 8
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 3 6 7)
+ #f
+ 'module-instance)))
(values
- struct:_33
- make-_33
- ?_33
- (make-struct-field-accessor -ref_33 0 'namespace)
- (make-struct-field-accessor -ref_33 1 'module)
- (make-struct-field-accessor -ref_33 2 'shifted-requires)
- (make-struct-field-accessor -ref_33 3 'phase-level-to-state)
- (make-struct-field-accessor -ref_33 4 'made-available?)
- (make-struct-field-accessor -ref_33 5 'attached?)
- (make-struct-field-accessor -ref_33 6 'data-box)
- (make-struct-field-accessor -ref_33 7 'portal-syntaxes)
- (make-struct-field-mutator -set!_33 2 'shifted-requires)
- (make-struct-field-mutator -set!_33 4 'made-available?)
- (make-struct-field-mutator -set!_33 5 'attached?))))
+ struct:_49
+ make-_49
+ ?_49
+ (make-struct-field-accessor -ref_49 0 'namespace)
+ (make-struct-field-accessor -ref_49 1 'module)
+ (make-struct-field-accessor -ref_49 2 'shifted-requires)
+ (make-struct-field-accessor -ref_49 3 'phase-level-to-state)
+ (make-struct-field-accessor -ref_49 4 'made-available?)
+ (make-struct-field-accessor -ref_49 5 'attached?)
+ (make-struct-field-accessor -ref_49 6 'data-box)
+ (make-struct-field-accessor -ref_49 7 'portal-syntaxes)
+ (make-struct-field-mutator -set!_49 2 'shifted-requires)
+ (make-struct-field-mutator -set!_49 4 'made-available?)
+ (make-struct-field-mutator -set!_49 5 'attached?))))
(define-values
(make-module-instance)
(lambda (m-ns_0 m_1 portal-syntaxes_0)
- (begin (module-instance44.1 m-ns_0 m_1 #f (make-small-hasheqv) #f #f (box #f) portal-syntaxes_0))))
+ (begin (module-instance48.1 m-ns_0 m_1 #f (make-small-hasheqv) #f #f (box #f) portal-syntaxes_0))))
(define-values
(make-module-namespace.1)
- (lambda (for-submodule?47_0 mpi45_0 portal-syntaxes48_0 root-expand-context46_0 ns53_0)
+ (lambda (for-submodule?51_0 mpi49_0 portal-syntaxes52_0 root-expand-context50_0 ns57_0)
(begin
'make-module-namespace
- (let-values (((ns_21) ns53_0))
- (let-values (((name-mpi_0) mpi45_0))
- (let-values (((root-expand-ctx_1) root-expand-context46_0))
- (let-values (((for-submodule?_0) for-submodule?47_0))
- (let-values (((portal-syntaxes_1) portal-syntaxes48_0))
- (let-values ()
- (let-values (((phase_34) 0))
- (let-values (((name_28) (1/module-path-index-resolve name-mpi_0)))
- (let-values (((m-ns_1)
- (let-values (((the-struct_32)
- (let-values (((ns148_0) ns_21)
- ((root-expand-ctx149_0) root-expand-ctx_1)
- ((temp150_0) #f))
- (new-namespace.1 temp150_0 root-expand-ctx149_0 ns148_0))))
- (if (1/namespace? the-struct_32)
- (let-values (((mpi140_0) name-mpi_0)
- ((source-name141_0) (resolved-module-path-root-name name_28))
- ((phase142_0) phase_34)
- ((0-phase143_0) phase_34)
- ((submodule-declarations144_0)
- (if for-submodule?_0
- (namespace-submodule-declarations ns_21)
- (make-small-hasheq)))
- ((available-module-instances145_0) (make-hasheqv))
- ((module-instances146_0) (make-hasheqv))
- ((declaration-inspector147_0) (current-code-inspector)))
- (namespace1.1
- mpi140_0
- source-name141_0
- (namespace-root-expand-ctx the-struct_32)
- phase142_0
- 0-phase143_0
- (namespace-phase-to-namespace the-struct_32)
- (namespace-phase-level-to-definitions the-struct_32)
- (namespace-module-registry$1 the-struct_32)
- (namespace-bulk-binding-registry the-struct_32)
- submodule-declarations144_0
- (namespace-root-namespace the-struct_32)
- declaration-inspector147_0
- (namespace-inspector the-struct_32)
- available-module-instances145_0
- module-instances146_0))
- (raise-argument-error 'struct-copy "namespace?" the-struct_32)))))
- (let-values ((()
- (begin
- (small-hash-set! (namespace-phase-to-namespace m-ns_1) phase_34 m-ns_1)
- (values))))
- (let-values (((at-phase_0) (make-hasheq)))
- (begin
- (hash-set! (namespace-module-instances m-ns_1) phase_34 at-phase_0)
- (hash-set! at-phase_0 name_28 (make-module-instance m-ns_1 #f portal-syntaxes_1))
- m-ns_1)))))))))))))))
+ (let-values (((ns_21) ns57_0))
+ (let-values (((name-mpi_0) mpi49_0))
+ (let-values (((root-expand-ctx_1) root-expand-context50_0))
+ (let-values (((for-submodule?_0) for-submodule?51_0))
+ (let-values (((portal-syntaxes_1) portal-syntaxes52_0))
+ (let-values (((phase_40) 0))
+ (let-values (((name_28) (1/module-path-index-resolve name-mpi_0)))
+ (let-values (((m-ns_1)
+ (let-values (((the-struct_33)
+ (let-values (((ns173_0) ns_21)
+ ((root-expand-ctx174_0) root-expand-ctx_1)
+ ((temp175_0) #f))
+ (new-namespace.1 temp175_0 root-expand-ctx174_0 ns173_0))))
+ (if (1/namespace? the-struct_33)
+ (let-values (((mpi164_0) name-mpi_0)
+ ((source-name165_0) (resolved-module-path-root-name name_28))
+ ((phase166_0) phase_40)
+ ((0-phase167_0) phase_40)
+ ((submodule-declarations168_0)
+ (if for-submodule?_0
+ (namespace-submodule-declarations ns_21)
+ (make-small-hasheq)))
+ ((available-module-instances169_0) (make-hasheqv))
+ ((available-cross-phase-module-instances170_0) (box null))
+ ((module-instances171_0) (make-hasheqv))
+ ((declaration-inspector172_0) (current-code-inspector)))
+ (namespace1.1
+ mpi164_0
+ source-name165_0
+ (namespace-root-expand-ctx the-struct_33)
+ phase166_0
+ 0-phase167_0
+ (namespace-phase-to-namespace the-struct_33)
+ (namespace-phase-level-to-definitions the-struct_33)
+ (namespace-module-registry$1 the-struct_33)
+ (namespace-module-instance-shifted-requires the-struct_33)
+ (namespace-bulk-binding-registry the-struct_33)
+ submodule-declarations168_0
+ (namespace-root-namespace the-struct_33)
+ declaration-inspector172_0
+ (namespace-inspector the-struct_33)
+ available-module-instances169_0
+ available-cross-phase-module-instances170_0
+ module-instances171_0))
+ (raise-argument-error 'struct-copy "namespace?" the-struct_33)))))
+ (let-values ((()
+ (begin
+ (small-hash-set! (namespace-phase-to-namespace m-ns_1) phase_40 m-ns_1)
+ (values))))
+ (let-values (((at-phase_0) (make-hasheq)))
+ (begin
+ (hash-set! (namespace-module-instances m-ns_1) phase_40 at-phase_0)
+ (hash-set! at-phase_0 name_28 (make-module-instance m-ns_1 #f portal-syntaxes_1))
+ m-ns_1))))))))))))))
(define-values
(declare-module!.1)
- (lambda (with-submodules?55_0 ns57_0 m58_0 mod-name59_0)
+ (lambda (with-submodules?59_0 ns61_0 m62_0 mod-name63_0)
(begin
'declare-module!
- (let-values (((ns_22) ns57_0))
- (let-values (((m_2) m58_0))
- (let-values (((mod-name_4) mod-name59_0))
- (let-values (((with-submodules?_0) with-submodules?55_0))
- (let-values ()
- (let-values (((prior-m_0)
- (if with-submodules?_0
- (hash-ref
- (module-registry-declarations (namespace-module-registry$1 ns_22))
- mod-name_4
- #f)
+ (let-values (((ns_22) ns61_0))
+ (let-values (((m_2) m62_0))
+ (let-values (((mod-name_4) mod-name63_0))
+ (let-values (((with-submodules?_0) with-submodules?59_0))
+ (let-values (((prior-m_0)
+ (if with-submodules?_0
+ (hash-ref
+ (module-registry-declarations (namespace-module-registry$1 ns_22))
+ mod-name_4
+ #f)
+ #f)))
+ (let-values (((prior-mi_0)
+ (if prior-m_0
+ (if (not (eq? m_2 prior-m_0))
+ (let-values (((ns176_0) ns_22)
+ ((mod-name177_0) mod-name_4)
+ ((temp178_0) (namespace-phase ns_22)))
+ (namespace->module-instance.1 #f #f void ns176_0 mod-name177_0 temp178_0))
+ #f)
#f)))
- (let-values (((prior-mi_0)
- (if prior-m_0
- (if (not (eq? m_2 prior-m_0))
- (let-values (((ns151_0) ns_22)
- ((mod-name152_0) mod-name_4)
- ((temp153_0) (namespace-phase ns_22)))
- (namespace->module-instance.1 #f #f void ns151_0 mod-name152_0 temp153_0))
- #f)
- #f)))
- (begin
- (if (if prior-m_0 (not (eq? m_2 prior-m_0)) #f)
- (let-values () (check-redeclaration-ok prior-m_0 prior-mi_0 mod-name_4))
- (void))
- (if with-submodules?_0
- (hash-set! (module-registry-declarations (namespace-module-registry$1 ns_22)) mod-name_4 m_2)
- (small-hash-set! (namespace-submodule-declarations ns_22) mod-name_4 m_2))
- (if with-submodules?_0
- (let-values ()
- (begin
- (register-bulk-provide!
- (namespace-bulk-binding-registry ns_22)
- mod-name_4
- (module-self m_2)
- (module-provides m_2))
- ((1/current-module-name-resolver) mod-name_4 #f)))
- (void))
- (if prior-mi_0
- (let-values ()
- (let-values (((m-ns_2) (module-instance-namespace prior-mi_0)))
- (let-values (((states_0) (module-instance-phase-level-to-state prior-mi_0)))
- (let-values (((phase_35) (namespace-phase ns_22)))
- (let-values (((visit?_0) (eq? 'started (small-hash-ref states_0 (add1 phase_35) #f))))
- (let-values (((run?_0) (eq? 'started (small-hash-ref states_0 phase_35 #f))))
- (let-values (((at-phase_1) (hash-ref (namespace-module-instances ns_22) phase_35)))
- (begin
- (hash-set! at-phase_1 mod-name_4 (make-module-instance m-ns_2 m_2 #f))
- (set-module-instance-shifted-requires! prior-mi_0 #f)
- (if visit?_0
- (let-values ()
- (let-values (((ns154_0) ns_22)
- ((temp155_0) (namespace-mpi m-ns_2))
- ((phase156_0) phase_35))
- (namespace-module-visit!.1
- unsafe-undefined
- ns154_0
- temp155_0
- phase156_0)))
- (void))
- (if run?_0
- (let-values ()
- (let-values (((ns157_0) ns_22)
- ((temp158_0) (namespace-mpi m-ns_2))
- ((phase159_0) phase_35))
- (namespace-module-instantiate!.1
- #f
- #t
- unsafe-undefined
- '#hasheq()
- null
- #f
- ns157_0
- temp158_0
- phase159_0)))
- (void))))))))))
- (void)))))))))))))
+ (begin
+ (if (if prior-m_0 (not (eq? m_2 prior-m_0)) #f)
+ (check-redeclaration-ok prior-m_0 prior-mi_0 mod-name_4)
+ (void))
+ (if with-submodules?_0
+ (hash-set! (module-registry-declarations (namespace-module-registry$1 ns_22)) mod-name_4 m_2)
+ (small-hash-set! (namespace-submodule-declarations ns_22) mod-name_4 m_2))
+ (if with-submodules?_0
+ (begin
+ (register-bulk-provide!
+ (namespace-bulk-binding-registry ns_22)
+ mod-name_4
+ (module-self m_2)
+ (module-provides m_2))
+ ((1/current-module-name-resolver) mod-name_4 #f))
+ (void))
+ (if prior-mi_0
+ (let-values (((m-ns_2) (module-instance-namespace prior-mi_0)))
+ (let-values (((states_0) (module-instance-phase-level-to-state prior-mi_0)))
+ (let-values (((phase_41) (namespace-phase ns_22)))
+ (let-values (((visit?_0) (eq? 'started (small-hash-ref states_0 (add1 phase_41) #f))))
+ (let-values (((run?_0) (eq? 'started (small-hash-ref states_0 phase_41 #f))))
+ (let-values (((at-phase_1) (hash-ref (namespace-module-instances ns_22) phase_41)))
+ (begin
+ (hash-set! at-phase_1 mod-name_4 (make-module-instance m-ns_2 m_2 #f))
+ (set-module-instance-shifted-requires! prior-mi_0 #f)
+ (namespace-clear-shifted-requires! ns_22 mod-name_4)
+ (if visit?_0
+ (let-values (((ns179_0) ns_22)
+ ((temp180_0) (namespace-mpi m-ns_2))
+ ((phase181_0) phase_41))
+ (namespace-module-visit!.1 #f unsafe-undefined ns179_0 temp180_0 phase181_0))
+ (void))
+ (if run?_0
+ (let-values (((ns182_0) ns_22)
+ ((temp183_0) (namespace-mpi m-ns_2))
+ ((phase184_0) phase_41))
+ (namespace-module-instantiate!.1
+ #f
+ #t
+ #t
+ unsafe-undefined
+ '#hasheq()
+ null
+ #f
+ #f
+ ns182_0
+ temp183_0
+ phase184_0))
+ (void)))))))))
+ (void))))))))))))
(define-values
(check-redeclaration-ok)
(lambda (prior-m_1 prior-mi_1 mod-name_5)
(begin
(begin
(if (module-cross-phase-persistent? prior-m_1)
- (let-values ()
- (raise-arguments-error
- 'module
- "cannot redeclare cross-phase persistent module"
- "module name"
- (module-name->error-string mod-name_5)))
+ (raise-arguments-error
+ 'module
+ "cannot redeclare cross-phase persistent module"
+ "module name"
+ (module-name->error-string mod-name_5))
(void))
(if (if prior-mi_1
- (let-values (((or-part_154) (module-instance-attached? prior-mi_1)))
- (if or-part_154
- or-part_154
+ (let-values (((or-part_228) (module-instance-attached? prior-mi_1)))
+ (if or-part_228
+ or-part_228
(not
(inspector-superior?
(current-code-inspector)
(namespace-inspector (module-instance-namespace prior-mi_1))))))
#f)
- (let-values ()
- (raise-arguments-error
- 'module
- "current code inspector cannot redeclare module"
- "module name"
- (module-name->error-string mod-name_5)))
+ (raise-arguments-error
+ 'module
+ "current code inspector cannot redeclare module"
+ "module name"
+ (module-name->error-string mod-name_5))
(void))))))
(define-values
(raise-unknown-module-error)
- (lambda (who_9 mod-name_6)
- (begin (raise-arguments-error who_9 "unknown module" "module name" (module-name->error-string mod-name_6)))))
+ (lambda (who_16 mod-name_6)
+ (begin (raise-arguments-error who_16 "unknown module" "module name" (module-name->error-string mod-name_6)))))
(define-values
(namespace->module-linklet-info)
- (lambda (ns_23 name_29 phase-level_14)
+ (lambda (ns_23 name_29 phase-level_16)
(begin
(let-values (((m_3) (namespace->module ns_23 name_29)))
- (if m_3 ((module-phase-level-linklet-info-callback m_3) phase-level_14 ns_23 (module-inspector m_3)) #f)))))
+ (if m_3 ((module-phase-level-linklet-info-callback m_3) phase-level_16 ns_23 (module-inspector m_3)) #f)))))
(define-values
(module-name->error-string)
(lambda (mod-name_7) (begin (unquoted-printing-string (format "~a" mod-name_7)))))
(define-values
(namespace->module-instance.1)
- (lambda (check-available-at-phase-level62_0
- complain-on-failure?61_0
- unavailable-callback63_0
- ns67_0
- name68_0
- 0-phase69_0)
+ (lambda (check-available-at-phase-level66_0
+ complain-on-failure?65_0
+ unavailable-callback67_0
+ ns71_0
+ name72_0
+ 0-phase73_0)
(begin
'namespace->module-instance
- (let-values (((ns_24) ns67_0))
- (let-values (((name_30) name68_0))
- (let-values (((0-phase_1) 0-phase69_0))
- (let-values (((complain-on-failure?_0) complain-on-failure?61_0))
- (let-values (((check-available-at-phase-level_0) check-available-at-phase-level62_0))
- (let-values (((unavailable-callback_0) unavailable-callback63_0))
- (let-values ()
- (let-values (((mi_0)
- (let-values (((or-part_155)
- (hash-ref
- (hash-ref (namespace-module-instances ns_24) 0-phase_1 '#hasheq())
- name_30
- #f)))
- (if or-part_155
- or-part_155
- (let-values (((or-part_156)
- (let-values (((c-ns_0)
- (let-values (((or-part_157)
- (namespace-root-namespace ns_24)))
- (if or-part_157 or-part_157 ns_24))))
- (hash-ref (namespace-module-instances c-ns_0) name_30 #f))))
- (if or-part_156
- or-part_156
- (if complain-on-failure?_0
- (error
- 'require
- (string-append
- "namespace mismatch;\n"
- " reference to a module that is not instantiated\n"
- " module: ~a\n"
- " phase: ~a")
- name_30
- 0-phase_1)
- #f)))))))
- (if (if mi_0 check-available-at-phase-level_0 #f)
- (check-availablilty mi_0 check-available-at-phase-level_0 unavailable-callback_0)
- mi_0))))))))))))
+ (let-values (((ns_24) ns71_0))
+ (let-values (((name_30) name72_0))
+ (let-values (((0-phase_1) 0-phase73_0))
+ (let-values (((complain-on-failure?_0) complain-on-failure?65_0))
+ (let-values (((check-available-at-phase-level_0) check-available-at-phase-level66_0))
+ (let-values (((unavailable-callback_0) unavailable-callback67_0))
+ (let-values (((mi_0)
+ (let-values (((or-part_229)
+ (hash-ref
+ (hash-ref (namespace-module-instances ns_24) 0-phase_1 '#hasheq())
+ name_30
+ #f)))
+ (if or-part_229
+ or-part_229
+ (let-values (((or-part_230)
+ (let-values (((c-ns_0)
+ (let-values (((or-part_231)
+ (namespace-root-namespace ns_24)))
+ (if or-part_231 or-part_231 ns_24))))
+ (hash-ref (namespace-module-instances c-ns_0) name_30 #f))))
+ (if or-part_230
+ or-part_230
+ (if complain-on-failure?_0
+ (error
+ 'require
+ (string-append
+ "namespace mismatch;\n"
+ " reference to a module that is not instantiated\n"
+ " module: ~a\n"
+ " phase: ~a")
+ name_30
+ 0-phase_1)
+ #f)))))))
+ (if (if mi_0 check-available-at-phase-level_0 #f)
+ (check-availablilty mi_0 check-available-at-phase-level_0 unavailable-callback_0)
+ mi_0)))))))))))
(define-values
(namespace-install-module-namespace!)
- (lambda (ns_25 name_31 0-phase_2 m_4 existing-m-ns_0)
+ (lambda (ns_25 name_31 0-phase_2 m_4 existing-m-ns_0 run-phase_0)
(begin
(let-values (((m-ns_3)
- (let-values (((the-struct_33) ns_25))
- (if (1/namespace? the-struct_33)
- (let-values (((mpi160_0) (namespace-mpi existing-m-ns_0))
- ((source-name161_0) (namespace-source-name existing-m-ns_0))
- ((root-expand-ctx162_0) (box (unbox (namespace-root-expand-ctx existing-m-ns_0))))
- ((phase163_0) (namespace-phase existing-m-ns_0))
- ((0-phase164_0) (namespace-0-phase existing-m-ns_0))
- ((phase-to-namespace165_0) (make-small-hasheqv))
- ((phase-level-to-definitions166_0)
+ (let-values (((the-struct_34) ns_25))
+ (if (1/namespace? the-struct_34)
+ (let-values (((mpi185_0) (namespace-mpi existing-m-ns_0))
+ ((source-name186_0) (namespace-source-name existing-m-ns_0))
+ ((root-expand-ctx187_0) (box (unbox (namespace-root-expand-ctx existing-m-ns_0))))
+ ((phase188_0) (namespace-phase existing-m-ns_0))
+ ((0-phase189_0) (namespace-0-phase existing-m-ns_0))
+ ((phase-to-namespace190_0) (make-small-hasheqv))
+ ((phase-level-to-definitions191_0)
(if (module-cross-phase-persistent? m_4)
(namespace-phase-level-to-definitions existing-m-ns_0)
(make-small-hasheqv)))
- ((declaration-inspector167_0) (module-inspector m_4))
- ((inspector168_0) (namespace-inspector existing-m-ns_0)))
+ ((declaration-inspector192_0) (module-inspector m_4))
+ ((inspector193_0) (namespace-inspector existing-m-ns_0)))
(namespace1.1
- mpi160_0
- source-name161_0
- root-expand-ctx162_0
- phase163_0
- 0-phase164_0
- phase-to-namespace165_0
- phase-level-to-definitions166_0
- (namespace-module-registry$1 the-struct_33)
- (namespace-bulk-binding-registry the-struct_33)
- (namespace-submodule-declarations the-struct_33)
- (namespace-root-namespace the-struct_33)
- declaration-inspector167_0
- inspector168_0
- (namespace-available-module-instances the-struct_33)
- (namespace-module-instances the-struct_33)))
- (raise-argument-error 'struct-copy "namespace?" the-struct_33)))))
+ mpi185_0
+ source-name186_0
+ root-expand-ctx187_0
+ phase188_0
+ 0-phase189_0
+ phase-to-namespace190_0
+ phase-level-to-definitions191_0
+ (namespace-module-registry$1 the-struct_34)
+ (namespace-module-instance-shifted-requires the-struct_34)
+ (namespace-bulk-binding-registry the-struct_34)
+ (namespace-submodule-declarations the-struct_34)
+ (namespace-root-namespace the-struct_34)
+ declaration-inspector192_0
+ inspector193_0
+ (namespace-available-module-instances the-struct_34)
+ (namespace-available-cross-phase-module-instances the-struct_34)
+ (namespace-module-instances the-struct_34)))
+ (raise-argument-error 'struct-copy "namespace?" the-struct_34)))))
(let-values (((mi_1) (make-module-instance m-ns_3 m_4 #f)))
(begin
(set-module-instance-attached?! mi_1 #t)
(if (module-cross-phase-persistent? m_4)
- (let-values ()
- (begin
- (small-hash-set! (namespace-phase-to-namespace m-ns_3) 0 m-ns_3)
- (small-hash-set!
- (namespace-phase-level-to-definitions m-ns_3)
- 0
- (namespace->definitions existing-m-ns_0 0))
- (small-hash-set! (namespace-phase-to-namespace m-ns_3) 1 (namespace->namespace-at-phase m-ns_3 1))
- (small-hash-set!
- (namespace-phase-level-to-definitions m-ns_3)
- 1
- (namespace->definitions existing-m-ns_0 1))
- (hash-set!
- (namespace-module-instances
- (let-values (((or-part_158) (namespace-root-namespace ns_25))) (if or-part_158 or-part_158 ns_25)))
- name_31
- mi_1)
- (small-hash-set! (module-instance-phase-level-to-state mi_1) 0 'started)))
- (let-values ()
+ (begin
+ (small-hash-set! (namespace-phase-to-namespace m-ns_3) 0 m-ns_3)
+ (small-hash-set!
+ (namespace-phase-level-to-definitions m-ns_3)
+ 0
+ (namespace->definitions existing-m-ns_0 0))
+ (small-hash-set! (namespace-phase-to-namespace m-ns_3) 1 (namespace->namespace-at-phase m-ns_3 1))
+ (small-hash-set!
+ (namespace-phase-level-to-definitions m-ns_3)
+ 1
+ (namespace->definitions existing-m-ns_0 1))
+ (hash-set!
+ (namespace-module-instances
+ (let-values (((or-part_232) (namespace-root-namespace ns_25))) (if or-part_232 or-part_232 ns_25)))
+ name_31
+ mi_1)
+ (small-hash-set! (module-instance-phase-level-to-state mi_1) 0 'started))
+ (let-values (((run-phase-level_0) (phase- run-phase_0 0-phase_2)))
(let-values ((()
(begin
(small-hash-set! (namespace-phase-to-namespace m-ns_3) 0-phase_2 m-ns_3)
@@ -14648,18 +14266,21 @@
(begin
(small-hash-set!
(namespace-phase-level-to-definitions m-ns_3)
- 0
- (namespace->definitions existing-m-ns_0 0))
+ run-phase-level_0
+ (namespace->definitions existing-m-ns_0 run-phase-level_0))
(values))))
(let-values ((()
(begin
- (small-hash-set! (module-instance-phase-level-to-state mi_1) 0 'started)
+ (small-hash-set!
+ (module-instance-phase-level-to-state mi_1)
+ run-phase-level_0
+ 'started)
(values))))
(let-values (((at-phase_2)
- (let-values (((or-part_159)
+ (let-values (((or-part_233)
(hash-ref (namespace-module-instances ns_25) 0-phase_2 #f)))
- (if or-part_159
- or-part_159
+ (if or-part_233
+ or-part_233
(let-values (((at-phase_3) (make-hasheq)))
(begin
(hash-set! (namespace-module-instances ns_25) 0-phase_2 at-phase_3)
@@ -14667,50 +14288,52 @@
(hash-set! at-phase_2 name_31 mi_1)))))))))))))
(define-values
(namespace-create-module-instance!)
- (lambda (ns_26 name_32 0-phase_3 m_5 mpi_21)
+ (lambda (ns_26 name_32 0-phase_3 m_5 mpi_23)
(begin
(let-values (((m-ns_4)
- (let-values (((the-struct_34) ns_26))
- (if (1/namespace? the-struct_34)
- (let-values (((mpi169_0) mpi_21)
- ((source-name170_0)
- (let-values (((or-part_160) (module-source-name m_5)))
- (if or-part_160
- or-part_160
- (resolved-module-path-root-name (1/module-path-index-resolve mpi_21)))))
- ((root-expand-ctx171_0) (box #f))
- ((phase172_0) 0-phase_3)
- ((0-phase173_0) 0-phase_3)
- ((phase-to-namespace174_0) (make-small-hasheqv))
- ((phase-level-to-definitions175_0) (make-small-hasheqv))
- ((declaration-inspector176_0) (module-inspector m_5))
- ((inspector177_0) (make-inspector (module-inspector m_5))))
+ (let-values (((the-struct_35) ns_26))
+ (if (1/namespace? the-struct_35)
+ (let-values (((mpi194_0) mpi_23)
+ ((source-name195_0)
+ (let-values (((or-part_234) (module-source-name m_5)))
+ (if or-part_234
+ or-part_234
+ (resolved-module-path-root-name (1/module-path-index-resolve mpi_23)))))
+ ((root-expand-ctx196_0) (box #f))
+ ((phase197_0) 0-phase_3)
+ ((0-phase198_0) 0-phase_3)
+ ((phase-to-namespace199_0) (make-small-hasheqv))
+ ((phase-level-to-definitions200_0) (make-small-hasheqv))
+ ((declaration-inspector201_0) (module-inspector m_5))
+ ((inspector202_0) (make-inspector (module-inspector m_5))))
(namespace1.1
- mpi169_0
- source-name170_0
- root-expand-ctx171_0
- phase172_0
- 0-phase173_0
- phase-to-namespace174_0
- phase-level-to-definitions175_0
- (namespace-module-registry$1 the-struct_34)
- (namespace-bulk-binding-registry the-struct_34)
- (namespace-submodule-declarations the-struct_34)
- (namespace-root-namespace the-struct_34)
- declaration-inspector176_0
- inspector177_0
- (namespace-available-module-instances the-struct_34)
- (namespace-module-instances the-struct_34)))
- (raise-argument-error 'struct-copy "namespace?" the-struct_34)))))
+ mpi194_0
+ source-name195_0
+ root-expand-ctx196_0
+ phase197_0
+ 0-phase198_0
+ phase-to-namespace199_0
+ phase-level-to-definitions200_0
+ (namespace-module-registry$1 the-struct_35)
+ (namespace-module-instance-shifted-requires the-struct_35)
+ (namespace-bulk-binding-registry the-struct_35)
+ (namespace-submodule-declarations the-struct_35)
+ (namespace-root-namespace the-struct_35)
+ declaration-inspector201_0
+ inspector202_0
+ (namespace-available-module-instances the-struct_35)
+ (namespace-available-cross-phase-module-instances the-struct_35)
+ (namespace-module-instances the-struct_35)))
+ (raise-argument-error 'struct-copy "namespace?" the-struct_35)))))
(let-values ((() (begin (small-hash-set! (namespace-phase-to-namespace m-ns_4) 0-phase_3 m-ns_4) (values))))
(let-values (((mi_2) (make-module-instance m-ns_4 m_5 #f)))
(begin
(if (module-cross-phase-persistent? m_5)
(hash-set! (namespace-module-instances ns_26) name_32 mi_2)
(let-values (((at-phase_4)
- (let-values (((or-part_161) (hash-ref (namespace-module-instances ns_26) 0-phase_3 #f)))
- (if or-part_161
- or-part_161
+ (let-values (((or-part_235) (hash-ref (namespace-module-instances ns_26) 0-phase_3 #f)))
+ (if or-part_235
+ or-part_235
(let-values (((at-phase_5) (make-hasheq)))
(begin
(hash-set! (namespace-module-instances ns_26) 0-phase_3 at-phase_5)
@@ -14735,1639 +14358,2092 @@
mi_3)))))
(define-values
(namespace->module-namespace.1)
- (lambda (check-available-at-phase-level72_0
- complain-on-failure?71_0
- unavailable-callback73_0
- ns77_0
- name78_0
- 0-phase79_0)
+ (lambda (check-available-at-phase-level76_0
+ complain-on-failure?75_0
+ unavailable-callback77_0
+ ns81_0
+ name82_0
+ 0-phase83_0)
(begin
'namespace->module-namespace
- (let-values (((ns_27) ns77_0))
- (let-values (((name_33) name78_0))
- (let-values (((0-phase_4) 0-phase79_0))
- (let-values (((complain-on-failure?_1) complain-on-failure?71_0))
- (let-values (((check-available-at-phase-level_2) check-available-at-phase-level72_0))
- (let-values (((unavailable-callback_2) unavailable-callback73_0))
- (let-values ()
- (let-values (((mi_4)
- (let-values (((ns178_0) ns_27)
- ((name179_0) name_33)
- ((0-phase180_0) 0-phase_4)
- ((complain-on-failure?181_0) complain-on-failure?_1)
- ((check-available-at-phase-level182_0) check-available-at-phase-level_2)
- ((unavailable-callback183_0) unavailable-callback_2))
- (namespace->module-instance.1
- check-available-at-phase-level182_0
- complain-on-failure?181_0
- unavailable-callback183_0
- ns178_0
- name179_0
- 0-phase180_0))))
- (if mi_4 (module-instance-namespace mi_4) #f))))))))))))
+ (let-values (((ns_27) ns81_0))
+ (let-values (((name_33) name82_0))
+ (let-values (((0-phase_4) 0-phase83_0))
+ (let-values (((complain-on-failure?_1) complain-on-failure?75_0))
+ (let-values (((check-available-at-phase-level_2) check-available-at-phase-level76_0))
+ (let-values (((unavailable-callback_2) unavailable-callback77_0))
+ (let-values (((mi_4)
+ (let-values (((ns203_0) ns_27)
+ ((name204_0) name_33)
+ ((0-phase205_0) 0-phase_4)
+ ((complain-on-failure?206_0) complain-on-failure?_1)
+ ((check-available-at-phase-level207_0) check-available-at-phase-level_2)
+ ((unavailable-callback208_0) unavailable-callback_2))
+ (namespace->module-instance.1
+ check-available-at-phase-level207_0
+ complain-on-failure?206_0
+ unavailable-callback208_0
+ ns203_0
+ name204_0
+ 0-phase205_0))))
+ (if mi_4 (module-instance-namespace mi_4) #f)))))))))))
(define-values
(namespace-record-module-instance-attached!)
- (lambda (ns_28 mod-name_8 phase_36)
+ (lambda (ns_28 mod-name_8 phase_42)
(begin
(let-values (((mi_5)
- (let-values (((ns184_0) ns_28) ((mod-name185_0) mod-name_8) ((phase186_0) phase_36))
- (namespace->module-instance.1 #f #f void ns184_0 mod-name185_0 phase186_0))))
+ (let-values (((ns209_0) ns_28) ((mod-name210_0) mod-name_8) ((phase211_0) phase_42))
+ (namespace->module-instance.1 #f #f void ns209_0 mod-name210_0 phase211_0))))
(set-module-instance-attached?! mi_5 #t)))))
(define-values
(module-force-bulk-binding!)
(lambda (m_7 ns_29) (begin ((module-force-bulk-binding m_7) (namespace-bulk-binding-registry ns_29)))))
+ (define-values
+ (module-instantiates-at-level?)
+ (lambda (m_8 phase-level_17)
+ (begin
+ (if (not (label-phase? phase-level_17))
+ (<= (module-min-phase-level m_8) phase-level_17 (module-max-phase-level m_8))
+ #f))))
(define-values
(namespace-module-instantiate!.1)
- (lambda (minimum-inspector86_0
- otherwise-available?83_0
- run-phase81_0
- seen84_0
- seen-list85_0
- skip-run?82_0
- ns93_0
- mpi94_0
- instance-phase95_0)
+ (lambda (minimum-inspector91_0
+ otherwise-available?87_0
+ recur?90_0
+ run-phase85_0
+ seen88_0
+ seen-list89_0
+ skip-run?86_0
+ transitive-record92_0
+ ns101_0
+ mpi102_0
+ instance-phase103_0)
(begin
'namespace-module-instantiate!
- (let-values (((ns_30) ns93_0))
- (let-values (((mpi_22) mpi94_0))
- (let-values (((instance-phase_0) instance-phase95_0))
- (let-values (((run-phase_0)
- (if (eq? run-phase81_0 unsafe-undefined) (namespace-phase ns_30) run-phase81_0)))
- (let-values (((skip-run?_0) skip-run?82_0))
- (let-values (((otherwise-available?_0) otherwise-available?83_0))
- (let-values (((seen_18) seen84_0))
- (let-values (((seen-list_0) seen-list85_0))
- (let-values (((minimum-inspector_0) minimum-inspector86_0))
- (let-values ()
- (let-values ((()
- (begin
- (if (1/module-path-index? mpi_22)
- (void)
- (let-values () (error "not a module path index:" mpi_22)))
- (values))))
- (let-values (((name_34) (1/module-path-index-resolve mpi_22 #t)))
- (let-values (((m_8) (namespace->module ns_30 name_34)))
+ (let-values (((ns_30) ns101_0))
+ (let-values (((mpi_24) mpi102_0))
+ (let-values (((instance-phase_0) instance-phase103_0))
+ (let-values (((run-phase_1)
+ (if (eq? run-phase85_0 unsafe-undefined) (namespace-phase ns_30) run-phase85_0)))
+ (let-values (((skip-run?_0) skip-run?86_0))
+ (let-values (((otherwise-available?_0) otherwise-available?87_0))
+ (let-values (((seen_19) seen88_0))
+ (let-values (((seen-list_0) seen-list89_0))
+ (let-values (((recur?_0) recur?90_0))
+ (let-values (((minimum-inspector_0) minimum-inspector91_0))
+ (let-values (((transitive-modules_0) transitive-record92_0))
+ (let-values ((()
+ (begin
+ (if (1/module-path-index? mpi_24)
+ (void)
+ (error "not a module path index:" mpi_24))
+ (values))))
+ (let-values (((name_34) (1/module-path-index-resolve mpi_24 #t)))
(let-values ((()
(begin
- (if m_8
- (void)
- (let-values () (raise-unknown-module-error 'instantiate name_34)))
+ (if (if transitive-modules_0 (pair? seen-list_0) #f)
+ (hash-set!
+ transitive-modules_0
+ name_34
+ (hash-set
+ (hash-ref transitive-modules_0 name_34 '#hasheqv())
+ instance-phase_0
+ #t))
+ (void))
(values))))
- (let-values (((instantiate!_0)
- (lambda (instance-phase_1 run-phase_1 ns_31)
+ (let-values (((m_9) (namespace->module ns_30 name_34)))
+ (let-values ((()
(begin
- 'instantiate!
- (let-values (((mi_6)
- (let-values (((or-part_162)
- (let-values (((ns195_0) ns_31)
- ((name196_0) name_34)
- ((instance-phase197_0)
- instance-phase_1))
- (namespace->module-instance.1
- #f
- #f
- void
- ns195_0
- name196_0
- instance-phase197_0))))
- (if or-part_162
- or-part_162
- (namespace-create-module-instance!
- ns_31
- name_34
- instance-phase_1
- m_8
- mpi_22)))))
- (let-values (((mi187_0) mi_6)
- ((ns188_0) ns_31)
- ((run-phase189_0) run-phase_1)
- ((skip-run?190_0) skip-run?_0)
- ((otherwise-available?191_0) otherwise-available?_0)
- ((seen192_0) seen_18)
- ((seen-list193_0) seen-list_0)
- ((minimum-inspector194_0) minimum-inspector_0))
- (run-module-instance!.1
- minimum-inspector194_0
- otherwise-available?191_0
- run-phase189_0
- seen192_0
- seen-list193_0
- skip-run?190_0
- mi187_0
- ns188_0)))))))
- (if (module-cross-phase-persistent? m_8)
- (let-values ()
- (instantiate!_0
- 0
- 0
- (let-values (((or-part_163) (namespace-root-namespace ns_30)))
- (if or-part_163 or-part_163 ns_30))))
- (let-values ()
- (instantiate!_0 instance-phase_0 run-phase_0 ns_30)))))))))))))))))))))
+ (if m_9 (void) (raise-unknown-module-error 'instantiate name_34))
+ (values))))
+ (let-values (((instantiate!_0)
+ (lambda (instance-phase_1 run-phase_2 ns_31)
+ (begin
+ 'instantiate!
+ (let-values (((mi_6)
+ (let-values (((or-part_236)
+ (let-values (((ns222_0) ns_31)
+ ((name223_0) name_34)
+ ((instance-phase224_0)
+ instance-phase_1))
+ (namespace->module-instance.1
+ #f
+ #f
+ void
+ ns222_0
+ name223_0
+ instance-phase224_0))))
+ (if or-part_236
+ or-part_236
+ (namespace-create-module-instance!
+ ns_31
+ name_34
+ instance-phase_1
+ m_9
+ mpi_24)))))
+ (let-values (((mi212_0) mi_6)
+ ((ns213_0) ns_31)
+ ((run-phase214_0) run-phase_2)
+ ((skip-run?215_0) skip-run?_0)
+ ((otherwise-available?216_0)
+ otherwise-available?_0)
+ ((seen217_0) seen_19)
+ ((seen-list218_0) seen-list_0)
+ ((recur?219_0) recur?_0)
+ ((minimum-inspector220_0) minimum-inspector_0)
+ ((transitive-modules221_0) transitive-modules_0))
+ (run-module-instance!.1
+ minimum-inspector220_0
+ otherwise-available?216_0
+ recur?219_0
+ run-phase214_0
+ seen217_0
+ seen-list218_0
+ skip-run?215_0
+ transitive-modules221_0
+ mi212_0
+ ns213_0)))))))
+ (if (module-cross-phase-persistent? m_9)
+ (instantiate!_0
+ 0
+ 0
+ (let-values (((or-part_237) (namespace-root-namespace ns_30)))
+ (if or-part_237 or-part_237 ns_30)))
+ (instantiate!_0 instance-phase_0 run-phase_1 ns_30))))))))))))))))))))))
(define-values
(namespace-module-visit!.1)
- (lambda (visit-phase97_0 ns99_0 mpi100_0 instance-phase101_0)
+ (lambda (transitive-record106_0 visit-phase105_0 ns109_0 mpi110_0 instance-phase111_0)
(begin
'namespace-module-visit!
- (let-values (((ns_32) ns99_0))
- (let-values (((mpi_23) mpi100_0))
- (let-values (((instance-phase_2) instance-phase101_0))
+ (let-values (((ns_32) ns109_0))
+ (let-values (((mpi_25) mpi110_0))
+ (let-values (((instance-phase_2) instance-phase111_0))
(let-values (((visit-phase_0)
- (if (eq? visit-phase97_0 unsafe-undefined) (namespace-phase ns_32) visit-phase97_0)))
- (let-values ()
- (let-values (((ns198_0) ns_32)
- ((mpi199_0) mpi_23)
- ((instance-phase200_0) instance-phase_2)
- ((temp201_0) (add1 visit-phase_0)))
+ (if (eq? visit-phase105_0 unsafe-undefined) (namespace-phase ns_32) visit-phase105_0)))
+ (let-values (((transitive-modules_1) transitive-record106_0))
+ (let-values (((ns225_0) ns_32)
+ ((mpi226_0) mpi_25)
+ ((instance-phase227_0) instance-phase_2)
+ ((temp228_0) (add1 visit-phase_0))
+ ((transitive-modules229_0) transitive-modules_1))
(namespace-module-instantiate!.1
#f
#t
- temp201_0
+ #t
+ temp228_0
'#hasheq()
null
#f
- ns198_0
- mpi199_0
- instance-phase200_0))))))))))
+ transitive-modules229_0
+ ns225_0
+ mpi226_0
+ instance-phase227_0))))))))))
(define-values
(namespace-module-make-available!.1)
- (lambda (visit-phase103_0 ns105_0 mpi106_0 instance-phase107_0)
+ (lambda (transitive-record114_0 visit-phase113_0 ns117_0 mpi118_0 instance-phase119_0)
(begin
'namespace-module-make-available!
- (let-values (((ns_33) ns105_0))
- (let-values (((mpi_24) mpi106_0))
- (let-values (((instance-phase_3) instance-phase107_0))
+ (let-values (((ns_33) ns117_0))
+ (let-values (((mpi_26) mpi118_0))
+ (let-values (((instance-phase_3) instance-phase119_0))
(let-values (((visit-phase_1)
- (if (eq? visit-phase103_0 unsafe-undefined) (namespace-phase ns_33) visit-phase103_0)))
- (let-values ()
- (let-values (((ns202_0) ns_33)
- ((mpi203_0) mpi_24)
- ((instance-phase204_0) instance-phase_3)
- ((temp205_0) (add1 visit-phase_1))
- ((temp206_0) #t))
+ (if (eq? visit-phase113_0 unsafe-undefined) (namespace-phase ns_33) visit-phase113_0)))
+ (let-values (((transitive-modules_2) transitive-record114_0))
+ (let-values (((ns230_0) ns_33)
+ ((mpi231_0) mpi_26)
+ ((instance-phase232_0) instance-phase_3)
+ ((temp233_0) (add1 visit-phase_1))
+ ((temp234_0) #t)
+ ((transitive-modules235_0) transitive-modules_2))
(namespace-module-instantiate!.1
#f
#t
- temp205_0
+ #t
+ temp233_0
'#hasheq()
null
- temp206_0
- ns202_0
- mpi203_0
- instance-phase204_0))))))))))
+ temp234_0
+ transitive-modules235_0
+ ns230_0
+ mpi231_0
+ instance-phase232_0))))))))))
(define-values
(namespace-module-get-portal-syntax-lookup)
- (lambda (ns_34 mpi_25 phase-shift_1)
+ (lambda (ns_34 mpi_27 phase-shift_1)
(begin
- (let-values (((name_35) (1/module-path-index-resolve mpi_25 #t)))
+ (let-values (((name_35) (1/module-path-index-resolve mpi_27 #t)))
(let-values (((ready-mi_0)
- (let-values (((ns207_0) ns_34) ((name208_0) name_35) ((phase-shift209_0) phase-shift_1))
- (namespace->module-instance.1 #f #f void ns207_0 name208_0 phase-shift209_0))))
+ (let-values (((ns236_0) ns_34) ((name237_0) name_35) ((phase-shift238_0) phase-shift_1))
+ (namespace->module-instance.1 #f #f void ns236_0 name237_0 phase-shift238_0))))
(let-values (((try-namespace-lookup_0)
- (lambda (ns_35 phase_37 sym_24)
+ (lambda (ns_35 phase_43 sym_30)
(begin
'try-namespace-lookup
- (let-values (((v_88) (namespace-get-transformer ns_35 phase_37 sym_24 (lambda () #f))))
- (if (1/portal-syntax? v_88) (1/portal-syntax-content v_88) #f))))))
- (let-values (((c1_23) (if ready-mi_0 (module-instance-portal-syntaxes ready-mi_0) #f)))
- (if c1_23
+ (let-values (((v_125) (namespace-get-transformer ns_35 phase_43 sym_30 (lambda () #f))))
+ (if (1/portal-syntax? v_125) (1/portal-syntax-content v_125) #f))))))
+ (let-values (((cond-val_7) (if ready-mi_0 (module-instance-portal-syntaxes ready-mi_0) #f)))
+ (if cond-val_7
((lambda (portal-syntaxes_2)
- (lambda (phase_38 sym_25) (hash-ref (hash-ref portal-syntaxes_2 phase_38 '#hasheqv()) sym_25 #f)))
- c1_23)
- (if (top-level-module-path-index? mpi_25)
- (let-values ()
- (lambda (phase_39 sym_26) (try-namespace-lookup_0 ns_34 (phase+ phase_39 phase-shift_1) sym_26)))
- (let-values ()
+ (lambda (phase_44 sym_31) (hash-ref (hash-ref portal-syntaxes_2 phase_44 '#hasheqv()) sym_31 #f)))
+ cond-val_7)
+ (if (top-level-module-path-index? mpi_27)
+ (lambda (phase_45 sym_32) (try-namespace-lookup_0 ns_34 (phase+ phase_45 phase-shift_1) sym_32))
+ (if (non-self-module-path-index? mpi_27)
(let-values (((mi_7)
- (let-values (((or-part_164) ready-mi_0))
- (if or-part_164
- or-part_164
- (let-values (((m_9) (namespace->module ns_34 name_35)))
+ (let-values (((or-part_238) ready-mi_0))
+ (if or-part_238
+ or-part_238
+ (let-values (((m_10) (namespace->module ns_34 name_35)))
(begin
- (if m_9
+ (if m_10
(void)
- (let-values ()
- (raise-unknown-module-error 'identifier-binding-portal-syntax name_35)))
+ (raise-unknown-module-error 'identifier-binding-portal-syntax name_35))
(namespace-create-module-instance!
ns_34
name_35
phase-shift_1
- m_9
- mpi_25)))))))
+ m_10
+ mpi_27)))))))
(let-values (((m-ns_5) (module-instance-namespace mi_7)))
(let-values (((bulk-binding-registry_4) (namespace-bulk-binding-registry m-ns_5)))
- (let-values (((m_10) (module-instance-module mi_7)))
- (let-values (((insp_4) (module-inspector m_10)))
+ (let-values (((m_11) (module-instance-module mi_7)))
+ (let-values (((insp_4) (module-inspector m_11)))
(let-values (((data-box_1) (module-instance-data-box mi_7)))
- (let-values (((prep_0) (module-prepare-instance m_10)))
+ (let-values (((prep_0) (module-prepare-instance m_11)))
(let-values ((()
(begin
(prep_0
data-box_1
m-ns_5
phase-shift_1
- mpi_25
+ mpi_27
bulk-binding-registry_4
insp_4)
(values))))
- (let-values (((get_0) (module-get-portal-syntax-callback m_10)))
- (lambda (phase_40 sym_27)
- (let-values (((or-part_20) (get_0 data-box_1 phase_40 sym_27)))
- (if or-part_20
- or-part_20
- (try-namespace-lookup_0 m-ns_5 phase_40 sym_27)))))))))))))))))))))))
+ (let-values (((get_0) (module-get-portal-syntax-callback m_11)))
+ (lambda (phase_46 sym_33)
+ (let-values (((or-part_239) (get_0 data-box_1 phase_46 sym_33)))
+ (if or-part_239
+ or-part_239
+ (try-namespace-lookup_0 m-ns_5 phase_46 sym_33)))))))))))))
+ (lambda (phase_47 sym_34) (try-namespace-lookup_0 ns_34 phase_47 sym_34))))))))))))
(define-values
(run-module-instance!.1)
- (lambda (minimum-inspector114_0
- otherwise-available?111_0
- run-phase109_0
- seen112_0
- seen-list113_0
- skip-run?110_0
- mi121_0
- ns122_0)
+ (lambda (minimum-inspector127_0
+ otherwise-available?123_0
+ recur?124_0
+ run-phase121_0
+ seen125_0
+ seen-list126_0
+ skip-run?122_0
+ transitive-record128_0
+ mi137_0
+ ns138_0)
(begin
'run-module-instance!
- (let-values (((mi_8) mi121_0))
- (let-values (((ns_36) ns122_0))
- (let-values (((run-phase_2) run-phase109_0))
- (let-values (((skip-run?_1) skip-run?110_0))
- (let-values (((otherwise-available?_1) otherwise-available?111_0))
- (let-values (((seen_19) seen112_0))
- (let-values (((seen-list_1) seen-list113_0))
- (let-values (((minimum-inspector_1) minimum-inspector114_0))
- (let-values ()
- (begin
- (if log-performance? (let-values () (start-performance-region 'eval 'requires)) (void))
- (begin0
- (let-values ()
+ (let-values (((mi_8) mi137_0))
+ (let-values (((ns_36) ns138_0))
+ (let-values (((run-phase_3) run-phase121_0))
+ (let-values (((skip-run?_1) skip-run?122_0))
+ (let-values (((otherwise-available?_1) otherwise-available?123_0))
+ (let-values (((recur?_1) recur?124_0))
+ (let-values (((seen_20) seen125_0))
+ (let-values (((seen-list_1) seen-list126_0))
+ (let-values (((minimum-inspector_1) minimum-inspector127_0))
+ (let-values (((transitive-modules_3) transitive-record128_0))
+ (begin
+ (if log-performance? (start-performance-region 'eval 'requires) (void))
+ (begin0
(let-values (((m-ns_6) (module-instance-namespace mi_8)))
(let-values (((instance-phase_4) (namespace-0-phase m-ns_6)))
- (let-values (((run-phase-level_0) (phase- run-phase_2 instance-phase_4)))
- (let-values (((m_11) (module-instance-module mi_8)))
- (let-values (((inspector_7) (if m_11 (module-inspector m_11) #f)))
+ (let-values (((run-phase-level_1) (phase- run-phase_3 instance-phase_4)))
+ (let-values (((m_12) (module-instance-module mi_8)))
+ (let-values (((inspector_7) (if m_12 (module-inspector m_12) #f)))
(begin
(if (if minimum-inspector_1 inspector_7 #f)
- (let-values ()
- (if (let-values (((or-part_165) (eq? inspector_7 minimum-inspector_1)))
- (if or-part_165
- or-part_165
- (inspector-superior? inspector_7 minimum-inspector_1)))
- (void)
- (let-values ()
- (error
- 'require
- "cannot import module with weaker code inspector\n module: ~a"
- (1/module-path-index-resolve
- (namespace-mpi (module-instance-namespace mi_8)))))))
+ (if (let-values (((or-part_240) (eq? inspector_7 minimum-inspector_1)))
+ (if or-part_240
+ or-part_240
+ (inspector-superior? inspector_7 minimum-inspector_1)))
+ (void)
+ (error
+ 'require
+ "cannot import module with weaker code inspector\n module: ~a"
+ (1/module-path-index-resolve
+ (namespace-mpi (module-instance-namespace mi_8)))))
(void))
- (if (if (let-values (((or-part_166) skip-run?_1))
- (if or-part_166
- or-part_166
+ (if (if (let-values (((or-part_241) skip-run?_1))
+ (if or-part_241
+ or-part_241
(eq?
'started
(small-hash-ref
(module-instance-phase-level-to-state mi_8)
- run-phase-level_0
+ run-phase-level_1
#f))))
- (let-values (((or-part_167) (not otherwise-available?_1)))
- (if or-part_167 or-part_167 (module-instance-made-available? mi_8)))
+ (if (let-values (((or-part_242) (not otherwise-available?_1)))
+ (if or-part_242
+ or-part_242
+ (module-instance-made-available? mi_8)))
+ (let-values (((or-part_243) (not transitive-modules_3)))
+ (if or-part_243
+ or-part_243
+ (not
+ (module-cross-phase-persistent? (module-instance-module mi_8)))))
+ #f)
#f)
(void)
- (let-values ()
- (let-values (((m_12) (module-instance-module mi_8)))
- (let-values ((()
- (begin
- (if m_12
- (void)
- (let-values ()
- (error
- 'require
- "import cycle detected; trying to run module being expanded")))
- (values))))
- (let-values (((mpi_26) (namespace-mpi m-ns_6)))
- (let-values (((phase-shift_2) instance-phase_4))
- (let-values (((bulk-binding-registry_5)
- (namespace-bulk-binding-registry m-ns_6)))
- (begin
- (if (hash-ref seen_19 mi_8 #f)
- (let-values ()
- (error
- 'require
- (apply
- string-append
- "import cycle detected during module instantiation\n"
- " dependency chain:"
- (module-instances->indented-module-names
- mi_8
- seen-list_1))))
- (void))
- (if (module-instance-shifted-requires mi_8)
- (void)
- (let-values ()
- (set-module-instance-shifted-requires!
- mi_8
- (reverse$1
- (let-values (((lst_69) (module-requires m_12)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_69)))
- ((letrec-values (((for-loop_90)
- (lambda (fold-var_49 lst_70)
- (begin
- 'for-loop
- (if (pair? lst_70)
- (let-values (((phase+mpis_0)
- (unsafe-car
- lst_70))
- ((rest_32)
- (unsafe-cdr
- lst_70)))
- (let-values (((fold-var_50)
- (let-values (((fold-var_51)
- fold-var_49))
- (let-values (((fold-var_52)
- (let-values ()
- (cons
- (let-values ()
- (cons
- (car
- phase+mpis_0)
- (reverse$1
- (let-values (((lst_71)
- (cdr
- phase+mpis_0)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_71)))
- ((letrec-values (((for-loop_91)
- (lambda (fold-var_53
- lst_72)
- (begin
- 'for-loop
- (if (pair?
- lst_72)
- (let-values (((req-mpi_0)
- (unsafe-car
- lst_72))
- ((rest_33)
- (unsafe-cdr
- lst_72)))
- (let-values (((fold-var_54)
- (let-values (((fold-var_55)
- fold-var_53))
- (let-values (((fold-var_56)
- (let-values ()
- (cons
- (let-values ()
- (module-path-index-shift
- req-mpi_0
- (module-self
- m_12)
- mpi_26))
- fold-var_55))))
- (values
- fold-var_56)))))
- (if (not
- #f)
- (for-loop_91
- fold-var_54
- rest_33)
- fold-var_54)))
- fold-var_53)))))
- for-loop_91)
- null
- lst_71))))))
- fold-var_51))))
- (values
- fold-var_52)))))
- (if (not #f)
- (for-loop_90
- fold-var_50
- rest_32)
- fold-var_50)))
- fold-var_49)))))
- for-loop_90)
- null
- lst_69)))))))
- (let-values (((lst_73)
- (module-instance-shifted-requires mi_8)))
+ (let-values (((m_13) (module-instance-module mi_8)))
+ (let-values ((()
(begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
+ (if m_13
(void)
- (let-values () (check-list lst_73)))
- ((letrec-values (((for-loop_92)
- (lambda (lst_74)
- (begin
- 'for-loop
- (if (pair? lst_74)
- (let-values (((phase+mpis_1)
- (unsafe-car lst_74))
- ((rest_34)
- (unsafe-cdr
- lst_74)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((req-phase_0)
- (car
- phase+mpis_1)))
- (begin
- (let-values (((lst_75)
- (cdr
- phase+mpis_1)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_75)))
- ((letrec-values (((for-loop_93)
- (lambda (lst_76)
- (begin
- 'for-loop
- (if (pair?
- lst_76)
- (let-values (((req-mpi_1)
- (unsafe-car
- lst_76))
- ((rest_35)
- (unsafe-cdr
- lst_76)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((ns210_0)
- ns_36)
- ((req-mpi211_0)
- req-mpi_1)
- ((temp212_0)
- (phase+
- instance-phase_4
- req-phase_0))
- ((run-phase213_0)
- run-phase_2)
- ((skip-run?214_0)
- skip-run?_1)
- ((otherwise-available?215_0)
- otherwise-available?_1)
- ((temp216_0)
- (hash-set
- seen_19
- mi_8
- #t))
- ((temp217_0)
- (cons
- mi_8
- seen-list_1))
- ((inspector218_0)
- inspector_7))
- (namespace-module-instantiate!.1
- inspector218_0
- otherwise-available?215_0
- run-phase213_0
- temp216_0
- temp217_0
- skip-run?214_0
- ns210_0
- req-mpi211_0
- temp212_0)))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_93
- rest_35)
- (values))))
- (values))))))
- for-loop_93)
- lst_75)))
- (void))))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_92 rest_34)
- (values))))
- (values))))))
- for-loop_92)
- lst_73)))
- (void)
- (if (label-phase? instance-phase_4)
- (void)
- (let-values ()
- (begin
- (let-values (((start_16) (module-max-phase-level m_12))
- ((end_9)
- (sub1 (module-min-phase-level m_12)))
- ((inc_3) -1))
+ (error
+ 'require
+ "import cycle detected; trying to run module being expanded"))
+ (values))))
+ (let-values (((mpi_28) (namespace-mpi m-ns_6)))
+ (let-values (((phase-shift_2) instance-phase_4))
+ (let-values (((bulk-binding-registry_5)
+ (namespace-bulk-binding-registry m-ns_6)))
+ (begin
+ (if recur?_1
+ (let-values ((()
+ (begin
+ (if (hash-ref seen_20 mi_8 #f)
+ (error
+ 'require
+ (apply
+ string-append
+ "import cycle detected during module instantiation\n"
+ " dependency chain:"
+ (module-instances->indented-module-names
+ mi_8
+ seen-list_1)))
+ (void))
+ (values))))
+ (let-values (((record-shifted-requires-at-name_0)
+ (if (module-instance-shifted-requires mi_8)
+ #f
+ (let-values (((name_36)
+ (1/module-path-index-resolve
+ mpi_28)))
+ (let-values (((shifted-requires_0)
+ (build-module-instance-shifted-requires
+ ns_36
+ m_13
+ mpi_28
+ name_36)))
+ (begin
+ (set-module-instance-shifted-requires!
+ mi_8
+ shifted-requires_0)
+ (if (non-self-derived-module-path-index?
+ mpi_28)
+ name_36
+ #f)))))))
+ (let-values (((new-seen_0) (hash-set seen_20 mi_8 #t)))
+ (let-values (((recur-instantiate!_0)
+ (lambda (req-mpi_0
+ req-phase_0
+ req-recur?_0)
+ (begin
+ 'recur-instantiate!
+ (let-values (((ns239_0) ns_36)
+ ((req-mpi240_0)
+ req-mpi_0)
+ ((temp241_0)
+ (phase+
+ instance-phase_4
+ req-phase_0))
+ ((run-phase242_0)
+ run-phase_3)
+ ((skip-run?243_0)
+ skip-run?_1)
+ ((otherwise-available?244_0)
+ otherwise-available?_1)
+ ((new-seen245_0)
+ new-seen_0)
+ ((temp246_0)
+ (cons mi_8 seen-list_1))
+ ((req-recur?247_0)
+ req-recur?_0)
+ ((inspector248_0)
+ inspector_7)
+ ((transitive-modules249_0)
+ transitive-modules_3))
+ (namespace-module-instantiate!.1
+ inspector248_0
+ otherwise-available?244_0
+ req-recur?247_0
+ run-phase242_0
+ new-seen245_0
+ temp246_0
+ skip-run?243_0
+ transitive-modules249_0
+ ns239_0
+ req-mpi240_0
+ temp241_0))))))
(begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-range start_16 end_9 inc_3)))
- ((letrec-values (((for-loop_94)
- (lambda (pos_13)
- (begin
- 'for-loop
- (if (> pos_13 end_9)
- (let-values (((phase-level_15)
- pos_13))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((phase_41)
- (phase+
- phase-level_15
- phase-shift_2)))
- (if (if (not
- skip-run?_1)
- (eqv?
- phase_41
- run-phase_2)
- #f)
- (let-values ()
- (if (eq?
- 'started
- (small-hash-ref
- (module-instance-phase-level-to-state
- mi_8)
- phase-level_15
- #f))
- (void)
- (let-values ()
- (let-values ((()
- (begin
- (small-hash-set!
- (module-instance-phase-level-to-state
- mi_8)
- phase-level_15
- 'started)
- (values))))
- (let-values ((()
- (begin
- (void
- (namespace->definitions
- m-ns_6
- phase-level_15))
- (values))))
- (let-values (((p-ns_2)
- (namespace->namespace-at-phase
- m-ns_6
- phase_41)))
- (let-values (((insp_5)
- (module-inspector
- m_12)))
- (let-values (((data-box_2)
- (module-instance-data-box
- mi_8)))
- (let-values (((prep_1)
- (module-prepare-instance
- m_12)))
- (let-values (((go_0)
- (module-instantiate-phase
- m_12)))
- (begin
- (prep_1
- data-box_2
- p-ns_2
- phase-shift_2
- mpi_26
- bulk-binding-registry_5
- insp_5)
- (go_0
- data-box_2
- p-ns_2
- phase-shift_2
- phase-level_15
- mpi_26
- bulk-binding-registry_5
- insp_5))))))))))))
- (if (if otherwise-available?_1
- (if (not
- (negative?
- run-phase_2))
- (not
- (small-hash-ref
- (module-instance-phase-level-to-state
- mi_8)
- phase-level_15
- #f))
- #f)
- #f)
- (let-values ()
+ (if (not (module-flattened-requires m_13))
+ (begin
+ (let-values (((lst_79)
+ (module-instance-shifted-requires
+ mi_8))
+ ((lst_80)
+ (module-recur-requires m_13)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_79))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_80))
+ ((letrec-values (((for-loop_104)
+ (lambda (lst_81 lst_82)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_81)
+ (pair? lst_82)
+ #f)
+ (let-values (((phase+mpis_0)
+ (unsafe-car
+ lst_81))
+ ((rest_36)
+ (unsafe-cdr
+ lst_81))
+ ((recurs_0)
+ (unsafe-car
+ lst_82))
+ ((rest_37)
+ (unsafe-cdr
+ lst_82)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((req-phase_1)
+ (car
+ phase+mpis_0)))
+ (begin
+ (let-values (((lst_83)
+ (cdr
+ phase+mpis_0))
+ ((lst_84)
+ recurs_0))
(begin
- (hash-update!
- (namespace-available-module-instances
- ns_36)
- phase_41
- (lambda (l_34)
- (cons
- mi_8
- l_34))
- null)
- (small-hash-set!
- (module-instance-phase-level-to-state
- mi_8)
- phase-level_15
- 'available)))
- (void)))))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_94
- (+ pos_13 inc_3))
- (values))))
- (values))))))
- for-loop_94)
- start_16)))
- (void))))
- (if otherwise-available?_1
- (let-values ()
- (set-module-instance-made-available?! mi_8 #t))
- (void))
- (if skip-run?_1
- (void)
- (let-values ()
- (small-hash-set!
- (module-instance-phase-level-to-state mi_8)
- run-phase-level_0
- 'started))))))))))))))))))
- (if log-performance? (let-values () (end-performance-region)) (void))))))))))))))))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_83))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_84))
+ ((letrec-values (((for-loop_105)
+ (lambda (lst_85
+ lst_86)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_85)
+ (pair?
+ lst_86)
+ #f)
+ (let-values (((req-mpi_1)
+ (unsafe-car
+ lst_85))
+ ((rest_38)
+ (unsafe-cdr
+ lst_85))
+ ((recur_0)
+ (unsafe-car
+ lst_86))
+ ((rest_39)
+ (unsafe-cdr
+ lst_86)))
+ (let-values ((()
+ (if req-mpi_1
+ (let-values ((()
+ (begin
+ (recur-instantiate!_0
+ req-mpi_1
+ req-phase_1
+ recur_0)
+ (values))))
+ (values))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_105
+ rest_38
+ rest_39)
+ (values))))
+ (values))))))
+ for-loop_105)
+ lst_83
+ lst_84)))
+ (void)))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_104
+ rest_36
+ rest_37)
+ (values))))
+ (values))))))
+ for-loop_104)
+ lst_79
+ lst_80)))
+ (void))
+ (begin
+ (let-values (((lst_87)
+ (module-instance-shifted-requires
+ mi_8)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_87))
+ ((letrec-values (((for-loop_106)
+ (lambda (lst_88)
+ (begin
+ 'for-loop
+ (if (pair? lst_88)
+ (let-values (((mpi+phases_0)
+ (unsafe-car
+ lst_88))
+ ((rest_40)
+ (unsafe-cdr
+ lst_88)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((req-mpi_2)
+ (vector-ref
+ mpi+phases_0
+ 0)))
+ (begin
+ (let-values (((lst_89)
+ (vector-ref
+ mpi+phases_0
+ 1)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_89))
+ ((letrec-values (((for-loop_107)
+ (lambda (lst_90)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_90)
+ (let-values (((req-phase_2)
+ (unsafe-car
+ lst_90))
+ ((rest_41)
+ (unsafe-cdr
+ lst_90)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (recur-instantiate!_0
+ req-mpi_2
+ req-phase_2
+ #f)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_107
+ rest_41)
+ (values))))
+ (values))))))
+ for-loop_107)
+ lst_89)))
+ (void)))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_106
+ rest_40)
+ (values))))
+ (values))))))
+ for-loop_106)
+ lst_87)))
+ (void)))
+ (if record-shifted-requires-at-name_0
+ (namespace-save-shifted-requires!
+ ns_36
+ m_13
+ record-shifted-requires-at-name_0
+ (module-instance-shifted-requires mi_8))
+ (void)))))))
+ (void))
+ (if (label-phase? instance-phase_4)
+ (void)
+ (begin
+ (let-values (((start_21) (module-max-phase-level m_13))
+ ((end_9) (sub1 (module-min-phase-level m_13)))
+ ((inc_3) -1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range start_21 end_9 inc_3))
+ ((letrec-values (((for-loop_108)
+ (lambda (pos_23)
+ (begin
+ 'for-loop
+ (if (> pos_23 end_9)
+ (let-values (((phase-level_18)
+ pos_23))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((phase_48)
+ (phase+
+ phase-level_18
+ phase-shift_2)))
+ (if (if (not
+ skip-run?_1)
+ (eqv?
+ phase_48
+ run-phase_3)
+ #f)
+ (if (eq?
+ 'started
+ (small-hash-ref
+ (module-instance-phase-level-to-state
+ mi_8)
+ phase-level_18
+ #f))
+ (void)
+ (let-values ((()
+ (begin
+ (small-hash-set!
+ (module-instance-phase-level-to-state
+ mi_8)
+ phase-level_18
+ 'started)
+ (values))))
+ (let-values ((()
+ (begin
+ (void
+ (namespace->definitions
+ m-ns_6
+ phase-level_18))
+ (values))))
+ (let-values (((p-ns_2)
+ (namespace->namespace-at-phase
+ m-ns_6
+ phase_48)))
+ (let-values (((insp_5)
+ (module-inspector
+ m_13)))
+ (let-values (((data-box_2)
+ (module-instance-data-box
+ mi_8)))
+ (let-values (((prep_1)
+ (module-prepare-instance
+ m_13)))
+ (let-values (((go_0)
+ (module-instantiate-phase
+ m_13)))
+ (begin
+ (prep_1
+ data-box_2
+ p-ns_2
+ phase-shift_2
+ mpi_28
+ bulk-binding-registry_5
+ insp_5)
+ (go_0
+ data-box_2
+ p-ns_2
+ phase-shift_2
+ phase-level_18
+ mpi_28
+ bulk-binding-registry_5
+ insp_5))))))))))
+ (if (if otherwise-available?_1
+ (if (not
+ (negative?
+ run-phase_3))
+ (not
+ (small-hash-ref
+ (module-instance-phase-level-to-state
+ mi_8)
+ phase-level_18
+ #f))
+ #f)
+ #f)
+ (begin
+ (if (module-cross-phase-persistent?
+ m_13)
+ (let-values (((bx_0)
+ (namespace-available-cross-phase-module-instances
+ ns_36)))
+ (set-box!
+ bx_0
+ (cons
+ mi_8
+ (unbox
+ bx_0))))
+ (hash-update!
+ (namespace-available-module-instances
+ ns_36)
+ phase_48
+ (lambda (l_40)
+ (cons
+ mi_8
+ l_40))
+ null))
+ (small-hash-set!
+ (module-instance-phase-level-to-state
+ mi_8)
+ phase-level_18
+ 'available))
+ (void))))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_108
+ (+ pos_23 inc_3))
+ (values))))
+ (values))))))
+ for-loop_108)
+ start_21)))
+ (void)))
+ (if otherwise-available?_1
+ (set-module-instance-made-available?! mi_8 #t)
+ (void))
+ (if skip-run?_1
+ (void)
+ (small-hash-set!
+ (module-instance-phase-level-to-state mi_8)
+ run-phase-level_1
+ 'started)))))))))))))))
+ (if log-performance? (end-performance-region) (void)))))))))))))))))
(define-values
(namespace-visit-available-modules!)
(let-values (((namespace-visit-available-modules!_0)
- (lambda (ns125_0 run-phase124_0)
+ (lambda (ns141_0 run-phase140_0)
(begin
'namespace-visit-available-modules!
- (let-values (((ns_37) ns125_0))
- (let-values (((run-phase_3)
- (if (eq? run-phase124_0 unsafe-undefined) (namespace-phase ns_37) run-phase124_0)))
- (let-values () (namespace-run-available-modules! ns_37 (add1 run-phase_3)))))))))
+ (let-values (((ns_37) ns141_0))
+ (let-values (((run-phase_4)
+ (if (eq? run-phase140_0 unsafe-undefined) (namespace-phase ns_37) run-phase140_0)))
+ (namespace-run-available-modules! ns_37 (add1 run-phase_4))))))))
(case-lambda
((ns_38) (begin (namespace-visit-available-modules!_0 ns_38 unsafe-undefined)))
- ((ns_39 run-phase124_1) (namespace-visit-available-modules!_0 ns_39 run-phase124_1)))))
+ ((ns_39 run-phase140_1) (namespace-visit-available-modules!_0 ns_39 run-phase140_1)))))
(define-values
(namespace-run-available-modules!)
(let-values (((namespace-run-available-modules!_0)
- (lambda (ns127_0 run-phase126_0)
+ (lambda (ns143_0 run-phase142_0)
(begin
'namespace-run-available-modules!
- (let-values (((ns_40) ns127_0))
- (let-values (((run-phase_4)
- (if (eq? run-phase126_0 unsafe-undefined) (namespace-phase ns_40) run-phase126_0)))
- (let-values ()
- (registry-call-with-lock
- (namespace-module-registry$1 ns_40)
- (lambda ()
- ((letrec-values (((loop_74)
- (lambda ()
- (begin
- 'loop
+ (let-values (((ns_40) ns143_0))
+ (let-values (((run-phase_5)
+ (if (eq? run-phase142_0 unsafe-undefined) (namespace-phase ns_40) run-phase142_0)))
+ (registry-call-with-lock
+ (namespace-module-registry$1 ns_40)
+ (lambda ()
+ ((letrec-values (((loop_76)
+ (lambda ()
+ (begin
+ 'loop
+ (let-values (((cp-mis_0)
+ (unbox
+ (namespace-available-cross-phase-module-instances
+ ns_40))))
(let-values (((mis_0)
(hash-ref
(namespace-available-module-instances ns_40)
- run-phase_4
+ run-phase_5
null)))
- (if (null? mis_0)
+ (if (if (null? cp-mis_0) (null? mis_0) #f)
(void)
- (let-values ()
- (begin
- (hash-set!
- (namespace-available-module-instances ns_40)
- run-phase_4
- null)
- (let-values (((lst_77) (reverse$1 mis_0)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_77)))
- ((letrec-values (((for-loop_95)
- (lambda (lst_78)
- (begin
- 'for-loop
- (if (pair? lst_78)
- (let-values (((mi_9)
- (unsafe-car
- lst_78))
- ((rest_36)
- (unsafe-cdr
- lst_78)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((mi219_0)
- mi_9)
- ((ns220_0)
- ns_40)
- ((run-phase221_0)
- run-phase_4)
- ((temp222_0)
- #f)
- ((temp223_0)
- #f))
- (run-module-instance!.1
- #f
- temp223_0
- run-phase221_0
- '#hasheq()
- null
- temp222_0
- mi219_0
- ns220_0)))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_95 rest_36)
- (values))))
- (values))))))
- for-loop_95)
- lst_77)))
- (void)
- (loop_74)))))))))
- loop_74)))))))))))
+ (begin
+ (set-box!
+ (namespace-available-cross-phase-module-instances ns_40)
+ null)
+ (hash-set!
+ (namespace-available-module-instances ns_40)
+ run-phase_5
+ null)
+ (let-values (((lst_91) (reverse$1 cp-mis_0)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_91))
+ ((letrec-values (((for-loop_109)
+ (lambda (lst_92)
+ (begin
+ 'for-loop
+ (if (pair? lst_92)
+ (let-values (((mi_9)
+ (unsafe-car lst_92))
+ ((rest_42)
+ (unsafe-cdr lst_92)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((mi250_0)
+ mi_9)
+ ((ns251_0)
+ ns_40)
+ ((temp252_0)
+ 0)
+ ((temp253_0)
+ #f)
+ ((temp254_0)
+ #f)
+ ((temp255_0)
+ #f))
+ (run-module-instance!.1
+ #f
+ temp254_0
+ temp255_0
+ temp252_0
+ '#hasheq()
+ null
+ temp253_0
+ #f
+ mi250_0
+ ns251_0))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_109 rest_42)
+ (values))))
+ (values))))))
+ for-loop_109)
+ lst_91)))
+ (void)
+ (let-values (((lst_93) (reverse$1 mis_0)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_93))
+ ((letrec-values (((for-loop_110)
+ (lambda (lst_94)
+ (begin
+ 'for-loop
+ (if (pair? lst_94)
+ (let-values (((mi_10)
+ (unsafe-car lst_94))
+ ((rest_43)
+ (unsafe-cdr lst_94)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((mi256_0)
+ mi_10)
+ ((ns257_0)
+ ns_40)
+ ((run-phase258_0)
+ run-phase_5)
+ ((temp259_0)
+ #f)
+ ((temp260_0)
+ #f)
+ ((temp261_0)
+ #f))
+ (run-module-instance!.1
+ #f
+ temp260_0
+ temp261_0
+ run-phase258_0
+ '#hasheq()
+ null
+ temp259_0
+ #f
+ mi256_0
+ ns257_0))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_110 rest_43)
+ (values))))
+ (values))))))
+ for-loop_110)
+ lst_93)))
+ (void)
+ (loop_76)))))))))
+ loop_76))))))))))
(case-lambda
((ns_41) (begin (namespace-run-available-modules!_0 ns_41 unsafe-undefined)))
- ((ns_42 run-phase126_1) (namespace-run-available-modules!_0 ns_42 run-phase126_1)))))
+ ((ns_42 run-phase142_1) (namespace-run-available-modules!_0 ns_42 run-phase142_1)))))
(define-values
(namespace-primitive-module-visit!)
- (lambda (ns_43 name_36)
- (begin
- (let-values (((mi_10) (hash-ref (namespace-module-instances ns_43) (1/make-resolved-module-path name_36))))
- (let-values (((mi224_0) mi_10) ((ns225_0) ns_43) ((temp226_0) 1) ((temp227_0) #f) ((temp228_0) #t))
- (run-module-instance!.1 #f temp228_0 temp226_0 '#hasheq() null temp227_0 mi224_0 ns225_0))))))
- (define-values
- (namespace-module-use->module+linklet-instances.1)
- (lambda (phase-shift130_0 shift-from128_0 shift-to129_0 ns134_0 mu135_0)
- (begin
- 'namespace-module-use->module+linklet-instances
- (let-values (((ns_44) ns134_0))
- (let-values (((mu_0) mu135_0))
- (let-values (((shift-from_0) shift-from128_0))
- (let-values (((shift-to_0) shift-to129_0))
- (let-values (((phase-shift_3) phase-shift130_0))
- (let-values ()
- (let-values (((mod_1) (module-use-module mu_0)))
- (let-values (((mi_11)
- (let-values (((ns229_0) ns_44)
- ((temp230_0)
- (1/module-path-index-resolve
- (if shift-from_0
- (module-path-index-shift mod_1 shift-from_0 shift-to_0)
- mod_1)))
- ((phase-shift231_0) phase-shift_3)
- ((temp232_0) #t))
- (namespace->module-instance.1
- #f
- temp232_0
- void
- ns229_0
- temp230_0
- phase-shift231_0))))
- (let-values (((m-ns_7) (module-instance-namespace mi_11)))
- (let-values (((d_18)
- (small-hash-ref
- (namespace-phase-level-to-definitions m-ns_7)
- (module-use-phase mu_0)
- #f)))
- (if d_18
- (values mi_11 (definitions-variables d_18))
- (error
- 'eval
- (string-append
- "namespace mismatch: phase level not found;\n"
- " module: ~a\n"
- " phase level: ~a\n"
- " found phase levels: ~a")
- mod_1
- (module-use-phase mu_0)
- (small-hash-keys (namespace-phase-level-to-definitions m-ns_7)))))))))))))))))
- (define-values
- (fresh-requires)
- (lambda (requires_1)
- (begin
- (reverse$1
- (let-values (((lst_79) requires_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_79)))
- ((letrec-values (((for-loop_96)
- (lambda (fold-var_57 lst_80)
- (begin
- 'for-loop
- (if (pair? lst_80)
- (let-values (((phase+mpis_2) (unsafe-car lst_80)) ((rest_37) (unsafe-cdr lst_80)))
- (let-values (((fold-var_58)
- (let-values (((fold-var_59) fold-var_57))
- (let-values (((fold-var_60)
- (let-values ()
- (cons
- (let-values ()
- (cons
- (car phase+mpis_2)
- (reverse$1
- (let-values (((lst_81) (cdr phase+mpis_2)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_81)))
- ((letrec-values (((for-loop_97)
- (lambda (fold-var_61
- lst_82)
- (begin
- 'for-loop
- (if (pair? lst_82)
- (let-values (((req-mpi_2)
- (unsafe-car
- lst_82))
- ((rest_38)
- (unsafe-cdr
- lst_82)))
- (let-values (((fold-var_62)
- (let-values (((fold-var_63)
- fold-var_61))
- (let-values (((fold-var_64)
- (let-values ()
- (cons
- (let-values ()
- (module-path-index-fresh
- req-mpi_2))
- fold-var_63))))
- (values
- fold-var_64)))))
- (if (not #f)
- (for-loop_97
- fold-var_62
- rest_38)
- fold-var_62)))
- fold-var_61)))))
- for-loop_97)
- null
- lst_81))))))
- fold-var_59))))
- (values fold-var_60)))))
- (if (not #f) (for-loop_96 fold-var_58 rest_37) fold-var_58)))
- fold-var_57)))))
- for-loop_96)
- null
- lst_79)))))))
- (define-values
- (module-compute-access!)
- (lambda (m_13)
- (begin
- (let-values (((access_0)
- (let-values (((ht_73) (module-provides m_13)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_73)))
- ((letrec-values (((for-loop_98)
- (lambda (table_105 i_89)
- (begin
- 'for-loop
- (if i_89
- (let-values (((phase_42 at-phase_6)
- (hash-iterate-key+value ht_73 i_89)))
- (let-values (((table_106)
- (let-values (((table_107) table_105))
- (let-values (((table_108)
- (let-values ()
- (let-values (((key_42 val_30)
- (let-values ()
- (values
- phase_42
- (let-values (((ht_74)
- at-phase_6))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash
- ht_74)))
- ((letrec-values (((for-loop_99)
- (lambda (table_109
- i_90)
- (begin
- 'for-loop
- (if i_90
- (let-values (((sym_28
- binding/p_1)
- (hash-iterate-key+value
- ht_74
- i_90)))
- (let-values (((table_110)
- (let-values (((table_111)
- table_109))
- (let-values (((table_112)
- (let-values ()
- (let-values (((key_43
- val_31)
- (let-values ()
- (values
- (module-binding-sym
- (provided-as-binding
- binding/p_1))
- (if (provided-as-protected?
- binding/p_1)
- 'protected
- 'provided)))))
- (hash-set
- table_111
- key_43
- val_31)))))
- (values
- table_112)))))
- (if (not
- #f)
- (for-loop_99
- table_110
- (hash-iterate-next
- ht_74
- i_90))
- table_110)))
- table_109)))))
- for-loop_99)
- '#hash()
- (hash-iterate-first
- ht_74))))))))
- (hash-set
- table_107
- key_42
- val_30)))))
- (values table_108)))))
- (if (not #f)
- (for-loop_98 table_106 (hash-iterate-next ht_73 i_89))
- table_106)))
- table_105)))))
- for-loop_98)
- '#hasheqv()
- (hash-iterate-first ht_73))))))
- (begin (set-module-access! m_13 access_0) access_0)))))
- (define-values
- (module-instances->indented-module-names)
- (lambda (mi_12 seen-list_2)
- (begin
- (let-values (((mi->name_0)
- (lambda (mi_13)
- (begin
- 'mi->name
- (format
+ (lambda (ns_43 name_37)
+ (begin
+ (let-values (((mi_11) (hash-ref (namespace-module-instances ns_43) (1/make-resolved-module-path name_37))))
+ (let-values (((mi262_0) mi_11) ((ns263_0) ns_43) ((temp264_0) 1) ((temp265_0) #f) ((temp266_0) #t))
+ (run-module-instance!.1 #f temp266_0 #t temp264_0 '#hasheq() null temp265_0 #f mi262_0 ns263_0))))))
+ (define-values
+ (namespace-clear-shifted-requires!)
+ (lambda (ns_44 mod-name_9) (begin (hash-remove! (namespace-module-instance-shifted-requires ns_44) mod-name_9))))
+ (define-values
+ (build-module-instance-shifted-requires)
+ (lambda (ns_45 m_14 mpi_29 name_38)
+ (begin
+ (let-values (((requires_1) (module-requires m_14)))
+ (let-values (((recur-requires_1) (module-recur-requires m_14)))
+ (let-values (((flattened-requires_1) (module-flattened-requires m_14)))
+ (let-values (((freshen-cache_2) (make-hasheq)))
+ (if (not flattened-requires_1)
+ (reverse$1
+ (let-values (((fold-var_75) (let-values (((fold-var_76) null)) fold-var_76)))
+ (let-values (((lst_95) requires_1)
+ ((lst_96) recur-requires_1)
+ ((lst_97)
+ (let-values (((ns267_0) ns_45) ((name268_0) name_38) ((requires269_0) requires_1))
+ (namespace-find-shifted-requires.1 #f ns267_0 name268_0 requires269_0))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_95))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_96))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_97))
+ ((letrec-values (((for-loop_111)
+ (lambda (fold-var_77 lst_98 lst_99 lst_100)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_98) (if (pair? lst_99) (pair? lst_100) #f) #f)
+ (let-values (((phase+mpis_1) (unsafe-car lst_98))
+ ((rest_44) (unsafe-cdr lst_98))
+ ((recurs_1) (unsafe-car lst_99))
+ ((rest_45) (unsafe-cdr lst_99))
+ ((resolved-paths_0) (unsafe-car lst_100))
+ ((rest_46) (unsafe-cdr lst_100)))
+ (let-values (((fold-var_78)
+ (let-values (((fold-var_79)
+ (cons
+ (cons
+ (car phase+mpis_1)
+ (reverse$1
+ (let-values (((fold-var_80)
+ (let-values (((fold-var_81)
+ null))
+ fold-var_81)))
+ (let-values (((lst_101)
+ (cdr phase+mpis_1))
+ ((lst_102) recurs_1)
+ ((lst_103)
+ resolved-paths_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_101))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_102))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_103))
+ ((letrec-values (((for-loop_112)
+ (lambda (fold-var_82
+ lst_104
+ lst_105
+ lst_106)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_104)
+ (if (pair?
+ lst_105)
+ (pair?
+ lst_106)
+ #f)
+ #f)
+ (let-values (((req-mpi_3)
+ (unsafe-car
+ lst_104))
+ ((rest_47)
+ (unsafe-cdr
+ lst_104))
+ ((recur_1)
+ (unsafe-car
+ lst_105))
+ ((rest_48)
+ (unsafe-cdr
+ lst_105))
+ ((resolved-path_0)
+ (unsafe-car
+ lst_106))
+ ((rest_49)
+ (unsafe-cdr
+ lst_106)))
+ (let-values (((fold-var_83)
+ (let-values (((fold-var_84)
+ (cons
+ (if recur_1
+ (module-path-index-shift/resolved
+ req-mpi_3
+ (module-self
+ m_14)
+ mpi_29
+ freshen-cache_2
+ resolved-path_0)
+ #f)
+ fold-var_82)))
+ (values
+ fold-var_84))))
+ (if (not
+ #f)
+ (for-loop_112
+ fold-var_83
+ rest_47
+ rest_48
+ rest_49)
+ fold-var_83)))
+ fold-var_82)))))
+ for-loop_112)
+ fold-var_80
+ lst_101
+ lst_102
+ lst_103))))))
+ fold-var_77)))
+ (values fold-var_79))))
+ (if (not #f)
+ (for-loop_111 fold-var_78 rest_44 rest_45 rest_46)
+ fold-var_78)))
+ fold-var_77)))))
+ for-loop_111)
+ fold-var_75
+ lst_95
+ lst_96
+ lst_97)))))
+ (reverse$1
+ (let-values (((fold-var_85) (let-values (((fold-var_86) null)) fold-var_86)))
+ (let-values (((lst_107) flattened-requires_1)
+ ((lst_108)
+ (let-values (((ns270_0) ns_45)
+ ((name271_0) name_38)
+ ((flattened-requires272_0) flattened-requires_1)
+ ((temp273_0) #t))
+ (namespace-find-shifted-requires.1
+ temp273_0
+ ns270_0
+ name271_0
+ flattened-requires272_0))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_107))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_108))
+ ((letrec-values (((for-loop_113)
+ (lambda (fold-var_87 lst_109 lst_110)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_109) (pair? lst_110) #f)
+ (let-values (((mpi+phases_1) (unsafe-car lst_109))
+ ((rest_50) (unsafe-cdr lst_109))
+ ((resolved-path_1) (unsafe-car lst_110))
+ ((rest_51) (unsafe-cdr lst_110)))
+ (let-values (((fold-var_88)
+ (let-values (((fold-var_89)
+ (cons
+ (let-values (((req-mpi_4)
+ (vector-ref
+ mpi+phases_1
+ 0)))
+ (let-values (((new-req-mpi_0)
+ (module-path-index-shift/resolved
+ req-mpi_4
+ (module-self m_14)
+ mpi_29
+ freshen-cache_2
+ resolved-path_1)))
+ (vector-immutable
+ new-req-mpi_0
+ (vector-ref mpi+phases_1 1))))
+ fold-var_87)))
+ (values fold-var_89))))
+ (if (not #f)
+ (for-loop_113 fold-var_88 rest_50 rest_51)
+ fold-var_88)))
+ fold-var_87)))))
+ for-loop_113)
+ fold-var_85
+ lst_107
+ lst_108)))))))))))))
+ (define-values
+ (namespace-find-shifted-requires.1)
+ (lambda (flattened?144_0 ns146_0 name147_0 requires148_0)
+ (begin
+ 'namespace-find-shifted-requires
+ (let-values (((ns_46) ns146_0))
+ (let-values (((name_39) name147_0))
+ (let-values (((requires_2) requires148_0))
+ (let-values (((flattened?_0) flattened?144_0))
+ (let-values (((bx_1) (hash-ref (namespace-module-instance-shifted-requires ns_46) name_39 #f)))
+ (let-values (((or-part_244) (if bx_1 (unbox bx_1) #f)))
+ (if or-part_244
+ or-part_244
+ (if (not flattened?_0)
+ (reverse$1
+ (let-values (((fold-var_90) (let-values (((fold-var_91) null)) fold-var_91)))
+ (let-values (((lst_111) requires_2))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_111))
+ ((letrec-values (((for-loop_114)
+ (lambda (fold-var_92 lst_112)
+ (begin
+ 'for-loop
+ (if (pair? lst_112)
+ (let-values (((phase+mpis_2) (unsafe-car lst_112))
+ ((rest_52) (unsafe-cdr lst_112)))
+ (let-values (((fold-var_93)
+ (let-values (((fold-var_94)
+ (cons
+ (reverse$1
+ (let-values (((fold-var_95)
+ (let-values (((fold-var_96)
+ null))
+ fold-var_96)))
+ (let-values (((lst_113)
+ (cdr
+ phase+mpis_2)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_113))
+ ((letrec-values (((for-loop_115)
+ (lambda (fold-var_97
+ lst_114)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_114)
+ (let-values (((mpi_30)
+ (unsafe-car
+ lst_114))
+ ((rest_53)
+ (unsafe-cdr
+ lst_114)))
+ (let-values (((fold-var_98)
+ (let-values (((fold-var_99)
+ (cons
+ #f
+ fold-var_97)))
+ (values
+ fold-var_99))))
+ (if (not
+ #f)
+ (for-loop_115
+ fold-var_98
+ rest_53)
+ fold-var_98)))
+ fold-var_97)))))
+ for-loop_115)
+ fold-var_95
+ lst_113)))))
+ fold-var_92)))
+ (values fold-var_94))))
+ (if (not #f) (for-loop_114 fold-var_93 rest_52) fold-var_93)))
+ fold-var_92)))))
+ for-loop_114)
+ fold-var_90
+ lst_111)))))
+ (reverse$1
+ (let-values (((fold-var_100) (let-values (((fold-var_101) null)) fold-var_101)))
+ (let-values (((lst_115) requires_2))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_115))
+ ((letrec-values (((for-loop_116)
+ (lambda (fold-var_102 lst_116)
+ (begin
+ 'for-loop
+ (if (pair? lst_116)
+ (let-values (((mpi+phases_2) (unsafe-car lst_116))
+ ((rest_54) (unsafe-cdr lst_116)))
+ (let-values (((fold-var_103)
+ (let-values (((fold-var_104)
+ (cons #f fold-var_102)))
+ (values fold-var_104))))
+ (if (not #f)
+ (for-loop_116 fold-var_103 rest_54)
+ fold-var_103)))
+ fold-var_102)))))
+ for-loop_116)
+ fold-var_100
+ lst_115))))))))))))))))
+ (define-values
+ (namespace-shifted-requires-box)
+ (lambda (ns_47 name_40)
+ (begin
+ (let-values (((or-part_245) (hash-ref (namespace-module-instance-shifted-requires ns_47) name_40 #f)))
+ (if or-part_245
+ or-part_245
+ (let-values (((bx_2) (box #f)))
+ (begin (hash-set! (namespace-module-instance-shifted-requires ns_47) name_40 bx_2) bx_2)))))))
+ (define-values
+ (namespace-save-shifted-requires!)
+ (lambda (ns_48 m_15 name_41 shifted-requires_1)
+ (begin
+ (let-values (((bx_3) (namespace-shifted-requires-box ns_48 name_41)))
+ (if (unbox bx_3)
+ (void)
+ (let-values (((resolve_0)
+ (lambda (mpi_31)
+ (begin
+ 'resolve
+ (let-values (((r_28) (if mpi_31 (1/module-path-index-resolve mpi_31) #f)))
+ (if r_28
+ (let-values (((name_42) (1/resolved-module-path-name r_28)))
+ (if (let-values (((or-part_246) (path? name_42)))
+ (if or-part_246 or-part_246 (if (pair? name_42) (path? (car name_42)) #f)))
+ r_28
+ #f))
+ #f))))))
+ (set-box!
+ bx_3
+ (if (not (module-flattened-requires m_15))
+ (reverse$1
+ (let-values (((fold-var_105) (let-values (((fold-var_106) null)) fold-var_106)))
+ (let-values (((lst_117) shifted-requires_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_117))
+ ((letrec-values (((for-loop_117)
+ (lambda (fold-var_107 lst_118)
+ (begin
+ 'for-loop
+ (if (pair? lst_118)
+ (let-values (((phase+mpis_3) (unsafe-car lst_118))
+ ((rest_55) (unsafe-cdr lst_118)))
+ (let-values (((fold-var_108)
+ (let-values (((fold-var_109)
+ (cons
+ (reverse$1
+ (let-values (((fold-var_110)
+ (let-values (((fold-var_111)
+ null))
+ fold-var_111)))
+ (let-values (((lst_119)
+ (cdr phase+mpis_3)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_119))
+ ((letrec-values (((for-loop_118)
+ (lambda (fold-var_112
+ lst_120)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_120)
+ (let-values (((mpi_32)
+ (unsafe-car
+ lst_120))
+ ((rest_56)
+ (unsafe-cdr
+ lst_120)))
+ (let-values (((fold-var_113)
+ (let-values (((fold-var_114)
+ (cons
+ (resolve_0
+ mpi_32)
+ fold-var_112)))
+ (values
+ fold-var_114))))
+ (if (not
+ #f)
+ (for-loop_118
+ fold-var_113
+ rest_56)
+ fold-var_113)))
+ fold-var_112)))))
+ for-loop_118)
+ fold-var_110
+ lst_119)))))
+ fold-var_107)))
+ (values fold-var_109))))
+ (if (not #f) (for-loop_117 fold-var_108 rest_55) fold-var_108)))
+ fold-var_107)))))
+ for-loop_117)
+ fold-var_105
+ lst_117)))))
+ (reverse$1
+ (let-values (((fold-var_115) (let-values (((fold-var_116) null)) fold-var_116)))
+ (let-values (((lst_121) shifted-requires_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_121))
+ ((letrec-values (((for-loop_119)
+ (lambda (fold-var_117 lst_122)
+ (begin
+ 'for-loop
+ (if (pair? lst_122)
+ (let-values (((mpi+phases_3) (unsafe-car lst_122))
+ ((rest_57) (unsafe-cdr lst_122)))
+ (let-values (((fold-var_118)
+ (let-values (((fold-var_119)
+ (cons
+ (let-values (((mpi_33)
+ (vector-ref mpi+phases_3 0)))
+ (resolve_0 mpi_33))
+ fold-var_117)))
+ (values fold-var_119))))
+ (if (not #f) (for-loop_119 fold-var_118 rest_57) fold-var_118)))
+ fold-var_117)))))
+ for-loop_119)
+ fold-var_115
+ lst_121)))))))))))))
+ (define-values
+ (namespace-copy-shifted-requires!)
+ (lambda (dest-namespace_0 src-namespace_0 name_43)
+ (begin
+ (let-values (((bx_4) (namespace-shifted-requires-box src-namespace_0 name_43)))
+ (hash-set! (namespace-module-instance-shifted-requires dest-namespace_0) name_43 bx_4)))))
+ (define-values
+ (namespace-module-use->module+linklet-instances.1)
+ (lambda (phase-shift152_0 resolution-cache153_0 shift-from150_0 shift-to151_0 ns158_0 mu159_0)
+ (begin
+ 'namespace-module-use->module+linklet-instances
+ (let-values (((ns_49) ns158_0))
+ (let-values (((mu_0) mu159_0))
+ (let-values (((shift-from_0) shift-from150_0))
+ (let-values (((shift-to_0) shift-to151_0))
+ (let-values (((phase-shift_3) phase-shift152_0))
+ (let-values (((module-use-resolution-cache_0) resolution-cache153_0))
+ (let-values (((mod_1) (module-use-module mu_0)))
+ (let-values (((use-name_0)
+ (let-values (((or-part_247)
+ (if module-use-resolution-cache_0
+ (hash-ref module-use-resolution-cache_0 mod_1 #f)
+ #f)))
+ (if or-part_247
+ or-part_247
+ (let-values (((name_44)
+ (1/module-path-index-resolve
+ (if shift-from_0
+ (module-path-index-shift mod_1 shift-from_0 shift-to_0)
+ mod_1))))
+ (begin
+ (if module-use-resolution-cache_0
+ (hash-set! module-use-resolution-cache_0 mod_1 name_44)
+ (void))
+ name_44))))))
+ (let-values (((mi_12)
+ (let-values (((ns274_0) ns_49)
+ ((use-name275_0) use-name_0)
+ ((phase-shift276_0) phase-shift_3)
+ ((temp277_0) #t))
+ (namespace->module-instance.1
+ #f
+ temp277_0
+ void
+ ns274_0
+ use-name275_0
+ phase-shift276_0))))
+ (let-values (((m-ns_7) (module-instance-namespace mi_12)))
+ (let-values (((d_18)
+ (small-hash-ref
+ (namespace-phase-level-to-definitions m-ns_7)
+ (module-use-phase mu_0)
+ #f)))
+ (if d_18
+ (values mi_12 (definitions-variables d_18))
+ (error
+ 'eval
+ (string-append
+ "namespace mismatch: phase level not found;\n"
+ " module: ~a\n"
+ " instance phase: ~a\n"
+ " phase level: ~a\n"
+ " found phase levels: ~a")
+ mod_1
+ (namespace-0-phase m-ns_7)
+ (module-use-phase mu_0)
+ (small-hash-keys (namespace-phase-level-to-definitions m-ns_7))))))))))))))))))
+ (define-values
+ (module-compute-access!)
+ (lambda (m_16)
+ (begin
+ (let-values (((access_0)
+ (let-values (((access_1) (let-values (((access_2) '#hasheqv())) access_2)))
+ (let-values (((ht_83) (module-provides m_16)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_83))
+ ((letrec-values (((for-loop_120)
+ (lambda (access_3 i_115)
+ (begin
+ 'for-loop
+ (if i_115
+ (let-values (((phase+space_1 at-phase+space_0)
+ (hash-iterate-key+value ht_83 i_115)))
+ (let-values (((access_4)
+ (let-values (((access_5)
+ (let-values (((phase_49)
+ (phase+space-phase
+ phase+space_1)))
+ (let-values (((phase-access_0)
+ (let-values (((phase-access_1)
+ (let-values (((phase-access_2)
+ (hash-ref
+ access_3
+ phase_49
+ '#hasheq())))
+ phase-access_2)))
+ (let-values (((ht_84)
+ at-phase+space_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash
+ ht_84))
+ ((letrec-values (((for-loop_121)
+ (lambda (phase-access_3
+ i_116)
+ (begin
+ 'for-loop
+ (if i_116
+ (let-values (((sym_35
+ binding/p_2)
+ (hash-iterate-key+value
+ ht_84
+ i_116)))
+ (let-values (((phase-access_4)
+ (let-values (((phase-access_5)
+ (hash-set
+ phase-access_3
+ (module-binding-sym
+ (provided-as-binding
+ binding/p_2))
+ (if (provided-as-protected?
+ binding/p_2)
+ 'protected
+ 'provided))))
+ (values
+ phase-access_5))))
+ (if (not
+ #f)
+ (for-loop_121
+ phase-access_4
+ (hash-iterate-next
+ ht_84
+ i_116))
+ phase-access_4)))
+ phase-access_3)))))
+ for-loop_121)
+ phase-access_1
+ (hash-iterate-first
+ ht_84)))))))
+ (hash-set
+ access_3
+ phase_49
+ phase-access_0)))))
+ (values access_5))))
+ (if (not #f)
+ (for-loop_120 access_4 (hash-iterate-next ht_83 i_115))
+ access_4)))
+ access_3)))))
+ for-loop_120)
+ access_1
+ (hash-iterate-first ht_83)))))))
+ (begin (set-module-access! m_16 access_0) access_0)))))
+ (define-values
+ (module-instances->indented-module-names)
+ (lambda (mi_13 seen-list_2)
+ (begin
+ (let-values (((mi->name_0)
+ (lambda (mi_14)
+ (begin
+ 'mi->name
+ (format
"\n ~a"
- (1/module-path-index-resolve (namespace-mpi (module-instance-namespace mi_13))))))))
+ (1/module-path-index-resolve (namespace-mpi (module-instance-namespace mi_14))))))))
(cons
- (mi->name_0 mi_12)
- ((letrec-values (((loop_75)
+ (mi->name_0 mi_13)
+ ((letrec-values (((loop_77)
(lambda (seen-list_3)
(begin
'loop
(if (null? seen-list_3)
- (let-values () '())
- (if (eq? mi_12 (car seen-list_3))
- (let-values () (list (mi->name_0 mi_12)))
- (let-values ()
- (cons (mi->name_0 (car seen-list_3)) (loop_75 (cdr seen-list_3))))))))))
- loop_75)
+ '()
+ (if (eq? mi_13 (car seen-list_3))
+ (list (mi->name_0 mi_13))
+ (cons (mi->name_0 (car seen-list_3)) (loop_77 (cdr seen-list_3)))))))))
+ loop_77)
seen-list_2))))))
(define-values
(binding->module-instance)
- (lambda (b_44 ns_45 phase_43 id_14)
- (begin
- (let-values (((at-phase_7) (phase- phase_43 (module-binding-phase b_44))))
- (let-values (((mi_14)
- (let-values (((ns1_0) ns_45)
- ((temp2_0) (1/module-path-index-resolve (module-binding-module b_44)))
- ((at-phase3_0) at-phase_7)
- ((temp4_0) (module-binding-phase b_44))
- ((temp5_1) (lambda (mi_15) 'unavailable)))
+ (lambda (b_78 ns_50 phase_50 id_14)
+ (begin
+ (let-values (((at-phase_6) (phase- phase_50 (module-binding-phase b_78))))
+ (let-values (((mi_15)
+ (let-values (((ns1_0) ns_50)
+ ((temp2_0) (1/module-path-index-resolve (module-binding-module b_78)))
+ ((at-phase3_0) at-phase_6)
+ ((temp4_0) (module-binding-phase b_78))
+ ((temp5_1) (lambda (mi_16) 'unavailable)))
(namespace->module-instance.1 temp4_0 #f temp5_1 ns1_0 temp2_0 at-phase3_0))))
(begin
- (if (eq? mi_14 'unavailable)
- (let-values ()
- (raise-syntax-error$1
- #f
- (format
- (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")
- (module-binding-module b_44)
- (phase+ at-phase_7 (module-binding-phase b_44)))
- id_14))
+ (if (eq? mi_15 'unavailable)
+ (raise-syntax-error$1
+ #f
+ (format
+ (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")
+ (module-binding-module b_78)
+ (phase+ at-phase_6 (module-binding-phase b_78)))
+ id_14)
(void))
- (if mi_14
+ (if mi_15
(void)
- (let-values ()
- (raise-syntax-error$1
- #f
- (format
- (string-append
- "namespace mismatch;\n"
- " cannot locate module instance\n"
- " module: ~a\n"
- " use phase: ~a\n"
- " definition phase: ~a")
- (1/module-path-index-resolve (module-binding-module b_44))
- phase_43
- (module-binding-phase b_44))
- id_14)))
- mi_14))))))
+ (raise-syntax-error$1
+ #f
+ (format
+ (string-append
+ "namespace mismatch;\n"
+ " cannot locate module instance\n"
+ " module: ~a\n"
+ " use phase: ~a\n"
+ " definition phase: ~a")
+ (1/module-path-index-resolve (module-binding-module b_78))
+ phase_50
+ (module-binding-phase b_78))
+ id_14))
+ mi_15))))))
(define-values
(check-access)
- (lambda (b_44 mi_16 id_15 in-s_0 what_0)
- (begin
- (let-values (((m_14) (module-instance-module mi_16)))
- (if (if m_14 (not (module-no-protected? m_14)) #f)
- (let-values ()
- (let-values (((access_1)
- (let-values (((or-part_32) (module-access m_14)))
- (if or-part_32 or-part_32 (module-compute-access! m_14)))))
- (let-values (((a_21)
- (hash-ref
- (hash-ref access_1 (module-binding-phase b_44) '#hasheq())
- (module-binding-sym b_44)
- 'unexported)))
- (if (let-values (((or-part_33) (eq? a_21 'unexported)))
- (if or-part_33 or-part_33 (eq? a_21 'protected)))
- (let-values ()
- (begin
- (if (let-values (((or-part_0)
- (inspector-superior?
- (let-values (((or-part_72) (syntax-inspector id_15)))
- (if or-part_72 or-part_72 (current-code-inspector)))
- (namespace-inspector (module-instance-namespace mi_16)))))
- (if or-part_0
- or-part_0
- (if (module-binding-extra-inspector b_44)
- (inspector-superior?
- (module-binding-extra-inspector b_44)
- (namespace-inspector (module-instance-namespace mi_16)))
- #f)))
- (void)
- (let-values ()
- (let-values (((complain-id_0)
- (let-values (((c-id_0)
- (let-values (((or-part_83) in-s_0))
- (if or-part_83 or-part_83 (module-binding-sym b_44)))))
- (if (not
- (eq?
- (if (syntax?$1 c-id_0) (syntax-content c-id_0) c-id_0)
- (syntax-content id_15)))
- c-id_0
- #f))))
- (raise-syntax-error$1
- #f
- (format
- "access disallowed by code inspector to ~a ~a\n from module: ~a"
- a_21
- what_0
- (1/module-path-index-resolve (namespace-mpi (module-instance-namespace mi_16))))
- complain-id_0
- id_15
- null))))
- #t))
- (let-values () #f)))))
- (let-values () #f))))))
+ (lambda (b_79 mi_17 id_15 in-s_0 what_1)
+ (begin
+ (let-values (((m_17) (module-instance-module mi_17)))
+ (if (if m_17 (not (module-no-protected? m_17)) #f)
+ (let-values (((access_6)
+ (let-values (((or-part_248) (module-access m_17)))
+ (if or-part_248 or-part_248 (module-compute-access! m_17)))))
+ (let-values (((a_31)
+ (hash-ref
+ (hash-ref access_6 (module-binding-phase b_79) '#hasheq())
+ (module-binding-sym b_79)
+ 'unexported)))
+ (if (let-values (((or-part_249) (eq? a_31 'unexported)))
+ (if or-part_249 or-part_249 (eq? a_31 'protected)))
+ (begin
+ (if (let-values (((or-part_250)
+ (inspector-superior?
+ (let-values (((or-part_251) (syntax-inspector id_15)))
+ (if or-part_251 or-part_251 (current-code-inspector)))
+ (namespace-inspector (module-instance-namespace mi_17)))))
+ (if or-part_250
+ or-part_250
+ (if (module-binding-extra-inspector b_79)
+ (inspector-superior?
+ (module-binding-extra-inspector b_79)
+ (namespace-inspector (module-instance-namespace mi_17)))
+ #f)))
+ (void)
+ (let-values (((complain-id_0)
+ (let-values (((c-id_0)
+ (let-values (((or-part_252) in-s_0))
+ (if or-part_252 or-part_252 (module-binding-sym b_79)))))
+ (if (not
+ (eq?
+ (if (syntax?$1 c-id_0) (syntax-content c-id_0) c-id_0)
+ (syntax-content id_15)))
+ c-id_0
+ #f))))
+ (raise-syntax-error$1
+ #f
+ (format
+ "access disallowed by code inspector to ~a ~a\n from module: ~a"
+ a_31
+ what_1
+ (1/module-path-index-resolve (namespace-mpi (module-instance-namespace mi_17))))
+ complain-id_0
+ id_15
+ null)))
+ #t)
+ #f)))
+ #f)))))
(define-values
(resolve+shift/extra-inspector)
- (lambda (id_16 phase_44 ns_46)
+ (lambda (id_16 phase_51 ns_51)
(begin
- ((letrec-values (((loop_76)
+ ((letrec-values (((loop_78)
(lambda (id_17 in-s_1)
(begin
'loop
- (let-values (((b_62)
- (let-values (((id1_2) id_17) ((phase2_0) phase_44) ((temp3_0) #t))
+ (let-values (((b_80)
+ (let-values (((id1_2) id_17) ((phase2_0) phase_51) ((temp3_0) #t))
(resolve+shift.1 #f #f null temp3_0 #f id1_2 phase2_0))))
- (let-values (((c1_24) (binding-free=id b_62)))
- (if c1_24
+ (let-values (((cond-val_8) (binding-free=id b_80)))
+ (if cond-val_8
((lambda (next-id_0)
(let-values ((()
(begin
- (if (if (module-binding? b_62)
+ (if (if (module-binding? b_80)
(not
- (top-level-module-path-index? (module-binding-module b_62)))
+ (top-level-module-path-index? (module-binding-module b_80)))
#f)
- (let-values ()
- (let-values (((mi_17)
- (binding->module-instance
- b_62
- ns_46
- phase_44
- id_17)))
- (check-access b_62 mi_17 id_17 in-s_1 "provided binding")))
+ (let-values (((mi_18)
+ (binding->module-instance
+ b_80
+ ns_51
+ phase_51
+ id_17)))
+ (check-access b_80 mi_18 id_17 in-s_1 "provided binding"))
(void))
(values))))
(let-values (((next-b_0)
- (loop_76
+ (loop_78
next-id_0
- (let-values (((or-part_6) in-s_1))
- (if or-part_6 or-part_6 id_17)))))
+ (let-values (((or-part_253) in-s_1))
+ (if or-part_253 or-part_253 id_17)))))
(if (not next-b_0)
- (let-values () b_62)
+ b_80
(if (if (module-binding? next-b_0)
(if (not (module-binding-extra-inspector next-b_0))
(syntax-inspector id_17)
#f)
#f)
- (let-values ()
- (let-values (((next-b4_0) next-b_0) ((temp5_2) (syntax-inspector id_17)))
- (module-binding-update.1
- temp5_2
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- next-b4_0)))
- (let-values () next-b_0))))))
- c1_24)
- (let-values () b_62))))))))
- loop_76)
+ (let-values (((next-b4_0) next-b_0) ((temp5_2) (syntax-inspector id_17)))
+ (module-binding-update.1
+ temp5_2
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ next-b4_0))
+ next-b_0)))))
+ cond-val_8)
+ b_80)))))))
+ loop_78)
id_16
#f))))
(define-values
(1/prop:set!-transformer 1/set!-transformer? set!-transformer-value)
(make-struct-type-property
'set!-transformer
- (lambda (v_29 info_0)
+ (lambda (v_126 info_2)
(let-values ((()
(begin
- (if (let-values (((or-part_12)
- (if (procedure? v_29)
- (let-values (((or-part_3) (procedure-arity-includes? v_29 1)))
- (if or-part_3 or-part_3 (procedure-arity-includes? v_29 2)))
+ (if (let-values (((or-part_254)
+ (if (procedure? v_126)
+ (let-values (((or-part_255) (procedure-arity-includes? v_126 1)))
+ (if or-part_255 or-part_255 (procedure-arity-includes? v_126 2)))
#f)))
- (if or-part_12 or-part_12 (exact-nonnegative-integer? v_29)))
+ (if or-part_254 or-part_254 (exact-nonnegative-integer? v_126)))
(void)
- (let-values ()
- (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_29)))
+ (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_126))
(values))))
(let-values ((()
(begin
- (if (exact-nonnegative-integer? v_29)
- (let-values ()
- (begin
- (if (<= v_29 (list-ref info_0 1))
- (void)
- (let-values ()
- (raise-arguments-error
- 'guard-for-prop:set!-transformer
- "field index >= initialized-field count for structure type"
- "field index"
- v_29
- "initialized-field count"
- (list-ref info_0 1))))
- (if (member v_29 (list-ref info_0 5))
- (void)
- (let-values ()
- (raise-arguments-error
- 'guard-for-prop:set!-transformer
- "field index not declared immutable"
- "field index"
- v_29)))))
+ (if (exact-nonnegative-integer? v_126)
+ (begin
+ (if (<= v_126 (list-ref info_2 1))
+ (void)
+ (raise-arguments-error
+ 'guard-for-prop:set!-transformer
+ "field index >= initialized-field count for structure type"
+ "field index"
+ v_126
+ "initialized-field count"
+ (list-ref info_2 1)))
+ (if (member v_126 (list-ref info_2 5))
+ (void)
+ (raise-arguments-error
+ 'guard-for-prop:set!-transformer
+ "field index not declared immutable"
+ "field index"
+ v_126)))
(void))
(values))))
- (let-values (((ref_0) (list-ref info_0 3)))
- (if (integer? v_29)
- (let-values ()
- (lambda (t_9)
- (let-values (((p_19) (ref_0 t_9 v_29)))
- (if (if (procedure? p_19) (procedure-arity-includes? p_19 1) #f)
- p_19
- (lambda (s_179) (error "bad syntax:" s_179))))))
- (let-values () (lambda (t_11) v_29)))))))))
+ (let-values (((ref_1) (list-ref info_2 3)))
+ (if (integer? v_126)
+ (lambda (t_13)
+ (let-values (((p_22) (ref_1 t_13 v_126)))
+ (if (if (procedure? p_22) (procedure-arity-includes? p_22 1) #f)
+ p_22
+ (lambda (s_215) (error "bad syntax:" s_215)))))
+ (lambda (t_14) v_126))))))))
(define-values
(1/make-set!-transformer)
- (let-values ()
- (let-values (((struct:set!-transformer_0 set!-transformer1_0 set!-transformer?_0 set!-transformer-proc_0)
- (let-values (((struct:_34 make-_34 ?_34 -ref_34 -set!_34)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'set!-transformer
- #f
- 1
- 0
- #f
- (list (cons 1/prop:set!-transformer 0))
- (current-inspector)
- #f
- '(0)
- #f
- 'set!-transformer)))))
- (values struct:_34 make-_34 ?_34 (make-struct-field-accessor -ref_34 0 'proc)))))
- (lambda (proc_4)
+ (let-values (((struct:set!-transformer_0 set!-transformer1_0 set!-transformer?_0 set!-transformer-proc_0)
+ (let-values (((struct:_50 make-_50 ?_50 -ref_50 -set!_50)
+ (make-struct-type
+ 'set!-transformer
+ #f
+ 1
+ 0
+ #f
+ (list (cons 1/prop:set!-transformer 0))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'set!-transformer)))
+ (values struct:_50 make-_50 ?_50 (make-struct-field-accessor -ref_50 0 'proc)))))
+ (lambda (proc_4)
+ (begin
+ 'make-set!-transformer
(begin
- 'make-set!-transformer
- (begin
- (if (if (procedure? proc_4) (procedure-arity-includes? proc_4 1) #f)
- (void)
- (let-values () (raise-argument-error 'make-set!-transformer "(procedure-arity-includes/c 1)" proc_4)))
- (set!-transformer1_0 proc_4)))))))
+ (if (if (procedure? proc_4) (procedure-arity-includes? proc_4 1) #f)
+ (void)
+ (raise-argument-error 'make-set!-transformer "(procedure-arity-includes/c 1)" proc_4))
+ (set!-transformer1_0 proc_4))))))
(define-values
(1/set!-transformer-procedure)
- (lambda (t_13)
+ (lambda (t_15)
(begin
'set!-transformer-procedure
- (let-values (((v_89) ((set!-transformer-value t_13) t_13)))
- (if (procedure-arity-includes? v_89 1) v_89 (lambda (s_180) (v_89 t_13 s_180)))))))
+ (let-values (((v_127) ((set!-transformer-value t_15) t_15)))
+ (if (procedure-arity-includes? v_127 1) v_127 (lambda (s_216) (v_127 t_15 s_216)))))))
(define-values (empty-env) '#hasheq())
- (define-values (env-extend) (lambda (env_0 key_35 val_32) (begin (hash-set env_0 key_35 val_32))))
- (define-values (lookup) (lambda (env_1 key_44 default_6) (begin (hash-ref env_1 key_44 default_6))))
+ (define-values (env-extend) (lambda (env_0 key_45 val_33) (begin (hash-set env_0 key_45 val_33))))
+ (define-values (lookup) (lambda (env_1 key_46 default_6) (begin (hash-ref env_1 key_46 default_6))))
(define-values (variable) (gensym 'variable))
(define-values
(variable?)
- (lambda (t_14)
- (begin (let-values (((or-part_84) (eq? t_14 variable))) (if or-part_84 or-part_84 (local-variable? t_14))))))
+ (lambda (t_16)
+ (begin (let-values (((or-part_256) (eq? t_16 variable))) (if or-part_256 or-part_256 (local-variable? t_16))))))
(define-values
(struct:local-variable local-variable1.1 local-variable? local-variable-id)
- (let-values (((struct:_35 make-_35 ?_35 -ref_35 -set!_35)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'local-variable
- #f
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'local-variable)))))
- (values struct:_35 make-_35 ?_35 (make-struct-field-accessor -ref_35 0 'id))))
+ (let-values (((struct:_51 make-_51 ?_51 -ref_51 -set!_51)
+ (make-struct-type
+ 'local-variable
+ #f
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'local-variable)))
+ (values struct:_51 make-_51 ?_51 (make-struct-field-accessor -ref_51 0 'id))))
(define-values
(substitute-variable.1)
(lambda (no-stops?2_0 id4_1 t5_0)
(begin
'substitute-variable
(let-values (((id_18) id4_1))
- (let-values (((t_2) t5_0))
+ (let-values (((t_17) t5_0))
(let-values (((no-stops?_0) no-stops?2_0))
- (let-values ()
- (if (if no-stops?_0 (local-variable? t_2) #f)
- (let-values (((bind-id_0) (local-variable-id t_2)))
- (let-values (((pruned-id_0) (datum->syntax$1 bind-id_0 (syntax-e$1 bind-id_0) id_18 id_18)))
- (if (syntax-any-macro-scopes? id_18)
- (1/syntax-property-remove pruned-id_0 original-property-sym)
- pruned-id_0)))
- id_18))))))))
+ (if (if no-stops?_0 (local-variable? t_17) #f)
+ (let-values (((bind-id_0) (local-variable-id t_17)))
+ (let-values (((pruned-id_0) (datum->syntax$1 bind-id_0 (syntax-e$1 bind-id_0) id_18 id_18)))
+ (if (syntax-any-macro-scopes? id_18)
+ (1/syntax-property-remove pruned-id_0 original-property-sym)
+ pruned-id_0)))
+ id_18)))))))
(define-values (missing) (gensym 'missing))
(define-values
(transformer?)
- (lambda (t_15)
+ (lambda (t_18)
(begin
- (let-values (((or-part_168) (procedure? t_15)))
- (if or-part_168
- or-part_168
- (let-values (((or-part_169) (1/set!-transformer? t_15)))
- (if or-part_169 or-part_169 (1/rename-transformer? t_15))))))))
+ (let-values (((or-part_257) (procedure? t_18)))
+ (if or-part_257
+ or-part_257
+ (let-values (((or-part_258) (1/set!-transformer? t_18)))
+ (if or-part_258 or-part_258 (1/rename-transformer? t_18))))))))
(define-values
(transformer->procedure)
- (lambda (t_16)
+ (lambda (t_19)
(begin
- (if (1/set!-transformer? t_16)
- (let-values () (1/set!-transformer-procedure t_16))
- (if (1/rename-transformer? t_16) (let-values () (lambda (s_181) s_181)) (let-values () t_16))))))
+ (if (1/set!-transformer? t_19)
+ (1/set!-transformer-procedure t_19)
+ (if (1/rename-transformer? t_19) (lambda (s_217) s_217) t_19)))))
(define-values
(struct:core-form core-form7.1 core-form? core-form-expander core-form-name)
- (let-values (((struct:_0 make-_0 ?_0 -ref_0 -set!_0)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'core-form
- #f
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- #f
- #f
- '(0 1)
- #f
- 'core-form)))))
+ (let-values (((struct:_52 make-_52 ?_52 -ref_52 -set!_52)
+ (make-struct-type 'core-form #f 2 0 #f (list (cons prop:authentic #t)) #f #f '(0 1) #f 'core-form)))
(values
- struct:_0
- make-_0
- ?_0
- (make-struct-field-accessor -ref_0 0 'expander)
- (make-struct-field-accessor -ref_0 1 'name))))
+ struct:_52
+ make-_52
+ ?_52
+ (make-struct-field-accessor -ref_52 0 'expander)
+ (make-struct-field-accessor -ref_52 1 'name))))
(define-values
(add-binding!.1)
(lambda (in8_0 just-for-nominal?9_0 id12_0 binding13_0 phase14_0)
(begin
'add-binding!
(let-values (((id_19) id12_0))
- (let-values (((binding_8) binding13_0))
- (let-values (((phase_45) phase14_0))
+ (let-values (((binding_9) binding13_0))
+ (let-values (((phase_52) phase14_0))
(let-values (((in-s_2) in8_0))
(let-values (((just-for-nominal?_2) just-for-nominal?9_0))
- (let-values ()
- (begin
- (check-id-taint id_19 in-s_2)
- (let-values (((temp49_0) (syntax-scope-set id_19 phase_45))
- ((temp50_0) (syntax-e$1 id_19))
- ((binding51_0) binding_8)
- ((just-for-nominal?52_0) just-for-nominal?_2))
- (add-binding-in-scopes!.1 just-for-nominal?52_0 temp49_0 temp50_0 binding51_0))))))))))))
+ (begin
+ (check-id-taint id_19 in-s_2)
+ (let-values (((temp49_0) (syntax-scope-set id_19 phase_52))
+ ((temp50_0) (syntax-e$1 id_19))
+ ((binding51_0) binding_9)
+ ((just-for-nominal?52_0) just-for-nominal?_2))
+ (add-binding-in-scopes!.1 just-for-nominal?52_0 temp49_0 temp50_0 binding51_0)))))))))))
(define-values
(add-bulk-binding!.1)
(lambda (in16_0 shadow-except17_0 s20_0 binding21_0 phase22_1)
(begin
'add-bulk-binding!
- (let-values (((s_182) s20_0))
- (let-values (((binding_9) binding21_0))
- (let-values (((phase_46) phase22_1))
+ (let-values (((s_218) s20_0))
+ (let-values (((binding_10) binding21_0))
+ (let-values (((phase_53) phase22_1))
(let-values (((in-s_3) in16_0))
(let-values (((shadow-except_2) shadow-except17_0))
- (let-values ()
- (begin
- (if (syntax-tainted?$1 s_182)
- (let-values () (raise-syntax-error$1 #f "cannot bind from tainted syntax" in-s_3 s_182))
- (void))
- (let-values (((temp53_0) (syntax-scope-set s_182 phase_46))
- ((binding54_0) binding_9)
- ((shadow-except55_0) shadow-except_2))
- (add-bulk-binding-in-scopes!.1 shadow-except55_0 temp53_0 binding54_0))))))))))))
+ (begin
+ (if (syntax-tainted?$1 s_218)
+ (raise-syntax-error$1 #f "cannot bind from tainted syntax" in-s_3 s_218)
+ (void))
+ (let-values (((temp53_0) (syntax-scope-set s_218 phase_53))
+ ((binding54_0) binding_10)
+ ((shadow-except55_0) shadow-except_2))
+ (add-bulk-binding-in-scopes!.1 shadow-except55_0 temp53_0 binding54_0)))))))))))
(define-values
(add-local-binding!.1)
(lambda (frame-id25_0 in26_0 local-sym24_0 id30_0 phase31_0 counter32_0)
(begin
'add-local-binding!
(let-values (((id_20) id30_0))
- (let-values (((phase_47) phase31_0))
+ (let-values (((phase_54) phase31_0))
(let-values (((counter_1) counter32_0))
(let-values (((local-sym_0) local-sym24_0))
(let-values (((frame-id_5) frame-id25_0))
(let-values (((in-s_4) in26_0))
- (let-values ()
- (let-values ((() (begin (check-id-taint id_20 in-s_4) (values))))
- (let-values (((c_13) (add1 (unbox counter_1))))
- (let-values ((() (begin (set-box! counter_1 c_13) (values))))
- (let-values (((sym_29) (syntax-content id_20)))
- (let-values (((key_45)
- (string->uninterned-symbol
- (string-append-immutable
- (symbol->immutable-string
- (let-values (((or-part_170) local-sym_0))
- (if or-part_170 or-part_170 sym_29)))
- "_"
- (number->string c_13)))))
- (begin
- (let-values (((temp56_0) (syntax-scope-set id_20 phase_47))
- ((sym57_0) sym_29)
- ((temp58_0)
- (let-values (((key59_0) key_45) ((frame-id60_0) frame-id_5))
- (make-local-binding.1 frame-id60_0 #f key59_0))))
- (add-binding-in-scopes!.1 #f temp56_0 sym57_0 temp58_0))
- key_45))))))))))))))))
+ (let-values ((() (begin (check-id-taint id_20 in-s_4) (values))))
+ (let-values (((c_21) (add1 (unbox counter_1))))
+ (let-values ((() (begin (set-box! counter_1 c_21) (values))))
+ (let-values (((sym_36) (syntax-content id_20)))
+ (let-values (((key_47)
+ (string->uninterned-symbol
+ (string-append-immutable
+ (symbol->immutable-string
+ (let-values (((or-part_259) local-sym_0))
+ (if or-part_259 or-part_259 sym_36)))
+ "_"
+ (number->string c_21)))))
+ (begin
+ (let-values (((temp56_0) (syntax-scope-set id_20 phase_54))
+ ((sym57_0) sym_36)
+ ((temp58_0)
+ (let-values (((key59_0) key_47) ((frame-id60_0) frame-id_5))
+ (make-local-binding.1 frame-id60_0 #f key59_0))))
+ (add-binding-in-scopes!.1 #f temp56_0 sym57_0 temp58_0))
+ key_47)))))))))))))))
(define-values
(check-id-taint)
(lambda (id_21 in-s_5)
(begin
- (if (syntax-tainted?$1 id_21)
- (let-values () (raise-syntax-error$1 #f "cannot bind tainted identifier" in-s_5 id_21))
- (void)))))
+ (if (syntax-tainted?$1 id_21) (raise-syntax-error$1 #f "cannot bind tainted identifier" in-s_5 id_21) (void)))))
(define-values
(binding-lookup.1)
(lambda (check-access?36_0 in34_0 out-of-context-as-variable?35_0 b40_0 env41_0 lift-envs42_0 ns43_0 phase44_0 id45_0)
(begin
'binding-lookup
- (let-values (((b_20) b40_0))
+ (let-values (((b_81) b40_0))
(let-values (((env_2) env41_0))
(let-values (((lift-envs_0) lift-envs42_0))
- (let-values (((ns_47) ns43_0))
- (let-values (((phase_13) phase44_0))
+ (let-values (((ns_52) ns43_0))
+ (let-values (((phase_55) phase44_0))
(let-values (((id_22) id45_0))
(let-values (((in-s_6) in34_0))
(let-values (((out-of-context-as-variable?_0) out-of-context-as-variable?35_0))
(let-values (((check-access?_0) check-access?36_0))
- (let-values ()
- (if (module-binding? b_20)
- (let-values ()
- (let-values (((top-level?_0) (top-level-module-path-index? (module-binding-module b_20))))
- (let-values (((mi_18)
- (if (not top-level?_0)
- (binding->module-instance b_20 ns_47 phase_13 id_22)
- #f)))
- (let-values (((m_15) (if mi_18 (module-instance-module mi_18) #f)))
- (let-values (((primitive?_1) (if m_15 (module-primitive? m_15) #f)))
- (let-values (((m-ns_8)
- (if top-level?_0
- ns_47
- (if mi_18 (module-instance-namespace mi_18) #f))))
- (let-values ((() (begin (check-taint id_22) (values))))
- (let-values (((t_17)
- (namespace-get-transformer
- m-ns_8
- (module-binding-phase b_20)
- (module-binding-sym b_20)
- variable)))
- (let-values (((protected?_1)
- (if check-access?_0
- (if mi_18
- (check-access
- b_20
- mi_18
- id_22
- in-s_6
- (if (variable? t_17) "variable" "transformer"))
- #f)
- #f)))
- (let-values (((insp_6)
- (if mi_18
- (if (module-instance-module mi_18)
- (module-inspector (module-instance-module mi_18))
- #f)
- #f)))
- (values t_17 primitive?_1 insp_6 protected?_1)))))))))))
- (if (local-binding? b_20)
- (let-values ()
- (let-values (((t_18) (lookup env_2 (local-binding-key b_20) missing)))
- (if (eq? t_18 missing)
- (let-values ()
- (values
- (let-values (((or-part_171)
- (let-values (((lst_83) lift-envs_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_83)))
- ((letrec-values (((for-loop_58)
- (lambda (result_19 lst_84)
- (begin
- 'for-loop
- (if (pair? lst_84)
- (let-values (((lift-env_0)
- (unsafe-car lst_84))
- ((rest_39)
- (unsafe-cdr lst_84)))
- (let-values (((result_57)
- (let-values ()
- (let-values (((result_58)
- (let-values ()
- (let-values ()
- (lookup
- (unbox
- lift-env_0)
- (local-binding-key
- b_20)
- #f)))))
- (values
- result_58)))))
- (if (if (not
- ((lambda x_36 result_57)
- lift-env_0))
- (not #f)
- #f)
- (for-loop_58 result_57 rest_39)
- result_57)))
- result_19)))))
- for-loop_58)
- #f
- lst_83)))))
- (if or-part_171
- or-part_171
- (if out-of-context-as-variable?_0
- variable
- (raise-syntax-error$1 #f "identifier used out of context" id_22))))
- #f
- #f
- #f))
- (let-values () (begin (check-taint id_22) (values t_18 #f #f #f))))))
- (let-values () (error "internal error: unknown binding for lookup:" b_20)))))))))))))))))
- (define-values
- (check-taint)
- (lambda (id_23)
- (begin
- (if (syntax-tainted?$1 id_23)
- (let-values () (raise-syntax-error$1 #f "cannot use identifier tainted by macro transformation" id_23))
- (void)))))
- (define-values
- (existing-binding-key)
- (lambda (id_24 phase_48)
- (begin
- (let-values (((b_63)
- (let-values (((id61_1) id_24) ((phase62_1) phase_48) ((temp63_0) #t))
- (resolve+shift.1 #f #f null temp63_0 #f id61_1 phase62_1))))
- (begin
- (if (local-binding? b_63)
- (void)
- (let-values ()
- (raise-syntax-error$1 #f "expected an existing local binding for an already-expanded identifier" id_24)))
- (local-binding-key b_63))))))
- (define-values (cons-ish) (lambda (a_27 b_47) (begin (if (null? b_47) a_27 (cons a_27 b_47)))))
+ (if (module-binding? b_81)
+ (let-values (((top-level?_0) (top-level-module-path-index? (module-binding-module b_81))))
+ (let-values (((mi_19)
+ (if (not top-level?_0)
+ (binding->module-instance b_81 ns_52 phase_55 id_22)
+ #f)))
+ (let-values (((m_18) (if mi_19 (module-instance-module mi_19) #f)))
+ (let-values (((primitive?_1) (if m_18 (module-primitive? m_18) #f)))
+ (let-values (((m-ns_8)
+ (if top-level?_0
+ ns_52
+ (if mi_19 (module-instance-namespace mi_19) #f))))
+ (let-values ((() (begin (check-taint id_22) (values))))
+ (let-values (((t_20)
+ (namespace-get-transformer
+ m-ns_8
+ (module-binding-phase b_81)
+ (module-binding-sym b_81)
+ variable)))
+ (let-values (((protected?_1)
+ (if check-access?_0
+ (if mi_19
+ (check-access
+ b_81
+ mi_19
+ id_22
+ in-s_6
+ (if (variable? t_20) "variable" "transformer"))
+ #f)
+ #f)))
+ (let-values (((insp_6)
+ (if mi_19
+ (if (module-instance-module mi_19)
+ (module-inspector (module-instance-module mi_19))
+ #f)
+ #f)))
+ (values t_20 primitive?_1 insp_6 protected?_1))))))))))
+ (if (local-binding? b_81)
+ (let-values (((t_21) (lookup env_2 (local-binding-key b_81) missing)))
+ (if (eq? t_21 missing)
+ (values
+ (let-values (((or-part_260)
+ (let-values (((result_102) (let-values (((result_103) #f)) result_103)))
+ (let-values (((lst_123) lift-envs_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_123))
+ ((letrec-values (((for-loop_122)
+ (lambda (result_104 lst_124)
+ (begin
+ 'for-loop
+ (if (pair? lst_124)
+ (let-values (((lift-env_0)
+ (unsafe-car lst_124))
+ ((rest_58)
+ (unsafe-cdr lst_124)))
+ (let-values (((result_105)
+ (let-values (((result_106)
+ (lookup
+ (unbox
+ lift-env_0)
+ (local-binding-key
+ b_81)
+ #f)))
+ (values result_106))))
+ (if (if (not
+ ((lambda x_40 result_105)
+ lift-env_0))
+ (not #f)
+ #f)
+ (for-loop_122 result_105 rest_58)
+ result_105)))
+ result_104)))))
+ for-loop_122)
+ result_102
+ lst_123))))))
+ (if or-part_260
+ or-part_260
+ (if out-of-context-as-variable?_0
+ variable
+ (raise-syntax-error$1 #f "identifier used out of context" id_22))))
+ #f
+ #f
+ #f)
+ (begin (check-taint id_22) (values t_21 #f #f #f))))
+ (error "internal error: unknown binding for lookup:" b_81)))))))))))))))
(define-values
- (free-id-set)
- (lambda (phase_49 ids_1)
+ (check-taint)
+ (lambda (id_23)
+ (begin
+ (if (syntax-tainted?$1 id_23)
+ (raise-syntax-error$1 #f "cannot use identifier tainted by macro transformation" id_23)
+ (void)))))
+ (define-values
+ (existing-binding-key)
+ (lambda (id_24 phase_56)
(begin
- (let-values (((lst_85) ids_1))
+ (let-values (((b_82)
+ (let-values (((id61_1) id_24) ((phase62_1) phase_56) ((temp63_0) #t))
+ (resolve+shift.1 #f #f null temp63_0 #f id61_1 phase62_1))))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_85)))
- ((letrec-values (((for-loop_100)
- (lambda (ht_75 lst_86)
- (begin
- 'for-loop
- (if (pair? lst_86)
- (let-values (((id_12) (unsafe-car lst_86)) ((rest_40) (unsafe-cdr lst_86)))
- (let-values (((ht_76)
- (let-values (((ht_77) ht_75))
- (let-values (((ht_78)
- (let-values ()
- (let-values (((sym_30)
- (identifier-binding-symbol$1
- id_12
- phase_49)))
- (hash-set
- ht_77
- sym_30
- (cons-ish
- id_12
- (hash-ref ht_77 sym_30 null)))))))
- (values ht_78)))))
- (if (not #f) (for-loop_100 ht_76 rest_40) ht_76)))
- ht_75)))))
- for-loop_100)
- '#hasheq()
- lst_85))))))
+ (if (local-binding? b_82)
+ (void)
+ (raise-syntax-error$1 #f "expected an existing local binding for an already-expanded identifier" id_24))
+ (local-binding-key b_82))))))
+ (define-values (cons-ish) (lambda (a_32 b_83) (begin (if (null? b_83) a_32 (cons a_32 b_83)))))
+ (define-values
+ (free-id-set)
+ (lambda (phase_57 ids_1)
+ (begin
+ (let-values (((ht_85) (let-values (((ht_86) '#hasheq())) ht_86)))
+ (let-values (((lst_125) ids_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_125))
+ ((letrec-values (((for-loop_123)
+ (lambda (ht_87 lst_126)
+ (begin
+ 'for-loop
+ (if (pair? lst_126)
+ (let-values (((id_25) (unsafe-car lst_126)) ((rest_59) (unsafe-cdr lst_126)))
+ (let-values (((ht_88)
+ (let-values (((ht_89)
+ (let-values (((sym_37)
+ (identifier-binding-symbol$1
+ id_25
+ phase_57)))
+ (hash-set
+ ht_87
+ sym_37
+ (cons-ish id_25 (hash-ref ht_87 sym_37 null))))))
+ (values ht_89))))
+ (if (not #f) (for-loop_123 ht_88 rest_59) ht_88)))
+ ht_87)))))
+ for-loop_123)
+ ht_85
+ lst_125)))))))
(define-values (empty-free-id-set) (free-id-set 0 null))
(define-values (free-id-set-empty?) (lambda (fs_0) (begin (eq? fs_0 empty-free-id-set))))
(define-values
(free-id-set-member?)
- (lambda (fs_1 phase_50 given-id_0)
+ (lambda (fs_1 phase_58 given-id_0)
(begin
(if (free-id-set-empty? fs_1)
#f
- (let-values (((lst_46) (hash-ref fs_1 (identifier-binding-symbol$1 given-id_0 phase_50) null)))
- (begin
- (void)
- ((letrec-values (((for-loop_55)
- (lambda (result_3 lst_23)
+ (let-values (((result_107) (let-values (((result_108) #f)) result_108)))
+ (let-values (((lst_127) (hash-ref fs_1 (identifier-binding-symbol$1 given-id_0 phase_58) null)))
+ ((letrec-values (((for-loop_124)
+ (lambda (result_109 lst_128)
(begin
'for-loop
- (if (not (null? lst_23))
- (let-values (((id_2) (if (pair? lst_23) (car lst_23) lst_23))
- ((rest_20) (if (pair? lst_23) (cdr lst_23) null)))
- (let-values (((result_59)
- (let-values ()
- (let-values (((result_60)
- (let-values ()
- (let-values ()
- (free-identifier=?$1
- id_2
- given-id_0
- phase_50
- phase_50)))))
- (values result_60)))))
- (if (if (not ((lambda x_37 result_59) id_2)) (not #f) #f)
- (for-loop_55 result_59 rest_20)
- result_59)))
- result_3)))))
- for-loop_55)
- #f
- lst_46)))))))
+ (if (not (null? lst_128))
+ (let-values (((id_26) (if (pair? lst_128) (car lst_128) lst_128))
+ ((rest_60) (if (pair? lst_128) (cdr lst_128) null)))
+ (let-values (((result_110)
+ (let-values (((result_111)
+ (free-identifier=?$1
+ id_26
+ given-id_0
+ phase_58
+ phase_58)))
+ (values result_111))))
+ (if (if (not ((lambda x_41 result_110) id_26)) (not #f) #f)
+ (for-loop_124 result_110 rest_60)
+ result_110)))
+ result_109)))))
+ for-loop_124)
+ result_107
+ lst_127)))))))
(define-values
(free-id-set-empty-or-just-module*?)
- (lambda (fs_2) (begin (let-values (((c_18) (hash-count fs_2))) (<= c_18 1)))))
+ (lambda (fs_2) (begin (let-values (((c_22) (hash-count fs_2))) (<= c_22 1)))))
(define-values
(struct:expand-context/outer
expand-context/outer1.1
@@ -16383,36 +16459,34 @@
expand-context/outer-current-introduction-scopes
expand-context/outer-current-use-scopes
expand-context/outer-name)
- (let-values (((struct:_36 make-_36 ?_36 -ref_36 -set!_36)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'expand-context
- struct:root-expand-context/outer
- 11
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6 7 8 9 10)
- #f
- 'expand-context/outer)))))
+ (let-values (((struct:_53 make-_53 ?_53 -ref_53 -set!_53)
+ (make-struct-type
+ 'expand-context
+ struct:root-expand-context/outer
+ 11
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 6 7 8 9 10)
+ #f
+ 'expand-context/outer)))
(values
- struct:_36
- make-_36
- ?_36
- (make-struct-field-accessor -ref_36 0 'context)
- (make-struct-field-accessor -ref_36 1 'env)
- (make-struct-field-accessor -ref_36 2 'scopes)
- (make-struct-field-accessor -ref_36 3 'def-ctx-scopes)
- (make-struct-field-accessor -ref_36 4 'binding-layer)
- (make-struct-field-accessor -ref_36 5 'reference-records)
- (make-struct-field-accessor -ref_36 6 'only-immediate?)
- (make-struct-field-accessor -ref_36 7 'need-eventually-defined)
- (make-struct-field-accessor -ref_36 8 'current-introduction-scopes)
- (make-struct-field-accessor -ref_36 9 'current-use-scopes)
- (make-struct-field-accessor -ref_36 10 'name))))
+ struct:_53
+ make-_53
+ ?_53
+ (make-struct-field-accessor -ref_53 0 'context)
+ (make-struct-field-accessor -ref_53 1 'env)
+ (make-struct-field-accessor -ref_53 2 'scopes)
+ (make-struct-field-accessor -ref_53 3 'def-ctx-scopes)
+ (make-struct-field-accessor -ref_53 4 'binding-layer)
+ (make-struct-field-accessor -ref_53 5 'reference-records)
+ (make-struct-field-accessor -ref_53 6 'only-immediate?)
+ (make-struct-field-accessor -ref_53 7 'need-eventually-defined)
+ (make-struct-field-accessor -ref_53 8 'current-introduction-scopes)
+ (make-struct-field-accessor -ref_53 9 'current-use-scopes)
+ (make-struct-field-accessor -ref_53 10 'name))))
(define-values
(struct:expand-context/inner
expand-context/inner2.1
@@ -16439,47 +16513,45 @@
expand-context/inner-normalize-locals?
expand-context/inner-parsing-expanded?
expand-context/inner-skip-visit-available?)
- (let-values (((struct:_37 make-_37 ?_37 -ref_37 -set!_37)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'expand-context/inner
- struct:root-expand-context/inner
- 22
- 0
- #f
- (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)))))
+ (let-values (((struct:_54 make-_54 ?_54 -ref_54 -set!_54)
+ (make-struct-type
+ 'expand-context/inner
+ struct:root-expand-context/inner
+ 22
+ 0
+ #f
+ (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)))
(values
- struct:_37
- make-_37
- ?_37
- (make-struct-field-accessor -ref_37 0 'to-parsed?)
- (make-struct-field-accessor -ref_37 1 'phase)
- (make-struct-field-accessor -ref_37 2 'namespace)
- (make-struct-field-accessor -ref_37 3 'just-once?)
- (make-struct-field-accessor -ref_37 4 'module-begin-k)
- (make-struct-field-accessor -ref_37 5 'allow-unbound?)
- (make-struct-field-accessor -ref_37 6 'in-local-expand?)
- (make-struct-field-accessor -ref_37 7 'keep-#%expression?)
- (make-struct-field-accessor -ref_37 8 'stops)
- (make-struct-field-accessor -ref_37 9 'declared-submodule-names)
- (make-struct-field-accessor -ref_37 10 'lifts)
- (make-struct-field-accessor -ref_37 11 'lift-envs)
- (make-struct-field-accessor -ref_37 12 'module-lifts)
- (make-struct-field-accessor -ref_37 13 'require-lifts)
- (make-struct-field-accessor -ref_37 14 'to-module-lifts)
- (make-struct-field-accessor -ref_37 15 'requires+provides)
- (make-struct-field-accessor -ref_37 16 'observer)
- (make-struct-field-accessor -ref_37 17 'for-serializable?)
- (make-struct-field-accessor -ref_37 18 'to-correlated-linklet?)
- (make-struct-field-accessor -ref_37 19 'normalize-locals?)
- (make-struct-field-accessor -ref_37 20 'parsing-expanded?)
- (make-struct-field-accessor -ref_37 21 'skip-visit-available?))))
+ struct:_54
+ make-_54
+ ?_54
+ (make-struct-field-accessor -ref_54 0 'to-parsed?)
+ (make-struct-field-accessor -ref_54 1 'phase)
+ (make-struct-field-accessor -ref_54 2 'namespace)
+ (make-struct-field-accessor -ref_54 3 'just-once?)
+ (make-struct-field-accessor -ref_54 4 'module-begin-k)
+ (make-struct-field-accessor -ref_54 5 'allow-unbound?)
+ (make-struct-field-accessor -ref_54 6 'in-local-expand?)
+ (make-struct-field-accessor -ref_54 7 'keep-#%expression?)
+ (make-struct-field-accessor -ref_54 8 'stops)
+ (make-struct-field-accessor -ref_54 9 'declared-submodule-names)
+ (make-struct-field-accessor -ref_54 10 'lifts)
+ (make-struct-field-accessor -ref_54 11 'lift-envs)
+ (make-struct-field-accessor -ref_54 12 'module-lifts)
+ (make-struct-field-accessor -ref_54 13 'require-lifts)
+ (make-struct-field-accessor -ref_54 14 'to-module-lifts)
+ (make-struct-field-accessor -ref_54 15 'requires+provides)
+ (make-struct-field-accessor -ref_54 16 'observer)
+ (make-struct-field-accessor -ref_54 17 'for-serializable?)
+ (make-struct-field-accessor -ref_54 18 'to-correlated-linklet?)
+ (make-struct-field-accessor -ref_54 19 'normalize-locals?)
+ (make-struct-field-accessor -ref_54 20 'parsing-expanded?)
+ (make-struct-field-accessor -ref_54 21 'skip-visit-available?))))
(define-values
(expand-context/make)
(lambda (self-mpi_2
@@ -16494,7 +16566,7 @@
lift-key_1
to-parsed?_0
context_0
- phase_51
+ phase_59
namespace_0
env_3
scopes_19
@@ -16518,7 +16590,7 @@
require-lifts_0
to-module-lifts_0
requires+provides_0
- name_37
+ name_45
observer_0
for-serializable?_0
to-correlated-linklet?_0
@@ -16536,7 +16608,7 @@
counter_2
lift-key_1
to-parsed?_0
- phase_51
+ phase_59
namespace_0
just-once?_0
module-begin-k_0
@@ -16570,163 +16642,162 @@
need-eventually-defined_0
current-introduction-scopes_0
current-use-scopes_0
- name_37))))
- (define-values (expand-context-context) (lambda (v_90) (begin (expand-context/outer-context v_90))))
- (define-values (expand-context-env) (lambda (v_91) (begin (expand-context/outer-env v_91))))
- (define-values (expand-context-scopes) (lambda (v_92) (begin (expand-context/outer-scopes v_92))))
- (define-values (expand-context-def-ctx-scopes) (lambda (v_93) (begin (expand-context/outer-def-ctx-scopes v_93))))
- (define-values (expand-context-binding-layer) (lambda (v_94) (begin (expand-context/outer-binding-layer v_94))))
+ name_45))))
+ (define-values (expand-context-context) (lambda (v_128) (begin (expand-context/outer-context v_128))))
+ (define-values (expand-context-env) (lambda (v_129) (begin (expand-context/outer-env v_129))))
+ (define-values (expand-context-scopes) (lambda (v_130) (begin (expand-context/outer-scopes v_130))))
+ (define-values (expand-context-def-ctx-scopes) (lambda (v_131) (begin (expand-context/outer-def-ctx-scopes v_131))))
+ (define-values (expand-context-binding-layer) (lambda (v_132) (begin (expand-context/outer-binding-layer v_132))))
(define-values
(expand-context-reference-records)
- (lambda (v_95) (begin (expand-context/outer-reference-records v_95))))
- (define-values (expand-context-only-immediate?) (lambda (v_38) (begin (expand-context/outer-only-immediate? v_38))))
+ (lambda (v_133) (begin (expand-context/outer-reference-records v_133))))
+ (define-values (expand-context-only-immediate?) (lambda (v_134) (begin (expand-context/outer-only-immediate? v_134))))
(define-values
(expand-context-need-eventually-defined)
- (lambda (v_96) (begin (expand-context/outer-need-eventually-defined v_96))))
+ (lambda (v_135) (begin (expand-context/outer-need-eventually-defined v_135))))
(define-values
(expand-context-current-introduction-scopes)
- (lambda (v_97) (begin (expand-context/outer-current-introduction-scopes v_97))))
+ (lambda (v_136) (begin (expand-context/outer-current-introduction-scopes v_136))))
(define-values
(expand-context-current-use-scopes)
- (lambda (v_98) (begin (expand-context/outer-current-use-scopes v_98))))
- (define-values (expand-context-name) (lambda (v_99) (begin (expand-context/outer-name v_99))))
+ (lambda (v_137) (begin (expand-context/outer-current-use-scopes v_137))))
+ (define-values (expand-context-name) (lambda (v_138) (begin (expand-context/outer-name v_138))))
(define-values
(expand-context-to-parsed?)
- (lambda (v_100) (begin (expand-context/inner-to-parsed? (root-expand-context/outer-inner v_100)))))
+ (lambda (v_139) (begin (expand-context/inner-to-parsed? (root-expand-context/outer-inner v_139)))))
(define-values
(expand-context-phase)
- (lambda (v_101) (begin (expand-context/inner-phase (root-expand-context/outer-inner v_101)))))
+ (lambda (v_140) (begin (expand-context/inner-phase (root-expand-context/outer-inner v_140)))))
(define-values
(expand-context-namespace)
- (lambda (v_102) (begin (expand-context/inner-namespace (root-expand-context/outer-inner v_102)))))
+ (lambda (v_141) (begin (expand-context/inner-namespace (root-expand-context/outer-inner v_141)))))
(define-values
(expand-context-just-once?)
- (lambda (v_103) (begin (expand-context/inner-just-once? (root-expand-context/outer-inner v_103)))))
+ (lambda (v_142) (begin (expand-context/inner-just-once? (root-expand-context/outer-inner v_142)))))
(define-values
(expand-context-module-begin-k)
- (lambda (v_42) (begin (expand-context/inner-module-begin-k (root-expand-context/outer-inner v_42)))))
+ (lambda (v_143) (begin (expand-context/inner-module-begin-k (root-expand-context/outer-inner v_143)))))
(define-values
(expand-context-allow-unbound?)
- (lambda (v_104) (begin (expand-context/inner-allow-unbound? (root-expand-context/outer-inner v_104)))))
+ (lambda (v_144) (begin (expand-context/inner-allow-unbound? (root-expand-context/outer-inner v_144)))))
(define-values
(expand-context-in-local-expand?)
- (lambda (v_105) (begin (expand-context/inner-in-local-expand? (root-expand-context/outer-inner v_105)))))
+ (lambda (v_145) (begin (expand-context/inner-in-local-expand? (root-expand-context/outer-inner v_145)))))
(define-values
(expand-context-keep-#%expression?)
- (lambda (v_106) (begin (expand-context/inner-keep-#%expression? (root-expand-context/outer-inner v_106)))))
+ (lambda (v_146) (begin (expand-context/inner-keep-#%expression? (root-expand-context/outer-inner v_146)))))
(define-values
(expand-context-stops)
- (lambda (v_107) (begin (expand-context/inner-stops (root-expand-context/outer-inner v_107)))))
+ (lambda (v_147) (begin (expand-context/inner-stops (root-expand-context/outer-inner v_147)))))
(define-values
(expand-context-declared-submodule-names)
- (lambda (v_108) (begin (expand-context/inner-declared-submodule-names (root-expand-context/outer-inner v_108)))))
+ (lambda (v_148) (begin (expand-context/inner-declared-submodule-names (root-expand-context/outer-inner v_148)))))
(define-values
(expand-context-lifts)
- (lambda (v_109) (begin (expand-context/inner-lifts (root-expand-context/outer-inner v_109)))))
+ (lambda (v_149) (begin (expand-context/inner-lifts (root-expand-context/outer-inner v_149)))))
(define-values
(expand-context-lift-envs)
- (lambda (v_110) (begin (expand-context/inner-lift-envs (root-expand-context/outer-inner v_110)))))
+ (lambda (v_150) (begin (expand-context/inner-lift-envs (root-expand-context/outer-inner v_150)))))
(define-values
(expand-context-module-lifts)
- (lambda (v_111) (begin (expand-context/inner-module-lifts (root-expand-context/outer-inner v_111)))))
+ (lambda (v_151) (begin (expand-context/inner-module-lifts (root-expand-context/outer-inner v_151)))))
(define-values
(expand-context-require-lifts)
- (lambda (v_53) (begin (expand-context/inner-require-lifts (root-expand-context/outer-inner v_53)))))
+ (lambda (v_152) (begin (expand-context/inner-require-lifts (root-expand-context/outer-inner v_152)))))
(define-values
(expand-context-to-module-lifts)
- (lambda (v_112) (begin (expand-context/inner-to-module-lifts (root-expand-context/outer-inner v_112)))))
+ (lambda (v_153) (begin (expand-context/inner-to-module-lifts (root-expand-context/outer-inner v_153)))))
(define-values
(expand-context-requires+provides)
- (lambda (v_113) (begin (expand-context/inner-requires+provides (root-expand-context/outer-inner v_113)))))
+ (lambda (v_154) (begin (expand-context/inner-requires+provides (root-expand-context/outer-inner v_154)))))
(define-values
(expand-context-observer)
- (lambda (v_114) (begin (expand-context/inner-observer (root-expand-context/outer-inner v_114)))))
+ (lambda (v_155) (begin (expand-context/inner-observer (root-expand-context/outer-inner v_155)))))
(define-values
(expand-context-for-serializable?)
- (lambda (v_82) (begin (expand-context/inner-for-serializable? (root-expand-context/outer-inner v_82)))))
+ (lambda (v_156) (begin (expand-context/inner-for-serializable? (root-expand-context/outer-inner v_156)))))
(define-values
(expand-context-to-correlated-linklet?)
- (lambda (v_115) (begin (expand-context/inner-to-correlated-linklet? (root-expand-context/outer-inner v_115)))))
+ (lambda (v_157) (begin (expand-context/inner-to-correlated-linklet? (root-expand-context/outer-inner v_157)))))
(define-values
(expand-context-normalize-locals?)
- (lambda (v_116) (begin (expand-context/inner-normalize-locals? (root-expand-context/outer-inner v_116)))))
+ (lambda (v_158) (begin (expand-context/inner-normalize-locals? (root-expand-context/outer-inner v_158)))))
(define-values
(expand-context-parsing-expanded?)
- (lambda (v_117) (begin (expand-context/inner-parsing-expanded? (root-expand-context/outer-inner v_117)))))
+ (lambda (v_159) (begin (expand-context/inner-parsing-expanded? (root-expand-context/outer-inner v_159)))))
(define-values
(expand-context-skip-visit-available?)
- (lambda (v_118) (begin (expand-context/inner-skip-visit-available? (root-expand-context/outer-inner v_118)))))
+ (lambda (v_160) (begin (expand-context/inner-skip-visit-available? (root-expand-context/outer-inner v_160)))))
(define-values
(make-expand-context.1)
(lambda (for-serializable?4_0 observer6_0 skip-visit-available?7_0 to-correlated-linklet?5_0 to-parsed?3_0 ns13_0)
(begin
'make-expand-context
- (let-values (((ns_48) ns13_0))
+ (let-values (((ns_53) ns13_0))
(let-values (((to-parsed?_1) to-parsed?3_0))
(let-values (((for-serializable?_1) for-serializable?4_0))
(let-values (((to-correlated-linklet?_1) to-correlated-linklet?5_0))
(let-values (((observer_1) observer6_0))
(let-values (((skip-visit-available?_1) skip-visit-available?7_0))
- (let-values ()
- (let-values (((root-ctx_1) (namespace-get-root-expand-ctx ns_48)))
- (expand-context/make
- (root-expand-context-self-mpi root-ctx_1)
- (root-expand-context-module-scopes root-ctx_1)
- (root-expand-context-post-expansion root-ctx_1)
- (root-expand-context-top-level-bind-scope root-ctx_1)
- (root-expand-context-all-scopes-stx root-ctx_1)
- (root-expand-context-use-site-scopes root-ctx_1)
- (root-expand-context-defined-syms root-ctx_1)
- (root-expand-context-frame-id root-ctx_1)
- (root-expand-context-counter root-ctx_1)
- (root-expand-context-lift-key root-ctx_1)
- to-parsed?_1
- 'top-level
- (namespace-phase ns_48)
- ns_48
- empty-env
- null
- #f
- (root-expand-context-frame-id root-ctx_1)
- null
- #f
- #f
- #f
- #f
- #t
- #f
- #f
- empty-free-id-set
- null
- null
- '#hasheq()
- #f
- '()
- #f
- #f
- #f
- #f
- #f
- observer_1
- for-serializable?_1
- to-correlated-linklet?_1
- to-correlated-linklet?_1
- #f
- skip-visit-available?_1))))))))))))
+ (let-values (((root-ctx_1) (namespace-get-root-expand-ctx ns_53)))
+ (expand-context/make
+ (root-expand-context-self-mpi root-ctx_1)
+ (root-expand-context-module-scopes root-ctx_1)
+ (root-expand-context-post-expansion root-ctx_1)
+ (root-expand-context-top-level-bind-scope root-ctx_1)
+ (root-expand-context-all-scopes-stx root-ctx_1)
+ (root-expand-context-use-site-scopes root-ctx_1)
+ (root-expand-context-defined-syms root-ctx_1)
+ (root-expand-context-frame-id root-ctx_1)
+ (root-expand-context-counter root-ctx_1)
+ (root-expand-context-lift-key root-ctx_1)
+ to-parsed?_1
+ 'top-level
+ (namespace-phase ns_53)
+ ns_53
+ empty-env
+ null
+ #f
+ (root-expand-context-frame-id root-ctx_1)
+ null
+ #f
+ #f
+ #f
+ #f
+ #t
+ #f
+ #f
+ empty-free-id-set
+ null
+ null
+ '#hasheq()
+ #f
+ '()
+ #f
+ #f
+ #f
+ #f
+ #f
+ observer_1
+ for-serializable?_1
+ to-correlated-linklet?_1
+ to-correlated-linklet?_1
+ #f
+ skip-visit-available?_1)))))))))))
(define-values
(copy-root-expand-context)
(lambda (ctx_1 root-ctx_2)
(begin
- (let-values (((v_60) ctx_1))
- (let-values (((the-struct_35) v_60))
- (if (expand-context/outer? the-struct_35)
+ (let-values (((v_161) ctx_1))
+ (let-values (((the-struct_36) v_161))
+ (if (expand-context/outer? the-struct_36)
(let-values (((post-expansion25_0) (root-expand-context-post-expansion root-ctx_2))
((use-site-scopes26_0) (root-expand-context-use-site-scopes root-ctx_2))
((frame-id27_0) (root-expand-context-frame-id root-ctx_2))
((binding-layer28_0) (root-expand-context-frame-id root-ctx_2))
((inner29_0)
- (let-values (((the-struct_36) (root-expand-context/outer-inner v_60)))
- (if (expand-context/inner? the-struct_36)
+ (let-values (((the-struct_37) (root-expand-context/outer-inner v_161)))
+ (if (expand-context/inner? the-struct_37)
(let-values (((self-mpi30_0) (root-expand-context-self-mpi root-ctx_2))
((module-scopes31_0) (root-expand-context-module-scopes root-ctx_2))
((top-level-bind-scope32_0)
@@ -16743,46 +16814,46 @@
defined-syms34_0
counter35_0
lift-key36_0
- (expand-context/inner-to-parsed? the-struct_36)
- (expand-context/inner-phase the-struct_36)
- (expand-context/inner-namespace the-struct_36)
- (expand-context/inner-just-once? the-struct_36)
- (expand-context/inner-module-begin-k the-struct_36)
- (expand-context/inner-allow-unbound? the-struct_36)
- (expand-context/inner-in-local-expand? the-struct_36)
- (expand-context/inner-keep-#%expression? the-struct_36)
- (expand-context/inner-stops the-struct_36)
- (expand-context/inner-declared-submodule-names the-struct_36)
- (expand-context/inner-lifts the-struct_36)
- (expand-context/inner-lift-envs the-struct_36)
- (expand-context/inner-module-lifts the-struct_36)
- (expand-context/inner-require-lifts the-struct_36)
- (expand-context/inner-to-module-lifts the-struct_36)
- (expand-context/inner-requires+provides the-struct_36)
- (expand-context/inner-observer the-struct_36)
- (expand-context/inner-for-serializable? the-struct_36)
- (expand-context/inner-to-correlated-linklet? the-struct_36)
- (expand-context/inner-normalize-locals? the-struct_36)
- (expand-context/inner-parsing-expanded? the-struct_36)
- (expand-context/inner-skip-visit-available? the-struct_36)))
- (raise-argument-error 'struct-copy "expand-context/inner?" the-struct_36)))))
+ (expand-context/inner-to-parsed? the-struct_37)
+ (expand-context/inner-phase the-struct_37)
+ (expand-context/inner-namespace the-struct_37)
+ (expand-context/inner-just-once? the-struct_37)
+ (expand-context/inner-module-begin-k the-struct_37)
+ (expand-context/inner-allow-unbound? the-struct_37)
+ (expand-context/inner-in-local-expand? the-struct_37)
+ (expand-context/inner-keep-#%expression? the-struct_37)
+ (expand-context/inner-stops the-struct_37)
+ (expand-context/inner-declared-submodule-names the-struct_37)
+ (expand-context/inner-lifts the-struct_37)
+ (expand-context/inner-lift-envs the-struct_37)
+ (expand-context/inner-module-lifts the-struct_37)
+ (expand-context/inner-require-lifts the-struct_37)
+ (expand-context/inner-to-module-lifts the-struct_37)
+ (expand-context/inner-requires+provides the-struct_37)
+ (expand-context/inner-observer the-struct_37)
+ (expand-context/inner-for-serializable? the-struct_37)
+ (expand-context/inner-to-correlated-linklet? the-struct_37)
+ (expand-context/inner-normalize-locals? the-struct_37)
+ (expand-context/inner-parsing-expanded? the-struct_37)
+ (expand-context/inner-skip-visit-available? the-struct_37)))
+ (raise-argument-error 'struct-copy "expand-context/inner?" the-struct_37)))))
(expand-context/outer1.1
inner29_0
post-expansion25_0
use-site-scopes26_0
frame-id27_0
- (expand-context/outer-context the-struct_35)
- (expand-context/outer-env the-struct_35)
- (expand-context/outer-scopes the-struct_35)
- (expand-context/outer-def-ctx-scopes the-struct_35)
+ (expand-context/outer-context the-struct_36)
+ (expand-context/outer-env the-struct_36)
+ (expand-context/outer-scopes the-struct_36)
+ (expand-context/outer-def-ctx-scopes the-struct_36)
binding-layer28_0
- (expand-context/outer-reference-records the-struct_35)
- (expand-context/outer-only-immediate? the-struct_35)
- (expand-context/outer-need-eventually-defined the-struct_35)
- (expand-context/outer-current-introduction-scopes the-struct_35)
- (expand-context/outer-current-use-scopes the-struct_35)
- (expand-context/outer-name the-struct_35)))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_35)))))))
+ (expand-context/outer-reference-records the-struct_36)
+ (expand-context/outer-only-immediate? the-struct_36)
+ (expand-context/outer-need-eventually-defined the-struct_36)
+ (expand-context/outer-current-introduction-scopes the-struct_36)
+ (expand-context/outer-current-use-scopes the-struct_36)
+ (expand-context/outer-name the-struct_36)))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_36)))))))
(define-values (default-val.1$1) #f)
(define-values
(current-expand-context)
@@ -16792,85 +16863,81 @@
(lambda (fail-ok?15_0 who17_0)
(begin
'get-current-expand-context
- (let-values (((who_10) who17_0))
+ (let-values (((who_17) who17_0))
(let-values (((fail-ok?_0) fail-ok?15_0))
- (let-values ()
- (let-values (((or-part_51) (force (current-expand-context))))
- (if or-part_51
- or-part_51
- (if fail-ok?_0 #f (raise-arguments-error who_10 "not currently expanding"))))))))))
+ (let-values (((or-part_261) (force (current-expand-context))))
+ (if or-part_261
+ or-part_261
+ (if fail-ok?_0 #f (raise-arguments-error who_17 "not currently expanding")))))))))
(define-values
(current-expand-observe)
(make-parameter
#f
- (lambda (v_119)
+ (lambda (v_162)
(begin
- (if (let-values (((or-part_94) (not v_119)))
- (if or-part_94 or-part_94 (if (procedure? v_119) (procedure-arity-includes? v_119 2) #f)))
+ (if (let-values (((or-part_262) (not v_162)))
+ (if or-part_262 or-part_262 (if (procedure? v_162) (procedure-arity-includes? v_162 2) #f)))
(void)
- (let-values ()
- (raise-argument-error 'current-expand-observe "(or/c (procedure-arity-includes/c 2) #f)" v_119)))
- v_119))
+ (raise-argument-error 'current-expand-observe "(or/c (procedure-arity-includes/c 2) #f)" v_162))
+ v_162))
'current-expand-observe))
(define-values
(as-expression-context)
(lambda (ctx_2)
(begin
(if (if (eq? 'expression (expand-context-context ctx_2)) (not (expand-context-name ctx_2)) #f)
- (let-values () ctx_2)
- (let-values ()
- (let-values (((v_120) ctx_2))
- (let-values (((the-struct_37) v_120))
- (if (expand-context/outer? the-struct_37)
- (let-values (((context37_0) 'expression)
- ((name38_0) #f)
- ((post-expansion39_0) #f)
- ((inner40_0) (root-expand-context/outer-inner v_120)))
- (expand-context/outer1.1
- inner40_0
- post-expansion39_0
- (root-expand-context/outer-use-site-scopes the-struct_37)
- (root-expand-context/outer-frame-id the-struct_37)
- context37_0
- (expand-context/outer-env the-struct_37)
- (expand-context/outer-scopes the-struct_37)
- (expand-context/outer-def-ctx-scopes the-struct_37)
- (expand-context/outer-binding-layer the-struct_37)
- (expand-context/outer-reference-records the-struct_37)
- (expand-context/outer-only-immediate? the-struct_37)
- (expand-context/outer-need-eventually-defined the-struct_37)
- (expand-context/outer-current-introduction-scopes the-struct_37)
- (expand-context/outer-current-use-scopes the-struct_37)
- name38_0))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_37)))))))))
+ ctx_2
+ (let-values (((v_163) ctx_2))
+ (let-values (((the-struct_38) v_163))
+ (if (expand-context/outer? the-struct_38)
+ (let-values (((context37_0) 'expression)
+ ((name38_0) #f)
+ ((post-expansion39_0) #f)
+ ((inner40_0) (root-expand-context/outer-inner v_163)))
+ (expand-context/outer1.1
+ inner40_0
+ post-expansion39_0
+ (root-expand-context/outer-use-site-scopes the-struct_38)
+ (root-expand-context/outer-frame-id the-struct_38)
+ context37_0
+ (expand-context/outer-env the-struct_38)
+ (expand-context/outer-scopes the-struct_38)
+ (expand-context/outer-def-ctx-scopes the-struct_38)
+ (expand-context/outer-binding-layer the-struct_38)
+ (expand-context/outer-reference-records the-struct_38)
+ (expand-context/outer-only-immediate? the-struct_38)
+ (expand-context/outer-need-eventually-defined the-struct_38)
+ (expand-context/outer-current-introduction-scopes the-struct_38)
+ (expand-context/outer-current-use-scopes the-struct_38)
+ name38_0))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_38))))))))
(define-values
(as-begin-expression-context)
(lambda (ctx_3)
(begin
(if (not (expand-context-name ctx_3))
- (let-values () ctx_3)
- (let-values ()
- (let-values (((v_121) ctx_3))
- (let-values (((the-struct_38) v_121))
- (if (expand-context/outer? the-struct_38)
- (let-values (((name41_0) #f) ((inner42_0) (root-expand-context/outer-inner v_121)))
- (expand-context/outer1.1
- inner42_0
- (root-expand-context/outer-post-expansion the-struct_38)
- (root-expand-context/outer-use-site-scopes the-struct_38)
- (root-expand-context/outer-frame-id the-struct_38)
- (expand-context/outer-context the-struct_38)
- (expand-context/outer-env the-struct_38)
- (expand-context/outer-scopes the-struct_38)
- (expand-context/outer-def-ctx-scopes the-struct_38)
- (expand-context/outer-binding-layer the-struct_38)
- (expand-context/outer-reference-records the-struct_38)
- (expand-context/outer-only-immediate? the-struct_38)
- (expand-context/outer-need-eventually-defined the-struct_38)
- (expand-context/outer-current-introduction-scopes the-struct_38)
- (expand-context/outer-current-use-scopes the-struct_38)
- name41_0))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_38)))))))))
+ ctx_3
+ (let-values (((v_164) ctx_3))
+ (let-values (((the-struct_39) v_164))
+ (if (expand-context/outer? the-struct_39)
+ (let-values (((name41_0) #f) ((inner42_0) (root-expand-context/outer-inner v_164)))
+ (expand-context/outer1.1
+ inner42_0
+ (root-expand-context/outer-post-expansion the-struct_39)
+ (root-expand-context/outer-use-site-scopes the-struct_39)
+ (root-expand-context/outer-frame-id the-struct_39)
+ (expand-context/outer-context the-struct_39)
+ (expand-context/outer-env the-struct_39)
+ (expand-context/outer-scopes the-struct_39)
+ (expand-context/outer-def-ctx-scopes the-struct_39)
+ (expand-context/outer-binding-layer the-struct_39)
+ (expand-context/outer-reference-records the-struct_39)
+ (expand-context/outer-only-immediate? the-struct_39)
+ (expand-context/outer-need-eventually-defined the-struct_39)
+ (expand-context/outer-current-introduction-scopes the-struct_39)
+ (expand-context/outer-current-use-scopes the-struct_39)
+ name41_0))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_39))))))))
(define-values
(as-tail-context.1)
(lambda (wrt19_0 ctx21_0)
@@ -16878,119 +16945,116 @@
'as-tail-context
(let-values (((ctx_4) ctx21_0))
(let-values (((wrt-ctx_0) wrt19_0))
- (let-values ()
- (if (expand-context-name wrt-ctx_0)
- (let-values ()
- (let-values (((v_122) ctx_4))
- (let-values (((the-struct_39) v_122))
- (if (expand-context/outer? the-struct_39)
- (let-values (((name43_0) (expand-context-name wrt-ctx_0))
- ((inner44_0) (root-expand-context/outer-inner v_122)))
- (expand-context/outer1.1
- inner44_0
- (root-expand-context/outer-post-expansion the-struct_39)
- (root-expand-context/outer-use-site-scopes the-struct_39)
- (root-expand-context/outer-frame-id the-struct_39)
- (expand-context/outer-context the-struct_39)
- (expand-context/outer-env the-struct_39)
- (expand-context/outer-scopes the-struct_39)
- (expand-context/outer-def-ctx-scopes the-struct_39)
- (expand-context/outer-binding-layer the-struct_39)
- (expand-context/outer-reference-records the-struct_39)
- (expand-context/outer-only-immediate? the-struct_39)
- (expand-context/outer-need-eventually-defined the-struct_39)
- (expand-context/outer-current-introduction-scopes the-struct_39)
- (expand-context/outer-current-use-scopes the-struct_39)
- name43_0))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_39)))))
- (let-values () ctx_4))))))))
+ (if (expand-context-name wrt-ctx_0)
+ (let-values (((v_165) ctx_4))
+ (let-values (((the-struct_40) v_165))
+ (if (expand-context/outer? the-struct_40)
+ (let-values (((name43_0) (expand-context-name wrt-ctx_0))
+ ((inner44_0) (root-expand-context/outer-inner v_165)))
+ (expand-context/outer1.1
+ inner44_0
+ (root-expand-context/outer-post-expansion the-struct_40)
+ (root-expand-context/outer-use-site-scopes the-struct_40)
+ (root-expand-context/outer-frame-id the-struct_40)
+ (expand-context/outer-context the-struct_40)
+ (expand-context/outer-env the-struct_40)
+ (expand-context/outer-scopes the-struct_40)
+ (expand-context/outer-def-ctx-scopes the-struct_40)
+ (expand-context/outer-binding-layer the-struct_40)
+ (expand-context/outer-reference-records the-struct_40)
+ (expand-context/outer-only-immediate? the-struct_40)
+ (expand-context/outer-need-eventually-defined the-struct_40)
+ (expand-context/outer-current-introduction-scopes the-struct_40)
+ (expand-context/outer-current-use-scopes the-struct_40)
+ name43_0))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_40))))
+ ctx_4))))))
(define-values
(as-named-context)
(lambda (ctx_5 ids_2)
(begin
(if (if (pair? ids_2) (null? (cdr ids_2)) #f)
- (let-values ()
- (let-values (((v_123) ctx_5))
- (let-values (((the-struct_40) v_123))
- (if (expand-context/outer? the-struct_40)
- (let-values (((name45_0) (car ids_2)) ((inner46_0) (root-expand-context/outer-inner v_123)))
- (expand-context/outer1.1
- inner46_0
- (root-expand-context/outer-post-expansion the-struct_40)
- (root-expand-context/outer-use-site-scopes the-struct_40)
- (root-expand-context/outer-frame-id the-struct_40)
- (expand-context/outer-context the-struct_40)
- (expand-context/outer-env the-struct_40)
- (expand-context/outer-scopes the-struct_40)
- (expand-context/outer-def-ctx-scopes the-struct_40)
- (expand-context/outer-binding-layer the-struct_40)
- (expand-context/outer-reference-records the-struct_40)
- (expand-context/outer-only-immediate? the-struct_40)
- (expand-context/outer-need-eventually-defined the-struct_40)
- (expand-context/outer-current-introduction-scopes the-struct_40)
- (expand-context/outer-current-use-scopes the-struct_40)
- name45_0))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_40)))))
- (let-values () ctx_5)))))
+ (let-values (((v_166) ctx_5))
+ (let-values (((the-struct_41) v_166))
+ (if (expand-context/outer? the-struct_41)
+ (let-values (((name45_0) (car ids_2)) ((inner46_0) (root-expand-context/outer-inner v_166)))
+ (expand-context/outer1.1
+ inner46_0
+ (root-expand-context/outer-post-expansion the-struct_41)
+ (root-expand-context/outer-use-site-scopes the-struct_41)
+ (root-expand-context/outer-frame-id the-struct_41)
+ (expand-context/outer-context the-struct_41)
+ (expand-context/outer-env the-struct_41)
+ (expand-context/outer-scopes the-struct_41)
+ (expand-context/outer-def-ctx-scopes the-struct_41)
+ (expand-context/outer-binding-layer the-struct_41)
+ (expand-context/outer-reference-records the-struct_41)
+ (expand-context/outer-only-immediate? the-struct_41)
+ (expand-context/outer-need-eventually-defined the-struct_41)
+ (expand-context/outer-current-introduction-scopes the-struct_41)
+ (expand-context/outer-current-use-scopes the-struct_41)
+ name45_0))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_41))))
+ ctx_5))))
(define-values
(as-to-parsed-context)
(lambda (ctx_6)
(begin
- (let-values (((v_124) ctx_6))
- (let-values (((the-struct_41) v_124))
- (if (expand-context/outer? the-struct_41)
+ (let-values (((v_167) ctx_6))
+ (let-values (((the-struct_42) v_167))
+ (if (expand-context/outer? the-struct_42)
(let-values (((inner47_0)
- (let-values (((the-struct_42) (root-expand-context/outer-inner v_124)))
- (if (expand-context/inner? the-struct_42)
+ (let-values (((the-struct_43) (root-expand-context/outer-inner v_167)))
+ (if (expand-context/inner? the-struct_43)
(let-values (((to-parsed?48_0) #t) ((observer49_0) #f) ((parsing-expanded?50_0) #t))
(expand-context/inner2.1
- (root-expand-context/inner-self-mpi the-struct_42)
- (root-expand-context/inner-module-scopes the-struct_42)
- (root-expand-context/inner-top-level-bind-scope the-struct_42)
- (root-expand-context/inner-all-scopes-stx the-struct_42)
- (root-expand-context/inner-defined-syms the-struct_42)
- (root-expand-context/inner-counter the-struct_42)
- (root-expand-context/inner-lift-key the-struct_42)
+ (root-expand-context/inner-self-mpi the-struct_43)
+ (root-expand-context/inner-module-scopes the-struct_43)
+ (root-expand-context/inner-top-level-bind-scope the-struct_43)
+ (root-expand-context/inner-all-scopes-stx the-struct_43)
+ (root-expand-context/inner-defined-syms the-struct_43)
+ (root-expand-context/inner-counter the-struct_43)
+ (root-expand-context/inner-lift-key the-struct_43)
to-parsed?48_0
- (expand-context/inner-phase the-struct_42)
- (expand-context/inner-namespace the-struct_42)
- (expand-context/inner-just-once? the-struct_42)
- (expand-context/inner-module-begin-k the-struct_42)
- (expand-context/inner-allow-unbound? the-struct_42)
- (expand-context/inner-in-local-expand? the-struct_42)
- (expand-context/inner-keep-#%expression? the-struct_42)
- (expand-context/inner-stops the-struct_42)
- (expand-context/inner-declared-submodule-names the-struct_42)
- (expand-context/inner-lifts the-struct_42)
- (expand-context/inner-lift-envs the-struct_42)
- (expand-context/inner-module-lifts the-struct_42)
- (expand-context/inner-require-lifts the-struct_42)
- (expand-context/inner-to-module-lifts the-struct_42)
- (expand-context/inner-requires+provides the-struct_42)
+ (expand-context/inner-phase the-struct_43)
+ (expand-context/inner-namespace the-struct_43)
+ (expand-context/inner-just-once? the-struct_43)
+ (expand-context/inner-module-begin-k the-struct_43)
+ (expand-context/inner-allow-unbound? the-struct_43)
+ (expand-context/inner-in-local-expand? the-struct_43)
+ (expand-context/inner-keep-#%expression? the-struct_43)
+ (expand-context/inner-stops the-struct_43)
+ (expand-context/inner-declared-submodule-names the-struct_43)
+ (expand-context/inner-lifts the-struct_43)
+ (expand-context/inner-lift-envs the-struct_43)
+ (expand-context/inner-module-lifts the-struct_43)
+ (expand-context/inner-require-lifts the-struct_43)
+ (expand-context/inner-to-module-lifts the-struct_43)
+ (expand-context/inner-requires+provides the-struct_43)
observer49_0
- (expand-context/inner-for-serializable? the-struct_42)
- (expand-context/inner-to-correlated-linklet? the-struct_42)
- (expand-context/inner-normalize-locals? the-struct_42)
+ (expand-context/inner-for-serializable? the-struct_43)
+ (expand-context/inner-to-correlated-linklet? the-struct_43)
+ (expand-context/inner-normalize-locals? the-struct_43)
parsing-expanded?50_0
- (expand-context/inner-skip-visit-available? the-struct_42)))
- (raise-argument-error 'struct-copy "expand-context/inner?" the-struct_42)))))
+ (expand-context/inner-skip-visit-available? the-struct_43)))
+ (raise-argument-error 'struct-copy "expand-context/inner?" the-struct_43)))))
(expand-context/outer1.1
inner47_0
- (root-expand-context/outer-post-expansion the-struct_41)
- (root-expand-context/outer-use-site-scopes the-struct_41)
- (root-expand-context/outer-frame-id the-struct_41)
- (expand-context/outer-context the-struct_41)
- (expand-context/outer-env the-struct_41)
- (expand-context/outer-scopes the-struct_41)
- (expand-context/outer-def-ctx-scopes the-struct_41)
- (expand-context/outer-binding-layer the-struct_41)
- (expand-context/outer-reference-records the-struct_41)
- (expand-context/outer-only-immediate? the-struct_41)
- (expand-context/outer-need-eventually-defined the-struct_41)
- (expand-context/outer-current-introduction-scopes the-struct_41)
- (expand-context/outer-current-use-scopes the-struct_41)
- (expand-context/outer-name the-struct_41)))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_41)))))))
+ (root-expand-context/outer-post-expansion the-struct_42)
+ (root-expand-context/outer-use-site-scopes the-struct_42)
+ (root-expand-context/outer-frame-id the-struct_42)
+ (expand-context/outer-context the-struct_42)
+ (expand-context/outer-env the-struct_42)
+ (expand-context/outer-scopes the-struct_42)
+ (expand-context/outer-def-ctx-scopes the-struct_42)
+ (expand-context/outer-binding-layer the-struct_42)
+ (expand-context/outer-reference-records the-struct_42)
+ (expand-context/outer-only-immediate? the-struct_42)
+ (expand-context/outer-need-eventually-defined the-struct_42)
+ (expand-context/outer-current-introduction-scopes the-struct_42)
+ (expand-context/outer-current-use-scopes the-struct_42)
+ (expand-context/outer-name the-struct_42)))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_42)))))))
(call-with-values
(lambda ()
(set-current-previously-unbound!
@@ -17001,988 +17065,922 @@
print-values)
(define-values
(to-syntax-list.1)
- (lambda (s_183)
+ (lambda (s_219)
(begin
'to-syntax-list
- (if (list? s_183)
- (let-values () s_183)
- (if (pair? s_183)
- (let-values () (let-values (((r_25) (to-syntax-list.1 (cdr s_183)))) (if r_25 (cons (car s_183) r_25) #f)))
- (if (syntax?$1 s_183) (let-values () (to-syntax-list.1 (syntax-e$1 s_183))) (let-values () #f)))))))
+ (if (list? s_219)
+ s_219
+ (if (pair? s_219)
+ (let-values (((r_29) (to-syntax-list.1 (cdr s_219)))) (if r_29 (cons (car s_219) r_29) #f))
+ (if (syntax?$1 s_219) (to-syntax-list.1 (syntax-e$1 s_219)) #f))))))
(define-values
(syntax-debug-info$1)
- (lambda (s_0 phase_52 all-bindings?_0)
+ (lambda (s_220 phase_60 all-bindings?_0)
(begin
'syntax-debug-info
(let-values (((hts_0)
(reverse$1
- (let-values (((lst_86) (fallback->list (syntax-shifted-multi-scopes s_0))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_86)))
- ((letrec-values (((for-loop_101)
- (lambda (fold-var_65 lst_87)
- (begin
- 'for-loop
- (if (pair? lst_87)
- (let-values (((smss_2) (unsafe-car lst_87))
- ((rest_41) (unsafe-cdr lst_87)))
- (let-values (((fold-var_66)
- (let-values (((fold-var_67) fold-var_65))
- (let-values (((fold-var_68)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((init-ht_0)
- (if (identifier?
- s_0)
- (hasheq
- 'name
- (syntax-e$1 s_0))
- '#hasheq())))
- (let-values (((s-scs_0)
- (scope-set-at-fallback
- s_0
- smss_2
- phase_52)))
- (let-values (((context_1)
- (scope-set->context
- s-scs_0)))
- (let-values (((context-ht_0)
- (hash-set
- init-ht_0
- 'context
- context_1)))
- (let-values (((sym_18)
- (syntax-e$1
- s_0)))
- (let-values (((classify-binding_0)
- (lambda (b_48)
- (begin
- 'classify-binding
- (if (local-binding?
- b_48)
- (let-values ()
- 'local)
- (if (like-ambiguous-binding?
- b_48)
- (let-values ()
- 'ambiguous)
- (let-values ()
- 'module)))))))
- (let-values (((extract-binding_0)
- (lambda (b_11)
- (begin
- 'extract-binding
- (if (local-binding?
- b_11)
- (let-values ()
- (local-binding-key
- b_11))
- (if (like-ambiguous-binding?
- b_11)
- (let-values ()
- #t)
- (let-values ()
- (vector
- (module-binding-sym
- b_11)
- (module-binding-module
- b_11)
- (module-binding-phase
- b_11)))))))))
- (let-values (((bindings_0)
- (append
- (if (identifier?
- s_0)
- (let-values ()
- (let-values (((bindings_1
- covered-scopess_0)
- (let-values (((ht_79)
- s-scs_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-immutable-hash-keys
- ht_79)))
- ((letrec-values (((for-loop_102)
- (lambda (bindings_2
- covered-scope-sets_0
- i_91)
- (begin
- 'for-loop
- (if i_91
- (let-values (((sc_28)
- (unsafe-immutable-hash-iterate-key
- ht_79
- i_91)))
- (let-values (((bindings_3
- covered-scope-sets_1)
- (let-values (((ht_31
- bulk-bindings_3)
- (let-values (((table_113)
- (scope-binding-table
- sc_28)))
- (if (hash?
- table_113)
- (values
- (hash-ref
- table_113
- sym_18
- '#hash())
- null)
- (values
- (hash-ref
- (table-with-bulk-bindings-syms
- table_113)
- sym_18
- '#hash())
- (table-with-bulk-bindings-bulk-bindings
- table_113)))))
- ((s_177)
- s_0)
- ((extra-shifts_9)
- null))
- (begin
- #t
- ((letrec-values (((for-loop_103)
- (lambda (bindings_4
- covered-scope-sets_2
- i_92)
- (begin
- 'for-loop
- (if (not
- (null?
- i_92))
- (let-values (((scs_17)
- (if (pair?
- i_92)
- (let-values ()
- (bulk-binding-at-scopes
- (car
- i_92)))
- (let-values ()
- (hash-iterate-key
- ht_31
- i_92))))
- ((b_64)
- (if (pair?
- i_92)
- (let-values ()
- (let-values (((bulk_4)
- (bulk-binding-at-bulk
- (car
- i_92))))
- (let-values (((b-info_1)
- (if (symbol-interned?
- sym_18)
- (hash-ref
- (bulk-binding-symbols
- bulk_4
- s_177
- extra-shifts_9)
- sym_18
- #f)
- #f)))
- (if b-info_1
- ((bulk-binding-create
- bulk_4)
- bulk_4
- b-info_1
- sym_18)
- #f))))
- (let-values ()
- (hash-iterate-value
- ht_31
- i_92)))))
- (let-values (((bindings_5
- covered-scope-sets_3)
- (let-values (((bindings_6)
- bindings_4)
- ((covered-scope-sets_4)
- covered-scope-sets_2))
- (if (if scs_17
- (if b_64
- (not
- (set-member?
- covered-scope-sets_4
- scs_17))
- #f)
- #f)
- (let-values (((bindings_7)
- bindings_6)
- ((covered-scope-sets_5)
- covered-scope-sets_4))
- (let-values (((bindings_8
- covered-scope-sets_6)
- (let-values ()
- (values
- (cons
- (hasheq
- 'name
- (syntax-e$1
- s_0)
- 'context
- (scope-set->context
- scs_17)
- 'match?
- (subset?
- scs_17
- s-scs_0)
- (classify-binding_0
- b_64)
- (extract-binding_0
- b_64))
- bindings_7)
- (set-add
- covered-scope-sets_5
- scs_17)))))
- (values
- bindings_8
- covered-scope-sets_6)))
- (values
- bindings_6
- covered-scope-sets_4)))))
- (if (not
- #f)
- (for-loop_103
- bindings_5
- covered-scope-sets_3
- (if (pair?
- i_92)
- (let-values ()
- (cdr
- i_92))
- (let-values ()
- (let-values (((or-part_36)
- (hash-iterate-next
- ht_31
- i_92)))
- (if or-part_36
- or-part_36
- bulk-bindings_3)))))
- (values
- bindings_5
- covered-scope-sets_3))))
- (values
- bindings_4
- covered-scope-sets_2))))))
- for-loop_103)
- bindings_2
- covered-scope-sets_0
- (let-values (((or-part_37)
- (hash-iterate-first
- ht_31)))
- (if or-part_37
- or-part_37
- bulk-bindings_3)))))))
- (if (not
- #f)
- (for-loop_102
- bindings_3
- covered-scope-sets_1
- (unsafe-immutable-hash-iterate-next
- ht_79
- i_91))
- (values
- bindings_3
- covered-scope-sets_1))))
- (values
- bindings_2
- covered-scope-sets_0))))))
- for-loop_102)
- null
- (set)
- (unsafe-immutable-hash-iterate-first
- ht_79))))))
- bindings_1))
- (let-values ()
- null))
- (if all-bindings?_0
- (let-values ()
- (reverse$1
- (let-values (((ht_80)
- s-scs_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-immutable-hash-keys
- ht_80)))
- ((letrec-values (((for-loop_104)
- (lambda (fold-var_69
- i_93)
- (begin
- 'for-loop
- (if i_93
- (let-values (((sc_29)
- (unsafe-immutable-hash-iterate-key
- ht_80
- i_93)))
- (let-values (((fold-var_70)
- (let-values (((fold-var_71)
- fold-var_69))
- (let-values (((sym-ht_1)
- (let-values (((table_114)
- (scope-binding-table
- sc_29)))
- (if (hash?
- table_114)
- table_114
- (table-with-bulk-bindings-syms
- table_114)))))
- (begin
- #t
- ((letrec-values (((for-loop_105)
- (lambda (fold-var_72
- state_25)
- (begin
- 'for-loop
- (if (car
- state_25)
- (let-values (((o-sym_0)
- (vector-ref
- (car
- state_25)
- 1))
- ((scs_18)
- (hash-iterate-key
- (vector-ref
- (car
- state_25)
- 2)
- (cdr
- state_25)))
- ((b_65)
- (hash-iterate-value
- (vector-ref
- (car
- state_25)
- 2)
- (cdr
- state_25))))
- (let-values (((fold-var_73)
- (let-values (((fold-var_74)
- fold-var_72))
- (let-values (((fold-var_75)
- fold-var_74))
- (if (eq?
- o-sym_0
- sym_18)
- fold-var_75
- (let-values (((fold-var_76)
- fold-var_75))
- (let-values (((fold-var_77)
- (let-values ()
+ (let-values (((fold-var_120) (let-values (((fold-var_121) null)) fold-var_121)))
+ (let-values (((lst_129) (fallback->list (syntax-shifted-multi-scopes s_220))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_129))
+ ((letrec-values (((for-loop_125)
+ (lambda (fold-var_122 lst_130)
+ (begin
+ 'for-loop
+ (if (pair? lst_130)
+ (let-values (((smss_26) (unsafe-car lst_130))
+ ((rest_61) (unsafe-cdr lst_130)))
+ (let-values (((fold-var_123)
+ (let-values (((fold-var_124)
+ (cons
+ (let-values (((init-ht_0)
+ (if (identifier? s_220)
+ (hasheq
+ 'name
+ (syntax-e$1 s_220))
+ '#hasheq())))
+ (let-values (((s-scs_0)
+ (scope-set-at-fallback
+ s_220
+ smss_26
+ phase_60)))
+ (let-values (((context_1)
+ (scope-set->context
+ s-scs_0)))
+ (let-values (((context-ht_0)
+ (hash-set
+ init-ht_0
+ 'context
+ context_1)))
+ (let-values (((sym_38)
+ (syntax-e$1
+ s_220)))
+ (let-values (((classify-binding_0)
+ (lambda (b_84)
+ (begin
+ 'classify-binding
+ (if (local-binding?
+ b_84)
+ 'local
+ (if (like-ambiguous-binding?
+ b_84)
+ 'ambiguous
+ 'module))))))
+ (let-values (((extract-binding_0)
+ (lambda (b_85)
+ (begin
+ 'extract-binding
+ (if (local-binding?
+ b_85)
+ (local-binding-key
+ b_85)
+ (if (like-ambiguous-binding?
+ b_85)
+ #t
+ (vector
+ (module-binding-sym
+ b_85)
+ (module-binding-module
+ b_85)
+ (module-binding-phase
+ b_85))))))))
+ (let-values (((bindings_0)
+ (append
+ (if (identifier?
+ s_220)
+ (let-values (((bindings_1
+ covered-scopess_0)
+ (let-values (((bindings_2)
+ (let-values (((bindings_3)
+ null))
+ bindings_3))
+ ((covered-scope-sets_0)
+ (let-values (((covered-scope-sets_1)
+ (set)))
+ covered-scope-sets_1)))
+ (let-values (((ht_90)
+ s-scs_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys
+ ht_90))
+ ((letrec-values (((for-loop_126)
+ (lambda (bindings_4
+ covered-scope-sets_2
+ i_117)
+ (begin
+ 'for-loop
+ (if i_117
+ (let-values (((sc_31)
+ (unsafe-immutable-hash-iterate-key
+ ht_90
+ i_117)))
+ (let-values (((bindings_5
+ covered-scope-sets_3)
+ (let-values (((ht_91
+ bulk-bindings_4)
+ (let-values (((table_123)
+ (scope-binding-table
+ sc_31)))
+ (if (hash?
+ table_123)
+ (values
+ (hash-ref
+ table_123
+ sym_38
+ '#hash())
+ null)
+ (values
+ (hash-ref
+ (table-with-bulk-bindings-syms
+ table_123)
+ sym_38
+ '#hash())
+ (table-with-bulk-bindings-bulk-bindings
+ table_123)))))
+ ((s_221)
+ s_220)
+ ((extra-shifts_10)
+ null))
+ (begin
+ #t
+ ((letrec-values (((for-loop_127)
+ (lambda (bindings_6
+ covered-scope-sets_4
+ i_118)
+ (begin
+ 'for-loop
+ (if (not
+ (null?
+ i_118))
+ (let-values (((scs_19)
+ (if (pair?
+ i_118)
+ (bulk-binding-at-scopes
+ (car
+ i_118))
+ (hash-iterate-key
+ ht_91
+ i_118)))
+ ((b_86)
+ (if (pair?
+ i_118)
+ (let-values (((bulk_4)
+ (bulk-binding-at-bulk
+ (car
+ i_118))))
+ (let-values (((b-info_1)
+ (if (symbol-interned?
+ sym_38)
+ (hash-ref
+ (bulk-binding-symbols
+ bulk_4
+ s_221
+ extra-shifts_10)
+ sym_38
+ #f)
+ #f)))
+ (if b-info_1
+ ((bulk-binding-create
+ bulk_4)
+ bulk_4
+ b-info_1
+ sym_38)
+ #f)))
+ (hash-iterate-value
+ ht_91
+ i_118))))
+ (let-values (((bindings_7
+ covered-scope-sets_5)
+ (if (if scs_19
+ (if b_86
+ (not
+ (set-member?
+ covered-scope-sets_4
+ scs_19))
+ #f)
+ #f)
+ (let-values (((bindings_8
+ covered-scope-sets_6)
+ (values
(cons
- (let-values ()
- (hasheq
- 'name
- o-sym_0
- 'context
- (scope-set->context
- scs_18)
- 'match?
- #f
- (classify-binding_0
- b_65)
- (extract-binding_0
- b_65)))
- fold-var_76))))
- (values
- fold-var_77))))))))
- (if (not
- #f)
- (for-loop_105
- fold-var_73
- (let-values (((ht_81)
- (vector-ref
- (car
- state_25)
- 2)))
- (let-values (((i_94)
- (hash-iterate-next
- ht_81
- (cdr
- state_25))))
- (if i_94
- (cons
- (car
- state_25)
- i_94)
- (next-state-in-full-binding-table
- sym-ht_1
- (hash-iterate-next
- sym-ht_1
+ (hasheq
+ 'name
+ (syntax-e$1
+ s_220)
+ 'context
+ (scope-set->context
+ scs_19)
+ 'match?
+ (subset?
+ scs_19
+ s-scs_0)
+ 'via
+ (scope-id
+ sc_31)
+ (classify-binding_0
+ b_86)
+ (extract-binding_0
+ b_86))
+ bindings_6)
+ (set-add
+ covered-scope-sets_4
+ scs_19))))
+ (values
+ bindings_8
+ covered-scope-sets_6))
+ (values
+ bindings_6
+ covered-scope-sets_4))))
+ (if (not
+ #f)
+ (for-loop_127
+ bindings_7
+ covered-scope-sets_5
+ (if (pair?
+ i_118)
+ (cdr
+ i_118)
+ (let-values (((or-part_263)
+ (hash-iterate-next
+ ht_91
+ i_118)))
+ (if or-part_263
+ or-part_263
+ bulk-bindings_4))))
+ (values
+ bindings_7
+ covered-scope-sets_5))))
+ (values
+ bindings_6
+ covered-scope-sets_4))))))
+ for-loop_127)
+ bindings_4
+ covered-scope-sets_2
+ (let-values (((or-part_264)
+ (hash-iterate-first
+ ht_91)))
+ (if or-part_264
+ or-part_264
+ bulk-bindings_4)))))))
+ (if (not
+ #f)
+ (for-loop_126
+ bindings_5
+ covered-scope-sets_3
+ (unsafe-immutable-hash-iterate-next
+ ht_90
+ i_117))
+ (values
+ bindings_5
+ covered-scope-sets_3))))
+ (values
+ bindings_4
+ covered-scope-sets_2))))))
+ for-loop_126)
+ bindings_2
+ covered-scope-sets_0
+ (unsafe-immutable-hash-iterate-first
+ ht_90)))))))
+ bindings_1)
+ null)
+ (if all-bindings?_0
+ (reverse$1
+ (let-values (((fold-var_125)
+ (let-values (((fold-var_126)
+ null))
+ fold-var_126)))
+ (let-values (((ht_92)
+ s-scs_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys
+ ht_92))
+ ((letrec-values (((for-loop_128)
+ (lambda (fold-var_127
+ i_119)
+ (begin
+ 'for-loop
+ (if i_119
+ (let-values (((sc_32)
+ (unsafe-immutable-hash-iterate-key
+ ht_92
+ i_119)))
+ (let-values (((fold-var_128)
+ (let-values (((sym-ht_1)
+ (let-values (((table_124)
+ (scope-binding-table
+ sc_32)))
+ (if (hash?
+ table_124)
+ table_124
+ (table-with-bulk-bindings-syms
+ table_124)))))
+ (begin
+ #t
+ ((letrec-values (((for-loop_129)
+ (lambda (fold-var_129
+ state_27)
+ (begin
+ 'for-loop
+ (if (car
+ state_27)
+ (let-values (((o-sym_0)
+ (vector-ref
+ (car
+ state_27)
+ 1))
+ ((scs_20)
+ (hash-iterate-key
+ (vector-ref
+ (car
+ state_27)
+ 2)
+ (cdr
+ state_27)))
+ ((b_87)
+ (hash-iterate-value
+ (vector-ref
+ (car
+ state_27)
+ 2)
+ (cdr
+ state_27))))
+ (let-values (((fold-var_130)
+ (if (eq?
+ o-sym_0
+ sym_38)
+ fold-var_129
+ (let-values (((fold-var_131)
+ (cons
+ (hasheq
+ 'name
+ o-sym_0
+ 'context
+ (scope-set->context
+ scs_20)
+ 'match?
+ #f
+ (classify-binding_0
+ b_87)
+ (extract-binding_0
+ b_87))
+ fold-var_129)))
+ (values
+ fold-var_131)))))
+ (if (not
+ #f)
+ (for-loop_129
+ fold-var_130
+ (let-values (((ht_93)
(vector-ref
(car
- state_25)
- 0)))))))
- fold-var_73)))
- fold-var_72)))))
- for-loop_105)
- fold-var_71
- ((letrec-values (((loop_47)
- (lambda (sym-i_1)
- (begin
- 'loop
- (if sym-i_1
- (next-state-in-full-binding-table
- sym-ht_1
- sym-i_1)
- '(#f
- .
- #f))))))
- loop_47)
- (hash-iterate-first
- sym-ht_1))))))))
- (if (not
- #f)
- (for-loop_104
- fold-var_70
- (unsafe-immutable-hash-iterate-next
- ht_80
- i_93))
- fold-var_70)))
- fold-var_69)))))
- for-loop_104)
- null
- (unsafe-immutable-hash-iterate-first
- ht_80))))))
- (let-values ()
- null)))))
- (if (null?
- bindings_0)
- context-ht_0
- (hash-set
- context-ht_0
- 'bindings
- bindings_0)))))))))))
- fold-var_67))))
- (values fold-var_68)))))
- (if (not #f) (for-loop_101 fold-var_66 rest_41) fold-var_66)))
- fold-var_65)))))
- for-loop_101)
- null
- lst_86))))))
- (let-values (((ht_75) (car hts_0))) (if (null? (cdr hts_0)) ht_75 (hash-set ht_75 'fallbacks (cdr hts_0))))))))
+ state_27)
+ 2)))
+ (let-values (((i_120)
+ (hash-iterate-next
+ ht_93
+ (cdr
+ state_27))))
+ (if i_120
+ (cons
+ (car
+ state_27)
+ i_120)
+ (next-state-in-full-binding-table
+ sym-ht_1
+ (hash-iterate-next
+ sym-ht_1
+ (vector-ref
+ (car
+ state_27)
+ 0)))))))
+ fold-var_130)))
+ fold-var_129)))))
+ for-loop_129)
+ fold-var_127
+ ((letrec-values (((loop_79)
+ (lambda (sym-i_1)
+ (begin
+ 'loop
+ (if sym-i_1
+ (next-state-in-full-binding-table
+ sym-ht_1
+ sym-i_1)
+ '(#f
+ .
+ #f))))))
+ loop_79)
+ (hash-iterate-first
+ sym-ht_1)))))))
+ (if (not
+ #f)
+ (for-loop_128
+ fold-var_128
+ (unsafe-immutable-hash-iterate-next
+ ht_92
+ i_119))
+ fold-var_128)))
+ fold-var_127)))))
+ for-loop_128)
+ fold-var_125
+ (unsafe-immutable-hash-iterate-first
+ ht_92))))))
+ null))))
+ (if (null? bindings_0)
+ context-ht_0
+ (hash-set
+ context-ht_0
+ 'bindings
+ bindings_0))))))))))
+ fold-var_122)))
+ (values fold-var_124))))
+ (if (not #f) (for-loop_125 fold-var_123 rest_61) fold-var_123)))
+ fold-var_122)))))
+ for-loop_125)
+ fold-var_120
+ lst_129)))))))
+ (let-values (((ht_94) (car hts_0))) (if (null? (cdr hts_0)) ht_94 (hash-set ht_94 'fallbacks (cdr hts_0))))))))
(define-values
(scope-set->context)
- (lambda (scs_19)
+ (lambda (scs_21)
(begin
(let-values (((temp1_0)
(reverse$1
- (let-values (((ht_66) scs_19))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_66)))
- ((letrec-values (((for-loop_83)
- (lambda (fold-var_21 i_83)
- (begin
- 'for-loop
- (if i_83
- (let-values (((sc_30) (unsafe-immutable-hash-iterate-key ht_66 i_83)))
- (let-values (((fold-var_78)
- (let-values (((fold-var_79) fold-var_21))
- (let-values (((fold-var_80)
- (let-values ()
- (cons
- (let-values ()
- (if (interned-scope? sc_30)
- (let-values ()
- (vector
- (scope-id sc_30)
- (scope-kind sc_30)
- (interned-scope-key sc_30)))
- (if (representative-scope?
- sc_30)
- (let-values ()
- (vector
- (scope-id sc_30)
- (scope-kind sc_30)
- (multi-scope-name
- (representative-scope-owner
- sc_30))))
- (let-values ()
- (vector
- (scope-id sc_30)
- (scope-kind sc_30))))))
- fold-var_79))))
- (values fold-var_80)))))
- (if (not #f)
- (for-loop_83
- fold-var_78
- (unsafe-immutable-hash-iterate-next ht_66 i_83))
- fold-var_78)))
- fold-var_21)))))
- for-loop_83)
- null
- (unsafe-immutable-hash-iterate-first ht_66))))))
+ (let-values (((fold-var_132) (let-values (((fold-var_133) null)) fold-var_133)))
+ (let-values (((ht_95) scs_21))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_95))
+ ((letrec-values (((for-loop_130)
+ (lambda (fold-var_134 i_121)
+ (begin
+ 'for-loop
+ (if i_121
+ (let-values (((sc_33)
+ (unsafe-immutable-hash-iterate-key ht_95 i_121)))
+ (let-values (((fold-var_135)
+ (let-values (((fold-var_136)
+ (cons
+ (if (interned-scope? sc_33)
+ (vector
+ (scope-id sc_33)
+ (scope-kind sc_33)
+ (interned-scope-key sc_33))
+ (if (representative-scope? sc_33)
+ (vector
+ (scope-id sc_33)
+ (scope-kind sc_33)
+ (multi-scope-name
+ (representative-scope-owner
+ sc_33)))
+ (vector
+ (scope-id sc_33)
+ (scope-kind sc_33))))
+ fold-var_134)))
+ (values fold-var_136))))
+ (if (not #f)
+ (for-loop_130
+ fold-var_135
+ (unsafe-immutable-hash-iterate-next ht_95 i_121))
+ fold-var_135)))
+ fold-var_134)))))
+ for-loop_130)
+ fold-var_132
+ (unsafe-immutable-hash-iterate-first ht_95)))))))
((<2_0) <)
- ((temp3_1) (lambda (v_110) (vector-ref v_110 0))))
+ ((temp3_1) (lambda (v_168) (vector-ref v_168 0))))
(sort.1 #f temp3_1 temp1_0 <2_0)))))
(define-values
(raise-ambiguous-error)
- (lambda (id_25 ctx_8)
+ (lambda (id_27 ctx_8)
(begin
(raise-syntax-error$1
#f
"identifier's binding is ambiguous"
- id_25
+ id_27
#f
null
- (syntax-debug-info-string id_25 ctx_8)))))
+ (syntax-debug-info-string id_27 ctx_8)))))
(define-values
(syntax-debug-info-string)
- (lambda (s_10 ctx_9)
+ (lambda (s_222 ctx_9)
(begin
- (let-values (((info_2) (syntax-debug-info$1 s_10 (expand-context-phase ctx_9) #f)))
+ (let-values (((info_3) (syntax-debug-info$1 s_222 (expand-context-phase ctx_9) #f)))
(if (not
- (let-values (((or-part_31) (pair? (hash-ref info_2 'bindings null))))
- (if or-part_31
- or-part_31
- (let-values (((lst_88) (hash-ref info_2 'fallbacks null)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_88)))
- ((letrec-values (((for-loop_106)
- (lambda (result_61 lst_89)
- (begin
- 'for-loop
- (if (pair? lst_89)
- (let-values (((fb-info_0) (unsafe-car lst_89))
- ((rest_42) (unsafe-cdr lst_89)))
- (let-values (((result_1)
- (let-values ()
- (let-values (((result_62)
- (let-values ()
- (let-values ()
- (pair?
- (hash-ref
- fb-info_0
- 'bindings
- null))))))
- (values result_62)))))
- (if (if (not ((lambda x_38 result_1) fb-info_0)) (not #f) #f)
- (for-loop_106 result_1 rest_42)
- result_1)))
- result_61)))))
- for-loop_106)
- #f
- lst_88))))))
- (let-values () "")
- (let-values ()
- (let-values (((relevant-scope-sets_0)
- ((letrec-values (((loop_76)
- (lambda (info_3 layer_0)
- (begin
- 'loop
- (apply
- append
- (cons
- (hash-ref info_3 'context)
- (reverse$1
- (let-values (((lst_90) (hash-ref info_3 'bindings null)))
+ (let-values (((or-part_265) (pair? (hash-ref info_3 'bindings null))))
+ (if or-part_265
+ or-part_265
+ (let-values (((result_112) (let-values (((result_113) #f)) result_113)))
+ (let-values (((lst_131) (hash-ref info_3 'fallbacks null)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_131))
+ ((letrec-values (((for-loop_131)
+ (lambda (result_114 lst_132)
+ (begin
+ 'for-loop
+ (if (pair? lst_132)
+ (let-values (((fb-info_0) (unsafe-car lst_132))
+ ((rest_62) (unsafe-cdr lst_132)))
+ (let-values (((result_115)
+ (let-values (((result_116)
+ (pair?
+ (hash-ref fb-info_0 'bindings null))))
+ (values result_116))))
+ (if (if (not ((lambda x_42 result_115) fb-info_0)) (not #f) #f)
+ (for-loop_131 result_115 rest_62)
+ result_115)))
+ result_114)))))
+ for-loop_131)
+ result_112
+ lst_131)))))))
+ ""
+ (let-values (((relevant-scope-sets_0)
+ ((letrec-values (((loop_80)
+ (lambda (info_4 layer_0)
+ (begin
+ 'loop
+ (apply
+ append
+ (cons
+ (hash-ref info_4 'context)
+ (reverse$1
+ (let-values (((fold-var_137)
+ (let-values (((fold-var_138) null)) fold-var_138)))
+ (let-values (((lst_133) (hash-ref info_4 'bindings null)))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_90)))
- ((letrec-values (((for-loop_107)
- (lambda (fold-var_35 lst_91)
+ (check-list lst_133))
+ ((letrec-values (((for-loop_132)
+ (lambda (fold-var_139 lst_134)
(begin
'for-loop
- (if (pair? lst_91)
- (let-values (((b_66) (unsafe-car lst_91))
- ((rest_43)
- (unsafe-cdr lst_91)))
- (let-values (((fold-var_81)
- (let-values (((fold-var_82)
- fold-var_35))
- (let-values (((fold-var_29)
- (let-values ()
- (cons
- (let-values ()
- (hash-ref
- b_66
- 'context))
- fold-var_82))))
- (values
- fold-var_29)))))
+ (if (pair? lst_134)
+ (let-values (((b_88)
+ (unsafe-car lst_134))
+ ((rest_63)
+ (unsafe-cdr lst_134)))
+ (let-values (((fold-var_140)
+ (let-values (((fold-var_141)
+ (cons
+ (hash-ref
+ b_88
+ 'context)
+ fold-var_139)))
+ (values
+ fold-var_141))))
(if (not #f)
- (for-loop_107 fold-var_81 rest_43)
- fold-var_81)))
- fold-var_35)))))
- for-loop_107)
- null
- lst_90)))))
- (let-values (((fallbacks_0) (hash-ref info_3 'fallbacks null)))
- (reverse$1
- (let-values (((lst_92) fallbacks_0) ((start_17) (add1 layer_0)))
+ (for-loop_132 fold-var_140 rest_63)
+ fold-var_140)))
+ fold-var_139)))))
+ for-loop_132)
+ fold-var_137
+ lst_133))))))
+ (let-values (((fallbacks_0) (hash-ref info_4 'fallbacks null)))
+ (reverse$1
+ (let-values (((fold-var_142)
+ (let-values (((fold-var_143) null)) fold-var_143)))
+ (let-values (((lst_135) fallbacks_0) ((start_22) (add1 layer_0)))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_92)))
+ (check-list lst_135))
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-naturals start_17)))
- ((letrec-values (((for-loop_108)
- (lambda (fold-var_83 lst_93 pos_14)
+ (check-naturals start_22))
+ ((letrec-values (((for-loop_133)
+ (lambda (fold-var_144 lst_136 pos_24)
(begin
'for-loop
- (if (if (pair? lst_93) #t #f)
+ (if (if (pair? lst_136) #t #f)
(let-values (((fallback_0)
- (unsafe-car lst_93))
- ((rest_44)
- (unsafe-cdr lst_93))
- ((layer_1) pos_14))
- (let-values (((fold-var_84)
- (let-values (((fold-var_85)
- fold-var_83))
- (let-values (((fold-var_86)
- (let-values ()
- (cons
- (let-values ()
- (loop_76
- fallback_0
- layer_1))
- fold-var_85))))
- (values
- fold-var_86)))))
+ (unsafe-car lst_136))
+ ((rest_64)
+ (unsafe-cdr lst_136))
+ ((layer_1) pos_24))
+ (let-values (((fold-var_145)
+ (let-values (((fold-var_146)
+ (cons
+ (loop_80
+ fallback_0
+ layer_1)
+ fold-var_144)))
+ (values
+ fold-var_146))))
(if (not #f)
- (for-loop_108
- fold-var_84
- rest_44
- (+ pos_14 1))
- fold-var_84)))
- fold-var_83)))))
- for-loop_108)
- null
- lst_92
- start_17))))))))))
- loop_76)
- info_2
- 0)))
- (let-values (((common-scopes_0)
- (if (null? relevant-scope-sets_0)
- (set)
- (let-values (((lst_27) relevant-scope-sets_0))
+ (for-loop_133
+ fold-var_145
+ rest_64
+ (+ pos_24 1))
+ fold-var_145)))
+ fold-var_144)))))
+ for-loop_133)
+ fold-var_142
+ lst_135
+ start_22)))))))))))
+ loop_80)
+ info_3
+ 0)))
+ (let-values (((common-scopes_0)
+ (if (null? relevant-scope-sets_0)
+ (set)
+ (let-values (((s_223)
+ (let-values (((s_224) (list->set (car relevant-scope-sets_0)))) s_224)))
+ (let-values (((lst_137) relevant-scope-sets_0))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_27)))
- ((letrec-values (((for-loop_26)
- (lambda (s_86 lst_25)
+ (check-list lst_137))
+ ((letrec-values (((for-loop_134)
+ (lambda (s_225 lst_138)
(begin
'for-loop
- (if (pair? lst_25)
- (let-values (((l_35) (unsafe-car lst_25))
- ((rest_10) (unsafe-cdr lst_25)))
- (let-values (((s_184)
- (let-values (((s_185) s_86))
- (let-values (((s_186)
- (let-values ()
- (set-intersect
- s_185
- (list->set l_35)))))
- (values s_186)))))
- (if (not #f) (for-loop_26 s_184 rest_10) s_184)))
- s_86)))))
- for-loop_26)
- (list->set (car relevant-scope-sets_0))
- lst_27))))))
- (string-append
- ((letrec-values (((loop_77)
- (lambda (info_4 layer_2)
- (begin
- 'loop
- (string-append
- "\n context"
- (layer->string layer_2)
- "...:"
- (describe-context (hash-ref info_4 'context) common-scopes_0)
- (apply
- string-append
- (reverse$1
- (let-values (((lst_94)
- (let-values (((temp1_1) (hash-ref info_4 'bindings null))
+ (if (pair? lst_138)
+ (let-values (((l_41) (unsafe-car lst_138))
+ ((rest_65) (unsafe-cdr lst_138)))
+ (let-values (((s_226)
+ (let-values (((s_227)
+ (set-intersect
+ s_225
+ (list->set l_41))))
+ (values s_227))))
+ (if (not #f) (for-loop_134 s_226 rest_65) s_226)))
+ s_225)))))
+ for-loop_134)
+ s_223
+ lst_137)))))))
+ (string-append
+ ((letrec-values (((loop_81)
+ (lambda (info_5 layer_2)
+ (begin
+ 'loop
+ (string-append
+ "\n context"
+ (layer->string layer_2)
+ "...:"
+ (describe-context (hash-ref info_5 'context) common-scopes_0)
+ (apply
+ string-append
+ (reverse$1
+ (let-values (((fold-var_147) (let-values (((fold-var_148) null)) fold-var_148)))
+ (let-values (((lst_139)
+ (let-values (((temp1_1) (hash-ref info_5 'bindings null))
((temp2_1)
- (lambda (a_28 b_67)
- (if (hash-ref a_28 'match? #f)
- (not (hash-ref b_67 'match? #f))
+ (lambda (a_33 b_89)
+ (if (hash-ref a_33 'match? #f)
+ (not (hash-ref b_89 'match? #f))
#f))))
(sort.1 #f #f temp1_1 temp2_1))))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_94)))
- ((letrec-values (((for-loop_109)
- (lambda (fold-var_87 lst_95)
+ (check-list lst_139))
+ ((letrec-values (((for-loop_135)
+ (lambda (fold-var_149 lst_140)
(begin
'for-loop
- (if (pair? lst_95)
- (let-values (((b_68) (unsafe-car lst_95))
- ((rest_45) (unsafe-cdr lst_95)))
- (let-values (((fold-var_88)
- (let-values (((fold-var_89)
- fold-var_87))
- (let-values (((fold-var_72)
- (let-values ()
- (cons
- (let-values ()
- (string-append
- "\n "
- (if (hash-ref
- b_68
- 'match?
- #f)
- "matching"
- "other")
- " binding"
- (layer->string
- layer_2)
- "...:"
- "\n "
- (if (hash-ref
- b_68
- 'local
- #f)
- "local"
- (format
- "~a"
- (hash-ref
- b_68
- 'module
- #f)))
- (describe-context
- (hash-ref
- b_68
- 'context)
- common-scopes_0)))
- fold-var_89))))
- (values fold-var_72)))))
+ (if (pair? lst_140)
+ (let-values (((b_90) (unsafe-car lst_140))
+ ((rest_66) (unsafe-cdr lst_140)))
+ (let-values (((fold-var_150)
+ (let-values (((fold-var_151)
+ (cons
+ (string-append
+ "\n "
+ (if (hash-ref
+ b_90
+ 'match?
+ #f)
+ "matching"
+ "other")
+ " binding"
+ (layer->string
+ layer_2)
+ "...:"
+ "\n "
+ (if (hash-ref
+ b_90
+ 'local
+ #f)
+ "local"
+ (format
+ "~a"
+ (hash-ref
+ b_90
+ 'module
+ #f)))
+ (describe-context
+ (hash-ref
+ b_90
+ 'context)
+ common-scopes_0))
+ fold-var_149)))
+ (values fold-var_151))))
(if (not #f)
- (for-loop_109 fold-var_88 rest_45)
- fold-var_88)))
- fold-var_87)))))
- for-loop_109)
- null
- lst_94)))))
- (let-values (((fallbacks_1) (hash-ref info_4 'fallbacks null)))
- (apply
- string-append
- (reverse$1
- (let-values (((lst_96) fallbacks_1) ((start_18) (add1 layer_2)))
+ (for-loop_135 fold-var_150 rest_66)
+ fold-var_150)))
+ fold-var_149)))))
+ for-loop_135)
+ fold-var_147
+ lst_139))))))
+ (let-values (((fallbacks_1) (hash-ref info_5 'fallbacks null)))
+ (apply
+ string-append
+ (reverse$1
+ (let-values (((fold-var_152)
+ (let-values (((fold-var_153) null)) fold-var_153)))
+ (let-values (((lst_141) fallbacks_1) ((start_23) (add1 layer_2)))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_96)))
+ (check-list lst_141))
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-naturals start_18)))
- ((letrec-values (((for-loop_110)
- (lambda (fold-var_73 lst_97 pos_15)
+ (check-naturals start_23))
+ ((letrec-values (((for-loop_136)
+ (lambda (fold-var_154 lst_142 pos_25)
(begin
'for-loop
- (if (if (pair? lst_97) #t #f)
- (let-values (((fallback_1) (unsafe-car lst_97))
- ((rest_0) (unsafe-cdr lst_97))
- ((layer_3) pos_15))
- (let-values (((fold-var_90)
- (let-values (((fold-var_91)
- fold-var_73))
- (let-values (((fold-var_92)
- (let-values ()
- (cons
- (let-values ()
- (loop_77
- fallback_1
- layer_3))
- fold-var_91))))
- (values fold-var_92)))))
+ (if (if (pair? lst_142) #t #f)
+ (let-values (((fallback_1) (unsafe-car lst_142))
+ ((rest_67) (unsafe-cdr lst_142))
+ ((layer_3) pos_25))
+ (let-values (((fold-var_155)
+ (let-values (((fold-var_156)
+ (cons
+ (loop_81
+ fallback_1
+ layer_3)
+ fold-var_154)))
+ (values fold-var_156))))
(if (not #f)
- (for-loop_110
- fold-var_90
- rest_0
- (+ pos_15 1))
- fold-var_90)))
- fold-var_73)))))
- for-loop_110)
- null
- lst_96
- start_18)))))))))))
- loop_77)
- info_2
- 0)
- (if (set-empty? common-scopes_0)
- ""
- (string-append
- "\n common scopes...:"
- (describe-context
- (reverse$1
- (let-values (((lst_9) (hash-ref info_2 'context)))
+ (for-loop_136
+ fold-var_155
+ rest_67
+ (+ pos_25 1))
+ fold-var_155)))
+ fold-var_154)))))
+ for-loop_136)
+ fold-var_152
+ lst_141
+ start_23))))))))))))
+ loop_81)
+ info_3
+ 0)
+ (if (set-empty? common-scopes_0)
+ ""
+ (string-append
+ "\n common scopes...:"
+ (describe-context
+ (reverse$1
+ (let-values (((fold-var_157) (let-values (((fold-var_158) null)) fold-var_158)))
+ (let-values (((lst_143) (hash-ref info_3 'context)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_9)))
- ((letrec-values (((for-loop_3)
- (lambda (fold-var_93 lst_10)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_143))
+ ((letrec-values (((for-loop_137)
+ (lambda (fold-var_159 lst_144)
(begin
'for-loop
- (if (pair? lst_10)
- (let-values (((s_187) (unsafe-car lst_10))
- ((rest_1) (unsafe-cdr lst_10)))
- (let-values (((fold-var_94)
- (let-values (((fold-var_21) fold-var_93))
- (if (set-member? common-scopes_0 s_187)
- (let-values (((fold-var_22) fold-var_21))
- (let-values (((fold-var_16)
- (let-values ()
- (cons
- (let-values () s_187)
- fold-var_22))))
- (values fold-var_16)))
- fold-var_21))))
- (if (not #f) (for-loop_3 fold-var_94 rest_1) fold-var_94)))
- fold-var_93)))))
- for-loop_3)
- null
- lst_9))))
- (set)))))))))))))
+ (if (pair? lst_144)
+ (let-values (((s_228) (unsafe-car lst_144))
+ ((rest_68) (unsafe-cdr lst_144)))
+ (let-values (((fold-var_160)
+ (if (set-member? common-scopes_0 s_228)
+ (let-values (((fold-var_161)
+ (cons s_228 fold-var_159)))
+ (values fold-var_161))
+ fold-var_159)))
+ (if (not #f) (for-loop_137 fold-var_160 rest_68) fold-var_160)))
+ fold-var_159)))))
+ for-loop_137)
+ fold-var_157
+ lst_143)))))
+ (set))))))))))))
(define-values
(describe-context)
(lambda (scopes_20 common-scopes_1)
(begin
(let-values (((strs_0)
- ((letrec-values (((loop_40)
+ ((letrec-values (((loop_82)
(lambda (strs_1 scopes_21)
(begin
'loop
(if (null? scopes_21)
- (let-values () (reverse$1 strs_1))
- (let-values ()
- (let-values (((str_3) (format " ~a" (car scopes_21))))
- (if (if (pair? strs_1)
- (< (+ (string-length str_3) (string-length (car strs_1))) 72)
- #f)
- (loop_40
- (cons (string-append (car strs_1) str_3) (cdr strs_1))
- (cdr scopes_21))
- (loop_40 (cons str_3 strs_1) (cdr scopes_21))))))))))
- loop_40)
+ (reverse$1 strs_1)
+ (let-values (((str_3) (format " ~a" (car scopes_21))))
+ (if (if (pair? strs_1)
+ (< (+ (string-length str_3) (string-length (car strs_1))) 72)
+ #f)
+ (loop_82
+ (cons (string-append (car strs_1) str_3) (cdr strs_1))
+ (cdr scopes_21))
+ (loop_82 (cons str_3 strs_1) (cdr scopes_21)))))))))
+ loop_82)
null
(if (set-empty? common-scopes_1)
scopes_20
(append
(reverse$1
- (let-values (((lst_98) scopes_20))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_98)))
- ((letrec-values (((for-loop_1)
- (lambda (fold-var_95 lst_99)
- (begin
- 'for-loop
- (if (pair? lst_99)
- (let-values (((s_188) (unsafe-car lst_99))
- ((rest_46) (unsafe-cdr lst_99)))
- (let-values (((fold-var_96)
- (let-values (((fold-var_97) fold-var_95))
- (if (not (set-member? common-scopes_1 s_188))
- (let-values (((fold-var_98) fold-var_97))
- (let-values (((fold-var_45)
- (let-values ()
- (cons
- (let-values () s_188)
- fold-var_98))))
- (values fold-var_45)))
- fold-var_97))))
- (if (not #f) (for-loop_1 fold-var_96 rest_46) fold-var_96)))
- fold-var_95)))))
- for-loop_1)
- null
- lst_98))))
+ (let-values (((fold-var_162) (let-values (((fold-var_163) null)) fold-var_163)))
+ (let-values (((lst_145) scopes_20))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_145))
+ ((letrec-values (((for-loop_138)
+ (lambda (fold-var_164 lst_146)
+ (begin
+ 'for-loop
+ (if (pair? lst_146)
+ (let-values (((s_229) (unsafe-car lst_146))
+ ((rest_69) (unsafe-cdr lst_146)))
+ (let-values (((fold-var_165)
+ (if (not (set-member? common-scopes_1 s_229))
+ (let-values (((fold-var_166)
+ (cons s_229 fold-var_164)))
+ (values fold-var_166))
+ fold-var_164)))
+ (if (not #f)
+ (for-loop_138 fold-var_165 rest_69)
+ fold-var_165)))
+ fold-var_164)))))
+ for-loop_138)
+ fold-var_162
+ lst_145)))))
(list "[common scopes]"))))))
(if (null? strs_0)
- (let-values () "\n [empty]")
- (let-values ()
- (apply
- string-append
- (reverse$1
- (let-values (((lst_68) strs_0))
+ "\n [empty]"
+ (apply
+ string-append
+ (reverse$1
+ (let-values (((fold-var_167) (let-values (((fold-var_168) null)) fold-var_168)))
+ (let-values (((lst_147) strs_0))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_68)))
- ((letrec-values (((for-loop_82)
- (lambda (fold-var_99 lst_100)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_147))
+ ((letrec-values (((for-loop_139)
+ (lambda (fold-var_169 lst_148)
(begin
'for-loop
- (if (pair? lst_100)
- (let-values (((str_4) (unsafe-car lst_100)) ((rest_47) (unsafe-cdr lst_100)))
- (let-values (((fold-var_100)
- (let-values (((fold-var_101) fold-var_99))
- (let-values (((fold-var_102)
- (let-values ()
- (cons
- (let-values ()
- (string-append "\n " str_4))
- fold-var_101))))
- (values fold-var_102)))))
- (if (not #f) (for-loop_82 fold-var_100 rest_47) fold-var_100)))
- fold-var_99)))))
- for-loop_82)
- null
- lst_68)))))))))))
+ (if (pair? lst_148)
+ (let-values (((str_4) (unsafe-car lst_148)) ((rest_70) (unsafe-cdr lst_148)))
+ (let-values (((fold-var_170)
+ (let-values (((fold-var_171)
+ (cons
+ (string-append "\n " str_4)
+ fold-var_169)))
+ (values fold-var_171))))
+ (if (not #f) (for-loop_139 fold-var_170 rest_70) fold-var_170)))
+ fold-var_169)))))
+ for-loop_139)
+ fold-var_167
+ lst_147)))))))))))
(define-values (layer->string) (lambda (layer_4) (begin (if (zero? layer_4) "" (format " at layer ~a" layer_4)))))
(define-values
(raise-syntax-implicit-error)
- (lambda (s_0 sym_31 trigger-id_0 ctx_9)
- (begin
- (let-values (((phase_53) (expand-context-phase ctx_9)))
- (let-values (((what_1)
- (let-values (((tmp_13) sym_31))
- (if (equal? tmp_13 '#%app)
- (let-values () "function application")
- (if (equal? tmp_13 '#%datum)
- (let-values () "literal data")
- (if (equal? tmp_13 '#%top)
- (let-values ()
- (if (expand-context-allow-unbound? ctx_9)
- "reference to a top-level identifier"
- "reference to an unbound identifier"))
- (let-values () (void))))))))
+ (lambda (s_230 sym_39 trigger-id_0 ctx_10)
+ (begin
+ (let-values (((phase_61) (expand-context-phase ctx_10)))
+ (let-values (((what_2)
+ (let-values (((tmp_14) sym_39))
+ (if (equal? tmp_14 '#%app)
+ "function application"
+ (if (equal? tmp_14 '#%datum)
+ "literal data"
+ (if (equal? tmp_14 '#%top)
+ (if (expand-context-allow-unbound? ctx_10)
+ "reference to a top-level identifier"
+ "reference to an unbound identifier")
+ (void)))))))
(let-values (((unbound?_0)
(if trigger-id_0
(not
- (let-values (((trigger-id1_0) trigger-id_0) ((phase2_1) phase_53))
+ (let-values (((trigger-id1_0) trigger-id_0) ((phase2_1) phase_61))
(resolve.1 #f #f null #f trigger-id1_0 phase2_1)))
#f)))
(let-values (((unbound-form_0)
- (if unbound?_0 (if (not (eq? (syntax-e$1 s_0) (syntax-e$1 trigger-id_0))) s_0 #f) #f)))
+ (if unbound?_0 (if (not (eq? (syntax-e$1 s_230) (syntax-e$1 trigger-id_0))) s_230 #f) #f)))
(raise-syntax-error$1
#f
(format
(if unbound?_0
"unbound identifier;\n also, no ~a syntax transformer is bound~a"
- (string-append what_1 " is not allowed;\n no ~a syntax transformer is bound~a"))
- sym_31
- (let-values (((tmp_14) phase_53))
- (if (equal? tmp_14 0)
- (let-values () "")
- (if (equal? tmp_14 1)
- (let-values () " in the transformer phase")
- (let-values () (format " at phase ~a" phase_53))))))
- (if unbound?_0 (let-values (((or-part_13) unbound-form_0)) (if or-part_13 or-part_13 trigger-id_0)) #f)
- (if unbound?_0 (if unbound-form_0 trigger-id_0 #f) s_0)
+ (string-append what_2 " is not allowed;\n no ~a syntax transformer is bound~a"))
+ sym_39
+ (let-values (((tmp_15) phase_61))
+ (if (equal? tmp_15 0)
+ ""
+ (if (equal? tmp_15 1) " in the transformer phase" (format " at phase ~a" phase_61)))))
+ (if unbound?_0
+ (let-values (((or-part_266) unbound-form_0)) (if or-part_266 or-part_266 trigger-id_0))
+ #f)
+ (if unbound?_0 (if unbound-form_0 trigger-id_0 #f) s_230)
null
- (if unbound?_0 (syntax-debug-info-string trigger-id_0 ctx_9) "")))))))))
+ (if unbound?_0 (syntax-debug-info-string trigger-id_0 ctx_10) "")))))))))
(define-values (make-check-no-duplicate-table) (lambda () (begin '#hasheq())))
(define-values
(check-no-duplicate-ids.1)
@@ -17990,102 +17988,89 @@
(begin
'check-no-duplicate-ids
(let-values (((ids_3) ids4_0))
- (let-values (((phase_54) phase5_1))
- (let-values (((s_179) s6_2))
- (let-values (((ht_76) (if (eq? ht3_0 unsafe-undefined) (make-check-no-duplicate-table) ht3_0)))
- (let-values (((what_2) (if (eq? what1_0 unsafe-undefined) "binding name" what1_0)))
- (let-values ()
- ((letrec-values (((loop_78)
- (lambda (v_1 ht_82)
- (begin
- 'loop
- (if (identifier? v_1)
- (let-values ()
- (let-values (((l_32) (hash-ref ht_82 (syntax-e$1 v_1) null)))
+ (let-values (((phase_62) phase5_1))
+ (let-values (((s_231) s6_2))
+ (let-values (((ht_96) (if (eq? ht3_0 unsafe-undefined) (make-check-no-duplicate-table) ht3_0)))
+ (let-values (((what_3) (if (eq? what1_0 unsafe-undefined) "binding name" what1_0)))
+ ((letrec-values (((loop_83)
+ (lambda (v_169 ht_97)
+ (begin
+ 'loop
+ (if (identifier? v_169)
+ (let-values (((l_42) (hash-ref ht_97 (syntax-e$1 v_169) null)))
+ (begin
+ (let-values (((lst_149) l_42))
(begin
- (let-values (((lst_101) l_32))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_101)))
- ((letrec-values (((for-loop_111)
- (lambda (lst_46)
- (begin
- 'for-loop
- (if (pair? lst_46)
- (let-values (((id_26) (unsafe-car lst_46))
- ((rest_48)
- (unsafe-cdr lst_46)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (if (bound-identifier=?$1
- id_26
- v_1
- phase_54)
- (let-values ()
- (raise-syntax-error$1
- #f
- (string-append
- "duplicate "
- what_2)
- s_179
- v_1))
- (void)))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_111 rest_48)
- (values))))
- (values))))))
- for-loop_111)
- lst_101)))
- (void)
- (hash-set ht_82 (syntax-e$1 v_1) (cons v_1 l_32)))))
- (if (pair? v_1)
- (let-values () (loop_78 (cdr v_1) (loop_78 (car v_1) ht_82)))
- (let-values () ht_82)))))))
- loop_78)
- ids_3
- ht_76))))))))))
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_149))
+ ((letrec-values (((for-loop_140)
+ (lambda (lst_150)
+ (begin
+ 'for-loop
+ (if (pair? lst_150)
+ (let-values (((id_28) (unsafe-car lst_150))
+ ((rest_71) (unsafe-cdr lst_150)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (if (bound-identifier=?$1
+ id_28
+ v_169
+ phase_62)
+ (raise-syntax-error$1
+ #f
+ (string-append
+ "duplicate "
+ what_3)
+ s_231
+ v_169)
+ (void))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_140 rest_71)
+ (values))))
+ (values))))))
+ for-loop_140)
+ lst_149)))
+ (void)
+ (hash-set ht_97 (syntax-e$1 v_169) (cons v_169 l_42))))
+ (if (pair? v_169) (loop_83 (cdr v_169) (loop_83 (car v_169) ht_97)) ht_97))))))
+ loop_83)
+ ids_3
+ ht_96)))))))))
(define-values
(remove-use-site-scopes)
- (lambda (s_0 ctx_8)
+ (lambda (s_232 ctx_11)
(begin
- (let-values (((use-sites_0) (root-expand-context-use-site-scopes ctx_8)))
+ (let-values (((use-sites_0) (root-expand-context-use-site-scopes ctx_11)))
(if (if use-sites_0 (pair? (unbox use-sites_0)) #f)
- (if (syntax?$1 s_0)
- (remove-scopes s_0 (unbox use-sites_0))
+ (if (syntax?$1 s_232)
+ (remove-scopes s_232 (unbox use-sites_0))
(reverse$1
- (let-values (((lst_102) s_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_102)))
- ((letrec-values (((for-loop_112)
- (lambda (fold-var_103 lst_88)
- (begin
- 'for-loop
- (if (pair? lst_88)
- (let-values (((id_27) (unsafe-car lst_88)) ((rest_49) (unsafe-cdr lst_88)))
- (let-values (((fold-var_104)
- (let-values (((fold-var_105) fold-var_103))
- (let-values (((fold-var_66)
- (let-values ()
- (cons
- (let-values ()
- (remove-scopes id_27 (unbox use-sites_0)))
- fold-var_105))))
- (values fold-var_66)))))
- (if (not #f) (for-loop_112 fold-var_104 rest_49) fold-var_104)))
- fold-var_103)))))
- for-loop_112)
- null
- lst_102)))))
- s_0)))))
+ (let-values (((fold-var_172) (let-values (((fold-var_173) null)) fold-var_173)))
+ (let-values (((lst_151) s_232))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_151))
+ ((letrec-values (((for-loop_141)
+ (lambda (fold-var_174 lst_152)
+ (begin
+ 'for-loop
+ (if (pair? lst_152)
+ (let-values (((id_29) (unsafe-car lst_152)) ((rest_72) (unsafe-cdr lst_152)))
+ (let-values (((fold-var_175)
+ (let-values (((fold-var_176)
+ (cons
+ (remove-scopes id_29 (unbox use-sites_0))
+ fold-var_174)))
+ (values fold-var_176))))
+ (if (not #f) (for-loop_141 fold-var_175 rest_72) fold-var_175)))
+ fold-var_174)))))
+ for-loop_141)
+ fold-var_172
+ lst_151))))))
+ s_232)))))
(define-values
(struct:compile-context
compile-context1.1
@@ -18097,59 +18082,56 @@
compile-context-full-module-name
compile-context-lazy-syntax-literals?
compile-context-header)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'compile-context
- #f
- 7
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6)
- #f
- 'compile-context)))))
+ (let-values (((struct:_55 make-_55 ?_55 -ref_55 -set!_55)
+ (make-struct-type
+ 'compile-context
+ #f
+ 7
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 6)
+ #f
+ 'compile-context)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'namespace)
- (make-struct-field-accessor -ref_2 1 'phase)
- (make-struct-field-accessor -ref_2 2 'self)
- (make-struct-field-accessor -ref_2 3 'module-self)
- (make-struct-field-accessor -ref_2 4 'full-module-name)
- (make-struct-field-accessor -ref_2 5 'lazy-syntax-literals?)
- (make-struct-field-accessor -ref_2 6 'header))))
+ struct:_55
+ make-_55
+ ?_55
+ (make-struct-field-accessor -ref_55 0 'namespace)
+ (make-struct-field-accessor -ref_55 1 'phase)
+ (make-struct-field-accessor -ref_55 2 'self)
+ (make-struct-field-accessor -ref_55 3 'module-self)
+ (make-struct-field-accessor -ref_55 4 'full-module-name)
+ (make-struct-field-accessor -ref_55 5 'lazy-syntax-literals?)
+ (make-struct-field-accessor -ref_55 6 'header))))
(define-values
(make-compile-context.1)
(lambda (full-module-name6_0 lazy-syntax-literals?7_0 module-self5_0 namespace2_0 phase3_0 self4_1)
(begin
'make-compile-context
(let-values (((namespace_1) (if (eq? namespace2_0 unsafe-undefined) (1/current-namespace) namespace2_0)))
- (let-values (((phase_55) (if (eq? phase3_0 unsafe-undefined) (namespace-phase namespace_1) phase3_0)))
- (let-values (((self_5) (if (eq? self4_1 unsafe-undefined) (namespace-self-mpi namespace_1) self4_1)))
+ (let-values (((phase_63) (if (eq? phase3_0 unsafe-undefined) (namespace-phase namespace_1) phase3_0)))
+ (let-values (((self_7) (if (eq? self4_1 unsafe-undefined) (namespace-self-mpi namespace_1) self4_1)))
(let-values (((module-self_0) module-self5_0))
(let-values (((full-module-name_0) full-module-name6_0))
(let-values (((lazy-syntax-literals?_0)
(if (eq? lazy-syntax-literals?7_0 unsafe-undefined)
(if module-self_0 #t #f)
lazy-syntax-literals?7_0)))
- (let-values ()
- (begin
- (if (if module-self_0 (not full-module-name_0) #f)
- (let-values () (error "internal error: module-self provided without full name"))
- (void))
- (compile-context1.1
- namespace_1
- phase_55
- self_5
- module-self_0
- full-module-name_0
- lazy-syntax-literals?_0
- #f))))))))))))
+ (begin
+ (if (if module-self_0 (not full-module-name_0) #f)
+ (error "internal error: module-self provided without full name")
+ (void))
+ (compile-context1.1
+ namespace_1
+ phase_63
+ self_7
+ module-self_0
+ full-module-name_0
+ lazy-syntax-literals?_0
+ #f)))))))))))
(define-values (kernel) (primitive-table '#%kernel))
(define-values (syntax?$3) (hash-ref kernel 'syntax?))
(define-values (syntax-e$4) (hash-ref kernel 'syntax-e))
@@ -18162,7 +18144,7 @@
(define-values (syntax-column$3) (hash-ref kernel 'syntax-column))
(define-values (syntax-position$3) (hash-ref kernel 'syntax-position))
(define-values (syntax-span$3) (hash-ref kernel 'syntax-span))
- (define-values (correlated?$1) (lambda (e_19) (begin 'correlated? (syntax?$3 e_19))))
+ (define-values (correlated?$1) (lambda (e_20) (begin 'correlated? (syntax?$3 e_20))))
(define-values
(datum->correlated$1)
(let-values (((datum->correlated_0)
@@ -18171,377 +18153,343 @@
'datum->correlated
(let-values (((d_19) d3_0))
(let-values (((srcloc_3) srcloc1_0))
- (let-values (((props_2) props2_1))
- (let-values () (datum->syntax$4 #f d_19 srcloc_3 props_2)))))))))
+ (let-values (((props_2) props2_1)) (datum->syntax$4 #f d_19 srcloc_3 props_2))))))))
(case-lambda
((d_20) (begin 'datum->correlated (datum->correlated_0 d_20 #f #f)))
((d_21 srcloc_4 props2_2) (datum->correlated_0 d_21 srcloc_4 props2_2))
((d_22 srcloc1_1) (datum->correlated_0 d_22 srcloc1_1 #f)))))
- (define-values (correlated-e$1) (lambda (e_20) (begin 'correlated-e (syntax-e$4 e_20))))
+ (define-values (correlated-e$1) (lambda (e_21) (begin 'correlated-e (syntax-e$4 e_21))))
(define-values
(correlated-property$1)
(case-lambda
- ((e_21 k_24) (begin 'correlated-property (syntax-property$3 e_21 k_24)))
- ((e_22 k_23 v_77) (syntax-property$3 e_22 k_23 v_77))))
+ ((e_22 k_24) (begin 'correlated-property (syntax-property$3 e_22 k_24)))
+ ((e_23 k_25 v_170) (syntax-property$3 e_23 k_25 v_170))))
(define-values
(correlated-property-symbol-keys$1)
- (lambda (e_23) (begin 'correlated-property-symbol-keys (syntax-property-symbol-keys$3 e_23))))
- (define-values (correlated-source$1) (lambda (s_83) (begin 'correlated-source (syntax-source$3 s_83))))
- (define-values (correlated-line$1) (lambda (s_177) (begin 'correlated-line (syntax-line$3 s_177))))
- (define-values (correlated-column$1) (lambda (s_51) (begin 'correlated-column (syntax-column$3 s_51))))
- (define-values (correlated-position$1) (lambda (s_6) (begin 'correlated-position (syntax-position$3 s_6))))
- (define-values (correlated-span$1) (lambda (s_84) (begin 'correlated-span (syntax-span$3 s_84))))
+ (lambda (e_24) (begin 'correlated-property-symbol-keys (syntax-property-symbol-keys$3 e_24))))
+ (define-values (correlated-source$1) (lambda (s_233) (begin 'correlated-source (syntax-source$3 s_233))))
+ (define-values (correlated-line$1) (lambda (s_234) (begin 'correlated-line (syntax-line$3 s_234))))
+ (define-values (correlated-column$1) (lambda (s_235) (begin 'correlated-column (syntax-column$3 s_235))))
+ (define-values (correlated-position$1) (lambda (s_236) (begin 'correlated-position (syntax-position$3 s_236))))
+ (define-values (correlated-span$1) (lambda (s_237) (begin 'correlated-span (syntax-span$3 s_237))))
+ (define-values
+ (check-flvector)
+ (lambda (v_171)
+ (begin (if (flvector? v_171) (void) (1/raise-argument-error 'in-flvector* (string-append "flvector" "?") v_171)))))
+ (define-values
+ (not-an-fX.1$1)
+ (lambda (who_18 v_172) (begin 'not-an-fX (raise-argument-error who_18 "flonum?" v_172))))
(define-values
(truncate-path)
- (lambda (p_20)
+ (lambda (p_23)
(begin
- (let-values (((base1_0 name1_0 dir?_3) (split-path p_20)))
+ (let-values (((base1_0 name1_0 dir?_3) (split-path p_23)))
(if (path-for-some-system? base1_0)
- (let-values ()
- (let-values (((base2_0 name2_0 dir?_4) (split-path base1_0)))
- (if (not base2_0)
- (let-values () (path-for-some-system->string p_20))
- (if (symbol? name2_0)
- (let-values () (string-append ".../" (path-elem->string name1_0)))
- (let-values ()
- (string-append ".../" (path-for-some-system->string name2_0) "/" (path-elem->string name1_0)))))))
- (if (eq? base1_0 'relative)
- (let-values () (path-elem->string name1_0))
- (let-values () (path-for-some-system->string p_20))))))))
+ (let-values (((base2_0 name2_0 dir?_4) (split-path base1_0)))
+ (if (not base2_0)
+ (path-for-some-system->string p_23)
+ (if (symbol? name2_0)
+ (string-append ".../" (path-elem->string name1_0))
+ (string-append ".../" (path-for-some-system->string name2_0) "/" (path-elem->string name1_0)))))
+ (if (eq? base1_0 'relative) (path-elem->string name1_0) (path-for-some-system->string p_23)))))))
(define-values
(path-elem->string)
- (lambda (p_21)
- (begin
- (if (eq? p_21 'same)
- (let-values () ".")
- (if (eq? p_21 'up) (let-values () "..") (let-values () (path-for-some-system->string p_21)))))))
+ (lambda (p_24) (begin (if (eq? p_24 'same) "." (if (eq? p_24 'up) ".." (path-for-some-system->string p_24))))))
(define-values
(path-for-some-system->string)
- (lambda (p_22)
- (begin
- (if (path? p_22)
- (let-values () (path->string p_22))
- (let-values () (bytes->string/utf-8 (path->bytes p_22) '#\�))))))
+ (lambda (p_25) (begin (if (path? p_25) (path->string p_25) (bytes->string/utf-8 (path->bytes p_25) '#\�)))))
(define-values
(make-path->relative-path-elements.1)
(lambda (who1_0 wr-dir3_0)
(begin
'make-path->relative-path-elements
(let-values (((wr-dir_0) (if (eq? wr-dir3_0 unsafe-undefined) (current-write-relative-directory) wr-dir3_0)))
- (let-values (((who_11) who1_0))
- (let-values ()
- (begin
- (if who_11
- (let-values ()
- (if (let-values (((or-part_84) (not wr-dir_0)))
- (if or-part_84
- or-part_84
- (let-values (((or-part_58) (if (path-string? wr-dir_0) (complete-path? wr-dir_0) #f)))
- (if or-part_58
- or-part_58
- (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)
- (let-values ()
- (raise-argument-error
- who_11
- (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)
- (let-values () (lambda (v_125) #f))
- (let-values ()
- (let-values (((exploded-base-dir_0) 'not-ready))
- (let-values (((exploded-wrt-rel-dir_0) 'not-ready))
- (lambda (v_89)
- (begin
- (if (if (eq? exploded-base-dir_0 'not-ready) (path? v_89) #f)
- (let-values ()
- (let-values (((wrt-dir_0) (if wr-dir_0 (if (pair? wr-dir_0) (car wr-dir_0) wr-dir_0) #f)))
- (let-values (((exploded-wrt-dir_0) (explode-path wrt-dir_0)))
- (let-values (((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-values () '())
- (let-values ()
- (let-values (((exploded-wrt-dir_1) (explode-path wrt-dir_0)))
- (let-values (((base-len_0) (length exploded-base-dir_0)))
- (begin
- (if who_11
- (let-values ()
- (if (if (>= (length exploded-wrt-dir_1) base-len_0)
- (let-values (((lst_103) exploded-wrt-dir_1)
- ((lst_104) exploded-base-dir_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_103)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_104)))
- ((letrec-values (((for-loop_113)
- (lambda (result_63 lst_105 lst_106)
- (begin
- 'for-loop
- (if (if (pair? lst_105)
- (pair? lst_106)
+ (let-values (((who_19) who1_0))
+ (begin
+ (if who_19
+ (if (let-values (((or-part_267) (not wr-dir_0)))
+ (if or-part_267
+ or-part_267
+ (let-values (((or-part_268) (if (path-string? wr-dir_0) (complete-path? wr-dir_0) #f)))
+ (if or-part_268
+ or-part_268
+ (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
+ who_19
+ (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_173) #f)
+ (let-values (((exploded-base-dir_0) 'not-ready))
+ (let-values (((exploded-wrt-rel-dir_0) 'not-ready))
+ (lambda (v_174)
+ (begin
+ (if (if (eq? exploded-base-dir_0 'not-ready) (path? v_174) #f)
+ (let-values (((wrt-dir_0) (if wr-dir_0 (if (pair? wr-dir_0) (car wr-dir_0) wr-dir_0) #f)))
+ (let-values (((exploded-wrt-dir_0) (explode-path wrt-dir_0)))
+ (let-values (((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-values (((exploded-wrt-dir_1) (explode-path wrt-dir_0)))
+ (let-values (((base-len_0) (length exploded-base-dir_0)))
+ (begin
+ (if who_19
+ (if (if (>= (length exploded-wrt-dir_1) base-len_0)
+ (let-values (((result_117)
+ (let-values (((result_118) #t)) result_118)))
+ (let-values (((lst_153) exploded-wrt-dir_1)
+ ((lst_154) exploded-base-dir_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_153))
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_154))
+ ((letrec-values (((for-loop_142)
+ (lambda (result_119 lst_155 lst_156)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_155)
+ (pair? lst_156)
+ #f)
+ (let-values (((a_34)
+ (unsafe-car lst_155))
+ ((rest_73)
+ (unsafe-cdr lst_155))
+ ((b_91)
+ (unsafe-car lst_156))
+ ((rest_74)
+ (unsafe-cdr lst_156)))
+ (let-values (((result_120)
+ (let-values (((result_121)
+ (equal?
+ a_34
+ b_91)))
+ (values result_121))))
+ (if (if (not
+ ((lambda x_43
+ (not result_120))
+ a_34))
+ (if (not
+ ((lambda x_44
+ (not result_120))
+ b_91))
+ (not #f)
#f)
- (let-values (((a_13)
- (unsafe-car
- lst_105))
- ((rest_50)
- (unsafe-cdr
- lst_105))
- ((b_69)
- (unsafe-car
- lst_106))
- ((rest_51)
- (unsafe-cdr
- lst_106)))
- (let-values (((result_64)
- (let-values ()
- (let-values (((result_65)
- (let-values ()
- (let-values ()
- (equal?
- a_13
- b_69)))))
- (values
- result_65)))))
- (if (if (not
- ((lambda x_39
- (not result_64))
- a_13))
- (if (not
- ((lambda x_40
- (not
- result_64))
- b_69))
- (not #f)
- #f)
- #f)
- (for-loop_113
- result_64
- rest_50
- rest_51)
- result_64)))
- result_63)))))
- for-loop_113)
- #t
- lst_103
- lst_104)))
- #f)
- (void)
- (let-values ()
- (raise-arguments-error
- who_11
- "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_89)
- (let-values (((exploded_0) (explode-path v_89)))
- (if (let-values (((lst_107) exploded-base-dir_0) ((lst_108) exploded_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_107)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_108)))
- ((letrec-values (((for-loop_114)
- (lambda (result_66 lst_109 lst_26)
- (begin
- 'for-loop
- (if (if (pair? lst_109) (pair? lst_26) #f)
- (let-values (((base-p_0) (unsafe-car lst_109))
- ((rest_9) (unsafe-cdr lst_109))
- ((p_14) (unsafe-car lst_26))
- ((rest_52) (unsafe-cdr lst_26)))
- (let-values (((result_67)
- (let-values ()
- (let-values (((result_68)
- (let-values ()
- (let-values ()
- (equal?
- base-p_0
- p_14)))))
- (values result_68)))))
- (if (if (not
- ((lambda x_41 (not result_67)) base-p_0))
- (if (not ((lambda x_42 (not result_67)) p_14))
- (not #f)
- #f)
+ #f)
+ (for-loop_142
+ result_120
+ rest_73
+ rest_74)
+ result_120)))
+ result_119)))))
+ for-loop_142)
+ result_117
+ lst_153
+ lst_154))))
+ #f)
+ (void)
+ (raise-arguments-error
+ who_19
+ "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_174)
+ (let-values (((exploded_0) (explode-path v_174)))
+ (if (let-values (((result_122) (let-values (((result_123) #t)) result_123)))
+ (let-values (((lst_157) exploded-base-dir_0) ((lst_158) exploded_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_157))
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_158))
+ ((letrec-values (((for-loop_143)
+ (lambda (result_124 lst_159 lst_160)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_159) (pair? lst_160) #f)
+ (let-values (((base-p_0) (unsafe-car lst_159))
+ ((rest_75) (unsafe-cdr lst_159))
+ ((p_26) (unsafe-car lst_160))
+ ((rest_76) (unsafe-cdr lst_160)))
+ (let-values (((result_125)
+ (let-values (((result_126)
+ (equal? base-p_0 p_26)))
+ (values result_126))))
+ (if (if (not
+ ((lambda x_45 (not result_125)) base-p_0))
+ (if (not ((lambda x_46 (not result_125)) p_26))
+ (not #f)
#f)
- (for-loop_114 result_67 rest_9 rest_52)
- result_67)))
- result_66)))))
- for-loop_114)
- #t
- lst_107
- lst_108)))
- (if (>= (length exploded_0) (length exploded-base-dir_0))
- ((letrec-values (((loop_79)
- (lambda (exploded-wrt-rel-dir_1 rel_0)
- (begin
- 'loop
- (if (null? exploded-wrt-rel-dir_1)
- (let-values ()
- (reverse$1
- (let-values (((lst_95) rel_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_95)))
- ((letrec-values (((for-loop_115)
- (lambda (fold-var_106 lst_110)
- (begin
- 'for-loop
- (if (pair? lst_110)
- (let-values (((p_23)
- (unsafe-car
- lst_110))
- ((rest_53)
- (unsafe-cdr
- lst_110)))
- (let-values (((fold-var_107)
- (let-values (((fold-var_108)
- fold-var_106))
- (let-values (((fold-var_109)
- (let-values ()
- (cons
- (let-values ()
- (if (path?
- p_23)
- (path-element->bytes
- p_23)
- p_23))
- fold-var_108))))
- (values
- fold-var_109)))))
- (if (not #f)
- (for-loop_115
- fold-var_107
- rest_53)
- fold-var_107)))
- fold-var_106)))))
- for-loop_115)
- null
- lst_95)))))
- (if (if (pair? rel_0)
- (equal? (car rel_0) (car exploded-wrt-rel-dir_1))
- #f)
- (let-values ()
- (loop_79 (cdr exploded-wrt-rel-dir_1) (cdr rel_0)))
- (let-values ()
- (append
- (reverse$1
- (let-values (((lst_7) exploded-wrt-rel-dir_1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_7)))
- ((letrec-values (((for-loop_2)
- (lambda (fold-var_74 lst_8)
- (begin
- 'for-loop
- (if (pair? lst_8)
- (let-values (((p_24)
- (unsafe-car
- lst_8))
- ((rest_0)
- (unsafe-cdr
- lst_8)))
- (let-values (((fold-var_110)
- (let-values (((fold-var_90)
- fold-var_74))
- (let-values (((fold-var_91)
- (let-values ()
- (cons
- (let-values ()
- 'up)
- fold-var_90))))
- (values
- fold-var_91)))))
- (if (not #f)
- (for-loop_2
- fold-var_110
- rest_0)
- fold-var_110)))
- fold-var_74)))))
- for-loop_2)
- null
- lst_7))))
- (reverse$1
- (let-values (((lst_111) rel_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_111)))
- ((letrec-values (((for-loop_116)
- (lambda (fold-var_111 lst_112)
- (begin
- 'for-loop
- (if (pair? lst_112)
- (let-values (((p_25)
- (unsafe-car
- lst_112))
- ((rest_54)
- (unsafe-cdr
- lst_112)))
- (let-values (((fold-var_112)
- (let-values (((fold-var_94)
- fold-var_111))
- (let-values (((fold-var_21)
- (let-values ()
- (cons
- (let-values ()
- (if (path?
- p_25)
- (path-element->bytes
- p_25)
- p_25))
- fold-var_94))))
- (values
- fold-var_21)))))
- (if (not #f)
- (for-loop_116
- fold-var_112
- rest_54)
- fold-var_112)))
- fold-var_111)))))
- for-loop_116)
- null
- lst_111))))))))))))
- loop_79)
- exploded-wrt-rel-dir_0
- (list-tail exploded_0 (length exploded-base-dir_0)))
- #f)
- #f))
- #f)
- #f))))))))))))))
+ #f)
+ (for-loop_143 result_125 rest_75 rest_76)
+ result_125)))
+ result_124)))))
+ for-loop_143)
+ result_122
+ lst_157
+ lst_158))))
+ (if (>= (length exploded_0) (length exploded-base-dir_0))
+ ((letrec-values (((loop_84)
+ (lambda (exploded-wrt-rel-dir_1 rel_0)
+ (begin
+ 'loop
+ (if (null? exploded-wrt-rel-dir_1)
+ (reverse$1
+ (let-values (((fold-var_177)
+ (let-values (((fold-var_178) null))
+ fold-var_178)))
+ (let-values (((lst_161) rel_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_161))
+ ((letrec-values (((for-loop_144)
+ (lambda (fold-var_179 lst_162)
+ (begin
+ 'for-loop
+ (if (pair? lst_162)
+ (let-values (((p_27)
+ (unsafe-car
+ lst_162))
+ ((rest_77)
+ (unsafe-cdr
+ lst_162)))
+ (let-values (((fold-var_180)
+ (let-values (((fold-var_181)
+ (cons
+ (if (path?
+ p_27)
+ (path-element->bytes
+ p_27)
+ p_27)
+ fold-var_179)))
+ (values
+ fold-var_181))))
+ (if (not #f)
+ (for-loop_144
+ fold-var_180
+ rest_77)
+ fold-var_180)))
+ fold-var_179)))))
+ for-loop_144)
+ fold-var_177
+ lst_161)))))
+ (if (if (pair? rel_0)
+ (equal? (car rel_0) (car exploded-wrt-rel-dir_1))
+ #f)
+ (loop_84 (cdr exploded-wrt-rel-dir_1) (cdr rel_0))
+ (append
+ (reverse$1
+ (let-values (((fold-var_182)
+ (let-values (((fold-var_183) null))
+ fold-var_183)))
+ (let-values (((lst_163) exploded-wrt-rel-dir_1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_163))
+ ((letrec-values (((for-loop_145)
+ (lambda (fold-var_184 lst_164)
+ (begin
+ 'for-loop
+ (if (pair? lst_164)
+ (let-values (((p_28)
+ (unsafe-car
+ lst_164))
+ ((rest_78)
+ (unsafe-cdr
+ lst_164)))
+ (let-values (((fold-var_185)
+ (let-values (((fold-var_186)
+ (cons
+ 'up
+ fold-var_184)))
+ (values
+ fold-var_186))))
+ (if (not #f)
+ (for-loop_145
+ fold-var_185
+ rest_78)
+ fold-var_185)))
+ fold-var_184)))))
+ for-loop_145)
+ fold-var_182
+ lst_163)))))
+ (reverse$1
+ (let-values (((fold-var_187)
+ (let-values (((fold-var_188) null))
+ fold-var_188)))
+ (let-values (((lst_165) rel_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_165))
+ ((letrec-values (((for-loop_146)
+ (lambda (fold-var_189 lst_166)
+ (begin
+ 'for-loop
+ (if (pair? lst_166)
+ (let-values (((p_29)
+ (unsafe-car
+ lst_166))
+ ((rest_79)
+ (unsafe-cdr
+ lst_166)))
+ (let-values (((fold-var_190)
+ (let-values (((fold-var_191)
+ (cons
+ (if (path?
+ p_29)
+ (path-element->bytes
+ p_29)
+ p_29)
+ fold-var_189)))
+ (values
+ fold-var_191))))
+ (if (not #f)
+ (for-loop_146
+ fold-var_190
+ rest_79)
+ fold-var_190)))
+ fold-var_189)))))
+ for-loop_146)
+ fold-var_187
+ lst_165))))))))))))
+ loop_84)
+ exploded-wrt-rel-dir_0
+ (list-tail exploded_0 (length exploded-base-dir_0)))
+ #f)
+ #f))
+ #f)
+ #f))))))))))))
(define-values (1/write-byte) (lambda (byte_0 out_0) (begin 'write-byte (write-byte byte_0 out_0))))
(define-values
(1/write-bytes)
@@ -18554,7 +18502,7 @@
(let-values (((start-pos_0) start-pos1_0))
(let-values (((end-pos_0)
(if (eq? end-pos2_0 unsafe-undefined) (bytes-length bstr_3) end-pos2_0)))
- (let-values () (write-bytes bstr_3 out_1 start-pos_0 end-pos_0))))))))))
+ (write-bytes bstr_3 out_1 start-pos_0 end-pos_0)))))))))
(case-lambda
((bstr_4 out_2) (begin 'write-bytes (write-bytes_0 bstr_4 out_2 0 unsafe-undefined)))
((bstr_5 out_3 start-pos_1 end-pos2_1) (write-bytes_0 bstr_5 out_3 start-pos_1 end-pos2_1))
@@ -18601,6 +18549,8 @@
(define-values (fasl-correlated-type) 40)
(define-values (fasl-undefined-type) 41)
(define-values (fasl-prefab-type-type) 42)
+ (define-values (fasl-fxvector-type) 43)
+ (define-values (fasl-flvector-type) 44)
(define-values (fasl-small-integer-start) 100)
(define-values (fasl-lowest-small-integer) -10)
(define-values (fasl-highest-small-integer) (- 255 (- fasl-small-integer-start fasl-lowest-small-integer) 1))
@@ -18615,1101 +18565,1111 @@
(lambda (external-lift?7_0 handle-fail6_0 keep-mutable?5_0 skip-prefix?8_0 v14_0 orig-o13_0)
(begin
's-exp->fasl
- (let-values (((v_110) v14_0))
+ (let-values (((v_175) v14_0))
(let-values (((orig-o_0) orig-o13_0))
(let-values (((keep-mutable?_0) keep-mutable?5_0))
(let-values (((handle-fail_0) handle-fail6_0))
(let-values (((external-lift?_0) external-lift?7_0))
(let-values (((skip-prefix?_0) skip-prefix?8_0))
- (let-values ()
+ (let-values ((()
+ (begin
+ (if orig-o_0
+ (if (output-port? orig-o_0)
+ (void)
+ (raise-argument-error 's-exp->fasl "(or/c output-port? #f)" orig-o_0))
+ (void))
+ (values))))
(let-values ((()
(begin
- (if orig-o_0
- (let-values ()
- (if (output-port? orig-o_0)
- (void)
- (let-values ()
- (raise-argument-error 's-exp->fasl "(or/c output-port? #f)" orig-o_0))))
+ (if handle-fail_0
+ (if (if (procedure? handle-fail_0) (procedure-arity-includes? handle-fail_0 1) #f)
+ (void)
+ (raise-argument-error
+ 's-exp->fasl
+ "(or/c (procedure-arity-includes/c 1) #f)"
+ handle-fail_0))
(void))
(values))))
(let-values ((()
(begin
- (if handle-fail_0
- (let-values ()
- (if (if (procedure? handle-fail_0)
- (procedure-arity-includes? handle-fail_0 1)
- #f)
- (void)
- (let-values ()
- (raise-argument-error
- 's-exp->fasl
- "(or/c (procedure-arity-includes/c 1) #f)"
- handle-fail_0))))
+ (if external-lift?_0
+ (if (if (procedure? external-lift?_0)
+ (procedure-arity-includes? external-lift?_0 1)
+ #f)
+ (void)
+ (raise-argument-error
+ 's-exp->fasl
+ "(or/c (procedure-arity-includes/c 1) #f)"
+ external-lift?_0))
(void))
(values))))
- (let-values ((()
- (begin
- (if external-lift?_0
- (let-values ()
- (if (if (procedure? external-lift?_0)
- (procedure-arity-includes? external-lift?_0 1)
- #f)
- (void)
- (let-values ()
- (raise-argument-error
- 's-exp->fasl
- "(or/c (procedure-arity-includes/c 1) #f)"
- external-lift?_0))))
- (void))
- (values))))
- (let-values (((o_0)
- (let-values (((or-part_172) orig-o_0))
- (if or-part_172 or-part_172 (open-output-bytes)))))
- (let-values (((shared_0) (make-hasheq)))
- (let-values (((external-lift_0) (if external-lift?_0 (make-hasheq) #f)))
- (let-values (((shared-counter_0) 0))
- (let-values ((()
- (begin
- ((letrec-values (((loop_80)
- (lambda (v_126)
- (begin
- 'loop
- (if (if external-lift_0
- (hash-ref external-lift_0 v_126 #f)
+ (let-values (((o_0)
+ (let-values (((or-part_269) orig-o_0))
+ (if or-part_269 or-part_269 (open-output-bytes)))))
+ (let-values (((shared_0) (make-hasheq)))
+ (let-values (((external-lift_0) (if external-lift?_0 (make-hasheq) #f)))
+ (let-values (((shared-counter_0) 0))
+ (let-values ((()
+ (begin
+ ((letrec-values (((loop_85)
+ (lambda (v_176)
+ (begin
+ 'loop
+ (if (if external-lift_0
+ (hash-ref external-lift_0 v_176 #f)
+ #f)
+ (void)
+ (if (if external-lift?_0
+ (external-lift?_0 v_176)
#f)
- (let-values () (void))
- (if (if external-lift?_0
- (external-lift?_0 v_126)
- #f)
- (let-values ()
+ (begin
+ (hash-set! external-lift_0 v_176 #t)
+ (set! shared-counter_0
+ (add1 shared-counter_0))
+ (hash-set!
+ shared_0
+ v_176
+ (- shared-counter_0)))
+ (if (let-values (((or-part_270)
+ (symbol? v_176)))
+ (if or-part_270
+ or-part_270
+ (let-values (((or-part_271)
+ (keyword? v_176)))
+ (if or-part_271
+ or-part_271
+ (let-values (((or-part_272)
+ (string? v_176)))
+ (if or-part_272
+ or-part_272
+ (let-values (((or-part_273)
+ (bytes? v_176)))
+ (if or-part_273
+ or-part_273
+ (let-values (((or-part_274)
+ (fxvector?
+ v_176)))
+ (if or-part_274
+ or-part_274
+ (let-values (((or-part_275)
+ (flvector?
+ v_176)))
+ (if or-part_275
+ or-part_275
+ (path?
+ v_176)))))))))))))
+ (hash-update! shared_0 v_176 add1 0)
+ (if (pair? v_176)
(begin
- (hash-set! external-lift_0 v_126 #t)
- (set! shared-counter_0
- (add1 shared-counter_0))
- (hash-set!
- shared_0
- v_126
- (- shared-counter_0))))
- (if (let-values (((or-part_173)
- (symbol? v_126)))
- (if or-part_173
- or-part_173
- (let-values (((or-part_110)
- (keyword? v_126)))
- (if or-part_110
- or-part_110
- (let-values (((or-part_27)
- (string? v_126)))
- (if or-part_27
- or-part_27
- (let-values (((or-part_174)
- (bytes?
- v_126)))
- (if or-part_174
- or-part_174
- (path? v_126)))))))))
- (let-values ()
- (hash-update! shared_0 v_126 add1 0))
- (if (pair? v_126)
- (let-values ()
- (begin
- (loop_80 (car v_126))
- (loop_80 (cdr v_126))))
- (if (vector? v_126)
- (let-values ()
- (begin
- (let-values (((vec_32 len_13)
- (let-values (((vec_33)
- v_126))
- (begin
- (check-vector
- vec_33)
- (values
- vec_33
- (unsafe-vector-length
- vec_33))))))
- (begin
- #f
- ((letrec-values (((for-loop_117)
- (lambda (pos_16)
- (begin
- 'for-loop
- (if (unsafe-fx<
- pos_16
- len_13)
- (let-values (((e_24)
- (unsafe-vector-ref
- vec_32
- pos_16)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (loop_80
- e_24))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_117
- (unsafe-fx+
- 1
- pos_16))
- (values))))
- (values))))))
- for-loop_117)
- 0)))
- (void)))
- (if (hash? v_126)
- (let-values ()
- (hash-for-each
- v_126
- (lambda (k_25 v_127)
- (begin
- (loop_80 k_25)
- (loop_80 v_127)))
- #t))
- (if (box? v_126)
- (let-values ()
- (loop_80 (unbox v_126)))
- (let-values (((c2_1)
- (prefab-struct-key
- v_126)))
- (if c2_1
- ((lambda (k_26)
- (begin
- (loop_80 k_26)
- (let-values (((v*_1
- start*_1
- stop*_2
- step*_1)
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (unsafe-normalise-inputs
- unsafe-vector-length
- (struct->vector
- v_126)
- 1
- #f
- 1)
- (normalise-inputs
- 'in-vector
- "vector"
- (lambda (x_43)
- (vector?
- x_43))
- (lambda (x_44)
- (unsafe-vector-length
- x_44))
- (struct->vector
- v_126)
- 1
- #f
- 1))))
- (begin
- #t
- ((letrec-values (((for-loop_118)
- (lambda (idx_1)
- (begin
- 'for-loop
- (if (unsafe-fx<
- idx_1
- stop*_2)
- (let-values (((e_25)
- (unsafe-vector-ref
- v*_1
- idx_1)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (loop_80
- e_25))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_118
- (unsafe-fx+
- idx_1
- 1))
- (values))))
- (values))))))
- for-loop_118)
- start*_1)))
- (void)))
- c2_1)
- (if (srcloc? v_126)
- (let-values ()
- (loop_80
- (srcloc-source v_126)))
- (if (correlated?$1 v_126)
- (let-values ()
- (begin
- (loop_80
- (correlated-e$1
- v_126))
- (loop_80
- (correlated-source$1
- v_126))
- (let-values (((lst_113)
- (correlated-property-symbol-keys$1
- v_126)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_113)))
- ((letrec-values (((for-loop_119)
- (lambda (lst_114)
- (begin
- 'for-loop
- (if (pair?
- lst_114)
- (let-values (((k_27)
- (unsafe-car
- lst_114))
- ((rest_55)
- (unsafe-cdr
- lst_114)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (begin
- (loop_80
- k_27)
- (loop_80
- (correlated-property$1
- v_126
- k_27))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_119
- rest_55)
- (values))))
- (values))))))
- for-loop_119)
- lst_113)))
- (void)))
- (let-values (((c1_25)
- (if (struct-type?
- v_126)
- (prefab-struct-type-key+field-count
- v_126)
- #f)))
- (if c1_25
- ((lambda (k+c_0)
- (begin
- (loop_80
- (car k+c_0))
- (loop_80
- (cdr k+c_0))))
- c1_25)
- (let-values ()
- (void)))))))))))))))))))
- loop_80)
- v_110)
- (values))))
- (let-values (((treat-immutable?_0)
- (lambda (v_128)
- (begin
- 'treat-immutable?
- (let-values (((or-part_153) (not keep-mutable?_0)))
- (if or-part_153 or-part_153 (immutable? v_128)))))))
- (let-values (((path->relative-path-elements_0)
- (let-values ()
- (make-path->relative-path-elements.1 #f unsafe-undefined))))
- (let-values ((()
- (begin
- (if skip-prefix?_0
- (void)
- (let-values () (1/write-bytes fasl-prefix o_0)))
- (values))))
- (let-values (((bstr_7)
- (let-values (((o_1) (open-output-bytes)))
- (begin
- ((letrec-values (((loop_81)
- (lambda (v_25)
+ (loop_85 (car v_176))
+ (loop_85 (cdr v_176)))
+ (if (vector? v_176)
(begin
- 'loop
- (if (not
- (eq?
- (hash-ref shared_0 v_25 1)
- 1))
- (let-values ()
- (let-values (((c_19)
- (hash-ref
- shared_0
- v_25)))
- (if (negative? c_19)
- (let-values ()
+ (let-values (((vec_32 len_13)
+ (let-values (((vec_33)
+ v_176))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-vector
+ vec_33))
+ (values
+ vec_33
+ (unsafe-vector-length
+ vec_33))))))
+ ((letrec-values (((for-loop_147)
+ (lambda (pos_26)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ pos_26
+ len_13)
+ (let-values (((e_25)
+ (unsafe-vector-ref
+ vec_32
+ pos_26)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (loop_85
+ e_25)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_147
+ (unsafe-fx+
+ 1
+ pos_26))
+ (values))))
+ (values))))))
+ for-loop_147)
+ 0))
+ (void))
+ (if (hash? v_176)
+ (hash-for-each
+ v_176
+ (lambda (k_26 v_177)
+ (begin
+ (loop_85 k_26)
+ (loop_85 v_177)))
+ #t)
+ (if (box? v_176)
+ (loop_85 (unbox v_176))
+ (let-values (((cond-val_9)
+ (prefab-struct-key
+ v_176)))
+ (if cond-val_9
+ ((lambda (k_27)
+ (begin
+ (loop_85 k_27)
+ (let-values (((v*_1
+ start*_1
+ stop*_2
+ step*_1)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (unsafe-normalise-inputs
+ unsafe-vector-length
+ (struct->vector
+ v_176)
+ 1
+ #f
+ 1)
+ (normalise-inputs
+ 'in-vector
+ "vector"
+ (lambda (x_47)
+ (vector?
+ x_47))
+ (lambda (x_48)
+ (unsafe-vector-length
+ x_48))
+ (struct->vector
+ v_176)
+ 1
+ #f
+ 1))))
+ ((letrec-values (((for-loop_148)
+ (lambda (idx_1)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ idx_1
+ stop*_2)
+ (let-values (((e_26)
+ (unsafe-vector-ref
+ v*_1
+ idx_1)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (loop_85
+ e_26)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_148
+ (unsafe-fx+
+ idx_1
+ 1))
+ (values))))
+ (values))))))
+ for-loop_148)
+ start*_1))
+ (void)))
+ cond-val_9)
+ (if (srcloc? v_176)
+ (loop_85
+ (srcloc-source v_176))
+ (if (correlated?$1 v_176)
(begin
- (1/write-byte
- fasl-graph-ref-type
- o_1)
- (write-fasl-integer
- (sub1 (- c_19))
- o_1)))
- (let-values ()
- (let-values (((pos_17)
- shared-counter_0))
- (begin
- (set! shared-counter_0
- (add1
- shared-counter_0))
- (1/write-byte
- fasl-graph-def-type
- o_1)
- (write-fasl-integer
- pos_17
- o_1)
- (hash-remove!
- shared_0
- v_25)
- (loop_81 v_25)
- (hash-set!
+ (loop_85
+ (correlated-e$1 v_176))
+ (loop_85
+ (correlated-source$1
+ v_176))
+ (let-values (((lst_167)
+ (correlated-property-symbol-keys$1
+ v_176)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_167))
+ ((letrec-values (((for-loop_149)
+ (lambda (lst_168)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_168)
+ (let-values (((k_28)
+ (unsafe-car
+ lst_168))
+ ((rest_80)
+ (unsafe-cdr
+ lst_168)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (begin
+ (loop_85
+ k_28)
+ (loop_85
+ (correlated-property$1
+ v_176
+ k_28)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_149
+ rest_80)
+ (values))))
+ (values))))))
+ for-loop_149)
+ lst_167)))
+ (void))
+ (let-values (((cond-val_10)
+ (if (struct-type?
+ v_176)
+ (prefab-struct-type-key+field-count
+ v_176)
+ #f)))
+ (if cond-val_10
+ ((lambda (k+c_0)
+ (begin
+ (loop_85
+ (car k+c_0))
+ (loop_85
+ (cdr k+c_0))))
+ cond-val_10)
+ (void))))))))))))))))))
+ loop_85)
+ v_175)
+ (values))))
+ (let-values (((treat-immutable?_0)
+ (lambda (v_178)
+ (begin
+ 'treat-immutable?
+ (let-values (((or-part_276) (not keep-mutable?_0)))
+ (if or-part_276 or-part_276 (immutable? v_178)))))))
+ (let-values (((path->relative-path-elements_0)
+ (make-path->relative-path-elements.1 #f unsafe-undefined)))
+ (let-values ((()
+ (begin
+ (if skip-prefix?_0 (void) (1/write-bytes fasl-prefix o_0))
+ (values))))
+ (let-values (((bstr_7)
+ (let-values (((o_1) (open-output-bytes)))
+ (begin
+ ((letrec-values (((loop_86)
+ (lambda (v_179)
+ (begin
+ 'loop
+ (if (not
+ (eq?
+ (hash-ref shared_0 v_179 1)
+ 1))
+ (let-values (((c_23)
+ (hash-ref
shared_0
- v_25
- (-
- (add1 pos_17)))))))))
- (if (not v_25)
- (let-values ()
+ v_179)))
+ (if (negative? c_23)
+ (begin
(1/write-byte
- fasl-false-type
+ fasl-graph-ref-type
+ o_1)
+ (write-fasl-integer
+ (sub1 (- c_23))
o_1))
- (if (eq? v_25 #t)
- (let-values ()
+ (let-values (((pos_27)
+ shared-counter_0))
+ (begin
+ (set! shared-counter_0
+ (add1 shared-counter_0))
(1/write-byte
- fasl-true-type
- o_1))
- (if (null? v_25)
- (let-values ()
+ fasl-graph-def-type
+ o_1)
+ (write-fasl-integer
+ pos_27
+ o_1)
+ (hash-remove! shared_0 v_179)
+ (loop_86 v_179)
+ (hash-set!
+ shared_0
+ v_179
+ (- (add1 pos_27)))))))
+ (if (not v_179)
+ (1/write-byte fasl-false-type o_1)
+ (if (eq? v_179 #t)
+ (1/write-byte fasl-true-type o_1)
+ (if (null? v_179)
+ (1/write-byte
+ fasl-null-type
+ o_1)
+ (if (void? v_179)
+ (1/write-byte
+ fasl-void-type
+ o_1)
+ (if (eof-object? v_179)
(1/write-byte
- fasl-null-type
- o_1))
- (if (void? v_25)
- (let-values ()
- (1/write-byte
- fasl-void-type
- o_1))
- (if (eof-object? v_25)
- (let-values ()
+ fasl-eof-type
+ o_1)
+ (if (exact-integer? v_179)
+ (if (<=
+ fasl-lowest-small-integer
+ v_179
+ fasl-highest-small-integer)
(1/write-byte
- fasl-eof-type
- o_1))
- (if (exact-integer? v_25)
- (let-values ()
- (if (<=
- fasl-lowest-small-integer
- v_25
- fasl-highest-small-integer)
- (let-values ()
- (1/write-byte
- (+
- fasl-small-integer-start
- (-
- v_25
- fasl-lowest-small-integer))
- o_1))
- (let-values ()
- (begin
- (1/write-byte
- fasl-integer-type
- o_1)
- (write-fasl-integer
- v_25
- o_1)))))
- (if (flonum? v_25)
- (let-values ()
- (begin
- (1/write-byte
- fasl-flonum-type
- o_1)
- (1/write-bytes
- (if (eqv?
- v_25
- +nan.0)
- #"\0\0\0\0\0\0\370\177"
- (real->floating-point-bytes
- v_25
- 8
- #f))
- o_1)))
- (if (single-flonum?
- v_25)
- (let-values ()
+ (+
+ fasl-small-integer-start
+ (-
+ v_179
+ fasl-lowest-small-integer))
+ o_1)
+ (begin
+ (1/write-byte
+ fasl-integer-type
+ o_1)
+ (write-fasl-integer
+ v_179
+ o_1)))
+ (if (flonum? v_179)
+ (begin
+ (1/write-byte
+ fasl-flonum-type
+ o_1)
+ (write-fasl-flonum
+ v_179
+ o_1))
+ (if (single-flonum?
+ v_179)
+ (begin
+ (1/write-byte
+ fasl-single-flonum-type
+ o_1)
+ (1/write-bytes
+ (if (eqv?
+ v_179
+ (real->single-flonum
+ +nan.0))
+ #"\0\0\300\177"
+ (real->floating-point-bytes
+ v_179
+ 4
+ #f))
+ o_1))
+ (if (extflonum? v_179)
+ (let-values ((()
+ (begin
+ (1/write-byte
+ fasl-extflonum-type
+ o_1)
+ (values))))
+ (let-values (((bstr_8)
+ (string->bytes/utf-8
+ (format
+ "~a"
+ v_179))))
+ (begin
+ (write-fasl-integer
+ (bytes-length
+ bstr_8)
+ o_1)
+ (1/write-bytes
+ bstr_8
+ o_1))))
+ (if (rational?
+ v_179)
(begin
(1/write-byte
- fasl-single-flonum-type
+ fasl-rational-type
o_1)
- (1/write-bytes
- (if (eqv?
- v_25
- (real->single-flonum
- +nan.0))
- #"\0\0\300\177"
- (real->floating-point-bytes
- v_25
- 4
- #f))
- o_1)))
- (if (extflonum?
- v_25)
- (let-values ()
- (let-values ((()
- (begin
- (1/write-byte
- fasl-extflonum-type
- o_1)
- (values))))
- (let-values (((bstr_8)
- (string->bytes/utf-8
- (format
- "~a"
- v_25))))
- (begin
- (write-fasl-integer
- (bytes-length
- bstr_8)
- o_1)
- (1/write-bytes
- bstr_8
- o_1)))))
- (if (rational?
- v_25)
- (let-values ()
+ (loop_86
+ (numerator
+ v_179))
+ (loop_86
+ (denominator
+ v_179)))
+ (if (complex?
+ v_179)
+ (begin
+ (1/write-byte
+ fasl-complex-type
+ o_1)
+ (loop_86
+ (real-part
+ v_179))
+ (loop_86
+ (imag-part
+ v_179)))
+ (if (char?
+ v_179)
(begin
(1/write-byte
- fasl-rational-type
+ fasl-char-type
o_1)
- (loop_81
- (numerator
- v_25))
- (loop_81
- (denominator
- v_25))))
- (if (complex?
- v_25)
- (let-values ()
- (begin
- (1/write-byte
- fasl-complex-type
- o_1)
- (loop_81
- (real-part
- v_25))
- (loop_81
- (imag-part
- v_25))))
- (if (char?
- v_25)
- (let-values ()
- (begin
- (1/write-byte
- fasl-char-type
- o_1)
- (write-fasl-integer
- (char->integer
- v_25)
- o_1)))
- (if (symbol?
- v_25)
- (let-values ()
- (let-values ((()
- (begin
- (if (symbol-interned?
- v_25)
- (let-values ()
- (1/write-byte
- fasl-symbol-type
- o_1))
- (if (symbol-unreadable?
- v_25)
- (let-values ()
- (1/write-byte
- fasl-unreadable-symbol-type
- o_1))
- (let-values ()
- (1/write-byte
- fasl-uninterned-symbol-type
- o_1))))
- (values))))
- (let-values (((bstr_9)
- (string->bytes/utf-8
- (symbol->string
- v_25))))
- (begin
- (write-fasl-integer
- (bytes-length
- bstr_9)
- o_1)
- (1/write-bytes
- bstr_9
- o_1)))))
- (if (keyword?
- v_25)
- (let-values ()
- (let-values ((()
- (begin
- (1/write-byte
- fasl-keyword-type
- o_1)
- (values))))
- (let-values (((bstr_10)
- (string->bytes/utf-8
- (keyword->string
- v_25))))
- (begin
- (write-fasl-integer
- (bytes-length
- bstr_10)
- o_1)
- (1/write-bytes
- bstr_10
- o_1)))))
- (if (string?
- v_25)
- (let-values ()
- (begin
- (write-fasl-integer
- (if (treat-immutable?_0
- v_25)
- fasl-immutable-string-type
- fasl-string-type)
- o_1)
- (write-fasl-string
- v_25
- o_1)))
- (if (bytes?
- v_25)
- (let-values ()
- (begin
- (write-fasl-integer
- (if (treat-immutable?_0
- v_25)
- fasl-immutable-bytes-type
- fasl-bytes-type)
- o_1)
- (write-fasl-bytes
- v_25
- o_1)))
- (if (path-for-some-system?
- v_25)
- (let-values ()
- (let-values (((rel-elems_0)
- (path->relative-path-elements_0
- v_25)))
- (if rel-elems_0
- (let-values ()
- (begin
+ (write-fasl-integer
+ (char->integer
+ v_179)
+ o_1))
+ (if (symbol?
+ v_179)
+ (let-values ((()
+ (begin
+ (if (symbol-interned?
+ v_179)
+ (1/write-byte
+ fasl-symbol-type
+ o_1)
+ (if (symbol-unreadable?
+ v_179)
(1/write-byte
- fasl-relative-path-type
+ fasl-unreadable-symbol-type
o_1)
- (loop_81
- rel-elems_0)))
- (let-values ()
- (begin
(1/write-byte
- fasl-path-type
- o_1)
- (write-fasl-bytes
- (path->bytes
- v_25)
- o_1)
- (loop_81
- (path-convention-type
- v_25)))))))
- (if (if (srcloc?
- v_25)
- (let-values (((src_0)
- (srcloc-source
- v_25)))
- (let-values (((or-part_46)
- (not
- src_0)))
- (if or-part_46
- or-part_46
- (let-values (((or-part_47)
- (path-for-some-system?
- src_0)))
- (if or-part_47
- or-part_47
- (let-values (((or-part_48)
- (string?
- src_0)))
- (if or-part_48
- or-part_48
- (let-values (((or-part_49)
- (bytes?
- src_0)))
- (if or-part_49
- or-part_49
- (symbol?
- src_0))))))))))
- #f)
- (let-values ()
- (let-values (((src_1)
+ fasl-uninterned-symbol-type
+ o_1)))
+ (values))))
+ (let-values (((bstr_9)
+ (string->bytes/utf-8
+ (symbol->string
+ v_179))))
+ (begin
+ (write-fasl-integer
+ (bytes-length
+ bstr_9)
+ o_1)
+ (1/write-bytes
+ bstr_9
+ o_1))))
+ (if (keyword?
+ v_179)
+ (let-values ((()
+ (begin
+ (1/write-byte
+ fasl-keyword-type
+ o_1)
+ (values))))
+ (let-values (((bstr_10)
+ (string->bytes/utf-8
+ (keyword->string
+ v_179))))
+ (begin
+ (write-fasl-integer
+ (bytes-length
+ bstr_10)
+ o_1)
+ (1/write-bytes
+ bstr_10
+ o_1))))
+ (if (string?
+ v_179)
+ (begin
+ (write-fasl-integer
+ (if (treat-immutable?_0
+ v_179)
+ fasl-immutable-string-type
+ fasl-string-type)
+ o_1)
+ (write-fasl-string
+ v_179
+ o_1))
+ (if (bytes?
+ v_179)
+ (begin
+ (write-fasl-integer
+ (if (treat-immutable?_0
+ v_179)
+ fasl-immutable-bytes-type
+ fasl-bytes-type)
+ o_1)
+ (write-fasl-bytes
+ v_179
+ o_1))
+ (if (path-for-some-system?
+ v_179)
+ (let-values (((rel-elems_0)
+ (path->relative-path-elements_0
+ v_179)))
+ (if rel-elems_0
+ (begin
+ (1/write-byte
+ fasl-relative-path-type
+ o_1)
+ (loop_86
+ rel-elems_0))
+ (begin
+ (1/write-byte
+ fasl-path-type
+ o_1)
+ (write-fasl-bytes
+ (path->bytes
+ v_179)
+ o_1)
+ (loop_86
+ (path-convention-type
+ v_179)))))
+ (if (if (srcloc?
+ v_179)
+ (let-values (((src_0)
(srcloc-source
- v_25)))
- (let-values (((new-src_0)
- (if (if (path?
- src_1)
- (not
- (path->relative-path-elements_0
- src_1))
- #f)
- (let-values ()
- (truncate-path
- src_1))
- (let-values ()
- src_1))))
- (begin
- (write-fasl-integer
- fasl-srcloc-type
- o_1)
- (loop_81
- new-src_0)
- (loop_81
- (srcloc-line
- v_25))
- (loop_81
- (srcloc-column
- v_25))
- (loop_81
- (srcloc-position
- v_25))
- (loop_81
- (srcloc-span
- v_25))))))
+ v_179)))
+ (let-values (((or-part_277)
+ (not
+ src_0)))
+ (if or-part_277
+ or-part_277
+ (let-values (((or-part_278)
+ (path-for-some-system?
+ src_0)))
+ (if or-part_278
+ or-part_278
+ (let-values (((or-part_279)
+ (string?
+ src_0)))
+ (if or-part_279
+ or-part_279
+ (let-values (((or-part_280)
+ (bytes?
+ src_0)))
+ (if or-part_280
+ or-part_280
+ (symbol?
+ src_0))))))))))
+ #f)
+ (let-values (((src_1)
+ (srcloc-source
+ v_179)))
+ (let-values (((new-src_0)
+ (if (if (path?
+ src_1)
+ (not
+ (path->relative-path-elements_0
+ src_1))
+ #f)
+ (truncate-path
+ src_1)
+ src_1)))
+ (begin
+ (write-fasl-integer
+ fasl-srcloc-type
+ o_1)
+ (loop_86
+ new-src_0)
+ (loop_86
+ (srcloc-line
+ v_179))
+ (loop_86
+ (srcloc-column
+ v_179))
+ (loop_86
+ (srcloc-position
+ v_179))
+ (loop_86
+ (srcloc-span
+ v_179)))))
+ (if (pair?
+ v_179)
(if (pair?
- v_25)
- (let-values ()
- (if (pair?
- (cdr
- v_25))
- (let-values ()
- (let-values (((n_22
- normal-list?_0)
- ((letrec-values (((loop_82)
- (lambda (v_129
- len_14)
- (begin
- 'loop
- (if (null?
- v_129)
- (let-values ()
- (values
- len_14
- #t))
- (if (pair?
- v_129)
- (let-values ()
- (loop_82
- (cdr
- v_129)
- (add1
- len_14)))
- (let-values ()
- (values
- len_14
- #f))))))))
- loop_82)
- v_25
- 0)))
- (begin
- (1/write-byte
- (if normal-list?_0
- fasl-list-type
- fasl-list*-type)
- o_1)
- (write-fasl-integer
- n_22
- o_1)
- ((letrec-values (((ploop_0)
- (lambda (v_40)
- (begin
- 'ploop
- (if (pair?
- v_40)
- (let-values ()
- (begin
- (loop_81
- (car
- v_40))
- (ploop_0
- (cdr
- v_40))))
- (let-values ()
- (if normal-list?_0
- (void)
- (let-values ()
- (loop_81
- v_40)))))))))
- ploop_0)
- v_25))))
- (let-values ()
- (begin
- (1/write-byte
- fasl-pair-type
- o_1)
- (loop_81
- (car
- v_25))
- (loop_81
- (cdr
- v_25))))))
- (if (vector?
- v_25)
- (let-values ()
+ (cdr
+ v_179))
+ (let-values (((n_22
+ normal-list?_0)
+ ((letrec-values (((loop_87)
+ (lambda (v_180
+ len_14)
+ (begin
+ 'loop
+ (if (null?
+ v_180)
+ (values
+ len_14
+ #t)
+ (if (pair?
+ v_180)
+ (loop_87
+ (cdr
+ v_180)
+ (add1
+ len_14))
+ (values
+ len_14
+ #f)))))))
+ loop_87)
+ v_179
+ 0)))
+ (begin
+ (1/write-byte
+ (if normal-list?_0
+ fasl-list-type
+ fasl-list*-type)
+ o_1)
+ (write-fasl-integer
+ n_22
+ o_1)
+ ((letrec-values (((ploop_0)
+ (lambda (v_181)
+ (begin
+ 'ploop
+ (if (pair?
+ v_181)
+ (begin
+ (loop_86
+ (car
+ v_181))
+ (ploop_0
+ (cdr
+ v_181)))
+ (if normal-list?_0
+ (void)
+ (loop_86
+ v_181)))))))
+ ploop_0)
+ v_179)))
+ (begin
+ (1/write-byte
+ fasl-pair-type
+ o_1)
+ (loop_86
+ (car
+ v_179))
+ (loop_86
+ (cdr
+ v_179))))
+ (if (vector?
+ v_179)
+ (begin
+ (1/write-byte
+ (if (treat-immutable?_0
+ v_179)
+ fasl-immutable-vector-type
+ fasl-vector-type)
+ o_1)
+ (write-fasl-integer
+ (vector-length
+ v_179)
+ o_1)
+ (let-values (((vec_34
+ len_15)
+ (let-values (((vec_35)
+ v_179))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-vector
+ vec_35))
+ (values
+ vec_35
+ (unsafe-vector-length
+ vec_35))))))
+ ((letrec-values (((for-loop_150)
+ (lambda (pos_28)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ pos_28
+ len_15)
+ (let-values (((e_27)
+ (unsafe-vector-ref
+ vec_34
+ pos_28)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (loop_86
+ e_27)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_150
+ (unsafe-fx+
+ 1
+ pos_28))
+ (values))))
+ (values))))))
+ for-loop_150)
+ 0))
+ (void))
+ (if (flvector?
+ v_179)
+ (begin
+ (1/write-byte
+ fasl-flvector-type
+ o_1)
+ (write-fasl-integer
+ (flvector-length
+ v_179)
+ o_1)
+ (let-values (((vec_36
+ len_16)
+ (let-values (((vec_37)
+ v_179))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-flvector
+ vec_37))
+ (values
+ vec_37
+ (unsafe-flvector-length
+ vec_37))))))
+ ((letrec-values (((for-loop_151)
+ (lambda (pos_29)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ pos_29
+ len_16)
+ (let-values (((e_28)
+ (unsafe-flvector-ref
+ vec_36
+ pos_29)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (write-fasl-flonum
+ e_28
+ o_1)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_151
+ (unsafe-fx+
+ 1
+ pos_29))
+ (values))))
+ (values))))))
+ for-loop_151)
+ 0))
+ (void))
+ (if (fxvector?
+ v_179)
(begin
(1/write-byte
- (if (treat-immutable?_0
- v_25)
- fasl-immutable-vector-type
- fasl-vector-type)
+ fasl-fxvector-type
o_1)
(write-fasl-integer
- (vector-length
- v_25)
+ (fxvector-length
+ v_179)
o_1)
- (let-values (((vec_34
- len_15)
- (let-values (((vec_35)
- v_25))
+ (let-values (((vec_38
+ len_17)
+ (let-values (((vec_39)
+ v_179))
(begin
- (check-vector
- vec_35)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-fxvector
+ vec_39))
(values
- vec_35
- (unsafe-vector-length
- vec_35))))))
- (begin
- #f
- ((letrec-values (((for-loop_120)
- (lambda (pos_18)
- (begin
- 'for-loop
- (if (unsafe-fx<
- pos_18
- len_15)
- (let-values (((e_26)
- (unsafe-vector-ref
- vec_34
- pos_18)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (loop_81
- e_26))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_120
- (unsafe-fx+
- 1
- pos_18))
- (values))))
- (values))))))
- for-loop_120)
- 0)))
- (void)))
- (if (box?
- v_25)
- (let-values ()
+ vec_39
+ (unsafe-fxvector-length
+ vec_39))))))
+ ((letrec-values (((for-loop_152)
+ (lambda (pos_30)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ pos_30
+ len_17)
+ (let-values (((e_29)
+ (unsafe-fxvector-ref
+ vec_38
+ pos_30)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (write-fasl-integer
+ e_29
+ o_1)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_152
+ (unsafe-fx+
+ 1
+ pos_30))
+ (values))))
+ (values))))))
+ for-loop_152)
+ 0))
+ (void))
+ (if (box?
+ v_179)
(begin
(1/write-byte
(if (treat-immutable?_0
- v_25)
+ v_179)
fasl-immutable-box-type
fasl-box-type)
o_1)
- (loop_81
+ (loop_86
(unbox
- v_25))))
- (let-values (((c4_0)
- (prefab-struct-key
- v_25)))
- (if c4_0
- ((lambda (k_28)
- (let-values ((()
- (begin
- (1/write-byte
- fasl-prefab-type
- o_1)
- (values))))
+ v_179)))
+ (let-values (((cond-val_11)
+ (prefab-struct-key
+ v_179)))
+ (if cond-val_11
+ ((lambda (k_29)
(let-values ((()
(begin
- (loop_81
- k_28)
+ (1/write-byte
+ fasl-prefab-type
+ o_1)
(values))))
- (let-values (((vec_36)
- (struct->vector
- v_25)))
- (begin
- (write-fasl-integer
- (sub1
- (vector-length
- vec_36))
- o_1)
- (let-values (((v*_2
- start*_2
- stop*_3
- step*_2)
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (unsafe-normalise-inputs
- unsafe-vector-length
- vec_36
- 1
- #f
- 1)
- (normalise-inputs
- 'in-vector
- "vector"
- (lambda (x_45)
- (vector?
- x_45))
- (lambda (x_46)
- (unsafe-vector-length
- x_46))
- vec_36
- 1
- #f
- 1))))
- (begin
- #t
- ((letrec-values (((for-loop_121)
+ (let-values ((()
+ (begin
+ (loop_86
+ k_29)
+ (values))))
+ (let-values (((vec_40)
+ (struct->vector
+ v_179)))
+ (begin
+ (write-fasl-integer
+ (sub1
+ (vector-length
+ vec_40))
+ o_1)
+ (let-values (((v*_2
+ start*_2
+ stop*_3
+ step*_2)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (unsafe-normalise-inputs
+ unsafe-vector-length
+ vec_40
+ 1
+ #f
+ 1)
+ (normalise-inputs
+ 'in-vector
+ "vector"
+ (lambda (x_49)
+ (vector?
+ x_49))
+ (lambda (x_50)
+ (unsafe-vector-length
+ x_50))
+ vec_40
+ 1
+ #f
+ 1))))
+ ((letrec-values (((for-loop_153)
(lambda (idx_2)
(begin
'for-loop
(if (unsafe-fx<
idx_2
stop*_3)
- (let-values (((e_27)
+ (let-values (((e_30)
(unsafe-vector-ref
v*_2
idx_2)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (loop_81
- e_27))
- (values)))))
- (values)))))
+ (let-values ((()
+ (begin
+ (loop_86
+ e_30)
+ (values))))
+ (values))))
(if (not
#f)
- (for-loop_121
+ (for-loop_153
(unsafe-fx+
idx_2
1))
(values))))
(values))))))
- for-loop_121)
- start*_2)))
- (void))))))
- c4_0)
- (if (hash?
- v_25)
- (let-values ()
+ for-loop_153)
+ start*_2))
+ (void))))))
+ cond-val_11)
+ (if (hash?
+ v_179)
(begin
(1/write-byte
(if (treat-immutable?_0
- v_25)
+ v_179)
fasl-immutable-hash-type
fasl-hash-type)
o_1)
(1/write-byte
(if (hash-eq?
- v_25)
- (let-values ()
- fasl-hash-eq-variant)
+ v_179)
+ fasl-hash-eq-variant
(if (hash-eqv?
- v_25)
- (let-values ()
- fasl-hash-eqv-variant)
+ v_179)
+ fasl-hash-eqv-variant
(if (hash-equal-always?
- v_25)
- (let-values ()
- fasl-hash-equal-always-variant)
- (let-values ()
- fasl-hash-equal-variant))))
+ v_179)
+ fasl-hash-equal-always-variant
+ fasl-hash-equal-variant)))
o_1)
(write-fasl-integer
(hash-count
- v_25)
+ v_179)
o_1)
(hash-for-each
- v_25
- (lambda (k_29
- v_61)
+ v_179
+ (lambda (k_30
+ v_182)
(begin
- (loop_81
- k_29)
- (loop_81
- v_61)))
- #t)))
- (if (regexp?
- v_25)
- (let-values ()
+ (loop_86
+ k_30)
+ (loop_86
+ v_182)))
+ #t))
+ (if (regexp?
+ v_179)
(begin
(1/write-byte
(if (pregexp?
- v_25)
+ v_179)
fasl-pregexp-type
fasl-regexp-type)
o_1)
(write-fasl-string
(object-name
- v_25)
- o_1)))
- (if (byte-regexp?
- v_25)
- (let-values ()
+ v_179)
+ o_1))
+ (if (byte-regexp?
+ v_179)
(begin
(1/write-byte
(if (byte-pregexp?
- v_25)
+ v_179)
fasl-byte-pregexp-type
fasl-byte-regexp-type)
o_1)
(write-fasl-bytes
(object-name
- v_25)
- o_1)))
- (if (correlated?$1
- v_25)
- (let-values ()
+ v_179)
+ o_1))
+ (if (correlated?$1
+ v_179)
(begin
(1/write-byte
fasl-correlated-type
o_1)
- (loop_81
+ (loop_86
(correlated-e$1
- v_25))
- (loop_81
+ v_179))
+ (loop_86
(srcloc
(correlated-source$1
- v_25)
+ v_179)
(correlated-line$1
- v_25)
+ v_179)
(correlated-column$1
- v_25)
+ v_179)
(correlated-position$1
- v_25)
+ v_179)
(correlated-span$1
- v_25)))
- (loop_81
+ v_179)))
+ (loop_86
(reverse$1
- (let-values (((lst_115)
- (correlated-property-symbol-keys$1
- v_25)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
+ (let-values (((fold-var_192)
+ (let-values (((fold-var_193)
+ null))
+ fold-var_193)))
+ (let-values (((lst_169)
+ (correlated-property-symbol-keys$1
+ v_179)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
(check-list
- lst_115)))
- ((letrec-values (((for-loop_56)
- (lambda (fold-var_113
- lst_116)
- (begin
- 'for-loop
- (if (pair?
- lst_116)
- (let-values (((k_30)
- (unsafe-car
- lst_116))
- ((rest_56)
- (unsafe-cdr
- lst_116)))
- (let-values (((fold-var_114)
- (let-values (((fold-var_115)
- fold-var_113))
- (let-values (((fold-var_116)
- (let-values ()
- (cons
- (let-values ()
- (cons
- k_30
- (correlated-property$1
- v_25
- k_30)))
- fold-var_115))))
+ lst_169))
+ ((letrec-values (((for-loop_154)
+ (lambda (fold-var_194
+ lst_170)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_170)
+ (let-values (((k_31)
+ (unsafe-car
+ lst_170))
+ ((rest_81)
+ (unsafe-cdr
+ lst_170)))
+ (let-values (((fold-var_195)
+ (let-values (((fold-var_196)
+ (cons
+ (cons
+ k_31
+ (correlated-property$1
+ v_179
+ k_31))
+ fold-var_194)))
(values
- fold-var_116)))))
- (if (not
- #f)
- (for-loop_56
- fold-var_114
- rest_56)
- fold-var_114)))
- fold-var_113)))))
- for-loop_56)
- null
- lst_115)))))))
- (if (eq?
- v_25
- unsafe-undefined)
- (let-values ()
+ fold-var_196))))
+ (if (not
+ #f)
+ (for-loop_154
+ fold-var_195
+ rest_81)
+ fold-var_195)))
+ fold-var_194)))))
+ for-loop_154)
+ fold-var_192
+ lst_169)))))))
+ (if (eq?
+ v_179
+ unsafe-undefined)
(1/write-byte
fasl-undefined-type
- o_1))
- (let-values (((c3_0)
- (if (struct-type?
- v_25)
- (prefab-struct-type-key+field-count
- v_25)
- #f)))
- (if c3_0
- ((lambda (k+c_1)
- (begin
- (1/write-byte
- fasl-prefab-type-type
- o_1)
- (loop_81
- (car
- k+c_1))
- (loop_81
- (cdr
- k+c_1))))
- c3_0)
- (let-values ()
+ o_1)
+ (let-values (((cond-val_12)
+ (if (struct-type?
+ v_179)
+ (prefab-struct-type-key+field-count
+ v_179)
+ #f)))
+ (if cond-val_12
+ ((lambda (k+c_1)
+ (begin
+ (1/write-byte
+ fasl-prefab-type-type
+ o_1)
+ (loop_86
+ (car
+ k+c_1))
+ (loop_86
+ (cdr
+ k+c_1))))
+ cond-val_12)
(if handle-fail_0
- (loop_81
+ (loop_86
(handle-fail_0
- v_25))
+ v_179))
(raise-arguments-error
's-exp->fasl
"cannot write value"
"value"
- v_25))))))))))))))))))))))))))))))))))))))
- loop_81)
- v_110)
- (get-output-bytes o_1 #t)))))
- (begin
- (write-fasl-integer shared-counter_0 o_0)
- (write-fasl-integer (bytes-length bstr_7) o_0)
- (1/write-bytes bstr_7 o_0)
- (if orig-o_0 (void) (get-output-bytes o_0)))))))))))))))))))))))))
+ v_179)))))))))))))))))))))))))))))))))))))))
+ loop_86)
+ v_175)
+ (get-output-bytes o_1 #t)))))
+ (begin
+ (write-fasl-integer shared-counter_0 o_0)
+ (write-fasl-integer (bytes-length bstr_7) o_0)
+ (1/write-bytes bstr_7 o_0)
+ (if orig-o_0 (void) (get-output-bytes o_0))))))))))))))))))))))))
(define-values
(fasl->s-exp.1)
(lambda (datum-intern?16_0 external-lifts17_0 skip-prefix?18_0 orig-i22_0)
@@ -19719,1030 +19679,1089 @@
(let-values (((intern?_0) datum-intern?16_0))
(let-values (((external-lifts_0) (if (eq? external-lifts17_0 unsafe-undefined) '#() external-lifts17_0)))
(let-values (((skip-prefix?_1) skip-prefix?18_0))
- (let-values ()
- (let-values (((init-i_0)
- (if (bytes? orig-i_0)
- (let-values () (mcons orig-i_0 0))
- (if (input-port? orig-i_0)
- (let-values () orig-i_0)
- (let-values ()
- (raise-argument-error 'fasl->s-exp "(or/c bytes? input-port?)" orig-i_0))))))
- (let-values ((()
- (begin
- (if skip-prefix?_1
+ (let-values (((init-i_0)
+ (if (bytes? orig-i_0)
+ (mcons orig-i_0 0)
+ (if (input-port? orig-i_0)
+ orig-i_0
+ (raise-argument-error 'fasl->s-exp "(or/c bytes? input-port?)" orig-i_0)))))
+ (let-values ((()
+ (begin
+ (if skip-prefix?_1
+ (void)
+ (if (bytes=? (read-bytes/exactly* fasl-prefix-length init-i_0) fasl-prefix)
(void)
- (let-values ()
- (if (bytes=? (read-bytes/exactly* fasl-prefix-length init-i_0) fasl-prefix)
+ (read-error "unrecognized prefix")))
+ (values))))
+ (let-values (((shared-count_0) (read-fasl-integer* init-i_0)))
+ (let-values (((shared_1) (make-vector shared-count_0)))
+ (let-values ((()
+ (begin
+ (if (if (vector? external-lifts_0)
+ (<= (vector-length external-lifts_0) shared-count_0)
+ #f)
(void)
- (let-values () (read-error "unrecognized prefix")))))
- (values))))
- (let-values (((shared-count_0) (read-fasl-integer* init-i_0)))
- (let-values (((shared_1) (make-vector shared-count_0)))
+ (error 'fasl->s-exp "external-lift vector does not match expected size"))
+ (values))))
(let-values ((()
(begin
- (if (if (vector? external-lifts_0)
- (<= (vector-length external-lifts_0) shared-count_0)
- #f)
- (void)
- (let-values ()
- (error 'fasl->s-exp "external-lift vector does not match expected size")))
- (values))))
- (let-values ((()
- (begin
- (let-values (((vec_37 len_16)
- (let-values (((vec_38) external-lifts_0))
- (begin
- (check-vector vec_38)
- (values vec_38 (unsafe-vector-length vec_38)))))
- ((start_19) 0))
- (begin
- #f
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-naturals start_19)))
- ((letrec-values (((for-loop_122)
- (lambda (pos_19 pos_20)
- (begin
- 'for-loop
- (if (if (unsafe-fx< pos_19 len_16) #t #f)
- (let-values (((v_130)
- (unsafe-vector-ref vec_37 pos_19))
- ((pos_21) pos_20))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (vector-set!
- shared_1
- pos_21
- (vector-ref
- external-lifts_0
- pos_21)))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_122
- (unsafe-fx+ 1 pos_19)
- (+ pos_20 1))
- (values))))
- (values))))))
- for-loop_122)
- 0
- start_19)))
- (values))))
- (let-values ()
- (let-values (((len_17) (read-fasl-integer* init-i_0)))
- (let-values (((i_95)
- (if (mpair? init-i_0)
- init-i_0
- (let-values (((bstr_11) (read-bytes/exactly* len_17 init-i_0)))
- (mcons bstr_11 0)))))
- (let-values (((intern_0)
- (lambda (v_131)
- (begin 'intern (if intern?_0 (datum-intern-literal v_131) v_131)))))
- ((letrec-values (((loop_83)
- (lambda ()
+ (let-values (((vec_41 len_18)
+ (let-values (((vec_42) external-lifts_0))
(begin
- 'loop
- (let-values (((type_0) (read-byte/no-eof i_95)))
- (let-values (((tmp_15) type_0))
- (let-values (((index_0)
- (if (fixnum? tmp_15)
- (if (if (unsafe-fx>= tmp_15 1)
- (unsafe-fx< tmp_15 43)
- #f)
- (let-values (((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
- 41)))
- (unsafe-vector*-ref
- tbl_0
- (unsafe-fx- tmp_15 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)
- (let-values ()
- (if (>= type_0 fasl-small-integer-start)
- (let-values ()
- (+
- (- type_0 fasl-small-integer-start)
- fasl-lowest-small-integer))
- (let-values ()
- (read-error
- "unrecognized fasl tag"
- "tag"
- type_0))))
- (if (unsafe-fx< index_0 2)
- (let-values ()
- (let-values (((pos_22)
- (read-fasl-integer i_95)))
- (let-values (((v_132) (loop_83)))
- (begin
- (if (< pos_22 shared-count_0)
- (void)
- (let-values ()
- (read-error "bad graph index")))
- (vector-set! shared_1 pos_22 v_132)
- v_132))))
- (if (unsafe-fx< index_0 3)
- (let-values ()
- (let-values (((pos_23)
- (read-fasl-integer i_95)))
- (begin
- (if (< pos_23 shared-count_0)
- (void)
- (let-values ()
- (read-error "bad graph index")))
- (vector-ref shared_1 pos_23))))
- (let-values () #f))))
- (if (unsafe-fx< index_0 6)
- (if (unsafe-fx< index_0 5)
- (let-values () #t)
- (let-values () null))
- (if (unsafe-fx< index_0 7)
- (let-values () (void))
- (if (unsafe-fx< index_0 8)
- (let-values () eof)
- (let-values ()
- (intern_0 (read-fasl-integer i_95)))))))
- (if (unsafe-fx< index_0 14)
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-vector vec_42))
+ (values vec_42 (unsafe-vector-length vec_42)))))
+ ((start_24) 0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-naturals start_24))
+ ((letrec-values (((for-loop_155)
+ (lambda (pos_31 pos_32)
+ (begin
+ 'for-loop
+ (if (if (unsafe-fx< pos_31 len_18) #t #f)
+ (let-values (((v_183)
+ (unsafe-vector-ref vec_41 pos_31))
+ ((pos_33) pos_32))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (vector-set!
+ shared_1
+ pos_33
+ (vector-ref
+ external-lifts_0
+ pos_33))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_155
+ (unsafe-fx+ 1 pos_31)
+ (+ pos_32 1))
+ (values))))
+ (values))))))
+ for-loop_155)
+ 0
+ start_24)))
+ (values))))
+ (let-values ()
+ (let-values (((len_19) (read-fasl-integer* init-i_0)))
+ (let-values (((i_122)
+ (if (mpair? init-i_0)
+ init-i_0
+ (let-values (((bstr_11) (read-bytes/exactly* len_19 init-i_0)))
+ (mcons bstr_11 0)))))
+ (let-values (((intern_0)
+ (lambda (v_184)
+ (begin 'intern (if intern?_0 (datum-intern-literal v_184) v_184)))))
+ ((letrec-values (((loop_88)
+ (lambda ()
+ (begin
+ 'loop
+ (let-values (((type_0) (read-byte/no-eof i_122)))
+ (let-values (((tmp_16) type_0))
+ (let-values (((index_0)
+ (if (fixnum? tmp_16)
+ (if (if (unsafe-fx>= tmp_16 1)
+ (unsafe-fx< tmp_16 45)
+ #f)
+ (let-values (((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
+ 35
+ 36
+ 37
+ 38
+ 39
+ 40
+ 11
+ 41
+ 42
+ 43
+ 34
+ 33)))
+ (unsafe-vector*-ref
+ tbl_0
+ (unsafe-fx- tmp_16 1)))
+ 0)
+ 0)))
+ (if (unsafe-fx< index_0 21)
+ (if (unsafe-fx< index_0 10)
+ (if (unsafe-fx< index_0 4)
+ (if (unsafe-fx< index_0 1)
+ (if (>= type_0 fasl-small-integer-start)
+ (+
+ (- type_0 fasl-small-integer-start)
+ fasl-lowest-small-integer)
+ (read-error
+ "unrecognized fasl tag"
+ "tag"
+ type_0))
+ (if (unsafe-fx< index_0 2)
+ (let-values (((pos_34)
+ (read-fasl-integer i_122)))
+ (let-values (((v_185) (loop_88)))
+ (begin
+ (if (< pos_34 shared-count_0)
+ (void)
+ (read-error "bad graph index"))
+ (vector-set! shared_1 pos_34 v_185)
+ v_185)))
+ (if (unsafe-fx< index_0 3)
+ (let-values (((pos_35)
+ (read-fasl-integer i_122)))
+ (begin
+ (if (< pos_35 shared-count_0)
+ (void)
+ (read-error "bad graph index"))
+ (vector-ref shared_1 pos_35)))
+ #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
+ (if (unsafe-fx< index_0 9)
+ (intern_0 (read-fasl-integer i_122))
+ (read-fasl-flonum i_122))))))
+ (if (unsafe-fx< index_0 15)
+ (if (unsafe-fx< index_0 12)
(if (unsafe-fx< index_0 11)
- (if (unsafe-fx< index_0 10)
- (let-values ()
- (floating-point-bytes->real
- (read-bytes/exactly 8 i_95)
- #f))
- (let-values ()
- (real->single-flonum
- (floating-point-bytes->real
- (read-bytes/exactly 4 i_95)
- #f))))
- (if (unsafe-fx< index_0 12)
- (let-values ()
- (let-values (((bstr_12)
- (read-bytes/exactly
- (read-fasl-integer i_95)
- i_95)))
- (1/string->number
- (bytes->string/utf-8 bstr_12)
- 10
- 'read)))
- (if (unsafe-fx< index_0 13)
- (let-values ()
- (intern_0 (/ (loop_83) (loop_83))))
- (let-values ()
- (intern_0
- (make-rectangular
- (loop_83)
- (loop_83)))))))
+ (real->single-flonum
+ (floating-point-bytes->real
+ (read-bytes/exactly 4 i_122)
+ #f))
+ (let-values (((bstr_12)
+ (read-bytes/exactly
+ (read-fasl-integer i_122)
+ i_122)))
+ (1/string->number
+ (bytes->string/utf-8 bstr_12)
+ 10
+ 'read)))
+ (if (unsafe-fx< index_0 13)
+ (intern_0 (/ (loop_88) (loop_88)))
+ (if (unsafe-fx< index_0 14)
+ (intern_0
+ (make-rectangular (loop_88) (loop_88)))
+ (intern_0
+ (integer->char (read-fasl-integer i_122))))))
+ (if (unsafe-fx< index_0 17)
(if (unsafe-fx< index_0 16)
- (if (unsafe-fx< index_0 15)
- (let-values ()
+ (string->symbol (read-fasl-string i_122))
+ (string->unreadable-symbol
+ (read-fasl-string i_122)))
+ (if (unsafe-fx< index_0 18)
+ (string->uninterned-symbol
+ (read-fasl-string i_122))
+ (if (unsafe-fx< index_0 19)
+ (string->keyword (read-fasl-string i_122))
+ (if (unsafe-fx< index_0 20)
+ (read-fasl-string i_122)
(intern_0
- (integer->char (read-fasl-integer i_95))))
- (let-values ()
- (string->symbol (read-fasl-string i_95))))
- (if (unsafe-fx< index_0 17)
- (let-values ()
- (string->unreadable-symbol
- (read-fasl-string i_95)))
- (if (unsafe-fx< index_0 18)
- (let-values ()
- (string->uninterned-symbol
- (read-fasl-string i_95)))
- (if (unsafe-fx< index_0 19)
- (let-values ()
- (string->keyword
- (read-fasl-string i_95)))
- (let-values ()
- (read-fasl-string i_95))))))))
- (if (unsafe-fx< index_0 30)
- (if (unsafe-fx< index_0 24)
- (if (unsafe-fx< index_0 21)
- (let-values ()
- (intern_0
- (string->immutable-string
- (read-fasl-string i_95))))
- (if (unsafe-fx< index_0 22)
- (let-values () (read-fasl-bytes i_95))
- (if (unsafe-fx< index_0 23)
- (let-values ()
- (intern_0
- (bytes->immutable-bytes
- (read-fasl-bytes i_95))))
- (let-values ()
- (bytes->path
- (read-fasl-bytes i_95)
- (loop_83))))))
- (if (unsafe-fx< index_0 26)
+ (string->immutable-string
+ (read-fasl-string i_122)))))))))
+ (if (unsafe-fx< index_0 32)
+ (if (unsafe-fx< index_0 26)
+ (if (unsafe-fx< index_0 23)
+ (if (unsafe-fx< index_0 22)
+ (read-fasl-bytes i_122)
+ (intern_0
+ (bytes->immutable-bytes
+ (read-fasl-bytes i_122))))
+ (if (unsafe-fx< index_0 24)
+ (bytes->path (read-fasl-bytes i_122) (loop_88))
(if (unsafe-fx< index_0 25)
- (let-values ()
- (let-values (((wrt-dir_1)
- (let-values (((or-part_154)
- (current-load-relative-directory)))
- (if or-part_154
- or-part_154
- (current-directory)))))
- (let-values (((rel-elems_1)
- (reverse$1
- (let-values (((lst_40)
- (loop_83)))
+ (let-values (((wrt-dir_1)
+ (let-values (((or-part_281)
+ (current-load-relative-directory)))
+ (if or-part_281
+ or-part_281
+ (current-directory)))))
+ (let-values (((rel-elems_1)
+ (reverse$1
+ (let-values (((fold-var_197)
+ (let-values (((fold-var_198)
+ null))
+ fold-var_198)))
+ (let-values (((lst_171)
+ (loop_88)))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-list
- lst_40)))
- ((letrec-values (((for-loop_42)
- (lambda (fold-var_117
- lst_41)
+ (check-list lst_171))
+ ((letrec-values (((for-loop_156)
+ (lambda (fold-var_199
+ lst_172)
(begin
'for-loop
(if (pair?
- lst_41)
- (let-values (((p_26)
+ lst_172)
+ (let-values (((p_30)
(unsafe-car
- lst_41))
- ((rest_17)
+ lst_172))
+ ((rest_82)
(unsafe-cdr
- lst_41)))
- (let-values (((fold-var_118)
- (let-values (((fold-var_119)
- fold-var_117))
- (let-values (((fold-var_120)
- (let-values ()
- (cons
- (let-values ()
- (if (bytes?
- p_26)
- (bytes->path-element
- p_26)
- p_26))
- fold-var_119))))
- (values
- fold-var_120)))))
+ lst_172)))
+ (let-values (((fold-var_200)
+ (let-values (((fold-var_201)
+ (cons
+ (if (bytes?
+ p_30)
+ (bytes->path-element
+ p_30)
+ p_30)
+ fold-var_199)))
+ (values
+ fold-var_201))))
(if (not
#f)
- (for-loop_42
- fold-var_118
- rest_17)
- fold-var_118)))
- fold-var_117)))))
- for-loop_42)
- null
- lst_40))))))
- (if wrt-dir_1
- (let-values ()
- (apply
- build-path
- wrt-dir_1
- rel-elems_1))
- (if (null? rel-elems_1)
- (let-values () (build-path 'same))
- (let-values ()
- (apply
- build-path
- rel-elems_1)))))))
- (let-values ()
- (intern_0
- (pregexp (read-fasl-string i_95)))))
- (if (unsafe-fx< index_0 27)
- (let-values ()
- (intern_0 (regexp (read-fasl-string i_95))))
- (if (unsafe-fx< index_0 28)
- (let-values ()
- (intern_0
- (byte-pregexp (read-fasl-bytes i_95))))
- (if (unsafe-fx< index_0 29)
- (let-values ()
- (intern_0
- (byte-regexp (read-fasl-bytes i_95))))
- (let-values ()
- (let-values (((len_18)
- (read-fasl-integer i_95)))
- (reverse$1
- (let-values (((start_20) 0)
- ((end_10) len_18)
- ((inc_4) 1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-range
- start_20
- end_10
- inc_4)))
- ((letrec-values (((for-loop_123)
- (lambda (fold-var_121
- pos_24)
- (begin
- 'for-loop
- (if (<
- pos_24
- end_10)
- (let-values ()
- (let-values (((fold-var_122)
- (let-values (((fold-var_123)
- fold-var_121))
- (let-values (((fold-var_124)
- (let-values ()
- (cons
- (let-values ()
- (loop_83))
- fold-var_123))))
- (values
- fold-var_124)))))
- (if (not
- #f)
- (for-loop_123
- fold-var_122
- (+
- pos_24
- inc_4))
- fold-var_122)))
- fold-var_121)))))
- for-loop_123)
- null
- start_20)))))))))))
- (if (unsafe-fx< index_0 35)
- (if (unsafe-fx< index_0 32)
- (if (unsafe-fx< index_0 31)
- (let-values () (cons (loop_83) (loop_83)))
- (let-values ()
- (let-values (((len_19)
- (read-fasl-integer i_95)))
+ (for-loop_156
+ fold-var_200
+ rest_82)
+ fold-var_200)))
+ fold-var_199)))))
+ for-loop_156)
+ fold-var_197
+ lst_171)))))))
+ (if wrt-dir_1
+ (apply build-path wrt-dir_1 rel-elems_1)
+ (if (null? rel-elems_1)
+ (build-path 'same)
+ (apply build-path rel-elems_1)))))
+ (intern_0
+ (pregexp (read-fasl-string i_122))))))
+ (if (unsafe-fx< index_0 28)
+ (if (unsafe-fx< index_0 27)
+ (intern_0 (regexp (read-fasl-string i_122)))
+ (intern_0
+ (byte-pregexp (read-fasl-bytes i_122))))
+ (if (unsafe-fx< index_0 29)
+ (intern_0 (byte-regexp (read-fasl-bytes i_122)))
+ (if (unsafe-fx< index_0 30)
+ (let-values (((len_20)
+ (read-fasl-integer i_122)))
+ (reverse$1
+ (let-values (((fold-var_202)
+ (let-values (((fold-var_203)
+ null))
+ fold-var_203)))
+ (let-values (((start_25) 0)
+ ((end_10) len_20)
+ ((inc_4) 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range
+ start_25
+ end_10
+ inc_4))
+ ((letrec-values (((for-loop_157)
+ (lambda (fold-var_204
+ pos_36)
+ (begin
+ 'for-loop
+ (if (<
+ pos_36
+ end_10)
+ (let-values ()
+ (let-values (((fold-var_205)
+ (let-values (((fold-var_206)
+ (cons
+ (loop_88)
+ fold-var_204)))
+ (values
+ fold-var_206))))
+ (if (not
+ #f)
+ (for-loop_157
+ fold-var_205
+ (+
+ pos_36
+ inc_4))
+ fold-var_205)))
+ fold-var_204)))))
+ for-loop_157)
+ fold-var_202
+ start_25))))))
+ (if (unsafe-fx< index_0 31)
+ (cons (loop_88) (loop_88))
+ (let-values (((len_21)
+ (read-fasl-integer i_122)))
((letrec-values (((ploop_1)
- (lambda (len_20)
+ (lambda (len_22)
(begin
'ploop
- (if (zero? len_20)
- (loop_83)
+ (if (zero? len_22)
+ (loop_88)
(cons
- (loop_83)
+ (loop_88)
(ploop_1
(sub1
- len_20))))))))
+ len_22))))))))
ploop_1)
- len_19))))
- (if (unsafe-fx< index_0 33)
- (let-values ()
- (let-values (((len_21)
- (read-fasl-integer i_95)))
- (let-values (((vec_39)
- (let-values (((len_22)
- len_21))
+ len_21)))))))
+ (if (unsafe-fx< index_0 37)
+ (if (unsafe-fx< index_0 34)
+ (if (unsafe-fx< index_0 33)
+ (let-values (((len_23)
+ (read-fasl-integer i_122)))
+ (let-values (((vec_43)
+ (let-values (((len_24) len_23))
+ (begin
+ (if (exact-nonnegative-integer?
+ len_24)
+ (void)
+ (1/raise-argument-error
+ 'for/vector
+ "exact-nonnegative-integer?"
+ len_24))
+ (let-values (((v_186)
+ (make-vector
+ len_24
+ 0)))
(begin
- (if (exact-nonnegative-integer?
- len_22)
+ (if (zero? len_24)
(void)
- (let-values ()
- (raise-argument-error
- 'for/vector
- "exact-nonnegative-integer?"
- len_22)))
- (let-values (((v_133)
- (make-vector
- len_22
- 0)))
- (begin
- (if (zero? len_22)
- (void)
- (let-values ()
- (let-values (((start_21)
- 0)
- ((end_11)
- len_21)
- ((inc_5)
- 1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-range
- start_21
- end_11
- inc_5)))
- ((letrec-values (((for-loop_124)
- (lambda (i_96
- pos_25)
- (begin
- 'for-loop
- (if (<
- pos_25
- end_11)
- (let-values (((j_3)
- pos_25))
- (let-values (((i_97)
- (let-values (((i_98)
- i_96))
- (let-values (((i_99)
- (let-values ()
- (begin
- (unsafe-vector*-set!
- v_133
- i_98
- (let-values ()
- (loop_83)))
- (unsafe-fx+
- 1
- i_98)))))
- (values
- i_99)))))
- (if (if (not
- ((lambda x_47
- (unsafe-fx=
- i_97
- len_22))
- j_3))
- (not
- #f)
- #f)
- (for-loop_124
- i_97
- (+
- pos_25
- inc_5))
- i_97)))
- i_96)))))
- for-loop_124)
- 0
- start_21)))))
- v_133))))))
- (if (eqv?
- type_0
- fasl-immutable-vector-type)
- (vector->immutable-vector vec_39)
- vec_39))))
- (if (unsafe-fx< index_0 34)
- (let-values () (box (loop_83)))
- (let-values () (box-immutable (loop_83))))))
- (if (unsafe-fx< index_0 38)
- (if (unsafe-fx< index_0 36)
- (let-values ()
- (let-values (((key_46) (loop_83)))
- (let-values (((len_23)
- (read-fasl-integer i_95)))
- (apply
- make-prefab-struct
- key_46
- (reverse$1
- (let-values (((start_22) 0)
- ((end_12) len_23)
- ((inc_6) 1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-range
- start_22
- end_12
- inc_6)))
- ((letrec-values (((for-loop_125)
- (lambda (fold-var_125
- pos_26)
- (begin
- 'for-loop
- (if (<
- pos_26
- end_12)
- (let-values ()
- (let-values (((fold-var_126)
- (let-values (((fold-var_127)
- fold-var_125))
- (let-values (((fold-var_128)
- (let-values ()
- (cons
- (let-values ()
- (loop_83))
- fold-var_127))))
- (values
- fold-var_128)))))
- (if (not
- #f)
- (for-loop_125
- fold-var_126
- (+
- pos_26
- inc_6))
- fold-var_126)))
- fold-var_125)))))
- for-loop_125)
- null
- start_22))))))))
- (if (unsafe-fx< index_0 37)
- (let-values ()
- (let-values (((ht_83)
- (let-values (((tmp_16)
- (read-byte/no-eof
- i_95)))
- (if (equal? tmp_16 0)
- (let-values ()
- (make-hasheq))
- (if (equal? tmp_16 2)
- (let-values ()
- (make-hasheqv))
- (if (equal? tmp_16 3)
- (let-values ()
- (make-hashalw))
- (let-values ()
- (make-hash))))))))
- (let-values (((len_24)
- (read-fasl-integer i_95)))
+ (let-values (((i_123)
+ (let-values (((i_124)
+ 0))
+ i_124)))
+ (let-values (((start_26)
+ 0)
+ ((end_11)
+ len_23)
+ ((inc_5)
+ 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range
+ start_26
+ end_11
+ inc_5))
+ ((letrec-values (((for-loop_158)
+ (lambda (i_125
+ pos_37)
+ (begin
+ 'for-loop
+ (if (<
+ pos_37
+ end_11)
+ (let-values (((j_3)
+ pos_37))
+ (let-values (((i_126)
+ (let-values (((i_127)
+ (begin
+ (unsafe-vector*-set!
+ v_186
+ i_125
+ (loop_88))
+ (unsafe-fx+
+ 1
+ i_125))))
+ (values
+ i_127))))
+ (if (if (not
+ ((lambda x_51
+ (unsafe-fx=
+ i_126
+ len_24))
+ j_3))
+ (not
+ #f)
+ #f)
+ (for-loop_158
+ i_126
+ (+
+ pos_37
+ inc_5))
+ i_126)))
+ i_125)))))
+ for-loop_158)
+ i_123
+ start_26)))))
+ v_186))))))
+ (if (eqv? type_0 fasl-immutable-vector-type)
+ (vector->immutable-vector vec_43)
+ vec_43)))
+ (let-values (((len_25)
+ (read-fasl-integer i_122)))
+ (let-values (((len_26) len_25))
+ (begin
+ (if (exact-nonnegative-integer? len_26)
+ (void)
+ (raise-argument-error
+ 'for/flvector
+ "exact-nonnegative-integer?"
+ len_26))
+ (let-values (((fill_0) 0.0))
+ (let-values (((v_187)
+ (make-flvector
+ len_26
+ fill_0)))
(begin
- (let-values (((start_23) 0)
- ((end_13) len_24)
- ((inc_7) 1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-range
- start_23
- end_13
- inc_7)))
- ((letrec-values (((for-loop_126)
- (lambda (pos_27)
- (begin
- 'for-loop
- (if (<
- pos_27
- end_13)
- (let-values ()
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
+ (if (zero? len_26)
+ (void)
+ (let-values (((i_128)
+ (let-values (((i_129)
+ 0))
+ i_129)))
+ (let-values (((start_27) 0)
+ ((end_12) len_25)
+ ((inc_6) 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range
+ start_27
+ end_12
+ inc_6))
+ ((letrec-values (((for-loop_159)
+ (lambda (i_130
+ pos_38)
+ (begin
+ 'for-loop
+ (if (<
+ pos_38
+ end_12)
+ (let-values (((j_4)
+ pos_38))
+ (let-values (((i_131)
+ (let-values (((i_132)
(begin
- (let-values ()
- (hash-set!
- ht_83
- (loop_83)
- (loop_83)))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_126
- (+
- pos_27
- inc_7))
- (values))))
- (values))))))
- for-loop_126)
- start_23)))
- (void)
- ht_83))))
- (let-values ()
- (let-values (((ht_84)
- (let-values (((tmp_17)
- (read-byte/no-eof
- i_95)))
- (if (equal? tmp_17 0)
- (let-values ()
- '#hasheq())
- (if (equal? tmp_17 2)
- (let-values ()
- '#hasheqv())
- (if (equal? tmp_17 3)
- (let-values ()
- (hashalw))
- (let-values ()
- '#hash())))))))
- (let-values (((len_25)
- (read-fasl-integer i_95)))
- (let-values (((start_24) 0)
- ((end_14) len_25)
- ((inc_8) 1))
+ (let-values (((elem_0)
+ (read-fasl-flonum
+ i_122)))
+ (if (flonum?
+ elem_0)
+ (unsafe-flvector-set!
+ v_187
+ i_130
+ elem_0)
+ (not-an-fX.1$1
+ 'for*/vector
+ elem_0)))
+ (unsafe-fx+
+ 1
+ i_130))))
+ (values
+ i_132))))
+ (if (if (not
+ ((lambda x_52
+ (unsafe-fx=
+ i_131
+ len_26))
+ j_4))
+ (not
+ #f)
+ #f)
+ (for-loop_159
+ i_131
+ (+
+ pos_38
+ inc_6))
+ i_131)))
+ i_130)))))
+ for-loop_159)
+ i_128
+ start_27)))))
+ v_187)))))))
+ (if (unsafe-fx< index_0 35)
+ (let-values (((len_27)
+ (read-fasl-integer i_122)))
+ (let-values (((len_28) len_27))
+ (begin
+ (if (exact-nonnegative-integer? len_28)
+ (void)
+ (raise-argument-error
+ 'for/fxvector
+ "exact-nonnegative-integer?"
+ len_28))
+ (let-values (((fill_1) 0))
+ (let-values (((v_188)
+ (make-fxvector
+ len_28
+ fill_1)))
+ (begin
+ (if (zero? len_28)
+ (void)
+ (let-values (((i_133)
+ (let-values (((i_134)
+ 0))
+ i_134)))
+ (let-values (((start_28) 0)
+ ((end_13) len_27)
+ ((inc_7) 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range
+ start_28
+ end_13
+ inc_7))
+ ((letrec-values (((for-loop_160)
+ (lambda (i_135
+ pos_39)
+ (begin
+ 'for-loop
+ (if (<
+ pos_39
+ end_13)
+ (let-values (((j_5)
+ pos_39))
+ (let-values (((i_136)
+ (let-values (((i_137)
+ (begin
+ (let-values (((elem_1)
+ (read-fasl-integer
+ i_122)))
+ (if (fixnum?
+ elem_1)
+ (unsafe-fxvector-set!
+ v_188
+ i_135
+ elem_1)
+ (not-an-fX.1
+ 'for*/vector
+ elem_1)))
+ (unsafe-fx+
+ 1
+ i_135))))
+ (values
+ i_137))))
+ (if (if (not
+ ((lambda x_53
+ (unsafe-fx=
+ i_136
+ len_28))
+ j_5))
+ (not
+ #f)
+ #f)
+ (for-loop_160
+ i_136
+ (+
+ pos_39
+ inc_7))
+ i_136)))
+ i_135)))))
+ for-loop_160)
+ i_133
+ start_28)))))
+ v_188))))))
+ (if (unsafe-fx< index_0 36)
+ (box (loop_88))
+ (box-immutable (loop_88)))))
+ (if (unsafe-fx< index_0 40)
+ (if (unsafe-fx< index_0 38)
+ (let-values (((key_48) (loop_88)))
+ (let-values (((len_29)
+ (read-fasl-integer i_122)))
+ (apply
+ make-prefab-struct
+ key_48
+ (reverse$1
+ (let-values (((fold-var_207)
+ (let-values (((fold-var_208)
+ null))
+ fold-var_208)))
+ (let-values (((start_29) 0)
+ ((end_14) len_29)
+ ((inc_8) 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range
+ start_29
+ end_14
+ inc_8))
+ ((letrec-values (((for-loop_161)
+ (lambda (fold-var_209
+ pos_40)
+ (begin
+ 'for-loop
+ (if (<
+ pos_40
+ end_14)
+ (let-values ()
+ (let-values (((fold-var_210)
+ (let-values (((fold-var_211)
+ (cons
+ (loop_88)
+ fold-var_209)))
+ (values
+ fold-var_211))))
+ (if (not
+ #f)
+ (for-loop_161
+ fold-var_210
+ (+
+ pos_40
+ inc_8))
+ fold-var_210)))
+ fold-var_209)))))
+ for-loop_161)
+ fold-var_207
+ start_29))))))))
+ (if (unsafe-fx< index_0 39)
+ (let-values (((ht_98)
+ (let-values (((tmp_17)
+ (read-byte/no-eof
+ i_122)))
+ (if (equal? tmp_17 0)
+ (make-hasheq)
+ (if (equal? tmp_17 2)
+ (make-hasheqv)
+ (if (equal? tmp_17 3)
+ (make-hashalw)
+ (make-hash)))))))
+ (let-values (((len_30)
+ (read-fasl-integer i_122)))
+ (begin
+ (let-values (((start_30) 0)
+ ((end_15) len_30)
+ ((inc_9) 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range
+ start_30
+ end_15
+ inc_9))
+ ((letrec-values (((for-loop_162)
+ (lambda (pos_41)
+ (begin
+ 'for-loop
+ (if (<
+ pos_41
+ end_15)
+ (let-values ()
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (hash-set!
+ ht_98
+ (loop_88)
+ (loop_88))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_162
+ (+
+ pos_41
+ inc_9))
+ (values))))
+ (values))))))
+ for-loop_162)
+ start_30)))
+ (void)
+ ht_98)))
+ (let-values (((ht_99)
+ (let-values (((tmp_18)
+ (read-byte/no-eof
+ i_122)))
+ (if (equal? tmp_18 0)
+ '#hasheq()
+ (if (equal? tmp_18 2)
+ '#hasheqv()
+ (if (equal? tmp_18 3)
+ (hashalw)
+ '#hash()))))))
+ (let-values (((len_31)
+ (read-fasl-integer i_122)))
+ (let-values (((ht_100)
+ (let-values (((ht_101)
+ ht_99))
+ ht_101)))
+ (let-values (((start_31) 0)
+ ((end_16) len_31)
+ ((inc_10) 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range
+ start_31
+ end_16
+ inc_10))
+ ((letrec-values (((for-loop_163)
+ (lambda (ht_102
+ pos_42)
+ (begin
+ 'for-loop
+ (if (<
+ pos_42
+ end_16)
+ (let-values ()
+ (let-values (((ht_103)
+ (let-values (((ht_104)
+ (hash-set
+ ht_102
+ (loop_88)
+ (loop_88))))
+ (values
+ ht_104))))
+ (if (not
+ #f)
+ (for-loop_163
+ ht_103
+ (+
+ pos_42
+ inc_10))
+ ht_103)))
+ ht_102)))))
+ for-loop_163)
+ ht_100
+ start_31))))))))
+ (if (unsafe-fx< index_0 41)
+ (srcloc
+ (loop_88)
+ (loop_88)
+ (loop_88)
+ (loop_88)
+ (loop_88))
+ (if (unsafe-fx< index_0 42)
+ (let-values (((e_31) (loop_88)))
+ (let-values (((s_238) (loop_88)))
+ (let-values (((c_24)
+ (datum->correlated$1
+ e_31
+ (vector
+ (srcloc-source s_238)
+ (srcloc-line s_238)
+ (srcloc-column s_238)
+ (srcloc-position s_238)
+ (srcloc-span s_238)))))
+ (let-values (((c_25)
+ (let-values (((c_26)
+ c_24))
+ c_26)))
+ (let-values (((lst_173) (loop_88)))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-range
- start_24
- end_14
- inc_8)))
- ((letrec-values (((for-loop_127)
- (lambda (ht_43
- pos_28)
+ (check-list lst_173))
+ ((letrec-values (((for-loop_164)
+ (lambda (c_27
+ lst_174)
(begin
'for-loop
- (if (<
- pos_28
- end_14)
- (let-values ()
- (let-values (((ht_85)
- (let-values (((ht_86)
- ht_43))
- (let-values (((ht_87)
- (let-values ()
- (hash-set
- ht_86
- (loop_83)
- (loop_83)))))
- (values
- ht_87)))))
+ (if (pair?
+ lst_174)
+ (let-values (((p_31)
+ (unsafe-car
+ lst_174))
+ ((rest_83)
+ (unsafe-cdr
+ lst_174)))
+ (let-values (((c_28)
+ (let-values (((c_29)
+ (correlated-property$1
+ c_27
+ (car
+ p_31)
+ (cdr
+ p_31))))
+ (values
+ c_29))))
(if (not
#f)
- (for-loop_127
- ht_85
- (+
- pos_28
- inc_8))
- ht_85)))
- ht_43)))))
- for-loop_127)
- ht_84
- start_24))))))))
- (if (unsafe-fx< index_0 39)
- (let-values ()
- (srcloc
- (loop_83)
- (loop_83)
- (loop_83)
- (loop_83)
- (loop_83)))
- (if (unsafe-fx< index_0 40)
- (let-values ()
- (let-values (((e_28) (loop_83)))
- (let-values (((s_189) (loop_83)))
- (let-values (((c_20)
- (datum->correlated$1
- e_28
- (vector
- (srcloc-source s_189)
- (srcloc-line s_189)
- (srcloc-column s_189)
- (srcloc-position
- s_189)
- (srcloc-span
- s_189)))))
- (let-values (((lst_117) (loop_83)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_117)))
- ((letrec-values (((for-loop_128)
- (lambda (c_21
- lst_118)
- (begin
- 'for-loop
- (if (pair?
- lst_118)
- (let-values (((p_27)
- (unsafe-car
- lst_118))
- ((rest_57)
- (unsafe-cdr
- lst_118)))
- (let-values (((c_22)
- (let-values (((c_23)
- c_21))
- (let-values (((c_24)
- (let-values ()
- (correlated-property$1
- c_23
- (car
- p_27)
- (cdr
- p_27)))))
- (values
- c_24)))))
- (if (not
- #f)
- (for-loop_128
- c_22
- rest_57)
- c_22)))
- c_21)))))
- for-loop_128)
- c_20
- lst_117)))))))
- (if (unsafe-fx< index_0 41)
- (let-values () unsafe-undefined)
- (let-values ()
- (prefab-key->struct-type
- (loop_83)
- (loop_83)))))))))))))))))
- loop_83))))))))))))))))))))
+ (for-loop_164
+ c_28
+ rest_83)
+ c_28)))
+ c_27)))))
+ for-loop_164)
+ c_25
+ lst_173)))))))
+ (if (unsafe-fx< index_0 43)
+ unsafe-undefined
+ (prefab-key->struct-type
+ (loop_88)
+ (loop_88))))))))))))))))
+ loop_88)))))))))))))))))))
(define-values
(write-fasl-integer)
- (lambda (i_100 o_2)
- (begin
- (if (<= -124 i_100 127)
- (let-values () (if (negative? i_100) (1/write-byte (+ i_100 256) o_2) (1/write-byte i_100 o_2)))
- (if (<= -32768 i_100 32767)
- (let-values () (begin (1/write-byte 128 o_2) (1/write-bytes (integer->integer-bytes i_100 2 #t #f) o_2)))
- (if (<= -2147483648 i_100 2147483647)
- (let-values () (begin (1/write-byte 129 o_2) (1/write-bytes (integer->integer-bytes i_100 4 #t #f) o_2)))
- (if (<= -9223372036854775808 i_100 9223372036854775807)
- (let-values () (begin (1/write-byte 130 o_2) (1/write-bytes (integer->integer-bytes i_100 8 #t #f) o_2)))
- (let-values ()
- (let-values ((() (begin (1/write-byte 131 o_2) (values))))
- (let-values (((s_190) (format "~x" i_100)))
- (begin (write-fasl-integer (string-length s_190) o_2) (write-string s_190 o_2))))))))))))
+ (lambda (i_138 o_2)
+ (begin
+ (if (<= -124 i_138 127)
+ (if (negative? i_138) (1/write-byte (+ i_138 256) o_2) (1/write-byte i_138 o_2))
+ (if (<= -32768 i_138 32767)
+ (begin (1/write-byte 128 o_2) (1/write-bytes (integer->integer-bytes i_138 2 #t #f) o_2))
+ (if (<= -2147483648 i_138 2147483647)
+ (begin (1/write-byte 129 o_2) (1/write-bytes (integer->integer-bytes i_138 4 #t #f) o_2))
+ (if (<= -9223372036854775808 i_138 9223372036854775807)
+ (begin (1/write-byte 130 o_2) (1/write-bytes (integer->integer-bytes i_138 8 #t #f) o_2))
+ (let-values ((() (begin (1/write-byte 131 o_2) (values))))
+ (let-values (((s_239) (format "~x" i_138)))
+ (begin (write-fasl-integer (string-length s_239) o_2) (write-string s_239 o_2)))))))))))
(define-values
(write-fasl-string)
- (lambda (v_134 o_3)
+ (lambda (v_189 o_3)
(begin
- (let-values (((bstr_13) (string->bytes/utf-8 v_134)))
+ (let-values (((bstr_13) (string->bytes/utf-8 v_189)))
(begin (write-fasl-integer (bytes-length bstr_13) o_3) (1/write-bytes bstr_13 o_3))))))
(define-values
(write-fasl-bytes)
- (lambda (v_64 o_4) (begin (begin (write-fasl-integer (bytes-length v_64) o_4) (1/write-bytes v_64 o_4)))))
+ (lambda (v_190 o_4) (begin (begin (write-fasl-integer (bytes-length v_190) o_4) (1/write-bytes v_190 o_4)))))
+ (define-values
+ (write-fasl-flonum)
+ (lambda (v_191 o_5)
+ (begin
+ (1/write-bytes (if (eqv? v_191 +nan.0) #"\0\0\0\0\0\0\370\177" (real->floating-point-bytes v_191 8 #f)) o_5))))
(define-values
(read-error)
- (lambda (s_136 . args_4)
- (begin (apply raise-arguments-error 'fasl-read (string-append "error parsing fasl stream;\n" " " s_136) args_4))))
+ (lambda (s_240 . args_7)
+ (begin (apply raise-arguments-error 'fasl-read (string-append "error parsing fasl stream;\n" " " s_240) args_7))))
(define-values
(read-byte/no-eof)
- (lambda (i_101)
+ (lambda (i_139)
(begin
- (let-values (((pos_29) (mcdr i_101)))
+ (let-values (((pos_43) (mcdr i_139)))
(begin
- (if (fx< pos_29 (bytes-length (mcar i_101))) (void) (let-values () (read-error "truncated stream")))
- (set-mcdr! i_101 (fx+ pos_29 1))
- (bytes-ref (mcar i_101) pos_29))))))
+ (if (fx< pos_43 (bytes-length (mcar i_139))) (void) (read-error "truncated stream"))
+ (set-mcdr! i_139 (fx+ pos_43 1))
+ (bytes-ref (mcar i_139) pos_43))))))
(define-values
(read-byte/no-eof*)
- (lambda (i_102)
+ (lambda (i_140)
(begin
- (if (mpair? i_102)
- (let-values () (read-byte/no-eof i_102))
- (let-values ()
- (let-values (((b_70) (read-byte i_102)))
- (begin (if (eof-object? b_70) (let-values () (read-error "truncated stream")) (void)) b_70)))))))
+ (if (mpair? i_140)
+ (read-byte/no-eof i_140)
+ (let-values (((b_92) (read-byte i_140)))
+ (begin (if (eof-object? b_92) (read-error "truncated stream") (void)) b_92))))))
(define-values
(read-bytes/exactly)
- (lambda (n_23 i_103)
+ (lambda (n_23 i_141)
(begin
- (let-values (((pos_30) (mcdr i_103)))
+ (let-values (((pos_44) (mcdr i_141)))
(begin
- (if (<= (+ pos_30 n_23) (bytes-length (mcar i_103))) (void) (let-values () (read-error "truncated stream")))
- (set-mcdr! i_103 (fx+ pos_30 n_23))
- (subbytes (mcar i_103) pos_30 (fx+ pos_30 n_23)))))))
+ (if (<= (+ pos_44 n_23) (bytes-length (mcar i_141))) (void) (read-error "truncated stream"))
+ (set-mcdr! i_141 (fx+ pos_44 n_23))
+ (subbytes (mcar i_141) pos_44 (fx+ pos_44 n_23)))))))
(define-values
(read-bytes/exactly*)
- (lambda (n_24 i_104)
+ (lambda (n_24 i_142)
(begin
- (if (mpair? i_104)
- (let-values () (read-bytes/exactly n_24 i_104))
- (let-values ()
- (let-values (((bstr_14) (read-bytes n_24 i_104)))
- (begin
- (if (if (bytes? bstr_14) (= n_24 (bytes-length bstr_14)) #f)
- (void)
- (let-values () (read-error "truncated stream")))
- bstr_14)))))))
+ (if (mpair? i_142)
+ (read-bytes/exactly n_24 i_142)
+ (let-values (((bstr_14) (read-bytes n_24 i_142)))
+ (begin
+ (if (if (bytes? bstr_14) (= n_24 (bytes-length bstr_14)) #f) (void) (read-error "truncated stream"))
+ bstr_14))))))
(define-values
(read-fasl-integer read-fasl-integer*)
- (let-values ()
- (let-values ()
- (values
- (lambda (i_105)
- (let-values (((b_71) (read-byte/no-eof i_105)))
- (if (fx<= b_71 127)
- (let-values () b_71)
- (if (fx>= b_71 132)
- (let-values () (fx- b_71 256))
- (if (eqv? b_71 128)
- (let-values ()
- (let-values (((lo_0) (read-byte/no-eof i_105)))
- (let-values (((hi_0) (read-byte/no-eof i_105)))
- (if (fx> hi_0 127) (fxior (fxlshift (fx+ -256 hi_0) 8) lo_0) (fxior (fxlshift hi_0 8) lo_0)))))
- (if (eqv? b_71 129)
- (let-values ()
- (let-values (((a_29) (read-byte/no-eof i_105)))
- (let-values (((b_72) (read-byte/no-eof i_105)))
- (let-values (((c_25) (read-byte/no-eof i_105)))
- (let-values (((d_23) (read-byte/no-eof i_105)))
- (bitwise-ior
- a_29
- (arithmetic-shift
- (if (fx> d_23 127)
- (fxior (fxlshift (fx+ -256 d_23) 16) (fxlshift c_25 8) b_72)
- (fxior (fxlshift d_23 16) (fxlshift c_25 8) b_72))
- 8)))))))
- (if (eqv? b_71 130)
- (let-values () (integer-bytes->integer (read-bytes/exactly 8 i_105) #t #f))
- (if (eqv? b_71 131)
- (let-values ()
- (let-values (((len_26) (read-fasl-integer i_105)))
- (let-values (((str_5) (read-fasl-string i_105 len_26)))
- (begin
- (if (if (string? str_5) (= len_26 (string-length str_5)) #f)
- (void)
- (let-values () (read-error "truncated stream at number")))
- (1/string->number str_5 16)))))
- (let-values () (read-error "internal error on integer mode"))))))))))
- (lambda (i_106)
- (let-values (((b_73) (read-byte/no-eof* i_106)))
- (if (fx<= b_73 127)
- (let-values () b_73)
- (if (fx>= b_73 132)
- (let-values () (fx- b_73 256))
- (if (eqv? b_73 128)
- (let-values ()
- (let-values (((lo_1) (read-byte/no-eof* i_106)))
- (let-values (((hi_1) (read-byte/no-eof* i_106)))
- (if (fx> hi_1 127) (fxior (fxlshift (fx+ -256 hi_1) 8) lo_1) (fxior (fxlshift hi_1 8) lo_1)))))
- (if (eqv? b_73 129)
- (let-values ()
- (let-values (((a_30) (read-byte/no-eof* i_106)))
- (let-values (((b_74) (read-byte/no-eof* i_106)))
- (let-values (((c_26) (read-byte/no-eof* i_106)))
- (let-values (((d_24) (read-byte/no-eof* i_106)))
- (bitwise-ior
- a_30
- (arithmetic-shift
- (if (fx> d_24 127)
- (fxior (fxlshift (fx+ -256 d_24) 16) (fxlshift c_26 8) b_74)
- (fxior (fxlshift d_24 16) (fxlshift c_26 8) b_74))
- 8)))))))
- (if (eqv? b_73 130)
- (let-values () (integer-bytes->integer (read-bytes/exactly* 8 i_106) #t #f))
- (if (eqv? b_73 131)
- (let-values ()
- (let-values (((len_27) (read-fasl-integer i_106)))
- (let-values (((str_6) (read-fasl-string i_106 len_27)))
- (begin
- (if (if (string? str_6) (= len_27 (string-length str_6)) #f)
- (void)
- (let-values () (read-error "truncated stream at number")))
- (1/string->number str_6 16)))))
- (let-values () (read-error "internal error on integer mode"))))))))))))))
+ (values
+ (lambda (i_143)
+ (let-values (((b_93) (read-byte/no-eof i_143)))
+ (if (fx<= b_93 127)
+ b_93
+ (if (fx>= b_93 132)
+ (fx- b_93 256)
+ (if (eqv? b_93 128)
+ (let-values (((lo_0) (read-byte/no-eof i_143)))
+ (let-values (((hi_0) (read-byte/no-eof i_143)))
+ (if (fx> hi_0 127) (fxior (fxlshift (fx+ -256 hi_0) 8) lo_0) (fxior (fxlshift hi_0 8) lo_0))))
+ (if (eqv? b_93 129)
+ (let-values (((a_35) (read-byte/no-eof i_143)))
+ (let-values (((b_94) (read-byte/no-eof i_143)))
+ (let-values (((c_30) (read-byte/no-eof i_143)))
+ (let-values (((d_23) (read-byte/no-eof i_143)))
+ (bitwise-ior
+ a_35
+ (arithmetic-shift
+ (if (fx> d_23 127)
+ (fxior (fxlshift (fx+ -256 d_23) 16) (fxlshift c_30 8) b_94)
+ (fxior (fxlshift d_23 16) (fxlshift c_30 8) b_94))
+ 8))))))
+ (if (eqv? b_93 130)
+ (integer-bytes->integer (read-bytes/exactly 8 i_143) #t #f)
+ (if (eqv? b_93 131)
+ (let-values (((len_32) (read-fasl-integer i_143)))
+ (let-values (((str_5) (read-fasl-string i_143 len_32)))
+ (begin
+ (if (if (string? str_5) (= len_32 (string-length str_5)) #f)
+ (void)
+ (read-error "truncated stream at number"))
+ (1/string->number str_5 16))))
+ (read-error "internal error on integer mode")))))))))
+ (lambda (i_144)
+ (let-values (((b_95) (read-byte/no-eof* i_144)))
+ (if (fx<= b_95 127)
+ b_95
+ (if (fx>= b_95 132)
+ (fx- b_95 256)
+ (if (eqv? b_95 128)
+ (let-values (((lo_1) (read-byte/no-eof* i_144)))
+ (let-values (((hi_1) (read-byte/no-eof* i_144)))
+ (if (fx> hi_1 127) (fxior (fxlshift (fx+ -256 hi_1) 8) lo_1) (fxior (fxlshift hi_1 8) lo_1))))
+ (if (eqv? b_95 129)
+ (let-values (((a_36) (read-byte/no-eof* i_144)))
+ (let-values (((b_96) (read-byte/no-eof* i_144)))
+ (let-values (((c_31) (read-byte/no-eof* i_144)))
+ (let-values (((d_24) (read-byte/no-eof* i_144)))
+ (bitwise-ior
+ a_36
+ (arithmetic-shift
+ (if (fx> d_24 127)
+ (fxior (fxlshift (fx+ -256 d_24) 16) (fxlshift c_31 8) b_96)
+ (fxior (fxlshift d_24 16) (fxlshift c_31 8) b_96))
+ 8))))))
+ (if (eqv? b_95 130)
+ (integer-bytes->integer (read-bytes/exactly* 8 i_144) #t #f)
+ (if (eqv? b_95 131)
+ (let-values (((len_33) (read-fasl-integer i_144)))
+ (let-values (((str_6) (read-fasl-string i_144 len_33)))
+ (begin
+ (if (if (string? str_6) (= len_33 (string-length str_6)) #f)
+ (void)
+ (read-error "truncated stream at number"))
+ (1/string->number str_6 16))))
+ (read-error "internal error on integer mode")))))))))))
(define-values
(read-fasl-string)
(let-values (((read-fasl-string_0)
(lambda (i25_0 len24_0)
(begin
'read-fasl-string
- (let-values (((i_107) i25_0))
- (let-values (((len_28) (if (eq? len24_0 unsafe-undefined) (read-fasl-integer i_107) len24_0)))
- (let-values ()
- (let-values (((pos_31) (mcdr i_107)))
- (let-values (((bstr_15) (mcar i_107)))
- (if (<= (+ pos_31 len_28) (bytes-length bstr_15))
- (let-values ()
- (let-values ((() (begin (set-mcdr! i_107 (fx+ pos_31 len_28)) (values))))
- (let-values (((s_191) (make-string len_28)))
- ((letrec-values (((loop_84)
- (lambda (i_108)
- (begin
- 'loop
- (if (fx= i_108 len_28)
- (let-values () s_191)
- (let-values ()
- (let-values (((c_27)
- (bytes-ref bstr_15 (fx+ i_108 pos_31))))
- (if (fx<= c_27 128)
- (let-values ()
- (begin
- (string-set! s_191 i_108 (integer->char c_27))
- (loop_84 (fx+ i_108 1))))
- (let-values ()
- (bytes->string/utf-8
- bstr_15
- #f
- pos_31
- (fx+ pos_31 len_28)))))))))))
- loop_84)
- 0))))
- (let-values ()
- (let-values (((bstr_16) (read-bytes/exactly len_28 i_107)))
- (bytes->string/utf-8 bstr_16)))))))))))))
+ (let-values (((i_145) i25_0))
+ (let-values (((len_34) (if (eq? len24_0 unsafe-undefined) (read-fasl-integer i_145) len24_0)))
+ (let-values (((pos_45) (mcdr i_145)))
+ (let-values (((bstr_15) (mcar i_145)))
+ (if (<= (+ pos_45 len_34) (bytes-length bstr_15))
+ (let-values ((() (begin (set-mcdr! i_145 (fx+ pos_45 len_34)) (values))))
+ (let-values (((s_241) (make-string len_34)))
+ ((letrec-values (((loop_89)
+ (lambda (i_146)
+ (begin
+ 'loop
+ (if (fx= i_146 len_34)
+ s_241
+ (let-values (((c_32) (bytes-ref bstr_15 (fx+ i_146 pos_45))))
+ (if (fx<= c_32 128)
+ (begin
+ (string-set! s_241 i_146 (integer->char c_32))
+ (loop_89 (fx+ i_146 1)))
+ (bytes->string/utf-8
+ bstr_15
+ #f
+ pos_45
+ (fx+ pos_45 len_34)))))))))
+ loop_89)
+ 0)))
+ (let-values (((bstr_16) (read-bytes/exactly len_34 i_145)))
+ (bytes->string/utf-8 bstr_16)))))))))))
(case-lambda
- ((i_109) (begin (read-fasl-string_0 i_109 unsafe-undefined)))
- ((i_110 len24_1) (read-fasl-string_0 i_110 len24_1)))))
+ ((i_147) (begin (read-fasl-string_0 i_147 unsafe-undefined)))
+ ((i_148 len24_1) (read-fasl-string_0 i_148 len24_1)))))
(define-values
(read-fasl-bytes)
- (lambda (i_111) (begin (let-values (((len_29) (read-fasl-integer i_111))) (read-bytes/exactly len_29 i_111)))))
+ (lambda (i_149) (begin (let-values (((len_35) (read-fasl-integer i_149))) (read-bytes/exactly len_35 i_149)))))
+ (define-values
+ (read-fasl-flonum)
+ (lambda (i_150) (begin (floating-point-bytes->real (read-bytes/exactly 8 i_150) #f))))
(define-values
(struct:mpi-intern-table mpi-intern-table1.1 mpi-intern-table? mpi-intern-table-normal mpi-intern-table-fast)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'mpi-intern-table
- #f
- 2
- 0
- #f
- null
- (current-inspector)
- #f
- '(0 1)
- #f
- 'mpi-intern-table)))))
+ (let-values (((struct:_56 make-_56 ?_56 -ref_56 -set!_56)
+ (make-struct-type 'mpi-intern-table #f 2 0 #f null (current-inspector) #f '(0 1) #f 'mpi-intern-table)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'normal)
- (make-struct-field-accessor -ref_2 1 'fast))))
+ struct:_56
+ make-_56
+ ?_56
+ (make-struct-field-accessor -ref_56 0 'normal)
+ (make-struct-field-accessor -ref_56 1 'fast))))
(define-values
(make-module-path-index-intern-table)
(lambda () (begin (mpi-intern-table1.1 (make-hash) (make-hasheq)))))
(define-values
(intern-module-path-index!)
- (lambda (t_10 mpi_27)
- (begin
- (let-values (((or-part_32) (hash-ref (mpi-intern-table-fast t_10) mpi_27 #f)))
- (if or-part_32
- or-part_32
- (let-values (((name_38 base_16) (1/module-path-index-split mpi_27)))
- (if (not name_38)
- (let-values () (begin (hash-set! (mpi-intern-table-fast t_10) mpi_27 mpi_27) mpi_27))
- (let-values ()
- (let-values (((interned-base_0) (if base_16 (intern-module-path-index! t_10 base_16) #f)))
- (let-values (((at-name_0)
- (let-values (((or-part_83) (hash-ref (mpi-intern-table-normal t_10) name_38 #f)))
- (if or-part_83
- or-part_83
- (let-values (((at-name_1) (make-hasheq)))
- (begin
- (hash-set! (mpi-intern-table-normal t_10) name_38 at-name_1)
- at-name_1))))))
- (let-values (((i-mpi_0)
- (let-values (((or-part_73) (hash-ref at-name_0 interned-base_0 #f)))
- (if or-part_73
- or-part_73
- (let-values (((mpi_28)
- (if (eq? base_16 interned-base_0)
- mpi_27
- (let-values (((the-struct_43) mpi_27))
- (if (1/module-path-index? the-struct_43)
- (let-values (((base3_0) interned-base_0))
- (module-path-index2.1
- (module-path-index-path the-struct_43)
- base3_0
- (module-path-index-resolved the-struct_43)
- (module-path-index-shift-cache the-struct_43)))
- (raise-argument-error
- 'struct-copy
- "module-path-index?"
- the-struct_43))))))
- (begin (hash-set! at-name_0 interned-base_0 mpi_28) mpi_28))))))
- (begin (hash-set! (mpi-intern-table-fast t_10) mpi_27 i-mpi_0) i-mpi_0))))))))))))
+ (lambda (t_22 mpi_34)
+ (begin
+ (let-values (((or-part_282) (hash-ref (mpi-intern-table-fast t_22) mpi_34 #f)))
+ (if or-part_282
+ or-part_282
+ (let-values (((name_46 base_18) (1/module-path-index-split mpi_34)))
+ (if (not name_46)
+ (begin (hash-set! (mpi-intern-table-fast t_22) mpi_34 mpi_34) mpi_34)
+ (let-values (((interned-base_0) (if base_18 (intern-module-path-index! t_22 base_18) #f)))
+ (let-values (((at-name_0)
+ (let-values (((or-part_283) (hash-ref (mpi-intern-table-normal t_22) name_46 #f)))
+ (if or-part_283
+ or-part_283
+ (let-values (((at-name_1) (make-hasheq)))
+ (begin (hash-set! (mpi-intern-table-normal t_22) name_46 at-name_1) at-name_1))))))
+ (let-values (((i-mpi_0)
+ (let-values (((or-part_284) (hash-ref at-name_0 interned-base_0 #f)))
+ (if or-part_284
+ or-part_284
+ (let-values (((mpi_35)
+ (if (eq? base_18 interned-base_0)
+ mpi_34
+ (let-values (((the-struct_44) mpi_34))
+ (if (1/module-path-index? the-struct_44)
+ (let-values (((base3_0) interned-base_0))
+ (module-path-index2.1
+ (module-path-index-path the-struct_44)
+ base3_0
+ (module-path-index-resolved the-struct_44)
+ (module-path-index-shift-cache the-struct_44)))
+ (raise-argument-error
+ 'struct-copy
+ "module-path-index?"
+ the-struct_44))))))
+ (begin (hash-set! at-name_0 interned-base_0 mpi_35) mpi_35))))))
+ (begin (hash-set! (mpi-intern-table-fast t_22) mpi_34 i-mpi_0) i-mpi_0)))))))))))
(define-values (built-in-symbols) (make-hasheq))
- (define-values (register-built-in-symbol!) (lambda (s_0) (begin (hash-set! built-in-symbols s_0 #t))))
- (define-values (built-in-symbol?) (lambda (s_89) (begin (hash-ref built-in-symbols s_89 #f))))
+ (define-values (register-built-in-symbol!) (lambda (s_242) (begin (hash-set! built-in-symbols s_242 #t))))
+ (define-values (built-in-symbol?) (lambda (s_243) (begin (hash-ref built-in-symbols s_243 #f))))
(define-values
(make-built-in-symbol!)
- (lambda (s_10)
+ (lambda (s_244)
(begin
- (let-values (((built-in-s_0) (string->symbol (format ".~s" s_10))))
+ (let-values (((built-in-s_0) (string->symbol (format ".~s" s_244))))
(begin (register-built-in-symbol! built-in-s_0) built-in-s_0)))))
(void
(begin
@@ -20757,7 +20776,8 @@
set!
quote
with-continuation-mark
- #%variable-reference))
+ #%variable-reference
+ #%foreign-inline))
(for-each2
register-built-in-symbol!
'(check-not-undefined
@@ -20792,9 +20812,22 @@
#%call-with-values
#%app/no-return
#%app/value
+ apply-string-append
+ apply-string-append-immutable
+ apply-bytes-append
call-with-module-prompt
make-pthread-parameter
engine-block
+ make-mutex
+ make-condition
+ mutex-acquire
+ mutex-release
+ condition-wait
+ condition-signal
+ assert-push-lock-level!
+ assert-pop-lock-level!
+ get-thread-id
+ threaded?
make-record-type-descriptor
make-record-type-descriptor*
make-record-constructor-descriptor
@@ -20839,7 +20872,18 @@
ptr-ref/double
ptr-set!/double
ptr-ref/float
- ptr-set!/float))))
+ ptr-set!/float
+ ffi-static-call-and-callback-core
+ ffi2-ptr?-maker
+ ffi2-procedure-maker
+ ffi2-callback-maker
+ ffi2-ptr-ref-maker
+ ffi2-ptr-set!-maker
+ ffi2-malloc-maker
+ ffi2-ptr-cast-maker
+ ffi2-sizeof
+ ffi2-offsetof
+ ffi2-system-type-select))))
(define-values (phase-shift-id) (make-built-in-symbol! 'phase))
(define-values (dest-phase-id) (make-built-in-symbol! 'dest-phase))
(define-values (ns-id) (make-built-in-symbol! 'namespace))
@@ -20860,532 +20904,553 @@
module-path-index-table?
module-path-index-table-positions
module-path-index-table-intern)
- (let-values (((struct:_29 make-_29 ?_29 -ref_29 -set!_29)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'module-path-index-table
- #f
- 2
- 0
- #f
- null
- (current-inspector)
- #f
- '(0 1)
- #f
- 'module-path-index-table)))))
+ (let-values (((struct:_57 make-_57 ?_57 -ref_57 -set!_57)
+ (make-struct-type
+ 'module-path-index-table
+ #f
+ 2
+ 0
+ #f
+ null
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'module-path-index-table)))
(values
- struct:_29
- make-_29
- ?_29
- (make-struct-field-accessor -ref_29 0 'positions)
- (make-struct-field-accessor -ref_29 1 'intern))))
+ struct:_57
+ make-_57
+ ?_57
+ (make-struct-field-accessor -ref_57 0 'positions)
+ (make-struct-field-accessor -ref_57 1 'intern))))
(define-values
(make-module-path-index-table)
(lambda () (begin (module-path-index-table1.1 (make-hasheq) (make-module-path-index-intern-table)))))
(define-values
(add-module-path-index!)
- (lambda (mpis_0 mpi_29)
+ (lambda (mpis_0 mpi_36)
(begin
- (let-values (((pos_32) (add-module-path-index!/pos mpis_0 mpi_29)))
- (if pos_32 (list 'unsafe-vector*-ref mpi-vector-id pos_32) #f)))))
+ (let-values (((pos_46) (add-module-path-index!/pos mpis_0 mpi_36)))
+ (if pos_46 (list 'unsafe-vector*-ref mpi-vector-id pos_46) #f)))))
(define-values
(add-module-path-index!/pos)
- (lambda (mpis_1 mpi_20)
+ (lambda (mpis_1 mpi_37)
(begin
- (if (not mpi_20)
- (let-values () #f)
- (if mpi_20
- (let-values ()
- (let-values (((mpi_30) (intern-module-path-index! (module-path-index-table-intern mpis_1) mpi_20))
- ((positions_0) (module-path-index-table-positions mpis_1)))
- (let-values (((or-part_58) (hash-ref positions_0 mpi_30 #f)))
- (if or-part_58
- or-part_58
- (let-values (((pos_33) (hash-count positions_0)))
- (begin (hash-set! positions_0 mpi_30 pos_33) pos_33))))))
+ (if (not mpi_37)
+ #f
+ (if mpi_37
+ (let-values (((mpi_38) (intern-module-path-index! (module-path-index-table-intern mpis_1) mpi_37))
+ ((positions_0) (module-path-index-table-positions mpis_1)))
+ (let-values (((or-part_285) (hash-ref positions_0 mpi_38 #f)))
+ (if or-part_285
+ or-part_285
+ (let-values (((pos_47) (hash-count positions_0)))
+ (begin (hash-set! positions_0 mpi_38 pos_47) pos_47)))))
(void))))))
+ (define-values
+ (module-path-index-table-mpis)
+ (lambda (mpis_2)
+ (begin
+ (let-values (((pos->mpi_0)
+ (let-values (((table_125) (let-values (((table_126) '#hasheqv())) table_126)))
+ (let-values (((ht_105) (module-path-index-table-positions mpis_2)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_105))
+ ((letrec-values (((for-loop_165)
+ (lambda (table_127 i_151)
+ (begin
+ 'for-loop
+ (if i_151
+ (let-values (((mpi_39 pos_48) (hash-iterate-key+value ht_105 i_151)))
+ (let-values (((table_128)
+ (let-values (((table_129)
+ (let-values (((key_49 val_34)
+ (values pos_48 mpi_39)))
+ (hash-set table_127 key_49 val_34))))
+ (values table_129))))
+ (if (not #f)
+ (for-loop_165 table_128 (hash-iterate-next ht_105 i_151))
+ table_128)))
+ table_127)))))
+ for-loop_165)
+ table_125
+ (hash-iterate-first ht_105)))))))
+ (let-values (((vec_44 i_152)
+ (let-values (((vec_45) (let-values (((vec_46) (make-vector 16))) vec_46))
+ ((i_153) (let-values (((i_154) 0)) i_154)))
+ (let-values (((start_32) 0) ((end_17) (hash-count pos->mpi_0)) ((inc_11) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_32 end_17 inc_11))
+ ((letrec-values (((for-loop_166)
+ (lambda (vec_47 i_155 pos_49)
+ (begin
+ 'for-loop
+ (if (< pos_49 end_17)
+ (let-values (((i_156) pos_49))
+ (let-values (((vec_48 i_157)
+ (let-values (((vec_49 i_158)
+ (let-values (((new-vec_2)
+ (if (eq?
+ i_155
+ (unsafe-vector*-length
+ vec_47))
+ (grow-vector vec_47)
+ vec_47)))
+ (begin
+ (unsafe-vector*-set!
+ new-vec_2
+ i_155
+ (hash-ref pos->mpi_0 i_156))
+ (values
+ new-vec_2
+ (unsafe-fx+ i_155 1))))))
+ (values vec_49 i_158))))
+ (if (not #f)
+ (for-loop_166 vec_48 i_157 (+ pos_49 inc_11))
+ (values vec_48 i_157))))
+ (values vec_47 i_155))))))
+ for-loop_166)
+ vec_45
+ i_153
+ start_32))))))
+ (shrink-vector vec_44 i_152))))))
(define-values
(generate-module-path-index-deserialize.1)
(lambda (as-data?2_0 mpis4_0)
(begin
'generate-module-path-index-deserialize
- (let-values (((mpis_2) mpis4_0))
+ (let-values (((mpis_3) mpis4_0))
(let-values (((as-data?_0) as-data?2_0))
- (let-values ()
- (let-values (((unique-list_0)
- (lambda (v_34)
- (begin
- 'unique-list
- (if (pair? v_34)
- (reverse$1
- (let-values (((lst_105) v_34))
+ (let-values (((unique-list_0)
+ (lambda (v_192)
+ (begin
+ 'unique-list
+ (if (pair? v_192)
+ (reverse$1
+ (let-values (((fold-var_212) (let-values (((fold-var_213) null)) fold-var_213)))
+ (let-values (((lst_175) v_192))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_105)))
- ((letrec-values (((for-loop_108)
- (lambda (fold-var_83 lst_93)
+ (check-list lst_175))
+ ((letrec-values (((for-loop_167)
+ (lambda (fold-var_214 lst_176)
(begin
'for-loop
- (if (pair? lst_93)
- (let-values (((i_112) (unsafe-car lst_93))
- ((rest_51) (unsafe-cdr lst_93)))
- (let-values (((fold-var_129)
- (let-values (((fold-var_130) fold-var_83))
- (let-values (((fold-var_84)
- (let-values ()
- (cons
- (let-values () i_112)
- fold-var_130))))
- (values fold-var_84)))))
+ (if (pair? lst_176)
+ (let-values (((i_159) (unsafe-car lst_176))
+ ((rest_84) (unsafe-cdr lst_176)))
+ (let-values (((fold-var_215)
+ (let-values (((fold-var_216)
+ (cons i_159 fold-var_214)))
+ (values fold-var_216))))
(if (not #f)
- (for-loop_108 fold-var_129 rest_51)
- fold-var_129)))
- fold-var_83)))))
- for-loop_108)
- null
- lst_105))))
- v_34)))))
- (let-values (((positions_1) (module-path-index-table-positions mpis_2)))
- (let-values (((gen-order_0) (make-hasheqv)))
- (let-values (((rev-positions_0)
- (let-values (((ht_88) positions_1))
+ (for-loop_167 fold-var_215 rest_84)
+ fold-var_215)))
+ fold-var_214)))))
+ for-loop_167)
+ fold-var_212
+ lst_175)))))
+ v_192)))))
+ (let-values (((positions_1) (module-path-index-table-positions mpis_3)))
+ (let-values (((gen-order_0) (make-hasheqv)))
+ (let-values (((rev-positions_0)
+ (let-values (((table_130) (let-values (((table_131) '#hasheqv())) table_131)))
+ (let-values (((ht_106) positions_1))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-in-hash ht_88)))
- ((letrec-values (((for-loop_129)
- (lambda (table_11 i_113)
+ (check-in-hash ht_106))
+ ((letrec-values (((for-loop_168)
+ (lambda (table_132 i_160)
(begin
'for-loop
- (if i_113
- (let-values (((k_31 v_51)
- (hash-iterate-key+value ht_88 i_113)))
- (let-values (((table_115)
- (let-values (((table_116) table_11))
- (let-values (((table_117)
- (let-values ()
- (let-values (((key_47
- val_33)
- (let-values ()
- (values
- v_51
- k_31))))
- (hash-set
- table_116
- key_47
- val_33)))))
- (values table_117)))))
+ (if i_160
+ (let-values (((k_32 v_193)
+ (hash-iterate-key+value ht_106 i_160)))
+ (let-values (((table_133)
+ (let-values (((table_134)
+ (let-values (((key_50 val_35)
+ (values
+ v_193
+ k_32)))
+ (hash-set
+ table_132
+ key_50
+ val_35))))
+ (values table_134))))
(if (not #f)
- (for-loop_129
- table_115
- (hash-iterate-next ht_88 i_113))
- table_115)))
- table_11)))))
- for-loop_129)
- '#hasheqv()
- (hash-iterate-first ht_88))))))
- (let-values ((()
- (begin
- (let-values (((start_25) 0) ((end_15) (hash-count rev-positions_0)) ((inc_9) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_25 end_15 inc_9)))
- ((letrec-values (((for-loop_130)
- (lambda (pos_34)
- (begin
- 'for-loop
- (if (< pos_34 end_15)
- (let-values (((i_114) pos_34))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((mpi_31)
- (hash-ref
- rev-positions_0
- i_114)))
- ((letrec-values (((loop_79)
- (lambda (mpi_32)
- (begin
- 'loop
- (if (hash-ref
- gen-order_0
- mpi_32
- #f)
- (void)
- (let-values ()
- (let-values (((name_39
- base_17)
- (1/module-path-index-split
- mpi_32)))
- (begin
- (if base_17
- (let-values ()
- (loop_79
- base_17))
- (void))
- (hash-set!
- gen-order_0
- mpi_32
- (hash-count
- gen-order_0))))))))))
- loop_79)
- mpi_31)))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_130 (+ pos_34 inc_9))
- (values))))
- (values))))))
- for-loop_130)
- start_25)))
- (values))))
- (let-values ()
- (let-values (((rev-gen-order_0)
- (let-values (((ht_89) gen-order_0))
+ (for-loop_168
+ table_133
+ (hash-iterate-next ht_106 i_160))
+ table_133)))
+ table_132)))))
+ for-loop_168)
+ table_130
+ (hash-iterate-first ht_106)))))))
+ (let-values ((()
+ (begin
+ (let-values (((start_33) 0) ((end_18) (hash-count rev-positions_0)) ((inc_12) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_33 end_18 inc_12))
+ ((letrec-values (((for-loop_169)
+ (lambda (pos_50)
+ (begin
+ 'for-loop
+ (if (< pos_50 end_18)
+ (let-values (((i_161) pos_50))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((mpi_40)
+ (hash-ref
+ rev-positions_0
+ i_161)))
+ ((letrec-values (((loop_90)
+ (lambda (mpi_41)
+ (begin
+ 'loop
+ (if (hash-ref
+ gen-order_0
+ mpi_41
+ #f)
+ (void)
+ (let-values (((name_47
+ base_19)
+ (1/module-path-index-split
+ mpi_41)))
+ (begin
+ (if base_19
+ (loop_90
+ base_19)
+ (void))
+ (hash-set!
+ gen-order_0
+ mpi_41
+ (hash-count
+ gen-order_0)))))))))
+ loop_90)
+ mpi_40))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_169 (+ pos_50 inc_12))
+ (values))))
+ (values))))))
+ for-loop_169)
+ start_33)))
+ (values))))
+ (let-values ()
+ (let-values (((rev-gen-order_0)
+ (let-values (((table_135) (let-values (((table_136) '#hasheqv())) table_136)))
+ (let-values (((ht_107) gen-order_0))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-in-hash ht_89)))
- ((letrec-values (((for-loop_131)
- (lambda (table_114 i_115)
+ (check-in-hash ht_107))
+ ((letrec-values (((for-loop_170)
+ (lambda (table_137 i_162)
(begin
'for-loop
- (if i_115
- (let-values (((k_32 v_135)
- (hash-iterate-key+value ht_89 i_115)))
- (let-values (((table_118)
- (let-values (((table_119) table_114))
- (let-values (((table_120)
- (let-values ()
- (let-values (((key_48
- val_34)
- (let-values ()
- (values
- v_135
- k_32))))
- (hash-set
- table_119
- key_48
- val_34)))))
- (values table_120)))))
+ (if i_162
+ (let-values (((k_33 v_194)
+ (hash-iterate-key+value ht_107 i_162)))
+ (let-values (((table_138)
+ (let-values (((table_139)
+ (let-values (((key_51
+ val_36)
+ (values
+ v_194
+ k_33)))
+ (hash-set
+ table_137
+ key_51
+ val_36))))
+ (values table_139))))
(if (not #f)
- (for-loop_131
- table_118
- (hash-iterate-next ht_89 i_115))
- table_118)))
- table_114)))))
- for-loop_131)
- '#hasheqv()
- (hash-iterate-first ht_89))))))
- (let-values (((gens_0)
- (let-values (((len_30) (hash-count gen-order_0)))
- (begin
- (if (exact-nonnegative-integer? len_30)
- (void)
- (let-values ()
- (raise-argument-error 'for/vector "exact-nonnegative-integer?" len_30)))
- (let-values (((v_93) (make-vector len_30 0)))
- (begin
- (if (zero? len_30)
- (void)
- (let-values ()
- (let-values (((start_26) 0)
- ((end_16) (hash-count gen-order_0))
- ((inc_10) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_26 end_16 inc_10)))
- ((letrec-values (((for-loop_132)
- (lambda (i_116 pos_35)
- (begin
- 'for-loop
- (if (< pos_35 end_16)
- (let-values (((i_117) pos_35))
- (let-values (((i_118)
- (let-values (((i_119)
- i_116))
- (let-values (((i_120)
- (let-values ()
- (begin
- (unsafe-vector*-set!
- v_93
- i_119
- (let-values ()
- (let-values (((mpi_33)
- (hash-ref
- rev-gen-order_0
- i_117)))
- (let-values (((path_9
- base_18)
- (1/module-path-index-split
- mpi_33)))
- (if (top-level-module-path-index?
- mpi_33)
- (let-values ()
- 'top)
- (if (not
- path_9)
- (let-values ()
- (box
- (let-values (((or-part_175)
- (unique-list_0
- (1/resolved-module-path-name
- (module-path-index-resolved
- mpi_33)))))
- (if or-part_175
- or-part_175
- 'self))))
- (if (not
- base_18)
- (let-values ()
- (vector
- path_9))
- (if base_18
- (let-values ()
- (vector
- path_9
- (hash-ref
- gen-order_0
- base_18)))
- (void)))))))))
- (unsafe-fx+
- 1
- i_119)))))
- (values i_120)))))
- (if (if (not
- ((lambda x_48
- (unsafe-fx=
- i_118
- len_30))
- i_117))
- (not #f)
- #f)
- (for-loop_132
- i_118
- (+ pos_35 inc_10))
- i_118)))
- i_116)))))
- for-loop_132)
- 0
- start_26)))))
- v_93))))))
- (let-values (((reorder-vec_0)
- (let-values (((vec_40 i_45)
- (let-values (((start_27) 0)
- ((end_17) (hash-count rev-positions_0))
- ((inc_11) 1))
+ (for-loop_170
+ table_138
+ (hash-iterate-next ht_107 i_162))
+ table_138)))
+ table_137)))))
+ for-loop_170)
+ table_135
+ (hash-iterate-first ht_107)))))))
+ (let-values (((gens_0)
+ (let-values (((len_36) (hash-count gen-order_0)))
+ (begin
+ (if (exact-nonnegative-integer? len_36)
+ (void)
+ (1/raise-argument-error 'for/vector "exact-nonnegative-integer?" len_36))
+ (let-values (((v_195) (make-vector len_36 0)))
+ (begin
+ (if (zero? len_36)
+ (void)
+ (let-values (((i_163) (let-values (((i_164) 0)) i_164)))
+ (let-values (((start_34) 0)
+ ((end_19) (hash-count gen-order_0))
+ ((inc_13) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_34 end_19 inc_13))
+ ((letrec-values (((for-loop_171)
+ (lambda (i_165 pos_51)
+ (begin
+ 'for-loop
+ (if (< pos_51 end_19)
+ (let-values (((i_166) pos_51))
+ (let-values (((i_167)
+ (let-values (((i_168)
+ (begin
+ (unsafe-vector*-set!
+ v_195
+ i_165
+ (let-values (((mpi_42)
+ (hash-ref
+ rev-gen-order_0
+ i_166)))
+ (let-values (((path_8
+ base_20)
+ (1/module-path-index-split
+ mpi_42)))
+ (if (top-level-module-path-index?
+ mpi_42)
+ 'top
+ (if (not
+ path_8)
+ (box
+ (let-values (((or-part_286)
+ (unique-list_0
+ (1/resolved-module-path-name
+ (module-path-index-resolved
+ mpi_42)))))
+ (if or-part_286
+ or-part_286
+ 'self)))
+ (if (not
+ base_20)
+ (vector
+ path_8)
+ (if base_20
+ (vector
+ path_8
+ (hash-ref
+ gen-order_0
+ base_20))
+ (void))))))))
+ (unsafe-fx+
+ 1
+ i_165))))
+ (values i_168))))
+ (if (if (not
+ ((lambda x_54
+ (unsafe-fx= i_167 len_36))
+ i_166))
+ (not #f)
+ #f)
+ (for-loop_171
+ i_167
+ (+ pos_51 inc_13))
+ i_167)))
+ i_165)))))
+ for-loop_171)
+ i_163
+ start_34)))))
+ v_195))))))
+ (let-values (((reorder-vec_0)
+ (let-values (((vec_50 i_169)
+ (let-values (((vec_51)
+ (let-values (((vec_52) (make-vector 16))) vec_52))
+ ((i_170) (let-values (((i_171) 0)) i_171)))
+ (let-values (((start_35) 0)
+ ((end_20) (hash-count rev-positions_0))
+ ((inc_14) 1))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-range start_27 end_17 inc_11)))
- ((letrec-values (((for-loop_133)
- (lambda (vec_41 i_121 pos_36)
+ (check-range start_35 end_20 inc_14))
+ ((letrec-values (((for-loop_172)
+ (lambda (vec_53 i_172 pos_52)
(begin
'for-loop
- (if (< pos_36 end_17)
- (let-values (((i_22) pos_36))
- (let-values (((vec_42 i_66)
- (let-values (((vec_43)
- vec_41)
- ((i_84)
- i_121))
- (let-values (((vec_44
- i_122)
- (let-values ()
- (let-values (((new-vec_2)
- (if (eq?
- i_84
- (unsafe-vector*-length
- vec_43))
- (grow-vector
- vec_43)
- vec_43)))
- (begin
- (unsafe-vector*-set!
- new-vec_2
- i_84
- (let-values ()
- (hash-ref
- gen-order_0
- (hash-ref
- rev-positions_0
- i_22))))
- (values
- new-vec_2
- (unsafe-fx+
- i_84
- 1)))))))
- (values
- vec_44
- i_122)))))
+ (if (< pos_52 end_20)
+ (let-values (((i_173) pos_52))
+ (let-values (((vec_54 i_174)
+ (let-values (((vec_55
+ i_175)
+ (let-values (((new-vec_3)
+ (if (eq?
+ i_172
+ (unsafe-vector*-length
+ vec_53))
+ (grow-vector
+ vec_53)
+ vec_53)))
+ (begin
+ (unsafe-vector*-set!
+ new-vec_3
+ i_172
+ (hash-ref
+ gen-order_0
+ (hash-ref
+ rev-positions_0
+ i_173)))
+ (values
+ new-vec_3
+ (unsafe-fx+
+ i_172
+ 1))))))
+ (values
+ vec_55
+ i_175))))
(if (not #f)
- (for-loop_133
- vec_42
- i_66
- (+ pos_36 inc_11))
- (values vec_42 i_66))))
- (values vec_41 i_121))))))
- for-loop_133)
- (make-vector 16)
- 0
- start_27)))))
- (shrink-vector vec_40 i_45))))
- (if as-data?_0
- (let-values () (vector gens_0 reorder-vec_0))
- (let-values ()
- (list
- 'deserialize-module-path-indexes
- (list 'quote gens_0)
- (list 'quote reorder-vec_0)))))))))))))))))))
+ (for-loop_172
+ vec_54
+ i_174
+ (+ pos_52 inc_14))
+ (values vec_54 i_174))))
+ (values vec_53 i_172))))))
+ for-loop_172)
+ vec_51
+ i_170
+ start_35))))))
+ (shrink-vector vec_50 i_169))))
+ (if as-data?_0
+ (vector gens_0 reorder-vec_0)
+ (list
+ 'deserialize-module-path-indexes
+ (list 'quote gens_0)
+ (list 'quote reorder-vec_0)))))))))))))))))
(define-values
(deserialize-module-path-indexes)
(lambda (gen-vec_0 order-vec_0)
(begin
(let-values (((gen_0) (make-vector (vector-length gen-vec_0) #f)))
(begin
- (let-values (((vec_45 len_31)
- (let-values (((vec_46) gen-vec_0))
- (begin (check-vector vec_46) (values vec_46 (unsafe-vector-length vec_46)))))
- ((start_28) 0))
+ (let-values (((vec_56 len_37)
+ (let-values (((vec_57) gen-vec_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-vector vec_57))
+ (values vec_57 (unsafe-vector-length vec_57)))))
+ ((start_36) 0))
(begin
- #f
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-naturals start_28)))
- ((letrec-values (((for-loop_6)
- (lambda (pos_37 pos_38)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-naturals start_36))
+ ((letrec-values (((for-loop_173)
+ (lambda (pos_53 pos_54)
(begin
'for-loop
- (if (if (unsafe-fx< pos_37 len_31) #t #f)
- (let-values (((d_25) (unsafe-vector-ref vec_45 pos_37)) ((i_123) pos_38))
+ (if (if (unsafe-fx< pos_53 len_37) #t #f)
+ (let-values (((d_25) (unsafe-vector-ref vec_56 pos_53)) ((i_176) pos_54))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (vector-set!
- gen_0
- i_123
- (if (eq? d_25 'top)
- (let-values ()
- (deserialize-module-path-index))
- (if (box? d_25)
- (let-values ()
- (deserialize-module-path-index
- (unbox d_25)))
- (let-values ()
- (deserialize-module-path-index
- (vector*-ref d_25 0)
- (if (> (vector*-length d_25) 1)
- (vector*-ref
- gen_0
- (vector*-ref d_25 1))
- #f)))))))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_6 (unsafe-fx+ 1 pos_37) (+ pos_38 1)) (values))))
+ (let-values ((()
+ (begin
+ (vector-set!
+ gen_0
+ i_176
+ (if (eq? d_25 'top)
+ (deserialize-module-path-index)
+ (if (box? d_25)
+ (deserialize-module-path-index (unbox d_25))
+ (deserialize-module-path-index
+ (vector*-ref d_25 0)
+ (if (> (vector*-length d_25) 1)
+ (vector*-ref gen_0 (vector*-ref d_25 1))
+ #f)))))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_173 (unsafe-fx+ 1 pos_53) (+ pos_54 1)) (values))))
(values))))))
- for-loop_6)
+ for-loop_173)
0
- start_28)))
+ start_36)))
(void)
- (let-values (((len_32) (vector-length order-vec_0)))
+ (let-values (((len_38) (vector-length order-vec_0)))
(begin
- (if (exact-nonnegative-integer? len_32)
+ (if (exact-nonnegative-integer? len_38)
(void)
- (let-values () (raise-argument-error 'for/vector "exact-nonnegative-integer?" len_32)))
- (let-values (((v_136) (make-vector len_32 0)))
+ (1/raise-argument-error 'for/vector "exact-nonnegative-integer?" len_38))
+ (let-values (((v_196) (make-vector len_38 0)))
(begin
- (if (zero? len_32)
+ (if (zero? len_38)
(void)
- (let-values ()
- (let-values (((vec_47 len_33)
- (let-values (((vec_48) order-vec_0))
- (begin (check-vector vec_48) (values vec_48 (unsafe-vector-length vec_48))))))
- (begin
- #f
- ((letrec-values (((for-loop_134)
- (lambda (i_124 pos_4)
- (begin
- 'for-loop
- (if (unsafe-fx< pos_4 len_33)
- (let-values (((p_28) (unsafe-vector-ref vec_47 pos_4)))
- (let-values (((i_37)
- (let-values (((i_26) i_124))
- (let-values (((i_125)
- (let-values ()
- (begin
- (unsafe-vector*-set!
- v_136
- i_26
- (let-values ()
- (vector*-ref gen_0 p_28)))
- (unsafe-fx+ 1 i_26)))))
- (values i_125)))))
- (if (if (not ((lambda x_49 (unsafe-fx= i_37 len_32)) p_28))
- (not #f)
- #f)
- (for-loop_134 i_37 (unsafe-fx+ 1 pos_4))
- i_37)))
- i_124)))))
- for-loop_134)
- 0
- 0)))))
- v_136)))))))))
+ (let-values (((i_177) (let-values (((i_178) 0)) i_178)))
+ (let-values (((vec_58 len_39)
+ (let-values (((vec_59) order-vec_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-vector vec_59))
+ (values vec_59 (unsafe-vector-length vec_59))))))
+ ((letrec-values (((for-loop_174)
+ (lambda (i_179 pos_55)
+ (begin
+ 'for-loop
+ (if (unsafe-fx< pos_55 len_39)
+ (let-values (((p_32) (unsafe-vector-ref vec_58 pos_55)))
+ (let-values (((i_180)
+ (let-values (((i_181)
+ (begin
+ (unsafe-vector*-set!
+ v_196
+ i_179
+ (vector*-ref gen_0 p_32))
+ (unsafe-fx+ 1 i_179))))
+ (values i_181))))
+ (if (if (not ((lambda x_55 (unsafe-fx= i_180 len_38)) p_32))
+ (not #f)
+ #f)
+ (for-loop_174 i_180 (unsafe-fx+ 1 pos_55))
+ i_180)))
+ i_179)))))
+ for-loop_174)
+ i_177
+ 0))))
+ v_196)))))))))
(define-values
(deserialize-module-path-index-data)
- (lambda (v_137)
+ (lambda (v_197)
(begin
(begin
- (if (if (vector? v_137) (= 2 (vector-length v_137)) #f)
+ (if (if (vector? v_197) (= 2 (vector-length v_197)) #f)
(void)
- (let-values () (error 'syntax-deserialize "ill-formed serialization")))
- (deserialize-module-path-indexes (vector-ref v_137 0) (vector-ref v_137 1))))))
+ (error 'syntax-deserialize "ill-formed serialization"))
+ (deserialize-module-path-indexes (vector-ref v_197 0) (vector-ref v_197 1))))))
(define-values
(mpis-as-vector)
- (lambda (mpis_3)
+ (lambda (mpis_4)
(begin
- (let-values (((positions_2) (module-path-index-table-positions mpis_3)))
- (let-values (((vec_49) (make-vector (hash-count positions_2) #f)))
+ (let-values (((positions_2) (module-path-index-table-positions mpis_4)))
+ (let-values (((vec_60) (make-vector (hash-count positions_2) #f)))
(begin
- (let-values (((ht_90) positions_2))
+ (let-values (((ht_108) positions_2))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_90)))
- ((letrec-values (((for-loop_135)
- (lambda (i_126)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_108))
+ ((letrec-values (((for-loop_175)
+ (lambda (i_182)
(begin
'for-loop
- (if i_126
- (let-values (((mpi_34 pos_39) (hash-iterate-key+value ht_90 i_126)))
+ (if i_182
+ (let-values (((mpi_43 pos_56) (hash-iterate-key+value ht_108 i_182)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (vector-set! vec_49 pos_39 mpi_34))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_135 (hash-iterate-next ht_90 i_126)) (values))))
+ (let-values ((()
+ (begin
+ (vector-set! vec_60 pos_56 mpi_43)
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_175 (hash-iterate-next ht_108 i_182)) (values))))
(values))))))
- for-loop_135)
- (hash-iterate-first ht_90))))
+ for-loop_175)
+ (hash-iterate-first ht_108))))
(void)
- vec_49))))))
+ vec_60))))))
(define-values
(generate-module-data-linklet)
- (lambda (mpis_4)
+ (lambda (mpis_5)
(begin
(list
'linklet
@@ -21395,1945 +21460,1985 @@
(list
'define-values
(list mpi-vector-id)
- (let-values (((mpis21_0) mpis_4)) (generate-module-path-index-deserialize.1 #f mpis21_0)))))))
+ (let-values (((mpis27_0) mpis_5)) (generate-module-path-index-deserialize.1 #f mpis27_0)))))))
(define-values
(generate-module-declaration-linklet)
- (lambda (mpis_5 self_6 requires_2 provides_5 phase-to-link-module-uses-expr_0 portal-stxes_0)
+ (lambda (mpis_6
+ self_8
+ requires_3
+ recur-requires_2
+ flattened-requires_2
+ provides_6
+ phase-to-link-module-uses-expr_0
+ portal-stxes_0)
(begin
(list
'linklet
(list deserialize-imports (list mpi-vector-id))
- '(self-mpi requires provides phase-to-link-modules portal-stxes)
- (list 'define-values '(self-mpi) (add-module-path-index! mpis_5 self_6))
+ '(self-mpi requires recur-requires flattened-requires provides phase-to-link-modules portal-stxes)
+ (list 'define-values '(self-mpi) (add-module-path-index! mpis_6 self_8))
(list
'define-values
'(requires)
- (let-values (((requires22_0) requires_2) ((mpis23_0) mpis_5) ((temp24_0) #f))
- (generate-deserialize.1 #f #f mpis23_0 #f '#hasheq() temp24_0 requires22_0)))
+ (let-values (((requires28_0) requires_3) ((mpis29_0) mpis_6) ((temp30_1) #f))
+ (generate-deserialize.1
+ #f
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ mpis29_0
+ #f
+ '#hasheq()
+ #f
+ temp30_1
+ requires28_0)))
+ (list 'define-values '(recur-requires) (list 'quote recur-requires_2))
+ (list
+ 'define-values
+ '(flattened-requires)
+ (if flattened-requires_2
+ (let-values (((flattened-requires31_0) flattened-requires_2) ((mpis32_0) mpis_6) ((temp33_0) #f))
+ (generate-deserialize.1
+ #f
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ mpis32_0
+ #f
+ '#hasheq()
+ #f
+ temp33_0
+ flattened-requires31_0))
+ ''#f))
(list
'define-values
'(provides)
- (let-values (((provides25_0) provides_5) ((mpis26_0) mpis_5) ((temp27_1) #f) ((provides28_0) provides_5))
- (generate-deserialize.1 #f #f mpis26_0 provides28_0 '#hasheq() temp27_1 provides25_0)))
+ (let-values (((provides34_0) provides_6) ((mpis35_0) mpis_6) ((temp36_0) #f) ((provides37_0) provides_6))
+ (generate-deserialize.1
+ #f
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ mpis35_0
+ provides37_0
+ '#hasheq()
+ #f
+ temp36_0
+ provides34_0)))
(list 'define-values '(phase-to-link-modules) phase-to-link-module-uses-expr_0)
(list 'define-values '(portal-stxes) (list 'quote portal-stxes_0))))))
(define-values
(serialize-module-uses)
- (lambda (mus_0 mpis_6)
+ (lambda (mus_0 mpis_7)
(begin
(reverse$1
- (let-values (((lst_119) mus_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_119)))
- ((letrec-values (((for-loop_136)
- (lambda (fold-var_131 lst_120)
- (begin
- 'for-loop
- (if (pair? lst_120)
- (let-values (((mu_1) (unsafe-car lst_120)) ((rest_58) (unsafe-cdr lst_120)))
- (let-values (((fold-var_132)
- (let-values (((fold-var_114) fold-var_131))
- (let-values (((fold-var_115)
- (let-values ()
- (cons
- (let-values ()
- (list
- 'module-use
- (add-module-path-index!
- mpis_6
- (module-use-module mu_1))
- (module-use-phase mu_1)))
- fold-var_114))))
- (values fold-var_115)))))
- (if (not #f) (for-loop_136 fold-var_132 rest_58) fold-var_132)))
- fold-var_131)))))
- for-loop_136)
- null
- lst_119)))))))
+ (let-values (((fold-var_217) (let-values (((fold-var_218) null)) fold-var_218)))
+ (let-values (((lst_177) mus_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_177))
+ ((letrec-values (((for-loop_176)
+ (lambda (fold-var_219 lst_178)
+ (begin
+ 'for-loop
+ (if (pair? lst_178)
+ (let-values (((mu_1) (unsafe-car lst_178)) ((rest_85) (unsafe-cdr lst_178)))
+ (let-values (((fold-var_220)
+ (let-values (((fold-var_221)
+ (cons
+ (list
+ 'module-use
+ (add-module-path-index!
+ mpis_7
+ (module-use-module mu_1))
+ (module-use-phase mu_1))
+ fold-var_219)))
+ (values fold-var_221))))
+ (if (not #f) (for-loop_176 fold-var_220 rest_85) fold-var_220)))
+ fold-var_219)))))
+ for-loop_176)
+ fold-var_217
+ lst_177))))))))
(define-values
(interned-literal?)
- (lambda (v_138)
- (begin
- (let-values (((or-part_95) (null? v_138)))
- (if or-part_95
- or-part_95
- (let-values (((or-part_176) (boolean? v_138)))
- (if or-part_176
- or-part_176
- (let-values (((or-part_100)
- (if (fixnum? v_138) (if (< v_138 (sub1 (expt 2 30))) (> v_138 (- (expt 2 30))) #f) #f)))
- (if or-part_100
- or-part_100
- (let-values (((or-part_177) (symbol? v_138)))
- (if or-part_177
- or-part_177
- (let-values (((or-part_178) (char? v_138)))
- (if or-part_178 or-part_178 (keyword? v_138))))))))))))))
+ (lambda (v_198)
+ (begin
+ (let-values (((or-part_287) (null? v_198)))
+ (if or-part_287
+ or-part_287
+ (let-values (((or-part_288) (boolean? v_198)))
+ (if or-part_288
+ or-part_288
+ (let-values (((or-part_289)
+ (if (fixnum? v_198) (if (< v_198 (sub1 (expt 2 30))) (> v_198 (- (expt 2 30))) #f) #f)))
+ (if or-part_289
+ or-part_289
+ (let-values (((or-part_290) (symbol? v_198)))
+ (if or-part_290
+ or-part_290
+ (let-values (((or-part_291) (char? v_198)))
+ (if or-part_291 or-part_291 (keyword? v_198))))))))))))))
(define-values
(serialize-phase-to-link-module-uses)
- (lambda (phase-to-link-module-uses_0 mpis_7)
+ (lambda (phase-to-link-module-uses_0 mpis_8)
(begin
(let-values (((phases-in-order_0)
- (let-values (((temp29_1) (hash-keys phase-to-link-module-uses_0)) ((<30_0) <))
- (sort.1 #f #f temp29_1 <30_0))))
+ (let-values (((temp38_0) (hash-keys phase-to-link-module-uses_0)) ((<39_0) <))
+ (sort.1 #f #f temp38_0 <39_0))))
(list*
'hasheqv
(apply
append
(reverse$1
- (let-values (((lst_121) phases-in-order_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_121)))
- ((letrec-values (((for-loop_19)
- (lambda (fold-var_133 lst_122)
- (begin
- 'for-loop
- (if (pair? lst_122)
- (let-values (((phase_56) (unsafe-car lst_122)) ((rest_59) (unsafe-cdr lst_122)))
- (let-values (((fold-var_134)
- (let-values (((fold-var_135) fold-var_133))
- (let-values (((fold-var_136)
- (let-values ()
- (cons
- (let-values ()
- (list
- phase_56
- (list*
- 'list
- (serialize-module-uses
- (hash-ref
- phase-to-link-module-uses_0
- phase_56)
- mpis_7))))
- fold-var_135))))
- (values fold-var_136)))))
- (if (not #f) (for-loop_19 fold-var_134 rest_59) fold-var_134)))
- fold-var_133)))))
- for-loop_19)
- null
- lst_121))))))))))
+ (let-values (((fold-var_222) (let-values (((fold-var_223) null)) fold-var_223)))
+ (let-values (((lst_179) phases-in-order_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_179))
+ ((letrec-values (((for-loop_177)
+ (lambda (fold-var_224 lst_180)
+ (begin
+ 'for-loop
+ (if (pair? lst_180)
+ (let-values (((phase_64) (unsafe-car lst_180))
+ ((rest_86) (unsafe-cdr lst_180)))
+ (let-values (((fold-var_225)
+ (let-values (((fold-var_226)
+ (cons
+ (list
+ phase_64
+ (list*
+ 'list
+ (serialize-module-uses
+ (hash-ref
+ phase-to-link-module-uses_0
+ phase_64)
+ mpis_8)))
+ fold-var_224)))
+ (values fold-var_226))))
+ (if (not #f) (for-loop_177 fold-var_225 rest_86) fold-var_225)))
+ fold-var_224)))))
+ for-loop_177)
+ fold-var_222
+ lst_179)))))))))))
(define-values
(generate-deserialize.1)
(lambda (as-data?7_0
keep-provides?10_0
+ map-binding-symbol13_0
+ map-mpi12_0
mpis6_0
phase+space-hasheqv11_0
preserve-prop-keys9_0
+ report-mpi-shifts14_0
syntax-support?8_0
- v18_0)
+ v24_0)
(begin
'generate-deserialize
- (let-values (((v_139) v18_0))
- (let-values (((mpis_8) mpis6_0))
+ (let-values (((v_199) v24_0))
+ (let-values (((mpis_9) mpis6_0))
(let-values (((as-data?_1) as-data?7_0))
(let-values (((syntax-support?_0) syntax-support?8_0))
(let-values (((preserve-prop-keys_1) preserve-prop-keys9_0))
(let-values (((keep-provides?_1) keep-provides?10_0))
(let-values (((phase+space-hasheqv_0) phase+space-hasheqv11_0))
- (let-values ()
- (let-values (((bulk-shifts_7) (if keep-provides?_1 (list (make-hasheq)) #f)))
- (let-values (((reachable-scopes_3) (find-reachable-scopes v_139 bulk-shifts_7)))
- (let-values (((state_26)
- (make-serialize-state
- reachable-scopes_3
- preserve-prop-keys_1
- (if keep-provides?_1
- (lambda (b_75)
- (let-values (((name_40) (hash-ref (car bulk-shifts_7) b_75 #f)))
- (let-values (((or-part_114) (not name_40)))
- (if or-part_114 or-part_114 (keep-provides?_1 name_40)))))
- #f))))
- (let-values (((mutables_0) (make-hasheq)))
- (let-values (((objs_0) (make-hasheq)))
- (let-values (((shares_0) (make-hasheq)))
- (let-values (((obj-step_0) 0))
- (let-values (((frontier_0) null))
- (letrec-values (((add-frontier!_0)
- (case-lambda
- ((v_140)
- (begin
- 'add-frontier!
- (set! frontier_0 (cons v_140 frontier_0))))
- ((kind_5 v_141) (add-frontier!_0 v_141)))))
- (let-values ((()
- (begin
- ((letrec-values (((frontier-loop_0)
- (lambda (v_142)
- (begin
- 'frontier-loop
- (begin
- ((letrec-values (((loop_85)
- (lambda (v_143)
- (begin
- 'loop
- (if (let-values (((or-part_179)
- (interned-literal?
- v_143)))
- (if or-part_179
- or-part_179
- (1/module-path-index?
- v_143)))
- (let-values ()
- (void))
- (if (hash-ref
- objs_0
- v_143
- #f)
- (let-values ()
- (if (hash-ref
- mutables_0
- v_143
- #f)
- (void)
- (let-values ()
- (hash-set!
- shares_0
- v_143
- #t))))
- (let-values ()
+ (let-values (((map-mpi_0)
+ (if (eq? map-mpi12_0 unsafe-undefined)
+ (lambda (mpi_44) (begin 'map-mpi mpi_44))
+ map-mpi12_0)))
+ (let-values (((map-binding-symbol_2)
+ (if (eq? map-binding-symbol13_0 unsafe-undefined)
+ (lambda (mpi_45 sym_40 phase_65)
+ (begin 'map-binding-symbol (values sym_40 phase_65)))
+ map-binding-symbol13_0)))
+ (let-values (((report-mpi-shifts_0) report-mpi-shifts14_0))
+ (let-values (((bulk-shifts_11) (if keep-provides?_1 (list (make-hasheq)) #f)))
+ (let-values (((reachable-scopes_3 implicitly-reachable-scopes_1)
+ (find-reachable-scopes v_199 bulk-shifts_11 report-mpi-shifts_0)))
+ (let-values (((state_28)
+ (make-serialize-state
+ reachable-scopes_3
+ implicitly-reachable-scopes_1
+ preserve-prop-keys_1
+ (if keep-provides?_1
+ (lambda (b_97)
+ (let-values (((name_48) (hash-ref (car bulk-shifts_11) b_97 #f)))
+ (let-values (((or-part_292) (not name_48)))
+ (if or-part_292 or-part_292 (keep-provides?_1 name_48)))))
+ #f)
+ (if report-mpi-shifts_0 #t #f)
+ map-binding-symbol_2)))
+ (let-values (((mutables_0) (make-hasheq)))
+ (let-values (((objs_0) (make-hasheq)))
+ (let-values (((shares_0) (make-hasheq)))
+ (let-values (((binding-interns_0) (make-hash)))
+ (let-values (((obj-step_0) 0))
+ (let-values (((serialize-maybe-intern_0)
+ (lambda (v_200)
+ (begin
+ 'serialize-maybe-intern
+ (if (module-binding? v_200)
+ (module-binding-maybe-intern
+ v_200
+ binding-interns_0
+ map-binding-symbol_2
+ (lambda (mpi_46)
+ (add-module-path-index!/pos
+ mpis_9
+ (map-mpi_0 mpi_46))))
+ #f)))))
+ (let-values (((frontier_0) null))
+ (letrec-values (((add-frontier!_0)
+ (case-lambda
+ ((v_201)
+ (begin
+ 'add-frontier!
+ (set! frontier_0 (cons v_201 frontier_0))))
+ ((kind_5 v_202) (add-frontier!_0 v_202)))))
+ (let-values ((()
+ (begin
+ ((letrec-values (((frontier-loop_0)
+ (lambda (v_203)
+ (begin
+ 'frontier-loop
+ (begin
+ ((letrec-values (((loop_91)
+ (lambda (v_204)
(begin
- (if (serialize-fill!?
- v_143)
- (let-values ()
- (begin
- (hash-set!
- mutables_0
- v_143
- (hash-count
- mutables_0))
- ((serialize-fill!-ref
- v_143)
- v_143
- add-frontier!_0
- state_26)))
- (if (serialize?
- v_143)
- (let-values ()
- ((serialize-ref
- v_143)
- v_143
- (case-lambda
- ((sub-v_0)
- (loop_85
- sub-v_0))
- ((kind_6
- sub-v_1)
- (loop_85
- sub-v_1)))
- state_26))
- (if (pair?
- v_143)
- (let-values ()
+ 'loop
+ (if (let-values (((or-part_293)
+ (interned-literal?
+ v_204)))
+ (if or-part_293
+ or-part_293
+ (1/module-path-index?
+ v_204)))
+ (void)
+ (let-values (((cond-val_13)
+ (serialize-maybe-intern_0
+ v_204)))
+ (if cond-val_13
+ ((lambda (v_205)
+ (loop_91
+ v_205))
+ cond-val_13)
+ (if (hash-ref
+ objs_0
+ v_204
+ #f)
+ (if (hash-ref
+ mutables_0
+ v_204
+ #f)
+ (void)
+ (hash-set!
+ shares_0
+ v_204
+ #t))
(begin
- (loop_85
- (car
- v_143))
- (loop_85
- (cdr
- v_143))))
- (if (vector?
- v_143)
- (let-values ()
- (if (let-values (((or-part_180)
- (immutable?
- v_143)))
- (if or-part_180
- or-part_180
- (zero?
- (vector-length
- v_143))))
- (begin
- (let-values (((vec_50
- len_34)
- (let-values (((vec_51)
- v_143))
- (begin
- (check-vector
- vec_51)
- (values
- vec_51
- (unsafe-vector-length
- vec_51))))))
- (begin
- #f
- ((letrec-values (((for-loop_137)
- (lambda (pos_40)
- (begin
- 'for-loop
- (if (unsafe-fx<
- pos_40
- len_34)
- (let-values (((e_29)
- (unsafe-vector-ref
- vec_50
- pos_40)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (loop_85
- e_29))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_137
- (unsafe-fx+
- 1
- pos_40))
- (values))))
- (values))))))
- for-loop_137)
- 0)))
- (void))
+ (if (serialize-fill!?
+ v_204)
(begin
(hash-set!
mutables_0
- v_143
+ v_204
(hash-count
mutables_0))
- (begin
- (let-values (((vec_52
- len_35)
- (let-values (((vec_53)
- v_143))
- (begin
- (check-vector
- vec_53)
- (values
- vec_53
- (unsafe-vector-length
- vec_53))))))
- (begin
- #f
- ((letrec-values (((for-loop_138)
- (lambda (pos_41)
- (begin
- 'for-loop
- (if (unsafe-fx<
- pos_41
- len_35)
- (let-values (((e_30)
- (unsafe-vector-ref
- vec_52
- pos_41)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (add-frontier!_0
- e_30))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_138
- (unsafe-fx+
- 1
- pos_41))
- (values))))
- (values))))))
- for-loop_138)
- 0)))
- (void)))))
- (if (box?
- v_143)
- (let-values ()
- (if (immutable?
- v_143)
- (loop_85
- (unbox
- v_143))
- (begin
- (hash-set!
- mutables_0
- v_143
- (hash-count
- mutables_0))
- (add-frontier!_0
- (unbox
- v_143)))))
- (if (hash?
- v_143)
- (let-values ()
- (if (immutable?
- v_143)
+ ((serialize-fill!-ref
+ v_204)
+ v_204
+ add-frontier!_0
+ state_28))
+ (if (serialize?
+ v_204)
+ ((serialize-ref
+ v_204)
+ v_204
+ (case-lambda
+ ((sub-v_0)
+ (loop_91
+ sub-v_0))
+ ((kind_6
+ sub-v_1)
+ (loop_91
+ sub-v_1)))
+ state_28)
+ (if (pair?
+ v_204)
(begin
- (let-values (((lst_123)
- (sorted-hash-keys
- v_143)))
+ (loop_91
+ (car
+ v_204))
+ (loop_91
+ (cdr
+ v_204)))
+ (if (vector?
+ v_204)
+ (if (let-values (((or-part_294)
+ (immutable?
+ v_204)))
+ (if or-part_294
+ or-part_294
+ (zero?
+ (vector-length
+ v_204))))
(begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_123)))
- ((letrec-values (((for-loop_139)
- (lambda (lst_124)
- (begin
- 'for-loop
- (if (pair?
- lst_124)
- (let-values (((k_33)
- (unsafe-car
- lst_124))
- ((rest_60)
- (unsafe-cdr
- lst_124)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (begin
- (loop_85
- k_33)
- (loop_85
- (hash-ref
- v_143
- k_33))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_139
- rest_60)
- (values))))
- (values))))))
- for-loop_139)
- lst_123)))
- (void))
- (begin
- (hash-set!
- mutables_0
- v_143
- (hash-count
- mutables_0))
- (begin
- (let-values (((lst_125)
- (sorted-hash-keys
- v_143)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_125)))
- ((letrec-values (((for-loop_140)
- (lambda (lst_57)
+ (let-values (((vec_61
+ len_40)
+ (let-values (((vec_62)
+ v_204))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-vector
+ vec_62))
+ (values
+ vec_62
+ (unsafe-vector-length
+ vec_62))))))
+ ((letrec-values (((for-loop_178)
+ (lambda (pos_57)
(begin
'for-loop
- (if (pair?
- lst_57)
- (let-values (((k_34)
- (unsafe-car
- lst_57))
- ((rest_61)
- (unsafe-cdr
- lst_57)))
+ (if (unsafe-fx<
+ pos_57
+ len_40)
+ (let-values (((e_32)
+ (unsafe-vector-ref
+ vec_61
+ pos_57)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (begin
- (add-frontier!_0
- k_34)
- (add-frontier!_0
- (hash-ref
- v_143
- k_34))))
- (values)))))
- (values)))))
+ (let-values ((()
+ (begin
+ (loop_91
+ e_32)
+ (values))))
+ (values))))
(if (not
#f)
- (for-loop_140
- rest_61)
+ (for-loop_178
+ (unsafe-fx+
+ 1
+ pos_57))
(values))))
(values))))))
- for-loop_140)
- lst_125)))
- (void)))))
- (if (prefab-struct-key
- v_143)
- (let-values ()
- (begin
- (let-values (((v*_3
- start*_3
- stop*_4
- step*_3)
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (unsafe-normalise-inputs
- unsafe-vector-length
- (struct->vector
- v_143)
- 1
- #f
- 1)
- (normalise-inputs
- 'in-vector
- "vector"
- (lambda (x_50)
- (vector?
- x_50))
- (lambda (x_51)
- (unsafe-vector-length
- x_51))
- (struct->vector
- v_143)
- 1
- #f
- 1))))
+ for-loop_178)
+ 0))
+ (void))
(begin
- #t
- ((letrec-values (((for-loop_141)
- (lambda (idx_3)
- (begin
- 'for-loop
- (if (unsafe-fx<
- idx_3
- stop*_4)
- (let-values (((e_31)
- (unsafe-vector-ref
- v*_3
- idx_3)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (loop_85
- e_31))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_141
- (unsafe-fx+
- idx_3
- 1))
- (values))))
- (values))))))
- for-loop_141)
- start*_3)))
- (void)))
- (if (srcloc?
- v_143)
- (let-values ()
- (if (path?
- (srcloc-source
- v_143))
- (void)
- (let-values ()
+ (hash-set!
+ mutables_0
+ v_204
+ (hash-count
+ mutables_0))
(begin
- (let-values (((v*_4
- start*_4
- stop*_5
- step*_4)
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (unsafe-normalise-inputs
- unsafe-vector-length
- (struct->vector
- v_143)
- 1
- #f
- 1)
- (normalise-inputs
- 'in-vector
- "vector"
- (lambda (x_52)
- (vector?
- x_52))
- (lambda (x_53)
+ (let-values (((vec_63
+ len_41)
+ (let-values (((vec_64)
+ v_204))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-vector
+ vec_64))
+ (values
+ vec_64
(unsafe-vector-length
- x_53))
- (struct->vector
- v_143)
- 1
- #f
- 1))))
+ vec_64))))))
+ ((letrec-values (((for-loop_179)
+ (lambda (pos_58)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ pos_58
+ len_41)
+ (let-values (((e_33)
+ (unsafe-vector-ref
+ vec_63
+ pos_58)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (add-frontier!_0
+ e_33)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_179
+ (unsafe-fx+
+ 1
+ pos_58))
+ (values))))
+ (values))))))
+ for-loop_179)
+ 0))
+ (void))))
+ (if (box?
+ v_204)
+ (if (immutable?
+ v_204)
+ (loop_91
+ (unbox
+ v_204))
+ (begin
+ (hash-set!
+ mutables_0
+ v_204
+ (hash-count
+ mutables_0))
+ (add-frontier!_0
+ (unbox
+ v_204))))
+ (if (hash?
+ v_204)
+ (if (immutable?
+ v_204)
+ (begin
+ (let-values (((lst_181)
+ (sorted-hash-keys
+ v_204)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_181))
+ ((letrec-values (((for-loop_180)
+ (lambda (lst_182)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_182)
+ (let-values (((k_34)
+ (unsafe-car
+ lst_182))
+ ((rest_87)
+ (unsafe-cdr
+ lst_182)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (begin
+ (loop_91
+ k_34)
+ (loop_91
+ (hash-ref
+ v_204
+ k_34)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_180
+ rest_87)
+ (values))))
+ (values))))))
+ for-loop_180)
+ lst_181)))
+ (void))
+ (begin
+ (hash-set!
+ mutables_0
+ v_204
+ (hash-count
+ mutables_0))
(begin
- #t
- ((letrec-values (((for-loop_142)
- (lambda (idx_4)
+ (let-values (((lst_183)
+ (sorted-hash-keys
+ v_204)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_183))
+ ((letrec-values (((for-loop_181)
+ (lambda (lst_184)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_184)
+ (let-values (((k_35)
+ (unsafe-car
+ lst_184))
+ ((rest_88)
+ (unsafe-cdr
+ lst_184)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (begin
+ (add-frontier!_0
+ k_35)
+ (add-frontier!_0
+ (hash-ref
+ v_204
+ k_35)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_181
+ rest_88)
+ (values))))
+ (values))))))
+ for-loop_181)
+ lst_183)))
+ (void))))
+ (if (prefab-struct-key
+ v_204)
+ (begin
+ (let-values (((v*_3
+ start*_3
+ stop*_4
+ step*_3)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (unsafe-normalise-inputs
+ unsafe-vector-length
+ (struct->vector
+ v_204)
+ 1
+ #f
+ 1)
+ (normalise-inputs
+ 'in-vector
+ "vector"
+ (lambda (x_56)
+ (vector?
+ x_56))
+ (lambda (x_57)
+ (unsafe-vector-length
+ x_57))
+ (struct->vector
+ v_204)
+ 1
+ #f
+ 1))))
+ ((letrec-values (((for-loop_182)
+ (lambda (idx_3)
(begin
'for-loop
(if (unsafe-fx<
- idx_4
- stop*_5)
- (let-values (((e_32)
+ idx_3
+ stop*_4)
+ (let-values (((e_34)
(unsafe-vector-ref
- v*_4
- idx_4)))
+ v*_3
+ idx_3)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (loop_85
- e_32))
- (values)))))
- (values)))))
+ (let-values ((()
+ (begin
+ (loop_91
+ e_34)
+ (values))))
+ (values))))
(if (not
#f)
- (for-loop_142
+ (for-loop_182
(unsafe-fx+
- idx_4
+ idx_3
1))
(values))))
(values))))))
- for-loop_142)
- start*_4)))
- (void)))))
- (let-values ()
- (void))))))))))
- (hash-set!
- objs_0
- v_143
- obj-step_0)
- (set! obj-step_0
- (add1
- obj-step_0))))))))))
- loop_85)
- v_142)
- (if (null? frontier_0)
- (void)
- (let-values ()
- (let-values (((l_36) frontier_0))
- (begin
- (set! frontier_0 null)
- (let-values (((lst_126) l_36))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_126)))
- ((letrec-values (((for-loop_143)
- (lambda (lst_127)
- (begin
- 'for-loop
- (if (pair?
- lst_127)
- (let-values (((v_144)
- (unsafe-car
- lst_127))
- ((rest_62)
- (unsafe-cdr
- lst_127)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
+ for-loop_182)
+ start*_3))
+ (void))
+ (if (srcloc?
+ v_204)
+ (if (path?
+ (srcloc-source
+ v_204))
+ (void)
+ (begin
+ (let-values (((v*_4
+ start*_4
+ stop*_5
+ step*_4)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (unsafe-normalise-inputs
+ unsafe-vector-length
+ (struct->vector
+ v_204)
+ 1
+ #f
+ 1)
+ (normalise-inputs
+ 'in-vector
+ "vector"
+ (lambda (x_58)
+ (vector?
+ x_58))
+ (lambda (x_59)
+ (unsafe-vector-length
+ x_59))
+ (struct->vector
+ v_204)
+ 1
+ #f
+ 1))))
+ ((letrec-values (((for-loop_183)
+ (lambda (idx_4)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ idx_4
+ stop*_5)
+ (let-values (((e_35)
+ (unsafe-vector-ref
+ v*_4
+ idx_4)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (loop_91
+ e_35)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_183
+ (unsafe-fx+
+ idx_4
+ 1))
+ (values))))
+ (values))))))
+ for-loop_183)
+ start*_4))
+ (void)))
+ (void)))))))))
+ (hash-set!
+ objs_0
+ v_204
+ obj-step_0)
+ (set! obj-step_0
+ (add1
+ obj-step_0)))))))))))
+ loop_91)
+ v_203)
+ (if (null? frontier_0)
+ (void)
+ (let-values (((l_43)
+ frontier_0))
+ (begin
+ (set! frontier_0 null)
+ (let-values (((lst_185)
+ l_43))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_185))
+ ((letrec-values (((for-loop_184)
+ (lambda (lst_186)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_186)
+ (let-values (((v_206)
+ (unsafe-car
+ lst_186))
+ ((rest_89)
+ (unsafe-cdr
+ lst_186)))
+ (let-values ((()
+ (let-values ((()
+ (begin
(frontier-loop_0
- v_144))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_143
- rest_62)
- (values))))
- (values))))))
- for-loop_143)
- lst_126)))
- (void))))))))))
- frontier-loop_0)
- v_139)
- (values))))
- (let-values (((num-mutables_0) (hash-count mutables_0)))
- (let-values (((share-step-positions_0)
- (let-values (((share-steps_0)
- (reverse$1
- (let-values (((ht_83) shares_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash-keys ht_83)))
- ((letrec-values (((for-loop_144)
- (lambda (fold-var_137
- i_127)
- (begin
- 'for-loop
- (if i_127
- (let-values (((obj_0)
- (hash-iterate-key
- ht_83
- i_127)))
- (let-values (((fold-var_138)
- (let-values (((fold-var_139)
- fold-var_137))
- (let-values (((fold-var_140)
- (let-values ()
- (cons
- (let-values ()
- (hash-ref
- objs_0
- obj_0))
- fold-var_139))))
- (values
- fold-var_140)))))
- (if (not #f)
- (for-loop_144
- fold-var_138
- (hash-iterate-next
- ht_83
- i_127))
- fold-var_138)))
- fold-var_137)))))
- for-loop_144)
- null
- (hash-iterate-first ht_83)))))))
- (let-values (((lst_128)
- (let-values (((share-steps31_0) share-steps_0)
- ((<32_0) <))
- (sort.1 #f #f share-steps31_0 <32_0)))
- ((start_29) num-mutables_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_128)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-naturals start_29)))
- ((letrec-values (((for-loop_145)
- (lambda (table_43 lst_129 pos_42)
- (begin
- 'for-loop
- (if (if (pair? lst_129) #t #f)
- (let-values (((step_5)
- (unsafe-car
- lst_129))
- ((rest_63)
- (unsafe-cdr
- lst_129))
- ((pos_43) pos_42))
- (let-values (((table_121)
- (let-values (((table_122)
- table_43))
- (let-values (((table_123)
- (let-values ()
- (let-values (((key_49
- val_35)
- (let-values ()
- (values
- step_5
- pos_43))))
- (hash-set
- table_122
- key_49
- val_35)))))
- (values
- table_123)))))
- (if (not #f)
- (for-loop_145
- table_121
- rest_63
- (+ pos_42 1))
- table_121)))
- table_43)))))
- for-loop_145)
- '#hasheqv()
- lst_128
- start_29))))))
- (let-values (((stream_0) null))
- (let-values (((stream-size_0) 0))
- (let-values (((next-push-position_0)
- (lambda () (begin 'next-push-position stream-size_0))))
- (let-values (((quoted?_0)
- (lambda (pos_44)
- (begin
- 'quoted?
- (let-values (((v_145)
- (list-ref
- stream_0
- (- stream-size_0 (add1 pos_44)))))
- (let-values (((or-part_181)
- (not (keyword? v_145))))
- (if or-part_181
- or-part_181
- (eq? '#:quote v_145))))))))
- (let-values (((ser-reset!_0)
- (lambda (pos_45)
- (begin
- 'ser-reset!
- (begin
- (set! stream_0
- (list-tail
- stream_0
- (- stream-size_0 pos_45)))
- (set! stream-size_0 pos_45))))))
- (let-values (((reap-stream!_0)
- (lambda ()
+ v_206)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_184
+ rest_89)
+ (values))))
+ (values))))))
+ for-loop_184)
+ lst_185)))
+ (void)))))))))
+ frontier-loop_0)
+ v_199)
+ (values))))
+ (let-values (((num-mutables_0) (hash-count mutables_0)))
+ (let-values (((share-step-positions_0)
+ (let-values (((share-steps_0)
+ (reverse$1
+ (let-values (((fold-var_227)
+ (let-values (((fold-var_228)
+ null))
+ fold-var_228)))
+ (let-values (((ht_109) shares_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash-keys ht_109))
+ ((letrec-values (((for-loop_185)
+ (lambda (fold-var_229
+ i_183)
+ (begin
+ 'for-loop
+ (if i_183
+ (let-values (((obj_0)
+ (hash-iterate-key
+ ht_109
+ i_183)))
+ (let-values (((fold-var_230)
+ (let-values (((fold-var_231)
+ (cons
+ (hash-ref
+ objs_0
+ obj_0)
+ fold-var_229)))
+ (values
+ fold-var_231))))
+ (if (not
+ #f)
+ (for-loop_185
+ fold-var_230
+ (hash-iterate-next
+ ht_109
+ i_183))
+ fold-var_230)))
+ fold-var_229)))))
+ for-loop_185)
+ fold-var_227
+ (hash-iterate-first
+ ht_109))))))))
+ (let-values (((table_140)
+ (let-values (((table_141)
+ '#hasheqv()))
+ table_141)))
+ (let-values (((lst_187)
+ (let-values (((share-steps40_0)
+ share-steps_0)
+ ((<41_0) <))
+ (sort.1
+ #f
+ #f
+ share-steps40_0
+ <41_0)))
+ ((start_37) num-mutables_0))
(begin
- 'reap-stream!
- (begin0
- (list->vector (reverse$1 stream_0))
- (set! stream_0 null)
- (set! stream-size_0 0))))))
- (letrec-values (((ser-push!_15)
- (case-lambda
- ((v_146)
- (begin
- 'ser-push!
- (if (hash-ref shares_0 v_146 #f)
- (let-values ()
- (let-values (((n_25)
- (hash-ref
- share-step-positions_0
- (hash-ref
- objs_0
- v_146))))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_187))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-naturals start_37))
+ ((letrec-values (((for-loop_186)
+ (lambda (table_142
+ lst_188
+ pos_59)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_188)
+ #t
+ #f)
+ (let-values (((step_10)
+ (unsafe-car
+ lst_188))
+ ((rest_90)
+ (unsafe-cdr
+ lst_188))
+ ((pos_60)
+ pos_59))
+ (let-values (((table_143)
+ (let-values (((table_144)
+ (let-values (((key_52
+ val_37)
+ (values
+ step_10
+ pos_60)))
+ (hash-set
+ table_142
+ key_52
+ val_37))))
+ (values
+ table_144))))
+ (if (not #f)
+ (for-loop_186
+ table_143
+ rest_90
+ (+ pos_59 1))
+ table_143)))
+ table_142)))))
+ for-loop_186)
+ table_140
+ lst_187
+ start_37)))))))
+ (let-values (((stream_0) null))
+ (let-values (((stream-size_0) 0))
+ (let-values (((next-push-position_0)
+ (lambda ()
+ (begin 'next-push-position stream-size_0))))
+ (let-values (((quoted?_0)
+ (lambda (pos_61)
+ (begin
+ 'quoted?
+ (let-values (((v_207)
+ (list-ref
+ stream_0
+ (-
+ stream-size_0
+ (add1 pos_61)))))
+ (let-values (((or-part_295)
+ (not (keyword? v_207))))
+ (if or-part_295
+ or-part_295
+ (eq? '#:quote v_207))))))))
+ (let-values (((ser-reset!_0)
+ (lambda (pos_62)
+ (begin
+ 'ser-reset!
+ (begin
+ (set! stream_0
+ (list-tail
+ stream_0
+ (- stream-size_0 pos_62)))
+ (set! stream-size_0 pos_62))))))
+ (let-values (((reap-stream!_0)
+ (lambda ()
+ (begin
+ 'reap-stream!
+ (begin0
+ (list->vector (reverse$1 stream_0))
+ (set! stream_0 null)
+ (set! stream-size_0 0))))))
+ (letrec-values (((ser-push!_17)
+ (case-lambda
+ ((v_208)
(begin
- (ser-push!_15 'tag '#:ref)
- (ser-push!_15 'exact n_25))))
- (let-values (((c1_26)
- (hash-ref
- mutables_0
- v_146
- #f)))
- (if c1_26
- ((lambda (n_26)
- (begin
- (ser-push!_15 'tag '#:ref)
- (ser-push!_15 'exact n_26)))
- c1_26)
- (let-values ()
- (ser-push-encoded!_0 v_146)))))))
- ((kind_7 v_147)
- (let-values (((tmp_18) kind_7))
- (if (equal? tmp_18 'exact)
- (let-values ()
- (begin
- (set! stream_0
- (cons v_147 stream_0))
- (set! stream-size_0
- (add1 stream-size_0))))
- (if (equal? tmp_18 'tag)
- (let-values ()
- (ser-push!_15 'exact v_147))
- (if (equal? tmp_18 'reference)
- (let-values ()
- (if (hash-ref shares_0 v_147 #f)
- (let-values ()
- (let-values (((n_27)
- (hash-ref
- share-step-positions_0
- (hash-ref
- objs_0
- v_147))))
- (ser-push!_15
+ 'ser-push!
+ (if (hash-ref shares_0 v_208 #f)
+ (let-values (((n_25)
+ (hash-ref
+ share-step-positions_0
+ (hash-ref
+ objs_0
+ v_208))))
+ (begin
+ (ser-push!_17 'tag '#:ref)
+ (ser-push!_17
'exact
- n_27)))
- (let-values (((c2_2)
+ n_25)))
+ (let-values (((cond-val_14)
(hash-ref
mutables_0
- v_147
+ v_208
#f)))
- (if c2_2
- ((lambda (n_28)
- (ser-push!_15
- 'exact
- n_28))
- c2_2)
- (let-values ()
- (ser-push!_15 v_147))))))
- (let-values ()
- (ser-push!_15 v_147)))))))))
- ((ser-push-encoded!_0)
- (lambda (v_148)
- (begin
- 'ser-push-encoded!
- (if (keyword? v_148)
- (let-values ()
- (begin
- (ser-push!_15 'tag '#:quote)
- (ser-push!_15 'exact v_148)))
- (if (1/module-path-index? v_148)
- (let-values ()
+ (if cond-val_14
+ ((lambda (n_26)
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:ref)
+ (ser-push!_17
+ 'exact
+ n_26)))
+ cond-val_14)
+ (ser-push-encoded!_0
+ v_208))))))
+ ((kind_7 v_209)
+ (let-values (((tmp_19) kind_7))
+ (if (equal? tmp_19 'exact)
+ (begin
+ (set! stream_0
+ (cons v_209 stream_0))
+ (set! stream-size_0
+ (add1 stream-size_0)))
+ (if (equal? tmp_19 'tag)
+ (ser-push!_17 'exact v_209)
+ (if (equal?
+ tmp_19
+ 'reference)
+ (if (hash-ref
+ shares_0
+ v_209
+ #f)
+ (let-values (((n_27)
+ (hash-ref
+ share-step-positions_0
+ (hash-ref
+ objs_0
+ v_209))))
+ (ser-push!_17
+ 'exact
+ n_27))
+ (let-values (((cond-val_15)
+ (hash-ref
+ mutables_0
+ v_209
+ #f)))
+ (if cond-val_15
+ ((lambda (n_28)
+ (ser-push!_17
+ 'exact
+ n_28))
+ cond-val_15)
+ (ser-push!_17
+ v_209))))
+ (ser-push!_17 v_209))))))))
+ ((ser-push-encoded!_0)
+ (lambda (v_210)
(begin
- (ser-push!_15 'tag '#:mpi)
- (ser-push!_15
- 'exact
- (add-module-path-index!/pos
- mpis_8
- v_148))))
- (if (serialize? v_148)
- (let-values ()
- ((serialize-ref v_148)
- v_148
- ser-push!_15
- state_26))
- (if (if (list? v_148)
- (if (pair? v_148)
- (pair? (cdr v_148))
- #f)
- #f)
- (let-values ()
- (let-values (((start-pos_2)
- (next-push-position_0)))
- (let-values ((()
- (begin
- (ser-push!_15
- 'tag
- '#:list)
- (values))))
- (let-values ((()
- (begin
- (ser-push!_15
- 'exact
- (length
- v_148))
- (values))))
- (let-values (((all-quoted?_0)
- (let-values (((lst_43)
- v_148))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_43)))
- ((letrec-values (((for-loop_146)
- (lambda (all-quoted?_1
- lst_130)
- (begin
- 'for-loop
- (if (pair?
- lst_130)
- (let-values (((i_128)
- (unsafe-car
- lst_130))
- ((rest_64)
- (unsafe-cdr
- lst_130)))
- (let-values (((all-quoted?_2)
- (let-values (((all-quoted?_3)
- all-quoted?_1))
- (let-values (((all-quoted?_4)
- (let-values ()
- (let-values (((i-pos_0)
- (next-push-position_0)))
- (begin
- (ser-push!_15
- i_128)
- (if all-quoted?_3
- (quoted?_0
- i-pos_0)
- #f))))))
- (values
- all-quoted?_4)))))
- (if (not
- #f)
- (for-loop_146
- all-quoted?_2
- rest_64)
- all-quoted?_2)))
- all-quoted?_1)))))
- for-loop_146)
- #t
- lst_43)))))
- (if all-quoted?_0
- (let-values ()
- (begin
- (ser-reset!_0
- start-pos_2)
- (ser-push-optional-quote!_0)
- (ser-push!_15
- 'exact
- v_148)))
- (void)))))))
- (if (pair? v_148)
- (let-values ()
- (let-values (((start-pos_3)
- (next-push-position_0)))
- (let-values ((()
- (begin
- (ser-push!_15
- 'tag
- '#:cons)
- (values))))
- (let-values (((a-pos_0)
- (next-push-position_0)))
- (let-values ((()
- (begin
- (ser-push!_15
- (car
- v_148))
- (values))))
- (let-values (((d-pos_0)
+ 'ser-push-encoded!
+ (let-values (((cond-val_16)
+ (serialize-maybe-intern_0
+ v_210)))
+ (if cond-val_16
+ ((lambda (v_211)
+ (ser-push!_17 v_211))
+ cond-val_16)
+ (if (keyword? v_210)
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:quote)
+ (ser-push!_17
+ 'exact
+ v_210))
+ (if (1/module-path-index?
+ v_210)
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:mpi)
+ (ser-push!_17
+ 'exact
+ (add-module-path-index!/pos
+ mpis_9
+ (map-mpi_0 v_210))))
+ (if (serialize? v_210)
+ ((serialize-ref v_210)
+ v_210
+ ser-push!_17
+ state_28)
+ (if (if (list? v_210)
+ (if (pair? v_210)
+ (pair?
+ (cdr v_210))
+ #f)
+ #f)
+ (let-values (((start-pos_2)
(next-push-position_0)))
- (begin
- (ser-push!_15
- (cdr v_148))
- (if (if (quoted?_0
- a-pos_0)
- (quoted?_0
- d-pos_0)
- #f)
- (let-values ()
- (begin
- (ser-reset!_0
- start-pos_3)
- (ser-push-optional-quote!_0)
- (ser-push!_15
- 'exact
- v_148)))
- (void)))))))))
- (if (box? v_148)
- (let-values ()
- (let-values (((start-pos_4)
- (next-push-position_0)))
- (let-values ((()
- (begin
- (ser-push!_15
- 'tag
- '#:box)
- (values))))
- (let-values (((v-pos_0)
- (next-push-position_0)))
- (begin
- (ser-push!_15
- (unbox v_148))
- (if (quoted?_0
- v-pos_0)
- (let-values ()
- (begin
- (ser-reset!_0
- start-pos_4)
- (ser-push-optional-quote!_0)
- (ser-push!_15
- 'exact
- v_148)))
- (void)))))))
- (if (vector? v_148)
- (let-values ()
- (let-values (((start-pos_5)
- (next-push-position_0)))
- (let-values ((()
- (begin
- (ser-push!_15
- 'tag
- '#:vector)
- (values))))
- (let-values ((()
- (begin
- (ser-push!_15
- 'exact
- (vector-length
- v_148))
- (values))))
- (let-values (((all-quoted?_5)
- (let-values (((vec_54
- len_36)
- (let-values (((vec_55)
- v_148))
- (begin
- (check-vector
- vec_55)
- (values
- vec_55
- (unsafe-vector-length
- vec_55))))))
- (begin
- #f
- ((letrec-values (((for-loop_49)
- (lambda (all-quoted?_6
- pos_46)
- (begin
- 'for-loop
- (if (unsafe-fx<
- pos_46
- len_36)
- (let-values (((i_129)
- (unsafe-vector-ref
- vec_54
- pos_46)))
- (let-values (((all-quoted?_7)
- (let-values (((all-quoted?_8)
- all-quoted?_6))
- (let-values (((all-quoted?_9)
- (let-values ()
- (let-values (((i-pos_1)
- (next-push-position_0)))
- (begin
- (ser-push!_15
- i_129)
- (if all-quoted?_8
- (quoted?_0
- i-pos_1)
- #f))))))
- (values
- all-quoted?_9)))))
- (if (not
- #f)
- (for-loop_49
- all-quoted?_7
- (unsafe-fx+
- 1
- pos_46))
- all-quoted?_7)))
- all-quoted?_6)))))
- for-loop_49)
- #t
- 0)))))
- (if all-quoted?_5
- (let-values ()
- (begin
- (ser-reset!_0
- start-pos_5)
- (ser-push-optional-quote!_0)
- (ser-push!_15
- 'exact
- v_148)))
- (void)))))))
- (if (hash? v_148)
- (let-values ()
- (let-values (((start-pos_6)
- (next-push-position_0)))
- (let-values (((as-set?_0)
- (let-values (((ht_91)
- v_148))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash-values
- ht_91)))
- ((letrec-values (((for-loop_147)
- (lambda (result_69
- i_130)
- (begin
- 'for-loop
- (if i_130
- (let-values (((val_36)
- (hash-iterate-value
- ht_91
- i_130)))
- (let-values (((result_70)
- (let-values ()
- (let-values (((result_71)
- (let-values ()
- (let-values ()
- (eq?
- val_36
- #t)))))
- (values
- result_71)))))
- (if (if (not
- ((lambda x_54
- (not
- result_70))
- val_36))
- (not
- #f)
- #f)
- (for-loop_147
- result_70
- (hash-iterate-next
- ht_91
- i_130))
- result_70)))
- result_69)))))
- for-loop_147)
- #t
- (hash-iterate-first
- ht_91))))))
(let-values ((()
(begin
- (ser-push!_15
+ (ser-push!_17
'tag
- (if as-set?_0
- (if (hash-eq?
- v_148)
- (let-values ()
- '#:seteq)
- (if (hash-eqv?
- v_148)
- (let-values ()
- '#:seteqv)
- (let-values ()
- '#:set)))
- (if (hash-eq?
- v_148)
- (let-values ()
- '#:hasheq)
- (if (hash-eqv?
- v_148)
- (let-values ()
- (if (eq?
- v_148
- phase+space-hasheqv_0)
- '#:hasheqv/phase+space
- '#:hasheqv))
- (let-values ()
- '#:hash)))))
+ '#:list)
(values))))
(let-values ((()
(begin
- (ser-push!_15
+ (ser-push!_17
'exact
- (hash-count
- v_148))
+ (length
+ v_210))
(values))))
- (let-values (((ks_0)
- (sorted-hash-keys
- v_148)))
- (let-values (((all-quoted?_10)
- (let-values (((lst_131)
- ks_0))
+ (let-values (((all-quoted?_0)
+ (let-values (((all-quoted?_1)
+ (let-values (((all-quoted?_2)
+ #t))
+ all-quoted?_2)))
+ (let-values (((lst_189)
+ v_210))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-list
- lst_131)))
- ((letrec-values (((for-loop_148)
- (lambda (all-quoted?_11
- lst_132)
+ (check-list
+ lst_189))
+ ((letrec-values (((for-loop_187)
+ (lambda (all-quoted?_3
+ lst_190)
(begin
'for-loop
(if (pair?
- lst_132)
- (let-values (((k_35)
+ lst_190)
+ (let-values (((i_184)
(unsafe-car
- lst_132))
- ((rest_65)
+ lst_190))
+ ((rest_91)
(unsafe-cdr
- lst_132)))
- (let-values (((all-quoted?_12)
- (let-values (((all-quoted?_13)
- all-quoted?_11))
- (let-values (((all-quoted?_14)
- (let-values ()
- (let-values (((k-pos_0)
- (next-push-position_0)))
- (let-values ((()
- (begin
- (ser-push!_15
- k_35)
- (values))))
- (let-values (((v-pos_1)
- (next-push-position_0)))
- (begin
- (if as-set?_0
- (void)
- (let-values ()
- (ser-push!_15
- (hash-ref
- v_148
- k_35))))
- (if all-quoted?_13
- (if (quoted?_0
- k-pos_0)
- (let-values (((or-part_182)
- as-set?_0))
- (if or-part_182
- or-part_182
- (quoted?_0
- v-pos_1)))
- #f)
- #f))))))))
- (values
- all-quoted?_14)))))
+ lst_190)))
+ (let-values (((all-quoted?_4)
+ (let-values (((all-quoted?_5)
+ (let-values (((i-pos_0)
+ (next-push-position_0)))
+ (begin
+ (ser-push!_17
+ i_184)
+ (if all-quoted?_3
+ (quoted?_0
+ i-pos_0)
+ #f)))))
+ (values
+ all-quoted?_5))))
(if (not
#f)
- (for-loop_148
- all-quoted?_12
- rest_65)
- all-quoted?_12)))
- all-quoted?_11)))))
- for-loop_148)
- #t
- lst_131)))))
- (if all-quoted?_10
- (let-values ()
+ (for-loop_187
+ all-quoted?_4
+ rest_91)
+ all-quoted?_4)))
+ all-quoted?_3)))))
+ for-loop_187)
+ all-quoted?_1
+ lst_189))))))
+ (if all-quoted?_0
+ (begin
+ (ser-reset!_0
+ start-pos_2)
+ (ser-push-optional-quote!_0)
+ (ser-push!_17
+ 'exact
+ v_210))
+ (void))))))
+ (if (pair? v_210)
+ (let-values (((start-pos_3)
+ (next-push-position_0)))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:cons)
+ (values))))
+ (let-values (((a-pos_0)
+ (next-push-position_0)))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ (car
+ v_210))
+ (values))))
+ (let-values (((d-pos_0)
+ (next-push-position_0)))
+ (begin
+ (ser-push!_17
+ (cdr
+ v_210))
+ (if (if (quoted?_0
+ a-pos_0)
+ (quoted?_0
+ d-pos_0)
+ #f)
+ (begin
+ (ser-reset!_0
+ start-pos_3)
+ (ser-push-optional-quote!_0)
+ (ser-push!_17
+ 'exact
+ v_210))
+ (void))))))))
+ (if (box? v_210)
+ (let-values (((start-pos_4)
+ (next-push-position_0)))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:box)
+ (values))))
+ (let-values (((v-pos_0)
+ (next-push-position_0)))
+ (begin
+ (ser-push!_17
+ (unbox
+ v_210))
+ (if (quoted?_0
+ v-pos_0)
(begin
(ser-reset!_0
- start-pos_6)
+ start-pos_4)
(ser-push-optional-quote!_0)
- (ser-push!_15
+ (ser-push!_17
'exact
- v_148)))
- (void)))))))))
- (let-values (((c3_1)
- (prefab-struct-key
- v_148)))
- (if c3_1
- ((lambda (k_36)
- (let-values (((vec_56)
- (struct->vector
- v_148)))
- (let-values (((start-pos_7)
- (next-push-position_0)))
- (let-values ((()
- (begin
- (ser-push!_15
- 'tag
- '#:prefab)
- (values))))
- (let-values ((()
- (begin
- (ser-push!_15
- 'exact
- k_36)
- (values))))
- (let-values ((()
- (begin
- (ser-push!_15
- 'exact
- (sub1
- (vector-length
- vec_56)))
- (values))))
- (let-values (((all-quoted?_15)
- (let-values (((v*_5
- start*_5
- stop*_6
- step*_5)
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (unsafe-normalise-inputs
- unsafe-vector-length
- vec_56
- 1
- #f
- 1)
- (normalise-inputs
- 'in-vector
- "vector"
- (lambda (x_55)
- (vector?
- x_55))
- (lambda (x_56)
- (unsafe-vector-length
- x_56))
- vec_56
- 1
- #f
- 1))))
- (begin
- #t
- ((letrec-values (((for-loop_149)
- (lambda (all-quoted?_16
- idx_5)
- (begin
- 'for-loop
- (if (unsafe-fx<
- idx_5
- stop*_6)
- (let-values (((i_131)
- (unsafe-vector-ref
- v*_5
- idx_5)))
- (let-values (((all-quoted?_17)
- (let-values (((all-quoted?_18)
- all-quoted?_16))
- (let-values (((all-quoted?_19)
- (let-values ()
- (let-values (((i-pos_2)
- (next-push-position_0)))
- (begin
- (ser-push!_15
- i_131)
- (if all-quoted?_18
- (quoted?_0
- i-pos_2)
- #f))))))
- (values
- all-quoted?_19)))))
- (if (not
+ v_210))
+ (void))))))
+ (if (vector?
+ v_210)
+ (let-values (((start-pos_5)
+ (next-push-position_0)))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:vector)
+ (values))))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'exact
+ (vector-length
+ v_210))
+ (values))))
+ (let-values (((all-quoted?_6)
+ (let-values (((all-quoted?_7)
+ (let-values (((all-quoted?_8)
+ #t))
+ all-quoted?_8)))
+ (let-values (((vec_65
+ len_42)
+ (let-values (((vec_66)
+ v_210))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-vector
+ vec_66))
+ (values
+ vec_66
+ (unsafe-vector-length
+ vec_66))))))
+ ((letrec-values (((for-loop_188)
+ (lambda (all-quoted?_9
+ pos_63)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ pos_63
+ len_42)
+ (let-values (((i_185)
+ (unsafe-vector-ref
+ vec_65
+ pos_63)))
+ (let-values (((all-quoted?_10)
+ (let-values (((all-quoted?_11)
+ (let-values (((i-pos_1)
+ (next-push-position_0)))
+ (begin
+ (ser-push!_17
+ i_185)
+ (if all-quoted?_9
+ (quoted?_0
+ i-pos_1)
+ #f)))))
+ (values
+ all-quoted?_11))))
+ (if (not
+ #f)
+ (for-loop_188
+ all-quoted?_10
+ (unsafe-fx+
+ 1
+ pos_63))
+ all-quoted?_10)))
+ all-quoted?_9)))))
+ for-loop_188)
+ all-quoted?_7
+ 0)))))
+ (if all-quoted?_6
+ (begin
+ (ser-reset!_0
+ start-pos_5)
+ (ser-push-optional-quote!_0)
+ (ser-push!_17
+ 'exact
+ v_210))
+ (void))))))
+ (if (hash?
+ v_210)
+ (let-values (((start-pos_6)
+ (next-push-position_0)))
+ (let-values (((as-set?_0)
+ (let-values (((result_127)
+ (let-values (((result_128)
+ #t))
+ result_128)))
+ (let-values (((ht_110)
+ v_210))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash-values
+ ht_110))
+ ((letrec-values (((for-loop_189)
+ (lambda (result_129
+ i_186)
+ (begin
+ 'for-loop
+ (if i_186
+ (let-values (((val_38)
+ (hash-iterate-value
+ ht_110
+ i_186)))
+ (let-values (((result_130)
+ (let-values (((result_131)
+ (eq?
+ val_38
+ #t)))
+ (values
+ result_131))))
+ (if (if (not
+ ((lambda x_60
+ (not
+ result_130))
+ val_38))
+ (not
+ #f)
#f)
- (for-loop_149
- all-quoted?_17
- (unsafe-fx+
- idx_5
- 1))
- all-quoted?_17)))
- all-quoted?_16)))))
- for-loop_149)
- #t
- start*_5)))))
- (if all-quoted?_15
- (let-values ()
- (begin
- (ser-reset!_0
- start-pos_7)
- (ser-push-optional-quote!_0)
- (ser-push!_15
- 'exact
- v_148)))
- (void)))))))))
- c3_1)
- (if (srcloc? v_148)
- (let-values ()
- (if (path?
- (srcloc-source
- v_148))
- (let-values ()
- (begin
- (ser-push-optional-quote!_0)
- (ser-push!_15
- 'exact
- v_148)))
- (let-values ()
- (begin
- (ser-push!_15
- 'tag
- '#:srcloc)
- (ser-push!_15
- (srcloc-source
- v_148))
- (ser-push!_15
- (srcloc-line
- v_148))
- (ser-push!_15
- (srcloc-column
- v_148))
- (ser-push!_15
- (srcloc-position
- v_148))
- (ser-push!_15
- (srcloc-span
- v_148))))))
- (let-values ()
- (begin
- (ser-push-optional-quote!_0)
- (ser-push!_15
- 'exact
- v_148)))))))))))))))))
- ((ser-push-optional-quote!_0)
- (lambda ()
- (begin 'ser-push-optional-quote! (void)))))
- (let-values (((ser-shell!_0)
- (lambda (v_149)
- (begin
- 'ser-shell!
- (if (serialize-fill!? v_149)
- (let-values ()
- ((serialize-ref v_149)
- v_149
- ser-push!_15
- state_26))
- (if (box? v_149)
- (let-values ()
- (ser-push!_15 'tag '#:box))
- (if (vector? v_149)
- (let-values ()
- (begin
- (ser-push!_15 'tag '#:vector)
- (ser-push!_15
- 'exact
- (vector-length v_149))))
- (if (hash? v_149)
- (let-values ()
- (ser-push!_15
- 'tag
- (if (hash-eq? v_149)
- (let-values () '#:hasheq)
- (if (hash-eqv? v_149)
- (let-values () '#:hasheqv)
- (let-values () '#:hash)))))
- (let-values ()
- (error
- 'ser-shell
- "unknown mutable: ~e"
- v_149))))))))))
- (let-values (((ser-shell-fill!_0)
- (lambda (v_150)
- (begin
- 'ser-shell-fill!
- (if (serialize-fill!? v_150)
- (let-values ()
- ((serialize-fill!-ref v_150)
- v_150
- ser-push!_15
- state_26))
- (if (box? v_150)
- (let-values ()
+ (for-loop_189
+ result_130
+ (hash-iterate-next
+ ht_110
+ i_186))
+ result_130)))
+ result_129)))))
+ for-loop_189)
+ result_127
+ (hash-iterate-first
+ ht_110)))))))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'tag
+ (if as-set?_0
+ (if (hash-eq?
+ v_210)
+ '#:seteq
+ (if (hash-eqv?
+ v_210)
+ '#:seteqv
+ '#:set))
+ (if (hash-eq?
+ v_210)
+ '#:hasheq
+ (if (hash-eqv?
+ v_210)
+ (if (eq?
+ v_210
+ phase+space-hasheqv_0)
+ '#:hasheqv/phase+space
+ '#:hasheqv)
+ '#:hash))))
+ (values))))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'exact
+ (hash-count
+ v_210))
+ (values))))
+ (let-values (((ks_0)
+ (sorted-hash-keys
+ v_210)))
+ (let-values (((all-quoted?_12)
+ (let-values (((all-quoted?_13)
+ (let-values (((all-quoted?_14)
+ #t))
+ all-quoted?_14)))
+ (let-values (((lst_191)
+ ks_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_191))
+ ((letrec-values (((for-loop_190)
+ (lambda (all-quoted?_15
+ lst_192)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_192)
+ (let-values (((k_36)
+ (unsafe-car
+ lst_192))
+ ((rest_92)
+ (unsafe-cdr
+ lst_192)))
+ (let-values (((all-quoted?_16)
+ (let-values (((all-quoted?_17)
+ (let-values (((k-pos_0)
+ (next-push-position_0)))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ k_36)
+ (values))))
+ (let-values (((v-pos_1)
+ (next-push-position_0)))
+ (begin
+ (if as-set?_0
+ (void)
+ (ser-push!_17
+ (hash-ref
+ v_210
+ k_36)))
+ (if all-quoted?_15
+ (if (quoted?_0
+ k-pos_0)
+ (let-values (((or-part_296)
+ as-set?_0))
+ (if or-part_296
+ or-part_296
+ (quoted?_0
+ v-pos_1)))
+ #f)
+ #f)))))))
+ (values
+ all-quoted?_17))))
+ (if (not
+ #f)
+ (for-loop_190
+ all-quoted?_16
+ rest_92)
+ all-quoted?_16)))
+ all-quoted?_15)))))
+ for-loop_190)
+ all-quoted?_13
+ lst_191))))))
+ (if all-quoted?_12
+ (begin
+ (ser-reset!_0
+ start-pos_6)
+ (ser-push-optional-quote!_0)
+ (ser-push!_17
+ 'exact
+ v_210))
+ (void))))))))
+ (let-values (((cond-val_17)
+ (prefab-struct-key
+ v_210)))
+ (if cond-val_17
+ ((lambda (k_37)
+ (let-values (((vec_67)
+ (struct->vector
+ v_210)))
+ (let-values (((start-pos_7)
+ (next-push-position_0)))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:prefab)
+ (values))))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'exact
+ k_37)
+ (values))))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'exact
+ (sub1
+ (vector-length
+ vec_67)))
+ (values))))
+ (let-values (((all-quoted?_18)
+ (let-values (((all-quoted?_19)
+ (let-values (((all-quoted?_20)
+ #t))
+ all-quoted?_20)))
+ (let-values (((v*_5
+ start*_5
+ stop*_6
+ step*_5)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (unsafe-normalise-inputs
+ unsafe-vector-length
+ vec_67
+ 1
+ #f
+ 1)
+ (normalise-inputs
+ 'in-vector
+ "vector"
+ (lambda (x_61)
+ (vector?
+ x_61))
+ (lambda (x_62)
+ (unsafe-vector-length
+ x_62))
+ vec_67
+ 1
+ #f
+ 1))))
+ ((letrec-values (((for-loop_191)
+ (lambda (all-quoted?_21
+ idx_5)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ idx_5
+ stop*_6)
+ (let-values (((i_187)
+ (unsafe-vector-ref
+ v*_5
+ idx_5)))
+ (let-values (((all-quoted?_22)
+ (let-values (((all-quoted?_23)
+ (let-values (((i-pos_2)
+ (next-push-position_0)))
+ (begin
+ (ser-push!_17
+ i_187)
+ (if all-quoted?_21
+ (quoted?_0
+ i-pos_2)
+ #f)))))
+ (values
+ all-quoted?_23))))
+ (if (not
+ #f)
+ (for-loop_191
+ all-quoted?_22
+ (unsafe-fx+
+ idx_5
+ 1))
+ all-quoted?_22)))
+ all-quoted?_21)))))
+ for-loop_191)
+ all-quoted?_19
+ start*_5)))))
+ (if all-quoted?_18
+ (begin
+ (ser-reset!_0
+ start-pos_7)
+ (ser-push-optional-quote!_0)
+ (ser-push!_17
+ 'exact
+ v_210))
+ (void)))))))))
+ cond-val_17)
+ (if (srcloc?
+ v_210)
+ (if (path?
+ (srcloc-source
+ v_210))
+ (begin
+ (ser-push-optional-quote!_0)
+ (ser-push!_17
+ 'exact
+ v_210))
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:srcloc)
+ (ser-push!_17
+ (srcloc-source
+ v_210))
+ (ser-push!_17
+ (srcloc-line
+ v_210))
+ (ser-push!_17
+ (srcloc-column
+ v_210))
+ (ser-push!_17
+ (srcloc-position
+ v_210))
+ (ser-push!_17
+ (srcloc-span
+ v_210))))
+ (begin
+ (ser-push-optional-quote!_0)
+ (ser-push!_17
+ 'exact
+ v_210))))))))))))))))))
+ ((ser-push-optional-quote!_0)
+ (lambda ()
+ (begin
+ 'ser-push-optional-quote!
+ (void)))))
+ (let-values (((ser-shell!_0)
+ (lambda (v_212)
+ (begin
+ 'ser-shell!
+ (if (serialize-fill!? v_212)
+ ((serialize-ref v_212)
+ v_212
+ ser-push!_17
+ state_28)
+ (if (box? v_212)
+ (ser-push!_17 'tag '#:box)
+ (if (vector? v_212)
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:vector)
+ (ser-push!_17
+ 'exact
+ (vector-length v_212)))
+ (if (hash? v_212)
+ (ser-push!_17
+ 'tag
+ (if (hash-eq? v_212)
+ '#:hasheq
+ (if (hash-eqv? v_212)
+ '#:hasheqv
+ '#:hash)))
+ (error
+ 'ser-shell
+ "unknown mutable: ~e"
+ v_212)))))))))
+ (let-values (((ser-shell-fill!_0)
+ (lambda (v_213)
(begin
- (ser-push!_15 'tag '#:set-box!)
- (ser-push!_15 (unbox v_150))))
- (if (vector? v_150)
- (let-values ()
- (begin
- (ser-push!_15
- 'tag
- '#:set-vector!)
- (ser-push!_15
- 'exact
- (vector-length v_150))
- (let-values (((vec_57 len_37)
- (let-values (((vec_58)
- v_150))
- (begin
- (check-vector
- vec_58)
- (values
- vec_58
- (unsafe-vector-length
- vec_58))))))
+ 'ser-shell-fill!
+ (if (serialize-fill!? v_213)
+ ((serialize-fill!-ref v_213)
+ v_213
+ ser-push!_17
+ state_28)
+ (if (box? v_213)
(begin
- #f
- ((letrec-values (((for-loop_150)
- (lambda (pos_31)
- (begin
- 'for-loop
- (if (unsafe-fx<
- pos_31
- len_37)
- (let-values (((v_151)
- (unsafe-vector-ref
- vec_57
- pos_31)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
+ (ser-push!_17
+ 'tag
+ '#:set-box!)
+ (ser-push!_17
+ (unbox v_213)))
+ (if (vector? v_213)
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:set-vector!)
+ (ser-push!_17
+ 'exact
+ (vector-length v_213))
+ (let-values (((vec_68
+ len_43)
+ (let-values (((vec_69)
+ v_213))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-vector
+ vec_69))
+ (values
+ vec_69
+ (unsafe-vector-length
+ vec_69))))))
+ ((letrec-values (((for-loop_192)
+ (lambda (pos_64)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ pos_64
+ len_43)
+ (let-values (((v_214)
+ (unsafe-vector-ref
+ vec_68
+ pos_64)))
+ (let-values ((()
+ (let-values ((()
(begin
- (let-values ()
- (ser-push!_15
- v_151))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_150
- (unsafe-fx+
- 1
- pos_31))
- (values))))
- (values))))))
- for-loop_150)
- 0)))
- (void)))
- (if (hash? v_150)
- (let-values ()
- (let-values ((()
- (begin
- (ser-push!_15
- 'tag
- '#:set-hash!)
- (values))))
- (let-values ((()
+ (ser-push!_17
+ v_214)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_192
+ (unsafe-fx+
+ 1
+ pos_64))
+ (values))))
+ (values))))))
+ for-loop_192)
+ 0))
+ (void))
+ (if (hash? v_213)
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'tag
+ '#:set-hash!)
+ (values))))
+ (let-values ((()
+ (begin
+ (ser-push!_17
+ 'exact
+ (hash-count
+ v_213))
+ (values))))
+ (let-values (((ks_1)
+ (sorted-hash-keys
+ v_213)))
+ (begin
+ (let-values (((lst_193)
+ ks_1))
(begin
- (ser-push!_15
- 'exact
- (hash-count
- v_150))
- (values))))
- (let-values (((ks_1)
- (sorted-hash-keys
- v_150)))
- (begin
- (let-values (((lst_133)
- ks_1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_133)))
- ((letrec-values (((for-loop_151)
- (lambda (lst_134)
- (begin
- 'for-loop
- (if (pair?
- lst_134)
- (let-values (((k_37)
- (unsafe-car
- lst_134))
- ((rest_66)
- (unsafe-cdr
- lst_134)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_193))
+ ((letrec-values (((for-loop_193)
+ (lambda (lst_194)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_194)
+ (let-values (((k_38)
+ (unsafe-car
+ lst_194))
+ ((rest_93)
+ (unsafe-cdr
+ lst_194)))
+ (let-values ((()
+ (let-values ((()
+ (begin
(begin
- (ser-push!_15
- k_37)
- (ser-push!_15
+ (ser-push!_17
+ k_38)
+ (ser-push!_17
(hash-ref
- v_150
- k_37))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_151
- rest_66)
- (values))))
- (values))))))
- for-loop_151)
- lst_133)))
- (void))))))
- (let-values ()
- (error
- 'ser-shell-fill
- "unknown mutable: ~e"
- v_150))))))))))
- (let-values (((rev-mutables_0)
- (let-values (((ht_92) mutables_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash ht_92)))
- ((letrec-values (((for-loop_152)
- (lambda (table_124
- i_132)
- (begin
- 'for-loop
- (if i_132
- (let-values (((k_38
- v_152)
- (hash-iterate-key+value
- ht_92
- i_132)))
- (let-values (((table_125)
- (let-values (((table_126)
- table_124))
- (let-values (((table_127)
- (let-values ()
- (let-values (((key_50
- val_37)
- (let-values ()
- (values
- v_152
- k_38))))
- (hash-set
- table_126
- key_50
- val_37)))))
- (values
- table_127)))))
- (if (not
- #f)
- (for-loop_152
- table_125
- (hash-iterate-next
- ht_92
- i_132))
- table_125)))
- table_124)))))
- for-loop_152)
- '#hasheqv()
- (hash-iterate-first ht_92))))))
- (let-values (((mutable-shell-bindings_0)
- (begin
- (begin
- (let-values (((start_30) 0)
- ((end_18)
- (hash-count
- mutables_0))
- ((inc_12) 1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-range
- start_30
- end_18
- inc_12)))
- ((letrec-values (((for-loop_153)
- (lambda (pos_47)
- (begin
- 'for-loop
- (if (<
- pos_47
- end_18)
- (let-values (((i_133)
- pos_47))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (ser-shell!_0
- (hash-ref
- rev-mutables_0
- i_133)))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_153
- (+
- pos_47
- inc_12))
- (values))))
- (values))))))
- for-loop_153)
- start_30)))
- (void))
- (reap-stream!_0))))
- (let-values (((rev-shares_0)
- (let-values (((ht_0) shares_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash-keys ht_0)))
- ((letrec-values (((for-loop_154)
- (lambda (table_128
- i_134)
- (begin
- 'for-loop
- (if i_134
- (let-values (((obj_1)
- (hash-iterate-key
- ht_0
- i_134)))
- (let-values (((table_129)
- (let-values (((table_130)
- table_128))
- (let-values (((table_131)
- (let-values ()
- (let-values (((key_51
- val_38)
- (let-values ()
- (values
- (hash-ref
- share-step-positions_0
- (hash-ref
- objs_0
- obj_1))
- obj_1))))
- (hash-set
- table_130
- key_51
- val_38)))))
- (values
- table_131)))))
- (if (not
- #f)
- (for-loop_154
- table_129
- (hash-iterate-next
- ht_0
- i_134))
- table_129)))
- table_128)))))
- for-loop_154)
- '#hasheqv()
- (hash-iterate-first ht_0))))))
- (let-values (((shared-bindings_0)
- (begin
- (begin
- (let-values (((start_31)
- num-mutables_0)
- ((end_19)
- (+
- num-mutables_0
- (hash-count
- shares_0)))
- ((inc_13) 1))
+ v_213
+ k_38)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_193
+ rest_93)
+ (values))))
+ (values))))))
+ for-loop_193)
+ lst_193)))
+ (void)))))
+ (error
+ 'ser-shell-fill
+ "unknown mutable: ~e"
+ v_213)))))))))
+ (let-values (((rev-mutables_0)
+ (let-values (((table_145)
+ (let-values (((table_146)
+ '#hasheqv()))
+ table_146)))
+ (let-values (((ht_111)
+ mutables_0))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-range
- start_31
- end_19
- inc_13)))
- ((letrec-values (((for-loop_155)
- (lambda (pos_48)
+ (check-in-hash ht_111))
+ ((letrec-values (((for-loop_194)
+ (lambda (table_147
+ i_188)
(begin
'for-loop
- (if (<
- pos_48
- end_19)
- (let-values (((i_135)
- pos_48))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (ser-push-encoded!_0
- (hash-ref
- rev-shares_0
- i_135)))
- (values)))))
- (values)))))
+ (if i_188
+ (let-values (((k_39
+ v_215)
+ (hash-iterate-key+value
+ ht_111
+ i_188)))
+ (let-values (((table_148)
+ (let-values (((table_149)
+ (let-values (((key_53
+ val_39)
+ (values
+ v_215
+ k_39)))
+ (hash-set
+ table_147
+ key_53
+ val_39))))
+ (values
+ table_149))))
(if (not
#f)
- (for-loop_155
- (+
- pos_48
- inc_13))
- (values))))
- (values))))))
- for-loop_155)
- start_31)))
- (void))
- (reap-stream!_0))))
- (let-values (((mutable-fills_0)
- (begin
+ (for-loop_194
+ table_148
+ (hash-iterate-next
+ ht_111
+ i_188))
+ table_148)))
+ table_147)))))
+ for-loop_194)
+ table_145
+ (hash-iterate-first
+ ht_111)))))))
+ (let-values (((mutable-shell-bindings_0)
(begin
- (let-values (((start_32) 0)
- ((end_20)
- (hash-count
- mutables_0))
- ((inc_14) 1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
+ (begin
+ (let-values (((start_38) 0)
+ ((end_21)
+ (hash-count
+ mutables_0))
+ ((inc_15) 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
(check-range
- start_32
- end_20
- inc_14)))
- ((letrec-values (((for-loop_156)
- (lambda (pos_49)
- (begin
- 'for-loop
- (if (<
- pos_49
- end_20)
- (let-values (((i_136)
- pos_49))
- (let-values ((()
- (let-values ()
+ start_38
+ end_21
+ inc_15))
+ ((letrec-values (((for-loop_195)
+ (lambda (pos_65)
+ (begin
+ 'for-loop
+ (if (<
+ pos_65
+ end_21)
+ (let-values (((i_189)
+ pos_65))
+ (let-values ((()
(let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (ser-shell-fill!_0
- (hash-ref
- rev-mutables_0
- i_136)))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_156
- (+
- pos_49
- inc_14))
- (values))))
- (values))))))
- for-loop_156)
- start_32)))
- (void))
- (reap-stream!_0))))
- (let-values (((result_72)
- (begin
- (ser-push!_15 v_139)
+ (begin
+ (ser-shell!_0
+ (hash-ref
+ rev-mutables_0
+ i_189))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_195
+ (+
+ pos_65
+ inc_15))
+ (values))))
+ (values))))))
+ for-loop_195)
+ start_38)))
+ (void))
(reap-stream!_0))))
- (if as-data?_1
- (let-values ()
- (vector
- (hash-count mutables_0)
- mutable-shell-bindings_0
- (hash-count shares_0)
- shared-bindings_0
- mutable-fills_0
- result_72))
- (let-values ()
- (let-values (((finish_2)
- (lambda (mutable-shell-bindings-expr_0
- shared-bindings-expr_0
- mutable-fills-expr_0
- result-expr_0)
+ (let-values (((rev-shares_0)
+ (let-values (((table_150)
+ (let-values (((table_151)
+ '#hasheqv()))
+ table_151)))
+ (let-values (((ht_112)
+ shares_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash-keys
+ ht_112))
+ ((letrec-values (((for-loop_196)
+ (lambda (table_152
+ i_190)
+ (begin
+ 'for-loop
+ (if i_190
+ (let-values (((obj_1)
+ (hash-iterate-key
+ ht_112
+ i_190)))
+ (let-values (((table_153)
+ (let-values (((table_154)
+ (let-values (((key_54
+ val_40)
+ (values
+ (hash-ref
+ share-step-positions_0
+ (hash-ref
+ objs_0
+ obj_1))
+ obj_1)))
+ (hash-set
+ table_152
+ key_54
+ val_40))))
+ (values
+ table_154))))
+ (if (not
+ #f)
+ (for-loop_196
+ table_153
+ (hash-iterate-next
+ ht_112
+ i_190))
+ table_153)))
+ table_152)))))
+ for-loop_196)
+ table_150
+ (hash-iterate-first
+ ht_112)))))))
+ (let-values (((shared-bindings_0)
+ (begin
+ (begin
+ (let-values (((start_39)
+ num-mutables_0)
+ ((end_22)
+ (+
+ num-mutables_0
+ (hash-count
+ shares_0)))
+ ((inc_16)
+ 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range
+ start_39
+ end_22
+ inc_16))
+ ((letrec-values (((for-loop_197)
+ (lambda (pos_66)
+ (begin
+ 'for-loop
+ (if (<
+ pos_66
+ end_22)
+ (let-values (((i_191)
+ pos_66))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (ser-push-encoded!_0
+ (hash-ref
+ rev-shares_0
+ i_191))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_197
+ (+
+ pos_66
+ inc_16))
+ (values))))
+ (values))))))
+ for-loop_197)
+ start_39)))
+ (void))
+ (reap-stream!_0))))
+ (let-values (((mutable-fills_0)
+ (begin
(begin
- 'finish
- (list
- 'deserialize
- mpi-vector-id
- (if syntax-support?_0
- inspector-id
- #f)
- (if syntax-support?_0
- bulk-binding-registry-id
- #f)
- (list
- 'quote
- (hash-count
- mutables_0))
- mutable-shell-bindings-expr_0
- (list
- 'quote
- (hash-count
- shares_0))
- shared-bindings-expr_0
- mutable-fills-expr_0
- result-expr_0)))))
- (list
- 'let-values
- (list
- (list
- '(data)
- (list
- 'quote
+ (let-values (((start_40)
+ 0)
+ ((end_23)
+ (hash-count
+ mutables_0))
+ ((inc_17)
+ 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range
+ start_40
+ end_23
+ inc_17))
+ ((letrec-values (((for-loop_198)
+ (lambda (pos_67)
+ (begin
+ 'for-loop
+ (if (<
+ pos_67
+ end_23)
+ (let-values (((i_192)
+ pos_67))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (ser-shell-fill!_0
+ (hash-ref
+ rev-mutables_0
+ i_192))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_198
+ (+
+ pos_67
+ inc_17))
+ (values))))
+ (values))))))
+ for-loop_198)
+ start_40)))
+ (void))
+ (reap-stream!_0))))
+ (let-values (((result_132)
+ (begin
+ (ser-push!_17 v_199)
+ (reap-stream!_0))))
+ (if as-data?_1
(vector
+ (hash-count mutables_0)
mutable-shell-bindings_0
+ (hash-count shares_0)
shared-bindings_0
mutable-fills_0
- result_72))))
- (finish_2
- '(unsafe-vector*-ref data 0)
- '(unsafe-vector*-ref data 1)
- '(unsafe-vector*-ref data 2)
- '(unsafe-vector*-ref
- data
- 3))))))))))))))))))))))))))))))))))))))))))))
+ result_132)
+ (let-values (((finish_2)
+ (lambda (mutable-shell-bindings-expr_0
+ shared-bindings-expr_0
+ mutable-fills-expr_0
+ result-expr_0)
+ (begin
+ 'finish
+ (list
+ 'deserialize
+ mpi-vector-id
+ (if syntax-support?_0
+ inspector-id
+ #f)
+ (if syntax-support?_0
+ bulk-binding-registry-id
+ #f)
+ (list
+ 'quote
+ (hash-count
+ mutables_0))
+ mutable-shell-bindings-expr_0
+ (list
+ 'quote
+ (hash-count
+ shares_0))
+ shared-bindings-expr_0
+ mutable-fills-expr_0
+ result-expr_0)))))
+ (list
+ 'let-values
+ (list
+ (list
+ '(data)
+ (list
+ 'quote
+ (vector
+ mutable-shell-bindings_0
+ shared-bindings_0
+ mutable-fills_0
+ result_132))))
+ (finish_2
+ '(unsafe-vector*-ref data 0)
+ '(unsafe-vector*-ref data 1)
+ '(unsafe-vector*-ref data 2)
+ '(unsafe-vector*-ref
+ data
+ 3)))))))))))))))))))))))))))))))))))))))))))))))
(define-values
(sorted-hash-keys)
- (lambda (ht_93)
+ (lambda (ht_113)
(begin
- (let-values (((ks_2) (hash-keys ht_93)))
+ (let-values (((ks_2) (hash-keys ht_113)))
(if (null? ks_2)
- (let-values () ks_2)
+ ks_2
(if (null? (cdr ks_2))
- (let-values () ks_2)
+ ks_2
(if (andmap2 symbol? ks_2)
- (let-values ()
- (let-values (((ks33_0) ks_2) ((symbol34_0) symbol)) (sort.1 #f #f ks33_0 symbol34_0)))
+ (let-values (((ks42_0) ks_2) ((symbol43_0) symbol)) (sort.1 #f #f ks42_0 symbol43_0))
(if (andmap2 scope? ks_2)
- (let-values () (let-values (((ks35_0) ks_2) ((scope36_0) scope)) (sort.1 #f #f ks35_0 scope36_0)))
+ (let-values (((ks44_0) ks_2) ((scope45_0) scope)) (sort.1 #f #f ks44_0 scope45_0))
(if (andmap2 shifted-multi-scope? ks_2)
- (let-values ()
- (let-values (((ks37_0) ks_2) ((shifted-multi-scope38_0) shifted-multi-scope))
- (sort.1 #f #f ks37_0 shifted-multi-scope38_0)))
+ (let-values (((ks46_0) ks_2) ((shifted-multi-scope47_0) shifted-multi-scope))
+ (sort.1 #f #f ks46_0 shifted-multi-scope47_0))
(if (andmap2 real? ks_2)
- (let-values () (let-values (((ks39_0) ks_2) ((<40_0) <)) (sort.1 #f #f ks39_0 <40_0)))
- (let-values () ks_2)))))))))))
+ (let-values (((ks48_0) ks_2) ((<49_0) <)) (sort.1 #f #f ks48_0 <49_0))
+ ks_2))))))))))
(define-values
(deserialize)
- (lambda (mpis_9
+ (lambda (mpis_10
inspector_8
bulk-binding-registry_6
num-mutables_1
@@ -23346,141 +23451,142 @@
(let-values (((shared_2) (make-vector (+ num-mutables_1 num-shared_0) 'uninit)))
(let-values ((()
(begin
- (let-values (((start_33) 0) ((end_21) num-mutables_1) ((inc_15) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_33 end_21 inc_15)))
- ((letrec-values (((for-loop_157)
- (lambda (pos_50 pos_51)
- (begin
- 'for-loop
- (if (< pos_51 end_21)
- (let-values (((i_137) pos_51))
- (let-values (((pos_52)
- (let-values (((pos_53) pos_50))
- (let-values (((pos_54)
- (let-values ()
- (let-values (((d_26 next-pos_0)
- (decode-shell
- mutable-vec_0
- pos_53
- mpis_9
- inspector_8
- bulk-binding-registry_6
- shared_2)))
- (begin
- (vector-set!
- shared_2
- i_137
- d_26)
- next-pos_0)))))
- (values pos_54)))))
- (if (not #f) (for-loop_157 pos_52 (+ pos_51 inc_15)) pos_52)))
- pos_50)))))
- for-loop_157)
- 0
- start_33)))
- (values))))
- (let-values ((()
- (begin
- (let-values (((start_34) num-mutables_1)
- ((end_22) (+ num-mutables_1 num-shared_0))
- ((inc_16) 1))
+ (let-values (((pos_68) (let-values (((pos_69) 0)) pos_69)))
+ (let-values (((start_41) 0) ((end_24) num-mutables_1) ((inc_18) 1))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-range start_34 end_22 inc_16)))
- ((letrec-values (((for-loop_158)
- (lambda (pos_55 pos_56)
+ (check-range start_41 end_24 inc_18))
+ ((letrec-values (((for-loop_199)
+ (lambda (pos_70 pos_71)
(begin
'for-loop
- (if (< pos_56 end_22)
- (let-values (((i_138) pos_56))
- (let-values (((pos_57)
- (let-values (((pos_58) pos_55))
- (let-values (((pos_59)
- (let-values ()
- (let-values (((d_27 next-pos_1)
- (decode
- shared-vec_0
- pos_58
- mpis_9
- inspector_8
- bulk-binding-registry_6
- shared_2)))
- (begin
- (vector-set!
- shared_2
- i_138
- d_27)
- next-pos_1)))))
- (values pos_59)))))
- (if (not #f) (for-loop_158 pos_57 (+ pos_56 inc_16)) pos_57)))
- pos_55)))))
- for-loop_158)
- 0
- start_34)))
- (values))))
- (let-values ((()
- (begin
- (let-values (((start_35) 0)
- ((end_23) num-mutables_1)
- ((inc_17) 1)
- ((vec_59 len_38)
- (let-values (((vec_60) shared_2))
- (begin
- (check-vector vec_60)
- (values vec_60 (unsafe-vector-length vec_60))))))
+ (if (< pos_71 end_24)
+ (let-values (((i_193) pos_71))
+ (let-values (((pos_72)
+ (let-values (((pos_73)
+ (let-values (((d_26 next-pos_0)
+ (decode-shell
+ mutable-vec_0
+ pos_70
+ mpis_10
+ inspector_8
+ bulk-binding-registry_6
+ shared_2)))
+ (begin
+ (vector-set!
+ shared_2
+ i_193
+ d_26)
+ next-pos_0))))
+ (values pos_73))))
+ (if (not #f) (for-loop_199 pos_72 (+ pos_71 inc_18)) pos_72)))
+ pos_70)))))
+ for-loop_199)
+ pos_68
+ start_41))))
+ (values))))
+ (let-values ((()
+ (begin
+ (let-values (((pos_74) (let-values (((pos_75) 0)) pos_75)))
+ (let-values (((start_42) num-mutables_1)
+ ((end_25) (+ num-mutables_1 num-shared_0))
+ ((inc_19) 1))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-range start_35 end_23 inc_17)))
- #f
- ((letrec-values (((for-loop_159)
- (lambda (pos_60 pos_61 pos_62)
+ (check-range start_42 end_25 inc_19))
+ ((letrec-values (((for-loop_200)
+ (lambda (pos_76 pos_77)
(begin
'for-loop
- (if (if (< pos_61 end_23) (unsafe-fx< pos_62 len_38) #f)
- (let-values (((v_153) (unsafe-vector-ref vec_59 pos_62)))
- (let-values (((pos_63)
- (let-values (((pos_64) pos_60))
- (let-values (((pos_65)
- (let-values ()
- (decode-fill!
- v_153
- mutable-fill-vec_0
- pos_64
- mpis_9
- inspector_8
- bulk-binding-registry_6
- shared_2))))
- (values pos_65)))))
+ (if (< pos_77 end_25)
+ (let-values (((i_194) pos_77))
+ (let-values (((pos_78)
+ (let-values (((pos_79)
+ (let-values (((d_27 next-pos_1)
+ (decode
+ shared-vec_0
+ pos_76
+ mpis_10
+ inspector_8
+ bulk-binding-registry_6
+ shared_2)))
+ (begin
+ (vector-set!
+ shared_2
+ i_194
+ d_27)
+ next-pos_1))))
+ (values pos_79))))
(if (not #f)
- (for-loop_159
- pos_63
- (+ pos_61 inc_17)
- (unsafe-fx+ 1 pos_62))
- pos_63)))
- pos_60)))))
- for-loop_159)
- 0
- start_35
- 0)))
+ (for-loop_200 pos_78 (+ pos_77 inc_19))
+ pos_78)))
+ pos_76)))))
+ for-loop_200)
+ pos_74
+ start_42))))
+ (values))))
+ (let-values ((()
+ (begin
+ (let-values (((pos_80) (let-values (((pos_81) 0)) pos_81)))
+ (let-values (((start_43) 0)
+ ((end_26) num-mutables_1)
+ ((inc_20) 1)
+ ((vec_70 len_44)
+ (let-values (((vec_71) shared_2))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-vector vec_71))
+ (values vec_71 (unsafe-vector-length vec_71))))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_43 end_26 inc_20))
+ (void)
+ ((letrec-values (((for-loop_201)
+ (lambda (pos_82 pos_83 pos_84)
+ (begin
+ 'for-loop
+ (if (if (< pos_83 end_26) (unsafe-fx< pos_84 len_44) #f)
+ (let-values (((v_216) (unsafe-vector-ref vec_70 pos_84)))
+ (let-values (((pos_85)
+ (let-values (((pos_86)
+ (decode-fill!
+ v_216
+ mutable-fill-vec_0
+ pos_82
+ mpis_10
+ inspector_8
+ bulk-binding-registry_6
+ shared_2)))
+ (values pos_86))))
+ (if (not #f)
+ (for-loop_201
+ pos_85
+ (+ pos_83 inc_20)
+ (unsafe-fx+ 1 pos_84))
+ pos_85)))
+ pos_82)))))
+ for-loop_201)
+ pos_80
+ start_43
+ 0))))
(values))))
- (let-values (((result_73 done-pos_0)
- (decode result-vec_0 0 mpis_9 inspector_8 bulk-binding-registry_6 shared_2)))
- result_73))))))))
+ (let-values (((result_133 done-pos_0)
+ (decode result-vec_0 0 mpis_10 inspector_8 bulk-binding-registry_6 shared_2)))
+ result_133))))))))
(define-values
(deserialize-data)
- (lambda (mpis_10 inspector_9 bulk-binding-registry_7 data_0)
+ (lambda (mpis_11 inspector_9 bulk-binding-registry_7 data_0)
(begin
(begin
(if (if (vector? data_0) (= 6 (vector-length data_0)) #f)
(void)
- (let-values () (error 'syntax-deserialize "ill-formed serialization")))
+ (error 'syntax-deserialize "ill-formed serialization"))
(deserialize
- mpis_10
+ mpis_11
inspector_9
bulk-binding-registry_7
(vector-ref data_0 0)
@@ -23491,1346 +23597,1208 @@
(vector-ref data_0 5))))))
(define-values
(decode-shell)
- (lambda (vec_61 pos_66 mpis_11 inspector_10 bulk-binding-registry_8 shared_3)
- (begin
- (let-values (((tmp_19) (vector*-ref vec_61 pos_66)))
- (if (equal? tmp_19 '#:box)
- (let-values () (values (box #f) (add1 pos_66)))
- (if (equal? tmp_19 '#:vector)
- (let-values () (values (make-vector (vector*-ref vec_61 (add1 pos_66))) (+ pos_66 2)))
- (if (equal? tmp_19 '#:hash)
- (let-values () (values (make-hasheq) (add1 pos_66)))
- (if (equal? tmp_19 '#:hasheq)
- (let-values () (values (make-hasheq) (add1 pos_66)))
- (if (equal? tmp_19 '#:hasheqv)
- (let-values () (values (make-hasheqv) (add1 pos_66)))
- (let-values () (decode vec_61 pos_66 mpis_11 inspector_10 bulk-binding-registry_8 shared_3)))))))))))
+ (lambda (vec_72 pos_87 mpis_12 inspector_10 bulk-binding-registry_8 shared_3)
+ (begin
+ (let-values (((tmp_20) (vector*-ref vec_72 pos_87)))
+ (if (equal? tmp_20 '#:box)
+ (values (box #f) (add1 pos_87))
+ (if (equal? tmp_20 '#:vector)
+ (values (make-vector (vector*-ref vec_72 (add1 pos_87))) (+ pos_87 2))
+ (if (equal? tmp_20 '#:hash)
+ (values (make-hasheq) (add1 pos_87))
+ (if (equal? tmp_20 '#:hasheq)
+ (values (make-hasheq) (add1 pos_87))
+ (if (equal? tmp_20 '#:hasheqv)
+ (values (make-hasheqv) (add1 pos_87))
+ (decode vec_72 pos_87 mpis_12 inspector_10 bulk-binding-registry_8 shared_3))))))))))
(define-values
(decode)
- (lambda (vec_62 pos_67 mpis_12 inspector_11 bulk-binding-registry_9 shared_4)
- (begin
- (let-values ()
- (let-values (((tmp_20) (vector*-ref vec_62 pos_67)))
- (let-values (((index_1)
- (if (keyword? tmp_20)
- (hash-ref
- '#hasheq((#:box . 10)
- (#:bulk-binding . 28)
- (#:bulk-binding+provides . 30)
- (#:bulk-binding-at . 23)
- (#:bulk-binding-registry . 3)
- (#:cons . 11)
- (#:datum->syntax . 5)
- (#:hash . 13)
- (#:hasheq . 13)
- (#:hasheqv . 13)
- (#:hasheqv/phase+space . 14)
- (#:inspector . 2)
- (#:interned-scope . 19)
- (#:like-ambiguous-binding . 29)
- (#:list . 12)
- (#:local-binding . 27)
- (#:module-binding . 25)
- (#:mpi . 9)
- (#:multi-scope . 20)
- (#:prefab . 16)
- (#:provided . 31)
- (#:quote . 8)
- (#:ref . 1)
- (#:representative-scope . 24)
- (#:scope . 17)
- (#:scope+kind . 18)
- (#:set . 15)
- (#:seteq . 15)
- (#:seteqv . 15)
- (#:shifted-multi-scope . 21)
- (#:simple-module-binding . 26)
- (#:srcloc . 7)
- (#:syntax . 4)
- (#:syntax+props . 6)
- (#:table-with-bulk-bindings . 22)
- (#:vector . 12))
- tmp_20
- (lambda () 0))
- 0)))
- (if (unsafe-fx< index_1 15)
- (if (unsafe-fx< index_1 7)
- (if (unsafe-fx< index_1 3)
- (if (unsafe-fx< index_1 1)
- (let-values () (values (vector*-ref vec_62 pos_67) (add1 pos_67)))
- (if (unsafe-fx< index_1 2)
- (let-values () (values (vector*-ref shared_4 (vector*-ref vec_62 (add1 pos_67))) (+ pos_67 2)))
- (let-values () (values inspector_11 (add1 pos_67)))))
- (if (unsafe-fx< index_1 4)
- (let-values () (values bulk-binding-registry_9 (add1 pos_67)))
- (if (unsafe-fx< index_1 5)
- (let-values ()
- (let-values (((content_18 next-pos_2)
- (decode
- vec_62
- (add1 pos_67)
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((context_2 next-pos_3)
- (let-values (((i_139) (vector*-ref vec_62 next-pos_2)))
- (if (exact-integer? i_139)
- (values (vector*-ref shared_4 i_139) (add1 next-pos_2))
- (decode
- vec_62
- next-pos_2
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))))
- (let-values (((srcloc_5 next-pos_4)
- (let-values (((i_140) (vector*-ref vec_62 next-pos_3)))
- (if (exact-integer? i_140)
- (values (vector*-ref shared_4 i_140) (add1 next-pos_3))
- (decode
- vec_62
- next-pos_3
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))))
- (values
- (deserialize-syntax content_18 context_2 srcloc_5 #f #f inspector_11)
- next-pos_4)))))
- (if (unsafe-fx< index_1 6)
- (let-values ()
- (let-values (((content_19 next-pos_5)
+ (lambda (vec_73 pos_88 mpis_13 inspector_11 bulk-binding-registry_9 shared_4)
+ (begin
+ (let-values (((tmp_21) (vector*-ref vec_73 pos_88)))
+ (let-values (((index_1)
+ (if (keyword? tmp_21)
+ (hash-ref
+ '#hasheq((#:box . 10)
+ (#:bulk-binding . 28)
+ (#:bulk-binding+provides . 30)
+ (#:bulk-binding-at . 23)
+ (#:bulk-binding-registry . 3)
+ (#:cons . 11)
+ (#:datum->syntax . 5)
+ (#:hash . 13)
+ (#:hasheq . 13)
+ (#:hasheqv . 13)
+ (#:hasheqv/phase+space . 14)
+ (#:inspector . 2)
+ (#:interned-scope . 19)
+ (#:like-ambiguous-binding . 29)
+ (#:list . 12)
+ (#:local-binding . 27)
+ (#:module-binding . 25)
+ (#:mpi . 9)
+ (#:multi-scope . 20)
+ (#:prefab . 16)
+ (#:provided . 31)
+ (#:quote . 8)
+ (#:ref . 1)
+ (#:representative-scope . 24)
+ (#:scope . 17)
+ (#:scope+kind . 18)
+ (#:set . 15)
+ (#:seteq . 15)
+ (#:seteqv . 15)
+ (#:shifted-multi-scope . 21)
+ (#:simple-module-binding . 26)
+ (#:srcloc . 7)
+ (#:syntax . 4)
+ (#:syntax+props . 6)
+ (#:table-with-bulk-bindings . 22)
+ (#:vector . 12))
+ tmp_21
+ (lambda () 0))
+ 0)))
+ (if (unsafe-fx< index_1 15)
+ (if (unsafe-fx< index_1 7)
+ (if (unsafe-fx< index_1 3)
+ (if (unsafe-fx< index_1 1)
+ (values (vector*-ref vec_73 pos_88) (add1 pos_88))
+ (if (unsafe-fx< index_1 2)
+ (values (vector*-ref shared_4 (vector*-ref vec_73 (add1 pos_88))) (+ pos_88 2))
+ (values inspector_11 (add1 pos_88))))
+ (if (unsafe-fx< index_1 4)
+ (values bulk-binding-registry_9 (add1 pos_88))
+ (if (unsafe-fx< index_1 5)
+ (let-values (((content_18 next-pos_2)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((context_2 next-pos_3)
+ (let-values (((i_195) (vector*-ref vec_73 next-pos_2)))
+ (if (exact-integer? i_195)
+ (values (vector*-ref shared_4 i_195) (add1 next-pos_2))
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ next-pos_2
+ mpis_13
inspector_11
bulk-binding-registry_9
- shared_4)))
- (let-values (((context_3 next-pos_6)
- (let-values (((i_141) (vector*-ref vec_62 next-pos_5)))
- (if (exact-integer? i_141)
- (values (vector*-ref shared_4 i_141) (add1 next-pos_5))
- (decode
- vec_62
- next-pos_5
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))))
- (let-values (((srcloc_6 next-pos_7)
- (let-values (((i_142) (vector*-ref vec_62 next-pos_6)))
- (if (exact-integer? i_142)
- (values (vector*-ref shared_4 i_142) (add1 next-pos_6))
- (decode
- vec_62
- next-pos_6
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))))
- (values
- (deserialize-datum->syntax content_19 context_3 srcloc_6 inspector_11)
- next-pos_7)))))
- (let-values ()
- (let-values (((content_20 next-pos_8)
- (decode
- vec_62
- (add1 pos_67)
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((context_4 next-pos_9)
- (let-values (((i_143) (vector*-ref vec_62 next-pos_8)))
- (if (exact-integer? i_143)
- (values (vector*-ref shared_4 i_143) (add1 next-pos_8))
- (decode
- vec_62
- next-pos_8
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))))
- (let-values (((srcloc_7 next-pos_10)
- (let-values (((i_144) (vector*-ref vec_62 next-pos_9)))
- (if (exact-integer? i_144)
- (values (vector*-ref shared_4 i_144) (add1 next-pos_9))
- (decode
- vec_62
- next-pos_9
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))))
- (let-values (((props_3 next-pos_11)
- (decode
- vec_62
- next-pos_10
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((tamper_0 next-pos_12)
- (decode
- vec_62
- next-pos_11
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values
- (deserialize-syntax content_20 context_4 srcloc_7 props_3 tamper_0 inspector_11)
- next-pos_12)))))))))))
- (if (unsafe-fx< index_1 10)
- (if (unsafe-fx< index_1 8)
- (let-values ()
- (let-values (((source_0 next-pos_13)
+ shared_4)))))
+ (let-values (((srcloc_5 next-pos_4)
+ (let-values (((i_196) (vector*-ref vec_73 next-pos_3)))
+ (if (exact-integer? i_196)
+ (values (vector*-ref shared_4 i_196) (add1 next-pos_3))
+ (decode
+ vec_73
+ next-pos_3
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))))
+ (values (deserialize-syntax content_18 context_2 srcloc_5 #f #f inspector_11) next-pos_4))))
+ (if (unsafe-fx< index_1 6)
+ (let-values (((content_19 next-pos_5)
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ (add1 pos_88)
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((line_0 next-pos_14)
- (decode
- vec_62
- next-pos_13
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((column_0 next-pos_15)
- (decode
- vec_62
- next-pos_14
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((position_0 next-pos_16)
+ (let-values (((context_3 next-pos_6)
+ (let-values (((i_197) (vector*-ref vec_73 next-pos_5)))
+ (if (exact-integer? i_197)
+ (values (vector*-ref shared_4 i_197) (add1 next-pos_5))
(decode
- vec_62
- next-pos_15
- mpis_12
+ vec_73
+ next-pos_5
+ mpis_13
inspector_11
bulk-binding-registry_9
- shared_4)))
- (let-values (((span_0 next-pos_17)
+ shared_4)))))
+ (let-values (((srcloc_6 next-pos_7)
+ (let-values (((i_198) (vector*-ref vec_73 next-pos_6)))
+ (if (exact-integer? i_198)
+ (values (vector*-ref shared_4 i_198) (add1 next-pos_6))
(decode
- vec_62
- next-pos_16
- mpis_12
+ vec_73
+ next-pos_6
+ mpis_13
inspector_11
bulk-binding-registry_9
- shared_4)))
- (values (srcloc source_0 line_0 column_0 position_0 span_0) next-pos_17)))))))
- (if (unsafe-fx< index_1 9)
- (let-values () (values (vector*-ref vec_62 (add1 pos_67)) (+ pos_67 2)))
- (let-values () (values (vector*-ref mpis_12 (vector*-ref vec_62 (add1 pos_67))) (+ pos_67 2)))))
- (if (unsafe-fx< index_1 12)
- (if (unsafe-fx< index_1 11)
- (let-values ()
- (let-values (((v_154 next-pos_18)
- (decode
- vec_62
- (add1 pos_67)
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values (box-immutable v_154) next-pos_18)))
- (let-values ()
- (let-values (((a_31 next-pos_19)
+ shared_4)))))
+ (values
+ (deserialize-datum->syntax content_19 context_3 srcloc_6 inspector_11)
+ next-pos_7))))
+ (let-values (((content_20 next-pos_8)
+ (decode
+ vec_73
+ (add1 pos_88)
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((context_4 next-pos_9)
+ (let-values (((i_199) (vector*-ref vec_73 next-pos_8)))
+ (if (exact-integer? i_199)
+ (values (vector*-ref shared_4 i_199) (add1 next-pos_8))
+ (decode
+ vec_73
+ next-pos_8
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))))
+ (let-values (((srcloc_7 next-pos_10)
+ (let-values (((i_200) (vector*-ref vec_73 next-pos_9)))
+ (if (exact-integer? i_200)
+ (values (vector*-ref shared_4 i_200) (add1 next-pos_9))
+ (decode
+ vec_73
+ next-pos_9
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))))
+ (let-values (((props_3 next-pos_11)
+ (decode
+ vec_73
+ next-pos_10
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((tamper_0 next-pos_12)
+ (decode
+ vec_73
+ next-pos_11
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (values
+ (deserialize-syntax content_20 context_4 srcloc_7 props_3 tamper_0 inspector_11)
+ next-pos_12))))))))))
+ (if (unsafe-fx< index_1 10)
+ (if (unsafe-fx< index_1 8)
+ (let-values (((source_0 next-pos_13)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((line_0 next-pos_14)
+ (decode vec_73 next-pos_13 mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((column_0 next-pos_15)
+ (decode vec_73 next-pos_14 mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((position_0 next-pos_16)
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ next-pos_15
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((d_28 next-pos_20)
+ (let-values (((span_0 next-pos_17)
(decode
- vec_62
- next-pos_19
- mpis_12
+ vec_73
+ next-pos_16
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (values (cons a_31 d_28) next-pos_20)))))
- (if (unsafe-fx< index_1 13)
- (let-values ()
- (let-values (((len_39) (vector*-ref vec_62 (add1 pos_67))))
- (let-values (((r_26) (make-vector len_39)))
- (let-values (((next-pos_21)
- (let-values (((start_36) 0) ((end_24) len_39) ((inc_18) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_36 end_24 inc_18)))
- ((letrec-values (((for-loop_160)
- (lambda (pos_68 pos_69)
- (begin
- 'for-loop
- (if (< pos_69 end_24)
- (let-values (((i_145) pos_69))
- (let-values (((pos_70)
- (let-values (((pos_71) pos_68))
- (let-values (((pos_72)
- (let-values ()
- (let-values (((v_155
- next-pos_22)
- (let-values (((v_156
- next-pos_23)
- (decode
- vec_62
- pos_71
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values
- v_156
- next-pos_23))))
- (begin
- (vector-set!
- r_26
- i_145
- v_155)
- next-pos_22)))))
- (values pos_72)))))
- (if (not #f)
- (for-loop_160 pos_70 (+ pos_69 inc_18))
- pos_70)))
- pos_68)))))
- for-loop_160)
- (+ pos_67 2)
- start_36)))))
- (values
- (if (eq? (vector*-ref vec_62 pos_67) '#:list)
- (vector->list r_26)
- (vector->immutable-vector r_26))
- next-pos_21)))))
- (if (unsafe-fx< index_1 14)
- (let-values ()
- (let-values (((ht_94)
- (let-values (((tmp_21) (vector*-ref vec_62 pos_67)))
- (if (equal? tmp_21 '#:hash)
- (let-values () (hash))
- (if (equal? tmp_21 '#:hasheq)
- (let-values () (hasheq))
- (if (equal? tmp_21 '#:hasheqv)
- (let-values () (hasheqv))
- (let-values () (void))))))))
- (let-values (((len_40) (vector*-ref vec_62 (add1 pos_67))))
- (let-values (((start_37) 0) ((end_25) len_40) ((inc_19) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_37 end_25 inc_19)))
- ((letrec-values (((for-loop_161)
- (lambda (ht_95 pos_73 pos_74)
- (begin
- 'for-loop
- (if (< pos_74 end_25)
- (let-values ()
- (let-values (((ht_96 pos_75)
- (let-values (((ht_97) ht_95)
- ((pos_76) pos_73))
- (let-values (((ht_98 pos_77)
- (let-values ()
- (let-values (((k_39
- next-pos_24)
- (decode
- vec_62
- pos_76
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((v_157
- next-pos_25)
- (decode
- vec_62
- next-pos_24
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values
- (hash-set
- ht_97
- k_39
- v_157)
- next-pos_25))))))
- (values ht_98 pos_77)))))
- (if (not #f)
- (for-loop_161 ht_96 pos_75 (+ pos_74 inc_19))
- (values ht_96 pos_75))))
- (values ht_95 pos_73))))))
- for-loop_161)
- ht_94
- (+ pos_67 2)
- start_37))))))
- (let-values ()
- (let-values (((ht_99) (hasheqv)))
- (let-values (((len_41) (vector*-ref vec_62 (add1 pos_67))))
- (let-values (((start_38) 0) ((end_26) len_41) ((inc_20) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_38 end_26 inc_20)))
- ((letrec-values (((for-loop_162)
- (lambda (ht_100 pos_78 pos_79)
- (begin
- 'for-loop
- (if (< pos_79 end_26)
- (let-values ()
- (let-values (((ht_101 pos_80)
- (let-values (((ht_102) ht_100)
- ((pos_81) pos_78))
- (let-values (((ht_103 pos_82)
- (let-values ()
- (let-values (((k_40
- next-pos_26)
- (decode
- vec_62
- pos_81
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((v_158
- next-pos_27)
- (decode
- vec_62
- next-pos_26
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values
- (hash-set
- ht_102
- (intern-phase+space
- k_40)
- v_158)
- next-pos_27))))))
- (values ht_103 pos_82)))))
- (if (not #f)
- (for-loop_162 ht_101 pos_80 (+ pos_79 inc_20))
- (values ht_101 pos_80))))
- (values ht_100 pos_78))))))
- for-loop_162)
- ht_99
- (+ pos_67 2)
- start_38)))))))))))
- (if (unsafe-fx< index_1 23)
- (if (unsafe-fx< index_1 18)
- (if (unsafe-fx< index_1 16)
- (let-values ()
- (let-values (((s_192)
- (let-values (((tmp_22) (vector*-ref vec_62 pos_67)))
- (if (equal? tmp_22 '#:set)
- (let-values () (set))
- (if (equal? tmp_22 '#:seteq)
- (let-values () (seteq))
- (if (equal? tmp_22 '#:seteqv)
- (let-values () (seteqv))
- (let-values () (void))))))))
- (let-values (((len_42) (vector*-ref vec_62 (add1 pos_67))))
- (let-values (((start_39) 0) ((end_27) len_42) ((inc_21) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_39 end_27 inc_21)))
- ((letrec-values (((for-loop_163)
- (lambda (s_193 pos_83 pos_84)
- (begin
- 'for-loop
- (if (< pos_84 end_27)
- (let-values ()
- (let-values (((s_194 pos_85)
- (let-values (((s_195) s_193) ((pos_86) pos_83))
- (let-values (((s_196 pos_87)
- (let-values ()
- (let-values (((k_41 next-pos_28)
+ (values (srcloc source_0 line_0 column_0 position_0 span_0) next-pos_17))))))
+ (if (unsafe-fx< index_1 9)
+ (values (vector*-ref vec_73 (add1 pos_88)) (+ pos_88 2))
+ (values (vector*-ref mpis_13 (vector*-ref vec_73 (add1 pos_88))) (+ pos_88 2))))
+ (if (unsafe-fx< index_1 12)
+ (if (unsafe-fx< index_1 11)
+ (let-values (((v_217 next-pos_18)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (values (box-immutable v_217) next-pos_18))
+ (let-values (((a_37 next-pos_19)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((d_28 next-pos_20)
+ (decode vec_73 next-pos_19 mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (values (cons a_37 d_28) next-pos_20))))
+ (if (unsafe-fx< index_1 13)
+ (let-values (((len_45) (vector*-ref vec_73 (add1 pos_88))))
+ (let-values (((r_30) (make-vector len_45)))
+ (let-values (((next-pos_21)
+ (let-values (((pos_89) (let-values (((pos_90) (+ pos_88 2))) pos_90)))
+ (let-values (((start_44) 0) ((end_27) len_45) ((inc_21) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_44 end_27 inc_21))
+ ((letrec-values (((for-loop_202)
+ (lambda (pos_91 pos_92)
+ (begin
+ 'for-loop
+ (if (< pos_92 end_27)
+ (let-values (((i_201) pos_92))
+ (let-values (((pos_93)
+ (let-values (((pos_94)
+ (let-values (((v_218
+ next-pos_22)
+ (let-values (((v_219
+ next-pos_23)
+ (decode
+ vec_73
+ pos_91
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (values
+ v_219
+ next-pos_23))))
+ (begin
+ (vector-set!
+ r_30
+ i_201
+ v_218)
+ next-pos_22))))
+ (values pos_94))))
+ (if (not #f)
+ (for-loop_202 pos_93 (+ pos_92 inc_21))
+ pos_93)))
+ pos_91)))))
+ for-loop_202)
+ pos_89
+ start_44))))))
+ (values
+ (if (eq? (vector*-ref vec_73 pos_88) '#:list)
+ (vector->list r_30)
+ (vector->immutable-vector r_30))
+ next-pos_21))))
+ (if (unsafe-fx< index_1 14)
+ (let-values (((ht_114)
+ (let-values (((tmp_22) (vector*-ref vec_73 pos_88)))
+ (if (equal? tmp_22 '#:hash)
+ (hash)
+ (if (equal? tmp_22 '#:hasheq)
+ (hasheq)
+ (if (equal? tmp_22 '#:hasheqv) (hasheqv) (void)))))))
+ (let-values (((len_46) (vector*-ref vec_73 (add1 pos_88))))
+ (let-values (((ht_115) (let-values (((ht_116) ht_114)) ht_116))
+ ((pos_95) (let-values (((pos_96) (+ pos_88 2))) pos_96)))
+ (let-values (((start_45) 0) ((end_28) len_46) ((inc_22) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_45 end_28 inc_22))
+ ((letrec-values (((for-loop_203)
+ (lambda (ht_117 pos_97 pos_98)
+ (begin
+ 'for-loop
+ (if (< pos_98 end_28)
+ (let-values ()
+ (let-values (((ht_118 pos_99)
+ (let-values (((ht_119 pos_100)
+ (let-values (((k_40 next-pos_24)
+ (decode
+ vec_73
+ pos_97
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((v_220
+ next-pos_25)
(decode
- vec_62
- pos_86
- mpis_12
+ vec_73
+ next-pos_24
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
(values
- (set-add s_195 k_41)
- next-pos_28)))))
- (values s_196 pos_87)))))
- (if (not #f)
- (for-loop_163 s_194 pos_85 (+ pos_84 inc_21))
- (values s_194 pos_85))))
- (values s_193 pos_83))))))
- for-loop_163)
- s_192
- (+ pos_67 2)
- start_39))))))
- (if (unsafe-fx< index_1 17)
- (let-values ()
- (let-values (((key_52 next-pos_29)
- (let-values (((k_42 next-pos_30)
- (decode
- vec_62
- (add1 pos_67)
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values k_42 next-pos_30))))
- (let-values (((len_43) (vector*-ref vec_62 next-pos_29)))
- (let-values (((r_27 done-pos_1)
- (let-values (((start_40) 0) ((end_28) len_43) ((inc_22) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_40 end_28 inc_22)))
- ((letrec-values (((for-loop_164)
- (lambda (r_28 pos_88 pos_89)
- (begin
- 'for-loop
- (if (< pos_89 end_28)
- (let-values ()
- (let-values (((r_29 pos_90)
- (let-values (((r_30) r_28)
- ((pos_91) pos_88))
- (let-values (((r_31 pos_92)
- (let-values ()
- (let-values (((v_159
- next-pos_31)
- (decode
- vec_62
- pos_91
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values
- (cons
- v_159
- r_30)
- next-pos_31)))))
- (values r_31 pos_92)))))
- (if (not #f)
- (for-loop_164 r_29 pos_90 (+ pos_89 inc_22))
- (values r_29 pos_90))))
- (values r_28 pos_88))))))
- for-loop_164)
- null
- (add1 next-pos_29)
- start_40)))))
- (values (apply make-prefab-struct key_52 (reverse$1 r_27)) done-pos_1)))))
- (let-values () (values (deserialize-scope) (add1 pos_67)))))
- (if (unsafe-fx< index_1 20)
- (if (unsafe-fx< index_1 19)
- (let-values ()
- (let-values (((kind_8 next-pos_32)
- (decode
- vec_62
- (add1 pos_67)
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values (deserialize-scope kind_8) next-pos_32)))
- (let-values ()
- (let-values (((id_28 next-pos_33)
- (decode
- vec_62
- (add1 pos_67)
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values (make-interned-scope id_28) next-pos_33))))
- (if (unsafe-fx< index_1 21)
- (let-values ()
- (let-values (((name_41 next-pos_34)
+ (hash-set ht_117 k_40 v_220)
+ next-pos_25)))))
+ (values ht_119 pos_100))))
+ (if (not #f)
+ (for-loop_203 ht_118 pos_99 (+ pos_98 inc_22))
+ (values ht_118 pos_99))))
+ (values ht_117 pos_97))))))
+ for-loop_203)
+ ht_115
+ pos_95
+ start_45))))))
+ (let-values (((ht_120) (hasheqv)))
+ (let-values (((len_47) (vector*-ref vec_73 (add1 pos_88))))
+ (let-values (((ht_121) (let-values (((ht_122) ht_120)) ht_122))
+ ((pos_101) (let-values (((pos_102) (+ pos_88 2))) pos_102)))
+ (let-values (((start_46) 0) ((end_29) len_47) ((inc_23) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_46 end_29 inc_23))
+ ((letrec-values (((for-loop_204)
+ (lambda (ht_123 pos_103 pos_104)
+ (begin
+ 'for-loop
+ (if (< pos_104 end_29)
+ (let-values ()
+ (let-values (((ht_124 pos_105)
+ (let-values (((ht_125 pos_106)
+ (let-values (((k_41 next-pos_26)
+ (decode
+ vec_73
+ pos_103
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((v_221
+ next-pos_27)
+ (decode
+ vec_73
+ next-pos_26
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (values
+ (hash-set
+ ht_123
+ (intern-phase+space k_41)
+ v_221)
+ next-pos_27)))))
+ (values ht_125 pos_106))))
+ (if (not #f)
+ (for-loop_204 ht_124 pos_105 (+ pos_104 inc_23))
+ (values ht_124 pos_105))))
+ (values ht_123 pos_103))))))
+ for-loop_204)
+ ht_121
+ pos_101
+ start_46)))))))))))
+ (if (unsafe-fx< index_1 23)
+ (if (unsafe-fx< index_1 18)
+ (if (unsafe-fx< index_1 16)
+ (let-values (((s_245)
+ (let-values (((tmp_23) (vector*-ref vec_73 pos_88)))
+ (if (equal? tmp_23 '#:set)
+ (set)
+ (if (equal? tmp_23 '#:seteq)
+ (seteq)
+ (if (equal? tmp_23 '#:seteqv) (seteqv) (void)))))))
+ (let-values (((len_48) (vector*-ref vec_73 (add1 pos_88))))
+ (let-values (((s_246) (let-values (((s_247) s_245)) s_247))
+ ((pos_107) (let-values (((pos_108) (+ pos_88 2))) pos_108)))
+ (let-values (((start_47) 0) ((end_30) len_48) ((inc_24) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_47 end_30 inc_24))
+ ((letrec-values (((for-loop_205)
+ (lambda (s_248 pos_109 pos_110)
+ (begin
+ 'for-loop
+ (if (< pos_110 end_30)
+ (let-values ()
+ (let-values (((s_249 pos_111)
+ (let-values (((s_250 pos_112)
+ (let-values (((k_42 next-pos_28)
+ (decode
+ vec_73
+ pos_109
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (values
+ (set-add s_248 k_42)
+ next-pos_28))))
+ (values s_250 pos_112))))
+ (if (not #f)
+ (for-loop_205 s_249 pos_111 (+ pos_110 inc_24))
+ (values s_249 pos_111))))
+ (values s_248 pos_109))))))
+ for-loop_205)
+ s_246
+ pos_107
+ start_47))))))
+ (if (unsafe-fx< index_1 17)
+ (let-values (((key_55 next-pos_29)
+ (let-values (((k_43 next-pos_30)
+ (decode
+ vec_73
+ (add1 pos_88)
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (values k_43 next-pos_30))))
+ (let-values (((len_49) (vector*-ref vec_73 next-pos_29)))
+ (let-values (((r_31 done-pos_1)
+ (let-values (((r_32) (let-values (((r_33) null)) r_33))
+ ((pos_113) (let-values (((pos_114) (add1 next-pos_29))) pos_114)))
+ (let-values (((start_48) 0) ((end_31) len_49) ((inc_25) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_48 end_31 inc_25))
+ ((letrec-values (((for-loop_206)
+ (lambda (r_34 pos_115 pos_116)
+ (begin
+ 'for-loop
+ (if (< pos_116 end_31)
+ (let-values ()
+ (let-values (((r_35 pos_117)
+ (let-values (((r_36 pos_118)
+ (let-values (((v_222
+ next-pos_31)
+ (decode
+ vec_73
+ pos_115
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (values
+ (cons v_222 r_34)
+ next-pos_31))))
+ (values r_36 pos_118))))
+ (if (not #f)
+ (for-loop_206 r_35 pos_117 (+ pos_116 inc_25))
+ (values r_35 pos_117))))
+ (values r_34 pos_115))))))
+ for-loop_206)
+ r_32
+ pos_113
+ start_48))))))
+ (values (apply make-prefab-struct key_55 (reverse$1 r_31)) done-pos_1))))
+ (values (deserialize-scope) (add1 pos_88))))
+ (if (unsafe-fx< index_1 20)
+ (if (unsafe-fx< index_1 19)
+ (let-values (((kind_8 next-pos_32)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (values (deserialize-scope kind_8) next-pos_32))
+ (let-values (((id_30 next-pos_33)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (values (make-interned-scope id_30) next-pos_33)))
+ (if (unsafe-fx< index_1 21)
+ (let-values (((name_49 next-pos_34)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((scopes_22 next-pos_35)
+ (decode vec_73 next-pos_34 mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (values (deserialize-multi-scope name_49 scopes_22) next-pos_35)))
+ (if (unsafe-fx< index_1 22)
+ (let-values (((phase_66 next-pos_36)
+ (decode
+ vec_73
+ (add1 pos_88)
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((multi-scope_2 next-pos_37)
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ next-pos_36
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((scopes_22 next-pos_35)
- (decode
- vec_62
- next-pos_34
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values (deserialize-multi-scope name_41 scopes_22) next-pos_35))))
- (if (unsafe-fx< index_1 22)
- (let-values ()
- (let-values (((phase_57 next-pos_36)
- (decode
- vec_62
- (add1 pos_67)
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((multi-scope_2 next-pos_37)
- (decode
- vec_62
- next-pos_36
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values (deserialize-shifted-multi-scope phase_57 multi-scope_2) next-pos_37))))
- (let-values ()
- (let-values (((syms_12 next-pos_38)
- (decode
- vec_62
- (add1 pos_67)
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((bulk-bindings_4 next-pos_39)
- (decode
- vec_62
- next-pos_38
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values (deserialize-table-with-bulk-bindings syms_12 bulk-bindings_4) next-pos_39))))))))
- (if (unsafe-fx< index_1 27)
- (if (unsafe-fx< index_1 24)
- (let-values ()
- (let-values (((scopes_23 next-pos_40)
+ (values (deserialize-shifted-multi-scope phase_66 multi-scope_2) next-pos_37)))
+ (let-values (((syms_14 next-pos_38)
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ (add1 pos_88)
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((bulk_5 next-pos_41)
+ (let-values (((bulk-bindings_5 next-pos_39)
(decode
- vec_62
- next-pos_40
- mpis_12
+ vec_73
+ next-pos_38
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (values (deserialize-bulk-binding-at scopes_23 bulk_5) next-pos_41))))
- (if (unsafe-fx< index_1 25)
- (let-values ()
- (let-values (((kind_9 next-pos_42)
+ (values (deserialize-table-with-bulk-bindings syms_14 bulk-bindings_5) next-pos_39)))))))
+ (if (unsafe-fx< index_1 27)
+ (if (unsafe-fx< index_1 24)
+ (let-values (((scopes_23 next-pos_40)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((bulk_5 next-pos_41)
+ (decode vec_73 next-pos_40 mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (values (deserialize-bulk-binding-at scopes_23 bulk_5) next-pos_41)))
+ (if (unsafe-fx< index_1 25)
+ (let-values (((kind_9 next-pos_42)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((phase_67 next-pos_43)
+ (decode vec_73 next-pos_42 mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (values (deserialize-representative-scope kind_9 phase_67) next-pos_43)))
+ (if (unsafe-fx< index_1 26)
+ (let-values (((module_4 next-pos_44)
+ (decode
+ vec_73
+ (add1 pos_88)
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((sym_41 next-pos_45)
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ next-pos_44
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((phase_58 next-pos_43)
- (decode
- vec_62
- next-pos_42
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values (deserialize-representative-scope kind_9 phase_58) next-pos_43))))
- (if (unsafe-fx< index_1 26)
- (let-values ()
- (let-values (((module_4 next-pos_44)
+ (let-values (((phase_68 next-pos_46)
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ next-pos_45
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((sym_32 next-pos_45)
+ (let-values (((nominal-module_4 next-pos_47)
(decode
- vec_62
- next-pos_44
- mpis_12
+ vec_73
+ next-pos_46
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((phase_59 next-pos_46)
+ (let-values (((nominal-phase_0 next-pos_48)
(decode
- vec_62
- next-pos_45
- mpis_12
+ vec_73
+ next-pos_47
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((nominal-module_4 next-pos_47)
+ (let-values (((nominal-sym_4 next-pos_49)
(decode
- vec_62
- next-pos_46
- mpis_12
+ vec_73
+ next-pos_48
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((nominal-phase_0 next-pos_48)
+ (let-values (((nominal-require-phase_0 next-pos_50)
(decode
- vec_62
- next-pos_47
- mpis_12
+ vec_73
+ next-pos_49
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((nominal-sym_4 next-pos_49)
+ (let-values (((free=id_8 next-pos_51)
(decode
- vec_62
- next-pos_48
- mpis_12
+ vec_73
+ next-pos_50
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((nominal-require-phase_0 next-pos_50)
+ (let-values (((extra-inspector_3 next-pos_52)
(decode
- vec_62
- next-pos_49
- mpis_12
+ vec_73
+ next-pos_51
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((free=id_8 next-pos_51)
+ (let-values (((extra-nominal-bindings_3 next-pos_53)
(decode
- vec_62
- next-pos_50
- mpis_12
+ vec_73
+ next-pos_52
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((extra-inspector_3 next-pos_52)
- (decode
- vec_62
- next-pos_51
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((extra-nominal-bindings_3 next-pos_53)
- (decode
- vec_62
- next-pos_52
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values
- (deserialize-full-module-binding
- module_4
- sym_32
- phase_59
- nominal-module_4
- nominal-phase_0
- nominal-sym_4
- nominal-require-phase_0
- free=id_8
- extra-inspector_3
- extra-nominal-bindings_3)
- next-pos_53))))))))))))
- (let-values ()
- (let-values (((module_5 next-pos_54)
- (decode
- vec_62
- (add1 pos_67)
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((sym_33 next-pos_55)
- (decode
- vec_62
- next-pos_54
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((phase_60 next-pos_56)
- (decode
- vec_62
- next-pos_55
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((nominal-module_5 next-pos_57)
- (decode
- vec_62
- next-pos_56
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values
- (deserialize-simple-module-binding module_5 sym_33 phase_60 nominal-module_5)
- next-pos_57)))))))))
- (if (unsafe-fx< index_1 29)
- (if (unsafe-fx< index_1 28)
- (let-values ()
- (let-values (((key_53 next-pos_58)
+ (values
+ (deserialize-full-module-binding
+ module_4
+ sym_41
+ phase_68
+ nominal-module_4
+ nominal-phase_0
+ nominal-sym_4
+ nominal-require-phase_0
+ free=id_8
+ extra-inspector_3
+ extra-nominal-bindings_3)
+ next-pos_53)))))))))))
+ (let-values (((module_5 next-pos_54)
+ (decode
+ vec_73
+ (add1 pos_88)
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((sym_42 next-pos_55)
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ next-pos_54
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((free=id_9 next-pos_59)
+ (let-values (((phase_69 next-pos_56)
(decode
- vec_62
- next-pos_58
- mpis_12
+ vec_73
+ next-pos_55
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (values (deserialize-full-local-binding key_53 free=id_9) next-pos_59))))
- (let-values ()
- (let-values (((prefix_4 next-pos_60)
+ (let-values (((nominal-module_5 next-pos_57)
+ (decode
+ vec_73
+ next-pos_56
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (values
+ (deserialize-simple-module-binding module_5 sym_42 phase_69 nominal-module_5)
+ next-pos_57))))))))
+ (if (unsafe-fx< index_1 29)
+ (if (unsafe-fx< index_1 28)
+ (let-values (((key_56 next-pos_58)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((free=id_9 next-pos_59)
+ (decode vec_73 next-pos_58 mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (values (deserialize-full-local-binding key_56 free=id_9) next-pos_59)))
+ (let-values (((prefix_4 next-pos_60)
+ (decode vec_73 (add1 pos_88) mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((excepts_4 next-pos_61)
+ (decode vec_73 next-pos_60 mpis_13 inspector_11 bulk-binding-registry_9 shared_4)))
+ (let-values (((mpi_47 next-pos_62)
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ next-pos_61
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((excepts_4 next-pos_61)
+ (let-values (((provide-phase-level_0 next-pos_63)
(decode
- vec_62
- next-pos_60
- mpis_12
+ vec_73
+ next-pos_62
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((mpi_35 next-pos_62)
+ (let-values (((phase-shift_4 next-pos_64)
(decode
- vec_62
- next-pos_61
- mpis_12
+ vec_73
+ next-pos_63
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((provide-phase-level_0 next-pos_63)
+ (let-values (((bulk-binding-registry_10 next-pos_65)
(decode
- vec_62
- next-pos_62
- mpis_12
+ vec_73
+ next-pos_64
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((phase-shift_4 next-pos_64)
- (decode
- vec_62
- next-pos_63
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((bulk-binding-registry_10 next-pos_65)
- (decode
- vec_62
- next-pos_64
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values
- (deserialize-bulk-binding
- prefix_4
- excepts_4
- mpi_35
- provide-phase-level_0
- phase-shift_4
- bulk-binding-registry_10)
- next-pos_65)))))))))
- (if (unsafe-fx< index_1 30)
- (let-values () (values (like-ambiguous-binding1.1) (add1 pos_67)))
- (if (unsafe-fx< index_1 31)
- (let-values ()
- (let-values (((provides_6 next-pos_66)
+ (values
+ (deserialize-bulk-binding
+ prefix_4
+ excepts_4
+ mpi_47
+ provide-phase-level_0
+ phase-shift_4
+ bulk-binding-registry_10)
+ next-pos_65))))))))
+ (if (unsafe-fx< index_1 30)
+ (values (like-ambiguous-binding1.1) (add1 pos_88))
+ (if (unsafe-fx< index_1 31)
+ (let-values (((provides_7 next-pos_66)
+ (decode
+ vec_73
+ (add1 pos_88)
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((self_9 next-pos_67)
+ (decode
+ vec_73
+ next-pos_66
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((prefix_5 next-pos_68)
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ next-pos_67
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((self_7 next-pos_67)
+ (let-values (((excepts_5 next-pos_69)
(decode
- vec_62
- next-pos_66
- mpis_12
+ vec_73
+ next-pos_68
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((prefix_5 next-pos_68)
+ (let-values (((mpi_48 next-pos_70)
(decode
- vec_62
- next-pos_67
- mpis_12
+ vec_73
+ next-pos_69
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((excepts_5 next-pos_69)
+ (let-values (((provide-phase-level_1 next-pos_71)
(decode
- vec_62
- next-pos_68
- mpis_12
+ vec_73
+ next-pos_70
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((mpi_36 next-pos_70)
+ (let-values (((phase-shift_5 next-pos_72)
(decode
- vec_62
- next-pos_69
- mpis_12
+ vec_73
+ next-pos_71
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((provide-phase-level_1 next-pos_71)
+ (let-values (((bulk-binding-registry_11 next-pos_73)
(decode
- vec_62
- next-pos_70
- mpis_12
+ vec_73
+ next-pos_72
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((phase-shift_5 next-pos_72)
- (decode
- vec_62
- next-pos_71
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((bulk-binding-registry_11 next-pos_73)
- (decode
- vec_62
- next-pos_72
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values
- (deserialize-bulk-binding+provides
- provides_6
- self_7
- prefix_5
- excepts_5
- mpi_36
- provide-phase-level_1
- phase-shift_5
- bulk-binding-registry_11)
- next-pos_73))))))))))
- (let-values ()
- (let-values (((binding_10 next-pos_74)
+ (values
+ (deserialize-bulk-binding+provides
+ provides_7
+ self_9
+ prefix_5
+ excepts_5
+ mpi_48
+ provide-phase-level_1
+ phase-shift_5
+ bulk-binding-registry_11)
+ next-pos_73)))))))))
+ (let-values (((binding_11 next-pos_74)
+ (decode
+ vec_73
+ (add1 pos_88)
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((protected?_2 next-pos_75)
+ (decode
+ vec_73
+ next-pos_74
+ mpis_13
+ inspector_11
+ bulk-binding-registry_9
+ shared_4)))
+ (let-values (((syntax?_2 next-pos_76)
(decode
- vec_62
- (add1 pos_67)
- mpis_12
+ vec_73
+ next-pos_75
+ mpis_13
inspector_11
bulk-binding-registry_9
shared_4)))
- (let-values (((protected?_2 next-pos_75)
- (decode
- vec_62
- next-pos_74
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (let-values (((syntax?_2 next-pos_76)
- (decode
- vec_62
- next-pos_75
- mpis_12
- inspector_11
- bulk-binding-registry_9
- shared_4)))
- (values
- (deserialize-provided binding_10 protected?_2 syntax?_2)
- next-pos_76)))))))))))))))))
+ (values (deserialize-provided binding_11 protected?_2 syntax?_2) next-pos_76)))))))))))))))
(define-values
(decode-fill!)
- (lambda (v_160 vec_63 pos_93 mpis_13 inspector_12 bulk-binding-registry_12 shared_5)
- (begin
- (let-values (((tmp_23) (vector*-ref vec_63 pos_93)))
- (if (equal? tmp_23 #f)
- (let-values () (add1 pos_93))
- (if (equal? tmp_23 '#:set-box!)
- (let-values ()
- (let-values (((c_28 next-pos_77)
- (decode vec_63 (add1 pos_93) mpis_13 inspector_12 bulk-binding-registry_12 shared_5)))
- (begin (set-box! v_160 c_28) next-pos_77)))
- (if (equal? tmp_23 '#:set-vector!)
- (let-values ()
- (let-values (((len_44) (vector*-ref vec_63 (add1 pos_93))))
- (let-values (((start_41) 0) ((end_29) len_44) ((inc_23) 1))
+ (lambda (v_223 vec_74 pos_119 mpis_14 inspector_12 bulk-binding-registry_12 shared_5)
+ (begin
+ (let-values (((tmp_24) (vector*-ref vec_74 pos_119)))
+ (if (equal? tmp_24 #f)
+ (add1 pos_119)
+ (if (equal? tmp_24 '#:set-box!)
+ (let-values (((c_33 next-pos_77)
+ (decode vec_74 (add1 pos_119) mpis_14 inspector_12 bulk-binding-registry_12 shared_5)))
+ (begin (set-box! v_223 c_33) next-pos_77))
+ (if (equal? tmp_24 '#:set-vector!)
+ (let-values (((len_50) (vector*-ref vec_74 (add1 pos_119))))
+ (let-values (((pos_120) (let-values (((pos_121) (+ pos_119 2))) pos_121)))
+ (let-values (((start_49) 0) ((end_32) len_50) ((inc_26) 1))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-range start_41 end_29 inc_23)))
- ((letrec-values (((for-loop_165)
- (lambda (pos_94 pos_95)
+ (check-range start_49 end_32 inc_26))
+ ((letrec-values (((for-loop_207)
+ (lambda (pos_122 pos_123)
(begin
'for-loop
- (if (< pos_95 end_29)
- (let-values (((i_146) pos_95))
- (let-values (((pos_96)
- (let-values (((pos_97) pos_94))
- (let-values (((pos_98)
- (let-values ()
- (let-values (((c_29 next-pos_78)
- (decode
- vec_63
- pos_97
- mpis_13
- inspector_12
- bulk-binding-registry_12
- shared_5)))
- (begin
- (vector-set! v_160 i_146 c_29)
- next-pos_78)))))
- (values pos_98)))))
- (if (not #f) (for-loop_165 pos_96 (+ pos_95 inc_23)) pos_96)))
- pos_94)))))
- for-loop_165)
- (+ pos_93 2)
- start_41)))))
- (if (equal? tmp_23 '#:set-hash!)
- (let-values ()
- (let-values (((len_45) (vector*-ref vec_63 (add1 pos_93))))
- (let-values (((start_42) 0) ((end_30) len_45) ((inc_24) 1))
+ (if (< pos_123 end_32)
+ (let-values (((i_202) pos_123))
+ (let-values (((pos_124)
+ (let-values (((pos_125)
+ (let-values (((c_34 next-pos_78)
+ (decode
+ vec_74
+ pos_122
+ mpis_14
+ inspector_12
+ bulk-binding-registry_12
+ shared_5)))
+ (begin
+ (vector-set! v_223 i_202 c_34)
+ next-pos_78))))
+ (values pos_125))))
+ (if (not #f) (for-loop_207 pos_124 (+ pos_123 inc_26)) pos_124)))
+ pos_122)))))
+ for-loop_207)
+ pos_120
+ start_49)))))
+ (if (equal? tmp_24 '#:set-hash!)
+ (let-values (((len_51) (vector*-ref vec_74 (add1 pos_119))))
+ (let-values (((pos_126) (let-values (((pos_127) (+ pos_119 2))) pos_127)))
+ (let-values (((start_50) 0) ((end_33) len_51) ((inc_27) 1))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-range start_42 end_30 inc_24)))
- ((letrec-values (((for-loop_166)
- (lambda (pos_99 pos_100)
+ (check-range start_50 end_33 inc_27))
+ ((letrec-values (((for-loop_208)
+ (lambda (pos_128 pos_129)
(begin
'for-loop
- (if (< pos_100 end_30)
+ (if (< pos_129 end_33)
(let-values ()
- (let-values (((pos_101)
- (let-values (((pos_102) pos_99))
- (let-values (((pos_103)
- (let-values ()
- (let-values (((key_54 next-pos_79)
- (decode
- vec_63
- pos_102
- mpis_13
- inspector_12
- bulk-binding-registry_12
- shared_5)))
- (let-values (((val_39 done-pos_2)
- (decode
- vec_63
- next-pos_79
- mpis_13
- inspector_12
- bulk-binding-registry_12
- shared_5)))
- (begin
- (hash-set! v_160 key_54 val_39)
- done-pos_2))))))
- (values pos_103)))))
- (if (not #f) (for-loop_166 pos_101 (+ pos_100 inc_24)) pos_101)))
- pos_99)))))
- for-loop_166)
- (+ pos_93 2)
- start_42)))))
- (if (equal? tmp_23 '#:scope-fill!)
- (let-values ()
- (let-values (((c_30 next-pos_80)
- (decode vec_63 (add1 pos_93) mpis_13 inspector_12 bulk-binding-registry_12 shared_5)))
- (begin (deserialize-scope-fill! v_160 c_30) next-pos_80)))
- (if (equal? tmp_23 '#:representative-scope-fill!)
- (let-values ()
- (let-values (((a_32 next-pos_81)
- (decode
- vec_63
- (add1 pos_93)
- mpis_13
- inspector_12
- bulk-binding-registry_12
- shared_5)))
- (let-values (((d_29 done-pos_3)
- (decode
- vec_63
- next-pos_81
- mpis_13
- inspector_12
- bulk-binding-registry_12
- shared_5)))
- (begin (deserialize-representative-scope-fill! v_160 a_32 d_29) done-pos_3))))
- (let-values () (error 'deserialize "bad fill encoding: ~v" (vector*-ref vec_63 pos_93)))))))))))))
+ (let-values (((pos_130)
+ (let-values (((pos_131)
+ (let-values (((key_57 next-pos_79)
+ (decode
+ vec_74
+ pos_128
+ mpis_14
+ inspector_12
+ bulk-binding-registry_12
+ shared_5)))
+ (let-values (((val_41 done-pos_2)
+ (decode
+ vec_74
+ next-pos_79
+ mpis_14
+ inspector_12
+ bulk-binding-registry_12
+ shared_5)))
+ (begin
+ (hash-set! v_223 key_57 val_41)
+ done-pos_2)))))
+ (values pos_131))))
+ (if (not #f) (for-loop_208 pos_130 (+ pos_129 inc_27)) pos_130)))
+ pos_128)))))
+ for-loop_208)
+ pos_126
+ start_50)))))
+ (if (equal? tmp_24 '#:scope-fill!)
+ (let-values (((c_35 next-pos_80)
+ (decode vec_74 (add1 pos_119) mpis_14 inspector_12 bulk-binding-registry_12 shared_5)))
+ (begin (deserialize-scope-fill! v_223 c_35) next-pos_80))
+ (if (equal? tmp_24 '#:representative-scope-fill!)
+ (let-values (((a_38 next-pos_81)
+ (decode
+ vec_74
+ (add1 pos_119)
+ mpis_14
+ inspector_12
+ bulk-binding-registry_12
+ shared_5)))
+ (let-values (((d_29 done-pos_3)
+ (decode vec_74 next-pos_81 mpis_14 inspector_12 bulk-binding-registry_12 shared_5)))
+ (begin (deserialize-representative-scope-fill! v_223 a_38 d_29) done-pos_3)))
+ (error 'deserialize "bad fill encoding: ~v" (vector*-ref vec_74 pos_119))))))))))))
(define-values
(find-reachable-scopes)
- (lambda (v_161 bulk-shifts_8)
+ (lambda (v_224 bulk-shifts_12 report-mpi-shifts_1)
(begin
- (let-values (((seen_20) (make-hasheq)))
+ (let-values (((seen_21) (make-hasheq)))
(let-values (((reachable-scopes_4) (interned-scopes)))
- (let-values (((get-reachable-scopes_4) (lambda () (begin 'get-reachable-scopes reachable-scopes_4))))
- (let-values (((scope-triggers_0) (make-hasheq)))
- (begin
- ((letrec-values (((loop_86)
- (lambda (v_162 bulk-shifts_9)
- (begin
- 'loop
- (if (interned-literal? v_162)
- (let-values () (void))
- (if (hash-ref seen_20 v_162 #f)
- (let-values () (void))
- (let-values ()
- (begin
- (hash-set! seen_20 v_162 #t)
- (if (scope-with-bindings? v_162)
- (let-values ()
+ (let-values (((implicitly-reachable-scopes_2) (interned-scopes)))
+ (let-values (((get-reachable-scopes_4) (lambda () (begin 'get-reachable-scopes reachable-scopes_4))))
+ (let-values (((scope-triggers_0) (make-hasheq)))
+ (let-values (((report-shifts_7)
+ (if report-mpi-shifts_1
+ (lambda (mpi_49 bulk-shifts_13)
+ (begin
+ 'report-shifts
+ (report-mpi-shifts_1 mpi_49 (apply-syntax-shifts mpi_49 (cdr bulk-shifts_13)))))
+ #f)))
+ (begin
+ ((letrec-values (((loop_92)
+ (lambda (v_225 bulk-shifts_14)
+ (begin
+ 'loop
+ (if (interned-literal? v_225)
+ (void)
+ (if (hash-ref seen_21 v_225 #f)
+ (void)
+ (begin
+ (hash-set! seen_21 v_225 #t)
+ (if (scope-with-bindings? v_225)
(begin
- (set! reachable-scopes_4 (set-add reachable-scopes_4 v_162))
- ((reach-scopes-ref v_162) v_162 bulk-shifts_9 loop_86)
- (let-values (((lst_135) (hash-ref scope-triggers_0 v_162 null)))
+ (set! reachable-scopes_4 (set-add reachable-scopes_4 v_225))
+ ((reach-scopes-ref v_225) v_225 bulk-shifts_14 loop_92)
+ (let-values (((lst_195) (hash-ref scope-triggers_0 v_225 null)))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_135)))
- ((letrec-values (((for-loop_167)
- (lambda (lst_136)
+ (check-list lst_195))
+ ((letrec-values (((for-loop_209)
+ (lambda (lst_196)
(begin
'for-loop
- (if (pair? lst_136)
+ (if (pair? lst_196)
(let-values (((proc_5)
- (unsafe-car lst_136))
- ((rest_67)
- (unsafe-cdr lst_136)))
+ (unsafe-car lst_196))
+ ((rest_94)
+ (unsafe-cdr lst_196)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (proc_5
- loop_86))
- (values)))))
- (values)))))
+ (let-values ((()
+ (begin
+ (proc_5
+ loop_92)
+ (values))))
+ (values))))
(if (not #f)
- (for-loop_167 rest_67)
+ (for-loop_209 rest_94)
(values))))
(values))))))
- for-loop_167)
- lst_135)))
+ for-loop_209)
+ lst_195)))
(void)
- (hash-remove! scope-triggers_0 v_162)
- ((scope-with-bindings-ref v_162)
- v_162
+ (hash-remove! scope-triggers_0 v_225)
+ ((scope-with-bindings-ref v_225)
+ v_225
get-reachable-scopes_4
- bulk-shifts_9
- loop_86
- (lambda (sc-unreachable_0 b_76)
+ bulk-shifts_14
+ loop_92
+ (lambda (sc-unreachable_0 b_98)
(hash-update!
scope-triggers_0
sc-unreachable_0
- (lambda (l_37) (cons b_76 l_37))
- null)))))
- (if (reach-scopes? v_162)
- (let-values () ((reach-scopes-ref v_162) v_162 bulk-shifts_9 loop_86))
- (if (pair? v_162)
- (let-values ()
+ (lambda (l_44) (cons b_98 l_44))
+ null))
+ (lambda (sc_34)
+ (if (set-member? reachable-scopes_4 sc_34)
+ (void)
+ (set! implicitly-reachable-scopes_2
+ (set-add implicitly-reachable-scopes_2 sc_34))))
+ report-shifts_7))
+ (if (reach-scopes? v_225)
+ ((reach-scopes-ref v_225) v_225 bulk-shifts_14 loop_92)
+ (if (pair? v_225)
(begin
- (loop_86 (car v_162) bulk-shifts_9)
- (loop_86 (cdr v_162) bulk-shifts_9)))
- (if (vector? v_162)
- (let-values ()
+ (loop_92 (car v_225) bulk-shifts_14)
+ (loop_92 (cdr v_225) bulk-shifts_14))
+ (if (vector? v_225)
(begin
- (let-values (((vec_64 len_46)
- (let-values (((vec_65) v_162))
+ (let-values (((vec_75 len_52)
+ (let-values (((vec_76) v_225))
(begin
- (check-vector vec_65)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-vector vec_76))
(values
- vec_65
- (unsafe-vector-length vec_65))))))
- (begin
- #f
- ((letrec-values (((for-loop_168)
- (lambda (pos_104)
- (begin
- 'for-loop
- (if (unsafe-fx< pos_104 len_46)
- (let-values (((e_33)
- (unsafe-vector-ref
- vec_64
- pos_104)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (loop_86
- e_33
- bulk-shifts_9))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_168
- (unsafe-fx+ 1 pos_104))
- (values))))
- (values))))))
- for-loop_168)
- 0)))
- (void)))
- (if (box? v_162)
- (let-values () (loop_86 (unbox v_162) bulk-shifts_9))
- (if (hash? v_162)
- (let-values ()
+ vec_76
+ (unsafe-vector-length vec_76))))))
+ ((letrec-values (((for-loop_210)
+ (lambda (pos_132)
+ (begin
+ 'for-loop
+ (if (unsafe-fx< pos_132 len_52)
+ (let-values (((e_36)
+ (unsafe-vector-ref
+ vec_75
+ pos_132)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (loop_92
+ e_36
+ bulk-shifts_14)
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_210
+ (unsafe-fx+ 1 pos_132))
+ (values))))
+ (values))))))
+ for-loop_210)
+ 0))
+ (void))
+ (if (box? v_225)
+ (loop_92 (unbox v_225) bulk-shifts_14)
+ (if (hash? v_225)
(begin
- (let-values (((ht_104) v_162))
+ (let-values (((ht_126) v_225))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-in-hash ht_104)))
- ((letrec-values (((for-loop_169)
- (lambda (i_147)
+ (check-in-hash ht_126))
+ ((letrec-values (((for-loop_211)
+ (lambda (i_203)
(begin
'for-loop
- (if i_147
- (let-values (((k_43 v_163)
+ (if i_203
+ (let-values (((k_44 v_226)
(hash-iterate-key+value
- ht_104
- i_147)))
+ ht_126
+ i_203)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (begin
- (loop_86
- k_43
- bulk-shifts_9)
- (loop_86
- v_163
- bulk-shifts_9)))
- (values)))))
- (values)))))
+ (let-values ((()
+ (begin
+ (begin
+ (loop_92
+ k_44
+ bulk-shifts_14)
+ (loop_92
+ v_226
+ bulk-shifts_14))
+ (values))))
+ (values))))
(if (not #f)
- (for-loop_169
+ (for-loop_211
(hash-iterate-next
- ht_104
- i_147))
+ ht_126
+ i_203))
(values))))
(values))))))
- for-loop_169)
- (hash-iterate-first ht_104))))
- (void)))
- (if (prefab-struct-key v_162)
- (let-values ()
+ for-loop_211)
+ (hash-iterate-first ht_126))))
+ (void))
+ (if (prefab-struct-key v_225)
(begin
(let-values (((v*_6 start*_6 stop*_7 step*_6)
(if (variable-reference-from-unsafe?
(#%variable-reference))
(unsafe-normalise-inputs
unsafe-vector-length
- (struct->vector v_162)
+ (struct->vector v_225)
1
#f
1)
(normalise-inputs
'in-vector
"vector"
- (lambda (x_57) (vector? x_57))
- (lambda (x_58)
- (unsafe-vector-length x_58))
- (struct->vector v_162)
+ (lambda (x_63) (vector? x_63))
+ (lambda (x_64)
+ (unsafe-vector-length x_64))
+ (struct->vector v_225)
1
#f
1))))
- (begin
- #t
- ((letrec-values (((for-loop_170)
- (lambda (idx_6)
- (begin
- 'for-loop
- (if (unsafe-fx< idx_6 stop*_7)
- (let-values (((e_34)
- (unsafe-vector-ref
- v*_6
- idx_6)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (loop_86
- e_34
- bulk-shifts_9))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_170
- (unsafe-fx+ idx_6 1))
- (values))))
- (values))))))
- for-loop_170)
- start*_6)))
- (void)))
- (if (srcloc? v_162)
- (let-values ()
- (loop_86 (srcloc-source v_162) bulk-shifts_9))
- (let-values () (void))))))))))))))))))
- loop_86)
- v_161
- bulk-shifts_8)
- reachable-scopes_4))))))))
+ ((letrec-values (((for-loop_212)
+ (lambda (idx_6)
+ (begin
+ 'for-loop
+ (if (unsafe-fx< idx_6 stop*_7)
+ (let-values (((e_37)
+ (unsafe-vector-ref
+ v*_6
+ idx_6)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (loop_92
+ e_37
+ bulk-shifts_14)
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_212
+ (unsafe-fx+ idx_6 1))
+ (values))))
+ (values))))))
+ for-loop_212)
+ start*_6))
+ (void))
+ (if (srcloc? v_225)
+ (loop_92 (srcloc-source v_225) bulk-shifts_14)
+ (void))))))))))))))))
+ loop_92)
+ v_224
+ bulk-shifts_12)
+ (values reachable-scopes_4 implicitly-reachable-scopes_2)))))))))))
+ (define-values
+ (force-syntax-object)
+ (lambda (syntax-literals_0
+ pos_133
+ mpi_50
+ self-mpi_3
+ phase-shift_6
+ inspector_13
+ deserialized-syntax-vector/box_0
+ bulk-binding-registry_13
+ deserialize-syntax_0)
+ (begin
+ (let-values (((deserialized-syntax-vector_0)
+ (let-values (((or-part_297) (unbox deserialized-syntax-vector/box_0)))
+ (if or-part_297
+ or-part_297
+ (begin
+ (deserialize-syntax_0 bulk-binding-registry_13)
+ (unbox deserialized-syntax-vector/box_0))))))
+ (let-values (((stx_10)
+ (let-values (((temp50_1)
+ (syntax-shift-phase-level$1
+ (vector*-ref deserialized-syntax-vector_0 pos_133)
+ phase-shift_6))
+ ((mpi51_0) mpi_50)
+ ((self-mpi52_0) self-mpi_3)
+ ((inspector53_0) inspector_13))
+ (syntax-module-path-index-shift.1 #f temp50_1 mpi51_0 self-mpi52_0 inspector53_0))))
+ ((letrec-values (((loop_93)
+ (lambda ()
+ (begin
+ 'loop
+ (let-values ((() (begin (vector-cas! syntax-literals_0 pos_133 #f stx_10) (values))))
+ (let-values (((new-stx_9) (vector*-ref syntax-literals_0 pos_133)))
+ (if new-stx_9 new-stx_9 (loop_93))))))))
+ loop_93)))))))
(define-values
(deserialize-imports)
- '(deserialize-module-path-indexes syntax-module-path-index-shift syntax-shift-phase-level module-use deserialize))
+ '(deserialize-module-path-indexes
+ syntax-module-path-index-shift
+ syntax-shift-phase-level
+ force-syntax-object
+ module-use
+ deserialize))
(define-values
(syntax-module-path-index-shift/no-keywords)
(let-values (((syntax-module-path-index-shift_0)
(let-values (((syntax-module-path-index-shift_1)
- (lambda (s42_0 from-mpi43_0 to-mpi44_0 inspector41_0)
+ (lambda (s55_0 from-mpi56_0 to-mpi57_0 inspector54_0)
(begin
'syntax-module-path-index-shift
- (let-values (((s_197) s42_0))
- (let-values (((from-mpi_4) from-mpi43_0))
- (let-values (((to-mpi_3) to-mpi44_0))
- (let-values (((inspector_13) inspector41_0))
- (let-values ()
- (let-values (((s45_1) s_197)
- ((from-mpi46_0) from-mpi_4)
- ((to-mpi47_0) to-mpi_3)
- ((inspector48_0) inspector_13))
- (syntax-module-path-index-shift.1
- #f
- s45_1
- from-mpi46_0
- to-mpi47_0
- inspector48_0)))))))))))
+ (let-values (((s_251) s55_0))
+ (let-values (((from-mpi_6) from-mpi56_0))
+ (let-values (((to-mpi_5) to-mpi57_0))
+ (let-values (((inspector_14) inspector54_0))
+ (let-values (((s58_0) s_251)
+ ((from-mpi59_0) from-mpi_6)
+ ((to-mpi60_0) to-mpi_5)
+ ((inspector61_0) inspector_14))
+ (syntax-module-path-index-shift.1
+ #f
+ s58_0
+ from-mpi59_0
+ to-mpi60_0
+ inspector61_0))))))))))
(case-lambda
- ((s_198 from-mpi_5 to-mpi_4)
+ ((s_252 from-mpi_7 to-mpi_6)
(begin
'syntax-module-path-index-shift
- (syntax-module-path-index-shift_1 s_198 from-mpi_5 to-mpi_4 #f)))
- ((s_199 from-mpi_6 to-mpi_5 inspector41_1)
- (syntax-module-path-index-shift_1 s_199 from-mpi_6 to-mpi_5 inspector41_1))))))
+ (syntax-module-path-index-shift_1 s_252 from-mpi_7 to-mpi_6 #f)))
+ ((s_253 from-mpi_8 to-mpi_7 inspector54_1)
+ (syntax-module-path-index-shift_1 s_253 from-mpi_8 to-mpi_7 inspector54_1))))))
syntax-module-path-index-shift_0))
(define-values
(deserialize-instance)
@@ -24844,187 +24812,171 @@
syntax-module-path-index-shift/no-keywords
'syntax-shift-phase-level
syntax-shift-phase-level$1
+ 'force-syntax-object
+ force-syntax-object
'module-use
module-use1.1
'deserialize
deserialize))
(define-values
(struct:parsed parsed1.1 parsed? parsed-s)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type 'parsed #f 1 0 #f (list (cons prop:authentic #t)) #f #f '(0) #f 'parsed)))))
- (values struct:_2 make-_2 ?_2 (make-struct-field-accessor -ref_2 0 's))))
+ (let-values (((struct:_58 make-_58 ?_58 -ref_58 -set!_58)
+ (make-struct-type 'parsed #f 1 0 #f (list (cons prop:authentic #t)) #f #f '(0) #f 'parsed)))
+ (values struct:_58 make-_58 ?_58 (make-struct-field-accessor -ref_58 0 's))))
(define-values
(struct:parsed-id parsed-id2.1 parsed-id? parsed-id-binding parsed-id-inspector)
- (let-values (((struct:_3 make-_3 ?_3 -ref_3 -set!_3)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-id
- struct:parsed
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'parsed-id)))))
+ (let-values (((struct:_59 make-_59 ?_59 -ref_59 -set!_59)
+ (make-struct-type
+ 'parsed-id
+ struct:parsed
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'parsed-id)))
(values
- struct:_3
- make-_3
- ?_3
- (make-struct-field-accessor -ref_3 0 'binding)
- (make-struct-field-accessor -ref_3 1 'inspector))))
+ struct:_59
+ make-_59
+ ?_59
+ (make-struct-field-accessor -ref_59 0 'binding)
+ (make-struct-field-accessor -ref_59 1 'inspector))))
(define-values
(struct:parsed-primitive-id parsed-primitive-id3.1 parsed-primitive-id?)
- (let-values (((struct:_6 make-_6 ?_6 -ref_6 -set!_6)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-primitive-id
- struct:parsed-id
- 0
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '()
- #f
- 'parsed-primitive-id)))))
- (values struct:_6 make-_6 ?_6)))
+ (let-values (((struct:_60 make-_60 ?_60 -ref_60 -set!_60)
+ (make-struct-type
+ 'parsed-primitive-id
+ struct:parsed-id
+ 0
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '()
+ #f
+ 'parsed-primitive-id)))
+ (values struct:_60 make-_60 ?_60)))
(define-values
(struct:parsed-top-id parsed-top-id4.1 parsed-top-id?)
- (let-values (((struct:_35 make-_35 ?_35 -ref_35 -set!_35)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-top-id
- struct:parsed-id
- 0
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '()
- #f
- 'parsed-top-id)))))
- (values struct:_35 make-_35 ?_35)))
+ (let-values (((struct:_61 make-_61 ?_61 -ref_61 -set!_61)
+ (make-struct-type
+ 'parsed-top-id
+ struct:parsed-id
+ 0
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '()
+ #f
+ 'parsed-top-id)))
+ (values struct:_61 make-_61 ?_61)))
(define-values
(struct:parsed-lambda parsed-lambda5.1 parsed-lambda? parsed-lambda-keys parsed-lambda-body)
- (let-values (((struct:_38 make-_38 ?_38 -ref_38 -set!_38)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-lambda
- struct:parsed
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'parsed-lambda)))))
+ (let-values (((struct:_62 make-_62 ?_62 -ref_62 -set!_62)
+ (make-struct-type
+ 'parsed-lambda
+ struct:parsed
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'parsed-lambda)))
(values
- struct:_38
- make-_38
- ?_38
- (make-struct-field-accessor -ref_38 0 'keys)
- (make-struct-field-accessor -ref_38 1 'body))))
+ struct:_62
+ make-_62
+ ?_62
+ (make-struct-field-accessor -ref_62 0 'keys)
+ (make-struct-field-accessor -ref_62 1 'body))))
(define-values
(struct:parsed-case-lambda parsed-case-lambda6.1 parsed-case-lambda? parsed-case-lambda-clauses)
- (let-values (((struct:_39 make-_39 ?_39 -ref_39 -set!_39)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-case-lambda
- struct:parsed
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'parsed-case-lambda)))))
- (values struct:_39 make-_39 ?_39 (make-struct-field-accessor -ref_39 0 'clauses))))
+ (let-values (((struct:_63 make-_63 ?_63 -ref_63 -set!_63)
+ (make-struct-type
+ 'parsed-case-lambda
+ struct:parsed
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'parsed-case-lambda)))
+ (values struct:_63 make-_63 ?_63 (make-struct-field-accessor -ref_63 0 'clauses))))
(define-values
(struct:parsed-app parsed-app7.1 parsed-app? parsed-app-rator parsed-app-rands)
- (let-values (((struct:_40 make-_40 ?_40 -ref_40 -set!_40)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-app
- struct:parsed
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'parsed-app)))))
+ (let-values (((struct:_64 make-_64 ?_64 -ref_64 -set!_64)
+ (make-struct-type
+ 'parsed-app
+ struct:parsed
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'parsed-app)))
(values
- struct:_40
- make-_40
- ?_40
- (make-struct-field-accessor -ref_40 0 'rator)
- (make-struct-field-accessor -ref_40 1 'rands))))
+ struct:_64
+ make-_64
+ ?_64
+ (make-struct-field-accessor -ref_64 0 'rator)
+ (make-struct-field-accessor -ref_64 1 'rands))))
(define-values
(struct:parsed-if parsed-if8.1 parsed-if? parsed-if-tst parsed-if-thn parsed-if-els)
- (let-values (((struct:_41 make-_41 ?_41 -ref_41 -set!_41)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-if
- struct:parsed
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'parsed-if)))))
+ (let-values (((struct:_65 make-_65 ?_65 -ref_65 -set!_65)
+ (make-struct-type
+ 'parsed-if
+ struct:parsed
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'parsed-if)))
(values
- struct:_41
- make-_41
- ?_41
- (make-struct-field-accessor -ref_41 0 'tst)
- (make-struct-field-accessor -ref_41 1 'thn)
- (make-struct-field-accessor -ref_41 2 'els))))
+ struct:_65
+ make-_65
+ ?_65
+ (make-struct-field-accessor -ref_65 0 'tst)
+ (make-struct-field-accessor -ref_65 1 'thn)
+ (make-struct-field-accessor -ref_65 2 'els))))
(define-values
(struct:parsed-set! parsed-set!9.1 parsed-set!? parsed-set!-id parsed-set!-rhs)
- (let-values (((struct:_42 make-_42 ?_42 -ref_42 -set!_42)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-set!
- struct:parsed
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'parsed-set!)))))
+ (let-values (((struct:_66 make-_66 ?_66 -ref_66 -set!_66)
+ (make-struct-type
+ 'parsed-set!
+ struct:parsed
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'parsed-set!)))
(values
- struct:_42
- make-_42
- ?_42
- (make-struct-field-accessor -ref_42 0 'id)
- (make-struct-field-accessor -ref_42 1 'rhs))))
+ struct:_66
+ make-_66
+ ?_66
+ (make-struct-field-accessor -ref_66 0 'id)
+ (make-struct-field-accessor -ref_66 1 'rhs))))
(define-values
(struct:parsed-with-continuation-mark
parsed-with-continuation-mark10.1
@@ -25032,333 +24984,332 @@
parsed-with-continuation-mark-key
parsed-with-continuation-mark-val
parsed-with-continuation-mark-body)
- (let-values (((struct:_43 make-_43 ?_43 -ref_43 -set!_43)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-with-continuation-mark
- struct:parsed
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'parsed-with-continuation-mark)))))
+ (let-values (((struct:_67 make-_67 ?_67 -ref_67 -set!_67)
+ (make-struct-type
+ 'parsed-with-continuation-mark
+ struct:parsed
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'parsed-with-continuation-mark)))
(values
- struct:_43
- make-_43
- ?_43
- (make-struct-field-accessor -ref_43 0 'key)
- (make-struct-field-accessor -ref_43 1 'val)
- (make-struct-field-accessor -ref_43 2 'body))))
+ struct:_67
+ make-_67
+ ?_67
+ (make-struct-field-accessor -ref_67 0 'key)
+ (make-struct-field-accessor -ref_67 1 'val)
+ (make-struct-field-accessor -ref_67 2 'body))))
(define-values
(struct:parsed-#%variable-reference
parsed-#%variable-reference11.1
parsed-#%variable-reference?
parsed-#%variable-reference-id)
- (let-values (((struct:_44 make-_44 ?_44 -ref_44 -set!_44)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-#%variable-reference
- struct:parsed
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'parsed-#%variable-reference)))))
- (values struct:_44 make-_44 ?_44 (make-struct-field-accessor -ref_44 0 'id))))
+ (let-values (((struct:_68 make-_68 ?_68 -ref_68 -set!_68)
+ (make-struct-type
+ 'parsed-#%variable-reference
+ struct:parsed
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'parsed-#%variable-reference)))
+ (values struct:_68 make-_68 ?_68 (make-struct-field-accessor -ref_68 0 'id))))
(define-values
(struct:parsed-begin parsed-begin12.1 parsed-begin? parsed-begin-body)
- (let-values (((struct:_45 make-_45 ?_45 -ref_45 -set!_45)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-begin
- struct:parsed
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'parsed-begin)))))
- (values struct:_45 make-_45 ?_45 (make-struct-field-accessor -ref_45 0 'body))))
+ (let-values (((struct:_69 make-_69 ?_69 -ref_69 -set!_69)
+ (make-struct-type
+ 'parsed-begin
+ struct:parsed
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'parsed-begin)))
+ (values struct:_69 make-_69 ?_69 (make-struct-field-accessor -ref_69 0 'body))))
(define-values
(struct:parsed-begin0 parsed-begin013.1 parsed-begin0? parsed-begin0-body)
- (let-values (((struct:_46 make-_46 ?_46 -ref_46 -set!_46)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-begin0
- struct:parsed
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'parsed-begin0)))))
- (values struct:_46 make-_46 ?_46 (make-struct-field-accessor -ref_46 0 'body))))
+ (let-values (((struct:_70 make-_70 ?_70 -ref_70 -set!_70)
+ (make-struct-type
+ 'parsed-begin0
+ struct:parsed
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'parsed-begin0)))
+ (values struct:_70 make-_70 ?_70 (make-struct-field-accessor -ref_70 0 'body))))
(define-values
(struct:parsed-quote parsed-quote14.1 parsed-quote? parsed-quote-datum)
- (let-values (((struct:_47 make-_47 ?_47 -ref_47 -set!_47)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-quote
- struct:parsed
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'parsed-quote)))))
- (values struct:_47 make-_47 ?_47 (make-struct-field-accessor -ref_47 0 'datum))))
+ (let-values (((struct:_71 make-_71 ?_71 -ref_71 -set!_71)
+ (make-struct-type
+ 'parsed-quote
+ struct:parsed
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'parsed-quote)))
+ (values struct:_71 make-_71 ?_71 (make-struct-field-accessor -ref_71 0 'datum))))
(define-values
(struct:parsed-quote-syntax parsed-quote-syntax15.1 parsed-quote-syntax? parsed-quote-syntax-datum)
- (let-values (((struct:_48 make-_48 ?_48 -ref_48 -set!_48)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-quote-syntax
- struct:parsed
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'parsed-quote-syntax)))))
- (values struct:_48 make-_48 ?_48 (make-struct-field-accessor -ref_48 0 'datum))))
+ (let-values (((struct:_72 make-_72 ?_72 -ref_72 -set!_72)
+ (make-struct-type
+ 'parsed-quote-syntax
+ struct:parsed
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'parsed-quote-syntax)))
+ (values struct:_72 make-_72 ?_72 (make-struct-field-accessor -ref_72 0 'datum))))
+ (define-values
+ (struct:parsed-foreign-inline
+ parsed-foreign-inline16.1
+ parsed-foreign-inline?
+ parsed-foreign-inline-datum
+ parsed-foreign-inline-mode)
+ (let-values (((struct:_73 make-_73 ?_73 -ref_73 -set!_73)
+ (make-struct-type
+ 'parsed-foreign-inline
+ struct:parsed
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'parsed-foreign-inline)))
+ (values
+ struct:_73
+ make-_73
+ ?_73
+ (make-struct-field-accessor -ref_73 0 'datum)
+ (make-struct-field-accessor -ref_73 1 'mode))))
(define-values
(struct:parsed-let_-values
- parsed-let_-values16.1
+ parsed-let_-values17.1
parsed-let_-values?
parsed-let_-values-idss
parsed-let_-values-clauses
parsed-let_-values-body)
- (let-values (((struct:_49 make-_49 ?_49 -ref_49 -set!_49)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-let_-values
- struct:parsed
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'parsed-let_-values)))))
+ (let-values (((struct:_74 make-_74 ?_74 -ref_74 -set!_74)
+ (make-struct-type
+ 'parsed-let_-values
+ struct:parsed
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'parsed-let_-values)))
(values
- struct:_49
- make-_49
- ?_49
- (make-struct-field-accessor -ref_49 0 'idss)
- (make-struct-field-accessor -ref_49 1 'clauses)
- (make-struct-field-accessor -ref_49 2 'body))))
+ struct:_74
+ make-_74
+ ?_74
+ (make-struct-field-accessor -ref_74 0 'idss)
+ (make-struct-field-accessor -ref_74 1 'clauses)
+ (make-struct-field-accessor -ref_74 2 'body))))
(define-values
- (struct:parsed-let-values parsed-let-values17.1 parsed-let-values?)
- (let-values (((struct:_7 make-_7 ?_7 -ref_7 -set!_7)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-let-values
- struct:parsed-let_-values
- 0
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '()
- #f
- 'parsed-let-values)))))
- (values struct:_7 make-_7 ?_7)))
+ (struct:parsed-let-values parsed-let-values18.1 parsed-let-values?)
+ (let-values (((struct:_75 make-_75 ?_75 -ref_75 -set!_75)
+ (make-struct-type
+ 'parsed-let-values
+ struct:parsed-let_-values
+ 0
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '()
+ #f
+ 'parsed-let-values)))
+ (values struct:_75 make-_75 ?_75)))
(define-values
- (struct:parsed-letrec-values parsed-letrec-values18.1 parsed-letrec-values?)
- (let-values (((struct:_8 make-_8 ?_8 -ref_8 -set!_8)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-letrec-values
- struct:parsed-let_-values
- 0
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '()
- #f
- 'parsed-letrec-values)))))
- (values struct:_8 make-_8 ?_8)))
+ (struct:parsed-letrec-values parsed-letrec-values19.1 parsed-letrec-values?)
+ (let-values (((struct:_76 make-_76 ?_76 -ref_76 -set!_76)
+ (make-struct-type
+ 'parsed-letrec-values
+ struct:parsed-let_-values
+ 0
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '()
+ #f
+ 'parsed-letrec-values)))
+ (values struct:_76 make-_76 ?_76)))
(define-values
(struct:parsed-define-values
- parsed-define-values19.1
+ parsed-define-values20.1
parsed-define-values?
parsed-define-values-ids
parsed-define-values-syms
parsed-define-values-rhs)
- (let-values (((struct:_50 make-_50 ?_50 -ref_50 -set!_50)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-define-values
- struct:parsed
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'parsed-define-values)))))
+ (let-values (((struct:_77 make-_77 ?_77 -ref_77 -set!_77)
+ (make-struct-type
+ 'parsed-define-values
+ struct:parsed
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'parsed-define-values)))
(values
- struct:_50
- make-_50
- ?_50
- (make-struct-field-accessor -ref_50 0 'ids)
- (make-struct-field-accessor -ref_50 1 'syms)
- (make-struct-field-accessor -ref_50 2 'rhs))))
+ struct:_77
+ make-_77
+ ?_77
+ (make-struct-field-accessor -ref_77 0 'ids)
+ (make-struct-field-accessor -ref_77 1 'syms)
+ (make-struct-field-accessor -ref_77 2 'rhs))))
(define-values
(struct:parsed-define-syntaxes
- parsed-define-syntaxes20.1
+ parsed-define-syntaxes21.1
parsed-define-syntaxes?
parsed-define-syntaxes-ids
parsed-define-syntaxes-syms
parsed-define-syntaxes-rhs)
- (let-values (((struct:_51 make-_51 ?_51 -ref_51 -set!_51)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-define-syntaxes
- struct:parsed
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'parsed-define-syntaxes)))))
+ (let-values (((struct:_78 make-_78 ?_78 -ref_78 -set!_78)
+ (make-struct-type
+ 'parsed-define-syntaxes
+ struct:parsed
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'parsed-define-syntaxes)))
(values
- struct:_51
- make-_51
- ?_51
- (make-struct-field-accessor -ref_51 0 'ids)
- (make-struct-field-accessor -ref_51 1 'syms)
- (make-struct-field-accessor -ref_51 2 'rhs))))
- (define-values
- (struct:parsed-begin-for-syntax parsed-begin-for-syntax21.1 parsed-begin-for-syntax? parsed-begin-for-syntax-body)
- (let-values (((struct:_52 make-_52 ?_52 -ref_52 -set!_52)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-begin-for-syntax
- struct:parsed
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'parsed-begin-for-syntax)))))
- (values struct:_52 make-_52 ?_52 (make-struct-field-accessor -ref_52 0 'body))))
- (define-values
- (struct:parsed-#%declare parsed-#%declare22.1 parsed-#%declare?)
- (let-values (((struct:_53 make-_53 ?_53 -ref_53 -set!_53)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-#%declare
- struct:parsed
- 0
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '()
- #f
- 'parsed-#%declare)))))
- (values struct:_53 make-_53 ?_53)))
- (define-values
- (struct:parsed-require parsed-require23.1 parsed-require? parsed-require-portal-syms)
- (let-values (((struct:_54 make-_54 ?_54 -ref_54 -set!_54)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-require
- struct:parsed
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'parsed-require)))))
- (values struct:_54 make-_54 ?_54 (make-struct-field-accessor -ref_54 0 'portal-syms))))
+ struct:_78
+ make-_78
+ ?_78
+ (make-struct-field-accessor -ref_78 0 'ids)
+ (make-struct-field-accessor -ref_78 1 'syms)
+ (make-struct-field-accessor -ref_78 2 'rhs))))
+ (define-values
+ (struct:parsed-begin-for-syntax parsed-begin-for-syntax22.1 parsed-begin-for-syntax? parsed-begin-for-syntax-body)
+ (let-values (((struct:_79 make-_79 ?_79 -ref_79 -set!_79)
+ (make-struct-type
+ 'parsed-begin-for-syntax
+ struct:parsed
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'parsed-begin-for-syntax)))
+ (values struct:_79 make-_79 ?_79 (make-struct-field-accessor -ref_79 0 'body))))
+ (define-values
+ (struct:parsed-#%declare parsed-#%declare23.1 parsed-#%declare?)
+ (let-values (((struct:_80 make-_80 ?_80 -ref_80 -set!_80)
+ (make-struct-type
+ 'parsed-#%declare
+ struct:parsed
+ 0
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '()
+ #f
+ 'parsed-#%declare)))
+ (values struct:_80 make-_80 ?_80)))
+ (define-values
+ (struct:parsed-require parsed-require24.1 parsed-require? parsed-require-portal-syms)
+ (let-values (((struct:_81 make-_81 ?_81 -ref_81 -set!_81)
+ (make-struct-type
+ 'parsed-require
+ struct:parsed
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'parsed-require)))
+ (values struct:_81 make-_81 ?_81 (make-struct-field-accessor -ref_81 0 'portal-syms))))
(define-values
(struct:parsed-#%module-begin
- parsed-#%module-begin24.1
+ parsed-#%module-begin25.1
parsed-#%module-begin?
parsed-#%module-begin-body
- parsed-#%module-begin-realm)
- (let-values (((struct:_55 make-_55 ?_55 -ref_55 -set!_55)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-#%module-begin
- struct:parsed
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'parsed-#%module-begin)))))
+ parsed-#%module-begin-realm
+ parsed-#%module-begin-flatten-requires?)
+ (let-values (((struct:_82 make-_82 ?_82 -ref_82 -set!_82)
+ (make-struct-type
+ 'parsed-#%module-begin
+ struct:parsed
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'parsed-#%module-begin)))
(values
- struct:_55
- make-_55
- ?_55
- (make-struct-field-accessor -ref_55 0 'body)
- (make-struct-field-accessor -ref_55 1 'realm))))
+ struct:_82
+ make-_82
+ ?_82
+ (make-struct-field-accessor -ref_82 0 'body)
+ (make-struct-field-accessor -ref_82 1 'realm)
+ (make-struct-field-accessor -ref_82 2 'flatten-requires?))))
(define-values
(struct:parsed-module
- parsed-module25.1
+ parsed-module26.1
parsed-module?
parsed-module-star?
parsed-module-name-id
parsed-module-self
parsed-module-requires
+ parsed-module-recur-requires
+ parsed-module-flattened-requires
parsed-module-provides
parsed-module-root-ctx-simple?
parsed-module-encoded-root-ctx
@@ -25367,224 +25318,287 @@
parsed-module-portal-syntaxes
parsed-module-compiled-module
parsed-module-compiled-submodules)
- (let-values (((struct:_56 make-_56 ?_56 -ref_56 -set!_56)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parsed-module
- struct:parsed
- 12
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6 7 8 9 10 11)
- #f
- 'parsed-module)))))
+ (let-values (((struct:_83 make-_83 ?_83 -ref_83 -set!_83)
+ (make-struct-type
+ 'parsed-module
+ struct:parsed
+ 14
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 6 7 8 9 10 11 12 13)
+ #f
+ 'parsed-module)))
(values
- struct:_56
- make-_56
- ?_56
- (make-struct-field-accessor -ref_56 0 'star?)
- (make-struct-field-accessor -ref_56 1 'name-id)
- (make-struct-field-accessor -ref_56 2 'self)
- (make-struct-field-accessor -ref_56 3 'requires)
- (make-struct-field-accessor -ref_56 4 'provides)
- (make-struct-field-accessor -ref_56 5 'root-ctx-simple?)
- (make-struct-field-accessor -ref_56 6 'encoded-root-ctx)
- (make-struct-field-accessor -ref_56 7 'body)
- (make-struct-field-accessor -ref_56 8 'realm)
- (make-struct-field-accessor -ref_56 9 'portal-syntaxes)
- (make-struct-field-accessor -ref_56 10 'compiled-module)
- (make-struct-field-accessor -ref_56 11 'compiled-submodules))))
+ struct:_83
+ make-_83
+ ?_83
+ (make-struct-field-accessor -ref_83 0 'star?)
+ (make-struct-field-accessor -ref_83 1 'name-id)
+ (make-struct-field-accessor -ref_83 2 'self)
+ (make-struct-field-accessor -ref_83 3 'requires)
+ (make-struct-field-accessor -ref_83 4 'recur-requires)
+ (make-struct-field-accessor -ref_83 5 'flattened-requires)
+ (make-struct-field-accessor -ref_83 6 'provides)
+ (make-struct-field-accessor -ref_83 7 'root-ctx-simple?)
+ (make-struct-field-accessor -ref_83 8 'encoded-root-ctx)
+ (make-struct-field-accessor -ref_83 9 'body)
+ (make-struct-field-accessor -ref_83 10 'realm)
+ (make-struct-field-accessor -ref_83 11 'portal-syntaxes)
+ (make-struct-field-accessor -ref_83 12 'compiled-module)
+ (make-struct-field-accessor -ref_83 13 'compiled-submodules))))
+ (define-values
+ (struct:parsed-bundle parsed-bundle27.1 parsed-bundle? parsed-bundle-bundle)
+ (let-values (((struct:_84 make-_84 ?_84 -ref_84 -set!_84)
+ (make-struct-type
+ 'parsed-bundle
+ struct:parsed
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'parsed-bundle)))
+ (values struct:_84 make-_84 ?_84 (make-struct-field-accessor -ref_84 0 'bundle))))
(define-values
(add-space-scope)
- (lambda (stx_10 space_1) (begin (if space_1 (add-scope stx_10 (make-interned-scope space_1)) stx_10))))
+ (lambda (stx_11 space_1) (begin (if space_1 (add-scope stx_11 (make-interned-scope space_1)) stx_11))))
(define-values
(remove-space-scope)
- (lambda (stx_11 space_2) (begin (if space_2 (remove-scope stx_11 (make-interned-scope space_2)) stx_11))))
+ (lambda (stx_12 space_2) (begin (if space_2 (remove-scope stx_12 (make-interned-scope space_2)) stx_12))))
(define-values
(module-path->mpi.1)
(lambda (declared-submodule-names1_0 mod-path3_0 self4_2)
(begin
'module-path->mpi
- (let-values (((mod-path_4) mod-path3_0))
- (let-values (((self_8) self4_2))
+ (let-values (((mod-path_5) mod-path3_0))
+ (let-values (((self_10) self4_2))
(let-values (((declared-submodule-names_1) declared-submodule-names1_0))
- (let-values ()
- (if (if (list? mod-path_4)
- (if (= 2 (length mod-path_4))
- (if (eq? 'quote (car mod-path_4))
- (if (symbol? (cadr mod-path_4)) (hash-ref declared-submodule-names_1 (cadr mod-path_4) #f) #f)
- #f)
+ (if (if (list? mod-path_5)
+ (if (= 2 (length mod-path_5))
+ (if (eq? 'quote (car mod-path_5))
+ (if (symbol? (cadr mod-path_5)) (hash-ref declared-submodule-names_1 (cadr mod-path_5) #f) #f)
#f)
#f)
- (let-values () (1/module-path-index-join (list 'submod "." (cadr mod-path_4)) self_8))
- (if (if (list? mod-path_4)
- (if (eq? 'submod (car mod-path_4))
- (let-values (((mod-path_5) (cadr mod-path_4)))
- (if (list? mod-path_5)
- (if (= 2 (length mod-path_5))
- (if (eq? 'quote (car mod-path_5))
- (if (symbol? (cadr mod-path_5))
- (hash-ref declared-submodule-names_1 (cadr mod-path_5) #f)
- #f)
+ #f)
+ (module-path-index-join* (list 'submod "." (cadr mod-path_5)) self_10)
+ (if (if (list? mod-path_5)
+ (if (eq? 'submod (car mod-path_5))
+ (let-values (((mod-path_6) (cadr mod-path_5)))
+ (if (list? mod-path_6)
+ (if (= 2 (length mod-path_6))
+ (if (eq? 'quote (car mod-path_6))
+ (if (symbol? (cadr mod-path_6))
+ (hash-ref declared-submodule-names_1 (cadr mod-path_6) #f)
#f)
#f)
- #f))
- #f)
+ #f)
+ #f))
#f)
- (let-values ()
- (1/module-path-index-join (list* 'submod "." (cadr (cadr mod-path_4)) (cddr mod-path_4)) self_8))
- (let-values () (1/module-path-index-join mod-path_4 self_8)))))))))))
+ #f)
+ (module-path-index-join* (list* 'submod "." (cadr (cadr mod-path_5)) (cddr mod-path_5)) self_10)
+ (module-path-index-join* mod-path_5 self_10)))))))))
(define-values
(module-path->mpi/context)
- (lambda (mod-path_6 ctx_10)
+ (lambda (mod-path_7 ctx_12)
(begin
- (let-values (((mod-path6_0) mod-path_6)
- ((temp7_2) (namespace-mpi (expand-context-namespace ctx_10)))
- ((temp8_1) (expand-context-declared-submodule-names ctx_10)))
+ (let-values (((mod-path6_0) mod-path_7)
+ ((temp7_2) (namespace-mpi (expand-context-namespace ctx_12)))
+ ((temp8_1) (expand-context-declared-submodule-names ctx_12)))
(module-path->mpi.1 temp8_1 mod-path6_0 temp7_2)))))
(define-values
(syntax-mapped-names.1)
(lambda (exactly?2_0 only-interned?1_0 s5_0 phase6_0)
(begin
'syntax-mapped-names
- (let-values (((s_11) s5_0))
- (let-values (((phase_61) phase6_0))
+ (let-values (((s_254) s5_0))
+ (let-values (((phase_70) phase6_0))
(let-values (((only-interned?_1) only-interned?1_0))
- (let-values (((exactly?_4) exactly?2_0))
- (let-values ()
- (let-values (((s-scs_1) (syntax-scope-set s_11 phase_61)))
- (let-values (((ht_77) s-scs_1))
+ (let-values (((exactly?_5) exactly?2_0))
+ (let-values (((s-scs_1) (syntax-scope-set s_254 phase_70)))
+ (let-values (((syms_15) (let-values (((syms_16) (seteq))) syms_16)))
+ (let-values (((ht_127) s-scs_1))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-in-immutable-hash-keys ht_77)))
- ((letrec-values (((for-loop_171)
- (lambda (syms_13 i_148)
+ (check-in-immutable-hash-keys ht_127))
+ ((letrec-values (((for-loop_213)
+ (lambda (syms_17 i_204)
(begin
'for-loop
- (if i_148
- (let-values (((sc_31) (unsafe-immutable-hash-iterate-key ht_77 i_148)))
- (let-values (((syms_14)
- (let-values (((syms_15) syms_13))
- (let-values (((syms_16)
- (let-values ()
- (set-union
- syms_15
- (let-values (((temp8_2)
- (scope-binding-table
- sc_31))
- ((s-scs9_0) s-scs_1)
- ((s10_0) s_11)
- ((null11_0) null)
- ((only-interned?12_0)
- only-interned?_1)
- ((exactly?13_0)
- exactly?_4))
- (binding-table-symbols.1
- exactly?13_0
- only-interned?12_0
- temp8_2
- s-scs9_0
- s10_0
- null11_0))))))
- (values syms_16)))))
+ (if i_204
+ (let-values (((sc_35) (unsafe-immutable-hash-iterate-key ht_127 i_204)))
+ (let-values (((syms_18)
+ (let-values (((syms_19)
+ (set-union
+ syms_17
+ (let-values (((temp13_1)
+ (scope-binding-table sc_35))
+ ((s-scs14_0) s-scs_1)
+ ((s15_1) s_254)
+ ((null16_0) null)
+ ((only-interned?17_0)
+ only-interned?_1)
+ ((exactly?18_0) exactly?_5))
+ (binding-table-symbols.1
+ exactly?18_0
+ only-interned?17_0
+ temp13_1
+ s-scs14_0
+ s15_1
+ null16_0)))))
+ (values syms_19))))
(if (not #f)
- (for-loop_171
- syms_14
- (unsafe-immutable-hash-iterate-next ht_77 i_148))
- syms_14)))
- syms_13)))))
- for-loop_171)
- (seteq)
- (unsafe-immutable-hash-iterate-first ht_77)))))))))))))
+ (for-loop_213
+ syms_18
+ (unsafe-immutable-hash-iterate-next ht_127 i_204))
+ syms_18)))
+ syms_17)))))
+ for-loop_213)
+ syms_15
+ (unsafe-immutable-hash-iterate-first ht_127)))))))))))))
(define-values
(syntax-mapped-phases)
- (lambda (s_87)
+ (lambda (s_255)
(begin
- (let-values (((smss_26) (fallback-first (syntax-shifted-multi-scopes s_87))))
- (let-values (((ht_105) smss_26))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_105)))
- ((letrec-values (((for-loop_172)
- (lambda (phases_5 i_2)
- (begin
- 'for-loop
- (if i_2
- (let-values (((sms_12) (unsafe-immutable-hash-iterate-key ht_105 i_2)))
- (let-values (((phases_6)
- (let-values (((phases_7) phases_5))
- (let-values (((phases_8)
- (let-values ()
- (shifted-multi-scope-add-binding-phases
- sms_12
- phases_7))))
- (values phases_8)))))
- (if (not #f)
- (for-loop_172 phases_6 (unsafe-immutable-hash-iterate-next ht_105 i_2))
- phases_6)))
- phases_5)))))
- for-loop_172)
- (seteqv)
- (unsafe-immutable-hash-iterate-first ht_105))))))))
- (define-values
- (struct:requires+provides
- requires+provides1.1
- requires+provides?
- requires+provides-self
- requires+provides-require-mpis
- requires+provides-require-mpis-in-order
- requires+provides-requires
+ (let-values (((smss_27) (fallback-first (syntax-shifted-multi-scopes s_255))))
+ (let-values (((phases_6) (let-values (((phases_7) (seteqv))) phases_7)))
+ (let-values (((ht_128) smss_27))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-immutable-hash-keys ht_128))
+ ((letrec-values (((for-loop_214)
+ (lambda (phases_8 i_205)
+ (begin
+ 'for-loop
+ (if i_205
+ (let-values (((sms_12) (unsafe-immutable-hash-iterate-key ht_128 i_205)))
+ (let-values (((phases_9)
+ (let-values (((phases_10)
+ (shifted-multi-scope-add-binding-phases
+ sms_12
+ phases_8)))
+ (values phases_10))))
+ (if (not #f)
+ (for-loop_214 phases_9 (unsafe-immutable-hash-iterate-next ht_128 i_205))
+ phases_9)))
+ phases_8)))))
+ for-loop_214)
+ phases_6
+ (unsafe-immutable-hash-iterate-first ht_128)))))))))
+ (define-values
+ (syntax-mapped-interned-scope-symbols.1)
+ (lambda (exactly?8_0 s10_0 phase11_0)
+ (begin
+ 'syntax-mapped-interned-scope-symbols
+ (let-values (((s_256) s10_0))
+ (let-values (((phase_71) phase11_0))
+ (let-values (((exactly?_6) exactly?8_0))
+ (let-values (((s-scs_2) (syntax-scope-set s_256 phase_71)))
+ (let-values (((sym_43) (syntax-e$1 s_256)))
+ (let-values (((syms_20) (let-values (((syms_21) (seteq))) syms_21)))
+ (let-values (((ht_129) s-scs_2))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_129))
+ ((letrec-values (((for-loop_215)
+ (lambda (syms_22 i_206)
+ (begin
+ 'for-loop
+ (if i_206
+ (let-values (((sc_36) (unsafe-immutable-hash-iterate-key ht_129 i_206)))
+ (let-values (((syms_23)
+ (let-values (((syms_24)
+ (set-union
+ syms_22
+ (let-values (((temp19_0)
+ (scope-binding-table sc_36))
+ ((s-scs20_0) s-scs_2)
+ ((sym21_0) sym_43)
+ ((s22_1) s_256)
+ ((null23_1) null)
+ ((exactly?24_1) exactly?_6)
+ ((interned-scope?25_0)
+ interned-scope?)
+ ((interned-scope-key26_0)
+ interned-scope-key))
+ (binding-table-interned-scope-keys.1
+ exactly?24_1
+ temp19_0
+ s-scs20_0
+ sym21_0
+ s22_1
+ null23_1
+ interned-scope?25_0
+ interned-scope-key26_0)))))
+ (values syms_24))))
+ (if (not #f)
+ (for-loop_215
+ syms_23
+ (unsafe-immutable-hash-iterate-next ht_129 i_206))
+ syms_23)))
+ syms_22)))))
+ for-loop_215)
+ syms_20
+ (unsafe-immutable-hash-iterate-first ht_129)))))))))))))
+ (define-values
+ (struct:requires+provides
+ requires+provides1.1
+ requires+provides?
+ requires+provides-self
+ requires+provides-require-mpis
+ requires+provides-require-mpis-in-order
+ requires+provides-requires
+ requires+provides-transitive-requires
requires+provides-provides
requires+provides-phase-to-defined-syms
requires+provides-also-required
requires+provides-spaces
requires+provides-portal-syntaxes
- requires+provides-can-cross-phase-persistent?
+ requires+provides-required-non-cross-phase-module/#f
requires+provides-all-bindings-simple?
requires+provides-definitions-shadow-imports?
- set-requires+provides-can-cross-phase-persistent?!
+ set-requires+provides-required-non-cross-phase-module/#f!
set-requires+provides-all-bindings-simple?!
set-requires+provides-definitions-shadow-imports?!)
- (let-values (((struct:_39 make-_39 ?_39 -ref_39 -set!_39)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'requires+provides
- #f
- 12
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6 7 8)
- #f
- 'requires+provides)))))
+ (let-values (((struct:_85 make-_85 ?_85 -ref_85 -set!_85)
+ (make-struct-type
+ 'requires+provides
+ #f
+ 13
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 6 7 8 9)
+ #f
+ 'requires+provides)))
(values
- struct:_39
- make-_39
- ?_39
- (make-struct-field-accessor -ref_39 0 'self)
- (make-struct-field-accessor -ref_39 1 'require-mpis)
- (make-struct-field-accessor -ref_39 2 'require-mpis-in-order)
- (make-struct-field-accessor -ref_39 3 'requires)
- (make-struct-field-accessor -ref_39 4 'provides)
- (make-struct-field-accessor -ref_39 5 'phase-to-defined-syms)
- (make-struct-field-accessor -ref_39 6 'also-required)
- (make-struct-field-accessor -ref_39 7 'spaces)
- (make-struct-field-accessor -ref_39 8 'portal-syntaxes)
- (make-struct-field-accessor -ref_39 9 'can-cross-phase-persistent?)
- (make-struct-field-accessor -ref_39 10 'all-bindings-simple?)
- (make-struct-field-accessor -ref_39 11 'definitions-shadow-imports?)
- (make-struct-field-mutator -set!_39 9 'can-cross-phase-persistent?)
- (make-struct-field-mutator -set!_39 10 'all-bindings-simple?)
- (make-struct-field-mutator -set!_39 11 'definitions-shadow-imports?))))
+ struct:_85
+ make-_85
+ ?_85
+ (make-struct-field-accessor -ref_85 0 'self)
+ (make-struct-field-accessor -ref_85 1 'require-mpis)
+ (make-struct-field-accessor -ref_85 2 'require-mpis-in-order)
+ (make-struct-field-accessor -ref_85 3 'requires)
+ (make-struct-field-accessor -ref_85 4 'transitive-requires)
+ (make-struct-field-accessor -ref_85 5 'provides)
+ (make-struct-field-accessor -ref_85 6 'phase-to-defined-syms)
+ (make-struct-field-accessor -ref_85 7 'also-required)
+ (make-struct-field-accessor -ref_85 8 'spaces)
+ (make-struct-field-accessor -ref_85 9 'portal-syntaxes)
+ (make-struct-field-accessor -ref_85 10 'required-non-cross-phase-module/#f)
+ (make-struct-field-accessor -ref_85 11 'all-bindings-simple?)
+ (make-struct-field-accessor -ref_85 12 'definitions-shadow-imports?)
+ (make-struct-field-mutator -set!_85 10 'required-non-cross-phase-module/#f)
+ (make-struct-field-mutator -set!_85 11 'all-bindings-simple?)
+ (make-struct-field-mutator -set!_85 12 'definitions-shadow-imports?))))
(define-values
(struct:required
required2.1
@@ -25593,29 +25607,27 @@
required-phase+space
required-can-be-shadowed?
required-as-transformer?)
- (let-values (((struct:_40 make-_40 ?_40 -ref_40 -set!_40)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'required
- #f
- 4
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3)
- #f
- 'required)))))
+ (let-values (((struct:_86 make-_86 ?_86 -ref_86 -set!_86)
+ (make-struct-type
+ 'required
+ #f
+ 4
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3)
+ #f
+ 'required)))
(values
- struct:_40
- make-_40
- ?_40
- (make-struct-field-accessor -ref_40 0 'id)
- (make-struct-field-accessor -ref_40 1 'phase+space)
- (make-struct-field-accessor -ref_40 2 'can-be-shadowed?)
- (make-struct-field-accessor -ref_40 3 'as-transformer?))))
+ struct:_86
+ make-_86
+ ?_86
+ (make-struct-field-accessor -ref_86 0 'id)
+ (make-struct-field-accessor -ref_86 1 'phase+space)
+ (make-struct-field-accessor -ref_86 2 'can-be-shadowed?)
+ (make-struct-field-accessor -ref_86 3 'as-transformer?))))
(define-values
(struct:bulk-required
bulk-required3.1
@@ -25625,130 +25637,141 @@
bulk-required-s
bulk-required-provide-phase+space
bulk-required-can-be-shadowed?)
- (let-values (((struct:_41 make-_41 ?_41 -ref_41 -set!_41)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'bulk-required
- #f
- 5
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3 4)
- #f
- 'bulk-required)))))
+ (let-values (((struct:_87 make-_87 ?_87 -ref_87 -set!_87)
+ (make-struct-type
+ 'bulk-required
+ #f
+ 5
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4)
+ #f
+ 'bulk-required)))
(values
- struct:_41
- make-_41
- ?_41
- (make-struct-field-accessor -ref_41 0 'provides)
- (make-struct-field-accessor -ref_41 1 'prefix-len)
- (make-struct-field-accessor -ref_41 2 's)
- (make-struct-field-accessor -ref_41 3 'provide-phase+space)
- (make-struct-field-accessor -ref_41 4 'can-be-shadowed?))))
+ struct:_87
+ make-_87
+ ?_87
+ (make-struct-field-accessor -ref_87 0 'provides)
+ (make-struct-field-accessor -ref_87 1 'prefix-len)
+ (make-struct-field-accessor -ref_87 2 's)
+ (make-struct-field-accessor -ref_87 3 'provide-phase+space)
+ (make-struct-field-accessor -ref_87 4 'can-be-shadowed?))))
(define-values
(make-requires+provides.1)
(lambda (copy-requires4_0 portal-syntaxes5_0 self8_0)
(begin
'make-requires+provides
- (let-values (((self_9) self8_0))
+ (let-values (((self_11) self8_0))
(let-values (((copy-r+p_0) copy-requires4_0))
(let-values (((portal-syntaxes_3)
(if (eq? portal-syntaxes5_0 unsafe-undefined)
(if copy-r+p_0 (hash-copy (requires+provides-portal-syntaxes copy-r+p_0)) #f)
portal-syntaxes5_0)))
- (let-values ()
- (requires+provides1.1
- self_9
- (if copy-r+p_0 (requires+provides-require-mpis copy-r+p_0) (make-module-path-index-intern-table))
- (if copy-r+p_0 (hash-copy (requires+provides-require-mpis-in-order copy-r+p_0)) (make-hasheqv))
- (make-hasheq)
- (make-hasheqv)
- (make-hasheqv)
- (make-hasheq)
- (make-hasheq)
- portal-syntaxes_3
- #t
- #t
- #t))))))))
+ (requires+provides1.1
+ self_11
+ (if copy-r+p_0 (requires+provides-require-mpis copy-r+p_0) (make-module-path-index-intern-table))
+ (if copy-r+p_0 (hash-copy (requires+provides-require-mpis-in-order copy-r+p_0)) (make-hasheqv))
+ (make-hasheq)
+ (make-hasheq)
+ (make-hasheqv)
+ (make-hasheqv)
+ (make-hasheq)
+ (make-hasheq)
+ portal-syntaxes_3
+ #f
+ #t
+ #t)))))))
(define-values
(requires+provides-reset!)
(lambda (r+p_0)
(begin
(begin
(hash-clear! (requires+provides-requires r+p_0))
+ (hash-clear! (requires+provides-transitive-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))
(hash-clear! (requires+provides-spaces r+p_0))))))
+ (define-values
+ (requires+provides-can-cross-phase-persistent?)
+ (lambda (r+p_1) (begin (not (requires+provides-required-non-cross-phase-module/#f r+p_1)))))
+ (define-values
+ (requires+provides-why-not-cross-phase-persistent)
+ (lambda (r+p_2)
+ (begin
+ (let-values (((m_19) (requires+provides-required-non-cross-phase-module/#f r+p_2)))
+ (begin
+ (if m_19
+ (void)
+ (error
+ 'requires+provides-why-not-cross-phase-persistent
+ "internal error: module could be cross-phase-persistent"))
+ m_19)))))
(define-values
(intern-mpi)
- (lambda (r+p_1 mpi_37) (begin (intern-module-path-index! (requires+provides-require-mpis r+p_1) mpi_37))))
+ (lambda (r+p_3 mpi_51) (begin (intern-module-path-index! (requires+provides-require-mpis r+p_3) mpi_51))))
(define-values
(add-required-space!)
- (lambda (r+p_2 space_3)
- (begin (if space_3 (let-values () (hash-set! (requires+provides-spaces r+p_2) space_3 #t)) (void)))))
+ (lambda (r+p_4 space_3) (begin (if space_3 (hash-set! (requires+provides-spaces r+p_4) space_3 #t) (void)))))
(define-values
(add-required-module!)
- (lambda (r+p_3 mod-name_9 phase+space-shift_2 is-cross-phase-persistent?_0)
+ (lambda (r+p_5 mod-name_10 phase+space-shift_2 is-cross-phase-persistent?_0)
(begin
- (let-values (((mpi_38) (intern-mpi r+p_3 mod-name_9)))
+ (let-values (((mpi_52) (intern-mpi r+p_5 mod-name_10)))
(begin
- (if (hash-ref (hash-ref (requires+provides-requires r+p_3) mpi_38 '#hasheqv()) phase+space-shift_2 #f)
+ (if (hash-ref (hash-ref (requires+provides-requires r+p_5) mpi_52 '#hasheqv()) phase+space-shift_2 #f)
(void)
- (let-values ()
- (begin
- (hash-update!
- (requires+provides-require-mpis-in-order r+p_3)
- (phase+space-shift-phase-level phase+space-shift_2)
- (lambda (l_29) (cons mpi_38 l_29))
- null)
- (hash-set!
- (hash-ref! (requires+provides-requires r+p_3) mpi_38 make-hasheqv)
- phase+space-shift_2
- (make-hasheq)))))
+ (begin
+ (hash-update!
+ (requires+provides-require-mpis-in-order r+p_5)
+ (phase+space-shift-phase-level phase+space-shift_2)
+ (lambda (l_45) (cons mpi_52 l_45))
+ null)
+ (hash-set!
+ (hash-ref! (requires+provides-requires r+p_5) mpi_52 make-hasheqv)
+ phase+space-shift_2
+ (make-hasheq))))
(if is-cross-phase-persistent?_0
(void)
- (let-values () (set-requires+provides-can-cross-phase-persistent?! r+p_3 #f)))
- mpi_38)))))
+ (set-requires+provides-required-non-cross-phase-module/#f! r+p_5 mod-name_10))
+ mpi_52)))))
(define-values
(add-defined-or-required-id!.1)
(lambda (as-transformer?11_0 can-be-shadowed?10_0 r+p14_0 id15_0 phase+space16_0 binding17_1)
(begin
'add-defined-or-required-id!
- (let-values (((r+p_4) r+p14_0))
- (let-values (((id_29) id15_0))
- (let-values (((phase+space_1) phase+space16_0))
- (let-values (((binding_11) binding17_1))
+ (let-values (((r+p_6) r+p14_0))
+ (let-values (((id_31) id15_0))
+ (let-values (((phase+space_2) phase+space16_0))
+ (let-values (((binding_12) binding17_1))
(let-values (((can-be-shadowed?_0) can-be-shadowed?10_0))
(let-values (((as-transformer?_0) as-transformer?11_0))
- (let-values ()
- (begin
- (if (eqv?
- phase+space_1
- (phase+space+
- (module-binding-nominal-phase+space binding_11)
- (module-binding-nominal-require-phase+space-shift binding_11)))
- (void)
- (let-values () (error "internal error: binding phase+space does not match nominal info")))
- (let-values (((r+p101_0) r+p_4)
- ((id102_0) id_29)
- ((phase+space103_0) phase+space_1)
- ((temp104_0) (module-binding-nominal-module binding_11))
- ((temp105_1) (module-binding-nominal-require-phase+space-shift binding_11))
- ((can-be-shadowed?106_0) can-be-shadowed?_0)
- ((as-transformer?107_0) as-transformer?_0))
- (add-defined-or-required-id-at-nominal!.1
- as-transformer?107_0
- can-be-shadowed?106_0
- temp104_0
- temp105_1
- r+p101_0
- id102_0
- phase+space103_0)))))))))))))
+ (begin
+ (if (eqv?
+ phase+space_2
+ (phase+space+
+ (module-binding-nominal-phase+space binding_12)
+ (module-binding-nominal-require-phase+space-shift binding_12)))
+ (void)
+ (error "internal error: binding phase+space does not match nominal info"))
+ (let-values (((r+p109_0) r+p_6)
+ ((id110_0) id_31)
+ ((phase+space111_0) phase+space_2)
+ ((temp112_0) (module-binding-nominal-module binding_12))
+ ((temp113_0) (module-binding-nominal-require-phase+space-shift binding_12))
+ ((can-be-shadowed?114_0) can-be-shadowed?_0)
+ ((as-transformer?115_0) as-transformer?_0))
+ (add-defined-or-required-id-at-nominal!.1
+ as-transformer?115_0
+ can-be-shadowed?114_0
+ temp112_0
+ temp113_0
+ r+p109_0
+ id110_0
+ phase+space111_0))))))))))))
(define-values
(add-defined-or-required-id-at-nominal!.1)
(lambda (as-transformer?22_0
@@ -25760,28 +25783,27 @@
phase+space29_0)
(begin
'add-defined-or-required-id-at-nominal!
- (let-values (((r+p_5) r+p27_0))
- (let-values (((id_30) id28_0))
- (let-values (((phase+space_2) phase+space29_0))
+ (let-values (((r+p_7) r+p27_0))
+ (let-values (((id_32) id28_0))
+ (let-values (((phase+space_3) phase+space29_0))
(let-values (((nominal-module_6) nominal-module19_0))
(let-values (((nominal-require-phase+space-shift_4) nominal-require-phase+space-shift20_0))
(let-values (((can-be-shadowed?_1) can-be-shadowed?21_0))
(let-values (((as-transformer?_1) as-transformer?22_0))
- (let-values ()
- (let-values (((at-mod_0)
- (hash-ref!
- (requires+provides-requires r+p_5)
- (intern-mpi r+p_5 nominal-module_6)
- make-hasheqv)))
- (let-values (((sym-to-reqds_0)
- (hash-ref! at-mod_0 nominal-require-phase+space-shift_4 make-hasheq)))
- (let-values (((sym_13) (syntax-e$1 id_30)))
- (hash-set!
- sym-to-reqds_0
- sym_13
- (cons-ish
- (required2.1 id_30 phase+space_2 can-be-shadowed?_1 as-transformer?_1)
- (hash-ref sym-to-reqds_0 sym_13 null)))))))))))))))))
+ (let-values (((at-mod_0)
+ (hash-ref!
+ (requires+provides-requires r+p_7)
+ (intern-mpi r+p_7 nominal-module_6)
+ make-hasheqv)))
+ (let-values (((sym-to-reqds_0)
+ (hash-ref! at-mod_0 nominal-require-phase+space-shift_4 make-hasheq)))
+ (let-values (((sym_44) (syntax-e$1 id_32)))
+ (hash-set!
+ sym-to-reqds_0
+ sym_44
+ (cons-ish
+ (required2.1 id_32 phase+space_3 can-be-shadowed?_1 as-transformer?_1)
+ (hash-ref sym-to-reqds_0 sym_44 null))))))))))))))))
(define-values
(add-bulk-required-ids!.1)
(lambda (accum-update-nominals37_0
@@ -25801,12 +25823,12 @@
provide-phase+space53_0)
(begin
'add-bulk-required-ids!
- (let-values (((r+p_6) r+p47_0))
- (let-values (((s_200) s48_0))
- (let-values (((self_10) self49_0))
+ (let-values (((r+p_8) r+p47_0))
+ (let-values (((s_257) s48_0))
+ (let-values (((self_12) self49_0))
(let-values (((nominal-module_7) nominal-module50_1))
- (let-values (((phase-level_16) phase-level51_0))
- (let-values (((provides_7) provides52_0))
+ (let-values (((phase-level_19) phase-level51_0))
+ (let-values (((provides_8) provides52_0))
(let-values (((provide-phase+space_3) provide-phase+space53_0))
(let-values (((bulk-prefix_0) prefix31_0))
(let-values (((bulk-excepts_0) excepts32_0))
@@ -25815,592 +25837,532 @@
(let-values (((can-be-shadowed?_2) can-be-shadowed?35_0))
(let-values (((check-and-remove?_0) check-and-remove?36_0))
(let-values (((accum-update-nominals_0) accum-update-nominals37_0))
- (let-values (((who_12) who38_0))
- (let-values ()
- (let-values (((phase+space_3)
- (phase+space+ provide-phase+space_3 phase-level_16)))
- (let-values (((phase_62) (phase+space-phase phase+space_3)))
- (let-values (((space_4) (phase+space-space phase+space_3)))
- (let-values (((s-at-space_0) (add-space-scope s_200 space_4)))
- (let-values (((shortcut-table_0)
- (if check-and-remove?_0
- (if (> (hash-count provides_7) 64)
- (let-values (((s-at-space108_0) s-at-space_0)
- ((phase109_0) phase_62))
- (syntax-mapped-names.1
- #f
- #f
- s-at-space108_0
- phase109_0))
- #f)
- #f)))
- (let-values (((mpi_39) (intern-mpi r+p_6 nominal-module_7)))
- (let-values (((at-mod_1)
- (hash-ref!
- (requires+provides-requires r+p_6)
- mpi_39
- make-hasheqv)))
- (let-values (((sym-to-reqds_1)
- (hash-ref! at-mod_1 phase-level_16 make-hasheq)))
- (let-values (((prefix-len_0)
- (if bulk-prefix_0
- (string-length (symbol->string bulk-prefix_0))
- 0)))
- (let-values (((br_0)
- (bulk-required3.1
- provides_7
- prefix-len_0
- s_200
- provide-phase+space_3
- can-be-shadowed?_2)))
- (let-values (((ht_106) provides_7))
+ (let-values (((who_20) who38_0))
+ (let-values (((phase+space_4) (phase+space+ provide-phase+space_3 phase-level_19)))
+ (let-values (((phase_72) (phase+space-phase phase+space_4)))
+ (let-values (((space_4) (phase+space-space phase+space_4)))
+ (let-values (((s-at-space_0) (add-space-scope s_257 space_4)))
+ (let-values (((shortcut-table_0)
+ (if check-and-remove?_0
+ (if (> (hash-count provides_8) 64)
+ (let-values (((s-at-space116_0) s-at-space_0)
+ ((phase117_0) phase_72))
+ (syntax-mapped-names.1
+ #f
+ #f
+ s-at-space116_0
+ phase117_0))
+ #f)
+ #f)))
+ (let-values (((mpi_53) (intern-mpi r+p_8 nominal-module_7)))
+ (let-values (((at-mod_1)
+ (hash-ref!
+ (requires+provides-requires r+p_8)
+ mpi_53
+ make-hasheqv)))
+ (let-values (((sym-to-reqds_1)
+ (hash-ref! at-mod_1 phase-level_19 make-hasheq)))
+ (let-values (((prefix-len_0)
+ (if bulk-prefix_0
+ (string-length (symbol->string bulk-prefix_0))
+ 0)))
+ (let-values (((br_0)
+ (bulk-required3.1
+ provides_8
+ prefix-len_0
+ s_257
+ provide-phase+space_3
+ can-be-shadowed?_2)))
+ (let-values (((any-already-defined?_0)
+ (let-values (((any-already-defined?_1) #f))
+ any-already-defined?_1)))
+ (let-values (((ht_130) provides_8))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-in-hash ht_106)))
- ((letrec-values (((for-loop_173)
- (lambda (any-already-defined?_0 i_149)
+ (check-in-hash ht_130))
+ ((letrec-values (((for-loop_216)
+ (lambda (any-already-defined?_2 i_207)
(begin
'for-loop
- (if i_149
+ (if i_207
(let-values (((out-sym_0
- binding/p_2)
+ binding/p_3)
(hash-iterate-key+value
- ht_106
- i_149)))
- (let-values (((any-already-defined?_1)
- (let-values (((any-already-defined?_2)
- any-already-defined?_0))
- (if (not
- (symbol-interned?
- out-sym_0))
- any-already-defined?_2
- (let-values (((any-already-defined?_3)
- any-already-defined?_2))
- (let-values (((any-already-defined?_4)
- (let-values ()
- (begin
- (if symbols-accum_0
- (let-values ()
- (hash-set!
- symbols-accum_0
- out-sym_0
- #t))
- (void))
- (if (hash-ref
- bulk-excepts_0
- out-sym_0
- #f)
- (let-values ()
- #f)
- (let-values ()
- (let-values (((sym_8)
- (if (not
- bulk-prefix_0)
- (let-values ()
- out-sym_0)
- (let-values ()
- (string->symbol
- (string-append
- (symbol->string
- bulk-prefix_0)
- (symbol->string
- out-sym_0)))))))
- (let-values (((bound-status_0)
- (if (if check-and-remove?_0
- (let-values (((or-part_183)
- (not
- shortcut-table_0)))
- (if or-part_183
- or-part_183
- (hash-ref
- shortcut-table_0
- sym_8
- #f)))
- #f)
- (let-values ()
- (let-values (((id_31)
- (datum->syntax$1
- s-at-space_0
- sym_8
- s-at-space_0)))
- (begin
- (adjust-shadow-requires!
- r+p_6
- id_31
- phase_62
- space_4)
- (let-values (((temp110_1)
- #t)
- ((temp111_1)
- (requires+provides-definitions-shadow-imports?
- r+p_6))
- ((r+p112_0)
- r+p_6)
- ((id113_0)
- id_31)
- ((phase114_0)
- phase_62)
- ((space115_0)
- space_4)
- ((orig-s116_0)
- orig-s_0)
- ((temp117_0)
- (lambda ()
- (let-values (((binding/p121_0)
- binding/p_2)
- ((sym122_0)
- sym_8)
- ((self123_0)
- self_10)
- ((mpi124_0)
- mpi_39)
- ((provide-phase+space125_0)
- provide-phase+space_3)
- ((phase-level126_0)
- phase-level_16))
- (provide-binding-to-require-binding.1
- mpi124_0
- phase-level126_0
- provide-phase+space125_0
- self123_0
- binding/p121_0
- sym122_0))))
- ((temp118_0)
- #t)
- ((accum-update-nominals119_0)
- accum-update-nominals_0)
- ((who120_0)
- who_12))
- (check-not-defined.1
- accum-update-nominals119_0
- temp111_1
- temp110_1
- orig-s116_0
- temp118_0
- temp117_0
- who120_0
- r+p112_0
- id113_0
- phase114_0
- space115_0)))))
- (let-values ()
- #f))))
- (let-values (((already-defined?_0)
- (eq?
- bound-status_0
- 'defined)))
- (begin
- (if already-defined?_0
- (void)
- (let-values ()
- (hash-set!
- sym-to-reqds_1
- sym_8
- (cons-ish
- br_0
- (hash-ref
- sym-to-reqds_1
- sym_8
- null)))))
- (let-values (((or-part_184)
- any-already-defined?_3))
- (if or-part_184
- or-part_184
- already-defined?_0))))))))))))
- (values
- any-already-defined?_4)))))))
+ ht_130
+ i_207)))
+ (let-values (((any-already-defined?_3)
+ (if (not
+ (symbol-interned?
+ out-sym_0))
+ any-already-defined?_2
+ (let-values (((any-already-defined?_4)
+ (begin
+ (if symbols-accum_0
+ (hash-set!
+ symbols-accum_0
+ out-sym_0
+ #t)
+ (void))
+ (if (hash-ref
+ bulk-excepts_0
+ out-sym_0
+ #f)
+ #f
+ (let-values (((sym_45)
+ (if (not
+ bulk-prefix_0)
+ out-sym_0
+ (string->symbol
+ (string-append
+ (symbol->string
+ bulk-prefix_0)
+ (symbol->string
+ out-sym_0))))))
+ (let-values (((bound-status_0)
+ (if (if check-and-remove?_0
+ (let-values (((or-part_298)
+ (not
+ shortcut-table_0)))
+ (if or-part_298
+ or-part_298
+ (hash-ref
+ shortcut-table_0
+ sym_45
+ #f)))
+ #f)
+ (let-values (((id_33)
+ (datum->syntax$1
+ s-at-space_0
+ sym_45
+ s-at-space_0)))
+ (begin
+ (adjust-shadow-requires!
+ r+p_8
+ id_33
+ phase_72
+ space_4)
+ (let-values (((temp118_0)
+ #t)
+ ((temp119_0)
+ (requires+provides-definitions-shadow-imports?
+ r+p_8))
+ ((r+p120_0)
+ r+p_8)
+ ((id121_0)
+ id_33)
+ ((phase122_0)
+ phase_72)
+ ((space123_0)
+ space_4)
+ ((orig-s124_0)
+ orig-s_0)
+ ((temp125_0)
+ (lambda ()
+ (let-values (((binding/p129_0)
+ binding/p_3)
+ ((sym130_0)
+ sym_45)
+ ((self131_0)
+ self_12)
+ ((mpi132_0)
+ mpi_53)
+ ((provide-phase+space133_0)
+ provide-phase+space_3)
+ ((phase-level134_0)
+ phase-level_19))
+ (provide-binding-to-require-binding.1
+ mpi132_0
+ phase-level134_0
+ provide-phase+space133_0
+ self131_0
+ binding/p129_0
+ sym130_0))))
+ ((temp126_0)
+ #t)
+ ((accum-update-nominals127_0)
+ accum-update-nominals_0)
+ ((who128_0)
+ who_20))
+ (check-not-defined.1
+ accum-update-nominals127_0
+ temp119_0
+ temp118_0
+ orig-s124_0
+ temp126_0
+ temp125_0
+ who128_0
+ r+p120_0
+ id121_0
+ phase122_0
+ space123_0))))
+ #f)))
+ (let-values (((already-defined?_0)
+ (eq?
+ bound-status_0
+ 'defined)))
+ (begin
+ (if already-defined?_0
+ (void)
+ (hash-set!
+ sym-to-reqds_1
+ sym_45
+ (cons-ish
+ br_0
+ (hash-ref
+ sym-to-reqds_1
+ sym_45
+ null))))
+ (let-values (((or-part_299)
+ any-already-defined?_2))
+ (if or-part_299
+ or-part_299
+ already-defined?_0))))))))))
+ (values
+ any-already-defined?_4)))))
(if (not #f)
- (for-loop_173
- any-already-defined?_1
+ (for-loop_216
+ any-already-defined?_3
(hash-iterate-next
- ht_106
- i_149))
- any-already-defined?_1)))
- any-already-defined?_0)))))
- for-loop_173)
- #f
+ ht_130
+ i_207))
+ any-already-defined?_3)))
+ any-already-defined?_2)))))
+ for-loop_216)
+ any-already-defined?_0
(hash-iterate-first
- ht_106)))))))))))))))))))))))))))))))))
+ ht_130)))))))))))))))))))))))))))))))))
(define-values
(bulk-required->required)
- (lambda (br_1 nominal-module_8 phase+space-shift_3 sym_34)
+ (lambda (br_1 nominal-module_8 phase+space-shift_3 sym_46)
(begin
(let-values (((prefix-len_1) (bulk-required-prefix-len br_1)))
(let-values (((out-sym_1)
(if (zero? prefix-len_1)
- sym_34
- (string->symbol (substring (symbol->string sym_34) prefix-len_1)))))
- (let-values (((binding/p_3) (hash-ref (bulk-required-provides br_1) out-sym_1)))
- (let-values (((phase+space_4) (phase+space+ (bulk-required-provide-phase+space br_1) phase+space-shift_3)))
+ sym_46
+ (string->symbol (substring (symbol->string sym_46) prefix-len_1)))))
+ (let-values (((binding/p_4) (hash-ref (bulk-required-provides br_1) out-sym_1)))
+ (let-values (((phase+space_5) (phase+space+ (bulk-required-provide-phase+space br_1) phase+space-shift_3)))
(required2.1
- (add-space-scope (datum->syntax$1 (bulk-required-s br_1) sym_34) (phase+space-space phase+space_4))
- phase+space_4
+ (add-space-scope (datum->syntax$1 (bulk-required-s br_1) sym_46) (phase+space-space phase+space_5))
+ phase+space_5
(bulk-required-can-be-shadowed? br_1)
- (provided-as-transformer? binding/p_3)))))))))
+ (provided-as-transformer? binding/p_4)))))))))
(define-values
(normalize-required)
- (lambda (r_32 mod-name_10 phase+space-shift_4 sym_35)
- (begin (if (bulk-required? r_32) (bulk-required->required r_32 mod-name_10 phase+space-shift_4 sym_35) r_32))))
+ (lambda (r_37 mod-name_11 phase+space-shift_4 sym_47)
+ (begin (if (bulk-required? r_37) (bulk-required->required r_37 mod-name_11 phase+space-shift_4 sym_47) r_37))))
(define-values
(add-enclosing-module-defined-and-required!.1)
(lambda (enclosing-requires+provides55_0 r+p57_0 enclosing-mod58_0 phase-level59_0)
(begin
'add-enclosing-module-defined-and-required!
- (let-values (((r+p_7) r+p57_0))
+ (let-values (((r+p_9) r+p57_0))
(let-values (((enclosing-r+p_0) enclosing-requires+provides55_0))
(let-values (((enclosing-mod_0) enclosing-mod58_0))
- (let-values (((phase-level_17) phase-level59_0))
- (let-values ()
- (begin
- (set-requires+provides-all-bindings-simple?! r+p_7 #f)
- (let-values (((ht_107) (requires+provides-requires enclosing-r+p_0)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_107)))
- ((letrec-values (((for-loop_174)
- (lambda (i_150)
- (begin
- 'for-loop
- (if i_150
- (let-values (((mod-name_11 at-mod_2)
- (hash-iterate-key+value ht_107 i_150)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
+ (let-values (((phase-level_20) phase-level59_0))
+ (begin
+ (set-requires+provides-all-bindings-simple?! r+p_9 #f)
+ (let-values (((ht_131) (requires+provides-requires enclosing-r+p_0)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_131))
+ ((letrec-values (((for-loop_217)
+ (lambda (i_208)
+ (begin
+ 'for-loop
+ (if i_208
+ (let-values (((mod-name_12 at-mod_2) (hash-iterate-key+value ht_131 i_208)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (begin
+ (let-values (((ht_132) at-mod_2))
(begin
- (let-values ()
- (begin
- (let-values (((ht_108) at-mod_2))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash ht_108)))
- ((letrec-values (((for-loop_175)
- (lambda (i_151)
- (begin
- 'for-loop
- (if i_151
- (let-values (((phase+space-shift_5
- at-phase_8)
- (hash-iterate-key+value
- ht_108
- i_151)))
- (let-values ((()
- (let-values ()
- (let-values (((ht_109)
- at-phase_8))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash
- ht_109)))
- ((letrec-values (((for-loop_176)
- (lambda (i_152)
- (begin
- 'for-loop
- (if i_152
- (let-values (((sym_36
- reqds_0)
- (hash-iterate-key+value
- ht_109
- i_152)))
- (let-values ((()
- (let-values ()
- (let-values (((lst_137)
- reqds_0))
- (begin
- (void)
- ((letrec-values (((for-loop_177)
- (lambda (lst_0)
- (begin
- 'for-loop
- (if (not
- (null?
- lst_0))
- (let-values (((reqd/maybe-bulk_0)
- (if (pair?
- lst_0)
- (car
- lst_0)
- lst_0))
- ((rest_68)
- (if (pair?
- lst_0)
- (cdr
- lst_0)
- null)))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash ht_132))
+ ((letrec-values (((for-loop_218)
+ (lambda (i_209)
+ (begin
+ 'for-loop
+ (if i_209
+ (let-values (((phase+space-shift_5
+ at-phase_7)
+ (hash-iterate-key+value
+ ht_132
+ i_209)))
+ (let-values ((()
+ (let-values (((ht_133)
+ at-phase_7))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash
+ ht_133))
+ ((letrec-values (((for-loop_219)
+ (lambda (i_210)
+ (begin
+ 'for-loop
+ (if i_210
+ (let-values (((sym_48
+ reqds_0)
+ (hash-iterate-key+value
+ ht_133
+ i_210)))
+ (let-values ((()
+ (let-values (((lst_197)
+ reqds_0))
+ ((letrec-values (((for-loop_220)
+ (lambda (lst_198)
+ (begin
+ 'for-loop
+ (if (not
+ (null?
+ lst_198))
+ (let-values (((reqd/maybe-bulk_0)
+ (if (pair?
+ lst_198)
+ (car
+ lst_198)
+ lst_198))
+ ((rest_95)
+ (if (pair?
+ lst_198)
+ (cdr
+ lst_198)
+ null)))
+ (let-values ((()
(let-values ((()
- (let-values ()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((reqd_0)
- (normalize-required
- reqd/maybe-bulk_0
- mod-name_11
- phase+space-shift_5
- sym_36)))
- (let-values (((r+p127_0)
- r+p_7)
- ((temp128_0)
- (syntax-shift-phase-level$1
- (let-values (((temp134_0)
- (required-id
- reqd_0))
- ((temp135_0)
- (requires+provides-self
- enclosing-r+p_0))
- ((enclosing-mod136_0)
- enclosing-mod_0))
- (syntax-module-path-index-shift.1
- #f
- temp134_0
- temp135_0
- enclosing-mod136_0
- #f))
- phase-level_17))
- ((temp129_0)
- (phase+space+
- (required-phase+space
- reqd_0)
- phase-level_17))
- ((enclosing-mod130_0)
- enclosing-mod_0)
- ((phase-level131_0)
- phase-level_17)
- ((temp132_0)
- #t)
- ((temp133_0)
- (required-as-transformer?
- reqd_0)))
- (add-defined-or-required-id-at-nominal!.1
- temp133_0
- temp132_0
- enclosing-mod130_0
- phase-level131_0
- r+p127_0
- temp128_0
- temp129_0))))
- (values)))))
- (values))))))
- (if (not
- #f)
- (for-loop_177
- rest_68)
- (values))))
- (values))))))
- for-loop_177)
- lst_137))))))
- (if (not
- #f)
- (for-loop_176
- (hash-iterate-next
- ht_109
- i_152))
- (values))))
- (values))))))
- for-loop_176)
- (hash-iterate-first
- ht_109)))))))
- (if (not
- #f)
- (for-loop_175
- (hash-iterate-next
- ht_108
- i_151))
- (values))))
- (values))))))
- for-loop_175)
- (hash-iterate-first
- ht_108))))
- (void)))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_174 (hash-iterate-next ht_107 i_150))
- (values))))
- (values))))))
- for-loop_174)
- (hash-iterate-first ht_107))))
- (void))))))))))
+ (begin
+ (let-values (((reqd_0)
+ (normalize-required
+ reqd/maybe-bulk_0
+ mod-name_12
+ phase+space-shift_5
+ sym_48)))
+ (let-values (((r+p135_0)
+ r+p_9)
+ ((temp136_0)
+ (syntax-shift-phase-level$1
+ (let-values (((temp142_0)
+ (required-id
+ reqd_0))
+ ((temp143_0)
+ (requires+provides-self
+ enclosing-r+p_0))
+ ((enclosing-mod144_0)
+ enclosing-mod_0))
+ (syntax-module-path-index-shift.1
+ #f
+ temp142_0
+ temp143_0
+ enclosing-mod144_0
+ #f))
+ phase-level_20))
+ ((temp137_0)
+ (phase+space+
+ (required-phase+space
+ reqd_0)
+ phase-level_20))
+ ((enclosing-mod138_0)
+ enclosing-mod_0)
+ ((phase-level139_0)
+ phase-level_20)
+ ((temp140_0)
+ #t)
+ ((temp141_0)
+ (required-as-transformer?
+ reqd_0)))
+ (add-defined-or-required-id-at-nominal!.1
+ temp141_0
+ temp140_0
+ enclosing-mod138_0
+ phase-level139_0
+ r+p135_0
+ temp136_0
+ temp137_0)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_220
+ rest_95)
+ (values))))
+ (values))))))
+ for-loop_220)
+ lst_197))))
+ (if (not
+ #f)
+ (for-loop_219
+ (hash-iterate-next
+ ht_133
+ i_210))
+ (values))))
+ (values))))))
+ for-loop_219)
+ (hash-iterate-first
+ ht_133))))))
+ (if (not
+ #f)
+ (for-loop_218
+ (hash-iterate-next
+ ht_132
+ i_209))
+ (values))))
+ (values))))))
+ for-loop_218)
+ (hash-iterate-first ht_132))))
+ (void))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_217 (hash-iterate-next ht_131 i_208)) (values))))
+ (values))))))
+ for-loop_217)
+ (hash-iterate-first ht_131))))
+ (void)))))))))
(define-values
(remove-required-id!)
- (lambda (r+p_8 id_32 phase_63)
+ (lambda (r+p_10 id_34 phase_73)
(begin
(let-values (((remove!_0)
- (lambda (bind-as-ambiguous?137_0 id139_0)
+ (lambda (bind-as-ambiguous?145_0 id147_0)
(begin
'remove!
- (let-values (((id_33) id139_0))
- (let-values (((bind-as-ambiguous?_0) bind-as-ambiguous?137_0))
- (let-values ()
- (let-values (((b_77)
- (let-values (((id142_0) id_33) ((phase143_0) phase_63) ((temp144_0) #t))
- (resolve+shift.1
- #f
- temp144_0
- null
- unsafe-undefined
- #f
- id142_0
- phase143_0))))
- (if (if (module-binding? b_77)
- (not (eq? (requires+provides-self r+p_8) (module-binding-module b_77)))
- #f)
- (let-values ()
- (let-values ((()
- (begin
- (if bind-as-ambiguous?_0
- (let-values ()
- (let-values (((id145_0) id_33)
- ((temp146_0) (like-ambiguous-binding1.1))
- ((phase147_0) phase_63))
- (add-binding!.1 #f #f id145_0 temp146_0 phase147_0)))
- (void))
- (values))))
- (let-values (((mpi_15) (intern-mpi r+p_8 (module-binding-nominal-module b_77))))
- (let-values (((at-mod_3)
- (hash-ref (requires+provides-requires r+p_8) mpi_15 #f)))
- (if at-mod_3
- (let-values ()
- (let-values (((nominal-phase+space-shift_0)
- (module-binding-nominal-require-phase+space-shift b_77)))
- (let-values (((sym-to-reqds_2)
- (hash-ref at-mod_3 nominal-phase+space-shift_0 #f)))
- (if sym-to-reqds_2
- (let-values ()
- (let-values (((sym_37) (syntax-e$1 id_33)))
- (let-values (((l_38) (hash-ref sym-to-reqds_2 sym_37 null)))
- (if (null? l_38)
- (void)
- (let-values ()
- (hash-set!
- sym-to-reqds_2
- sym_37
- (remove-non-matching-requireds
- l_38
- id_33
- phase_63
- mpi_15
- nominal-phase+space-shift_0
- sym_37)))))))
- (void)))))
- (void))))))
- (void))))))))))
+ (let-values (((id_35) id147_0))
+ (let-values (((bind-as-ambiguous?_0) bind-as-ambiguous?145_0))
+ (let-values (((b_99)
+ (let-values (((id150_0) id_35) ((phase151_0) phase_73) ((temp152_0) #t))
+ (resolve+shift.1
+ #f
+ temp152_0
+ null
+ unsafe-undefined
+ #f
+ id150_0
+ phase151_0))))
+ (if (if (module-binding? b_99)
+ (not (eq? (requires+provides-self r+p_10) (module-binding-module b_99)))
+ #f)
+ (let-values ((()
+ (begin
+ (if bind-as-ambiguous?_0
+ (let-values (((id153_0) id_35)
+ ((temp154_0) (like-ambiguous-binding1.1))
+ ((phase155_0) phase_73))
+ (add-binding!.1 #f #f id153_0 temp154_0 phase155_0))
+ (void))
+ (values))))
+ (let-values (((mpi_54) (intern-mpi r+p_10 (module-binding-nominal-module b_99))))
+ (let-values (((at-mod_3) (hash-ref (requires+provides-requires r+p_10) mpi_54 #f)))
+ (if at-mod_3
+ (let-values (((nominal-phase+space-shift_0)
+ (module-binding-nominal-require-phase+space-shift b_99)))
+ (let-values (((sym-to-reqds_2)
+ (hash-ref at-mod_3 nominal-phase+space-shift_0 #f)))
+ (if sym-to-reqds_2
+ (let-values (((sym_49) (syntax-e$1 id_35)))
+ (let-values (((l_46) (hash-ref sym-to-reqds_2 sym_49 null)))
+ (if (null? l_46)
+ (void)
+ (hash-set!
+ sym-to-reqds_2
+ sym_49
+ (remove-non-matching-requireds
+ l_46
+ id_35
+ phase_73
+ mpi_54
+ nominal-phase+space-shift_0
+ sym_49)))))
+ (void))))
+ (void)))))
+ (void)))))))))
(let-values ()
(let-values ()
(begin
- (let-values (((id141_0) id_32)) (remove!_0 #f id141_0))
- (let-values (((ht_110) (requires+provides-spaces r+p_8)))
+ (let-values (((id149_0) id_34)) (remove!_0 #f id149_0))
+ (let-values (((ht_134) (requires+provides-spaces r+p_10)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash-keys ht_110)))
- ((letrec-values (((for-loop_178)
- (lambda (i_153)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash-keys ht_134))
+ ((letrec-values (((for-loop_221)
+ (lambda (i_211)
(begin
'for-loop
- (if i_153
- (let-values (((space_5) (hash-iterate-key ht_110 i_153)))
+ (if i_211
+ (let-values (((space_5) (hash-iterate-key ht_134 i_211)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((temp148_0)
- (add-space-scope
- id_32
- space_5))
- ((temp149_0) #t))
- (remove!_0 temp149_0 temp148_0)))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_178 (hash-iterate-next ht_110 i_153)) (values))))
+ (let-values ((()
+ (begin
+ (let-values (((temp156_0)
+ (add-space-scope id_34 space_5))
+ ((temp157_0) #t))
+ (remove!_0 temp157_0 temp156_0))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_221 (hash-iterate-next ht_134 i_211)) (values))))
(values))))))
- for-loop_178)
- (hash-iterate-first ht_110))))
+ for-loop_221)
+ (hash-iterate-first ht_134))))
(void))))))))
(define-values
(remove-non-matching-requireds)
- (lambda (reqds_1 id_34 phase_64 mpi_40 nominal-phase+space-shift_1 sym_38)
+ (lambda (reqds_1 id_36 phase_74 mpi_55 nominal-phase+space-shift_1 sym_50)
(begin
(reverse$1
- (let-values (((lst_138) reqds_1))
- (begin
- (void)
- ((letrec-values (((for-loop_179)
- (lambda (fold-var_141 lst_139)
+ (let-values (((fold-var_232) (let-values (((fold-var_233) null)) fold-var_233)))
+ (let-values (((lst_199) reqds_1))
+ ((letrec-values (((for-loop_222)
+ (lambda (fold-var_234 lst_200)
(begin
'for-loop
- (if (not (null? lst_139))
- (let-values (((r_2) (if (pair? lst_139) (car lst_139) lst_139))
- ((rest_69) (if (pair? lst_139) (cdr lst_139) null)))
- (let-values (((fold-var_142)
- (let-values (((fold-var_143) fold-var_141))
- (let-values (((id*_3)
- (normalize-required
- r_2
- mpi_40
- nominal-phase+space-shift_1
- sym_38)))
- (begin
- #t
- ((letrec-values (((for-loop_153)
- (lambda (fold-var_144)
- (begin
- 'for-loop
- (let-values (((r_33) id*_3))
- (let-values (((fold-var_145)
- (let-values (((fold-var_146)
- fold-var_144))
- (let-values (((fold-var_147)
- fold-var_146))
- (if (if (eqv?
- phase_64
- (phase+space-phase
- (required-phase+space
- r_33)))
- (free-identifier=?$1
- (required-id
- r_33)
- id_34
- phase_64
- phase_64)
- #f)
- fold-var_147
- (let-values (((fold-var_148)
- fold-var_147))
- (let-values (((fold-var_149)
- (let-values ()
- (cons
- (let-values ()
- r_33)
- fold-var_148))))
- (values
- fold-var_149))))))))
- fold-var_145))))))
- for-loop_153)
- fold-var_143))))))
- (if (not #f) (for-loop_179 fold-var_142 rest_69) fold-var_142)))
- fold-var_141)))))
- for-loop_179)
- null
- lst_138)))))))
- (define-values
- (check-not-defined.1)
- (lambda (accum-update-nominals66_0
- allow-defined?62_0
+ (if (not (null? lst_200))
+ (let-values (((r_38) (if (pair? lst_200) (car lst_200) lst_200))
+ ((rest_96) (if (pair? lst_200) (cdr lst_200) null)))
+ (let-values (((fold-var_235)
+ (let-values (((id*_3)
+ (normalize-required
+ r_38
+ mpi_55
+ nominal-phase+space-shift_1
+ sym_50)))
+ ((letrec-values (((for-loop_223)
+ (lambda (fold-var_236)
+ (begin
+ 'for-loop
+ (let-values (((r_39) id*_3))
+ (let-values (((fold-var_237)
+ (if (if (eqv?
+ phase_74
+ (phase+space-phase
+ (required-phase+space
+ r_39)))
+ (free-identifier=?$1
+ (required-id r_39)
+ id_36
+ phase_74
+ phase_74)
+ #f)
+ fold-var_236
+ (let-values (((fold-var_238)
+ (cons
+ r_39
+ fold-var_236)))
+ (values fold-var_238)))))
+ fold-var_237))))))
+ for-loop_223)
+ fold-var_234))))
+ (if (not #f) (for-loop_222 fold-var_235 rest_96) fold-var_235)))
+ fold-var_234)))))
+ for-loop_222)
+ fold-var_232
+ lst_199)))))))
+ (define-values
+ (check-not-defined.1)
+ (lambda (accum-update-nominals66_0
+ allow-defined?62_0
check-not-required?61_0
in63_0
remove-shadowed!?65_0
@@ -26414,806 +26376,749 @@
'check-not-defined
(let-values (((check-not-required?_0) check-not-required?61_0))
(let-values (((allow-defined?_0) allow-defined?62_0))
- (let-values (((r+p_9) r+p75_0))
- (let-values (((id_35) id76_0))
- (let-values (((phase_65) phase77_0))
+ (let-values (((r+p_11) r+p75_0))
+ (let-values (((id_37) id76_0))
+ (let-values (((phase_75) phase77_0))
(let-values (((space_6) space78_0))
(let-values (((orig-s_1) in63_0))
(let-values (((ok-binding/delayed_0) unless-matches64_0))
(let-values (((remove-shadowed!?_0) remove-shadowed!?65_0))
(let-values (((accum-update-nominals_1) accum-update-nominals66_0))
- (let-values (((who_13) who67_0))
- (let-values ()
- (let-values (((b_78)
- (let-values (((id150_0) id_35) ((phase151_0) phase_65) ((temp152_0) #t))
- (resolve+shift.1
- #f
- temp152_0
- null
- unsafe-undefined
- #f
- id150_0
- phase151_0))))
- (let-values (((check-default-space_0)
- (lambda ()
- (begin
- 'check-default-space
- (if (let-values (((or-part_185) (not space_6)))
- (if or-part_185 or-part_185 (not check-not-required?_0)))
- (let-values () #f)
- (let-values ()
- (let-values (((default-b_0)
- (let-values (((temp153_1)
- (remove-space-scope id_35 space_6))
- ((phase154_0) phase_65)
- ((temp155_1) #t))
- (resolve+shift.1
- #f
- temp155_1
- null
- unsafe-undefined
- #f
- temp153_1
- phase154_0))))
- (let-values (((defined?_0)
- (if default-b_0
- (eq?
- (requires+provides-self r+p_9)
- (module-binding-module default-b_0))
- #f)))
- (if defined?_0
- (let-values ()
- (begin
- (let-values (((id156_0) id_35)
- ((temp157_0) (like-ambiguous-binding1.1))
- ((phase158_0) phase_65))
- (add-binding!.1 #f #f id156_0 temp157_0 phase158_0))
- 'defined))
- (let-values () #f))))))))))
- (if (not b_78)
- (let-values () (check-default-space_0))
- (if (not (module-binding? b_78))
- (let-values ()
- (if allow-defined?_0
- (let-values ()
- (begin (set-requires+provides-all-bindings-simple?! r+p_9 #f) 'defined))
- (let-values () (raise-syntax-error$1 #f "identifier out of context" id_35))))
- (let-values ()
- (let-values (((defined?_1)
- (if b_78
- (eq?
- (requires+provides-self r+p_9)
- (module-binding-module b_78))
+ (let-values (((who_21) who67_0))
+ (let-values (((b_100)
+ (let-values (((id158_0) id_37) ((phase159_0) phase_75) ((temp160_0) #t))
+ (resolve+shift.1
+ #f
+ temp160_0
+ null
+ unsafe-undefined
+ #f
+ id158_0
+ phase159_0))))
+ (let-values (((check-default-space_0)
+ (lambda ()
+ (begin
+ 'check-default-space
+ (if (let-values (((or-part_300) (not space_6)))
+ (if or-part_300 or-part_300 (not check-not-required?_0)))
+ #f
+ (let-values (((default-b_0)
+ (let-values (((temp161_0)
+ (remove-space-scope id_37 space_6))
+ ((phase162_0) phase_75)
+ ((temp163_0) #t))
+ (resolve+shift.1
+ #f
+ temp163_0
+ null
+ unsafe-undefined
+ #f
+ temp161_0
+ phase162_0))))
+ (let-values (((defined?_0)
+ (if default-b_0
+ (eq?
+ (requires+provides-self r+p_11)
+ (module-binding-module default-b_0))
+ #f)))
+ (if defined?_0
+ (begin
+ (let-values (((id164_0) id_37)
+ ((temp165_0) (like-ambiguous-binding1.1))
+ ((phase166_1) phase_75))
+ (add-binding!.1 #f #f id164_0 temp165_0 phase166_1))
+ 'defined)
+ #f))))))))
+ (if (not b_100)
+ (check-default-space_0)
+ (if (not (module-binding? b_100))
+ (if allow-defined?_0
+ (begin (set-requires+provides-all-bindings-simple?! r+p_11 #f) 'defined)
+ (raise-syntax-error$1 #f "identifier out of context" id_37))
+ (let-values (((defined?_1)
+ (if b_100
+ (eq? (requires+provides-self r+p_11) (module-binding-module b_100))
+ #f)))
+ (if (if defined?_1
+ (not
+ (hash-ref
+ (hash-ref
+ (requires+provides-phase-to-defined-syms r+p_11)
+ phase_75
+ '#hasheq())
+ (module-binding-sym b_100)
+ #f))
+ #f)
+ (check-default-space_0)
+ (let-values (((define-shadowing-require?_0)
+ (if (not defined?_1)
+ (if (requires+provides-definitions-shadow-imports? r+p_11)
+ (not check-not-required?_0)
+ #f)
#f)))
- (if (if defined?_1
- (not
- (hash-ref
- (hash-ref
- (requires+provides-phase-to-defined-syms r+p_9)
- phase_65
- '#hasheq())
- (module-binding-sym b_78)
- #f))
- #f)
- (let-values () (check-default-space_0))
- (let-values ()
- (let-values (((define-shadowing-require?_0)
- (if (not defined?_1)
- (if (requires+provides-definitions-shadow-imports? r+p_9)
- (not check-not-required?_0)
- #f)
+ (let-values (((mpi_56)
+ (intern-mpi r+p_11 (module-binding-nominal-module b_100))))
+ (let-values (((at-mod_4)
+ (hash-ref (requires+provides-requires r+p_11) mpi_56 #f)))
+ (let-values (((ok-binding_0)
+ (if (not define-shadowing-require?_0)
+ (if (procedure? ok-binding/delayed_0)
+ (ok-binding/delayed_0)
+ ok-binding/delayed_0)
#f)))
- (let-values (((mpi_41)
- (intern-mpi r+p_9 (module-binding-nominal-module b_78))))
- (let-values (((at-mod_4)
- (hash-ref
- (requires+provides-requires r+p_9)
- mpi_41
- #f)))
- (let-values (((ok-binding_0)
- (if (not define-shadowing-require?_0)
- (if (procedure? ok-binding/delayed_0)
- (ok-binding/delayed_0)
- ok-binding/delayed_0)
- #f)))
- (let-values (((raise-already-bound_0)
- (lambda (defined?_2 where_0)
- (begin
- 'raise-already-bound
- (raise-syntax-error$1
- who_13
- (string-append
- "identifier"
- (if (if (not defined?_2)
- (not check-not-required?_0)
- #f)
- (let-values () " for definition")
- (if (if defined?_2 check-not-required?_0 #f)
- (let-values () " for require")
- (let-values () "")))
- " already "
- (if defined?_2 "defined" "required")
- (if (zero-phase? phase_65)
- (let-values () "")
- (if (label-phase? phase_65)
- (let-values () " for label")
- (if (= 1 phase_65)
- (let-values () " for syntax")
- (let-values ()
- (format " for phase ~a" phase_65))))))
- orig-s_1
- id_35
- null
- (if (bulk-required? where_0)
- (let-values ()
- (format
- "\n also provided by: ~.s"
- (syntax->datum$1
- (bulk-required-s where_0))))
- (let-values () "")))))))
- (if (if (not at-mod_4) (not define-shadowing-require?_0) #f)
- (let-values () (check-default-space_0))
- (if (if ok-binding_0 (same-binding? b_78 ok-binding_0) #f)
- (let-values ()
- (begin
- (if (same-binding-nominals? b_78 ok-binding_0)
- (void)
- (let-values ()
- (let-values (((update!_0)
- (lambda ()
- (begin
- 'update!
- (let-values (((temp159_0) #t)
- ((id160_0) id_35)
- ((temp161_0)
- (let-values (((ok-binding163_0)
- ok-binding_0)
- ((temp164_0)
- (cons
- b_78
- (module-binding-extra-nominal-bindings
- b_78))))
- (module-binding-update.1
- unsafe-undefined
- temp164_0
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- ok-binding163_0)))
- ((phase162_0)
- phase_65))
- (add-binding!.1
- #f
- temp159_0
- id160_0
- temp161_0
- phase162_0))))))
- (if accum-update-nominals_1
- (let-values ()
- (set-box!
- accum-update-nominals_1
- (cons
- update!_0
- (unbox accum-update-nominals_1))))
- (let-values () (update!_0))))))
- (if defined?_1 'defined 'required)))
- (if (if defined?_1 allow-defined?_0 #f)
- (let-values ()
- (let-values (((also-required_0)
- (requires+provides-also-required r+p_9)))
- (let-values (((prev-b_0)
- (hash-ref
- also-required_0
- (module-binding-sym b_78)
- #f)))
+ (let-values (((raise-already-bound_0)
+ (lambda (defined?_2 where_0)
+ (begin
+ 'raise-already-bound
+ (raise-syntax-error$1
+ who_21
+ (string-append
+ "identifier"
+ (if (if (not defined?_2)
+ (not check-not-required?_0)
+ #f)
+ " for definition"
+ (if (if defined?_2 check-not-required?_0 #f)
+ " for require"
+ ""))
+ " already "
+ (if defined?_2 "defined" "required")
+ (if (zero-phase? phase_75)
+ ""
+ (if (label-phase? phase_75)
+ " for label"
+ (if (= 1 phase_75)
+ " for syntax"
+ (format " for phase ~a" phase_75)))))
+ orig-s_1
+ id_37
+ null
+ (if (bulk-required? where_0)
+ (format
+ "\n also provided by: ~a"
+ ((error-syntax->string-handler)
+ (bulk-required-s where_0)
+ (error-print-width)))
+ ""))))))
+ (if (if (not at-mod_4) (not define-shadowing-require?_0) #f)
+ (check-default-space_0)
+ (if (if ok-binding_0 (same-binding? b_100 ok-binding_0) #f)
+ (begin
+ (if (same-binding-nominals? b_100 ok-binding_0)
+ (void)
+ (let-values (((update!_0)
+ (lambda ()
+ (begin
+ 'update!
+ (let-values (((temp167_0) #t)
+ ((id168_0) id_37)
+ ((temp169_0)
+ (let-values (((ok-binding171_0)
+ ok-binding_0)
+ ((temp172_0)
+ (cons
+ b_100
+ (module-binding-extra-nominal-bindings
+ b_100))))
+ (module-binding-update.1
+ unsafe-undefined
+ temp172_0
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ ok-binding171_0)))
+ ((phase170_0) phase_75))
+ (add-binding!.1
+ #f
+ temp167_0
+ id168_0
+ temp169_0
+ phase170_0))))))
+ (if accum-update-nominals_1
+ (set-box!
+ accum-update-nominals_1
+ (cons update!_0 (unbox accum-update-nominals_1)))
+ (update!_0))))
+ (if defined?_1 'defined 'required))
+ (if (if defined?_1 allow-defined?_0 #f)
+ (let-values (((also-required_0)
+ (requires+provides-also-required r+p_11)))
+ (let-values (((prev-b_0)
+ (hash-ref
+ also-required_0
+ (module-binding-sym b_100)
+ #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_100)
+ ok-binding_0)
+ (set-requires+provides-all-bindings-simple?! r+p_11 #f)
+ 'defined)))
+ (let-values (((nominal-phase+space-shift_2)
+ (module-binding-nominal-require-phase+space-shift
+ b_100)))
+ (let-values (((sym-to-reqds_3)
+ (hash-ref
+ at-mod_4
+ nominal-phase+space-shift_2
+ '#hasheq())))
+ (let-values (((reqds_2)
+ (hash-ref
+ sym-to-reqds_3
+ (syntax-e$1 id_37)
+ null)))
+ (let-values (((only-can-can-shadow-require?_0)
+ (let-values (((only-can-can-shadow-require?_1)
+ (let-values (((only-can-can-shadow-require?_2)
+ #t))
+ only-can-can-shadow-require?_2)))
+ (let-values (((lst_201) reqds_2))
+ ((letrec-values (((for-loop_224)
+ (lambda (only-can-can-shadow-require?_3
+ lst_202)
+ (begin
+ 'for-loop
+ (if (not
+ (null?
+ lst_202))
+ (let-values (((r_40)
+ (if (pair?
+ lst_202)
+ (car
+ lst_202)
+ lst_202))
+ ((rest_97)
+ (if (pair?
+ lst_202)
+ (cdr
+ lst_202)
+ null)))
+ (let-values (((only-can-can-shadow-require?_4)
+ (let-values (((only-can-can-shadow-require?_5)
+ (if (if (bulk-required?
+ r_40)
+ (bulk-required-can-be-shadowed?
+ r_40)
+ (required-can-be-shadowed?
+ r_40))
+ (begin
+ (set-requires+provides-all-bindings-simple?!
+ r+p_11
+ #f)
+ only-can-can-shadow-require?_3)
+ (if define-shadowing-require?_0
+ #f
+ (let-values (((nr_0)
+ (normalize-required
+ r_40
+ mpi_56
+ nominal-phase+space-shift_2
+ (syntax-e$1
+ id_37))))
+ (if (if (eqv?
+ (required-phase+space
+ nr_0)
+ (intern-phase+space
+ phase_75
+ space_6))
+ (bound-identifier=?$1
+ id_37
+ (required-id
+ nr_0)
+ phase_75)
+ #f)
+ (raise-already-bound_0
+ defined?_1
+ r_40)
+ only-can-can-shadow-require?_3))))))
+ (values
+ only-can-can-shadow-require?_5))))
+ (if (not #f)
+ (for-loop_224
+ only-can-can-shadow-require?_4
+ rest_97)
+ only-can-can-shadow-require?_4)))
+ only-can-can-shadow-require?_3)))))
+ for-loop_224)
+ only-can-can-shadow-require?_1
+ lst_201)))))
+ (begin
+ (if define-shadowing-require?_0
(begin
- (if (if prev-b_0
- (not (same-binding? ok-binding_0 prev-b_0))
- #f)
- (let-values () (raise-already-bound_0 #f #f))
- (void))
- (hash-set!
- also-required_0
- (module-binding-sym b_78)
- ok-binding_0)
(set-requires+provides-all-bindings-simple?!
- r+p_9
+ r+p_11
#f)
- 'defined))))
- (let-values ()
- (let-values (((nominal-phase+space-shift_2)
- (module-binding-nominal-require-phase+space-shift
- b_78)))
- (let-values (((sym-to-reqds_3)
- (hash-ref
- at-mod_4
- nominal-phase+space-shift_2
- '#hasheq())))
- (let-values (((reqds_2)
- (hash-ref
- sym-to-reqds_3
- (syntax-e$1 id_35)
- null)))
- (let-values (((only-can-can-shadow-require?_0)
- (let-values (((lst_140) reqds_2))
- (begin
- (void)
- ((letrec-values (((for-loop_180)
- (lambda (only-can-can-shadow-require?_1
- lst_141)
- (begin
- 'for-loop
- (if (not
- (null?
- lst_141))
- (let-values (((r_34)
- (if (pair?
- lst_141)
- (car
- lst_141)
- lst_141))
- ((rest_70)
- (if (pair?
- lst_141)
- (cdr
- lst_141)
- null)))
- (let-values (((only-can-can-shadow-require?_2)
- (let-values (((only-can-can-shadow-require?_3)
- only-can-can-shadow-require?_1))
- (let-values (((only-can-can-shadow-require?_4)
- (let-values ()
- (if (if (bulk-required?
- r_34)
- (bulk-required-can-be-shadowed?
- r_34)
- (required-can-be-shadowed?
- r_34))
- (let-values ()
- (begin
- (set-requires+provides-all-bindings-simple?!
- r+p_9
- #f)
- only-can-can-shadow-require?_3))
- (if define-shadowing-require?_0
- (let-values ()
- #f)
- (let-values ()
- (raise-already-bound_0
- defined?_1
- r_34)))))))
- (values
- only-can-can-shadow-require?_4)))))
- (if (not
- #f)
- (for-loop_180
- only-can-can-shadow-require?_2
- rest_70)
- only-can-can-shadow-require?_2)))
- only-can-can-shadow-require?_1)))))
- for-loop_180)
- #t
- lst_140)))))
- (begin
- (if define-shadowing-require?_0
- (let-values ()
- (begin
- (set-requires+provides-all-bindings-simple?!
- r+p_9
- #f)
- (if only-can-can-shadow-require?_0
- (void)
- (let-values ()
- (hash-set!
- (requires+provides-also-required
- r+p_9)
- (module-binding-sym b_78)
- b_78)))))
- (let-values ()
- (if (if remove-shadowed!?_0
- (not (null? reqds_2))
- #f)
- (let-values ()
- (hash-set!
- sym-to-reqds_3
- (syntax-e$1 id_35)
- (remove-non-matching-requireds
- reqds_2
- id_35
- phase_65
- mpi_41
- nominal-phase+space-shift_2
- (syntax-e$1 id_35))))
- (void))))
- #f)))))))))))))))))))))))))))))))))))))
+ (if only-can-can-shadow-require?_0
+ (void)
+ (hash-set!
+ (requires+provides-also-required r+p_11)
+ (module-binding-sym b_100)
+ b_100)))
+ (if (if remove-shadowed!?_0
+ (not (null? reqds_2))
+ #f)
+ (hash-set!
+ sym-to-reqds_3
+ (syntax-e$1 id_37)
+ (remove-non-matching-requireds
+ reqds_2
+ id_37
+ phase_75
+ mpi_56
+ nominal-phase+space-shift_2
+ (syntax-e$1 id_37)))
+ (void)))
+ #f)))))))))))))))))))))))))))))))))
(define-values
(adjust-shadow-requires!)
- (lambda (r+p_10 id_36 phase_66 space_7)
+ (lambda (r+p_12 id_38 phase_76 space_7)
(begin
(if space_7
(void)
- (let-values ()
- (begin
- (let-values (((ht_111) (requires+provides-spaces r+p_10)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash-keys ht_111)))
- ((letrec-values (((for-loop_181)
- (lambda (i_154)
- (begin
- 'for-loop
- (if i_154
- (let-values (((space_8) (hash-iterate-key ht_111 i_154)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((space-id_0)
- (add-space-scope
- id_36
- space_8)))
- (let-values (((b_79)
- (let-values (((space-id165_0)
- space-id_0)
- ((phase166_0)
- phase_66)
- ((temp167_0)
- #t))
- (resolve+shift.1
- #f
- temp167_0
- null
- unsafe-undefined
- #f
- space-id165_0
- phase166_0))))
- (if (if (module-binding? b_79)
- (not
- (eq?
- (requires+provides-self
- r+p_10)
- (module-binding-module b_79)))
- #f)
- (let-values ()
- (let-values (((mpi_42)
- (intern-mpi
- r+p_10
- (module-binding-nominal-module
- b_79))))
- (let-values (((at-mod_5)
+ (begin
+ (let-values (((ht_135) (requires+provides-spaces r+p_12)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash-keys ht_135))
+ ((letrec-values (((for-loop_225)
+ (lambda (i_212)
+ (begin
+ 'for-loop
+ (if i_212
+ (let-values (((space_8) (hash-iterate-key ht_135 i_212)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((space-id_0)
+ (add-space-scope id_38 space_8)))
+ (let-values (((b_101)
+ (let-values (((space-id173_0)
+ space-id_0)
+ ((phase174_0)
+ phase_76)
+ ((temp175_1) #t))
+ (resolve+shift.1
+ #f
+ temp175_1
+ null
+ unsafe-undefined
+ #f
+ space-id173_0
+ phase174_0))))
+ (if (if (module-binding? b_101)
+ (not
+ (eq?
+ (requires+provides-self r+p_12)
+ (module-binding-module b_101)))
+ #f)
+ (let-values (((mpi_57)
+ (intern-mpi
+ r+p_12
+ (module-binding-nominal-module
+ b_101))))
+ (let-values (((at-mod_5)
+ (hash-ref
+ (requires+provides-requires
+ r+p_12)
+ mpi_57
+ #f)))
+ (if at-mod_5
+ (let-values (((nominal-phase+space-shift_3)
+ (module-binding-nominal-require-phase+space-shift
+ b_101)))
+ (let-values (((sym-to-reqds_4)
+ (hash-ref
+ at-mod_5
+ nominal-phase+space-shift_3
+ #f)))
+ (if sym-to-reqds_4
+ (let-values (((reqds_3)
(hash-ref
- (requires+provides-requires
- r+p_10)
- mpi_42
- #f)))
- (let-values (((nominal-phase+space-shift_3)
- (module-binding-nominal-require-phase+space-shift
- b_79)))
- (let-values (((sym-to-reqds_4)
- (hash-ref
- at-mod_5
- nominal-phase+space-shift_3
- '#hasheq())))
- (let-values (((reqds_3)
- (hash-ref
- sym-to-reqds_4
- (syntax-e$1
- id_36)
- null)))
- (if (let-values (((lst_142)
- reqds_3))
- (begin
- (void)
- ((letrec-values (((for-loop_182)
- (lambda (result_74
- lst_143)
- (begin
- 'for-loop
- (if (not
- (null?
- lst_143))
- (let-values (((r_35)
- (if (pair?
- lst_143)
- (car
- lst_143)
- lst_143))
- ((rest_71)
- (if (pair?
- lst_143)
- (cdr
- lst_143)
- null)))
- (let-values (((result_75)
- (let-values ()
- (let-values (((result_76)
- (let-values ()
- (let-values ()
- (if (bulk-required?
- r_35)
- (bulk-required-can-be-shadowed?
- r_35)
- (required-can-be-shadowed?
- r_35))))))
- (values
- result_76)))))
- (if (if (not
- ((lambda x_59
- (not
- result_75))
- r_35))
- (not
- #f)
- #f)
- (for-loop_182
- result_75
- rest_71)
- result_75)))
- result_74)))))
- for-loop_182)
- #t
- lst_142)))
- (let-values ()
- (begin
- (hash-set!
sym-to-reqds_4
(syntax-e$1
- id_36)
- (remove-non-matching-requireds
- reqds_3
- space-id_0
- phase_66
- mpi_42
- nominal-phase+space-shift_3
- (syntax-e$1
- id_36)))
- (let-values (((space-id168_0)
- space-id_0)
- ((temp169_0)
- (like-ambiguous-binding1.1))
- ((phase170_0)
- phase_66))
- (add-binding!.1
- #f
- #f
- space-id168_0
- temp169_0
- phase170_0))))
- (void))))))))
- (void)))))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_181 (hash-iterate-next ht_111 i_154)) (values))))
- (values))))))
- for-loop_181)
- (hash-iterate-first ht_111))))
- (void)))))))
+ id_38)
+ null)))
+ (if (let-values (((result_134)
+ (let-values (((result_135)
+ #t))
+ result_135)))
+ (let-values (((lst_203)
+ reqds_3))
+ ((letrec-values (((for-loop_226)
+ (lambda (result_136
+ lst_204)
+ (begin
+ 'for-loop
+ (if (not
+ (null?
+ lst_204))
+ (let-values (((r_41)
+ (if (pair?
+ lst_204)
+ (car
+ lst_204)
+ lst_204))
+ ((rest_98)
+ (if (pair?
+ lst_204)
+ (cdr
+ lst_204)
+ null)))
+ (let-values (((result_137)
+ (let-values (((result_138)
+ (if (bulk-required?
+ r_41)
+ (bulk-required-can-be-shadowed?
+ r_41)
+ (required-can-be-shadowed?
+ r_41))))
+ (values
+ result_138))))
+ (if (if (not
+ ((lambda x_65
+ (not
+ result_137))
+ r_41))
+ (not
+ #f)
+ #f)
+ (for-loop_226
+ result_137
+ rest_98)
+ result_137)))
+ result_136)))))
+ for-loop_226)
+ result_134
+ lst_203)))
+ (begin
+ (hash-set!
+ sym-to-reqds_4
+ (syntax-e$1 id_38)
+ (remove-non-matching-requireds
+ reqds_3
+ space-id_0
+ phase_76
+ mpi_57
+ nominal-phase+space-shift_3
+ (syntax-e$1 id_38)))
+ (let-values (((space-id176_0)
+ space-id_0)
+ ((temp177_0)
+ (like-ambiguous-binding1.1))
+ ((phase178_0)
+ phase_76))
+ (add-binding!.1
+ #f
+ #f
+ space-id176_0
+ temp177_0
+ phase178_0)))
+ (void)))
+ (void))))
+ (void))))
+ (void))))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_225 (hash-iterate-next ht_135 i_212)) (values))))
+ (values))))))
+ for-loop_225)
+ (hash-iterate-first ht_135))))
+ (void))))))
(define-values
(add-defined-syms!.1)
(lambda (as-transformer?80_0 r+p82_0 syms83_0 phase84_0)
(begin
'add-defined-syms!
- (let-values (((r+p_11) r+p82_0))
- (let-values (((syms_17) syms83_0))
- (let-values (((phase_67) phase84_0))
+ (let-values (((r+p_13) r+p82_0))
+ (let-values (((syms_25) syms83_0))
+ (let-values (((phase_77) phase84_0))
(let-values (((as-transformer?_2) as-transformer?80_0))
- (let-values ()
- (let-values (((phase-to-defined-syms_0) (requires+provides-phase-to-defined-syms r+p_11)))
- (let-values (((defined-syms_2) (hash-ref phase-to-defined-syms_0 phase_67 '#hasheq())))
- (let-values (((new-defined-syms_0)
- (let-values (((lst_144) syms_17))
+ (let-values (((phase-to-defined-syms_0) (requires+provides-phase-to-defined-syms r+p_13)))
+ (let-values (((defined-syms_2) (hash-ref phase-to-defined-syms_0 phase_77 '#hasheq())))
+ (let-values (((new-defined-syms_0)
+ (let-values (((defined-syms_3)
+ (let-values (((defined-syms_4) defined-syms_2)) defined-syms_4)))
+ (let-values (((lst_205) syms_25))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_144)))
- ((letrec-values (((for-loop_70)
- (lambda (defined-syms_3 lst_145)
+ (check-list lst_205))
+ ((letrec-values (((for-loop_227)
+ (lambda (defined-syms_5 lst_206)
(begin
'for-loop
- (if (pair? lst_145)
- (let-values (((sym_39) (unsafe-car lst_145))
- ((rest_72) (unsafe-cdr lst_145)))
- (let-values (((defined-syms_4)
- (let-values (((defined-syms_5)
- defined-syms_3))
- (let-values (((defined-syms_6)
- (let-values ()
- (hash-set
- defined-syms_5
- sym_39
- (if as-transformer?_2
- 'transformer
- 'variable)))))
- (values defined-syms_6)))))
+ (if (pair? lst_206)
+ (let-values (((sym_51) (unsafe-car lst_206))
+ ((rest_99) (unsafe-cdr lst_206)))
+ (let-values (((defined-syms_6)
+ (let-values (((defined-syms_7)
+ (hash-set
+ defined-syms_5
+ sym_51
+ (if as-transformer?_2
+ 'transformer
+ 'variable))))
+ (values defined-syms_7))))
(if (not #f)
- (for-loop_70 defined-syms_4 rest_72)
- defined-syms_4)))
- defined-syms_3)))))
- for-loop_70)
- defined-syms_2
- lst_144)))))
- (hash-set! phase-to-defined-syms_0 phase_67 new-defined-syms_0))))))))))))
+ (for-loop_227 defined-syms_6 rest_99)
+ defined-syms_6)))
+ defined-syms_5)))))
+ for-loop_227)
+ defined-syms_3
+ lst_205))))))
+ (hash-set! phase-to-defined-syms_0 phase_77 new-defined-syms_0)))))))))))
(define-values
(defined-sym-kind)
- (lambda (r+p_12 sym_40 phase_68)
+ (lambda (r+p_14 sym_52 phase_78)
(begin
- (let-values (((phase-to-defined-syms_1) (requires+provides-phase-to-defined-syms r+p_12)))
- (let-values (((defined-syms_7) (hash-ref phase-to-defined-syms_1 phase_68 '#hasheq())))
- (hash-ref defined-syms_7 sym_40 #f))))))
+ (let-values (((phase-to-defined-syms_1) (requires+provides-phase-to-defined-syms r+p_14)))
+ (let-values (((defined-syms_8) (hash-ref phase-to-defined-syms_1 phase_78 '#hasheq())))
+ (hash-ref defined-syms_8 sym_52 #f))))))
(define-values
(extract-module-requires)
- (lambda (r+p_13 mod-name_12 phase+space-shift_6)
+ (lambda (r+p_15 mod-name_13 phase+space-shift_6)
(begin
- (let-values (((mpi_43) (intern-mpi r+p_13 mod-name_12)))
- (let-values (((at-mod_6) (hash-ref (requires+provides-requires r+p_13) mpi_43 #f)))
+ (let-values (((mpi_58) (intern-mpi r+p_15 mod-name_13)))
+ (let-values (((at-mod_6) (hash-ref (requires+provides-requires r+p_15) mpi_58 #f)))
(if at-mod_6
(reverse$1
- (let-values (((ht_112) (hash-ref at-mod_6 phase+space-shift_6 '#hasheq())))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_112)))
- ((letrec-values (((for-loop_92)
- (lambda (fold-var_150 i_155)
- (begin
- 'for-loop
- (if i_155
- (let-values (((sym_41 reqds_4) (hash-iterate-key+value ht_112 i_155)))
- (let-values (((fold-var_151)
- (let-values (((fold-var_152) fold-var_150))
- (let-values (((lst_76) reqds_4))
- (begin
- (void)
- ((letrec-values (((for-loop_183)
- (lambda (fold-var_153 lst_146)
- (begin
- 'for-loop
- (if (not (null? lst_146))
- (let-values (((reqd_1)
- (if (pair? lst_146)
- (car lst_146)
- lst_146))
- ((rest_73)
- (if (pair? lst_146)
- (cdr lst_146)
- null)))
- (let-values (((fold-var_154)
- (let-values (((fold-var_155)
- fold-var_153))
- (let-values (((fold-var_156)
- fold-var_155))
- (let-values (((fold-var_157)
- (let-values ()
- (cons
- (let-values ()
- (normalize-required
- reqd_1
- mpi_43
- phase+space-shift_6
- sym_41))
- fold-var_156))))
- (values
- fold-var_157))))))
- (if (not #f)
- (for-loop_183
- fold-var_154
- rest_73)
- fold-var_154)))
- fold-var_153)))))
- for-loop_183)
- fold-var_152
- lst_76))))))
- (if (not #f)
- (for-loop_92 fold-var_151 (hash-iterate-next ht_112 i_155))
- fold-var_151)))
- fold-var_150)))))
- for-loop_92)
- null
- (hash-iterate-first ht_112)))))
+ (let-values (((fold-var_239) (let-values (((fold-var_240) null)) fold-var_240)))
+ (let-values (((ht_136) (hash-ref at-mod_6 phase+space-shift_6 '#hasheq())))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_136))
+ ((letrec-values (((for-loop_228)
+ (lambda (fold-var_241 i_213)
+ (begin
+ 'for-loop
+ (if i_213
+ (let-values (((sym_53 reqds_4) (hash-iterate-key+value ht_136 i_213)))
+ (let-values (((fold-var_242)
+ (let-values (((lst_207) reqds_4))
+ ((letrec-values (((for-loop_229)
+ (lambda (fold-var_243 lst_208)
+ (begin
+ 'for-loop
+ (if (not (null? lst_208))
+ (let-values (((reqd_1)
+ (if (pair? lst_208)
+ (car lst_208)
+ lst_208))
+ ((rest_100)
+ (if (pair? lst_208)
+ (cdr lst_208)
+ null)))
+ (let-values (((fold-var_244)
+ (let-values (((fold-var_245)
+ (cons
+ (normalize-required
+ reqd_1
+ mpi_58
+ phase+space-shift_6
+ sym_53)
+ fold-var_243)))
+ (values
+ fold-var_245))))
+ (if (not #f)
+ (for-loop_229
+ fold-var_244
+ rest_100)
+ fold-var_244)))
+ fold-var_243)))))
+ for-loop_229)
+ fold-var_241
+ lst_207))))
+ (if (not #f)
+ (for-loop_228 fold-var_242 (hash-iterate-next ht_136 i_213))
+ fold-var_242)))
+ fold-var_241)))))
+ for-loop_228)
+ fold-var_239
+ (hash-iterate-first ht_136))))))
#f))))))
(define-values
(extract-module-definitions)
- (lambda (r+p_14)
+ (lambda (r+p_16)
(begin
- (let-values (((or-part_186) (extract-module-requires r+p_14 (requires+provides-self r+p_14) 0)))
- (if or-part_186 or-part_186 null)))))
+ (let-values (((or-part_301) (extract-module-requires r+p_16 (requires+provides-self r+p_16) 0)))
+ (if or-part_301 or-part_301 null)))))
(define-values
(extract-all-module-requires)
- (lambda (r+p_15 mod-name_13 phase+space-shift_7)
+ (lambda (r+p_17 mod-name_14 phase+space-shift_7)
(begin
- (let-values (((self_11) (requires+provides-self r+p_15)))
- (let-values (((requires_3) (requires+provides-requires r+p_15)))
- (call/ec
+ (let-values (((self_13) (requires+provides-self r+p_17)))
+ (let-values (((requires_4) (requires+provides-requires r+p_17)))
+ (call-with-escape-continuation
(lambda (esc_0)
(reverse$1
- (let-values (((lst_147) (if mod-name_13 (list (intern-mpi r+p_15 mod-name_13)) (hash-keys requires_3))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_147)))
- ((letrec-values (((for-loop_184)
- (lambda (fold-var_158 lst_148)
- (begin
- 'for-loop
- (if (pair? lst_148)
- (let-values (((mod-name_14) (unsafe-car lst_148))
- ((rest_74) (unsafe-cdr lst_148)))
- (let-values (((fold-var_159)
- (let-values (((fold-var_160) fold-var_158))
- (let-values (((fold-var_161) fold-var_160))
- (if (eq? mod-name_14 self_11)
- fold-var_161
- (let-values (((id*_4)
- (hash-ref
- requires_3
- mod-name_14
- '#hasheqv())))
- (begin
- #t
- ((letrec-values (((for-loop_185)
- (lambda (fold-var_162)
- (begin
- 'for-loop
- (let-values (((phase+space-to-requireds_0)
- id*_4))
- (let-values (((fold-var_163)
- (let-values (((fold-var_164)
- fold-var_162))
- (let-values (((lst_149)
- (if (eq?
- phase+space-shift_7
- 'all)
- (hash-keys
- phase+space-to-requireds_0)
- (list
- phase+space-shift_7))))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_149)))
- ((letrec-values (((for-loop_186)
- (lambda (fold-var_165
- lst_150)
- (begin
- 'for-loop
- (if (pair?
- lst_150)
- (let-values (((phase+space-shift_8)
- (unsafe-car
- lst_150))
- ((rest_75)
- (unsafe-cdr
- lst_150)))
- (let-values (((fold-var_166)
- (let-values (((fold-var_167)
- fold-var_165))
- (let-values (((ht_113)
- (hash-ref
- phase+space-to-requireds_0
- phase+space-shift_8
- (lambda ()
- (esc_0
- #f)))))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash
- ht_113)))
- ((letrec-values (((for-loop_187)
- (lambda (fold-var_168
- i_156)
- (begin
- 'for-loop
- (if i_156
- (let-values (((sym_42
- reqds_5)
- (hash-iterate-key+value
- ht_113
- i_156)))
- (let-values (((fold-var_169)
- (let-values (((fold-var_170)
- fold-var_168))
- (let-values (((lst_151)
- reqds_5))
- (begin
- (void)
- ((letrec-values (((for-loop_188)
- (lambda (fold-var_171
- lst_152)
- (begin
- 'for-loop
- (if (not
- (null?
- lst_152))
- (let-values (((reqd_2)
- (if (pair?
- lst_152)
- (car
- lst_152)
- lst_152))
- ((rest_76)
- (if (pair?
- lst_152)
- (cdr
- lst_152)
- null)))
- (let-values (((fold-var_172)
- (let-values (((fold-var_173)
- fold-var_171))
- (let-values (((fold-var_174)
- fold-var_173))
- (let-values (((fold-var_175)
- (let-values ()
- (cons
- (let-values ()
- (normalize-required
- reqd_2
- mod-name_14
- phase+space-shift_8
- sym_42))
- fold-var_174))))
- (values
- fold-var_175))))))
- (if (not
- #f)
- (for-loop_188
- fold-var_172
- rest_76)
- fold-var_172)))
- fold-var_171)))))
- for-loop_188)
- fold-var_170
- lst_151))))))
- (if (not
- #f)
- (for-loop_187
- fold-var_169
- (hash-iterate-next
- ht_113
- i_156))
- fold-var_169)))
- fold-var_168)))))
- for-loop_187)
- fold-var_167
- (hash-iterate-first
- ht_113)))))))
- (if (not
- #f)
- (for-loop_186
- fold-var_166
- rest_75)
- fold-var_166)))
- fold-var_165)))))
- for-loop_186)
- fold-var_164
- lst_149))))))
- fold-var_163))))))
- for-loop_185)
- fold-var_161))))))))
- (if (not #f) (for-loop_184 fold-var_159 rest_74) fold-var_159)))
- fold-var_158)))))
- for-loop_184)
- null
- lst_147)))))))))))
- (define-values
- (disable-definitions-shadow-imports!)
- (lambda (r+p_16) (begin (set-requires+provides-definitions-shadow-imports?! r+p_16 #f))))
- (define-values
- (add-provide!.1)
+ (let-values (((fold-var_246) (let-values (((fold-var_247) null)) fold-var_247)))
+ (let-values (((lst_209) (if mod-name_14 (list (intern-mpi r+p_17 mod-name_14)) (hash-keys requires_4))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_209))
+ ((letrec-values (((for-loop_230)
+ (lambda (fold-var_248 lst_210)
+ (begin
+ 'for-loop
+ (if (pair? lst_210)
+ (let-values (((mod-name_15) (unsafe-car lst_210))
+ ((rest_101) (unsafe-cdr lst_210)))
+ (let-values (((fold-var_249)
+ (if (eq? mod-name_15 self_13)
+ fold-var_248
+ (let-values (((id*_4)
+ (hash-ref
+ requires_4
+ mod-name_15
+ '#hasheqv())))
+ ((letrec-values (((for-loop_231)
+ (lambda (fold-var_250)
+ (begin
+ 'for-loop
+ (let-values (((phase+space-to-requireds_0)
+ id*_4))
+ (let-values (((fold-var_251)
+ (let-values (((lst_211)
+ (if (eq?
+ phase+space-shift_7
+ 'all)
+ (hash-keys
+ phase+space-to-requireds_0)
+ (list
+ phase+space-shift_7))))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_211))
+ ((letrec-values (((for-loop_232)
+ (lambda (fold-var_252
+ lst_212)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_212)
+ (let-values (((phase+space-shift_8)
+ (unsafe-car
+ lst_212))
+ ((rest_102)
+ (unsafe-cdr
+ lst_212)))
+ (let-values (((fold-var_253)
+ (let-values (((ht_137)
+ (hash-ref
+ phase+space-to-requireds_0
+ phase+space-shift_8
+ (lambda ()
+ (esc_0
+ #f)))))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash
+ ht_137))
+ ((letrec-values (((for-loop_233)
+ (lambda (fold-var_254
+ i_214)
+ (begin
+ 'for-loop
+ (if i_214
+ (let-values (((sym_54
+ reqds_5)
+ (hash-iterate-key+value
+ ht_137
+ i_214)))
+ (let-values (((fold-var_255)
+ (let-values (((lst_213)
+ reqds_5))
+ ((letrec-values (((for-loop_234)
+ (lambda (fold-var_256
+ lst_214)
+ (begin
+ 'for-loop
+ (if (not
+ (null?
+ lst_214))
+ (let-values (((reqd_2)
+ (if (pair?
+ lst_214)
+ (car
+ lst_214)
+ lst_214))
+ ((rest_103)
+ (if (pair?
+ lst_214)
+ (cdr
+ lst_214)
+ null)))
+ (let-values (((fold-var_257)
+ (let-values (((fold-var_258)
+ (cons
+ (normalize-required
+ reqd_2
+ mod-name_15
+ phase+space-shift_8
+ sym_54)
+ fold-var_256)))
+ (values
+ fold-var_258))))
+ (if (not
+ #f)
+ (for-loop_234
+ fold-var_257
+ rest_103)
+ fold-var_257)))
+ fold-var_256)))))
+ for-loop_234)
+ fold-var_254
+ lst_213))))
+ (if (not
+ #f)
+ (for-loop_233
+ fold-var_255
+ (hash-iterate-next
+ ht_137
+ i_214))
+ fold-var_255)))
+ fold-var_254)))))
+ for-loop_233)
+ fold-var_252
+ (hash-iterate-first
+ ht_137))))))
+ (if (not
+ #f)
+ (for-loop_232
+ fold-var_253
+ rest_102)
+ fold-var_253)))
+ fold-var_252)))))
+ for-loop_232)
+ fold-var_250
+ lst_211)))))
+ fold-var_251))))))
+ for-loop_231)
+ fold-var_248)))))
+ (if (not #f) (for-loop_230 fold-var_249 rest_101) fold-var_249)))
+ fold-var_248)))))
+ for-loop_230)
+ fold-var_246
+ lst_209))))))))))))
+ (define-values
+ (disable-definitions-shadow-imports!)
+ (lambda (r+p_18) (begin (set-requires+provides-definitions-shadow-imports?! r+p_18 #f))))
+ (define-values
+ (add-provide!.1)
(lambda (as-protected?86_0
as-transformer?87_0
r+p90_0
@@ -27225,327 +27130,736 @@
orig-s96_0)
(begin
'add-provide!
- (let-values (((r+p_17) r+p90_0))
- (let-values (((sym_43) sym91_0))
- (let-values (((phase+space_5) phase+space92_0))
- (let-values (((binding_12) binding93_0))
+ (let-values (((r+p_19) r+p90_0))
+ (let-values (((sym_55) sym91_0))
+ (let-values (((phase+space_6) phase+space92_0))
+ (let-values (((binding_13) binding93_0))
(let-values (((immed-binding_0) immed-binding94_0))
- (let-values (((id_37) id95_0))
+ (let-values (((id_39) id95_0))
(let-values (((orig-s_2) orig-s96_0))
(let-values (((as-protected?_0) as-protected?86_0))
(let-values (((as-transformer?_3) as-transformer?87_0))
- (let-values ()
- (begin
- (if (if as-protected?_0
- (not (eq? (module-binding-module immed-binding_0) (requires+provides-self r+p_17)))
- #f)
- (let-values ()
- (raise-syntax-error$1 #f "cannot protect required identifier in re-provide" sym_43))
- (void))
- (hash-update!
- (requires+provides-provides r+p_17)
- phase+space_5
- (lambda (at-phase_9)
- (let-values (((b/p_0) (hash-ref at-phase_9 sym_43 #f)))
- (let-values (((b_80) (provided-as-binding b/p_0)))
- (if (not b_80)
- (let-values ()
- (let-values (((plain-binding_0)
- (if (binding-free=id binding_12)
- (let-values (((binding171_0) binding_12) ((temp172_0) #f))
- (module-binding-update.1
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- temp172_0
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- unsafe-undefined
- binding171_0))
- binding_12)))
- (hash-set
- at-phase_9
- sym_43
- (if (let-values (((or-part_187) as-protected?_0))
- (if or-part_187 or-part_187 as-transformer?_3))
- (provided1.1 plain-binding_0 as-protected?_0 as-transformer?_3)
- plain-binding_0))))
- (if (same-binding? b_80 binding_12)
- (let-values () at-phase_9)
- (let-values ()
- (raise-syntax-error$1
- #f
- "identifier already provided (as a different binding)"
- orig-s_2
- id_37)))))))
- '#hasheq())))))))))))))))
- (define-values
- (extract-requires-and-provides)
- (lambda (r+p_18 old-self_0 new-self_1)
- (begin
- (let-values (((extract-requires_0)
- (lambda ()
- (begin
- 'extract-requires
- (let-values (((phase-to-mpis-in-order_0) (requires+provides-require-mpis-in-order r+p_18)))
- (let-values (((phases-in-order_1)
- (let-values (((temp173_0) (hash-keys phase-to-mpis-in-order_0))
- ((phase174_0) phase))
- (sort.1 #f #f temp173_0 phase174_0))))
- (reverse$1
- (let-values (((lst_153) phases-in-order_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_153)))
- ((letrec-values (((for-loop_189)
- (lambda (fold-var_176 lst_154)
- (begin
- 'for-loop
- (if (pair? lst_154)
- (let-values (((phase_69) (unsafe-car lst_154))
- ((rest_77) (unsafe-cdr lst_154)))
- (let-values (((fold-var_177)
- (let-values (((fold-var_58) fold-var_176))
- (let-values (((fold-var_59)
- (let-values ()
- (cons
- (let-values ()
- (cons
- phase_69
- (reverse$1
- (let-values (((lst_155)
- (reverse$1
- (hash-ref
- phase-to-mpis-in-order_0
- phase_69))))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_155)))
- ((letrec-values (((for-loop_190)
- (lambda (fold-var_178
- lst_156)
- (begin
- 'for-loop
- (if (pair?
- lst_156)
- (let-values (((mpi_44)
- (unsafe-car
- lst_156))
- ((rest_78)
- (unsafe-cdr
- lst_156)))
- (let-values (((fold-var_179)
- (let-values (((fold-var_62)
- fold-var_178))
- (if (eq?
- mpi_44
- old-self_0)
- fold-var_62
- (let-values (((fold-var_63)
- fold-var_62))
- (let-values (((fold-var_64)
- (let-values ()
- (cons
- (let-values ()
+ (begin
+ (if (if as-protected?_0
+ (not (eq? (module-binding-module immed-binding_0) (requires+provides-self r+p_19)))
+ #f)
+ (raise-syntax-error$1 #f "cannot protect required identifier in re-provide" sym_55)
+ (void))
+ (hash-update!
+ (requires+provides-provides r+p_19)
+ phase+space_6
+ (lambda (at-phase_8)
+ (let-values (((b/p_0) (hash-ref at-phase_8 sym_55 #f)))
+ (let-values (((b_102) (provided-as-binding b/p_0)))
+ (if (not b_102)
+ (let-values (((plain-binding_0)
+ (if (binding-free=id binding_13)
+ (let-values (((binding179_0) binding_13) ((temp180_1) #f))
+ (module-binding-update.1
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ temp180_1
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ unsafe-undefined
+ binding179_0))
+ binding_13)))
+ (hash-set
+ at-phase_8
+ sym_55
+ (if (let-values (((or-part_302) as-protected?_0))
+ (if or-part_302 or-part_302 as-transformer?_3))
+ (provided1.1 plain-binding_0 as-protected?_0 as-transformer?_3)
+ plain-binding_0)))
+ (if (same-binding? b_102 binding_13)
+ at-phase_8
+ (raise-syntax-error$1
+ #f
+ "identifier already provided (as a different binding)"
+ orig-s_2
+ id_39))))))
+ '#hasheq()))))))))))))))
+ (define-values
+ (extract-requires-and-provides.1)
+ (lambda (flatten-requires?98_0 namespace99_0 r+p102_0 old-self103_0 new-self104_0)
+ (begin
+ 'extract-requires-and-provides
+ (let-values (((r+p_20) r+p102_0))
+ (let-values (((old-self_0) old-self103_0))
+ (let-values (((new-self_1) new-self104_0))
+ (let-values (((flatten-requires?_0) flatten-requires?98_0))
+ (let-values (((ns_54) namespace99_0))
+ (let-values (((extract-requires_0)
+ (lambda (recurs?181_0)
+ (begin
+ 'extract-requires
+ (let-values (((recurs?_0) recurs?181_0))
+ (let-values (((phase-to-mpis-in-order_0)
+ (requires+provides-require-mpis-in-order r+p_20)))
+ (let-values (((phases-in-order_1)
+ (let-values (((temp184_0) (hash-keys phase-to-mpis-in-order_0))
+ ((phase185_0) phase))
+ (sort.1 #f #f temp184_0 phase185_0))))
+ (let-values (((transitive-requires_0)
+ (requires+provides-transitive-requires r+p_20)))
+ (reverse$1
+ (let-values (((fold-var_259)
+ (let-values (((fold-var_260) null)) fold-var_260)))
+ (let-values (((lst_215) phases-in-order_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_215))
+ ((letrec-values (((for-loop_235)
+ (lambda (fold-var_261 lst_216)
+ (begin
+ 'for-loop
+ (if (pair? lst_216)
+ (let-values (((phase_79) (unsafe-car lst_216))
+ ((rest_104) (unsafe-cdr lst_216)))
+ (let-values (((fold-var_262)
+ (let-values (((fold-var_263)
+ (cons
+ (let-values (((elems_0)
+ (reverse$1
+ (let-values (((fold-var_264)
+ (let-values (((fold-var_265)
+ null))
+ fold-var_265)))
+ (let-values (((lst_217)
+ (reverse$1
+ (hash-ref
+ phase-to-mpis-in-order_0
+ phase_79))))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_217))
+ ((letrec-values (((for-loop_236)
+ (lambda (fold-var_266
+ lst_218)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_218)
+ (let-values (((mpi_59)
+ (unsafe-car
+ lst_218))
+ ((rest_105)
+ (unsafe-cdr
+ lst_218)))
+ (let-values (((fold-var_267)
+ (if (eq?
+ mpi_59
+ old-self_0)
+ fold-var_266
+ (let-values (((fold-var_268)
+ (cons
+ (if recurs?_0
+ (not
+ (hash-ref
+ (hash-ref
+ transitive-requires_0
+ (module-path-index-resolved
+ mpi_59)
+ '#hasheqv())
+ phase_79
+ #f))
+ (module-path-index-shift
+ mpi_59
+ old-self_0
+ new-self_1))
+ fold-var_266)))
+ (values
+ fold-var_268)))))
+ (if (not
+ #f)
+ (for-loop_236
+ fold-var_267
+ rest_105)
+ fold-var_267)))
+ fold-var_266)))))
+ for-loop_236)
+ fold-var_264
+ lst_217)))))))
+ (if recurs?_0
+ elems_0
+ (cons
+ phase_79
+ elems_0)))
+ fold-var_261)))
+ (values fold-var_263))))
+ (if (not #f)
+ (for-loop_235 fold-var_262 rest_104)
+ fold-var_262)))
+ fold-var_261)))))
+ for-loop_235)
+ fold-var_259
+ lst_215)))))))))))))
+ (let-values ()
+ (let-values ()
+ (let-values (((extract-flattened-requires_0)
+ (lambda ()
+ (begin
+ 'extract-flattened-requires
+ (let-values (((phase-to-mpis-in-order_1)
+ (requires+provides-require-mpis-in-order r+p_20)))
+ (let-values (((phases-in-order_2)
+ (let-values (((temp186_0) (hash-keys phase-to-mpis-in-order_1))
+ ((phase187_0) phase))
+ (sort.1 #f #f temp186_0 phase187_0))))
+ (let-values (((name-to-phases_0 all-mpis_0)
+ (let-values (((name-to-phases_1)
+ (let-values (((name-to-phases_2) '#hasheq()))
+ name-to-phases_2))
+ ((all-mpis_1)
+ (let-values (((all-mpis_2) '())) all-mpis_2)))
+ (let-values (((lst_219) phases-in-order_2))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_219))
+ ((letrec-values (((for-loop_237)
+ (lambda (name-to-phases_3
+ all-mpis_3
+ lst_220)
+ (begin
+ 'for-loop
+ (if (pair? lst_220)
+ (let-values (((phase_80)
+ (unsafe-car
+ lst_220))
+ ((rest_106)
+ (unsafe-cdr
+ lst_220)))
+ (let-values (((name-to-phases_4
+ all-mpis_4)
+ (let-values (((lst_221)
+ (reverse$1
+ (hash-ref
+ phase-to-mpis-in-order_1
+ phase_80))))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_221))
+ ((letrec-values (((for-loop_238)
+ (lambda (name-to-phases_5
+ all-mpis_5
+ lst_222)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_222)
+ (let-values (((mpi_60)
+ (unsafe-car
+ lst_222))
+ ((rest_107)
+ (unsafe-cdr
+ lst_222)))
+ (let-values (((name-to-phases_6
+ all-mpis_6)
+ (if (eq?
+ mpi_60
+ old-self_0)
+ (values
+ name-to-phases_5
+ all-mpis_5)
+ (let-values (((name-to-phases_7
+ all-mpis_7)
+ ((letrec-values (((loop_94)
+ (lambda (name-to-phases_8
+ all-mpis_8
+ mpi_61
+ phase_81)
+ (begin
+ 'loop
+ (let-values (((name_50)
+ (1/module-path-index-resolve
+ mpi_61)))
+ (let-values (((at-name_2)
+ (hash-ref
+ name-to-phases_8
+ name_50
+ '#hasheq())))
+ (if (hash-ref
+ at-name_2
+ phase_81
+ #f)
+ (values
+ name-to-phases_8
+ all-mpis_8)
+ (let-values (((done-name-to-phases_0)
+ (hash-set
+ name-to-phases_8
+ name_50
+ (hash-set
+ at-name_2
+ phase_81
+ #t))))
+ (let-values (((add_3)
+ (lambda (mpi_62
+ all-mpis_9)
+ (begin
+ 'add
+ (if (hash-ref
+ name-to-phases_8
+ name_50
+ #f)
+ all-mpis_9
+ (cons
+ (cons
+ name_50
+ mpi_62)
+ all-mpis_9))))))
+ (let-values (((m_20)
+ (namespace->module
+ ns_54
+ name_50)))
+ (begin
+ (if m_20
+ (void)
+ (raise-arguments-error
+ 'module
+ "cannot find module while flattening requires"
+ "module"
+ name_50))
+ (if (if (module-cross-phase-persistent?
+ m_20)
+ (if (not
+ (eqv?
+ phase_81
+ 0))
+ (not
+ (label-phase?
+ phase_81))
+ #f)
+ #f)
+ (loop_94
+ name-to-phases_8
+ all-mpis_8
+ mpi_61
+ 0)
+ (let-values (((new-name-to-phases_0
+ new-all-mpis_0)
+ (let-values (((name-to-phases_9)
+ (let-values (((name-to-phases_10)
+ done-name-to-phases_0))
+ name-to-phases_10))
+ ((all-mpis_10)
+ (let-values (((all-mpis_11)
+ all-mpis_8))
+ all-mpis_11)))
+ (let-values (((lst_223)
+ (module-requires
+ m_20))
+ ((lst_224)
+ (module-recur-requires
+ m_20)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_223))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_224))
+ ((letrec-values (((for-loop_239)
+ (lambda (name-to-phases_11
+ all-mpis_12
+ lst_225
+ lst_226)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_225)
+ (pair?
+ lst_226)
+ #f)
+ (let-values (((phase+reqs_0)
+ (unsafe-car
+ lst_225))
+ ((rest_108)
+ (unsafe-cdr
+ lst_225))
+ ((recurs_2)
+ (unsafe-car
+ lst_226))
+ ((rest_109)
+ (unsafe-cdr
+ lst_226)))
+ (let-values (((name-to-phases_12
+ all-mpis_13)
+ (let-values (((new-phase_0)
+ (phase+
+ (car
+ phase+reqs_0)
+ phase_81)))
+ (let-values (((lst_227)
+ (cdr
+ phase+reqs_0))
+ ((lst_228)
+ recurs_2))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_227))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_228))
+ ((letrec-values (((for-loop_240)
+ (lambda (name-to-phases_13
+ all-mpis_14
+ lst_229
+ lst_230)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_229)
+ (pair?
+ lst_230)
+ #f)
+ (let-values (((req_0)
+ (unsafe-car
+ lst_229))
+ ((rest_110)
+ (unsafe-cdr
+ lst_229))
+ ((recur_2)
+ (unsafe-car
+ lst_230))
+ ((rest_111)
+ (unsafe-cdr
+ lst_230)))
+ (let-values (((name-to-phases_14
+ all-mpis_15)
+ (if recur_2
+ (let-values (((name-to-phases_15
+ all-mpis_16)
+ (loop_94
+ name-to-phases_13
+ all-mpis_14
+ (module-path-index-shift
+ req_0
+ (module-self
+ m_20)
+ mpi_61)
+ new-phase_0)))
+ (values
+ name-to-phases_15
+ all-mpis_16))
+ (values
+ name-to-phases_13
+ all-mpis_14))))
+ (if (not
+ #f)
+ (for-loop_240
+ name-to-phases_14
+ all-mpis_15
+ rest_110
+ rest_111)
+ (values
+ name-to-phases_14
+ all-mpis_15))))
+ (values
+ name-to-phases_13
+ all-mpis_14))))))
+ for-loop_240)
+ name-to-phases_11
+ all-mpis_12
+ lst_227
+ lst_228))))))
+ (if (not
+ #f)
+ (for-loop_239
+ name-to-phases_12
+ all-mpis_13
+ rest_108
+ rest_109)
+ (values
+ name-to-phases_12
+ all-mpis_13))))
+ (values
+ name-to-phases_11
+ all-mpis_12))))))
+ for-loop_239)
+ name-to-phases_9
+ all-mpis_10
+ lst_223
+ lst_224))))))
+ (values
+ new-name-to-phases_0
+ (add_3
+ mpi_61
+ new-all-mpis_0)))))))))))))))
+ loop_94)
+ name-to-phases_5
+ all-mpis_5
(module-path-index-shift
- mpi_44
+ mpi_60
old-self_0
- new-self_1))
- fold-var_63))))
- (values
- fold-var_64)))))))
- (if (not
- #f)
- (for-loop_190
- fold-var_179
- rest_78)
- fold-var_179)))
- fold-var_178)))))
- for-loop_190)
- null
- lst_155))))))
- fold-var_58))))
- (values fold-var_59)))))
- (if (not #f)
- (for-loop_189 fold-var_177 rest_77)
- fold-var_177)))
- fold-var_176)))))
- for-loop_189)
- null
- lst_153))))))))))
- (let-values (((extract-provides_0)
- (lambda ()
- (begin
- 'extract-provides
- (shift-provides-module-path-index
- (requires+provides-provides r+p_18)
- old-self_0
- new-self_1)))))
- (values (extract-requires_0) (extract-provides_0)))))))
+ new-self_1)
+ phase_80)))
+ (values
+ name-to-phases_7
+ all-mpis_7)))))
+ (if (not
+ #f)
+ (for-loop_238
+ name-to-phases_6
+ all-mpis_6
+ rest_107)
+ (values
+ name-to-phases_6
+ all-mpis_6))))
+ (values
+ name-to-phases_5
+ all-mpis_5))))))
+ for-loop_238)
+ name-to-phases_3
+ all-mpis_3
+ lst_221)))))
+ (if (not #f)
+ (for-loop_237
+ name-to-phases_4
+ all-mpis_4
+ rest_106)
+ (values
+ name-to-phases_4
+ all-mpis_4))))
+ (values
+ name-to-phases_3
+ all-mpis_3))))))
+ for-loop_237)
+ name-to-phases_1
+ all-mpis_1
+ lst_219))))))
+ (let-values (((interned_0) (make-hash)))
+ (let-values (((intern-phases_0)
+ (lambda (phases_11)
+ (begin
+ 'intern-phases
+ (let-values (((or-part_303)
+ (hash-ref interned_0 phases_11 #f)))
+ (if or-part_303
+ or-part_303
+ (let-values (((lst_231) (hash-keys phases_11 #t)))
+ (begin
+ (hash-set! interned_0 phases_11 lst_231)
+ lst_231))))))))
+ (reverse$1
+ (let-values (((fold-var_269)
+ (let-values (((fold-var_270) null)) fold-var_270)))
+ (let-values (((lst_232) (reverse$1 all-mpis_0)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_232))
+ ((letrec-values (((for-loop_241)
+ (lambda (fold-var_271 lst_233)
+ (begin
+ 'for-loop
+ (if (pair? lst_233)
+ (let-values (((name+mpi_0)
+ (unsafe-car lst_233))
+ ((rest_112)
+ (unsafe-cdr lst_233)))
+ (let-values (((fold-var_272)
+ (let-values (((fold-var_273)
+ (cons
+ (let-values (((name_51)
+ (car
+ name+mpi_0)))
+ (let-values (((mpi_63)
+ (cdr
+ name+mpi_0)))
+ (vector-immutable
+ mpi_63
+ (intern-phases_0
+ (hash-ref
+ name-to-phases_0
+ name_51)))))
+ fold-var_271)))
+ (values
+ fold-var_273))))
+ (if (not #f)
+ (for-loop_241
+ fold-var_272
+ rest_112)
+ fold-var_272)))
+ fold-var_271)))))
+ for-loop_241)
+ fold-var_269
+ lst_232))))))))))))))
+ (let-values (((extract-provides_0)
+ (lambda ()
+ (begin
+ 'extract-provides
+ (shift-provides-module-path-index
+ (requires+provides-provides r+p_20)
+ old-self_0
+ new-self_1)))))
+ (values
+ (extract-requires_0 #f)
+ (let-values (((temp188_0) #t)) (extract-requires_0 temp188_0))
+ (if flatten-requires?_0 (extract-flattened-requires_0) #f)
+ (extract-provides_0)))))))))))))))
(define-values
(shift-provides-module-path-index)
- (lambda (provides_8 from-mpi_7 to-mpi_6)
+ (lambda (provides_9 from-mpi_9 to-mpi_8)
(begin
- (let-values (((ht_114) provides_8))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-in-hash ht_114)))
- ((letrec-values (((for-loop_191)
- (lambda (table_132 i_157)
- (begin
- 'for-loop
- (if i_157
- (let-values (((phase+space_6 at-phase_10) (hash-iterate-key+value ht_114 i_157)))
- (let-values (((table_107)
- (let-values (((table_108) table_132))
- (let-values (((table_133)
- (let-values ()
- (let-values (((key_55 val_40)
- (let-values ()
- (values
- phase+space_6
- (let-values (((ht_115)
- at-phase_10))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash ht_115)))
- ((letrec-values (((for-loop_192)
- (lambda (table_134
- i_158)
- (begin
- 'for-loop
- (if i_158
- (let-values (((sym_44
- binding_13)
- (hash-iterate-key+value
- ht_115
- i_158)))
- (let-values (((table_111)
- (let-values (((table_112)
- table_134))
- (let-values (((table_135)
- (let-values ()
- (let-values (((key_56
- val_41)
- (let-values ()
- (values
- sym_44
- (if (eq?
- from-mpi_7
- to-mpi_6)
- (let-values ()
- binding_13)
- (let-values ()
- ((letrec-values (((loop_87)
- (lambda (binding_14)
- (begin
- 'loop
- (if (provided?
- binding_14)
- (let-values ()
- (provided1.1
- (loop_87
- (provided-binding
- binding_14))
- (provided-protected?
- binding_14)
- (provided-syntax?
- binding_14)))
- (let-values ()
- (binding-module-path-index-shift
- binding_14
- from-mpi_7
- to-mpi_6)))))))
- loop_87)
- binding_13)))))))
- (hash-set
- table_112
- key_56
- val_41)))))
- (values
- table_135)))))
- (if (not
- #f)
- (for-loop_192
- table_111
- (hash-iterate-next
- ht_115
- i_158))
- table_111)))
- table_134)))))
- for-loop_192)
- '#hasheq()
- (hash-iterate-first
- ht_115))))))))
- (hash-set table_108 key_55 val_40)))))
- (values table_133)))))
- (if (not #f)
- (for-loop_191 table_107 (hash-iterate-next ht_114 i_157))
- table_107)))
- table_132)))))
- for-loop_191)
- '#hasheqv()
- (hash-iterate-first ht_114)))))))
+ (let-values (((table_155) (let-values (((table_156) '#hasheqv())) table_156)))
+ (let-values (((ht_138) provides_9))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_138))
+ ((letrec-values (((for-loop_242)
+ (lambda (table_157 i_215)
+ (begin
+ 'for-loop
+ (if i_215
+ (let-values (((phase+space_7 at-phase_9) (hash-iterate-key+value ht_138 i_215)))
+ (let-values (((table_158)
+ (let-values (((table_159)
+ (let-values (((key_58 val_42)
+ (values
+ phase+space_7
+ (let-values (((table_160)
+ (let-values (((table_161)
+ '#hasheq()))
+ table_161)))
+ (let-values (((ht_139) at-phase_9))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash ht_139))
+ ((letrec-values (((for-loop_243)
+ (lambda (table_162
+ i_216)
+ (begin
+ 'for-loop
+ (if i_216
+ (let-values (((sym_56
+ binding_14)
+ (hash-iterate-key+value
+ ht_139
+ i_216)))
+ (let-values (((table_163)
+ (let-values (((table_164)
+ (let-values (((key_59
+ val_43)
+ (values
+ sym_56
+ (if (eq?
+ from-mpi_9
+ to-mpi_8)
+ binding_14
+ ((letrec-values (((loop_95)
+ (lambda (binding_15)
+ (begin
+ 'loop
+ (if (provided?
+ binding_15)
+ (provided1.1
+ (loop_95
+ (provided-binding
+ binding_15))
+ (provided-protected?
+ binding_15)
+ (provided-syntax?
+ binding_15))
+ (binding-module-path-index-shift
+ binding_15
+ from-mpi_9
+ to-mpi_8))))))
+ loop_95)
+ binding_14)))))
+ (hash-set
+ table_162
+ key_59
+ val_43))))
+ (values
+ table_164))))
+ (if (not
+ #f)
+ (for-loop_243
+ table_163
+ (hash-iterate-next
+ ht_139
+ i_216))
+ table_163)))
+ table_162)))))
+ for-loop_243)
+ table_160
+ (hash-iterate-first
+ ht_139))))))))
+ (hash-set table_157 key_58 val_42))))
+ (values table_159))))
+ (if (not #f)
+ (for-loop_242 table_158 (hash-iterate-next ht_138 i_215))
+ table_158)))
+ table_157)))))
+ for-loop_242)
+ table_155
+ (hash-iterate-first ht_138))))))))
(define-values
(struct:adjust-only adjust-only1.1 adjust-only? adjust-only-syms)
- (let-values (((struct:_57 make-_57 ?_57 -ref_57 -set!_57)
- (let-values ()
- (let-values ()
- (make-struct-type 'adjust-only #f 1 0 #f null (current-inspector) #f '(0) #f 'adjust-only)))))
- (values struct:_57 make-_57 ?_57 (make-struct-field-accessor -ref_57 0 'syms))))
+ (let-values (((struct:_88 make-_88 ?_88 -ref_88 -set!_88)
+ (make-struct-type 'adjust-only #f 1 0 #f null (current-inspector) #f '(0) #f 'adjust-only)))
+ (values struct:_88 make-_88 ?_88 (make-struct-field-accessor -ref_88 0 'syms))))
(define-values
(struct:adjust-prefix adjust-prefix2.1 adjust-prefix? adjust-prefix-sym)
- (let-values (((struct:_58 make-_58 ?_58 -ref_58 -set!_58)
- (let-values ()
- (let-values ()
- (make-struct-type 'adjust-prefix #f 1 0 #f null (current-inspector) #f '(0) #f 'adjust-prefix)))))
- (values struct:_58 make-_58 ?_58 (make-struct-field-accessor -ref_58 0 'sym))))
+ (let-values (((struct:_89 make-_89 ?_89 -ref_89 -set!_89)
+ (make-struct-type 'adjust-prefix #f 1 0 #f null (current-inspector) #f '(0) #f 'adjust-prefix)))
+ (values struct:_89 make-_89 ?_89 (make-struct-field-accessor -ref_89 0 'sym))))
(define-values
(struct:adjust-all-except adjust-all-except3.1 adjust-all-except? adjust-all-except-prefix-sym adjust-all-except-syms)
- (let-values (((struct:_59 make-_59 ?_59 -ref_59 -set!_59)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'adjust-all-except
- #f
- 2
- 0
- #f
- null
- (current-inspector)
- #f
- '(0 1)
- #f
- 'adjust-all-except)))))
+ (let-values (((struct:_90 make-_90 ?_90 -ref_90 -set!_90)
+ (make-struct-type
+ 'adjust-all-except
+ #f
+ 2
+ 0
+ #f
+ null
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'adjust-all-except)))
(values
- struct:_59
- make-_59
- ?_59
- (make-struct-field-accessor -ref_59 0 'prefix-sym)
- (make-struct-field-accessor -ref_59 1 'syms))))
+ struct:_90
+ make-_90
+ ?_90
+ (make-struct-field-accessor -ref_90 0 'prefix-sym)
+ (make-struct-field-accessor -ref_90 1 'syms))))
(define-values
(struct:adjust-rename adjust-rename4.1 adjust-rename? adjust-rename-to-id adjust-rename-from-sym)
- (let-values (((struct:_60 make-_60 ?_60 -ref_60 -set!_60)
- (let-values ()
- (let-values ()
- (make-struct-type 'adjust-rename #f 2 0 #f null (current-inspector) #f '(0 1) #f 'adjust-rename)))))
+ (let-values (((struct:_91 make-_91 ?_91 -ref_91 -set!_91)
+ (make-struct-type 'adjust-rename #f 2 0 #f null (current-inspector) #f '(0 1) #f 'adjust-rename)))
(values
- struct:_60
- make-_60
- ?_60
- (make-struct-field-accessor -ref_60 0 'to-id)
- (make-struct-field-accessor -ref_60 1 'from-sym))))
+ struct:_91
+ make-_91
+ ?_91
+ (make-struct-field-accessor -ref_91 0 'to-id)
+ (make-struct-field-accessor -ref_91 1 'from-sym))))
(define-values (layers$1) '(raw phaseless spaceless justspaceless path))
(define-values
(parse-and-perform-requires!.1)
@@ -27571,10 +27885,10 @@
(let-values (((reqs_0) reqs29_0))
(let-values (((orig-s_3) orig-s30_0))
(let-values (((m-ns_9) m-ns31_0))
- (let-values (((phase-shift_6) phase-shift32_0))
+ (let-values (((phase-shift_7) phase-shift32_0))
(let-values (((requires+provides_1) requires+provides33_0))
- (let-values (((self_12) self5_0))
- (let-values (((run-phase_5)
+ (let-values (((self_14) self5_0))
+ (let-values (((run-phase_6)
(if (eq? run-phase6_0 unsafe-undefined) (namespace-phase m-ns_9) run-phase6_0)))
(let-values (((run?_1) run?7_0))
(let-values (((visit?_1) visit?8_0))
@@ -27585,2182 +27899,2132 @@
(let-values (((initial-require?_0) initial-require?13_0))
(let-values (((add-defined-portal_0) add-defined-portal14_0))
(let-values (((all-scopes-stx_3) all-scopes-stx15_0))
- (let-values (((who_14) who16_0))
- (let-values ()
- ((letrec-values (((loop_88)
- (lambda (reqs_1
- top-req_0
- phase-shift_7
- space-level_1
- just-meta_0
- just-space_0
- adjust_0
- for-meta-ok?_0
- just-meta-ok?_0
- layer_5)
+ (let-values (((who_22) who16_0))
+ ((letrec-values (((loop_96)
+ (lambda (reqs_1
+ top-req_0
+ phase-shift_8
+ space-level_1
+ just-meta_0
+ just-space_0
+ adjust_0
+ for-meta-ok?_0
+ just-meta-ok?_0
+ layer_5)
+ (begin
+ 'loop
(begin
- 'loop
- (begin
- (let-values (((lst_157) reqs_1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_157)))
- ((letrec-values (((for-loop_193)
- (lambda (lst_68)
- (begin
- 'for-loop
- (if (pair? lst_68)
- (let-values (((req_0)
- (unsafe-car
- lst_68))
- ((rest_31)
- (unsafe-cdr
- lst_68)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((check-nested_0)
- (let-values (((check-nested_1)
- (lambda (want-layer132_0
- ok?131_0)
- (begin
- 'check-nested
- (let-values (((want-layer_0)
- want-layer132_0))
- (let-values (((ok?_0)
- ok?131_0))
- (let-values ()
- (if (if ok?_0
- (member
- want-layer_0
- (member
- layer_5
- layers$1))
- #f)
- (void)
- (let-values ()
- (raise-syntax-error$1
- #f
- "invalid nesting"
- orig-s_3
- req_0))))))))))
- (case-lambda
- ((want-layer_1)
- (begin
- 'check-nested
- (check-nested_1
- want-layer_1
- #t)))
- ((want-layer_2
- ok?131_1)
- (check-nested_1
- want-layer_2
- ok?131_1))))))
- (let-values (((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)))
- (let-values (((tmp_24)
- fm_0))
- (let-values (((index_2)
- (if (symbol?
- tmp_24)
- (hash-ref
- '#hasheq((all-except
- .
- 11)
- (for-label
- .
- 4)
- (for-meta
- .
- 1)
- (for-space
- .
- 7)
- (for-syntax
- .
- 2)
- (for-template
- .
- 3)
- (just-meta
- .
- 5)
- (just-space
- .
- 8)
- (only
- .
- 9)
- (portal
- .
- 6)
- (prefix
- .
- 10)
- (prefix-all-except
- .
- 12)
- (rename .
- 13))
- tmp_24
- (lambda ()
- 0))
- 0)))
- (if (unsafe-fx<
- index_2
- 6)
- (if (unsafe-fx<
- index_2
- 2)
- (if (unsafe-fx<
- index_2
- 1)
- (let-values ()
- (let-values (((maybe-mp_0)
- (syntax->datum$1
- req_0)))
- (let-values ((()
- (begin
- (if (let-values (((or-part_188)
- (1/module-path?
- maybe-mp_0)))
- (if or-part_188
- or-part_188
- (1/resolved-module-path?
- maybe-mp_0)))
- (void)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad require spec"
- orig-s_3
- req_0)))
- (values))))
- (let-values ((()
- (begin
- (if (if (requires+provides-all-bindings-simple?
- requires+provides_1)
- (let-values (((or-part_189)
- adjust_0))
- (if or-part_189
- or-part_189
- (let-values (((or-part_190)
- (not
- (eq?
- just-meta_0
- 'all))))
- (if or-part_190
- or-part_190
- (let-values (((or-part_191)
- (not
- (eq?
- space-level_1
- '#:none))))
- (if or-part_191
- or-part_191
- (if all-scopes-stx_3
- (not
- (same-scopes?
- req_0
- all-scopes-stx_3))
- #f)))))))
- #f)
- (let-values ()
- (set-requires+provides-all-bindings-simple?!
- requires+provides_1
- #f))
- (void))
- (values))))
- (let-values (((mp_0)
- (if (1/resolved-module-path?
- maybe-mp_0)
- (resolved-module-path->module-path
- maybe-mp_0)
- maybe-mp_0)))
- (let-values (((mpi_45)
- (let-values (((mp152_0)
- mp_0)
- ((self153_0)
- self_12)
- ((declared-submodule-names154_0)
- declared-submodule-names_2))
- (module-path->mpi.1
- declared-submodule-names154_0
- mp152_0
- self153_0))))
- (begin
- (let-values (((mpi133_0)
- mpi_45)
- ((req134_0)
- req_0)
- ((self135_0)
- self_12)
- ((temp136_0)
- (let-values (((or-part_48)
- req_0))
- (if or-part_48
- or-part_48
- top-req_0)))
- ((m-ns137_0)
- m-ns_9)
- ((phase-shift138_0)
- phase-shift_7)
- ((space-level139_0)
- space-level_1)
- ((run-phase140_0)
- run-phase_5)
- ((just-meta141_0)
- just-meta_0)
- ((just-space142_0)
- just-space_0)
- ((adjust143_0)
- adjust_0)
- ((requires+provides144_0)
- requires+provides_1)
- ((run?145_0)
- run?_1)
- ((visit?146_0)
- visit?_1)
- ((copy-variable-phase-level147_0)
- copy-variable-phase-level_0)
- ((copy-variable-as-constant?148_0)
- copy-variable-as-constant?_0)
- ((skip-variable-phase-level149_0)
- skip-variable-phase-level_0)
- ((initial-require?150_0)
- initial-require?_0)
- ((who151_0)
- who_14))
- (perform-require!.1
- adjust143_0
- #t
+ (let-values (((lst_234) reqs_1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_234))
+ ((letrec-values (((for-loop_244)
+ (lambda (lst_235)
+ (begin
+ 'for-loop
+ (if (pair? lst_235)
+ (let-values (((req_1)
+ (unsafe-car
+ lst_235))
+ ((rest_113)
+ (unsafe-cdr
+ lst_235)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((check-nested_0)
+ (let-values (((check-nested_1)
+ (lambda (want-layer132_0
+ ok?131_0)
+ (begin
+ 'check-nested
+ (let-values (((want-layer_0)
+ want-layer132_0))
+ (let-values (((ok?_0)
+ ok?131_0))
+ (if (if ok?_0
+ (member
+ want-layer_0
+ (member
+ layer_5
+ layers$1))
+ #f)
+ (void)
+ (raise-syntax-error$1
#f
- copy-variable-as-constant?148_0
- copy-variable-phase-level147_0
- initial-require?150_0
- just-meta141_0
- just-space142_0
- phase-shift138_0
- requires+provides144_0
- run-phase140_0
- run?145_0
- skip-variable-phase-level149_0
- space-level139_0
- visit?146_0
- who151_0
- mpi133_0
- req134_0
- self135_0
- temp136_0
- m-ns137_0))
- (set! initial-require?_0
- #f))))))))
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'raw
- for-meta-ok?_0)
- (values))))
- (let-values (((ok?_1
- for-meta155_0
- phase-level156_0
- spec157_0)
- (let-values (((s_201)
- req_0))
- (let-values (((orig-s_4)
- s_201))
- (let-values (((for-meta155_1
- phase-level156_1
- spec157_1)
- (let-values (((s_202)
- (if (syntax?$1
- s_201)
- (syntax-e$1
- s_201)
- s_201)))
- (if (pair?
- s_202)
- (let-values (((for-meta158_0)
- (let-values (((s_40)
- (car
- s_202)))
- s_40))
- ((phase-level159_0
- spec160_0)
- (let-values (((s_203)
- (cdr
- s_202)))
- (let-values (((s_66)
- (if (syntax?$1
- s_203)
- (syntax-e$1
- s_203)
- s_203)))
- (if (pair?
- s_66)
- (let-values (((phase-level161_0)
- (let-values (((s_204)
- (car
- s_66)))
- s_204))
- ((spec162_0)
- (let-values (((s_67)
- (cdr
- s_66)))
- (let-values (((s_103)
- (if (syntax?$1
- s_67)
- (syntax-e$1
- s_67)
- s_67)))
- (let-values (((flat-s_0)
- (to-syntax-list.1
- s_103)))
- (if (not
- flat-s_0)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_4))
- (let-values ()
- flat-s_0)))))))
- (values
- phase-level161_0
- spec162_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_4))))))
- (values
- for-meta158_0
- phase-level159_0
- spec160_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_4)))))
- (values
- #t
- for-meta155_1
- phase-level156_1
- spec157_1))))))
- (let-values (((p_29)
- (syntax-e$1
- phase-level156_0)))
+ "invalid nesting"
+ orig-s_3
+ req_1))))))))
+ (case-lambda
+ ((want-layer_1)
+ (begin
+ 'check-nested
+ (check-nested_1
+ want-layer_1
+ #t)))
+ ((want-layer_2
+ ok?131_1)
+ (check-nested_1
+ want-layer_2
+ ok?131_1))))))
+ (let-values (((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)))
+ (let-values (((tmp_25)
+ fm_0))
+ (let-values (((index_2)
+ (if (symbol?
+ tmp_25)
+ (hash-ref
+ '#hasheq((all-except
+ .
+ 11)
+ (for-label
+ .
+ 4)
+ (for-meta
+ .
+ 1)
+ (for-space
+ .
+ 7)
+ (for-syntax
+ .
+ 2)
+ (for-template
+ .
+ 3)
+ (just-meta
+ .
+ 5)
+ (just-space
+ .
+ 8)
+ (only
+ .
+ 9)
+ (portal
+ .
+ 6)
+ (prefix
+ .
+ 10)
+ (prefix-all-except
+ .
+ 12)
+ (rename .
+ 13))
+ tmp_25
+ (lambda ()
+ 0))
+ 0)))
+ (if (unsafe-fx<
+ index_2
+ 6)
+ (if (unsafe-fx<
+ index_2
+ 2)
+ (if (unsafe-fx<
+ index_2
+ 1)
+ (let-values (((maybe-mp_0)
+ (syntax->datum$1
+ req_1)))
+ (let-values ((()
(begin
- (if (phase?
- p_29)
+ (if (let-values (((or-part_304)
+ (1/module-path?
+ maybe-mp_0)))
+ (if or-part_304
+ or-part_304
+ (1/resolved-module-path?
+ maybe-mp_0)))
(void)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad phase"
- orig-s_3
- req_0)))
- (loop_88
- spec157_0
- (let-values (((or-part_95)
- top-req_0))
- (if or-part_95
- or-part_95
- req_0))
- (phase+
- phase-shift_7
- p_29)
- space-level_1
- just-meta_0
- just-space_0
- adjust_0
- #f
- just-meta-ok?_0
- 'raw)))))))
- (if (unsafe-fx<
- index_2
- 3)
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'raw
- for-meta-ok?_0)
- (values))))
- (let-values (((ok?_2
- for-syntax163_0
- spec164_0)
- (let-values (((s_205)
- req_0))
- (let-values (((orig-s_5)
- s_205))
- (let-values (((for-syntax163_1
- spec164_1)
- (let-values (((s_93)
- (if (syntax?$1
- s_205)
- (syntax-e$1
- s_205)
- s_205)))
- (if (pair?
- s_93)
- (let-values (((for-syntax165_0)
- (let-values (((s_70)
- (car
- s_93)))
- s_70))
- ((spec166_0)
- (let-values (((s_206)
- (cdr
- s_93)))
- (let-values (((s_207)
- (if (syntax?$1
- s_206)
- (syntax-e$1
- s_206)
- s_206)))
- (let-values (((flat-s_1)
- (to-syntax-list.1
- s_207)))
- (if (not
- flat-s_1)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_5))
- (let-values ()
- flat-s_1)))))))
- (values
- for-syntax165_0
- spec166_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_5)))))
- (values
- #t
- for-syntax163_1
- spec164_1))))))
- (loop_88
- spec164_0
- (let-values (((or-part_192)
- top-req_0))
- (if or-part_192
- or-part_192
- req_0))
- (phase+
- phase-shift_7
- 1)
- space-level_1
- just-meta_0
- just-space_0
- adjust_0
+ (raise-syntax-error$1
+ #f
+ "bad require spec"
+ orig-s_3
+ req_1))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (if (requires+provides-all-bindings-simple?
+ requires+provides_1)
+ (let-values (((or-part_305)
+ adjust_0))
+ (if or-part_305
+ or-part_305
+ (let-values (((or-part_306)
+ (not
+ (eq?
+ just-meta_0
+ 'all))))
+ (if or-part_306
+ or-part_306
+ (let-values (((or-part_307)
+ (not
+ (eq?
+ space-level_1
+ '#:none))))
+ (if or-part_307
+ or-part_307
+ (if all-scopes-stx_3
+ (not
+ (same-scopes?
+ req_1
+ all-scopes-stx_3))
+ #f)))))))
+ #f)
+ (set-requires+provides-all-bindings-simple?!
+ requires+provides_1
+ #f)
+ (void))
+ (values))))
+ (let-values (((mp_1)
+ (if (1/resolved-module-path?
+ maybe-mp_0)
+ (resolved-module-path->module-path
+ maybe-mp_0)
+ maybe-mp_0)))
+ (let-values (((mpi_64)
+ (let-values (((mp152_0)
+ mp_1)
+ ((self153_0)
+ self_14)
+ ((declared-submodule-names154_0)
+ declared-submodule-names_2))
+ (module-path->mpi.1
+ declared-submodule-names154_0
+ mp152_0
+ self153_0))))
+ (begin
+ (let-values (((mpi133_0)
+ mpi_64)
+ ((req134_0)
+ req_1)
+ ((self135_0)
+ self_14)
+ ((temp136_1)
+ (let-values (((or-part_308)
+ req_1))
+ (if or-part_308
+ or-part_308
+ top-req_0)))
+ ((m-ns137_0)
+ m-ns_9)
+ ((phase-shift138_0)
+ phase-shift_8)
+ ((space-level139_0)
+ space-level_1)
+ ((run-phase140_2)
+ run-phase_6)
+ ((just-meta141_0)
+ just-meta_0)
+ ((just-space142_0)
+ just-space_0)
+ ((adjust143_0)
+ adjust_0)
+ ((requires+provides144_0)
+ requires+provides_1)
+ ((run?145_0)
+ run?_1)
+ ((visit?146_0)
+ visit?_1)
+ ((copy-variable-phase-level147_0)
+ copy-variable-phase-level_0)
+ ((copy-variable-as-constant?148_0)
+ copy-variable-as-constant?_0)
+ ((skip-variable-phase-level149_0)
+ skip-variable-phase-level_0)
+ ((initial-require?150_0)
+ initial-require?_0)
+ ((who151_0)
+ who_22))
+ (perform-require!.1
+ adjust143_0
+ #t
#f
- just-meta-ok?_0
- 'raw))))
- (if (unsafe-fx<
- index_2
- 4)
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'raw
- for-meta-ok?_0)
- (values))))
- (let-values (((ok?_3
- for-template167_0
- spec168_0)
- (let-values (((s_74)
- req_0))
- (let-values (((orig-s_6)
- s_74))
- (let-values (((for-template167_1
- spec168_1)
- (let-values (((s_208)
- (if (syntax?$1
- s_74)
- (syntax-e$1
- s_74)
- s_74)))
- (if (pair?
- s_208)
- (let-values (((for-template169_0)
- (let-values (((s_106)
- (car
- s_208)))
- s_106))
- ((spec170_0)
- (let-values (((s_209)
- (cdr
- s_208)))
- (let-values (((s_76)
- (if (syntax?$1
- s_209)
- (syntax-e$1
- s_209)
- s_209)))
- (let-values (((flat-s_2)
- (to-syntax-list.1
- s_76)))
- (if (not
- flat-s_2)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_6))
- (let-values ()
- flat-s_2)))))))
- (values
- for-template169_0
- spec170_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_6)))))
- (values
- #t
- for-template167_1
- spec168_1))))))
- (loop_88
- spec168_0
- (let-values (((or-part_193)
- top-req_0))
- (if or-part_193
- or-part_193
- req_0))
- (phase+
- phase-shift_7
- -1)
- space-level_1
- just-meta_0
- just-space_0
- adjust_0
- #f
- just-meta-ok?_0
- 'raw))))
- (if (unsafe-fx<
- index_2
- 5)
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'raw
- for-meta-ok?_0)
- (values))))
- (let-values (((ok?_4
- for-label171_0
- spec172_0)
- (let-values (((s_210)
- req_0))
- (let-values (((orig-s_7)
- s_210))
- (let-values (((for-label171_1
- spec172_1)
- (let-values (((s_211)
- (if (syntax?$1
- s_210)
- (syntax-e$1
- s_210)
- s_210)))
- (if (pair?
- s_211)
- (let-values (((for-label173_0)
- (let-values (((s_212)
- (car
- s_211)))
- s_212))
- ((spec174_0)
- (let-values (((s_213)
- (cdr
- s_211)))
- (let-values (((s_46)
- (if (syntax?$1
- s_213)
- (syntax-e$1
- s_213)
- s_213)))
- (let-values (((flat-s_3)
- (to-syntax-list.1
- s_46)))
- (if (not
- flat-s_3)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_7))
- (let-values ()
- flat-s_3)))))))
- (values
- for-label173_0
- spec174_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_7)))))
- (values
- #t
- for-label171_1
- spec172_1))))))
- (loop_88
- spec172_0
- (let-values (((or-part_70)
- top-req_0))
- (if or-part_70
- or-part_70
- req_0))
- (phase+
- phase-shift_7
- #f)
- space-level_1
- just-meta_0
- just-space_0
- adjust_0
- #f
- just-meta-ok?_0
- 'raw))))
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'raw
- just-meta-ok?_0)
- (values))))
- (let-values (((ok?_5
- just-meta175_0
- phase-level176_0
- spec177_0)
- (let-values (((s_115)
- req_0))
- (let-values (((orig-s_8)
- s_115))
- (let-values (((just-meta175_1
- phase-level176_1
- spec177_1)
- (let-values (((s_214)
- (if (syntax?$1
- s_115)
- (syntax-e$1
- s_115)
- s_115)))
- (if (pair?
- s_214)
- (let-values (((just-meta178_0)
- (let-values (((s_215)
- (car
- s_214)))
- s_215))
- ((phase-level179_0
- spec180_0)
- (let-values (((s_216)
- (cdr
- s_214)))
- (let-values (((s_217)
- (if (syntax?$1
- s_216)
- (syntax-e$1
- s_216)
- s_216)))
- (if (pair?
- s_217)
- (let-values (((phase-level181_0)
- (let-values (((s_218)
- (car
- s_217)))
- s_218))
- ((spec182_0)
- (let-values (((s_219)
- (cdr
- s_217)))
- (let-values (((s_220)
- (if (syntax?$1
- s_219)
- (syntax-e$1
- s_219)
- s_219)))
- (let-values (((flat-s_4)
- (to-syntax-list.1
- s_220)))
- (if (not
- flat-s_4)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_8))
- (let-values ()
- flat-s_4)))))))
- (values
- phase-level181_0
- spec182_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_8))))))
- (values
- just-meta178_0
- phase-level179_0
- spec180_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_8)))))
- (values
- #t
- just-meta175_1
- phase-level176_1
- spec177_1))))))
- (let-values (((p_30)
- (syntax-e$1
- phase-level176_0)))
- (begin
- (if (phase?
- p_30)
- (void)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad phase"
- orig-s_3
- req_0)))
- (loop_88
- spec177_0
- (let-values (((or-part_194)
- top-req_0))
- (if or-part_194
- or-part_194
- req_0))
- phase-shift_7
- space-level_1
- p_30
- just-space_0
- adjust_0
- for-meta-ok?_0
- #f
- 'raw))))))))))
- (if (unsafe-fx<
- index_2
- 9)
- (if (unsafe-fx<
- index_2
- 7)
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'raw
- (eq?
- just-meta_0
- 'all))
- (values))))
- (let-values (((ok?_6
- portal183_0
- id:name184_0
- stx185_0)
- (let-values (((s_221)
- req_0))
- (let-values (((orig-s_9)
- s_221))
- (let-values (((portal183_1
- id:name184_1
- stx185_1)
- (let-values (((s_189)
- (if (syntax?$1
- s_221)
- (syntax-e$1
- s_221)
- s_221)))
- (if (pair?
- s_189)
- (let-values (((portal186_0)
- (let-values (((s_222)
- (car
- s_189)))
- s_222))
- ((id:name187_0
- stx188_0)
- (let-values (((s_125)
- (cdr
- s_189)))
- (let-values (((s_223)
- (if (syntax?$1
- s_125)
- (syntax-e$1
- s_125)
- s_125)))
- (if (pair?
- s_223)
- (let-values (((id:name189_0)
- (let-values (((s_126)
- (car
- s_223)))
- (if (let-values (((or-part_195)
- (if (syntax?$1
- s_126)
- (symbol?
- (syntax-e$1
- s_126))
- #f)))
- (if or-part_195
- or-part_195
- (symbol?
- s_126)))
- s_126
- (raise-syntax-error$1
- #f
- "not an identifier"
- orig-s_9
- s_126))))
- ((stx190_0)
- (let-values (((s_224)
- (cdr
- s_223)))
- (let-values (((s_225)
- (if (syntax?$1
- s_224)
- (syntax-e$1
- s_224)
- s_224)))
- (if (pair?
- s_225)
- (let-values (((stx191_0)
- (let-values (((s_128)
- (car
- s_225)))
- s_128))
- (()
- (let-values (((s_129)
- (cdr
- s_225)))
- (let-values (((s_130)
- (if (syntax?$1
- s_129)
- (syntax-e$1
- s_129)
- s_129)))
- (if (null?
- s_130)
- (values)
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_9))))))
- (values
- stx191_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_9))))))
- (values
- id:name189_0
- stx190_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_9))))))
- (values
- portal186_0
- id:name187_0
- stx188_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_9)))))
- (values
- #t
- portal183_1
- id:name184_1
- stx185_1))))))
- (let-values (((temp192_0)
- id:name184_0)
- ((temp193_0)
- stx185_0)
- ((phase-shift194_0)
- phase-shift_7)
- ((orig-s195_0)
- orig-s_3)
- ((self196_0)
- self_12)
- ((requires+provides197_0)
- requires+provides_1)
- ((add-defined-portal198_0)
- add-defined-portal_0))
- (perform-portal-syntax-bind!.1
- add-defined-portal198_0
- orig-s195_0
- phase-shift194_0
- requires+provides197_0
- self196_0
- temp192_0
- temp193_0)))))
- (if (unsafe-fx<
- index_2
- 8)
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'phaseless)
- (values))))
- (let-values (((ok?_7
- for-space199_0
- space200_0
- spec201_0)
- (let-values (((s_138)
- req_0))
- (let-values (((orig-s_10)
- s_138))
- (let-values (((for-space199_1
- space200_1
- spec201_1)
- (let-values (((s_226)
- (if (syntax?$1
- s_138)
- (syntax-e$1
- s_138)
- s_138)))
- (if (pair?
- s_226)
- (let-values (((for-space202_0)
- (let-values (((s_227)
- (car
- s_226)))
- s_227))
- ((space203_0
- spec204_0)
- (let-values (((s_228)
- (cdr
- s_226)))
- (let-values (((s_229)
- (if (syntax?$1
- s_228)
- (syntax-e$1
- s_228)
- s_228)))
- (if (pair?
- s_229)
- (let-values (((space205_0)
- (let-values (((s_230)
- (car
- s_229)))
- s_230))
- ((spec206_0)
- (let-values (((s_140)
- (cdr
- s_229)))
- (let-values (((s_231)
- (if (syntax?$1
- s_140)
- (syntax-e$1
- s_140)
- s_140)))
- (let-values (((flat-s_5)
- (to-syntax-list.1
- s_231)))
- (if (not
- flat-s_5)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_10))
- (let-values ()
- flat-s_5)))))))
- (values
- space205_0
- spec206_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_10))))))
- (values
- for-space202_0
- space203_0
- spec204_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_10)))))
- (values
- #t
- for-space199_1
- space200_1
- spec201_1))))))
- (let-values (((space_9)
- (syntax-e$1
- space200_0)))
+ copy-variable-as-constant?148_0
+ copy-variable-phase-level147_0
+ initial-require?150_0
+ just-meta141_0
+ just-space142_0
+ phase-shift138_0
+ requires+provides144_0
+ run-phase140_2
+ run?145_0
+ skip-variable-phase-level149_0
+ space-level139_0
+ visit?146_0
+ who151_0
+ mpi133_0
+ req134_0
+ self135_0
+ temp136_1
+ m-ns137_0))
+ (set! initial-require?_0
+ #f)))))))
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'raw
+ for-meta-ok?_0)
+ (values))))
+ (let-values (((ok?_1
+ for-meta155_0
+ phase-level156_0
+ spec157_0)
+ (let-values (((s_258)
+ req_1))
+ (let-values (((orig-s_4)
+ s_258))
+ (let-values (((for-meta155_1
+ phase-level156_1
+ spec157_1)
+ (let-values (((s_259)
+ (if (syntax?$1
+ s_258)
+ (syntax-e$1
+ s_258)
+ s_258)))
+ (if (pair?
+ s_259)
+ (let-values (((for-meta158_0)
+ (let-values (((s_260)
+ (car
+ s_259)))
+ s_260))
+ ((phase-level159_0
+ spec160_0)
+ (let-values (((s_261)
+ (cdr
+ s_259)))
+ (let-values (((s_262)
+ (if (syntax?$1
+ s_261)
+ (syntax-e$1
+ s_261)
+ s_261)))
+ (if (pair?
+ s_262)
+ (let-values (((phase-level161_0)
+ (let-values (((s_263)
+ (car
+ s_262)))
+ s_263))
+ ((spec162_0)
+ (let-values (((s_264)
+ (cdr
+ s_262)))
+ (let-values (((s_265)
+ (if (syntax?$1
+ s_264)
+ (syntax-e$1
+ s_264)
+ s_264)))
+ (let-values (((flat-s_0)
+ (to-syntax-list.1
+ s_265)))
+ (if (not
+ flat-s_0)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_4)
+ flat-s_0))))))
+ (values
+ phase-level161_0
+ spec162_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_4))))))
+ (values
+ for-meta158_0
+ phase-level159_0
+ spec160_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_4)))))
+ (values
+ #t
+ for-meta155_1
+ phase-level156_1
+ spec157_1))))))
+ (let-values (((p_33)
+ (syntax-e$1
+ phase-level156_0)))
+ (begin
+ (if (phase?
+ p_33)
+ (void)
+ (raise-syntax-error$1
+ #f
+ "bad phase"
+ orig-s_3
+ req_1))
+ (loop_96
+ spec157_0
+ (let-values (((or-part_309)
+ top-req_0))
+ (if or-part_309
+ or-part_309
+ req_1))
+ (phase+
+ phase-shift_8
+ p_33)
+ space-level_1
+ just-meta_0
+ just-space_0
+ adjust_0
+ #f
+ just-meta-ok?_0
+ 'raw))))))
+ (if (unsafe-fx<
+ index_2
+ 3)
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'raw
+ for-meta-ok?_0)
+ (values))))
+ (let-values (((ok?_2
+ for-syntax163_0
+ spec164_0)
+ (let-values (((s_266)
+ req_1))
+ (let-values (((orig-s_5)
+ s_266))
+ (let-values (((for-syntax163_1
+ spec164_1)
+ (let-values (((s_267)
+ (if (syntax?$1
+ s_266)
+ (syntax-e$1
+ s_266)
+ s_266)))
+ (if (pair?
+ s_267)
+ (let-values (((for-syntax165_0)
+ (let-values (((s_268)
+ (car
+ s_267)))
+ s_268))
+ ((spec166_0)
+ (let-values (((s_269)
+ (cdr
+ s_267)))
+ (let-values (((s_270)
+ (if (syntax?$1
+ s_269)
+ (syntax-e$1
+ s_269)
+ s_269)))
+ (let-values (((flat-s_1)
+ (to-syntax-list.1
+ s_270)))
+ (if (not
+ flat-s_1)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_5)
+ flat-s_1))))))
+ (values
+ for-syntax165_0
+ spec166_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_5)))))
+ (values
+ #t
+ for-syntax163_1
+ spec164_1))))))
+ (loop_96
+ spec164_0
+ (let-values (((or-part_310)
+ top-req_0))
+ (if or-part_310
+ or-part_310
+ req_1))
+ (phase+
+ phase-shift_8
+ 1)
+ space-level_1
+ just-meta_0
+ just-space_0
+ adjust_0
+ #f
+ just-meta-ok?_0
+ 'raw)))
+ (if (unsafe-fx<
+ index_2
+ 4)
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'raw
+ for-meta-ok?_0)
+ (values))))
+ (let-values (((ok?_3
+ for-template167_0
+ spec168_0)
+ (let-values (((s_271)
+ req_1))
+ (let-values (((orig-s_6)
+ s_271))
+ (let-values (((for-template167_1
+ spec168_1)
+ (let-values (((s_272)
+ (if (syntax?$1
+ s_271)
+ (syntax-e$1
+ s_271)
+ s_271)))
+ (if (pair?
+ s_272)
+ (let-values (((for-template169_0)
+ (let-values (((s_273)
+ (car
+ s_272)))
+ s_273))
+ ((spec170_0)
+ (let-values (((s_274)
+ (cdr
+ s_272)))
+ (let-values (((s_275)
+ (if (syntax?$1
+ s_274)
+ (syntax-e$1
+ s_274)
+ s_274)))
+ (let-values (((flat-s_2)
+ (to-syntax-list.1
+ s_275)))
+ (if (not
+ flat-s_2)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_6)
+ flat-s_2))))))
+ (values
+ for-template169_0
+ spec170_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_6)))))
+ (values
+ #t
+ for-template167_1
+ spec168_1))))))
+ (loop_96
+ spec168_0
+ (let-values (((or-part_311)
+ top-req_0))
+ (if or-part_311
+ or-part_311
+ req_1))
+ (phase+
+ phase-shift_8
+ -1)
+ space-level_1
+ just-meta_0
+ just-space_0
+ adjust_0
+ #f
+ just-meta-ok?_0
+ 'raw)))
+ (if (unsafe-fx<
+ index_2
+ 5)
+ (let-values ((()
(begin
- (if (space?
- space_9)
- (void)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad space"
- orig-s_3
- req_0)))
- (loop_88
- spec201_0
- (let-values (((or-part_104)
- top-req_0))
- (if or-part_104
- or-part_104
- req_0))
- phase-shift_7
- space_9
- just-meta_0
- just-space_0
- adjust_0
- #f
- #f
- 'spaceless))))))
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'spaceless)
- (values))))
- (let-values (((ok?_8
- just-space207_0
- space208_0
- spec209_0)
- (let-values (((s_145)
- req_0))
- (let-values (((orig-s_11)
- s_145))
- (let-values (((just-space207_1
- space208_1
- spec209_1)
- (let-values (((s_232)
- (if (syntax?$1
- s_145)
- (syntax-e$1
- s_145)
- s_145)))
- (if (pair?
- s_232)
- (let-values (((just-space210_0)
- (let-values (((s_233)
- (car
- s_232)))
- s_233))
- ((space211_0
- spec212_0)
- (let-values (((s_234)
- (cdr
- s_232)))
- (let-values (((s_235)
- (if (syntax?$1
- s_234)
- (syntax-e$1
- s_234)
- s_234)))
- (if (pair?
- s_235)
- (let-values (((space213_0)
- (let-values (((s_236)
- (car
- s_235)))
- s_236))
- ((spec214_0)
- (let-values (((s_237)
- (cdr
- s_235)))
- (let-values (((s_238)
- (if (syntax?$1
- s_237)
- (syntax-e$1
- s_237)
- s_237)))
- (let-values (((flat-s_6)
- (to-syntax-list.1
- s_238)))
- (if (not
- flat-s_6)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_11))
- (let-values ()
- flat-s_6)))))))
- (values
- space213_0
- spec214_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_11))))))
- (values
- just-space210_0
- space211_0
- spec212_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_11)))))
- (values
- #t
- just-space207_1
- space208_1
- spec209_1))))))
- (let-values (((space_10)
- (syntax-e$1
- space208_0)))
+ (check-nested_0
+ 'raw
+ for-meta-ok?_0)
+ (values))))
+ (let-values (((ok?_4
+ for-label171_0
+ spec172_0)
+ (let-values (((s_276)
+ req_1))
+ (let-values (((orig-s_7)
+ s_276))
+ (let-values (((for-label171_1
+ spec172_1)
+ (let-values (((s_277)
+ (if (syntax?$1
+ s_276)
+ (syntax-e$1
+ s_276)
+ s_276)))
+ (if (pair?
+ s_277)
+ (let-values (((for-label173_0)
+ (let-values (((s_278)
+ (car
+ s_277)))
+ s_278))
+ ((spec174_0)
+ (let-values (((s_279)
+ (cdr
+ s_277)))
+ (let-values (((s_280)
+ (if (syntax?$1
+ s_279)
+ (syntax-e$1
+ s_279)
+ s_279)))
+ (let-values (((flat-s_3)
+ (to-syntax-list.1
+ s_280)))
+ (if (not
+ flat-s_3)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_7)
+ flat-s_3))))))
+ (values
+ for-label173_0
+ spec174_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_7)))))
+ (values
+ #t
+ for-label171_1
+ spec172_1))))))
+ (loop_96
+ spec172_0
+ (let-values (((or-part_312)
+ top-req_0))
+ (if or-part_312
+ or-part_312
+ req_1))
+ (phase+
+ phase-shift_8
+ #f)
+ space-level_1
+ just-meta_0
+ just-space_0
+ adjust_0
+ #f
+ just-meta-ok?_0
+ 'raw)))
+ (let-values ((()
(begin
- (if (space?
- space_10)
- (void)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad space"
- orig-s_3
- req_0)))
- (loop_88
- spec209_0
- (let-values (((or-part_196)
- top-req_0))
- (if or-part_196
- or-part_196
- req_0))
- phase-shift_7
- space-level_1
- just-meta_0
- space_10
- adjust_0
- #f
- #f
- 'justspaceless))))))))
- (if (unsafe-fx<
- index_2
- 11)
- (if (unsafe-fx<
- index_2
- 10)
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'justspaceless)
- (values))))
- (let-values (((ok?_9
- only215_0
- spec216_0
- id217_0)
- (let-values (((s_239)
- req_0))
- (let-values (((orig-s_12)
- s_239))
- (let-values (((only215_1
- spec216_1
- id217_1)
- (let-values (((s_240)
- (if (syntax?$1
- s_239)
- (syntax-e$1
- s_239)
- s_239)))
- (if (pair?
- s_240)
- (let-values (((only218_0)
- (let-values (((s_241)
- (car
- s_240)))
- s_241))
- ((spec219_0
- id220_0)
- (let-values (((s_242)
- (cdr
- s_240)))
- (let-values (((s_243)
- (if (syntax?$1
- s_242)
- (syntax-e$1
- s_242)
- s_242)))
- (if (pair?
- s_243)
- (let-values (((spec221_0)
- (let-values (((s_244)
- (car
- s_243)))
- s_244))
- ((id222_0)
- (let-values (((s_245)
- (cdr
- s_243)))
- (let-values (((s_246)
- (if (syntax?$1
- s_245)
- (syntax-e$1
- s_245)
- s_245)))
- (let-values (((flat-s_7)
- (to-syntax-list.1
- s_246)))
- (if (not
- flat-s_7)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_12))
- (let-values ()
- (let-values (((id_38)
- (let-values (((lst_158)
- flat-s_7))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_158)))
- ((letrec-values (((for-loop_194)
- (lambda (id_39
- lst_159)
- (begin
- 'for-loop
- (if (pair?
- lst_159)
- (let-values (((s_247)
- (unsafe-car
- lst_159))
- ((rest_79)
- (unsafe-cdr
- lst_159)))
- (let-values (((id_35)
- (let-values (((id_40)
- id_39))
- (let-values (((id_41)
- (let-values ()
- (let-values (((id223_0)
- (let-values ()
- (if (let-values (((or-part_197)
- (if (syntax?$1
- s_247)
- (symbol?
- (syntax-e$1
- s_247))
- #f)))
- (if or-part_197
- or-part_197
- (symbol?
- s_247)))
- s_247
- (raise-syntax-error$1
- #f
- "not an identifier"
- orig-s_12
- s_247)))))
- (cons
- id223_0
- id_40)))))
- (values
- id_41)))))
- (if (not
- #f)
- (for-loop_194
- id_35
- rest_79)
- id_35)))
- id_39)))))
- for-loop_194)
- null
- lst_158)))))
- (reverse$1
- id_38)))))))))
- (values
- spec221_0
- id222_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_12))))))
- (values
- only218_0
- spec219_0
- id220_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_12)))))
- (values
- #t
- only215_1
- spec216_1
- id217_1))))))
- (loop_88
- (list
- spec216_0)
- (let-values (((or-part_198)
- top-req_0))
- (if or-part_198
- or-part_198
- req_0))
- phase-shift_7
- space-level_1
- just-meta_0
- just-space_0
- (adjust-only1.1
- (ids->sym-set
- id217_0))
- #f
- #f
- 'path))))
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'justspaceless)
- (values))))
- (let-values (((ok?_10
- prefix224_0
- id:prefix225_0
- spec226_0)
- (let-values (((s_248)
- req_0))
- (let-values (((orig-s_13)
- s_248))
- (let-values (((prefix224_1
- id:prefix225_1
- spec226_1)
- (let-values (((s_249)
- (if (syntax?$1
- s_248)
- (syntax-e$1
- s_248)
- s_248)))
- (if (pair?
- s_249)
- (let-values (((prefix227_0)
- (let-values (((s_250)
- (car
- s_249)))
- s_250))
- ((id:prefix228_0
- spec229_0)
- (let-values (((s_251)
- (cdr
- s_249)))
- (let-values (((s_252)
- (if (syntax?$1
- s_251)
- (syntax-e$1
- s_251)
- s_251)))
- (if (pair?
- s_252)
- (let-values (((id:prefix230_0)
- (let-values (((s_253)
- (car
- s_252)))
- (if (let-values (((or-part_199)
- (if (syntax?$1
- s_253)
- (symbol?
- (syntax-e$1
- s_253))
- #f)))
- (if or-part_199
- or-part_199
+ (check-nested_0
+ 'raw
+ just-meta-ok?_0)
+ (values))))
+ (let-values (((ok?_5
+ just-meta175_0
+ phase-level176_0
+ spec177_0)
+ (let-values (((s_281)
+ req_1))
+ (let-values (((orig-s_8)
+ s_281))
+ (let-values (((just-meta175_1
+ phase-level176_1
+ spec177_1)
+ (let-values (((s_282)
+ (if (syntax?$1
+ s_281)
+ (syntax-e$1
+ s_281)
+ s_281)))
+ (if (pair?
+ s_282)
+ (let-values (((just-meta178_0)
+ (let-values (((s_283)
+ (car
+ s_282)))
+ s_283))
+ ((phase-level179_0
+ spec180_0)
+ (let-values (((s_284)
+ (cdr
+ s_282)))
+ (let-values (((s_285)
+ (if (syntax?$1
+ s_284)
+ (syntax-e$1
+ s_284)
+ s_284)))
+ (if (pair?
+ s_285)
+ (let-values (((phase-level181_0)
+ (let-values (((s_286)
+ (car
+ s_285)))
+ s_286))
+ ((spec182_0)
+ (let-values (((s_287)
+ (cdr
+ s_285)))
+ (let-values (((s_288)
+ (if (syntax?$1
+ s_287)
+ (syntax-e$1
+ s_287)
+ s_287)))
+ (let-values (((flat-s_4)
+ (to-syntax-list.1
+ s_288)))
+ (if (not
+ flat-s_4)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_8)
+ flat-s_4))))))
+ (values
+ phase-level181_0
+ spec182_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_8))))))
+ (values
+ just-meta178_0
+ phase-level179_0
+ spec180_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_8)))))
+ (values
+ #t
+ just-meta175_1
+ phase-level176_1
+ spec177_1))))))
+ (let-values (((p_34)
+ (syntax-e$1
+ phase-level176_0)))
+ (begin
+ (if (phase?
+ p_34)
+ (void)
+ (raise-syntax-error$1
+ #f
+ "bad phase"
+ orig-s_3
+ req_1))
+ (loop_96
+ spec177_0
+ (let-values (((or-part_313)
+ top-req_0))
+ (if or-part_313
+ or-part_313
+ req_1))
+ phase-shift_8
+ space-level_1
+ p_34
+ just-space_0
+ adjust_0
+ for-meta-ok?_0
+ #f
+ 'raw)))))))))
+ (if (unsafe-fx<
+ index_2
+ 9)
+ (if (unsafe-fx<
+ index_2
+ 7)
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'raw
+ (eq?
+ just-meta_0
+ 'all))
+ (values))))
+ (let-values (((ok?_6
+ portal183_0
+ id:name184_0
+ stx185_0)
+ (let-values (((s_289)
+ req_1))
+ (let-values (((orig-s_9)
+ s_289))
+ (let-values (((portal183_1
+ id:name184_1
+ stx185_1)
+ (let-values (((s_290)
+ (if (syntax?$1
+ s_289)
+ (syntax-e$1
+ s_289)
+ s_289)))
+ (if (pair?
+ s_290)
+ (let-values (((portal186_0)
+ (let-values (((s_291)
+ (car
+ s_290)))
+ s_291))
+ ((id:name187_0
+ stx188_0)
+ (let-values (((s_292)
+ (cdr
+ s_290)))
+ (let-values (((s_293)
+ (if (syntax?$1
+ s_292)
+ (syntax-e$1
+ s_292)
+ s_292)))
+ (if (pair?
+ s_293)
+ (let-values (((id:name189_0)
+ (let-values (((s_294)
+ (car
+ s_293)))
+ (if (let-values (((or-part_314)
+ (if (syntax?$1
+ s_294)
(symbol?
- s_253)))
- s_253
- (raise-syntax-error$1
- #f
- "not an identifier"
- orig-s_13
- s_253))))
- ((spec231_0)
- (let-values (((s_254)
- (cdr
- s_252)))
- (let-values (((s_255)
- (if (syntax?$1
- s_254)
- (syntax-e$1
- s_254)
- s_254)))
- (if (pair?
- s_255)
- (let-values (((spec232_0)
- (let-values (((s_256)
- (car
- s_255)))
- s_256))
- (()
- (let-values (((s_257)
- (cdr
- s_255)))
- (let-values (((s_258)
- (if (syntax?$1
- s_257)
- (syntax-e$1
- s_257)
- s_257)))
- (if (null?
- s_258)
- (values)
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_13))))))
- (values
- spec232_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_13))))))
- (values
- id:prefix230_0
- spec231_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_13))))))
- (values
- prefix227_0
- id:prefix228_0
- spec229_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_13)))))
- (values
- #t
- prefix224_1
- id:prefix225_1
- spec226_1))))))
- (loop_88
- (list
- spec226_0)
- (let-values (((or-part_125)
- top-req_0))
- (if or-part_125
- or-part_125
- req_0))
- phase-shift_7
- space-level_1
- just-meta_0
- just-space_0
- (adjust-prefix2.1
- (syntax-e$1
- id:prefix225_0))
- #f
- #f
- 'path)))))
- (if (unsafe-fx<
- index_2
- 12)
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'justspaceless)
- (values))))
- (let-values (((ok?_11
- all-except233_0
- spec234_0
- id235_0)
- (let-values (((s_259)
- req_0))
- (let-values (((orig-s_14)
- s_259))
- (let-values (((all-except233_1
- spec234_1
- id235_1)
- (let-values (((s_260)
- (if (syntax?$1
- s_259)
- (syntax-e$1
- s_259)
- s_259)))
- (if (pair?
- s_260)
- (let-values (((all-except236_0)
- (let-values (((s_261)
- (car
- s_260)))
- s_261))
- ((spec237_0
- id238_0)
- (let-values (((s_262)
- (cdr
- s_260)))
- (let-values (((s_263)
- (if (syntax?$1
- s_262)
- (syntax-e$1
- s_262)
- s_262)))
- (if (pair?
- s_263)
- (let-values (((spec239_0)
- (let-values (((s_264)
- (car
- s_263)))
- s_264))
- ((id240_0)
- (let-values (((s_265)
- (cdr
- s_263)))
- (let-values (((s_147)
- (if (syntax?$1
- s_265)
- (syntax-e$1
- s_265)
- s_265)))
- (let-values (((flat-s_8)
- (to-syntax-list.1
- s_147)))
- (if (not
- flat-s_8)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_14))
- (let-values ()
- (let-values (((id_42)
- (let-values (((lst_160)
- flat-s_8))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_160)))
- ((letrec-values (((for-loop_195)
- (lambda (id_43
- lst_161)
- (begin
- 'for-loop
- (if (pair?
- lst_161)
- (let-values (((s_148)
- (unsafe-car
- lst_161))
- ((rest_80)
- (unsafe-cdr
- lst_161)))
- (let-values (((id_44)
- (let-values (((id_36)
- id_43))
- (let-values (((id_45)
- (let-values ()
- (let-values (((id241_0)
- (let-values ()
- (if (let-values (((or-part_200)
- (if (syntax?$1
- s_148)
- (symbol?
- (syntax-e$1
- s_148))
- #f)))
- (if or-part_200
- or-part_200
- (symbol?
- s_148)))
- s_148
- (raise-syntax-error$1
- #f
- "not an identifier"
- orig-s_14
- s_148)))))
- (cons
- id241_0
- id_36)))))
- (values
- id_45)))))
- (if (not
- #f)
- (for-loop_195
- id_44
- rest_80)
- id_44)))
- id_43)))))
- for-loop_195)
- null
- lst_160)))))
- (reverse$1
- id_42)))))))))
- (values
- spec239_0
- id240_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_14))))))
- (values
- all-except236_0
- spec237_0
- id238_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_14)))))
- (values
- #t
- all-except233_1
- spec234_1
- id235_1))))))
- (loop_88
- (list
- spec234_0)
- (let-values (((or-part_201)
- top-req_0))
- (if or-part_201
- or-part_201
- req_0))
- phase-shift_7
- space-level_1
- just-meta_0
- just-space_0
- (adjust-all-except3.1
- '||
- (ids->sym-set
- id235_0))
- #f
- #f
- 'path))))
- (if (unsafe-fx<
- index_2
- 13)
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'justspaceless)
- (values))))
- (let-values (((ok?_12
- prefix-all-except242_0
- id:prefix243_0
- spec244_0
- id245_0)
- (let-values (((s_266)
- req_0))
- (let-values (((orig-s_15)
- s_266))
- (let-values (((prefix-all-except242_1
- id:prefix243_1
- spec244_1
- id245_1)
- (let-values (((s_154)
- (if (syntax?$1
- s_266)
- (syntax-e$1
- s_266)
- s_266)))
- (if (pair?
- s_154)
- (let-values (((prefix-all-except246_0)
- (let-values (((s_267)
- (car
- s_154)))
- s_267))
- ((id:prefix247_0
- spec248_0
- id249_0)
- (let-values (((s_268)
- (cdr
- s_154)))
- (let-values (((s_269)
- (if (syntax?$1
- s_268)
- (syntax-e$1
- s_268)
- s_268)))
- (if (pair?
- s_269)
- (let-values (((id:prefix250_0)
- (let-values (((s_270)
- (car
- s_269)))
- (if (let-values (((or-part_202)
- (if (syntax?$1
- s_270)
- (symbol?
- (syntax-e$1
- s_270))
- #f)))
- (if or-part_202
- or-part_202
- (symbol?
- s_270)))
- s_270
- (raise-syntax-error$1
- #f
- "not an identifier"
- orig-s_15
- s_270))))
- ((spec251_0
- id252_0)
- (let-values (((s_271)
- (cdr
- s_269)))
- (let-values (((s_272)
- (if (syntax?$1
- s_271)
- (syntax-e$1
- s_271)
- s_271)))
- (if (pair?
- s_272)
- (let-values (((spec253_0)
- (let-values (((s_273)
- (car
- s_272)))
- s_273))
- ((id254_0)
- (let-values (((s_274)
- (cdr
- s_272)))
- (let-values (((s_275)
- (if (syntax?$1
- s_274)
- (syntax-e$1
- s_274)
- s_274)))
- (let-values (((flat-s_9)
- (to-syntax-list.1
- s_275)))
- (if (not
- flat-s_9)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_15))
- (let-values ()
- (let-values (((id_46)
- (let-values (((lst_162)
- flat-s_9))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_162)))
- ((letrec-values (((for-loop_196)
- (lambda (id_47
- lst_163)
- (begin
- 'for-loop
- (if (pair?
- lst_163)
- (let-values (((s_276)
- (unsafe-car
- lst_163))
- ((rest_81)
- (unsafe-cdr
- lst_163)))
- (let-values (((id_48)
- (let-values (((id_49)
- id_47))
- (let-values (((id_50)
- (let-values ()
- (let-values (((id255_0)
- (let-values ()
- (if (let-values (((or-part_203)
- (if (syntax?$1
- s_276)
- (symbol?
- (syntax-e$1
- s_276))
- #f)))
- (if or-part_203
- or-part_203
- (symbol?
- s_276)))
- s_276
- (raise-syntax-error$1
- #f
- "not an identifier"
- orig-s_15
- s_276)))))
- (cons
- id255_0
- id_49)))))
- (values
- id_50)))))
- (if (not
- #f)
- (for-loop_196
- id_48
- rest_81)
- id_48)))
- id_47)))))
- for-loop_196)
- null
- lst_162)))))
- (reverse$1
- id_46)))))))))
- (values
- spec253_0
- id254_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_15))))))
- (values
- id:prefix250_0
- spec251_0
- id252_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_15))))))
- (values
- prefix-all-except246_0
- id:prefix247_0
- spec248_0
- id249_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_15)))))
- (values
- #t
- prefix-all-except242_1
- id:prefix243_1
- spec244_1
- id245_1))))))
- (loop_88
- (list
- spec244_0)
- (let-values (((or-part_204)
- top-req_0))
- (if or-part_204
- or-part_204
- req_0))
- phase-shift_7
- space-level_1
- just-meta_0
- just-space_0
- (adjust-all-except3.1
+ (syntax-e$1
+ s_294))
+ #f)))
+ (if or-part_314
+ or-part_314
+ (symbol?
+ s_294)))
+ s_294
+ (raise-syntax-error$1
+ #f
+ "not an identifier"
+ orig-s_9
+ s_294))))
+ ((stx190_0)
+ (let-values (((s_295)
+ (cdr
+ s_293)))
+ (let-values (((s_296)
+ (if (syntax?$1
+ s_295)
+ (syntax-e$1
+ s_295)
+ s_295)))
+ (if (pair?
+ s_296)
+ (let-values (((stx191_0)
+ (let-values (((s_297)
+ (car
+ s_296)))
+ s_297))
+ (()
+ (let-values (((s_298)
+ (cdr
+ s_296)))
+ (let-values (((s_299)
+ (if (syntax?$1
+ s_298)
+ (syntax-e$1
+ s_298)
+ s_298)))
+ (if (null?
+ s_299)
+ (values)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_9))))))
+ (values
+ stx191_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_9))))))
+ (values
+ id:name189_0
+ stx190_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_9))))))
+ (values
+ portal186_0
+ id:name187_0
+ stx188_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_9)))))
+ (values
+ #t
+ portal183_1
+ id:name184_1
+ stx185_1))))))
+ (let-values (((temp192_0)
+ id:name184_0)
+ ((temp193_0)
+ stx185_0)
+ ((phase-shift194_0)
+ phase-shift_8)
+ ((orig-s195_0)
+ orig-s_3)
+ ((self196_0)
+ self_14)
+ ((requires+provides197_0)
+ requires+provides_1)
+ ((add-defined-portal198_0)
+ add-defined-portal_0))
+ (perform-portal-syntax-bind!.1
+ add-defined-portal198_0
+ orig-s195_0
+ phase-shift194_0
+ requires+provides197_0
+ self196_0
+ temp192_0
+ temp193_0))))
+ (if (unsafe-fx<
+ index_2
+ 8)
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'phaseless)
+ (values))))
+ (let-values (((ok?_7
+ for-space199_0
+ space200_0
+ spec201_0)
+ (let-values (((s_300)
+ req_1))
+ (let-values (((orig-s_10)
+ s_300))
+ (let-values (((for-space199_1
+ space200_1
+ spec201_1)
+ (let-values (((s_301)
+ (if (syntax?$1
+ s_300)
+ (syntax-e$1
+ s_300)
+ s_300)))
+ (if (pair?
+ s_301)
+ (let-values (((for-space202_0)
+ (let-values (((s_302)
+ (car
+ s_301)))
+ s_302))
+ ((space203_0
+ spec204_0)
+ (let-values (((s_303)
+ (cdr
+ s_301)))
+ (let-values (((s_304)
+ (if (syntax?$1
+ s_303)
+ (syntax-e$1
+ s_303)
+ s_303)))
+ (if (pair?
+ s_304)
+ (let-values (((space205_0)
+ (let-values (((s_305)
+ (car
+ s_304)))
+ s_305))
+ ((spec206_0)
+ (let-values (((s_306)
+ (cdr
+ s_304)))
+ (let-values (((s_307)
+ (if (syntax?$1
+ s_306)
+ (syntax-e$1
+ s_306)
+ s_306)))
+ (let-values (((flat-s_5)
+ (to-syntax-list.1
+ s_307)))
+ (if (not
+ flat-s_5)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_10)
+ flat-s_5))))))
+ (values
+ space205_0
+ spec206_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_10))))))
+ (values
+ for-space202_0
+ space203_0
+ spec204_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_10)))))
+ (values
+ #t
+ for-space199_1
+ space200_1
+ spec201_1))))))
+ (let-values (((space_9)
(syntax-e$1
- id:prefix243_0)
- (ids->sym-set
- id245_0))
- #f
- #f
- 'path))))
- (let-values ()
- (let-values ((()
- (begin
- (check-nested_0
- 'justspaceless)
- (values))))
- (let-values (((ok?_13
- rename256_0
- spec257_0
- id:to258_0
- id:from259_0)
- (let-values (((s_277)
- req_0))
- (let-values (((orig-s_16)
- s_277))
- (let-values (((rename256_1
- spec257_1
- id:to258_1
- id:from259_1)
- (let-values (((s_278)
- (if (syntax?$1
- s_277)
- (syntax-e$1
- s_277)
- s_277)))
- (if (pair?
- s_278)
- (let-values (((rename260_0)
- (let-values (((s_279)
- (car
- s_278)))
- s_279))
- ((spec261_0
- id:to262_0
- id:from263_0)
- (let-values (((s_280)
- (cdr
- s_278)))
- (let-values (((s_161)
- (if (syntax?$1
- s_280)
- (syntax-e$1
- s_280)
- s_280)))
- (if (pair?
- s_161)
- (let-values (((spec264_0)
- (let-values (((s_281)
- (car
- s_161)))
- s_281))
- ((id:to265_0
- id:from266_0)
- (let-values (((s_282)
- (cdr
- s_161)))
- (let-values (((s_283)
- (if (syntax?$1
- s_282)
- (syntax-e$1
- s_282)
- s_282)))
- (if (pair?
- s_283)
- (let-values (((id:to267_0)
- (let-values (((s_284)
- (car
- s_283)))
- (if (let-values (((or-part_205)
- (if (syntax?$1
- s_284)
- (symbol?
- (syntax-e$1
- s_284))
- #f)))
- (if or-part_205
- or-part_205
- (symbol?
- s_284)))
- s_284
- (raise-syntax-error$1
- #f
- "not an identifier"
- orig-s_16
- s_284))))
- ((id:from268_0)
- (let-values (((s_285)
- (cdr
- s_283)))
- (let-values (((s_286)
- (if (syntax?$1
- s_285)
- (syntax-e$1
- s_285)
- s_285)))
- (if (pair?
- s_286)
- (let-values (((id:from269_0)
- (let-values (((s_287)
- (car
- s_286)))
- (if (let-values (((or-part_206)
- (if (syntax?$1
- s_287)
- (symbol?
- (syntax-e$1
- s_287))
- #f)))
- (if or-part_206
- or-part_206
- (symbol?
- s_287)))
- s_287
- (raise-syntax-error$1
- #f
- "not an identifier"
- orig-s_16
- s_287))))
- (()
- (let-values (((s_288)
- (cdr
- s_286)))
- (let-values (((s_289)
- (if (syntax?$1
- s_288)
- (syntax-e$1
- s_288)
- s_288)))
- (if (null?
- s_289)
- (values)
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_16))))))
- (values
- id:from269_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_16))))))
- (values
- id:to267_0
- id:from268_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_16))))))
- (values
- spec264_0
- id:to265_0
- id:from266_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_16))))))
- (values
- rename260_0
- spec261_0
- id:to262_0
- id:from263_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_16)))))
- (values
- #t
- rename256_1
- spec257_1
- id:to258_1
- id:from259_1))))))
- (loop_88
- (list
- spec257_0)
- (let-values (((or-part_207)
- top-req_0))
- (if or-part_207
- or-part_207
- req_0))
- phase-shift_7
- space-level_1
- just-meta_0
- just-space_0
- (adjust-rename4.1
- id:to258_0
+ space200_0)))
+ (begin
+ (if (space?
+ space_9)
+ (void)
+ (raise-syntax-error$1
+ #f
+ "bad space"
+ orig-s_3
+ req_1))
+ (loop_96
+ spec201_0
+ (let-values (((or-part_315)
+ top-req_0))
+ (if or-part_315
+ or-part_315
+ req_1))
+ phase-shift_8
+ space_9
+ just-meta_0
+ just-space_0
+ adjust_0
+ #f
+ #f
+ 'spaceless)))))
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'spaceless)
+ (values))))
+ (let-values (((ok?_8
+ just-space207_0
+ space208_0
+ spec209_0)
+ (let-values (((s_308)
+ req_1))
+ (let-values (((orig-s_11)
+ s_308))
+ (let-values (((just-space207_1
+ space208_1
+ spec209_1)
+ (let-values (((s_309)
+ (if (syntax?$1
+ s_308)
+ (syntax-e$1
+ s_308)
+ s_308)))
+ (if (pair?
+ s_309)
+ (let-values (((just-space210_0)
+ (let-values (((s_310)
+ (car
+ s_309)))
+ s_310))
+ ((space211_0
+ spec212_0)
+ (let-values (((s_311)
+ (cdr
+ s_309)))
+ (let-values (((s_312)
+ (if (syntax?$1
+ s_311)
+ (syntax-e$1
+ s_311)
+ s_311)))
+ (if (pair?
+ s_312)
+ (let-values (((space213_0)
+ (let-values (((s_313)
+ (car
+ s_312)))
+ s_313))
+ ((spec214_0)
+ (let-values (((s_314)
+ (cdr
+ s_312)))
+ (let-values (((s_315)
+ (if (syntax?$1
+ s_314)
+ (syntax-e$1
+ s_314)
+ s_314)))
+ (let-values (((flat-s_6)
+ (to-syntax-list.1
+ s_315)))
+ (if (not
+ flat-s_6)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_11)
+ flat-s_6))))))
+ (values
+ space213_0
+ spec214_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_11))))))
+ (values
+ just-space210_0
+ space211_0
+ spec212_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_11)))))
+ (values
+ #t
+ just-space207_1
+ space208_1
+ spec209_1))))))
+ (let-values (((space_10)
(syntax-e$1
- id:from259_0))
- #f
- #f
- 'path))))))))))))))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_193
- rest_31)
- (values))))
- (values))))))
- for-loop_193)
- lst_157)))
- (void))))))
- loop_88)
- reqs_0
- #f
- phase-shift_6
- '#:none
- 'all
- #t
- #f
- #t
- #t
- 'raw))))))))))))))))))))))
+ space208_0)))
+ (begin
+ (if (space?
+ space_10)
+ (void)
+ (raise-syntax-error$1
+ #f
+ "bad space"
+ orig-s_3
+ req_1))
+ (loop_96
+ spec209_0
+ (let-values (((or-part_316)
+ top-req_0))
+ (if or-part_316
+ or-part_316
+ req_1))
+ phase-shift_8
+ space-level_1
+ just-meta_0
+ space_10
+ adjust_0
+ #f
+ #f
+ 'justspaceless)))))))
+ (if (unsafe-fx<
+ index_2
+ 11)
+ (if (unsafe-fx<
+ index_2
+ 10)
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'justspaceless)
+ (values))))
+ (let-values (((ok?_9
+ only215_0
+ spec216_0
+ id217_0)
+ (let-values (((s_316)
+ req_1))
+ (let-values (((orig-s_12)
+ s_316))
+ (let-values (((only215_1
+ spec216_1
+ id217_1)
+ (let-values (((s_317)
+ (if (syntax?$1
+ s_316)
+ (syntax-e$1
+ s_316)
+ s_316)))
+ (if (pair?
+ s_317)
+ (let-values (((only218_0)
+ (let-values (((s_318)
+ (car
+ s_317)))
+ s_318))
+ ((spec219_0
+ id220_0)
+ (let-values (((s_319)
+ (cdr
+ s_317)))
+ (let-values (((s_320)
+ (if (syntax?$1
+ s_319)
+ (syntax-e$1
+ s_319)
+ s_319)))
+ (if (pair?
+ s_320)
+ (let-values (((spec221_0)
+ (let-values (((s_321)
+ (car
+ s_320)))
+ s_321))
+ ((id222_0)
+ (let-values (((s_322)
+ (cdr
+ s_320)))
+ (let-values (((s_323)
+ (if (syntax?$1
+ s_322)
+ (syntax-e$1
+ s_322)
+ s_322)))
+ (let-values (((flat-s_7)
+ (to-syntax-list.1
+ s_323)))
+ (if (not
+ flat-s_7)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_12)
+ (let-values (((id_40)
+ (let-values (((id_41)
+ (let-values (((id_42)
+ null))
+ id_42)))
+ (let-values (((lst_236)
+ flat-s_7))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_236))
+ ((letrec-values (((for-loop_245)
+ (lambda (id_43
+ lst_237)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_237)
+ (let-values (((s_324)
+ (unsafe-car
+ lst_237))
+ ((rest_114)
+ (unsafe-cdr
+ lst_237)))
+ (let-values (((id_44)
+ (let-values (((id_45)
+ (let-values (((id223_0)
+ (if (let-values (((or-part_317)
+ (if (syntax?$1
+ s_324)
+ (symbol?
+ (syntax-e$1
+ s_324))
+ #f)))
+ (if or-part_317
+ or-part_317
+ (symbol?
+ s_324)))
+ s_324
+ (raise-syntax-error$1
+ #f
+ "not an identifier"
+ orig-s_12
+ s_324))))
+ (cons
+ id223_0
+ id_43))))
+ (values
+ id_45))))
+ (if (not
+ #f)
+ (for-loop_245
+ id_44
+ rest_114)
+ id_44)))
+ id_43)))))
+ for-loop_245)
+ id_41
+ lst_236))))))
+ (reverse$1
+ id_40))))))))
+ (values
+ spec221_0
+ id222_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_12))))))
+ (values
+ only218_0
+ spec219_0
+ id220_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_12)))))
+ (values
+ #t
+ only215_1
+ spec216_1
+ id217_1))))))
+ (loop_96
+ (list
+ spec216_0)
+ (let-values (((or-part_318)
+ top-req_0))
+ (if or-part_318
+ or-part_318
+ req_1))
+ phase-shift_8
+ space-level_1
+ just-meta_0
+ just-space_0
+ (adjust-only1.1
+ (ids->sym-set
+ id217_0))
+ #f
+ #f
+ 'path)))
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'justspaceless)
+ (values))))
+ (let-values (((ok?_10
+ prefix224_0
+ id:prefix225_0
+ spec226_0)
+ (let-values (((s_325)
+ req_1))
+ (let-values (((orig-s_13)
+ s_325))
+ (let-values (((prefix224_1
+ id:prefix225_1
+ spec226_1)
+ (let-values (((s_326)
+ (if (syntax?$1
+ s_325)
+ (syntax-e$1
+ s_325)
+ s_325)))
+ (if (pair?
+ s_326)
+ (let-values (((prefix227_0)
+ (let-values (((s_327)
+ (car
+ s_326)))
+ s_327))
+ ((id:prefix228_0
+ spec229_0)
+ (let-values (((s_328)
+ (cdr
+ s_326)))
+ (let-values (((s_329)
+ (if (syntax?$1
+ s_328)
+ (syntax-e$1
+ s_328)
+ s_328)))
+ (if (pair?
+ s_329)
+ (let-values (((id:prefix230_0)
+ (let-values (((s_330)
+ (car
+ s_329)))
+ (if (let-values (((or-part_319)
+ (if (syntax?$1
+ s_330)
+ (symbol?
+ (syntax-e$1
+ s_330))
+ #f)))
+ (if or-part_319
+ or-part_319
+ (symbol?
+ s_330)))
+ s_330
+ (raise-syntax-error$1
+ #f
+ "not an identifier"
+ orig-s_13
+ s_330))))
+ ((spec231_0)
+ (let-values (((s_331)
+ (cdr
+ s_329)))
+ (let-values (((s_332)
+ (if (syntax?$1
+ s_331)
+ (syntax-e$1
+ s_331)
+ s_331)))
+ (if (pair?
+ s_332)
+ (let-values (((spec232_0)
+ (let-values (((s_333)
+ (car
+ s_332)))
+ s_333))
+ (()
+ (let-values (((s_334)
+ (cdr
+ s_332)))
+ (let-values (((s_335)
+ (if (syntax?$1
+ s_334)
+ (syntax-e$1
+ s_334)
+ s_334)))
+ (if (null?
+ s_335)
+ (values)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_13))))))
+ (values
+ spec232_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_13))))))
+ (values
+ id:prefix230_0
+ spec231_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_13))))))
+ (values
+ prefix227_0
+ id:prefix228_0
+ spec229_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_13)))))
+ (values
+ #t
+ prefix224_1
+ id:prefix225_1
+ spec226_1))))))
+ (loop_96
+ (list
+ spec226_0)
+ (let-values (((or-part_320)
+ top-req_0))
+ (if or-part_320
+ or-part_320
+ req_1))
+ phase-shift_8
+ space-level_1
+ just-meta_0
+ just-space_0
+ (adjust-prefix2.1
+ (syntax-e$1
+ id:prefix225_0))
+ #f
+ #f
+ 'path))))
+ (if (unsafe-fx<
+ index_2
+ 12)
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'justspaceless)
+ (values))))
+ (let-values (((ok?_11
+ all-except233_0
+ spec234_0
+ id235_0)
+ (let-values (((s_336)
+ req_1))
+ (let-values (((orig-s_14)
+ s_336))
+ (let-values (((all-except233_1
+ spec234_1
+ id235_1)
+ (let-values (((s_337)
+ (if (syntax?$1
+ s_336)
+ (syntax-e$1
+ s_336)
+ s_336)))
+ (if (pair?
+ s_337)
+ (let-values (((all-except236_0)
+ (let-values (((s_338)
+ (car
+ s_337)))
+ s_338))
+ ((spec237_0
+ id238_0)
+ (let-values (((s_339)
+ (cdr
+ s_337)))
+ (let-values (((s_340)
+ (if (syntax?$1
+ s_339)
+ (syntax-e$1
+ s_339)
+ s_339)))
+ (if (pair?
+ s_340)
+ (let-values (((spec239_0)
+ (let-values (((s_341)
+ (car
+ s_340)))
+ s_341))
+ ((id240_0)
+ (let-values (((s_342)
+ (cdr
+ s_340)))
+ (let-values (((s_343)
+ (if (syntax?$1
+ s_342)
+ (syntax-e$1
+ s_342)
+ s_342)))
+ (let-values (((flat-s_8)
+ (to-syntax-list.1
+ s_343)))
+ (if (not
+ flat-s_8)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_14)
+ (let-values (((id_46)
+ (let-values (((id_47)
+ (let-values (((id_48)
+ null))
+ id_48)))
+ (let-values (((lst_238)
+ flat-s_8))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_238))
+ ((letrec-values (((for-loop_246)
+ (lambda (id_49
+ lst_239)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_239)
+ (let-values (((s_344)
+ (unsafe-car
+ lst_239))
+ ((rest_115)
+ (unsafe-cdr
+ lst_239)))
+ (let-values (((id_50)
+ (let-values (((id_51)
+ (let-values (((id241_0)
+ (if (let-values (((or-part_321)
+ (if (syntax?$1
+ s_344)
+ (symbol?
+ (syntax-e$1
+ s_344))
+ #f)))
+ (if or-part_321
+ or-part_321
+ (symbol?
+ s_344)))
+ s_344
+ (raise-syntax-error$1
+ #f
+ "not an identifier"
+ orig-s_14
+ s_344))))
+ (cons
+ id241_0
+ id_49))))
+ (values
+ id_51))))
+ (if (not
+ #f)
+ (for-loop_246
+ id_50
+ rest_115)
+ id_50)))
+ id_49)))))
+ for-loop_246)
+ id_47
+ lst_238))))))
+ (reverse$1
+ id_46))))))))
+ (values
+ spec239_0
+ id240_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_14))))))
+ (values
+ all-except236_0
+ spec237_0
+ id238_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_14)))))
+ (values
+ #t
+ all-except233_1
+ spec234_1
+ id235_1))))))
+ (loop_96
+ (list
+ spec234_0)
+ (let-values (((or-part_322)
+ top-req_0))
+ (if or-part_322
+ or-part_322
+ req_1))
+ phase-shift_8
+ space-level_1
+ just-meta_0
+ just-space_0
+ (adjust-all-except3.1
+ '||
+ (ids->sym-set
+ id235_0))
+ #f
+ #f
+ 'path)))
+ (if (unsafe-fx<
+ index_2
+ 13)
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'justspaceless)
+ (values))))
+ (let-values (((ok?_12
+ prefix-all-except242_0
+ id:prefix243_0
+ spec244_0
+ id245_0)
+ (let-values (((s_345)
+ req_1))
+ (let-values (((orig-s_15)
+ s_345))
+ (let-values (((prefix-all-except242_1
+ id:prefix243_1
+ spec244_1
+ id245_1)
+ (let-values (((s_346)
+ (if (syntax?$1
+ s_345)
+ (syntax-e$1
+ s_345)
+ s_345)))
+ (if (pair?
+ s_346)
+ (let-values (((prefix-all-except246_0)
+ (let-values (((s_347)
+ (car
+ s_346)))
+ s_347))
+ ((id:prefix247_0
+ spec248_0
+ id249_0)
+ (let-values (((s_348)
+ (cdr
+ s_346)))
+ (let-values (((s_349)
+ (if (syntax?$1
+ s_348)
+ (syntax-e$1
+ s_348)
+ s_348)))
+ (if (pair?
+ s_349)
+ (let-values (((id:prefix250_0)
+ (let-values (((s_350)
+ (car
+ s_349)))
+ (if (let-values (((or-part_323)
+ (if (syntax?$1
+ s_350)
+ (symbol?
+ (syntax-e$1
+ s_350))
+ #f)))
+ (if or-part_323
+ or-part_323
+ (symbol?
+ s_350)))
+ s_350
+ (raise-syntax-error$1
+ #f
+ "not an identifier"
+ orig-s_15
+ s_350))))
+ ((spec251_0
+ id252_0)
+ (let-values (((s_351)
+ (cdr
+ s_349)))
+ (let-values (((s_352)
+ (if (syntax?$1
+ s_351)
+ (syntax-e$1
+ s_351)
+ s_351)))
+ (if (pair?
+ s_352)
+ (let-values (((spec253_0)
+ (let-values (((s_353)
+ (car
+ s_352)))
+ s_353))
+ ((id254_0)
+ (let-values (((s_354)
+ (cdr
+ s_352)))
+ (let-values (((s_355)
+ (if (syntax?$1
+ s_354)
+ (syntax-e$1
+ s_354)
+ s_354)))
+ (let-values (((flat-s_9)
+ (to-syntax-list.1
+ s_355)))
+ (if (not
+ flat-s_9)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_15)
+ (let-values (((id_52)
+ (let-values (((id_53)
+ (let-values (((id_54)
+ null))
+ id_54)))
+ (let-values (((lst_240)
+ flat-s_9))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_240))
+ ((letrec-values (((for-loop_247)
+ (lambda (id_55
+ lst_241)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_241)
+ (let-values (((s_356)
+ (unsafe-car
+ lst_241))
+ ((rest_116)
+ (unsafe-cdr
+ lst_241)))
+ (let-values (((id_56)
+ (let-values (((id_57)
+ (let-values (((id255_0)
+ (if (let-values (((or-part_324)
+ (if (syntax?$1
+ s_356)
+ (symbol?
+ (syntax-e$1
+ s_356))
+ #f)))
+ (if or-part_324
+ or-part_324
+ (symbol?
+ s_356)))
+ s_356
+ (raise-syntax-error$1
+ #f
+ "not an identifier"
+ orig-s_15
+ s_356))))
+ (cons
+ id255_0
+ id_55))))
+ (values
+ id_57))))
+ (if (not
+ #f)
+ (for-loop_247
+ id_56
+ rest_116)
+ id_56)))
+ id_55)))))
+ for-loop_247)
+ id_53
+ lst_240))))))
+ (reverse$1
+ id_52))))))))
+ (values
+ spec253_0
+ id254_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_15))))))
+ (values
+ id:prefix250_0
+ spec251_0
+ id252_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_15))))))
+ (values
+ prefix-all-except246_0
+ id:prefix247_0
+ spec248_0
+ id249_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_15)))))
+ (values
+ #t
+ prefix-all-except242_1
+ id:prefix243_1
+ spec244_1
+ id245_1))))))
+ (loop_96
+ (list
+ spec244_0)
+ (let-values (((or-part_325)
+ top-req_0))
+ (if or-part_325
+ or-part_325
+ req_1))
+ phase-shift_8
+ space-level_1
+ just-meta_0
+ just-space_0
+ (adjust-all-except3.1
+ (syntax-e$1
+ id:prefix243_0)
+ (ids->sym-set
+ id245_0))
+ #f
+ #f
+ 'path)))
+ (let-values ((()
+ (begin
+ (check-nested_0
+ 'justspaceless)
+ (values))))
+ (let-values (((ok?_13
+ rename256_0
+ spec257_0
+ id:to258_0
+ id:from259_0)
+ (let-values (((s_357)
+ req_1))
+ (let-values (((orig-s_16)
+ s_357))
+ (let-values (((rename256_1
+ spec257_1
+ id:to258_1
+ id:from259_1)
+ (let-values (((s_358)
+ (if (syntax?$1
+ s_357)
+ (syntax-e$1
+ s_357)
+ s_357)))
+ (if (pair?
+ s_358)
+ (let-values (((rename260_0)
+ (let-values (((s_359)
+ (car
+ s_358)))
+ s_359))
+ ((spec261_0
+ id:to262_0
+ id:from263_0)
+ (let-values (((s_360)
+ (cdr
+ s_358)))
+ (let-values (((s_361)
+ (if (syntax?$1
+ s_360)
+ (syntax-e$1
+ s_360)
+ s_360)))
+ (if (pair?
+ s_361)
+ (let-values (((spec264_0)
+ (let-values (((s_362)
+ (car
+ s_361)))
+ s_362))
+ ((id:to265_0
+ id:from266_0)
+ (let-values (((s_363)
+ (cdr
+ s_361)))
+ (let-values (((s_364)
+ (if (syntax?$1
+ s_363)
+ (syntax-e$1
+ s_363)
+ s_363)))
+ (if (pair?
+ s_364)
+ (let-values (((id:to267_0)
+ (let-values (((s_365)
+ (car
+ s_364)))
+ (if (let-values (((or-part_326)
+ (if (syntax?$1
+ s_365)
+ (symbol?
+ (syntax-e$1
+ s_365))
+ #f)))
+ (if or-part_326
+ or-part_326
+ (symbol?
+ s_365)))
+ s_365
+ (raise-syntax-error$1
+ #f
+ "not an identifier"
+ orig-s_16
+ s_365))))
+ ((id:from268_0)
+ (let-values (((s_366)
+ (cdr
+ s_364)))
+ (let-values (((s_367)
+ (if (syntax?$1
+ s_366)
+ (syntax-e$1
+ s_366)
+ s_366)))
+ (if (pair?
+ s_367)
+ (let-values (((id:from269_0)
+ (let-values (((s_368)
+ (car
+ s_367)))
+ (if (let-values (((or-part_327)
+ (if (syntax?$1
+ s_368)
+ (symbol?
+ (syntax-e$1
+ s_368))
+ #f)))
+ (if or-part_327
+ or-part_327
+ (symbol?
+ s_368)))
+ s_368
+ (raise-syntax-error$1
+ #f
+ "not an identifier"
+ orig-s_16
+ s_368))))
+ (()
+ (let-values (((s_369)
+ (cdr
+ s_367)))
+ (let-values (((s_370)
+ (if (syntax?$1
+ s_369)
+ (syntax-e$1
+ s_369)
+ s_369)))
+ (if (null?
+ s_370)
+ (values)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_16))))))
+ (values
+ id:from269_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_16))))))
+ (values
+ id:to267_0
+ id:from268_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_16))))))
+ (values
+ spec264_0
+ id:to265_0
+ id:from266_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_16))))))
+ (values
+ rename260_0
+ spec261_0
+ id:to262_0
+ id:from263_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_16)))))
+ (values
+ #t
+ rename256_1
+ spec257_1
+ id:to258_1
+ id:from259_1))))))
+ (loop_96
+ (list
+ spec257_0)
+ (let-values (((or-part_328)
+ top-req_0))
+ (if or-part_328
+ or-part_328
+ req_1))
+ phase-shift_8
+ space-level_1
+ just-meta_0
+ just-space_0
+ (adjust-rename4.1
+ id:to258_0
+ (syntax-e$1
+ id:from259_0))
+ #f
+ #f
+ 'path))))))))))))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_244
+ rest_113)
+ (values))))
+ (values))))))
+ for-loop_244)
+ lst_234)))
+ (void))))))
+ loop_96)
+ reqs_0
+ #f
+ phase-shift_7
+ '#:none
+ 'all
+ #t
+ #f
+ #t
+ #t
+ 'raw)))))))))))))))))))))
(define-values
(ids->sym-set)
(lambda (ids_4)
(begin
- (let-values (((lst_164) ids_4))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_164)))
- ((letrec-values (((for-loop_197)
- (lambda (table_136 lst_165)
- (begin
- 'for-loop
- (if (pair? lst_165)
- (let-values (((id_51) (unsafe-car lst_165)) ((rest_82) (unsafe-cdr lst_165)))
- (let-values (((table_137)
- (let-values (((table_138) table_136))
- (let-values (((table_139)
- (let-values ()
- (let-values (((key_57 val_42)
- (let-values ()
- (values
- (let-values () (syntax-e$1 id_51))
- #t))))
- (hash-set table_138 key_57 val_42)))))
- (values table_139)))))
- (if (not #f) (for-loop_197 table_137 rest_82) table_137)))
- table_136)))))
- for-loop_197)
- '#hash()
- lst_164))))))
+ (let-values (((table_165) (let-values (((table_166) '#hash())) table_166)))
+ (let-values (((lst_242) ids_4))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_242))
+ ((letrec-values (((for-loop_248)
+ (lambda (table_167 lst_243)
+ (begin
+ 'for-loop
+ (if (pair? lst_243)
+ (let-values (((id_58) (unsafe-car lst_243)) ((rest_117) (unsafe-cdr lst_243)))
+ (let-values (((table_168)
+ (let-values (((table_169)
+ (let-values (((key_60 val_44)
+ (values (syntax-e$1 id_58) #t)))
+ (hash-set table_167 key_60 val_44))))
+ (values table_169))))
+ (if (not #f) (for-loop_248 table_168 rest_117) table_168)))
+ table_167)))))
+ for-loop_248)
+ table_165
+ lst_242)))))))
(define-values
(same-scopes?)
- (lambda (a_33 b_81) (begin (equal? (syntax-scope-set a_33 0) (syntax-scope-set b_81 0)))))
+ (lambda (a_39 b_103) (begin (equal? (syntax-scope-set a_39 0) (syntax-scope-set b_103 0)))))
+ (define-values
+ (build-initial-require-mpi)
+ (lambda (mod-path_8 self_15)
+ (begin
+ (let-values (((mod-path270_0) mod-path_8) ((self271_0) self_15))
+ (module-path->mpi.1 '#hasheq() mod-path270_0 self271_0)))))
(define-values
(perform-initial-require!.1)
- (lambda (bind?35_0 who36_0 mod-path39_0 self40_0 in-stx41_0 m-ns42_0 requires+provides43_0)
+ (lambda (bind?35_0 who36_0 mpi39_0 self40_0 in-stx41_0 m-ns42_0 requires+provides43_0)
(begin
'perform-initial-require!
- (let-values (((mod-path_7) mod-path39_0))
- (let-values (((self_13) self40_0))
+ (let-values (((mpi_65) mpi39_0))
+ (let-values (((self_16) self40_0))
(let-values (((in-stx_0) in-stx41_0))
(let-values (((m-ns_10) m-ns42_0))
(let-values (((requires+provides_2) requires+provides43_0))
(let-values (((bind?_0) bind?35_0))
- (let-values (((who_15) who36_0))
- (let-values ()
- (let-values (((temp270_0)
- (let-values (((mod-path282_0) mod-path_7) ((self283_0) self_13))
- (module-path->mpi.1 '#hasheq() mod-path282_0 self283_0)))
- ((temp271_0) #f)
- ((self272_0) self_13)
- ((in-stx273_0) in-stx_0)
- ((m-ns274_0) m-ns_10)
- ((temp275_0) 0)
- ((temp276_0) 0)
- ((requires+provides277_0) requires+provides_2)
- ((temp278_0) #t)
- ((temp279_0) #t)
- ((bind?280_0) bind?_0)
- ((who281_0) who_15))
- (perform-require!.1
- #f
- bind?280_0
- temp278_0
- #f
- #f
- temp279_0
- 'all
- #t
- temp275_0
- requires+provides277_0
- temp276_0
- #f
- #f
- unsafe-undefined
- #t
- who281_0
- temp270_0
- temp271_0
- self272_0
- in-stx273_0
- m-ns274_0)))))))))))))
+ (let-values (((who_23) who36_0))
+ (let-values (((mpi272_0) mpi_65)
+ ((temp273_1) #f)
+ ((self274_0) self_16)
+ ((in-stx275_0) in-stx_0)
+ ((m-ns276_0) m-ns_10)
+ ((temp277_1) 0)
+ ((temp278_0) 0)
+ ((requires+provides279_0) requires+provides_2)
+ ((temp280_0) #t)
+ ((temp281_0) #t)
+ ((bind?282_0) bind?_0)
+ ((who283_0) who_23))
+ (perform-require!.1
+ #f
+ bind?282_0
+ temp280_0
+ #f
+ #f
+ temp281_0
+ 'all
+ #t
+ temp277_1
+ requires+provides279_0
+ temp278_0
+ #f
+ #f
+ unsafe-undefined
+ #t
+ who283_0
+ mpi272_0
+ temp273_1
+ self274_0
+ in-stx275_0
+ m-ns276_0))))))))))))
(define-values
(perform-require!.1)
(lambda (adjust50_0
@@ -29786,14 +30050,14 @@
m-ns81_0)
(begin
'perform-require!
- (let-values (((mpi_46) mpi77_0))
+ (let-values (((mpi_66) mpi77_0))
(let-values (((orig-s_17) orig-s78_0))
(let-values ()
(let-values (((in-stx_1) in-stx80_0))
(let-values (((m-ns_11) m-ns81_0))
- (let-values (((phase-shift_8) phase-shift45_0))
+ (let-values (((phase-shift_9) phase-shift45_0))
(let-values (((space-level_2) (if (eq? space-level46_0 unsafe-undefined) '#:none space-level46_0)))
- (let-values (((run-phase_6) run-phase47_0))
+ (let-values (((run-phase_7) run-phase47_0))
(let-values (((just-meta_1) just-meta48_0))
(let-values (((just-space_1) just-space49_0))
(let-values (((adjust_1) adjust50_0))
@@ -29806,636 +30070,602 @@
(let-values (((copy-variable-as-constant?_1) copy-variable-as-constant?57_0))
(let-values (((skip-variable-phase-level_1) skip-variable-phase-level58_0))
(let-values (((bind?_1) bind?59_0))
- (let-values (((who_16) who60_0))
- (let-values ()
- (begin
- (if log-performance?
- (let-values () (start-performance-region 'expand 'require))
- (void))
- (begin0
- (let-values ()
- (let-values (((module-name_0)
- (1/module-path-index-resolve
- mpi_46
- #t
- orig-s_17)))
- (let-values (((bind-in-stx_0)
- (if (adjust-rename? adjust_1)
- (adjust-rename-to-id adjust_1)
- in-stx_1)))
- (let-values (((done-syms_0) (if adjust_1 (make-hasheq) #f)))
- (let-values (((m_16)
- (namespace->module m-ns_11 module-name_0)))
- (let-values ((()
- (begin
- (if m_16
- (void)
- (let-values ()
- (raise-unknown-module-error
- 'require
- module-name_0)))
- (values))))
- (let-values (((interned-mpi_0)
- (if requires+provides_3
- (add-required-module!
- requires+provides_3
- mpi_46
- (intern-phase+space-shift
- phase-shift_8
- space-level_2)
- (module-cross-phase-persistent?
- m_16))
- mpi_46)))
+ (let-values (((who_24) who60_0))
+ (begin
+ (if log-performance?
+ (start-performance-region 'expand 'require)
+ (void))
+ (begin0
+ (let-values (((module-name_0)
+ (1/module-path-index-resolve mpi_66 #t orig-s_17)))
+ (let-values (((bind-in-stx_0)
+ (if (adjust-rename? adjust_1)
+ (adjust-rename-to-id adjust_1)
+ in-stx_1)))
+ (let-values (((done-syms_0) (if adjust_1 (make-hasheq) #f)))
+ (let-values (((m_21)
+ (namespace->module m-ns_11 module-name_0)))
+ (let-values ((()
+ (begin
+ (if m_21
+ (void)
+ (raise-unknown-module-error
+ 'require
+ module-name_0))
+ (values))))
+ (let-values (((interned-mpi_0)
+ (if requires+provides_3
+ (add-required-module!
+ requires+provides_3
+ mpi_66
+ (intern-phase+space-shift
+ phase-shift_9
+ space-level_2)
+ (module-cross-phase-persistent? m_21))
+ mpi_66)))
+ (let-values (((transitive-requires_1)
+ (if requires+provides_3
+ (requires+provides-transitive-requires
+ requires+provides_3)
+ #f)))
+ (let-values ((()
+ (begin
+ (if visit?_2
+ (let-values (((m-ns303_0) m-ns_11)
+ ((interned-mpi304_0)
+ interned-mpi_0)
+ ((phase-shift305_0)
+ phase-shift_9)
+ ((run-phase306_0)
+ run-phase_7)
+ ((transitive-requires307_0)
+ transitive-requires_1))
+ (namespace-module-visit!.1
+ transitive-requires307_0
+ run-phase306_0
+ m-ns303_0
+ interned-mpi304_0
+ phase-shift305_0))
+ (void))
+ (values))))
(let-values ((()
(begin
- (if visit?_2
- (let-values ()
- (let-values (((m-ns303_0)
- m-ns_11)
- ((interned-mpi304_0)
- interned-mpi_0)
- ((phase-shift305_0)
- phase-shift_8)
- ((run-phase306_0)
- run-phase_6))
- (namespace-module-visit!.1
- run-phase306_0
- m-ns303_0
- interned-mpi304_0
- phase-shift305_0)))
+ (if run?_2
+ (let-values (((m-ns308_0) m-ns_11)
+ ((interned-mpi309_0)
+ interned-mpi_0)
+ ((phase-shift310_0)
+ phase-shift_9)
+ ((run-phase311_0)
+ run-phase_7)
+ ((transitive-requires312_0)
+ transitive-requires_1))
+ (namespace-module-instantiate!.1
+ #f
+ #t
+ #t
+ run-phase311_0
+ '#hasheq()
+ null
+ #f
+ transitive-requires312_0
+ m-ns308_0
+ interned-mpi309_0
+ phase-shift310_0))
(void))
(values))))
(let-values ((()
(begin
- (if run?_2
- (let-values ()
- (let-values (((m-ns307_0)
- m-ns_11)
- ((interned-mpi308_0)
- interned-mpi_0)
- ((phase-shift309_0)
- phase-shift_8)
- ((run-phase310_0)
- run-phase_6))
- (namespace-module-instantiate!.1
- #f
- #t
- run-phase310_0
- '#hasheq()
- null
- #f
- m-ns307_0
- interned-mpi308_0
- phase-shift309_0)))
+ (if (not
+ (let-values (((or-part_329)
+ visit?_2))
+ (if or-part_329
+ or-part_329
+ run?_2)))
+ (let-values (((m-ns313_0)
+ m-ns_11)
+ ((interned-mpi314_0)
+ interned-mpi_0)
+ ((phase-shift315_0)
+ phase-shift_9)
+ ((run-phase316_0)
+ run-phase_7)
+ ((transitive-requires317_0)
+ transitive-requires_1))
+ (namespace-module-make-available!.1
+ transitive-requires317_0
+ run-phase316_0
+ m-ns313_0
+ interned-mpi314_0
+ phase-shift315_0))
(void))
(values))))
- (let-values ((()
- (begin
- (if (not
- (let-values (((or-part_208)
- visit?_2))
- (if or-part_208
- or-part_208
- run?_2)))
- (let-values ()
- (let-values (((m-ns311_0)
- m-ns_11)
- ((interned-mpi312_0)
- interned-mpi_0)
- ((phase-shift313_0)
- phase-shift_8)
- ((run-phase314_0)
- run-phase_6))
- (namespace-module-make-available!.1
- run-phase314_0
- m-ns311_0
- interned-mpi312_0
- phase-shift313_0)))
- (void))
- (values))))
- (let-values (((can-bulk-bind?_0)
- (if (eq? space-level_2 '#:none)
- (if (let-values (((or-part_209)
- (not
- adjust_1)))
- (if or-part_209
- or-part_209
- (let-values (((or-part_210)
- (adjust-prefix?
- adjust_1)))
- (if or-part_210
- or-part_210
- (adjust-all-except?
- adjust_1)))))
- (not
- skip-variable-phase-level_1)
- #f)
- #f)))
- (let-values (((bulk-prefix_1)
- (if (adjust-prefix? adjust_1)
- (let-values ()
- (adjust-prefix-sym
- adjust_1))
- (if (adjust-all-except?
- adjust_1)
- (let-values ()
- (adjust-all-except-prefix-sym
- adjust_1))
- (let-values () #f)))))
- (let-values (((bulk-excepts_1)
- (if (adjust-all-except?
- adjust_1)
- (let-values ()
- (adjust-all-except-syms
- adjust_1))
- (let-values ()
- '#hasheq()))))
- (let-values (((update-nominals-box_0)
- (if can-bulk-bind?_0
- (box null)
- #f)))
- (let-values ((()
- (begin
- (let-values (((m284_0)
- m_16)
- ((bind-in-stx285_0)
- bind-in-stx_0)
- ((phase-shift286_0)
- phase-shift_8)
- ((space-level287_0)
- space-level_2)
- ((m-ns288_0)
- m-ns_11)
- ((interned-mpi289_0)
- interned-mpi_0)
- ((module-name290_0)
- module-name_0)
- ((requires+provides291_0)
- requires+provides_3)
- ((orig-s292_0)
- orig-s_17)
- ((temp293_0)
- (if requires+provides_3
- (requires+provides-self
- requires+provides_3)
- #f))
- ((temp294_0)
- (if (adjust-only?
+ (let-values (((can-bulk-bind?_0)
+ (if (eq? space-level_2 '#:none)
+ (if (let-values (((or-part_330)
+ (not
+ adjust_1)))
+ (if or-part_330
+ or-part_330
+ (let-values (((or-part_331)
+ (adjust-prefix?
+ adjust_1)))
+ (if or-part_331
+ or-part_331
+ (adjust-all-except?
+ adjust_1)))))
+ (not
+ skip-variable-phase-level_1)
+ #f)
+ #f)))
+ (let-values (((bulk-prefix_1)
+ (if (adjust-prefix? adjust_1)
+ (adjust-prefix-sym adjust_1)
+ (if (adjust-all-except?
+ adjust_1)
+ (adjust-all-except-prefix-sym
+ adjust_1)
+ #f))))
+ (let-values (((bulk-excepts_1)
+ (if (adjust-all-except?
+ adjust_1)
+ (adjust-all-except-syms
+ adjust_1)
+ '#hasheq())))
+ (let-values (((update-nominals-box_0)
+ (if can-bulk-bind?_0
+ (box null)
+ #f)))
+ (let-values ((()
+ (begin
+ (let-values (((m284_0)
+ m_21)
+ ((bind-in-stx285_0)
+ bind-in-stx_0)
+ ((phase-shift286_0)
+ phase-shift_9)
+ ((space-level287_0)
+ space-level_2)
+ ((m-ns288_0)
+ m-ns_11)
+ ((interned-mpi289_0)
+ interned-mpi_0)
+ ((module-name290_0)
+ module-name_0)
+ ((requires+provides291_0)
+ requires+provides_3)
+ ((orig-s292_0)
+ orig-s_17)
+ ((temp293_0)
+ (if requires+provides_3
+ (requires+provides-self
+ requires+provides_3)
+ #f))
+ ((temp294_0)
+ (if (adjust-only?
+ adjust_1)
+ (set->list
+ (adjust-only-syms
+ adjust_1))
+ (if (adjust-rename?
adjust_1)
- (let-values ()
- (set->list
- (adjust-only-syms
- adjust_1)))
- (if (adjust-rename?
- adjust_1)
- (let-values ()
- (list
- (adjust-rename-from-sym
- adjust_1)))
- (let-values ()
- #f))))
- ((just-meta295_0)
- just-meta_1)
- ((just-space296_0)
- just-space_1)
- ((bind?297_0)
- bind?_1)
- ((can-bulk-bind?298_0)
- can-bulk-bind?_0)
- ((bulk-prefix299_0)
- bulk-prefix_1)
- ((bulk-excepts300_0)
- bulk-excepts_1)
- ((temp301_0)
- (if requires+provides_3
- (if can-bulk-bind?_0
- (lambda (provides_9
- provide-phase+space_4)
- (begin
- 'temp301
- (let-values (((requires+provides315_0)
- requires+provides_3)
- ((bind-in-stx316_0)
- bind-in-stx_0)
- ((temp317_0)
- (module-self
- m_16))
- ((mpi318_0)
- mpi_46)
- ((phase-shift319_0)
- phase-shift_8)
- ((provides320_0)
- provides_9)
- ((provide-phase+space321_0)
- provide-phase+space_4)
- ((bulk-prefix322_0)
- bulk-prefix_1)
- ((bulk-excepts323_0)
- bulk-excepts_1)
- ((temp324_0)
- (if (positive?
- (hash-count
- bulk-excepts_1))
- done-syms_0
- #f))
- ((can-be-shadowed?325_0)
- can-be-shadowed?_3)
- ((temp326_0)
- (not
- initial-require?_1))
- ((orig-s327_0)
- orig-s_17)
- ((update-nominals-box328_0)
- update-nominals-box_0)
- ((who329_0)
- who_16))
- (add-bulk-required-ids!.1
- update-nominals-box328_0
- can-be-shadowed?325_0
- temp326_0
- bulk-excepts323_0
- orig-s327_0
- bulk-prefix322_0
- temp324_0
- who329_0
- requires+provides315_0
- bind-in-stx316_0
- temp317_0
- mpi318_0
- phase-shift319_0
- provides320_0
- provide-phase+space321_0))))
- #f)
- #f))
- ((temp302_0)
- (if (let-values (((or-part_211)
- (not
- can-bulk-bind?_0)))
- (if or-part_211
- or-part_211
- copy-variable-phase-level_1))
- (lambda (binding_15
- as-transformer?_4)
+ (list
+ (adjust-rename-from-sym
+ adjust_1))
+ #f)))
+ ((just-meta295_0)
+ just-meta_1)
+ ((just-space296_0)
+ just-space_1)
+ ((bind?297_0)
+ bind?_1)
+ ((can-bulk-bind?298_0)
+ can-bulk-bind?_0)
+ ((bulk-prefix299_0)
+ bulk-prefix_1)
+ ((bulk-excepts300_0)
+ bulk-excepts_1)
+ ((temp301_0)
+ (if requires+provides_3
+ (if can-bulk-bind?_0
+ (lambda (provides_10
+ provide-phase+space_4)
(begin
- 'temp302
- (let-values (((sym_45)
- (module-binding-nominal-sym
- binding_15)))
- (let-values (((provide-phase+space_5)
- (module-binding-nominal-phase+space
- binding_15)))
- (let-values (((provide-phase_0)
- (phase+space-phase
+ 'temp301
+ (let-values (((requires+provides318_0)
+ requires+provides_3)
+ ((bind-in-stx319_0)
+ bind-in-stx_0)
+ ((temp320_0)
+ (module-self
+ m_21))
+ ((mpi321_0)
+ mpi_66)
+ ((phase-shift322_0)
+ phase-shift_9)
+ ((provides323_0)
+ provides_10)
+ ((provide-phase+space324_0)
+ provide-phase+space_4)
+ ((bulk-prefix325_0)
+ bulk-prefix_1)
+ ((bulk-excepts326_0)
+ bulk-excepts_1)
+ ((temp327_0)
+ (if (positive?
+ (hash-count
+ bulk-excepts_1))
+ done-syms_0
+ #f))
+ ((can-be-shadowed?328_0)
+ can-be-shadowed?_3)
+ ((temp329_0)
+ (not
+ initial-require?_1))
+ ((orig-s330_0)
+ orig-s_17)
+ ((update-nominals-box331_0)
+ update-nominals-box_0)
+ ((who332_0)
+ who_24))
+ (add-bulk-required-ids!.1
+ update-nominals-box331_0
+ can-be-shadowed?328_0
+ temp329_0
+ bulk-excepts326_0
+ orig-s330_0
+ bulk-prefix325_0
+ temp327_0
+ who332_0
+ requires+provides318_0
+ bind-in-stx319_0
+ temp320_0
+ mpi321_0
+ phase-shift322_0
+ provides323_0
+ provide-phase+space324_0))))
+ #f)
+ #f))
+ ((temp302_0)
+ (if (let-values (((or-part_332)
+ (not
+ can-bulk-bind?_0)))
+ (if or-part_332
+ or-part_332
+ copy-variable-phase-level_1))
+ (lambda (binding_16
+ as-transformer?_4)
+ (begin
+ 'temp302
+ (let-values (((sym_57)
+ (module-binding-nominal-sym
+ binding_16)))
+ (let-values (((provide-phase+space_5)
+ (module-binding-nominal-phase+space
+ binding_16)))
+ (let-values (((provide-phase_0)
+ (phase+space-phase
+ provide-phase+space_5)))
+ (let-values (((provide-space_0)
+ (phase+space-space
provide-phase+space_5)))
- (let-values (((provide-space_0)
- (phase+space-space
- provide-phase+space_5)))
- (let-values (((adjusted-sym_0)
- (if (not
- (symbol-interned?
- sym_45))
- (let-values ()
- #f)
- (if (if skip-variable-phase-level_1
- (if (not
- as-transformer?_4)
- (equal?
- provide-phase_0
- skip-variable-phase-level_1)
- #f)
+ (let-values (((adjusted-sym_0)
+ (if (not
+ (symbol-interned?
+ sym_57))
+ #f
+ (if (if skip-variable-phase-level_1
+ (if (not
+ as-transformer?_4)
+ (equal?
+ provide-phase_0
+ skip-variable-phase-level_1)
#f)
- (let-values ()
#f)
- (if (not
+ #f
+ (if (not
+ adjust_1)
+ sym_57
+ (if (adjust-only?
adjust_1)
- (let-values ()
- sym_45)
- (if (adjust-only?
+ (if (set-member?
+ (adjust-only-syms
+ adjust_1)
+ sym_57)
+ (if (hash-set!
+ done-syms_0
+ sym_57
+ #t)
+ sym_57
+ #f)
+ #f)
+ (if (adjust-prefix?
adjust_1)
- (let-values ()
- (if (set-member?
- (adjust-only-syms
- adjust_1)
- sym_45)
- (if (hash-set!
- done-syms_0
- sym_45
- #t)
- sym_45
- #f)
- #f))
- (if (adjust-prefix?
+ (string->symbol
+ (string-append
+ (symbol->string
+ (adjust-prefix-sym
+ adjust_1))
+ (symbol->string
+ sym_57)))
+ (if (adjust-all-except?
adjust_1)
- (let-values ()
+ (if (not
+ (if (set-member?
+ (adjust-all-except-syms
+ adjust_1)
+ sym_57)
+ (hash-set!
+ done-syms_0
+ sym_57
+ #t)
+ #f))
(string->symbol
(string-append
(symbol->string
- (adjust-prefix-sym
+ (adjust-all-except-prefix-sym
adjust_1))
(symbol->string
- sym_45))))
- (if (adjust-all-except?
+ sym_57)))
+ #f)
+ (if (adjust-rename?
adjust_1)
- (let-values ()
- (if (not
- (if (set-member?
- (adjust-all-except-syms
- adjust_1)
- sym_45)
- (hash-set!
- done-syms_0
- sym_45
- #t)
- #f))
- (string->symbol
- (string-append
- (symbol->string
- (adjust-all-except-prefix-sym
- adjust_1))
- (symbol->string
- sym_45)))
- #f))
- (if (adjust-rename?
+ (if (eq?
+ sym_57
+ (adjust-rename-from-sym
+ adjust_1))
+ (if (hash-set!
+ done-syms_0
+ sym_57
+ #t)
+ (adjust-rename-to-id
adjust_1)
- (let-values ()
- (if (eq?
- sym_45
- (adjust-rename-from-sym
- adjust_1))
- (if (hash-set!
- done-syms_0
- sym_45
- #t)
- (adjust-rename-to-id
- adjust_1)
- #f)
- #f))
- (void))))))))))
- (let-values (((skip-bind?_0)
- (if (if adjusted-sym_0
- requires+provides_3
- #f)
- (let-values ()
- (let-values (((bind-phase_0)
- (phase+
- phase-shift_8
- provide-phase_0)))
- (let-values (((bind-space_0)
- (space+
- provide-space_0
- space-level_2)))
- (let-values (((s_197)
- (add-space-scope
- (datum->syntax$1
- bind-in-stx_0
- adjusted-sym_0)
- bind-space_0)))
- (let-values (((bound-status_1)
- (if initial-require?_1
- (let-values ()
- #f)
- (let-values ()
- (begin
- (adjust-shadow-requires!
- requires+provides_3
- s_197
- bind-phase_0
- bind-space_0)
- (let-values (((temp330_0)
- #t)
- ((temp331_0)
- (requires+provides-definitions-shadow-imports?
- requires+provides_3))
- ((requires+provides332_0)
- requires+provides_3)
- ((s333_0)
- s_197)
- ((bind-phase334_0)
- bind-phase_0)
- ((bind-space335_0)
- bind-space_0)
- ((binding336_0)
- binding_15)
- ((orig-s337_0)
- orig-s_17)
- ((temp338_0)
- #t)
- ((who339_0)
- who_16))
- (check-not-defined.1
- #f
- temp331_0
- temp330_0
- orig-s337_0
- temp338_0
- binding336_0
- who339_0
- requires+provides332_0
- s333_0
- bind-phase334_0
- bind-space335_0)))))))
- (begin
- (if (eq?
- bound-status_1
- 'defined)
- (void)
- (let-values ()
- (let-values (((requires+provides340_0)
- requires+provides_3)
- ((s341_0)
- s_197)
- ((temp342_0)
- (intern-phase+space
- bind-phase_0
- bind-space_0))
- ((binding343_0)
- binding_15)
- ((can-be-shadowed?344_0)
- can-be-shadowed?_3)
- ((as-transformer?345_0)
- as-transformer?_4))
- (add-defined-or-required-id!.1
- as-transformer?345_0
- can-be-shadowed?344_0
- requires+provides340_0
- s341_0
- temp342_0
- binding343_0))))
- bound-status_1))))))
- (let-values ()
- #f))))
- (begin
- (if (if copy-variable-phase-level_1
- (if (not
- as-transformer?_4)
- (equal?
- provide-phase_0
- copy-variable-phase-level_1)
- #f)
+ #f)
+ #f)
+ (void))))))))))
+ (let-values (((skip-bind?_0)
+ (if (if adjusted-sym_0
+ requires+provides_3
+ #f)
+ (let-values (((bind-phase_0)
+ (phase+
+ phase-shift_9
+ provide-phase_0)))
+ (let-values (((bind-space_0)
+ (space+
+ provide-space_0
+ space-level_2)))
+ (let-values (((s_371)
+ (add-space-scope
+ (datum->syntax$1
+ bind-in-stx_0
+ adjusted-sym_0)
+ bind-space_0)))
+ (let-values (((bound-status_1)
+ (if initial-require?_1
+ #f
+ (begin
+ (adjust-shadow-requires!
+ requires+provides_3
+ s_371
+ bind-phase_0
+ bind-space_0)
+ (let-values (((temp333_0)
+ #t)
+ ((temp334_0)
+ (requires+provides-definitions-shadow-imports?
+ requires+provides_3))
+ ((requires+provides335_0)
+ requires+provides_3)
+ ((s336_0)
+ s_371)
+ ((bind-phase337_0)
+ bind-phase_0)
+ ((bind-space338_0)
+ bind-space_0)
+ ((binding339_0)
+ binding_16)
+ ((orig-s340_0)
+ orig-s_17)
+ ((temp341_0)
+ #t)
+ ((who342_0)
+ who_24))
+ (check-not-defined.1
+ #f
+ temp334_0
+ temp333_0
+ orig-s340_0
+ temp341_0
+ binding339_0
+ who342_0
+ requires+provides335_0
+ s336_0
+ bind-phase337_0
+ bind-space338_0))))))
+ (begin
+ (if (eq?
+ bound-status_1
+ 'defined)
+ (void)
+ (let-values (((requires+provides343_0)
+ requires+provides_3)
+ ((s344_0)
+ s_371)
+ ((temp345_0)
+ (intern-phase+space
+ bind-phase_0
+ bind-space_0))
+ ((binding346_0)
+ binding_16)
+ ((can-be-shadowed?347_0)
+ can-be-shadowed?_3)
+ ((as-transformer?348_0)
+ as-transformer?_4))
+ (add-defined-or-required-id!.1
+ as-transformer?348_0
+ can-be-shadowed?347_0
+ requires+provides343_0
+ s344_0
+ temp345_0
+ binding346_0)))
+ bound-status_1)))))
+ #f)))
+ (begin
+ (if (if copy-variable-phase-level_1
+ (if (not
+ as-transformer?_4)
+ (equal?
+ provide-phase_0
+ copy-variable-phase-level_1)
#f)
- (let-values ()
- (copy-namespace-value
- m-ns_11
- sym_45
- binding_15
- copy-variable-phase-level_1
- phase-shift_8
- copy-variable-as-constant?_1))
- (void))
- (if (not
- skip-bind?_0)
- adjusted-sym_0
- #f))))))))))
- #f)))
- (bind-all-provides!.1
- bind?297_0
- temp301_0
- bulk-excepts300_0
- bulk-prefix299_0
- can-bulk-bind?298_0
- temp293_0
- temp302_0
- orig-s292_0
- just-meta295_0
- just-space296_0
- temp294_0
- m284_0
- bind-in-stx285_0
- phase-shift286_0
- space-level287_0
- m-ns288_0
- interned-mpi289_0
- module-name290_0
- requires+provides291_0))
- (values))))
- (let-values ((()
- (begin
- (if update-nominals-box_0
- (let-values ()
+ #f)
+ (copy-namespace-value
+ m-ns_11
+ sym_57
+ binding_16
+ copy-variable-phase-level_1
+ phase-shift_9
+ copy-variable-as-constant?_1)
+ (void))
+ (if (not
+ skip-bind?_0)
+ adjusted-sym_0
+ #f))))))))))
+ #f)))
+ (bind-all-provides!.1
+ bind?297_0
+ temp301_0
+ bulk-excepts300_0
+ bulk-prefix299_0
+ can-bulk-bind?298_0
+ temp293_0
+ temp302_0
+ orig-s292_0
+ just-meta295_0
+ just-space296_0
+ temp294_0
+ m284_0
+ bind-in-stx285_0
+ phase-shift286_0
+ space-level287_0
+ m-ns288_0
+ interned-mpi289_0
+ module-name290_0
+ requires+provides291_0))
+ (values))))
+ (let-values ((()
+ (begin
+ (if update-nominals-box_0
+ (begin
+ (let-values (((lst_244)
+ (unbox
+ update-nominals-box_0)))
(begin
- (let-values (((lst_166)
- (unbox
- update-nominals-box_0)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_166)))
- ((letrec-values (((for-loop_198)
- (lambda (lst_167)
- (begin
- 'for-loop
- (if (pair?
- lst_167)
- (let-values (((update!_1)
- (unsafe-car
- lst_167))
- ((rest_83)
- (unsafe-cdr
- lst_167)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (update!_1))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_198
- rest_83)
- (values))))
- (values))))))
- for-loop_198)
- lst_166)))
- (void)))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_244))
+ ((letrec-values (((for-loop_249)
+ (lambda (lst_245)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_245)
+ (let-values (((update!_1)
+ (unsafe-car
+ lst_245))
+ ((rest_118)
+ (unsafe-cdr
+ lst_245)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (update!_1)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_249
+ rest_118)
+ (values))))
+ (values))))))
+ for-loop_249)
+ lst_244)))
(void))
- (values))))
- (let-values (((need-syms_0)
- (if (adjust-only?
+ (void))
+ (values))))
+ (let-values (((need-syms_0)
+ (if (adjust-only?
+ adjust_1)
+ (adjust-only-syms
+ adjust_1)
+ (if (adjust-all-except?
adjust_1)
- (let-values ()
- (adjust-only-syms
- adjust_1))
- (if (adjust-all-except?
+ (adjust-all-except-syms
+ adjust_1)
+ (if (adjust-rename?
adjust_1)
- (let-values ()
- (adjust-all-except-syms
- adjust_1))
- (if (adjust-rename?
- adjust_1)
- (let-values ()
- (set
- (adjust-rename-from-sym
- adjust_1)))
- (let-values ()
- #f))))))
- (if (if need-syms_0
- (not
- (=
- (set-count need-syms_0)
- (hash-count
- done-syms_0)))
- #f)
- (let-values ()
+ (set
+ (adjust-rename-from-sym
+ adjust_1))
+ #f)))))
+ (if (if need-syms_0
+ (not
+ (=
+ (set-count need-syms_0)
+ (hash-count done-syms_0)))
+ #f)
+ (begin
+ (let-values (((ht_140)
+ need-syms_0))
(begin
- (let-values (((ht_116)
- need-syms_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-immutable-hash-keys
- ht_116)))
- ((letrec-values (((for-loop_199)
- (lambda (i_159)
- (begin
- 'for-loop
- (if i_159
- (let-values (((sym_46)
- (unsafe-immutable-hash-iterate-key
- ht_116
- i_159)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (if (hash-ref
- done-syms_0
- sym_46
- #f)
- (void)
- (let-values ()
- (raise-syntax-error$1
- who_16
- "not in nested spec"
- orig-s_17
- sym_46))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_199
- (unsafe-immutable-hash-iterate-next
- ht_116
- i_159))
- (values))))
- (values))))))
- for-loop_199)
- (unsafe-immutable-hash-iterate-first
- ht_116))))
- (void)))
- (void)))))))))))))))))))
- (if log-performance?
- (let-values () (end-performance-region))
- (void)))))))))))))))))))))))))))))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys
+ ht_140))
+ ((letrec-values (((for-loop_250)
+ (lambda (i_217)
+ (begin
+ 'for-loop
+ (if i_217
+ (let-values (((sym_58)
+ (unsafe-immutable-hash-iterate-key
+ ht_140
+ i_217)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (if (hash-ref
+ done-syms_0
+ sym_58
+ #f)
+ (void)
+ (raise-syntax-error$1
+ who_24
+ "not in nested spec"
+ orig-s_17
+ sym_58))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_250
+ (unsafe-immutable-hash-iterate-next
+ ht_140
+ i_217))
+ (values))))
+ (values))))))
+ for-loop_250)
+ (unsafe-immutable-hash-iterate-first
+ ht_140))))
+ (void))
+ (void)))))))))))))))))))
+ (if log-performance?
+ (end-performance-region)
+ (void))))))))))))))))))))))))))))
(define-values
(bind-all-provides!.1)
(lambda (bind?88_0
@@ -30453,18 +30683,18 @@
in-stx106_0
phase-shift107_0
space-level108_0
- ns109_0
- mpi110_0
+ ns109_1
+ mpi110_1
module-name111_0
requires+provides112_0)
(begin
'bind-all-provides!
- (let-values (((m_17) m105_0))
+ (let-values (((m_22) m105_0))
(let-values (((in-stx_2) in-stx106_0))
- (let-values (((phase-shift_9) phase-shift107_0))
+ (let-values (((phase-shift_10) phase-shift107_0))
(let-values (((space-level_3) space-level108_0))
- (let-values (((ns_49) ns109_0))
- (let-values (((mpi_47) mpi110_0))
+ (let-values (((ns_55) ns109_1))
+ (let-values (((mpi_67) mpi110_1))
(let-values (((module-name_1) module-name111_0))
(let-values (((requires+provides_4) requires+provides112_0))
(let-values (((orig-s_18) in83_0))
@@ -30478,579 +30708,537 @@
(let-values (((bulk-excepts_2) bulk-excepts91_0))
(let-values (((filter_0) filter92_0))
(let-values (((bulk-callback_0) bulk-callback93_0))
- (let-values ()
- (let-values (((self_14) (module-self m_17)))
- (let-values (((phase+space-shift_9)
- (intern-phase+space-shift phase-shift_9 space-level_3)))
- (begin
- (let-values (((ht_117) (module-provides m_17)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_117)))
- ((letrec-values (((for-loop_200)
- (lambda (i_160)
- (begin
- 'for-loop
- (if i_160
- (let-values (((provide-phase+space_6
- provides_10)
- (hash-iterate-key+value
- ht_117
- i_160)))
- (let-values ((()
- (let-values ()
- (if (if (let-values (((or-part_212)
- (eq?
- just-meta_2
- 'all)))
- (if or-part_212
- or-part_212
- (eqv?
- just-meta_2
- (phase+space-phase
- provide-phase+space_6))))
- (let-values (((or-part_213)
- (eq?
- just-space_2
- #t)))
- (if or-part_213
- or-part_213
- (eqv?
- just-space_2
- (phase+space-space
- provide-phase+space_6))))
- #f)
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((phase+space_7)
- (phase+space+
- provide-phase+space_6
- phase+space-shift_9)))
- (let-values (((phase_70)
- (phase+space-phase
- phase+space_7)))
- (let-values (((space_11)
- (phase+space-space
- phase+space_7)))
- (let-values ((()
- (begin
- (if requires+provides_4
- (let-values ()
- (add-required-space!
- requires+provides_4
- space_11))
- (void))
- (values))))
- (let-values (((need-except?_0)
- (if bulk-callback_0
- (bulk-callback_0
- provides_10
- provide-phase+space_6)
- #f)))
- (if bind?_2
- (let-values ()
- (begin
- (if filter_0
- (let-values ()
- (begin
- (let-values (((lst_168)
- (let-values (((or-part_214)
- only-syms_0))
- (if or-part_214
- or-part_214
- (hash-keys
- provides_10)))))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_168)))
- ((letrec-values (((for-loop_201)
- (lambda (lst_169)
- (begin
- 'for-loop
- (if (pair?
- lst_169)
- (let-values (((sym_47)
- (unsafe-car
- lst_169))
- ((rest_84)
- (unsafe-cdr
- lst_169)))
+ (let-values (((self_17) (module-self m_22)))
+ (let-values (((phase+space-shift_9)
+ (intern-phase+space-shift phase-shift_10 space-level_3)))
+ (begin
+ (let-values (((ht_141) (module-provides m_22)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash ht_141))
+ ((letrec-values (((for-loop_251)
+ (lambda (i_218)
+ (begin
+ 'for-loop
+ (if i_218
+ (let-values (((provide-phase+space_6
+ provides_11)
+ (hash-iterate-key+value
+ ht_141
+ i_218)))
+ (let-values ((()
+ (if (if (let-values (((or-part_333)
+ (eq?
+ just-meta_2
+ 'all)))
+ (if or-part_333
+ or-part_333
+ (eqv?
+ just-meta_2
+ (phase+space-phase
+ provide-phase+space_6))))
+ (let-values (((or-part_334)
+ (eq?
+ just-space_2
+ #t)))
+ (if or-part_334
+ or-part_334
+ (eqv?
+ just-space_2
+ (phase+space-space
+ provide-phase+space_6))))
+ #f)
+ (let-values ((()
+ (begin
+ (let-values (((phase+space_8)
+ (phase+space+
+ provide-phase+space_6
+ phase+space-shift_9)))
+ (let-values (((phase_82)
+ (phase+space-phase
+ phase+space_8)))
+ (let-values (((space_11)
+ (phase+space-space
+ phase+space_8)))
+ (let-values ((()
+ (begin
+ (if requires+provides_4
+ (add-required-space!
+ requires+provides_4
+ space_11)
+ (void))
+ (values))))
+ (let-values (((need-except?_0)
+ (if bulk-callback_0
+ (bulk-callback_0
+ provides_11
+ provide-phase+space_6)
+ #f)))
+ (if bind?_2
+ (begin
+ (if filter_0
+ (begin
+ (let-values (((lst_246)
+ (let-values (((or-part_335)
+ only-syms_0))
+ (if or-part_335
+ or-part_335
+ (hash-keys
+ provides_11)))))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_246))
+ ((letrec-values (((for-loop_252)
+ (lambda (lst_247)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_247)
+ (let-values (((sym_59)
+ (unsafe-car
+ lst_247))
+ ((rest_119)
+ (unsafe-cdr
+ lst_247)))
+ (let-values ((()
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((binding/p_4)
- (hash-ref
- provides_10
- sym_47
- #f)))
- (if binding/p_4
- (let-values ()
- (let-values (((b_82)
- (let-values (((binding/p346_0)
- binding/p_4)
- ((sym347_0)
- sym_47)
- ((self348_0)
- self_14)
- ((mpi349_0)
- mpi_47)
- ((provide-phase+space350_0)
- provide-phase+space_6)
- ((phase+space-shift351_0)
- phase+space-shift_9))
- (provide-binding-to-require-binding.1
- mpi349_0
- phase+space-shift351_0
- provide-phase+space350_0
- self348_0
- binding/p346_0
- sym347_0))))
- (let-values (((sym_48)
- (filter_0
- b_82
- (provided-as-transformer?
- binding/p_4))))
- (if (if sym_48
- (not
- can-bulk?_0)
- #f)
- (let-values ()
- (let-values (((temp352_0)
- (add-space-scope
- (datum->syntax$1
- in-stx_2
- sym_48)
- space_11))
- ((b353_0)
- b_82)
- ((phase354_0)
- phase_70))
- (add-binding!.1
- #f
- #f
- temp352_0
- b353_0
- phase354_0)))
- (void)))))
- (void))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_201
- rest_84)
- (values))))
- (values))))))
- for-loop_201)
- lst_168)))
- (void)))
- (void))
- (if can-bulk?_0
- (let-values ()
- (let-values (((bulk-binding-registry_13)
- (namespace-bulk-binding-registry
- ns_49)))
- (let-values (((temp355_0)
- (add-space-scope
- in-stx_2
- space_11))
- ((temp356_0)
- (bulk-binding12.1
- (let-values (((or-part_215)
- (if (not
- bulk-prefix_2)
- (if (zero?
- (hash-count
- bulk-excepts_2))
- provides_10
- #f)
- #f)))
- (if or-part_215
- or-part_215
- (if (not
- (registered-bulk-provide?
- bulk-binding-registry_13
- module-name_1))
- (bulk-provides-add-prefix-remove-exceptions
- provides_10
- bulk-prefix_2
- bulk-excepts_2)
- #f)))
- bulk-prefix_2
- bulk-excepts_2
- self_14
- mpi_47
- provide-phase+space_6
- phase-shift_9
- bulk-binding-registry_13))
- ((phase357_0)
- phase_70)
- ((orig-s358_0)
- orig-s_18)
- ((temp359_0)
- (if need-except?_0
- defines-mpi_0
- #f)))
- (add-bulk-binding!.1
- orig-s358_0
- temp359_0
- temp355_0
- temp356_0
- phase357_0))))
- (void))))
- (void))))))))
- (values)))))
- (values)))
- (values)))))
- (if (not #f)
- (for-loop_200
- (hash-iterate-next ht_117 i_160))
- (values))))
- (values))))))
- for-loop_200)
- (hash-iterate-first ht_117))))
- (void)))))))))))))))))))))))))))
+ (begin
+ (let-values (((binding/p_5)
+ (hash-ref
+ provides_11
+ sym_59
+ #f)))
+ (if binding/p_5
+ (let-values (((b_104)
+ (let-values (((binding/p349_0)
+ binding/p_5)
+ ((sym350_0)
+ sym_59)
+ ((self351_0)
+ self_17)
+ ((mpi352_0)
+ mpi_67)
+ ((provide-phase+space353_0)
+ provide-phase+space_6)
+ ((phase+space-shift354_0)
+ phase+space-shift_9))
+ (provide-binding-to-require-binding.1
+ mpi352_0
+ phase+space-shift354_0
+ provide-phase+space353_0
+ self351_0
+ binding/p349_0
+ sym350_0))))
+ (let-values (((sym_60)
+ (filter_0
+ b_104
+ (provided-as-transformer?
+ binding/p_5))))
+ (if (if sym_60
+ (not
+ can-bulk?_0)
+ #f)
+ (let-values (((temp355_0)
+ (add-space-scope
+ (datum->syntax$1
+ in-stx_2
+ sym_60)
+ space_11))
+ ((b356_0)
+ b_104)
+ ((phase357_0)
+ phase_82))
+ (add-binding!.1
+ #f
+ #f
+ temp355_0
+ b356_0
+ phase357_0))
+ (void))))
+ (void)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_252
+ rest_119)
+ (values))))
+ (values))))))
+ for-loop_252)
+ lst_246)))
+ (void))
+ (void))
+ (if can-bulk?_0
+ (let-values (((bulk-binding-registry_14)
+ (namespace-bulk-binding-registry
+ ns_55)))
+ (let-values (((temp358_0)
+ (add-space-scope
+ in-stx_2
+ space_11))
+ ((temp359_0)
+ (bulk-binding12.1
+ (let-values (((or-part_336)
+ (if (not
+ bulk-prefix_2)
+ (if (zero?
+ (hash-count
+ bulk-excepts_2))
+ provides_11
+ #f)
+ #f)))
+ (if or-part_336
+ or-part_336
+ (if (not
+ (registered-bulk-provide?
+ bulk-binding-registry_14
+ module-name_1))
+ (bulk-provides-add-prefix-remove-exceptions
+ provides_11
+ bulk-prefix_2
+ bulk-excepts_2)
+ #f)))
+ bulk-prefix_2
+ bulk-excepts_2
+ self_17
+ mpi_67
+ provide-phase+space_6
+ phase-shift_10
+ bulk-binding-registry_14))
+ ((phase360_0)
+ phase_82)
+ ((orig-s361_0)
+ orig-s_18)
+ ((temp362_0)
+ (if need-except?_0
+ defines-mpi_0
+ #f)))
+ (add-bulk-binding!.1
+ orig-s361_0
+ temp362_0
+ temp358_0
+ temp359_0
+ phase360_0)))
+ (void)))
+ (void)))))))
+ (values))))
+ (values))
+ (values))))
+ (if (not #f)
+ (for-loop_251
+ (hash-iterate-next ht_141 i_218))
+ (values))))
+ (values))))))
+ for-loop_251)
+ (hash-iterate-first ht_141))))
+ (void))))))))))))))))))))))))))
(define-values
(require-spec-shift-for-syntax)
- (lambda (req_1)
+ (lambda (req_2)
(begin
(let-values (((rebuild-req_0)
- (lambda (req_2 new-req_0) (begin 'rebuild-req (datum->syntax$1 req_2 new-req_0 req_2 req_2)))))
- (letrec-values (((loop_89)
+ (lambda (req_3 new-req_0) (begin 'rebuild-req (datum->syntax$1 req_3 new-req_0 req_3 req_3)))))
+ (letrec-values (((loop_97)
(lambda (shifted?_0)
(begin
'loop
- (lambda (req_3)
+ (lambda (req_4)
(let-values (((fm_1)
- (if (pair? (syntax-e$1 req_3))
- (if (identifier? (car (syntax-e$1 req_3)))
- (syntax-e$1 (car (syntax-e$1 req_3)))
+ (if (pair? (syntax-e$1 req_4))
+ (if (identifier? (car (syntax-e$1 req_4)))
+ (syntax-e$1 (car (syntax-e$1 req_4)))
#f)
#f)))
- (let-values (((tmp_25) fm_1))
- (if (equal? tmp_25 'for-meta)
- (let-values ()
- (let-values (((ok?_14 for-meta360_0 phase-level361_0 spec362_0)
- (let-values (((s_290) req_3))
- (let-values (((orig-s_19) s_290))
- (let-values (((for-meta360_1 phase-level361_1 spec362_1)
- (let-values (((s_291)
- (if (syntax?$1 s_290)
- (syntax-e$1 s_290)
- s_290)))
- (if (pair? s_291)
- (let-values (((for-meta363_0)
- (let-values (((s_292)
- (car s_291)))
- s_292))
- ((phase-level364_0 spec365_0)
- (let-values (((s_293)
- (cdr s_291)))
- (let-values (((s_294)
+ (let-values (((tmp_26) fm_1))
+ (if (equal? tmp_26 'for-meta)
+ (let-values (((ok?_14 for-meta363_0 phase-level364_0 spec365_0)
+ (let-values (((s_372) req_4))
+ (let-values (((orig-s_19) s_372))
+ (let-values (((for-meta363_1 phase-level364_1 spec365_1)
+ (let-values (((s_373)
+ (if (syntax?$1 s_372)
+ (syntax-e$1 s_372)
+ s_372)))
+ (if (pair? s_373)
+ (let-values (((for-meta366_0)
+ (let-values (((s_374)
+ (car s_373)))
+ s_374))
+ ((phase-level367_0 spec368_0)
+ (let-values (((s_375)
+ (cdr s_373)))
+ (let-values (((s_376)
+ (if (syntax?$1
+ s_375)
+ (syntax-e$1
+ s_375)
+ s_375)))
+ (if (pair? s_376)
+ (let-values (((phase-level369_0)
+ (let-values (((s_377)
+ (car
+ s_376)))
+ s_377))
+ ((spec370_0)
+ (let-values (((s_378)
+ (cdr
+ s_376)))
+ (let-values (((s_379)
+ (if (syntax?$1
+ s_378)
+ (syntax-e$1
+ s_378)
+ s_378)))
+ (let-values (((flat-s_10)
+ (to-syntax-list.1
+ s_379)))
+ (if (not
+ flat-s_10)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_19)
+ flat-s_10))))))
+ (values
+ phase-level369_0
+ spec370_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_19))))))
+ (values
+ for-meta366_0
+ phase-level367_0
+ spec368_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_19)))))
+ (values #t for-meta363_1 phase-level364_1 spec365_1))))))
+ (let-values (((p_35) (syntax-e$1 phase-level364_0)))
+ (begin
+ (if (phase? p_35) (void) (raise-syntax-error$1 #f "bad phase" req_4))
+ (rebuild-req_0
+ req_4
+ (list* for-meta363_0 (phase+ p_35 1) (map2 (loop_97 #t) spec365_0))))))
+ (if (equal? tmp_26 'for-syntax)
+ (let-values (((ok?_15 for-syntax371_0 spec372_0)
+ (let-values (((s_380) req_4))
+ (let-values (((orig-s_20) s_380))
+ (let-values (((for-syntax371_1 spec372_1)
+ (let-values (((s_381)
+ (if (syntax?$1 s_380)
+ (syntax-e$1 s_380)
+ s_380)))
+ (if (pair? s_381)
+ (let-values (((for-syntax373_0)
+ (let-values (((s_382)
+ (car s_381)))
+ s_382))
+ ((spec374_0)
+ (let-values (((s_383)
+ (cdr s_381)))
+ (let-values (((s_384)
(if (syntax?$1
- s_293)
+ s_383)
(syntax-e$1
- s_293)
- s_293)))
- (if (pair? s_294)
- (let-values (((phase-level366_0)
- (let-values (((s_295)
- (car
- s_294)))
- s_295))
- ((spec367_0)
- (let-values (((s_296)
- (cdr
- s_294)))
- (let-values (((s_297)
- (if (syntax?$1
- s_296)
- (syntax-e$1
- s_296)
- s_296)))
- (let-values (((flat-s_10)
- (to-syntax-list.1
- s_297)))
- (if (not
- flat-s_10)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_19))
- (let-values ()
- flat-s_10)))))))
- (values
- phase-level366_0
- spec367_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_19))))))
- (values
- for-meta363_0
- phase-level364_0
- spec365_0))
+ s_383)
+ s_383)))
+ (let-values (((flat-s_11)
+ (to-syntax-list.1
+ s_384)))
+ (if (not flat-s_11)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_20)
+ flat-s_11))))))
+ (values for-syntax373_0 spec374_0))
(raise-syntax-error$1
#f
"bad syntax"
- orig-s_19)))))
- (values #t for-meta360_1 phase-level361_1 spec362_1))))))
- (let-values (((p_31) (syntax-e$1 phase-level361_0)))
- (begin
- (if (phase? p_31)
- (void)
- (let-values () (raise-syntax-error$1 #f "bad phase" req_3)))
- (rebuild-req_0
- req_3
- (list* for-meta360_0 (phase+ p_31 1) (map2 (loop_89 #t) spec362_0)))))))
- (if (equal? tmp_25 'for-syntax)
- (let-values ()
- (let-values (((ok?_15 for-syntax368_0 spec369_0)
- (let-values (((s_298) req_3))
- (let-values (((orig-s_20) s_298))
- (let-values (((for-syntax368_1 spec369_1)
- (let-values (((s_299)
- (if (syntax?$1 s_298)
- (syntax-e$1 s_298)
- s_298)))
- (if (pair? s_299)
- (let-values (((for-syntax370_0)
- (let-values (((s_300)
- (car s_299)))
- s_300))
- ((spec371_0)
- (let-values (((s_301)
- (cdr s_299)))
- (let-values (((s_302)
+ orig-s_20)))))
+ (values #t for-syntax371_1 spec372_1))))))
+ (rebuild-req_0 req_4 (list* 'for-meta 2 (map2 (loop_97 #t) spec372_0))))
+ (if (equal? tmp_26 'for-template)
+ (let-values (((ok?_16 for-template375_0 spec376_0)
+ (let-values (((s_385) req_4))
+ (let-values (((orig-s_21) s_385))
+ (let-values (((for-template375_1 spec376_1)
+ (let-values (((s_386)
+ (if (syntax?$1 s_385)
+ (syntax-e$1 s_385)
+ s_385)))
+ (if (pair? s_386)
+ (let-values (((for-template377_0)
+ (let-values (((s_387)
+ (car s_386)))
+ s_387))
+ ((spec378_0)
+ (let-values (((s_388)
+ (cdr s_386)))
+ (let-values (((s_389)
(if (syntax?$1
- s_301)
+ s_388)
(syntax-e$1
- s_301)
- s_301)))
- (let-values (((flat-s_11)
+ s_388)
+ s_388)))
+ (let-values (((flat-s_12)
(to-syntax-list.1
- s_302)))
- (if (not flat-s_11)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_20))
- (let-values ()
- flat-s_11)))))))
- (values for-syntax370_0 spec371_0))
+ s_389)))
+ (if (not flat-s_12)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_21)
+ flat-s_12))))))
+ (values for-template377_0 spec378_0))
(raise-syntax-error$1
#f
"bad syntax"
- orig-s_20)))))
- (values #t for-syntax368_1 spec369_1))))))
- (rebuild-req_0 req_3 (list* 'for-meta 2 (map2 (loop_89 #t) spec369_0)))))
- (if (equal? tmp_25 'for-template)
- (let-values ()
- (let-values (((ok?_16 for-template372_0 spec373_0)
- (let-values (((s_303) req_3))
- (let-values (((orig-s_21) s_303))
- (let-values (((for-template372_1 spec373_1)
- (let-values (((s_304)
- (if (syntax?$1 s_303)
- (syntax-e$1 s_303)
- s_303)))
- (if (pair? s_304)
- (let-values (((for-template374_0)
- (let-values (((s_305)
- (car s_304)))
- s_305))
- ((spec375_0)
- (let-values (((s_306)
- (cdr s_304)))
- (let-values (((s_307)
+ orig-s_21)))))
+ (values #t for-template375_1 spec376_1))))))
+ (rebuild-req_0 req_4 (list* 'for-meta 0 (map2 (loop_97 #t) spec376_0))))
+ (if (equal? tmp_26 'for-label)
+ (let-values (((ok?_17 for-label379_0 spec380_0)
+ (let-values (((s_390) req_4))
+ (let-values (((orig-s_22) s_390))
+ (let-values (((for-label379_1 spec380_1)
+ (let-values (((s_391)
+ (if (syntax?$1 s_390)
+ (syntax-e$1 s_390)
+ s_390)))
+ (if (pair? s_391)
+ (let-values (((for-label381_0)
+ (let-values (((s_392)
+ (car s_391)))
+ s_392))
+ ((spec382_0)
+ (let-values (((s_393)
+ (cdr s_391)))
+ (let-values (((s_394)
(if (syntax?$1
- s_306)
+ s_393)
(syntax-e$1
- s_306)
- s_306)))
- (let-values (((flat-s_12)
+ s_393)
+ s_393)))
+ (let-values (((flat-s_13)
(to-syntax-list.1
- s_307)))
- (if (not flat-s_12)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_21))
- (let-values ()
- flat-s_12)))))))
- (values for-template374_0 spec375_0))
+ s_394)))
+ (if (not flat-s_13)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_22)
+ flat-s_13))))))
+ (values for-label381_0 spec382_0))
(raise-syntax-error$1
#f
"bad syntax"
- orig-s_21)))))
- (values #t for-template372_1 spec373_1))))))
- (rebuild-req_0 req_3 (list* 'for-meta 0 (map2 (loop_89 #t) spec373_0)))))
- (if (equal? tmp_25 'for-label)
- (let-values ()
- (let-values (((ok?_17 for-label376_0 spec377_0)
- (let-values (((s_308) req_3))
- (let-values (((orig-s_22) s_308))
- (let-values (((for-label376_1 spec377_1)
- (let-values (((s_309)
- (if (syntax?$1 s_308)
- (syntax-e$1 s_308)
- s_308)))
- (if (pair? s_309)
- (let-values (((for-label378_0)
- (let-values (((s_310)
+ orig-s_22)))))
+ (values #t for-label379_1 spec380_1))))))
+ (rebuild-req_0 req_4 (list* for-label379_0 (map2 (loop_97 #t) spec380_0))))
+ (if (equal? tmp_26 'just-meta)
+ (let-values (((ok?_18 just-meta383_0 phase-level384_0 spec385_0)
+ (let-values (((s_395) req_4))
+ (let-values (((orig-s_23) s_395))
+ (let-values (((just-meta383_1 phase-level384_1 spec385_1)
+ (let-values (((s_396)
+ (if (syntax?$1 s_395)
+ (syntax-e$1 s_395)
+ s_395)))
+ (if (pair? s_396)
+ (let-values (((just-meta386_0)
+ (let-values (((s_397)
(car
- s_309)))
- s_310))
- ((spec379_0)
- (let-values (((s_311)
+ s_396)))
+ s_397))
+ ((phase-level387_0
+ spec388_0)
+ (let-values (((s_398)
(cdr
- s_309)))
- (let-values (((s_312)
+ s_396)))
+ (let-values (((s_399)
(if (syntax?$1
- s_311)
+ s_398)
(syntax-e$1
- s_311)
- s_311)))
- (let-values (((flat-s_13)
- (to-syntax-list.1
- s_312)))
- (if (not flat-s_13)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_22))
- (let-values ()
- flat-s_13)))))))
- (values for-label378_0 spec379_0))
+ s_398)
+ s_398)))
+ (if (pair? s_399)
+ (let-values (((phase-level389_0)
+ (let-values (((s_400)
+ (car
+ s_399)))
+ s_400))
+ ((spec390_0)
+ (let-values (((s_401)
+ (cdr
+ s_399)))
+ (let-values (((s_402)
+ (if (syntax?$1
+ s_401)
+ (syntax-e$1
+ s_401)
+ s_401)))
+ (let-values (((flat-s_14)
+ (to-syntax-list.1
+ s_402)))
+ (if (not
+ flat-s_14)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_23)
+ flat-s_14))))))
+ (values
+ phase-level389_0
+ spec390_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_23))))))
+ (values
+ just-meta386_0
+ phase-level387_0
+ spec388_0))
(raise-syntax-error$1
#f
"bad syntax"
- orig-s_22)))))
- (values #t for-label376_1 spec377_1))))))
+ orig-s_23)))))
+ (values
+ #t
+ just-meta383_1
+ phase-level384_1
+ spec385_1))))))
(rebuild-req_0
- req_3
- (list* for-label376_0 (map2 (loop_89 #t) spec377_0)))))
- (if (equal? tmp_25 'just-meta)
- (let-values ()
- (let-values (((ok?_18 just-meta380_0 phase-level381_0 spec382_0)
- (let-values (((s_313) req_3))
- (let-values (((orig-s_23) s_313))
- (let-values (((just-meta380_1
- phase-level381_1
- spec382_1)
- (let-values (((s_314)
- (if (syntax?$1 s_313)
- (syntax-e$1 s_313)
- s_313)))
- (if (pair? s_314)
- (let-values (((just-meta383_0)
- (let-values (((s_315)
- (car
- s_314)))
- s_315))
- ((phase-level384_0
- spec385_0)
- (let-values (((s_316)
- (cdr
- s_314)))
- (let-values (((s_317)
- (if (syntax?$1
- s_316)
- (syntax-e$1
- s_316)
- s_316)))
- (if (pair? s_317)
- (let-values (((phase-level386_0)
- (let-values (((s_318)
- (car
- s_317)))
- s_318))
- ((spec387_0)
- (let-values (((s_319)
- (cdr
- s_317)))
- (let-values (((s_320)
- (if (syntax?$1
- s_319)
- (syntax-e$1
- s_319)
- s_319)))
- (let-values (((flat-s_14)
- (to-syntax-list.1
- s_320)))
- (if (not
- flat-s_14)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_23))
- (let-values ()
- flat-s_14)))))))
- (values
- phase-level386_0
- spec387_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_23))))))
- (values
- just-meta383_0
- phase-level384_0
- spec385_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_23)))))
- (values
- #t
- just-meta380_1
- phase-level381_1
- spec382_1))))))
- (rebuild-req_0
- req_3
- (list*
- just-meta380_0
- phase-level381_0
- (map2 (loop_89 #f) spec382_0)))))
- (let-values ()
- (if shifted?_0
- req_3
- (datum->syntax$1 #f (list 'for-syntax req_3))))))))))))))))
- ((loop_89 #f) req_1))))))
+ req_4
+ (list* just-meta383_0 phase-level384_0 (map2 (loop_97 #f) spec385_0))))
+ (if shifted?_0
+ req_4
+ (datum->syntax$1 #f (list 'for-syntax req_4)))))))))))))))
+ ((loop_97 #f) req_2))))))
(define-values
(copy-namespace-value)
- (lambda (m-ns_12 adjusted-sym_1 binding_16 phase-level_18 phase-shift_10 as-constant?_1)
+ (lambda (m-ns_12 adjusted-sym_1 binding_17 phase-level_21 phase-shift_11 as-constant?_1)
(begin
(let-values (((i-ns_0)
- (let-values (((m-ns388_0) m-ns_12)
- ((temp389_0) (1/module-path-index-resolve (module-binding-module binding_16)))
- ((temp390_0)
+ (let-values (((m-ns391_0) m-ns_12)
+ ((temp392_0) (1/module-path-index-resolve (module-binding-module binding_17)))
+ ((temp393_0)
(phase+
- (phase- (module-binding-phase binding_16) phase-level_18)
+ (phase- (module-binding-phase binding_17) phase-level_21)
(namespace-phase m-ns_12)))
- ((temp391_0) #t))
- (namespace->module-namespace.1 #f temp391_0 void m-ns388_0 temp389_0 temp390_0))))
- (let-values (((val_43)
+ ((temp394_0) #t))
+ (namespace->module-namespace.1 #f temp394_0 void m-ns391_0 temp392_0 temp393_0))))
+ (let-values (((val_45)
(namespace-get-variable
i-ns_0
- (module-binding-phase binding_16)
- (module-binding-sym binding_16)
+ (module-binding-phase binding_17)
+ (module-binding-sym binding_17)
(lambda ()
(error
'namespace-require/copy
@@ -31061,14 +31249,14 @@
" module: ~a\n"
" variable name: ~s\n"
" phase level: ~s")
- (module-binding-module binding_16)
- (module-binding-sym binding_16)
- (module-binding-phase binding_16)))))))
+ (module-binding-module binding_17)
+ (module-binding-sym binding_17)
+ (module-binding-phase binding_17)))))))
(namespace-set-variable!
m-ns_12
- (phase+ phase-shift_10 phase-level_18)
+ (phase+ phase-shift_11 phase-level_21)
adjusted-sym_1
- val_43
+ val_45
as-constant?_1))))))
(define-values
(perform-portal-syntax-bind!.1)
@@ -31081,40 +31269,37 @@
portal-stx125_0)
(begin
'perform-portal-syntax-bind!
- (let-values (((id_52) id124_0))
+ (let-values (((id_59) id124_0))
(let-values (((portal-stx_0) portal-stx125_0))
(let-values (((orig-s_24) orig-s114_0))
- (let-values (((phase-shift_11) phase-shift115_0))
- (let-values (((self_15) self116_0))
+ (let-values (((phase-shift_12) phase-shift115_0))
+ (let-values (((self_18) self116_0))
(let-values ()
(let-values (((add-defined-portal_1) add-defined-portal118_0))
- (let-values ()
- (let-values (((sym_49)
- (if add-defined-portal_1
- (add-defined-portal_1 id_52 phase-shift_11 portal-stx_0 orig-s_24)
- (syntax-e$1 id_52))))
- (let-values (((binding_17)
- (let-values (((temp395_0)
- (let-values (((or-part_216) self_15))
- (if or-part_216 or-part_216 top-level-module-path-index)))
- ((phase-shift396_0) phase-shift_11)
- ((sym397_0) sym_49))
- (make-module-binding.1
- #f
- null
- #f
- #f
- unsafe-undefined
- unsafe-undefined
- 0
- unsafe-undefined
- temp395_0
- phase-shift396_0
- sym397_0))))
- (let-values (((id392_0) id_52)
- ((binding393_0) binding_17)
- ((phase-shift394_0) phase-shift_11))
- (add-binding!.1 #f #f id392_0 binding393_0 phase-shift394_0)))))))))))))))
+ (let-values (((sym_61)
+ (if add-defined-portal_1
+ (add-defined-portal_1 id_59 phase-shift_12 portal-stx_0 orig-s_24)
+ (syntax-e$1 id_59))))
+ (let-values (((binding_18)
+ (let-values (((temp398_0)
+ (let-values (((or-part_337) self_18))
+ (if or-part_337 or-part_337 top-level-module-path-index)))
+ ((phase-shift399_0) phase-shift_12)
+ ((sym400_0) sym_61))
+ (make-module-binding.1
+ #f
+ null
+ #f
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ 0
+ unsafe-undefined
+ temp398_0
+ phase-shift399_0
+ sym400_0))))
+ (let-values (((id395_0) id_59) ((binding396_0) binding_18) ((phase-shift397_0) phase-shift_12))
+ (add-binding!.1 #f #f id395_0 binding396_0 phase-shift397_0))))))))))))))
(define-values
(top-level-instance)
(1/make-instance
@@ -31122,13 +31307,13 @@
#f
'constant
top-level-bind!-id
- (lambda (id_25 mpi_48 orig-phase_0 phase-shift_12 ns_50 sym_50 trans?_0 trans-val_0)
- (let-values (((phase_71) (phase+ orig-phase_0 phase-shift_12)))
- (let-values (((b_83)
- (let-values (((mpi4_0) mpi_48)
- ((phase5_2) phase_71)
- ((sym6_0) sym_50)
- ((temp7_3) (root-expand-context-frame-id (namespace-get-root-expand-ctx ns_50))))
+ (lambda (id_60 mpi_68 orig-phase_0 phase-shift_13 ns_56 sym_62 trans?_0 trans-val_0)
+ (let-values (((phase_83) (phase+ orig-phase_0 phase-shift_13)))
+ (let-values (((b_105)
+ (let-values (((mpi4_0) mpi_68)
+ ((phase5_2) phase_83)
+ ((sym6_0) sym_62)
+ ((temp7_3) (root-expand-context-frame-id (namespace-get-root-expand-ctx ns_56))))
(make-module-binding.1
#f
null
@@ -31142,36 +31327,36 @@
phase5_2
sym6_0))))
(begin
- (let-values (((id1_3) id_25) ((b2_4) b_83) ((phase3_1) phase_71)) (add-binding!.1 #f #f id1_3 b2_4 phase3_1))
+ (let-values (((id1_3) id_60) ((b2_4) b_105) ((phase3_1) phase_83))
+ (add-binding!.1 #f #f id1_3 b2_4 phase3_1))
(if trans?_0
- (let-values () (if trans-val_0 (let-values () (maybe-install-free=id! trans-val_0 id_25 phase_71)) (void)))
- (let-values () (namespace-unset-transformer! ns_50 phase_71 sym_50)))))))
+ (if trans-val_0 (maybe-install-free=id! trans-val_0 id_60 phase_83) (void))
+ (namespace-unset-transformer! ns_56 phase_83 sym_62))))))
top-level-require!-id
- (lambda (stx_2 ns_51 syms_18)
- (let-values (((reqs_2) (cdr (syntax->list$1 stx_2))))
- (let-values (((temp8_3) #t)
+ (lambda (stx_13 ns_57 syms_26)
+ (let-values (((reqs_2) (cdr (syntax->list$1 stx_13))))
+ (let-values (((temp8_2) #t)
((temp9_0) #f)
((reqs10_0) reqs_2)
((temp11_0) #f)
- ((ns12_0) ns_51)
- ((temp13_1) (namespace-self-mpi/no-top-level ns_51))
- ((temp14_2) (namespace-phase ns_51))
- ((temp15_2) (let-values (((temp19_0) #f)) (make-requires+provides.1 #f unsafe-undefined temp19_0)))
+ ((ns12_0) ns_57)
+ ((temp13_2) (namespace-self-mpi/no-top-level ns_57))
+ ((temp14_2) (namespace-phase ns_57))
+ ((temp15_2) (let-values (((temp19_1) #f)) (make-requires+provides.1 #f unsafe-undefined temp19_1)))
((temp16_4) 'require)
((temp17_1) #t)
((temp18_1)
- (lambda (id_53 phase_72 portal-stx_1 orig-s_25)
- (let-values (((sym_51)
- (if (pair? syms_18)
- (begin0 (car syms_18) (set! syms_18 (cdr syms_18)))
- (syntax-e$1 id_53))))
+ (lambda (id_61 phase_84 portal-stx_1 orig-s_25)
+ (let-values (((sym_63)
+ (if (pair? syms_26)
+ (begin0 (car syms_26) (set! syms_26 (cdr syms_26)))
+ (syntax-e$1 id_61))))
(begin
- (if phase_72
- (let-values ()
- (let-values (((t_19) (portal-syntax1.1 portal-stx_1)))
- (namespace-set-transformer! ns_51 phase_72 sym_51 t_19)))
+ (if phase_84
+ (let-values (((t_23) (portal-syntax1.1 portal-stx_1 #f)))
+ (namespace-set-transformer! ns_57 phase_84 sym_63 t_23))
(void))
- sym_51)))))
+ sym_63)))))
(parse-and-perform-requires!.1
temp18_1
#f
@@ -31180,8 +31365,8 @@
'#hasheq()
temp17_1
unsafe-undefined
- temp8_3
- temp13_1
+ temp8_2
+ temp13_2
#f
temp9_0
temp16_4
@@ -31197,6 +31382,8 @@
compiled-in-memory-linklet-directory
compiled-in-memory-original-self
compiled-in-memory-requires
+ compiled-in-memory-recur-requires
+ compiled-in-memory-flattened-requires
compiled-in-memory-provides
compiled-in-memory-phase-to-link-module-uses
compiled-in-memory-compile-time-inspector
@@ -31208,42 +31395,42 @@
compiled-in-memory-post-compiled-in-memorys
compiled-in-memory-namespace-scopes
compiled-in-memory-purely-functional?)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'compiled-in-memory
- #f
- 14
- 0
- #f
- (list
- (cons
- prop:custom-write
- (lambda (cim_0 port_7 mode_10) (write (compiled-in-memory-linklet-directory cim_0) port_7))))
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6 7 8 9 10 11 12 13)
- #f
- 'compiled-in-memory)))))
+ (let-values (((struct:_92 make-_92 ?_92 -ref_92 -set!_92)
+ (make-struct-type
+ 'compiled-in-memory
+ #f
+ 16
+ 0
+ #f
+ (list
+ (cons
+ prop:custom-write
+ (lambda (cim_0 port_8 mode_11) (write (compiled-in-memory-linklet-directory cim_0) port_8))))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)
+ #f
+ 'compiled-in-memory)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'linklet-directory)
- (make-struct-field-accessor -ref_2 1 'original-self)
- (make-struct-field-accessor -ref_2 2 'requires)
- (make-struct-field-accessor -ref_2 3 'provides)
- (make-struct-field-accessor -ref_2 4 'phase-to-link-module-uses)
- (make-struct-field-accessor -ref_2 5 'compile-time-inspector)
- (make-struct-field-accessor -ref_2 6 'phase-to-link-extra-inspectorsss)
- (make-struct-field-accessor -ref_2 7 'portal-stxes)
- (make-struct-field-accessor -ref_2 8 'mpis)
- (make-struct-field-accessor -ref_2 9 'syntax-literals)
- (make-struct-field-accessor -ref_2 10 'pre-compiled-in-memorys)
- (make-struct-field-accessor -ref_2 11 'post-compiled-in-memorys)
- (make-struct-field-accessor -ref_2 12 'namespace-scopes)
- (make-struct-field-accessor -ref_2 13 'purely-functional?))))
+ struct:_92
+ make-_92
+ ?_92
+ (make-struct-field-accessor -ref_92 0 'linklet-directory)
+ (make-struct-field-accessor -ref_92 1 'original-self)
+ (make-struct-field-accessor -ref_92 2 'requires)
+ (make-struct-field-accessor -ref_92 3 'recur-requires)
+ (make-struct-field-accessor -ref_92 4 'flattened-requires)
+ (make-struct-field-accessor -ref_92 5 'provides)
+ (make-struct-field-accessor -ref_92 6 'phase-to-link-module-uses)
+ (make-struct-field-accessor -ref_92 7 'compile-time-inspector)
+ (make-struct-field-accessor -ref_92 8 'phase-to-link-extra-inspectorsss)
+ (make-struct-field-accessor -ref_92 9 'portal-stxes)
+ (make-struct-field-accessor -ref_92 10 'mpis)
+ (make-struct-field-accessor -ref_92 11 'syntax-literals)
+ (make-struct-field-accessor -ref_92 12 'pre-compiled-in-memorys)
+ (make-struct-field-accessor -ref_92 13 'post-compiled-in-memorys)
+ (make-struct-field-accessor -ref_92 14 'namespace-scopes)
+ (make-struct-field-accessor -ref_92 15 'purely-functional?))))
(define-values (version-bytes$1) (string->bytes/utf-8 (version)))
(define-values (vm-bytes$1) (1/linklet-virtual-machine-bytes))
(define-values (datum->syntax$3) datum->syntax)
@@ -31255,7 +31442,7 @@
(define-values (syntax-source$2) syntax-source)
(define-values (syntax-e$2) syntax-e)
(define-values (1/syntax?) syntax?)
- (define-values (correlated?) (lambda (e_35) (begin (1/syntax? e_35))))
+ (define-values (correlated?) (lambda (e_38) (begin (1/syntax? e_38))))
(define-values
(datum->correlated)
(let-values (((datum->correlated_1)
@@ -31263,54 +31450,54 @@
(begin
'datum->correlated
(let-values (((d_30) d2_0))
- (let-values (((srcloc_8) srcloc1_2)) (let-values () (datum->syntax$3 #f d_30 srcloc_8))))))))
+ (let-values (((srcloc_8) srcloc1_2)) (datum->syntax$3 #f d_30 srcloc_8)))))))
(case-lambda
((d_31) (begin (datum->correlated_1 d_31 #f)))
((d_32 srcloc1_3) (datum->correlated_1 d_32 srcloc1_3)))))
- (define-values (correlated-e) (lambda (e_36) (begin (if (1/syntax? e_36) (syntax-e$2 e_36) e_36))))
- (define-values (correlated-cadr) (lambda (e_37) (begin (car (correlated-e (cdr (correlated-e e_37)))))))
+ (define-values (correlated-e) (lambda (e_39) (begin (if (1/syntax? e_39) (syntax-e$2 e_39) e_39))))
+ (define-values (correlated-cadr) (lambda (e_40) (begin (car (correlated-e (cdr (correlated-e e_40)))))))
(define-values
(correlated-length)
- (lambda (e_38) (begin (let-values (((l_39) (correlated-e e_38))) (if (list? l_39) (length l_39) #f)))))
+ (lambda (e_41) (begin (let-values (((l_47) (correlated-e e_41))) (if (list? l_47) (length l_47) #f)))))
(define-values
(correlated->list)
- (lambda (e_39)
+ (lambda (e_42)
(begin
- ((letrec-values (((loop_90)
- (lambda (e_40)
+ ((letrec-values (((loop_98)
+ (lambda (e_43)
(begin
'loop
- (if (list? e_40)
- (let-values () e_40)
- (if (pair? e_40)
- (let-values () (cons (car e_40) (loop_90 (cdr e_40))))
- (if (null? e_40)
- (let-values () null)
- (if (1/syntax? e_40)
- (let-values () (loop_90 (syntax-e$2 e_40)))
- (let-values () (error 'correlated->list "not a list"))))))))))
- loop_90)
- e_39))))
+ (if (list? e_43)
+ e_43
+ (if (pair? e_43)
+ (cons (car e_43) (loop_98 (cdr e_43)))
+ (if (null? e_43)
+ null
+ (if (1/syntax? e_43)
+ (loop_98 (syntax-e$2 e_43))
+ (error 'correlated->list "not a list")))))))))
+ loop_98)
+ e_42))))
(define-values
(correlated-property)
(case-lambda
- ((e_41 k_44) (begin (syntax-property$2 e_41 k_44)))
- ((e_42 k_45 v_164) (syntax-property$2 e_42 k_45 v_164))))
+ ((e_44 k_45) (begin (syntax-property$2 e_44 k_45)))
+ ((e_45 k_46 v_227) (syntax-property$2 e_45 k_46 v_227))))
(define-values
(to-syntax-list.1$1)
- (lambda (s_321)
+ (lambda (s_403)
(begin
'to-syntax-list
- (if (list? s_321)
- (let-values () s_321)
- (if (pair? s_321)
- (let-values () (let-values (((r_36) (to-syntax-list.1$1 (cdr s_321)))) (if r_36 (cons (car s_321) r_36) #f)))
- (if (1/syntax? s_321) (let-values () (to-syntax-list.1$1 (syntax-e$2 s_321))) (let-values () #f)))))))
- (define-values (correlated-source) (lambda (s_322) (begin (syntax-source$2 s_322))))
- (define-values (correlated-line) (lambda (s_323) (begin (syntax-line$2 s_323))))
- (define-values (correlated-column) (lambda (s_324) (begin (syntax-column$2 s_324))))
- (define-values (correlated-position) (lambda (s_222) (begin (syntax-position$2 s_222))))
- (define-values (correlated-span) (lambda (s_125) (begin (syntax-span$2 s_125))))
+ (if (list? s_403)
+ s_403
+ (if (pair? s_403)
+ (let-values (((r_42) (to-syntax-list.1$1 (cdr s_403)))) (if r_42 (cons (car s_403) r_42) #f))
+ (if (1/syntax? s_403) (to-syntax-list.1$1 (syntax-e$2 s_403)) #f))))))
+ (define-values (correlated-source) (lambda (s_404) (begin (syntax-source$2 s_404))))
+ (define-values (correlated-line) (lambda (s_405) (begin (syntax-line$2 s_405))))
+ (define-values (correlated-column) (lambda (s_406) (begin (syntax-column$2 s_406))))
+ (define-values (correlated-position) (lambda (s_407) (begin (syntax-position$2 s_407))))
+ (define-values (correlated-span) (lambda (s_408) (begin (syntax-span$2 s_408))))
(define-values
(struct:correlated-linklet
correlated-linklet1.1
@@ -31319,50 +31506,46 @@
correlated-linklet-name
correlated-linklet-compiled
set-correlated-linklet-compiled!)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'correlated-linklet
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'correlated-linklet)))))
+ (let-values (((struct:_93 make-_93 ?_93 -ref_93 -set!_93)
+ (make-struct-type
+ 'correlated-linklet
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'correlated-linklet)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'expr)
- (make-struct-field-accessor -ref_2 1 'name)
- (make-struct-field-accessor -ref_2 2 'compiled)
- (make-struct-field-mutator -set!_2 2 'compiled))))
- (define-values (make-correlated-linklet) (lambda (expr_10 name_42) (begin (correlated-linklet1.1 expr_10 name_42 #f))))
+ struct:_93
+ make-_93
+ ?_93
+ (make-struct-field-accessor -ref_93 0 'expr)
+ (make-struct-field-accessor -ref_93 1 'name)
+ (make-struct-field-accessor -ref_93 2 'compiled)
+ (make-struct-field-mutator -set!_93 2 'compiled))))
+ (define-values (make-correlated-linklet) (lambda (expr_10 name_52) (begin (correlated-linklet1.1 expr_10 name_52 #f))))
(define-values
(force-compile-linklet)
- (lambda (l_31)
+ (lambda (l_48)
(begin
- (if (correlated-linklet? l_31)
- (let-values ()
- (let-values (((or-part_33) (correlated-linklet-compiled l_31)))
- (if or-part_33
- or-part_33
- (let-values (((c_31) (1/compile-linklet (correlated-linklet-expr l_31) (correlated-linklet-name l_31))))
- (begin (set-correlated-linklet-compiled! l_31 c_31) c_31)))))
- (let-values () l_31)))))
+ (if (correlated-linklet? l_48)
+ (let-values (((or-part_338) (correlated-linklet-compiled l_48)))
+ (if or-part_338
+ or-part_338
+ (let-values (((c_36) (1/compile-linklet (correlated-linklet-expr l_48) (correlated-linklet-name l_48))))
+ (begin (set-correlated-linklet-compiled! l_48 c_36) c_36))))
+ l_48))))
(define-values
(eval-correlated-linklet)
- (lambda (l_40)
+ (lambda (l_49)
(begin
- (if (correlated-linklet? l_40)
- (let-values ()
- (eval-linklet$1 (1/compile-linklet (correlated-linklet-expr l_40) (correlated-linklet-name l_40) #f #f '())))
- (let-values () (error 'eval-correlated-linklet "cannot evaluate unknown linklet: ~s" l_40))))))
+ (if (correlated-linklet? l_49)
+ (eval-linklet$1 (1/compile-linklet (correlated-linklet-expr l_49) (correlated-linklet-name l_49) #f #f '()))
+ (error 'eval-correlated-linklet "cannot evaluate unknown linklet: ~s" l_49)))))
(define-values (correlated-linklet-vm-bytes) #"linklet")
(define-values
(struct:faslable-correlated
@@ -31375,760 +31558,706 @@
faslable-correlated-column
faslable-correlated-span
faslable-correlated-props)
- (let-values (((struct:_6 make-_6 ?_6 -ref_6 -set!_6)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'faslable-correlated
- #f
- 7
- 0
- #f
- null
- 'prefab
- #f
- '(0 1 2 3 4 5 6)
- #f
- 'faslable-correlated)))))
+ (let-values (((struct:_94 make-_94 ?_94 -ref_94 -set!_94)
+ (make-struct-type
+ 'faslable-correlated
+ #f
+ 7
+ 0
+ #f
+ null
+ 'prefab
+ #f
+ '(0 1 2 3 4 5 6)
+ #f
+ 'faslable-correlated)))
(values
- struct:_6
- make-_6
- ?_6
- (make-struct-field-accessor -ref_6 0 'e)
- (make-struct-field-accessor -ref_6 1 'source)
- (make-struct-field-accessor -ref_6 2 'position)
- (make-struct-field-accessor -ref_6 3 'line)
- (make-struct-field-accessor -ref_6 4 'column)
- (make-struct-field-accessor -ref_6 5 'span)
- (make-struct-field-accessor -ref_6 6 'props))))
+ struct:_94
+ make-_94
+ ?_94
+ (make-struct-field-accessor -ref_94 0 'e)
+ (make-struct-field-accessor -ref_94 1 'source)
+ (make-struct-field-accessor -ref_94 2 'position)
+ (make-struct-field-accessor -ref_94 3 'line)
+ (make-struct-field-accessor -ref_94 4 'column)
+ (make-struct-field-accessor -ref_94 5 'span)
+ (make-struct-field-accessor -ref_94 6 'props))))
(define-values
(struct:faslable-correlated-linklet
faslable-correlated-linklet3.1
faslable-correlated-linklet?
faslable-correlated-linklet-expr
faslable-correlated-linklet-name)
- (let-values (((struct:_35 make-_35 ?_35 -ref_35 -set!_35)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'faslable-correlated-linklet
- #f
- 2
- 0
- #f
- null
- 'prefab
- #f
- '(0 1)
- #f
- 'faslable-correlated-linklet)))))
+ (let-values (((struct:_95 make-_95 ?_95 -ref_95 -set!_95)
+ (make-struct-type
+ 'faslable-correlated-linklet
+ #f
+ 2
+ 0
+ #f
+ null
+ 'prefab
+ #f
+ '(0 1)
+ #f
+ 'faslable-correlated-linklet)))
(values
- struct:_35
- make-_35
- ?_35
- (make-struct-field-accessor -ref_35 0 'expr)
- (make-struct-field-accessor -ref_35 1 'name))))
+ struct:_95
+ make-_95
+ ?_95
+ (make-struct-field-accessor -ref_95 0 'expr)
+ (make-struct-field-accessor -ref_95 1 'name))))
(define-values
(write-correlated-linklet-bundle-hash)
- (lambda (ht_118 o_5)
- (begin (let-values (((temp7_4) (->faslable ht_118)) ((o8_0) o_5)) (s-exp->fasl.1 #f #f #f #f temp7_4 o8_0)))))
+ (lambda (ht_142 o_6)
+ (begin (let-values (((temp7_4) (->faslable ht_142)) ((o8_0) o_6)) (s-exp->fasl.1 #f #f #f #f temp7_4 o8_0)))))
(define-values
(->faslable)
- (lambda (v_67)
- (begin
- (if (pair? v_67)
- (let-values ()
- (let-values (((a_34) (->faslable (car v_67))))
- (let-values (((d_33) (->faslable (cdr v_67))))
- (if (if (eq? a_34 (car v_67)) (eq? d_33 (cdr v_67)) #f) v_67 (cons a_34 d_33)))))
- (if (correlated? v_67)
- (let-values ()
- (faslable-correlated2.1
- (->faslable (correlated-e v_67))
- (correlated-source v_67)
- (correlated-position v_67)
- (correlated-line v_67)
- (correlated-column v_67)
- (correlated-span v_67)
- (let-values (((lst_92)
- '(inferred-name undefined-error-name method-arity-error compiler-hint:cross-module-inline)))
+ (lambda (v_228)
+ (begin
+ (if (pair? v_228)
+ (let-values (((a_40) (->faslable (car v_228))))
+ (let-values (((d_33) (->faslable (cdr v_228))))
+ (if (if (eq? a_40 (car v_228)) (eq? d_33 (cdr v_228)) #f) v_228 (cons a_40 d_33))))
+ (if (correlated? v_228)
+ (faslable-correlated2.1
+ (->faslable (correlated-e v_228))
+ (correlated-source v_228)
+ (correlated-position v_228)
+ (correlated-line v_228)
+ (correlated-column v_228)
+ (correlated-span v_228)
+ (let-values (((ht_143) (let-values (((ht_144) #f)) ht_144)))
+ (let-values (((lst_248)
+ '(inferred-name
+ undefined-error-name
+ method-arity-error
+ compiler-hint:cross-module-inline
+ body-as-unsafe)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_92)))
- ((letrec-values (((for-loop_202)
- (lambda (ht_119 lst_170)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_248))
+ ((letrec-values (((for-loop_253)
+ (lambda (ht_145 lst_249)
(begin
'for-loop
- (if (pair? lst_170)
- (let-values (((k_46) (unsafe-car lst_170)) ((rest_85) (unsafe-cdr lst_170)))
- (let-values (((ht_27)
- (let-values (((ht_120) ht_119))
- (let-values (((ht_121)
- (let-values ()
- (let-values (((p_6)
- (correlated-property
- v_67
- k_46)))
- (if p_6
- (hash-set
- (let-values (((or-part_99) ht_120))
- (if or-part_99 or-part_99 '#hasheq()))
- k_46
- p_6)
- ht_120)))))
- (values ht_121)))))
- (if (not #f) (for-loop_202 ht_27 rest_85) ht_27)))
- ht_119)))))
- for-loop_202)
- #f
- lst_92)))))
- (if (hash? v_67)
- (let-values ()
- (let-values (((v9_1) v_67)
- ((temp10_0) (lambda (key_58 value_0) (values (->faslable key_58) (->faslable value_0))))
- ((temp11_1) 'immutable))
- (hash-map/copy.1 temp11_1 v9_1 temp10_0)))
- (if (correlated-linklet? v_67)
- (let-values ()
- (faslable-correlated-linklet3.1
- (->faslable (correlated-linklet-expr v_67))
- (->faslable (correlated-linklet-name v_67))))
- (let-values () v_67))))))))
+ (if (pair? lst_249)
+ (let-values (((k_47) (unsafe-car lst_249)) ((rest_120) (unsafe-cdr lst_249)))
+ (let-values (((ht_146)
+ (let-values (((ht_147)
+ (let-values (((p_36)
+ (correlated-property v_228 k_47)))
+ (if p_36
+ (hash-set
+ (let-values (((or-part_339) ht_145))
+ (if or-part_339 or-part_339 '#hasheq()))
+ k_47
+ p_36)
+ ht_145))))
+ (values ht_147))))
+ (if (not #f) (for-loop_253 ht_146 rest_120) ht_146)))
+ ht_145)))))
+ for-loop_253)
+ ht_143
+ lst_248)))))
+ (if (hash? v_228)
+ (let-values (((v9_1) v_228)
+ ((temp10_0) (lambda (key_61 value_0) (values (->faslable key_61) (->faslable value_0))))
+ ((temp11_1) 'immutable))
+ (hash-map/copy.1 temp11_1 v9_1 temp10_0))
+ (if (correlated-linklet? v_228)
+ (faslable-correlated-linklet3.1
+ (->faslable (correlated-linklet-expr v_228))
+ (->faslable (correlated-linklet-name v_228)))
+ v_228)))))))
(define-values
(read-correlated-linklet-bundle-hash)
(lambda (in_0)
(begin
- (faslable-> (let-values (((in12_0) in_0) ((temp13_2) #t)) (fasl->s-exp.1 temp13_2 unsafe-undefined #f in12_0))))))
+ (faslable-> (let-values (((in12_0) in_0) ((temp13_3) #t)) (fasl->s-exp.1 temp13_3 unsafe-undefined #f in12_0))))))
(define-values
(faslable->)
- (lambda (v_165)
- (begin
- (if (pair? v_165)
- (let-values ()
- (let-values (((a_35) (faslable-> (car v_165))))
- (let-values (((d_34) (faslable-> (cdr v_165))))
- (if (if (eq? a_35 (car v_165)) (eq? d_34 (cdr v_165)) #f) v_165 (cons a_35 d_34)))))
- (if (faslable-correlated? v_165)
- (let-values ()
- (let-values (((props_4) (faslable-correlated-props v_165)))
- (let-values (((c_32)
- (datum->correlated
- (faslable-> (faslable-correlated-e v_165))
- (vector
- (faslable-correlated-source v_165)
- (faslable-correlated-line v_165)
- (faslable-correlated-column v_165)
- (faslable-correlated-position v_165)
- (faslable-correlated-span v_165)))))
- (if props_4
- (let-values (((ht_80) props_4))
+ (lambda (v_229)
+ (begin
+ (if (pair? v_229)
+ (let-values (((a_41) (faslable-> (car v_229))))
+ (let-values (((d_34) (faslable-> (cdr v_229))))
+ (if (if (eq? a_41 (car v_229)) (eq? d_34 (cdr v_229)) #f) v_229 (cons a_41 d_34))))
+ (if (faslable-correlated? v_229)
+ (let-values (((props_4) (faslable-correlated-props v_229)))
+ (let-values (((c_37)
+ (datum->correlated
+ (faslable-> (faslable-correlated-e v_229))
+ (vector
+ (faslable-correlated-source v_229)
+ (faslable-correlated-line v_229)
+ (faslable-correlated-column v_229)
+ (faslable-correlated-position v_229)
+ (faslable-correlated-span v_229)))))
+ (if props_4
+ (let-values (((c_38) (let-values (((c_39) c_37)) c_39)))
+ (let-values (((ht_148) props_4))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_80)))
- ((letrec-values (((for-loop_104)
- (lambda (c_33 i_93)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_148))
+ ((letrec-values (((for-loop_254)
+ (lambda (c_40 i_219)
(begin
'for-loop
- (if i_93
- (let-values (((k_47 p_32) (hash-iterate-key+value ht_80 i_93)))
- (let-values (((c_34)
- (let-values (((c_35) c_33))
- (let-values (((c_36)
- (let-values ()
- (correlated-property c_35 k_47 p_32))))
- (values c_36)))))
+ (if i_219
+ (let-values (((k_48 p_37) (hash-iterate-key+value ht_148 i_219)))
+ (let-values (((c_41)
+ (let-values (((c_42)
+ (correlated-property c_40 k_48 p_37)))
+ (values c_42))))
(if (not #f)
- (for-loop_104 c_34 (hash-iterate-next ht_80 i_93))
- c_34)))
- c_33)))))
- for-loop_104)
- c_32
- (hash-iterate-first ht_80))))
- c_32))))
- (if (hash? v_165)
- (let-values ()
- (let-values (((v14_1) v_165)
- ((temp15_3) (lambda (key_59 value_1) (values (faslable-> key_59) (faslable-> value_1))))
- ((temp16_5) 'immutable))
- (hash-map/copy.1 temp16_5 v14_1 temp15_3)))
- (if (faslable-correlated-linklet? v_165)
- (let-values ()
- (make-correlated-linklet
- (faslable-> (faslable-correlated-linklet-expr v_165))
- (faslable-> (faslable-correlated-linklet-name v_165))))
- (let-values () v_165))))))))
+ (for-loop_254 c_41 (hash-iterate-next ht_148 i_219))
+ c_41)))
+ c_40)))))
+ for-loop_254)
+ c_38
+ (hash-iterate-first ht_148)))))
+ c_37)))
+ (if (hash? v_229)
+ (let-values (((v14_1) v_229)
+ ((temp15_3) (lambda (key_62 value_1) (values (faslable-> key_62) (faslable-> value_1))))
+ ((temp16_5) 'immutable))
+ (hash-map/copy.1 temp16_5 v14_1 temp15_3))
+ (if (faslable-correlated-linklet? v_229)
+ (make-correlated-linklet
+ (faslable-> (faslable-correlated-linklet-expr v_229))
+ (faslable-> (faslable-correlated-linklet-name v_229)))
+ v_229)))))))
+ (define-values
+ (machine-type-vm-bytes)
+ (lambda (machine-type_0)
+ (begin
+ (if (eq? machine-type_0 (system-type 'target-machine))
+ vm-bytes$1
+ (string->bytes/utf-8 (symbol->string machine-type_0))))))
(define-values
(write-linklet-bundle)
- (lambda (b_44 as-correlated-linklet?_0 linklet-bundle->hash_0 port_8)
+ (lambda (b_106 as-correlated-linklet?_0 linklet-bundle->hash_0 machine-type_1 port_9)
(begin
(begin
- (write-bytes #"#~" port_8)
- (write-bytes (bytes (bytes-length version-bytes$1)) port_8)
- (write-bytes version-bytes$1 port_8)
- (let-values (((vm-bytes_0) (if as-correlated-linklet?_0 correlated-linklet-vm-bytes vm-bytes$1)))
- (begin (write-bytes (bytes (bytes-length vm-bytes_0)) port_8) (write-bytes vm-bytes_0 port_8)))
- (write-bytes #"B" port_8)
- (write-bytes (make-bytes 20 0) port_8)
+ (write-bytes #"#~" port_9)
+ (write-bytes (bytes (bytes-length version-bytes$1)) port_9)
+ (write-bytes version-bytes$1 port_9)
+ (let-values (((vm-bytes_0)
+ (if as-correlated-linklet?_0 correlated-linklet-vm-bytes (machine-type-vm-bytes machine-type_1))))
+ (begin (write-bytes (bytes (bytes-length vm-bytes_0)) port_9) (write-bytes vm-bytes_0 port_9)))
+ (write-bytes #"B" port_9)
+ (write-bytes (make-bytes 20 0) port_9)
(if as-correlated-linklet?_0
- (write-correlated-linklet-bundle-hash (linklet-bundle->hash_0 b_44) port_8)
- (1/write-linklet-bundle-hash (linklet-bundle->hash_0 b_44) port_8))))))
+ (write-correlated-linklet-bundle-hash (linklet-bundle->hash_0 b_106) port_9)
+ (1/write-linklet-bundle-hash (linklet-bundle->hash_0 b_106) port_9))))))
(define-values
(linklet-bundle->bytes)
- (lambda (b_16 as-correlated-linklet?_1 linklet-bundle->hash_1)
+ (lambda (b_107 as-correlated-linklet?_1 linklet-bundle->hash_1 machine-type_2)
(begin
- (let-values (((o_6) (open-output-bytes)))
+ (let-values (((o_7) (open-output-bytes)))
(begin
- (write-linklet-bundle b_16 as-correlated-linklet?_1 linklet-bundle->hash_1 o_6)
- (get-output-bytes o_6))))))
+ (write-linklet-bundle b_107 as-correlated-linklet?_1 linklet-bundle->hash_1 machine-type_2 o_7)
+ (get-output-bytes o_7))))))
(define-values
(write-linklet-directory)
- (lambda (ld_0 as-correlated-linklet?_2 linklet-directory->hash_0 linklet-bundle->hash_2 port_9)
- (begin
- (let-values (((vm-bytes_1) (if as-correlated-linklet?_2 correlated-linklet-vm-bytes vm-bytes$1)))
- (let-values ((() (begin (write-bytes #"#~" port_9) (values))))
- (let-values ((() (begin (write-byte (bytes-length version-bytes$1) port_9) (values))))
- (let-values ((() (begin (write-bytes version-bytes$1 port_9) (values))))
- (let-values ((() (begin (write-byte (bytes-length vm-bytes_1) port_9) (values))))
- (let-values ((() (begin (write-bytes vm-bytes_1 port_9) (values))))
- (let-values ((() (begin (write-bytes #"D" port_9) (values))))
+ (lambda (ld_0 as-correlated-linklet?_2 linklet-directory->hash_0 linklet-bundle->hash_2 machine-type_3 port_10)
+ (begin
+ (let-values (((vm-bytes_1)
+ (if as-correlated-linklet?_2 correlated-linklet-vm-bytes (machine-type-vm-bytes machine-type_3))))
+ (let-values ((() (begin (write-bytes #"#~" port_10) (values))))
+ (let-values ((() (begin (write-byte (bytes-length version-bytes$1) port_10) (values))))
+ (let-values ((() (begin (write-bytes version-bytes$1 port_10) (values))))
+ (let-values ((() (begin (write-byte (bytes-length vm-bytes_1) port_10) (values))))
+ (let-values ((() (begin (write-bytes vm-bytes_1 port_10) (values))))
+ (let-values ((() (begin (write-bytes #"D" port_10) (values))))
(letrec-values (((flatten-linklet-directory_0)
(lambda (ld_1 rev-name-prefix_0 accum_2)
(begin
'flatten-linklet-directory
(let-values (((new-accum_0 saw-bundle?_0)
- (let-values (((ht_122) (linklet-directory->hash_0 ld_1)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_122)))
- ((letrec-values (((for-loop_203)
- (lambda (accum_3 saw-bundle?_1 i_88)
- (begin
- 'for-loop
- (if i_88
- (let-values (((key_60 value_2)
- (hash-iterate-key+value
- ht_122
- i_88)))
- (let-values (((accum_4
- saw-bundle?_2)
- (let-values (((accum_5)
- accum_3)
- ((saw-bundle?_3)
- saw-bundle?_1))
- (let-values (((accum_6
- saw-bundle?_4)
- (let-values ()
- (if (eq?
- key_60
- #f)
- (let-values ()
- (values
- (cons
- (cons
- (encode-name
- rev-name-prefix_0)
- (linklet-bundle->bytes
- value_2
- as-correlated-linklet?_2
- linklet-bundle->hash_2))
- accum_5)
- #t))
- (let-values ()
- (values
- (flatten-linklet-directory_0
- value_2
- (cons
- key_60
- rev-name-prefix_0)
- accum_5)
- saw-bundle?_3))))))
+ (let-values (((accum_3)
+ (let-values (((accum_4) accum_2)) accum_4))
+ ((saw-bundle?_1)
+ (let-values (((saw-bundle?_2) #f)) saw-bundle?_2)))
+ (let-values (((ht_149) (linklet-directory->hash_0 ld_1)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash ht_149))
+ ((letrec-values (((for-loop_255)
+ (lambda (accum_5 saw-bundle?_3 i_220)
+ (begin
+ 'for-loop
+ (if i_220
+ (let-values (((key_63 value_2)
+ (hash-iterate-key+value
+ ht_149
+ i_220)))
+ (let-values (((accum_6
+ saw-bundle?_4)
+ (let-values (((accum_7
+ saw-bundle?_5)
+ (if (eq?
+ key_63
+ #f)
+ (values
+ (cons
+ (cons
+ (encode-name
+ rev-name-prefix_0)
+ (linklet-bundle->bytes
+ value_2
+ as-correlated-linklet?_2
+ linklet-bundle->hash_2
+ machine-type_3))
+ accum_5)
+ #t)
+ (values
+ (flatten-linklet-directory_0
+ value_2
+ (cons
+ key_63
+ rev-name-prefix_0)
+ accum_5)
+ saw-bundle?_3))))
(values
- accum_6
- saw-bundle?_4)))))
- (if (not #f)
- (for-loop_203
- accum_4
- saw-bundle?_2
- (hash-iterate-next
- ht_122
- i_88))
- (values
- accum_4
- saw-bundle?_2))))
- (values accum_3 saw-bundle?_1))))))
- for-loop_203)
- accum_2
- #f
- (hash-iterate-first ht_122))))))
+ accum_7
+ saw-bundle?_5))))
+ (if (not #f)
+ (for-loop_255
+ accum_6
+ saw-bundle?_4
+ (hash-iterate-next
+ ht_149
+ i_220))
+ (values
+ accum_6
+ saw-bundle?_4))))
+ (values accum_5 saw-bundle?_3))))))
+ for-loop_255)
+ accum_3
+ saw-bundle?_1
+ (hash-iterate-first ht_149)))))))
(if saw-bundle?_0
- (let-values () new-accum_0)
- (let-values ()
- (cons (cons (encode-name rev-name-prefix_0) #"#f") new-accum_0))))))))
+ new-accum_0
+ (cons (cons (encode-name rev-name-prefix_0) #"#f") new-accum_0)))))))
(let-values (((bundles_0)
(list->vector
(let-values (((temp1_2) (flatten-linklet-directory_0 ld_0 '() '()))
- ((temp2_2) (lambda (a_36 b_84) (bytes (car a_36) (car b_84)))))
+ ((temp2_2) (lambda (a_42 b_108) (bytes (car a_42) (car b_108)))))
(sort.1 #f #f temp1_2 temp2_2)))))
- (let-values (((len_47) (vector-length bundles_0)))
+ (let-values (((len_53) (vector-length bundles_0)))
(let-values (((initial-offset_0)
(+ 2 1 (bytes-length version-bytes$1) 1 (bytes-length vm-bytes_1) 1 4)))
- (let-values ((() (begin (write-int len_47 port_9) (values))))
- (let-values (((btree-size_0) (compute-btree-size bundles_0 len_47)))
+ (let-values ((() (begin (write-int len_53 port_10) (values))))
+ (let-values (((btree-size_0) (compute-btree-size bundles_0 len_53)))
(let-values (((node-offsets_0)
- (compute-btree-node-offsets bundles_0 len_47 initial-offset_0)))
+ (compute-btree-node-offsets bundles_0 len_53 initial-offset_0)))
(let-values (((bundle-offsets_0)
(compute-bundle-offsets
bundles_0
- len_47
+ len_53
(+ initial-offset_0 btree-size_0))))
(begin
- (write-directory-btree bundles_0 node-offsets_0 bundle-offsets_0 len_47 port_9)
- (let-values (((start_43) 0) ((end_31) len_47) ((inc_25) 1))
+ (write-directory-btree bundles_0 node-offsets_0 bundle-offsets_0 len_53 port_10)
+ (let-values (((start_51) 0) ((end_34) len_53) ((inc_28) 1))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-range start_43 end_31 inc_25)))
- ((letrec-values (((for-loop_23)
- (lambda (pos_105)
+ (check-range start_51 end_34 inc_28))
+ ((letrec-values (((for-loop_256)
+ (lambda (pos_134)
(begin
'for-loop
- (if (< pos_105 end_31)
- (let-values (((i_161) pos_105))
+ (if (< pos_134 end_34)
+ (let-values (((i_221) pos_134))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (write-bytes
- (cdr
- (vector-ref
- bundles_0
- i_161))
- port_9))
- (values)))))
- (values)))))
+ (let-values ((()
+ (begin
+ (write-bytes
+ (cdr
+ (vector-ref
+ bundles_0
+ i_221))
+ port_10)
+ (values))))
+ (values))))
(if (not #f)
- (for-loop_23 (+ pos_105 inc_25))
+ (for-loop_256 (+ pos_134 inc_28))
(values))))
(values))))))
- for-loop_23)
- start_43)))
+ for-loop_256)
+ start_51)))
(void))))))))))))))))))))
(define-values
(encode-name)
(lambda (rev-name_0)
(begin
(let-values (((encode-symbol_0)
- (lambda (s_7)
+ (lambda (s_409)
(begin
'encode-symbol
- (let-values (((bstr_17) (string->bytes/utf-8 (symbol->string s_7))))
- (let-values (((len_48) (bytes-length bstr_17)))
- (if (< len_48 255)
- (list (bytes len_48) bstr_17)
- (list (bytes 255) (integer->integer-bytes len_48 4 #f #f) bstr_17))))))))
- ((letrec-values (((loop_91)
- (lambda (rev-name_1 accum_7)
+ (let-values (((bstr_17) (string->bytes/utf-8 (symbol->string s_409))))
+ (let-values (((len_54) (bytes-length bstr_17)))
+ (if (< len_54 255)
+ (list (bytes len_54) bstr_17)
+ (list (bytes 255) (integer->integer-bytes len_54 4 #f #f) bstr_17))))))))
+ ((letrec-values (((loop_99)
+ (lambda (rev-name_1 accum_8)
(begin
'loop
(if (null? rev-name_1)
- (let-values () (apply bytes-append accum_7))
- (let-values ()
- (loop_91 (cdr rev-name_1) (append (encode-symbol_0 (car rev-name_1)) accum_7))))))))
- loop_91)
+ (apply bytes-append accum_8)
+ (loop_99 (cdr rev-name_1) (append (encode-symbol_0 (car rev-name_1)) accum_8)))))))
+ loop_99)
rev-name_0
'())))))
(define-values
(compute-btree-size)
- (lambda (bundles_1 len_49)
+ (lambda (bundles_1 len_55)
(begin
- (let-values (((start_44) 0) ((end_32) len_49) ((inc_26) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_44 end_32 inc_26)))
- ((letrec-values (((for-loop_115)
- (lambda (result_5 pos_106)
- (begin
- 'for-loop
- (if (< pos_106 end_32)
- (let-values (((i_115) pos_106))
- (let-values (((result_77)
- (let-values (((result_23) result_5))
- (let-values (((result_78)
- (let-values ()
- (+
- result_23
- (let-values ()
- (let-values (((nlen_0)
- (bytes-length
- (car
- (vector-ref bundles_1 i_115)))))
- (+ nlen_0 (* 5 4))))))))
- (values result_78)))))
- (if (not #f) (for-loop_115 result_77 (+ pos_106 inc_26)) result_77)))
- result_5)))))
- for-loop_115)
- 0
- start_44))))))
+ (let-values (((result_139) (let-values (((result_140) 0)) result_140)))
+ (let-values (((start_52) 0) ((end_35) len_55) ((inc_29) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-range start_52 end_35 inc_29))
+ ((letrec-values (((for-loop_257)
+ (lambda (result_141 pos_135)
+ (begin
+ 'for-loop
+ (if (< pos_135 end_35)
+ (let-values (((i_222) pos_135))
+ (let-values (((result_142)
+ (let-values (((result_143)
+ (+
+ result_141
+ (let-values (((nlen_0)
+ (bytes-length
+ (car (vector-ref bundles_1 i_222)))))
+ (+ nlen_0 (* 5 4))))))
+ (values result_143))))
+ (if (not #f) (for-loop_257 result_142 (+ pos_135 inc_29)) result_142)))
+ result_141)))))
+ for-loop_257)
+ result_139
+ start_52)))))))
(define-values
(compute-btree-node-offsets)
- (lambda (bundles_2 len_50 initial-offset_1)
+ (lambda (bundles_2 len_56 initial-offset_1)
(begin
- (let-values (((node-offsets_1) (make-vector len_50)))
+ (let-values (((node-offsets_1) (make-vector len_56)))
(begin
- ((letrec-values (((loop_92)
+ ((letrec-values (((loop_100)
(lambda (lo_2 hi_2 offset_1)
(begin
'loop
(if (= lo_2 hi_2)
- (let-values () offset_1)
- (let-values ()
- (let-values (((mid_0) (quotient (+ lo_2 hi_2) 2)))
- (let-values ((() (begin (vector-set! node-offsets_1 mid_0 offset_1) (values))))
- (let-values (((nlen_1) (bytes-length (car (vector-ref bundles_2 mid_0)))))
- (let-values (((offset_2) (+ offset_1 4 nlen_1 4 4 4 4)))
- (let-values (((offset_3) (loop_92 lo_2 mid_0 offset_2)))
- (loop_92 (add1 mid_0) hi_2 offset_3))))))))))))
- loop_92)
+ offset_1
+ (let-values (((mid_0) (quotient (+ lo_2 hi_2) 2)))
+ (let-values ((() (begin (vector-set! node-offsets_1 mid_0 offset_1) (values))))
+ (let-values (((nlen_1) (bytes-length (car (vector-ref bundles_2 mid_0)))))
+ (let-values (((offset_2) (+ offset_1 4 nlen_1 4 4 4 4)))
+ (let-values (((offset_3) (loop_100 lo_2 mid_0 offset_2)))
+ (loop_100 (add1 mid_0) hi_2 offset_3)))))))))))
+ loop_100)
0
- len_50
+ len_56
initial-offset_1)
node-offsets_1)))))
(define-values
(compute-bundle-offsets)
- (lambda (bundles_3 len_51 offset_4)
+ (lambda (bundles_3 len_57 offset_4)
(begin
- (let-values (((bundle-offsets_1) (make-vector len_51)))
+ (let-values (((bundle-offsets_1) (make-vector len_57)))
(begin
- ((letrec-values (((loop_38)
- (lambda (i_29 offset_5)
+ ((letrec-values (((loop_101)
+ (lambda (i_223 offset_5)
(begin
'loop
- (if (= i_29 len_51)
+ (if (= i_223 len_57)
(void)
- (let-values ()
- (begin
- (vector-set! bundle-offsets_1 i_29 offset_5)
- (loop_38
- (add1 i_29)
- (+ offset_5 (bytes-length (cdr (vector-ref bundles_3 i_29))))))))))))
- loop_38)
+ (begin
+ (vector-set! bundle-offsets_1 i_223 offset_5)
+ (loop_101
+ (add1 i_223)
+ (+ offset_5 (bytes-length (cdr (vector-ref bundles_3 i_223)))))))))))
+ loop_101)
0
offset_4)
bundle-offsets_1)))))
(define-values
(write-directory-btree)
- (lambda (bundles_4 node-offsets_2 bundle-offsets_2 len_52 port_10)
+ (lambda (bundles_4 node-offsets_2 bundle-offsets_2 len_58 port_11)
(begin
- ((letrec-values (((loop_88)
+ ((letrec-values (((loop_102)
(lambda (lo_3 hi_3)
(begin
'loop
(if (= lo_3 hi_3)
- (let-values () (void))
- (let-values ()
- (let-values (((mid_1) (quotient (+ lo_3 hi_3) 2)))
- (let-values (((p_33) (vector-ref bundles_4 mid_1)))
- (let-values (((nlen_2) (bytes-length (car p_33))))
- (begin
- (write-int nlen_2 port_10)
- (write-bytes (car p_33) port_10)
- (write-int (vector-ref bundle-offsets_2 mid_1) port_10)
- (write-int (bytes-length (cdr p_33)) port_10)
- (if (> mid_1 lo_3)
- (let-values ()
- (let-values (((left_0) (quotient (+ lo_3 mid_1) 2)))
- (write-int (vector-ref node-offsets_2 left_0) port_10)))
- (let-values () (write-int 0 port_10)))
- (if (< (add1 mid_1) hi_3)
- (let-values ()
- (let-values (((right_0) (quotient (+ (add1 mid_1) hi_3) 2)))
- (write-int (vector-ref node-offsets_2 right_0) port_10)))
- (let-values () (write-int 0 port_10)))
- (loop_88 lo_3 mid_1)
- (loop_88 (add1 mid_1) hi_3)))))))))))
- loop_88)
+ (void)
+ (let-values (((mid_1) (quotient (+ lo_3 hi_3) 2)))
+ (let-values (((p_38) (vector-ref bundles_4 mid_1)))
+ (let-values (((nlen_2) (bytes-length (car p_38))))
+ (begin
+ (write-int nlen_2 port_11)
+ (write-bytes (car p_38) port_11)
+ (write-int (vector-ref bundle-offsets_2 mid_1) port_11)
+ (write-int (bytes-length (cdr p_38)) port_11)
+ (if (> mid_1 lo_3)
+ (let-values (((left_0) (quotient (+ lo_3 mid_1) 2)))
+ (write-int (vector-ref node-offsets_2 left_0) port_11))
+ (write-int 0 port_11))
+ (if (< (add1 mid_1) hi_3)
+ (let-values (((right_0) (quotient (+ (add1 mid_1) hi_3) 2)))
+ (write-int (vector-ref node-offsets_2 right_0) port_11))
+ (write-int 0 port_11))
+ (loop_102 lo_3 mid_1)
+ (loop_102 (add1 mid_1) hi_3))))))))))
+ loop_102)
0
- len_52))))
- (define-values (write-int) (lambda (n_29 port_11) (begin (write-bytes (integer->integer-bytes n_29 4 #f #f) port_11))))
+ len_58))))
+ (define-values (write-int) (lambda (n_29 port_12) (begin (write-bytes (integer->integer-bytes n_29 4 #f #f) port_12))))
(define-values
(struct:linklet-directory linklet-directory1.1 linklet-directory?$1 linklet-directory-ht)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'linklet-directory
- #f
- 1
- 0
- #f
- (list
- (cons
- prop:custom-write
- (lambda (ld_2 port_7 mode_10)
- (write-linklet-directory
- ld_2
- (correlated-linklet-directory? ld_2)
- linklet-directory->hash$1
- 1/linklet-bundle->hash
- port_7))))
- (current-inspector)
- #f
- '(0)
- #f
- 'linklet-directory)))))
- (values struct:_2 make-_2 ?_2 (make-struct-field-accessor -ref_2 0 'ht))))
+ (let-values (((struct:_96 make-_96 ?_96 -ref_96 -set!_96)
+ (make-struct-type
+ 'linklet-directory
+ #f
+ 1
+ 0
+ #f
+ (list
+ (cons
+ prop:custom-write
+ (lambda (ld_2 port_13 mode_12)
+ (let-values (((machine-type_4) (linklet-directory-machine-type ld_2)))
+ (write-linklet-directory
+ ld_2
+ (not machine-type_4)
+ linklet-directory->hash$1
+ linklet-bundle->hash$1
+ machine-type_4
+ port_13)))))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'linklet-directory)))
+ (values struct:_96 make-_96 ?_96 (make-struct-field-accessor -ref_96 0 'ht))))
(define-values
- (struct:linklet-bundle linklet-bundle2.1 1/linklet-bundle? linklet-bundle-ht)
- (let-values (((struct:_61 make-_61 ?_61 -ref_61 -set!_61)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'linklet-bundle
- #f
- 1
- 0
- #f
- (list
- (cons
- prop:custom-write
- (lambda (b_47 port_12 mode_11)
- (write-linklet-bundle b_47 (correlated-linklet-bundle? b_47) 1/linklet-bundle->hash port_12))))
- (current-inspector)
- #f
- '(0)
- #f
- 'linklet-bundle)))))
- (values struct:_61 make-_61 ?_61 (make-struct-field-accessor -ref_61 0 'ht))))
+ (struct:linklet-bundle linklet-bundle2.1 linklet-bundle?$1 linklet-bundle-ht)
+ (let-values (((struct:_97 make-_97 ?_97 -ref_97 -set!_97)
+ (make-struct-type
+ 'linklet-bundle
+ #f
+ 1
+ 0
+ #f
+ (list
+ (cons
+ prop:custom-write
+ (lambda (b_109 port_14 mode_13)
+ (let-values (((machine-type_5) (linklet-bundle-machine-type b_109)))
+ (write-linklet-bundle
+ b_109
+ (not machine-type_5)
+ linklet-bundle->hash$1
+ machine-type_5
+ port_14)))))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'linklet-bundle)))
+ (values struct:_97 make-_97 ?_97 (make-struct-field-accessor -ref_97 0 'ht))))
(define-values
(1/hash->linklet-directory)
- (lambda (ht_71)
+ (lambda (ht_150)
(begin
'hash->linklet-directory
- (let-values ()
- (let-values ()
+ (begin
+ (if ((lambda (ht_151)
+ (if (not (impersonator? ht_151))
+ (if (hash? ht_151) (if (immutable? ht_151) (hash-eq? ht_151) #f) #f)
+ #f))
+ ht_150)
+ (void)
+ (raise-argument-error
+ 'hash->linklet-directory
+ "(and/c hash? hash-eq? immutable? (not/c impersonator?))"
+ ht_150))
+ (let-values (((ht_152) ht_150))
(begin
- (if ((lambda (ht_123)
- (if (not (impersonator? ht_123))
- (if (hash? ht_123) (if (immutable? ht_123) (hash-eq? ht_123) #f) #f)
- #f))
- ht_71)
- (void)
- (let-values ()
- (raise-argument-error
- 'hash->linklet-directory
- "(and/c hash? hash-eq? immutable? (not/c impersonator?))"
- ht_71)))
- (let-values (((ht_124) ht_71))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_124)))
- ((letrec-values (((for-loop_107)
- (lambda (i_162)
- (begin
- 'for-loop
- (if i_162
- (let-values (((k_1 v_166) (hash-iterate-key+value ht_124 i_162)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (if (not k_1)
- (let-values ()
- (if (1/linklet-bundle? v_166)
- (void)
- (let-values ()
- (raise-arguments-error
- 'hash->linklet-directory
- "value for #f key is not a linklet bundle"
- "value"
- v_166))))
- (if (symbol? k_1)
- (let-values ()
- (if (linklet-directory?$1 v_166)
- (void)
- (let-values ()
- (raise-arguments-error
- 'hash->linklet-directory
- "value for symbol key is not a linklet directory"
- "value"
- v_166))))
- (let-values ()
- (raise-arguments-error
- 'hash->linklet-directory
- "key in given hash is not #f or a symbol"
- "key"
- k_1)))))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_107 (hash-iterate-next ht_124 i_162)) (values))))
- (values))))))
- for-loop_107)
- (hash-iterate-first ht_124))))
- (void)
- (linklet-directory1.1 ht_71)))))))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_152))
+ ((letrec-values (((for-loop_258)
+ (lambda (i_224)
+ (begin
+ 'for-loop
+ (if i_224
+ (let-values (((k_49 v_230) (hash-iterate-key+value ht_152 i_224)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (if (not k_49)
+ (if (linklet-bundle?$1 v_230)
+ (void)
+ (raise-arguments-error
+ 'hash->linklet-directory
+ "value for #f key is not a linklet bundle"
+ "value"
+ v_230))
+ (if (symbol? k_49)
+ (if (linklet-directory?$1 v_230)
+ (void)
+ (raise-arguments-error
+ 'hash->linklet-directory
+ "value for symbol key is not a linklet directory"
+ "value"
+ v_230))
+ (raise-arguments-error
+ 'hash->linklet-directory
+ "key in given hash is not #f or a symbol"
+ "key"
+ k_49)))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_258 (hash-iterate-next ht_152 i_224)) (values))))
+ (values))))))
+ for-loop_258)
+ (hash-iterate-first ht_152))))
+ (void)
+ (linklet-directory1.1 ht_150)))))
(define-values
(1/hash->linklet-bundle)
- (lambda (ht_79)
+ (lambda (ht_153)
(begin
'hash->linklet-bundle
- (let-values ()
- (let-values ()
+ (begin
+ (if ((lambda (ht_154)
+ (if (not (impersonator? ht_154))
+ (if (hash? ht_154) (if (immutable? ht_154) (hash-eq? ht_154) #f) #f)
+ #f))
+ ht_153)
+ (void)
+ (raise-argument-error 'hash->linklet-bundle "(and/c hash? hash-eq? immutable? (not/c impersonator?))" ht_153))
+ (let-values (((ht_155) ht_153))
(begin
- (if ((lambda (ht_72)
- (if (not (impersonator? ht_72))
- (if (hash? ht_72) (if (immutable? ht_72) (hash-eq? ht_72) #f) #f)
- #f))
- ht_79)
- (void)
- (let-values ()
- (raise-argument-error
- 'hash->linklet-bundle
- "(and/c hash? hash-eq? immutable? (not/c impersonator?))"
- ht_79)))
- (let-values (((ht_125) ht_79))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash-keys ht_125)))
- ((letrec-values (((for-loop_113)
- (lambda (i_88)
- (begin
- 'for-loop
- (if i_88
- (let-values (((k_23) (hash-iterate-key ht_125 i_88)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (if (let-values (((or-part_35)
- (symbol? k_23)))
- (if or-part_35
- or-part_35
- (fixnum? k_23)))
- (void)
- (let-values ()
- (raise-arguments-error
- 'hash->linklet-bundle
- "key in given hash is not a symbol or fixnum"
- "key"
- k_23))))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_113 (hash-iterate-next ht_125 i_88)) (values))))
- (values))))))
- for-loop_113)
- (hash-iterate-first ht_125))))
- (void)
- (linklet-bundle2.1 ht_79)))))))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash-keys ht_155))
+ ((letrec-values (((for-loop_259)
+ (lambda (i_225)
+ (begin
+ 'for-loop
+ (if i_225
+ (let-values (((k_50) (hash-iterate-key ht_155 i_225)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_340) (symbol? k_50)))
+ (if or-part_340 or-part_340 (fixnum? k_50)))
+ (void)
+ (raise-arguments-error
+ 'hash->linklet-bundle
+ "key in given hash is not a symbol or fixnum"
+ "key"
+ k_50))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_259 (hash-iterate-next ht_155 i_225)) (values))))
+ (values))))))
+ for-loop_259)
+ (hash-iterate-first ht_155))))
+ (void)
+ (linklet-bundle2.1 ht_153)))))
(define-values
(linklet-directory->hash$1)
(lambda (ld_3)
(begin
'linklet-directory->hash
- (let-values ()
- (let-values ()
- (begin
- (if (linklet-directory?$1 ld_3)
- (void)
- (let-values () (raise-argument-error 'linklet-directory->hash "linklet-directory?" ld_3)))
- (linklet-directory-ht ld_3)))))))
+ (begin
+ (if (linklet-directory?$1 ld_3)
+ (void)
+ (raise-argument-error 'linklet-directory->hash "linklet-directory?" ld_3))
+ (linklet-directory-ht ld_3)))))
(define-values
- (1/linklet-bundle->hash)
+ (linklet-bundle->hash$1)
(lambda (ld_4)
(begin
'linklet-bundle->hash
- (let-values ()
- (let-values ()
- (begin
- (if (1/linklet-bundle? ld_4)
- (void)
- (let-values () (raise-argument-error 'linklet-bundle->hash "linklet-bundle?" ld_4)))
- (linklet-bundle-ht ld_4)))))))
+ (begin
+ (if (linklet-bundle?$1 ld_4) (void) (raise-argument-error 'linklet-bundle->hash "linklet-bundle?" ld_4))
+ (linklet-bundle-ht ld_4)))))
(define-values
- (correlated-linklet-directory?)
+ (linklet-directory-machine-type)
(lambda (ld_5)
(begin
- (let-values (((ht_121) (linklet-directory->hash$1 ld_5)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-in-hash ht_121)))
- ((letrec-values (((for-loop_204)
- (lambda (result_79 i_92)
- (begin
- 'for-loop
- (if i_92
- (let-values (((k_48 v_167) (hash-iterate-key+value ht_121 i_92)))
- (let-values (((result_80)
- (let-values ()
- (let-values (((result_66)
- (let-values ()
- (let-values ()
- (if (not k_48)
- (let-values ()
- (correlated-linklet-bundle? v_167))
- (if (symbol? k_48)
- (let-values ()
- (correlated-linklet-directory? v_167))
- (let-values () #t)))))))
- (values result_66)))))
- (if (if (not ((lambda x_60 (not result_80)) k_48 v_167)) (not #f) #f)
- (for-loop_204 result_80 (hash-iterate-next ht_121 i_92))
- result_80)))
- result_79)))))
- for-loop_204)
- #t
- (hash-iterate-first ht_121)))))))
- (define-values
- (correlated-linklet-bundle?)
- (lambda (b_18)
- (begin
- (let-values (((ht_126) (1/linklet-bundle->hash b_18)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-in-hash ht_126)))
- ((letrec-values (((for-loop_88)
- (lambda (result_81 i_163)
- (begin
- 'for-loop
- (if i_163
- (let-values (((k_49 v_168) (hash-iterate-key+value ht_126 i_163)))
- (let-values (((result_68)
- (let-values ()
- (let-values (((result_82)
- (let-values ()
- (let-values () (not (linklet?$1 v_168))))))
- (values result_82)))))
- (if (if (not ((lambda x_61 (not result_68)) k_49 v_168)) (not #f) #f)
- (for-loop_88 result_68 (hash-iterate-next ht_126 i_163))
- result_68)))
- result_81)))))
- for-loop_88)
- #t
- (hash-iterate-first ht_126)))))))
+ (let-values (((result_144) (let-values (((result_145) #f)) result_145)))
+ (let-values (((ht_156) (linklet-directory->hash$1 ld_5)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_156))
+ ((letrec-values (((for-loop_260)
+ (lambda (result_146 i_226)
+ (begin
+ 'for-loop
+ (if i_226
+ (let-values (((k_51 v_231) (hash-iterate-key+value ht_156 i_226)))
+ (let-values (((result_147)
+ (let-values (((result_148)
+ (if (not k_51)
+ (linklet-bundle-machine-type v_231)
+ (if (symbol? k_51)
+ (linklet-directory-machine-type v_231)
+ #f))))
+ (values result_148))))
+ (if (if (not ((lambda x_66 result_147) k_51 v_231)) (not #f) #f)
+ (for-loop_260 result_147 (hash-iterate-next ht_156 i_226))
+ result_147)))
+ result_146)))))
+ for-loop_260)
+ result_144
+ (hash-iterate-first ht_156))))))))
+ (define-values
+ (linklet-bundle-machine-type)
+ (lambda (b_110)
+ (begin
+ (let-values (((result_149) (let-values (((result_150) #f)) result_150)))
+ (let-values (((ht_157) (linklet-bundle->hash$1 b_110)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_157))
+ ((letrec-values (((for-loop_261)
+ (lambda (result_151 i_227)
+ (begin
+ 'for-loop
+ (if i_227
+ (let-values (((k_52 v_232) (hash-iterate-key+value ht_157 i_227)))
+ (let-values (((result_152)
+ (let-values (((result_153)
+ (if (linklet?$1 v_232)
+ (let-values (((or-part_341)
+ (1/linklet-cross-machine-type v_232)))
+ (if or-part_341
+ or-part_341
+ (system-type 'target-machine)))
+ #f)))
+ (values result_153))))
+ (if (if (not ((lambda x_67 result_152) k_52 v_232)) (not #f) #f)
+ (for-loop_261 result_152 (hash-iterate-next ht_157 i_227))
+ result_152)))
+ result_151)))))
+ for-loop_261)
+ result_149
+ (hash-iterate-first ht_157))))))))
(define-values
(struct:namespace-scopes namespace-scopes1.1 namespace-scopes? namespace-scopes-post namespace-scopes-other)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type 'namespace-scopes #f 2 0 #f null 'prefab #f '(0 1) #f 'namespace-scopes)))))
+ (let-values (((struct:_98 make-_98 ?_98 -ref_98 -set!_98)
+ (make-struct-type 'namespace-scopes #f 2 0 #f null 'prefab #f '(0 1) #f 'namespace-scopes)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'post)
- (make-struct-field-accessor -ref_2 1 'other))))
+ struct:_98
+ make-_98
+ ?_98
+ (make-struct-field-accessor -ref_98 0 'post)
+ (make-struct-field-accessor -ref_98 1 'other))))
(define-values
(swap-top-level-scopes)
- (lambda (s_325 original-scopes-s_0 new-ns_0)
+ (lambda (s_410 original-scopes-s_0 new-ns_0)
(begin
(let-values (((old-scs-post_0 old-scs-other_0)
(if (namespace-scopes? original-scopes-s_0)
@@ -32136,38 +32265,38 @@
(decode-namespace-scopes original-scopes-s_0))))
(let-values (((new-scs-post_0 new-scs-other_0) (extract-namespace-scopes/values new-ns_0)))
(syntax-swap-scopes
- (syntax-swap-scopes s_325 old-scs-post_0 new-scs-post_0)
+ (syntax-swap-scopes s_410 old-scs-post_0 new-scs-post_0)
old-scs-other_0
new-scs-other_0))))))
(define-values
(extract-namespace-scopes/values)
- (lambda (ns_52)
+ (lambda (ns_58)
(begin
- (let-values (((root-ctx_3) (namespace-get-root-expand-ctx ns_52)))
+ (let-values (((root-ctx_3) (namespace-get-root-expand-ctx ns_58)))
(let-values (((post-expansion-sc_0) (post-expansion-scope (root-expand-context-post-expansion root-ctx_3))))
(values
(seteq post-expansion-sc_0)
(set-remove (list->seteq (root-expand-context-module-scopes root-ctx_3)) post-expansion-sc_0)))))))
(define-values
(extract-namespace-scopes)
- (lambda (ns_53)
+ (lambda (ns_59)
(begin
- (let-values (((scs-post_0 scs-other_0) (extract-namespace-scopes/values ns_53)))
+ (let-values (((scs-post_0 scs-other_0) (extract-namespace-scopes/values ns_59)))
(namespace-scopes1.1 scs-post_0 scs-other_0)))))
(define-values
(encode-namespace-scopes)
- (lambda (ns_51)
+ (lambda (ns_60)
(begin
- (let-values (((post-expansion-scs_0 other-scs_1) (extract-namespace-scopes/values ns_51)))
+ (let-values (((post-expansion-scs_0 other-scs_1) (extract-namespace-scopes/values ns_60)))
(let-values (((post-expansion-s_0) (add-scopes (datum->syntax$1 #f 'post) (set->list post-expansion-scs_0))))
(let-values (((other-s_0) (add-scopes (datum->syntax$1 #f 'other) (set->list other-scs_1))))
(datum->syntax$1 #f (vector post-expansion-s_0 other-s_0))))))))
(define-values
(decode-namespace-scopes)
- (lambda (stx_12)
+ (lambda (stx_14)
(begin
- (let-values (((vec_66) (syntax-e$1 stx_12)))
- (values (syntax-scope-set (vector-ref vec_66 0) 0) (syntax-scope-set (vector-ref vec_66 1) 0))))))
+ (let-values (((vec_77) (syntax-e$1 stx_14)))
+ (values (syntax-scope-set (vector-ref vec_77 0) 0) (syntax-scope-set (vector-ref vec_77 1) 0))))))
(define-values
(namespace-scopes=?)
(lambda (nss1_0 nss2_0)
@@ -32183,29 +32312,16 @@
syntax-literals-count
set-syntax-literals-stxes!
set-syntax-literals-count!)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'syntax-literals
- #f
- 2
- 0
- #f
- null
- (current-inspector)
- #f
- '()
- #f
- 'syntax-literals)))))
+ (let-values (((struct:_99 make-_99 ?_99 -ref_99 -set!_99)
+ (make-struct-type 'syntax-literals #f 2 0 #f null (current-inspector) #f '() #f 'syntax-literals)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'stxes)
- (make-struct-field-accessor -ref_2 1 'count)
- (make-struct-field-mutator -set!_2 0 'stxes)
- (make-struct-field-mutator -set!_2 1 'count))))
+ struct:_99
+ make-_99
+ ?_99
+ (make-struct-field-accessor -ref_99 0 'stxes)
+ (make-struct-field-accessor -ref_99 1 'count)
+ (make-struct-field-mutator -set!_99 0 'stxes)
+ (make-struct-field-mutator -set!_99 1 'count))))
(define-values
(struct:header
header2.1
@@ -32220,41 +32336,38 @@
header-syntax-literals
set-header-binding-syms-in-order!
set-header-require-vars-in-order!)
- (let-values (((struct:_3 make-_3 ?_3 -ref_3 -set!_3)
- (let-values ()
- (let-values ()
- (make-struct-type 'header #f 8 0 #f null (current-inspector) #f '(0 1 3 4 6 7) #f 'header)))))
+ (let-values (((struct:_100 make-_100 ?_100 -ref_100 -set!_100)
+ (make-struct-type 'header #f 8 0 #f null (current-inspector) #f '(0 1 3 4 6 7) #f 'header)))
(values
- struct:_3
- make-_3
- ?_3
- (make-struct-field-accessor -ref_3 0 'module-path-indexes)
- (make-struct-field-accessor -ref_3 1 'binding-sym-to-define-sym)
- (make-struct-field-accessor -ref_3 2 'binding-syms-in-order)
- (make-struct-field-accessor -ref_3 3 'require-var-to-import-sym)
- (make-struct-field-accessor -ref_3 4 'import-sym-to-extra-inspectors)
- (make-struct-field-accessor -ref_3 5 'require-vars-in-order)
- (make-struct-field-accessor -ref_3 6 'define-and-import-syms)
- (make-struct-field-accessor -ref_3 7 'syntax-literals)
- (make-struct-field-mutator -set!_3 2 'binding-syms-in-order)
- (make-struct-field-mutator -set!_3 5 'require-vars-in-order))))
+ struct:_100
+ make-_100
+ ?_100
+ (make-struct-field-accessor -ref_100 0 'module-path-indexes)
+ (make-struct-field-accessor -ref_100 1 'binding-sym-to-define-sym)
+ (make-struct-field-accessor -ref_100 2 'binding-syms-in-order)
+ (make-struct-field-accessor -ref_100 3 'require-var-to-import-sym)
+ (make-struct-field-accessor -ref_100 4 'import-sym-to-extra-inspectors)
+ (make-struct-field-accessor -ref_100 5 'require-vars-in-order)
+ (make-struct-field-accessor -ref_100 6 'define-and-import-syms)
+ (make-struct-field-accessor -ref_100 7 'syntax-literals)
+ (make-struct-field-mutator -set!_100 2 'binding-syms-in-order)
+ (make-struct-field-mutator -set!_100 5 'require-vars-in-order))))
(define-values
(struct:variable-use variable-use3.1 variable-use? variable-use-module-use variable-use-sym)
- (let-values (((struct:_6 make-_6 ?_6 -ref_6 -set!_6)
- (let-values ()
- (let-values () (make-struct-type 'variable-use #f 2 0 #f null #f #f '(0 1) #f 'variable-use)))))
+ (let-values (((struct:_101 make-_101 ?_101 -ref_101 -set!_101)
+ (make-struct-type 'variable-use #f 2 0 #f null #f #f '(0 1) #f 'variable-use)))
(values
- struct:_6
- make-_6
- ?_6
- (make-struct-field-accessor -ref_6 0 'module-use)
- (make-struct-field-accessor -ref_6 1 'sym))))
+ struct:_101
+ make-_101
+ ?_101
+ (make-struct-field-accessor -ref_101 0 'module-use)
+ (make-struct-field-accessor -ref_101 1 'sym))))
(define-values (make-syntax-literals) (lambda () (begin (syntax-literals1.1 null 0))))
(define-values
(make-header)
- (lambda (mpis_14 syntax-literals_0)
+ (lambda (mpis_15 syntax-literals_1)
(begin
- (header2.1 mpis_14 (make-hasheq) null (make-variable-uses) (make-hasheq) null (make-hasheq) syntax-literals_0))))
+ (header2.1 mpis_15 (make-hasheq) null (make-variable-uses) (make-hasheq) null (make-hasheq) syntax-literals_1))))
(define-values (make-variable-uses) (lambda () (begin (make-hash))))
(define-values
(add-syntax-literal!)
@@ -32264,43 +32377,37 @@
(if (header? header-or-literals_0)
(header-syntax-literals header-or-literals_0)
header-or-literals_0)))
- (let-values (((pos_0) (syntax-literals-count sl_0)))
+ (let-values (((pos_136) (syntax-literals-count sl_0)))
(begin
- (set-syntax-literals-count! sl_0 (add1 pos_0))
+ (set-syntax-literals-count! sl_0 (add1 pos_136))
(set-syntax-literals-stxes! sl_0 (cons q_0 (syntax-literals-stxes sl_0)))
- pos_0))))))
+ pos_136))))))
(define-values
(add-syntax-literals!)
- (lambda (sl_1 vec_66)
+ (lambda (sl_1 vec_78)
(begin
- (let-values (((pos_107) (syntax-literals-count sl_1)))
+ (let-values (((pos_137) (syntax-literals-count sl_1)))
(begin
- (let-values (((vec_67 len_53)
- (let-values (((vec_68) vec_66))
- (begin (check-vector vec_68) (values vec_68 (unsafe-vector-length vec_68))))))
- (begin
- #f
- ((letrec-values (((for-loop_113)
- (lambda (pos_108)
- (begin
- 'for-loop
- (if (unsafe-fx< pos_108 len_53)
- (let-values (((e_43) (unsafe-vector-ref vec_67 pos_108)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (add-syntax-literal! sl_1 e_43))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_113 (unsafe-fx+ 1 pos_108)) (values))))
- (values))))))
- for-loop_113)
- 0)))
+ (let-values (((vec_79 len_59)
+ (let-values (((vec_80) vec_78))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-vector vec_80))
+ (values vec_80 (unsafe-vector-length vec_80))))))
+ ((letrec-values (((for-loop_262)
+ (lambda (pos_138)
+ (begin
+ 'for-loop
+ (if (unsafe-fx< pos_138 len_59)
+ (let-values (((e_46) (unsafe-vector-ref vec_79 pos_138)))
+ (let-values ((()
+ (let-values ((() (begin (add-syntax-literal! sl_1 e_46) (values))))
+ (values))))
+ (if (not #f) (for-loop_262 (unsafe-fx+ 1 pos_138)) (values))))
+ (values))))))
+ for-loop_262)
+ 0))
(void)
- (cons pos_107 (vector-length vec_66)))))))
+ (cons pos_137 (vector-length vec_78)))))))
(define-values (syntax-literals-empty?) (lambda (sl_2) (begin (null? (syntax-literals-stxes sl_2)))))
(define-values
(generate-lazy-syntax-literals!.1)
@@ -32308,200 +32415,192 @@
(begin
'generate-lazy-syntax-literals!
(let-values (((sl_3) sl6_0))
- (let-values (((mpis_15) mpis7_0))
- (let-values (((self_16) self8_1))
+ (let-values (((mpis_16) mpis7_0))
+ (let-values (((self_19) self8_1))
(let-values (((skip-deserialize?_0) skip-deserialize?4_0))
- (let-values ()
+ (list
+ (list 'define-values (list syntax-literals-id) (list* 'make-vector (syntax-literals-count sl_3) '(#f)))
+ (list
+ 'define-values
+ (list get-syntax-literal!-id)
(list
- (list 'define-values (list syntax-literals-id) (list* 'make-vector (syntax-literals-count sl_3) '(#f)))
+ 'lambda
+ '(pos)
(list
- 'define-values
- (list get-syntax-literal!-id)
+ 'let-values
+ (list (list '(ready-stx) (list* 'unsafe-vector*-ref syntax-literals-id '(pos))))
(list
- 'lambda
- '(pos)
+ 'if
+ 'ready-stx
+ 'ready-stx
(list
- 'let-values
- (list (list '(ready-stx) (list* 'unsafe-vector*-ref syntax-literals-id '(pos))))
- (list
- 'if
- 'ready-stx
- 'ready-stx
- (list*
- 'begin
- (qq-append
- (if skip-deserialize?_0
- null
- (list
- (list
- 'if
- (list* 'unsafe-vector*-ref deserialized-syntax-vector-id '(0))
- '(void)
- (list deserialize-syntax-id bulk-binding-registry-id))))
- (list
- (list
- 'let-values
- (list
- (list
- '(stx)
- (list
- 'syntax-module-path-index-shift
- (list
- 'syntax-shift-phase-level
- (list* 'unsafe-vector*-ref deserialized-syntax-vector-id '(pos))
- phase-shift-id)
- (add-module-path-index! mpis_15 self_16)
- self-id
- inspector-id)))
- (list*
- 'letrec-values
- (list
- (list
- '(loop)
- (list
- 'lambda
- '()
- (list
- 'begin
- (list* 'vector-cas! syntax-literals-id '(pos #f stx))
- (list*
- 'let-values
- (list (list '(new-stx) (list* 'unsafe-vector*-ref syntax-literals-id '(pos))))
- '((if new-stx new-stx (loop))))))))
- '((loop))))))))))))))))))))
+ 'force-syntax-object
+ syntax-literals-id
+ 'pos
+ (add-module-path-index! mpis_16 self_19)
+ self-id
+ phase-shift-id
+ inspector-id
+ deserialized-syntax-vector-id
+ bulk-binding-registry-id
+ (if skip-deserialize?_0 #f deserialize-syntax-id))))))))))))))
(define-values
(generate-lazy-syntax-literals-data!)
- (lambda (sl_4 mpis_16)
+ (lambda (sl_4 mpis_17)
(begin
(if (syntax-literals-empty? sl_4)
- (let-values () (list (list* 'define-values (list deserialize-syntax-id) '(#f))))
- (let-values ()
+ (list (list* 'define-values (list deserialize-syntax-id) '(#f)))
+ (list
+ (list
+ 'define-values
+ (list deserialize-syntax-id)
(list
+ 'lambda
+ (list bulk-binding-registry-id)
(list
- 'define-values
- (list deserialize-syntax-id)
+ 'let-values
(list
- 'lambda
- (list bulk-binding-registry-id)
(list
- 'begin
+ '(vec)
+ (list
+ 'let-values
+ (list (list* (list inspector-id) '(#f)))
+ (let-values (((temp21_3)
+ (vector->immutable-vector (list->vector (reverse$1 (syntax-literals-stxes sl_4)))))
+ ((mpis22_0) mpis_17))
+ (generate-deserialize.1
+ #f
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ mpis22_0
+ #f
+ '#hasheq()
+ #f
+ #t
+ temp21_3)))))
+ (list
+ 'begin
+ (list*
+ 'letrec-values
(list
- 'vector-copy!
- deserialized-syntax-vector-id
- ''0
(list
- 'let-values
- (list (list* (list inspector-id) '(#f)))
- (let-values (((temp21_3)
- (vector->immutable-vector (list->vector (reverse$1 (syntax-literals-stxes sl_4)))))
- ((mpis22_0) mpis_16))
- (generate-deserialize.1 #f #f mpis22_0 #f '#hasheq() #t temp21_3))))
- (list* 'set! deserialize-syntax-id '(#f)))))))))))
- (define-values (generate-lazy-syntax-literal-lookup) (lambda (pos_109) (begin (list get-syntax-literal!-id pos_109))))
+ '(loop)
+ (list
+ 'lambda
+ '()
+ (list
+ 'if
+ (list* 'box-cas! deserialized-syntax-vector-id '(#f vec))
+ 'vec
+ (list*
+ 'let-values
+ (list (list '(other-vec) (list 'unbox deserialized-syntax-vector-id)))
+ '((if other-vec other-vec (loop))))))))
+ '((loop)))
+ (list* 'set! deserialize-syntax-id '(#f)))))))))))
+ (define-values (generate-lazy-syntax-literal-lookup) (lambda (pos_139) (begin (list get-syntax-literal!-id pos_139))))
(define-values
(generate-eager-syntax-literals!)
- (lambda (sl_5 mpis_17 base-phase_0 self_17 ns_54)
+ (lambda (sl_5 mpis_18 base-phase_0 self_20 ns_61)
(begin
(if (syntax-literals-empty? sl_5)
- (let-values () #f)
- (let-values ()
+ #f
+ (list
+ 'let-values
+ (list
(list
- 'let-values
- (list
- (list
- '(ns+stxss)
- (let-values (((temp23_1) (cons (encode-namespace-scopes ns_54) (reverse$1 (syntax-literals-stxes sl_5))))
- ((mpis24_0) mpis_17))
- (generate-deserialize.1 #f #f mpis24_0 #f '#hasheq() #t temp23_1))))
- (list
- 'let-values
- '(((ns-scope-s) (car ns+stxss)))
+ '(ns+stxss)
+ (let-values (((temp23_1) (cons (encode-namespace-scopes ns_61) (reverse$1 (syntax-literals-stxes sl_5))))
+ ((mpis24_0) mpis_18))
+ (generate-deserialize.1 #f #f unsafe-undefined unsafe-undefined mpis24_0 #f '#hasheq() #f #t temp23_1))))
+ (list
+ 'let-values
+ '(((ns-scope-s) (car ns+stxss)))
+ (list
+ 'list->vector
+ (list*
+ 'map
(list
- 'list->vector
- (list*
- 'map
+ 'lambda
+ '(stx)
+ (list
+ 'swap-top-level-scopes
(list
- 'lambda
- '(stx)
- (list
- 'swap-top-level-scopes
- (list
- 'syntax-module-path-index-shift
- (list 'syntax-shift-phase-level 'stx (list '- base-phase_0 dest-phase-id))
- (add-module-path-index! mpis_17 self_17)
- self-id)
- 'ns-scope-s
- ns-id))
- '((cdr ns+stxss)))))))))))
+ 'syntax-module-path-index-shift
+ (list 'syntax-shift-phase-level 'stx (list '- base-phase_0 dest-phase-id))
+ (add-module-path-index! mpis_18 self_20)
+ self-id)
+ 'ns-scope-s
+ ns-id))
+ '((cdr ns+stxss))))))))))
(define-values
(generate-eager-syntax-literal-lookup)
- (lambda (pos_110) (begin (list 'unsafe-vector*-ref syntax-literals-id pos_110))))
+ (lambda (pos_140) (begin (list 'unsafe-vector*-ref syntax-literals-id pos_140))))
(define-values
(syntax-literals-as-vector)
(lambda (sl_6) (begin (list->vector (reverse$1 (syntax-literals-stxes sl_6))))))
(define-values
(select-fresh)
- (lambda (sym_23 header_0)
+ (lambda (sym_64 header_0)
(begin
- (if (symbol-conflicts? sym_23 header_0)
- ((letrec-values (((loop_93)
- (lambda (pos_111)
+ (if (symbol-conflicts? sym_64 header_0)
+ ((letrec-values (((loop_103)
+ (lambda (pos_141)
(begin
'loop
(let-values (((new-sym_0)
(string->symbol
- (string-append (number->string pos_111) "/" (symbol->string sym_23)))))
- (if (symbol-conflicts? new-sym_0 header_0) (loop_93 (add1 pos_111)) new-sym_0))))))
- loop_93)
+ (string-append (number->string pos_141) "/" (symbol->string sym_64)))))
+ (if (symbol-conflicts? new-sym_0 header_0) (loop_103 (add1 pos_141)) new-sym_0))))))
+ loop_103)
1)
- sym_23))))
+ sym_64))))
(define-values
(symbol-conflicts?)
- (lambda (sym_52 header_1)
+ (lambda (sym_65 header_1)
(begin
- (let-values (((or-part_217) (built-in-symbol? sym_52)))
- (if or-part_217 or-part_217 (hash-ref (header-define-and-import-syms header_1) sym_52 #f))))))
+ (let-values (((or-part_342) (built-in-symbol? sym_65)))
+ (if or-part_342 or-part_342 (hash-ref (header-define-and-import-syms header_1) sym_65 #f))))))
(define-values
(register-required-variable-use!.1)
(lambda (defined?10_0 header12_0 mpi13_0 phase14_1 sym15_0 extra-inspector16_0)
(begin
'register-required-variable-use!
(let-values (((header_2) header12_0))
- (let-values (((mpi_49) mpi13_0))
- (let-values (((phase_73) phase14_1))
- (let-values (((sym_53) sym15_0))
+ (let-values (((mpi_69) mpi13_0))
+ (let-values (((phase_85) phase14_1))
+ (let-values (((sym_66) sym15_0))
(let-values (((extra-inspector_4) extra-inspector16_0))
(let-values (((defined?_3) defined?10_0))
- (let-values ()
- (let-values (((key_61) (variable-use3.1 (module-use1.1 mpi_49 phase_73) sym_53)))
- (let-values (((variable-uses_0) (header-require-var-to-import-sym header_2)))
- (let-values (((prev-var-sym_0) (hash-ref variable-uses_0 key_61 #f)))
- (let-values (((var-sym_0)
- (let-values (((or-part_218) prev-var-sym_0))
- (if or-part_218
- or-part_218
- (let-values (((sym_54) (select-fresh (variable-use-sym key_61) header_2)))
- (begin
- (hash-set! variable-uses_0 key_61 sym_54)
- (set-header-require-vars-in-order!
- header_2
- (cons key_61 (header-require-vars-in-order header_2)))
- (hash-set!
- (header-define-and-import-syms header_2)
- sym_54
- (if defined?_3 'defined 'required))
- sym_54))))))
- (begin
- (if (if extra-inspector_4 (not prev-var-sym_0) #f)
- (let-values ()
- (let-values (((extra-inspectors_0) (header-import-sym-to-extra-inspectors header_2)))
- (hash-update!
- extra-inspectors_0
- var-sym_0
- (lambda (s_326) (set-add s_326 extra-inspector_4))
- '#hasheq())))
- (void))
- var-sym_0)))))))))))))))
+ (let-values (((key_64) (variable-use3.1 (module-use1.1 mpi_69 phase_85) sym_66)))
+ (let-values (((variable-uses_0) (header-require-var-to-import-sym header_2)))
+ (let-values (((prev-var-sym_0) (hash-ref variable-uses_0 key_64 #f)))
+ (let-values (((var-sym_0)
+ (let-values (((or-part_343) prev-var-sym_0))
+ (if or-part_343
+ or-part_343
+ (let-values (((sym_67) (select-fresh (variable-use-sym key_64) header_2)))
+ (begin
+ (hash-set! variable-uses_0 key_64 sym_67)
+ (set-header-require-vars-in-order!
+ header_2
+ (cons key_64 (header-require-vars-in-order header_2)))
+ (hash-set!
+ (header-define-and-import-syms header_2)
+ sym_67
+ (if defined?_3 'defined 'required))
+ sym_67))))))
+ (begin
+ (if (if extra-inspector_4 (not prev-var-sym_0) #f)
+ (let-values (((extra-inspectors_0) (header-import-sym-to-extra-inspectors header_2)))
+ (hash-update!
+ extra-inspectors_0
+ var-sym_0
+ (lambda (s_411) (set-add s_411 extra-inspector_4))
+ '#hasheq()))
+ (void))
+ var-sym_0))))))))))))))
(define-values
(register-as-defined!)
(lambda (header_3 def-sym_0) (begin (hash-set! (header-define-and-import-syms header_3) def-sym_0 'defined))))
@@ -32511,323 +32610,295 @@
(begin (eq? 'required (hash-ref (header-define-and-import-syms header_4) var-sym_1 #f)))))
(define-values
(generate-links+imports)
- (lambda (header_5 phase_74 cctx_0 cross-linklet-inlining?_0)
+ (lambda (header_5 phase_86 cctx_0 cross-linklet-inlining?_0)
(begin
(let-values (((mod-use-ht_0 link-mod-uses_0)
- (let-values (((lst_171) (header-require-vars-in-order header_5)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_171)))
- ((letrec-values (((for-loop_205)
- (lambda (ht_127 link-mod-uses_1 lst_172)
- (begin
- 'for-loop
- (if (pair? lst_172)
- (let-values (((vu_0) (unsafe-car lst_172))
- ((rest_86) (unsafe-cdr lst_172)))
- (let-values (((ht_128 link-mod-uses_2)
- (let-values (((ht_129) ht_127)
- ((link-mod-uses_3) link-mod-uses_1))
- (let-values (((ht_25 link-mod-uses_4)
- (let-values ()
- (let-values (((mu_2)
- (variable-use-module-use
- vu_0)))
- (if (let-values (((or-part_219)
- (hash-ref
- ht_129
- mu_2
- #f)))
- (if or-part_219
- or-part_219
- (let-values (((or-part_220)
- (eq?
- (module-use-module
- mu_2)
- (compile-context-self
- cctx_0))))
- (if or-part_220
- or-part_220
- (top-level-module-path-index?
- (module-use-module
- mu_2))))))
- (values ht_129 link-mod-uses_3)
- (values
- (hash-set ht_129 mu_2 #t)
- (cons mu_2 link-mod-uses_3)))))))
- (values ht_25 link-mod-uses_4)))))
- (if (not #f)
- (for-loop_205 ht_128 link-mod-uses_2 rest_86)
- (values ht_128 link-mod-uses_2))))
- (values ht_127 link-mod-uses_1))))))
- for-loop_205)
- '#hash()
- null
- lst_171)))))
+ (let-values (((ht_158) (let-values (((ht_159) '#hash())) ht_159))
+ ((link-mod-uses_1) (let-values (((link-mod-uses_2) null)) link-mod-uses_2)))
+ (let-values (((lst_250) (header-require-vars-in-order header_5)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_250))
+ ((letrec-values (((for-loop_263)
+ (lambda (ht_160 link-mod-uses_3 lst_251)
+ (begin
+ 'for-loop
+ (if (pair? lst_251)
+ (let-values (((vu_0) (unsafe-car lst_251))
+ ((rest_121) (unsafe-cdr lst_251)))
+ (let-values (((ht_161 link-mod-uses_4)
+ (let-values (((ht_162 link-mod-uses_5)
+ (let-values (((mu_2)
+ (variable-use-module-use
+ vu_0)))
+ (if (let-values (((or-part_344)
+ (hash-ref
+ ht_160
+ mu_2
+ #f)))
+ (if or-part_344
+ or-part_344
+ (let-values (((or-part_345)
+ (eq?
+ (module-use-module
+ mu_2)
+ (compile-context-self
+ cctx_0))))
+ (if or-part_345
+ or-part_345
+ (top-level-module-path-index?
+ (module-use-module
+ mu_2))))))
+ (values ht_160 link-mod-uses_3)
+ (values
+ (hash-set ht_160 mu_2 #t)
+ (cons mu_2 link-mod-uses_3))))))
+ (values ht_162 link-mod-uses_5))))
+ (if (not #f)
+ (for-loop_263 ht_161 link-mod-uses_4 rest_121)
+ (values ht_161 link-mod-uses_4))))
+ (values ht_160 link-mod-uses_3))))))
+ for-loop_263)
+ ht_158
+ link-mod-uses_1
+ lst_250))))))
(values
link-mod-uses_0
(reverse$1
- (let-values (((lst_173) link-mod-uses_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_173)))
- ((letrec-values (((for-loop_206)
- (lambda (fold-var_5 lst_11)
- (begin
- 'for-loop
- (if (pair? lst_11)
- (let-values (((mu_3) (unsafe-car lst_11)) ((rest_87) (unsafe-cdr lst_11)))
- (let-values (((fold-var_180)
- (let-values (((fold-var_181) fold-var_5))
- (let-values (((fold-var_182)
- (let-values ()
- (cons
- (let-values ()
- (reverse$1
- (let-values (((lst_174)
- (header-require-vars-in-order
- header_5)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_174)))
- ((letrec-values (((for-loop_120)
- (lambda (fold-var_183
- lst_175)
- (begin
- 'for-loop
- (if (pair?
- lst_175)
- (let-values (((vu_1)
- (unsafe-car
- lst_175))
- ((rest_88)
- (unsafe-cdr
- lst_175)))
- (let-values (((fold-var_184)
- (let-values (((fold-var_185)
- fold-var_183))
- (if (equal?
- mu_3
- (variable-use-module-use
- vu_1))
- (let-values (((fold-var_186)
- fold-var_185))
- (let-values (((fold-var_187)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((var-sym_2)
- (hash-ref
- (header-require-var-to-import-sym
- header_5)
- vu_1)))
- (let-values (((ex-sym_0)
- (variable-use-sym
- vu_1)))
- (if (eq?
- var-sym_2
- ex-sym_0)
- var-sym_2
- (list
- ex-sym_0
- var-sym_2)))))
- fold-var_186))))
- (values
- fold-var_187)))
- fold-var_185))))
- (if (not #f)
- (for-loop_120
- fold-var_184
- rest_88)
- fold-var_184)))
- fold-var_183)))))
- for-loop_120)
- null
- lst_174)))))
- fold-var_181))))
- (values fold-var_182)))))
- (if (not #f) (for-loop_206 fold-var_180 rest_87) fold-var_180)))
- fold-var_5)))))
- for-loop_206)
- null
- lst_173))))
+ (let-values (((fold-var_274) (let-values (((fold-var_275) null)) fold-var_275)))
+ (let-values (((lst_252) link-mod-uses_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_252))
+ ((letrec-values (((for-loop_264)
+ (lambda (fold-var_276 lst_253)
+ (begin
+ 'for-loop
+ (if (pair? lst_253)
+ (let-values (((mu_3) (unsafe-car lst_253)) ((rest_122) (unsafe-cdr lst_253)))
+ (let-values (((fold-var_277)
+ (let-values (((fold-var_278)
+ (cons
+ (reverse$1
+ (let-values (((fold-var_279)
+ (let-values (((fold-var_280)
+ null))
+ fold-var_280)))
+ (let-values (((lst_254)
+ (header-require-vars-in-order
+ header_5)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_254))
+ ((letrec-values (((for-loop_265)
+ (lambda (fold-var_281
+ lst_255)
+ (begin
+ 'for-loop
+ (if (pair? lst_255)
+ (let-values (((vu_1)
+ (unsafe-car
+ lst_255))
+ ((rest_123)
+ (unsafe-cdr
+ lst_255)))
+ (let-values (((fold-var_282)
+ (if (equal?
+ mu_3
+ (variable-use-module-use
+ vu_1))
+ (let-values (((fold-var_283)
+ (cons
+ (let-values (((var-sym_2)
+ (hash-ref
+ (header-require-var-to-import-sym
+ header_5)
+ vu_1)))
+ (let-values (((ex-sym_0)
+ (variable-use-sym
+ vu_1)))
+ (if (eq?
+ var-sym_2
+ ex-sym_0)
+ var-sym_2
+ (list
+ ex-sym_0
+ var-sym_2))))
+ fold-var_281)))
+ (values
+ fold-var_283))
+ fold-var_281)))
+ (if (not #f)
+ (for-loop_265
+ fold-var_282
+ rest_123)
+ fold-var_282)))
+ fold-var_281)))))
+ for-loop_265)
+ fold-var_279
+ lst_254)))))
+ fold-var_276)))
+ (values fold-var_278))))
+ (if (not #f) (for-loop_264 fold-var_277 rest_122) fold-var_277)))
+ fold-var_276)))))
+ for-loop_264)
+ fold-var_274
+ lst_252)))))
(reverse$1
- (let-values (((lst_176) link-mod-uses_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_176)))
- ((letrec-values (((for-loop_121)
- (lambda (fold-var_188 lst_177)
- (begin
- 'for-loop
- (if (pair? lst_177)
- (let-values (((mu_4) (unsafe-car lst_177)) ((rest_89) (unsafe-cdr lst_177)))
- (let-values (((fold-var_189)
- (let-values (((fold-var_131) fold-var_188))
- (let-values (((fold-var_113)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((extra-inspectorss_0)
- (let-values (((lst_178)
- (header-require-vars-in-order
- header_5)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_178)))
- ((letrec-values (((for-loop_207)
- (lambda (table_140
- lst_179)
- (begin
- 'for-loop
- (if (pair?
- lst_179)
- (let-values (((vu_2)
- (unsafe-car
- lst_179))
- ((rest_90)
- (unsafe-cdr
- lst_179)))
- (let-values (((table_69)
- (let-values (((table_141)
- table_140))
- (let-values (((table_142)
- table_141))
- (if (equal?
- mu_4
- (variable-use-module-use
- vu_2))
- (let-values (((id*_5)
- (hash-ref
- (header-require-var-to-import-sym
- header_5)
- vu_2)))
- (begin
- #t
- ((letrec-values (((for-loop_208)
- (lambda (table_143)
- (begin
- 'for-loop
- (let-values (((var-sym_3)
- id*_5))
- (let-values (((table_144)
- (let-values (((table_145)
- table_143))
- (let-values (((id*_6)
- (hash-ref
- (header-import-sym-to-extra-inspectors
- header_5)
- var-sym_3
- #f)))
- (begin
- #t
- ((letrec-values (((for-loop_19)
- (lambda (table_146)
- (begin
- 'for-loop
- (let-values (((extra-inspectors_1)
- id*_6))
- (let-values (((table_147)
- (let-values (((table_148)
- table_146))
- (let-values (((table_149)
- table_148))
- (if (let-values (((or-part_221)
- extra-inspectors_1))
- (if or-part_221
- or-part_221
- cross-linklet-inlining?_0))
- (let-values (((table_150)
- table_149))
- (let-values (((table_151)
- (let-values ()
- (let-values (((key_62
- val_44)
- (let-values ()
- (values
- var-sym_3
- extra-inspectors_1))))
- (hash-set
- table_150
- key_62
- val_44)))))
- (values
- table_151)))
- table_149)))))
- table_147))))))
- for-loop_19)
- table_145))))))
- table_144))))))
- for-loop_208)
- table_142)))
- table_142)))))
- (if (not
- #f)
- (for-loop_207
- table_69
- rest_90)
- table_69)))
- table_140)))))
- for-loop_207)
- '#hash()
- lst_178)))))
- (if (hash-count extra-inspectorss_0)
- extra-inspectorss_0
- #f)))
- fold-var_131))))
- (values fold-var_113)))))
- (if (not #f) (for-loop_121 fold-var_189 rest_89) fold-var_189)))
- fold-var_188)))))
- for-loop_121)
- null
- lst_176))))
+ (let-values (((fold-var_284) (let-values (((fold-var_285) null)) fold-var_285)))
+ (let-values (((lst_256) link-mod-uses_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_256))
+ ((letrec-values (((for-loop_266)
+ (lambda (fold-var_286 lst_257)
+ (begin
+ 'for-loop
+ (if (pair? lst_257)
+ (let-values (((mu_4) (unsafe-car lst_257)) ((rest_124) (unsafe-cdr lst_257)))
+ (let-values (((fold-var_287)
+ (let-values (((fold-var_288)
+ (cons
+ (let-values (((extra-inspectorss_0)
+ (let-values (((table_170)
+ (let-values (((table_171)
+ '#hash()))
+ table_171)))
+ (let-values (((lst_258)
+ (header-require-vars-in-order
+ header_5)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_258))
+ ((letrec-values (((for-loop_267)
+ (lambda (table_172
+ lst_259)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_259)
+ (let-values (((vu_2)
+ (unsafe-car
+ lst_259))
+ ((rest_125)
+ (unsafe-cdr
+ lst_259)))
+ (let-values (((table_173)
+ (if (equal?
+ mu_4
+ (variable-use-module-use
+ vu_2))
+ (let-values (((id*_5)
+ (hash-ref
+ (header-require-var-to-import-sym
+ header_5)
+ vu_2)))
+ ((letrec-values (((for-loop_268)
+ (lambda (table_174)
+ (begin
+ 'for-loop
+ (let-values (((var-sym_3)
+ id*_5))
+ (let-values (((table_175)
+ (let-values (((id*_6)
+ (hash-ref
+ (header-import-sym-to-extra-inspectors
+ header_5)
+ var-sym_3
+ #f)))
+ ((letrec-values (((for-loop_269)
+ (lambda (table_176)
+ (begin
+ 'for-loop
+ (let-values (((extra-inspectors_1)
+ id*_6))
+ (let-values (((table_177)
+ (if (let-values (((or-part_346)
+ extra-inspectors_1))
+ (if or-part_346
+ or-part_346
+ cross-linklet-inlining?_0))
+ (let-values (((table_178)
+ (let-values (((key_65
+ val_46)
+ (values
+ var-sym_3
+ extra-inspectors_1)))
+ (hash-set
+ table_176
+ key_65
+ val_46))))
+ (values
+ table_178))
+ table_176)))
+ table_177))))))
+ for-loop_269)
+ table_174))))
+ table_175))))))
+ for-loop_268)
+ table_172))
+ table_172)))
+ (if (not
+ #f)
+ (for-loop_267
+ table_173
+ rest_125)
+ table_173)))
+ table_172)))))
+ for-loop_267)
+ table_170
+ lst_258))))))
+ (if (hash-count extra-inspectorss_0)
+ extra-inspectorss_0
+ #f))
+ fold-var_286)))
+ (values fold-var_288))))
+ (if (not #f) (for-loop_266 fold-var_287 rest_124) fold-var_287)))
+ fold-var_286)))))
+ for-loop_266)
+ fold-var_284
+ lst_256)))))
(reverse$1
- (let-values (((lst_180) (header-require-vars-in-order header_5)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_180)))
- ((letrec-values (((for-loop_209)
- (lambda (fold-var_190 lst_181)
- (begin
- 'for-loop
- (if (pair? lst_181)
- (let-values (((vu_3) (unsafe-car lst_181)) ((rest_91) (unsafe-cdr lst_181)))
- (let-values (((fold-var_191)
- (let-values (((fold-var_192) fold-var_190))
+ (let-values (((fold-var_289) (let-values (((fold-var_290) null)) fold-var_290)))
+ (let-values (((lst_260) (header-require-vars-in-order header_5)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_260))
+ ((letrec-values (((for-loop_270)
+ (lambda (fold-var_291 lst_261)
+ (begin
+ 'for-loop
+ (if (pair? lst_261)
+ (let-values (((vu_3) (unsafe-car lst_261)) ((rest_126) (unsafe-cdr lst_261)))
+ (let-values (((fold-var_292)
(if (let-values (((mod_2)
(module-use-module
(variable-use-module-use vu_3))))
- (let-values (((or-part_222)
+ (let-values (((or-part_347)
(eq? mod_2 (compile-context-self cctx_0))))
- (if or-part_222
- or-part_222
+ (if or-part_347
+ or-part_347
(top-level-module-path-index? mod_2))))
- (let-values (((fold-var_37) fold-var_192))
- (let-values (((fold-var_193)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((var-sym_4)
- (hash-ref
- (header-require-var-to-import-sym
- header_5)
- vu_3)))
- (let-values (((ex-sym_1)
- (variable-use-sym vu_3)))
- (if (eq? var-sym_4 ex-sym_1)
- var-sym_4
- (list var-sym_4 ex-sym_1)))))
- fold-var_37))))
- (values fold-var_193)))
- fold-var_192))))
- (if (not #f) (for-loop_209 fold-var_191 rest_91) fold-var_191)))
- fold-var_190)))))
- for-loop_209)
- null
- lst_180)))))))))
+ (let-values (((fold-var_293)
+ (cons
+ (let-values (((var-sym_4)
+ (hash-ref
+ (header-require-var-to-import-sym
+ header_5)
+ vu_3)))
+ (let-values (((ex-sym_1)
+ (variable-use-sym vu_3)))
+ (if (eq? var-sym_4 ex-sym_1)
+ var-sym_4
+ (list var-sym_4 ex-sym_1))))
+ fold-var_291)))
+ (values fold-var_293))
+ fold-var_291)))
+ (if (not #f) (for-loop_270 fold-var_292 rest_126) fold-var_292)))
+ fold-var_291)))))
+ for-loop_270)
+ fold-var_289
+ lst_260))))))))))
(define-values
(instance-imports)
(list ns-id phase-shift-id self-id inspector-id bulk-binding-registry-id set-transformer!-id))
@@ -32836,36 +32907,35 @@
(lambda (bulk-binding-registry5_0 inspector4_0 namespace1_0 phase-shift2_0 self3_0 set-transformer!6_0)
(begin
'make-instance-instance
- (let-values (((ns_55) namespace1_0))
- (let-values (((phase-shift_13) phase-shift2_0))
- (let-values (((self_18) self3_0))
- (let-values (((inspector_14) inspector4_0))
- (let-values (((bulk-binding-registry_14) bulk-binding-registry5_0))
+ (let-values (((ns_62) namespace1_0))
+ (let-values (((phase-shift_14) phase-shift2_0))
+ (let-values (((self_21) self3_0))
+ (let-values (((inspector_15) inspector4_0))
+ (let-values (((bulk-binding-registry_15) bulk-binding-registry5_0))
(let-values (((set-transformer!_0) set-transformer!6_0))
- (let-values ()
- (1/make-instance
- 'instance
- #f
- 'constant
- ns-id
- ns_55
- phase-shift-id
- phase-shift_13
- self-id
- self_18
- inspector-id
- inspector_14
- bulk-binding-registry-id
- bulk-binding-registry_14
- set-transformer!-id
- set-transformer!_0)))))))))))
+ (1/make-instance
+ 'instance
+ #f
+ 'constant
+ ns-id
+ ns_62
+ phase-shift-id
+ phase-shift_14
+ self-id
+ self_21
+ inspector-id
+ inspector_15
+ bulk-binding-registry-id
+ bulk-binding-registry_15
+ set-transformer!-id
+ set-transformer!_0))))))))))
(define-values
(make-module-body-instance-instance.1)
(lambda (set-transformer!14_0)
(begin
'make-module-body-instance-instance
(let-values (((set-transformer!_1) set-transformer!14_0))
- (let-values () (1/make-instance 'body-instance #f 'constant set-transformer!-id set-transformer!_1))))))
+ (1/make-instance 'body-instance #f 'constant set-transformer!-id set-transformer!_1)))))
(define-values
(empty-syntax-literals-instance)
(1/make-instance
@@ -32873,91 +32943,713 @@
#f
'constant
get-syntax-literal!-id
- (lambda (pos_112) #f)
+ (lambda (pos_142) #f)
'get-encoded-root-expand-ctx
#f))
(void (1/instance-describe-variable! empty-syntax-literals-instance get-syntax-literal!-id '(procedure/pure 2)))
(define-values
(empty-module-body-instance)
- (let-values (((temp17_2) (lambda (name_43 val_45) (void)))) (make-module-body-instance-instance.1 temp17_2)))
+ (let-values (((temp17_2) (lambda (name_53 val_47) (void)))) (make-module-body-instance-instance.1 temp17_2)))
(void (1/instance-describe-variable! empty-module-body-instance set-transformer!-id '(procedure/succeeds 4)))
(define-values
(empty-top-syntax-literal-instance)
(1/make-instance 'top-syntax-literal #f 'constant mpi-vector-id #f syntax-literals-id #f))
(define-values
(empty-syntax-literals-data-instance)
- (1/make-instance 'empty-stx-data #f 'constant deserialized-syntax-vector-id (vector) deserialize-syntax-id void))
+ (1/make-instance
+ 'empty-stx-data
+ #f
+ 'constant
+ deserialized-syntax-vector-id
+ (box (vector))
+ deserialize-syntax-id
+ void))
+ (define-values
+ (empty-instance-instance)
+ (let-values (((temp18_2) #f) ((temp19_2) #f) ((temp20_1) #f) ((temp21_4) #f) ((temp22_2) #f) ((temp23_2) #f))
+ (make-instance-instance.1 temp22_2 temp21_4 temp18_2 temp19_2 temp20_1 temp23_2)))
+ (define-values
+ (eager-instance-imports)
+ (list* ns-id dest-phase-id self-id bulk-binding-registry-id inspector-id '(swap-top-level-scopes)))
+ (define-values
+ (make-eager-instance-instance.1)
+ (lambda (bulk-binding-registry4_0 dest-phase2_0 inspector5_0 namespace1_1 self3_1)
+ (begin
+ 'make-eager-instance-instance
+ (let-values (((ns_63) namespace1_1))
+ (let-values (((dest-phase_0) dest-phase2_0))
+ (let-values (((self_22) self3_1))
+ (let-values (((bulk-binding-registry_16) bulk-binding-registry4_0))
+ (let-values (((inspector_16) inspector5_0))
+ (1/make-instance
+ 'instance
+ #f
+ 'constant
+ ns-id
+ ns_63
+ dest-phase-id
+ dest-phase_0
+ self-id
+ self_22
+ bulk-binding-registry-id
+ bulk-binding-registry_16
+ inspector-id
+ inspector_16
+ 'swap-top-level-scopes
+ swap-top-level-scopes)))))))))
+ (define-values
+ (empty-eager-instance-instance)
+ (let-values (((temp12_1) #f) ((temp13_4) #f) ((temp14_3) #f) ((temp15_4) #f) ((temp16_6) #f))
+ (make-eager-instance-instance.1 temp15_4 temp13_4 temp16_6 temp12_1 temp14_3)))
+ (define-values
+ (self-quoting-in-linklet?)
+ (lambda (datum_1)
+ (begin
+ (let-values (((or-part_348) (number? datum_1)))
+ (if or-part_348
+ or-part_348
+ (let-values (((or-part_349) (boolean? datum_1)))
+ (if or-part_349
+ or-part_349
+ (let-values (((or-part_350) (string? datum_1))) (if or-part_350 or-part_350 (bytes? datum_1))))))))))
+ (define-values
+ (extra-inspectors-allow?)
+ (lambda (extra-inspectors_2 guard-insp_0)
+ (begin
+ (if (not extra-inspectors_2)
+ #f
+ (if (set? extra-inspectors_2)
+ (let-values (((result_154) (let-values (((result_155) #t)) result_155)))
+ (let-values (((ht_163) extra-inspectors_2))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_163))
+ ((letrec-values (((for-loop_271)
+ (lambda (result_156 i_228)
+ (begin
+ 'for-loop
+ (if i_228
+ (let-values (((extra-insp_0) (unsafe-immutable-hash-iterate-key ht_163 i_228)))
+ (let-values (((result_157)
+ (let-values (((result_158)
+ (inspector-superior? extra-insp_0 guard-insp_0)))
+ (values result_158))))
+ (if (if (not ((lambda x_68 (not result_157)) extra-insp_0)) (not #f) #f)
+ (for-loop_271
+ result_157
+ (unsafe-immutable-hash-iterate-next ht_163 i_228))
+ result_157)))
+ result_156)))))
+ for-loop_271)
+ result_154
+ (unsafe-immutable-hash-iterate-first ht_163)))))
+ (if (procedure? extra-inspectors_2)
+ (extra-inspectors_2 guard-insp_0)
+ (error 'extra-inspectors-allow? "unknown representation of extra inspectors: ~e" extra-inspectors_2)))))))
+ (define-values
+ (extra-inspectors-merge)
+ (lambda (extra-inspectors-1_0 extra-inspectors-2_0)
+ (begin
+ (if (let-values (((or-part_351) (not extra-inspectors-1_0)))
+ (if or-part_351 or-part_351 (not extra-inspectors-2_0)))
+ #f
+ (if (if (set? extra-inspectors-1_0) (set? extra-inspectors-2_0) #f)
+ (set-union extra-inspectors-1_0 extra-inspectors-2_0)
+ (lambda (guard-insp_1)
+ (if (extra-inspectors-allow? extra-inspectors-1_0 guard-insp_1)
+ (extra-inspectors-allow? extra-inspectors-2_0 guard-insp_1)
+ #f)))))))
+ (define-values
+ (struct:module-use*
+ module-use*1.1
+ module-use*?
+ module-use*-extra-inspectorss
+ module-use*-self-inspector
+ set-module-use*-extra-inspectorss!
+ set-module-use*-self-inspector!)
+ (let-values (((struct:_102 make-_102 ?_102 -ref_102 -set!_102)
+ (make-struct-type
+ 'module-use*
+ struct:module-use
+ 2
+ 0
+ #f
+ null
+ (current-inspector)
+ #f
+ '()
+ #f
+ 'module-use*)))
+ (values
+ struct:_102
+ make-_102
+ ?_102
+ (make-struct-field-accessor -ref_102 0 'extra-inspectorss)
+ (make-struct-field-accessor -ref_102 1 'self-inspector)
+ (make-struct-field-mutator -set!_102 0 'extra-inspectorss)
+ (make-struct-field-mutator -set!_102 1 'self-inspector))))
+ (define-values
+ (module-uses-add-extra-inspectorsss)
+ (lambda (mus_1 extra-inspectorsss_0)
+ (begin
+ (if extra-inspectorsss_0
+ (reverse$1
+ (let-values (((fold-var_294) (let-values (((fold-var_295) null)) fold-var_295)))
+ (let-values (((lst_262) mus_1) ((lst_263) extra-inspectorsss_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_262))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_263))
+ ((letrec-values (((for-loop_272)
+ (lambda (fold-var_296 lst_264 lst_265)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_264) (pair? lst_265) #f)
+ (let-values (((mu_5) (unsafe-car lst_264))
+ ((rest_127) (unsafe-cdr lst_264))
+ ((extra-inspectorss_1) (unsafe-car lst_265))
+ ((rest_128) (unsafe-cdr lst_265)))
+ (let-values (((fold-var_297)
+ (let-values (((fold-var_298)
+ (cons
+ (module-use*1.1
+ (module-use-module mu_5)
+ (module-use-phase mu_5)
+ extra-inspectorss_1
+ #f)
+ fold-var_296)))
+ (values fold-var_298))))
+ (if (not #f) (for-loop_272 fold-var_297 rest_127 rest_128) fold-var_297)))
+ fold-var_296)))))
+ for-loop_272)
+ fold-var_294
+ lst_262
+ lst_263)))))
+ (reverse$1
+ (let-values (((fold-var_299) (let-values (((fold-var_300) null)) fold-var_300)))
+ (let-values (((lst_266) mus_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_266))
+ ((letrec-values (((for-loop_273)
+ (lambda (fold-var_301 lst_267)
+ (begin
+ 'for-loop
+ (if (pair? lst_267)
+ (let-values (((mu_6) (unsafe-car lst_267)) ((rest_129) (unsafe-cdr lst_267)))
+ (let-values (((fold-var_302)
+ (let-values (((fold-var_303)
+ (cons
+ (module-use*1.1
+ (module-use-module mu_6)
+ (module-use-phase mu_6)
+ #f
+ #f)
+ fold-var_301)))
+ (values fold-var_303))))
+ (if (not #f) (for-loop_273 fold-var_302 rest_129) fold-var_302)))
+ fold-var_301)))))
+ for-loop_273)
+ fold-var_299
+ lst_266)))))))))
+ (define-values
+ (module-uses-strip-extra-inspectorsss)
+ (lambda (mu*s_0)
+ (begin
+ (reverse$1
+ (let-values (((fold-var_304) (let-values (((fold-var_305) null)) fold-var_305)))
+ (let-values (((lst_268) mu*s_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_268))
+ ((letrec-values (((for-loop_274)
+ (lambda (fold-var_306 lst_269)
+ (begin
+ 'for-loop
+ (if (pair? lst_269)
+ (let-values (((mu*_0) (unsafe-car lst_269)) ((rest_130) (unsafe-cdr lst_269)))
+ (let-values (((fold-var_307)
+ (let-values (((fold-var_308)
+ (cons
+ (module-use1.1
+ (module-use-module mu*_0)
+ (module-use-phase mu*_0))
+ fold-var_306)))
+ (values fold-var_308))))
+ (if (not #f) (for-loop_274 fold-var_307 rest_130) fold-var_307)))
+ fold-var_306)))))
+ for-loop_274)
+ fold-var_304
+ lst_268))))))))
+ (define-values
+ (module-uses-extract-extra-inspectorsss)
+ (lambda (mu*s_1 linklet_0 check-inlined-reference?_0 skip-n_0)
+ (begin
+ (if (not check-inlined-reference?_0)
+ (reverse$1
+ (let-values (((fold-var_309) (let-values (((fold-var_310) null)) fold-var_310)))
+ (let-values (((lst_270) mu*s_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_270))
+ ((letrec-values (((for-loop_275)
+ (lambda (fold-var_311 lst_271)
+ (begin
+ 'for-loop
+ (if (pair? lst_271)
+ (let-values (((mu*_1) (unsafe-car lst_271)) ((rest_131) (unsafe-cdr lst_271)))
+ (let-values (((fold-var_312)
+ (let-values (((fold-var_313)
+ (cons
+ (module-use*-extra-inspectorss mu*_1)
+ fold-var_311)))
+ (values fold-var_313))))
+ (if (not #f) (for-loop_275 fold-var_312 rest_131) fold-var_312)))
+ fold-var_311)))))
+ for-loop_275)
+ fold-var_309
+ lst_270)))))
+ (reverse$1
+ (let-values (((fold-var_314) (let-values (((fold-var_315) null)) fold-var_315)))
+ (let-values (((lst_272) mu*s_1) ((lst_273) (list-tail (linklet-import-variables$1 linklet_0) skip-n_0)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_272))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_273))
+ ((letrec-values (((for-loop_276)
+ (lambda (fold-var_316 lst_274 lst_275)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_274) (pair? lst_275) #f)
+ (let-values (((mu*_2) (unsafe-car lst_274))
+ ((rest_132) (unsafe-cdr lst_274))
+ ((imports_0) (unsafe-car lst_275))
+ ((rest_133) (unsafe-cdr lst_275)))
+ (let-values (((fold-var_317)
+ (let-values (((fold-var_318)
+ (cons
+ (let-values (((extra-inspectorss_2)
+ (module-use*-extra-inspectorss
+ mu*_2)))
+ (let-values (((extra-inspectorss_3)
+ (let-values (((extra-inspectorss_4)
+ extra-inspectorss_2))
+ extra-inspectorss_4)))
+ (let-values (((lst_276) imports_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_276))
+ ((letrec-values (((for-loop_277)
+ (lambda (extra-inspectorss_5
+ lst_277)
+ (begin
+ 'for-loop
+ (if (pair? lst_277)
+ (let-values (((import_0)
+ (unsafe-car
+ lst_277))
+ ((rest_134)
+ (unsafe-cdr
+ lst_277)))
+ (let-values (((extra-inspectorss_6)
+ (let-values (((extra-inspectorss_7)
+ (if (eq?
+ (hash-ref
+ extra-inspectorss_5
+ import_0
+ '#:not-recorded)
+ '#:not-recorded)
+ (hash-set
+ extra-inspectorss_5
+ import_0
+ (set
+ (module-use*-self-inspector
+ mu*_2)))
+ extra-inspectorss_5)))
+ (values
+ extra-inspectorss_7))))
+ (if (not #f)
+ (for-loop_277
+ extra-inspectorss_6
+ rest_134)
+ extra-inspectorss_6)))
+ extra-inspectorss_5)))))
+ for-loop_277)
+ extra-inspectorss_3
+ lst_276)))))
+ fold-var_316)))
+ (values fold-var_318))))
+ (if (not #f) (for-loop_276 fold-var_317 rest_132 rest_133) fold-var_317)))
+ fold-var_316)))))
+ for-loop_276)
+ fold-var_314
+ lst_272
+ lst_273)))))))))
(define-values
- (empty-instance-instance)
- (let-values (((temp18_2) #f) ((temp19_1) #f) ((temp20_1) #f) ((temp21_4) #f) ((temp22_2) #f) ((temp23_2) #f))
- (make-instance-instance.1 temp22_2 temp21_4 temp18_2 temp19_1 temp20_1 temp23_2)))
+ (module-use*-declaration-inspector!)
+ (lambda (mu*_3 insp_7) (begin (set-module-use*-self-inspector! mu*_3 insp_7))))
(define-values
- (eager-instance-imports)
- (list* ns-id dest-phase-id self-id bulk-binding-registry-id inspector-id '(swap-top-level-scopes)))
+ (module-use+extra-inspectors)
+ (lambda (mpi_70 phase_87 imports_1 inspector_17 extra-inspector_5 extra-inspectorss_8)
+ (begin
+ (let-values (((now-inspector_0) (current-code-inspector)))
+ (let-values (((add-insp?_0) (if inspector_17 (inspector-superior? inspector_17 now-inspector_0) #f)))
+ (let-values (((add-extra-insp?_0)
+ (if extra-inspector_5 (inspector-superior? extra-inspector_5 now-inspector_0) #f)))
+ (let-values (((new-extra-inspectorss_0)
+ (if (let-values (((or-part_352) add-insp?_0)) (if or-part_352 or-part_352 add-extra-insp?_0))
+ (let-values (((table_179) (let-values (((table_180) '#hash())) table_180)))
+ (let-values (((lst_278) imports_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_278))
+ ((letrec-values (((for-loop_278)
+ (lambda (table_181 lst_279)
+ (begin
+ 'for-loop
+ (if (pair? lst_279)
+ (let-values (((import_1) (unsafe-car lst_279))
+ ((rest_135) (unsafe-cdr lst_279)))
+ (let-values (((table_182)
+ (let-values (((table_183)
+ (let-values (((key_66 val_48)
+ (values
+ import_1
+ (let-values (((extra-inspectors_3)
+ (if extra-inspectorss_8
+ (hash-ref
+ extra-inspectorss_8
+ import_1
+ #f)
+ #f)))
+ (lambda (guard-insp_2)
+ (let-values (((or-part_353)
+ (if add-insp?_0
+ (inspector-superior?
+ inspector_17
+ guard-insp_2)
+ #f)))
+ (if or-part_353
+ or-part_353
+ (let-values (((or-part_354)
+ (if add-extra-insp?_0
+ (inspector-superior?
+ extra-inspector_5
+ guard-insp_2)
+ #f)))
+ (if or-part_354
+ or-part_354
+ (extra-inspectors-allow?
+ extra-inspectors_3
+ guard-insp_2))))))))))
+ (hash-set
+ table_181
+ key_66
+ val_48))))
+ (values table_183))))
+ (if (not #f)
+ (for-loop_278 table_182 rest_135)
+ table_182)))
+ table_181)))))
+ for-loop_278)
+ table_179
+ lst_278))))
+ (let-values (((extra-inspectorss_9)
+ (let-values (((extra-inspectorss_10)
+ (let-values (((or-part_355) extra-inspectorss_8))
+ (if or-part_355 or-part_355 (seteq)))))
+ extra-inspectorss_10)))
+ (let-values (((lst_280) imports_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_280))
+ ((letrec-values (((for-loop_279)
+ (lambda (extra-inspectorss_11 lst_281)
+ (begin
+ 'for-loop
+ (if (pair? lst_281)
+ (let-values (((import_2) (unsafe-car lst_281))
+ ((rest_136) (unsafe-cdr lst_281)))
+ (let-values (((extra-inspectorss_12)
+ (let-values (((extra-inspectorss_13)
+ (if (hash-ref
+ extra-inspectorss_11
+ import_2
+ #f)
+ extra-inspectorss_11
+ (hash-set
+ extra-inspectorss_11
+ import_2
+ #f))))
+ (values extra-inspectorss_13))))
+ (if (not #f)
+ (for-loop_279 extra-inspectorss_12 rest_136)
+ extra-inspectorss_12)))
+ extra-inspectorss_11)))))
+ for-loop_279)
+ extra-inspectorss_9
+ lst_280)))))))
+ (module-use*1.1 mpi_70 phase_87 new-extra-inspectorss_0 #f))))))))
(define-values
- (make-eager-instance-instance.1)
- (lambda (bulk-binding-registry4_0 dest-phase2_0 inspector5_0 namespace1_1 self3_1)
+ (module-use-merge-extra-inspectorss!)
+ (lambda (existing-mu*_0 mu*_4)
(begin
- 'make-eager-instance-instance
- (let-values (((ns_56) namespace1_1))
- (let-values (((dest-phase_0) dest-phase2_0))
- (let-values (((self_5) self3_1))
- (let-values (((bulk-binding-registry_15) bulk-binding-registry4_0))
- (let-values (((inspector_15) inspector5_0))
- (let-values ()
- (1/make-instance
- 'instance
- #f
- 'constant
- ns-id
- ns_56
- dest-phase-id
- dest-phase_0
- self-id
- self_5
- bulk-binding-registry-id
- bulk-binding-registry_15
- inspector-id
- inspector_15
- 'swap-top-level-scopes
- swap-top-level-scopes))))))))))
+ (let-values (((existing-extra-inspectorss_0) (module-use*-extra-inspectorss existing-mu*_0)))
+ (let-values (((extra-inspectorss_14) (module-use*-extra-inspectorss mu*_4)))
+ (let-values (((new-extra-inspectorss_1)
+ (if (not existing-extra-inspectorss_0)
+ extra-inspectorss_14
+ (if (not extra-inspectorss_14)
+ existing-extra-inspectorss_0
+ (let-values (((new-extra-inspectorss_2)
+ (let-values (((new-extra-inspectorss_3) existing-extra-inspectorss_0))
+ new-extra-inspectorss_3)))
+ (let-values (((ht_164) extra-inspectorss_14))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash ht_164))
+ ((letrec-values (((for-loop_280)
+ (lambda (new-extra-inspectorss_4 i_229)
+ (begin
+ 'for-loop
+ (if i_229
+ (let-values (((sym_68 extra-inspectors_4)
+ (hash-iterate-key+value ht_164 i_229)))
+ (let-values (((new-extra-inspectorss_5)
+ (let-values (((new-extra-inspectorss_6)
+ (hash-set
+ new-extra-inspectorss_4
+ sym_68
+ (extra-inspectors-merge
+ extra-inspectors_4
+ (hash-ref
+ new-extra-inspectorss_4
+ sym_68
+ (seteq))))))
+ (values new-extra-inspectorss_6))))
+ (if (not #f)
+ (for-loop_280
+ new-extra-inspectorss_5
+ (hash-iterate-next ht_164 i_229))
+ new-extra-inspectorss_5)))
+ new-extra-inspectorss_4)))))
+ for-loop_280)
+ new-extra-inspectorss_2
+ (hash-iterate-first ht_164)))))))))
+ (set-module-use*-extra-inspectorss! existing-mu*_0 new-extra-inspectorss_1)))))))
+ (define-values (initial-code-inspector) (current-code-inspector))
(define-values
- (empty-eager-instance-instance)
- (let-values (((temp12_1) #f) ((temp13_3) #f) ((temp14_3) #f) ((temp15_4) #f) ((temp16_6) #f))
- (make-eager-instance-instance.1 temp15_4 temp13_3 temp16_6 temp12_1 temp14_3)))
+ (check-require-access.1)
+ (lambda (skip-imports1_0
+ linklet3_0
+ import-module-uses4_0
+ import-module-instances5_0
+ insp6_0
+ extra-inspector7_1
+ extra-inspectorsss8_0)
+ (begin
+ 'check-require-access
+ (let-values (((linklet_1) linklet3_0))
+ (let-values (((skip-num-imports_0) skip-imports1_0))
+ (let-values (((import-module-uses_0) import-module-uses4_0))
+ (let-values (((import-module-instances_0) import-module-instances5_0))
+ (let-values (((insp_8) insp6_0))
+ (let-values (((extra-inspector_6) extra-inspector7_1))
+ (let-values (((extra-inspectorsss_1) extra-inspectorsss8_0))
+ (begin
+ (let-values (((lst_282) (list-tail (linklet-import-variables$1 linklet_1) skip-num-imports_0))
+ ((lst_283) import-module-uses_0)
+ ((lst_284) import-module-instances_0)
+ ((lst_285)
+ (let-values (((or-part_356) extra-inspectorsss_1))
+ (if or-part_356 or-part_356 import-module-uses_0))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_282))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_283))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_284))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_285))
+ ((letrec-values (((for-loop_281)
+ (lambda (lst_286 lst_287 lst_288 lst_289)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_286)
+ (if (pair? lst_287) (if (pair? lst_288) (pair? lst_289) #f) #f)
+ #f)
+ (let-values (((import-syms_0) (unsafe-car lst_286))
+ ((rest_137) (unsafe-cdr lst_286))
+ ((mu_7) (unsafe-car lst_287))
+ ((rest_138) (unsafe-cdr lst_287))
+ ((mi_20) (unsafe-car lst_288))
+ ((rest_139) (unsafe-cdr lst_288))
+ ((extra-inspectorss_15) (unsafe-car lst_289))
+ ((rest_140) (unsafe-cdr lst_289)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((m_23)
+ (module-instance-module
+ mi_20)))
+ (if (module-no-protected? m_23)
+ (void)
+ (let-values (((access_7)
+ (let-values (((or-part_357)
+ (module-access
+ m_23)))
+ (if or-part_357
+ or-part_357
+ (module-compute-access!
+ m_23)))))
+ (begin
+ (let-values (((lst_290)
+ import-syms_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_290))
+ ((letrec-values (((for-loop_282)
+ (lambda (lst_291)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_291)
+ (let-values (((import-sym_0)
+ (unsafe-car
+ lst_291))
+ ((rest_141)
+ (unsafe-cdr
+ lst_291)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((a_43)
+ (hash-ref
+ (hash-ref
+ access_7
+ (module-use-phase
+ mu_7)
+ '#hasheq())
+ import-sym_0
+ 'unexported)))
+ (if (let-values (((or-part_358)
+ (eq?
+ a_43
+ 'unexported)))
+ (if or-part_358
+ or-part_358
+ (eq?
+ a_43
+ 'protected)))
+ (let-values (((guard-insp_3)
+ (namespace-inspector
+ (module-instance-namespace
+ mi_20))))
+ (if (let-values (((or-part_359)
+ (inspector-superior?
+ insp_8
+ guard-insp_3)))
+ (if or-part_359
+ or-part_359
+ (let-values (((or-part_360)
+ (if extra-inspector_6
+ (inspector-superior?
+ extra-inspector_6
+ guard-insp_3)
+ #f)))
+ (if or-part_360
+ or-part_360
+ (if extra-inspectorsss_1
+ (if extra-inspectorss_15
+ (extra-inspectors-allow?
+ (hash-ref
+ extra-inspectorss_15
+ import-sym_0
+ #f)
+ guard-insp_3)
+ #f)
+ #f)))))
+ (void)
+ (error
+ 'link
+ (string-append
+ "access disallowed by code inspector to ~a variable\n"
+ " variable: ~s\n"
+ " from module: ~a")
+ a_43
+ import-sym_0
+ (1/module-path-index-resolve
+ (namespace-mpi
+ (module-instance-namespace
+ mi_20))))))
+ (void)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_282
+ rest_141)
+ (values))))
+ (values))))))
+ for-loop_282)
+ lst_290)))
+ (void)))))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_281 rest_137 rest_138 rest_139 rest_140)
+ (values))))
+ (values))))))
+ for-loop_281)
+ lst_282
+ lst_283
+ lst_284
+ lst_285)))
+ (void))))))))))))
(define-values
- (self-quoting-in-linklet?)
- (lambda (datum_1)
+ (check-single-require-access)
+ (lambda (mi_21 phase_88 sym_69 insp_9)
(begin
- (let-values (((or-part_1) (number? datum_1)))
- (if or-part_1
- or-part_1
- (let-values (((or-part_2) (boolean? datum_1)))
- (if or-part_2
- or-part_2
- (let-values (((or-part_12) (string? datum_1))) (if or-part_12 or-part_12 (bytes? datum_1))))))))))
+ (let-values (((m_24) (module-instance-module mi_21)))
+ (if (module-no-protected? m_24)
+ #t
+ (let-values (((access_8)
+ (let-values (((or-part_361) (module-access m_24)))
+ (if or-part_361 or-part_361 (module-compute-access! m_24)))))
+ (let-values (((a_44) (hash-ref (hash-ref access_8 phase_88 '#hasheq()) sym_69 'unexported)))
+ (if (let-values (((or-part_362) (eq? a_44 'unexported)))
+ (if or-part_362 or-part_362 (eq? a_44 'protected)))
+ (let-values (((guard-insp_4) (namespace-inspector (module-instance-namespace mi_21))))
+ (let-values (((or-part_363) (if insp_9 (inspector-superior? insp_9 guard-insp_4) #f)))
+ (if or-part_363 or-part_363 (inspector-superior? (current-code-inspector) guard-insp_4))))
+ #t))))))))
(define-values
(srcloc->vector)
- (lambda (s_52)
- (begin
- (if s_52
- (vector (srcloc-source s_52) (srcloc-line s_52) (srcloc-column s_52) (srcloc-position s_52) (srcloc-span s_52))
+ (lambda (s_412)
+ (begin
+ (if s_412
+ (vector
+ (srcloc-source s_412)
+ (srcloc-line s_412)
+ (srcloc-column s_412)
+ (srcloc-position s_412)
+ (srcloc-span s_412))
#f))))
(define-values (keep-source-locations?) #f)
(define-values
(correlate*)
- (lambda (stx_10 s-exp_0)
+ (lambda (stx_15 s-exp_0)
(begin
- (if (syntax-srcloc$1 stx_10) (datum->correlated s-exp_0 (srcloc->vector (syntax-srcloc$1 stx_10))) s-exp_0))))
- (define-values (correlate~) (lambda (stx_11 s-exp_1) (begin s-exp_1)))
+ (if (syntax-srcloc$1 stx_15) (datum->correlated s-exp_0 (srcloc->vector (syntax-srcloc$1 stx_15))) s-exp_0))))
+ (define-values (correlate~) (lambda (stx_16 s-exp_1) (begin s-exp_1)))
(define-values
(correlate/app)
- (lambda (stx_13 s-exp_2) (begin (if keep-source-locations? (correlate* stx_13 s-exp_2) (correlate~ stx_13 s-exp_2)))))
- (define-values (->correlated) (lambda (s_325) (begin (datum->correlated s_325 #f))))
+ (lambda (stx_17 s-exp_2) (begin (if keep-source-locations? (correlate* stx_17 s-exp_2) (correlate~ stx_17 s-exp_2)))))
+ (define-values (->correlated) (lambda (s_413) (begin (datum->correlated s_413 #f))))
(define-values
(correlate-source-name)
- (lambda (sym_55 e-sym_0)
- (begin (if (eq? sym_55 e-sym_0) sym_55 (correlated-property (datum->correlated sym_55 #f) 'source-name e-sym_0)))))
+ (lambda (sym_70 e-sym_0)
+ (begin (if (eq? sym_70 e-sym_0) sym_70 (correlated-property (datum->correlated sym_70 #f) 'source-name e-sym_0)))))
(define-values (compile-keep-source-locations!) (lambda (on?_0) (begin (set! keep-source-locations? on?_0))))
(define-values
(compile$2)
@@ -32965,1072 +33657,561 @@
(lambda (p3_0 cctx4_0 name1_1 result-used?2_0)
(begin
'compile
- (let-values (((p_34) p3_0))
+ (let-values (((p_39) p3_0))
(let-values (((cctx_1) cctx4_0))
- (let-values (((name_44) name1_1))
+ (let-values (((name_54) name1_1))
(let-values (((result-used?_0) result-used?2_0))
- (let-values ()
- (let-values (((compile_1)
- (lambda (p_35 name_45 result-used?_1)
- (begin 'compile (compile$2 p_35 cctx_1 name_45 result-used?_1)))))
- (let-values (((s_4) (parsed-s p_34)))
- (if (parsed-id? p_34)
- (let-values ()
- (let-values (((p19_0) p_34) ((cctx20_0) cctx_1))
- (compile-identifier.1 #f #f p19_0 cctx20_0)))
- (if (parsed-lambda? p_34)
- (let-values ()
- (if result-used?_0
- (let-values ()
- (add-lambda-properties
- (correlate*
- s_4
- (list*
- 'lambda
- (compile-lambda
- (parsed-lambda-keys p_34)
- (parsed-lambda-body p_34)
- cctx_1)))
- name_44
- s_4))
- (let-values () (correlate~ s_4 ''unused-lambda))))
- (if (parsed-case-lambda? p_34)
- (let-values ()
- (if result-used?_0
- (let-values ()
- (add-lambda-properties
- (correlate*
- s_4
- (list*
- 'case-lambda
- (reverse$1
- (let-values (((lst_90) (parsed-case-lambda-clauses p_34)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_90)))
- ((letrec-values (((for-loop_107)
- (lambda (fold-var_35 lst_91)
- (begin
- 'for-loop
- (if (pair? lst_91)
- (let-values (((clause_0)
- (unsafe-car lst_91))
- ((rest_43)
- (unsafe-cdr lst_91)))
- (let-values (((fold-var_81)
- (let-values (((fold-var_82)
- fold-var_35))
- (let-values (((fold-var_29)
- (let-values ()
- (cons
- (let-values ()
- (compile-lambda
- (car
- clause_0)
- (cadr
- clause_0)
- cctx_1))
- fold-var_82))))
- (values
- fold-var_29)))))
- (if (not #f)
- (for-loop_107 fold-var_81 rest_43)
- fold-var_81)))
- fold-var_35)))))
- for-loop_107)
- null
- lst_90))))))
- name_44
- s_4))
- (let-values () (correlate~ s_4 ''unused-case-lambda))))
- (if (parsed-app? p_34)
- (let-values ()
- (let-values (((rands_0) (parsed-app-rands p_34)))
- (correlate/app
- s_4
- (cons
- (compile_1 (parsed-app-rator p_34) #f #t)
+ (let-values (((compile_1)
+ (lambda (p_40 name_55 result-used?_1)
+ (begin 'compile (compile$2 p_40 cctx_1 name_55 result-used?_1)))))
+ (let-values (((s_414) (parsed-s p_39)))
+ (if (parsed-id? p_39)
+ (let-values (((p19_0) p_39) ((cctx20_0) cctx_1))
+ (compile-identifier.1 #f #f p19_0 cctx20_0))
+ (if (parsed-lambda? p_39)
+ (if result-used?_0
+ (add-lambda-properties
+ (correlate*
+ s_414
+ (list*
+ 'lambda
+ (compile-lambda (parsed-lambda-keys p_39) (parsed-lambda-body p_39) cctx_1)))
+ name_54
+ s_414)
+ (correlate~ s_414 ''unused-lambda))
+ (if (parsed-case-lambda? p_39)
+ (if result-used?_0
+ (add-lambda-properties
+ (correlate*
+ s_414
+ (list*
+ 'case-lambda
+ (reverse$1
+ (let-values (((fold-var_319)
+ (let-values (((fold-var_320) null)) fold-var_320)))
+ (let-values (((lst_292) (parsed-case-lambda-clauses p_39)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_292))
+ ((letrec-values (((for-loop_283)
+ (lambda (fold-var_321 lst_293)
+ (begin
+ 'for-loop
+ (if (pair? lst_293)
+ (let-values (((clause_0) (unsafe-car lst_293))
+ ((rest_142)
+ (unsafe-cdr lst_293)))
+ (let-values (((fold-var_322)
+ (let-values (((fold-var_323)
+ (cons
+ (compile-lambda
+ (car clause_0)
+ (cadr
+ clause_0)
+ cctx_1)
+ fold-var_321)))
+ (values fold-var_323))))
+ (if (not #f)
+ (for-loop_283 fold-var_322 rest_142)
+ fold-var_322)))
+ fold-var_321)))))
+ for-loop_283)
+ fold-var_319
+ lst_292)))))))
+ name_54
+ s_414)
+ (correlate~ s_414 ''unused-case-lambda))
+ (if (parsed-app? p_39)
+ (let-values (((rands_0) (parsed-app-rands p_39)))
+ (correlate/app
+ s_414
+ (cons
+ (compile_1 (parsed-app-rator p_39) #f #t)
+ (reverse$1
+ (let-values (((fold-var_324)
+ (let-values (((fold-var_325) null)) fold-var_325)))
+ (let-values (((lst_294) rands_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_294))
+ ((letrec-values (((for-loop_284)
+ (lambda (fold-var_326 lst_295)
+ (begin
+ 'for-loop
+ (if (pair? lst_295)
+ (let-values (((r_43) (unsafe-car lst_295))
+ ((rest_143)
+ (unsafe-cdr lst_295)))
+ (let-values (((fold-var_327)
+ (let-values (((fold-var_328)
+ (cons
+ (compile_1
+ r_43
+ #f
+ #t)
+ fold-var_326)))
+ (values fold-var_328))))
+ (if (not #f)
+ (for-loop_284 fold-var_327 rest_143)
+ fold-var_327)))
+ fold-var_326)))))
+ for-loop_284)
+ fold-var_324
+ lst_294))))))))
+ (if (parsed-if? p_39)
+ (let-values (((tst-e_0) (compile_1 (parsed-if-tst p_39) #f #f)))
+ (if (eq? (correlated-e tst-e_0) #t)
+ (compile_1 (parsed-if-thn p_39) name_54 result-used?_0)
+ (if (eq? (correlated-e tst-e_0) #f)
+ (compile_1 (parsed-if-els p_39) name_54 result-used?_0)
+ (correlate~
+ s_414
+ (list
+ 'if
+ tst-e_0
+ (compile_1 (parsed-if-thn p_39) name_54 result-used?_0)
+ (compile_1 (parsed-if-els p_39) name_54 result-used?_0))))))
+ (if (parsed-with-continuation-mark? p_39)
+ (correlate~
+ s_414
+ (list
+ 'with-continuation-mark
+ (compile_1 (parsed-with-continuation-mark-key p_39) #f #t)
+ (compile_1 (parsed-with-continuation-mark-val p_39) #f #t)
+ (compile_1
+ (parsed-with-continuation-mark-body p_39)
+ name_54
+ result-used?_0)))
+ (if (parsed-begin0? p_39)
+ (correlate~
+ s_414
+ (list*
+ 'begin0
+ (compile_1 (car (parsed-begin0-body p_39)) name_54 result-used?_0)
(reverse$1
- (let-values (((lst_92) rands_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_92)))
- ((letrec-values (((for-loop_202)
- (lambda (fold-var_194 lst_170)
- (begin
- 'for-loop
- (if (pair? lst_170)
- (let-values (((r_37) (unsafe-car lst_170))
- ((rest_85)
- (unsafe-cdr lst_170)))
- (let-values (((fold-var_195)
- (let-values (((fold-var_129)
- fold-var_194))
- (let-values (((fold-var_130)
- (let-values ()
- (cons
- (let-values ()
- (compile_1
- r_37
- #f
- #t))
- fold-var_129))))
+ (let-values (((fold-var_329)
+ (let-values (((fold-var_330) null)) fold-var_330)))
+ (let-values (((lst_296) (cdr (parsed-begin0-body p_39))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_296))
+ ((letrec-values (((for-loop_285)
+ (lambda (fold-var_331 lst_297)
+ (begin
+ 'for-loop
+ (if (pair? lst_297)
+ (let-values (((e_47)
+ (unsafe-car lst_297))
+ ((rest_144)
+ (unsafe-cdr lst_297)))
+ (let-values (((fold-var_332)
+ (let-values (((fold-var_333)
+ (cons
+ (compile_1
+ e_47
+ #f
+ #f)
+ fold-var_331)))
(values
- fold-var_130)))))
- (if (not #f)
- (for-loop_202 fold-var_195 rest_85)
- fold-var_195)))
- fold-var_194)))))
- for-loop_202)
- null
- lst_92))))))))
- (if (parsed-if? p_34)
- (let-values ()
- (let-values (((tst-e_0) (compile_1 (parsed-if-tst p_34) #f #f)))
- (if (eq? (correlated-e tst-e_0) #t)
- (let-values ()
- (compile_1 (parsed-if-thn p_34) name_44 result-used?_0))
- (if (eq? (correlated-e tst-e_0) #f)
- (let-values ()
- (compile_1 (parsed-if-els p_34) name_44 result-used?_0))
- (let-values ()
- (correlate~
- s_4
- (list
- 'if
- tst-e_0
- (compile_1 (parsed-if-thn p_34) name_44 result-used?_0)
- (compile_1 (parsed-if-els p_34) name_44 result-used?_0))))))))
- (if (parsed-with-continuation-mark? p_34)
- (let-values ()
+ fold-var_333))))
+ (if (not #f)
+ (for-loop_285
+ fold-var_332
+ rest_144)
+ fold-var_332)))
+ fold-var_331)))))
+ for-loop_285)
+ fold-var_329
+ lst_296)))))))
+ (if (parsed-begin? p_39)
(correlate~
- s_4
- (list
- 'with-continuation-mark
- (compile_1 (parsed-with-continuation-mark-key p_34) #f #t)
- (compile_1 (parsed-with-continuation-mark-val p_34) #f #t)
- (compile_1
- (parsed-with-continuation-mark-body p_34)
- name_44
- result-used?_0))))
- (if (parsed-begin0? p_34)
- (let-values ()
+ s_414
+ (compile-begin (parsed-begin-body p_39) cctx_1 name_54 result-used?_0))
+ (if (parsed-set!? p_39)
(correlate~
- s_4
- (list*
- 'begin0
- (compile_1 (car (parsed-begin0-body p_34)) name_44 result-used?_0)
- (reverse$1
- (let-values (((lst_182) (cdr (parsed-begin0-body p_34))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_182)))
- ((letrec-values (((for-loop_129)
- (lambda (fold-var_196 lst_107)
- (begin
- 'for-loop
- (if (pair? lst_107)
- (let-values (((e_44)
- (unsafe-car lst_107))
- ((rest_92)
- (unsafe-cdr lst_107)))
- (let-values (((fold-var_197)
- (let-values (((fold-var_7)
- fold-var_196))
- (let-values (((fold-var_13)
- (let-values ()
- (cons
- (let-values ()
- (compile_1
- e_44
- #f
- #f))
- fold-var_7))))
- (values
- fold-var_13)))))
- (if (not #f)
- (for-loop_129
- fold-var_197
- rest_92)
- fold-var_197)))
- fold-var_196)))))
- for-loop_129)
- null
- lst_182)))))))
- (if (parsed-begin? p_34)
- (let-values ()
- (correlate~
- s_4
- (compile-begin
- (parsed-begin-body p_34)
- cctx_1
- name_44
- result-used?_0)))
- (if (parsed-set!? p_34)
- (let-values ()
- (correlate~
- s_4
- (let-values (((temp21_5) (parsed-set!-id p_34))
- ((cctx22_0) cctx_1)
- ((temp23_3) #t)
- ((temp24_1)
- (compile_1
- (parsed-set!-rhs p_34)
- (parsed-s (parsed-set!-id p_34))
- #t)))
- (compile-identifier.1 temp24_1 temp23_3 temp21_5 cctx22_0))))
- (if (parsed-let-values? p_34)
- (let-values ()
- (let-values (((p25_0) p_34)
- ((cctx26_0) cctx_1)
- ((name27_0) name_44)
- ((temp28_1) #f)
- ((result-used?29_0) result-used?_0))
- (compile-let.1
- temp28_1
- p25_0
- cctx26_0
- name27_0
- result-used?29_0)))
- (if (parsed-letrec-values? p_34)
- (let-values ()
- (let-values (((p30_1) p_34)
- ((cctx31_0) cctx_1)
- ((name32_0) name_44)
- ((temp33_0) #t)
- ((result-used?34_0) result-used?_0))
- (compile-let.1
- temp33_0
- p30_1
- cctx31_0
- name32_0
- result-used?34_0)))
- (if (parsed-quote? p_34)
- (let-values ()
- (let-values (((datum_2) (parsed-quote-datum p_34)))
- (if (self-quoting-in-linklet? datum_2)
- (let-values () (correlate~ s_4 datum_2))
- (let-values ()
- (correlate~ s_4 (list 'quote datum_2))))))
- (if (parsed-quote-syntax? p_34)
- (let-values ()
- (if result-used?_0
- (compile-quote-syntax
- (parsed-quote-syntax-datum p_34)
- cctx_1)
- (correlate~ s_4 ''syntax)))
- (if (parsed-#%variable-reference? p_34)
- (let-values ()
- (let-values (((id_54)
- (parsed-#%variable-reference-id p_34)))
- (correlate~
- s_4
- (if id_54
- (list
- '#%variable-reference
- (let-values (((id35_0) id_54) ((cctx36_0) cctx_1))
- (compile-identifier.1 #f #f id35_0 cctx36_0)))
- '(#%variable-reference)))))
- (let-values ()
- (error
- "unrecognized parsed form:"
- p_34)))))))))))))))))))))))))))
+ s_414
+ (let-values (((temp21_5) (parsed-set!-id p_39))
+ ((cctx22_0) cctx_1)
+ ((temp23_3) #t)
+ ((temp24_0)
+ (compile_1
+ (parsed-set!-rhs p_39)
+ (parsed-s (parsed-set!-id p_39))
+ #t)))
+ (compile-identifier.1 temp24_0 temp23_3 temp21_5 cctx22_0)))
+ (if (parsed-let-values? p_39)
+ (let-values (((p25_0) p_39)
+ ((cctx26_0) cctx_1)
+ ((name27_0) name_54)
+ ((temp28_1) #f)
+ ((result-used?29_0) result-used?_0))
+ (compile-let.1 temp28_1 p25_0 cctx26_0 name27_0 result-used?29_0))
+ (if (parsed-letrec-values? p_39)
+ (let-values (((p30_1) p_39)
+ ((cctx31_0) cctx_1)
+ ((name32_0) name_54)
+ ((temp33_1) #t)
+ ((result-used?34_0) result-used?_0))
+ (compile-let.1
+ temp33_1
+ p30_1
+ cctx31_0
+ name32_0
+ result-used?34_0))
+ (if (parsed-quote? p_39)
+ (let-values (((datum_2) (parsed-quote-datum p_39)))
+ (if (self-quoting-in-linklet? datum_2)
+ (correlate~ s_414 datum_2)
+ (correlate~ s_414 (list 'quote datum_2))))
+ (if (parsed-quote-syntax? p_39)
+ (if result-used?_0
+ (compile-quote-syntax
+ (parsed-quote-syntax-datum p_39)
+ cctx_1)
+ (correlate~ s_414 ''syntax))
+ (if (parsed-foreign-inline? p_39)
+ (let-values (((datum_3) (parsed-foreign-inline-datum p_39)))
+ (let-values (((mode_14)
+ (parsed-foreign-inline-mode p_39)))
+ (correlate~
+ s_414
+ (list '#%foreign-inline datum_3 mode_14))))
+ (if (parsed-#%variable-reference? p_39)
+ (let-values (((id_62)
+ (parsed-#%variable-reference-id p_39)))
+ (correlate~
+ s_414
+ (if id_62
+ (list
+ '#%variable-reference
+ (let-values (((id35_0) id_62) ((cctx36_0) cctx_1))
+ (compile-identifier.1 #f #f id35_0 cctx36_0)))
+ '(#%variable-reference))))
+ (error
+ "unrecognized parsed form:"
+ p_39))))))))))))))))))))))))))
(case-lambda
- ((p_36 cctx_2) (begin 'compile (compile_0 p_36 cctx_2 #f #t)))
- ((p_37 cctx_3 name_46 result-used?2_1) (compile_0 p_37 cctx_3 name_46 result-used?2_1))
- ((p_38 cctx_4 name1_2) (compile_0 p_38 cctx_4 name1_2 #t)))))
+ ((p_41 cctx_2) (begin 'compile (compile_0 p_41 cctx_2 #f #t)))
+ ((p_42 cctx_3 name_56 result-used?2_1) (compile_0 p_42 cctx_3 name_56 result-used?2_1))
+ ((p_43 cctx_4 name1_2) (compile_0 p_43 cctx_4 name1_2 #t)))))
(define-values
(compile-lambda)
(lambda (formals_0 bodys_0 cctx_5) (begin (list formals_0 (compile-sequence bodys_0 cctx_5 #f #t)))))
(define-values
(compile-sequence)
- (lambda (bodys_1 cctx_6 name_47 result-used?_2)
+ (lambda (bodys_1 cctx_6 name_57 result-used?_2)
(begin
(if (null? (cdr bodys_1))
- (compile$2 (car bodys_1) cctx_6 name_47 result-used?_2)
- (compile-begin bodys_1 cctx_6 name_47 result-used?_2)))))
+ (compile$2 (car bodys_1) cctx_6 name_57 result-used?_2)
+ (compile-begin bodys_1 cctx_6 name_57 result-used?_2)))))
(define-values
(compile-begin)
- (lambda (es_0 cctx_7 name_48 result-used?_3)
+ (lambda (es_0 cctx_7 name_58 result-used?_3)
(begin
(let-values (((used-pos_0) (sub1 (length es_0))))
(list*
'begin
(reverse$1
- (let-values (((lst_183) es_0) ((start_27) 0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_183)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-naturals start_27)))
- ((letrec-values (((for-loop_210)
- (lambda (fold-var_18 lst_184 pos_113)
- (begin
- 'for-loop
- (if (if (pair? lst_184) #t #f)
- (let-values (((e_6) (unsafe-car lst_184))
- ((rest_93) (unsafe-cdr lst_184))
- ((i_22) pos_113))
- (let-values (((fold-var_198)
- (let-values (((fold-var_199) fold-var_18))
- (let-values (((fold-var_200)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((used?_0) (= i_22 used-pos_0)))
- (compile$2
- e_6
- cctx_7
- (if used?_0 name_48 #f)
- (if used?_0 result-used?_3 #f))))
- fold-var_199))))
- (values fold-var_200)))))
- (if (not #f) (for-loop_210 fold-var_198 rest_93 (+ pos_113 1)) fold-var_198)))
- fold-var_18)))))
- for-loop_210)
- null
- lst_183
- start_27)))))))))
+ (let-values (((fold-var_334) (let-values (((fold-var_335) null)) fold-var_335)))
+ (let-values (((lst_298) es_0) ((start_53) 0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_298))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-naturals start_53))
+ ((letrec-values (((for-loop_286)
+ (lambda (fold-var_336 lst_299 pos_143)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_299) #t #f)
+ (let-values (((e_48) (unsafe-car lst_299))
+ ((rest_145) (unsafe-cdr lst_299))
+ ((i_230) pos_143))
+ (let-values (((fold-var_337)
+ (let-values (((fold-var_338)
+ (cons
+ (let-values (((used?_0) (= i_230 used-pos_0)))
+ (compile$2
+ e_48
+ cctx_7
+ (if used?_0 name_58 #f)
+ (if used?_0 result-used?_3 #f)))
+ fold-var_336)))
+ (values fold-var_338))))
+ (if (not #f)
+ (for-loop_286 fold-var_337 rest_145 (+ pos_143 1))
+ fold-var_337)))
+ fold-var_336)))))
+ for-loop_286)
+ fold-var_334
+ lst_298
+ start_53))))))))))
(define-values
(add-lambda-properties)
- (lambda (s_327 inferred-name_0 orig-s_26)
+ (lambda (s_415 inferred-name_0 orig-s_26)
(begin
(letrec-values (((simplify-name_0)
- (lambda (v_169)
+ (lambda (v_233)
(begin
'simplify-name
- (if (pair? v_169)
- (let-values ()
- (let-values (((n1_0) (simplify-name_0 (car v_169))))
- (let-values (((n2_0) (simplify-name_0 (cdr v_169)))) (if (eq? n1_0 n2_0) n1_0 v_169))))
- (let-values () v_169))))))
- (let-values (((name_49)
- (let-values (((or-part_61)
- (let-values (((v_170)
+ (if (pair? v_233)
+ (let-values (((n1_0) (simplify-name_0 (car v_233))))
+ (let-values (((n2_0) (simplify-name_0 (cdr v_233)))) (if (eq? n1_0 n2_0) n1_0 v_233)))
+ v_233)))))
+ (let-values (((name_59)
+ (let-values (((or-part_364)
+ (let-values (((v_234)
(simplify-name_0 (syntax-property$1 orig-s_26 'inferred-name))))
- (if (let-values (((or-part_150) (symbol? v_170)))
- (if or-part_150
- or-part_150
- (let-values (((or-part_151)
- (if (syntax?$1 v_170) (symbol? (syntax-e$1 v_170)) #f)))
- (if or-part_151 or-part_151 (void? v_170)))))
- v_170
+ (if (let-values (((or-part_365) (symbol? v_234)))
+ (if or-part_365
+ or-part_365
+ (let-values (((or-part_366)
+ (if (syntax?$1 v_234) (symbol? (syntax-e$1 v_234)) #f)))
+ (if or-part_366 or-part_366 (void? v_234)))))
+ v_234
#f))))
- (if or-part_61 or-part_61 inferred-name_0))))
+ (if or-part_364 or-part_364 inferred-name_0))))
(let-values (((named-s_0)
- (if name_49
+ (if name_59
(correlated-property
- (->correlated s_327)
+ (->correlated s_415)
'inferred-name
- (if (syntax?$1 name_49) (syntax-e$1 name_49) name_49))
- s_327)))
+ (if (syntax?$1 name_59) (syntax-e$1 name_59) name_59))
+ s_415)))
(let-values (((as-method_0) (syntax-property$1 orig-s_26 'method-arity-error)))
- (if as-method_0
- (correlated-property (->correlated named-s_0) 'method-arity-error as-method_0)
- named-s_0))))))))
+ (let-values (((method-s_0)
+ (if as-method_0
+ (correlated-property (->correlated named-s_0) 'method-arity-error as-method_0)
+ named-s_0)))
+ (let-values (((as-unsafe_0) (syntax-property$1 orig-s_26 'body-as-unsafe)))
+ (if as-unsafe_0
+ (begin
+ (if (eq? (current-code-inspector) initial-code-inspector)
+ (void)
+ (raise-syntax-error$1 #f "unsafe procedure compilation disallowed by code inspector" orig-s_26))
+ (correlated-property (->correlated method-s_0) 'body-as-unsafe #t))
+ method-s_0))))))))))
(define-values
(compile-let.1)
(lambda (rec?5_0 p7_0 cctx8_0 name9_0 result-used?10_0)
(begin
'compile-let
- (let-values (((p_39) p7_0))
+ (let-values (((p_44) p7_0))
(let-values (((cctx_8) cctx8_0))
- (let-values (((name_50) name9_0))
+ (let-values (((name_60) name9_0))
(let-values (((rec?_0) rec?5_0))
(let-values (((result-used?_4) result-used?10_0))
- (let-values ()
- (let-values (((body_0) (parsed-let_-values-body p_39)))
- (correlate~
- (parsed-s p_39)
- (list
- (if rec?_0 'letrec-values 'let-values)
- (reverse$1
- (let-values (((lst_185) (parsed-let_-values-clauses p_39))
- ((lst_186) (parsed-let_-values-idss p_39)))
+ (let-values (((body_0) (parsed-let_-values-body p_44)))
+ (correlate~
+ (parsed-s p_44)
+ (list
+ (if rec?_0 'letrec-values 'let-values)
+ (reverse$1
+ (let-values (((fold-var_339) (let-values (((fold-var_340) null)) fold-var_340)))
+ (let-values (((lst_300) (parsed-let_-values-clauses p_44))
+ ((lst_301) (parsed-let_-values-idss p_44)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_185)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_186)))
- ((letrec-values (((for-loop_211)
- (lambda (fold-var_201 lst_187 lst_188)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_300))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_301))
+ ((letrec-values (((for-loop_287)
+ (lambda (fold-var_341 lst_302 lst_303)
(begin
'for-loop
- (if (if (pair? lst_187) (pair? lst_188) #f)
- (let-values (((clause_1) (unsafe-car lst_187))
- ((rest_94) (unsafe-cdr lst_187))
- ((ids_5) (unsafe-car lst_188))
- ((rest_95) (unsafe-cdr lst_188)))
- (let-values (((fold-var_202)
- (let-values (((fold-var_203) fold-var_201))
- (let-values (((fold-var_204)
- (let-values ()
- (cons
- (let-values ()
- (list
- (if rec?_0
- (reverse$1
- (let-values (((lst_189)
- (car
- clause_1))
- ((lst_190)
- ids_5))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_189)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_190)))
- ((letrec-values (((for-loop_212)
- (lambda (fold-var_205
- lst_191
- lst_173)
- (begin
- 'for-loop
- (if (if (pair?
- lst_191)
- (pair?
- lst_173)
- #f)
- (let-values (((sym_56)
- (unsafe-car
- lst_191))
- ((rest_96)
- (unsafe-cdr
- lst_191))
- ((id_55)
- (unsafe-car
- lst_173))
- ((rest_97)
- (unsafe-cdr
- lst_173)))
- (let-values (((fold-var_206)
- (let-values (((fold-var_180)
- fold-var_205))
- (let-values (((fold-var_181)
- (let-values ()
- (cons
- (let-values ()
- (add-undefined-error-name-property
- sym_56
- id_55))
- fold-var_180))))
- (values
- fold-var_181)))))
- (if (not
- #f)
- (for-loop_212
- fold-var_206
- rest_96
- rest_97)
- fold-var_206)))
- fold-var_205)))))
- for-loop_212)
- null
- lst_189
- lst_190))))
- (car clause_1))
- (compile$2
- (cadr clause_1)
- cctx_8
- (if (= 1 (length ids_5))
- (car ids_5)
- #f))))
- fold-var_203))))
- (values fold-var_204)))))
+ (if (if (pair? lst_302) (pair? lst_303) #f)
+ (let-values (((clause_1) (unsafe-car lst_302))
+ ((rest_146) (unsafe-cdr lst_302))
+ ((ids_5) (unsafe-car lst_303))
+ ((rest_147) (unsafe-cdr lst_303)))
+ (let-values (((fold-var_342)
+ (let-values (((fold-var_343)
+ (cons
+ (list
+ (if rec?_0
+ (reverse$1
+ (let-values (((fold-var_344)
+ (let-values (((fold-var_345)
+ null))
+ fold-var_345)))
+ (let-values (((lst_304)
+ (car clause_1))
+ ((lst_305) ids_5))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_304))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_305))
+ ((letrec-values (((for-loop_288)
+ (lambda (fold-var_346
+ lst_306
+ lst_307)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_306)
+ (pair?
+ lst_307)
+ #f)
+ (let-values (((sym_71)
+ (unsafe-car
+ lst_306))
+ ((rest_148)
+ (unsafe-cdr
+ lst_306))
+ ((id_63)
+ (unsafe-car
+ lst_307))
+ ((rest_149)
+ (unsafe-cdr
+ lst_307)))
+ (let-values (((fold-var_347)
+ (let-values (((fold-var_348)
+ (cons
+ (add-undefined-error-name-property
+ sym_71
+ id_63)
+ fold-var_346)))
+ (values
+ fold-var_348))))
+ (if (not
+ #f)
+ (for-loop_288
+ fold-var_347
+ rest_148
+ rest_149)
+ fold-var_347)))
+ fold-var_346)))))
+ for-loop_288)
+ fold-var_344
+ lst_304
+ lst_305)))))
+ (car clause_1))
+ (compile$2
+ (cadr clause_1)
+ cctx_8
+ (if (= 1 (length ids_5))
+ (car ids_5)
+ #f)))
+ fold-var_341)))
+ (values fold-var_343))))
(if (not #f)
- (for-loop_211 fold-var_202 rest_94 rest_95)
- fold-var_202)))
- fold-var_201)))))
- for-loop_211)
- null
- lst_185
- lst_186))))
- (compile-sequence body_0 cctx_8 name_50 result-used?_4)))))))))))))
+ (for-loop_287 fold-var_342 rest_146 rest_147)
+ fold-var_342)))
+ fold-var_341)))))
+ for-loop_287)
+ fold-var_339
+ lst_300
+ lst_301)))))
+ (compile-sequence body_0 cctx_8 name_60 result-used?_4))))))))))))
(define-values
(add-undefined-error-name-property)
- (lambda (sym_57 orig-id_0)
+ (lambda (sym_72 orig-id_0)
(begin
- (let-values (((id_56) (correlate~ orig-id_0 sym_57)))
+ (let-values (((id_64) (correlate~ orig-id_0 sym_72)))
(correlated-property
- (->correlated id_56)
+ (->correlated id_64)
'undefined-error-name
- (let-values (((or-part_223) (syntax-property$1 orig-id_0 'undefined-error-name)))
- (if or-part_223 or-part_223 (syntax-e$1 orig-id_0))))))))
+ (let-values (((or-part_367) (syntax-property$1 orig-id_0 'undefined-error-name)))
+ (if or-part_367 or-part_367 (syntax-e$1 orig-id_0))))))))
(define-values
(compile-identifier.1)
(lambda (set-to13_0 set-to?12_0 p16_0 cctx17_0)
(begin
'compile-identifier
- (let-values (((p_40) p16_0))
+ (let-values (((p_45) p16_0))
(let-values (((cctx_9) cctx17_0))
(let-values (((set-to?_0) set-to?12_0))
(let-values (((rhs_0) set-to13_0))
- (let-values ()
- (let-values (((normal-b_0) (parsed-id-binding p_40)))
- (let-values (((b_25)
- (let-values (((or-part_177) normal-b_0))
- (if or-part_177
- or-part_177
- (let-values (((temp37_1) (compile-context-self cctx_9))
- ((temp38_0) (compile-context-phase cctx_9))
- ((temp39_0) (syntax-e$1 (parsed-s p_40))))
- (make-module-binding.1
- #f
- null
- #f
- #f
- unsafe-undefined
- unsafe-undefined
- 0
- unsafe-undefined
- temp37_1
- temp38_0
- temp39_0))))))
- (let-values (((sym_58)
- (if (local-binding? b_25)
- (let-values () (local-binding-key b_25))
- (if (module-binding? b_25)
- (let-values ()
- (let-values (((mpi_50)
- (if (parsed-top-id? p_40)
- (compile-context-self cctx_9)
- (module-binding-module b_25))))
- (if (parsed-primitive-id? p_40)
- (let-values ()
- (begin
- (if (zero? (module-binding-phase b_25))
- (void)
- (let-values ()
- (error "internal error: non-zero phase for a primitive")))
- (if set-to?_0
- (let-values ()
- (error
- "internal error: cannot assign to a primitive:"
- (module-binding-sym b_25)))
- (void))
- (module-binding-sym b_25)))
- (let-values (((c1_27)
- (if (eq? mpi_50 (compile-context-module-self cctx_9))
- (hash-ref
- (header-binding-sym-to-define-sym
- (compile-context-header cctx_9))
- (module-binding-sym b_25)
- #f)
- #f)))
- (if c1_27
- ((lambda (sym_59) sym_59) c1_27)
- (let-values ()
- (let-values (((temp40_0) (compile-context-header cctx_9))
- ((temp41_1)
- (if (inside-module-context?
- mpi_50
- (compile-context-self cctx_9))
- (compile-context-self cctx_9)
- mpi_50))
- ((temp42_0) (module-binding-phase b_25))
- ((temp43_0) (module-binding-sym b_25))
- ((temp44_0)
- (let-values (((or-part_67)
- (module-binding-extra-inspector b_25)))
- (if or-part_67
- or-part_67
- (let-values (((or-part_224)
- (parsed-id-inspector p_40)))
- (if or-part_224
- or-part_224
- (if (parsed-s p_40)
- (syntax-inspector (parsed-s p_40))
- #f)))))))
- (register-required-variable-use!.1
- #f
- temp40_0
- temp41_1
- temp42_0
- temp43_0
- temp44_0))))))))
- (let-values ()
- (error
- "not a reference to a module or local binding:"
- b_25
- (parsed-s p_40)))))))
- (correlate~ (parsed-s p_40) (if set-to?_0 (list 'set! sym_58 rhs_0) sym_58)))))))))))))
+ (let-values (((normal-b_0) (parsed-id-binding p_45)))
+ (let-values (((b_111)
+ (let-values (((or-part_368) normal-b_0))
+ (if or-part_368
+ or-part_368
+ (let-values (((temp37_0) (compile-context-self cctx_9))
+ ((temp38_1) (compile-context-phase cctx_9))
+ ((temp39_0) (syntax-e$1 (parsed-s p_45))))
+ (make-module-binding.1
+ #f
+ null
+ #f
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ 0
+ unsafe-undefined
+ temp37_0
+ temp38_1
+ temp39_0))))))
+ (let-values (((sym_73)
+ (if (local-binding? b_111)
+ (local-binding-key b_111)
+ (if (module-binding? b_111)
+ (let-values (((mpi_71)
+ (if (parsed-top-id? p_45)
+ (compile-context-self cctx_9)
+ (module-binding-module b_111))))
+ (if (parsed-primitive-id? p_45)
+ (begin
+ (if (zero? (module-binding-phase b_111))
+ (void)
+ (error "internal error: non-zero phase for a primitive"))
+ (if set-to?_0
+ (error
+ "internal error: cannot assign to a primitive:"
+ (module-binding-sym b_111))
+ (void))
+ (module-binding-sym b_111))
+ (let-values (((cond-val_18)
+ (if (eq? mpi_71 (compile-context-module-self cctx_9))
+ (hash-ref
+ (header-binding-sym-to-define-sym
+ (compile-context-header cctx_9))
+ (module-binding-sym b_111)
+ #f)
+ #f)))
+ (if cond-val_18
+ ((lambda (sym_74) sym_74) cond-val_18)
+ (let-values (((temp40_0) (compile-context-header cctx_9))
+ ((temp41_0)
+ (if (inside-module-context?
+ mpi_71
+ (compile-context-self cctx_9))
+ (compile-context-self cctx_9)
+ mpi_71))
+ ((temp42_0) (module-binding-phase b_111))
+ ((temp43_0) (module-binding-sym b_111))
+ ((temp44_0)
+ (let-values (((or-part_369)
+ (module-binding-extra-inspector b_111)))
+ (if or-part_369
+ or-part_369
+ (let-values (((or-part_370) (parsed-id-inspector p_45)))
+ (if or-part_370
+ or-part_370
+ (if (parsed-s p_45)
+ (syntax-inspector (parsed-s p_45))
+ #f)))))))
+ (register-required-variable-use!.1
+ #f
+ temp40_0
+ temp41_0
+ temp42_0
+ temp43_0
+ temp44_0))))))
+ (error "not a reference to a module or local binding:" b_111 (parsed-s p_45))))))
+ (correlate~ (parsed-s p_45) (if set-to?_0 (list 'set! sym_73 rhs_0) sym_73))))))))))))
(define-values
(compile-quote-syntax)
(lambda (q_1 cctx_10)
(begin
- (let-values (((pos_114) (add-syntax-literal! (compile-context-header cctx_10) q_1)))
+ (let-values (((pos_144) (add-syntax-literal! (compile-context-header cctx_10) q_1)))
(if (compile-context-lazy-syntax-literals? cctx_10)
- (let-values () (generate-lazy-syntax-literal-lookup pos_114))
- (let-values () (generate-eager-syntax-literal-lookup pos_114)))))))
- (define-values
- (extra-inspectors-allow?)
- (lambda (extra-inspectors_2 guard-insp_0)
- (begin
- (if (not extra-inspectors_2)
- (let-values () #f)
- (if (set? extra-inspectors_2)
- (let-values ()
- (let-values (((ht_130) extra-inspectors_2))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_130)))
- ((letrec-values (((for-loop_100)
- (lambda (result_83 i_164)
- (begin
- 'for-loop
- (if i_164
- (let-values (((extra-insp_0) (unsafe-immutable-hash-iterate-key ht_130 i_164)))
- (let-values (((result_84)
- (let-values ()
- (let-values (((result_85)
- (let-values ()
- (let-values ()
- (inspector-superior?
- extra-insp_0
- guard-insp_0)))))
- (values result_85)))))
- (if (if (not ((lambda x_62 (not result_84)) extra-insp_0)) (not #f) #f)
- (for-loop_100 result_84 (unsafe-immutable-hash-iterate-next ht_130 i_164))
- result_84)))
- result_83)))))
- for-loop_100)
- #t
- (unsafe-immutable-hash-iterate-first ht_130)))))
- (if (procedure? extra-inspectors_2)
- (let-values () (extra-inspectors_2 guard-insp_0))
- (let-values ()
- (error
- 'extra-inspectors-allow?
- "unknown representation of extra inspectors: ~e"
- extra-inspectors_2))))))))
- (define-values
- (extra-inspectors-merge)
- (lambda (extra-inspectors-1_0 extra-inspectors-2_0)
- (begin
- (if (let-values (((or-part_14) (not extra-inspectors-1_0))) (if or-part_14 or-part_14 (not extra-inspectors-2_0)))
- (let-values () #f)
- (if (if (set? extra-inspectors-1_0) (set? extra-inspectors-2_0) #f)
- (let-values () (set-union extra-inspectors-1_0 extra-inspectors-2_0))
- (let-values ()
- (lambda (guard-insp_1)
- (if (extra-inspectors-allow? extra-inspectors-1_0 guard-insp_1)
- (extra-inspectors-allow? extra-inspectors-2_0 guard-insp_1)
- #f))))))))
- (define-values
- (struct:module-use*
- module-use*1.1
- module-use*?
- module-use*-extra-inspectorss
- module-use*-self-inspector
- set-module-use*-extra-inspectorss!
- set-module-use*-self-inspector!)
- (let-values (((struct:_62 make-_62 ?_62 -ref_62 -set!_62)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'module-use*
- struct:module-use
- 2
- 0
- #f
- null
- (current-inspector)
- #f
- '()
- #f
- 'module-use*)))))
- (values
- struct:_62
- make-_62
- ?_62
- (make-struct-field-accessor -ref_62 0 'extra-inspectorss)
- (make-struct-field-accessor -ref_62 1 'self-inspector)
- (make-struct-field-mutator -set!_62 0 'extra-inspectorss)
- (make-struct-field-mutator -set!_62 1 'self-inspector))))
- (define-values
- (module-uses-add-extra-inspectorsss)
- (lambda (mus_1 extra-inspectorsss_0)
- (begin
- (if extra-inspectorsss_0
- (let-values ()
- (reverse$1
- (let-values (((lst_192) mus_1) ((lst_91) extra-inspectorsss_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_192)))
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_91)))
- ((letrec-values (((for-loop_213)
- (lambda (fold-var_207 lst_193 lst_103)
- (begin
- 'for-loop
- (if (if (pair? lst_193) (pair? lst_103) #f)
- (let-values (((mu_5) (unsafe-car lst_193))
- ((rest_98) (unsafe-cdr lst_193))
- ((extra-inspectorss_1) (unsafe-car lst_103))
- ((rest_99) (unsafe-cdr lst_103)))
- (let-values (((fold-var_194)
- (let-values (((fold-var_83) fold-var_207))
- (let-values (((fold-var_208)
- (let-values ()
- (cons
- (let-values ()
- (module-use*1.1
- (module-use-module mu_5)
- (module-use-phase mu_5)
- extra-inspectorss_1
- #f))
- fold-var_83))))
- (values fold-var_208)))))
- (if (not #f) (for-loop_213 fold-var_194 rest_98 rest_99) fold-var_194)))
- fold-var_207)))))
- for-loop_213)
- null
- lst_192
- lst_91)))))
- (let-values ()
- (reverse$1
- (let-values (((lst_194) mus_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_194)))
- ((letrec-values (((for-loop_214)
- (lambda (fold-var_129 lst_66)
- (begin
- 'for-loop
- (if (pair? lst_66)
- (let-values (((mu_6) (unsafe-car lst_66)) ((rest_30) (unsafe-cdr lst_66)))
- (let-values (((fold-var_86)
- (let-values (((fold-var_196) fold-var_129))
- (let-values (((fold-var_209)
- (let-values ()
- (cons
- (let-values ()
- (module-use*1.1
- (module-use-module mu_6)
- (module-use-phase mu_6)
- #f
- #f))
- fold-var_196))))
- (values fold-var_209)))))
- (if (not #f) (for-loop_214 fold-var_86 rest_30) fold-var_86)))
- fold-var_129)))))
- for-loop_214)
- null
- lst_194)))))))))
- (define-values
- (module-uses-strip-extra-inspectorsss)
- (lambda (mu*s_0)
- (begin
- (reverse$1
- (let-values (((lst_25) mu*s_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_25)))
- ((letrec-values (((for-loop_23)
- (lambda (fold-var_7 lst_26)
- (begin
- 'for-loop
- (if (pair? lst_26)
- (let-values (((mu*_0) (unsafe-car lst_26)) ((rest_9) (unsafe-cdr lst_26)))
- (let-values (((fold-var_8)
- (let-values (((fold-var_9) fold-var_7))
- (let-values (((fold-var_10)
- (let-values ()
- (cons
- (let-values ()
- (module-use1.1
- (module-use-module mu*_0)
- (module-use-phase mu*_0)))
- fold-var_9))))
- (values fold-var_10)))))
- (if (not #f) (for-loop_23 fold-var_8 rest_9) fold-var_8)))
- fold-var_7)))))
- for-loop_23)
- null
- lst_25)))))))
- (define-values
- (module-uses-extract-extra-inspectorsss)
- (lambda (mu*s_1 linklet_0 check-inlined-reference?_0 skip-n_0)
- (begin
- (if (not check-inlined-reference?_0)
- (let-values ()
- (reverse$1
- (let-values (((lst_195) mu*s_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_195)))
- ((letrec-values (((for-loop_109)
- (lambda (fold-var_87 lst_95)
- (begin
- 'for-loop
- (if (pair? lst_95)
- (let-values (((mu*_1) (unsafe-car lst_95)) ((rest_45) (unsafe-cdr lst_95)))
- (let-values (((fold-var_88)
- (let-values (((fold-var_89) fold-var_87))
- (let-values (((fold-var_72)
- (let-values ()
- (cons
- (let-values ()
- (module-use*-extra-inspectorss mu*_1))
- fold-var_89))))
- (values fold-var_72)))))
- (if (not #f) (for-loop_109 fold-var_88 rest_45) fold-var_88)))
- fold-var_87)))))
- for-loop_109)
- null
- lst_195)))))
- (let-values ()
- (reverse$1
- (let-values (((lst_196) mu*s_1) ((lst_96) (list-tail (linklet-import-variables$1 linklet_0) skip-n_0)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_196)))
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_96)))
- ((letrec-values (((for-loop_215)
- (lambda (fold-var_210 lst_197 lst_97)
- (begin
- 'for-loop
- (if (if (pair? lst_197) (pair? lst_97) #f)
- (let-values (((mu*_2) (unsafe-car lst_197))
- ((rest_100) (unsafe-cdr lst_197))
- ((imports_0) (unsafe-car lst_97))
- ((rest_101) (unsafe-cdr lst_97)))
- (let-values (((fold-var_90)
- (let-values (((fold-var_91) fold-var_210))
- (let-values (((fold-var_92)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((extra-inspectorss_2)
- (module-use*-extra-inspectorss
- mu*_2)))
- (let-values (((lst_198) imports_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_198)))
- ((letrec-values (((for-loop_216)
- (lambda (extra-inspectorss_3
- lst_199)
- (begin
- 'for-loop
- (if (pair?
- lst_199)
- (let-values (((import_0)
- (unsafe-car
- lst_199))
- ((rest_102)
- (unsafe-cdr
- lst_199)))
- (let-values (((extra-inspectorss_4)
- (let-values (((extra-inspectorss_5)
- extra-inspectorss_3))
- (let-values (((extra-inspectorss_6)
- (let-values ()
- (if (eq?
- (hash-ref
- extra-inspectorss_5
- import_0
- '#:not-recorded)
- '#:not-recorded)
- (let-values ()
- (hash-set
- extra-inspectorss_5
- import_0
- (set
- (module-use*-self-inspector
- mu*_2))))
- (let-values ()
- extra-inspectorss_5)))))
- (values
- extra-inspectorss_6)))))
- (if (not
- #f)
- (for-loop_216
- extra-inspectorss_4
- rest_102)
- extra-inspectorss_4)))
- extra-inspectorss_3)))))
- for-loop_216)
- extra-inspectorss_2
- lst_198)))))
- fold-var_91))))
- (values fold-var_92)))))
- (if (not #f) (for-loop_215 fold-var_90 rest_100 rest_101) fold-var_90)))
- fold-var_210)))))
- for-loop_215)
- null
- lst_196
- lst_96)))))))))
- (define-values
- (module-use*-declaration-inspector!)
- (lambda (mu*_3 insp_7) (begin (set-module-use*-self-inspector! mu*_3 insp_7))))
- (define-values
- (module-use+extra-inspectors)
- (lambda (mpi_17 phase_75 imports_1 inspector_16 extra-inspector_4 extra-inspectorss_7)
- (begin
- (let-values (((now-inspector_0) (current-code-inspector)))
- (let-values (((add-insp?_0) (if inspector_16 (inspector-superior? inspector_16 now-inspector_0) #f)))
- (let-values (((add-extra-insp?_0)
- (if extra-inspector_4 (inspector-superior? extra-inspector_4 now-inspector_0) #f)))
- (let-values (((new-extra-inspectorss_0)
- (if (let-values (((or-part_218) add-insp?_0)) (if or-part_218 or-part_218 add-extra-insp?_0))
- (let-values ()
- (let-values (((lst_16) imports_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_16)))
- ((letrec-values (((for-loop_217)
- (lambda (table_152 lst_200)
- (begin
- 'for-loop
- (if (pair? lst_200)
- (let-values (((import_1) (unsafe-car lst_200))
- ((rest_103) (unsafe-cdr lst_200)))
- (let-values (((table_89)
- (let-values (((table_153) table_152))
- (let-values (((table_154)
- (let-values ()
- (let-values (((key_63
- val_46)
- (let-values ()
- (values
- import_1
- (let-values (((extra-inspectors_3)
- (if extra-inspectorss_7
- (hash-ref
- extra-inspectorss_7
- import_1
- #f)
- #f)))
- (lambda (guard-insp_2)
- (let-values (((or-part_150)
- (if add-insp?_0
- (inspector-superior?
- inspector_16
- guard-insp_2)
- #f)))
- (if or-part_150
- or-part_150
- (let-values (((or-part_151)
- (if add-extra-insp?_0
- (inspector-superior?
- extra-inspector_4
- guard-insp_2)
- #f)))
- (if or-part_151
- or-part_151
- (extra-inspectors-allow?
- extra-inspectors_3
- guard-insp_2)))))))))))
- (hash-set
- table_153
- key_63
- val_46)))))
- (values table_154)))))
- (if (not #f) (for-loop_217 table_89 rest_103) table_89)))
- table_152)))))
- for-loop_217)
- '#hash()
- lst_16))))
- (let-values ()
- (let-values (((lst_201) imports_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_201)))
- ((letrec-values (((for-loop_12)
- (lambda (extra-inspectorss_8 lst_202)
- (begin
- 'for-loop
- (if (pair? lst_202)
- (let-values (((import_2) (unsafe-car lst_202))
- ((rest_104) (unsafe-cdr lst_202)))
- (let-values (((extra-inspectorss_9)
- (let-values (((extra-inspectorss_10)
- extra-inspectorss_8))
- (let-values (((extra-inspectorss_11)
- (let-values ()
- (if (hash-ref
- extra-inspectorss_10
- import_2
- #f)
- extra-inspectorss_10
- (hash-set
- extra-inspectorss_10
- import_2
- #f)))))
- (values extra-inspectorss_11)))))
- (if (not #f)
- (for-loop_12 extra-inspectorss_9 rest_104)
- extra-inspectorss_9)))
- extra-inspectorss_8)))))
- for-loop_12)
- (let-values (((or-part_190) extra-inspectorss_7))
- (if or-part_190 or-part_190 (seteq)))
- lst_201)))))))
- (module-use*1.1 mpi_17 phase_75 new-extra-inspectorss_0 #f))))))))
- (define-values
- (module-use-merge-extra-inspectorss!)
- (lambda (existing-mu*_0 mu*_4)
- (begin
- (let-values (((existing-extra-inspectorss_0) (module-use*-extra-inspectorss existing-mu*_0)))
- (let-values (((extra-inspectorss_12) (module-use*-extra-inspectorss mu*_4)))
- (let-values (((new-extra-inspectorss_1)
- (if (not existing-extra-inspectorss_0)
- (let-values () extra-inspectorss_12)
- (if (not extra-inspectorss_12)
- (let-values () existing-extra-inspectorss_0)
- (let-values ()
- (let-values (((ht_131) extra-inspectorss_12))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_131)))
- ((letrec-values (((for-loop_218)
- (lambda (new-extra-inspectorss_2 i_165)
- (begin
- 'for-loop
- (if i_165
- (let-values (((sym_60 extra-inspectors_4)
- (hash-iterate-key+value ht_131 i_165)))
- (let-values (((new-extra-inspectorss_3)
- (let-values (((new-extra-inspectorss_4)
- new-extra-inspectorss_2))
- (let-values (((new-extra-inspectorss_5)
- (let-values ()
- (hash-set
- new-extra-inspectorss_4
- sym_60
- (extra-inspectors-merge
- extra-inspectors_4
- (hash-ref
- new-extra-inspectorss_4
- sym_60
- (seteq)))))))
- (values new-extra-inspectorss_5)))))
- (if (not #f)
- (for-loop_218
- new-extra-inspectorss_3
- (hash-iterate-next ht_131 i_165))
- new-extra-inspectorss_3)))
- new-extra-inspectorss_2)))))
- for-loop_218)
- existing-extra-inspectorss_0
- (hash-iterate-first ht_131)))))))))
- (set-module-use*-extra-inspectorss! existing-mu*_0 new-extra-inspectorss_1)))))))
+ (generate-lazy-syntax-literal-lookup pos_144)
+ (generate-eager-syntax-literal-lookup pos_144))))))
(define-values
(struct:link-info
link-info1.1
@@ -34039,18 +34220,16 @@
link-info-imports
link-info-extra-inspectorsss
link-info-def-decls)
- (let-values (((struct:_24 make-_24 ?_24 -ref_24 -set!_24)
- (let-values ()
- (let-values ()
- (make-struct-type 'link-info #f 4 0 #f null (current-inspector) #f '(0 1 2 3) #f 'link-info)))))
+ (let-values (((struct:_103 make-_103 ?_103 -ref_103 -set!_103)
+ (make-struct-type 'link-info #f 4 0 #f null (current-inspector) #f '(0 1 2 3) #f 'link-info)))
(values
- struct:_24
- make-_24
- ?_24
- (make-struct-field-accessor -ref_24 0 'link-module-uses)
- (make-struct-field-accessor -ref_24 1 'imports)
- (make-struct-field-accessor -ref_24 2 'extra-inspectorsss)
- (make-struct-field-accessor -ref_24 3 'def-decls))))
+ struct:_103
+ make-_103
+ ?_103
+ (make-struct-field-accessor -ref_103 0 'link-module-uses)
+ (make-struct-field-accessor -ref_103 1 'imports)
+ (make-struct-field-accessor -ref_103 2 'extra-inspectorsss)
+ (make-struct-field-accessor -ref_103 3 'def-decls))))
(define-values
(compile-forms.1)
(lambda (body-import-instances3_0
@@ -34062,21 +34241,22 @@
force-phases5_0
get-module-linklet-info11_0
module-prompt?13_0
- optimize-linklet?15_0
+ optimize-linklet?16_0
other-form-callback10_0
- realm17_0
+ realm18_0
root-ctx-only-if-syntax?7_0
serializable?12_0
- to-correlated-linklet?14_0
- unsafe?-box16_0
- bodys34_0
- cctx35_0
- mpis36_0)
+ to-correlated-linklet?15_0
+ unlimited-compile?-box14_0
+ unsafe?-box17_0
+ bodys36_0
+ cctx37_0
+ mpis38_0)
(begin
'compile-forms
- (let-values (((bodys_2) bodys34_0))
- (let-values (((cctx_11) cctx35_0))
- (let-values (((mpis_18) mpis36_0))
+ (let-values (((bodys_2) bodys36_0))
+ (let-values (((cctx_11) cctx37_0))
+ (let-values (((mpis_19) mpis38_0))
(let-values (((body-imports_0) body-imports2_0))
(let-values (((body-import-instances_0) body-import-instances3_0))
(let-values (((body-suffix-forms_0) body-suffix-forms4_0))
@@ -34088,94 +34268,91 @@
(let-values (((other-form-callback_0) other-form-callback10_0))
(let-values (((get-module-linklet-info_0)
(if (eq? get-module-linklet-info11_0 unsafe-undefined)
- (lambda (mod-name_15 p_41) (begin 'get-module-linklet-info #f))
+ (lambda (mod-name_16 p_46) (begin 'get-module-linklet-info #f))
get-module-linklet-info11_0)))
(let-values (((serializable?_0) serializable?12_0))
(let-values (((module-prompt?_0) module-prompt?13_0))
- (let-values (((to-correlated-linklet?_2) to-correlated-linklet?14_0))
- (let-values (((optimize-linklet?_0) optimize-linklet?15_0))
- (let-values (((unsafe?-box_0) unsafe?-box16_0))
- (let-values (((realm_1)
- (if (eq? realm17_0 unsafe-undefined)
- (current-compile-realm)
- realm17_0)))
- (let-values ()
- (let-values (((phase_76) (compile-context-phase cctx_11)))
- (let-values (((self_19) (compile-context-self cctx_11)))
- (let-values (((syntax-literals_1) (make-syntax-literals)))
+ (let-values (((unlimited-compile?-box_0) unlimited-compile?-box14_0))
+ (let-values (((to-correlated-linklet?_2) to-correlated-linklet?15_0))
+ (let-values (((optimize-linklet?_0) optimize-linklet?16_0))
+ (let-values (((unsafe?-box_0) unsafe?-box17_0))
+ (let-values (((realm_1)
+ (if (eq? realm18_0 unsafe-undefined)
+ (current-compile-realm)
+ realm18_0)))
+ (let-values (((phase_89) (compile-context-phase cctx_11)))
+ (let-values (((self_23) (compile-context-self cctx_11)))
+ (let-values (((syntax-literals_2) (make-syntax-literals)))
(let-values (((phase-to-body_0) (make-hasheqv)))
(let-values (((add-body!_0)
- (lambda (phase_77 body_1)
+ (lambda (phase_90 body_1)
(begin
'add-body!
(hash-update!
phase-to-body_0
- phase_77
- (lambda (l_41) (cons body_1 l_41))
+ phase_90
+ (lambda (l_50) (cons body_1 l_50))
null)))))
(let-values (((phase-to-header_0) (make-hasheqv)))
(let-values (((find-or-create-header!_0)
- (lambda (phase_78)
+ (lambda (phase_91)
(begin
'find-or-create-header!
- (let-values (((or-part_225)
+ (let-values (((or-part_371)
(hash-ref
phase-to-header_0
- phase_78
+ phase_91
#f)))
- (if or-part_225
- or-part_225
+ (if or-part_371
+ or-part_371
(let-values (((header_6)
(make-header
- mpis_18
- syntax-literals_1)))
+ mpis_19
+ syntax-literals_2)))
(begin
(hash-set!
phase-to-header_0
- phase_78
+ phase_91
header_6)
header_6))))))))
(let-values ((()
(begin
- (let-values (((lst_203) force-phases_0))
+ (let-values (((lst_308) force-phases_0))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_203)))
- ((letrec-values (((for-loop_219)
- (lambda (lst_183)
+ (check-list lst_308))
+ ((letrec-values (((for-loop_289)
+ (lambda (lst_309)
(begin
'for-loop
(if (pair?
- lst_183)
- (let-values (((phase_79)
+ lst_309)
+ (let-values (((phase_92)
(unsafe-car
- lst_183))
- ((rest_105)
+ lst_309))
+ ((rest_150)
(unsafe-cdr
- lst_183)))
+ lst_309)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (begin
- (find-or-create-header!_0
- phase_79)
- (add-body!_0
- phase_79
- '(void))))
- (values)))))
- (values)))))
+ (let-values ((()
+ (begin
+ (begin
+ (find-or-create-header!_0
+ phase_92)
+ (add-body!_0
+ phase_92
+ '(void)))
+ (values))))
+ (values))))
(if (not #f)
- (for-loop_219
- rest_105)
+ (for-loop_289
+ rest_150)
(values))))
(values))))))
- for-loop_219)
- lst_203)))
+ for-loop_289)
+ lst_308)))
(values))))
(let-values ()
(let-values (((saw-define-syntaxes?_0) #f))
@@ -34183,857 +34360,823 @@
(begin
(if (compile-context-module-self
cctx_11)
- (let-values ()
- ((letrec-values (((loop!_0)
- (lambda (bodys_3
- phase_80
- header_7)
+ ((letrec-values (((loop!_0)
+ (lambda (bodys_3
+ phase_93
+ header_7)
+ (begin
+ 'loop!
(begin
- 'loop!
- (begin
- (let-values (((lst_204)
- bodys_3))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_204)))
- ((letrec-values (((for-loop_220)
- (lambda (lst_99)
- (begin
- 'for-loop
- (if (pair?
- lst_99)
- (let-values (((body_2)
- (unsafe-car
- lst_99))
- ((rest_46)
- (unsafe-cdr
- lst_99)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (if (parsed-define-values?
- body_2)
- (let-values ()
- (begin
- (let-values (((lst_16)
- (parsed-define-values-syms
- body_2)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_16)))
- ((letrec-values (((for-loop_217)
- (lambda (lst_157)
- (begin
- 'for-loop
- (if (pair?
- lst_157)
- (let-values (((sym_61)
- (unsafe-car
- lst_157))
- ((rest_106)
- (unsafe-cdr
- lst_157)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((def-sym_1)
- (select-fresh
- sym_61
- header_7)))
- (begin
- (hash-set!
- (header-binding-sym-to-define-sym
- header_7)
- sym_61
- def-sym_1)
- (set-header-binding-syms-in-order!
- header_7
- (cons
- sym_61
- (header-binding-syms-in-order
- header_7)))
- (register-as-defined!
- header_7
- def-sym_1))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_217
- rest_106)
- (values))))
- (values))))))
- for-loop_217)
- lst_16)))
- (void)))
- (if (parsed-begin-for-syntax?
- body_2)
- (let-values ()
- (loop!_0
- (parsed-begin-for-syntax-body
- body_2)
- (add1
- phase_80)
- (find-or-create-header!_0
- (add1
- phase_80))))
- (void))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_220
- rest_46)
- (values))))
- (values))))))
- for-loop_220)
- lst_204)))
- (void))))))
- loop!_0)
- bodys_2
- phase_76
- (find-or-create-header!_0
- phase_76)))
+ (let-values (((lst_310)
+ bodys_3))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_310))
+ ((letrec-values (((for-loop_290)
+ (lambda (lst_311)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_311)
+ (let-values (((body_2)
+ (unsafe-car
+ lst_311))
+ ((rest_151)
+ (unsafe-cdr
+ lst_311)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (if (parsed-define-values?
+ body_2)
+ (begin
+ (let-values (((lst_312)
+ (parsed-define-values-syms
+ body_2)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_312))
+ ((letrec-values (((for-loop_291)
+ (lambda (lst_313)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_313)
+ (let-values (((sym_75)
+ (unsafe-car
+ lst_313))
+ ((rest_152)
+ (unsafe-cdr
+ lst_313)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((def-sym_1)
+ (select-fresh
+ sym_75
+ header_7)))
+ (begin
+ (hash-set!
+ (header-binding-sym-to-define-sym
+ header_7)
+ sym_75
+ def-sym_1)
+ (set-header-binding-syms-in-order!
+ header_7
+ (cons
+ sym_75
+ (header-binding-syms-in-order
+ header_7)))
+ (register-as-defined!
+ header_7
+ def-sym_1)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_291
+ rest_152)
+ (values))))
+ (values))))))
+ for-loop_291)
+ lst_312)))
+ (void))
+ (if (parsed-begin-for-syntax?
+ body_2)
+ (loop!_0
+ (parsed-begin-for-syntax-body
+ body_2)
+ (add1
+ phase_93)
+ (find-or-create-header!_0
+ (add1
+ phase_93)))
+ (void)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_290
+ rest_151)
+ (values))))
+ (values))))))
+ for-loop_290)
+ lst_310)))
+ (void))))))
+ loop!_0)
+ bodys_2
+ phase_89
+ (find-or-create-header!_0
+ phase_89))
(void))
(values))))
(let-values (((as-required?_0)
(lambda (header_8)
(begin
'as-required?
- (lambda (sym_62)
+ (lambda (sym_76)
(registered-as-required?
header_8
- sym_62))))))
+ sym_76))))))
(let-values (((last-i_0) (sub1 (length bodys_2))))
(let-values ((()
(begin
((letrec-values (((loop!_1)
(lambda (bodys_4
- phase_81
+ phase_94
header_9)
(begin
'loop!
(begin
- (let-values (((lst_205)
+ (let-values (((lst_314)
bodys_4)
- ((start_45)
+ ((start_54)
0))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-list
- lst_205)))
+ (check-list
+ lst_314))
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-naturals
- start_45)))
- ((letrec-values (((for-loop_5)
- (lambda (lst_201
- pos_115)
+ (check-naturals
+ start_54))
+ ((letrec-values (((for-loop_292)
+ (lambda (lst_315
+ pos_145)
(begin
'for-loop
(if (if (pair?
- lst_201)
+ lst_315)
#t
#f)
(let-values (((body_3)
(unsafe-car
- lst_201))
- ((rest_107)
+ lst_315))
+ ((rest_153)
(unsafe-cdr
- lst_201))
- ((i_166)
- pos_115))
+ lst_315))
+ ((i_231)
+ pos_145))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (if (parsed-define-values?
- body_3)
- (let-values ()
- (let-values (((ids_6)
- (parsed-define-values-ids
- body_3)))
- (let-values (((binding-syms_0)
- (parsed-define-values-syms
- body_3)))
- (let-values (((def-syms_0)
- (if (compile-context-module-self
- cctx_11)
- (let-values ()
- (reverse$1
- (let-values (((lst_206)
- binding-syms_0)
- ((lst_207)
- ids_6))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_206)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_207)))
- ((letrec-values (((for-loop_118)
- (lambda (fold-var_211
- lst_208
- lst_113)
- (begin
- 'for-loop
- (if (if (pair?
- lst_208)
- (pair?
- lst_113)
- #f)
- (let-values (((binding-sym_0)
- (unsafe-car
- lst_208))
- ((rest_108)
- (unsafe-cdr
- lst_208))
- ((id_57)
- (unsafe-car
- lst_113))
- ((rest_55)
- (unsafe-cdr
- lst_113)))
- (let-values (((fold-var_212)
- (let-values (((fold-var_213)
- fold-var_211))
- (let-values (((fold-var_214)
- (let-values ()
- (cons
- (let-values ()
- (correlate-source-name
- (hash-ref
- (header-binding-sym-to-define-sym
- header_9)
- binding-sym_0)
- (syntax-e$1
- id_57)))
- fold-var_213))))
- (values
- fold-var_214)))))
- (if (not
- #f)
- (for-loop_118
- fold-var_212
- rest_108
- rest_55)
- fold-var_212)))
- fold-var_211)))))
- for-loop_118)
- null
- lst_206
- lst_207)))))
- (let-values ()
- (reverse$1
- (let-values (((lst_186)
- binding-syms_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_186)))
- ((letrec-values (((for-loop_211)
- (lambda (fold-var_201
- lst_187)
- (begin
- 'for-loop
- (if (pair?
- lst_187)
- (let-values (((binding-sym_1)
- (unsafe-car
- lst_187))
- ((rest_109)
- (unsafe-cdr
- lst_187)))
- (let-values (((fold-var_215)
- (let-values (((fold-var_216)
- fold-var_201))
- (let-values (((fold-var_217)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((header65_0)
- header_9)
- ((temp66_2)
- (compile-context-self
- cctx_11))
- ((phase67_0)
- phase_81)
- ((binding-sym68_0)
- binding-sym_1)
- ((temp69_1)
- #f)
- ((temp70_0)
- #t))
- (register-required-variable-use!.1
- temp70_0
- header65_0
- temp66_2
- phase67_0
- binding-sym68_0
- temp69_1)))
- fold-var_216))))
- (values
- fold-var_217)))))
- (if (not
- #f)
- (for-loop_211
- fold-var_215
- rest_109)
- fold-var_215)))
- fold-var_201)))))
- for-loop_211)
- null
- lst_186))))))))
- (let-values (((rhs_1)
- (compile$2
- (parsed-define-values-rhs
- body_3)
- (let-values (((the-struct_44)
- cctx_11))
- (if (compile-context?
- the-struct_44)
- (let-values (((phase71_1)
- phase_81)
- ((header72_0)
- header_9))
- (compile-context1.1
- (compile-context-namespace
- the-struct_44)
- phase71_1
- (compile-context-self
- the-struct_44)
- (compile-context-module-self
- the-struct_44)
- (compile-context-full-module-name
- the-struct_44)
- (compile-context-lazy-syntax-literals?
- the-struct_44)
- header72_0))
- (raise-argument-error
- 'struct-copy
- "compile-context?"
- the-struct_44)))
- (if (=
- (length
- ids_6)
- 1)
- (car
- ids_6)
- #f))))
- (begin
- (definition-callback_0)
- (compiled-expression-callback_0
- rhs_1
- (length
- def-syms_0)
- phase_81
- (as-required?_0
- header_9))
- (add-body!_0
- phase_81
- (propagate-inline-property
- (correlate*
- (parsed-s
+ (let-values ((()
+ (begin
+ (if (parsed-define-values?
+ body_3)
+ (let-values (((ids_6)
+ (parsed-define-values-ids
+ body_3)))
+ (let-values (((binding-syms_0)
+ (parsed-define-values-syms
+ body_3)))
+ (let-values (((def-syms_0)
+ (if (compile-context-module-self
+ cctx_11)
+ (reverse$1
+ (let-values (((fold-var_349)
+ (let-values (((fold-var_350)
+ null))
+ fold-var_350)))
+ (let-values (((lst_316)
+ binding-syms_0)
+ ((lst_317)
+ ids_6))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_316))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_317))
+ ((letrec-values (((for-loop_293)
+ (lambda (fold-var_351
+ lst_318
+ lst_319)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_318)
+ (pair?
+ lst_319)
+ #f)
+ (let-values (((binding-sym_0)
+ (unsafe-car
+ lst_318))
+ ((rest_154)
+ (unsafe-cdr
+ lst_318))
+ ((id_65)
+ (unsafe-car
+ lst_319))
+ ((rest_155)
+ (unsafe-cdr
+ lst_319)))
+ (let-values (((fold-var_352)
+ (let-values (((fold-var_353)
+ (cons
+ (correlate-source-name
+ (hash-ref
+ (header-binding-sym-to-define-sym
+ header_9)
+ binding-sym_0)
+ (syntax-e$1
+ id_65))
+ fold-var_351)))
+ (values
+ fold-var_353))))
+ (if (not
+ #f)
+ (for-loop_293
+ fold-var_352
+ rest_154
+ rest_155)
+ fold-var_352)))
+ fold-var_351)))))
+ for-loop_293)
+ fold-var_349
+ lst_316
+ lst_317)))))
+ (reverse$1
+ (let-values (((fold-var_354)
+ (let-values (((fold-var_355)
+ null))
+ fold-var_355)))
+ (let-values (((lst_320)
+ binding-syms_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_320))
+ ((letrec-values (((for-loop_294)
+ (lambda (fold-var_356
+ lst_321)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_321)
+ (let-values (((binding-sym_1)
+ (unsafe-car
+ lst_321))
+ ((rest_156)
+ (unsafe-cdr
+ lst_321)))
+ (let-values (((fold-var_357)
+ (let-values (((fold-var_358)
+ (cons
+ (let-values (((header71_0)
+ header_9)
+ ((temp72_1)
+ (compile-context-self
+ cctx_11))
+ ((phase73_0)
+ phase_94)
+ ((binding-sym74_0)
+ binding-sym_1)
+ ((temp75_0)
+ #f)
+ ((temp76_0)
+ #t))
+ (register-required-variable-use!.1
+ temp76_0
+ header71_0
+ temp72_1
+ phase73_0
+ binding-sym74_0
+ temp75_0))
+ fold-var_356)))
+ (values
+ fold-var_358))))
+ (if (not
+ #f)
+ (for-loop_294
+ fold-var_357
+ rest_156)
+ fold-var_357)))
+ fold-var_356)))))
+ for-loop_294)
+ fold-var_354
+ lst_320))))))))
+ (let-values (((rhs_1)
+ (compile$2
+ (parsed-define-values-rhs
body_3)
- (list
- 'define-values
- def-syms_0
- rhs_1))
- (parsed-s
- body_3)))
- (if (let-values (((or-part_226)
- (compile-context-module-self
- cctx_11)))
- (if or-part_226
- or-part_226
- (null?
- ids_6)))
- (void)
- (let-values ()
+ (let-values (((the-struct_45)
+ cctx_11))
+ (if (compile-context?
+ the-struct_45)
+ (let-values (((phase77_1)
+ phase_94)
+ ((header78_0)
+ header_9))
+ (compile-context1.1
+ (compile-context-namespace
+ the-struct_45)
+ phase77_1
+ (compile-context-self
+ the-struct_45)
+ (compile-context-module-self
+ the-struct_45)
+ (compile-context-full-module-name
+ the-struct_45)
+ (compile-context-lazy-syntax-literals?
+ the-struct_45)
+ header78_0))
+ (raise-argument-error
+ 'struct-copy
+ "compile-context?"
+ the-struct_45)))
+ (if (=
+ (length
+ ids_6)
+ 1)
+ (car
+ ids_6)
+ #f))))
+ (begin
+ (definition-callback_0)
+ (compiled-expression-callback_0
+ rhs_1
+ (length
+ def-syms_0)
+ phase_94
+ (as-required?_0
+ header_9))
+ (add-body!_0
+ phase_94
+ (propagate-inline-property
+ (correlate*
+ (parsed-s
+ body_3)
+ (list
+ 'define-values
+ def-syms_0
+ rhs_1))
+ (parsed-s
+ body_3)))
+ (if (let-values (((or-part_372)
+ (compile-context-module-self
+ cctx_11)))
+ (if or-part_372
+ or-part_372
+ (null?
+ ids_6)))
+ (void)
+ (begin
+ (add-body!_0
+ phase_94
+ (list*
+ 'if
+ #f
+ (list*
+ 'begin
+ (reverse$1
+ (let-values (((fold-var_359)
+ (let-values (((fold-var_360)
+ null))
+ fold-var_360)))
+ (let-values (((lst_322)
+ def-syms_0))
(begin
- (add-body!_0
- phase_81
- (list*
- 'if
- #f
- (list*
- 'begin
- (reverse$1
- (let-values (((lst_11)
- def-syms_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_11)))
- ((letrec-values (((for-loop_9)
- (lambda (fold-var_206
- lst_12)
- (begin
- 'for-loop
- (if (pair?
- lst_12)
- (let-values (((def-sym_2)
- (unsafe-car
- lst_12))
- ((rest_2)
- (unsafe-cdr
- lst_12)))
- (let-values (((fold-var_218)
- (let-values (((fold-var_219)
- fold-var_206))
- (let-values (((fold-var_183)
- (let-values ()
- (cons
- (let-values ()
- (list*
- 'set!
- def-sym_2
- '(#f)))
- fold-var_219))))
- (values
- fold-var_183)))))
- (if (not
- #f)
- (for-loop_9
- fold-var_218
- rest_2)
- fold-var_218)))
- fold-var_206)))))
- for-loop_9)
- null
- lst_11)))))
- '((void))))
- (add-body!_0
- phase_81
- (compile-top-level-bind
- ids_6
- binding-syms_0
- (let-values (((the-struct_45)
- cctx_11))
- (if (compile-context?
- the-struct_45)
- (let-values (((phase73_0)
- phase_81)
- ((header74_0)
- header_9))
- (compile-context1.1
- (compile-context-namespace
- the-struct_45)
- phase73_0
- (compile-context-self
- the-struct_45)
- (compile-context-module-self
- the-struct_45)
- (compile-context-full-module-name
- the-struct_45)
- (compile-context-lazy-syntax-literals?
- the-struct_45)
- header74_0))
- (raise-argument-error
- 'struct-copy
- "compile-context?"
- the-struct_45)))
- #f)))))))))))
- (if (parsed-define-syntaxes?
- body_3)
- (let-values ()
- (let-values (((ids_7)
- (parsed-define-syntaxes-ids
- body_3)))
- (let-values (((binding-syms_1)
- (parsed-define-syntaxes-syms
- body_3)))
- (let-values (((next-header_0)
- (find-or-create-header!_0
- (add1
- phase_81))))
- (let-values (((gen-syms_0)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_322))
+ ((letrec-values (((for-loop_295)
+ (lambda (fold-var_361
+ lst_323)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_323)
+ (let-values (((def-sym_2)
+ (unsafe-car
+ lst_323))
+ ((rest_157)
+ (unsafe-cdr
+ lst_323)))
+ (let-values (((fold-var_362)
+ (let-values (((fold-var_363)
+ (cons
+ (list*
+ 'set!
+ def-sym_2
+ '(#f))
+ fold-var_361)))
+ (values
+ fold-var_363))))
+ (if (not
+ #f)
+ (for-loop_295
+ fold-var_362
+ rest_157)
+ fold-var_362)))
+ fold-var_361)))))
+ for-loop_295)
+ fold-var_359
+ lst_322))))))
+ '((void))))
+ (add-body!_0
+ phase_94
+ (compile-top-level-bind
+ ids_6
+ binding-syms_0
+ (let-values (((the-struct_46)
+ cctx_11))
+ (if (compile-context?
+ the-struct_46)
+ (let-values (((phase79_0)
+ phase_94)
+ ((header80_0)
+ header_9))
+ (compile-context1.1
+ (compile-context-namespace
+ the-struct_46)
+ phase79_0
+ (compile-context-self
+ the-struct_46)
+ (compile-context-module-self
+ the-struct_46)
+ (compile-context-full-module-name
+ the-struct_46)
+ (compile-context-lazy-syntax-literals?
+ the-struct_46)
+ header80_0))
+ (raise-argument-error
+ 'struct-copy
+ "compile-context?"
+ the-struct_46)))
+ #f)))))))))
+ (if (parsed-define-syntaxes?
+ body_3)
+ (let-values (((ids_7)
+ (parsed-define-syntaxes-ids
+ body_3)))
+ (let-values (((binding-syms_1)
+ (parsed-define-syntaxes-syms
+ body_3)))
+ (let-values (((next-header_0)
+ (find-or-create-header!_0
+ (add1
+ phase_94))))
+ (let-values (((gen-syms_0)
+ (reverse$1
+ (let-values (((fold-var_364)
+ (let-values (((fold-var_365)
+ null))
+ fold-var_365)))
+ (let-values (((lst_324)
+ binding-syms_1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_324))
+ ((letrec-values (((for-loop_296)
+ (lambda (fold-var_366
+ lst_325)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_325)
+ (let-values (((binding-sym_2)
+ (unsafe-car
+ lst_325))
+ ((rest_158)
+ (unsafe-cdr
+ lst_325)))
+ (let-values (((fold-var_367)
+ (let-values (((fold-var_368)
+ (cons
+ (let-values (((gen-sym_0)
+ (select-fresh
+ binding-sym_2
+ next-header_0)))
+ (begin
+ (register-as-defined!
+ next-header_0
+ gen-sym_0)
+ gen-sym_0))
+ fold-var_366)))
+ (values
+ fold-var_368))))
+ (if (not
+ #f)
+ (for-loop_296
+ fold-var_367
+ rest_158)
+ fold-var_367)))
+ fold-var_366)))))
+ for-loop_296)
+ fold-var_364
+ lst_324)))))))
+ (let-values (((rhs_2)
+ (compile$2
+ (parsed-define-syntaxes-rhs
+ body_3)
+ (let-values (((the-struct_47)
+ cctx_11))
+ (if (compile-context?
+ the-struct_47)
+ (let-values (((phase81_0)
+ (add1
+ phase_94))
+ ((header82_0)
+ next-header_0))
+ (compile-context1.1
+ (compile-context-namespace
+ the-struct_47)
+ phase81_0
+ (compile-context-self
+ the-struct_47)
+ (compile-context-module-self
+ the-struct_47)
+ (compile-context-full-module-name
+ the-struct_47)
+ (compile-context-lazy-syntax-literals?
+ the-struct_47)
+ header82_0))
+ (raise-argument-error
+ 'struct-copy
+ "compile-context?"
+ the-struct_47))))))
+ (let-values ((()
+ (begin
+ (definition-callback_0)
+ (values))))
+ (let-values ((()
+ (begin
+ (compiled-expression-callback_0
+ rhs_2
+ (length
+ gen-syms_0)
+ (add1
+ phase_94)
+ (as-required?_0
+ header_9))
+ (values))))
+ (let-values (((transformer-set!s_0)
(reverse$1
- (let-values (((lst_176)
- binding-syms_1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
+ (let-values (((fold-var_369)
+ (let-values (((fold-var_370)
+ null))
+ fold-var_370)))
+ (let-values (((lst_326)
+ binding-syms_1)
+ ((lst_327)
+ gen-syms_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
(check-list
- lst_176)))
- ((letrec-values (((for-loop_121)
- (lambda (fold-var_188
- lst_177)
- (begin
- 'for-loop
- (if (pair?
- lst_177)
- (let-values (((binding-sym_2)
- (unsafe-car
- lst_177))
- ((rest_89)
- (unsafe-cdr
- lst_177)))
- (let-values (((fold-var_189)
- (let-values (((fold-var_131)
- fold-var_188))
- (let-values (((fold-var_113)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((gen-sym_0)
- (select-fresh
- binding-sym_2
- next-header_0)))
- (begin
- (register-as-defined!
- next-header_0
- gen-sym_0)
- gen-sym_0)))
- fold-var_131))))
+ lst_326))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_327))
+ ((letrec-values (((for-loop_297)
+ (lambda (fold-var_371
+ lst_328
+ lst_329)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_328)
+ (pair?
+ lst_329)
+ #f)
+ (let-values (((binding-sym_3)
+ (unsafe-car
+ lst_328))
+ ((rest_159)
+ (unsafe-cdr
+ lst_328))
+ ((gen-sym_1)
+ (unsafe-car
+ lst_329))
+ ((rest_160)
+ (unsafe-cdr
+ lst_329)))
+ (let-values (((fold-var_372)
+ (let-values (((fold-var_373)
+ (cons
+ (list
+ set-transformer!-id
+ (list
+ 'quote
+ binding-sym_3)
+ gen-sym_1)
+ fold-var_371)))
(values
- fold-var_113)))))
- (if (not
- #f)
- (for-loop_121
- fold-var_189
- rest_89)
- fold-var_189)))
- fold-var_188)))))
- for-loop_121)
- null
- lst_176))))))
- (let-values (((rhs_2)
- (compile$2
- (parsed-define-syntaxes-rhs
- body_3)
- (let-values (((the-struct_46)
- cctx_11))
- (if (compile-context?
- the-struct_46)
- (let-values (((phase75_0)
- (add1
- phase_81))
- ((header76_0)
- next-header_0))
- (compile-context1.1
- (compile-context-namespace
- the-struct_46)
- phase75_0
- (compile-context-self
- the-struct_46)
- (compile-context-module-self
- the-struct_46)
- (compile-context-full-module-name
- the-struct_46)
- (compile-context-lazy-syntax-literals?
- the-struct_46)
- header76_0))
- (raise-argument-error
- 'struct-copy
- "compile-context?"
- the-struct_46))))))
- (let-values ((()
- (begin
- (definition-callback_0)
- (values))))
- (let-values ((()
- (begin
- (compiled-expression-callback_0
- rhs_2
- (length
- gen-syms_0)
- (add1
- phase_81)
- (as-required?_0
- header_9))
- (values))))
- (let-values (((transformer-set!s_0)
- (reverse$1
- (let-values (((lst_179)
- binding-syms_1)
- ((lst_209)
- gen-syms_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_179)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_209)))
- ((letrec-values (((for-loop_221)
- (lambda (fold-var_220
- lst_210
- lst_211)
- (begin
- 'for-loop
- (if (if (pair?
- lst_210)
- (pair?
- lst_211)
- #f)
- (let-values (((binding-sym_3)
- (unsafe-car
- lst_210))
- ((rest_110)
- (unsafe-cdr
- lst_210))
- ((gen-sym_1)
- (unsafe-car
- lst_211))
- ((rest_111)
- (unsafe-cdr
- lst_211)))
- (let-values (((fold-var_221)
- (let-values (((fold-var_222)
- fold-var_220))
- (let-values (((fold-var_223)
- (let-values ()
- (cons
- (let-values ()
- (list
- set-transformer!-id
- (list
- 'quote
- binding-sym_3)
- gen-sym_1))
- fold-var_222))))
- (values
- fold-var_223)))))
- (if (not
- #f)
- (for-loop_221
- fold-var_221
- rest_110
- rest_111)
- fold-var_221)))
- fold-var_220)))))
- for-loop_221)
- null
- lst_179
- lst_209))))))
- (begin
- (if (compile-context-module-self
- cctx_11)
- (let-values ()
- (add-body!_0
- (add1
- phase_81)
- (list
- 'let-values
- (list
- (list
- gen-syms_0
- rhs_2))
- (list*
- 'begin
- (qq-append
- transformer-set!s_0
- '((void)))))))
- (let-values ()
- (add-body!_0
- (add1
- phase_81)
- (generate-top-level-define-syntaxes
- gen-syms_0
- rhs_2
- transformer-set!s_0
- (compile-top-level-bind
- ids_7
- binding-syms_1
- (let-values (((the-struct_47)
- cctx_11))
- (if (compile-context?
- the-struct_47)
- (let-values (((phase77_1)
- phase_81)
- ((header78_0)
- header_9))
- (compile-context1.1
- (compile-context-namespace
- the-struct_47)
- phase77_1
- (compile-context-self
- the-struct_47)
- (compile-context-module-self
- the-struct_47)
- (compile-context-full-module-name
- the-struct_47)
- (compile-context-lazy-syntax-literals?
- the-struct_47)
- header78_0))
- (raise-argument-error
- 'struct-copy
- "compile-context?"
- the-struct_47)))
- gen-syms_0)))))
- (set! saw-define-syntaxes?_0
- #t)))))))))))
- (if (parsed-begin-for-syntax?
- body_3)
- (let-values ()
- (loop!_1
- (parsed-begin-for-syntax-body
- body_3)
- (add1
- phase_81)
- (find-or-create-header!_0
- (add1
- phase_81))))
- (if (let-values (((or-part_227)
- (parsed-#%declare?
- body_3)))
- (if or-part_227
- or-part_227
- (let-values (((or-part_67)
- (parsed-module?
- body_3)))
- (if or-part_67
- or-part_67
- (parsed-require?
- body_3)))))
- (let-values ()
- (let-values (((e_45)
- (other-form-callback_0
- body_3
- (let-values (((the-struct_48)
- cctx_11))
- (if (compile-context?
- the-struct_48)
- (let-values (((phase79_0)
- phase_81)
- ((header80_0)
- header_9))
- (compile-context1.1
- (compile-context-namespace
- the-struct_48)
- phase79_0
- (compile-context-self
- the-struct_48)
- (compile-context-module-self
- the-struct_48)
- (compile-context-full-module-name
- the-struct_48)
- (compile-context-lazy-syntax-literals?
- the-struct_48)
- header80_0))
- (raise-argument-error
- 'struct-copy
- "compile-context?"
- the-struct_48))))))
- (if e_45
- (let-values ()
- (begin
- (compiled-expression-callback_0
- e_45
- #f
- phase_81
- (as-required?_0
- header_9))
+ fold-var_373))))
+ (if (not
+ #f)
+ (for-loop_297
+ fold-var_372
+ rest_159
+ rest_160)
+ fold-var_372)))
+ fold-var_371)))))
+ for-loop_297)
+ fold-var_369
+ lst_326
+ lst_327)))))))
+ (begin
+ (if (compile-context-module-self
+ cctx_11)
(add-body!_0
- phase_81
- e_45)))
- (void))))
- (let-values ()
- (let-values (((e_46)
- (compile$2
- body_3
- (let-values (((the-struct_39)
- cctx_11))
- (if (compile-context?
- the-struct_39)
- (let-values (((phase81_0)
- phase_81)
- ((header82_0)
- header_9))
- (compile-context1.1
- (compile-context-namespace
- the-struct_39)
- phase81_0
- (compile-context-self
- the-struct_39)
- (compile-context-module-self
- the-struct_39)
- (compile-context-full-module-name
- the-struct_39)
- (compile-context-lazy-syntax-literals?
- the-struct_39)
- header82_0))
- (raise-argument-error
- 'struct-copy
- "compile-context?"
- the-struct_39)))
- #f
- (=
- i_166
- last-i_0))))
- (begin
- (compiled-expression-callback_0
- e_46
- #f
- phase_81
- (as-required?_0
- header_9))
- (add-body!_0
- phase_81
- e_46)))))))))
- (values)))))
- (values)))))
+ (add1
+ phase_94)
+ (list
+ 'let-values
+ (list
+ (list
+ gen-syms_0
+ rhs_2))
+ (list*
+ 'begin
+ (qq-append
+ transformer-set!s_0
+ '((void))))))
+ (add-body!_0
+ (add1
+ phase_94)
+ (generate-top-level-define-syntaxes
+ gen-syms_0
+ rhs_2
+ transformer-set!s_0
+ (compile-top-level-bind
+ ids_7
+ binding-syms_1
+ (let-values (((the-struct_48)
+ cctx_11))
+ (if (compile-context?
+ the-struct_48)
+ (let-values (((phase83_1)
+ phase_94)
+ ((header84_0)
+ header_9))
+ (compile-context1.1
+ (compile-context-namespace
+ the-struct_48)
+ phase83_1
+ (compile-context-self
+ the-struct_48)
+ (compile-context-module-self
+ the-struct_48)
+ (compile-context-full-module-name
+ the-struct_48)
+ (compile-context-lazy-syntax-literals?
+ the-struct_48)
+ header84_0))
+ (raise-argument-error
+ 'struct-copy
+ "compile-context?"
+ the-struct_48)))
+ gen-syms_0))))
+ (set! saw-define-syntaxes?_0
+ #t))))))))))
+ (if (parsed-begin-for-syntax?
+ body_3)
+ (loop!_1
+ (parsed-begin-for-syntax-body
+ body_3)
+ (add1
+ phase_94)
+ (find-or-create-header!_0
+ (add1
+ phase_94)))
+ (if (let-values (((or-part_373)
+ (parsed-#%declare?
+ body_3)))
+ (if or-part_373
+ or-part_373
+ (let-values (((or-part_374)
+ (parsed-module?
+ body_3)))
+ (if or-part_374
+ or-part_374
+ (parsed-require?
+ body_3)))))
+ (let-values (((e_49)
+ (other-form-callback_0
+ body_3
+ (let-values (((the-struct_49)
+ cctx_11))
+ (if (compile-context?
+ the-struct_49)
+ (let-values (((phase85_0)
+ phase_94)
+ ((header86_0)
+ header_9))
+ (compile-context1.1
+ (compile-context-namespace
+ the-struct_49)
+ phase85_0
+ (compile-context-self
+ the-struct_49)
+ (compile-context-module-self
+ the-struct_49)
+ (compile-context-full-module-name
+ the-struct_49)
+ (compile-context-lazy-syntax-literals?
+ the-struct_49)
+ header86_0))
+ (raise-argument-error
+ 'struct-copy
+ "compile-context?"
+ the-struct_49))))))
+ (if e_49
+ (begin
+ (compiled-expression-callback_0
+ e_49
+ #f
+ phase_94
+ (as-required?_0
+ header_9))
+ (add-body!_0
+ phase_94
+ e_49))
+ (void)))
+ (let-values (((e_50)
+ (compile$2
+ body_3
+ (let-values (((the-struct_50)
+ cctx_11))
+ (if (compile-context?
+ the-struct_50)
+ (let-values (((phase87_0)
+ phase_94)
+ ((header88_0)
+ header_9))
+ (compile-context1.1
+ (compile-context-namespace
+ the-struct_50)
+ phase87_0
+ (compile-context-self
+ the-struct_50)
+ (compile-context-module-self
+ the-struct_50)
+ (compile-context-full-module-name
+ the-struct_50)
+ (compile-context-lazy-syntax-literals?
+ the-struct_50)
+ header88_0))
+ (raise-argument-error
+ 'struct-copy
+ "compile-context?"
+ the-struct_50)))
+ #f
+ (=
+ i_231
+ last-i_0))))
+ (begin
+ (compiled-expression-callback_0
+ e_50
+ #f
+ phase_94
+ (as-required?_0
+ header_9))
+ (add-body!_0
+ phase_94
+ e_50)))))))
+ (values))))
+ (values))))
(if (not
#f)
- (for-loop_5
- rest_107
+ (for-loop_292
+ rest_153
(+
- pos_115
+ pos_145
1))
(values))))
(values))))))
- for-loop_5)
- lst_205
- start_45)))
+ for-loop_292)
+ lst_314
+ start_54)))
(void))))))
loop!_1)
bodys_2
- phase_76
+ phase_89
(find-or-create-header!_0
- phase_76))
+ phase_89))
(values))))
(let-values (((encoded-root-expand-pos_0)
(if encoded-root-expand-ctx-box_0
@@ -35044,433 +35187,441 @@
(if (not
saw-define-syntaxes?_0)
(syntax-literals-empty?
- syntax-literals_1)
+ syntax-literals_2)
#f)
#f))
(add-syntax-literal!
- syntax-literals_1
+ syntax-literals_2
(unbox
encoded-root-expand-ctx-box_0))
#f)
#f)
#f)))
- (let-values (((phases-in-order_2)
- (let-values (((temp83_0)
+ (let-values (((phases-in-order_3)
+ (let-values (((temp89_1)
(hash-keys
phase-to-body_0))
- ((<84_0) <))
+ ((<90_0) <))
(sort.1
#f
#f
- temp83_0
- <84_0))))
+ temp89_1
+ <90_0))))
(let-values (((min-phase_0)
(if (pair?
- phases-in-order_2)
- (car phases-in-order_2)
- phase_76)))
+ phases-in-order_3)
+ (car phases-in-order_3)
+ phase_89)))
(let-values (((max-phase_0)
(if (pair?
- phases-in-order_2)
+ phases-in-order_3)
(car
(reverse$1
- phases-in-order_2))
- phase_76)))
+ phases-in-order_3))
+ phase_89)))
(let-values (((phase-to-link-info_0)
- (let-values (((lst_212)
- phases-in-order_2))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_212)))
- ((letrec-values (((for-loop_222)
- (lambda (table_155
- lst_36)
- (begin
- 'for-loop
- (if (pair?
- lst_36)
- (let-values (((phase_82)
- (unsafe-car
- lst_36))
- ((rest_112)
- (unsafe-cdr
- lst_36)))
- (let-values (((table_156)
- (let-values (((table_157)
- table_155))
- (let-values (((table_158)
- (let-values ()
- (let-values (((key_64
- val_47)
- (let-values ()
- (let-values (((header_10)
- (hash-ref
- phase-to-header_0
- phase_82
- #f)))
- (let-values (((link-module-uses_0
- imports_2
- extra-inspectorsss_1
- def-decls_0)
- (generate-links+imports
- header_10
- phase_82
- cctx_11
- optimize-linklet?_0)))
- (values
- phase_82
- (link-info1.1
- link-module-uses_0
- imports_2
- extra-inspectorsss_1
- def-decls_0)))))))
- (hash-set
- table_157
- key_64
- val_47)))))
- (values
- table_158)))))
- (if (not
- #f)
- (for-loop_222
- table_156
- rest_112)
- table_156)))
- table_155)))))
- for-loop_222)
- '#hash()
- lst_212)))))
- (let-values (((body-linklets+module-use*s_0)
- (let-values (((lst_213)
- phases-in-order_2))
+ (let-values (((table_184)
+ (let-values (((table_185)
+ '#hash()))
+ table_185)))
+ (let-values (((lst_330)
+ phases-in-order_3))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-list
- lst_213)))
- ((letrec-values (((for-loop_223)
- (lambda (table_159
- lst_214)
+ (check-list
+ lst_330))
+ ((letrec-values (((for-loop_298)
+ (lambda (table_186
+ lst_331)
(begin
'for-loop
(if (pair?
- lst_214)
- (let-values (((phase_83)
+ lst_331)
+ (let-values (((phase_95)
(unsafe-car
- lst_214))
- ((rest_113)
+ lst_331))
+ ((rest_161)
(unsafe-cdr
- lst_214)))
- (let-values (((table_160)
- (let-values (((table_161)
- table_159))
- (let-values (((table_162)
- (let-values ()
- (let-values (((key_7
- val_48)
- (let-values ()
- (let-values (((bodys_5)
- (hash-ref
- phase-to-body_0
- phase_83)))
- (let-values (((li_0)
- (hash-ref
- phase-to-link-info_0
- phase_83)))
- (let-values (((binding-sym-to-define-sym_0)
- (header-binding-sym-to-define-sym
- (hash-ref
- phase-to-header_0
- phase_83))))
- (let-values (((module-use*s_0)
- (module-uses-add-extra-inspectorsss
- (link-info-link-module-uses
- li_0)
- (link-info-extra-inspectorsss
- li_0))))
- (let-values (((body-linklet_0)
- (list*
- 'linklet
- (qq-append
- body-imports_0
- (link-info-imports
- li_0))
- (qq-append
- (link-info-def-decls
- li_0)
- (reverse$1
- (let-values (((lst_215)
- (header-binding-syms-in-order
- (hash-ref
- phase-to-header_0
- phase_83))))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_215)))
- ((letrec-values (((for-loop_224)
- (lambda (fold-var_224
- lst_216)
- (begin
- 'for-loop
- (if (pair?
- lst_216)
- (let-values (((binding-sym_4)
- (unsafe-car
- lst_216))
- ((rest_114)
- (unsafe-cdr
- lst_216)))
- (let-values (((fold-var_225)
- (let-values (((fold-var_226)
- fold-var_224))
- (let-values (((fold-var_227)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((def-sym_3)
- (hash-ref
- binding-sym-to-define-sym_0
- binding-sym_4)))
- (if (eq?
- def-sym_3
- binding-sym_4)
- def-sym_3
- (list
- def-sym_3
- binding-sym_4))))
- fold-var_226))))
- (values
- fold-var_227)))))
- (if (not
- #f)
- (for-loop_224
- fold-var_225
- rest_114)
- fold-var_225)))
- fold-var_224)))))
- for-loop_224)
- null
- lst_215)))))
- (qq-append
- (reverse$1
- bodys_5)
- body-suffix-forms_0))))
- (let-values (((linklet_1
- new-module-use*s_0)
- (if to-correlated-linklet?_2
- (let-values ()
- (values
- (make-correlated-linklet
- body-linklet_0
- 'module)
- module-use*s_0))
- (let-values ()
- (let-values (((body-linklet85_0)
- body-linklet_0)
- ((body-imports86_0)
- body-imports_0)
- ((body-import-instances87_0)
- body-import-instances_0)
- ((get-module-linklet-info88_0)
- get-module-linklet-info_0)
- ((serializable?89_0)
- serializable?_0)
- ((module-prompt?90_0)
- module-prompt?_0)
- ((module-use*s91_0)
- module-use*s_0)
- ((optimize-linklet?92_0)
- optimize-linklet?_0)
- ((temp93_0)
- (if unsafe?-box_0
- (unbox
- unsafe?-box_0)
- #f))
- ((temp94_0)
- #f)
- ((temp95_0)
- (compile-context-namespace
- cctx_11))
- ((realm96_0)
- realm_1))
- (compile-module-linklet.1
- body-import-instances87_0
- body-imports86_0
- unsafe-undefined
- get-module-linklet-info88_0
- temp94_0
- module-prompt?90_0
- module-use*s91_0
- temp95_0
- optimize-linklet?92_0
- realm96_0
- serializable?89_0
- temp93_0
- body-linklet85_0))))))
- (values
- phase_83
- (cons
- linklet_1
- new-module-use*s_0)))))))))))
- (hash-set
- table_161
- key_7
- val_48)))))
- (values
- table_162)))))
+ lst_331)))
+ (let-values (((table_187)
+ (let-values (((table_188)
+ (let-values (((key_67
+ val_49)
+ (let-values (((header_10)
+ (hash-ref
+ phase-to-header_0
+ phase_95
+ #f)))
+ (let-values (((link-module-uses_0
+ imports_2
+ extra-inspectorsss_2
+ def-decls_0)
+ (generate-links+imports
+ header_10
+ phase_95
+ cctx_11
+ optimize-linklet?_0)))
+ (values
+ phase_95
+ (link-info1.1
+ link-module-uses_0
+ imports_2
+ extra-inspectorsss_2
+ def-decls_0))))))
+ (hash-set
+ table_186
+ key_67
+ val_49))))
+ (values
+ table_188))))
(if (not
#f)
- (for-loop_223
- table_160
- rest_113)
- table_160)))
- table_159)))))
- for-loop_223)
- '#hasheq()
- lst_213)))))
- (let-values (((body-linklets_0)
- (let-values (((ht_132)
- body-linklets+module-use*s_0))
+ (for-loop_298
+ table_187
+ rest_161)
+ table_187)))
+ table_186)))))
+ for-loop_298)
+ table_184
+ lst_330))))))
+ (let-values (((body-linklets+module-use*s_0)
+ (let-values (((table_189)
+ (let-values (((table_190)
+ '#hasheq()))
+ table_190)))
+ (let-values (((lst_332)
+ phases-in-order_3))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-in-hash
- ht_132)))
- ((letrec-values (((for-loop_225)
- (lambda (table_25
- i_167)
+ (check-list
+ lst_332))
+ ((letrec-values (((for-loop_299)
+ (lambda (table_191
+ lst_333)
(begin
'for-loop
- (if i_167
- (let-values (((phase_84
- l+mu*s_0)
- (hash-iterate-key+value
- ht_132
- i_167)))
- (let-values (((table_163)
- (let-values (((table_164)
- table_25))
- (let-values (((table_37)
- (let-values ()
- (let-values (((key_65
- val_49)
- (let-values ()
- (values
- phase_84
- (car
- l+mu*s_0)))))
- (hash-set
- table_164
- key_65
- val_49)))))
- (values
- table_37)))))
+ (if (pair?
+ lst_333)
+ (let-values (((phase_96)
+ (unsafe-car
+ lst_333))
+ ((rest_162)
+ (unsafe-cdr
+ lst_333)))
+ (let-values (((table_192)
+ (let-values (((table_193)
+ (let-values (((key_68
+ val_50)
+ (let-values (((bodys_5)
+ (hash-ref
+ phase-to-body_0
+ phase_96)))
+ (let-values (((li_0)
+ (hash-ref
+ phase-to-link-info_0
+ phase_96)))
+ (let-values (((binding-sym-to-define-sym_0)
+ (header-binding-sym-to-define-sym
+ (hash-ref
+ phase-to-header_0
+ phase_96))))
+ (let-values (((module-use*s_0)
+ (module-uses-add-extra-inspectorsss
+ (link-info-link-module-uses
+ li_0)
+ (link-info-extra-inspectorsss
+ li_0))))
+ (let-values (((body-linklet_0)
+ (list*
+ 'linklet
+ (qq-append
+ body-imports_0
+ (link-info-imports
+ li_0))
+ (qq-append
+ (link-info-def-decls
+ li_0)
+ (reverse$1
+ (let-values (((fold-var_374)
+ (let-values (((fold-var_375)
+ null))
+ fold-var_375)))
+ (let-values (((lst_334)
+ (header-binding-syms-in-order
+ (hash-ref
+ phase-to-header_0
+ phase_96))))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_334))
+ ((letrec-values (((for-loop_300)
+ (lambda (fold-var_376
+ lst_335)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_335)
+ (let-values (((binding-sym_4)
+ (unsafe-car
+ lst_335))
+ ((rest_163)
+ (unsafe-cdr
+ lst_335)))
+ (let-values (((fold-var_377)
+ (let-values (((fold-var_378)
+ (cons
+ (let-values (((def-sym_3)
+ (hash-ref
+ binding-sym-to-define-sym_0
+ binding-sym_4)))
+ (if (eq?
+ def-sym_3
+ binding-sym_4)
+ def-sym_3
+ (list
+ def-sym_3
+ binding-sym_4)))
+ fold-var_376)))
+ (values
+ fold-var_378))))
+ (if (not
+ #f)
+ (for-loop_300
+ fold-var_377
+ rest_163)
+ fold-var_377)))
+ fold-var_376)))))
+ for-loop_300)
+ fold-var_374
+ lst_334))))))
+ (qq-append
+ (reverse$1
+ bodys_5)
+ body-suffix-forms_0))))
+ (let-values (((linklet_2
+ new-module-use*s_0)
+ (if to-correlated-linklet?_2
+ (values
+ (make-correlated-linklet
+ body-linklet_0
+ 'module)
+ module-use*s_0)
+ (let-values (((body-linklet91_0)
+ body-linklet_0)
+ ((temp92_0)
+ (hasheq
+ 'module
+ (compile-context-full-module-name
+ cctx_11)
+ 'phase
+ phase_96))
+ ((body-imports93_0)
+ body-imports_0)
+ ((body-import-instances94_0)
+ body-import-instances_0)
+ ((get-module-linklet-info95_0)
+ get-module-linklet-info_0)
+ ((serializable?96_0)
+ serializable?_0)
+ ((module-prompt?97_0)
+ module-prompt?_0)
+ ((temp98_1)
+ (if unlimited-compile?-box_0
+ (unbox
+ unlimited-compile?-box_0)
+ #f))
+ ((module-use*s99_0)
+ module-use*s_0)
+ ((optimize-linklet?100_0)
+ optimize-linklet?_0)
+ ((temp101_1)
+ (if unsafe?-box_0
+ (unbox
+ unsafe?-box_0)
+ #f))
+ ((temp102_1)
+ #f)
+ ((temp103_1)
+ (compile-context-namespace
+ cctx_11))
+ ((realm104_0)
+ realm_1))
+ (compile-module-linklet.1
+ body-import-instances94_0
+ body-imports93_0
+ temp92_0
+ unsafe-undefined
+ get-module-linklet-info95_0
+ temp102_1
+ module-prompt?97_0
+ module-use*s99_0
+ temp103_1
+ optimize-linklet?100_0
+ realm104_0
+ serializable?96_0
+ temp98_1
+ temp101_1
+ body-linklet91_0)))))
+ (values
+ phase_96
+ (cons
+ linklet_2
+ new-module-use*s_0))))))))))
+ (hash-set
+ table_191
+ key_68
+ val_50))))
+ (values
+ table_193))))
(if (not
#f)
- (for-loop_225
- table_163
- (hash-iterate-next
- ht_132
- i_167))
- table_163)))
- table_25)))))
- for-loop_225)
- '#hasheq()
- (hash-iterate-first
- ht_132))))))
- (let-values (((phase-to-link-module-uses_1)
- (let-values (((ht_133)
+ (for-loop_299
+ table_192
+ rest_162)
+ table_192)))
+ table_191)))))
+ for-loop_299)
+ table_189
+ lst_332))))))
+ (let-values (((body-linklets_0)
+ (let-values (((table_194)
+ (let-values (((table_195)
+ '#hasheq()))
+ table_195)))
+ (let-values (((ht_165)
body-linklets+module-use*s_0))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-in-hash
- ht_133)))
- ((letrec-values (((for-loop_226)
- (lambda (table_41
- i_168)
+ (check-in-hash
+ ht_165))
+ ((letrec-values (((for-loop_301)
+ (lambda (table_196
+ i_232)
(begin
'for-loop
- (if i_168
- (let-values (((phase_85
- l+mu*s_1)
+ (if i_232
+ (let-values (((phase_97
+ l+mu*s_0)
(hash-iterate-key+value
- ht_133
- i_168)))
- (let-values (((table_165)
- (let-values (((table_166)
- table_41))
- (let-values (((table_167)
- (let-values ()
- (let-values (((key_66
- val_50)
- (let-values ()
- (values
- phase_85
- (module-uses-strip-extra-inspectorsss
- (cdr
- l+mu*s_1))))))
- (hash-set
- table_166
- key_66
- val_50)))))
- (values
- table_167)))))
+ ht_165
+ i_232)))
+ (let-values (((table_197)
+ (let-values (((table_198)
+ (let-values (((key_69
+ val_51)
+ (values
+ phase_97
+ (car
+ l+mu*s_0))))
+ (hash-set
+ table_196
+ key_69
+ val_51))))
+ (values
+ table_198))))
(if (not
#f)
- (for-loop_226
- table_165
+ (for-loop_301
+ table_197
(hash-iterate-next
- ht_133
- i_168))
- table_165)))
- table_41)))))
- for-loop_226)
- '#hasheq()
+ ht_165
+ i_232))
+ table_197)))
+ table_196)))))
+ for-loop_301)
+ table_194
(hash-iterate-first
- ht_133))))))
+ ht_165)))))))
+ (let-values (((phase-to-link-module-uses_1)
+ (let-values (((table_199)
+ (let-values (((table_200)
+ '#hasheq()))
+ table_200)))
+ (let-values (((ht_166)
+ body-linklets+module-use*s_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash
+ ht_166))
+ ((letrec-values (((for-loop_302)
+ (lambda (table_201
+ i_233)
+ (begin
+ 'for-loop
+ (if i_233
+ (let-values (((phase_98
+ l+mu*s_1)
+ (hash-iterate-key+value
+ ht_166
+ i_233)))
+ (let-values (((table_202)
+ (let-values (((table_203)
+ (let-values (((key_70
+ val_52)
+ (values
+ phase_98
+ (module-uses-strip-extra-inspectorsss
+ (cdr
+ l+mu*s_1)))))
+ (hash-set
+ table_201
+ key_70
+ val_52))))
+ (values
+ table_203))))
+ (if (not
+ #f)
+ (for-loop_302
+ table_202
+ (hash-iterate-next
+ ht_166
+ i_233))
+ table_202)))
+ table_201)))))
+ for-loop_302)
+ table_199
+ (hash-iterate-first
+ ht_166)))))))
(let-values (((phase-to-link-module-uses-expr_1)
(serialize-phase-to-link-module-uses
phase-to-link-module-uses_1
- mpis_18)))
+ mpis_19)))
(let-values (((phase-to-link-extra-inspectorsss_0)
- (let-values (((ht_134)
- body-linklets+module-use*s_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
+ (let-values (((table_204)
+ (let-values (((table_205)
+ '#hash()))
+ table_205)))
+ (let-values (((ht_167)
+ body-linklets+module-use*s_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
(check-in-hash
- ht_134)))
- ((letrec-values (((for-loop_227)
- (lambda (table_168
- i_96)
- (begin
- 'for-loop
- (if i_96
- (let-values (((phase_86
- l+mu*s_2)
- (hash-iterate-key+value
- ht_134
- i_96)))
- (let-values (((table_169)
- (let-values (((table_170)
- table_168))
+ ht_167))
+ ((letrec-values (((for-loop_303)
+ (lambda (table_206
+ i_234)
+ (begin
+ 'for-loop
+ (if i_234
+ (let-values (((phase_99
+ l+mu*s_2)
+ (hash-iterate-key+value
+ ht_167
+ i_234)))
+ (let-values (((table_207)
(let-values (((id*_7)
(module-uses-extract-extra-inspectorsss
(cdr
@@ -35483,53 +35634,43 @@
#f)
(length
body-imports_0))))
- (begin
- #t
- ((letrec-values (((for-loop_228)
- (lambda (table_171)
- (begin
- 'for-loop
- (let-values (((extra-inspectorsss_2)
- id*_7))
- (let-values (((table_172)
- (let-values (((table_173)
- table_171))
- (let-values (((table_174)
- table_173))
- (if extra-inspectorsss_2
- (let-values (((table_175)
- table_174))
- (let-values (((table_176)
- (let-values ()
- (let-values (((key_67
- val_51)
- (let-values ()
- (values
- phase_86
- extra-inspectorsss_2))))
- (hash-set
- table_175
- key_67
- val_51)))))
- (values
- table_176)))
- table_174)))))
- table_172))))))
- for-loop_228)
- table_170))))))
- (if (not
- #f)
- (for-loop_227
- table_169
- (hash-iterate-next
- ht_134
- i_96))
- table_169)))
- table_168)))))
- for-loop_227)
- '#hash()
- (hash-iterate-first
- ht_134))))))
+ ((letrec-values (((for-loop_304)
+ (lambda (table_208)
+ (begin
+ 'for-loop
+ (let-values (((extra-inspectorsss_3)
+ id*_7))
+ (let-values (((table_209)
+ (if extra-inspectorsss_3
+ (let-values (((table_210)
+ (let-values (((key_71
+ val_53)
+ (values
+ phase_99
+ extra-inspectorsss_3)))
+ (hash-set
+ table_208
+ key_71
+ val_53))))
+ (values
+ table_210))
+ table_208)))
+ table_209))))))
+ for-loop_304)
+ table_206))))
+ (if (not
+ #f)
+ (for-loop_303
+ table_207
+ (hash-iterate-next
+ ht_167
+ i_234))
+ table_207)))
+ table_206)))))
+ for-loop_303)
+ table_204
+ (hash-iterate-first
+ ht_167)))))))
(values
body-linklets_0
min-phase_0
@@ -35537,113 +35678,103 @@
phase-to-link-module-uses_1
phase-to-link-module-uses-expr_1
phase-to-link-extra-inspectorsss_0
- syntax-literals_1
+ syntax-literals_2
encoded-root-expand-pos_0))))))))))))))))))))))))))))))))))))))))))))))))
(define-values
(compile-top-level-bind)
(lambda (ids_8 binding-syms_2 cctx_12 trans-exprs_0)
(begin
- (let-values (((phase_87) (compile-context-phase cctx_12)))
- (let-values (((self_20) (compile-context-self cctx_12)))
+ (let-values (((phase_100) (compile-context-phase cctx_12)))
+ (let-values (((self_24) (compile-context-self cctx_12)))
(let-values (((header_11) (compile-context-header cctx_12)))
- (let-values (((mpis_19) (header-module-path-indexes header_11)))
+ (let-values (((mpis_20) (header-module-path-indexes header_11)))
(let-values (((top-level-bind-scope_2)
(root-expand-context-top-level-bind-scope
(namespace-get-root-expand-ctx (compile-context-namespace cctx_12)))))
- (let-values (((self-expr_0) (add-module-path-index! mpis_19 self_20)))
+ (let-values (((self-expr_0) (add-module-path-index! mpis_20 self_24)))
(list*
'begin
(reverse$1
- (let-values (((lst_217) ids_8)
- ((lst_218) binding-syms_2)
- ((lst_219)
- (let-values (((or-part_228) trans-exprs_0))
- (if or-part_228
- or-part_228
- (reverse$1
- (let-values (((lst_61) ids_8))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_61)))
- ((letrec-values (((for-loop_81)
- (lambda (fold-var_228 lst_62)
- (begin
- 'for-loop
- (if (pair? lst_62)
- (let-values (((id_58) (unsafe-car lst_62))
- ((rest_28) (unsafe-cdr lst_62)))
- (let-values (((fold-var_229)
- (let-values (((fold-var_230)
- fold-var_228))
- (let-values (((fold-var_231)
- (let-values ()
+ (let-values (((fold-var_379) (let-values (((fold-var_380) null)) fold-var_380)))
+ (let-values (((lst_336) ids_8)
+ ((lst_337) binding-syms_2)
+ ((lst_338)
+ (let-values (((or-part_375) trans-exprs_0))
+ (if or-part_375
+ or-part_375
+ (reverse$1
+ (let-values (((fold-var_381)
+ (let-values (((fold-var_382) null)) fold-var_382)))
+ (let-values (((lst_339) ids_8))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_339))
+ ((letrec-values (((for-loop_305)
+ (lambda (fold-var_383 lst_340)
+ (begin
+ 'for-loop
+ (if (pair? lst_340)
+ (let-values (((id_66) (unsafe-car lst_340))
+ ((rest_164) (unsafe-cdr lst_340)))
+ (let-values (((fold-var_384)
+ (let-values (((fold-var_385)
(cons
- (let-values ()
- ''#f)
- fold-var_230))))
- (values fold-var_231)))))
- (if (not #f)
- (for-loop_81 fold-var_229 rest_28)
- fold-var_229)))
- fold-var_228)))))
- for-loop_81)
- null
- lst_61))))))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_217)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_218)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_219)))
- ((letrec-values (((for-loop_229)
- (lambda (fold-var_232 lst_220 lst_3 lst_221)
- (begin
- 'for-loop
- (if (if (pair? lst_220) (if (pair? lst_3) (pair? lst_221) #f) #f)
- (let-values (((id_59) (unsafe-car lst_220))
- ((rest_115) (unsafe-cdr lst_220))
- ((binding-sym_5) (unsafe-car lst_3))
- ((rest_116) (unsafe-cdr lst_3))
- ((trans-expr_0) (unsafe-car lst_221))
- ((rest_117) (unsafe-cdr lst_221)))
- (let-values (((fold-var_233)
- (let-values (((fold-var_234) fold-var_232))
- (let-values (((fold-var_235)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((id-stx_0)
- (compile-quote-syntax
- (remove-scope
- id_59
- top-level-bind-scope_2)
- cctx_12)))
- (list
- top-level-bind!-id
- id-stx_0
- self-expr_0
- phase_87
- phase-shift-id
- ns-id
- (list 'quote binding-sym_5)
- (if trans-exprs_0 #t #f)
- trans-expr_0)))
- fold-var_234))))
- (values fold-var_235)))))
- (if (not #f)
- (for-loop_229 fold-var_233 rest_115 rest_116 rest_117)
- fold-var_233)))
- fold-var_232)))))
- for-loop_229)
- null
- lst_217
- lst_218
- lst_219))))))))))))))
+ ''#f
+ fold-var_383)))
+ (values fold-var_385))))
+ (if (not #f)
+ (for-loop_305 fold-var_384 rest_164)
+ fold-var_384)))
+ fold-var_383)))))
+ for-loop_305)
+ fold-var_381
+ lst_339)))))))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_336))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_337))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_338))
+ ((letrec-values (((for-loop_306)
+ (lambda (fold-var_386 lst_341 lst_342 lst_343)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_341) (if (pair? lst_342) (pair? lst_343) #f) #f)
+ (let-values (((id_67) (unsafe-car lst_341))
+ ((rest_165) (unsafe-cdr lst_341))
+ ((binding-sym_5) (unsafe-car lst_342))
+ ((rest_166) (unsafe-cdr lst_342))
+ ((trans-expr_0) (unsafe-car lst_343))
+ ((rest_167) (unsafe-cdr lst_343)))
+ (let-values (((fold-var_387)
+ (let-values (((fold-var_388)
+ (cons
+ (let-values (((id-stx_0)
+ (compile-quote-syntax
+ (remove-scope
+ id_67
+ top-level-bind-scope_2)
+ cctx_12)))
+ (list
+ top-level-bind!-id
+ id-stx_0
+ self-expr_0
+ phase_100
+ phase-shift-id
+ ns-id
+ (list 'quote binding-sym_5)
+ (if trans-exprs_0 #t #f)
+ trans-expr_0))
+ fold-var_386)))
+ (values fold-var_388))))
+ (if (not #f)
+ (for-loop_306 fold-var_387 rest_165 rest_166 rest_167)
+ fold-var_387)))
+ fold-var_386)))))
+ for-loop_306)
+ fold-var_379
+ lst_336
+ lst_337
+ lst_338)))))))))))))))
(define-values
(generate-top-level-define-syntaxes)
(lambda (gen-syms_1 rhs_3 transformer-set!s_1 finish_3)
@@ -35668,482 +35799,461 @@
(list*
'values
(reverse$1
- (let-values (((lst_222) gen-syms_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_222)))
- ((letrec-values (((for-loop_230)
- (lambda (fold-var_236 lst_223)
- (begin
- 'for-loop
- (if (pair? lst_223)
- (let-values (((s_328) (unsafe-car lst_223))
- ((rest_118) (unsafe-cdr lst_223)))
- (let-values (((fold-var_237)
- (let-values (((fold-var_238) fold-var_236))
- (let-values (((fold-var_239)
- (let-values ()
- (cons
- (let-values () ''#f)
- fold-var_238))))
- (values fold-var_239)))))
- (if (not #f) (for-loop_230 fold-var_237 rest_118) fold-var_237)))
- fold-var_236)))))
- for-loop_230)
- null
- lst_222)))))))
+ (let-values (((fold-var_389) (let-values (((fold-var_390) null)) fold-var_390)))
+ (let-values (((lst_344) gen-syms_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_344))
+ ((letrec-values (((for-loop_307)
+ (lambda (fold-var_391 lst_345)
+ (begin
+ 'for-loop
+ (if (pair? lst_345)
+ (let-values (((s_416) (unsafe-car lst_345))
+ ((rest_168) (unsafe-cdr lst_345)))
+ (let-values (((fold-var_392)
+ (let-values (((fold-var_393) (cons ''#f fold-var_391)))
+ (values fold-var_393))))
+ (if (not #f) (for-loop_307 fold-var_392 rest_168) fold-var_392)))
+ fold-var_391)))))
+ for-loop_307)
+ fold-var_389
+ lst_344))))))))
(list* 'begin (qq-append (cdr finish_3) '((void))))))
(list 'args (list* 'let-values (list (list* gen-syms_1 '((apply values args)))) '((void)))))))))))
(define-values
(propagate-inline-property)
- (lambda (e_47 orig-s_27)
+ (lambda (e_51 orig-s_27)
(begin
- (let-values (((v_171) (syntax-property$1 orig-s_27 'compiler-hint:cross-module-inline)))
- (if v_171 (correlated-property e_47 'compiler-hint:cross-module-inline v_171) e_47)))))
+ (let-values (((v_235) (syntax-property$1 orig-s_27 'compiler-hint:cross-module-inline)))
+ (if v_235 (correlated-property e_51 'compiler-hint:cross-module-inline v_235) e_51)))))
(define-values
(compile-module-linklet.1)
- (lambda (body-import-instances40_0
- body-imports39_0
- compile-linklet38_0
- get-module-linklet-info41_0
- load-modules?47_0
- module-prompt?43_0
- module-use*s44_0
- namespace48_0
- optimize-linklet?45_0
- realm49_0
- serializable?42_0
- unsafe?46_0
- body-linklet62_0)
+ (lambda (body-import-instances43_0
+ body-imports42_0
+ body-info41_0
+ compile-linklet40_0
+ get-module-linklet-info44_0
+ load-modules?51_0
+ module-prompt?46_0
+ module-use*s48_0
+ namespace52_0
+ optimize-linklet?49_0
+ realm53_0
+ serializable?45_0
+ unlimited-compile?47_0
+ unsafe?50_0
+ body-linklet68_0)
(begin
'compile-module-linklet
- (let-values (((body-linklet_1) body-linklet62_0))
+ (let-values (((body-linklet_1) body-linklet68_0))
(let-values (((compile-linklet_0)
- (if (eq? compile-linklet38_0 unsafe-undefined) 1/compile-linklet compile-linklet38_0)))
- (let-values (((body-imports_1) body-imports39_0))
- (let-values (((body-import-instances_1) body-import-instances40_0))
- (let-values (((get-module-linklet-info_1) get-module-linklet-info41_0))
- (let-values (((serializable?_1) serializable?42_0))
- (let-values (((module-prompt?_1) module-prompt?43_0))
- (let-values (((module-use*s_1) module-use*s44_0))
- (let-values (((optimize-linklet?_1) optimize-linklet?45_0))
- (let-values (((unsafe?_0) unsafe?46_0))
- (let-values (((load-modules?_0) load-modules?47_0))
- (let-values (((namespace_2) namespace48_0))
- (let-values (((realm_2) realm49_0))
- (let-values ()
- (let-values (((linklet_2 new-module-use*s_1)
- (begin
- (if log-performance?
- (let-values () (start-performance-region 'compile '_ 'linklet))
- (void))
- (begin0
- (let-values ()
- ((lambda (l_42 name_51 keys_1 getter_0)
+ (if (eq? compile-linklet40_0 unsafe-undefined) 1/compile-linklet compile-linklet40_0)))
+ (let-values (((body-info_0) body-info41_0))
+ (let-values (((body-imports_1) body-imports42_0))
+ (let-values (((body-import-instances_1) body-import-instances43_0))
+ (let-values (((get-module-linklet-info_1) get-module-linklet-info44_0))
+ (let-values (((serializable?_1) serializable?45_0))
+ (let-values (((module-prompt?_1) module-prompt?46_0))
+ (let-values (((unlimited-compile?_0) unlimited-compile?47_0))
+ (let-values (((module-use*s_1) module-use*s48_0))
+ (let-values (((optimize-linklet?_1) optimize-linklet?49_0))
+ (let-values (((unsafe?_0) unsafe?50_0))
+ (let-values (((load-modules?_0) load-modules?51_0))
+ (let-values (((namespace_2) namespace52_0))
+ (let-values (((realm_2) realm53_0))
+ (let-values (((linklet_3 new-module-use*s_1)
+ (begin
+ (if log-performance?
+ (start-performance-region 'compile '_ 'linklet)
+ (void))
+ (begin0
+ ((lambda (l_51 info_6 keys_2 getter_0)
(with-continuation-mark
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
current-compile-realm
realm_2)
- (let-values ()
- (compile-linklet_0
- l_42
- name_51
- keys_1
- getter_0
- (let-values (((flags_0)
- (if serializable?_1
- (if module-prompt?_1
- '(serializable use-prompt)
- '(serializable))
- (if module-prompt?_1
- '(use-prompt)
- (if optimize-linklet?_1 '() '(quick))))))
- (if unsafe?_0 (cons 'unsafe flags_0) flags_0))))))
+ (compile-linklet_0
+ l_51
+ info_6
+ keys_2
+ getter_0
+ (let-values (((flags_0)
+ (if serializable?_1
+ (if module-prompt?_1
+ '(serializable use-prompt)
+ '(serializable))
+ (if module-prompt?_1
+ '(use-prompt)
+ (if optimize-linklet?_1 '() '(quick))))))
+ (let-values (((flags_1)
+ (if unsafe?_0
+ (cons 'unsafe flags_0)
+ flags_0)))
+ (let-values (((flags_2)
+ (if unlimited-compile?_0
+ (cons 'unlimited-compile flags_1)
+ flags_1)))
+ flags_2))))))
body-linklet_1
- 'module
+ (hash-set body-info_0 'name 'module)
(list->vector (append body-import-instances_1 module-use*s_1))
(make-module-use-to-linklet
optimize-linklet?_1
load-modules?_0
namespace_2
get-module-linklet-info_1
- module-use*s_1)))
- (if log-performance?
- (let-values () (end-performance-region))
- (void))))))
- (values
- linklet_2
- (list-tail
- (vector->list new-module-use*s_1)
- (length body-imports_1)))))))))))))))))))))
+ module-use*s_1))
+ (if log-performance? (end-performance-region) (void))))))
+ (values
+ linklet_3
+ (list-tail
+ (vector->list new-module-use*s_1)
+ (length body-imports_1))))))))))))))))))))))
(define-values
(make-module-use-to-linklet)
- (lambda (optimize-linklet?_2 load-modules?_1 ns_57 get-module-linklet-info_2 init-mu*s_0)
+ (lambda (optimize-linklet?_2 load-modules?_1 ns_64 get-module-linklet-info_2 init-mu*s_0)
(begin
(let-values (((mu*-intern-table_0) (make-hash)))
(let-values (((intern-module-use*_0)
(lambda (mu*_5)
(begin
'intern-module-use*
- (let-values (((mod-name_16)
+ (let-values (((mod-name_17)
(1/module-path-index-resolve (module-use-module mu*_5) load-modules?_1)))
(let-values (((existing-mu*_1)
- (hash-ref mu*-intern-table_0 (cons mod-name_16 (module-use-phase mu*_5)) #f)))
+ (hash-ref mu*-intern-table_0 (cons mod-name_17 (module-use-phase mu*_5)) #f)))
(if existing-mu*_1
- (let-values ()
- (begin (module-use-merge-extra-inspectorss! existing-mu*_1 mu*_5) existing-mu*_1))
- (let-values ()
- (begin
- (hash-set! mu*-intern-table_0 (cons mod-name_16 (module-use-phase mu*_5)) mu*_5)
- mu*_5)))))))))
+ (begin (module-use-merge-extra-inspectorss! existing-mu*_1 mu*_5) existing-mu*_1)
+ (begin
+ (hash-set! mu*-intern-table_0 (cons mod-name_17 (module-use-phase mu*_5)) mu*_5)
+ mu*_5))))))))
(begin
- (let-values (((lst_224) init-mu*s_0))
+ (let-values (((lst_346) init-mu*s_0))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_224)))
- ((letrec-values (((for-loop_231)
- (lambda (lst_225)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_346))
+ ((letrec-values (((for-loop_308)
+ (lambda (lst_347)
(begin
'for-loop
- (if (pair? lst_225)
- (let-values (((mu*_6) (unsafe-car lst_225)) ((rest_119) (unsafe-cdr lst_225)))
+ (if (pair? lst_347)
+ (let-values (((mu*_6) (unsafe-car lst_347)) ((rest_169) (unsafe-cdr lst_347)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values () (intern-module-use*_0 mu*_6))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_231 rest_119) (values))))
+ (let-values ((() (begin (intern-module-use*_0 mu*_6) (values))))
+ (values))))
+ (if (not #f) (for-loop_308 rest_169) (values))))
(values))))))
- for-loop_231)
- lst_224)))
+ for-loop_308)
+ lst_346)))
(void)
(lambda (mu*-or-instance_0)
(if (1/instance? mu*-or-instance_0)
- (let-values () (values mu*-or-instance_0 #f))
+ (values mu*-or-instance_0 #f)
(if (not optimize-linklet?_2)
- (let-values () (values #f #f))
+ (values #f #f)
(if mu*-or-instance_0
- (let-values ()
- (let-values (((mu*_7) mu*-or-instance_0))
- (let-values (((mod-name_17)
- (1/module-path-index-resolve (module-use-module mu*_7) load-modules?_1)))
- (let-values (((mli_0)
- (let-values (((or-part_229)
- (get-module-linklet-info_2 mod-name_17 (module-use-phase mu*_7))))
- (if or-part_229
- or-part_229
- (namespace->module-linklet-info
- ns_57
- mod-name_17
- (module-use-phase mu*_7))))))
- (begin
- (if mli_0
- (let-values ()
- (module-use*-declaration-inspector! mu*_7 (module-linklet-info-inspector mli_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-values (((mus_2) (module-linklet-info-module-uses mli_0))
- ((extra-inspectorsss_3)
- (module-linklet-info-extra-inspectorsss mli_0)))
- (reverse$1
- (let-values (((lst_226) mus_2)
- ((lst_227)
+ (let-values (((mu*_7) mu*-or-instance_0))
+ (let-values (((mod-name_18)
+ (1/module-path-index-resolve (module-use-module mu*_7) load-modules?_1)))
+ (let-values (((mli_0)
+ (let-values (((or-part_376)
+ (get-module-linklet-info_2 mod-name_18 (module-use-phase mu*_7))))
+ (if or-part_376
+ or-part_376
+ (namespace->module-linklet-info
+ ns_64
+ mod-name_18
+ (module-use-phase mu*_7))))))
+ (begin
+ (if mli_0
+ (module-use*-declaration-inspector! mu*_7 (module-linklet-info-inspector mli_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-values (((mus_2) (module-linklet-info-module-uses mli_0))
+ ((extra-inspectorsss_4) (module-linklet-info-extra-inspectorsss mli_0)))
+ (reverse$1
+ (let-values (((fold-var_394) (let-values (((fold-var_395) null)) fold-var_395)))
+ (let-values (((lst_348) mus_2)
+ ((lst_349)
(linklet-import-variables$1
(module-linklet-info-linklet-or-instance mli_0)))
- ((lst_228)
- (let-values (((or-part_230) extra-inspectorsss_3))
- (if or-part_230 or-part_230 mus_2))))
+ ((lst_350)
+ (let-values (((or-part_377) extra-inspectorsss_4))
+ (if or-part_377 or-part_377 mus_2))))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_226)))
+ (check-list lst_348))
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_227)))
+ (check-list lst_349))
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_228)))
- ((letrec-values (((for-loop_232)
- (lambda (fold-var_240 lst_229 lst_230 lst_231)
+ (check-list lst_350))
+ ((letrec-values (((for-loop_309)
+ (lambda (fold-var_396 lst_351 lst_352 lst_353)
(begin
'for-loop
- (if (if (pair? lst_229)
- (if (pair? lst_230) (pair? lst_231) #f)
+ (if (if (pair? lst_351)
+ (if (pair? lst_352) (pair? lst_353) #f)
#f)
- (let-values (((sub-mu_0) (unsafe-car lst_229))
- ((rest_120) (unsafe-cdr lst_229))
- ((imports_3) (unsafe-car lst_230))
- ((rest_121) (unsafe-cdr lst_230))
- ((extra-inspectorss_13)
- (unsafe-car lst_231))
- ((rest_122) (unsafe-cdr lst_231)))
- (let-values (((fold-var_241)
- (let-values (((fold-var_242)
- fold-var_240))
- (let-values (((fold-var_243)
- (let-values ()
- (cons
- (let-values ()
- (intern-module-use*_0
- (module-use+extra-inspectors
- (module-path-index-shift
- (module-use-module
- sub-mu_0)
- (module-linklet-info-self
- mli_0)
- (module-use-module
- mu*_7))
- (module-use-phase
- sub-mu_0)
- imports_3
- (module-linklet-info-inspector
- mli_0)
- (module-linklet-info-extra-inspector
- mli_0)
- (if extra-inspectorsss_3
- extra-inspectorss_13
- #f))))
- fold-var_242))))
- (values fold-var_243)))))
+ (let-values (((sub-mu_0) (unsafe-car lst_351))
+ ((rest_170) (unsafe-cdr lst_351))
+ ((imports_3) (unsafe-car lst_352))
+ ((rest_171) (unsafe-cdr lst_352))
+ ((extra-inspectorss_16)
+ (unsafe-car lst_353))
+ ((rest_172) (unsafe-cdr lst_353)))
+ (let-values (((fold-var_397)
+ (let-values (((fold-var_398)
+ (cons
+ (intern-module-use*_0
+ (module-use+extra-inspectors
+ (module-path-index-shift
+ (module-use-module
+ sub-mu_0)
+ (module-linklet-info-self
+ mli_0)
+ (module-use-module
+ mu*_7))
+ (module-use-phase
+ sub-mu_0)
+ imports_3
+ (module-linklet-info-inspector
+ mli_0)
+ (module-linklet-info-extra-inspector
+ mli_0)
+ (if extra-inspectorsss_4
+ extra-inspectorss_16
+ #f)))
+ fold-var_396)))
+ (values fold-var_398))))
(if (not #f)
- (for-loop_232
- fold-var_241
- rest_120
- rest_121
- rest_122)
- fold-var_241)))
- fold-var_240)))))
- for-loop_232)
- null
- lst_226
- lst_227
- lst_228)))))))
- #f))
- (values #f #f)))))))
- (let-values () (values #f #f))))))))))))
+ (for-loop_309
+ fold-var_397
+ rest_170
+ rest_171
+ rest_172)
+ fold-var_397)))
+ fold-var_396)))))
+ for-loop_309)
+ fold-var_394
+ lst_348
+ lst_349
+ lst_350))))))))
+ #f))
+ (values #f #f))))))
+ (values #f #f)))))))))))
(define-values
(build-shared-data-linklet.1)
(lambda (to-correlated-linklet?1_0 cims3_0 ns4_0)
(begin
'build-shared-data-linklet
(let-values (((cims_0) cims3_0))
- (let-values (((ns_58) ns4_0))
+ (let-values (((ns_65) ns4_0))
(let-values (((to-correlated-linklet?_3) to-correlated-linklet?1_0))
- (let-values ()
- (let-values (((mpis_20) (make-module-path-index-table)))
- (let-values (((mpi-trees_0)
- (map-cim-tree
- cims_0
- (lambda (cim_1)
- (let-values (((vec_69 i_169)
- (let-values (((vec_70 len_54)
- (let-values (((vec_71) (compiled-in-memory-mpis cim_1)))
+ (let-values (((mpis_21) (make-module-path-index-table)))
+ (let-values (((mpi-trees_0)
+ (map-cim-tree
+ cims_0
+ (lambda (cim_1)
+ (let-values (((vec_81 i_235)
+ (let-values (((vec_82) (let-values (((vec_83) (make-vector 16))) vec_83))
+ ((i_236) (let-values (((i_237) 0)) i_237)))
+ (let-values (((vec_84 len_60)
+ (let-values (((vec_85) (compiled-in-memory-mpis cim_1)))
(begin
- (check-vector vec_71)
- (values vec_71 (unsafe-vector-length vec_71))))))
- (begin
- #f
- ((letrec-values (((for-loop_108)
- (lambda (vec_72 i_170 pos_14)
- (begin
- 'for-loop
- (if (unsafe-fx< pos_14 len_54)
- (let-values (((mpi_51)
- (unsafe-vector-ref
- vec_70
- pos_14)))
- (let-values (((vec_73 i_171)
- (let-values (((vec_74)
- vec_72)
- ((i_172) i_170))
- (let-values (((vec_75
- i_173)
- (let-values ()
- (let-values (((new-vec_3)
- (if (eq?
- i_172
- (unsafe-vector*-length
- vec_74))
- (grow-vector
- vec_74)
- vec_74)))
- (begin
- (unsafe-vector*-set!
- new-vec_3
- i_172
- (let-values ()
- (add-module-path-index!/pos
- mpis_20
- mpi_51)))
- (values
- new-vec_3
- (unsafe-fx+
- i_172
- 1)))))))
- (values vec_75 i_173)))))
- (if (not #f)
- (for-loop_108
- vec_73
- i_171
- (unsafe-fx+ 1 pos_14))
- (values vec_73 i_171))))
- (values vec_72 i_170))))))
- for-loop_108)
- (make-vector 16)
- 0
- 0)))))
- (shrink-vector vec_69 i_169))))))
- (let-values (((syntax-literals_0) (make-syntax-literals)))
- (let-values (((syntax-literals-trees_0)
- (map-cim-tree
- cims_0
- (lambda (cim_2)
- (add-syntax-literals!
- syntax-literals_0
- (compiled-in-memory-syntax-literals cim_2))))))
- (let-values (((module-uses-tables_0) null))
- (let-values (((module-uses-tables-count_0) 0))
- (let-values (((phase-to-link-module-uses-trees_0)
- (map-cim-tree
- cims_0
- (lambda (cim_3)
- (let-values (((pos_116) module-uses-tables-count_0))
- (begin
- (set! module-uses-tables_0
- (cons
- (compiled-in-memory-phase-to-link-module-uses cim_3)
- module-uses-tables_0))
- (set! module-uses-tables-count_0 (add1 pos_116))
- pos_116))))))
- (let-values (((syntax-literals-expr_0)
- (generate-eager-syntax-literals! syntax-literals_0 mpis_20 0 #f ns_58)))
- (let-values (((phase-to-link-module-uses-expr_2)
- (list*
- 'vector
- (reverse$1
- (let-values (((lst_109) (reverse$1 module-uses-tables_0)))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-vector vec_85))
+ (values vec_85 (unsafe-vector-length vec_85))))))
+ ((letrec-values (((for-loop_310)
+ (lambda (vec_86 i_238 pos_146)
+ (begin
+ 'for-loop
+ (if (unsafe-fx< pos_146 len_60)
+ (let-values (((mpi_72)
+ (unsafe-vector-ref
+ vec_84
+ pos_146)))
+ (let-values (((vec_87 i_239)
+ (let-values (((vec_88 i_240)
+ (let-values (((new-vec_4)
+ (if (eq?
+ i_238
+ (unsafe-vector*-length
+ vec_86))
+ (grow-vector
+ vec_86)
+ vec_86)))
+ (begin
+ (unsafe-vector*-set!
+ new-vec_4
+ i_238
+ (add-module-path-index!/pos
+ mpis_21
+ mpi_72))
+ (values
+ new-vec_4
+ (unsafe-fx+
+ i_238
+ 1))))))
+ (values vec_88 i_240))))
+ (if (not #f)
+ (for-loop_310
+ vec_87
+ i_239
+ (unsafe-fx+ 1 pos_146))
+ (values vec_87 i_239))))
+ (values vec_86 i_238))))))
+ for-loop_310)
+ vec_82
+ i_236
+ 0)))))
+ (shrink-vector vec_81 i_235))))))
+ (let-values (((syntax-literals_3) (make-syntax-literals)))
+ (let-values (((syntax-literals-trees_0)
+ (map-cim-tree
+ cims_0
+ (lambda (cim_2)
+ (add-syntax-literals!
+ syntax-literals_3
+ (compiled-in-memory-syntax-literals cim_2))))))
+ (let-values (((module-uses-tables_0) null))
+ (let-values (((module-uses-tables-count_0) 0))
+ (let-values (((phase-to-link-module-uses-trees_0)
+ (map-cim-tree
+ cims_0
+ (lambda (cim_3)
+ (let-values (((pos_147) module-uses-tables-count_0))
+ (begin
+ (set! module-uses-tables_0
+ (cons
+ (compiled-in-memory-phase-to-link-module-uses cim_3)
+ module-uses-tables_0))
+ (set! module-uses-tables-count_0 (add1 pos_147))
+ pos_147))))))
+ (let-values (((syntax-literals-expr_0)
+ (generate-eager-syntax-literals! syntax-literals_3 mpis_21 0 #f ns_65)))
+ (let-values (((phase-to-link-module-uses-expr_2)
+ (list*
+ 'vector
+ (reverse$1
+ (let-values (((fold-var_399)
+ (let-values (((fold-var_400) null)) fold-var_400)))
+ (let-values (((lst_354) (reverse$1 module-uses-tables_0)))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_109)))
- ((letrec-values (((for-loop_172)
- (lambda (fold-var_14 lst_232)
+ (check-list lst_354))
+ ((letrec-values (((for-loop_311)
+ (lambda (fold-var_401 lst_355)
(begin
'for-loop
- (if (pair? lst_232)
+ (if (pair? lst_355)
(let-values (((phase-to-link-module-uses_2)
- (unsafe-car lst_232))
- ((rest_52) (unsafe-cdr lst_232)))
- (let-values (((fold-var_10)
- (let-values (((fold-var_11)
- fold-var_14))
- (let-values (((fold-var_244)
- (let-values ()
- (cons
- (let-values ()
- (serialize-phase-to-link-module-uses
- phase-to-link-module-uses_2
- mpis_20))
- fold-var_11))))
- (values fold-var_244)))))
+ (unsafe-car lst_355))
+ ((rest_173)
+ (unsafe-cdr lst_355)))
+ (let-values (((fold-var_402)
+ (let-values (((fold-var_403)
+ (cons
+ (serialize-phase-to-link-module-uses
+ phase-to-link-module-uses_2
+ mpis_21)
+ fold-var_401)))
+ (values fold-var_403))))
(if (not #f)
- (for-loop_172 fold-var_10 rest_52)
- fold-var_10)))
- fold-var_14)))))
- for-loop_172)
- null
- lst_109)))))))
- (let-values (((linklet-s_0)
- (list
- 'linklet
- (list deserialize-imports eager-instance-imports)
- (list*
- mpi-vector-id
- '(mpi-vector-trees
- phase-to-link-modules-vector
- phase-to-link-modules-trees
- syntax-literals
- syntax-literals-trees))
- (list
- 'define-values
- (list mpi-vector-id)
- (let-values (((mpis6_1) mpis_20))
- (generate-module-path-index-deserialize.1 #f mpis6_1)))
- (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_2)
- (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?_3
- (make-correlated-linklet linklet-s_0 #f)
- (1/compile-linklet linklet-s_0)))))))))))))))))))
+ (for-loop_311 fold-var_402 rest_173)
+ fold-var_402)))
+ fold-var_401)))))
+ for-loop_311)
+ fold-var_399
+ lst_354))))))))
+ (let-values (((linklet-s_0)
+ (list
+ 'linklet
+ (list deserialize-imports eager-instance-imports)
+ (list*
+ mpi-vector-id
+ '(mpi-vector-trees
+ phase-to-link-modules-vector
+ phase-to-link-modules-trees
+ syntax-literals
+ syntax-literals-trees))
+ (list
+ 'define-values
+ (list mpi-vector-id)
+ (let-values (((mpis6_1) mpis_21))
+ (generate-module-path-index-deserialize.1 #f mpis6_1)))
+ (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_2)
+ (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?_3
+ (make-correlated-linklet linklet-s_0 #f)
+ (1/compile-linklet linklet-s_0))))))))))))))))))
(define-values
(map-cim-tree)
(lambda (cims_1 proc_6)
(begin
- ((letrec-values (((loop_94)
+ ((letrec-values (((loop_104)
(lambda (cims_2)
(begin
'loop
(reverse$1
- (let-values (((lst_8) cims_2))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_8)))
- ((letrec-values (((for-loop_233)
- (lambda (fold-var_77 lst_233)
- (begin
- 'for-loop
- (if (pair? lst_233)
- (let-values (((cim_4) (unsafe-car lst_233))
- ((rest_123) (unsafe-cdr lst_233)))
- (let-values (((fold-var_92)
- (let-values (((fold-var_245) fold-var_77))
- (let-values (((fold-var_111)
- (let-values ()
- (cons
- (let-values ()
- (vector
- (proc_6 cim_4)
- (loop_94
- (compiled-in-memory-pre-compiled-in-memorys
- cim_4))
- (loop_94
- (compiled-in-memory-post-compiled-in-memorys
- cim_4))))
- fold-var_245))))
- (values fold-var_111)))))
- (if (not #f)
- (for-loop_233 fold-var_92 rest_123)
- fold-var_92)))
- fold-var_77)))))
- for-loop_233)
- null
- lst_8))))))))
- loop_94)
+ (let-values (((fold-var_404) (let-values (((fold-var_405) null)) fold-var_405)))
+ (let-values (((lst_356) cims_2))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_356))
+ ((letrec-values (((for-loop_312)
+ (lambda (fold-var_406 lst_357)
+ (begin
+ 'for-loop
+ (if (pair? lst_357)
+ (let-values (((cim_4) (unsafe-car lst_357))
+ ((rest_174) (unsafe-cdr lst_357)))
+ (let-values (((fold-var_407)
+ (let-values (((fold-var_408)
+ (cons
+ (vector
+ (proc_6 cim_4)
+ (loop_104
+ (compiled-in-memory-pre-compiled-in-memorys
+ cim_4))
+ (loop_104
+ (compiled-in-memory-post-compiled-in-memorys
+ cim_4)))
+ fold-var_406)))
+ (values fold-var_408))))
+ (if (not #f)
+ (for-loop_312 fold-var_407 rest_174)
+ fold-var_407)))
+ fold-var_406)))))
+ for-loop_312)
+ fold-var_404
+ lst_356)))))))))
+ loop_104)
cims_1))))
(define-values
(compiled-tops->compiled-top.1)
@@ -36153,2081 +36263,2245 @@
(let-values (((all-cims_0) all-cims7_0))
(let-values (((to-correlated-linklet?_4) to-correlated-linklet?1_1))
(let-values (((merge-serialization?_0) merge-serialization?2_0))
- (let-values (((ns_59) namespace3_0))
- (let-values ()
- (let-values (((cims_3) (remove-nontail-purely-functional all-cims_0)))
- (if (= 1 (length cims_3))
- (let-values () (car cims_3))
- (let-values ()
- (let-values (((sequence-ht_0)
- (let-values (((lst_234) cims_3) ((start_46) 0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_234)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-naturals start_46)))
- ((letrec-values (((for-loop_234)
- (lambda (table_177 lst_235 pos_117)
- (begin
- 'for-loop
- (if (if (pair? lst_235) #t #f)
- (let-values (((cim_5) (unsafe-car lst_235))
- ((rest_48) (unsafe-cdr lst_235))
- ((i_174) pos_117))
- (let-values (((table_178)
- (let-values (((table_179) table_177))
- (let-values (((table_180)
- (let-values ()
- (let-values (((key_68
- val_52)
- (let-values ()
- (values
- (string->symbol
- (number->string
- i_174))
- (compiled-in-memory-linklet-directory
- cim_5)))))
- (hash-set
- table_179
- key_68
- val_52)))))
- (values table_180)))))
- (if (not #f)
- (for-loop_234 table_178 rest_48 (+ pos_117 1))
- table_178)))
- table_177)))))
- for-loop_234)
- '#hasheq()
- lst_234
- start_46)))))
- (let-values (((ht_78)
- (if merge-serialization?_0
- (hash-set
- sequence-ht_0
- 'data
- (1/hash->linklet-directory
- (hasheq
- #f
- (1/hash->linklet-bundle
- (hasheq
- 0
- (let-values (((cims9_0) cims_3)
- ((ns10_1) ns_59)
- ((to-correlated-linklet?11_0) to-correlated-linklet?_4))
- (build-shared-data-linklet.1
- to-correlated-linklet?11_0
- cims9_0
- ns10_1)))))))
- sequence-ht_0)))
- (compiled-in-memory1.1
- (1/hash->linklet-directory ht_78)
- #f
- #f
- #f
- '#hasheqv()
- #f
- '#hasheqv()
- '#hasheqv()
- '#()
- '#()
- cims_3
- null
- #f
- #f))))))))))))))
+ (let-values (((ns_66) namespace3_0))
+ (let-values (((cims_3) (remove-nontail-purely-functional all-cims_0)))
+ (if (= 1 (length cims_3))
+ (car cims_3)
+ (let-values (((sequence-ht_0)
+ (let-values (((table_211) (let-values (((table_212) '#hasheq())) table_212)))
+ (let-values (((lst_358) cims_3) ((start_55) 0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_358))
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-naturals start_55))
+ ((letrec-values (((for-loop_313)
+ (lambda (table_213 lst_359 pos_148)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_359) #t #f)
+ (let-values (((cim_5) (unsafe-car lst_359))
+ ((rest_175) (unsafe-cdr lst_359))
+ ((i_241) pos_148))
+ (let-values (((table_214)
+ (let-values (((table_215)
+ (let-values (((key_72
+ val_54)
+ (values
+ (string->symbol
+ (number->string
+ i_241))
+ (compiled-in-memory-linklet-directory
+ cim_5))))
+ (hash-set
+ table_213
+ key_72
+ val_54))))
+ (values table_215))))
+ (if (not #f)
+ (for-loop_313 table_214 rest_175 (+ pos_148 1))
+ table_214)))
+ table_213)))))
+ for-loop_313)
+ table_211
+ lst_358
+ start_55))))))
+ (let-values (((ht_168)
+ (if merge-serialization?_0
+ (hash-set
+ sequence-ht_0
+ 'data
+ (1/hash->linklet-directory
+ (hasheq
+ #f
+ (1/hash->linklet-bundle
+ (hasheq
+ 0
+ (let-values (((cims9_0) cims_3)
+ ((ns10_1) ns_66)
+ ((to-correlated-linklet?11_0) to-correlated-linklet?_4))
+ (build-shared-data-linklet.1 to-correlated-linklet?11_0 cims9_0 ns10_1)))))))
+ sequence-ht_0)))
+ (compiled-in-memory1.1
+ (1/hash->linklet-directory ht_168)
+ #f
+ #f
+ #f
+ #f
+ #f
+ '#hasheqv()
+ #f
+ '#hasheqv()
+ '#hasheqv()
+ '#()
+ '#()
+ cims_3
+ null
+ #f
+ #f))))))))))))
(define-values
(compiled-top->compiled-tops)
(lambda (ld_6)
(begin
- (let-values (((ht_135) (linklet-directory->hash$1 ld_6)))
+ (let-values (((ht_169) (linklet-directory->hash$1 ld_6)))
(reverse$1
- (let-values (((start_47) 0) ((end_33) (hash-count ht_135)) ((inc_27) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_47 end_33 inc_27)))
- ((letrec-values (((for-loop_16)
- (lambda (fold-var_246 pos_118)
- (begin
- 'for-loop
- (if (< pos_118 end_33)
- (let-values (((i_175) pos_118))
- (let-values (((fold-var_71)
- (let-values (((fold-var_106) fold-var_246))
+ (let-values (((fold-var_409) (let-values (((fold-var_410) null)) fold-var_410)))
+ (let-values (((start_56) 0) ((end_36) (hash-count ht_169)) ((inc_30) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-range start_56 end_36 inc_30))
+ ((letrec-values (((for-loop_314)
+ (lambda (fold-var_411 pos_149)
+ (begin
+ 'for-loop
+ (if (< pos_149 end_36)
+ (let-values (((i_242) pos_149))
+ (let-values (((fold-var_412)
(let-values (((id*_8)
(hash-ref
- ht_135
- (string->symbol (number->string i_175))
+ ht_169
+ (string->symbol (number->string i_242))
#f)))
- (begin
- #t
- ((letrec-values (((for-loop_105)
- (lambda (fold-var_72)
- (begin
- 'for-loop
- (let-values (((top_0) id*_8))
- (let-values (((fold-var_108)
- (let-values (((fold-var_109)
- fold-var_72))
- (let-values (((fold-var_210)
- fold-var_109))
- (if top_0
- (let-values (((fold-var_73)
- fold-var_210))
- (let-values (((fold-var_74)
- (let-values ()
- (cons
- (let-values ()
- top_0)
- fold-var_73))))
- (values
- fold-var_74)))
- fold-var_210)))))
- fold-var_108))))))
- for-loop_105)
- fold-var_106))))))
- (if (not #f) (for-loop_16 fold-var_71 (+ pos_118 inc_27)) fold-var_71)))
- fold-var_246)))))
- for-loop_16)
- null
- start_47))))))))
+ ((letrec-values (((for-loop_315)
+ (lambda (fold-var_413)
+ (begin
+ 'for-loop
+ (let-values (((top_0) id*_8))
+ (let-values (((fold-var_414)
+ (if top_0
+ (let-values (((fold-var_415)
+ (cons
+ top_0
+ fold-var_413)))
+ (values
+ fold-var_415))
+ fold-var_413)))
+ fold-var_414))))))
+ for-loop_315)
+ fold-var_411))))
+ (if (not #f) (for-loop_314 fold-var_412 (+ pos_149 inc_30)) fold-var_412)))
+ fold-var_411)))))
+ for-loop_314)
+ fold-var_409
+ start_56)))))))))
(define-values
(remove-nontail-purely-functional)
(lambda (cims_4)
(begin
- ((letrec-values (((loop_92)
+ ((letrec-values (((loop_105)
(lambda (cims_5)
(begin
'loop
(if (null? cims_5)
- (let-values () null)
+ null
(if (null? (cdr cims_5))
- (let-values () cims_5)
+ cims_5
(if (if (compiled-in-memory? (car cims_5))
(compiled-in-memory-purely-functional? (car cims_5))
#f)
- (let-values () (loop_92 (cdr cims_5)))
- (let-values () (cons (car cims_5) (cdr cims_5))))))))))
- loop_92)
+ (loop_105 (cdr cims_5))
+ (cons (car cims_5) (cdr cims_5)))))))))
+ loop_105)
cims_4))))
(define-values
(struct:known-defined/delay known-defined/delay2.1 known-defined/delay? known-defined/delay-thunk)
- (let-values (((struct:_3 make-_3 ?_3 -ref_3 -set!_3)
- (let-values ()
- (let-values ()
- (make-struct-type 'known-defined/delay #f 1 0 #f null 'prefab #f '(0) #f 'known-defined/delay)))))
- (values struct:_3 make-_3 ?_3 (make-struct-field-accessor -ref_3 0 'thunk))))
+ (let-values (((struct:_104 make-_104 ?_104 -ref_104 -set!_104)
+ (make-struct-type 'known-defined/delay #f 1 0 #f null 'prefab #f '(0) #f 'known-defined/delay)))
+ (values struct:_104 make-_104 ?_104 (make-struct-field-accessor -ref_104 0 'thunk))))
(define-values
(struct:known-property known-property3.1 known-property?)
- (let-values (((struct:_6 make-_6 ?_6 -ref_6 -set!_6)
- (let-values ()
- (let-values () (make-struct-type 'known-property #f 0 0 #f null 'prefab #f '() #f 'known-property)))))
- (values struct:_6 make-_6 ?_6)))
+ (let-values (((struct:_105 make-_105 ?_105 -ref_105 -set!_105)
+ (make-struct-type 'known-property #f 0 0 #f null 'prefab #f '() #f 'known-property)))
+ (values struct:_105 make-_105 ?_105)))
(define-values
(struct:known-property-of-function
known-property-of-function4.1
known-property-of-function?
known-property-of-function-arity)
- (let-values (((struct:_35 make-_35 ?_35 -ref_35 -set!_35)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'known-property-of-function
- #f
- 1
- 0
- #f
- null
- 'prefab
- #f
- '(0)
- #f
- 'known-property-of-function)))))
- (values struct:_35 make-_35 ?_35 (make-struct-field-accessor -ref_35 0 'arity))))
+ (let-values (((struct:_106 make-_106 ?_106 -ref_106 -set!_106)
+ (make-struct-type
+ 'known-property-of-function
+ #f
+ 1
+ 0
+ #f
+ null
+ 'prefab
+ #f
+ '(0)
+ #f
+ 'known-property-of-function)))
+ (values struct:_106 make-_106 ?_106 (make-struct-field-accessor -ref_106 0 'arity))))
(define-values
(struct:known-function known-function5.1 known-function? known-function-arity known-function-pure?)
- (let-values (((struct:_38 make-_38 ?_38 -ref_38 -set!_38)
- (let-values ()
- (let-values ()
- (make-struct-type 'known-function #f 2 0 #f null 'prefab #f '(0 1) #f 'known-function)))))
+ (let-values (((struct:_107 make-_107 ?_107 -ref_107 -set!_107)
+ (make-struct-type 'known-function #f 2 0 #f null 'prefab #f '(0 1) #f 'known-function)))
(values
- struct:_38
- make-_38
- ?_38
- (make-struct-field-accessor -ref_38 0 'arity)
- (make-struct-field-accessor -ref_38 1 'pure?))))
+ struct:_107
+ make-_107
+ ?_107
+ (make-struct-field-accessor -ref_107 0 'arity)
+ (make-struct-field-accessor -ref_107 1 'pure?))))
(define-values
(struct:known-function-of-satisfying
known-function-of-satisfying6.1
known-function-of-satisfying?
known-function-of-satisfying-arg-predicate-keys
known-function-of-satisfying-result-key)
- (let-values (((struct:_39 make-_39 ?_39 -ref_39 -set!_39)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'known-function-of-satisfying
- #f
- 2
- 0
- #f
- null
- 'prefab
- #f
- '(0 1)
- #f
- 'known-function-of-satisfying)))))
- (values
- struct:_39
- make-_39
- ?_39
- (make-struct-field-accessor -ref_39 0 'arg-predicate-keys)
- (make-struct-field-accessor -ref_39 1 'result-key))))
- (define-values
- (struct:known-predicate known-predicate7.1 known-predicate? known-predicate-key)
- (let-values (((struct:_40 make-_40 ?_40 -ref_40 -set!_40)
- (let-values ()
- (let-values ()
- (make-struct-type 'known-predicate #f 1 0 #f null 'prefab #f '(0) #f 'known-predicate)))))
- (values struct:_40 make-_40 ?_40 (make-struct-field-accessor -ref_40 0 'key))))
- (define-values
- (struct:known-satisfies known-satisfies8.1 known-satisfies? known-satisfies-predicate-key)
- (let-values (((struct:_41 make-_41 ?_41 -ref_41 -set!_41)
- (let-values ()
- (let-values ()
- (make-struct-type 'known-satisfies #f 1 0 #f null 'prefab #f '(0) #f 'known-satisfies)))))
- (values struct:_41 make-_41 ?_41 (make-struct-field-accessor -ref_41 0 'predicate-key))))
- (define-values
- (struct:known-struct-op known-struct-op9.1 known-struct-op? known-struct-op-type known-struct-op-field-count)
- (let-values (((struct:_42 make-_42 ?_42 -ref_42 -set!_42)
- (let-values ()
- (let-values ()
- (make-struct-type 'known-struct-op #f 2 0 #f null 'prefab #f '(0 1) #f 'known-struct-op)))))
- (values
- struct:_42
- make-_42
- ?_42
- (make-struct-field-accessor -ref_42 0 'type)
- (make-struct-field-accessor -ref_42 1 'field-count))))
- (define-values
- (lookup-defn)
- (lambda (defns_0 sym_63)
- (begin
- (let-values (((d_35) (hash-ref defns_0 sym_63 #f)))
- (if (known-defined/delay? d_35)
- (let-values () (begin ((known-defined/delay-thunk d_35)) (lookup-defn defns_0 sym_63)))
- (let-values () d_35))))))
- (define-values
- (any-side-effects?.1)
- (lambda (known-defns2_0 known-locals1_0 ready-variable?3_0 e7_0 expected-results8_0)
- (begin
- 'any-side-effects?
- (let-values (((e_48) e7_0))
- (let-values (((expected-results_0) expected-results8_0))
- (let-values (((locals_0) known-locals1_0))
- (let-values (((defns_1) known-defns2_0))
- (let-values (((ready-variable?_0)
- (if (eq? ready-variable?3_0 unsafe-undefined)
- (lambda (id_60) (begin 'ready-variable? #f))
- ready-variable?3_0)))
- (let-values ()
- (let-values (((effects?_0)
- (lambda (e_19 expected-results_1 locals_1)
- (begin
- 'effects?
- (let-values (((e10_0) e_19)
- ((expected-results11_0) expected-results_1)
- ((locals12_0) locals_1)
- ((defns13_0) defns_1)
- ((ready-variable?14_0) ready-variable?_0))
- (any-side-effects?.1
- defns13_0
- locals12_0
- ready-variable?14_0
- e10_0
- expected-results11_0))))))
- (let-values (((actual-results_0)
- ((letrec-values (((loop_44)
- (lambda (e_49 locals_2)
- (begin
- 'loop
- (let-values (((tmp_26)
- (if (pair? (correlated-e e_49))
- (correlated-e (car (correlated-e e_49)))
- #f)))
- (let-values (((index_3)
- (if (symbol? tmp_26)
- (hash-ref
- '#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))
- tmp_26
- (lambda () 0))
- 0)))
- (if (unsafe-fx< index_3 6)
- (if (unsafe-fx< index_3 2)
- (if (unsafe-fx< index_3 1)
- (let-values ()
- (let-values (((v_32) (correlated-e e_49)))
- (if (let-values (((or-part_4) (string? v_32)))
- (if or-part_4
- or-part_4
- (let-values (((or-part_5) (number? v_32)))
- (if or-part_5
- or-part_5
- (let-values (((or-part_6)
- (boolean? v_32)))
- (if or-part_6
- or-part_6
- (char? v_32)))))))
- (let-values () 1)
- (let-values (((c1_28)
- (if (pair? v_32)
- (let-values (((rator_0)
- (correlated-e
- (car v_32))))
- (let-values (((or-part_35)
- (hash-ref
- locals_2
- rator_0
- #f)))
- (if or-part_35
- or-part_35
- (lookup-defn
- defns_1
- rator_0))))
- #f)))
- (if c1_28
- ((lambda (d_36)
- (let-values (((ok?_19 _15_0 e16_0)
- (let-values (((s_7) e_49))
- (let-values (((orig-s_28)
- s_7))
- (let-values (((_15_1
- e16_1)
- (let-values (((s_8)
- (if (1/syntax?
- s_7)
- (syntax-e$2
- s_7)
- s_7)))
- (if (pair?
- s_8)
- (let-values (((_17_0)
- (let-values (((s_329)
- (car
- s_8)))
- s_329))
- ((e18_0)
- (let-values (((s_330)
- (cdr
- s_8)))
- (let-values (((s_331)
- (if (1/syntax?
- s_330)
- (syntax-e$2
- s_330)
- s_330)))
- (let-values (((flat-s_15)
- (to-syntax-list.1$1
- s_331)))
- (if (not
- flat-s_15)
- (let-values ()
- ((lambda (false_0
- str_7
- e_50)
- (error
- str_7))
- #f
- "bad syntax"
- orig-s_28))
- (let-values ()
- flat-s_15)))))))
- (values
- _17_0
- e18_0))
- ((lambda (false_1
- str_8
- e_10)
- (error
- str_8))
- #f
- "bad syntax"
- orig-s_28)))))
- (values
- #t
- _15_1
- e16_1))))))
- (let-values (((n-args_0)
- (length e16_0)))
- (if (let-values (((or-part_231)
- (if (let-values (((or-part_232)
- (if (known-struct-op?
- d_36)
- (if (eq?
- 'constructor
- (known-struct-op-type
- d_36))
- (let-values (((or-part_233)
- (eq?
- #t
- (known-struct-op-field-count
- d_36))))
- (if or-part_233
- or-part_233
- (=
- (known-struct-op-field-count
- d_36)
- n-args_0)))
- #f)
- #f)))
- (if or-part_232
- or-part_232
- (if (known-function?
- d_36)
- (if (known-function-pure?
- d_36)
- (arity-includes?
- (known-function-arity
- d_36)
- n-args_0)
- #f)
- #f)))
- (let-values (((lst_236)
- e16_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_236)))
- ((letrec-values (((for-loop_235)
- (lambda (result_86
- lst_237)
- (begin
- 'for-loop
- (if (pair?
- lst_237)
- (let-values (((e_51)
- (unsafe-car
- lst_237))
- ((rest_124)
- (unsafe-cdr
- lst_237)))
- (let-values (((result_87)
- (let-values ()
- (let-values (((result_88)
- (let-values ()
- (let-values ()
- (not
- (effects?_0
- e_51
- 1
- locals_2))))))
- (values
- result_88)))))
- (if (if (not
- ((lambda x_63
- (not
- result_87))
- e_51))
- (not
- #f)
- #f)
- (for-loop_235
- result_87
- rest_124)
- result_87)))
- result_86)))))
- for-loop_235)
- #t
- lst_236)))
- #f)))
- (if or-part_231
- or-part_231
- (if (known-function-of-satisfying?
- d_36)
- (if (=
- n-args_0
- (length
- (known-function-of-satisfying-arg-predicate-keys
- d_36)))
- (let-values (((lst_199)
- e16_0)
- ((lst_238)
- (known-function-of-satisfying-arg-predicate-keys
- d_36)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_199)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_238)))
- ((letrec-values (((for-loop_83)
- (lambda (result_89
- lst_239
- lst_203)
- (begin
- 'for-loop
- (if (if (pair?
- lst_239)
- (pair?
- lst_203)
- #f)
- (let-values (((e_52)
- (unsafe-car
- lst_239))
- ((rest_125)
- (unsafe-cdr
- lst_239))
- ((key_69)
- (unsafe-car
- lst_203))
- ((rest_105)
- (unsafe-cdr
- lst_203)))
- (let-values (((result_90)
- (let-values ()
- (let-values (((result_91)
- (let-values ()
- (let-values ()
- (if (not
- (effects?_0
- e_52
- 1
- locals_2))
- (satisfies?
- e_52
- key_69
- defns_1
- locals_2)
- #f)))))
- (values
- result_91)))))
- (if (if (not
- ((lambda x_64
+ (let-values (((struct:_108 make-_108 ?_108 -ref_108 -set!_108)
+ (make-struct-type
+ 'known-function-of-satisfying
+ #f
+ 2
+ 0
+ #f
+ null
+ 'prefab
+ #f
+ '(0 1)
+ #f
+ 'known-function-of-satisfying)))
+ (values
+ struct:_108
+ make-_108
+ ?_108
+ (make-struct-field-accessor -ref_108 0 'arg-predicate-keys)
+ (make-struct-field-accessor -ref_108 1 'result-key))))
+ (define-values
+ (struct:known-predicate known-predicate7.1 known-predicate? known-predicate-key)
+ (let-values (((struct:_109 make-_109 ?_109 -ref_109 -set!_109)
+ (make-struct-type 'known-predicate #f 1 0 #f null 'prefab #f '(0) #f 'known-predicate)))
+ (values struct:_109 make-_109 ?_109 (make-struct-field-accessor -ref_109 0 'key))))
+ (define-values
+ (struct:known-satisfies known-satisfies8.1 known-satisfies? known-satisfies-predicate-key)
+ (let-values (((struct:_110 make-_110 ?_110 -ref_110 -set!_110)
+ (make-struct-type 'known-satisfies #f 1 0 #f null 'prefab #f '(0) #f 'known-satisfies)))
+ (values struct:_110 make-_110 ?_110 (make-struct-field-accessor -ref_110 0 'predicate-key))))
+ (define-values
+ (struct:known-struct-op known-struct-op9.1 known-struct-op? known-struct-op-type known-struct-op-field-count)
+ (let-values (((struct:_111 make-_111 ?_111 -ref_111 -set!_111)
+ (make-struct-type 'known-struct-op #f 2 0 #f null 'prefab #f '(0 1) #f 'known-struct-op)))
+ (values
+ struct:_111
+ make-_111
+ ?_111
+ (make-struct-field-accessor -ref_111 0 'type)
+ (make-struct-field-accessor -ref_111 1 'field-count))))
+ (define-values
+ (lookup-defn)
+ (lambda (defns_0 sym_77)
+ (begin
+ (let-values (((d_35) (hash-ref defns_0 sym_77 #f)))
+ (if (known-defined/delay? d_35)
+ (begin ((known-defined/delay-thunk d_35)) (lookup-defn defns_0 sym_77))
+ d_35)))))
+ (define-values
+ (any-side-effects?.1)
+ (lambda (known-defns2_0 known-locals1_0 ready-variable?3_0 e7_0 expected-results8_0)
+ (begin
+ 'any-side-effects?
+ (let-values (((e_52) e7_0))
+ (let-values (((expected-results_0) expected-results8_0))
+ (let-values (((locals_0) known-locals1_0))
+ (let-values (((defns_1) known-defns2_0))
+ (let-values (((ready-variable?_0)
+ (if (eq? ready-variable?3_0 unsafe-undefined)
+ (lambda (id_68) (begin 'ready-variable? #f))
+ ready-variable?3_0)))
+ (let-values (((effects?_0)
+ (lambda (e_53 expected-results_1 locals_1)
+ (begin
+ 'effects?
+ (let-values (((e10_0) e_53)
+ ((expected-results11_0) expected-results_1)
+ ((locals12_0) locals_1)
+ ((defns13_0) defns_1)
+ ((ready-variable?14_0) ready-variable?_0))
+ (any-side-effects?.1
+ defns13_0
+ locals12_0
+ ready-variable?14_0
+ e10_0
+ expected-results11_0))))))
+ (let-values (((actual-results_0)
+ ((letrec-values (((loop_106)
+ (lambda (e_54 locals_2)
+ (begin
+ 'loop
+ (let-values (((tmp_27)
+ (if (pair? (correlated-e e_54))
+ (correlated-e (car (correlated-e e_54)))
+ #f)))
+ (let-values (((index_3)
+ (if (symbol? tmp_27)
+ (hash-ref
+ '#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)
+ (unsafe-make-struct-type-property/guard-calls-no-arguments
+ .
+ 11)
+ (values . 3)
+ (void . 4))
+ tmp_27
+ (lambda () 0))
+ 0)))
+ (if (unsafe-fx< index_3 6)
+ (if (unsafe-fx< index_3 2)
+ (if (unsafe-fx< index_3 1)
+ (let-values (((v_236) (correlated-e e_54)))
+ (if (let-values (((or-part_378) (string? v_236)))
+ (if or-part_378
+ or-part_378
+ (let-values (((or-part_379) (number? v_236)))
+ (if or-part_379
+ or-part_379
+ (let-values (((or-part_380)
+ (boolean? v_236)))
+ (if or-part_380
+ or-part_380
+ (char? v_236)))))))
+ 1
+ (let-values (((cond-val_19)
+ (if (pair? v_236)
+ (let-values (((rator_0)
+ (correlated-e
+ (car v_236))))
+ (let-values (((or-part_381)
+ (hash-ref
+ locals_2
+ rator_0
+ #f)))
+ (if or-part_381
+ or-part_381
+ (lookup-defn
+ defns_1
+ rator_0))))
+ #f)))
+ (if cond-val_19
+ ((lambda (d_36)
+ (let-values (((ok?_19 _15_0 e16_0)
+ (let-values (((s_417) e_54))
+ (let-values (((orig-s_28)
+ s_417))
+ (let-values (((_15_1 e16_1)
+ (let-values (((s_418)
+ (if (1/syntax?
+ s_417)
+ (syntax-e$2
+ s_417)
+ s_417)))
+ (if (pair?
+ s_418)
+ (let-values (((_17_0)
+ (let-values (((s_419)
+ (car
+ s_418)))
+ s_419))
+ ((e18_0)
+ (let-values (((s_420)
+ (cdr
+ s_418)))
+ (let-values (((s_421)
+ (if (1/syntax?
+ s_420)
+ (syntax-e$2
+ s_420)
+ s_420)))
+ (let-values (((flat-s_15)
+ (to-syntax-list.1$1
+ s_421)))
+ (if (not
+ flat-s_15)
+ ((lambda (false_0
+ str_7
+ e_55)
+ (error
+ str_7))
+ #f
+ "bad syntax"
+ orig-s_28)
+ flat-s_15))))))
+ (values
+ _17_0
+ e18_0))
+ ((lambda (false_1
+ str_8
+ e_56)
+ (error
+ str_8))
+ #f
+ "bad syntax"
+ orig-s_28)))))
+ (values
+ #t
+ _15_1
+ e16_1))))))
+ (let-values (((n-args_0) (length e16_0)))
+ (if (let-values (((or-part_382)
+ (if (let-values (((or-part_383)
+ (if (known-struct-op?
+ d_36)
+ (if (eq?
+ 'constructor
+ (known-struct-op-type
+ d_36))
+ (let-values (((or-part_384)
+ (eq?
+ #t
+ (known-struct-op-field-count
+ d_36))))
+ (if or-part_384
+ or-part_384
+ (=
+ (known-struct-op-field-count
+ d_36)
+ n-args_0)))
+ #f)
+ #f)))
+ (if or-part_383
+ or-part_383
+ (if (known-function?
+ d_36)
+ (if (known-function-pure?
+ d_36)
+ (arity-includes?
+ (known-function-arity
+ d_36)
+ n-args_0)
+ #f)
+ #f)))
+ (let-values (((result_159)
+ (let-values (((result_160)
+ #t))
+ result_160)))
+ (let-values (((lst_360)
+ e16_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_360))
+ ((letrec-values (((for-loop_316)
+ (lambda (result_161
+ lst_361)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_361)
+ (let-values (((e_57)
+ (unsafe-car
+ lst_361))
+ ((rest_176)
+ (unsafe-cdr
+ lst_361)))
+ (let-values (((result_162)
+ (let-values (((result_163)
+ (not
+ (effects?_0
+ e_57
+ 1
+ locals_2))))
+ (values
+ result_163))))
+ (if (if (not
+ ((lambda x_69
+ (not
+ result_162))
+ e_57))
(not
- result_90))
- e_52))
- (if (not
- ((lambda x_35
- (not
- result_90))
- key_69))
- (not
- #f)
- #f)
+ #f)
+ #f)
+ (for-loop_316
+ result_162
+ rest_176)
+ result_162)))
+ result_161)))))
+ for-loop_316)
+ result_159
+ lst_360))))
+ #f)))
+ (if or-part_382
+ or-part_382
+ (if (known-function-of-satisfying?
+ d_36)
+ (if (=
+ n-args_0
+ (length
+ (known-function-of-satisfying-arg-predicate-keys
+ d_36)))
+ (let-values (((result_164)
+ (let-values (((result_165)
+ #t))
+ result_165)))
+ (let-values (((lst_362)
+ e16_0)
+ ((lst_363)
+ (known-function-of-satisfying-arg-predicate-keys
+ d_36)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_362))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_363))
+ ((letrec-values (((for-loop_317)
+ (lambda (result_166
+ lst_364
+ lst_365)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_364)
+ (pair?
+ lst_365)
+ #f)
+ (let-values (((e_58)
+ (unsafe-car
+ lst_364))
+ ((rest_177)
+ (unsafe-cdr
+ lst_364))
+ ((key_73)
+ (unsafe-car
+ lst_365))
+ ((rest_178)
+ (unsafe-cdr
+ lst_365)))
+ (let-values (((result_167)
+ (let-values (((result_168)
+ (if (not
+ (effects?_0
+ e_58
+ 1
+ locals_2))
+ (satisfies?
+ e_58
+ key_73
+ defns_1
+ locals_2)
+ #f)))
+ (values
+ result_168))))
+ (if (if (not
+ ((lambda x_70
+ (not
+ result_167))
+ e_58))
+ (if (not
+ ((lambda x_71
+ (not
+ result_167))
+ key_73))
+ (not
+ #f)
#f)
- (for-loop_83
- result_90
- rest_125
- rest_105)
- result_90)))
- result_89)))))
- for-loop_83)
- #t
- lst_199
- lst_238)))
- #f)
- #f)))
- 1
- #f))))
- c1_28)
- (let-values ()
- (if (let-values (((or-part_81)
- (self-quoting-in-linklet?
- v_32)))
- (if or-part_81
- or-part_81
- (if (symbol? v_32)
- (let-values (((or-part_82)
- (hash-ref
- locals_2
- v_32
- #f)))
- (if or-part_82
- or-part_82
- (let-values (((or-part_147)
- (lookup-defn
- defns_1
- v_32)))
- (if or-part_147
- or-part_147
- (let-values (((or-part_218)
- (built-in-symbol?
- v_32)))
- (if or-part_218
- or-part_218
- (ready-variable?_0
- v_32)))))))
- #f)))
- 1
- #f)))))))
- (let-values () 1))
- (if (unsafe-fx< index_3 3)
- (let-values ()
- (let-values (((ok?_20
- _19_0
- ids20_0
- rhs21_0
- body22_0)
- (let-values (((s_332) e_49))
- (let-values (((orig-s_29) s_332))
- (let-values (((_19_1
- ids20_1
- rhs21_1
- body22_1)
- (let-values (((s_33)
- (if (1/syntax?
- s_332)
- (syntax-e$2
- s_332)
- s_332)))
- (if (pair? s_33)
- (let-values (((_23_0)
- (let-values (((s_101)
- (car
- s_33)))
- s_101))
- ((ids24_0
- rhs25_0
- body26_0)
- (let-values (((s_333)
- (cdr
- s_33)))
- (let-values (((s_334)
- (if (1/syntax?
- s_333)
- (syntax-e$2
- s_333)
- s_333)))
- (if (pair?
- s_334)
- (let-values (((ids27_0
- rhs28_0)
- (let-values (((s_169)
- (car
- s_334)))
- (let-values (((s_335)
- (if (1/syntax?
- s_169)
- (syntax-e$2
- s_169)
- s_169)))
- (let-values (((flat-s_16)
- (to-syntax-list.1$1
- s_335)))
- (if (not
- flat-s_16)
- (let-values ()
- ((lambda (false_2
- str_9
- e_53)
- (error
- str_9))
- #f
- "bad syntax"
- orig-s_29))
- (let-values ()
- (let-values (((ids_9
- rhs_4)
- (let-values (((lst_240)
- flat-s_16))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_240)))
- ((letrec-values (((for-loop_236)
- (lambda (ids_10
- rhs_5
- lst_241)
- (begin
- 'for-loop
- (if (pair?
- lst_241)
- (let-values (((s_58)
- (unsafe-car
- lst_241))
- ((rest_97)
- (unsafe-cdr
- lst_241)))
- (let-values (((ids_11
- rhs_6)
- (let-values (((ids_12)
- ids_10)
- ((rhs_7)
- rhs_5))
- (let-values (((ids_13
- rhs_8)
- (let-values ()
- (let-values (((ids34_0
- rhs35_0)
- (let-values ()
- (let-values (((s_336)
- (if (1/syntax?
- s_58)
- (syntax-e$2
- s_58)
- s_58)))
- (if (pair?
- s_336)
- (let-values (((ids30_0)
- (let-values (((s_63)
- (car
- s_336)))
- s_63))
- ((rhs31_0)
- (let-values (((s_337)
- (cdr
- s_336)))
- (let-values (((s_201)
- (if (1/syntax?
- s_337)
- (syntax-e$2
- s_337)
- s_337)))
- (if (pair?
- s_201)
- (let-values (((rhs32_0)
- (let-values (((s_65)
- (car
- s_201)))
- s_65))
- (()
- (let-values (((s_338)
- (cdr
- s_201)))
- (let-values (((s_91)
- (if (1/syntax?
- s_338)
- (syntax-e$2
- s_338)
- s_338)))
- (if (null?
- s_91)
- (values)
- ((lambda (false_3
- str_10
- e_54)
- (error
- str_10))
- #f
- "bad syntax"
- orig-s_29))))))
- (values
- rhs32_0))
- ((lambda (false_4
- str_11
- e_55)
- (error
- str_11))
- #f
- "bad syntax"
- orig-s_29))))))
- (values
- ids30_0
- rhs31_0))
- ((lambda (false_5
- str_12
- e_12)
- (error
- str_12))
- #f
- "bad syntax"
- orig-s_29))))))
- (values
- (cons
- ids34_0
- ids_12)
- (cons
- rhs35_0
- rhs_7))))))
- (values
- ids_13
- rhs_8)))))
- (if (not
- #f)
- (for-loop_236
- ids_11
- rhs_6
- rest_97)
- (values
- ids_11
- rhs_6))))
- (values
- ids_10
- rhs_5))))))
- for-loop_236)
- null
- null
- lst_240)))))
- (values
- (reverse$1
- ids_9)
- (reverse$1
- rhs_4)))))))))
- ((body29_0)
- (let-values (((s_204)
- (cdr
- s_334)))
- (let-values (((s_67)
- (if (1/syntax?
- s_204)
- (syntax-e$2
- s_204)
- s_204)))
- (if (pair?
- s_67)
- (let-values (((body33_0)
- (let-values (((s_339)
- (car
- s_67)))
- s_339))
- (()
- (let-values (((s_92)
- (cdr
- s_67)))
- (let-values (((s_340)
- (if (1/syntax?
- s_92)
- (syntax-e$2
- s_92)
- s_92)))
- (if (null?
- s_340)
- (values)
- ((lambda (false_6
- str_13
- e_56)
- (error
- str_13))
- #f
- "bad syntax"
- orig-s_29))))))
- (values
- body33_0))
- ((lambda (false_7
- str_14
- e_57)
- (error
- str_14))
- #f
- "bad syntax"
- orig-s_29))))))
- (values
- ids27_0
- rhs28_0
- body29_0))
- ((lambda (false_8
- str_15
- e_58)
+ #f)
+ (for-loop_317
+ result_167
+ rest_177
+ rest_178)
+ result_167)))
+ result_166)))))
+ for-loop_317)
+ result_164
+ lst_362
+ lst_363))))
+ #f)
+ #f)))
+ 1
+ #f))))
+ cond-val_19)
+ (if (let-values (((or-part_385)
+ (self-quoting-in-linklet?
+ v_236)))
+ (if or-part_385
+ or-part_385
+ (if (symbol? v_236)
+ (let-values (((or-part_386)
+ (hash-ref
+ locals_2
+ v_236
+ #f)))
+ (if or-part_386
+ or-part_386
+ (let-values (((or-part_387)
+ (lookup-defn
+ defns_1
+ v_236)))
+ (if or-part_387
+ or-part_387
+ (let-values (((or-part_388)
+ (built-in-symbol?
+ v_236)))
+ (if or-part_388
+ or-part_388
+ (ready-variable?_0
+ v_236)))))))
+ #f)))
+ 1
+ #f)))))
+ 1)
+ (if (unsafe-fx< index_3 3)
+ (let-values (((ok?_20 _19_0 ids20_0 rhs21_0 body22_0)
+ (let-values (((s_422) e_54))
+ (let-values (((orig-s_29) s_422))
+ (let-values (((_19_1
+ ids20_1
+ rhs21_1
+ body22_1)
+ (let-values (((s_423)
+ (if (1/syntax?
+ s_422)
+ (syntax-e$2
+ s_422)
+ s_422)))
+ (if (pair? s_423)
+ (let-values (((_23_0)
+ (let-values (((s_424)
+ (car
+ s_423)))
+ s_424))
+ ((ids24_0
+ rhs25_0
+ body26_0)
+ (let-values (((s_425)
+ (cdr
+ s_423)))
+ (let-values (((s_426)
+ (if (1/syntax?
+ s_425)
+ (syntax-e$2
+ s_425)
+ s_425)))
+ (if (pair?
+ s_426)
+ (let-values (((ids27_0
+ rhs28_0)
+ (let-values (((s_427)
+ (car
+ s_426)))
+ (let-values (((s_428)
+ (if (1/syntax?
+ s_427)
+ (syntax-e$2
+ s_427)
+ s_427)))
+ (let-values (((flat-s_16)
+ (to-syntax-list.1$1
+ s_428)))
+ (if (not
+ flat-s_16)
+ ((lambda (false_2
+ str_9
+ e_59)
+ (error
+ str_9))
+ #f
+ "bad syntax"
+ orig-s_29)
+ (let-values (((ids_9
+ rhs_4)
+ (let-values (((ids_10)
+ (let-values (((ids_11)
+ null))
+ ids_11))
+ ((rhs_5)
+ (let-values (((rhs_6)
+ null))
+ rhs_6)))
+ (let-values (((lst_366)
+ flat-s_16))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_366))
+ ((letrec-values (((for-loop_318)
+ (lambda (ids_12
+ rhs_7
+ lst_367)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_367)
+ (let-values (((s_429)
+ (unsafe-car
+ lst_367))
+ ((rest_179)
+ (unsafe-cdr
+ lst_367)))
+ (let-values (((ids_13
+ rhs_8)
+ (let-values (((ids_14
+ rhs_9)
+ (let-values (((ids34_0
+ rhs35_0)
+ (let-values (((s_430)
+ (if (1/syntax?
+ s_429)
+ (syntax-e$2
+ s_429)
+ s_429)))
+ (if (pair?
+ s_430)
+ (let-values (((ids30_0)
+ (let-values (((s_431)
+ (car
+ s_430)))
+ s_431))
+ ((rhs31_0)
+ (let-values (((s_432)
+ (cdr
+ s_430)))
+ (let-values (((s_433)
+ (if (1/syntax?
+ s_432)
+ (syntax-e$2
+ s_432)
+ s_432)))
+ (if (pair?
+ s_433)
+ (let-values (((rhs32_0)
+ (let-values (((s_434)
+ (car
+ s_433)))
+ s_434))
+ (()
+ (let-values (((s_435)
+ (cdr
+ s_433)))
+ (let-values (((s_436)
+ (if (1/syntax?
+ s_435)
+ (syntax-e$2
+ s_435)
+ s_435)))
+ (if (null?
+ s_436)
+ (values)
+ ((lambda (false_3
+ str_10
+ e_60)
+ (error
+ str_10))
+ #f
+ "bad syntax"
+ orig-s_29))))))
+ (values
+ rhs32_0))
+ ((lambda (false_4
+ str_11
+ e_61)
+ (error
+ str_11))
+ #f
+ "bad syntax"
+ orig-s_29))))))
+ (values
+ ids30_0
+ rhs31_0))
+ ((lambda (false_5
+ str_12
+ e_62)
+ (error
+ str_12))
+ #f
+ "bad syntax"
+ orig-s_29)))))
+ (values
+ (cons
+ ids34_0
+ ids_12)
+ (cons
+ rhs35_0
+ rhs_7)))))
+ (values
+ ids_14
+ rhs_9))))
+ (if (not
+ #f)
+ (for-loop_318
+ ids_13
+ rhs_8
+ rest_179)
+ (values
+ ids_13
+ rhs_8))))
+ (values
+ ids_12
+ rhs_7))))))
+ for-loop_318)
+ ids_10
+ rhs_5
+ lst_366))))))
+ (values
+ (reverse$1
+ ids_9)
+ (reverse$1
+ rhs_4))))))))
+ ((body29_0)
+ (let-values (((s_437)
+ (cdr
+ s_426)))
+ (let-values (((s_438)
+ (if (1/syntax?
+ s_437)
+ (syntax-e$2
+ s_437)
+ s_437)))
+ (if (pair?
+ s_438)
+ (let-values (((body33_0)
+ (let-values (((s_439)
+ (car
+ s_438)))
+ s_439))
+ (()
+ (let-values (((s_440)
+ (cdr
+ s_438)))
+ (let-values (((s_441)
+ (if (1/syntax?
+ s_440)
+ (syntax-e$2
+ s_440)
+ s_440)))
+ (if (null?
+ s_441)
+ (values)
+ ((lambda (false_6
+ str_13
+ e_63)
+ (error
+ str_13))
+ #f
+ "bad syntax"
+ orig-s_29))))))
+ (values
+ body33_0))
+ ((lambda (false_7
+ str_14
+ e_64)
+ (error
+ str_14))
+ #f
+ "bad syntax"
+ orig-s_29))))))
+ (values
+ ids27_0
+ rhs28_0
+ body29_0))
+ ((lambda (false_8
+ str_15
+ e_65)
+ (error
+ str_15))
+ #f
+ "bad syntax"
+ orig-s_29))))))
+ (values
+ _23_0
+ ids24_0
+ rhs25_0
+ body26_0))
+ ((lambda (false_9
+ str_16
+ e_66)
+ (error str_16))
+ #f
+ "bad syntax"
+ orig-s_29)))))
+ (values
+ #t
+ _19_1
+ ids20_1
+ rhs21_1
+ body22_1))))))
+ (if (not
+ (let-values (((result_169)
+ (let-values (((result_170) #f))
+ result_170)))
+ (let-values (((lst_368) ids20_0)
+ ((lst_369) rhs21_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_368))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_369))
+ ((letrec-values (((for-loop_319)
+ (lambda (result_171
+ lst_370
+ lst_371)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_370)
+ (pair? lst_371)
+ #f)
+ (let-values (((ids_15)
+ (unsafe-car
+ lst_370))
+ ((rest_180)
+ (unsafe-cdr
+ lst_370))
+ ((rhs_10)
+ (unsafe-car
+ lst_371))
+ ((rest_181)
+ (unsafe-cdr
+ lst_371)))
+ (let-values (((result_172)
+ (let-values (((result_173)
+ (effects?_0
+ rhs_10
+ (correlated-length
+ ids_15)
+ locals_2)))
+ (values
+ result_173))))
+ (if (if (not
+ ((lambda x_72
+ result_172)
+ ids_15))
+ (if (not
+ ((lambda x_73
+ result_172)
+ rhs_10))
+ (not
+ #f)
+ #f)
+ #f)
+ (for-loop_319
+ result_172
+ rest_180
+ rest_181)
+ result_172)))
+ result_171)))))
+ for-loop_319)
+ result_169
+ lst_368
+ lst_369)))))
+ (loop_106
+ body22_0
+ (add-binding-info locals_2 ids20_0 rhs21_0))
+ #f))
+ (if (unsafe-fx< index_3 4)
+ (let-values (((ok?_21 _36_0 e37_0)
+ (let-values (((s_442) e_54))
+ (let-values (((orig-s_30) s_442))
+ (let-values (((_36_1 e37_1)
+ (let-values (((s_443)
+ (if (1/syntax?
+ s_442)
+ (syntax-e$2
+ s_442)
+ s_442)))
+ (if (pair? s_443)
+ (let-values (((_38_0)
+ (let-values (((s_444)
+ (car
+ s_443)))
+ s_444))
+ ((e39_0)
+ (let-values (((s_445)
+ (cdr
+ s_443)))
+ (let-values (((s_446)
+ (if (1/syntax?
+ s_445)
+ (syntax-e$2
+ s_445)
+ s_445)))
+ (let-values (((flat-s_17)
+ (to-syntax-list.1$1
+ s_446)))
+ (if (not
+ flat-s_17)
+ ((lambda (false_10
+ str_17
+ e_67)
(error
- str_15))
+ str_17))
#f
"bad syntax"
- orig-s_29))))))
- (values
- _23_0
- ids24_0
- rhs25_0
- body26_0))
- ((lambda (false_9
- str_16
- e_59)
- (error
- str_16))
- #f
- "bad syntax"
- orig-s_29)))))
- (values
- #t
- _19_1
- ids20_1
- rhs21_1
- body22_1))))))
- (if (not
- (let-values (((lst_242) ids20_0)
- ((lst_243) rhs21_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_242)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_243)))
- ((letrec-values (((for-loop_237)
- (lambda (result_15
- lst_244
- lst_35)
- (begin
- 'for-loop
- (if (if (pair?
- lst_244)
- (pair?
- lst_35)
- #f)
- (let-values (((ids_14)
- (unsafe-car
- lst_244))
- ((rest_14)
- (unsafe-cdr
- lst_244))
- ((rhs_9)
- (unsafe-car
- lst_35))
- ((rest_126)
- (unsafe-cdr
- lst_35)))
- (let-values (((result_92)
- (let-values ()
- (let-values (((result_93)
- (let-values ()
- (let-values ()
- (effects?_0
- rhs_9
- (correlated-length
- ids_14)
- locals_2)))))
- (values
- result_93)))))
- (if (if (not
- ((lambda x_65
- result_92)
- ids_14))
- (if (not
- ((lambda x_66
- result_92)
- rhs_9))
- (not
- #f)
- #f)
- #f)
- (for-loop_237
- result_92
- rest_14
- rest_126)
- result_92)))
- result_15)))))
- for-loop_237)
- #f
- lst_242
- lst_243))))
- (loop_44
- body22_0
- (add-binding-info locals_2 ids20_0 rhs21_0))
- #f)))
- (if (unsafe-fx< index_3 4)
- (let-values ()
- (let-values (((ok?_3 _36_0 e37_0)
- (let-values (((s_74) e_49))
- (let-values (((orig-s_6) s_74))
- (let-values (((_36_1 e37_1)
- (let-values (((s_208)
- (if (1/syntax?
- s_74)
- (syntax-e$2
- s_74)
- s_74)))
- (if (pair?
- s_208)
- (let-values (((_38_0)
- (let-values (((s_106)
- (car
- s_208)))
- s_106))
- ((e39_0)
- (let-values (((s_209)
- (cdr
- s_208)))
- (let-values (((s_76)
- (if (1/syntax?
- s_209)
- (syntax-e$2
- s_209)
- s_209)))
- (let-values (((flat-s_2)
- (to-syntax-list.1$1
- s_76)))
- (if (not
- flat-s_2)
- (let-values ()
- ((lambda (false_10
- str_17
- e_60)
- (error
- str_17))
- #f
- "bad syntax"
- orig-s_6))
- (let-values ()
- flat-s_2)))))))
- (values
- _38_0
- e39_0))
- ((lambda (false_11
- str_18
- e_61)
- (error
- str_18))
- #f
- "bad syntax"
- orig-s_6)))))
- (values #t _36_1 e37_1))))))
- (if (let-values (((lst_245) e37_0))
+ orig-s_30)
+ flat-s_17))))))
+ (values
+ _38_0
+ e39_0))
+ ((lambda (false_11
+ str_18
+ e_68)
+ (error str_18))
+ #f
+ "bad syntax"
+ orig-s_30)))))
+ (values #t _36_1 e37_1))))))
+ (if (let-values (((result_174)
+ (let-values (((result_175) #t))
+ result_175)))
+ (let-values (((lst_372) e37_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_372))
+ ((letrec-values (((for-loop_320)
+ (lambda (result_176
+ lst_373)
+ (begin
+ 'for-loop
+ (if (pair? lst_373)
+ (let-values (((e_69)
+ (unsafe-car
+ lst_373))
+ ((rest_182)
+ (unsafe-cdr
+ lst_373)))
+ (let-values (((result_177)
+ (let-values (((result_178)
+ (not
+ (effects?_0
+ e_69
+ 1
+ locals_2))))
+ (values
+ result_178))))
+ (if (if (not
+ ((lambda x_74
+ (not
+ result_177))
+ e_69))
+ (not #f)
+ #f)
+ (for-loop_320
+ result_177
+ rest_182)
+ result_177)))
+ result_176)))))
+ for-loop_320)
+ result_174
+ lst_372))))
+ (length e37_0)
+ #f))
+ (if (unsafe-fx< index_3 5)
+ (let-values (((ok?_22 _40_0 e41_0)
+ (let-values (((s_447) e_54))
+ (let-values (((orig-s_31) s_447))
+ (let-values (((_40_1 e41_1)
+ (let-values (((s_448)
+ (if (1/syntax?
+ s_447)
+ (syntax-e$2
+ s_447)
+ s_447)))
+ (if (pair? s_448)
+ (let-values (((_42_0)
+ (let-values (((s_449)
+ (car
+ s_448)))
+ s_449))
+ ((e43_0)
+ (let-values (((s_450)
+ (cdr
+ s_448)))
+ (let-values (((s_451)
+ (if (1/syntax?
+ s_450)
+ (syntax-e$2
+ s_450)
+ s_450)))
+ (let-values (((flat-s_18)
+ (to-syntax-list.1$1
+ s_451)))
+ (if (not
+ flat-s_18)
+ ((lambda (false_12
+ str_19
+ e_70)
+ (error
+ str_19))
+ #f
+ "bad syntax"
+ orig-s_31)
+ flat-s_18))))))
+ (values
+ _42_0
+ e43_0))
+ ((lambda (false_13
+ str_20
+ e_71)
+ (error
+ str_20))
+ #f
+ "bad syntax"
+ orig-s_31)))))
+ (values #t _40_1 e41_1))))))
+ (if (let-values (((result_179)
+ (let-values (((result_180) #t))
+ result_180)))
+ (let-values (((lst_374) e41_0))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_245)))
- ((letrec-values (((for-loop_238)
- (lambda (result_94
- lst_246)
+ (check-list lst_374))
+ ((letrec-values (((for-loop_321)
+ (lambda (result_181
+ lst_375)
(begin
'for-loop
(if (pair?
- lst_246)
- (let-values (((e_62)
+ lst_375)
+ (let-values (((e_72)
(unsafe-car
- lst_246))
- ((rest_127)
+ lst_375))
+ ((rest_183)
(unsafe-cdr
- lst_246)))
- (let-values (((result_34)
- (let-values ()
- (let-values (((result_95)
- (let-values ()
- (let-values ()
- (not
- (effects?_0
- e_62
- 1
- locals_2))))))
- (values
- result_95)))))
+ lst_375)))
+ (let-values (((result_182)
+ (let-values (((result_183)
+ (not
+ (effects?_0
+ e_72
+ 1
+ locals_2))))
+ (values
+ result_183))))
(if (if (not
- ((lambda x_67
+ ((lambda x_75
(not
- result_34))
- e_62))
+ result_182))
+ e_72))
(not
#f)
#f)
- (for-loop_238
- result_34
- rest_127)
- result_34)))
- result_94)))))
- for-loop_238)
- #t
- lst_245)))
- (length e37_0)
- #f)))
- (if (unsafe-fx< index_3 5)
- (let-values ()
- (let-values (((ok?_21 _40_0 e41_0)
- (let-values (((s_341) e_49))
- (let-values (((orig-s_30)
- s_341))
- (let-values (((_40_1 e41_1)
- (let-values (((s_342)
- (if (1/syntax?
- s_341)
- (syntax-e$2
- s_341)
- s_341)))
- (if (pair?
- s_342)
- (let-values (((_42_0)
- (let-values (((s_343)
- (car
- s_342)))
- s_343))
- ((e43_0)
- (let-values (((s_344)
- (cdr
- s_342)))
- (let-values (((s_113)
- (if (1/syntax?
- s_344)
- (syntax-e$2
- s_344)
- s_344)))
- (let-values (((flat-s_17)
- (to-syntax-list.1$1
- s_113)))
- (if (not
- flat-s_17)
- (let-values ()
- ((lambda (false_12
- str_19
- e_63)
- (error
- str_19))
- #f
- "bad syntax"
- orig-s_30))
- (let-values ()
- flat-s_17)))))))
- (values
- _42_0
- e43_0))
- ((lambda (false_13
- str_20
- e_31)
- (error
- str_20))
- #f
- "bad syntax"
- orig-s_30)))))
- (values #t _40_1 e41_1))))))
- (if (let-values (((lst_247) e41_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_247)))
- ((letrec-values (((for-loop_239)
- (lambda (result_96
- lst_248)
- (begin
- 'for-loop
- (if (pair?
- lst_248)
- (let-values (((e_37)
- (unsafe-car
- lst_248))
- ((rest_128)
- (unsafe-cdr
- lst_248)))
- (let-values (((result_97)
- (let-values ()
- (let-values (((result_98)
- (let-values ()
- (let-values ()
- (not
- (effects?_0
- e_37
- 1
- locals_2))))))
- (values
- result_98)))))
- (if (if (not
- ((lambda x_68
- (not
- result_97))
- e_37))
- (not
- #f)
- #f)
- (for-loop_239
- result_97
- rest_128)
- result_97)))
- result_96)))))
- for-loop_239)
- #t
- lst_247)))
- 1
- #f)))
- (let-values ()
- (let-values (((ok?_22 _44_0 e45_0)
- (let-values (((s_122) e_49))
- (let-values (((orig-s_31)
- s_122))
- (let-values (((_44_1 e45_1)
- (let-values (((s_345)
- (if (1/syntax?
- s_122)
- (syntax-e$2
- s_122)
- s_122)))
- (if (pair?
- s_345)
- (let-values (((_46_0)
- (let-values (((s_346)
- (car
- s_345)))
- s_346))
- ((e47_0)
- (let-values (((s_221)
- (cdr
- s_345)))
- (let-values (((s_347)
- (if (1/syntax?
- s_221)
- (syntax-e$2
- s_221)
- s_221)))
- (let-values (((flat-s_18)
- (to-syntax-list.1$1
- s_347)))
- (if (not
- flat-s_18)
- (let-values ()
- ((lambda (false_14
- str_21
- e_64)
- (error
- str_21))
- #f
- "bad syntax"
- orig-s_31))
- (let-values ()
- flat-s_18)))))))
- (values
- _46_0
- e47_0))
- ((lambda (false_15
- str_22
- e_65)
- (error
- str_22))
- #f
- "bad syntax"
- orig-s_31)))))
- (values #t _44_1 e45_1))))))
- ((letrec-values (((bloop_0)
- (lambda (es_1)
- (begin
- 'bloop
- (if (null? es_1)
- (let-values () #f)
- (if (null? (cdr es_1))
- (let-values ()
- (loop_44
- (car es_1)
- locals_2))
- (let-values ()
- (if (not
- (effects?_0
- (car es_1)
- #f
- locals_2))
- (bloop_0
- (cdr es_1))
- #f))))))))
- bloop_0)
- e45_0)))))))
- (if (unsafe-fx< index_3 9)
- (if (unsafe-fx< index_3 7)
- (let-values ()
- (let-values (((ok?_23 _48_0 e049_0 e50_0)
- (let-values (((s_348) e_49))
- (let-values (((orig-s_32) s_348))
- (let-values (((_48_1 e049_1 e50_1)
- (let-values (((s_349)
+ (for-loop_321
+ result_182
+ rest_183)
+ result_182)))
+ result_181)))))
+ for-loop_321)
+ result_179
+ lst_374))))
+ 1
+ #f))
+ (let-values (((ok?_23 _44_0 e45_0)
+ (let-values (((s_452) e_54))
+ (let-values (((orig-s_32) s_452))
+ (let-values (((_44_1 e45_1)
+ (let-values (((s_453)
(if (1/syntax?
- s_348)
+ s_452)
(syntax-e$2
- s_348)
- s_348)))
- (if (pair? s_349)
- (let-values (((_51_0)
- (let-values (((s_190)
+ s_452)
+ s_452)))
+ (if (pair? s_453)
+ (let-values (((_46_0)
+ (let-values (((s_454)
(car
- s_349)))
- s_190))
- ((e052_0
- e53_0)
- (let-values (((s_134)
+ s_453)))
+ s_454))
+ ((e47_0)
+ (let-values (((s_455)
(cdr
- s_349)))
- (let-values (((s_350)
+ s_453)))
+ (let-values (((s_456)
(if (1/syntax?
- s_134)
+ s_455)
(syntax-e$2
- s_134)
- s_134)))
- (if (pair?
- s_350)
- (let-values (((e054_0)
- (let-values (((s_135)
- (car
- s_350)))
- s_135))
- ((e55_0)
- (let-values (((s_136)
- (cdr
- s_350)))
- (let-values (((s_137)
- (if (1/syntax?
- s_136)
- (syntax-e$2
- s_136)
- s_136)))
- (let-values (((flat-s_19)
- (to-syntax-list.1$1
- s_137)))
- (if (not
- flat-s_19)
- (let-values ()
- ((lambda (false_16
- str_23
- e_66)
- (error
- str_23))
- #f
- "bad syntax"
- orig-s_32))
- (let-values ()
- flat-s_19)))))))
- (values
- e054_0
- e55_0))
- ((lambda (false_17
- str_24
- e_67)
- (error
- str_24))
- #f
- "bad syntax"
- orig-s_32))))))
+ s_455)
+ s_455)))
+ (let-values (((flat-s_19)
+ (to-syntax-list.1$1
+ s_456)))
+ (if (not
+ flat-s_19)
+ ((lambda (false_14
+ str_21
+ e_73)
+ (error
+ str_21))
+ #f
+ "bad syntax"
+ orig-s_32)
+ flat-s_19))))))
(values
- _51_0
- e052_0
- e53_0))
- ((lambda (false_18
- str_25
- e_68)
+ _46_0
+ e47_0))
+ ((lambda (false_15
+ str_22
+ e_74)
(error
- str_25))
+ str_22))
#f
"bad syntax"
orig-s_32)))))
+ (values #t _44_1 e45_1))))))
+ ((letrec-values (((bloop_0)
+ (lambda (es_1)
+ (begin
+ 'bloop
+ (if (null? es_1)
+ #f
+ (if (null? (cdr es_1))
+ (loop_106
+ (car es_1)
+ locals_2)
+ (if (not
+ (effects?_0
+ (car es_1)
+ #f
+ locals_2))
+ (bloop_0 (cdr es_1))
+ #f)))))))
+ bloop_0)
+ e45_0))))))
+ (if (unsafe-fx< index_3 9)
+ (if (unsafe-fx< index_3 7)
+ (let-values (((ok?_24 _48_0 e049_0 e50_0)
+ (let-values (((s_457) e_54))
+ (let-values (((orig-s_33) s_457))
+ (let-values (((_48_1 e049_1 e50_1)
+ (let-values (((s_458)
+ (if (1/syntax?
+ s_457)
+ (syntax-e$2
+ s_457)
+ s_457)))
+ (if (pair? s_458)
+ (let-values (((_51_0)
+ (let-values (((s_459)
+ (car
+ s_458)))
+ s_459))
+ ((e052_0
+ e53_0)
+ (let-values (((s_460)
+ (cdr
+ s_458)))
+ (let-values (((s_461)
+ (if (1/syntax?
+ s_460)
+ (syntax-e$2
+ s_460)
+ s_460)))
+ (if (pair?
+ s_461)
+ (let-values (((e054_0)
+ (let-values (((s_462)
+ (car
+ s_461)))
+ s_462))
+ ((e55_0)
+ (let-values (((s_463)
+ (cdr
+ s_461)))
+ (let-values (((s_464)
+ (if (1/syntax?
+ s_463)
+ (syntax-e$2
+ s_463)
+ s_463)))
+ (let-values (((flat-s_20)
+ (to-syntax-list.1$1
+ s_464)))
+ (if (not
+ flat-s_20)
+ ((lambda (false_16
+ str_23
+ e_75)
+ (error
+ str_23))
+ #f
+ "bad syntax"
+ orig-s_33)
+ flat-s_20))))))
+ (values
+ e054_0
+ e55_0))
+ ((lambda (false_17
+ str_24
+ e_76)
+ (error
+ str_24))
+ #f
+ "bad syntax"
+ orig-s_33))))))
+ (values
+ _51_0
+ e052_0
+ e53_0))
+ ((lambda (false_18
+ str_25
+ e_77)
+ (error str_25))
+ #f
+ "bad syntax"
+ orig-s_33)))))
+ (values #t _48_1 e049_1 e50_1))))))
+ (if (let-values (((result_184)
+ (let-values (((result_185) #t))
+ result_185)))
+ (let-values (((lst_376) e50_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_376))
+ ((letrec-values (((for-loop_322)
+ (lambda (result_186
+ lst_377)
+ (begin
+ 'for-loop
+ (if (pair? lst_377)
+ (let-values (((e_78)
+ (unsafe-car
+ lst_377))
+ ((rest_184)
+ (unsafe-cdr
+ lst_377)))
+ (let-values (((result_187)
+ (let-values (((result_188)
+ (not
+ (effects?_0
+ e_78
+ #f
+ locals_2))))
+ (values
+ result_188))))
+ (if (if (not
+ ((lambda x_76
+ (not
+ result_187))
+ e_78))
+ (not #f)
+ #f)
+ (for-loop_322
+ result_187
+ rest_184)
+ result_187)))
+ result_186)))))
+ for-loop_322)
+ result_184
+ lst_376))))
+ (loop_106 e049_0 locals_2)
+ #f))
+ (if (unsafe-fx< index_3 8)
+ (let-values (((ok?_25
+ mp56_0
+ v57_0
+ g58_0
+ quot59_0
+ nm60_0)
+ (let-values (((s_465) e_54))
+ (if (let-values (((s_466)
+ (if (1/syntax?
+ s_465)
+ (syntax-e$2 s_465)
+ s_465)))
+ (if (pair? s_466)
+ (if (let-values (((s_467)
+ (car
+ s_466)))
+ #t)
+ (let-values (((s_468)
+ (cdr s_466)))
+ (let-values (((s_469)
+ (if (1/syntax?
+ s_468)
+ (syntax-e$2
+ s_468)
+ s_468)))
+ (if (pair? s_469)
+ (if (let-values (((s_470)
+ (car
+ s_469)))
+ #t)
+ (let-values (((s_471)
+ (cdr
+ s_469)))
+ (let-values (((s_472)
+ (if (1/syntax?
+ s_471)
+ (syntax-e$2
+ s_471)
+ s_471)))
+ (if (pair?
+ s_472)
+ (if (let-values (((s_473)
+ (car
+ s_472)))
+ #t)
+ (let-values (((s_474)
+ (cdr
+ s_472)))
+ (let-values (((s_475)
+ (if (1/syntax?
+ s_474)
+ (syntax-e$2
+ s_474)
+ s_474)))
+ (if (pair?
+ s_475)
+ (if (let-values (((s_476)
+ (car
+ s_475)))
+ (let-values (((s_477)
+ (if (1/syntax?
+ s_476)
+ (syntax-e$2
+ s_476)
+ s_476)))
+ (if (pair?
+ s_477)
+ (if (let-values (((s_478)
+ (car
+ s_477)))
+ #t)
+ (let-values (((s_479)
+ (cdr
+ s_477)))
+ (let-values (((s_480)
+ (if (1/syntax?
+ s_479)
+ (syntax-e$2
+ s_479)
+ s_479)))
+ (if (pair?
+ s_480)
+ (if (let-values (((s_481)
+ (car
+ s_480)))
+ #t)
+ (let-values (((s_482)
+ (cdr
+ s_480)))
+ (let-values (((s_483)
+ (if (1/syntax?
+ s_482)
+ (syntax-e$2
+ s_482)
+ s_482)))
+ (null?
+ s_483)))
+ #f)
+ #f)))
+ #f)
+ #f)))
+ (let-values (((s_484)
+ (cdr
+ s_475)))
+ (let-values (((s_485)
+ (if (1/syntax?
+ s_484)
+ (syntax-e$2
+ s_484)
+ s_484)))
+ (null?
+ s_485)))
+ #f)
+ #f)))
+ #f)
+ #f)))
+ #f)
+ #f)))
+ #f)
+ #f))
+ (let-values ()
+ (let-values (((mp56_1
+ v57_1
+ g58_1
+ quot59_1
+ nm60_1)
+ (let-values (((s_486)
+ (if (1/syntax?
+ s_465)
+ (syntax-e$2
+ s_465)
+ s_465)))
+ (let-values (((mp61_0)
+ (let-values (((s_487)
+ (car
+ s_486)))
+ s_487))
+ ((v62_0
+ g63_0
+ quot64_0
+ nm65_0)
+ (let-values (((s_488)
+ (cdr
+ s_486)))
+ (let-values (((s_489)
+ (if (1/syntax?
+ s_488)
+ (syntax-e$2
+ s_488)
+ s_488)))
+ (let-values (((v66_0)
+ (let-values (((s_490)
+ (car
+ s_489)))
+ s_490))
+ ((g67_0
+ quot68_0
+ nm69_0)
+ (let-values (((s_491)
+ (cdr
+ s_489)))
+ (let-values (((s_492)
+ (if (1/syntax?
+ s_491)
+ (syntax-e$2
+ s_491)
+ s_491)))
+ (let-values (((g70_0)
+ (let-values (((s_493)
+ (car
+ s_492)))
+ s_493))
+ ((quot71_0
+ nm72_0)
+ (let-values (((s_494)
+ (cdr
+ s_492)))
+ (let-values (((s_495)
+ (if (1/syntax?
+ s_494)
+ (syntax-e$2
+ s_494)
+ s_494)))
+ (let-values (((quot73_0
+ nm74_0)
+ (let-values (((s_496)
+ (car
+ s_495)))
+ (let-values (((s_497)
+ (if (1/syntax?
+ s_496)
+ (syntax-e$2
+ s_496)
+ s_496)))
+ (let-values (((quot75_0)
+ (let-values (((s_498)
+ (car
+ s_497)))
+ s_498))
+ ((nm76_0)
+ (let-values (((s_499)
+ (cdr
+ s_497)))
+ (let-values (((s_500)
+ (if (1/syntax?
+ s_499)
+ (syntax-e$2
+ s_499)
+ s_499)))
+ (let-values (((nm77_0)
+ (let-values (((s_501)
+ (car
+ s_500)))
+ s_501))
+ (()
+ (let-values (((s_502)
+ (cdr
+ s_500)))
+ (let-values (((s_503)
+ (if (1/syntax?
+ s_502)
+ (syntax-e$2
+ s_502)
+ s_502)))
+ (values)))))
+ (values
+ nm77_0))))))
+ (values
+ quot75_0
+ nm76_0)))))
+ (()
+ (let-values (((s_504)
+ (cdr
+ s_495)))
+ (let-values (((s_505)
+ (if (1/syntax?
+ s_504)
+ (syntax-e$2
+ s_504)
+ s_504)))
+ (values)))))
+ (values
+ quot73_0
+ nm74_0))))))
+ (values
+ g70_0
+ quot71_0
+ nm72_0))))))
+ (values
+ v66_0
+ g67_0
+ quot68_0
+ nm69_0))))))
+ (values
+ mp61_0
+ v62_0
+ g63_0
+ quot64_0
+ nm65_0)))))
(values
#t
- _48_1
- e049_1
- e50_1))))))
- (if (let-values (((lst_131) e50_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_131)))
- ((letrec-values (((for-loop_148)
- (lambda (result_99
- lst_132)
- (begin
- 'for-loop
- (if (pair? lst_132)
- (let-values (((e_69)
- (unsafe-car
- lst_132))
- ((rest_65)
- (unsafe-cdr
- lst_132)))
- (let-values (((result_100)
- (let-values ()
- (let-values (((result_49)
- (let-values ()
- (let-values ()
- (not
- (effects?_0
- e_69
- #f
- locals_2))))))
- (values
- result_49)))))
- (if (if (not
- ((lambda x_69
- (not
- result_100))
- e_69))
- (not #f)
- #f)
- (for-loop_148
- result_100
- rest_65)
- result_100)))
- result_99)))))
- for-loop_148)
- #t
- lst_131)))
- (loop_44 e049_0 locals_2)
- #f)))
- (if (unsafe-fx< index_3 8)
- (let-values ()
- (let-values (((ok?_24
- mp56_0
- v57_0
- g58_0
- quot59_0
- nm60_0)
- (let-values (((s_235) e_49))
- (if (let-values (((s_191)
- (if (1/syntax?
- s_235)
- (syntax-e$2
- s_235)
- s_235)))
- (if (pair? s_191)
- (if (let-values (((s_351)
- (car
- s_191)))
- #t)
- (let-values (((s_236)
- (cdr
- s_191)))
- (let-values (((s_237)
- (if (1/syntax?
- s_236)
- (syntax-e$2
- s_236)
- s_236)))
- (if (pair? s_237)
- (if (let-values (((s_238)
- (car
- s_237)))
- #t)
- (let-values (((s_352)
- (cdr
- s_237)))
- (let-values (((s_353)
+ mp56_1
+ v57_1
+ g58_1
+ quot59_1
+ nm60_1)))
+ (values #f #f #f #f #f #f)))))
+ (if ok?_25
+ (if (not
+ (let-values (((temp78_0) v57_0)
+ ((temp79_0) 1))
+ (any-side-effects?.1
+ '#hasheq()
+ '#hasheq()
+ unsafe-undefined
+ temp78_0
+ temp79_0)))
+ (if (eq? 'quote quot59_0)
+ (if (symbol? nm60_0)
+ (if (equal? #f g58_0) 1 #f)
+ #f)
+ #f)
+ #f)
+ #f))
+ (if (ok-make-struct-type?
+ e_54
+ ready-variable?_0
+ defns_1)
+ 5
+ #f)))
+ (if (unsafe-fx< index_3 11)
+ (if (unsafe-fx< index_3 10)
+ (if (ok-make-struct-field-accessor/mutator?
+ e_54
+ locals_2
+ 'general-accessor
+ defns_1)
+ 1
+ #f)
+ (if (ok-make-struct-field-accessor/mutator?
+ e_54
+ locals_2
+ 'general-mutator
+ defns_1)
+ 1
+ #f))
+ (if (unsafe-fx< index_3 12)
+ (if (ok-make-struct-type-property? e_54 defns_1) 3 #f)
+ (if (unsafe-fx< index_3 13)
+ (let-values (((ok?_26 gs80_0 quot81_0 datum82_0)
+ (let-values (((s_506) e_54))
+ (if (let-values (((s_507)
+ (if (1/syntax?
+ s_506)
+ (syntax-e$2
+ s_506)
+ s_506)))
+ (if (pair? s_507)
+ (if (let-values (((s_508)
+ (car
+ s_507)))
+ #t)
+ (let-values (((s_509)
+ (cdr
+ s_507)))
+ (let-values (((s_510)
+ (if (1/syntax?
+ s_509)
+ (syntax-e$2
+ s_509)
+ s_509)))
+ (if (pair? s_510)
+ (if (let-values (((s_511)
+ (car
+ s_510)))
+ (let-values (((s_512)
(if (1/syntax?
- s_352)
+ s_511)
(syntax-e$2
- s_352)
- s_352)))
+ s_511)
+ s_511)))
(if (pair?
- s_353)
- (if (let-values (((s_354)
+ s_512)
+ (if (let-values (((s_513)
(car
- s_353)))
+ s_512)))
#t)
- (let-values (((s_355)
+ (let-values (((s_514)
+ (cdr
+ s_512)))
+ (let-values (((s_515)
+ (if (1/syntax?
+ s_514)
+ (syntax-e$2
+ s_514)
+ s_514)))
+ (if (pair?
+ s_515)
+ (if (let-values (((s_516)
+ (car
+ s_515)))
+ #t)
+ (let-values (((s_517)
+ (cdr
+ s_515)))
+ (let-values (((s_518)
+ (if (1/syntax?
+ s_517)
+ (syntax-e$2
+ s_517)
+ s_517)))
+ (null?
+ s_518)))
+ #f)
+ #f)))
+ #f)
+ #f)))
+ (let-values (((s_519)
+ (cdr
+ s_510)))
+ (let-values (((s_520)
+ (if (1/syntax?
+ s_519)
+ (syntax-e$2
+ s_519)
+ s_519)))
+ (null?
+ s_520)))
+ #f)
+ #f)))
+ #f)
+ #f))
+ (let-values ()
+ (let-values (((gs80_1
+ quot81_1
+ datum82_1)
+ (let-values (((s_521)
+ (if (1/syntax?
+ s_506)
+ (syntax-e$2
+ s_506)
+ s_506)))
+ (let-values (((gs83_0)
+ (let-values (((s_522)
+ (car
+ s_521)))
+ s_522))
+ ((quot84_0
+ datum85_0)
+ (let-values (((s_523)
+ (cdr
+ s_521)))
+ (let-values (((s_524)
+ (if (1/syntax?
+ s_523)
+ (syntax-e$2
+ s_523)
+ s_523)))
+ (let-values (((quot86_0
+ datum87_0)
+ (let-values (((s_525)
+ (car
+ s_524)))
+ (let-values (((s_526)
+ (if (1/syntax?
+ s_525)
+ (syntax-e$2
+ s_525)
+ s_525)))
+ (let-values (((quot88_0)
+ (let-values (((s_527)
+ (car
+ s_526)))
+ s_527))
+ ((datum89_0)
+ (let-values (((s_528)
+ (cdr
+ s_526)))
+ (let-values (((s_529)
+ (if (1/syntax?
+ s_528)
+ (syntax-e$2
+ s_528)
+ s_528)))
+ (let-values (((datum90_0)
+ (let-values (((s_530)
+ (car
+ s_529)))
+ s_530))
+ (()
+ (let-values (((s_531)
+ (cdr
+ s_529)))
+ (let-values (((s_532)
+ (if (1/syntax?
+ s_531)
+ (syntax-e$2
+ s_531)
+ s_531)))
+ (values)))))
+ (values
+ datum90_0))))))
+ (values
+ quot88_0
+ datum89_0)))))
+ (()
+ (let-values (((s_533)
+ (cdr
+ s_524)))
+ (let-values (((s_534)
+ (if (1/syntax?
+ s_533)
+ (syntax-e$2
+ s_533)
+ s_533)))
+ (values)))))
+ (values
+ quot86_0
+ datum87_0))))))
+ (values
+ gs83_0
+ quot84_0
+ datum85_0)))))
+ (values
+ #t
+ gs80_1
+ quot81_1
+ datum82_1)))
+ (values #f #f #f #f)))))
+ (if (let-values (((or-part_389)
+ (if ok?_26
+ (if (eq? 'quote quot81_0)
+ (let-values (((or-part_390)
+ (symbol?
+ datum82_0)))
+ (if or-part_390
+ or-part_390
+ (string? datum82_0)))
+ #f)
+ #f)))
+ (if or-part_389
+ or-part_389
+ (null? (cdr (correlated-e e_54)))))
+ 1
+ #f))
+ (let-values (((ok?_27
+ _91_0
+ id:rator92_0
+ id:arg93_0
+ thn94_0
+ els95_0)
+ (let-values (((s_535) e_54))
+ (if (let-values (((s_536)
+ (if (1/syntax?
+ s_535)
+ (syntax-e$2
+ s_535)
+ s_535)))
+ (if (pair? s_536)
+ (if (let-values (((s_537)
+ (car
+ s_536)))
+ #t)
+ (let-values (((s_538)
+ (cdr
+ s_536)))
+ (let-values (((s_539)
+ (if (1/syntax?
+ s_538)
+ (syntax-e$2
+ s_538)
+ s_538)))
+ (if (pair? s_539)
+ (if (let-values (((s_540)
+ (car
+ s_539)))
+ (let-values (((s_541)
+ (if (1/syntax?
+ s_540)
+ (syntax-e$2
+ s_540)
+ s_540)))
+ (if (pair?
+ s_541)
+ (if (let-values (((s_542)
+ (car
+ s_541)))
+ (let-values (((or-part_391)
+ (if (1/syntax?
+ s_542)
+ (symbol?
+ (syntax-e$2
+ s_542))
+ #f)))
+ (if or-part_391
+ or-part_391
+ (symbol?
+ s_542))))
+ (let-values (((s_543)
(cdr
- s_353)))
- (let-values (((s_356)
+ s_541)))
+ (let-values (((s_544)
(if (1/syntax?
- s_355)
+ s_543)
(syntax-e$2
- s_355)
- s_355)))
+ s_543)
+ s_543)))
(if (pair?
- s_356)
- (if (let-values (((s_357)
+ s_544)
+ (if (let-values (((s_545)
(car
- s_356)))
- (let-values (((s_358)
+ s_544)))
+ (let-values (((or-part_392)
(if (1/syntax?
- s_357)
- (syntax-e$2
- s_357)
- s_357)))
- (if (pair?
- s_358)
- (if (let-values (((s_359)
- (car
- s_358)))
- #t)
- (let-values (((s_360)
- (cdr
- s_358)))
- (let-values (((s_361)
- (if (1/syntax?
- s_360)
- (syntax-e$2
- s_360)
- s_360)))
- (if (pair?
- s_361)
- (if (let-values (((s_362)
- (car
- s_361)))
- #t)
- (let-values (((s_363)
- (cdr
- s_361)))
- (let-values (((s_364)
- (if (1/syntax?
- s_363)
- (syntax-e$2
- s_363)
- s_363)))
- (null?
- s_364)))
- #f)
- #f)))
- #f)
- #f)))
- (let-values (((s_365)
+ s_545)
+ (symbol?
+ (syntax-e$2
+ s_545))
+ #f)))
+ (if or-part_392
+ or-part_392
+ (symbol?
+ s_545))))
+ (let-values (((s_546)
(cdr
- s_356)))
- (let-values (((s_366)
+ s_544)))
+ (let-values (((s_547)
(if (1/syntax?
- s_365)
+ s_546)
(syntax-e$2
- s_365)
- s_365)))
+ s_546)
+ s_546)))
(null?
- s_366)))
+ s_547)))
#f)
#f)))
#f)
#f)))
- #f)
- #f)))
- #f)
- #f))
- (let-values ()
- (let-values (((mp56_1
- v57_1
- g58_1
- quot59_1
- nm60_1)
- (let-values (((s_367)
+ (let-values (((s_548)
+ (cdr
+ s_539)))
+ (let-values (((s_549)
(if (1/syntax?
- s_235)
+ s_548)
(syntax-e$2
- s_235)
- s_235)))
- (let-values (((mp61_0)
- (let-values (((s_240)
+ s_548)
+ s_548)))
+ (if (pair?
+ s_549)
+ (if (let-values (((s_550)
+ (car
+ s_549)))
+ #t)
+ (let-values (((s_551)
+ (cdr
+ s_549)))
+ (let-values (((s_552)
+ (if (1/syntax?
+ s_551)
+ (syntax-e$2
+ s_551)
+ s_551)))
+ (if (pair?
+ s_552)
+ (if (let-values (((s_553)
(car
- s_367)))
- s_240))
- ((v62_0
- g63_0
- quot64_0
- nm65_0)
- (let-values (((s_368)
- (cdr
- s_367)))
- (let-values (((s_369)
- (if (1/syntax?
- s_368)
- (syntax-e$2
- s_368)
- s_368)))
- (let-values (((v66_0)
- (let-values (((s_370)
- (car
- s_369)))
- s_370))
- ((g67_0
- quot68_0
- nm69_0)
- (let-values (((s_371)
- (cdr
- s_369)))
- (let-values (((s_244)
- (if (1/syntax?
- s_371)
- (syntax-e$2
- s_371)
- s_371)))
- (let-values (((g70_0)
- (let-values (((s_372)
- (car
- s_244)))
- s_372))
- ((quot71_0
- nm72_0)
- (let-values (((s_373)
- (cdr
- s_244)))
- (let-values (((s_374)
- (if (1/syntax?
- s_373)
- (syntax-e$2
- s_373)
- s_373)))
- (let-values (((quot73_0
- nm74_0)
- (let-values (((s_247)
- (car
- s_374)))
- (let-values (((s_375)
- (if (1/syntax?
- s_247)
- (syntax-e$2
- s_247)
- s_247)))
- (let-values (((quot75_0)
- (let-values (((s_376)
- (car
- s_375)))
- s_376))
- ((nm76_0)
- (let-values (((s_377)
- (cdr
- s_375)))
- (let-values (((s_378)
- (if (1/syntax?
- s_377)
- (syntax-e$2
- s_377)
- s_377)))
- (let-values (((nm77_0)
- (let-values (((s_379)
- (car
- s_378)))
- s_379))
- (()
- (let-values (((s_380)
- (cdr
- s_378)))
- (let-values (((s_381)
- (if (1/syntax?
- s_380)
- (syntax-e$2
- s_380)
- s_380)))
- (values)))))
- (values
- nm77_0))))))
- (values
- quot75_0
- nm76_0)))))
- (()
- (let-values (((s_382)
- (cdr
- s_374)))
- (let-values (((s_383)
- (if (1/syntax?
- s_382)
- (syntax-e$2
- s_382)
- s_382)))
- (values)))))
- (values
- quot73_0
- nm74_0))))))
- (values
- g70_0
- quot71_0
- nm72_0))))))
- (values
- v66_0
- g67_0
- quot68_0
- nm69_0))))))
- (values
- mp61_0
- v62_0
- g63_0
- quot64_0
- nm65_0)))))
- (values
- #t
- mp56_1
- v57_1
- g58_1
- quot59_1
- nm60_1)))
- (values #f #f #f #f #f #f)))))
- (if ok?_24
- (if (not
- (let-values (((temp78_0) v57_0)
- ((temp79_0) 1))
- (any-side-effects?.1
- '#hasheq()
- '#hasheq()
- unsafe-undefined
- temp78_0
- temp79_0)))
- (if (eq? 'quote quot59_0)
- (if (symbol? nm60_0)
- (if (equal? #f g58_0) 1 #f)
- #f)
- #f)
- #f)
- #f)))
- (let-values ()
- (if (ok-make-struct-type?
- e_49
- ready-variable?_0
- defns_1)
- 5
- #f))))
- (if (unsafe-fx< index_3 11)
- (if (unsafe-fx< index_3 10)
- (let-values ()
- (if (ok-make-struct-field-accessor/mutator?
- e_49
- locals_2
- 'general-accessor
- defns_1)
- 1
- #f))
- (let-values ()
- (if (ok-make-struct-field-accessor/mutator?
- e_49
- locals_2
- 'general-mutator
- defns_1)
- 1
- #f)))
- (if (unsafe-fx< index_3 12)
- (let-values ()
- (if (ok-make-struct-type-property? e_49 defns_1)
- 3
- #f))
- (if (unsafe-fx< index_3 13)
- (let-values ()
- (let-values (((ok?_25 gs80_0 quot81_0 datum82_0)
- (let-values (((s_384) e_49))
- (if (let-values (((s_385)
- (if (1/syntax?
- s_384)
- (syntax-e$2
- s_384)
- s_384)))
- (if (pair? s_385)
- (if (let-values (((s_386)
- (car
- s_385)))
- #t)
- (let-values (((s_387)
- (cdr
- s_385)))
- (let-values (((s_388)
- (if (1/syntax?
- s_387)
- (syntax-e$2
- s_387)
- s_387)))
- (if (pair? s_388)
- (if (let-values (((s_389)
- (car
- s_388)))
- (let-values (((s_390)
- (if (1/syntax?
- s_389)
- (syntax-e$2
- s_389)
- s_389)))
- (if (pair?
- s_390)
- (if (let-values (((s_391)
+ s_552)))
+ #t)
+ (let-values (((s_554)
+ (cdr
+ s_552)))
+ (let-values (((s_555)
+ (if (1/syntax?
+ s_554)
+ (syntax-e$2
+ s_554)
+ s_554)))
+ (null?
+ s_555)))
+ #f)
+ #f)))
+ #f)
+ #f)))
+ #f)
+ #f)))
+ #f)
+ #f))
+ (let-values ()
+ (let-values (((_91_1
+ id:rator92_1
+ id:arg93_1
+ thn94_1
+ els95_1)
+ (let-values (((s_556)
+ (if (1/syntax?
+ s_535)
+ (syntax-e$2
+ s_535)
+ s_535)))
+ (let-values (((_96_0)
+ (let-values (((s_557)
(car
- s_390)))
- #t)
- (let-values (((s_146)
- (cdr
- s_390)))
- (let-values (((s_392)
- (if (1/syntax?
- s_146)
- (syntax-e$2
- s_146)
- s_146)))
- (if (pair?
- s_392)
- (if (let-values (((s_393)
- (car
- s_392)))
- #t)
- (let-values (((s_394)
- (cdr
- s_392)))
- (let-values (((s_395)
- (if (1/syntax?
- s_394)
- (syntax-e$2
- s_394)
- s_394)))
- (null?
- s_395)))
- #f)
- #f)))
- #f)
- #f)))
- (let-values (((s_396)
- (cdr
- s_388)))
- (let-values (((s_397)
- (if (1/syntax?
- s_396)
- (syntax-e$2
- s_396)
- s_396)))
- (null?
- s_397)))
- #f)
- #f)))
- #f)
- #f))
- (let-values ()
- (let-values (((gs80_1
- quot81_1
- datum82_1)
- (let-values (((s_398)
- (if (1/syntax?
- s_384)
- (syntax-e$2
- s_384)
- s_384)))
- (let-values (((gs83_0)
- (let-values (((s_260)
- (car
- s_398)))
- s_260))
- ((quot84_0
- datum85_0)
- (let-values (((s_399)
- (cdr
- s_398)))
- (let-values (((s_400)
- (if (1/syntax?
- s_399)
- (syntax-e$2
- s_399)
- s_399)))
- (let-values (((quot86_0
- datum87_0)
- (let-values (((s_262)
- (car
- s_400)))
- (let-values (((s_263)
- (if (1/syntax?
- s_262)
- (syntax-e$2
- s_262)
- s_262)))
- (let-values (((quot88_0)
- (let-values (((s_264)
- (car
- s_263)))
- s_264))
- ((datum89_0)
- (let-values (((s_265)
- (cdr
- s_263)))
- (let-values (((s_147)
- (if (1/syntax?
- s_265)
- (syntax-e$2
- s_265)
- s_265)))
- (let-values (((datum90_0)
- (let-values (((s_401)
- (car
- s_147)))
- s_401))
- (()
- (let-values (((s_402)
- (cdr
- s_147)))
- (let-values (((s_403)
- (if (1/syntax?
- s_402)
- (syntax-e$2
- s_402)
- s_402)))
- (values)))))
- (values
- datum90_0))))))
- (values
- quot88_0
- datum89_0)))))
- (()
- (let-values (((s_404)
- (cdr
- s_400)))
- (let-values (((s_405)
- (if (1/syntax?
- s_404)
- (syntax-e$2
- s_404)
- s_404)))
- (values)))))
- (values
- quot86_0
- datum87_0))))))
- (values
- gs83_0
- quot84_0
- datum85_0)))))
- (values
- #t
- gs80_1
- quot81_1
- datum82_1)))
- (values #f #f #f #f)))))
- (if (let-values (((or-part_234)
- (if ok?_25
- (if (eq? 'quote quot81_0)
- (let-values (((or-part_235)
- (symbol?
- datum82_0)))
- (if or-part_235
- or-part_235
- (string?
- datum82_0)))
- #f)
- #f)))
- (if or-part_234
- or-part_234
- (null? (cdr (correlated-e e_49)))))
- 1
- #f)))
- (let-values ()
- (let-values (((ok?_26
- _91_0
- id:rator92_0
- id:arg93_0
+ s_556)))
+ s_557))
+ ((id:rator97_0
+ id:arg98_0
+ thn99_0
+ els100_0)
+ (let-values (((s_558)
+ (cdr
+ s_556)))
+ (let-values (((s_559)
+ (if (1/syntax?
+ s_558)
+ (syntax-e$2
+ s_558)
+ s_558)))
+ (let-values (((id:rator101_0
+ id:arg102_0)
+ (let-values (((s_560)
+ (car
+ s_559)))
+ (let-values (((s_561)
+ (if (1/syntax?
+ s_560)
+ (syntax-e$2
+ s_560)
+ s_560)))
+ (let-values (((id:rator105_0)
+ (let-values (((s_562)
+ (car
+ s_561)))
+ s_562))
+ ((id:arg106_0)
+ (let-values (((s_563)
+ (cdr
+ s_561)))
+ (let-values (((s_564)
+ (if (1/syntax?
+ s_563)
+ (syntax-e$2
+ s_563)
+ s_563)))
+ (let-values (((id:arg107_0)
+ (let-values (((s_565)
+ (car
+ s_564)))
+ s_565))
+ (()
+ (let-values (((s_566)
+ (cdr
+ s_564)))
+ (let-values (((s_567)
+ (if (1/syntax?
+ s_566)
+ (syntax-e$2
+ s_566)
+ s_566)))
+ (values)))))
+ (values
+ id:arg107_0))))))
+ (values
+ id:rator105_0
+ id:arg106_0)))))
+ ((thn103_0
+ els104_0)
+ (let-values (((s_568)
+ (cdr
+ s_559)))
+ (let-values (((s_569)
+ (if (1/syntax?
+ s_568)
+ (syntax-e$2
+ s_568)
+ s_568)))
+ (let-values (((thn108_0)
+ (let-values (((s_570)
+ (car
+ s_569)))
+ s_570))
+ ((els109_0)
+ (let-values (((s_571)
+ (cdr
+ s_569)))
+ (let-values (((s_572)
+ (if (1/syntax?
+ s_571)
+ (syntax-e$2
+ s_571)
+ s_571)))
+ (let-values (((els110_0)
+ (let-values (((s_573)
+ (car
+ s_572)))
+ s_573))
+ (()
+ (let-values (((s_574)
+ (cdr
+ s_572)))
+ (let-values (((s_575)
+ (if (1/syntax?
+ s_574)
+ (syntax-e$2
+ s_574)
+ s_574)))
+ (values)))))
+ (values
+ els110_0))))))
+ (values
+ thn108_0
+ els109_0))))))
+ (values
+ id:rator101_0
+ id:arg102_0
+ thn103_0
+ els104_0))))))
+ (values
+ _96_0
+ id:rator97_0
+ id:arg98_0
+ thn99_0
+ els100_0)))))
+ (values
+ #t
+ _91_1
+ id:rator92_1
+ id:arg93_1
+ thn94_1
+ els95_1)))
+ (values #f #f #f #f #f #f)))))
+ (if ok?_27
+ (let-values (((cond-val_20)
+ (let-values (((or-part_393)
+ (hash-ref
+ locals_2
+ id:rator92_0
+ #f)))
+ (if or-part_393
+ or-part_393
+ (lookup-defn
+ defns_1
+ id:rator92_0)))))
+ (if cond-val_20
+ ((lambda (d_37)
+ (if (known-predicate? d_37)
+ (if (not
+ (effects?_0
thn94_0
- els95_0)
- (let-values (((s_406) e_49))
- (if (let-values (((s_267)
+ expected-results_0
+ (hash-set
+ locals_2
+ id:arg93_0
+ (known-satisfies8.1
+ (known-predicate-key d_37)))))
+ (loop_106 els95_0 locals_2)
+ #f)
+ #f))
+ cond-val_20)
+ #f))
+ (let-values (((ok?_28
+ _111_0
+ tst112_0
+ thn113_0
+ els114_0)
+ (let-values (((s_576) e_54))
+ (if (let-values (((s_577)
(if (1/syntax?
- s_406)
+ s_576)
(syntax-e$2
- s_406)
- s_406)))
- (if (pair? s_267)
- (if (let-values (((s_268)
+ s_576)
+ s_576)))
+ (if (pair? s_577)
+ (if (let-values (((s_578)
(car
- s_267)))
+ s_577)))
#t)
- (let-values (((s_269)
+ (let-values (((s_579)
(cdr
- s_267)))
- (let-values (((s_407)
+ s_577)))
+ (let-values (((s_580)
(if (1/syntax?
- s_269)
+ s_579)
(syntax-e$2
- s_269)
- s_269)))
- (if (pair? s_407)
- (if (let-values (((s_408)
+ s_579)
+ s_579)))
+ (if (pair? s_580)
+ (if (let-values (((s_581)
(car
- s_407)))
- (let-values (((s_409)
- (if (1/syntax?
- s_408)
- (syntax-e$2
- s_408)
- s_408)))
- (if (pair?
- s_409)
- (if (let-values (((s_270)
- (car
- s_409)))
- (let-values (((or-part_202)
- (if (1/syntax?
- s_270)
- (symbol?
- (syntax-e$2
- s_270))
- #f)))
- (if or-part_202
- or-part_202
- (symbol?
- s_270))))
- (let-values (((s_271)
- (cdr
- s_409)))
- (let-values (((s_272)
- (if (1/syntax?
- s_271)
- (syntax-e$2
- s_271)
- s_271)))
- (if (pair?
- s_272)
- (if (let-values (((s_410)
- (car
- s_272)))
- (let-values (((or-part_236)
- (if (1/syntax?
- s_410)
- (symbol?
- (syntax-e$2
- s_410))
- #f)))
- (if or-part_236
- or-part_236
- (symbol?
- s_410))))
- (let-values (((s_273)
- (cdr
- s_272)))
- (let-values (((s_274)
- (if (1/syntax?
- s_273)
- (syntax-e$2
- s_273)
- s_273)))
- (null?
- s_274)))
- #f)
- #f)))
- #f)
- #f)))
- (let-values (((s_275)
+ s_580)))
+ #t)
+ (let-values (((s_582)
(cdr
- s_407)))
- (let-values (((s_411)
+ s_580)))
+ (let-values (((s_583)
(if (1/syntax?
- s_275)
+ s_582)
(syntax-e$2
- s_275)
- s_275)))
+ s_582)
+ s_582)))
(if (pair?
- s_411)
- (if (let-values (((s_412)
+ s_583)
+ (if (let-values (((s_584)
(car
- s_411)))
+ s_583)))
#t)
- (let-values (((s_413)
+ (let-values (((s_585)
(cdr
- s_411)))
- (let-values (((s_414)
+ s_583)))
+ (let-values (((s_586)
(if (1/syntax?
- s_413)
+ s_585)
(syntax-e$2
- s_413)
- s_413)))
+ s_585)
+ s_585)))
(if (pair?
- s_414)
- (if (let-values (((s_415)
+ s_586)
+ (if (let-values (((s_587)
(car
- s_414)))
+ s_586)))
#t)
- (let-values (((s_416)
+ (let-values (((s_588)
(cdr
- s_414)))
- (let-values (((s_276)
+ s_586)))
+ (let-values (((s_589)
(if (1/syntax?
- s_416)
+ s_588)
(syntax-e$2
- s_416)
- s_416)))
+ s_588)
+ s_588)))
(null?
- s_276)))
+ s_589)))
#f)
#f)))
#f)
@@ -38237,443 +38511,172 @@
#f)
#f))
(let-values ()
- (let-values (((_91_1
- id:rator92_1
- id:arg93_1
- thn94_1
- els95_1)
- (let-values (((s_417)
+ (let-values (((_111_1
+ tst112_1
+ thn113_1
+ els114_1)
+ (let-values (((s_590)
(if (1/syntax?
- s_406)
+ s_576)
(syntax-e$2
- s_406)
- s_406)))
- (let-values (((_96_0)
- (let-values (((s_418)
+ s_576)
+ s_576)))
+ (let-values (((_115_0)
+ (let-values (((s_591)
(car
- s_417)))
- s_418))
- ((id:rator97_0
- id:arg98_0
- thn99_0
- els100_0)
- (let-values (((s_419)
+ s_590)))
+ s_591))
+ ((tst116_0
+ thn117_0
+ els118_0)
+ (let-values (((s_592)
(cdr
- s_417)))
- (let-values (((s_420)
+ s_590)))
+ (let-values (((s_593)
(if (1/syntax?
- s_419)
+ s_592)
(syntax-e$2
- s_419)
- s_419)))
- (let-values (((id:rator101_0
- id:arg102_0)
- (let-values (((s_421)
+ s_592)
+ s_592)))
+ (let-values (((tst119_0)
+ (let-values (((s_594)
(car
- s_420)))
- (let-values (((s_422)
- (if (1/syntax?
- s_421)
- (syntax-e$2
- s_421)
- s_421)))
- (let-values (((id:rator105_0)
- (let-values (((s_423)
- (car
- s_422)))
- s_423))
- ((id:arg106_0)
- (let-values (((s_424)
- (cdr
- s_422)))
- (let-values (((s_157)
- (if (1/syntax?
- s_424)
- (syntax-e$2
- s_424)
- s_424)))
- (let-values (((id:arg107_0)
- (let-values (((s_425)
- (car
- s_157)))
- s_425))
- (()
- (let-values (((s_426)
- (cdr
- s_157)))
- (let-values (((s_427)
- (if (1/syntax?
- s_426)
- (syntax-e$2
- s_426)
- s_426)))
- (values)))))
- (values
- id:arg107_0))))))
- (values
- id:rator105_0
- id:arg106_0)))))
- ((thn103_0
- els104_0)
- (let-values (((s_428)
+ s_593)))
+ s_594))
+ ((thn120_0
+ els121_0)
+ (let-values (((s_595)
(cdr
- s_420)))
- (let-values (((s_278)
+ s_593)))
+ (let-values (((s_596)
(if (1/syntax?
- s_428)
+ s_595)
(syntax-e$2
- s_428)
- s_428)))
- (let-values (((thn108_0)
- (let-values (((s_429)
+ s_595)
+ s_595)))
+ (let-values (((thn122_0)
+ (let-values (((s_597)
(car
- s_278)))
- s_429))
- ((els109_0)
- (let-values (((s_430)
+ s_596)))
+ s_597))
+ ((els123_0)
+ (let-values (((s_598)
(cdr
- s_278)))
- (let-values (((s_279)
+ s_596)))
+ (let-values (((s_599)
(if (1/syntax?
- s_430)
+ s_598)
(syntax-e$2
- s_430)
- s_430)))
- (let-values (((els110_0)
- (let-values (((s_161)
+ s_598)
+ s_598)))
+ (let-values (((els124_0)
+ (let-values (((s_600)
(car
- s_279)))
- s_161))
+ s_599)))
+ s_600))
(()
- (let-values (((s_162)
+ (let-values (((s_601)
(cdr
- s_279)))
- (let-values (((s_431)
+ s_599)))
+ (let-values (((s_602)
(if (1/syntax?
- s_162)
+ s_601)
(syntax-e$2
- s_162)
- s_162)))
+ s_601)
+ s_601)))
(values)))))
(values
- els110_0))))))
+ els124_0))))))
(values
- thn108_0
- els109_0))))))
+ thn122_0
+ els123_0))))))
(values
- id:rator101_0
- id:arg102_0
- thn103_0
- els104_0))))))
+ tst119_0
+ thn120_0
+ els121_0))))))
(values
- _96_0
- id:rator97_0
- id:arg98_0
- thn99_0
- els100_0)))))
+ _115_0
+ tst116_0
+ thn117_0
+ els118_0)))))
(values
#t
- _91_1
- id:rator92_1
- id:arg93_1
- thn94_1
- els95_1)))
- (values #f #f #f #f #f #f)))))
- (if ok?_26
- (let-values ()
- (let-values (((c2_3)
- (let-values (((or-part_237)
- (hash-ref
- locals_2
- id:rator92_0
- #f)))
- (if or-part_237
- or-part_237
- (lookup-defn
- defns_1
- id:rator92_0)))))
- (if c2_3
- ((lambda (d_37)
- (if (known-predicate? d_37)
- (if (not
- (effects?_0
- thn94_0
- expected-results_0
- (hash-set
- locals_2
- id:arg93_0
- (known-satisfies8.1
- (known-predicate-key
- d_37)))))
- (loop_44 els95_0 locals_2)
- #f)
- #f))
- c2_3)
- (let-values () #f))))
- (let-values ()
- (let-values (((ok?_27
- _111_0
- tst112_0
- thn113_0
- els114_0)
- (let-values (((s_432) e_49))
- (if (let-values (((s_433)
- (if (1/syntax?
- s_432)
- (syntax-e$2
- s_432)
- s_432)))
- (if (pair? s_433)
- (if (let-values (((s_434)
- (car
- s_433)))
- #t)
- (let-values (((s_435)
- (cdr
- s_433)))
- (let-values (((s_436)
- (if (1/syntax?
- s_435)
- (syntax-e$2
- s_435)
- s_435)))
- (if (pair?
- s_436)
- (if (let-values (((s_437)
- (car
- s_436)))
- #t)
- (let-values (((s_438)
- (cdr
- s_436)))
- (let-values (((s_439)
- (if (1/syntax?
- s_438)
- (syntax-e$2
- s_438)
- s_438)))
- (if (pair?
- s_439)
- (if (let-values (((s_440)
- (car
- s_439)))
- #t)
- (let-values (((s_441)
- (cdr
- s_439)))
- (let-values (((s_442)
- (if (1/syntax?
- s_441)
- (syntax-e$2
- s_441)
- s_441)))
- (if (pair?
- s_442)
- (if (let-values (((s_443)
- (car
- s_442)))
- #t)
- (let-values (((s_444)
- (cdr
- s_442)))
- (let-values (((s_445)
- (if (1/syntax?
- s_444)
- (syntax-e$2
- s_444)
- s_444)))
- (null?
- s_445)))
- #f)
- #f)))
- #f)
- #f)))
- #f)
- #f)))
- #f)
- #f))
- (let-values ()
- (let-values (((_111_1
- tst112_1
- thn113_1
- els114_1)
- (let-values (((s_446)
- (if (1/syntax?
- s_432)
- (syntax-e$2
- s_432)
- s_432)))
- (let-values (((_115_0)
- (let-values (((s_447)
- (car
- s_446)))
- s_447))
- ((tst116_0
- thn117_0
- els118_0)
- (let-values (((s_448)
- (cdr
- s_446)))
- (let-values (((s_449)
- (if (1/syntax?
- s_448)
- (syntax-e$2
- s_448)
- s_448)))
- (let-values (((tst119_0)
- (let-values (((s_450)
- (car
- s_449)))
- s_450))
- ((thn120_0
- els121_0)
- (let-values (((s_451)
- (cdr
- s_449)))
- (let-values (((s_452)
- (if (1/syntax?
- s_451)
- (syntax-e$2
- s_451)
- s_451)))
- (let-values (((thn122_0)
- (let-values (((s_453)
- (car
- s_452)))
- s_453))
- ((els123_0)
- (let-values (((s_454)
- (cdr
- s_452)))
- (let-values (((s_455)
- (if (1/syntax?
- s_454)
- (syntax-e$2
- s_454)
- s_454)))
- (let-values (((els124_0)
- (let-values (((s_456)
- (car
- s_455)))
- s_456))
- (()
- (let-values (((s_195)
- (cdr
- s_455)))
- (let-values (((s_457)
- (if (1/syntax?
- s_195)
- (syntax-e$2
- s_195)
- s_195)))
- (values)))))
- (values
- els124_0))))))
- (values
- thn122_0
- els123_0))))))
- (values
- tst119_0
- thn120_0
- els121_0))))))
- (values
- _115_0
- tst116_0
- thn117_0
- els118_0)))))
- (values
- #t
- _111_1
- tst112_1
- thn113_1
- els114_1)))
- (values
- #f
- #f
- #f
- #f
- #f)))))
- (if ok?_27
- (if (not
- (effects?_0 tst112_0 1 locals_2))
- (if (not
- (effects?_0
- thn113_0
- expected-results_0
- locals_2))
- (loop_44 els114_0 locals_2)
- #f)
- #f)
- #f)))))))))))))))))
- loop_44)
- e_48
- locals_0)))
- (not
- (if actual-results_0
- (let-values (((or-part_238) (not expected-results_0)))
- (if or-part_238 or-part_238 (= actual-results_0 expected-results_0)))
- #f)))))))))))))
+ _111_1
+ tst112_1
+ thn113_1
+ els114_1)))
+ (values #f #f #f #f #f)))))
+ (if ok?_28
+ (if (not (effects?_0 tst112_0 1 locals_2))
+ (if (not
+ (effects?_0
+ thn113_0
+ expected-results_0
+ locals_2))
+ (loop_106 els114_0 locals_2)
+ #f)
+ #f)
+ #f)))))))))))))))
+ loop_106)
+ e_52
+ locals_0)))
+ (not
+ (if actual-results_0
+ (let-values (((or-part_394) (not expected-results_0)))
+ (if or-part_394 or-part_394 (= actual-results_0 expected-results_0)))
+ #f))))))))))))
(define-values
(satisfies?)
- (lambda (e_70 key_70 defns_2 locals_3)
+ (lambda (e_79 key_74 defns_2 locals_3)
(begin
(let-values (((d_38)
- (let-values (((or-part_239) (hash-ref locals_3 e_70 #f)))
- (if or-part_239 or-part_239 (lookup-defn defns_2 e_70)))))
+ (let-values (((or-part_395) (hash-ref locals_3 e_79 #f)))
+ (if or-part_395 or-part_395 (lookup-defn defns_2 e_79)))))
(let-values (((known-key_0)
- (let-values (((or-part_240)
+ (let-values (((or-part_396)
(if d_38 (if (known-satisfies? d_38) (known-satisfies-predicate-key d_38) #f) #f)))
- (if or-part_240
- or-part_240
- (if (not e_70)
- (let-values () 'false)
- (if (exact-integer? e_70)
- (let-values () 'exact-integer)
- (if (pair? e_70)
- (let-values ()
- (let-values (((head_0) (car e_70)))
- (if (eq? head_0 'quote)
- (let-values ()
- (let-values (((v_172) (cadr e_70)))
- (if (symbol? v_172) (let-values () 'symbol) (let-values () #f))))
- (let-values ()
- (let-values (((p_42) (lookup-defn defns_2 head_0)))
- (if (known-function-of-satisfying? p_42)
- (let-values () (known-function-of-satisfying-result-key p_42))
- (let-values () #f)))))))
- (let-values () #f))))))))
+ (if or-part_396
+ or-part_396
+ (if (not e_79)
+ 'false
+ (if (exact-integer? e_79)
+ 'exact-integer
+ (if (pair? e_79)
+ (let-values (((head_0) (car e_79)))
+ (if (eq? head_0 'quote)
+ (let-values (((v_237) (cadr e_79))) (if (symbol? v_237) 'symbol #f))
+ (let-values (((p_47) (lookup-defn defns_2 head_0)))
+ (if (known-function-of-satisfying? p_47)
+ (known-function-of-satisfying-result-key p_47)
+ #f))))
+ #f)))))))
(if known-key_0
- (let-values (((or-part_241) (eq? key_70 known-key_0)))
- (if or-part_241
- or-part_241
- (if (pair? key_70)
- (if (eq? 'or (car key_70))
- (let-values (((lst_249) (cdr key_70)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_249)))
- ((letrec-values (((for-loop_240)
- (lambda (result_101 lst_250)
- (begin
- 'for-loop
- (if (pair? lst_250)
- (let-values (((key_71) (unsafe-car lst_250))
- ((rest_129) (unsafe-cdr lst_250)))
- (let-values (((result_102)
- (let-values ()
- (let-values (((result_103)
- (let-values ()
- (let-values ()
- (eq? key_71 known-key_0)))))
- (values result_103)))))
- (if (if (not ((lambda x_70 result_102) key_71)) (not #f) #f)
- (for-loop_240 result_102 rest_129)
- result_102)))
- result_101)))))
- for-loop_240)
- #f
- lst_249)))
+ (let-values (((or-part_397) (eq? key_74 known-key_0)))
+ (if or-part_397
+ or-part_397
+ (if (pair? key_74)
+ (if (eq? 'or (car key_74))
+ (let-values (((result_189) (let-values (((result_190) #f)) result_190)))
+ (let-values (((lst_378) (cdr key_74)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_378))
+ ((letrec-values (((for-loop_323)
+ (lambda (result_191 lst_379)
+ (begin
+ 'for-loop
+ (if (pair? lst_379)
+ (let-values (((key_75) (unsafe-car lst_379))
+ ((rest_185) (unsafe-cdr lst_379)))
+ (let-values (((result_192)
+ (let-values (((result_193) (eq? key_75 known-key_0)))
+ (values result_193))))
+ (if (if (not ((lambda x_77 result_192) key_75)) (not #f) #f)
+ (for-loop_323 result_192 rest_185)
+ result_192)))
+ result_191)))))
+ for-loop_323)
+ result_189
+ lst_378))))
#f)
#f)))
#f))))))
@@ -38681,615 +38684,576 @@
(add-binding-info)
(lambda (locals_4 idss_0 rhss_0)
(begin
- (let-values (((lst_251) idss_0) ((lst_252) rhss_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_251)))
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_252)))
- ((letrec-values (((for-loop_99)
- (lambda (locals_5 lst_253 lst_254)
- (begin
- 'for-loop
- (if (if (pair? lst_253) (pair? lst_254) #f)
- (let-values (((ids_15) (unsafe-car lst_253))
- ((rest_130) (unsafe-cdr lst_253))
- ((rhs_10) (unsafe-car lst_254))
- ((rest_131) (unsafe-cdr lst_254)))
- (let-values (((locals_6)
- (let-values (((locals_7) locals_5))
- (let-values (((locals_8)
- (let-values ()
- ((letrec-values (((loop_87)
- (lambda (rhs_11)
- (begin
- 'loop
- (let-values (((tmp_27)
- (if (pair?
- (correlated-e
- rhs_11))
+ (let-values (((locals_5) (let-values (((locals_6) locals_4)) locals_6)))
+ (let-values (((lst_380) idss_0) ((lst_381) rhss_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_380))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_381))
+ ((letrec-values (((for-loop_324)
+ (lambda (locals_7 lst_382 lst_383)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_382) (pair? lst_383) #f)
+ (let-values (((ids_16) (unsafe-car lst_382))
+ ((rest_186) (unsafe-cdr lst_382))
+ ((rhs_11) (unsafe-car lst_383))
+ ((rest_187) (unsafe-cdr lst_383)))
+ (let-values (((locals_8)
+ (let-values (((locals_9)
+ ((letrec-values (((loop_107)
+ (lambda (rhs_12)
+ (begin
+ 'loop
+ (let-values (((tmp_28)
+ (if (pair?
+ (correlated-e
+ rhs_12))
+ (correlated-e
+ (car
(correlated-e
- (car
- (correlated-e
- rhs_11)))
- #f)))
+ rhs_12)))
+ #f)))
+ (if (equal?
+ tmp_28
+ 'make-struct-type)
+ (let-values (((field-count_0)
+ (extract-struct-field-count-lower-bound
+ rhs_12)))
+ (let-values (((locals_10)
+ (let-values (((locals_11)
+ locals_7))
+ locals_11)))
+ (let-values (((lst_384)
+ (correlated->list
+ ids_16))
+ ((lst_385)
+ '(struct-type
+ constructor
+ predicate
+ general-accessor
+ general-mutator)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_384))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_385))
+ ((letrec-values (((for-loop_325)
+ (lambda (locals_12
+ lst_386
+ lst_387)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_386)
+ (pair?
+ lst_387)
+ #f)
+ (let-values (((id_69)
+ (unsafe-car
+ lst_386))
+ ((rest_188)
+ (unsafe-cdr
+ lst_386))
+ ((type_1)
+ (unsafe-car
+ lst_387))
+ ((rest_189)
+ (unsafe-cdr
+ lst_387)))
+ (let-values (((locals_13)
+ (let-values (((locals_14)
+ (hash-set
+ locals_12
+ (correlated-e
+ id_69)
+ (known-struct-op9.1
+ type_1
+ field-count_0))))
+ (values
+ locals_14))))
+ (if (not
+ #f)
+ (for-loop_325
+ locals_13
+ rest_188
+ rest_189)
+ locals_13)))
+ locals_12)))))
+ for-loop_325)
+ locals_10
+ lst_384
+ lst_385)))))
(if (equal?
- tmp_27
- 'make-struct-type)
- (let-values ()
- (let-values (((field-count_0)
- (extract-struct-field-count-lower-bound
- rhs_11)))
- (let-values (((lst_255)
- (correlated->list
- ids_15))
- ((lst_256)
- '(struct-type
- constructor
- predicate
- general-accessor
- general-mutator)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_255)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
+ tmp_28
+ 'let-values)
+ (if (null?
+ (correlated-e
+ (correlated-cadr
+ rhs_12)))
+ (loop_107
+ (caddr
+ (correlated->list
+ rhs_12)))
+ (loop_107 #f))
+ (let-values (((ids*_0)
+ (correlated->list
+ ids_16)))
+ (if (if (pair? ids*_0)
+ (null?
+ (cdr ids*_0))
+ #f)
+ (hash-set
+ locals_7
+ (correlated-e
+ (car ids*_0))
+ (infer-known rhs_12))
+ (let-values (((locals_15)
+ (let-values (((locals_16)
+ locals_7))
+ locals_16)))
+ (let-values (((lst_388)
+ ids*_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
(check-list
- lst_256)))
- ((letrec-values (((for-loop_241)
- (lambda (locals_9
- lst_257
- lst_258)
- (begin
- 'for-loop
- (if (if (pair?
- lst_257)
- (pair?
- lst_258)
- #f)
- (let-values (((id_61)
- (unsafe-car
- lst_257))
- ((rest_132)
- (unsafe-cdr
- lst_257))
- ((type_1)
- (unsafe-car
- lst_258))
- ((rest_133)
- (unsafe-cdr
- lst_258)))
- (let-values (((locals_10)
- (let-values (((locals_11)
- locals_9))
- (let-values (((locals_12)
- (let-values ()
- (hash-set
- locals_11
- (correlated-e
- id_61)
- (known-struct-op9.1
- type_1
- field-count_0)))))
+ lst_388))
+ ((letrec-values (((for-loop_326)
+ (lambda (locals_17
+ lst_389)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_389)
+ (let-values (((id_70)
+ (unsafe-car
+ lst_389))
+ ((rest_190)
+ (unsafe-cdr
+ lst_389)))
+ (let-values (((locals_18)
+ (let-values (((locals_19)
+ (hash-set
+ locals_17
+ (correlated-e
+ id_70)
+ #t)))
(values
- locals_12)))))
- (if (not
- #f)
- (for-loop_241
- locals_10
- rest_132
- rest_133)
- locals_10)))
- locals_9)))))
- for-loop_241)
- locals_7
- lst_255
- lst_256)))))
- (if (equal?
- tmp_27
- 'let-values)
- (let-values ()
- (if (null?
- (correlated-e
- (correlated-cadr
- rhs_11)))
- (loop_87
- (caddr
- (correlated->list
- rhs_11)))
- (loop_87 #f)))
- (let-values ()
- (let-values (((ids*_0)
- (correlated->list
- ids_15)))
- (if (if (pair?
- ids*_0)
- (null?
- (cdr ids*_0))
- #f)
- (let-values ()
- (hash-set
- locals_7
- (correlated-e
- (car ids*_0))
- (infer-known
- rhs_11)))
- (let-values ()
- (let-values (((lst_259)
- ids*_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_259)))
- ((letrec-values (((for-loop_242)
- (lambda (locals_13
- lst_260)
- (begin
- 'for-loop
- (if (pair?
- lst_260)
- (let-values (((id_62)
- (unsafe-car
- lst_260))
- ((rest_134)
- (unsafe-cdr
- lst_260)))
- (let-values (((locals_14)
- (let-values (((locals_15)
- locals_13))
- (let-values (((locals_16)
- (let-values ()
- (hash-set
- locals_15
- (correlated-e
- id_62)
- #t))))
- (values
- locals_16)))))
- (if (not
- #f)
- (for-loop_242
- locals_14
- rest_134)
- locals_14)))
- locals_13)))))
- for-loop_242)
- locals_7
- lst_259))))))))))))))
- loop_87)
- rhs_10))))
- (values locals_8)))))
- (if (not #f) (for-loop_99 locals_6 rest_130 rest_131) locals_6)))
- locals_5)))))
- for-loop_99)
- locals_4
- lst_251
- lst_252))))))
+ locals_19))))
+ (if (not
+ #f)
+ (for-loop_326
+ locals_18
+ rest_190)
+ locals_18)))
+ locals_17)))))
+ for-loop_326)
+ locals_15
+ lst_388)))))))))))))
+ loop_107)
+ rhs_11)))
+ (values locals_9))))
+ (if (not #f) (for-loop_324 locals_8 rest_186 rest_187) locals_8)))
+ locals_7)))))
+ for-loop_324)
+ locals_5
+ lst_380
+ lst_381)))))))
(define-values
(infer-known)
- (lambda (e_71)
+ (lambda (e_80)
(begin
- (let-values (((tmp_28) (if (pair? (correlated-e e_71)) (correlated-e (car (correlated-e e_71))) #f)))
- (if (if (equal? tmp_28 'lambda) #t (equal? tmp_28 'case-lambda))
- (let-values () (known-satisfies8.1 'procedure))
- (let-values () #t))))))
+ (let-values (((tmp_29) (if (pair? (correlated-e e_80)) (correlated-e (car (correlated-e e_80))) #f)))
+ (if (if (equal? tmp_29 'lambda) #t (equal? tmp_29 'case-lambda)) (known-satisfies8.1 'procedure) #t)))))
(define-values
(ok-make-struct-type-property?)
- (lambda (e_72 defns_3)
+ (lambda (e_81 defns_3)
(begin
- (let-values (((l_43) (correlated->list e_72)))
- (if (<= 2 (length l_43) 8)
- (let-values (((lst_261) (cdr l_43))
- ((lst_262)
- (list
- (lambda (v_173) (quoted? symbol? v_173))
- (lambda (v_174) (is-lambda? v_174 2 defns_3))
- (lambda (v_175) (ok-make-struct-type-property-super? v_175 defns_3))
- (lambda (v_176)
- (not
- (let-values (((v125_0) v_176) ((temp126_0) 1) ((defns127_0) defns_3))
- (any-side-effects?.1 defns127_0 '#hasheq() unsafe-undefined v125_0 temp126_0))))
- (lambda (v_177) (quoted? symbol? v_177))
- (lambda (v_178)
- (quoted?
- (lambda (x_71)
- (let-values (((or-part_242) (not x_71)))
- (if or-part_242
- or-part_242
- (let-values (((or-part_243) (symbol? x_71)))
- (if or-part_243 or-part_243 (string? x_71))))))
- v_178))
- (lambda (v_179) (quoted? symbol? v_179)))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_261)))
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_262)))
- ((letrec-values (((for-loop_243)
- (lambda (result_104 lst_263 lst_264)
- (begin
- 'for-loop
- (if (if (pair? lst_263) (pair? lst_264) #f)
- (let-values (((arg_0) (unsafe-car lst_263))
- ((rest_135) (unsafe-cdr lst_263))
- ((pred_1) (unsafe-car lst_264))
- ((rest_136) (unsafe-cdr lst_264)))
- (let-values (((result_105)
- (let-values ()
- (let-values (((result_106)
- (let-values () (let-values () (pred_1 arg_0)))))
- (values result_106)))))
- (if (if (not ((lambda x_72 (not result_105)) arg_0))
- (if (not ((lambda x_73 (not result_105)) pred_1)) (not #f) #f)
- #f)
- (for-loop_243 result_105 rest_135 rest_136)
- result_105)))
- result_104)))))
- for-loop_243)
- #t
- lst_261
- lst_262)))
+ (let-values (((l_52) (correlated->list e_81)))
+ (if (<= 2 (length l_52) 8)
+ (let-values (((result_194) (let-values (((result_195) #t)) result_195)))
+ (let-values (((lst_390) (cdr l_52))
+ ((lst_391)
+ (list
+ (lambda (v_238) (quoted? symbol? v_238))
+ (lambda (v_239) (is-lambda? v_239 2 defns_3))
+ (lambda (v_240) (ok-make-struct-type-property-super? v_240 defns_3))
+ (lambda (v_241)
+ (not
+ (let-values (((v125_0) v_241) ((temp126_1) 1) ((defns127_0) defns_3))
+ (any-side-effects?.1 defns127_0 '#hasheq() unsafe-undefined v125_0 temp126_1))))
+ (lambda (v_242) (quoted? symbol? v_242))
+ (lambda (v_243)
+ (quoted?
+ (lambda (x_78)
+ (let-values (((or-part_398) (not x_78)))
+ (if or-part_398
+ or-part_398
+ (let-values (((or-part_399) (symbol? x_78)))
+ (if or-part_399 or-part_399 (string? x_78))))))
+ v_243))
+ (lambda (v_244) (quoted? symbol? v_244)))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_390))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_391))
+ ((letrec-values (((for-loop_327)
+ (lambda (result_196 lst_392 lst_393)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_392) (pair? lst_393) #f)
+ (let-values (((arg_0) (unsafe-car lst_392))
+ ((rest_191) (unsafe-cdr lst_392))
+ ((pred_1) (unsafe-car lst_393))
+ ((rest_192) (unsafe-cdr lst_393)))
+ (let-values (((result_197)
+ (let-values (((result_198) (pred_1 arg_0)))
+ (values result_198))))
+ (if (if (not ((lambda x_79 (not result_197)) arg_0))
+ (if (not ((lambda x_80 (not result_197)) pred_1)) (not #f) #f)
+ #f)
+ (for-loop_327 result_197 rest_191 rest_192)
+ result_197)))
+ result_196)))))
+ for-loop_327)
+ result_194
+ lst_390
+ lst_391))))
#f)))))
(define-values
(ok-make-struct-type-property-super?)
- (lambda (v_180 defns_4)
- (begin
- (let-values (((or-part_244) (quoted? null? v_180)))
- (if or-part_244
- or-part_244
- (let-values (((or-part_245) (eq? 'null (correlated-e v_180))))
- (if or-part_245
- or-part_245
- (if (pair? (correlated-e v_180))
- (if (eq? (correlated-e (car (correlated-e v_180))) 'list)
- (if (let-values (((lst_265) (cdr (correlated->list v_180))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_265)))
- ((letrec-values (((for-loop_244)
- (lambda (result_107 lst_266)
- (begin
- 'for-loop
- (if (pair? lst_266)
- (let-values (((prop+val_0) (unsafe-car lst_266))
- ((rest_137) (unsafe-cdr lst_266)))
- (let-values (((result_108)
- (let-values ()
- (let-values (((result_109)
- (let-values ()
- (let-values ()
- (if (=
- (correlated-length
- prop+val_0)
- 3)
- (let-values (((prop+val_1)
- (correlated->list
- prop+val_0)))
- (if (eq?
- 'cons
- (correlated-e
- (car prop+val_1)))
- (if (let-values (((or-part_210)
- (memq
+ (lambda (v_245 defns_4)
+ (begin
+ (let-values (((or-part_400) (quoted? null? v_245)))
+ (if or-part_400
+ or-part_400
+ (let-values (((or-part_401) (eq? 'null (correlated-e v_245))))
+ (if or-part_401
+ or-part_401
+ (if (pair? (correlated-e v_245))
+ (if (eq? (correlated-e (car (correlated-e v_245))) 'list)
+ (if (let-values (((result_199) (let-values (((result_200) #t)) result_200)))
+ (let-values (((lst_394) (cdr (correlated->list v_245))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_394))
+ ((letrec-values (((for-loop_328)
+ (lambda (result_201 lst_395)
+ (begin
+ 'for-loop
+ (if (pair? lst_395)
+ (let-values (((prop+val_0) (unsafe-car lst_395))
+ ((rest_193) (unsafe-cdr lst_395)))
+ (let-values (((result_202)
+ (let-values (((result_203)
+ (if (=
+ (correlated-length prop+val_0)
+ 3)
+ (let-values (((prop+val_1)
+ (correlated->list
+ prop+val_0)))
+ (if (eq?
+ 'cons
+ (correlated-e
+ (car prop+val_1)))
+ (if (let-values (((or-part_402)
+ (memq
+ (correlated-e
+ (list-ref
+ prop+val_1
+ 1))
+ '(prop:procedure
+ prop:equal+hash))))
+ (if or-part_402
+ or-part_402
+ (let-values (((o_8)
+ (lookup-defn
+ defns_4
(correlated-e
(list-ref
prop+val_1
- 1))
- '(prop:procedure
- prop:equal+hash))))
- (if or-part_210
- or-part_210
- (let-values (((o_7)
- (lookup-defn
- defns_4
- (correlated-e
- (list-ref
- prop+val_1
- 1)))))
- (let-values (((or-part_246)
- (known-property?
- o_7)))
- (if or-part_246
- or-part_246
- (known-property-of-function?
- o_7))))))
- (not
- (let-values (((temp128_1)
- (list-ref
- prop+val_1
- 2))
- ((temp129_1)
- 1)
- ((defns130_0)
- defns_4))
- (any-side-effects?.1
- defns130_0
- '#hasheq()
- unsafe-undefined
- temp128_1
- temp129_1)))
- #f)
- #f))
- #f)))))
- (values result_109)))))
- (if (if (not ((lambda x_74 (not result_108)) prop+val_0))
- (not #f)
- #f)
- (for-loop_244 result_108 rest_137)
- result_108)))
- result_107)))))
- for-loop_244)
- #t
- lst_265)))
+ 1)))))
+ (let-values (((or-part_403)
+ (known-property?
+ o_8)))
+ (if or-part_403
+ or-part_403
+ (known-property-of-function?
+ o_8))))))
+ (not
+ (let-values (((temp128_0)
+ (list-ref
+ prop+val_1
+ 2))
+ ((temp129_0) 1)
+ ((defns130_0)
+ defns_4))
+ (any-side-effects?.1
+ defns130_0
+ '#hasheq()
+ unsafe-undefined
+ temp128_0
+ temp129_0)))
+ #f)
+ #f))
+ #f)))
+ (values result_203))))
+ (if (if (not ((lambda x_81 (not result_202)) prop+val_0))
+ (not #f)
+ #f)
+ (for-loop_328 result_202 rest_193)
+ result_202)))
+ result_201)))))
+ for-loop_328)
+ result_199
+ lst_394))))
(=
- (sub1 (correlated-length v_180))
+ (sub1 (correlated-length v_245))
(set-count
- (let-values (((lst_267) (cdr (correlated->list v_180))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_267)))
- ((letrec-values (((for-loop_245)
- (lambda (table_181 lst_268)
- (begin
- 'for-loop
- (if (pair? lst_268)
- (let-values (((prop+val_2) (unsafe-car lst_268))
- ((rest_138) (unsafe-cdr lst_268)))
- (let-values (((table_182)
- (let-values (((table_183) table_181))
- (let-values (((table_184)
- (let-values ()
- (let-values (((key_72 val_53)
- (let-values ()
- (values
- (let-values ()
- (correlated-e
- (list-ref
- (correlated->list
- prop+val_2)
- 1)))
- #t))))
- (hash-set
- table_183
- key_72
- val_53)))))
- (values table_184)))))
- (if (not #f) (for-loop_245 table_182 rest_138) table_182)))
- table_181)))))
- for-loop_245)
- '#hash()
- lst_267)))))
+ (let-values (((table_216) (let-values (((table_217) '#hash())) table_217)))
+ (let-values (((lst_396) (cdr (correlated->list v_245))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_396))
+ ((letrec-values (((for-loop_329)
+ (lambda (table_218 lst_397)
+ (begin
+ 'for-loop
+ (if (pair? lst_397)
+ (let-values (((prop+val_2) (unsafe-car lst_397))
+ ((rest_194) (unsafe-cdr lst_397)))
+ (let-values (((table_219)
+ (let-values (((table_220)
+ (let-values (((key_76 val_55)
+ (values
+ (correlated-e
+ (list-ref
+ (correlated->list
+ prop+val_2)
+ 1))
+ #t)))
+ (hash-set
+ table_218
+ key_76
+ val_55))))
+ (values table_220))))
+ (if (not #f) (for-loop_329 table_219 rest_194) table_219)))
+ table_218)))))
+ for-loop_329)
+ table_216
+ lst_396))))))
#f)
#f)
#f))))))))
(define-values
(ok-make-struct-type?)
- (lambda (e_73 ready-variable?_1 defns_5)
+ (lambda (e_82 ready-variable?_1 defns_5)
(begin
- (let-values (((l_44) (correlated->list e_73)))
- (let-values (((init-field-count-expr_0) (if (> (length l_44) 3) (list-ref l_44 3) #f)))
- (let-values (((auto-field-count-expr_0) (if (> (length l_44) 4) (list-ref l_44 4) #f)))
+ (let-values (((l_53) (correlated->list e_82)))
+ (let-values (((init-field-count-expr_0) (if (> (length l_53) 3) (list-ref l_53 3) #f)))
+ (let-values (((auto-field-count-expr_0) (if (> (length l_53) 4) (list-ref l_53 4) #f)))
(let-values (((num-fields_0)
(maybe+
(field-count-expr-to-field-count init-field-count-expr_0)
(field-count-expr-to-field-count auto-field-count-expr_0))))
(let-values (((immutables-expr_0)
- (let-values (((or-part_247) (if (> (length l_44) 9) (list-ref l_44 9) #f)))
- (if or-part_247 or-part_247 'null))))
- (let-values (((super-expr_0) (if (> (length l_44) 2) (list-ref l_44 2) #f)))
- (if (>= (length l_44) 5)
- (if (<= (length l_44) 12)
- (let-values (((lst_269) (cdr l_44))
- ((lst_270)
- (list
- (lambda (v_181) (quoted? symbol? v_181))
- (lambda (v_182) (super-ok? v_182 defns_5))
- (lambda (v_183) (field-count-expr-to-field-count v_183))
- (lambda (v_163) (field-count-expr-to-field-count v_163))
- (lambda (v_184)
- (not
- (let-values (((v131_0) v_184)
- ((temp132_1) 1)
- ((ready-variable?133_0) ready-variable?_1)
- ((defns134_0) defns_5))
- (any-side-effects?.1
- defns134_0
- '#hasheq()
- ready-variable?133_0
- v131_0
- temp132_1))))
- (lambda (v_185)
- (known-good-struct-properties? v_185 immutables-expr_0 super-expr_0 defns_5))
- (lambda (v_186) (inspector-or-false? v_186))
- (lambda (v_187) (procedure-spec? v_187 num-fields_0))
- (lambda (v_188) (immutables-ok? v_188 init-field-count-expr_0)))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_269)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_270)))
- ((letrec-values (((for-loop_246)
- (lambda (result_110 lst_271 lst_272)
- (begin
- 'for-loop
- (if (if (pair? lst_271) (pair? lst_272) #f)
- (let-values (((arg_1) (unsafe-car lst_271))
- ((rest_139) (unsafe-cdr lst_271))
- ((pred_2) (unsafe-car lst_272))
- ((rest_140) (unsafe-cdr lst_272)))
- (let-values (((result_111)
- (let-values ()
- (let-values (((result_112)
- (let-values ()
- (let-values () (pred_2 arg_1)))))
- (values result_112)))))
- (if (if (not ((lambda x_75 (not result_111)) arg_1))
- (if (not ((lambda x_76 (not result_111)) pred_2))
- (not #f)
+ (let-values (((or-part_404) (if (> (length l_53) 9) (list-ref l_53 9) #f)))
+ (if or-part_404 or-part_404 'null))))
+ (let-values (((super-expr_0) (if (> (length l_53) 2) (list-ref l_53 2) #f)))
+ (if (>= (length l_53) 5)
+ (if (<= (length l_53) 12)
+ (let-values (((result_204) (let-values (((result_205) #t)) result_205)))
+ (let-values (((lst_398) (cdr l_53))
+ ((lst_399)
+ (list
+ (lambda (v_246) (quoted? symbol? v_246))
+ (lambda (v_247) (super-ok? v_247 defns_5))
+ (lambda (v_248) (field-count-expr-to-field-count v_248))
+ (lambda (v_249) (field-count-expr-to-field-count v_249))
+ (lambda (v_250)
+ (not
+ (let-values (((v131_0) v_250)
+ ((temp132_0) 1)
+ ((ready-variable?133_0) ready-variable?_1)
+ ((defns134_0) defns_5))
+ (any-side-effects?.1
+ defns134_0
+ '#hasheq()
+ ready-variable?133_0
+ v131_0
+ temp132_0))))
+ (lambda (v_251)
+ (known-good-struct-properties? v_251 immutables-expr_0 super-expr_0 defns_5))
+ (lambda (v_252) (inspector-or-false? v_252))
+ (lambda (v_253) (procedure-spec? v_253 num-fields_0))
+ (lambda (v_254) (immutables-ok? v_254 init-field-count-expr_0)))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_398))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_399))
+ ((letrec-values (((for-loop_330)
+ (lambda (result_206 lst_400 lst_401)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_400) (pair? lst_401) #f)
+ (let-values (((arg_1) (unsafe-car lst_400))
+ ((rest_195) (unsafe-cdr lst_400))
+ ((pred_2) (unsafe-car lst_401))
+ ((rest_196) (unsafe-cdr lst_401)))
+ (let-values (((result_207)
+ (let-values (((result_208) (pred_2 arg_1)))
+ (values result_208))))
+ (if (if (not ((lambda x_82 (not result_207)) arg_1))
+ (if (not ((lambda x_83 (not result_207)) pred_2))
+ (not #f)
+ #f)
#f)
- #f)
- (for-loop_246 result_111 rest_139 rest_140)
- result_111)))
- result_110)))))
- for-loop_246)
- #t
- lst_269
- lst_270)))
+ (for-loop_330 result_207 rest_195 rest_196)
+ result_207)))
+ result_206)))))
+ for-loop_330)
+ result_204
+ lst_398
+ lst_399))))
#f)
#f))))))))))
(define-values
(super-ok?)
- (lambda (e_74 defns_6)
+ (lambda (e_83 defns_6)
(begin
- (let-values (((or-part_248) (quoted? false? e_74)))
- (if or-part_248
- or-part_248
- (let-values (((o_8) (lookup-defn defns_6 (correlated-e e_74))))
- (if o_8 (if (known-struct-op? o_8) (eq? 'struct-type (known-struct-op-type o_8)) #f) #f)))))))
+ (let-values (((or-part_405) (quoted? false? e_83)))
+ (if or-part_405
+ or-part_405
+ (let-values (((o_9) (lookup-defn defns_6 (correlated-e e_83))))
+ (if o_9 (if (known-struct-op? o_9) (eq? 'struct-type (known-struct-op-type o_9)) #f) #f)))))))
(define-values
(extract-struct-field-count-lower-bound)
- (lambda (e_75)
+ (lambda (e_84)
(begin
- (let-values (((l_45) (correlated->list e_75)))
- (+ (field-count-expr-to-field-count (list-ref l_45 3)) (field-count-expr-to-field-count (list-ref l_45 4)))))))
+ (let-values (((l_54) (correlated->list e_84)))
+ (+ (field-count-expr-to-field-count (list-ref l_54 3)) (field-count-expr-to-field-count (list-ref l_54 4)))))))
(define-values
(quoted?)
- (lambda (val?_0 v_189)
+ (lambda (val?_0 v_255)
(begin
- (let-values (((or-part_249)
- (if (pair? (correlated-e v_189))
- (if (eq? (correlated-e (car (correlated-e v_189))) 'quote)
- (val?_0 (correlated-e (correlated-cadr v_189)))
+ (let-values (((or-part_406)
+ (if (pair? (correlated-e v_255))
+ (if (eq? (correlated-e (car (correlated-e v_255))) 'quote)
+ (val?_0 (correlated-e (correlated-cadr v_255)))
#f)
#f)))
- (if or-part_249 or-part_249 (val?_0 (correlated-e v_189)))))))
+ (if or-part_406 or-part_406 (val?_0 (correlated-e v_255)))))))
(define-values
(quoted-value)
- (lambda (v_190)
- (begin (if (pair? (correlated-e v_190)) (correlated-e (correlated-cadr v_190)) (correlated-e v_190)))))
- (define-values (false?) (lambda (v_191) (begin (eq? (correlated-e v_191) #f))))
+ (lambda (v_256)
+ (begin (if (pair? (correlated-e v_256)) (correlated-e (correlated-cadr v_256)) (correlated-e v_256)))))
+ (define-values (false?) (lambda (v_257) (begin (eq? (correlated-e v_257) #f))))
(define-values
(field-count-expr-to-field-count)
- (lambda (v_192) (begin (if (quoted? exact-nonnegative-integer? v_192) (quoted-value v_192) #f))))
+ (lambda (v_258) (begin (if (quoted? exact-nonnegative-integer? v_258) (quoted-value v_258) #f))))
(define-values
(inspector-or-false?)
- (lambda (v_193)
- (begin
- (let-values (((or-part_250) (quoted? false? v_193)))
- (if or-part_250
- or-part_250
- (let-values (((or-part_251) (if (quoted? symbol? v_193) (eq? 'prefab (quoted-value v_193)) #f)))
- (if or-part_251
- or-part_251
- (if (= 1 (correlated-length v_193))
- (eq? 'current-inspector (correlated-e (car (correlated-e v_193))))
+ (lambda (v_259)
+ (begin
+ (let-values (((or-part_407) (quoted? false? v_259)))
+ (if or-part_407
+ or-part_407
+ (let-values (((or-part_408) (if (quoted? symbol? v_259) (eq? 'prefab (quoted-value v_259)) #f)))
+ (if or-part_408
+ or-part_408
+ (if (= 1 (correlated-length v_259))
+ (eq? 'current-inspector (correlated-e (car (correlated-e v_259))))
#f))))))))
(define-values
(known-good-struct-properties?)
- (lambda (v_194 immutables-expr_1 super-expr_1 defns_7)
- (begin
- (let-values (((or-part_252) (quoted? null? v_194)))
- (if or-part_252
- or-part_252
- (let-values (((or-part_253) (eq? 'null (correlated-e v_194))))
- (if or-part_253
- or-part_253
- (if (pair? (correlated-e v_194))
- (if (eq? (correlated-e (car (correlated-e v_194))) 'list)
- (if (let-values (((lst_273) (cdr (correlated->list v_194))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_273)))
- ((letrec-values (((for-loop_247)
- (lambda (result_113 lst_274)
- (begin
- 'for-loop
- (if (pair? lst_274)
- (let-values (((prop+val_3) (unsafe-car lst_274))
- ((rest_141) (unsafe-cdr lst_274)))
- (let-values (((result_114)
- (let-values ()
- (let-values (((result_115)
- (let-values ()
- (let-values ()
- (if (=
- (correlated-length
- prop+val_3)
- 3)
- (let-values (((prop+val_4)
- (correlated->list
- prop+val_3)))
- (if (eq?
- 'cons
- (correlated-e
- (car prop+val_4)))
- (known-good-struct-property+value?
- (list-ref prop+val_4 1)
- (list-ref prop+val_4 2)
- immutables-expr_1
- super-expr_1
- defns_7)
- #f))
- #f)))))
- (values result_115)))))
- (if (if (not ((lambda x_77 (not result_114)) prop+val_3))
- (not #f)
- #f)
- (for-loop_247 result_114 rest_141)
- result_114)))
- result_113)))))
- for-loop_247)
- #t
- lst_273)))
+ (lambda (v_260 immutables-expr_1 super-expr_1 defns_7)
+ (begin
+ (let-values (((or-part_409) (quoted? null? v_260)))
+ (if or-part_409
+ or-part_409
+ (let-values (((or-part_410) (eq? 'null (correlated-e v_260))))
+ (if or-part_410
+ or-part_410
+ (if (pair? (correlated-e v_260))
+ (if (eq? (correlated-e (car (correlated-e v_260))) 'list)
+ (if (let-values (((result_209) (let-values (((result_210) #t)) result_210)))
+ (let-values (((lst_402) (cdr (correlated->list v_260))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_402))
+ ((letrec-values (((for-loop_331)
+ (lambda (result_211 lst_403)
+ (begin
+ 'for-loop
+ (if (pair? lst_403)
+ (let-values (((prop+val_3) (unsafe-car lst_403))
+ ((rest_197) (unsafe-cdr lst_403)))
+ (let-values (((result_212)
+ (let-values (((result_213)
+ (if (=
+ (correlated-length prop+val_3)
+ 3)
+ (let-values (((prop+val_4)
+ (correlated->list
+ prop+val_3)))
+ (if (eq?
+ 'cons
+ (correlated-e
+ (car prop+val_4)))
+ (known-good-struct-property+value?
+ (list-ref prop+val_4 1)
+ (list-ref prop+val_4 2)
+ immutables-expr_1
+ super-expr_1
+ defns_7)
+ #f))
+ #f)))
+ (values result_213))))
+ (if (if (not ((lambda x_84 (not result_212)) prop+val_3))
+ (not #f)
+ #f)
+ (for-loop_331 result_212 rest_197)
+ result_212)))
+ result_211)))))
+ for-loop_331)
+ result_209
+ lst_402))))
(=
- (sub1 (correlated-length v_194))
+ (sub1 (correlated-length v_260))
(set-count
- (let-values (((lst_275) (cdr (correlated->list v_194))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_275)))
- ((letrec-values (((for-loop_248)
- (lambda (table_185 lst_276)
- (begin
- 'for-loop
- (if (pair? lst_276)
- (let-values (((prop+val_5) (unsafe-car lst_276))
- ((rest_142) (unsafe-cdr lst_276)))
- (let-values (((table_186)
- (let-values (((table_187) table_185))
- (let-values (((table_188)
- (let-values ()
- (let-values (((key_73 val_54)
- (let-values ()
- (values
- (let-values ()
- (correlated-e
- (list-ref
- (correlated->list
- prop+val_5)
- 1)))
- #t))))
- (hash-set
- table_187
- key_73
- val_54)))))
- (values table_188)))))
- (if (not #f) (for-loop_248 table_186 rest_142) table_186)))
- table_185)))))
- for-loop_248)
- '#hash()
- lst_275)))))
+ (let-values (((table_221) (let-values (((table_222) '#hash())) table_222)))
+ (let-values (((lst_404) (cdr (correlated->list v_260))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_404))
+ ((letrec-values (((for-loop_332)
+ (lambda (table_223 lst_405)
+ (begin
+ 'for-loop
+ (if (pair? lst_405)
+ (let-values (((prop+val_5) (unsafe-car lst_405))
+ ((rest_198) (unsafe-cdr lst_405)))
+ (let-values (((table_224)
+ (let-values (((table_225)
+ (let-values (((key_77 val_56)
+ (values
+ (correlated-e
+ (list-ref
+ (correlated->list
+ prop+val_5)
+ 1))
+ #t)))
+ (hash-set
+ table_223
+ key_77
+ val_56))))
+ (values table_225))))
+ (if (not #f) (for-loop_332 table_224 rest_198) table_224)))
+ table_223)))))
+ for-loop_332)
+ table_221
+ lst_404))))))
#f)
#f)
#f))))))))
@@ -39298,110 +39262,101 @@
(lambda (prop-expr_0 val-expr_0 immutables-expr_2 super-expr_2 defns_8)
(begin
(let-values (((prop-name_0) (correlated-e prop-expr_0)))
- (let-values (((tmp_29) prop-name_0))
- (if (equal? tmp_29 'prop:evt)
- (let-values ()
- (let-values (((or-part_254) (is-lambda? val-expr_0 1 defns_8)))
- (if or-part_254 or-part_254 (immutable-field? val-expr_0 immutables-expr_2))))
- (if (equal? tmp_29 'prop:procedure)
- (let-values ()
- (let-values (((or-part_255) (is-lambda? val-expr_0 1 defns_8)))
- (if or-part_255 or-part_255 (immutable-field? val-expr_0 immutables-expr_2))))
- (if (equal? tmp_29 'prop:equal+hash)
- (let-values ()
- (let-values (((l_46) (correlated->list val-expr_0)))
- (if (eq? 'list (car l_46))
- (if (is-lambda? (list-ref l_46 1) 3 defns_8)
- (if (is-lambda? (list-ref l_46 2) 2 defns_8) (is-lambda? (list-ref l_46 3) 2 defns_8) #f)
- #f)
- #f)))
- (if (equal? tmp_29 'prop:checked-procedure)
- (let-values () (if (quoted? false? super-expr_2) (immutable-field? 1 immutables-expr_2) #f))
- (if (equal? tmp_29 'prop:object-name)
- (let-values () (immutable-field? val-expr_0 immutables-expr_2))
- (let-values ()
- (let-values (((o_9) (lookup-defn defns_8 prop-name_0)))
- (if (known-property? o_9)
- (let-values ()
- (not
- (let-values (((val-expr135_0) val-expr_0) ((temp136_1) 1) ((defns137_0) defns_8))
- (any-side-effects?.1 defns137_0 '#hasheq() unsafe-undefined val-expr135_0 temp136_1))))
- (if (known-property-of-function? o_9)
- (let-values () (is-lambda? val-expr_0 (known-property-of-function-arity o_9) defns_8))
- (let-values () #f)))))))))))))))
+ (let-values (((tmp_30) prop-name_0))
+ (if (equal? tmp_30 'prop:evt)
+ (let-values (((or-part_411) (is-lambda? val-expr_0 1 defns_8)))
+ (if or-part_411 or-part_411 (immutable-field? val-expr_0 immutables-expr_2)))
+ (if (equal? tmp_30 'prop:procedure)
+ (let-values (((or-part_412) (is-lambda? val-expr_0 1 defns_8)))
+ (if or-part_412 or-part_412 (immutable-field? val-expr_0 immutables-expr_2)))
+ (if (equal? tmp_30 'prop:equal+hash)
+ (let-values (((l_55) (correlated->list val-expr_0)))
+ (if (eq? 'list (car l_55))
+ (if (is-lambda? (list-ref l_55 1) 3 defns_8)
+ (if (is-lambda? (list-ref l_55 2) 2 defns_8) (is-lambda? (list-ref l_55 3) 2 defns_8) #f)
+ #f)
+ #f))
+ (if (equal? tmp_30 'prop:checked-procedure)
+ (if (quoted? false? super-expr_2) (immutable-field? 1 immutables-expr_2) #f)
+ (if (equal? tmp_30 'prop:object-name)
+ (immutable-field? val-expr_0 immutables-expr_2)
+ (let-values (((o_10) (lookup-defn defns_8 prop-name_0)))
+ (if (known-property? o_10)
+ (not
+ (let-values (((val-expr135_0) val-expr_0) ((temp136_2) 1) ((defns137_0) defns_8))
+ (any-side-effects?.1 defns137_0 '#hasheq() unsafe-undefined val-expr135_0 temp136_2)))
+ (if (known-property-of-function? o_10)
+ (is-lambda? val-expr_0 (known-property-of-function-arity o_10) defns_8)
+ #f)))))))))))))
(define-values
(is-lambda?)
(lambda (expr_11 arity_0 defns_9)
(begin
(let-values (((lookup_0) (lookup-defn defns_9 expr_11)))
- (let-values (((or-part_256)
+ (let-values (((or-part_413)
(if lookup_0
(if (known-function? lookup_0)
- (let-values (((or-part_257) (not arity_0)))
- (if or-part_257 or-part_257 (arity-includes? (known-function-arity lookup_0) arity_0)))
+ (let-values (((or-part_414) (not arity_0)))
+ (if or-part_414 or-part_414 (arity-includes? (known-function-arity lookup_0) arity_0)))
#f)
#f)))
- (if or-part_256
- or-part_256
- (let-values (((or-part_258)
+ (if or-part_413
+ or-part_413
+ (let-values (((or-part_415)
(if (pair? (correlated-e expr_11))
(if (eq? 'case-lambda (car (correlated-e expr_11))) (not arity_0) #f)
#f)))
- (if or-part_258
- or-part_258
+ (if or-part_415
+ or-part_415
(if (pair? (correlated-e expr_11))
(if (eq? 'lambda (car (correlated-e expr_11)))
- (let-values (((or-part_259) (not arity_0)))
- (if or-part_259
- or-part_259
- ((letrec-values (((loop_95)
- (lambda (args_5 arity_1)
+ (let-values (((or-part_416) (not arity_0)))
+ (if or-part_416
+ or-part_416
+ ((letrec-values (((loop_108)
+ (lambda (args_8 arity_1)
(begin
'loop
- (if (correlated? args_5)
- (let-values () (loop_95 (correlated-e args_5) arity_1))
- (if (null? args_5)
- (let-values () (zero? arity_1))
- (if (pair? args_5)
- (let-values () (loop_95 (cdr args_5) (sub1 arity_1)))
- (let-values () (not (negative? arity_1))))))))))
- loop_95)
+ (if (correlated? args_8)
+ (loop_108 (correlated-e args_8) arity_1)
+ (if (null? args_8)
+ (zero? arity_1)
+ (if (pair? args_8)
+ (loop_108 (cdr args_8) (sub1 arity_1))
+ (not (negative? arity_1)))))))))
+ loop_108)
(cadr (correlated->list expr_11))
arity_0)))
#f)
#f)))))))))
(define-values
(arity-includes?)
- (lambda (a_37 n_30)
- (begin
- (let-values (((or-part_260) (equal? a_37 n_30)))
- (if or-part_260
- or-part_260
- (if (list? a_37)
- (let-values (((lst_277) a_37))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_277)))
- ((letrec-values (((for-loop_249)
- (lambda (result_116 lst_278)
- (begin
- 'for-loop
- (if (pair? lst_278)
- (let-values (((a_38) (unsafe-car lst_278)) ((rest_143) (unsafe-cdr lst_278)))
- (let-values (((result_117)
- (let-values ()
- (let-values (((result_118)
- (let-values ()
- (let-values () (equal? a_38 n_30)))))
- (values result_118)))))
- (if (if (not ((lambda x_78 result_117) a_38)) (not #f) #f)
- (for-loop_249 result_117 rest_143)
- result_117)))
- result_116)))))
- for-loop_249)
- #f
- lst_277)))
+ (lambda (a_45 n_30)
+ (begin
+ (let-values (((or-part_417) (equal? a_45 n_30)))
+ (if or-part_417
+ or-part_417
+ (if (list? a_45)
+ (let-values (((result_214) (let-values (((result_215) #f)) result_215)))
+ (let-values (((lst_406) a_45))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_406))
+ ((letrec-values (((for-loop_333)
+ (lambda (result_216 lst_407)
+ (begin
+ 'for-loop
+ (if (pair? lst_407)
+ (let-values (((a_46) (unsafe-car lst_407)) ((rest_199) (unsafe-cdr lst_407)))
+ (let-values (((result_217)
+ (let-values (((result_218) (equal? a_46 n_30)))
+ (values result_218))))
+ (if (if (not ((lambda x_85 result_217) a_46)) (not #f) #f)
+ (for-loop_333 result_217 rest_199)
+ result_217)))
+ result_216)))))
+ for-loop_333)
+ result_214
+ lst_406))))
#f))))))
(define-values
(immutable-field?)
@@ -39412,395 +39367,368 @@
#f))))
(define-values
(immutables-expr-to-immutables)
- (lambda (e_76 fail-v_0)
- (begin
- (let-values (((tmp_30) (if (pair? (correlated-e e_76)) (correlated-e (car (correlated-e e_76))) #f)))
- (if (equal? tmp_30 'quote)
- (let-values ()
- (let-values (((v_195) (correlated-cadr e_76)))
- (let-values (((or-part_261)
- (if (correlated-length v_195)
- (let-values (((l_47) (map2 correlated-e (correlated->list v_195))))
- (if (andmap2 exact-nonnegative-integer? l_47)
- (if (= (length l_47) (set-count (list->set l_47))) l_47 #f)
- #f))
- #f)))
- (if or-part_261 or-part_261 fail-v_0))))
- (let-values () fail-v_0))))))
+ (lambda (e_85 fail-v_0)
+ (begin
+ (let-values (((tmp_31) (if (pair? (correlated-e e_85)) (correlated-e (car (correlated-e e_85))) #f)))
+ (if (equal? tmp_31 'quote)
+ (let-values (((v_261) (correlated-cadr e_85)))
+ (let-values (((or-part_418)
+ (if (correlated-length v_261)
+ (let-values (((l_56) (map2 correlated-e (correlated->list v_261))))
+ (if (andmap2 exact-nonnegative-integer? l_56)
+ (if (= (length l_56) (set-count (list->set l_56))) l_56 #f)
+ #f))
+ #f)))
+ (if or-part_418 or-part_418 fail-v_0)))
+ fail-v_0)))))
(define-values
(procedure-spec?)
- (lambda (e_77 field-count_1)
- (begin
- (let-values (((or-part_262) (quoted? false? e_77)))
- (if or-part_262
- or-part_262
- (let-values (((or-part_263)
- (if (quoted? exact-nonnegative-integer? e_77)
- (if field-count_1 (< (quoted-value e_77) field-count_1) #f)
+ (lambda (e_86 field-count_1)
+ (begin
+ (let-values (((or-part_419) (quoted? false? e_86)))
+ (if or-part_419
+ or-part_419
+ (let-values (((or-part_420)
+ (if (quoted? exact-nonnegative-integer? e_86)
+ (if field-count_1 (< (quoted-value e_86) field-count_1) #f)
#f)))
- (if or-part_263 or-part_263 (is-lambda? e_77 #f '#hasheq()))))))))
+ (if or-part_420 or-part_420 (is-lambda? e_86 #f '#hasheq()))))))))
(define-values
(immutables-ok?)
- (lambda (e_78 init-field-count-expr_1)
+ (lambda (e_87 init-field-count-expr_1)
(begin
- (let-values (((l_48) (immutables-expr-to-immutables e_78 #f)))
- (let-values (((c_37) (field-count-expr-to-field-count init-field-count-expr_1)))
- (if l_48
- (let-values (((lst_279) l_48))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_279)))
- ((letrec-values (((for-loop_250)
- (lambda (result_119 lst_280)
- (begin
- 'for-loop
- (if (pair? lst_280)
- (let-values (((n_31) (unsafe-car lst_280)) ((rest_144) (unsafe-cdr lst_280)))
- (let-values (((result_120)
- (let-values ()
- (let-values (((result_121)
- (let-values () (let-values () (< n_31 c_37)))))
- (values result_121)))))
- (if (if (not ((lambda x_79 (not result_120)) n_31)) (not #f) #f)
- (for-loop_250 result_120 rest_144)
- result_120)))
- result_119)))))
- for-loop_250)
- #t
- lst_279)))
+ (let-values (((l_57) (immutables-expr-to-immutables e_87 #f)))
+ (let-values (((c_43) (field-count-expr-to-field-count init-field-count-expr_1)))
+ (if l_57
+ (let-values (((result_219) (let-values (((result_220) #t)) result_220)))
+ (let-values (((lst_408) l_57))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_408))
+ ((letrec-values (((for-loop_334)
+ (lambda (result_221 lst_409)
+ (begin
+ 'for-loop
+ (if (pair? lst_409)
+ (let-values (((n_31) (unsafe-car lst_409)) ((rest_200) (unsafe-cdr lst_409)))
+ (let-values (((result_222)
+ (let-values (((result_223) (< n_31 c_43)))
+ (values result_223))))
+ (if (if (not ((lambda x_86 (not result_222)) n_31)) (not #f) #f)
+ (for-loop_334 result_222 rest_200)
+ result_222)))
+ result_221)))))
+ for-loop_334)
+ result_219
+ lst_408))))
#f))))))
(define-values
(ok-make-struct-field-accessor/mutator?)
- (lambda (e_79 locals_17 type_2 defns_10)
- (begin
- (let-values (((l_49) (correlated->list e_79)))
- (let-values (((len_55) (length l_49)))
- (let-values (((a_39)
- (if (<= 3 len_55 6)
- (let-values (((or-part_264) (hash-ref locals_17 (correlated-e (list-ref l_49 1)) #f)))
- (if or-part_264 or-part_264 (lookup-defn defns_10 (correlated-e (list-ref l_49 1)))))
+ (lambda (e_88 locals_20 type_2 defns_10)
+ (begin
+ (let-values (((l_58) (correlated->list e_88)))
+ (let-values (((len_61) (length l_58)))
+ (let-values (((a_47)
+ (if (<= 3 len_61 6)
+ (let-values (((or-part_421) (hash-ref locals_20 (correlated-e (list-ref l_58 1)) #f)))
+ (if or-part_421 or-part_421 (lookup-defn defns_10 (correlated-e (list-ref l_58 1)))))
#f)))
- (if (known-struct-op? a_39)
- (if (eq? (known-struct-op-type a_39) type_2)
- (if (let-values (((c_38) (field-count-expr-to-field-count (list-ref l_49 2))))
- (if c_38 (< c_38 (known-struct-op-field-count a_39)) #f))
- (if (let-values (((or-part_265) (< len_55 4)))
- (if or-part_265 or-part_265 (quoted? symbol? (list-ref l_49 3))))
- (if (let-values (((or-part_266) (< len_55 5)))
- (if or-part_266
- or-part_266
+ (if (known-struct-op? a_47)
+ (if (eq? (known-struct-op-type a_47) type_2)
+ (if (let-values (((c_44) (field-count-expr-to-field-count (list-ref l_58 2))))
+ (if c_44 (< c_44 (known-struct-op-field-count a_47)) #f))
+ (if (let-values (((or-part_422) (< len_61 4)))
+ (if or-part_422 or-part_422 (quoted? symbol? (list-ref l_58 3))))
+ (if (let-values (((or-part_423) (< len_61 5)))
+ (if or-part_423
+ or-part_423
(quoted?
- (lambda (x_80)
- (let-values (((or-part_267) (not x_80)))
- (if or-part_267
- or-part_267
- (let-values (((or-part_268) (string? x_80)))
- (if or-part_268 or-part_268 (symbol? x_80))))))
- (list-ref l_49 4))))
- (let-values (((or-part_269) (< len_55 6)))
- (if or-part_269 or-part_269 (quoted? symbol? (list-ref l_49 5))))
+ (lambda (x_87)
+ (let-values (((or-part_424) (not x_87)))
+ (if or-part_424
+ or-part_424
+ (let-values (((or-part_425) (string? x_87)))
+ (if or-part_425 or-part_425 (symbol? x_87))))))
+ (list-ref l_58 4))))
+ (let-values (((or-part_426) (< len_61 6)))
+ (if or-part_426 or-part_426 (quoted? symbol? (list-ref l_58 5))))
#f)
#f)
#f)
#f)
#f)))))))
- (define-values (maybe+) (lambda (x_81 y_10) (begin (if x_81 (if y_10 (+ x_81 y_10) #f) #f))))
+ (define-values (maybe+) (lambda (x_88 y_11) (begin (if x_88 (if y_11 (+ x_88 y_11) #f) #f))))
(define-values
(compile-single)
- (lambda (p_20 cctx_13)
+ (lambda (p_48 cctx_13)
(begin
- (let-values (((p10_0) p_20) ((cctx11_0) cctx_13) ((temp12_2) #f) ((temp13_4) #t))
- (compile-top.1 temp12_2 temp13_4 #f p10_0 cctx11_0)))))
+ (let-values (((p10_0) p_48) ((cctx11_0) cctx_13) ((temp12_2) #f) ((temp13_5) #t))
+ (compile-top.1 temp12_2 temp13_5 #f p10_0 cctx11_0)))))
(define-values
(compile-top.1)
(lambda (serializable?1_0 single-expression?2_0 to-correlated-linklet?3_0 p7_1 cctx8_1)
(begin
'compile-top
- (let-values (((p_43) p7_1))
+ (let-values (((p_49) p7_1))
(let-values (((cctx_14) cctx8_1))
(let-values (((serializable?_2) serializable?1_0))
(let-values (((single-expression?_0) single-expression?2_0))
- (let-values (((to-correlated-linklet?_3) to-correlated-linklet?3_0))
- (let-values ()
- (begin
- (if log-performance?
- (let-values () (start-performance-region 'compile (if single-expression?_0 'transformer 'top)))
- (void))
- (begin0
- (let-values ()
- (let-values (((phase_32) (compile-context-phase cctx_14)))
- (let-values (((mpis_14) (make-module-path-index-table)))
- (let-values (((purely-functional?_0) #t))
- (let-values (((body-linklets_1
- min-phase_1
- max-phase_1
- phase-to-link-module-uses_3
- phase-to-link-module-uses-expr_3
- phase-to-link-extra-inspectorss_0
- syntax-literals_2
- no-root-context-pos_0)
- (let-values (((temp14_4) (flatten-begin p_43))
- ((cctx15_0) cctx_14)
- ((mpis16_0) mpis_14)
- ((temp17_3)
- (if single-expression?_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)))
- ((temp18_3)
- (list
- top-level-instance
- empty-top-syntax-literal-instance
- empty-instance-instance))
- ((serializable?19_0) serializable?_2)
- ((to-correlated-linklet?20_0) to-correlated-linklet?_3)
- ((temp21_6) (lambda () (set! purely-functional?_0 #f)))
- ((temp22_3)
- (lambda (e_80
- expected-results_2
- phase_88
- required-reference?_0)
- (if (if purely-functional?_0
- (let-values (((e25_0) e_80)
- ((expected-results26_0)
- expected-results_2)
- ((required-reference?27_0)
- required-reference?_0))
- (any-side-effects?.1
- '#hasheq()
- '#hasheq()
- required-reference?27_0
- e25_0
- expected-results26_0))
- #f)
- (let-values () (set! purely-functional?_0 #f))
- (void))))
- ((temp23_4)
- (lambda (s_185 cctx_15)
- (begin
- (set! purely-functional?_0 #f)
- (compile-top-level-require s_185 cctx_15))))
- ((temp24_2) (not single-expression?_0)))
- (compile-forms.1
- temp18_3
- temp17_3
- null
- temp22_3
- temp21_6
- #f
- null
- unsafe-undefined
- #f
- temp24_2
- temp23_4
- unsafe-undefined
- #f
- serializable?19_0
- to-correlated-linklet?20_0
- #f
- temp14_4
- cctx15_0
- mpis16_0))))
- (let-values (((add-metadata_0)
- (lambda (ht_136)
- (begin
- 'add-metadata
- (let-values (((ht_137) (hash-set ht_136 'original-phase phase_32)))
- (let-values (((ht_138) (hash-set ht_137 'max-phase max-phase_1)))
- ht_138))))))
- (let-values (((bundle_0)
- (1/hash->linklet-bundle
- (add-metadata_0
- (if serializable?_2
- (let-values ()
- (let-values (((syntax-literals-expr_1)
- (begin
- (if log-performance?
- (let-values ()
- (start-performance-region
- 'compile
- 'top
- 'serialize))
- (void))
- (begin0
- (let-values ()
- (generate-eager-syntax-literals!
- syntax-literals_2
- mpis_14
- phase_32
- (compile-context-self cctx_14)
- (compile-context-namespace cctx_14)))
- (if log-performance?
- (let-values () (end-performance-region))
- (void))))))
- (let-values (((link-linklet_0)
- ((lambda (s_94)
- (if to-correlated-linklet?_3
- (make-correlated-linklet s_94 #f)
- (begin
- (if log-performance?
- (let-values ()
- (start-performance-region
- 'compile
- 'top
- 'linklet))
- (void))
- (begin0
- (let-values ()
- (let-values (((linklet_3 new-keys_0)
- (1/compile-linklet
- s_94
- #f
- (vector
- deserialize-instance
- empty-eager-instance-instance)
- (lambda (inst_0)
- (values inst_0 #f)))))
- linklet_3))
- (if log-performance?
- (let-values ()
- (end-performance-region))
- (void))))))
- (list
- 'linklet
- (list
- deserialize-imports
- eager-instance-imports)
- (list
- mpi-vector-id
- deserialized-syntax-vector-id
- 'phase-to-link-modules
- syntax-literals-id)
- (list
- 'define-values
- (list mpi-vector-id)
- (let-values (((mpis28_0) mpis_14))
- (generate-module-path-index-deserialize.1
- #f
- mpis28_0)))
- (list
- 'define-values
- (list deserialized-syntax-vector-id)
- (list* 'make-vector (add1 phase_32) '(#f)))
- (list
- 'define-values
- '(phase-to-link-modules)
- phase-to-link-module-uses-expr_3)
- (list
- 'define-values
- (list syntax-literals-id)
- syntax-literals-expr_1)))))
- (hash-set body-linklets_1 'link link-linklet_0))))
- (let-values () body-linklets_1))))))
- (compiled-in-memory1.1
- (1/hash->linklet-directory (hasheq #f bundle_0))
- #f
- #f
- #f
- phase-to-link-module-uses_3
- (current-code-inspector)
- phase-to-link-extra-inspectorss_0
- '#hasheqv()
- (mpis-as-vector mpis_14)
- (syntax-literals-as-vector syntax-literals_2)
- null
- null
- (extract-namespace-scopes (compile-context-namespace cctx_14))
- purely-functional?_0))))))))
- (if log-performance? (let-values () (end-performance-region)) (void)))))))))))))
+ (let-values (((to-correlated-linklet?_5) to-correlated-linklet?3_0))
+ (begin
+ (if log-performance?
+ (start-performance-region 'compile (if single-expression?_0 'transformer 'top))
+ (void))
+ (begin0
+ (let-values (((phase_101) (compile-context-phase cctx_14)))
+ (let-values (((mpis_22) (make-module-path-index-table)))
+ (let-values (((purely-functional?_0) #t))
+ (let-values (((body-linklets_1
+ min-phase_1
+ max-phase_1
+ phase-to-link-module-uses_3
+ phase-to-link-module-uses-expr_3
+ phase-to-link-extra-inspectorss_0
+ syntax-literals_4
+ no-root-context-pos_0)
+ (let-values (((temp14_4) (flatten-begin p_49))
+ ((cctx15_0) cctx_14)
+ ((mpis16_0) mpis_22)
+ ((temp17_3)
+ (if single-expression?_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)))
+ ((temp18_3)
+ (list
+ top-level-instance
+ empty-top-syntax-literal-instance
+ empty-instance-instance))
+ ((serializable?19_0) serializable?_2)
+ ((to-correlated-linklet?20_0) to-correlated-linklet?_5)
+ ((temp21_6) (lambda () (set! purely-functional?_0 #f)))
+ ((temp22_3)
+ (lambda (e_89 expected-results_2 phase_102 required-reference?_0)
+ (if (if purely-functional?_0
+ (let-values (((e25_0) e_89)
+ ((expected-results26_0) expected-results_2)
+ ((required-reference?27_0)
+ required-reference?_0))
+ (any-side-effects?.1
+ '#hasheq()
+ '#hasheq()
+ required-reference?27_0
+ e25_0
+ expected-results26_0))
+ #f)
+ (set! purely-functional?_0 #f)
+ (void))))
+ ((temp23_4)
+ (lambda (s_603 cctx_15)
+ (begin
+ (set! purely-functional?_0 #f)
+ (compile-top-level-require s_603 cctx_15))))
+ ((temp24_1) (not single-expression?_0)))
+ (compile-forms.1
+ temp18_3
+ temp17_3
+ null
+ temp22_3
+ temp21_6
+ #f
+ null
+ unsafe-undefined
+ #f
+ temp24_1
+ temp23_4
+ unsafe-undefined
+ #f
+ serializable?19_0
+ to-correlated-linklet?20_0
+ #f
+ #f
+ temp14_4
+ cctx15_0
+ mpis16_0))))
+ (let-values (((add-metadata_0)
+ (lambda (ht_170)
+ (begin
+ 'add-metadata
+ (let-values (((ht_171) (hash-set ht_170 'original-phase phase_101)))
+ (let-values (((ht_172) (hash-set ht_171 'max-phase max-phase_1)))
+ ht_172))))))
+ (let-values (((bundle_0)
+ (1/hash->linklet-bundle
+ (add-metadata_0
+ (if serializable?_2
+ (let-values (((syntax-literals-expr_1)
+ (begin
+ (if log-performance?
+ (start-performance-region 'compile 'top 'serialize)
+ (void))
+ (begin0
+ (generate-eager-syntax-literals!
+ syntax-literals_4
+ mpis_22
+ phase_101
+ (compile-context-self cctx_14)
+ (compile-context-namespace cctx_14))
+ (if log-performance?
+ (end-performance-region)
+ (void))))))
+ (let-values (((link-linklet_0)
+ ((lambda (s_604)
+ (if to-correlated-linklet?_5
+ (make-correlated-linklet s_604 #f)
+ (begin
+ (if log-performance?
+ (start-performance-region
+ 'compile
+ 'top
+ 'linklet)
+ (void))
+ (begin0
+ (let-values (((linklet_4 new-keys_0)
+ (1/compile-linklet
+ s_604
+ #f
+ (vector
+ deserialize-instance
+ empty-eager-instance-instance)
+ (lambda (inst_0)
+ (values inst_0 #f)))))
+ linklet_4)
+ (if log-performance?
+ (end-performance-region)
+ (void))))))
+ (list
+ 'linklet
+ (list deserialize-imports eager-instance-imports)
+ (list
+ mpi-vector-id
+ deserialized-syntax-vector-id
+ 'phase-to-link-modules
+ syntax-literals-id)
+ (list
+ 'define-values
+ (list mpi-vector-id)
+ (let-values (((mpis28_0) mpis_22))
+ (generate-module-path-index-deserialize.1
+ #f
+ mpis28_0)))
+ (list*
+ 'define-values
+ (list deserialized-syntax-vector-id)
+ '((box #f)))
+ (list
+ 'define-values
+ '(phase-to-link-modules)
+ phase-to-link-module-uses-expr_3)
+ (list
+ 'define-values
+ (list syntax-literals-id)
+ syntax-literals-expr_1)))))
+ (hash-set body-linklets_1 'link link-linklet_0)))
+ body-linklets_1)))))
+ (compiled-in-memory1.1
+ (1/hash->linklet-directory (hasheq #f bundle_0))
+ #f
+ #f
+ #f
+ #f
+ #f
+ phase-to-link-module-uses_3
+ (current-code-inspector)
+ phase-to-link-extra-inspectorss_0
+ '#hasheqv()
+ (mpis-as-vector mpis_22)
+ (syntax-literals-as-vector syntax-literals_4)
+ null
+ null
+ (extract-namespace-scopes (compile-context-namespace cctx_14))
+ purely-functional?_0)))))))
+ (if log-performance? (end-performance-region) (void))))))))))))
(define-values
(compile-top-level-require)
- (lambda (p_44 cctx_16)
+ (lambda (p_50 cctx_16)
(begin
- (let-values (((phase_25) (compile-context-phase cctx_16)))
- (if (parsed-require? p_44)
- (let-values ()
- (let-values (((form-stx_0) (compile-quote-syntax (parsed-s p_44) cctx_16)))
- (list top-level-require!-id form-stx_0 ns-id (list 'quote (parsed-require-portal-syms p_44)))))
- (let-values () #f))))))
+ (let-values (((phase_103) (compile-context-phase cctx_16)))
+ (if (parsed-require? p_50)
+ (let-values (((form-stx_0) (compile-quote-syntax (parsed-s p_50) cctx_16)))
+ (list top-level-require!-id form-stx_0 ns-id (list 'quote (parsed-require-portal-syms p_50))))
+ #f)))))
(define-values
(flatten-begin)
- (lambda (p_45)
- (begin
- (if (parsed-begin? p_45)
- (let-values () (apply append (map2 flatten-begin (parsed-begin-body p_45))))
- (let-values () (list p_45))))))
+ (lambda (p_51)
+ (begin (if (parsed-begin? p_51) (apply append (map2 flatten-begin (parsed-begin-body p_51))) (list p_51)))))
(define-values (core-scope) (new-multi-scope))
(define-values (core-stx) (add-scope empty-syntax core-scope))
(define-values (core-module-name) (1/make-resolved-module-path '#%core))
- (define-values (core-mpi) (1/module-path-index-join ''#%core #f))
+ (define-values (core-mpi) (module-path-index-join* ''#%core #f))
(define-values (cell.1$4) (unsafe-make-place-local (make-hasheq)))
- (define-values (cell.2$1) (unsafe-make-place-local (make-hasheq)))
+ (define-values (cell.2$3) (unsafe-make-place-local (make-hasheq)))
(define-values
(core-place-init!)
(lambda ()
- (begin (begin (unsafe-place-local-set! cell.1$4 (make-hasheq)) (unsafe-place-local-set! cell.2$1 (make-hasheq))))))
+ (begin (begin (unsafe-place-local-set! cell.1$4 (make-hasheq)) (unsafe-place-local-set! cell.2$3 (make-hasheq))))))
(define-values
(core-id)
- (lambda (sym_64 phase_89)
- (begin
- (if (eqv? phase_89 0)
- (let-values ()
- (let-values (((or-part_36) (hash-ref (unsafe-place-local-ref cell.1$4) sym_64 #f)))
- (if or-part_36
- or-part_36
- (let-values (((s_8) (datum->syntax$1 core-stx sym_64)))
- (begin (hash-set! (unsafe-place-local-ref cell.1$4) sym_64 s_8) s_8)))))
- (if (eq? phase_89 1)
- (let-values ()
- (let-values (((or-part_38) (hash-ref (unsafe-place-local-ref cell.2$1) sym_64 #f)))
- (if or-part_38
- or-part_38
- (let-values (((s_9) (datum->syntax$1 (syntax-shift-phase-level$1 core-stx 1) sym_64)))
- (begin (hash-set! (unsafe-place-local-ref cell.2$1) sym_64 s_9) s_9)))))
- (let-values () (datum->syntax$1 (syntax-shift-phase-level$1 core-stx phase_89) sym_64)))))))
+ (lambda (sym_78 phase_104)
+ (begin
+ (if (eqv? phase_104 0)
+ (let-values (((or-part_427) (hash-ref (unsafe-place-local-ref cell.1$4) sym_78 #f)))
+ (if or-part_427
+ or-part_427
+ (let-values (((s_605) (datum->syntax$1 core-stx sym_78)))
+ (begin (hash-set! (unsafe-place-local-ref cell.1$4) sym_78 s_605) s_605))))
+ (if (eq? phase_104 1)
+ (let-values (((or-part_428) (hash-ref (unsafe-place-local-ref cell.2$3) sym_78 #f)))
+ (if or-part_428
+ or-part_428
+ (let-values (((s_606) (datum->syntax$1 (syntax-shift-phase-level$1 core-stx 1) sym_78)))
+ (begin (hash-set! (unsafe-place-local-ref cell.2$3) sym_78 s_606) s_606))))
+ (datum->syntax$1 (syntax-shift-phase-level$1 core-stx phase_104) sym_78))))))
(define-values (core-forms) '#hasheq())
(define-values (core-primitives) '#hasheq())
(define-values
(struct:protected-core protected-core1.1 protected-core? protected-core-val)
- (let-values (((struct:_26 make-_26 ?_26 -ref_26 -set!_26)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'protected-core
- #f
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'protected-core)))))
- (values struct:_26 make-_26 ?_26 (make-struct-field-accessor -ref_26 0 'val))))
+ (let-values (((struct:_112 make-_112 ?_112 -ref_112 -set!_112)
+ (make-struct-type
+ 'protected-core
+ #f
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'protected-core)))
+ (values struct:_112 make-_112 ?_112 (make-struct-field-accessor -ref_112 0 'val))))
(define-values
(add-core-form!*)
- (lambda (sym_65 proc_7)
- (begin (begin (add-core-binding! sym_65) (set! core-forms (hash-set core-forms sym_65 proc_7))))))
+ (lambda (sym_79 proc_7)
+ (begin (begin (add-core-binding! sym_79) (set! core-forms (hash-set core-forms sym_79 proc_7))))))
(define-values
(add-core-primitive!.1)
(lambda (protected?2_0 sym4_0 val5_0)
(begin
'add-core-primitive!
- (let-values (((sym_66) sym4_0))
- (let-values (((val_55) val5_0))
+ (let-values (((sym_80) sym4_0))
+ (let-values (((val_57) val5_0))
(let-values (((protected?_3) protected?2_0))
- (let-values ()
- (begin
- (add-core-binding! sym_66)
- (set! core-primitives
- (hash-set core-primitives sym_66 (if protected?_3 (protected-core1.1 val_55) val_55)))))))))))
+ (begin
+ (add-core-binding! sym_80)
+ (set! core-primitives
+ (hash-set core-primitives sym_80 (if protected?_3 (protected-core1.1 val_57) val_57))))))))))
(define-values
(add-core-binding!)
- (lambda (sym_67)
+ (lambda (sym_81)
(begin
- (let-values (((temp8_4) (datum->syntax$1 core-stx sym_67))
+ (let-values (((temp8_3) (datum->syntax$1 core-stx sym_81))
((temp9_1)
- (let-values (((core-mpi11_0) core-mpi) ((temp12_3) 0) ((sym13_0) sym_67))
+ (let-values (((core-mpi11_0) core-mpi) ((temp12_3) 0) ((sym13_0) sym_81))
(make-module-binding.1
#f
null
@@ -39814,12 +39742,12 @@
temp12_3
sym13_0)))
((temp10_1) 0))
- (add-binding!.1 #f #f temp8_4 temp9_1 temp10_1)))))
+ (add-binding!.1 #f #f temp8_3 temp9_1 temp10_1)))))
(define-values
(declare-core-module!)
- (lambda (ns_60)
+ (lambda (ns_67)
(begin
- (let-values (((ns14_0) ns_60)
+ (let-values (((ns14_0) ns_67)
((temp15_5)
(let-values (((temp17_4) #t)
((temp18_4) #t)
@@ -39827,118 +39755,110 @@
((temp20_2)
(hasheqv
0
- (let-values (((lst_200) (list core-primitives core-forms)) ((lst_68) '(#f #t)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_200)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_68)))
- ((letrec-values (((for-loop_82)
- (lambda (table_89 lst_100 lst_281)
- (begin
- 'for-loop
- (if (if (pair? lst_100) (pair? lst_281) #f)
- (let-values (((syms_19) (unsafe-car lst_100))
- ((rest_145) (unsafe-cdr lst_100))
- ((syntax?_3) (unsafe-car lst_281))
- ((rest_146) (unsafe-cdr lst_281)))
- (let-values (((table_92)
- (let-values (((table_93) table_89))
- (let-values (((ht_24) syms_19))
+ (let-values (((table_226) (let-values (((table_227) '#hasheq())) table_227)))
+ (let-values (((lst_410) (list core-primitives core-forms)) ((lst_411) '(#f #t)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_410))
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_411))
+ ((letrec-values (((for-loop_335)
+ (lambda (table_228 lst_412 lst_413)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_412) (pair? lst_413) #f)
+ (let-values (((syms_27) (unsafe-car lst_412))
+ ((rest_201) (unsafe-cdr lst_412))
+ ((syntax?_3) (unsafe-car lst_413))
+ ((rest_202) (unsafe-cdr lst_413)))
+ (let-values (((table_229)
+ (let-values (((ht_173) syms_27))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-in-hash ht_24)))
- ((letrec-values (((for-loop_12)
- (lambda (table_64
- i_176)
+ (check-in-hash ht_173))
+ ((letrec-values (((for-loop_336)
+ (lambda (table_230
+ i_243)
(begin
'for-loop
- (if i_176
- (let-values (((sym_68
- val_13)
+ (if i_243
+ (let-values (((sym_82
+ val_58)
(hash-iterate-key+value
- ht_24
- i_176)))
- (let-values (((table_189)
- (let-values (((table_190)
- table_64))
- (let-values (((table_191)
- (let-values ()
- (let-values (((key_74
- val_56)
- (let-values ()
- (let-values (((b_85)
- (let-values (((core-mpi23_0)
- core-mpi)
- ((temp24_3)
- 0)
- ((sym25_0)
- sym_68))
- (make-module-binding.1
- #f
- null
- #f
- #f
- unsafe-undefined
- unsafe-undefined
- 0
- unsafe-undefined
- core-mpi23_0
- temp24_3
- sym25_0))))
- (values
- sym_68
- (if syntax?_3
- (let-values ()
- (provided1.1
- b_85
- #f
- #t))
- (if (protected-core?
- val_13)
- (let-values ()
- (provided1.1
- b_85
- #t
- #f))
- (let-values ()
- b_85))))))))
- (hash-set
- table_190
- key_74
- val_56)))))
- (values
- table_191)))))
+ ht_173
+ i_243)))
+ (let-values (((table_231)
+ (let-values (((table_232)
+ (let-values (((key_78
+ val_59)
+ (let-values (((b_112)
+ (let-values (((core-mpi23_0)
+ core-mpi)
+ ((temp24_2)
+ 0)
+ ((sym25_0)
+ sym_82))
+ (make-module-binding.1
+ #f
+ null
+ #f
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ 0
+ unsafe-undefined
+ core-mpi23_0
+ temp24_2
+ sym25_0))))
+ (values
+ sym_82
+ (if syntax?_3
+ (provided1.1
+ b_112
+ #f
+ #t)
+ (if (protected-core?
+ val_58)
+ (provided1.1
+ b_112
+ #t
+ #f)
+ b_112))))))
+ (hash-set
+ table_230
+ key_78
+ val_59))))
+ (values
+ table_232))))
(if (not
#f)
- (for-loop_12
- table_189
+ (for-loop_336
+ table_231
(hash-iterate-next
- ht_24
- i_176))
- table_189)))
- table_64)))))
- for-loop_12)
- table_93
- (hash-iterate-first ht_24)))))))
- (if (not #f)
- (for-loop_82 table_92 rest_145 rest_146)
- table_92)))
- table_89)))))
- for-loop_82)
- '#hasheq()
- lst_200
- lst_68)))))
+ ht_173
+ i_243))
+ table_231)))
+ table_230)))))
+ for-loop_336)
+ table_228
+ (hash-iterate-first ht_173))))))
+ (if (not #f)
+ (for-loop_335 table_229 rest_201 rest_202)
+ table_229)))
+ table_228)))))
+ for-loop_335)
+ table_226
+ lst_410
+ lst_411))))))
((temp21_7)
- (lambda (phase-level_19 ns_61 insp_8)
- (if (zero? phase-level_19)
- (let-values (((ns_62)
- (let-values (((ns26_0) ns_61)
+ (lambda (phase-level_22 ns_68 insp_10)
+ (if (zero? phase-level_22)
+ (let-values (((ns_69)
+ (let-values (((ns26_0) ns_68)
((core-module-name27_0) core-module-name)
((temp28_2) 0))
(namespace->module-namespace.1
@@ -39948,105 +39868,105 @@
ns26_0
core-module-name27_0
temp28_2))))
- (if ns_62
- (module-linklet-info2.1 (namespace->instance ns_62 0) #f core-mpi #f #f #f)
+ (if ns_69
+ (module-linklet-info2.1
+ (namespace->instance ns_69 0)
+ #f
+ core-mpi
+ insp_10
+ #f
+ #f)
#f))
#f)))
((temp22_4)
(lambda (data-box_3
- ns_63
- phase_90
- phase-level_20
- self_21
- bulk-binding-registry_16
- insp_9)
- (let-values (((tmp_31) phase-level_20))
- (if (equal? tmp_31 0)
- (let-values ()
- (begin
- (let-values (((ht_128) core-primitives))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_128)))
- ((letrec-values (((for-loop_251)
- (lambda (i_52)
- (begin
- 'for-loop
- (if i_52
- (let-values (((sym_5 val_57)
- (hash-iterate-key+value
- ht_128
- i_52)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (namespace-set-consistent!
- ns_63
- 0
- sym_5
- (if (protected-core?
- val_57)
- (protected-core-val
- val_57)
- val_57)))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_251
- (hash-iterate-next ht_128 i_52))
- (values))))
- (values))))))
- for-loop_251)
- (hash-iterate-first ht_128))))
- (void)
- (let-values (((ht_139) core-forms))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_139)))
- ((letrec-values (((for-loop_212)
- (lambda (i_32)
- (begin
- 'for-loop
- (if i_32
- (let-values (((sym_13 proc_8)
- (hash-iterate-key+value
- ht_139
- i_32)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (namespace-set-transformer!
- ns_63
- 0
- sym_13
- (if (procedure-arity-includes?
- proc_8
- 2)
- (core-form7.1
- proc_8
- sym_13)
- proc_8)))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_212
- (hash-iterate-next ht_139 i_32))
- (values))))
- (values))))))
- for-loop_212)
- (hash-iterate-first ht_139))))
- (void)))
- (let-values () (void)))))))
+ ns_70
+ phase_105
+ phase-level_23
+ self_25
+ bulk-binding-registry_17
+ insp_11)
+ (let-values (((tmp_32) phase-level_23))
+ (if (equal? tmp_32 0)
+ (begin
+ (let-values (((ht_174) core-primitives))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash ht_174))
+ ((letrec-values (((for-loop_337)
+ (lambda (i_244)
+ (begin
+ 'for-loop
+ (if i_244
+ (let-values (((sym_83 val_60)
+ (hash-iterate-key+value
+ ht_174
+ i_244)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (namespace-set-consistent!
+ ns_70
+ 0
+ sym_83
+ (if (protected-core?
+ val_60)
+ (protected-core-val
+ val_60)
+ val_60))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_337
+ (hash-iterate-next ht_174 i_244))
+ (values))))
+ (values))))))
+ for-loop_337)
+ (hash-iterate-first ht_174))))
+ (void)
+ (let-values (((ht_175) core-forms))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash ht_175))
+ ((letrec-values (((for-loop_338)
+ (lambda (i_245)
+ (begin
+ 'for-loop
+ (if i_245
+ (let-values (((sym_84 proc_8)
+ (hash-iterate-key+value
+ ht_175
+ i_245)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (namespace-set-transformer!
+ ns_70
+ 0
+ sym_84
+ (if (procedure-arity-includes?
+ proc_8
+ 2)
+ (core-form7.1
+ proc_8
+ sym_84)
+ proc_8))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_338
+ (hash-iterate-next ht_175 i_245))
+ (values))))
+ (values))))))
+ for-loop_338)
+ (hash-iterate-first ht_175))))
+ (void))
+ (void))))))
(make-module.1
temp17_4
+ #f
void
unsafe-undefined
unsafe-undefined
@@ -40061,6 +39981,7 @@
#f
temp20_2
'racket
+ unsafe-undefined
null
core-mpi19_0
#f
@@ -40070,33 +39991,33 @@
(declare-module!.1 #t ns14_0 temp15_5 core-module-name16_0)))))
(define-values
(core-form-sym)
- (lambda (s_458 phase_91)
- (begin
- (let-values (((ok?_28 id29_0 _30_0)
- (let-values (((s_64) s_458))
- (if (let-values (((s_65) (if (syntax?$1 s_64) (syntax-e$1 s_64) s_64)))
- (if (pair? s_65)
- (if (let-values (((s_338) (car s_65)))
- (let-values (((or-part_54) (if (syntax?$1 s_338) (symbol? (syntax-e$1 s_338)) #f)))
- (if or-part_54 or-part_54 (symbol? s_338))))
- (let-values (((s_202) (cdr s_65))) #t)
+ (lambda (s_607 phase_106)
+ (begin
+ (let-values (((ok?_29 id29_0 _30_0)
+ (let-values (((s_608) s_607))
+ (if (let-values (((s_609) (if (syntax?$1 s_608) (syntax-e$1 s_608) s_608)))
+ (if (pair? s_609)
+ (if (let-values (((s_610) (car s_609)))
+ (let-values (((or-part_429) (if (syntax?$1 s_610) (symbol? (syntax-e$1 s_610)) #f)))
+ (if or-part_429 or-part_429 (symbol? s_610))))
+ (let-values (((s_611) (cdr s_609))) #t)
#f)
#f))
(let-values ()
(let-values (((id29_1 _30_1)
- (let-values (((s_40) (if (syntax?$1 s_64) (syntax-e$1 s_64) s_64)))
- (let-values (((id31_0) (let-values (((s_459) (car s_40))) s_459))
- ((_32_0) (let-values (((s_460) (cdr s_40))) s_460)))
+ (let-values (((s_612) (if (syntax?$1 s_608) (syntax-e$1 s_608) s_608)))
+ (let-values (((id31_0) (let-values (((s_613) (car s_612))) s_613))
+ ((_32_0) (let-values (((s_614) (cdr s_612))) s_614)))
(values id31_0 _32_0)))))
(values #t id29_1 _30_1)))
(values #f #f #f)))))
- (if ok?_28
- (let-values (((b_86)
- (let-values (((temp33_1) id29_0) ((phase34_0) phase_91))
- (resolve+shift.1 #f #f null unsafe-undefined #f temp33_1 phase34_0))))
- (if (module-binding? b_86)
- (if (eq? core-module-name (1/module-path-index-resolve (module-binding-module b_86)))
- (module-binding-sym b_86)
+ (if ok?_29
+ (let-values (((b_113)
+ (let-values (((temp33_2) id29_0) ((phase34_0) phase_106))
+ (resolve+shift.1 #f #f null unsafe-undefined #f temp33_2 phase34_0))))
+ (if (module-binding? b_113)
+ (if (eq? core-module-name (1/module-path-index-resolve (module-binding-module b_113)))
+ (module-binding-sym b_113)
#f)
#f))
#f)))))
@@ -40114,454 +40035,443 @@
all-scopes-stx15_1)
(begin
'select-defined-syms-and-bind!
- (let-values (((ids_16) ids11_0))
- (let-values (((defined-syms_8) defined-syms12_0))
- (let-values (((self_22) self13_0))
- (let-values (((phase_92) phase14_2))
+ (let-values (((ids_17) ids11_0))
+ (let-values (((defined-syms_9) defined-syms12_0))
+ (let-values (((self_26) self13_0))
+ (let-values (((phase_107) phase14_2))
(let-values (((all-scopes-stx_4) all-scopes-stx15_1))
(let-values (((frame-id_7) frame-id1_0))
(let-values (((top-level-bind-scope_3) top-level-bind-scope2_0))
(let-values (((requires+provides_5) requires+provides3_0))
- (let-values (((orig-s_33) in4_0))
+ (let-values (((orig-s_34) in4_0))
(let-values (((as-transformer?_5) as-transformer?5_0))
- (let-values ()
- (let-values (((defined-syms-at-phase_0)
- (let-values (((or-part_89) (hash-ref defined-syms_8 phase_92 #f)))
- (if or-part_89
- or-part_89
- (let-values (((ht_121) (make-hasheq)))
- (begin (hash-set! defined-syms_8 phase_92 ht_121) ht_121))))))
- (reverse$1
- (let-values (((lst_282) ids_16))
+ (let-values (((defined-syms-at-phase_0)
+ (let-values (((or-part_430) (hash-ref defined-syms_9 phase_107 #f)))
+ (if or-part_430
+ or-part_430
+ (let-values (((ht_176) (make-hasheq)))
+ (begin (hash-set! defined-syms_9 phase_107 ht_176) ht_176))))))
+ (reverse$1
+ (let-values (((fold-var_416) (let-values (((fold-var_417) null)) fold-var_417)))
+ (let-values (((lst_414) ids_17))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_282)))
- ((letrec-values (((for-loop_252)
- (lambda (fold-var_86 lst_27)
+ (check-list lst_414))
+ ((letrec-values (((for-loop_339)
+ (lambda (fold-var_418 lst_415)
(begin
'for-loop
- (if (pair? lst_27)
- (let-values (((id_63) (unsafe-car lst_27))
- ((rest_147) (unsafe-cdr lst_27)))
- (let-values (((fold-var_247)
- (let-values (((fold-var_197) fold-var_86))
- (let-values (((fold-var_7)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((sym_69)
- (syntax-e$1
- id_63)))
- (let-values (((defined-sym_0)
- (if (if (not
- (defined-as-other?
- (hash-ref
- defined-syms-at-phase_0
- sym_69
- #f)
- id_63
- phase_92
- top-level-bind-scope_3))
- (if (no-extra-scopes?
- id_63
- all-scopes-stx_4
- top-level-bind-scope_3
- phase_92)
- (symbol-interned?
- sym_69)
- #f)
- #f)
- sym_69
- ((letrec-values (((loop_77)
- (lambda (pos_119)
- (begin
- 'loop
- (let-values (((s_461)
- (string->unreadable-symbol
- (string-append
- (symbol->string
- sym_69)
- "."
- (number->string
- pos_119)))))
- (if (defined-as-other?
- (hash-ref
- defined-syms-at-phase_0
- s_461
- #f)
- id_63
- phase_92
- top-level-bind-scope_3)
- (loop_77
- (add1
- pos_119))
- s_461))))))
- loop_77)
- 1))))
- (let-values ((()
- (begin
- (hash-set!
+ (if (pair? lst_415)
+ (let-values (((id_71) (unsafe-car lst_415))
+ ((rest_203) (unsafe-cdr lst_415)))
+ (let-values (((fold-var_419)
+ (let-values (((fold-var_420)
+ (cons
+ (let-values (((sym_85)
+ (syntax-e$1
+ id_71)))
+ (let-values (((defined-sym_0)
+ (if (if (not
+ (defined-as-other?
+ (hash-ref
defined-syms-at-phase_0
- defined-sym_0
- id_63)
- (values))))
- (let-values (((b_19)
- (let-values (((self21_0)
- self_22)
- ((phase22_2)
- phase_92)
- ((defined-sym23_0)
- defined-sym_0)
- ((frame-id24_0)
- frame-id_7)
- ((sym25_1)
- sym_69))
- (make-module-binding.1
- #f
- null
- frame-id24_0
- #f
- unsafe-undefined
- unsafe-undefined
- 0
- sym25_1
- self21_0
- phase22_2
- defined-sym23_0))))
- (begin
- (if requires+provides_5
- (let-values ()
- (remove-required-id!
- requires+provides_5
- id_63
- phase_92))
- (void))
- (let-values (((id17_0)
- id_63)
- ((b18_0)
- b_19)
- ((phase19_0)
- phase_92)
- ((orig-s20_0)
- orig-s_33))
- (add-binding!.1
- orig-s20_0
- #f
- id17_0
- b18_0
- phase19_0))
- (if requires+provides_5
- (let-values ()
- (let-values (((requires+provides26_0)
- requires+provides_5)
- ((id27_0)
- id_63)
- ((phase28_0)
- phase_92)
- ((b29_0)
- b_19)
- ((as-transformer?30_0)
- as-transformer?_5))
- (add-defined-or-required-id!.1
- as-transformer?30_0
+ sym_85
+ #f)
+ id_71
+ phase_107
+ top-level-bind-scope_3))
+ (if (no-extra-scopes?
+ id_71
+ all-scopes-stx_4
+ top-level-bind-scope_3
+ phase_107)
+ (symbol-interned?
+ sym_85)
+ #f)
+ #f)
+ sym_85
+ (begin
+ (check-non-simple-due-to-interned-scope
+ id_71
+ requires+provides_5)
+ ((letrec-values (((loop_109)
+ (lambda (pos_150)
+ (begin
+ 'loop
+ (let-values (((s_615)
+ (string->unreadable-symbol
+ (string-append
+ (symbol->string
+ sym_85)
+ "."
+ (number->string
+ pos_150)))))
+ (if (defined-as-other?
+ (hash-ref
+ defined-syms-at-phase_0
+ s_615
+ #f)
+ id_71
+ phase_107
+ top-level-bind-scope_3)
+ (loop_109
+ (add1
+ pos_150))
+ s_615))))))
+ loop_109)
+ 1)))))
+ (let-values ((()
+ (begin
+ (hash-set!
+ defined-syms-at-phase_0
+ defined-sym_0
+ id_71)
+ (values))))
+ (let-values (((b_114)
+ (let-values (((self21_0)
+ self_26)
+ ((phase22_2)
+ phase_107)
+ ((defined-sym23_0)
+ defined-sym_0)
+ ((frame-id24_0)
+ frame-id_7)
+ ((sym25_1)
+ sym_85))
+ (make-module-binding.1
#f
- requires+provides26_0
- id27_0
- phase28_0
- b29_0)))
- (void))
- defined-sym_0))))))
- fold-var_197))))
- (values fold-var_7)))))
+ null
+ frame-id24_0
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ 0
+ sym25_1
+ self21_0
+ phase22_2
+ defined-sym23_0))))
+ (begin
+ (if requires+provides_5
+ (remove-required-id!
+ requires+provides_5
+ id_71
+ phase_107)
+ (void))
+ (let-values (((id17_0)
+ id_71)
+ ((b18_0)
+ b_114)
+ ((phase19_0)
+ phase_107)
+ ((orig-s20_0)
+ orig-s_34))
+ (add-binding!.1
+ orig-s20_0
+ #f
+ id17_0
+ b18_0
+ phase19_0))
+ (if requires+provides_5
+ (let-values (((requires+provides26_0)
+ requires+provides_5)
+ ((id27_0)
+ id_71)
+ ((phase28_0)
+ phase_107)
+ ((b29_0)
+ b_114)
+ ((as-transformer?30_0)
+ as-transformer?_5))
+ (add-defined-or-required-id!.1
+ as-transformer?30_0
+ #f
+ requires+provides26_0
+ id27_0
+ phase28_0
+ b29_0))
+ (void))
+ defined-sym_0)))))
+ fold-var_418)))
+ (values fold-var_420))))
(if (not #f)
- (for-loop_252 fold-var_247 rest_147)
- fold-var_247)))
- fold-var_86)))))
- for-loop_252)
- null
- lst_282)))))))))))))))))))
+ (for-loop_339 fold-var_419 rest_203)
+ fold-var_419)))
+ fold-var_418)))))
+ for-loop_339)
+ fold-var_416
+ lst_414)))))))))))))))))))
(define-values
(no-extra-scopes?)
- (lambda (id_64 all-scopes-stx_5 top-level-bind-scope_4 phase_93)
+ (lambda (id_72 all-scopes-stx_5 top-level-bind-scope_4 phase_108)
(begin
- (let-values (((m-id_0) (datum->syntax$1 all-scopes-stx_5 (syntax-e$1 id_64))))
- (let-values (((or-part_173) (bound-identifier=?$1 id_64 m-id_0 phase_93)))
- (if or-part_173
- or-part_173
+ (let-values (((m-id_0) (datum->syntax$1 all-scopes-stx_5 (syntax-e$1 id_72))))
+ (let-values (((or-part_431) (bound-identifier=?$1 id_72 m-id_0 phase_108)))
+ (if or-part_431
+ or-part_431
(if top-level-bind-scope_4
- (bound-identifier=?$1 id_64 (add-scope m-id_0 top-level-bind-scope_4) phase_93)
+ (bound-identifier=?$1 id_72 (add-scope m-id_0 top-level-bind-scope_4) phase_108)
#f)))))))
(define-values
(defined-as-other?)
- (lambda (prev-id_0 id_65 phase_94 top-level-bind-scope_5)
+ (lambda (prev-id_0 id_73 phase_109 top-level-bind-scope_5)
(begin
(if prev-id_0
- (if (not (bound-identifier=?$1 prev-id_0 id_65 phase_94))
- (let-values (((or-part_61) (not top-level-bind-scope_5)))
- (if or-part_61
- or-part_61
+ (if (not (bound-identifier=?$1 prev-id_0 id_73 phase_109))
+ (let-values (((or-part_432) (not top-level-bind-scope_5)))
+ (if or-part_432
+ or-part_432
(not
(bound-identifier=?$1
(remove-scope prev-id_0 top-level-bind-scope_5)
- (remove-scope id_65 top-level-bind-scope_5)
- phase_94))))
+ (remove-scope id_73 top-level-bind-scope_5)
+ phase_109))))
#f)
#f))))
+ (define-values
+ (check-non-simple-due-to-interned-scope)
+ (lambda (id_74 r+p_21)
+ (begin
+ (if (if r+p_21 (if (requires+provides-all-bindings-simple? r+p_21) (syntax-has-interned-scope? id_74) #f) #f)
+ (set-requires+provides-all-bindings-simple?! r+p_21 #f)
+ (void)))))
(define-values
(select-defined-syms-and-bind!/ctx)
- (lambda (tl-ids_0 ctx_11)
+ (lambda (tl-ids_0 ctx_13)
(begin
(let-values (((tl-ids31_0) tl-ids_0)
- ((temp32_0) (root-expand-context-defined-syms ctx_11))
- ((temp33_2) (root-expand-context-self-mpi ctx_11))
- ((temp34_0) (expand-context-phase ctx_11))
- ((temp35_0) (root-expand-context-all-scopes-stx ctx_11))
- ((temp36_0) (root-expand-context-frame-id ctx_11))
- ((temp37_2) (root-expand-context-top-level-bind-scope ctx_11)))
- (select-defined-syms-and-bind!.1 #f temp36_0 #f #f temp37_2 tl-ids31_0 temp32_0 temp33_2 temp34_0 temp35_0)))))
+ ((temp32_0) (root-expand-context-defined-syms ctx_13))
+ ((temp33_3) (root-expand-context-self-mpi ctx_13))
+ ((temp34_0) (expand-context-phase ctx_13))
+ ((temp35_0) (root-expand-context-all-scopes-stx ctx_13))
+ ((temp36_1) (root-expand-context-frame-id ctx_13))
+ ((temp37_1) (root-expand-context-top-level-bind-scope ctx_13)))
+ (select-defined-syms-and-bind!.1 #f temp36_1 #f #f temp37_1 tl-ids31_0 temp32_0 temp33_3 temp34_0 temp35_0)))))
(define-values
(add-defined-sym!)
- (lambda (defined-syms_9 phase_95 sym_70 id_66)
+ (lambda (defined-syms_10 phase_110 sym_86 id_75)
(begin
(let-values (((defined-syms-at-phase_1)
- (let-values (((or-part_270) (hash-ref defined-syms_9 phase_95 #f)))
- (if or-part_270
- or-part_270
- (let-values (((ht_140) (make-hasheq)))
- (begin (hash-set! defined-syms_9 phase_95 ht_140) ht_140))))))
- (hash-set! defined-syms-at-phase_1 sym_70 id_66)))))
+ (let-values (((or-part_433) (hash-ref defined-syms_10 phase_110 #f)))
+ (if or-part_433
+ or-part_433
+ (let-values (((ht_177) (make-hasheq)))
+ (begin (hash-set! defined-syms_10 phase_110 ht_177) ht_177))))))
+ (hash-set! defined-syms-at-phase_1 sym_86 id_75)))))
(define-values
(make-create-root-expand-context-from-module)
- (lambda (requires_4 evaled-ld-h_0)
+ (lambda (requires_5 evaled-ld-h_0)
(begin
- (lambda (ns_64 phase-shift_12 original-self_0 self_23)
+ (lambda (ns_71 phase-shift_15 original-self_0 self_27)
(let-values (((root-ctx_4)
- (let-values (((temp1_3) (namespace-mpi ns_64)))
+ (let-values (((temp1_3) (namespace-mpi ns_71)))
(make-root-expand-context.1 #f null unsafe-undefined unsafe-undefined temp1_3))))
- (let-values (((s_179) (add-scopes empty-syntax (root-expand-context-module-scopes root-ctx_4))))
+ (let-values (((s_616) (add-scopes empty-syntax (root-expand-context-module-scopes root-ctx_4))))
(let-values ((()
(begin
- (let-values (((lst_234) requires_4))
+ (let-values (((lst_416) requires_5))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-list lst_234)))
- ((letrec-values (((for-loop_253)
- (lambda (lst_20)
+ (check-list lst_416))
+ ((letrec-values (((for-loop_340)
+ (lambda (lst_417)
(begin
'for-loop
- (if (pair? lst_20)
- (let-values (((phase+reqs_0) (unsafe-car lst_20))
- ((rest_6) (unsafe-cdr lst_20)))
+ (if (pair? lst_417)
+ (let-values (((phase+reqs_1) (unsafe-car lst_417))
+ ((rest_204) (unsafe-cdr lst_417)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((phase_44)
- (car
- phase+reqs_0)))
- (begin
- (let-values (((lst_283)
- (cdr
- phase+reqs_0)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_283)))
- ((letrec-values (((for-loop_254)
- (lambda (lst_23)
- (begin
- 'for-loop
- (if (pair?
- lst_23)
- (let-values (((req_4)
- (unsafe-car
- lst_23))
- ((rest_20)
- (unsafe-cdr
- lst_23)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((mpi_52)
- (module-path-index-shift
- req_4
- original-self_0
- self_23)))
- (let-values (((mpi2_1)
- mpi_52)
- ((s3_0)
- s_179)
- ((self4_3)
- self_23)
- ((s5_1)
- s_179)
- ((ns6_0)
- ns_64)
- ((temp7_5)
- (phase+
- phase_44
- phase-shift_12))
- ((phase-shift8_0)
- phase-shift_12)
- ((temp9_2)
- 'module))
- (perform-require!.1
- #f
- #t
- #f
- #f
- #f
- #f
- 'all
- #t
- temp7_5
- #f
- phase-shift8_0
- #f
- #f
- unsafe-undefined
- #t
- temp9_2
- mpi2_1
- s3_0
- self4_3
- s5_1
- ns6_0))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_254
- rest_20)
- (values))))
- (values))))))
- for-loop_254)
- lst_283)))
- (void))))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_253 rest_6) (values))))
- (values))))))
- for-loop_253)
- lst_234)))
- (values))))
- (let-values ()
- (let-values (((defined-syms_10) (root-expand-context-defined-syms root-ctx_4)))
- (begin
- (let-values (((ht_30) evaled-ld-h_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_30)))
- ((letrec-values (((for-loop_108)
- (lambda (i_177)
- (begin
- 'for-loop
- (if i_177
- (let-values (((phase_96 linklet_4)
- (hash-iterate-key+value ht_30 i_177)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
+ (let-values ((()
(begin
- (let-values (((lst_65)
- (linklet-export-variables$1
- linklet_4)))
+ (let-values (((phase_111)
+ (car
+ phase+reqs_1)))
(begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_65)))
- ((letrec-values (((for-loop_22)
- (lambda (lst_66)
- (begin
- 'for-loop
- (if (pair?
- lst_66)
- (let-values (((sym_71)
- (unsafe-car
- lst_66))
- ((rest_30)
- (unsafe-cdr
- lst_66)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
+ (let-values (((lst_418)
+ (cdr
+ phase+reqs_1)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_418))
+ ((letrec-values (((for-loop_341)
+ (lambda (lst_419)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_419)
+ (let-values (((req_5)
+ (unsafe-car
+ lst_419))
+ ((rest_205)
+ (unsafe-cdr
+ lst_419)))
+ (let-values ((()
+ (let-values ((()
(begin
- (let-values ()
- (let-values (((id_67)
- (datum->syntax$1
- s_179
- sym_71)))
- (begin
- (let-values (((id10_0)
- id_67)
- ((temp11_2)
- (let-values (((self13_1)
- self_23)
- ((phase14_3)
- phase_96)
- ((sym15_1)
- sym_71))
- (make-module-binding.1
- #f
- null
- #f
- #f
- unsafe-undefined
- unsafe-undefined
- 0
- unsafe-undefined
- self13_1
- phase14_3
- sym15_1)))
- ((phase12_0)
- phase_96))
- (add-binding!.1
- #f
- #f
- id10_0
- temp11_2
- phase12_0))
- (add-defined-sym!
- defined-syms_10
- phase_96
- sym_71
- id_67))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_22
- rest_30)
- (values))))
- (values))))))
- for-loop_22)
- lst_65)))
- (void)))
- (values)))))
- (values)))))
+ (let-values (((mpi_73)
+ (module-path-index-shift
+ req_5
+ original-self_0
+ self_27)))
+ (let-values (((mpi2_1)
+ mpi_73)
+ ((s3_0)
+ s_616)
+ ((self4_3)
+ self_27)
+ ((s5_1)
+ s_616)
+ ((ns6_0)
+ ns_71)
+ ((temp7_5)
+ (phase+
+ phase_111
+ phase-shift_15))
+ ((phase-shift8_0)
+ phase-shift_15)
+ ((temp9_2)
+ 'module))
+ (perform-require!.1
+ #f
+ #t
+ #f
+ #f
+ #f
+ #f
+ 'all
+ #t
+ temp7_5
+ #f
+ phase-shift8_0
+ #f
+ #f
+ unsafe-undefined
+ #t
+ temp9_2
+ mpi2_1
+ s3_0
+ self4_3
+ s5_1
+ ns6_0)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_341
+ rest_205)
+ (values))))
+ (values))))))
+ for-loop_341)
+ lst_418)))
+ (void)))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_340 rest_204) (values))))
+ (values))))))
+ for-loop_340)
+ lst_416)))
+ (values))))
+ (let-values ()
+ (let-values (((defined-syms_11) (root-expand-context-defined-syms root-ctx_4)))
+ (begin
+ (let-values (((ht_178) evaled-ld-h_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_178))
+ ((letrec-values (((for-loop_342)
+ (lambda (i_246)
+ (begin
+ 'for-loop
+ (if i_246
+ (let-values (((phase_112 linklet_5)
+ (hash-iterate-key+value ht_178 i_246)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (begin
+ (let-values (((lst_420)
+ (linklet-export-variables$1
+ linklet_5)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_420))
+ ((letrec-values (((for-loop_343)
+ (lambda (lst_421)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_421)
+ (let-values (((sym_87)
+ (unsafe-car
+ lst_421))
+ ((rest_206)
+ (unsafe-cdr
+ lst_421)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((id_76)
+ (datum->syntax$1
+ s_616
+ sym_87)))
+ (begin
+ (let-values (((id10_0)
+ id_76)
+ ((temp11_2)
+ (let-values (((self13_1)
+ self_27)
+ ((phase14_3)
+ phase_112)
+ ((sym15_1)
+ sym_87))
+ (make-module-binding.1
+ #f
+ null
+ #f
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ 0
+ unsafe-undefined
+ self13_1
+ phase14_3
+ sym15_1)))
+ ((phase12_0)
+ phase_112))
+ (add-binding!.1
+ #f
+ #f
+ id10_0
+ temp11_2
+ phase12_0))
+ (add-defined-sym!
+ defined-syms_11
+ phase_112
+ sym_87
+ id_76)))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_343
+ rest_206)
+ (values))))
+ (values))))))
+ for-loop_343)
+ lst_420)))
+ (void))
+ (values))))
+ (values))))
(if (not #f)
- (for-loop_108 (hash-iterate-next ht_30 i_177))
+ (for-loop_342 (hash-iterate-next ht_178 i_246))
(values))))
(values))))))
- for-loop_108)
- (hash-iterate-first ht_30))))
+ for-loop_342)
+ (hash-iterate-first ht_178))))
(void)
root-ctx_4))))))))))
(define-values
@@ -40570,247 +40480,39 @@
(begin
(let-values (((outside-mpi_0) (root-expand-context-self-mpi root-context_0)))
(let-values (((inside-mpi_1) (make-self-module-path-index (module-path-index-resolved outside-mpi_0))))
- (let-values (((v_165) root-context_0))
- (let-values (((the-struct_4) v_165))
- (if (root-expand-context/outer? the-struct_4)
+ (let-values (((v_262) root-context_0))
+ (let-values (((the-struct_51) v_262))
+ (if (root-expand-context/outer? the-struct_51)
(let-values (((inner16_0)
- (let-values (((the-struct_49) (root-expand-context/outer-inner v_165)))
- (if (root-expand-context/inner? the-struct_49)
+ (let-values (((the-struct_52) (root-expand-context/outer-inner v_262)))
+ (if (root-expand-context/inner? the-struct_52)
(let-values (((self-mpi17_0) inside-mpi_1)
((all-scopes-stx18_0)
- (let-values (((temp19_2)
+ (let-values (((temp19_3)
(root-expand-context-all-scopes-stx root-context_0))
((outside-mpi20_0) outside-mpi_0)
((inside-mpi21_0) inside-mpi_1))
(syntax-module-path-index-shift.1
#f
- temp19_2
+ temp19_3
outside-mpi20_0
inside-mpi21_0
#f))))
(root-expand-context/inner2.1
self-mpi17_0
- (root-expand-context/inner-module-scopes the-struct_49)
- (root-expand-context/inner-top-level-bind-scope the-struct_49)
+ (root-expand-context/inner-module-scopes the-struct_52)
+ (root-expand-context/inner-top-level-bind-scope the-struct_52)
all-scopes-stx18_0
- (root-expand-context/inner-defined-syms the-struct_49)
- (root-expand-context/inner-counter the-struct_49)
- (root-expand-context/inner-lift-key the-struct_49)))
- (raise-argument-error 'struct-copy "root-expand-context/inner?" the-struct_49)))))
+ (root-expand-context/inner-defined-syms the-struct_52)
+ (root-expand-context/inner-counter the-struct_52)
+ (root-expand-context/inner-lift-key the-struct_52)))
+ (raise-argument-error 'struct-copy "root-expand-context/inner?" the-struct_52)))))
(root-expand-context/outer1.1
inner16_0
- (root-expand-context/outer-post-expansion the-struct_4)
- (root-expand-context/outer-use-site-scopes the-struct_4)
- (root-expand-context/outer-frame-id the-struct_4)))
- (raise-argument-error 'struct-copy "root-expand-context/outer?" the-struct_4)))))))))
- (define-values (initial-code-inspector) (current-code-inspector))
- (define-values
- (check-require-access.1)
- (lambda (skip-imports1_0
- linklet3_0
- import-module-uses4_0
- import-module-instances5_0
- insp6_0
- extra-inspector7_1
- extra-inspectorsss8_0)
- (begin
- 'check-require-access
- (let-values (((linklet_5) linklet3_0))
- (let-values (((skip-num-imports_0) skip-imports1_0))
- (let-values (((import-module-uses_0) import-module-uses4_0))
- (let-values (((import-module-instances_0) import-module-instances5_0))
- (let-values (((insp_10) insp6_0))
- (let-values (((extra-inspector_5) extra-inspector7_1))
- (let-values (((extra-inspectorsss_4) extra-inspectorsss8_0))
- (let-values ()
- (begin
- (let-values (((lst_106) (list-tail (linklet-import-variables$1 linklet_5) skip-num-imports_0))
- ((lst_170) import-module-uses_0)
- ((lst_93) import-module-instances_0)
- ((lst_194)
- (let-values (((or-part_271) extra-inspectorsss_4))
- (if or-part_271 or-part_271 import-module-uses_0))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_106)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_170)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_93)))
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_194)))
- ((letrec-values (((for-loop_22)
- (lambda (lst_66 lst_282 lst_182 lst_284)
- (begin
- 'for-loop
- (if (if (pair? lst_66)
- (if (pair? lst_282) (if (pair? lst_182) (pair? lst_284) #f) #f)
- #f)
- (let-values (((import-syms_0) (unsafe-car lst_66))
- ((rest_148) (unsafe-cdr lst_66))
- ((mu_7) (unsafe-car lst_282))
- ((rest_92) (unsafe-cdr lst_282))
- ((mi_19) (unsafe-car lst_182))
- ((rest_10) (unsafe-cdr lst_182))
- ((extra-inspectorss_14) (unsafe-car lst_284))
- ((rest_149) (unsafe-cdr lst_284)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((m_18)
- (module-instance-module
- mi_19)))
- (if (module-no-protected?
- m_18)
- (void)
- (let-values ()
- (let-values (((access_2)
- (let-values (((or-part_169)
- (module-access
- m_18)))
- (if or-part_169
- or-part_169
- (module-compute-access!
- m_18)))))
- (begin
- (let-values (((lst_285)
- import-syms_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_285)))
- ((letrec-values (((for-loop_130)
- (lambda (lst_286)
- (begin
- 'for-loop
- (if (pair?
- lst_286)
- (let-values (((import-sym_0)
- (unsafe-car
- lst_286))
- ((rest_150)
- (unsafe-cdr
- lst_286)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((a_40)
- (hash-ref
- (hash-ref
- access_2
- (module-use-phase
- mu_7)
- '#hasheq())
- import-sym_0
- 'unexported)))
- (if (let-values (((or-part_24)
- (eq?
- a_40
- 'unexported)))
- (if or-part_24
- or-part_24
- (eq?
- a_40
- 'protected)))
- (let-values ()
- (let-values (((guard-insp_3)
- (namespace-inspector
- (module-instance-namespace
- mi_19))))
- (if (let-values (((or-part_78)
- (inspector-superior?
- insp_10
- guard-insp_3)))
- (if or-part_78
- or-part_78
- (let-values (((or-part_272)
- (if extra-inspector_5
- (inspector-superior?
- extra-inspector_5
- guard-insp_3)
- #f)))
- (if or-part_272
- or-part_272
- (if extra-inspectorsss_4
- (if extra-inspectorss_14
- (extra-inspectors-allow?
- (hash-ref
- extra-inspectorss_14
- import-sym_0
- #f)
- guard-insp_3)
- #f)
- #f)))))
- (void)
- (let-values ()
- (error
- 'link
- (string-append
- "access disallowed by code inspector to ~a variable\n"
- " variable: ~s\n"
- " from module: ~a")
- a_40
- import-sym_0
- (1/module-path-index-resolve
- (namespace-mpi
- (module-instance-namespace
- mi_19))))))))
- (void))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_130
- rest_150)
- (values))))
- (values))))))
- for-loop_130)
- lst_285)))
- (void)))))))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_22 rest_148 rest_92 rest_10 rest_149)
- (values))))
- (values))))))
- for-loop_22)
- lst_106
- lst_170
- lst_93
- lst_194)))
- (void)))))))))))))
- (define-values
- (check-single-require-access)
- (lambda (mi_20 phase_23 sym_72 insp_11)
- (begin
- (let-values (((m_19) (module-instance-module mi_20)))
- (if (module-no-protected? m_19)
- (let-values () #t)
- (let-values ()
- (let-values (((access_3)
- (let-values (((or-part_273) (module-access m_19)))
- (if or-part_273 or-part_273 (module-compute-access! m_19)))))
- (let-values (((a_41) (hash-ref (hash-ref access_3 phase_23 '#hasheq()) sym_72 'unexported)))
- (if (let-values (((or-part_40) (eq? a_41 'unexported)))
- (if or-part_40 or-part_40 (eq? a_41 'protected)))
- (let-values ()
- (let-values (((guard-insp_4) (namespace-inspector (module-instance-namespace mi_20))))
- (let-values (((or-part_274) (if insp_11 (inspector-superior? insp_11 guard-insp_4) #f)))
- (if or-part_274 or-part_274 (inspector-superior? (current-code-inspector) guard-insp_4)))))
- (let-values () #t))))))))))
+ (root-expand-context/outer-post-expansion the-struct_51)
+ (root-expand-context/outer-use-site-scopes the-struct_51)
+ (root-expand-context/outer-frame-id the-struct_51)))
+ (raise-argument-error 'struct-copy "root-expand-context/outer?" the-struct_51)))))))))
(define-values (cell.1$3) (unsafe-make-place-local (make-weak-hasheq)))
(define-values (module-cache-place-init!) (lambda () (begin (unsafe-place-local-set! cell.1$3 (make-weak-hasheq)))))
(define-values
@@ -40824,382 +40526,365 @@
(list
hash-code_6
(path->directory-path
- (let-values (((or-part_85) (current-load-relative-directory)))
- (if or-part_85 or-part_85 (current-directory)))))))
+ (let-values (((or-part_434) (current-load-relative-directory)))
+ (if or-part_434 or-part_434 (current-directory)))))))
#f))))
(define-values
(module-cache-set!)
- (lambda (key_75 proc_9) (begin (hash-set! (unsafe-place-local-ref cell.1$3) key_75 (make-ephemeron key_75 proc_9)))))
+ (lambda (key_79 proc_9) (begin (hash-set! (unsafe-place-local-ref cell.1$3) key_79 (make-ephemeron key_79 proc_9)))))
(define-values
(module-cache-ref)
- (lambda (key_68)
+ (lambda (key_80)
(begin
- (let-values (((e_81) (hash-ref (unsafe-place-local-ref cell.1$3) key_68 #f)))
- (if e_81 (ephemeron-value e_81) #f)))))
+ (let-values (((e_90) (hash-ref (unsafe-place-local-ref cell.1$3) key_80 #f)))
+ (if e_90 (ephemeron-value e_90) #f)))))
(define-values
(1/module-cache-clear!)
- (lambda ()
- (begin 'module-cache-clear! (let-values () (let-values () (hash-clear! (unsafe-place-local-ref cell.1$3)))))))
+ (lambda () (begin 'module-cache-clear! (hash-clear! (unsafe-place-local-ref cell.1$3)))))
(define-values (current-module-declare-as-predefined) (make-parameter #f #f 'current-module-declare-as-predefined))
(define-values
(eval-module.1)
(lambda (namespace1_2 supermodule-name3_0 with-submodules?2_0 c7_0)
(begin
'eval-module
- (let-values (((c_39) c7_0))
- (let-values (((ns_65) (if (eq? namespace1_2 unsafe-undefined) (1/current-namespace) namespace1_2)))
+ (let-values (((c_45) c7_0))
+ (let-values (((ns_72) (if (eq? namespace1_2 unsafe-undefined) (1/current-namespace) namespace1_2)))
(let-values (((with-submodules?_1) with-submodules?2_0))
(let-values (((supermodule-name_1) supermodule-name3_0))
- (let-values ()
- (begin
- (if log-performance? (let-values () (start-performance-region 'eval 'module)) (void))
- (begin0
- (let-values ()
- (let-values (((dh_0 h_4 data-instance_0 declaration-instance_0)
- (compiled-module->dh+h+data-instance+declaration-instance c_39)))
- (let-values (((syntax-literals-data-instance_0)
- (if (compiled-in-memory? c_39)
- (make-syntax-literal-data-instance-from-compiled-in-memory c_39)
- (let-values (((l_10) (hash-ref h_4 'stx-data #f)))
- (if l_10
- (let-values ()
- (instantiate-linklet$1
- (eval-linklet* l_10)
- (list deserialize-instance data-instance_0)))
- (if (eq? (hash-ref h_4 'module->namespace #f) 'empty)
- (let-values () empty-syntax-literals-instance/empty-namespace)
- (let-values () empty-syntax-literals-data-instance)))))))
- (let-values (((decl_0)
- (lambda (key_76)
- (begin 'decl (1/instance-variable-value declaration-instance_0 key_76)))))
- (let-values (((pre-submodule-names_0) (hash-ref h_4 'pre null)))
- (let-values (((post-submodule-names_0) (hash-ref h_4 'post null)))
- (let-values (((default-name_1) (hash-ref h_4 'name 'module)))
- (let-values (((cache-key_0)
- (make-module-cache-key
- (if (null? pre-submodule-names_0)
- (if (null? post-submodule-names_0) (hash-ref h_4 'hash-code #f) #f)
- #f))))
- (let-values (((cross-phase-persistent?_1)
- (hash-ref h_4 'cross-phase-persistent? #f)))
- (let-values (((min-phase_2) (hash-ref h_4 'min-phase 0)))
- (let-values (((max-phase_2) (hash-ref h_4 'max-phase 0)))
- (let-values (((language-info_1) (hash-ref h_4 'language-info #f)))
- (let-values (((realm_3) (hash-ref h_4 'realm 'racket)))
- (let-values (((phases-h_0)
- (let-values (((start_48) min-phase_2)
- ((end_34) (add1 max-phase_2))
- ((inc_28) 1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-range start_48 end_34 inc_28)))
- ((letrec-values (((for-loop_204)
- (lambda (table_192 pos_120)
- (begin
- 'for-loop
- (if (< pos_120 end_34)
- (let-values (((phase-level_21)
- pos_120))
- (let-values (((table_12)
- (let-values (((table_193)
- table_192))
- (let-values (((id*_9)
- (hash-ref
- h_4
- phase-level_21
- #f)))
- (begin
- #t
- ((letrec-values (((for-loop_23)
- (lambda (table_116)
- (begin
- 'for-loop
- (let-values (((v_196)
- id*_9))
- (let-values (((table_194)
- (let-values (((table_195)
- table_116))
- (let-values (((table_196)
- table_195))
- (if v_196
- (let-values (((table_197)
- table_196))
- (let-values (((table_198)
- (let-values ()
- (let-values (((key_77
- val_58)
- (let-values ()
- (values
- phase-level_21
- (eval-linklet*
- v_196)))))
- (hash-set
- table_197
- key_77
- val_58)))))
- (values
- table_198)))
- table_196)))))
- table_194))))))
- for-loop_23)
- table_193))))))
- (if (not #f)
- (for-loop_204
- table_12
- (+ pos_120 inc_28))
- table_12)))
- table_192)))))
- for-loop_204)
- '#hash()
- start_48)))))
- (let-values (((syntax-literals-linklet_0)
- (let-values (((l_50) (hash-ref h_4 'stx #f)))
- (if l_50 (eval-linklet* l_50) #f))))
- (let-values (((extra-inspector_6)
- (if (compiled-in-memory? c_39)
- (compiled-in-memory-compile-time-inspector c_39)
- #f)))
- (let-values (((phase-to-link-extra-inspectorsss_1)
- (if (compiled-in-memory? c_39)
- (compiled-in-memory-phase-to-link-extra-inspectorsss
- c_39)
- '#hasheqv())))
- (let-values (((requires_5) (decl_0 'requires)))
- (let-values (((provides_11) (decl_0 'provides)))
+ (begin
+ (if log-performance? (start-performance-region 'eval 'module) (void))
+ (begin0
+ (let-values (((dh_0 h_4 data-instance_0 declaration-instance_0)
+ (compiled-module->dh+h+data-instance+declaration-instance c_45)))
+ (let-values (((syntax-literals-data-instance_0)
+ (if (compiled-in-memory? c_45)
+ (make-syntax-literal-data-instance-from-compiled-in-memory c_45)
+ (let-values (((l_59) (hash-ref h_4 'stx-data #f)))
+ (if l_59
+ (instantiate-linklet$1
+ (eval-linklet* l_59)
+ (list deserialize-instance data-instance_0))
+ (if (eq? (hash-ref h_4 'module->namespace #f) 'empty)
+ empty-syntax-literals-instance/empty-namespace
+ empty-syntax-literals-data-instance))))))
+ (let-values (((decl_0)
+ (lambda (key_81)
+ (begin 'decl (1/instance-variable-value declaration-instance_0 key_81)))))
+ (let-values (((pre-submodule-names_0) (hash-ref h_4 'pre null)))
+ (let-values (((post-submodule-names_0) (hash-ref h_4 'post null)))
+ (let-values (((default-name_1) (hash-ref h_4 'name 'module)))
+ (let-values (((cache-key_0)
+ (make-module-cache-key
+ (if (null? pre-submodule-names_0)
+ (if (null? post-submodule-names_0) (hash-ref h_4 'hash-code #f) #f)
+ #f))))
+ (let-values (((cross-phase-persistent?_1) (hash-ref h_4 'cross-phase-persistent? #f)))
+ (let-values (((min-phase_2) (hash-ref h_4 'min-phase 0)))
+ (let-values (((max-phase_2) (hash-ref h_4 'max-phase 0)))
+ (let-values (((language-info_1) (hash-ref h_4 'language-info #f)))
+ (let-values (((realm_3) (hash-ref h_4 'realm 'racket)))
+ (let-values (((phases-h_0)
+ (let-values (((table_233)
+ (let-values (((table_234) '#hash())) table_234)))
+ (let-values (((start_57) min-phase_2)
+ ((end_37) (add1 max-phase_2))
+ ((inc_31) 1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-range start_57 end_37 inc_31))
+ ((letrec-values (((for-loop_344)
+ (lambda (table_235 pos_151)
+ (begin
+ 'for-loop
+ (if (< pos_151 end_37)
+ (let-values (((phase-level_24)
+ pos_151))
+ (let-values (((table_236)
+ (let-values (((id*_9)
+ (hash-ref
+ h_4
+ phase-level_24
+ #f)))
+ ((letrec-values (((for-loop_345)
+ (lambda (table_237)
+ (begin
+ 'for-loop
+ (let-values (((v_263)
+ id*_9))
+ (let-values (((table_238)
+ (if v_263
+ (let-values (((table_239)
+ (let-values (((key_82
+ val_61)
+ (values
+ phase-level_24
+ (eval-linklet*
+ v_263))))
+ (hash-set
+ table_237
+ key_82
+ val_61))))
+ (values
+ table_239))
+ table_237)))
+ table_238))))))
+ for-loop_345)
+ table_235))))
+ (if (not #f)
+ (for-loop_344
+ table_236
+ (+ pos_151 inc_31))
+ table_236)))
+ table_235)))))
+ for-loop_344)
+ table_233
+ start_57))))))
+ (let-values (((syntax-literals-linklet_0)
+ (let-values (((l_60) (hash-ref h_4 'stx #f)))
+ (if l_60 (eval-linklet* l_60) #f))))
+ (let-values (((extra-inspector_7)
+ (if (compiled-in-memory? c_45)
+ (compiled-in-memory-compile-time-inspector c_45)
+ #f)))
+ (let-values (((phase-to-link-extra-inspectorsss_1)
+ (if (compiled-in-memory? c_45)
+ (compiled-in-memory-phase-to-link-extra-inspectorsss
+ c_45)
+ '#hasheqv())))
+ (let-values (((requires_6) (decl_0 'requires)))
+ (let-values (((recur-requires_3) (decl_0 'recur-requires)))
+ (let-values (((flattened-requires_3)
+ (decl_0 'flattened-requires)))
+ (let-values (((provides_12) (decl_0 'provides)))
(let-values (((original-self_1) (decl_0 'self-mpi)))
(let-values (((phase-to-link-modules_0)
(decl_0 'phase-to-link-modules)))
- (let-values (((portal-stxes_1) (decl_0 'portal-stxes)))
- (let-values (((create-root-expand-context-from-module_0)
- (make-create-root-expand-context-from-module
- requires_5
- phases-h_0)))
- (let-values (((declare-submodules_0)
- (if dh_0
- (lambda (ns_66
- names_0
- declare-name_0
- pre?_0)
- (begin
- 'declare-submodules
- (if (compiled-in-memory? c_39)
- (begin
- (let-values (((lst_95)
- (if pre?_0
- (compiled-in-memory-pre-compiled-in-memorys
- c_39)
- (compiled-in-memory-post-compiled-in-memorys
- c_39))))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_95)))
- ((letrec-values (((for-loop_115)
- (lambda (lst_287)
- (begin
- 'for-loop
- (if (pair?
- lst_287)
- (let-values (((c_36)
- (unsafe-car
- lst_287))
- ((rest_151)
- (unsafe-cdr
- lst_287)))
- (let-values ((()
- (let-values ()
+ (let-values (((module-use-resolution-cache_1)
+ (make-hasheq)))
+ (let-values (((portal-stxes_1) (decl_0 'portal-stxes)))
+ (let-values (((create-root-expand-context-from-module_0)
+ (make-create-root-expand-context-from-module
+ requires_6
+ phases-h_0)))
+ (let-values (((declare-submodules_0)
+ (if dh_0
+ (lambda (ns_73
+ names_0
+ declare-name_0
+ pre?_0)
+ (begin
+ 'declare-submodules
+ (if (compiled-in-memory? c_45)
+ (begin
+ (let-values (((lst_422)
+ (if pre?_0
+ (compiled-in-memory-pre-compiled-in-memorys
+ c_45)
+ (compiled-in-memory-post-compiled-in-memorys
+ c_45))))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_422))
+ ((letrec-values (((for-loop_346)
+ (lambda (lst_423)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_423)
+ (let-values (((c_46)
+ (unsafe-car
+ lst_423))
+ ((rest_207)
+ (unsafe-cdr
+ lst_423)))
+ (let-values ((()
(let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((c10_0)
- c_36)
- ((ns11_0)
- ns_66)
- ((declare-name12_0)
+ (begin
+ (let-values (((c10_0)
+ c_46)
+ ((ns11_0)
+ ns_73)
+ ((declare-name12_0)
+ declare-name_0))
+ (eval-module.1
+ ns11_0
+ declare-name12_0
+ #t
+ c10_0))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_346
+ rest_207)
+ (values))))
+ (values))))))
+ for-loop_346)
+ lst_422)))
+ (void))
+ (begin
+ (let-values (((lst_424)
+ names_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_424))
+ ((letrec-values (((for-loop_347)
+ (lambda (lst_425)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_425)
+ (let-values (((name_61)
+ (unsafe-car
+ lst_425))
+ ((rest_208)
+ (unsafe-cdr
+ lst_425)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((sm-cd_0)
+ (hash-ref
+ dh_0
+ name_61
+ #f)))
+ (begin
+ (if sm-cd_0
+ (void)
+ (error
+ "missing submodule declaration:"
+ name_61))
+ (let-values (((sm-cd13_0)
+ sm-cd_0)
+ ((ns14_1)
+ ns_73)
+ ((declare-name15_0)
declare-name_0))
(eval-module.1
- ns11_0
- declare-name12_0
+ ns14_1
+ declare-name15_0
#t
- c10_0)))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_115
- rest_151)
- (values))))
- (values))))))
- for-loop_115)
- lst_95)))
- (void))
- (begin
- (let-values (((lst_7)
- names_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_7)))
- ((letrec-values (((for-loop_2)
- (lambda (lst_97)
- (begin
- 'for-loop
- (if (pair?
- lst_97)
- (let-values (((name_52)
- (unsafe-car
- lst_97))
- ((rest_100)
- (unsafe-cdr
- lst_97)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((sm-cd_0)
- (hash-ref
- dh_0
- name_52
- #f)))
- (begin
- (if sm-cd_0
- (void)
- (let-values ()
- (error
- "missing submodule declaration:"
- name_52)))
- (let-values (((sm-cd13_0)
- sm-cd_0)
- ((ns14_1)
- ns_66)
- ((declare-name15_0)
- declare-name_0))
- (eval-module.1
- ns14_1
- declare-name15_0
- #t
- sm-cd13_0)))))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_2
- rest_100)
- (values))))
- (values))))))
- for-loop_2)
- lst_7)))
- (void)))))
- void)))
- (let-values (((declare-this-module_0)
- (lambda (ns_67)
- (begin
- 'declare-this-module
- (let-values (((m_20)
- (let-values (((temp20_3)
- (1/current-module-declare-source))
- ((original-self21_0)
- original-self_1)
- ((requires22_1)
- requires_5)
- ((provides23_0)
- provides_11)
- ((language-info24_0)
- language-info_1)
- ((realm25_0)
- realm_3)
- ((min-phase26_0)
- min-phase_2)
- ((max-phase27_0)
- max-phase_2)
- ((cross-phase-persistent?28_0)
- cross-phase-persistent?_1)
- ((temp29_2)
- (current-module-declare-as-predefined))
- ((temp30_1)
- (append
- pre-submodule-names_0
- post-submodule-names_0))
- ((supermodule-name31_0)
- supermodule-name_1)
- ((temp32_1)
- (lambda ()
- (get-all-variables
- phases-h_0)))
- ((temp33_3)
- (lambda (phase-level_2
- ns_14
- insp_12)
- (module-linklet-info2.1
- (hash-ref
- phases-h_0
- phase-level_2
- #f)
- (hash-ref
- phase-to-link-modules_0
- phase-level_2
- #f)
- original-self_1
- insp_12
- extra-inspector_6
- (hash-ref
- phase-to-link-extra-inspectorsss_1
- phase-level_2
- #f))))
- ((temp34_1)
- (lambda (bulk-binding-registry_17)
- (force-syntax-deserialize
- syntax-literals-data-instance_0
- bulk-binding-registry_17)))
- ((temp35_1)
- (lambda (data-box_4
- ns_15
- phase-shift_14
- self_24
- bulk-binding-registry_18
- insp_13)
- (if (unbox
- data-box_4)
- (void)
- (let-values ()
+ sm-cd13_0))))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_347
+ rest_208)
+ (values))))
+ (values))))))
+ for-loop_347)
+ lst_424)))
+ (void)))))
+ void)))
+ (let-values (((declare-this-module_0)
+ (lambda (ns_74)
+ (begin
+ 'declare-this-module
+ (let-values (((m_25)
+ (let-values (((temp20_3)
+ (1/current-module-declare-source))
+ ((original-self21_0)
+ original-self_1)
+ ((requires22_0)
+ requires_6)
+ ((recur-requires23_0)
+ recur-requires_3)
+ ((flattened-requires24_0)
+ flattened-requires_3)
+ ((provides25_0)
+ provides_12)
+ ((language-info26_0)
+ language-info_1)
+ ((realm27_0)
+ realm_3)
+ ((min-phase28_0)
+ min-phase_2)
+ ((max-phase29_0)
+ max-phase_2)
+ ((cross-phase-persistent?30_0)
+ cross-phase-persistent?_1)
+ ((temp31_0)
+ (current-module-declare-as-predefined))
+ ((temp32_1)
+ (append
+ pre-submodule-names_0
+ post-submodule-names_0))
+ ((supermodule-name33_0)
+ supermodule-name_1)
+ ((temp34_1)
+ (lambda ()
+ (get-all-variables
+ phases-h_0)))
+ ((temp35_1)
+ (lambda (phase-level_25
+ ns_75
+ insp_12)
+ (module-linklet-info2.1
+ (hash-ref
+ phases-h_0
+ phase-level_25
+ #f)
+ (hash-ref
+ phase-to-link-modules_0
+ phase-level_25
+ #f)
+ original-self_1
+ insp_12
+ extra-inspector_7
+ (hash-ref
+ phase-to-link-extra-inspectorsss_1
+ phase-level_25
+ #f))))
+ ((temp36_2)
+ (lambda (bulk-binding-registry_18)
+ (force-syntax-deserialize
+ syntax-literals-data-instance_0
+ bulk-binding-registry_18)))
+ ((temp37_2)
+ (lambda (data-box_4
+ ns_76
+ phase-shift_16
+ self_28
+ bulk-binding-registry_19
+ insp_13)
+ (if (unbox
+ data-box_4)
+ (void)
(init-instance-data!
data-box_4
cache-key_0
- ns_15
+ ns_76
syntax-literals-linklet_0
data-instance_0
syntax-literals-data-instance_0
- phase-shift_14
+ phase-shift_16
original-self_1
- self_24
- bulk-binding-registry_18
+ self_28
+ bulk-binding-registry_19
insp_13
- create-root-expand-context-from-module_0)))))
- ((temp36_1)
- (lambda (data-box_5
- phase_81
- sym_73)
- (let-values (((ht_141)
- (hash-ref
- portal-stxes_1
- phase_81
- '#hasheq())))
- (let-values (((pos_121)
+ create-root-expand-context-from-module_0))))
+ ((temp38_2)
+ (lambda (data-box_5
+ phase_113
+ sym_88)
+ (let-values (((ht_179)
(hash-ref
- ht_141
- sym_73
- #f)))
- (if pos_121
- (let-values ()
+ portal-stxes_1
+ phase_113
+ '#hasheq())))
+ (let-values (((pos_152)
+ (hash-ref
+ ht_179
+ sym_88
+ #f)))
+ (if pos_152
(let-values (((syntax-literals-instance_0)
(instance-data-syntax-literals-instance
(unbox
@@ -41207,26 +40892,23 @@
((1/instance-variable-value
syntax-literals-instance_0
get-syntax-literal!-id)
- pos_121)))
- (let-values ()
- #f))))))
- ((temp37_3)
- (lambda (data-box_6
- ns_68
- phase-shift_15
- phase-level_22
- self_25
- bulk-binding-registry_19
- insp_14)
- (begin
- (if log-performance?
- (let-values ()
+ pos_152))
+ #f)))))
+ ((temp39_1)
+ (lambda (data-box_6
+ ns_77
+ phase-shift_17
+ phase-level_26
+ self_29
+ bulk-binding-registry_20
+ insp_14)
+ (begin
+ (if log-performance?
(start-performance-region
'eval
- 'instantiate))
- (void))
- (begin0
- (let-values ()
+ 'instantiate)
+ (void))
+ (begin0
(let-values (((syntax-literals-instance_1)
(instance-data-syntax-literals-instance
(unbox
@@ -41235,415 +40917,397 @@
(hash-ref
portal-stxes_1
(sub1
- phase-level_22)
+ phase-level_26)
'#hasheq())))
(let-values ((()
- (begin
- (if (zero?
- (hash-count
- phase-portal-stxes_0))
- (void)
- (let-values ()
- (let-values (((get-syntax-literal!_0)
- (1/instance-variable-value
- syntax-literals-instance_1
- get-syntax-literal!-id)))
- (begin
- (let-values (((ht_33)
- phase-portal-stxes_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash
- ht_33)))
- ((letrec-values (((for-loop_36)
- (lambda (i_123)
- (begin
- 'for-loop
- (if i_123
- (let-values (((key_78
- pos_122)
- (hash-iterate-key+value
- ht_33
- i_123)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (if (symbol?
- key_78)
- (let-values ()
- (let-values (((portal-stx_2)
- (get-syntax-literal!_0
- pos_122)))
- (namespace-set-transformer!
- ns_68
- (sub1
- phase-level_22)
- key_78
- (portal-syntax1.1
- portal-stx_2))))
- (void)))
- (values)))))
- (values)))))
- (if (not
- #f)
- (for-loop_36
- (hash-iterate-next
- ht_33
- i_123))
- (values))))
- (values))))))
- for-loop_36)
- (hash-iterate-first
- ht_33))))
- (void)))))
+ (begin
+ (if (zero?
+ (hash-count
+ phase-portal-stxes_0))
+ (void)
+ (let-values (((get-syntax-literal!_0)
+ (1/instance-variable-value
+ syntax-literals-instance_1
+ get-syntax-literal!-id)))
+ (begin
+ (let-values (((ht_180)
+ phase-portal-stxes_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash
+ ht_180))
+ ((letrec-values (((for-loop_348)
+ (lambda (i_247)
+ (begin
+ 'for-loop
+ (if i_247
+ (let-values (((key_83
+ pos_153)
+ (hash-iterate-key+value
+ ht_180
+ i_247)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (if (symbol?
+ key_83)
+ (namespace-set-transformer!
+ ns_77
+ (sub1
+ phase-level_26)
+ key_83
+ (portal-syntax1.1
+ get-syntax-literal!_0
+ pos_153))
+ (void))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_348
+ (hash-iterate-next
+ ht_180
+ i_247))
+ (values))))
+ (values))))))
+ for-loop_348)
+ (hash-iterate-first
+ ht_180))))
+ (void))))
(values))))
(let-values (((phase-linklet_0)
(hash-ref
phases-h_0
- phase-level_22
+ phase-level_26
#f)))
(if phase-linklet_0
- (let-values ()
- (let-values (((module-uses_0)
- (hash-ref
- phase-to-link-modules_0
- phase-level_22)))
- (let-values (((import-module-instances_1
- import-instances_0)
- (let-values (((mis_1
- is_0)
- (let-values (((lst_288)
+ (let-values (((module-uses_0)
+ (hash-ref
+ phase-to-link-modules_0
+ phase-level_26)))
+ (let-values (((import-module-instances_1
+ import-instances_0)
+ (let-values (((mis_1
+ is_0)
+ (let-values (((mis_2)
+ (let-values (((mis_3)
+ null))
+ mis_3))
+ ((is_1)
+ (let-values (((is_2)
+ null))
+ is_2)))
+ (let-values (((lst_426)
module-uses_0))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-list
- lst_288)))
- ((letrec-values (((for-loop_255)
- (lambda (mis_2
- is_1
- lst_289)
+ (check-list
+ lst_426))
+ ((letrec-values (((for-loop_349)
+ (lambda (mis_4
+ is_3
+ lst_427)
(begin
'for-loop
(if (pair?
- lst_289)
+ lst_427)
(let-values (((mu_8)
(unsafe-car
- lst_289))
- ((rest_95)
+ lst_427))
+ ((rest_209)
(unsafe-cdr
- lst_289)))
- (let-values (((mis_3
- is_2)
- (let-values (((mis_4)
- mis_2)
- ((is_3)
- is_1))
- (let-values (((mis_5
- is_4)
- (let-values ()
- (let-values (((mis45_0
- is46_0)
- (let-values ()
- (let-values (((ns47_0)
- ns_68)
- ((mu48_0)
- mu_8)
- ((original-self49_0)
- original-self_1)
- ((self50_0)
- self_25)
- ((temp51_1)
- (phase+
- (phase-
- phase-level_22
- (module-use-phase
- mu_8))
- phase-shift_15)))
- (namespace-module-use->module+linklet-instances.1
- temp51_1
- original-self49_0
- self50_0
- ns47_0
- mu48_0)))))
- (values
- (cons
- mis45_0
- mis_4)
- (cons
- is46_0
- is_3))))))
- (values
- mis_5
- is_4)))))
+ lst_427)))
+ (let-values (((mis_5
+ is_4)
+ (let-values (((mis_6
+ is_5)
+ (let-values (((mis47_0
+ is48_0)
+ (let-values (((ns49_0)
+ ns_77)
+ ((mu50_0)
+ mu_8)
+ ((original-self51_0)
+ original-self_1)
+ ((self52_0)
+ self_29)
+ ((temp53_1)
+ (phase+
+ (phase-
+ phase-level_26
+ (module-use-phase
+ mu_8))
+ phase-shift_17))
+ ((module-use-resolution-cache54_0)
+ module-use-resolution-cache_1))
+ (namespace-module-use->module+linklet-instances.1
+ temp53_1
+ module-use-resolution-cache54_0
+ original-self51_0
+ self52_0
+ ns49_0
+ mu50_0))))
+ (values
+ (cons
+ mis47_0
+ mis_4)
+ (cons
+ is48_0
+ is_3)))))
+ (values
+ mis_6
+ is_5))))
(if (not
#f)
- (for-loop_255
- mis_3
- is_2
- rest_95)
+ (for-loop_349
+ mis_5
+ is_4
+ rest_209)
(values
- mis_3
- is_2))))
+ mis_5
+ is_4))))
(values
- mis_2
- is_1))))))
- for-loop_255)
- null
- null
- lst_288)))))
- (values
- (reverse$1
- mis_1)
- (reverse$1
- is_0)))))
- (let-values ((()
- (begin
- (let-values (((phase-linklet38_0)
- phase-linklet_0)
- ((temp39_1)
- 2)
- ((module-uses40_0)
- module-uses_0)
- ((import-module-instances41_0)
- import-module-instances_1)
- ((insp42_0)
- insp_14)
- ((extra-inspector43_0)
- extra-inspector_6)
- ((temp44_1)
- (hash-ref
- phase-to-link-extra-inspectorsss_1
- phase-level_22
- #f)))
- (check-require-access.1
- temp39_1
- phase-linklet38_0
- module-uses40_0
- import-module-instances41_0
- insp42_0
- extra-inspector43_0
- temp44_1))
- (values))))
- (let-values (((module-body-instance-instance_0)
- (let-values (((temp52_0)
- (if (zero-phase?
- phase-level_22)
- (let-values ()
- (lambda (name_53
- val_14)
- (begin
- 'temp52
- (error
- 'define-syntax
- "should not happen at phase level 0"))))
- (let-values ()
- (lambda (name_54
- val_59)
- (begin
- 'temp52
- (namespace-set-transformer!
- ns_68
- (sub1
- phase-level_22)
- name_54
- val_59)))))))
- (make-module-body-instance-instance.1
- temp52_0))))
- (let-values (((instantiate-body_0)
- (lambda ()
- (begin
- 'instantiate-body
- (instantiate-linklet$1
- phase-linklet_0
- (list*
- syntax-literals-instance_1
- module-body-instance-instance_0
- import-instances_0)
- (namespace->instance
- ns_68
- phase-level_22))))))
+ mis_4
+ is_3))))))
+ for-loop_349)
+ mis_2
+ is_1
+ lst_426))))))
+ (values
+ (reverse$1
+ mis_1)
+ (reverse$1
+ is_0)))))
+ (let-values ((()
+ (begin
+ (let-values (((phase-linklet40_0)
+ phase-linklet_0)
+ ((temp41_1)
+ 2)
+ ((module-uses42_0)
+ module-uses_0)
+ ((import-module-instances43_0)
+ import-module-instances_1)
+ ((insp44_0)
+ insp_14)
+ ((extra-inspector45_0)
+ extra-inspector_7)
+ ((temp46_0)
+ (hash-ref
+ phase-to-link-extra-inspectorsss_1
+ phase-level_26
+ #f)))
+ (check-require-access.1
+ temp41_1
+ phase-linklet40_0
+ module-uses42_0
+ import-module-instances43_0
+ insp44_0
+ extra-inspector45_0
+ temp46_0))
+ (values))))
+ (let-values (((module-body-instance-instance_0)
+ (let-values (((temp55_1)
+ (if (zero-phase?
+ phase-level_26)
+ (lambda (name_62
+ val_62)
+ (begin
+ 'temp55
+ (error
+ 'define-syntax
+ "should not happen at phase level 0")))
+ (lambda (name_63
+ val_63)
+ (begin
+ 'temp55
+ (namespace-set-transformer!
+ ns_77
+ (sub1
+ phase-level_26)
+ name_63
+ val_63))))))
+ (make-module-body-instance-instance.1
+ temp55_1))))
+ (let-values (((instantiate-body_0)
+ (lambda ()
+ (begin
+ 'instantiate-body
+ (instantiate-linklet$1
+ phase-linklet_0
+ (list*
+ syntax-literals-instance_1
+ module-body-instance-instance_0
+ import-instances_0)
+ (namespace->instance
+ ns_77
+ phase-level_26))))))
+ (if (zero-phase?
+ phase-level_26)
(if (zero-phase?
- phase-level_22)
- (let-values ()
- (if (zero-phase?
- phase-shift_15)
- (let-values ()
- (instantiate-body_0))
- (let-values ()
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first
- #f
- parameterization-key)
- 1/current-namespace
- ns_68)
- (let-values ()
- (instantiate-body_0))))))
- (let-values ()
- (let-values (((ns-1_0)
- (namespace->namespace-at-phase
- ns_68
- (phase+
- phase-shift_15
- (sub1
- phase-level_22)))))
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first
- #f
- parameterization-key)
- 1/current-namespace
- ns_68)
- (let-values ()
- (with-continuation-mark
- current-expand-context
- (promise1.1
- (lambda ()
- (let-values (((ns-153_0)
- ns-1_0)
- ((temp54_1)
- #t))
- (make-expand-context.1
- #f
- #f
- temp54_1
- #f
- #f
- ns-153_0)))
- #f)
- (with-continuation-mark
- current-module-code-inspector
- insp_14
- (let-values ()
- (instantiate-body_0)))))))))))))))
- (void)))))))
- (if log-performance?
- (let-values ()
- (end-performance-region))
- (void)))))))
- (make-module.1
- cross-phase-persistent?28_0
- temp34_1
- temp32_1
- temp36_1
- temp37_3
- language-info24_0
- max-phase27_0
- min-phase26_0
- #f
- temp33_3
- temp29_2
- temp35_1
- #f
- provides23_0
- realm25_0
- requires22_1
- original-self21_0
- temp20_3
- temp30_1
- supermodule-name31_0))))
- (let-values (((declare-name_1)
- (substitute-module-declare-name
- default-name_1)))
- (begin
- (if with-submodules?_1
- (let-values ()
+ phase-shift_17)
+ (instantiate-body_0)
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first
+ #f
+ parameterization-key)
+ 1/current-namespace
+ ns_77)
+ (instantiate-body_0)))
+ (let-values (((ns-1_0)
+ (namespace->namespace-at-phase
+ ns_77
+ (phase+
+ phase-shift_17
+ (sub1
+ phase-level_26)))))
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first
+ #f
+ parameterization-key)
+ 1/current-namespace
+ ns_77)
+ (with-continuation-mark
+ current-expand-context
+ (promise1.1
+ (lambda ()
+ (let-values (((ns-156_0)
+ ns-1_0)
+ ((temp57_0)
+ #t))
+ (make-expand-context.1
+ #f
+ #f
+ temp57_0
+ #f
+ #f
+ ns-156_0)))
+ #f)
+ (with-continuation-mark
+ current-module-code-inspector
+ insp_14
+ (instantiate-body_0)))))))))))
+ (void))))))
+ (if log-performance?
+ (end-performance-region)
+ (void)))))))
+ (make-module.1
+ cross-phase-persistent?30_0
+ flattened-requires24_0
+ temp36_2
+ temp34_1
+ temp38_2
+ temp39_1
+ language-info26_0
+ max-phase29_0
+ min-phase28_0
+ #f
+ temp35_1
+ temp31_0
+ temp37_2
+ #f
+ provides25_0
+ realm27_0
+ recur-requires23_0
+ requires22_0
+ original-self21_0
+ temp20_3
+ temp32_1
+ supermodule-name33_0))))
+ (let-values (((declare-name_1)
+ (substitute-module-declare-name
+ default-name_1)))
+ (begin
+ (if with-submodules?_1
(declare-submodules_0
- ns_67
+ ns_74
pre-submodule-names_0
declare-name_1
- #t))
- (void))
- (let-values (((ns16_0)
- ns_67)
- ((m17_0) m_20)
- ((declare-name18_0)
- declare-name_1)
- ((with-submodules?19_0)
- with-submodules?_1))
- (declare-module!.1
- with-submodules?19_0
- ns16_0
- m17_0
- declare-name18_0))
- (if with-submodules?_1
- (let-values ()
+ #t)
+ (void))
+ (let-values (((ns16_0)
+ ns_74)
+ ((m17_0)
+ m_25)
+ ((declare-name18_0)
+ declare-name_1)
+ ((with-submodules?19_0)
+ with-submodules?_1))
+ (declare-module!.1
+ with-submodules?19_0
+ ns16_0
+ m17_0
+ declare-name18_0))
+ (if with-submodules?_1
(declare-submodules_0
- ns_67
+ ns_74
post-submodule-names_0
declare-name_1
- #f))
- (void)))))))))
- (begin
- (if cache-key_0
- (let-values ()
+ #f)
+ (void)))))))))
+ (begin
+ (if cache-key_0
(module-cache-set!
cache-key_0
- declare-this-module_0))
- (void))
- (declare-this-module_0
- ns_65)))))))))))))))))))))))))))
- (if log-performance? (let-values () (end-performance-region)) (void))))))))))))
+ declare-this-module_0)
+ (void))
+ (declare-this-module_0
+ ns_72)))))))))))))))))))))))))))))
+ (if log-performance? (end-performance-region) (void)))))))))))
(define-values
(struct:instance-data instance-data9.1 instance-data? instance-data-syntax-literals-instance instance-data-cache-key)
- (let-values (((struct:_63 make-_63 ?_63 -ref_63 -set!_63)
- (let-values ()
- (let-values ()
- (make-struct-type 'instance-data #f 2 0 #f null (current-inspector) #f '(0 1) #f 'instance-data)))))
+ (let-values (((struct:_113 make-_113 ?_113 -ref_113 -set!_113)
+ (make-struct-type 'instance-data #f 2 0 #f null (current-inspector) #f '(0 1) #f 'instance-data)))
(values
- struct:_63
- make-_63
- ?_63
- (make-struct-field-accessor -ref_63 0 'syntax-literals-instance)
- (make-struct-field-accessor -ref_63 1 'cache-key))))
+ struct:_113
+ make-_113
+ ?_113
+ (make-struct-field-accessor -ref_113 0 'syntax-literals-instance)
+ (make-struct-field-accessor -ref_113 1 'cache-key))))
(define-values
(init-instance-data!)
(lambda (data-box_7
cache-key_1
- ns_69
+ ns_78
syntax-literals-linklet_1
data-instance_1
syntax-literals-data-instance_1
- phase-shift_16
+ phase-shift_18
original-self_2
- self_26
- bulk-binding-registry_20
+ self_30
+ bulk-binding-registry_21
insp_15
create-root-expand-context-from-module_1)
(begin
(let-values ((()
(begin
(if (not (load-on-demand-enabled))
- (let-values ()
- (force-syntax-deserialize syntax-literals-data-instance_1 bulk-binding-registry_20))
+ (force-syntax-deserialize syntax-literals-data-instance_1 bulk-binding-registry_21)
(void))
(values))))
(let-values (((inst_1)
- (let-values (((ns56_0) ns_69)
- ((phase-shift57_0) phase-shift_16)
- ((self58_0) self_26)
- ((insp59_0) insp_15)
- ((bulk-binding-registry60_0) bulk-binding-registry_20)
- ((temp61_0)
- (lambda (name_55 val_60) (error "shouldn't get here for the root-ctx linklet"))))
+ (let-values (((ns59_0) ns_78)
+ ((phase-shift60_0) phase-shift_18)
+ ((self61_0) self_30)
+ ((insp62_0) insp_15)
+ ((bulk-binding-registry63_0) bulk-binding-registry_21)
+ ((temp64_0)
+ (lambda (name_64 val_64) (error "shouldn't get here for the root-ctx linklet"))))
(make-instance-instance.1
- bulk-binding-registry60_0
- insp59_0
- ns56_0
- phase-shift57_0
- self58_0
- temp61_0))))
+ bulk-binding-registry63_0
+ insp62_0
+ ns59_0
+ phase-shift60_0
+ self61_0
+ temp64_0))))
(let-values (((syntax-literals-instance_2)
(if syntax-literals-linklet_1
(instantiate-linklet$1
@@ -41657,87 +41321,80 @@
(let-values (((get-encoded-root-expand-ctx_0)
(1/instance-variable-value syntax-literals-instance_2 'get-encoded-root-expand-ctx)))
(if (eq? get-encoded-root-expand-ctx_0 'empty)
- (let-values ()
+ (namespace-set-root-expand-ctx!
+ ns_78
+ (promise1.1
+ (lambda ()
+ (shift-to-inside-root-context
+ (let-values (((self65_0) self_30))
+ (make-root-expand-context.1 #f null unsafe-undefined unsafe-undefined self65_0))))
+ #f))
+ (if (procedure? get-encoded-root-expand-ctx_0)
(namespace-set-root-expand-ctx!
- ns_69
+ ns_78
(promise1.1
(lambda ()
(shift-to-inside-root-context
- (let-values (((self62_0) self_26))
- (make-root-expand-context.1 #f null unsafe-undefined unsafe-undefined self62_0))))
- #f)))
- (if (procedure? get-encoded-root-expand-ctx_0)
- (let-values ()
- (namespace-set-root-expand-ctx!
- ns_69
- (promise1.1
- (lambda ()
- (shift-to-inside-root-context
- (root-expand-context-decode-for-module (get-encoded-root-expand-ctx_0) self_26)))
- #f)))
- (let-values ()
- (namespace-set-root-expand-ctx!
- ns_69
- (promise1.1
- (lambda ()
- (shift-to-inside-root-context
- (create-root-expand-context-from-module_1 ns_69 phase-shift_16 original-self_2 self_26)))
- #f)))))))))))))
+ (root-expand-context-decode-for-module (get-encoded-root-expand-ctx_0) self_30)))
+ #f))
+ (namespace-set-root-expand-ctx!
+ ns_78
+ (promise1.1
+ (lambda ()
+ (shift-to-inside-root-context
+ (create-root-expand-context-from-module_1 ns_78 phase-shift_18 original-self_2 self_30)))
+ #f))))))))))))
(define-values
(force-syntax-deserialize)
- (lambda (syntax-literals-data-instance_2 bulk-binding-registry_21)
+ (lambda (syntax-literals-data-instance_2 bulk-binding-registry_22)
(begin
- (if (let-values (((or-part_275) (eq? syntax-literals-data-instance_2 empty-syntax-literals-data-instance)))
- (if or-part_275
- or-part_275
+ (if (let-values (((or-part_435) (eq? syntax-literals-data-instance_2 empty-syntax-literals-data-instance)))
+ (if or-part_435
+ or-part_435
(eq? syntax-literals-data-instance_2 empty-syntax-literals-instance/empty-namespace)))
(void)
- (let-values ()
- (let-values (((deserialize-syntax_0)
- (1/instance-variable-value syntax-literals-data-instance_2 deserialize-syntax-id)))
- (if deserialize-syntax_0 (let-values () (deserialize-syntax_0 bulk-binding-registry_21)) (void))))))))
+ (let-values (((deserialize-syntax_1)
+ (1/instance-variable-value syntax-literals-data-instance_2 deserialize-syntax-id)))
+ (if deserialize-syntax_1 (deserialize-syntax_1 bulk-binding-registry_22) (void)))))))
(define-values
(compiled-module->dh+h)
- (lambda (c_40)
+ (lambda (c_47)
(begin
- (let-values (((ld/h_0) (if (compiled-in-memory? c_40) (compiled-in-memory-linklet-directory c_40) c_40)))
- (let-values (((dh_1)
- (if (linklet-directory?$1 ld/h_0)
- (let-values () (linklet-directory->hash$1 ld/h_0))
- (let-values () #f))))
- (let-values (((h_5) (1/linklet-bundle->hash (if dh_1 (hash-ref dh_1 #f) ld/h_0)))) (values dh_1 h_5)))))))
+ (let-values (((ld/h_0) (if (compiled-in-memory? c_47) (compiled-in-memory-linklet-directory c_47) c_47)))
+ (let-values (((dh_1) (if (linklet-directory?$1 ld/h_0) (linklet-directory->hash$1 ld/h_0) #f)))
+ (let-values (((h_5) (linklet-bundle->hash$1 (if dh_1 (hash-ref dh_1 #f) ld/h_0)))) (values dh_1 h_5)))))))
(define-values
(compiled-module->h)
- (lambda (c_41) (begin (let-values (((dh_2 h_6) (compiled-module->dh+h c_41))) h_6))))
+ (lambda (c_48) (begin (let-values (((dh_2 h_6) (compiled-module->dh+h c_48))) h_6))))
(define-values
(compiled-module->dh+h+data-instance+declaration-instance)
- (lambda (c_42)
+ (lambda (c_49)
(begin
- (let-values (((dh_3 h_7) (compiled-module->dh+h c_42)))
+ (let-values (((dh_3 h_7) (compiled-module->dh+h c_49)))
(let-values (((data-instance_2)
- (if (compiled-in-memory? c_42)
- (make-data-instance-from-compiled-in-memory c_42)
+ (if (compiled-in-memory? c_49)
+ (make-data-instance-from-compiled-in-memory c_49)
(instantiate-linklet$1 (eval-linklet* (hash-ref h_7 'data)) (list deserialize-instance)))))
(let-values (((declaration-instance_1)
- (if (if (compiled-in-memory? c_42) (compiled-in-memory-original-self c_42) #f)
- (make-declaration-instance-from-compiled-in-memory c_42)
+ (if (if (compiled-in-memory? c_49) (compiled-in-memory-original-self c_49) #f)
+ (make-declaration-instance-from-compiled-in-memory c_49)
(instantiate-linklet$1
(eval-linklet* (hash-ref h_7 'decl))
(list deserialize-instance data-instance_2)))))
(values dh_3 h_7 data-instance_2 declaration-instance_1)))))))
(define-values
(compiled-module->declaration-instance)
- (lambda (c_43)
+ (lambda (c_50)
(begin
(let-values (((dh_4 h_8 data-instance_3 declaration-instance_2)
- (compiled-module->dh+h+data-instance+declaration-instance c_43)))
+ (compiled-module->dh+h+data-instance+declaration-instance c_50)))
declaration-instance_2))))
(define-values
(compiled-module->h+declaration-instance)
- (lambda (c_44)
+ (lambda (c_51)
(begin
(let-values (((dh_5 h_9 data-instance_4 declaration-instance_3)
- (compiled-module->dh+h+data-instance+declaration-instance c_44)))
+ (compiled-module->dh+h+data-instance+declaration-instance c_51)))
(values h_9 declaration-instance_3)))))
(define-values
(make-data-instance-from-compiled-in-memory)
@@ -41754,6 +41411,10 @@
(compiled-in-memory-original-self cim_7)
'requires
(compiled-in-memory-requires cim_7)
+ 'recur-requires
+ (compiled-in-memory-recur-requires cim_7)
+ 'flattened-requires
+ (compiled-in-memory-flattened-requires cim_7)
'provides
(compiled-in-memory-provides cim_7)
'phase-to-link-modules
@@ -41771,7 +41432,7 @@
deserialize-syntax-id
void
deserialized-syntax-vector-id
- (compiled-in-memory-syntax-literals cim_8)))))
+ (box (compiled-in-memory-syntax-literals cim_8))))))
(define-values
(empty-syntax-literals-instance/empty-namespace)
(1/make-instance
@@ -41779,262 +41440,242 @@
#f
'constant
get-syntax-literal!-id
- (lambda (pos_123) #f)
+ (lambda (pos_154) #f)
'get-encoded-root-expand-ctx
'empty))
(define-values
(get-all-variables)
(lambda (phases-h_1)
(begin
- (let-values (((ht_142) phases-h_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-in-hash ht_142)))
- ((letrec-values (((for-loop_256)
- (lambda (table_35 i_178)
- (begin
- 'for-loop
- (if i_178
- (let-values (((phase_97 linklet_6) (hash-iterate-key+value ht_142 i_178)))
- (let-values (((table_199)
- (let-values (((table_36) table_35))
- (let-values (((table_163)
- (let-values ()
- (let-values (((key_79 val_61)
- (let-values ()
- (values
- phase_97
- (linklet-export-variables$1
- linklet_6)))))
- (hash-set table_36 key_79 val_61)))))
- (values table_163)))))
- (if (not #f)
- (for-loop_256 table_199 (hash-iterate-next ht_142 i_178))
- table_199)))
- table_35)))))
- for-loop_256)
- '#hash()
- (hash-iterate-first ht_142)))))))
- (define-values (eval-linklet*) (lambda (l_51) (begin (eval-linklet$1 (force-compile-linklet l_51)))))
+ (let-values (((table_240) (let-values (((table_241) '#hash())) table_241)))
+ (let-values (((ht_181) phases-h_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_181))
+ ((letrec-values (((for-loop_350)
+ (lambda (table_242 i_248)
+ (begin
+ 'for-loop
+ (if i_248
+ (let-values (((phase_114 linklet_6) (hash-iterate-key+value ht_181 i_248)))
+ (let-values (((table_243)
+ (let-values (((table_244)
+ (let-values (((key_84 val_65)
+ (values
+ phase_114
+ (linklet-export-variables$1
+ linklet_6))))
+ (hash-set table_242 key_84 val_65))))
+ (values table_244))))
+ (if (not #f)
+ (for-loop_350 table_243 (hash-iterate-next ht_181 i_248))
+ table_243)))
+ table_242)))))
+ for-loop_350)
+ table_240
+ (hash-iterate-first ht_181))))))))
+ (define-values (eval-linklet*) (lambda (l_61) (begin (eval-linklet$1 (force-compile-linklet l_61)))))
(define-values
(check-provides-verbosity)
- (lambda (who_0 verbosity_0)
+ (lambda (who_25 verbosity_0)
(begin
- (if (let-values (((or-part_2) (not verbosity_0))) (if or-part_2 or-part_2 (eq? verbosity_0 'defined-names)))
+ (if (let-values (((or-part_436) (not verbosity_0))) (if or-part_436 or-part_436 (eq? verbosity_0 'defined-names)))
(void)
- (let-values () (raise-argument-error who_0 "(or/c #f 'defined-names)" verbosity_0))))))
+ (raise-argument-error who_25 "(or/c #f 'defined-names)" verbosity_0)))))
(define-values
(provides->api-provides)
- (lambda (provides_12 self_8 verbosity_1)
+ (lambda (provides_13 self_31 verbosity_1)
(begin
(let-values (((defined-names?_0) (eq? verbosity_1 'defined-names)))
(let-values (((extract_0)
- (lambda (ok?_29)
+ (lambda (ok?_30)
(begin
'extract
(let-values (((result-l_0)
(reverse$1
- (let-values (((ht_78) provides_12))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_78)))
- ((letrec-values (((for-loop_15)
- (lambda (fold-var_67 i_179)
- (begin
- 'for-loop
- (if i_179
- (let-values (((phase_50 at-phase_11)
- (hash-iterate-key+value
- ht_78
- i_179)))
- (let-values (((fold-var_248)
- (let-values (((fold-var_249)
- fold-var_67))
+ (let-values (((fold-var_421)
+ (let-values (((fold-var_422) null)) fold-var_422)))
+ (let-values (((ht_182) provides_13))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash ht_182))
+ ((letrec-values (((for-loop_351)
+ (lambda (fold-var_423 i_249)
+ (begin
+ 'for-loop
+ (if i_249
+ (let-values (((phase_115 at-phase_10)
+ (hash-iterate-key+value
+ ht_182
+ i_249)))
+ (let-values (((fold-var_424)
(let-values (((id*_10)
(reverse$1
- (let-values (((ht_143)
- at-phase_11))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
+ (let-values (((fold-var_425)
+ (let-values (((fold-var_426)
+ null))
+ fold-var_426)))
+ (let-values (((ht_183)
+ at-phase_10))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
(check-in-hash
- ht_143)))
- ((letrec-values (((for-loop_21)
- (lambda (fold-var_250
- i_180)
- (begin
- 'for-loop
- (if i_180
- (let-values (((sym_74
- b/p_1)
- (hash-iterate-key+value
- ht_143
- i_180)))
- (let-values (((fold-var_28)
- (let-values (((fold-var_207)
- fold-var_250))
- (if (ok?_29
+ ht_183))
+ ((letrec-values (((for-loop_352)
+ (lambda (fold-var_427
+ i_250)
+ (begin
+ 'for-loop
+ (if i_250
+ (let-values (((sym_89
+ b/p_1)
+ (hash-iterate-key+value
+ ht_183
+ i_250)))
+ (let-values (((fold-var_428)
+ (if (ok?_30
b/p_1)
- (let-values (((fold-var_81)
- fold-var_207))
- (let-values (((fold-var_82)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((b_87)
- (provided-as-binding
- b/p_1)))
- (list*
- sym_74
- (if (eq?
- self_8
- (module-binding-module
- b_87))
- (let-values ()
- null)
- (let-values ()
- (reverse$1
- (let-values (((lst_290)
- (cons
- b_87
- (module-binding-extra-nominal-bindings
- b_87))))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_290)))
- ((letrec-values (((for-loop_257)
- (lambda (fold-var_32
- lst_106)
- (begin
- 'for-loop
- (if (pair?
- lst_106)
- (let-values (((b_88)
- (unsafe-car
- lst_106))
- ((rest_50)
- (unsafe-cdr
- lst_106)))
- (let-values (((fold-var_251)
- (let-values (((fold-var_195)
- fold-var_32))
- (let-values (((fold-var_129)
- (let-values ()
- (cons
- (let-values ()
- (if (if (eqv?
- (module-binding-nominal-phase+space
- b_88)
- phase_50)
- (eq?
- (module-binding-nominal-sym
- b_88)
- sym_74)
- #f)
- (let-values ()
- (module-binding-nominal-module
- b_88))
- (let-values ()
- (list
- (module-binding-nominal-module
- b_88)
- (module-binding-phase
- b_88)
- (module-binding-nominal-sym
- b_88)
- (module-binding-nominal-phase+space
- b_88)))))
- fold-var_195))))
- (values
- fold-var_129)))))
- (if (not
- #f)
- (for-loop_257
- fold-var_251
- rest_50)
- fold-var_251)))
- fold-var_32)))))
- for-loop_257)
- null
- lst_290))))))
- (if defined-names?_0
- (list
- (module-binding-sym
- b_87))
- null))))
- fold-var_81))))
- (values
- fold-var_82)))
- fold-var_207))))
- (if (not
- #f)
- (for-loop_21
- fold-var_28
- (hash-iterate-next
- ht_143
- i_180))
- fold-var_28)))
- fold-var_250)))))
- for-loop_21)
- null
- (hash-iterate-first
- ht_143)))))))
- (begin
- #t
- ((letrec-values (((for-loop_103)
- (lambda (fold-var_84)
- (begin
- 'for-loop
- (let-values (((l_12)
- id*_10))
- (let-values (((fold-var_86)
- (let-values (((fold-var_196)
- fold-var_84))
- (let-values (((fold-var_209)
- fold-var_196))
- (if (null?
- l_12)
- fold-var_209
- (let-values (((fold-var_12)
- fold-var_209))
- (let-values (((fold-var_247)
- (let-values ()
- (cons
- (let-values ()
- (cons
- phase_50
- (let-values (((l4_0)
- l_12)
- ((symbol5_0)
- symbol)
- ((car6_0)
- car))
- (sort.1
- #f
- car6_0
- l4_0
- symbol5_0))))
- fold-var_12))))
- (values
- fold-var_247))))))))
- fold-var_86))))))
- for-loop_103)
- fold-var_249))))))
- (if (not #f)
- (for-loop_15
- fold-var_248
- (hash-iterate-next ht_78 i_179))
- fold-var_248)))
- fold-var_67)))))
- for-loop_15)
- null
- (hash-iterate-first ht_78)))))))
+ (let-values (((fold-var_429)
+ (cons
+ (let-values (((b_115)
+ (provided-as-binding
+ b/p_1)))
+ (list*
+ sym_89
+ (if (eq?
+ self_31
+ (module-binding-module
+ b_115))
+ null
+ (reverse$1
+ (let-values (((fold-var_430)
+ (let-values (((fold-var_431)
+ null))
+ fold-var_431)))
+ (let-values (((lst_428)
+ (cons
+ b_115
+ (module-binding-extra-nominal-bindings
+ b_115))))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_428))
+ ((letrec-values (((for-loop_353)
+ (lambda (fold-var_432
+ lst_429)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_429)
+ (let-values (((b_116)
+ (unsafe-car
+ lst_429))
+ ((rest_210)
+ (unsafe-cdr
+ lst_429)))
+ (let-values (((fold-var_433)
+ (let-values (((fold-var_434)
+ (cons
+ (if (if (eqv?
+ (module-binding-nominal-phase+space
+ b_116)
+ phase_115)
+ (eq?
+ (module-binding-nominal-sym
+ b_116)
+ sym_89)
+ #f)
+ (module-binding-nominal-module
+ b_116)
+ (list
+ (module-binding-nominal-module
+ b_116)
+ (module-binding-phase
+ b_116)
+ (module-binding-nominal-sym
+ b_116)
+ (module-binding-nominal-phase+space
+ b_116)))
+ fold-var_432)))
+ (values
+ fold-var_434))))
+ (if (not
+ #f)
+ (for-loop_353
+ fold-var_433
+ rest_210)
+ fold-var_433)))
+ fold-var_432)))))
+ for-loop_353)
+ fold-var_430
+ lst_428))))))
+ (if defined-names?_0
+ (list
+ (module-binding-sym
+ b_115))
+ null)))
+ fold-var_427)))
+ (values
+ fold-var_429))
+ fold-var_427)))
+ (if (not
+ #f)
+ (for-loop_352
+ fold-var_428
+ (hash-iterate-next
+ ht_183
+ i_250))
+ fold-var_428)))
+ fold-var_427)))))
+ for-loop_352)
+ fold-var_425
+ (hash-iterate-first
+ ht_183))))))))
+ ((letrec-values (((for-loop_354)
+ (lambda (fold-var_435)
+ (begin
+ 'for-loop
+ (let-values (((l_62)
+ id*_10))
+ (let-values (((fold-var_436)
+ (if (null?
+ l_62)
+ fold-var_435
+ (let-values (((fold-var_437)
+ (cons
+ (cons
+ phase_115
+ (let-values (((l4_0)
+ l_62)
+ ((symbol5_0)
+ symbol)
+ ((car6_0)
+ car))
+ (sort.1
+ #f
+ car6_0
+ l4_0
+ symbol5_0)))
+ fold-var_435)))
+ (values
+ fold-var_437)))))
+ fold-var_436))))))
+ for-loop_354)
+ fold-var_423))))
+ (if (not #f)
+ (for-loop_351
+ fold-var_424
+ (hash-iterate-next ht_182 i_249))
+ fold-var_424)))
+ fold-var_423)))))
+ for-loop_351)
+ fold-var_421
+ (hash-iterate-first ht_182))))))))
(let-values (((result-l1_0) result-l_0) ((phase+space2_0) phase+space) ((car3_0) car))
(sort.1 #f car3_0 result-l1_0 phase+space2_0)))))))
(values
@@ -42042,333 +41683,310 @@
(extract_0 provided-as-transformer?)))))))
(define-values
(variables->api-nonprovides)
- (lambda (provides_13 all-vars_0)
+ (lambda (provides_14 all-vars_0)
(begin
(let-values (((result-l_1)
(reverse$1
- (let-values (((ht_144) all-vars_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_144)))
- ((letrec-values (((for-loop_109)
- (lambda (fold-var_87 i_175)
- (begin
- 'for-loop
- (if i_175
- (let-values (((phase_98 vars_0) (hash-iterate-key+value ht_144 i_175)))
- (let-values (((fold-var_88)
- (let-values (((fold-var_89) fold-var_87))
+ (let-values (((fold-var_438) (let-values (((fold-var_439) null)) fold-var_439)))
+ (let-values (((ht_184) all-vars_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_184))
+ ((letrec-values (((for-loop_355)
+ (lambda (fold-var_440 i_251)
+ (begin
+ 'for-loop
+ (if i_251
+ (let-values (((phase_116 vars_0)
+ (hash-iterate-key+value ht_184 i_251)))
+ (let-values (((fold-var_441)
(let-values (((id*_11)
- (let-values (((syms_20)
+ (let-values (((syms_28)
(hash-ref
- provides_13
- phase_98
+ provides_14
+ phase_116
'#hasheq())))
(reverse$1
- (let-values (((lst_96) vars_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_96)))
- ((letrec-values (((for-loop_215)
- (lambda (fold-var_210
- lst_197)
- (begin
- 'for-loop
- (if (pair?
- lst_197)
- (let-values (((var-sym_5)
- (unsafe-car
- lst_197))
- ((rest_152)
- (unsafe-cdr
- lst_197)))
- (let-values (((fold-var_76)
- (let-values (((fold-var_77)
- fold-var_210))
+ (let-values (((fold-var_442)
+ (let-values (((fold-var_443)
+ null))
+ fold-var_443)))
+ (let-values (((lst_430) vars_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_430))
+ ((letrec-values (((for-loop_356)
+ (lambda (fold-var_444
+ lst_431)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_431)
+ (let-values (((var-sym_5)
+ (unsafe-car
+ lst_431))
+ ((rest_211)
+ (unsafe-cdr
+ lst_431)))
+ (let-values (((fold-var_445)
(if (hash-ref
- syms_20
+ syms_28
var-sym_5
#f)
- fold-var_77
- (let-values (((fold-var_110)
- fold-var_77))
- (let-values (((fold-var_90)
- (let-values ()
- (cons
- (let-values ()
- var-sym_5)
- fold-var_110))))
- (values
- fold-var_90)))))))
- (if (not
- #f)
- (for-loop_215
- fold-var_76
- rest_152)
- fold-var_76)))
- fold-var_210)))))
- for-loop_215)
- null
- lst_96)))))))
- (begin
- #t
- ((letrec-values (((for-loop_132)
- (lambda (fold-var_92)
- (begin
- 'for-loop
- (let-values (((l_52)
- id*_11))
- (let-values (((fold-var_111)
- (let-values (((fold-var_93)
- fold-var_92))
- (if (null?
- l_52)
- fold-var_93
- (let-values (((fold-var_252)
- fold-var_93))
- (let-values (((fold-var_20)
- (let-values ()
- (cons
- (let-values ()
- (cons
- phase_98
- (let-values (((l10_0)
- l_52)
- ((symbol11_0)
- symbol))
- (sort.1
- #f
- #f
- l10_0
- symbol11_0))))
- fold-var_252))))
- (values
- fold-var_20)))))))
- fold-var_111))))))
- for-loop_132)
- fold-var_89))))))
- (if (not #f)
- (for-loop_109 fold-var_88 (hash-iterate-next ht_144 i_175))
- fold-var_88)))
- fold-var_87)))))
- for-loop_109)
- null
- (hash-iterate-first ht_144)))))))
+ fold-var_444
+ (let-values (((fold-var_446)
+ (cons
+ var-sym_5
+ fold-var_444)))
+ (values
+ fold-var_446)))))
+ (if (not
+ #f)
+ (for-loop_356
+ fold-var_445
+ rest_211)
+ fold-var_445)))
+ fold-var_444)))))
+ for-loop_356)
+ fold-var_442
+ lst_430))))))))
+ ((letrec-values (((for-loop_357)
+ (lambda (fold-var_447)
+ (begin
+ 'for-loop
+ (let-values (((l_63) id*_11))
+ (let-values (((fold-var_448)
+ (if (null?
+ l_63)
+ fold-var_447
+ (let-values (((fold-var_449)
+ (cons
+ (cons
+ phase_116
+ (let-values (((l10_0)
+ l_63)
+ ((symbol11_0)
+ symbol))
+ (sort.1
+ #f
+ #f
+ l10_0
+ symbol11_0)))
+ fold-var_447)))
+ (values
+ fold-var_449)))))
+ fold-var_448))))))
+ for-loop_357)
+ fold-var_440))))
+ (if (not #f)
+ (for-loop_355 fold-var_441 (hash-iterate-next ht_184 i_251))
+ fold-var_441)))
+ fold-var_440)))))
+ for-loop_355)
+ fold-var_438
+ (hash-iterate-first ht_184))))))))
(let-values (((result-l7_0) result-l_1) ((phase+space8_0) phase+space) ((car9_0) car))
(sort.1 #f car9_0 result-l7_0 phase+space8_0))))))
(define-values
(1/compiled-expression?)
- (lambda (c_7)
+ (lambda (c_52)
(begin
'compiled-expression?
- (let-values (((or-part_1) (compiled-in-memory? c_7)))
- (if or-part_1
- or-part_1
- (let-values (((or-part_2) (linklet-directory?$1 c_7))) (if or-part_2 or-part_2 (1/linklet-bundle? c_7))))))))
+ (let-values (((or-part_437) (compiled-in-memory? c_52)))
+ (if or-part_437
+ or-part_437
+ (let-values (((or-part_438) (linklet-directory?$1 c_52)))
+ (if or-part_438 or-part_438 (linklet-bundle?$1 c_52))))))))
(define-values
(1/compiled-module-expression?)
- (lambda (c_45)
+ (lambda (c_53)
(begin
'compiled-module-expression?
- (let-values (((ld_7) (compiled->linklet-directory-or-bundle c_45)))
- (let-values (((or-part_31)
+ (let-values (((ld_7) (compiled->linklet-directory-or-bundle c_53)))
+ (let-values (((or-part_439)
(if (linklet-directory?$1 ld_7)
- (if (let-values (((b_21) (hash-ref (linklet-directory->hash$1 ld_7) #f #f)))
- (if b_21 (hash-ref (1/linklet-bundle->hash b_21) 'decl #f) #f))
+ (if (let-values (((b_117) (hash-ref (linklet-directory->hash$1 ld_7) #f #f)))
+ (if b_117 (hash-ref (linklet-bundle->hash$1 b_117) 'decl #f) #f))
#t
#f)
#f)))
- (if or-part_31
- or-part_31
- (if (1/linklet-bundle? ld_7) (if (hash-ref (1/linklet-bundle->hash ld_7) 'decl #f) #t #f) #f)))))))
+ (if or-part_439
+ or-part_439
+ (if (linklet-bundle?$1 ld_7) (if (hash-ref (linklet-bundle->hash$1 ld_7) 'decl #f) #t #f) #f)))))))
(define-values
(compiled->linklet-directory-or-bundle)
- (lambda (c_46) (begin (if (compiled-in-memory? c_46) (compiled-in-memory-linklet-directory c_46) c_46))))
+ (lambda (c_54) (begin (if (compiled-in-memory? c_54) (compiled-in-memory-linklet-directory c_54) c_54))))
(define-values
(normalize-to-linklet-directory)
- (lambda (c_47)
- (begin
- (if (linklet-directory?$1 (compiled->linklet-directory-or-bundle c_47))
- (let-values () c_47)
- (if (1/linklet-bundle? c_47)
- (let-values () (1/hash->linklet-directory (hasheq #f c_47)))
- (let-values ()
- (let-values (((the-struct_5) c_47))
- (if (compiled-in-memory? the-struct_5)
- (let-values (((linklet-directory1_0)
- (normalize-to-linklet-directory (compiled-in-memory-linklet-directory c_47))))
- (compiled-in-memory1.1
- linklet-directory1_0
- (compiled-in-memory-original-self the-struct_5)
- (compiled-in-memory-requires the-struct_5)
- (compiled-in-memory-provides the-struct_5)
- (compiled-in-memory-phase-to-link-module-uses the-struct_5)
- (compiled-in-memory-compile-time-inspector the-struct_5)
- (compiled-in-memory-phase-to-link-extra-inspectorsss the-struct_5)
- (compiled-in-memory-portal-stxes the-struct_5)
- (compiled-in-memory-mpis the-struct_5)
- (compiled-in-memory-syntax-literals the-struct_5)
- (compiled-in-memory-pre-compiled-in-memorys the-struct_5)
- (compiled-in-memory-post-compiled-in-memorys the-struct_5)
- (compiled-in-memory-namespace-scopes the-struct_5)
- (compiled-in-memory-purely-functional? the-struct_5)))
- (raise-argument-error 'struct-copy "compiled-in-memory?" the-struct_5)))))))))
+ (lambda (c_55)
+ (begin
+ (if (linklet-directory?$1 (compiled->linklet-directory-or-bundle c_55))
+ c_55
+ (if (linklet-bundle?$1 c_55)
+ (1/hash->linklet-directory (hasheq #f c_55))
+ (let-values (((the-struct_53) c_55))
+ (if (compiled-in-memory? the-struct_53)
+ (let-values (((linklet-directory1_0)
+ (normalize-to-linklet-directory (compiled-in-memory-linklet-directory c_55))))
+ (compiled-in-memory1.1
+ linklet-directory1_0
+ (compiled-in-memory-original-self the-struct_53)
+ (compiled-in-memory-requires the-struct_53)
+ (compiled-in-memory-recur-requires the-struct_53)
+ (compiled-in-memory-flattened-requires the-struct_53)
+ (compiled-in-memory-provides the-struct_53)
+ (compiled-in-memory-phase-to-link-module-uses the-struct_53)
+ (compiled-in-memory-compile-time-inspector the-struct_53)
+ (compiled-in-memory-phase-to-link-extra-inspectorsss the-struct_53)
+ (compiled-in-memory-portal-stxes the-struct_53)
+ (compiled-in-memory-mpis the-struct_53)
+ (compiled-in-memory-syntax-literals the-struct_53)
+ (compiled-in-memory-pre-compiled-in-memorys the-struct_53)
+ (compiled-in-memory-post-compiled-in-memorys the-struct_53)
+ (compiled-in-memory-namespace-scopes the-struct_53)
+ (compiled-in-memory-purely-functional? the-struct_53)))
+ (raise-argument-error 'struct-copy "compiled-in-memory?" the-struct_53))))))))
(define-values
(1/module-compiled-name)
- (let-values ()
- (let-values ()
- (case-lambda
- ((c_48)
- (begin
- 'module-compiled-name
- (begin
- (if (1/compiled-module-expression? c_48)
- (void)
- (let-values () (raise-argument-error 'module-compiled-name "compiled-module-expression?" c_48)))
- (module-compiled-current-name c_48))))
- ((c_49 name_56)
- (let-values ((()
- (begin
- (if (1/compiled-module-expression? c_49)
- (void)
- (let-values ()
- (raise-argument-error 'module-compiled-name "compiled-module-expression?" c_49)))
- (values))))
- (let-values ((()
- (begin
- (if (let-values (((or-part_71) (symbol? name_56)))
- (if or-part_71
- or-part_71
- (if (pair? name_56) (if (list? name_56) (andmap2 symbol? name_56) #f) #f)))
- (void)
- (let-values ()
- (raise-argument-error
- 'module-compiled-name
- "(or/c symbol? (cons/c symbol? (non-empty-listof symbol?)))"
- name_56)))
- (values))))
- (let-values (((i-name_0 prefix_6)
- (if (symbol? name_56)
- (values name_56 null)
- (let-values (((r_38) (reverse$1 name_56))) (values (car r_38) (reverse$1 (cdr r_38)))))))
- (change-module-name c_49 i-name_0 prefix_6)))))))))
+ (case-lambda
+ ((c_56)
+ (begin
+ 'module-compiled-name
+ (begin
+ (if (1/compiled-module-expression? c_56)
+ (void)
+ (raise-argument-error 'module-compiled-name "compiled-module-expression?" c_56))
+ (module-compiled-current-name c_56))))
+ ((c_57 name_65)
+ (let-values ((()
+ (begin
+ (if (1/compiled-module-expression? c_57)
+ (void)
+ (raise-argument-error 'module-compiled-name "compiled-module-expression?" c_57))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_440) (symbol? name_65)))
+ (if or-part_440
+ or-part_440
+ (if (pair? name_65) (if (list? name_65) (andmap2 symbol? name_65) #f) #f)))
+ (void)
+ (raise-argument-error
+ 'module-compiled-name
+ "(or/c symbol? (cons/c symbol? (non-empty-listof symbol?)))"
+ name_65))
+ (values))))
+ (let-values (((i-name_0 prefix_6)
+ (if (symbol? name_65)
+ (values name_65 null)
+ (let-values (((r_44) (reverse$1 name_65))) (values (car r_44) (reverse$1 (cdr r_44)))))))
+ (change-module-name c_57 i-name_0 prefix_6)))))))
(define-values
(module-compiled-current-name)
- (lambda (c_47)
+ (lambda (c_58)
(begin
- (let-values (((ld_0) (compiled->linklet-directory-or-bundle c_47)))
- (let-values (((b_89) (if (1/linklet-bundle? ld_0) ld_0 (hash-ref (linklet-directory->hash$1 ld_0) #f))))
- (hash-ref (1/linklet-bundle->hash b_89) 'name))))))
+ (let-values (((ld_8) (compiled->linklet-directory-or-bundle c_58)))
+ (let-values (((b_118) (if (linklet-bundle?$1 ld_8) ld_8 (hash-ref (linklet-directory->hash$1 ld_8) #f))))
+ (hash-ref (linklet-bundle->hash$1 b_118) 'name))))))
(define-values
(module-compiled-immediate-name)
- (lambda (c_50)
- (begin (let-values (((n_32) (module-compiled-current-name c_50))) (if (pair? n_32) (car (reverse$1 n_32)) n_32)))))
+ (lambda (c_59)
+ (begin (let-values (((n_32) (module-compiled-current-name c_59))) (if (pair? n_32) (car (reverse$1 n_32)) n_32)))))
(define-values
(change-module-name)
- (lambda (c_51 name_57 prefix_7)
+ (lambda (c_60 name_66 prefix_7)
(begin
- (let-values (((full-name_0) (if (null? prefix_7) name_57 (append prefix_7 (list name_57)))))
- (let-values (((next-prefix_0) (if (null? prefix_7) (list name_57) full-name_0)))
- (let-values (((recur_0)
- (lambda (sub-c_0 name_58)
+ (let-values (((full-name_0) (if (null? prefix_7) name_66 (append prefix_7 (list name_66)))))
+ (let-values (((next-prefix_0) (if (null? prefix_7) (list name_66) full-name_0)))
+ (let-values (((recur_3)
+ (lambda (sub-c_0 name_67)
(begin
'recur
- (if (equal? (module-compiled-current-name sub-c_0) (append next-prefix_0 (list name_58)))
+ (if (equal? (module-compiled-current-name sub-c_0) (append next-prefix_0 (list name_67)))
sub-c_0
- (change-module-name sub-c_0 name_58 next-prefix_0))))))
- (if (compiled-in-memory? c_51)
- (let-values ()
- (let-values (((change-submodule-name_0)
- (lambda (sub-c_1)
- (begin
- 'change-submodule-name
- (recur_0 sub-c_1 (module-compiled-immediate-name sub-c_1))))))
- (let-values (((pre-compiled-in-memorys_0)
- (map2 change-submodule-name_0 (compiled-in-memory-pre-compiled-in-memorys c_51))))
- (let-values (((post-compiled-in-memorys_0)
- (map2 change-submodule-name_0 (compiled-in-memory-post-compiled-in-memorys c_51))))
- (let-values (((the-struct_50) c_51))
- (if (compiled-in-memory? the-struct_50)
- (let-values (((pre-compiled-in-memorys7_0) pre-compiled-in-memorys_0)
- ((post-compiled-in-memorys8_0) post-compiled-in-memorys_0)
- ((linklet-directory9_0)
- (let-values (((temp10_2)
- (update-one-name
- (let-values (((ld_8)
- (compiled->linklet-directory-or-bundle c_51)))
- (if (1/linklet-bundle? ld_8)
- ld_8
- (hash-ref (linklet-directory->hash$1 ld_8) #f)))
- full-name_0))
- ((temp11_3) (symbol? full-name_0))
- ((temp12_4)
- (append pre-compiled-in-memorys_0 post-compiled-in-memorys_0)))
- (rebuild-linklet-directory.1 temp11_3 temp10_2 temp12_4))))
- (compiled-in-memory1.1
- linklet-directory9_0
- (compiled-in-memory-original-self the-struct_50)
- (compiled-in-memory-requires the-struct_50)
- (compiled-in-memory-provides the-struct_50)
- (compiled-in-memory-phase-to-link-module-uses the-struct_50)
- (compiled-in-memory-compile-time-inspector the-struct_50)
- (compiled-in-memory-phase-to-link-extra-inspectorsss the-struct_50)
- (compiled-in-memory-portal-stxes the-struct_50)
- (compiled-in-memory-mpis the-struct_50)
- (compiled-in-memory-syntax-literals the-struct_50)
- pre-compiled-in-memorys7_0
- post-compiled-in-memorys8_0
- (compiled-in-memory-namespace-scopes the-struct_50)
- (compiled-in-memory-purely-functional? the-struct_50)))
- (raise-argument-error 'struct-copy "compiled-in-memory?" the-struct_50)))))))
- (if (linklet-directory?$1 c_51)
- (let-values ()
- (1/hash->linklet-directory
- (let-values (((ht_31) (linklet-directory->hash$1 c_51)))
+ (change-module-name sub-c_0 name_67 next-prefix_0))))))
+ (if (compiled-in-memory? c_60)
+ (let-values (((change-submodule-name_0)
+ (lambda (sub-c_1)
+ (begin
+ 'change-submodule-name
+ (recur_3 sub-c_1 (module-compiled-immediate-name sub-c_1))))))
+ (let-values (((pre-compiled-in-memorys_0)
+ (map2 change-submodule-name_0 (compiled-in-memory-pre-compiled-in-memorys c_60))))
+ (let-values (((post-compiled-in-memorys_0)
+ (map2 change-submodule-name_0 (compiled-in-memory-post-compiled-in-memorys c_60))))
+ (let-values (((the-struct_54) c_60))
+ (if (compiled-in-memory? the-struct_54)
+ (let-values (((pre-compiled-in-memorys7_0) pre-compiled-in-memorys_0)
+ ((post-compiled-in-memorys8_0) post-compiled-in-memorys_0)
+ ((linklet-directory9_0)
+ (let-values (((temp10_2)
+ (update-one-name
+ (let-values (((ld_9) (compiled->linklet-directory-or-bundle c_60)))
+ (if (linklet-bundle?$1 ld_9)
+ ld_9
+ (hash-ref (linklet-directory->hash$1 ld_9) #f)))
+ full-name_0))
+ ((temp11_3) (symbol? full-name_0))
+ ((temp12_4)
+ (append pre-compiled-in-memorys_0 post-compiled-in-memorys_0)))
+ (rebuild-linklet-directory.1 temp11_3 temp10_2 temp12_4))))
+ (compiled-in-memory1.1
+ linklet-directory9_0
+ (compiled-in-memory-original-self the-struct_54)
+ (compiled-in-memory-requires the-struct_54)
+ (compiled-in-memory-recur-requires the-struct_54)
+ (compiled-in-memory-flattened-requires the-struct_54)
+ (compiled-in-memory-provides the-struct_54)
+ (compiled-in-memory-phase-to-link-module-uses the-struct_54)
+ (compiled-in-memory-compile-time-inspector the-struct_54)
+ (compiled-in-memory-phase-to-link-extra-inspectorsss the-struct_54)
+ (compiled-in-memory-portal-stxes the-struct_54)
+ (compiled-in-memory-mpis the-struct_54)
+ (compiled-in-memory-syntax-literals the-struct_54)
+ pre-compiled-in-memorys7_0
+ post-compiled-in-memorys8_0
+ (compiled-in-memory-namespace-scopes the-struct_54)
+ (compiled-in-memory-purely-functional? the-struct_54)))
+ (raise-argument-error 'struct-copy "compiled-in-memory?" the-struct_54))))))
+ (if (linklet-directory?$1 c_60)
+ (1/hash->linklet-directory
+ (let-values (((table_245) (let-values (((table_246) '#hasheq())) table_246)))
+ (let-values (((ht_185) (linklet-directory->hash$1 c_60)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_31)))
- ((letrec-values (((for-loop_258)
- (lambda (table_200 i_181)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_185))
+ ((letrec-values (((for-loop_358)
+ (lambda (table_247 i_252)
(begin
'for-loop
- (if i_181
- (let-values (((key_80 val_62) (hash-iterate-key+value ht_31 i_181)))
- (let-values (((table_201)
- (let-values (((table_192) table_200))
- (let-values (((table_202)
- (let-values ()
- (let-values (((key_37 val_63)
- (let-values ()
- (values
- key_80
- (if (not key_80)
- (update-one-name
- val_62
- full-name_0)
- (recur_0
- val_62
- key_80))))))
- (hash-set
- table_192
- key_37
- val_63)))))
- (values table_202)))))
+ (if i_252
+ (let-values (((key_85 val_66) (hash-iterate-key+value ht_185 i_252)))
+ (let-values (((table_248)
+ (let-values (((table_249)
+ (let-values (((key_86 val_67)
+ (values
+ key_85
+ (if (not key_85)
+ (update-one-name
+ val_66
+ full-name_0)
+ (recur_3
+ val_66
+ key_85)))))
+ (hash-set table_247 key_86 val_67))))
+ (values table_249))))
(if (not #f)
- (for-loop_258 table_201 (hash-iterate-next ht_31 i_181))
- table_201)))
- table_200)))))
- for-loop_258)
- '#hasheq()
- (hash-iterate-first ht_31))))))
- (let-values () (update-one-name c_51 full-name_0))))))))))
+ (for-loop_358 table_248 (hash-iterate-next ht_185 i_252))
+ table_248)))
+ table_247)))))
+ for-loop_358)
+ table_245
+ (hash-iterate-first ht_185))))))
+ (update-one-name c_60 full-name_0)))))))))
(define-values
(update-one-name)
- (lambda (lb_0 name_59) (begin (1/hash->linklet-bundle (hash-set (1/linklet-bundle->hash lb_0) 'name name_59)))))
+ (lambda (lb_0 name_68) (begin (1/hash->linklet-bundle (hash-set (linklet-bundle->hash$1 lb_0) 'name name_68)))))
(define-values
(rebuild-linklet-directory.1)
(lambda (bundle-ok?1_0 main3_0 submods4_0)
@@ -42377,489 +41995,435 @@
(let-values (((main_0) main3_0))
(let-values (((submods_0) submods4_0))
(let-values (((bundle-ok?_0) bundle-ok?1_0))
- (let-values ()
- (if (if (null? submods_0) bundle-ok?_0 #f)
- (let-values () main_0)
- (let-values ()
- (1/hash->linklet-directory
- (hash-set
- (let-values (((lst_64) submods_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_64)))
- ((letrec-values (((for-loop_259)
- (lambda (ht_135 lst_286)
- (begin
- 'for-loop
- (if (pair? lst_286)
- (let-values (((submod_1) (unsafe-car lst_286))
- ((rest_150) (unsafe-cdr lst_286)))
- (let-values (((ht_144)
- (let-values (((ht_145) ht_135))
- (let-values (((ht_146)
- (let-values ()
- (let-values (((name_60)
- (module-compiled-immediate-name
- submod_1)))
- (if (hash-ref ht_145 name_60 #f)
- (let-values ()
- (raise-arguments-error
- 'module-compiled-submodules
- "change would result in duplicate submodule name"
- "name"
- name_60))
- (let-values ()
- (hash-set
- ht_145
- name_60
- (compiled->linklet-directory-or-bundle
- submod_1))))))))
- (values ht_146)))))
- (if (not #f) (for-loop_259 ht_144 rest_150) ht_144)))
- ht_135)))))
- for-loop_259)
- '#hasheq()
- lst_64)))
- #f
- main_0)))))))))))
+ (if (if (null? submods_0) bundle-ok?_0 #f)
+ main_0
+ (1/hash->linklet-directory
+ (hash-set
+ (let-values (((ht_186) (let-values (((ht_187) '#hasheq())) ht_187)))
+ (let-values (((lst_432) submods_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_432))
+ ((letrec-values (((for-loop_359)
+ (lambda (ht_188 lst_433)
+ (begin
+ 'for-loop
+ (if (pair? lst_433)
+ (let-values (((submod_1) (unsafe-car lst_433))
+ ((rest_212) (unsafe-cdr lst_433)))
+ (let-values (((ht_189)
+ (let-values (((ht_190)
+ (let-values (((name_69)
+ (module-compiled-immediate-name
+ submod_1)))
+ (if (hash-ref ht_188 name_69 #f)
+ (raise-arguments-error
+ 'module-compiled-submodules
+ "change would result in duplicate submodule name"
+ "name"
+ name_69)
+ (hash-set
+ ht_188
+ name_69
+ (compiled->linklet-directory-or-bundle
+ submod_1))))))
+ (values ht_190))))
+ (if (not #f) (for-loop_359 ht_189 rest_212) ht_189)))
+ ht_188)))))
+ for-loop_359)
+ ht_186
+ lst_432))))
+ #f
+ main_0)))))))))
(define-values
(1/module-compiled-submodules)
- (let-values ()
- (let-values ()
- (case-lambda
- ((c_48 non-star?_0)
- (begin
- 'module-compiled-submodules
- (begin
- (if (1/compiled-module-expression? c_48)
- (void)
- (let-values () (raise-argument-error 'module-compiled-submodules "compiled-module-expression?" c_48)))
- (if (compiled-in-memory? c_48)
- (let-values ()
- (if non-star?_0
- (compiled-in-memory-pre-compiled-in-memorys c_48)
- (compiled-in-memory-post-compiled-in-memorys c_48)))
- (let-values ()
- (if (linklet-directory?$1 c_48)
- (let-values ()
- (let-values (((ht_147) (linklet-directory->hash$1 c_48)))
- (let-values (((bh_0) (1/linklet-bundle->hash (hash-ref ht_147 #f))))
- (let-values (((names_1) (hash-ref bh_0 (if non-star?_0 'pre 'post) null)))
- (reverse$1
- (let-values (((lst_88) names_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_88)))
- ((letrec-values (((for-loop_106)
- (lambda (fold-var_253 lst_89)
- (begin
- 'for-loop
- (if (pair? lst_89)
- (let-values (((name_61) (unsafe-car lst_89))
- ((rest_42) (unsafe-cdr lst_89)))
- (let-values (((fold-var_67)
- (let-values (((fold-var_68) fold-var_253))
- (let-values (((fold-var_254)
- (let-values ()
- (cons
- (let-values ()
- (hash-ref ht_147 name_61))
- fold-var_68))))
- (values fold-var_254)))))
- (if (not #f)
- (for-loop_106 fold-var_67 rest_42)
- fold-var_67)))
- fold-var_253)))))
- for-loop_106)
- null
- lst_88))))))))
- (let-values () null)))))))
- ((c_52 non-star?_1 submods_1)
- (begin
- (if (1/compiled-module-expression? c_52)
- (void)
- (let-values () (raise-argument-error 'module-compiled-submodules "compiled-module-expression?" c_52)))
- (if (if (list? submods_1) (andmap2 1/compiled-module-expression? submods_1) #f)
- (void)
- (let-values ()
- (raise-argument-error 'module-compiled-submodules "(listof compiled-module-expression?)" submods_1)))
- (if (if (null? submods_1)
- (let-values (((or-part_58) (1/linklet-bundle? (compiled->linklet-directory-or-bundle c_52))))
- (if or-part_58
- or-part_58
- (if (compiled-in-memory? c_52)
- (null?
- (if non-star?_1
- (compiled-in-memory-pre-compiled-in-memorys c_52)
- (compiled-in-memory-post-compiled-in-memorys c_52)))
- #f)))
- #f)
- (let-values () c_52)
- (if (if (compiled-in-memory? c_52) (andmap2 compiled-in-memory? submods_1) #f)
- (let-values ()
- (let-values (((pre-compiled-in-memorys_1)
- (if non-star?_1 submods_1 (compiled-in-memory-pre-compiled-in-memorys c_52))))
- (let-values (((post-compiled-in-memorys_1)
- (if non-star?_1 (compiled-in-memory-post-compiled-in-memorys c_52) submods_1)))
- (let-values (((n-c_0) (normalize-to-linklet-directory c_52)))
- (fixup-submodule-names
- (let-values (((the-struct_51) n-c_0))
- (if (compiled-in-memory? the-struct_51)
- (let-values (((pre-compiled-in-memorys2_0) pre-compiled-in-memorys_1)
- ((post-compiled-in-memorys3_0) post-compiled-in-memorys_1)
- ((linklet-directory4_0)
- (let-values (((temp5_3)
- (reset-submodule-names
- (hash-ref
- (linklet-directory->hash$1
- (compiled->linklet-directory-or-bundle n-c_0))
- #f)
- non-star?_1
- submods_1))
- ((temp6_0) (symbol? (module-compiled-current-name c_52)))
- ((temp7_5)
- (append pre-compiled-in-memorys_1 post-compiled-in-memorys_1)))
- (rebuild-linklet-directory.1 temp6_0 temp5_3 temp7_5))))
- (compiled-in-memory1.1
- linklet-directory4_0
- (compiled-in-memory-original-self the-struct_51)
- (compiled-in-memory-requires the-struct_51)
- (compiled-in-memory-provides the-struct_51)
- (compiled-in-memory-phase-to-link-module-uses the-struct_51)
- (compiled-in-memory-compile-time-inspector the-struct_51)
- (compiled-in-memory-phase-to-link-extra-inspectorsss the-struct_51)
- (compiled-in-memory-portal-stxes the-struct_51)
- (compiled-in-memory-mpis the-struct_51)
- (compiled-in-memory-syntax-literals the-struct_51)
- pre-compiled-in-memorys2_0
- post-compiled-in-memorys3_0
- (compiled-in-memory-namespace-scopes the-struct_51)
- (compiled-in-memory-purely-functional? the-struct_51)))
- (raise-argument-error 'struct-copy "compiled-in-memory?" the-struct_51))))))))
- (let-values ()
- (let-values (((n-c_1) (normalize-to-linklet-directory c_52)))
- (fixup-submodule-names
- (let-values (((temp8_5)
- (reset-submodule-names
- (hash-ref
- (linklet-directory->hash$1 (compiled->linklet-directory-or-bundle n-c_1))
- #f)
- non-star?_1
- submods_1))
- ((temp9_3)
- (map2
- compiled->linklet-directory-or-bundle
- (append
- (if non-star?_1 submods_1 (1/module-compiled-submodules c_52 #t))
- (if non-star?_1 (1/module-compiled-submodules c_52 #f) submods_1)))))
- (rebuild-linklet-directory.1 #f temp8_5 temp9_3)))))))))))))
+ (case-lambda
+ ((c_61 non-star?_0)
+ (begin
+ 'module-compiled-submodules
+ (begin
+ (if (1/compiled-module-expression? c_61)
+ (void)
+ (raise-argument-error 'module-compiled-submodules "compiled-module-expression?" c_61))
+ (if (compiled-in-memory? c_61)
+ (if non-star?_0
+ (compiled-in-memory-pre-compiled-in-memorys c_61)
+ (compiled-in-memory-post-compiled-in-memorys c_61))
+ (if (linklet-directory?$1 c_61)
+ (let-values (((ht_191) (linklet-directory->hash$1 c_61)))
+ (let-values (((bh_0) (linklet-bundle->hash$1 (hash-ref ht_191 #f))))
+ (let-values (((names_1) (hash-ref bh_0 (if non-star?_0 'pre 'post) null)))
+ (reverse$1
+ (let-values (((fold-var_450) (let-values (((fold-var_451) null)) fold-var_451)))
+ (let-values (((lst_434) names_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_434))
+ ((letrec-values (((for-loop_360)
+ (lambda (fold-var_452 lst_435)
+ (begin
+ 'for-loop
+ (if (pair? lst_435)
+ (let-values (((name_70) (unsafe-car lst_435))
+ ((rest_213) (unsafe-cdr lst_435)))
+ (let-values (((fold-var_453)
+ (let-values (((fold-var_454)
+ (cons
+ (hash-ref ht_191 name_70)
+ fold-var_452)))
+ (values fold-var_454))))
+ (if (not #f) (for-loop_360 fold-var_453 rest_213) fold-var_453)))
+ fold-var_452)))))
+ for-loop_360)
+ fold-var_450
+ lst_434))))))))
+ null)))))
+ ((c_62 non-star?_1 submods_1)
+ (begin
+ (if (1/compiled-module-expression? c_62)
+ (void)
+ (raise-argument-error 'module-compiled-submodules "compiled-module-expression?" c_62))
+ (if (if (list? submods_1) (andmap2 1/compiled-module-expression? submods_1) #f)
+ (void)
+ (raise-argument-error 'module-compiled-submodules "(listof compiled-module-expression?)" submods_1))
+ (if (if (null? submods_1)
+ (let-values (((or-part_441) (linklet-bundle?$1 (compiled->linklet-directory-or-bundle c_62))))
+ (if or-part_441
+ or-part_441
+ (if (compiled-in-memory? c_62)
+ (null?
+ (if non-star?_1
+ (compiled-in-memory-pre-compiled-in-memorys c_62)
+ (compiled-in-memory-post-compiled-in-memorys c_62)))
+ #f)))
+ #f)
+ c_62
+ (if (if (compiled-in-memory? c_62) (andmap2 compiled-in-memory? submods_1) #f)
+ (let-values (((pre-compiled-in-memorys_1)
+ (if non-star?_1 submods_1 (compiled-in-memory-pre-compiled-in-memorys c_62))))
+ (let-values (((post-compiled-in-memorys_1)
+ (if non-star?_1 (compiled-in-memory-post-compiled-in-memorys c_62) submods_1)))
+ (let-values (((n-c_0) (normalize-to-linklet-directory c_62)))
+ (fixup-submodule-names
+ (let-values (((the-struct_55) n-c_0))
+ (if (compiled-in-memory? the-struct_55)
+ (let-values (((pre-compiled-in-memorys2_0) pre-compiled-in-memorys_1)
+ ((post-compiled-in-memorys3_0) post-compiled-in-memorys_1)
+ ((linklet-directory4_0)
+ (let-values (((temp5_3)
+ (reset-submodule-names
+ (hash-ref
+ (linklet-directory->hash$1
+ (compiled->linklet-directory-or-bundle n-c_0))
+ #f)
+ non-star?_1
+ submods_1))
+ ((temp6_0) (symbol? (module-compiled-current-name c_62)))
+ ((temp7_6)
+ (append pre-compiled-in-memorys_1 post-compiled-in-memorys_1)))
+ (rebuild-linklet-directory.1 temp6_0 temp5_3 temp7_6))))
+ (compiled-in-memory1.1
+ linklet-directory4_0
+ (compiled-in-memory-original-self the-struct_55)
+ (compiled-in-memory-requires the-struct_55)
+ (compiled-in-memory-recur-requires the-struct_55)
+ (compiled-in-memory-flattened-requires the-struct_55)
+ (compiled-in-memory-provides the-struct_55)
+ (compiled-in-memory-phase-to-link-module-uses the-struct_55)
+ (compiled-in-memory-compile-time-inspector the-struct_55)
+ (compiled-in-memory-phase-to-link-extra-inspectorsss the-struct_55)
+ (compiled-in-memory-portal-stxes the-struct_55)
+ (compiled-in-memory-mpis the-struct_55)
+ (compiled-in-memory-syntax-literals the-struct_55)
+ pre-compiled-in-memorys2_0
+ post-compiled-in-memorys3_0
+ (compiled-in-memory-namespace-scopes the-struct_55)
+ (compiled-in-memory-purely-functional? the-struct_55)))
+ (raise-argument-error 'struct-copy "compiled-in-memory?" the-struct_55)))))))
+ (let-values (((n-c_1) (normalize-to-linklet-directory c_62)))
+ (fixup-submodule-names
+ (let-values (((temp8_4)
+ (reset-submodule-names
+ (hash-ref (linklet-directory->hash$1 (compiled->linklet-directory-or-bundle n-c_1)) #f)
+ non-star?_1
+ submods_1))
+ ((temp9_3)
+ (map2
+ compiled->linklet-directory-or-bundle
+ (append
+ (if non-star?_1 submods_1 (1/module-compiled-submodules c_62 #t))
+ (if non-star?_1 (1/module-compiled-submodules c_62 #f) submods_1)))))
+ (rebuild-linklet-directory.1 #f temp8_4 temp9_3))))))))))
(define-values
(fixup-submodule-names)
- (lambda (c_53) (begin (1/module-compiled-name c_53 (1/module-compiled-name c_53)))))
+ (lambda (c_63) (begin (1/module-compiled-name c_63 (1/module-compiled-name c_63)))))
(define-values
(reset-submodule-names)
- (lambda (b_88 pre?_1 submods_2)
+ (lambda (b_119 pre?_1 submods_2)
(begin
(1/hash->linklet-bundle
(hash-set
- (1/linklet-bundle->hash b_88)
+ (linklet-bundle->hash$1 b_119)
(if pre?_1 'pre 'post)
(let-values (((temp10_3) (map2 module-compiled-immediate-name submods_2)) ((symbol11_1) symbol))
(sort.1 #f #f temp10_3 symbol11_1)))))))
(define-values
(1/module-compiled-language-info)
- (lambda (c_7)
+ (lambda (c_64)
(begin
'module-compiled-language-info
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/compiled-module-expression? c_7)
- (void)
- (let-values ()
- (raise-argument-error 'module-compiled-language-info "compiled-module-expression?" c_7)))
- (values))))
- (let-values (((h_10) (compiled-module->h c_7))) (hash-ref h_10 'language-info #f))))))))
+ (let-values ((()
+ (begin
+ (if (1/compiled-module-expression? c_64)
+ (void)
+ (raise-argument-error 'module-compiled-language-info "compiled-module-expression?" c_64))
+ (values))))
+ (let-values (((h_10) (compiled-module->h c_64))) (hash-ref h_10 'language-info #f))))))
(define-values
(1/module-compiled-imports)
- (lambda (c_45)
+ (lambda (c_65)
(begin
'module-compiled-imports
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/compiled-module-expression? c_45)
- (void)
- (let-values ()
- (raise-argument-error 'module-compiled-imports "compiled-module-expression?" c_45)))
- (values))))
- (let-values (((inst_2) (compiled-module->declaration-instance c_45)))
- (1/instance-variable-value inst_2 'requires))))))))
+ (let-values ((()
+ (begin
+ (if (1/compiled-module-expression? c_65)
+ (void)
+ (raise-argument-error 'module-compiled-imports "compiled-module-expression?" c_65))
+ (values))))
+ (let-values (((inst_2) (compiled-module->declaration-instance c_65)))
+ (1/instance-variable-value inst_2 'requires))))))
(define-values
(1/module-compiled-exports)
(let-values (((module-compiled-exports_0)
- (lambda (c2_4 verbosity1_0)
+ (lambda (c2_1 verbosity1_0)
(begin
'module-compiled-exports
- (let-values (((c_54) c2_4))
+ (let-values (((c_66) c2_1))
(let-values (((verbosity_2) verbosity1_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/compiled-module-expression? c_54)
- (void)
- (let-values ()
- (raise-argument-error
- 'module-compiled-exports
- "compiled-module-expression?"
- c_54)))
- (values))))
- (let-values ((()
- (begin
- (check-provides-verbosity 'module-compiled-exports verbosity_2)
- (values))))
- (let-values (((inst_3) (compiled-module->declaration-instance c_54)))
- (provides->api-provides
- (1/instance-variable-value inst_3 'provides)
- (1/instance-variable-value inst_3 'self-mpi)
- verbosity_2)))))))))))))
+ (let-values ((()
+ (begin
+ (if (1/compiled-module-expression? c_66)
+ (void)
+ (raise-argument-error
+ 'module-compiled-exports
+ "compiled-module-expression?"
+ c_66))
+ (values))))
+ (let-values ((()
+ (begin
+ (check-provides-verbosity 'module-compiled-exports verbosity_2)
+ (values))))
+ (let-values (((inst_3) (compiled-module->declaration-instance c_66)))
+ (provides->api-provides
+ (1/instance-variable-value inst_3 'provides)
+ (1/instance-variable-value inst_3 'self-mpi)
+ verbosity_2))))))))))
(case-lambda
- ((c_51) (begin 'module-compiled-exports (module-compiled-exports_0 c_51 #f)))
- ((c_55 verbosity1_1) (module-compiled-exports_0 c_55 verbosity1_1)))))
+ ((c_67) (begin 'module-compiled-exports (module-compiled-exports_0 c_67 #f)))
+ ((c_68 verbosity1_1) (module-compiled-exports_0 c_68 verbosity1_1)))))
(define-values
(1/module-compiled-indirect-exports)
- (lambda (c_56)
+ (lambda (c_69)
(begin
'module-compiled-indirect-exports
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/compiled-module-expression? c_56)
- (void)
- (let-values ()
- (raise-argument-error
- 'module-compiled-indirect-exports
- "compiled-module-expression?"
- c_56)))
- (values))))
- (let-values (((h_0 inst_4) (compiled-module->h+declaration-instance c_56)))
- (let-values (((min-phase_3) (hash-ref h_0 'min-phase 0)))
- (let-values (((max-phase_3) (hash-ref h_0 'max-phase 0)))
- (variables->api-nonprovides
- (1/instance-variable-value inst_4 'provides)
- (let-values (((start_49) min-phase_3) ((end_35) (add1 max-phase_3)) ((inc_29) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_49 end_35 inc_29)))
- ((letrec-values (((for-loop_213)
- (lambda (table_203 pos_124)
- (begin
- 'for-loop
- (if (< pos_124 end_35)
- (let-values (((phase-level_23) pos_124))
- (let-values (((table_204)
- (let-values (((table_205) table_203))
- (let-values (((table_206)
- (let-values ()
- (let-values (((key_60 val_64)
- (let-values ()
- (let-values (((linklet_7)
- (hash-ref
- h_0
- phase-level_23
- #f)))
- (values
- phase-level_23
- (if linklet_7
- (linklet-export-variables$1
- linklet_7)
- null))))))
- (hash-set
- table_205
- key_60
- val_64)))))
- (values table_206)))))
- (if (not #f) (for-loop_213 table_204 (+ pos_124 inc_29)) table_204)))
- table_203)))))
- for-loop_213)
- '#hash()
- start_49)))))))))))))
+ (let-values ((()
+ (begin
+ (if (1/compiled-module-expression? c_69)
+ (void)
+ (raise-argument-error 'module-compiled-indirect-exports "compiled-module-expression?" c_69))
+ (values))))
+ (let-values (((h_11 inst_4) (compiled-module->h+declaration-instance c_69)))
+ (let-values (((min-phase_3) (hash-ref h_11 'min-phase 0)))
+ (let-values (((max-phase_3) (hash-ref h_11 'max-phase 0)))
+ (variables->api-nonprovides
+ (1/instance-variable-value inst_4 'provides)
+ (let-values (((table_250) (let-values (((table_251) '#hash())) table_251)))
+ (let-values (((start_58) min-phase_3) ((end_38) (add1 max-phase_3)) ((inc_32) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_58 end_38 inc_32))
+ ((letrec-values (((for-loop_361)
+ (lambda (table_252 pos_155)
+ (begin
+ 'for-loop
+ (if (< pos_155 end_38)
+ (let-values (((phase-level_27) pos_155))
+ (let-values (((table_253)
+ (let-values (((table_254)
+ (let-values (((key_87 val_68)
+ (let-values (((linklet_7)
+ (hash-ref
+ h_11
+ phase-level_27
+ #f)))
+ (values
+ phase-level_27
+ (if linklet_7
+ (linklet-export-variables$1
+ linklet_7)
+ null)))))
+ (hash-set table_252 key_87 val_68))))
+ (values table_254))))
+ (if (not #f) (for-loop_361 table_253 (+ pos_155 inc_32)) table_253)))
+ table_252)))))
+ for-loop_361)
+ table_250
+ start_58))))))))))))
(define-values
(1/module-compiled-cross-phase-persistent?)
- (lambda (c_57)
+ (lambda (c_70)
(begin
'module-compiled-cross-phase-persistent?
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/compiled-module-expression? c_57)
- (void)
- (let-values ()
- (raise-argument-error
- 'module-compiled-cross-phase-persistent?
- "compiled-module-expression?"
- c_57)))
- (values))))
- (let-values (((h_11) (compiled-module->h c_57))) (hash-ref h_11 'cross-phase-persistent? #f))))))))
+ (let-values ((()
+ (begin
+ (if (1/compiled-module-expression? c_70)
+ (void)
+ (raise-argument-error
+ 'module-compiled-cross-phase-persistent?
+ "compiled-module-expression?"
+ c_70))
+ (values))))
+ (let-values (((h_12) (compiled-module->h c_70))) (hash-ref h_12 'cross-phase-persistent? #f))))))
(define-values
(1/module-compiled-realm)
- (lambda (c_58)
+ (lambda (c_71)
(begin
'module-compiled-realm
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/compiled-module-expression? c_58)
- (void)
- (let-values ()
- (raise-argument-error 'module-compiled-realm "compiled-module-expression?" c_58)))
- (values))))
- (let-values (((h_12) (compiled-module->h c_58))) (hash-ref h_12 'realm 'racket))))))))
+ (let-values ((()
+ (begin
+ (if (1/compiled-module-expression? c_71)
+ (void)
+ (raise-argument-error 'module-compiled-realm "compiled-module-expression?" c_71))
+ (values))))
+ (let-values (((h_13) (compiled-module->h c_71))) (hash-ref h_13 'realm 'racket))))))
(define-values
(compile-module.1)
(lambda (force-linklet-directory?1_0
modules-being-compiled4_0
need-compiled-submodule-rename?5_0
serializable?2_0
- to-correlated-linklet?3_0
+ to-correlated-linklet?3_1
p11_0
cctx12_0)
(begin
'compile-module
- (let-values (((p_43) p11_0))
- (let-values (((cctx_14) cctx12_0))
+ (let-values (((p_52) p11_0))
+ (let-values (((cctx_17) cctx12_0))
(let-values (((force-linklet-directory?_0) force-linklet-directory?1_0))
(let-values (((serializable?_3) serializable?2_0))
- (let-values (((to-correlated-linklet?_3) to-correlated-linklet?3_0))
+ (let-values (((to-correlated-linklet?_6) to-correlated-linklet?3_1))
(let-values (((modules-being-compiled_0)
(if (eq? modules-being-compiled4_0 unsafe-undefined)
(make-hasheq)
modules-being-compiled4_0)))
(let-values (((need-compiled-submodule-rename?_0) need-compiled-submodule-rename?5_0))
- (let-values ()
- (let-values (((full-module-name_1)
- (let-values (((parent-full-name_0) (compile-context-full-module-name cctx_14))
- ((name_62) (syntax-e$1 (parsed-module-name-id p_43))))
- (if parent-full-name_0
- (append
- (if (list? parent-full-name_0) parent-full-name_0 (list parent-full-name_0))
- (list name_62))
- name_62))))
- (let-values (((compiled-submodules_0) (parsed-module-compiled-submodules p_43)))
- (let-values (((get-submodules_0)
- (lambda (star?_0)
- (begin
- 'get-submodules
- (reverse$1
- (let-values (((ht_122) compiled-submodules_0))
+ (let-values (((full-module-name_1)
+ (let-values (((parent-full-name_0) (compile-context-full-module-name cctx_17))
+ ((name_71) (syntax-e$1 (parsed-module-name-id p_52))))
+ (if parent-full-name_0
+ (append
+ (if (list? parent-full-name_0) parent-full-name_0 (list parent-full-name_0))
+ (list name_71))
+ name_71))))
+ (let-values (((compiled-submodules_0) (parsed-module-compiled-submodules p_52)))
+ (let-values (((get-submodules_0)
+ (lambda (star?_0)
+ (begin
+ 'get-submodules
+ (reverse$1
+ (let-values (((fold-var_455)
+ (let-values (((fold-var_456) null)) fold-var_456)))
+ (let-values (((ht_192) compiled-submodules_0))
(begin
(if (variable-reference-from-unsafe? (#%variable-reference))
(void)
- (let-values () (check-in-hash ht_122)))
- ((letrec-values (((for-loop_203)
- (lambda (fold-var_29 i_91)
+ (check-in-hash ht_192))
+ ((letrec-values (((for-loop_362)
+ (lambda (fold-var_457 i_253)
(begin
'for-loop
- (if i_91
- (let-values (((name_63 star?+compiled_0)
+ (if i_253
+ (let-values (((name_72 star?+compiled_0)
(hash-iterate-key+value
- ht_122
- i_91)))
- (let-values (((fold-var_194)
- (let-values (((fold-var_83)
- fold-var_29))
- (if (eq?
- star?_0
- (car star?+compiled_0))
- (let-values (((fold-var_208)
- fold-var_83))
- (let-values (((fold-var_251)
- (let-values ()
- (cons
- (let-values ()
- (cons
- name_63
- (if (if need-compiled-submodule-rename?_0
- (not
- (parsed-module-compiled-module
- p_43))
- #f)
- (update-submodule-names
- (cdr
- star?+compiled_0)
- name_63
- full-module-name_1)
- (cdr
- star?+compiled_0))))
- fold-var_208))))
- (values fold-var_251)))
- fold-var_83))))
+ ht_192
+ i_253)))
+ (let-values (((fold-var_458)
+ (if (eq?
+ star?_0
+ (car star?+compiled_0))
+ (let-values (((fold-var_459)
+ (cons
+ (cons
+ name_72
+ (if (if need-compiled-submodule-rename?_0
+ (not
+ (parsed-module-compiled-module
+ p_52))
+ #f)
+ (update-submodule-names
+ (cdr
+ star?+compiled_0)
+ name_72
+ full-module-name_1)
+ (cdr
+ star?+compiled_0)))
+ fold-var_457)))
+ (values fold-var_459))
+ fold-var_457)))
(if (not #f)
- (for-loop_203
- fold-var_194
- (hash-iterate-next ht_122 i_91))
- fold-var_194)))
- fold-var_29)))))
- for-loop_203)
- null
- (hash-iterate-first ht_122)))))))))
- (let-values (((pre-submodules_0)
- (let-values (((temp33_4) (get-submodules_0 #f))
- ((symbol34_1) symbol)
- ((car35_0) car))
- (sort.1 #f car35_0 temp33_4 symbol34_1))))
- (let-values (((post-submodules_0)
- (let-values (((temp36_2) (get-submodules_0 #t))
- ((symbol37_0) symbol)
- ((car38_0) car))
- (sort.1 #f car38_0 temp36_2 symbol37_0))))
- (let-values (((c1_29) (parsed-module-compiled-module p_43)))
- (if c1_29
- ((lambda (c_59)
- (let-values (((name_64 prefix_8)
- (if (symbol? full-module-name_1)
- (values full-module-name_1 null)
- (let-values (((r_39) (reverse$1 full-module-name_1)))
- (values (car r_39) (reverse$1 (cdr r_39)))))))
- (let-values (((m_21) (change-module-name c_59 name_64 prefix_8)))
- (1/module-compiled-submodules
- (1/module-compiled-submodules m_21 #t (map2 cdr pre-submodules_0))
- #f
- (map2 cdr post-submodules_0)))))
- c1_29)
- (let-values ()
- (let-values (((p39_0) p_43)
- ((cctx40_0) cctx_14)
- ((full-module-name41_0) full-module-name_1)
- ((force-linklet-directory?42_0) force-linklet-directory?_0)
- ((serializable?43_0) serializable?_3)
- ((to-correlated-linklet?44_0) to-correlated-linklet?_3)
- ((modules-being-compiled45_0) modules-being-compiled_0)
- ((pre-submodules46_0) pre-submodules_0)
- ((post-submodules47_0) post-submodules_0)
- ((need-compiled-submodule-rename?48_0)
- need-compiled-submodule-rename?_0))
- (compile-module-from-parsed.1
- force-linklet-directory?42_0
- full-module-name41_0
- modules-being-compiled45_0
- need-compiled-submodule-rename?48_0
- post-submodules47_0
- pre-submodules46_0
- serializable?43_0
- to-correlated-linklet?44_0
- p39_0
- cctx40_0)))))))))))))))))))))
+ (for-loop_362
+ fold-var_458
+ (hash-iterate-next ht_192 i_253))
+ fold-var_458)))
+ fold-var_457)))))
+ for-loop_362)
+ fold-var_455
+ (hash-iterate-first ht_192))))))))))
+ (let-values (((pre-submodules_0)
+ (let-values (((temp33_4) (get-submodules_0 #f))
+ ((symbol34_0) symbol)
+ ((car35_0) car))
+ (sort.1 #f car35_0 temp33_4 symbol34_0))))
+ (let-values (((post-submodules_0)
+ (let-values (((temp36_3) (get-submodules_0 #t))
+ ((symbol37_0) symbol)
+ ((car38_0) car))
+ (sort.1 #f car38_0 temp36_3 symbol37_0))))
+ (let-values (((cond-val_21) (parsed-module-compiled-module p_52)))
+ (if cond-val_21
+ ((lambda (c_72)
+ (let-values (((name_73 prefix_8)
+ (if (symbol? full-module-name_1)
+ (values full-module-name_1 null)
+ (let-values (((r_45) (reverse$1 full-module-name_1)))
+ (values (car r_45) (reverse$1 (cdr r_45)))))))
+ (let-values (((m_26) (change-module-name c_72 name_73 prefix_8)))
+ (1/module-compiled-submodules
+ (1/module-compiled-submodules m_26 #t (map2 cdr pre-submodules_0))
+ #f
+ (map2 cdr post-submodules_0)))))
+ cond-val_21)
+ (let-values (((p39_0) p_52)
+ ((cctx40_0) cctx_17)
+ ((full-module-name41_0) full-module-name_1)
+ ((force-linklet-directory?42_0) force-linklet-directory?_0)
+ ((serializable?43_0) serializable?_3)
+ ((to-correlated-linklet?44_0) to-correlated-linklet?_6)
+ ((modules-being-compiled45_0) modules-being-compiled_0)
+ ((pre-submodules46_0) pre-submodules_0)
+ ((post-submodules47_0) post-submodules_0)
+ ((need-compiled-submodule-rename?48_0)
+ need-compiled-submodule-rename?_0))
+ (compile-module-from-parsed.1
+ force-linklet-directory?42_0
+ full-module-name41_0
+ modules-being-compiled45_0
+ need-compiled-submodule-rename?48_0
+ post-submodules47_0
+ pre-submodules46_0
+ serializable?43_0
+ to-correlated-linklet?44_0
+ p39_0
+ cctx40_0)))))))))))))))))))
(define-values
(compile-module-from-parsed.1)
(lambda (force-linklet-directory?15_0
@@ -42874,77 +42438,77 @@
cctx31_1)
(begin
'compile-module-from-parsed
- (let-values (((p_46) p30_2))
- (let-values (((cctx_17) cctx31_1))
+ (let-values (((p_53) p30_2))
+ (let-values (((cctx_18) cctx31_1))
(let-values (((full-module-name_2) full-module-name14_0))
(let-values (((force-linklet-directory?_1) force-linklet-directory?15_0))
(let-values (((serializable?_4) serializable?16_0))
- (let-values (((to-correlated-linklet?_5) to-correlated-linklet?17_0))
+ (let-values (((to-correlated-linklet?_7) to-correlated-linklet?17_0))
(let-values (((modules-being-compiled_1) modules-being-compiled18_0))
(let-values (((pre-submodules_1) pre-submodules19_0))
(let-values (((post-submodules_1) post-submodules20_0))
(let-values (((need-compiled-submodule-rename?_1) need-compiled-submodule-rename?21_0))
- (let-values ()
- (begin
- (if log-performance? (let-values () (start-performance-region 'compile 'module)) (void))
- (begin0
- (let-values ()
- (let-values (((enclosing-self_0) (compile-context-module-self cctx_17)))
- (let-values (((self_27) (parsed-module-self p_46)))
- (let-values (((requires_6) (parsed-module-requires p_46)))
- (let-values (((provides_14) (parsed-module-provides p_46)))
+ (begin
+ (if log-performance? (start-performance-region 'compile 'module) (void))
+ (begin0
+ (let-values (((enclosing-self_0) (compile-context-module-self cctx_18)))
+ (let-values (((self_32) (parsed-module-self p_53)))
+ (let-values (((requires_7) (parsed-module-requires p_53)))
+ (let-values (((recur-requires_4) (parsed-module-recur-requires p_53)))
+ (let-values (((flattened-requires_4) (parsed-module-flattened-requires p_53)))
+ (let-values (((provides_15) (parsed-module-provides p_53)))
(let-values (((encoded-root-expand-ctx-box_1)
- (box (parsed-module-encoded-root-ctx p_46))))
+ (box (parsed-module-encoded-root-ctx p_53))))
(let-values (((body-context-simple?_0)
- (parsed-module-root-ctx-simple? p_46)))
+ (parsed-module-root-ctx-simple? p_53)))
(let-values (((language-info_2)
(filter-language-info
- (syntax-property$1 (parsed-s p_46) 'module-language))))
- (let-values (((realm_4) (parsed-module-realm p_46)))
- (let-values (((bodys_6) (parsed-module-body p_46)))
+ (syntax-property$1 (parsed-s p_53) 'module-language))))
+ (let-values (((realm_4) (parsed-module-realm p_53)))
+ (let-values (((bodys_6) (parsed-module-body p_53)))
(let-values (((portal-syntaxes_4)
- (parsed-module-portal-syntaxes p_46)))
+ (parsed-module-portal-syntaxes p_53)))
(let-values (((empty-result-for-module->namespace?_0) #f))
- (let-values (((mpis_21) (make-module-path-index-table)))
+ (let-values (((mpis_23) (make-module-path-index-table)))
(let-values (((body-cctx_0)
- (let-values (((the-struct_52) cctx_17))
- (if (compile-context? the-struct_52)
+ (let-values (((the-struct_56) cctx_18))
+ (if (compile-context? the-struct_56)
(let-values (((phase49_0) 0)
- ((self50_1) self_27)
- ((module-self51_0) self_27)
+ ((self50_0) self_32)
+ ((module-self51_0) self_32)
((full-module-name52_0)
full-module-name_2)
((lazy-syntax-literals?53_0)
#t))
(compile-context1.1
- (compile-context-namespace the-struct_52)
+ (compile-context-namespace the-struct_56)
phase49_0
- self50_1
+ self50_0
module-self51_0
full-module-name52_0
lazy-syntax-literals?53_0
- (compile-context-header the-struct_52)))
+ (compile-context-header the-struct_56)))
(raise-argument-error
'struct-copy
"compile-context?"
- the-struct_52)))))
+ the-struct_56)))))
(let-values (((cross-phase-persistent?_2) #f))
(let-values (((unsafe?-box_1) (box #f)))
- (let-values (((side-effects_0) (make-hasheqv)))
- (let-values (((check-side-effects!_0)
- (lambda (e_82
- expected-results_3
- phase_99
- required-reference?_1)
- (begin
- 'check-side-effects!
- (if (hash-ref
- side-effects_0
- phase_99
- #f)
- (void)
- (let-values ()
- (if (let-values (((e54_0) e_82)
+ (let-values (((unlimited-compile?-box_1) (box #f)))
+ (let-values (((side-effects_0) (make-hasheqv)))
+ (let-values (((check-side-effects!_0)
+ (lambda (e_91
+ expected-results_3
+ phase_117
+ required-reference?_1)
+ (begin
+ 'check-side-effects!
+ (if (hash-ref
+ side-effects_0
+ phase_117
+ #f)
+ (void)
+ (if (let-values (((e54_0) e_91)
((expected-results55_0)
expected-results_3)
((required-reference?56_0)
@@ -42955,376 +42519,373 @@
required-reference?56_0
e54_0
expected-results55_0))
- (let-values ()
- (hash-set!
- side-effects_0
- phase_99
- #t))
- (void))))))))
- (let-values ((()
- (begin
- (if (if need-compiled-submodule-rename?_1
- modules-being-compiled_1
- #f)
- (let-values ()
+ (hash-set!
+ side-effects_0
+ phase_117
+ #t)
+ (void)))))))
+ (let-values ((()
+ (begin
+ (if (if need-compiled-submodule-rename?_1
+ modules-being-compiled_1
+ #f)
(begin
(if (null? post-submodules_1)
(void)
- (let-values ()
- (error
- "internal error: have post submodules, but not already compiled")))
+ (error
+ "internal error: have post submodules, but not already compiled"))
(register-compiled-submodules
modules-being-compiled_1
pre-submodules_1
- self_27)))
- (void))
- (values))))
- (let-values (((body-linklets_2
- body-min-phase_0
- body-max-phase_0
- phase-to-link-module-uses_4
- phase-to-link-module-uses-expr_4
- phase-to-link-extra-inspectorsss_2
- syntax-literals_3
- root-ctx-pos_0)
- (let-values (((bodys57_0) bodys_6)
- ((body-cctx58_0)
- body-cctx_0)
- ((mpis59_0) mpis_21)
- ((temp60_2)
- (list
- (list
- get-syntax-literal!-id)
- (list
- set-transformer!-id)))
- ((temp61_1)
- (list
- empty-syntax-literals-instance
- empty-module-body-instance))
- ((temp62_0) '((void)))
- ((temp63_1) '(0))
- ((encoded-root-expand-ctx-box64_0)
- encoded-root-expand-ctx-box_1)
- ((body-context-simple?65_0)
- body-context-simple?_0)
- ((check-side-effects!66_0)
- check-side-effects!_0)
- ((temp67_1)
- (lambda (body_4
- cctx_18)
- (if (parsed-#%declare?
- body_4)
- (let-values ()
- (let-values (((ok?_30
- _74_0
- kw75_0)
- (let-values (((s_462)
+ self_32))
+ (void))
+ (values))))
+ (let-values (((body-linklets_2
+ body-min-phase_0
+ body-max-phase_0
+ phase-to-link-module-uses_4
+ phase-to-link-module-uses-expr_4
+ phase-to-link-extra-inspectorsss_2
+ syntax-literals_5
+ root-ctx-pos_0)
+ (let-values (((bodys57_0) bodys_6)
+ ((body-cctx58_0)
+ body-cctx_0)
+ ((mpis59_0) mpis_23)
+ ((temp60_2)
+ (list
+ (list
+ get-syntax-literal!-id)
+ (list
+ set-transformer!-id)))
+ ((temp61_0)
+ (list
+ empty-syntax-literals-instance
+ empty-module-body-instance))
+ ((temp62_0)
+ '((void)))
+ ((temp63_1) '(0))
+ ((encoded-root-expand-ctx-box64_0)
+ encoded-root-expand-ctx-box_1)
+ ((body-context-simple?65_0)
+ body-context-simple?_0)
+ ((check-side-effects!66_0)
+ check-side-effects!_0)
+ ((temp67_1)
+ (lambda (body_4
+ cctx_19)
+ (if (parsed-#%declare?
+ body_4)
+ (let-values (((ok?_31
+ _75_0
+ kw76_0)
+ (let-values (((s_617)
(parsed-s
body_4)))
- (let-values (((orig-s_34)
- s_462))
- (let-values (((_74_1
- kw75_1)
- (let-values (((s_200)
+ (let-values (((orig-s_35)
+ s_617))
+ (let-values (((_75_1
+ kw76_1)
+ (let-values (((s_618)
(if (syntax?$1
- s_462)
+ s_617)
(syntax-e$1
- s_462)
- s_462)))
+ s_617)
+ s_617)))
(if (pair?
- s_200)
- (let-values (((_76_0)
- (let-values (((s_206)
+ s_618)
+ (let-values (((_77_0)
+ (let-values (((s_619)
(car
- s_200)))
- s_206))
- ((kw77_0)
- (let-values (((s_207)
+ s_618)))
+ s_619))
+ ((kw78_0)
+ (let-values (((s_620)
(cdr
- s_200)))
- (let-values (((s_104)
+ s_618)))
+ (let-values (((s_621)
(if (syntax?$1
- s_207)
+ s_620)
(syntax-e$1
- s_207)
- s_207)))
- (let-values (((flat-s_20)
+ s_620)
+ s_620)))
+ (let-values (((flat-s_21)
(to-syntax-list.1
- s_104)))
+ s_621)))
(if (not
- flat-s_20)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_34))
- (let-values ()
- flat-s_20)))))))
+ flat-s_21)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_35)
+ flat-s_21))))))
(values
- _76_0
- kw77_0))
+ _77_0
+ kw78_0))
(raise-syntax-error$1
#f
"bad syntax"
- orig-s_34)))))
+ orig-s_35)))))
(values
#t
- _74_1
- kw75_1))))))
+ _75_1
+ kw76_1))))))
(begin
- (let-values (((lst_36)
- kw75_0))
+ (let-values (((lst_436)
+ kw76_0))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-list
- lst_36)))
- ((letrec-values (((for-loop_31)
- (lambda (lst_84)
+ (check-list
+ lst_436))
+ ((letrec-values (((for-loop_363)
+ (lambda (lst_437)
(begin
'for-loop
(if (pair?
- lst_84)
+ lst_437)
(let-values (((kw_0)
(unsafe-car
- lst_84))
- ((rest_39)
+ lst_437))
+ ((rest_214)
(unsafe-cdr
- lst_84)))
+ lst_437)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
+ (let-values ((()
+ (begin
+ (let-values (((tmp_33)
+ (syntax-e$1
+ kw_0)))
+ (if (equal?
+ tmp_33
+ '#:cross-phase-persistent)
+ (set! cross-phase-persistent?_2
+ #t)
+ (if (equal?
+ tmp_33
+ '#:empty-namespace)
(begin
- (if (eq?
- (syntax-e$1
- kw_0)
- '#:cross-phase-persistent)
- (let-values ()
- (set! cross-phase-persistent?_2
- #t))
- (void))
- (if (eq?
- (syntax-e$1
- kw_0)
- '#:empty-namespace)
- (let-values ()
- (begin
- (set! empty-result-for-module->namespace?_0
- #t)
- (set-box!
- encoded-root-expand-ctx-box_1
- #f)))
- (void))
- (if (eq?
- (syntax-e$1
- kw_0)
- '#:unsafe)
- (let-values ()
- (set-box!
- unsafe?-box_1
- #t))
- (void))))
- (values)))))
- (values)))))
+ (set! empty-result-for-module->namespace?_0
+ #t)
+ (set-box!
+ encoded-root-expand-ctx-box_1
+ #f))
+ (if (equal?
+ tmp_33
+ '#:unsafe)
+ (set-box!
+ unsafe?-box_1
+ #t)
+ (if (equal?
+ tmp_33
+ '#:unlimited-compile)
+ (set-box!
+ unlimited-compile?-box_1
+ #t)
+ (void))))))
+ (values))))
+ (values))))
(if (not
#f)
- (for-loop_31
- rest_39)
+ (for-loop_363
+ rest_214)
(values))))
(values))))))
- for-loop_31)
- lst_36)))
+ for-loop_363)
+ lst_436)))
(void)
- #f)))
- (let-values ()
- #f))))
- ((temp68_2)
- (lambda (mod-name_18
- phase_100)
- (let-values (((ht_148)
- (if modules-being-compiled_1
- (hash-ref
- modules-being-compiled_1
- mod-name_18
- #f)
- #f)))
- (if ht_148
- (hash-ref
- ht_148
- phase_100
- #f)
- #f))))
- ((serializable?69_0)
- serializable?_4)
- ((temp70_1) #t)
- ((to-correlated-linklet?71_0)
- to-correlated-linklet?_5)
- ((unsafe?-box72_0)
- unsafe?-box_1)
- ((realm73_0) realm_4))
- (compile-forms.1
- temp61_1
- temp60_2
- temp62_0
- check-side-effects!66_0
- void
- encoded-root-expand-ctx-box64_0
- temp63_1
- temp68_2
- temp70_1
- #t
- temp67_1
- realm73_0
- body-context-simple?65_0
- serializable?69_0
- to-correlated-linklet?71_0
- unsafe?-box72_0
- bodys57_0
- body-cctx58_0
- mpis59_0))))
- (let-values (((portal-stxes_2
- max-phase_4
- min-phase_4)
- (add-portal-syntaxes
- syntax-literals_3
- portal-syntaxes_4
- body-max-phase_0
- body-min-phase_0)))
- (let-values ((()
- (begin
- (if modules-being-compiled_1
- (let-values ()
+ #f))
+ #f)))
+ ((temp68_2)
+ (lambda (mod-name_19
+ phase_118)
+ (let-values (((ht_193)
+ (if modules-being-compiled_1
+ (hash-ref
+ modules-being-compiled_1
+ mod-name_19
+ #f)
+ #f)))
+ (if ht_193
+ (hash-ref
+ ht_193
+ phase_118
+ #f)
+ #f))))
+ ((serializable?69_0)
+ serializable?_4)
+ ((temp70_0) #t)
+ ((unlimited-compile?-box71_0)
+ unlimited-compile?-box_1)
+ ((to-correlated-linklet?72_0)
+ to-correlated-linklet?_7)
+ ((unsafe?-box73_0)
+ unsafe?-box_1)
+ ((realm74_0)
+ realm_4))
+ (compile-forms.1
+ temp61_0
+ temp60_2
+ temp62_0
+ check-side-effects!66_0
+ void
+ encoded-root-expand-ctx-box64_0
+ temp63_1
+ temp68_2
+ temp70_0
+ #t
+ temp67_1
+ realm74_0
+ body-context-simple?65_0
+ serializable?69_0
+ to-correlated-linklet?72_0
+ unlimited-compile?-box71_0
+ unsafe?-box73_0
+ bodys57_0
+ body-cctx58_0
+ mpis59_0))))
+ (let-values (((portal-stxes_2
+ max-phase_4
+ min-phase_4)
+ (add-portal-syntaxes
+ syntax-literals_5
+ portal-syntaxes_4
+ body-max-phase_0
+ body-min-phase_0)))
+ (let-values ((()
+ (begin
+ (if modules-being-compiled_1
(hash-set!
modules-being-compiled_1
(1/module-path-index-resolve
- self_27)
- (let-values (((ht_149)
- body-linklets_2))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
+ self_32)
+ (let-values (((table_255)
+ (let-values (((table_256)
+ '#hasheq()))
+ table_256)))
+ (let-values (((ht_194)
+ body-linklets_2))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
(check-in-hash
- ht_149)))
- ((letrec-values (((for-loop_260)
- (lambda (table_207
- i_182)
- (begin
- 'for-loop
- (if i_182
- (let-values (((phase_101
- linklet_8)
- (hash-iterate-key+value
- ht_149
- i_182)))
- (let-values (((table_208)
- (let-values (((table_159)
- table_207))
- (let-values (((table_209)
- (let-values ()
- (let-values (((key_81
- val_60)
- (let-values ()
- (values
- phase_101
- (module-linklet-info2.1
- linklet_8
- (hash-ref
- phase-to-link-module-uses_4
- phase_101
- #f)
- self_27
- #f
- #f
- (if phase-to-link-extra-inspectorsss_2
- (hash-ref
- phase-to-link-extra-inspectorsss_2
- phase_101
- #f)
- #f))))))
- (hash-set
- table_159
- key_81
- val_60)))))
+ ht_194))
+ ((letrec-values (((for-loop_364)
+ (lambda (table_257
+ i_254)
+ (begin
+ 'for-loop
+ (if i_254
+ (let-values (((phase_119
+ linklet_8)
+ (hash-iterate-key+value
+ ht_194
+ i_254)))
+ (let-values (((table_258)
+ (let-values (((table_259)
+ (let-values (((key_88
+ val_69)
+ (values
+ phase_119
+ (module-linklet-info2.1
+ linklet_8
+ (hash-ref
+ phase-to-link-module-uses_4
+ phase_119
+ #f)
+ self_32
+ #f
+ #f
+ (if phase-to-link-extra-inspectorsss_2
+ (hash-ref
+ phase-to-link-extra-inspectorsss_2
+ phase_119
+ #f)
+ #f)))))
+ (hash-set
+ table_257
+ key_88
+ val_69))))
(values
- table_209)))))
- (if (not
- #f)
- (for-loop_260
- table_208
- (hash-iterate-next
- ht_149
- i_182))
- table_208)))
- table_207)))))
- for-loop_260)
- '#hasheq()
- (hash-iterate-first
- ht_149))))))
- (void))
- (values))))
- (let-values (((declaration-linklet_0)
- (if serializable?_4
- ((lambda (s_82)
- (if to-correlated-linklet?_5
- (make-correlated-linklet
- s_82
- 'decl)
- (begin
- (if log-performance?
- (let-values ()
+ table_259))))
+ (if (not
+ #f)
+ (for-loop_364
+ table_258
+ (hash-iterate-next
+ ht_194
+ i_254))
+ table_258)))
+ table_257)))))
+ for-loop_364)
+ table_255
+ (hash-iterate-first
+ ht_194))))))
+ (void))
+ (values))))
+ (let-values (((declaration-linklet_0)
+ (if serializable?_4
+ ((lambda (s_622)
+ (if to-correlated-linklet?_7
+ (make-correlated-linklet
+ s_622
+ 'decl)
+ (begin
+ (if log-performance?
(start-performance-region
'compile
'module
- 'linklet))
- (void))
- (begin0
- (let-values ()
+ 'linklet)
+ (void))
+ (begin0
(1/compile-linklet
- s_82
- 'decl))
- (if log-performance?
- (let-values ()
- (end-performance-region))
- (void))))))
- (generate-module-declaration-linklet
- mpis_21
- self_27
- requires_6
- provides_14
- phase-to-link-module-uses-expr_4
- portal-stxes_2))
- #f)))
- (let-values (((syntax-literals-linklet_2)
- (if (not
- (syntax-literals-empty?
- syntax-literals_3))
- ((lambda (s_208)
- (if to-correlated-linklet?_5
- (make-correlated-linklet
- s_208
- 'syntax-literals)
- (begin
- (if log-performance?
- (let-values ()
+ s_622
+ (hasheq
+ 'module
+ full-module-name_2
+ 'name
+ 'decl))
+ (if log-performance?
+ (end-performance-region)
+ (void))))))
+ (generate-module-declaration-linklet
+ mpis_23
+ self_32
+ requires_7
+ recur-requires_4
+ flattened-requires_4
+ provides_15
+ phase-to-link-module-uses-expr_4
+ portal-stxes_2))
+ #f)))
+ (let-values (((syntax-literals-linklet_2)
+ (if (not
+ (syntax-literals-empty?
+ syntax-literals_5))
+ ((lambda (s_623)
+ (if to-correlated-linklet?_7
+ (make-correlated-linklet
+ s_623
+ 'syntax-literals)
+ (begin
+ (if log-performance?
(start-performance-region
'compile
'module
- 'linklet))
- (void))
- (begin0
- (let-values ()
+ 'linklet)
+ (void))
+ (begin0
(let-values (((linklet_9
new-keys_1)
(1/compile-linklet
- s_208
- 'syntax-literals
+ s_623
+ (hasheq
+ 'module
+ full-module-name_2
+ 'name
+ 'syntax-literals)
(vector
deserialize-instance
empty-top-syntax-literal-instance
@@ -43337,594 +42898,570 @@
(if serializable?_4
'(serializable)
'()))))
- linklet_9))
- (if log-performance?
- (let-values ()
- (end-performance-region))
- (void))))))
- (list*
- 'linklet
- (list
- deserialize-imports
- (list mpi-vector-id)
+ linklet_9)
+ (if log-performance?
+ (end-performance-region)
+ (void))))))
(list*
- deserialized-syntax-vector-id
- (if serializable?_4
- (list
- deserialize-syntax-id)
- '()))
- instance-imports)
- (list*
- get-syntax-literal!-id
- '(get-encoded-root-expand-ctx))
- (qq-append
- (let-values (((syntax-literals78_0)
- syntax-literals_3)
- ((mpis79_0)
- mpis_21)
- ((self80_0)
- self_27)
- ((temp81_1)
- (not
- serializable?_4)))
- (generate-lazy-syntax-literals!.1
- temp81_1
- syntax-literals78_0
- mpis79_0
- self80_0))
- (list
+ 'linklet
(list
- 'define-values
- '(get-encoded-root-expand-ctx)
- (if root-ctx-pos_0
- (let-values ()
+ deserialize-imports
+ (list mpi-vector-id)
+ (list*
+ deserialized-syntax-vector-id
+ (if serializable?_4
+ (list
+ deserialize-syntax-id)
+ '()))
+ instance-imports)
+ (list*
+ get-syntax-literal!-id
+ '(get-encoded-root-expand-ctx))
+ (qq-append
+ (let-values (((syntax-literals79_0)
+ syntax-literals_5)
+ ((mpis80_0)
+ mpis_23)
+ ((self81_0)
+ self_32)
+ ((temp82_0)
+ (not
+ serializable?_4)))
+ (generate-lazy-syntax-literals!.1
+ temp82_0
+ syntax-literals79_0
+ mpis80_0
+ self81_0))
+ (list
+ (list
+ 'define-values
+ '(get-encoded-root-expand-ctx)
+ (if root-ctx-pos_0
(list
'lambda
'()
(generate-lazy-syntax-literal-lookup
- root-ctx-pos_0)))
- (if empty-result-for-module->namespace?_0
- (let-values ()
- ''empty)
- (let-values ()
- ''#f))))))))
- #f)))
- (let-values (((syntax-literals-data-linklet_0)
- (if serializable?_4
- (if (not
- (syntax-literals-empty?
- syntax-literals_3))
- ((lambda (s_463)
- (if to-correlated-linklet?_5
- (make-correlated-linklet
- s_463
- 'syntax-literals-data)
- (begin
- (if log-performance?
- (let-values ()
+ root-ctx-pos_0))
+ (if empty-result-for-module->namespace?_0
+ ''empty
+ ''#f)))))))
+ #f)))
+ (let-values (((syntax-literals-data-linklet_0)
+ (if serializable?_4
+ (if (not
+ (syntax-literals-empty?
+ syntax-literals_5))
+ ((lambda (s_624)
+ (if to-correlated-linklet?_7
+ (make-correlated-linklet
+ s_624
+ 'syntax-literals-data)
+ (begin
+ (if log-performance?
(start-performance-region
'compile
'module
- 'linklet))
- (void))
- (begin0
- (let-values ()
+ 'linklet)
+ (void))
+ (begin0
(1/compile-linklet
- s_463
- 'syntax-literals-data
- #f
- #f
- '(serializable)))
- (if log-performance?
- (let-values ()
- (end-performance-region))
- (void))))))
- (list*
- 'linklet
- (list
- deserialize-imports
- (list
- mpi-vector-id))
- (list
- deserialized-syntax-vector-id
- deserialize-syntax-id)
- (list
- 'define-values
- (list
- deserialized-syntax-vector-id)
+ s_624
+ (hasheq
+ 'module
+ full-module-name_2
+ 'name
+ 'syntax-literals-data))
+ (if log-performance?
+ (end-performance-region)
+ (void))))))
(list*
- 'make-vector
- (syntax-literals-count
- syntax-literals_3)
- '(#f)))
- (begin
- (if log-performance?
- (let-values ()
+ 'linklet
+ (list
+ deserialize-imports
+ (list
+ mpi-vector-id))
+ (list
+ deserialized-syntax-vector-id
+ deserialize-syntax-id)
+ (list*
+ 'define-values
+ (list
+ deserialized-syntax-vector-id)
+ '((box #f)))
+ (begin
+ (if log-performance?
(start-performance-region
'compile
'module
- 'serialize))
- (void))
- (begin0
- (let-values ()
+ 'serialize)
+ (void))
+ (begin0
(generate-lazy-syntax-literals-data!
- syntax-literals_3
- mpis_21))
- (if log-performance?
- (let-values ()
- (end-performance-region))
- (void))))))
- #f)
- #f)))
- (let-values (((data-linklet_0)
- (if serializable?_4
- ((lambda (s_464)
- (if to-correlated-linklet?_5
- (make-correlated-linklet
- s_464
- 'data)
- (begin
- (if log-performance?
- (let-values ()
+ syntax-literals_5
+ mpis_23)
+ (if log-performance?
+ (end-performance-region)
+ (void))))))
+ #f)
+ #f)))
+ (let-values (((data-linklet_0)
+ (if serializable?_4
+ ((lambda (s_625)
+ (if to-correlated-linklet?_7
+ (make-correlated-linklet
+ s_625
+ 'data)
+ (begin
+ (if log-performance?
(start-performance-region
'compile
'module
- 'linklet))
- (void))
- (begin0
- (let-values ()
+ 'linklet)
+ (void))
+ (begin0
(1/compile-linklet
- s_464
- 'data))
- (if log-performance?
- (let-values ()
- (end-performance-region))
- (void))))))
- (generate-module-data-linklet
- mpis_21))
- #f)))
- (let-values (((bundle_1)
- (let-values (((bundle_2)
- (hash-set
- body-linklets_2
- 'name
- full-module-name_2)))
- (let-values (((bundle_3)
+ s_625
+ (hasheq
+ 'module
+ full-module-name_2
+ 'name
+ 'data))
+ (if log-performance?
+ (end-performance-region)
+ (void))))))
+ (generate-module-data-linklet
+ mpis_23))
+ #f)))
+ (let-values (((bundle_1)
+ (let-values (((bundle_2)
(hash-set
- bundle_2
- 'decl
- (let-values (((or-part_101)
- declaration-linklet_0))
- (if or-part_101
- or-part_101
- 'in-memory)))))
- (let-values (((bundle_4)
- (if data-linklet_0
- (hash-set
- bundle_3
- 'data
- data-linklet_0)
- bundle_3)))
- (let-values (((bundle_5)
- (if syntax-literals-linklet_2
+ body-linklets_2
+ 'name
+ full-module-name_2)))
+ (let-values (((bundle_3)
+ (hash-set
+ bundle_2
+ 'decl
+ (let-values (((or-part_442)
+ declaration-linklet_0))
+ (if or-part_442
+ or-part_442
+ 'in-memory)))))
+ (let-values (((bundle_4)
+ (if data-linklet_0
(hash-set
- bundle_4
- 'stx
- syntax-literals-linklet_2)
- bundle_4)))
- (let-values (((bundle_6)
- (if syntax-literals-data-linklet_0
+ bundle_3
+ 'data
+ data-linklet_0)
+ bundle_3)))
+ (let-values (((bundle_5)
+ (if syntax-literals-linklet_2
(hash-set
- bundle_5
- 'stx-data
- syntax-literals-data-linklet_0)
- bundle_5)))
- (let-values (((bundle_7)
- (if (null?
- pre-submodules_1)
- bundle_6
+ bundle_4
+ 'stx
+ syntax-literals-linklet_2)
+ bundle_4)))
+ (let-values (((bundle_6)
+ (if syntax-literals-data-linklet_0
(hash-set
- bundle_6
- 'pre
- (map2
- car
- pre-submodules_1)))))
- (let-values (((bundle_8)
+ bundle_5
+ 'stx-data
+ syntax-literals-data-linklet_0)
+ bundle_5)))
+ (let-values (((bundle_7)
(if (null?
- post-submodules_1)
- bundle_7
+ pre-submodules_1)
+ bundle_6
(hash-set
- bundle_7
- 'post
+ bundle_6
+ 'pre
(map2
car
- post-submodules_1)))))
- (let-values (((bundle_9)
- (if cross-phase-persistent?_2
+ pre-submodules_1)))))
+ (let-values (((bundle_8)
+ (if (null?
+ post-submodules_1)
+ bundle_7
(hash-set
- bundle_8
- 'cross-phase-persistent?
- #t)
- bundle_8)))
- (let-values (((bundle_10)
- (if language-info_2
+ bundle_7
+ 'post
+ (map2
+ car
+ post-submodules_1)))))
+ (let-values (((bundle_9)
+ (if cross-phase-persistent?_2
(hash-set
- bundle_9
- 'language-info
- language-info_2)
- bundle_9)))
- (let-values (((bundle_11)
- (if (not
- (eq?
- realm_4
- 'racket))
+ bundle_8
+ 'cross-phase-persistent?
+ #t)
+ bundle_8)))
+ (let-values (((bundle_10)
+ (if language-info_2
(hash-set
- bundle_10
- 'realm
- realm_4)
- bundle_10)))
- (let-values (((bundle_12)
- (if (zero?
- min-phase_4)
- bundle_11
+ bundle_9
+ 'language-info
+ language-info_2)
+ bundle_9)))
+ (let-values (((bundle_11)
+ (if (not
+ (eq?
+ realm_4
+ 'racket))
(hash-set
- bundle_11
- 'min-phase
- min-phase_4))))
- (let-values (((bundle_13)
+ bundle_10
+ 'realm
+ realm_4)
+ bundle_10)))
+ (let-values (((bundle_12)
(if (zero?
- max-phase_4)
- bundle_12
+ min-phase_4)
+ bundle_11
(hash-set
- bundle_12
- 'max-phase
- max-phase_4))))
- (let-values (((bundle_14)
- (if (hash-count
- side-effects_0)
+ bundle_11
+ 'min-phase
+ min-phase_4))))
+ (let-values (((bundle_13)
+ (if (zero?
+ max-phase_4)
+ bundle_12
(hash-set
- bundle_13
- 'side-effects
- (let-values (((temp82_0)
- (hash-keys
- side-effects_0))
- ((<83_0)
- <))
- (sort.1
- #f
- #f
- temp82_0
- <83_0)))
- bundle_13)))
- (let-values (((bundle_15)
- (if empty-result-for-module->namespace?_0
+ bundle_12
+ 'max-phase
+ max-phase_4))))
+ (let-values (((bundle_14)
+ (if (hash-count
+ side-effects_0)
(hash-set
- bundle_14
- 'module->namespace
- 'empty)
- bundle_14)))
- (let-values (((bundle_16)
- (if (unbox
- unsafe?-box_1)
+ bundle_13
+ 'side-effects
+ (let-values (((temp83_0)
+ (hash-keys
+ side-effects_0))
+ ((<84_0)
+ <))
+ (sort.1
+ #f
+ #f
+ temp83_0
+ <84_0)))
+ bundle_13)))
+ (let-values (((bundle_15)
+ (if empty-result-for-module->namespace?_0
(hash-set
- bundle_15
- 'unsafe?
- #t)
- bundle_15)))
- (1/hash->linklet-bundle
- bundle_16))))))))))))))))))
- (let-values (((ld_9)
- (if (if (null?
- pre-submodules_1)
- (if (null?
- post-submodules_1)
- (not
- force-linklet-directory?_1)
+ bundle_14
+ 'module->namespace
+ 'empty)
+ bundle_14)))
+ (let-values (((bundle_16)
+ (if (unbox
+ unsafe?-box_1)
+ (hash-set
+ bundle_15
+ 'unsafe?
+ #t)
+ bundle_15)))
+ (1/hash->linklet-bundle
+ bundle_16))))))))))))))))))
+ (let-values (((ld_10)
+ (if (if (null?
+ pre-submodules_1)
+ (if (null?
+ post-submodules_1)
+ (not
+ force-linklet-directory?_1)
+ #f)
#f)
- #f)
- (let-values ()
- bundle_1)
- (let-values ()
- (let-values (((ht_34)
- (let-values (((lst_291)
- (append
- pre-submodules_1
- post-submodules_1)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
+ bundle_1
+ (let-values (((ht_195)
+ (let-values (((ht_196)
+ (let-values (((ht_197)
+ (hasheq
+ #f
+ bundle_1)))
+ ht_197)))
+ (let-values (((lst_438)
+ (append
+ pre-submodules_1
+ post-submodules_1)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
(check-list
- lst_291)))
- ((letrec-values (((for-loop_261)
- (lambda (ht_142
- lst_292)
- (begin
- 'for-loop
- (if (pair?
- lst_292)
- (let-values (((sm_0)
- (unsafe-car
- lst_292))
- ((rest_153)
- (unsafe-cdr
- lst_292)))
- (let-values (((ht_150)
- (let-values (((ht_41)
- ht_142))
- (let-values (((ht_151)
- (let-values ()
- (hash-set
- ht_41
- (car
- sm_0)
- (compiled-in-memory-linklet-directory
- (cdr
- sm_0))))))
+ lst_438))
+ ((letrec-values (((for-loop_365)
+ (lambda (ht_198
+ lst_439)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_439)
+ (let-values (((sm_0)
+ (unsafe-car
+ lst_439))
+ ((rest_215)
+ (unsafe-cdr
+ lst_439)))
+ (let-values (((ht_199)
+ (let-values (((ht_200)
+ (hash-set
+ ht_198
+ (car
+ sm_0)
+ (compiled-in-memory-linklet-directory
+ (cdr
+ sm_0)))))
(values
- ht_151)))))
- (if (not
- #f)
- (for-loop_261
- ht_150
- rest_153)
- ht_150)))
- ht_142)))))
- for-loop_261)
- (hasheq
- #f
- bundle_1)
- lst_291)))))
+ ht_200))))
+ (if (not
+ #f)
+ (for-loop_365
+ ht_199
+ rest_215)
+ ht_199)))
+ ht_198)))))
+ for-loop_365)
+ ht_196
+ lst_438))))))
(1/hash->linklet-directory
- ht_34))))))
- (compiled-in-memory1.1
- ld_9
- self_27
- requires_6
- provides_14
- phase-to-link-module-uses_4
- (current-code-inspector)
- phase-to-link-extra-inspectorsss_2
- portal-stxes_2
- (mpis-as-vector mpis_21)
- (syntax-literals-as-vector
- syntax-literals_3)
- (map2 cdr pre-submodules_1)
- (map2 cdr post-submodules_1)
- #f
- #f)))))))))))))))))))))))))))))
- (if log-performance? (let-values () (end-performance-region)) (void))))))))))))))))))
+ ht_195)))))
+ (compiled-in-memory1.1
+ ld_10
+ self_32
+ requires_7
+ recur-requires_4
+ flattened-requires_4
+ provides_15
+ phase-to-link-module-uses_4
+ (current-code-inspector)
+ phase-to-link-extra-inspectorsss_2
+ portal-stxes_2
+ (mpis-as-vector mpis_23)
+ (syntax-literals-as-vector
+ syntax-literals_5)
+ (map2 cdr pre-submodules_1)
+ (map2 cdr post-submodules_1)
+ #f
+ #f)))))))))))))))))))))))))))))))
+ (if log-performance? (end-performance-region) (void)))))))))))))))))
(define-values
(update-submodule-names)
- (lambda (cim_9 name_65 full-module-name_3)
+ (lambda (cim_9 name_74 full-module-name_3)
(begin
(change-module-name
cim_9
- name_65
+ name_74
(if (symbol? full-module-name_3) (list full-module-name_3) (reverse$1 (cdr (reverse$1 full-module-name_3))))))))
(define-values
(register-compiled-submodules)
- (lambda (modules-being-compiled_2 pre-submodules_2 self_28)
+ (lambda (modules-being-compiled_2 pre-submodules_2 self_33)
(begin
(begin
- (let-values (((lst_293) pre-submodules_2))
+ (let-values (((lst_440) pre-submodules_2))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_293)))
- ((letrec-values (((for-loop_44)
- (lambda (lst_294)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_440))
+ ((letrec-values (((for-loop_366)
+ (lambda (lst_441)
(begin
'for-loop
- (if (pair? lst_294)
- (let-values (((s_122) (unsafe-car lst_294)) ((rest_154) (unsafe-cdr lst_294)))
+ (if (pair? lst_441)
+ (let-values (((s_626) (unsafe-car lst_441)) ((rest_216) (unsafe-cdr lst_441)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((name_66) (car s_122)))
- (let-values (((cim_10) (cdr s_122)))
- (let-values (((phase-to-link-module-uses_5)
- (compiled-in-memory-phase-to-link-module-uses
+ (let-values ((()
+ (begin
+ (let-values (((name_75) (car s_626)))
+ (let-values (((cim_10) (cdr s_626)))
+ (let-values (((phase-to-link-module-uses_5)
+ (compiled-in-memory-phase-to-link-module-uses
+ cim_10)))
+ (let-values (((ld_11)
+ (compiled-in-memory-linklet-directory
+ cim_10)))
+ (let-values (((sm-self_0)
+ (1/module-path-index-join
+ (list 'submod "." name_75)
+ self_33)))
+ (let-values (((phase-to-extra-inspectorsss_0)
+ (compiled-in-memory-phase-to-link-extra-inspectorsss
cim_10)))
- (let-values (((ld_10)
- (compiled-in-memory-linklet-directory
- cim_10)))
- (let-values (((sm-self_0)
- (1/module-path-index-join
- (list
- 'submod
- "."
- name_66)
- self_28)))
- (let-values (((phase-to-extra-inspectorsss_0)
- (compiled-in-memory-phase-to-link-extra-inspectorsss
- cim_10)))
- (hash-set!
- modules-being-compiled_2
- (1/module-path-index-resolve
- sm-self_0)
- (let-values (((ht_152)
- (1/linklet-bundle->hash
- (if (linklet-directory?$1
- ld_10)
- (hash-ref
- (linklet-directory->hash$1
- ld_10)
- #f)
- ld_10))))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash ht_152)))
- ((letrec-values (((for-loop_262)
- (lambda (table_122
- i_183)
- (begin
- 'for-loop
- (if i_183
- (let-values (((phase_102
- linklet_10)
- (hash-iterate-key+value
- ht_152
- i_183)))
- (let-values (((table_48)
- (let-values (((table_49)
- table_122))
- (if (number?
- phase_102)
- (let-values (((table_210)
- table_49))
- (let-values (((table_211)
- (let-values ()
- (let-values (((key_82
- val_65)
- (let-values ()
- (values
- phase_102
- (module-linklet-info2.1
- linklet_10
- (hash-ref
- phase-to-link-module-uses_5
- phase_102
- #f)
- (compiled-in-memory-original-self
- cim_10)
- #f
- (compiled-in-memory-compile-time-inspector
- cim_10)
- (if phase-to-extra-inspectorsss_0
- (hash-ref
- phase-to-extra-inspectorsss_0
- phase_102
- #f)
- #f))))))
- (hash-set
- table_210
- key_82
- val_65)))))
- (values
- table_211)))
- table_49))))
- (if (not
- #f)
- (for-loop_262
- table_48
- (hash-iterate-next
- ht_152
- i_183))
- table_48)))
- table_122)))))
- for-loop_262)
- '#hasheq()
- (hash-iterate-first
- ht_152))))))))))))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_44 rest_154) (values))))
+ (hash-set!
+ modules-being-compiled_2
+ (1/module-path-index-resolve sm-self_0)
+ (let-values (((table_260)
+ (let-values (((table_261)
+ '#hasheq()))
+ table_261)))
+ (let-values (((ht_201)
+ (linklet-bundle->hash$1
+ (if (linklet-directory?$1
+ ld_11)
+ (hash-ref
+ (linklet-directory->hash$1
+ ld_11)
+ #f)
+ ld_11))))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash ht_201))
+ ((letrec-values (((for-loop_367)
+ (lambda (table_262
+ i_255)
+ (begin
+ 'for-loop
+ (if i_255
+ (let-values (((phase_120
+ linklet_10)
+ (hash-iterate-key+value
+ ht_201
+ i_255)))
+ (let-values (((table_263)
+ (if (number?
+ phase_120)
+ (let-values (((table_264)
+ (let-values (((key_89
+ val_70)
+ (values
+ phase_120
+ (module-linklet-info2.1
+ linklet_10
+ (hash-ref
+ phase-to-link-module-uses_5
+ phase_120
+ #f)
+ (compiled-in-memory-original-self
+ cim_10)
+ #f
+ (compiled-in-memory-compile-time-inspector
+ cim_10)
+ (if phase-to-extra-inspectorsss_0
+ (hash-ref
+ phase-to-extra-inspectorsss_0
+ phase_120
+ #f)
+ #f)))))
+ (hash-set
+ table_262
+ key_89
+ val_70))))
+ (values
+ table_264))
+ table_262)))
+ (if (not
+ #f)
+ (for-loop_367
+ table_263
+ (hash-iterate-next
+ ht_201
+ i_255))
+ table_263)))
+ table_262)))))
+ for-loop_367)
+ table_260
+ (hash-iterate-first
+ ht_201))))))))))))
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_366 rest_216) (values))))
(values))))))
- for-loop_44)
- lst_293)))
+ for-loop_366)
+ lst_440)))
(void)))))
(define-values
(add-portal-syntaxes)
- (lambda (syntax-literals_4 portal-syntaxes_5 body-max-phase_1 body-min-phase_1)
+ (lambda (syntax-literals_6 portal-syntaxes_5 body-max-phase_1 body-min-phase_1)
(begin
- (let-values (((ht_107) portal-syntaxes_5))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-in-hash ht_107)))
- ((letrec-values (((for-loop_174)
- (lambda (portal-stxes_3 max-phase_5 min-phase_5 i_184)
- (begin
- 'for-loop
- (if i_184
- (let-values (((phase_103 ht_153) (hash-iterate-key+value ht_107 i_184)))
- (let-values (((portal-stxes_4 max-phase_6 min-phase_6)
- (let-values (((portal-stxes_5) portal-stxes_3)
- ((max-phase_7) max-phase_5)
- ((min-phase_7) min-phase_5))
- (let-values (((portal-stxes_6 max-phase_8 min-phase_8)
- (let-values ()
- (let-values (((new-portal-stxes_0)
- (hash-set
- portal-stxes_5
- phase_103
- (let-values (((ht_154) ht_153))
+ (let-values (((portal-stxes_3) (let-values (((portal-stxes_4) '#hasheq())) portal-stxes_4))
+ ((max-phase_5) (let-values (((max-phase_6) body-max-phase_1)) max-phase_6))
+ ((min-phase_5) (let-values (((min-phase_6) body-min-phase_1)) min-phase_6)))
+ (let-values (((ht_202) portal-syntaxes_5))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_202))
+ ((letrec-values (((for-loop_368)
+ (lambda (portal-stxes_5 max-phase_7 min-phase_7 i_256)
+ (begin
+ 'for-loop
+ (if i_256
+ (let-values (((phase_121 ht_203) (hash-iterate-key+value ht_202 i_256)))
+ (let-values (((portal-stxes_6 max-phase_8 min-phase_8)
+ (let-values (((portal-stxes_7 max-phase_9 min-phase_9)
+ (let-values (((new-portal-stxes_0)
+ (hash-set
+ portal-stxes_5
+ phase_121
+ (let-values (((table_265)
+ (let-values (((table_266)
+ '#hasheq()))
+ table_266)))
+ (let-values (((ht_204) ht_203))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-in-hash ht_154)))
- ((letrec-values (((for-loop_263)
- (lambda (table_212
- i_185)
+ (check-in-hash ht_204))
+ ((letrec-values (((for-loop_369)
+ (lambda (table_267
+ i_257)
(begin
'for-loop
- (if i_185
- (let-values (((sym_75
- stx_14)
+ (if i_257
+ (let-values (((sym_90
+ stx_18)
(hash-iterate-key+value
- ht_154
- i_185)))
- (let-values (((table_213)
- (let-values (((table_214)
- table_212))
- (let-values (((table_215)
- (let-values ()
- (let-values (((key_83
- val_66)
- (let-values ()
- (values
- sym_75
- (add-syntax-literal!
- syntax-literals_4
- stx_14)))))
- (hash-set
- table_214
- key_83
- val_66)))))
- (values
- table_215)))))
+ ht_204
+ i_257)))
+ (let-values (((table_268)
+ (let-values (((table_269)
+ (let-values (((key_90
+ val_71)
+ (values
+ sym_90
+ (add-syntax-literal!
+ syntax-literals_6
+ stx_18))))
+ (hash-set
+ table_267
+ key_90
+ val_71))))
+ (values
+ table_269))))
(if (not
#f)
- (for-loop_263
- table_213
+ (for-loop_369
+ table_268
(hash-iterate-next
- ht_154
- i_185))
- table_213)))
- table_212)))))
- for-loop_263)
- '#hasheq()
+ ht_204
+ i_257))
+ table_268)))
+ table_267)))))
+ for-loop_369)
+ table_265
(hash-iterate-first
- ht_154)))))))
- (if (integer? phase_103)
- (values
- new-portal-stxes_0
- (max (add1 phase_103) max-phase_7)
- (min (add1 phase_103) min-phase_7))
- (values
- new-portal-stxes_0
- max-phase_7
- min-phase_7))))))
- (values portal-stxes_6 max-phase_8 min-phase_8)))))
- (if (not #f)
- (for-loop_174
- portal-stxes_4
- max-phase_6
- min-phase_6
- (hash-iterate-next ht_107 i_184))
- (values portal-stxes_4 max-phase_6 min-phase_6))))
- (values portal-stxes_3 max-phase_5 min-phase_5))))))
- for-loop_174)
- '#hasheq()
- body-max-phase_1
- body-min-phase_1
- (hash-iterate-first ht_107)))))))
+ ht_204))))))))
+ (if (integer? phase_121)
+ (values
+ new-portal-stxes_0
+ (max (add1 phase_121) max-phase_7)
+ (min (add1 phase_121) min-phase_7))
+ (values
+ new-portal-stxes_0
+ max-phase_7
+ min-phase_7)))))
+ (values portal-stxes_7 max-phase_9 min-phase_9))))
+ (if (not #f)
+ (for-loop_368
+ portal-stxes_6
+ max-phase_8
+ min-phase_8
+ (hash-iterate-next ht_202 i_256))
+ (values portal-stxes_6 max-phase_8 min-phase_8))))
+ (values portal-stxes_5 max-phase_7 min-phase_7))))))
+ for-loop_368)
+ portal-stxes_3
+ max-phase_5
+ min-phase_5
+ (hash-iterate-first ht_202))))))))
(define-values
(filter-language-info)
(lambda (li_1)
@@ -43936,264 +43473,232 @@
#f))))
(define-values
(1/compiled-expression-recompile)
- (lambda (c_7)
+ (lambda (c_73)
(begin
'compiled-expression-recompile
(let-values ((()
(begin
- (if (1/compiled-expression? c_7)
+ (if (1/compiled-expression? c_73)
(void)
- (let-values ()
- (raise-argument-error 'compiled-expression-recompile "compiled-expression?" c_7)))
+ (raise-argument-error 'compiled-expression-recompile "compiled-expression?" c_73))
(values))))
(let-values (((target-machine_0) (current-compile-target-machine)))
(if (not target-machine_0)
- (let-values () c_7)
- (if (let-values (((or-part_2) (1/linklet-bundle? c_7))) (if or-part_2 or-part_2 (linklet-directory?$1 c_7)))
- (let-values ()
- (let-values (((ns_70) (1/current-namespace)))
- (let-values (((bundles_5) (extract-linklet-bundles c_7 '() '#hash())))
- (let-values (((recompileds_0) (make-hash)))
- (letrec-values (((force-recompile-bundle_0)
- (lambda (k_50)
+ c_73
+ (if (let-values (((or-part_443) (linklet-bundle?$1 c_73)))
+ (if or-part_443 or-part_443 (linklet-directory?$1 c_73)))
+ (let-values (((ns_79) (1/current-namespace)))
+ (let-values (((bundles_5) (extract-linklet-bundles c_73 '() '#hash())))
+ (let-values (((recompileds_0) (make-hash)))
+ (letrec-values (((force-recompile-bundle_0)
+ (lambda (k_53)
+ (begin
+ 'force-recompile-bundle
(begin
- 'force-recompile-bundle
- (begin
- (if (hash-ref recompileds_0 k_50 #f)
- (void)
- (let-values ()
- (let-values ((()
- (begin
- (hash-set! recompileds_0 k_50 'in-process)
- (values))))
- (let-values (((b_23) (hash-ref bundles_5 k_50 #f)))
- (begin
- (if b_23
- (void)
- (let-values ()
- (raise-arguments-error
- 'compiled-expression-recompile
- "cannot find submodule"
- "submodule path"
- k_50)))
- (hash-set!
- recompileds_0
- k_50
- (recompile-bundle
- b_23
- force-recompile-bundle_0
- ns_70
- target-machine_0)))))))
- (hash-ref recompileds_0 k_50))))))
- (begin
- (let-values (((ht_77) bundles_5))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash-keys ht_77)))
- ((letrec-values (((for-loop_171)
- (lambda (i_186)
- (begin
- 'for-loop
- (if i_186
- (let-values (((k_51) (hash-iterate-key ht_77 i_186)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (force-recompile-bundle_0
- k_51))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_171 (hash-iterate-next ht_77 i_186))
- (values))))
- (values))))))
- for-loop_171)
- (hash-iterate-first ht_77))))
- (void)
- (replace-linklet-bundles c_7 '() recompileds_0)))))))
- (let-values () (1/compiled-expression-recompile (compiled-in-memory-linklet-directory c_7))))))))))
+ (if (hash-ref recompileds_0 k_53 #f)
+ (void)
+ (let-values ((()
+ (begin (hash-set! recompileds_0 k_53 'in-process) (values))))
+ (let-values (((b_120) (hash-ref bundles_5 k_53 #f)))
+ (begin
+ (if b_120
+ (void)
+ (raise-arguments-error
+ 'compiled-expression-recompile
+ "cannot find submodule"
+ "submodule path"
+ k_53))
+ (hash-set!
+ recompileds_0
+ k_53
+ (recompile-bundle
+ b_120
+ force-recompile-bundle_0
+ ns_79
+ target-machine_0))))))
+ (hash-ref recompileds_0 k_53))))))
+ (begin
+ (let-values (((ht_205) bundles_5))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash-keys ht_205))
+ ((letrec-values (((for-loop_370)
+ (lambda (i_258)
+ (begin
+ 'for-loop
+ (if i_258
+ (let-values (((k_54) (hash-iterate-key ht_205 i_258)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (force-recompile-bundle_0 k_54)
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_370 (hash-iterate-next ht_205 i_258))
+ (values))))
+ (values))))))
+ for-loop_370)
+ (hash-iterate-first ht_205))))
+ (void)
+ (replace-linklet-bundles c_73 '() recompileds_0))))))
+ (1/compiled-expression-recompile (compiled-in-memory-linklet-directory c_73)))))))))
(define-values
(extract-linklet-bundles)
- (lambda (c_51 rev-path_0 accum_8)
+ (lambda (c_74 rev-path_0 accum_9)
(begin
- (if (1/linklet-bundle? c_51)
- (let-values () (hash-set accum_8 (reverse$1 rev-path_0) c_51))
- (if (linklet-directory?$1 c_51)
- (let-values ()
- (let-values (((ht_155) (linklet-directory->hash$1 c_51)))
+ (if (linklet-bundle?$1 c_74)
+ (hash-set accum_9 (reverse$1 rev-path_0) c_74)
+ (if (linklet-directory?$1 c_74)
+ (let-values (((accum_10) (let-values (((accum_11) accum_9)) accum_11)))
+ (let-values (((ht_206) (linklet-directory->hash$1 c_74)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_155)))
- ((letrec-values (((for-loop_55)
- (lambda (accum_9 i_174)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_206))
+ ((letrec-values (((for-loop_371)
+ (lambda (accum_12 i_259)
(begin
'for-loop
- (if i_174
- (let-values (((k_0 v_24) (hash-iterate-key+value ht_155 i_174)))
- (let-values (((accum_10)
- (let-values (((accum_11) accum_9))
- (let-values (((accum_2)
- (let-values ()
- (if (symbol? k_0)
- (let-values ()
- (extract-linklet-bundles
- v_24
- (cons k_0 rev-path_0)
- accum_11))
- (if (not k_0)
- (let-values ()
- (extract-linklet-bundles
- v_24
- rev-path_0
- accum_11))
- (let-values () accum_11))))))
- (values accum_2)))))
+ (if i_259
+ (let-values (((k_55 v_264) (hash-iterate-key+value ht_206 i_259)))
+ (let-values (((accum_13)
+ (let-values (((accum_14)
+ (if (symbol? k_55)
+ (extract-linklet-bundles
+ v_264
+ (cons k_55 rev-path_0)
+ accum_12)
+ (if (not k_55)
+ (extract-linklet-bundles
+ v_264
+ rev-path_0
+ accum_12)
+ accum_12))))
+ (values accum_14))))
(if (not #f)
- (for-loop_55 accum_10 (hash-iterate-next ht_155 i_174))
- accum_10)))
- accum_9)))))
- for-loop_55)
- accum_8
- (hash-iterate-first ht_155)))))
- (let-values () accum_8))))))
+ (for-loop_371 accum_13 (hash-iterate-next ht_206 i_259))
+ accum_13)))
+ accum_12)))))
+ for-loop_371)
+ accum_10
+ (hash-iterate-first ht_206)))))
+ accum_9)))))
(define-values
(replace-linklet-bundles)
- (lambda (c_60 rev-path_1 recompileds_1)
- (begin
- (if (1/linklet-bundle? c_60)
- (let-values () (recompiled-bundle (hash-ref recompileds_1 (reverse$1 rev-path_1))))
- (if (linklet-directory?$1 c_60)
- (let-values ()
- (1/hash->linklet-directory
- (let-values (((ht_72) (linklet-directory->hash$1 c_60)))
+ (lambda (c_75 rev-path_1 recompileds_1)
+ (begin
+ (if (linklet-bundle?$1 c_75)
+ (recompiled-bundle (hash-ref recompileds_1 (reverse$1 rev-path_1)))
+ (if (linklet-directory?$1 c_75)
+ (1/hash->linklet-directory
+ (let-values (((table_270) (let-values (((table_271) '#hasheq())) table_271)))
+ (let-values (((ht_207) (linklet-directory->hash$1 c_75)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_72)))
- ((letrec-values (((for-loop_87)
- (lambda (table_205 i_88)
- (begin
- 'for-loop
- (if i_88
- (let-values (((k_23 v_77) (hash-iterate-key+value ht_72 i_88)))
- (let-values (((table_216)
- (let-values (((table_217) table_205))
- (let-values (((table_200)
- (let-values ()
- (let-values (((key_84 val_67)
- (let-values ()
- (values
- k_23
- (if (symbol? k_23)
- (let-values ()
- (replace-linklet-bundles
- v_77
- (cons k_23 rev-path_1)
- recompileds_1))
- (if (not k_23)
- (let-values ()
- (replace-linklet-bundles
- v_77
- rev-path_1
- recompileds_1))
- (void)))))))
- (hash-set table_217 key_84 val_67)))))
- (values table_200)))))
- (if (not #f)
- (for-loop_87 table_216 (hash-iterate-next ht_72 i_88))
- table_216)))
- table_205)))))
- for-loop_87)
- '#hasheq()
- (hash-iterate-first ht_72))))))
- (let-values () c_60))))))
- (define-values
- (struct:recompiled recompiled1.1 recompiled? recompiled-bundle recompiled-phase-to-link-module-uses recompiled-self)
- (let-values (((struct:_12 make-_12 ?_12 -ref_12 -set!_12)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'recompiled
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'recompiled)))))
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_207))
+ ((letrec-values (((for-loop_372)
+ (lambda (table_272 i_260)
+ (begin
+ 'for-loop
+ (if i_260
+ (let-values (((k_56 v_265) (hash-iterate-key+value ht_207 i_260)))
+ (let-values (((table_273)
+ (let-values (((table_274)
+ (let-values (((key_91 val_72)
+ (values
+ k_56
+ (if (symbol? k_56)
+ (replace-linklet-bundles
+ v_265
+ (cons k_56 rev-path_1)
+ recompileds_1)
+ (if (not k_56)
+ (replace-linklet-bundles
+ v_265
+ rev-path_1
+ recompileds_1)
+ (void))))))
+ (hash-set table_272 key_91 val_72))))
+ (values table_274))))
+ (if (not #f)
+ (for-loop_372 table_273 (hash-iterate-next ht_207 i_260))
+ table_273)))
+ table_272)))))
+ for-loop_372)
+ table_270
+ (hash-iterate-first ht_207))))))
+ c_75)))))
+ (define-values
+ (struct:recompiled recompiled1.1 recompiled? recompiled-bundle recompiled-phase-to-link-module-uses recompiled-self)
+ (let-values (((struct:_114 make-_114 ?_114 -ref_114 -set!_114)
+ (make-struct-type
+ 'recompiled
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'recompiled)))
(values
- struct:_12
- make-_12
- ?_12
- (make-struct-field-accessor -ref_12 0 'bundle)
- (make-struct-field-accessor -ref_12 1 'phase-to-link-module-uses)
- (make-struct-field-accessor -ref_12 2 'self))))
+ struct:_114
+ make-_114
+ ?_114
+ (make-struct-field-accessor -ref_114 0 'bundle)
+ (make-struct-field-accessor -ref_114 1 'phase-to-link-module-uses)
+ (make-struct-field-accessor -ref_114 2 'self))))
(define-values
(recompile-bundle)
- (lambda (b_90 get-submodule-recompiled_0 ns_71 target-machine_1)
+ (lambda (b_121 get-submodule-recompiled_0 ns_80 target-machine_1)
(begin
- (let-values (((orig-h_0) (1/linklet-bundle->hash b_90)))
- (let-values (((h_13)
- (let-values (((ht_156) orig-h_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_156)))
- ((letrec-values (((for-loop_110)
- (lambda (table_88 i_47)
- (begin
- 'for-loop
- (if i_47
- (let-values (((k_52 v_93) (hash-iterate-key+value ht_156 i_47)))
- (let-values (((table_218)
- (let-values (((table_219) table_88))
- (let-values (((table_220)
- (let-values ()
- (let-values (((key_85 val_68)
- (let-values ()
- (if (if (not
- (exact-integer?
- k_52))
- (correlated-linklet?
- v_93)
- #f)
- (let-values ()
- (values
- k_52
- (force-compile-linklet
- v_93)))
- (let-values ()
- (values
- k_52
- v_93))))))
- (hash-set
- table_219
- key_85
- val_68)))))
- (values table_220)))))
- (if (not #f)
- (for-loop_110 table_218 (hash-iterate-next ht_156 i_47))
- table_218)))
- table_88)))))
- for-loop_110)
- '#hasheq()
- (hash-iterate-first ht_156))))))
+ (let-values (((orig-h_0) (linklet-bundle->hash$1 b_121)))
+ (let-values (((h_14)
+ (let-values (((table_275) (let-values (((table_276) '#hasheq())) table_276)))
+ (let-values (((ht_208) orig-h_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_208))
+ ((letrec-values (((for-loop_373)
+ (lambda (table_277 i_261)
+ (begin
+ 'for-loop
+ (if i_261
+ (let-values (((k_57 v_266) (hash-iterate-key+value ht_208 i_261)))
+ (let-values (((table_278)
+ (let-values (((table_279)
+ (let-values (((key_92 val_73)
+ (if (if (not
+ (exact-integer?
+ k_57))
+ (correlated-linklet?
+ v_266)
+ #f)
+ (values
+ k_57
+ (force-compile-linklet
+ v_266))
+ (values k_57 v_266))))
+ (hash-set
+ table_277
+ key_92
+ val_73))))
+ (values table_279))))
+ (if (not #f)
+ (for-loop_373 table_278 (hash-iterate-next ht_208 i_261))
+ table_278)))
+ table_277)))))
+ for-loop_373)
+ table_275
+ (hash-iterate-first ht_208)))))))
(let-values (((can-eval-compiled?_0) (eq? target-machine_1 (system-type 'target-machine))))
(let-values (((eval-metadata-linklet_0)
- (lambda (key_86)
+ (lambda (key_93)
(begin
'eval-metadata-linklet
(if can-eval-compiled?_0
- (eval-linklet$1 (hash-ref h_13 key_86))
- (eval-correlated-linklet (hash-ref orig-h_0 key_86)))))))
+ (eval-linklet$1 (hash-ref h_14 key_93))
+ (eval-correlated-linklet (hash-ref orig-h_0 key_93)))))))
(let-values (((data-instance_5)
(instantiate-linklet$1 (eval-metadata-linklet_0 'data) (list deserialize-instance))))
(let-values (((declaration-instance_4)
@@ -44201,497 +43706,808 @@
(eval-metadata-linklet_0 'decl)
(list deserialize-instance data-instance_5))))
(let-values (((decl_1)
- (lambda (key_10)
- (begin 'decl (1/instance-variable-value declaration-instance_4 key_10)))))
- (let-values (((mpis_22) (make-module-path-index-table)))
+ (lambda (key_94)
+ (begin 'decl (1/instance-variable-value declaration-instance_4 key_94)))))
+ (let-values (((mpis_24) (make-module-path-index-table)))
(let-values ((()
(begin
- (let-values (((vec_76 len_51)
- (let-values (((vec_77)
+ (let-values (((vec_89 len_62)
+ (let-values (((vec_90)
(1/instance-variable-value
data-instance_5
mpi-vector-id)))
(begin
- (check-vector vec_77)
- (values vec_77 (unsafe-vector-length vec_77))))))
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-vector vec_90))
+ (values vec_90 (unsafe-vector-length vec_90)))))
+ ((start_59) 0))
(begin
- #f
- ((letrec-values (((for-loop_264)
- (lambda (pos_125)
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-naturals start_59))
+ ((letrec-values (((for-loop_374)
+ (lambda (pos_156 pos_157)
(begin
'for-loop
- (if (unsafe-fx< pos_125 len_51)
- (let-values (((mpi_53)
- (unsafe-vector-ref vec_76 pos_125)))
+ (if (if (unsafe-fx< pos_156 len_62) #t #f)
+ (let-values (((mpi_74)
+ (unsafe-vector-ref vec_89 pos_156))
+ ((i_262) pos_157))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (add-module-path-index!
- mpis_22
- mpi_53))
- (values)))))
- (values)))))
+ (let-values ((()
+ (begin
+ (if (eqv?
+ (add-module-path-index!/pos
+ mpis_24
+ mpi_74)
+ i_262)
+ (void)
+ (raise-arguments-error
+ 'compiled-expression-recompile
+ "invalid or duplicate entry in MPI vector"
+ "entry"
+ mpi_74))
+ (values))))
+ (values))))
(if (not #f)
- (for-loop_264 (unsafe-fx+ 1 pos_125))
+ (for-loop_374
+ (unsafe-fx+ 1 pos_156)
+ (+ pos_157 1))
(values))))
(values))))))
- for-loop_264)
- 0)))
+ for-loop_374)
+ 0
+ start_59)))
(values))))
(let-values ()
- (let-values (((self_29) (decl_1 'self-mpi)))
+ (let-values (((self_34) (decl_1 'self-mpi)))
(let-values (((phase-to-link-modules_1) (decl_1 'phase-to-link-modules)))
- (let-values (((portal-stxes_7) (decl_1 'portal-stxes)))
+ (let-values (((portal-stxes_8) (decl_1 'portal-stxes)))
(let-values (((unsafe?_1) (hash-ref orig-h_0 'unsafe? #f)))
- (let-values (((realm_5) (hash-ref orig-h_0 'realm 'racket)))
- (let-values (((find-submodule_0)
- (lambda (mod-name_19 phase_27)
- (begin
- 'find-submodule
- (let-values (((find-l_0)
- (1/resolved-module-path-name mod-name_19)))
- (let-values (((self-l_0)
- (1/resolved-module-path-name
- (1/module-path-index-resolve self_29))))
- (let-values (((root-of_0)
- (lambda (l_53)
- (begin
- 'root-of
- (if (pair? l_53) (car l_53) l_53)))))
- (if (equal? (root-of_0 find-l_0) (root-of_0 self-l_0))
- (let-values ()
- (let-values (((r_40)
- (get-submodule-recompiled_0
- (if (pair? find-l_0)
- (cdr find-l_0)
- '()))))
- (let-values ((()
- (begin
- (if (eq? r_40 'in-process)
- (let-values ()
- (raise-arguments-error
- 'compiled-expression-recompile
- "cycle in linklet imports"))
- (void))
- (values))))
- (let-values (((b_91) (recompiled-bundle r_40)))
- (let-values (((linklet_11)
- (let-values (((or-part_79)
- (hash-ref
- (1/linklet-bundle->hash
- b_91)
- phase_27
- #f)))
- (if or-part_79
- or-part_79
+ (let-values (((module-prompt?_2) (hash-ref orig-h_0 'module-prompt? #t)))
+ (let-values (((unlimited-compile?_1) (hash-ref orig-h_0 'unlimited-compile? #f)))
+ (let-values (((realm_5) (hash-ref orig-h_0 'realm 'racket)))
+ (let-values (((find-submodule_0)
+ (lambda (mod-name_20 phase_122)
+ (begin
+ 'find-submodule
+ (let-values (((find-l_0)
+ (1/resolved-module-path-name mod-name_20)))
+ (let-values (((self-l_0)
+ (1/resolved-module-path-name
+ (1/module-path-index-resolve self_34))))
+ (let-values (((root-of_0)
+ (lambda (l_64)
+ (begin
+ 'root-of
+ (if (pair? l_64) (car l_64) l_64)))))
+ (if (equal? (root-of_0 find-l_0) (root-of_0 self-l_0))
+ (let-values (((submod_2)
+ (if (pair? find-l_0)
+ (cdr find-l_0)
+ '())))
+ (let-values (((r_46)
+ (get-submodule-recompiled_0
+ submod_2)))
+ (let-values ((()
+ (begin
+ (if (eq? r_46 'in-process)
(raise-arguments-error
'compiled-expression-recompile
- "cannot find submodule at phase"
- "submodule"
- mod-name_19
- "phase"
- phase_27)))))
- (module-linklet-info2.1
- linklet_11
- (hash-ref
- (recompiled-phase-to-link-module-uses r_40)
- phase_27
- #f)
- (recompiled-self r_40)
- #f
- (current-code-inspector)
- #f))))))
- (let-values () #f)))))))))
- (let-values (((body-linklets+module-use*s_1)
- (let-values (((ht_157) h_13))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_157)))
- ((letrec-values (((for-loop_220)
- (lambda (table_221 i_66)
- (begin
- 'for-loop
- (if i_66
- (let-values (((phase_104 body-linklet_2)
- (hash-iterate-key+value
- ht_157
- i_66)))
- (let-values (((table_222)
- (let-values (((table_152)
- table_221))
- (if (exact-integer?
- phase_104)
- (let-values (((table_223)
- table_152))
- (let-values (((table_224)
- (let-values ()
- (let-values (((key_87
- val_69)
- (let-values ()
- (let-values (((module-use*s_2)
- (module-uses-add-extra-inspectorsss
- (hash-ref
- phase-to-link-modules_1
- phase_104)
- #f)))
- (let-values (((linklet_12
- new-module-use*s_2)
- (let-values (((temp3_2)
- (if (correlated-linklet?
- body-linklet_2)
- (correlated-linklet-expr
+ "cycle in linklet imports")
+ (void))
+ (values))))
+ (let-values (((b_122) (recompiled-bundle r_46)))
+ (let-values (((linklet_11)
+ (let-values (((or-part_444)
+ (hash-ref
+ (linklet-bundle->hash$1
+ b_122)
+ phase_122
+ #f)))
+ (if or-part_444
+ or-part_444
+ (raise-arguments-error
+ 'compiled-expression-recompile
+ "cannot find (sub)module at phase"
+ "module"
+ (unquoted-printing-string
+ (format "~a" mod-name_20))
+ "phase"
+ phase_122)))))
+ (module-linklet-info2.1
+ linklet_11
+ (hash-ref
+ (recompiled-phase-to-link-module-uses
+ r_46)
+ phase_122
+ #f)
+ (recompiled-self r_46)
+ #f
+ (current-code-inspector)
+ #f))))))
+ #f))))))))
+ (let-values (((body-linklets+module-use*s_1)
+ (let-values (((table_280)
+ (let-values (((table_281) '#hash())) table_281)))
+ (let-values (((ht_209) h_14))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash ht_209))
+ ((letrec-values (((for-loop_375)
+ (lambda (table_282 i_263)
+ (begin
+ 'for-loop
+ (if i_263
+ (let-values (((phase_123
+ body-linklet_2)
+ (hash-iterate-key+value
+ ht_209
+ i_263)))
+ (let-values (((table_283)
+ (if (exact-integer?
+ phase_123)
+ (let-values (((table_284)
+ (let-values (((key_95
+ val_74)
+ (let-values (((module-use*s_2)
+ (module-uses-add-extra-inspectorsss
+ (hash-ref
+ phase-to-link-modules_1
+ phase_123)
+ #f)))
+ (let-values (((linklet_12
+ new-module-use*s_2)
+ (let-values (((temp3_2)
+ (if (correlated-linklet?
body-linklet_2)
- body-linklet_2))
- ((temp4_1)
- (if (correlated-linklet?
- body-linklet_2)
- 1/compile-linklet
- recompile-linklet$1))
- ((temp5_4)
- (list
- (list
- get-syntax-literal!-id)
- (list
- set-transformer!-id)))
- ((temp6_1)
- (list
- empty-syntax-literals-instance
- empty-module-body-instance))
- ((find-submodule7_0)
- find-submodule_0)
- ((temp8_6)
- #t)
- ((temp9_4)
- #t)
- ((module-use*s10_0)
- module-use*s_2)
- ((temp11_4)
- #t)
- ((unsafe?12_0)
- unsafe?_1)
- ((temp13_5)
- #t)
- ((ns14_2)
- ns_71)
- ((realm15_0)
- realm_5))
- (compile-module-linklet.1
- temp6_1
- temp5_4
- temp4_1
- find-submodule7_0
- temp13_5
- temp9_4
- module-use*s10_0
- ns14_2
- temp11_4
- realm15_0
- temp8_6
- unsafe?12_0
- temp3_2))))
- (values
- phase_104
- (cons
- linklet_12
- new-module-use*s_2)))))))
+ (correlated-linklet-expr
+ body-linklet_2)
+ body-linklet_2))
+ ((temp4_1)
+ (if (correlated-linklet?
+ body-linklet_2)
+ 1/compile-linklet
+ recompile-linklet$1))
+ ((temp5_4)
+ (hasheq
+ 'phase
+ phase_123))
+ ((temp6_1)
+ (list
+ (list
+ get-syntax-literal!-id)
+ (list
+ set-transformer!-id)))
+ ((temp7_7)
+ (list
+ empty-syntax-literals-instance
+ empty-module-body-instance))
+ ((find-submodule8_0)
+ find-submodule_0)
+ ((temp9_4)
+ #t)
+ ((module-prompt?10_0)
+ module-prompt?_2)
+ ((unlimited-compile?11_0)
+ unlimited-compile?_1)
+ ((module-use*s12_0)
+ module-use*s_2)
+ ((temp13_6)
+ #t)
+ ((unsafe?14_0)
+ unsafe?_1)
+ ((temp15_6)
+ #t)
+ ((ns16_1)
+ ns_80)
+ ((realm17_0)
+ realm_5))
+ (compile-module-linklet.1
+ temp7_7
+ temp6_1
+ temp5_4
+ temp4_1
+ find-submodule8_0
+ temp15_6
+ module-prompt?10_0
+ module-use*s12_0
+ ns16_1
+ temp13_6
+ realm17_0
+ temp9_4
+ unlimited-compile?11_0
+ unsafe?14_0
+ temp3_2))))
+ (values
+ phase_123
+ (cons
+ linklet_12
+ new-module-use*s_2))))))
(hash-set
- table_223
- key_87
- val_69)))))
- (values
- table_224)))
- table_152))))
- (if (not #f)
- (for-loop_220
- table_222
- (hash-iterate-next ht_157 i_66))
- table_222)))
- table_221)))))
- for-loop_220)
- '#hash()
- (hash-iterate-first ht_157))))))
- (let-values (((h/new-body-linklets_0)
- (let-values (((ht_158) body-linklets+module-use*s_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_158)))
- ((letrec-values (((for-loop_265)
- (lambda (h_14 i_187)
- (begin
- 'for-loop
- (if i_187
- (let-values (((phase_105 l+mu*s_3)
- (hash-iterate-key+value
- ht_158
- i_187)))
- (let-values (((h_15)
- (let-values (((h_16)
- h_14))
- (let-values (((h_17)
- (let-values ()
- (hash-set
- h_16
- phase_105
- (car
- l+mu*s_3)))))
- (values h_17)))))
- (if (not #f)
- (for-loop_265
- h_15
- (hash-iterate-next
- ht_158
- i_187))
- h_15)))
- h_14)))))
- for-loop_265)
- h_13
- (hash-iterate-first ht_158))))))
- (let-values (((phase-to-link-module-uses_6)
- (let-values (((ht_159) body-linklets+module-use*s_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_159)))
- ((letrec-values (((for-loop_134)
- (lambda (table_21 i_188)
- (begin
- 'for-loop
- (if i_188
- (let-values (((phase_106 l+mu*s_4)
- (hash-iterate-key+value
- ht_159
- i_188)))
- (let-values (((table_225)
- (let-values (((table_102)
- table_21))
- (let-values (((table_103)
- (let-values ()
- (let-values (((key_88
- val_70)
- (let-values ()
+ table_282
+ key_95
+ val_74))))
+ (values
+ table_284))
+ table_282)))
+ (if (not #f)
+ (for-loop_375
+ table_283
+ (hash-iterate-next
+ ht_209
+ i_263))
+ table_283)))
+ table_282)))))
+ for-loop_375)
+ table_280
+ (hash-iterate-first ht_209)))))))
+ (let-values (((h/new-body-linklets_0)
+ (let-values (((h_15) (let-values (((h_16) h_14)) h_16)))
+ (let-values (((ht_210) body-linklets+module-use*s_1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash ht_210))
+ ((letrec-values (((for-loop_376)
+ (lambda (h_17 i_264)
+ (begin
+ 'for-loop
+ (if i_264
+ (let-values (((phase_124
+ l+mu*s_3)
+ (hash-iterate-key+value
+ ht_210
+ i_264)))
+ (let-values (((h_18)
+ (let-values (((h_19)
+ (hash-set
+ h_17
+ phase_124
+ (car
+ l+mu*s_3))))
+ (values
+ h_19))))
+ (if (not #f)
+ (for-loop_376
+ h_18
+ (hash-iterate-next
+ ht_210
+ i_264))
+ h_18)))
+ h_17)))))
+ for-loop_376)
+ h_15
+ (hash-iterate-first ht_210)))))))
+ (let-values (((phase-to-link-module-uses_6)
+ (let-values (((table_285)
+ (let-values (((table_286) '#hasheq()))
+ table_286)))
+ (let-values (((ht_211) body-linklets+module-use*s_1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash ht_211))
+ ((letrec-values (((for-loop_377)
+ (lambda (table_287 i_265)
+ (begin
+ 'for-loop
+ (if i_265
+ (let-values (((phase_125
+ l+mu*s_4)
+ (hash-iterate-key+value
+ ht_211
+ i_265)))
+ (let-values (((table_288)
+ (let-values (((table_289)
+ (let-values (((key_96
+ val_75)
(values
- phase_106
+ phase_125
(module-uses-strip-extra-inspectorsss
(cdr
- l+mu*s_4))))))
- (hash-set
- table_102
- key_88
- val_70)))))
- (values
- table_103)))))
- (if (not #f)
- (for-loop_134
- table_225
- (hash-iterate-next
- ht_159
- i_188))
- table_225)))
- table_21)))))
- for-loop_134)
- '#hasheq()
- (hash-iterate-first ht_159))))))
- (let-values (((phase-to-link-module-uses-expr_5)
- (serialize-phase-to-link-module-uses
- phase-to-link-module-uses_6
- mpis_22)))
- (let-values (((data-linklet_1)
- (1/compile-linklet
- (generate-module-data-linklet mpis_22)
- 'data)))
- (let-values (((declaration-linklet_1)
- (1/compile-linklet
- (generate-module-declaration-linklet
- mpis_22
- self_29
- (decl_1 'requires)
- (decl_1 'provides)
- phase-to-link-module-uses-expr_5
- portal-stxes_7)
- 'decl)))
- (let-values (((new-bundle_0)
- (1/hash->linklet-bundle
- (let-values (((h_18) h/new-body-linklets_0))
- (let-values (((h_19)
- (hash-set h_18 'data data-linklet_1)))
- (let-values (((h_20)
- (hash-set
- h_19
- 'decl
- declaration-linklet_1)))
- h_20))))))
- (recompiled1.1
- new-bundle_0
- phase-to-link-module-uses_6
- self_29)))))))))))))))))))))))))))
+ l+mu*s_4)))))
+ (hash-set
+ table_287
+ key_96
+ val_75))))
+ (values
+ table_289))))
+ (if (not #f)
+ (for-loop_377
+ table_288
+ (hash-iterate-next
+ ht_211
+ i_265))
+ table_288)))
+ table_287)))))
+ for-loop_377)
+ table_285
+ (hash-iterate-first ht_211)))))))
+ (let-values (((phase-to-link-module-uses-expr_5)
+ (serialize-phase-to-link-module-uses
+ phase-to-link-module-uses_6
+ mpis_24)))
+ (let-values (((data-linklet_1)
+ (1/compile-linklet
+ (generate-module-data-linklet mpis_24)
+ 'data)))
+ (let-values (((declaration-linklet_1)
+ (1/compile-linklet
+ (generate-module-declaration-linklet
+ mpis_24
+ self_34
+ (decl_1 'requires)
+ (decl_1 'recur-requires)
+ (decl_1 'flattened-requires)
+ (decl_1 'provides)
+ phase-to-link-module-uses-expr_5
+ portal-stxes_8)
+ 'decl)))
+ (let-values (((new-bundle_0)
+ (1/hash->linklet-bundle
+ (let-values (((h_20) h/new-body-linklets_0))
+ (let-values (((h_21)
+ (hash-set
+ h_20
+ 'data
+ data-linklet_1)))
+ (let-values (((h_22)
+ (hash-set
+ h_21
+ 'decl
+ declaration-linklet_1)))
+ h_22))))))
+ (recompiled1.1
+ new-bundle_0
+ phase-to-link-module-uses_6
+ self_34)))))))))))))))))))))))))))))
+ (define-values
+ (1/compiled-expression-add-target-machine)
+ (lambda (c_76 from-c_0)
+ (begin
+ 'compiled-expression-add-target-machine
+ (let-values (((who_26) 'compiled-expression-add-target-machine))
+ (let-values ((()
+ (begin
+ (if (1/compiled-expression? c_76)
+ (void)
+ (raise-argument-error who_26 "compiled-expression?" c_76))
+ (values))))
+ (let-values (((from-hash?_0) (hash? from-c_0)))
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_445) from-hash?_0))
+ (if or-part_445 or-part_445 (1/compiled-expression? from-c_0)))
+ (void)
+ (raise-argument-error who_26 "(or/c compiled-expression? hash?)" from-c_0))
+ (values))))
+ (let-values (((looks-wrong_0)
+ (lambda ()
+ (begin
+ 'looks-wrong
+ (raise-arguments-error
+ who_26
+ (string-append
+ "compiled expressions are not compatible;\n"
+ " they appear to be from compiling different modules"))))))
+ (let-values (((get-linklet_0)
+ (lambda (c_77)
+ (begin
+ 'get-linklet
+ (if (let-values (((or-part_446) (linklet-bundle?$1 c_77)))
+ (if or-part_446 or-part_446 (linklet-directory?$1 c_77)))
+ c_77
+ (compiled-in-memory-linklet-directory c_77))))))
+ (let-values (((c_78) (get-linklet_0 c_76))
+ ((from-c_1) (if from-hash?_0 from-c_0 (get-linklet_0 from-c_0))))
+ (let-values (((bundles_6) (extract-linklet-bundles c_78 '() '#hash())))
+ (let-values (((from-bundles_0)
+ (if from-hash?_0 from-c_1 (extract-linklet-bundles from-c_1 '() '#hash()))))
+ (let-values ((()
+ (begin
+ (if (= (hash-count bundles_6) (hash-count from-bundles_0))
+ (void)
+ (looks-wrong_0))
+ (values))))
+ (let-values (((new-bundles_0)
+ (let-values (((table_290) (let-values (((table_291) '#hash())) table_291)))
+ (let-values (((ht_212) bundles_6))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash-keys ht_212))
+ ((letrec-values (((for-loop_378)
+ (lambda (table_292 i_266)
+ (begin
+ 'for-loop
+ (if i_266
+ (let-values (((k_58)
+ (hash-iterate-key ht_212 i_266)))
+ (let-values (((table_293)
+ (let-values (((table_294)
+ (let-values (((key_97
+ val_76)
+ (let-values (((b_123)
+ (hash-ref
+ bundles_6
+ k_58)))
+ (let-values (((from-b_0)
+ (hash-ref
+ from-bundles_0
+ k_58
+ #f)))
+ (let-values ((()
+ (begin
+ (if from-b_0
+ (void)
+ (looks-wrong_0))
+ (values))))
+ (let-values (((h_23)
+ (linklet-bundle->hash$1
+ b_123)))
+ (let-values (((from-h_0)
+ (if from-hash?_0
+ (begin
+ (if (hash?
+ from-b_0)
+ (void)
+ (looks-wrong_0))
+ from-b_0)
+ (linklet-bundle->hash$1
+ from-b_0))))
+ (let-values (((new-b_0)
+ (1/hash->linklet-bundle
+ (let-values (((h_24)
+ (let-values (((h_25)
+ h_23))
+ h_25)))
+ (let-values (((ht_213)
+ h_23))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash
+ ht_213))
+ ((letrec-values (((for-loop_379)
+ (lambda (h_26
+ i_267)
+ (begin
+ 'for-loop
+ (if i_267
+ (let-values (((phase_126
+ body-linklet_3)
+ (hash-iterate-key+value
+ ht_213
+ i_267)))
+ (let-values (((h_27)
+ (if (exact-integer?
+ phase_126)
+ (let-values (((h_28)
+ (let-values (((from-body-linklet_0)
+ (hash-ref
+ from-h_0
+ phase_126
+ #f)))
+ (begin
+ (if from-body-linklet_0
+ (void)
+ (looks-wrong_0))
+ (hash-set
+ h_26
+ phase_126
+ (1/linklet-add-target-machine-info
+ body-linklet_3
+ from-body-linklet_0))))))
+ (values
+ h_28))
+ h_26)))
+ (if (not
+ #f)
+ (for-loop_379
+ h_27
+ (hash-iterate-next
+ ht_213
+ i_267))
+ h_27)))
+ h_26)))))
+ for-loop_379)
+ h_24
+ (hash-iterate-first
+ ht_213))))))))
+ (values
+ k_58
+ (recompiled1.1
+ new-b_0
+ #f
+ #f))))))))))
+ (hash-set
+ table_292
+ key_97
+ val_76))))
+ (values table_294))))
+ (if (not #f)
+ (for-loop_378
+ table_293
+ (hash-iterate-next ht_212 i_266))
+ table_293)))
+ table_292)))))
+ for-loop_378)
+ table_290
+ (hash-iterate-first ht_212)))))))
+ (replace-linklet-bundles c_78 '() new-bundles_0)))))))))))))))
+ (define-values
+ (1/compiled-expression-summarize-target-machine)
+ (lambda (from-c_2)
+ (begin
+ 'compiled-expression-summarize-target-machine
+ (let-values ((()
+ (begin
+ (if (1/compiled-expression? from-c_2)
+ (void)
+ (raise-argument-error 'compiled-expression-recompile "compiled-expression?" from-c_2))
+ (values))))
+ (let-values (((get-linklet_1)
+ (lambda (c_79)
+ (begin
+ 'get-linklet
+ (if (let-values (((or-part_447) (linklet-bundle?$1 c_79)))
+ (if or-part_447 or-part_447 (linklet-directory?$1 c_79)))
+ c_79
+ (compiled-in-memory-linklet-directory c_79))))))
+ (let-values (((from-c_3) (get-linklet_1 from-c_2)))
+ (let-values (((from-bundles_1) (extract-linklet-bundles from-c_3 '() '#hash())))
+ (let-values (((table_295) (let-values (((table_296) '#hash())) table_296)))
+ (let-values (((ht_214) from-bundles_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_214))
+ ((letrec-values (((for-loop_380)
+ (lambda (table_297 i_268)
+ (begin
+ 'for-loop
+ (if i_268
+ (let-values (((k_59 from-b_1) (hash-iterate-key+value ht_214 i_268)))
+ (let-values (((table_298)
+ (let-values (((table_299)
+ (let-values (((key_98 val_77)
+ (let-values (((from-h_1)
+ (linklet-bundle->hash$1
+ from-b_1)))
+ (let-values (((new-h_0)
+ (let-values (((table_300)
+ (let-values (((table_301)
+ '#hash()))
+ table_301)))
+ (let-values (((ht_215)
+ from-h_1))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash
+ ht_215))
+ ((letrec-values (((for-loop_381)
+ (lambda (table_302
+ i_269)
+ (begin
+ 'for-loop
+ (if i_269
+ (let-values (((phase_127
+ from-body-linklet_1)
+ (hash-iterate-key+value
+ ht_215
+ i_269)))
+ (let-values (((table_303)
+ (if (exact-integer?
+ phase_127)
+ (let-values (((table_304)
+ (let-values (((key_99
+ val_78)
+ (values
+ phase_127
+ (1/linklet-summarize-target-machine-info
+ from-body-linklet_1))))
+ (hash-set
+ table_302
+ key_99
+ val_78))))
+ (values
+ table_304))
+ table_302)))
+ (if (not
+ #f)
+ (for-loop_381
+ table_303
+ (hash-iterate-next
+ ht_215
+ i_269))
+ table_303)))
+ table_302)))))
+ for-loop_381)
+ table_300
+ (hash-iterate-first
+ ht_215)))))))
+ (values k_59 new-h_0)))))
+ (hash-set table_297 key_98 val_77))))
+ (values table_299))))
+ (if (not #f)
+ (for-loop_380 table_298 (hash-iterate-next ht_214 i_268))
+ table_298)))
+ table_297)))))
+ for-loop_380)
+ table_295
+ (hash-iterate-first ht_214))))))))))))
(define-values
(create-compiled-in-memorys-using-shared-data)
- (lambda (tops_0 data-linklet_2 ns_64)
+ (lambda (tops_0 data-linklet_2 ns_81)
(begin
(let-values (((data-instance_6)
(instantiate-linklet$1
(force-compile-linklet data-linklet_2)
(list
deserialize-instance
- (let-values (((ns1_1) ns_64)
- ((temp2_3) (namespace-phase ns_64))
- ((temp3_3) (namespace-mpi ns_64))
- ((temp4_2) (namespace-bulk-binding-registry ns_64))
+ (let-values (((ns1_1) ns_81)
+ ((temp2_3) (namespace-phase ns_81))
+ ((temp3_3) (namespace-mpi ns_81))
+ ((temp4_2) (namespace-bulk-binding-registry ns_81))
((temp5_5) (current-code-inspector)))
(make-eager-instance-instance.1 temp4_2 temp2_3 temp5_5 ns1_1 temp3_3))))))
- (let-values (((data_1) (lambda (key_26) (begin 'data (1/instance-variable-value data-instance_6 key_26)))))
+ (let-values (((data_1) (lambda (key_100) (begin 'data (1/instance-variable-value data-instance_6 key_100)))))
(let-values (((mpi-vector_0) (data_1 mpi-vector-id)))
(let-values (((mpi-vector-trees_0) (data_1 'mpi-vector-trees)))
(let-values (((phase-to-link-modules-vector_0) (data_1 'phase-to-link-modules-vector)))
(let-values (((phase-to-link-modules-trees_0) (data_1 'phase-to-link-modules-trees)))
- (let-values (((syntax-literals_5) (data_1 'syntax-literals)))
+ (let-values (((syntax-literals_7) (data_1 'syntax-literals)))
(let-values (((syntax-literals-trees_1) (data_1 'syntax-literals-trees)))
- (let-values (((namespace-scopes_0) (extract-namespace-scopes ns_64)))
+ (let-values (((namespace-scopes_0) (extract-namespace-scopes ns_81)))
(letrec-values (((construct-compiled-in-memory_0)
- (lambda (ld_11
+ (lambda (ld_12
mpi-vector-tree_0
phase-to-link-modules-tree_0
syntax-literals-tree_0)
(begin
'construct-compiled-in-memory
(let-values (((is-module?_0)
- (let-values (((or-part_6) (1/linklet-bundle? ld_11)))
- (if or-part_6
- or-part_6
- (let-values (((b_92)
+ (let-values (((or-part_448) (linklet-bundle?$1 ld_12)))
+ (if or-part_448
+ or-part_448
+ (let-values (((b_124)
(hash-ref
- (linklet-directory->hash$1 ld_11)
+ (linklet-directory->hash$1 ld_12)
#f
#f)))
- (if b_92
- (hash-ref (1/linklet-bundle->hash b_92) 'decl #f)
+ (if b_124
+ (hash-ref (linklet-bundle->hash$1 b_124) 'decl #f)
#f))))))
(let-values (((mpi-pos-vec_0) (vector-ref mpi-vector-tree_0 0)))
(let-values (((syntax-literals-spec_0)
(vector-ref syntax-literals-tree_0 0)))
(let-values (((pres_0)
(if is-module?_0
- (extract-submodules ld_11 'pre)
- (compiled-top->compiled-tops ld_11))))
+ (extract-submodules ld_12 'pre)
+ (compiled-top->compiled-tops ld_12))))
(let-values (((posts_0)
(if is-module?_0
- (extract-submodules ld_11 'post)
+ (extract-submodules ld_12 'post)
null)))
(let-values (((map-construct-compiled-in-memory_0)
- (lambda (l_54 vec-pos_0)
+ (lambda (l_65 vec-pos_0)
(begin
'map-construct-compiled-in-memory
(reverse$1
- (let-values (((lst_170) l_54)
- ((lst_93)
- (vector-ref
- mpi-vector-tree_0
- vec-pos_0))
- ((lst_194)
- (vector-ref
- phase-to-link-modules-tree_0
- vec-pos_0))
- ((lst_65)
- (vector-ref
- syntax-literals-tree_0
- vec-pos_0)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_170)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_93)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_194)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_65)))
- ((letrec-values (((for-loop_22)
- (lambda (fold-var_130
- lst_282
- lst_182
- lst_284
- lst_27)
- (begin
- 'for-loop
- (if (if (pair?
- lst_282)
- (if (pair?
- lst_182)
+ (let-values (((fold-var_460)
+ (let-values (((fold-var_461)
+ null))
+ fold-var_461)))
+ (let-values (((lst_442) l_65)
+ ((lst_443)
+ (vector-ref
+ mpi-vector-tree_0
+ vec-pos_0))
+ ((lst_444)
+ (vector-ref
+ phase-to-link-modules-tree_0
+ vec-pos_0))
+ ((lst_445)
+ (vector-ref
+ syntax-literals-tree_0
+ vec-pos_0)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_442))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_443))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_444))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_445))
+ ((letrec-values (((for-loop_382)
+ (lambda (fold-var_462
+ lst_446
+ lst_447
+ lst_448
+ lst_449)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_446)
(if (pair?
- lst_284)
- (pair?
- lst_27)
+ lst_447)
+ (if (pair?
+ lst_448)
+ (pair?
+ lst_449)
+ #f)
#f)
#f)
- #f)
- (let-values (((sub-ld_0)
- (unsafe-car
- lst_282))
- ((rest_147)
- (unsafe-cdr
- lst_282))
- ((mpi-vector-tree_1)
- (unsafe-car
- lst_182))
- ((rest_155)
- (unsafe-cdr
- lst_182))
- ((phase-to-link-modules-tree_1)
- (unsafe-car
- lst_284))
- ((rest_156)
- (unsafe-cdr
- lst_284))
- ((syntax-literals-tree_1)
- (unsafe-car
- lst_27))
- ((rest_9)
- (unsafe-cdr
- lst_27)))
- (let-values (((fold-var_8)
- (let-values (((fold-var_9)
- fold-var_130))
- (let-values (((fold-var_10)
- (let-values ()
- (cons
- (let-values ()
- (construct-compiled-in-memory_0
- sub-ld_0
- mpi-vector-tree_1
- phase-to-link-modules-tree_1
- syntax-literals-tree_1))
- fold-var_9))))
+ (let-values (((sub-ld_0)
+ (unsafe-car
+ lst_446))
+ ((rest_217)
+ (unsafe-cdr
+ lst_446))
+ ((mpi-vector-tree_1)
+ (unsafe-car
+ lst_447))
+ ((rest_218)
+ (unsafe-cdr
+ lst_447))
+ ((phase-to-link-modules-tree_1)
+ (unsafe-car
+ lst_448))
+ ((rest_219)
+ (unsafe-cdr
+ lst_448))
+ ((syntax-literals-tree_1)
+ (unsafe-car
+ lst_449))
+ ((rest_220)
+ (unsafe-cdr
+ lst_449)))
+ (let-values (((fold-var_463)
+ (let-values (((fold-var_464)
+ (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_462)))
(values
- fold-var_10)))))
- (if (not #f)
- (for-loop_22
- fold-var_8
- rest_147
- rest_155
- rest_156
- rest_9)
- fold-var_8)))
- fold-var_130)))))
- for-loop_22)
- null
- lst_170
- lst_93
- lst_194
- lst_65))))))))
+ fold-var_464))))
+ (if (not #f)
+ (for-loop_382
+ fold-var_463
+ rest_217
+ rest_218
+ rest_219
+ rest_220)
+ fold-var_463)))
+ fold-var_462)))))
+ for-loop_382)
+ fold-var_460
+ lst_442
+ lst_443
+ lst_444
+ lst_445)))))))))
(compiled-in-memory1.1
- ld_11
+ ld_12
+ #f
+ #f
#f
#f
#f
@@ -44701,152 +44517,144 @@
#f
'#hasheqv()
'#hasheqv()
- (let-values (((len_56) (vector-length mpi-pos-vec_0)))
+ (let-values (((len_63) (vector-length mpi-pos-vec_0)))
(begin
- (if (exact-nonnegative-integer? len_56)
+ (if (exact-nonnegative-integer? len_63)
(void)
- (let-values ()
- (raise-argument-error
- 'for/vector
- "exact-nonnegative-integer?"
- len_56)))
- (let-values (((v_197) (make-vector len_56 0)))
+ (1/raise-argument-error
+ 'for/vector
+ "exact-nonnegative-integer?"
+ len_63))
+ (let-values (((v_267) (make-vector len_63 0)))
(begin
- (if (zero? len_56)
+ (if (zero? len_63)
(void)
- (let-values ()
- (let-values (((vec_78 len_57)
- (let-values (((vec_79)
+ (let-values (((i_270)
+ (let-values (((i_271) 0)) i_271)))
+ (let-values (((vec_91 len_64)
+ (let-values (((vec_92)
mpi-pos-vec_0))
(begin
- (check-vector vec_79)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-vector vec_92))
(values
- vec_79
+ vec_92
(unsafe-vector-length
- vec_79))))))
- (begin
- #f
- ((letrec-values (((for-loop_109)
- (lambda (i_189 pos_126)
- (begin
- 'for-loop
- (if (unsafe-fx<
- pos_126
- len_57)
- (let-values (((pos_127)
- (unsafe-vector-ref
- vec_78
- pos_126)))
- (let-values (((i_190)
- (let-values (((i_191)
- i_189))
- (let-values (((i_115)
- (let-values ()
- (begin
- (unsafe-vector*-set!
- v_197
- i_191
- (let-values ()
- (vector-ref
- mpi-vector_0
- pos_127)))
- (unsafe-fx+
- 1
- i_191)))))
- (values
- i_115)))))
- (if (if (not
- ((lambda x_82
- (unsafe-fx=
- i_190
- len_56))
- pos_127))
- (not #f)
- #f)
- (for-loop_109
- i_190
- (unsafe-fx+
- 1
- pos_126))
- i_190)))
- i_189)))))
- for-loop_109)
- 0
- 0)))))
- v_197))))
- (let-values (((len_58) (cdr syntax-literals-spec_0)))
+ vec_92))))))
+ ((letrec-values (((for-loop_383)
+ (lambda (i_272 pos_158)
+ (begin
+ 'for-loop
+ (if (unsafe-fx<
+ pos_158
+ len_64)
+ (let-values (((pos_159)
+ (unsafe-vector-ref
+ vec_91
+ pos_158)))
+ (let-values (((i_273)
+ (let-values (((i_274)
+ (begin
+ (unsafe-vector*-set!
+ v_267
+ i_272
+ (vector-ref
+ mpi-vector_0
+ pos_159))
+ (unsafe-fx+
+ 1
+ i_272))))
+ (values
+ i_274))))
+ (if (if (not
+ ((lambda x_89
+ (unsafe-fx=
+ i_273
+ len_63))
+ pos_159))
+ (not #f)
+ #f)
+ (for-loop_383
+ i_273
+ (unsafe-fx+
+ 1
+ pos_158))
+ i_273)))
+ i_272)))))
+ for-loop_383)
+ i_270
+ 0))))
+ v_267))))
+ (let-values (((len_65) (cdr syntax-literals-spec_0)))
(begin
- (if (exact-nonnegative-integer? len_58)
+ (if (exact-nonnegative-integer? len_65)
(void)
- (let-values ()
- (raise-argument-error
- 'for/vector
- "exact-nonnegative-integer?"
- len_58)))
- (let-values (((v_36) (make-vector len_58 0)))
+ (1/raise-argument-error
+ 'for/vector
+ "exact-nonnegative-integer?"
+ len_65))
+ (let-values (((v_268) (make-vector len_65 0)))
(begin
- (if (zero? len_58)
+ (if (zero? len_65)
(void)
- (let-values ()
- (let-values (((start_18) 0)
- ((end_36)
+ (let-values (((i_275)
+ (let-values (((i_276) 0)) i_276)))
+ (let-values (((start_60) 0)
+ ((end_39)
(cdr syntax-literals-spec_0))
- ((inc_30) 1))
+ ((inc_33) 1))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-range start_18 end_36 inc_30)))
- ((letrec-values (((for-loop_266)
- (lambda (i_48 pos_110)
+ (check-range start_60 end_39 inc_33))
+ ((letrec-values (((for-loop_384)
+ (lambda (i_277 pos_160)
(begin
'for-loop
- (if (< pos_110 end_36)
- (let-values (((i_192)
- pos_110))
- (let-values (((i_193)
- (let-values (((i_94)
- i_48))
- (let-values (((i_20)
- (let-values ()
- (begin
- (unsafe-vector*-set!
- v_36
- i_94
- (let-values ()
- (if syntax-literals_5
- (vector-ref
- syntax-literals_5
- (+
- (car
- syntax-literals-spec_0)
- i_192))
- #f)))
- (unsafe-fx+
- 1
- i_94)))))
- (values
- i_20)))))
+ (if (< pos_160 end_39)
+ (let-values (((i_278)
+ pos_160))
+ (let-values (((i_279)
+ (let-values (((i_280)
+ (begin
+ (unsafe-vector*-set!
+ v_268
+ i_277
+ (if syntax-literals_7
+ (vector-ref
+ syntax-literals_7
+ (+
+ (car
+ syntax-literals-spec_0)
+ i_278))
+ #f))
+ (unsafe-fx+
+ 1
+ i_277))))
+ (values
+ i_280))))
(if (if (not
- ((lambda x_83
+ ((lambda x_90
(unsafe-fx=
- i_193
- len_58))
- i_192))
+ i_279
+ len_65))
+ i_278))
(not #f)
#f)
- (for-loop_266
- i_193
+ (for-loop_384
+ i_279
(+
- pos_110
- inc_30))
- i_193)))
- i_48)))))
- for-loop_266)
- 0
- start_18)))))
- v_36))))
+ pos_160
+ inc_33))
+ i_279)))
+ i_277)))))
+ for-loop_384)
+ i_275
+ start_60)))))
+ v_268))))
(map-construct-compiled-in-memory_0 pres_0 1)
(map-construct-compiled-in-memory_0 posts_0 2)
namespace-scopes_0
@@ -44859,518 +44667,492 @@
syntax-literals-trees_1))))))))))))))
(define-values
(extract-submodules)
- (lambda (ld_12 names-key_0)
- (begin
- (if (1/linklet-bundle? ld_12)
- (let-values () null)
- (let-values ()
- (let-values (((h_21) (linklet-directory->hash$1 ld_12)))
- (let-values (((mod_3) (hash-ref h_21 #f #f)))
- (let-values ((() (begin (if mod_3 (void) (let-values () (error "missing main module"))) (values))))
- (let-values (((mh_0) (1/linklet-bundle->hash mod_3)))
- (let-values (((names_2) (hash-ref mh_0 names-key_0 null)))
- (reverse$1
- (let-values (((lst_295) names_2))
+ (lambda (ld_13 names-key_0)
+ (begin
+ (if (linklet-bundle?$1 ld_13)
+ null
+ (let-values (((h_29) (linklet-directory->hash$1 ld_13)))
+ (let-values (((mod_3) (hash-ref h_29 #f #f)))
+ (let-values ((() (begin (if mod_3 (void) (error "missing main module")) (values))))
+ (let-values (((mh_0) (linklet-bundle->hash$1 mod_3)))
+ (let-values (((names_2) (hash-ref mh_0 names-key_0 null)))
+ (reverse$1
+ (let-values (((fold-var_465) (let-values (((fold-var_466) null)) fold-var_466)))
+ (let-values (((lst_450) names_2))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_295)))
- ((letrec-values (((for-loop_0)
- (lambda (fold-var_22 lst_203)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_450))
+ ((letrec-values (((for-loop_385)
+ (lambda (fold-var_467 lst_451)
(begin
'for-loop
- (if (pair? lst_203)
- (let-values (((name_67) (unsafe-car lst_203))
- ((rest_125) (unsafe-cdr lst_203)))
- (let-values (((fold-var_80)
- (let-values (((fold-var_17) fold-var_22))
- (let-values (((fold-var_18)
- (let-values ()
- (cons
- (let-values ()
- (hash-ref
- h_21
- name_67
- (lambda ()
- (error
- "missing submodule declaration:"
- name_67))))
- fold-var_17))))
- (values fold-var_18)))))
- (if (not #f) (for-loop_0 fold-var_80 rest_125) fold-var_80)))
- fold-var_22)))))
- for-loop_0)
- null
- lst_295))))))))))))))
+ (if (pair? lst_451)
+ (let-values (((name_76) (unsafe-car lst_451))
+ ((rest_221) (unsafe-cdr lst_451)))
+ (let-values (((fold-var_468)
+ (let-values (((fold-var_469)
+ (cons
+ (hash-ref
+ h_29
+ name_76
+ (lambda ()
+ (error
+ "missing submodule declaration:"
+ name_76)))
+ fold-var_467)))
+ (values fold-var_469))))
+ (if (not #f) (for-loop_385 fold-var_468 rest_221) fold-var_468)))
+ fold-var_467)))))
+ for-loop_385)
+ fold-var_465
+ lst_450))))))))))))))
(define-values
(eval-single-top)
- (lambda (c_7 ns_45)
- (begin (let-values (((c11_0) c_7) ((ns12_1) ns_45) ((temp13_6) #t)) (eval-one-top.1 temp13_6 c11_0 ns12_1 #t)))))
+ (lambda (c_80 ns_82)
+ (begin (let-values (((c11_0) c_80) ((ns12_1) ns_82) ((temp13_7) #t)) (eval-one-top.1 temp13_7 c11_0 ns12_1 #t)))))
(define-values
(compiled-multiple-top?)
- (lambda (c_61)
+ (lambda (c_81)
(begin
- (let-values (((ld_13) (if (compiled-in-memory? c_61) (compiled-in-memory-linklet-directory c_61) c_61)))
- (if (linklet-directory?$1 ld_13) (not (hash-ref (linklet-directory->hash$1 ld_13) #f #f)) #f)))))
+ (let-values (((ld_14) (if (compiled-in-memory? c_81) (compiled-in-memory-linklet-directory c_81) c_81)))
+ (if (linklet-directory?$1 ld_14) (not (hash-ref (linklet-directory->hash$1 ld_14) #f #f)) #f)))))
(define-values
(eval-top)
(let-values (((eval-top_0)
- (lambda (c3_2 ns4_1 eval-compiled1_0 as-tail?2_0)
+ (lambda (c3_0 ns4_1 eval-compiled1_0 as-tail?2_0)
(begin
'eval-top
- (let-values (((c_51) c3_2))
- (let-values (((ns_72) ns4_1))
+ (let-values (((c_82) c3_0))
+ (let-values (((ns_83) ns4_1))
(let-values (((eval-compiled_0)
(if (eq? eval-compiled1_0 unsafe-undefined) eval-top eval-compiled1_0)))
(let-values (((as-tail?_0) as-tail?2_0))
- (let-values ()
- (if (compiled-multiple-top? c_51)
- (eval-multiple-tops c_51 ns_72 eval-compiled_0 as-tail?_0)
- (let-values (((c14_0) c_51) ((ns15_0) ns_72) ((as-tail?16_0) as-tail?_0))
- (eval-one-top.1 #f c14_0 ns15_0 as-tail?16_0))))))))))))
+ (if (compiled-multiple-top? c_82)
+ (eval-multiple-tops c_82 ns_83 eval-compiled_0 as-tail?_0)
+ (let-values (((c14_0) c_82) ((ns15_0) ns_83) ((as-tail?16_0) as-tail?_0))
+ (eval-one-top.1 #f c14_0 ns15_0 as-tail?16_0)))))))))))
(case-lambda
- ((c_62 ns_73) (begin (eval-top_0 c_62 ns_73 unsafe-undefined #t)))
- ((c_63 ns_74 eval-compiled_1 as-tail?2_1) (eval-top_0 c_63 ns_74 eval-compiled_1 as-tail?2_1))
- ((c_64 ns_1 eval-compiled1_1) (eval-top_0 c_64 ns_1 eval-compiled1_1 #t)))))
+ ((c_83 ns_84) (begin (eval-top_0 c_83 ns_84 unsafe-undefined #t)))
+ ((c_84 ns_85 eval-compiled_1 as-tail?2_1) (eval-top_0 c_84 ns_85 eval-compiled_1 as-tail?2_1))
+ ((c_85 ns_86 eval-compiled1_1) (eval-top_0 c_85 ns_86 eval-compiled1_1 #t)))))
(define-values
(eval-multiple-tops)
- (lambda (c_65 ns_75 eval-compiled_2 as-tail?_1)
+ (lambda (c_86 ns_87 eval-compiled_2 as-tail?_1)
(begin
(let-values (((eval-compiled-parts_0)
- (lambda (l_55)
+ (lambda (l_66)
(begin
'eval-compiled-parts
- ((letrec-values (((loop_96)
- (lambda (l_56)
+ ((letrec-values (((loop_110)
+ (lambda (l_67)
(begin
'loop
- (if (null? l_56)
- (let-values () void)
- (if (null? (cdr l_56))
- (let-values () (eval-compiled_2 (car l_56) ns_75 as-tail?_1))
- (let-values ()
- (begin
- (eval-compiled_2 (car l_56) ns_75 #f)
- (loop_96 (cdr l_56))))))))))
- loop_96)
- l_55)))))
- (if (compiled-in-memory? c_65)
- (let-values () (eval-compiled-parts_0 (compiled-in-memory-pre-compiled-in-memorys c_65)))
- (let-values (((c1_30) (hash-ref (linklet-directory->hash$1 c_65) 'data #f)))
- (if c1_30
+ (if (null? l_67)
+ void
+ (if (null? (cdr l_67))
+ (eval-compiled_2 (car l_67) ns_87 as-tail?_1)
+ (begin
+ (eval-compiled_2 (car l_67) ns_87 #f)
+ (loop_110 (cdr l_67)))))))))
+ loop_110)
+ l_66)))))
+ (if (compiled-in-memory? c_86)
+ (eval-compiled-parts_0 (compiled-in-memory-pre-compiled-in-memorys c_86))
+ (let-values (((cond-val_22) (hash-ref (linklet-directory->hash$1 c_86) 'data #f)))
+ (if cond-val_22
((lambda (data-ld_0)
(eval-compiled-parts_0
(create-compiled-in-memorys-using-shared-data
- (compiled-top->compiled-tops c_65)
- (hash-ref (1/linklet-bundle->hash (hash-ref (linklet-directory->hash$1 data-ld_0) #f)) 0)
- ns_75)))
- c1_30)
- (let-values () (eval-compiled-parts_0 (compiled-top->compiled-tops c_65))))))))))
+ (compiled-top->compiled-tops c_86)
+ (hash-ref (linklet-bundle->hash$1 (hash-ref (linklet-directory->hash$1 data-ld_0) #f)) 0)
+ ns_87)))
+ cond-val_22)
+ (eval-compiled-parts_0 (compiled-top->compiled-tops c_86)))))))))
(define-values
(eval-one-top.1)
(lambda (single-expression?5_0 c8_0 ns9_0 as-tail?7_0)
(begin
'eval-one-top
- (let-values (((c_66) c8_0))
- (let-values (((ns_76) ns9_0))
+ (let-values (((c_87) c8_0))
+ (let-values (((ns_88) ns9_0))
(let-values (((as-tail?_2) as-tail?7_0))
(let-values (((single-expression?_1) single-expression?5_0))
- (let-values ()
- (begin
- (if log-performance?
- (let-values () (start-performance-region 'eval (if single-expression?_1 'transformer 'top)))
- (void))
- (begin0
- (let-values ()
- (let-values (((ld_14)
- (if (compiled-in-memory? c_66) (compiled-in-memory-linklet-directory c_66) c_66)))
- (let-values (((h_22) (1/linklet-bundle->hash (hash-ref (linklet-directory->hash$1 ld_14) #f))))
- (let-values (((link-instance_0)
- (if (compiled-in-memory? c_66)
- (link-instance-from-compiled-in-memory
- c_66
- (if (not single-expression?_1) ns_76 #f))
- (instantiate-linklet$1
- (force-compile-linklet (hash-ref h_22 'link))
- (list
- deserialize-instance
- (let-values (((ns17_0) ns_76)
- ((temp18_5) (namespace-phase ns_76))
- ((temp19_3) (namespace-mpi ns_76))
- ((temp20_4) (namespace-bulk-binding-registry ns_76))
- ((temp21_8) (current-code-inspector)))
- (make-eager-instance-instance.1
- temp20_4
- temp18_5
- temp21_8
- ns17_0
- temp19_3)))))))
- (let-values (((orig-phase_1) (hash-ref h_22 'original-phase)))
- (let-values (((max-phase_9) (hash-ref h_22 'max-phase)))
- (let-values (((phase-shift_17) (phase- (namespace-phase ns_76) orig-phase_1)))
- (let-values (((extra-inspector_7)
- (if (compiled-in-memory? c_66)
- (compiled-in-memory-compile-time-inspector c_66)
- #f)))
- (let-values (((phase-to-link-extra-inspectorsss_3)
- (if (compiled-in-memory? c_66)
- (compiled-in-memory-phase-to-link-extra-inspectorsss c_66)
- '#hasheqv())))
- (let-values (((phase-to-link-modules_2)
- (if (compiled-in-memory? c_66)
- (compiled-in-memory-phase-to-link-module-uses c_66)
- (1/instance-variable-value
- link-instance_0
- 'phase-to-link-modules))))
- (let-values (((thunk_4)
- (let-values (((start_50) max-phase_9)
- ((end_37) (sub1 orig-phase_1))
- ((inc_31) -1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_50 end_37 inc_31)))
- ((letrec-values (((for-loop_105)
- (lambda (prev-thunk_0 pos_128)
- (begin
- 'for-loop
- (if (> pos_128 end_37)
- (let-values (((phase_45) pos_128))
- (let-values (((prev-thunk_1)
- (let-values (((prev-thunk_2)
- prev-thunk_0))
- (let-values (((prev-thunk_3)
- (let-values ()
- (let-values ((()
- (begin
- (prev-thunk_2
- #f)
- (values))))
- (let-values (((module-uses_1)
- (hash-ref
- phase-to-link-modules_2
- phase_45
- null)))
- (let-values (((import-module-instances_2
- import-instances_1)
- (let-values (((mis_6
- is_5)
- (let-values (((lst_9)
- module-uses_1))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_9)))
- ((letrec-values (((for-loop_3)
- (lambda (mis_7
- is_6
- lst_199)
- (begin
- 'for-loop
- (if (pair?
- lst_199)
- (let-values (((mu_9)
- (unsafe-car
- lst_199))
- ((rest_102)
- (unsafe-cdr
- lst_199)))
- (let-values (((mis_8
- is_7)
- (let-values (((mis_9)
- mis_7)
- ((is_8)
- is_6))
- (let-values (((mis_10
- is_9)
- (let-values ()
- (let-values (((mis22_0
- is23_0)
- (let-values ()
- (let-values (((ns24_0)
- ns_76)
- ((mu25_0)
- mu_9)
- ((temp26_2)
- (phase-
- (phase+
- phase_45
- phase-shift_17)
- (module-use-phase
- mu_9))))
- (namespace-module-use->module+linklet-instances.1
- temp26_2
- #f
- #f
- ns24_0
- mu25_0)))))
- (values
- (cons
- mis22_0
- mis_9)
- (cons
- is23_0
- is_8))))))
- (values
- mis_10
- is_9)))))
- (if (not
- #f)
- (for-loop_3
- mis_8
- is_7
- rest_102)
- (values
- mis_8
- is_7))))
- (values
- mis_7
- is_6))))))
- for-loop_3)
- null
- null
- lst_9)))))
- (values
- (reverse$1
- mis_6)
- (reverse$1
- is_5)))))
- (let-values (((phase-ns_0)
- (namespace->namespace-at-phase
- ns_76
- (phase+
- phase_45
- phase-shift_17))))
- (let-values (((inst_6)
- (if single-expression?_1
- link-instance_0
- (let-values (((phase-ns27_0)
- phase-ns_0)
- ((phase-shift28_0)
- phase-shift_17)
- ((temp29_3)
- (namespace-mpi
- ns_76))
- ((temp30_2)
- (namespace-inspector
- ns_76))
- ((temp31_0)
- (namespace-bulk-binding-registry
- ns_76))
- ((temp32_2)
- (lambda (name_68
- val_71)
- (namespace-set-transformer!
- ns_76
- (phase+
- (sub1
- phase_45)
- phase-shift_17)
- name_68
- val_71))))
- (make-instance-instance.1
- temp31_0
- temp30_2
- phase-ns27_0
- phase-shift28_0
- temp29_3
- temp32_2)))))
- (let-values (((linklet_13)
- (force-compile-linklet
- (hash-ref
- h_22
- phase_45
- #f))))
- (if linklet_13
- (let-values ()
- (let-values ((()
+ (begin
+ (if log-performance?
+ (start-performance-region 'eval (if single-expression?_1 'transformer 'top))
+ (void))
+ (begin0
+ (let-values (((ld_15)
+ (if (compiled-in-memory? c_87) (compiled-in-memory-linklet-directory c_87) c_87)))
+ (let-values (((h_30) (linklet-bundle->hash$1 (hash-ref (linklet-directory->hash$1 ld_15) #f))))
+ (let-values (((link-instance_0)
+ (if (compiled-in-memory? c_87)
+ (link-instance-from-compiled-in-memory
+ c_87
+ (if (not single-expression?_1) ns_88 #f))
+ (instantiate-linklet$1
+ (force-compile-linklet (hash-ref h_30 'link))
+ (list
+ deserialize-instance
+ (let-values (((ns17_0) ns_88)
+ ((temp18_5) (namespace-phase ns_88))
+ ((temp19_4) (namespace-mpi ns_88))
+ ((temp20_4) (namespace-bulk-binding-registry ns_88))
+ ((temp21_8) (current-code-inspector)))
+ (make-eager-instance-instance.1
+ temp20_4
+ temp18_5
+ temp21_8
+ ns17_0
+ temp19_4)))))))
+ (let-values (((orig-phase_1) (hash-ref h_30 'original-phase)))
+ (let-values (((max-phase_10) (hash-ref h_30 'max-phase)))
+ (let-values (((phase-shift_19) (phase- (namespace-phase ns_88) orig-phase_1)))
+ (let-values (((extra-inspector_8)
+ (if (compiled-in-memory? c_87)
+ (compiled-in-memory-compile-time-inspector c_87)
+ #f)))
+ (let-values (((phase-to-link-extra-inspectorsss_3)
+ (if (compiled-in-memory? c_87)
+ (compiled-in-memory-phase-to-link-extra-inspectorsss c_87)
+ '#hasheqv())))
+ (let-values (((phase-to-link-modules_2)
+ (if (compiled-in-memory? c_87)
+ (compiled-in-memory-phase-to-link-module-uses c_87)
+ (1/instance-variable-value link-instance_0 'phase-to-link-modules))))
+ (let-values (((thunk_3)
+ (let-values (((prev-thunk_0)
+ (let-values (((prev-thunk_1) void)) prev-thunk_1)))
+ (let-values (((start_61) max-phase_10)
+ ((end_40) (sub1 orig-phase_1))
+ ((inc_34) -1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_61 end_40 inc_34))
+ ((letrec-values (((for-loop_386)
+ (lambda (prev-thunk_2 pos_161)
+ (begin
+ 'for-loop
+ (if (> pos_161 end_40)
+ (let-values (((phase_128) pos_161))
+ (let-values (((prev-thunk_3)
+ (let-values (((prev-thunk_4)
+ (let-values ((()
+ (begin
+ (prev-thunk_2
+ #f)
+ (values))))
+ (let-values (((module-uses_1)
+ (hash-ref
+ phase-to-link-modules_2
+ phase_128
+ null)))
+ (let-values (((import-module-instances_2
+ import-instances_1)
+ (let-values (((mis_7
+ is_6)
+ (let-values (((mis_8)
+ (let-values (((mis_9)
+ null))
+ mis_9))
+ ((is_7)
+ (let-values (((is_8)
+ null))
+ is_8)))
+ (let-values (((lst_452)
+ module-uses_1))
(begin
- (let-values (((linklet33_0)
- linklet_13)
- ((temp34_2)
- 3)
- ((module-uses35_0)
- module-uses_1)
- ((import-module-instances36_0)
- import-module-instances_2)
- ((temp37_4)
- (current-code-inspector))
- ((extra-inspector38_0)
- extra-inspector_7)
- ((temp39_2)
- (hash-ref
- phase-to-link-extra-inspectorsss_3
- phase_45
- #f)))
- (check-require-access.1
- temp34_2
- linklet33_0
- module-uses35_0
- import-module-instances36_0
- temp37_4
- extra-inspector38_0
- temp39_2))
- (values))))
- (let-values (((instantiate_0)
- (lambda (tail?_45)
- (begin
- 'instantiate
- (instantiate-linklet$1
- linklet_13
- (list*
- top-level-instance
- link-instance_0
- inst_6
- import-instances_1)
- (namespace->instance
- ns_76
- (phase-
- (phase+
- phase_45
- phase-shift_17)
- (namespace-0-phase
- ns_76)))
- (not
- tail?_45))))))
- (if (zero-phase?
- phase_45)
- (let-values ()
- instantiate_0)
- (if single-expression?_1
- (let-values ()
- (lambda (tail?_46)
- (begin
- 'prev-thunk
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first
- #f
- parameterization-key)
- 1/current-namespace
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_452))
+ ((letrec-values (((for-loop_387)
+ (lambda (mis_10
+ is_9
+ lst_453)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_453)
+ (let-values (((mu_9)
+ (unsafe-car
+ lst_453))
+ ((rest_222)
+ (unsafe-cdr
+ lst_453)))
+ (let-values (((mis_11
+ is_10)
+ (let-values (((mis_12
+ is_11)
+ (let-values (((mis22_0
+ is23_0)
+ (let-values (((ns24_0)
+ ns_88)
+ ((mu25_0)
+ mu_9)
+ ((temp26_2)
+ (phase-
+ (phase+
+ phase_128
+ phase-shift_19)
+ (module-use-phase
+ mu_9))))
+ (namespace-module-use->module+linklet-instances.1
+ temp26_2
+ #f
+ #f
+ #f
+ ns24_0
+ mu25_0))))
+ (values
+ (cons
+ mis22_0
+ mis_10)
+ (cons
+ is23_0
+ is_9)))))
+ (values
+ mis_12
+ is_11))))
+ (if (not
+ #f)
+ (for-loop_387
+ mis_11
+ is_10
+ rest_222)
+ (values
+ mis_11
+ is_10))))
+ (values
+ mis_10
+ is_9))))))
+ for-loop_387)
+ mis_8
+ is_7
+ lst_452))))))
+ (values
+ (reverse$1
+ mis_7)
+ (reverse$1
+ is_6)))))
+ (let-values (((phase-ns_0)
+ (namespace->namespace-at-phase
+ ns_88
+ (phase+
+ phase_128
+ phase-shift_19))))
+ (let-values (((inst_6)
+ (if single-expression?_1
+ link-instance_0
+ (let-values (((phase-ns27_0)
phase-ns_0)
- (let-values ()
- (instantiate_0
- tail?_46))))))
- (let-values ()
- (let-values (((ns-1_1)
- (namespace->namespace-at-phase
- phase-ns_0
- (sub1
- phase_45))))
- (lambda (tail?_47)
- (begin
- 'prev-thunk
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first
- #f
- parameterization-key)
- 1/current-namespace
- phase-ns_0)
- (let-values ()
- (with-continuation-mark
- current-expand-context
- (let-values (((ns-140_0)
- ns-1_1))
- (make-expand-context.1
- #f
- #f
- #f
- #f
- #f
- ns-140_0))
- (let-values ()
- (instantiate_0
- tail?_47))))))))))))))
- (let-values ()
- void)))))))))))
- (values
- prev-thunk_3)))))
- (if (not #f)
- (for-loop_105
- prev-thunk_1
- (+ pos_128 inc_31))
- prev-thunk_1)))
- prev-thunk_0)))))
- for-loop_105)
- void
- start_50)))))
- (thunk_4 as-tail?_2))))))))))))
- (if log-performance? (let-values () (end-performance-region)) (void))))))))))))
+ ((phase-shift28_0)
+ phase-shift_19)
+ ((temp29_1)
+ (namespace-mpi
+ ns_88))
+ ((temp30_2)
+ (namespace-inspector
+ ns_88))
+ ((temp31_1)
+ (namespace-bulk-binding-registry
+ ns_88))
+ ((temp32_2)
+ (lambda (name_77
+ val_79)
+ (namespace-set-transformer!
+ ns_88
+ (phase+
+ (sub1
+ phase_128)
+ phase-shift_19)
+ name_77
+ val_79))))
+ (make-instance-instance.1
+ temp31_1
+ temp30_2
+ phase-ns27_0
+ phase-shift28_0
+ temp29_1
+ temp32_2)))))
+ (let-values (((linklet_13)
+ (force-compile-linklet
+ (hash-ref
+ h_30
+ phase_128
+ #f))))
+ (if linklet_13
+ (let-values ((()
+ (begin
+ (let-values (((linklet33_0)
+ linklet_13)
+ ((temp34_2)
+ 3)
+ ((module-uses35_0)
+ module-uses_1)
+ ((import-module-instances36_0)
+ import-module-instances_2)
+ ((temp37_3)
+ (current-code-inspector))
+ ((extra-inspector38_0)
+ extra-inspector_8)
+ ((temp39_2)
+ (hash-ref
+ phase-to-link-extra-inspectorsss_3
+ phase_128
+ #f)))
+ (check-require-access.1
+ temp34_2
+ linklet33_0
+ module-uses35_0
+ import-module-instances36_0
+ temp37_3
+ extra-inspector38_0
+ temp39_2))
+ (values))))
+ (let-values (((instantiate_0)
+ (lambda (tail?_46)
+ (begin
+ 'instantiate
+ (instantiate-linklet$1
+ linklet_13
+ (list*
+ top-level-instance
+ link-instance_0
+ inst_6
+ import-instances_1)
+ (namespace->instance
+ ns_88
+ (phase-
+ (phase+
+ phase_128
+ phase-shift_19)
+ (namespace-0-phase
+ ns_88)))
+ (not
+ tail?_46))))))
+ (if (zero-phase?
+ phase_128)
+ instantiate_0
+ (if single-expression?_1
+ (lambda (tail?_47)
+ (begin
+ 'prev-thunk
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first
+ #f
+ parameterization-key)
+ 1/current-namespace
+ phase-ns_0)
+ (instantiate_0
+ tail?_47))))
+ (let-values (((ns-1_1)
+ (namespace->namespace-at-phase
+ phase-ns_0
+ (sub1
+ phase_128))))
+ (lambda (tail?_48)
+ (begin
+ 'prev-thunk
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first
+ #f
+ parameterization-key)
+ 1/current-namespace
+ phase-ns_0)
+ (with-continuation-mark
+ current-expand-context
+ (let-values (((ns-140_0)
+ ns-1_1))
+ (make-expand-context.1
+ #f
+ #f
+ #f
+ #f
+ #f
+ ns-140_0))
+ (instantiate_0
+ tail?_48))))))))))
+ void)))))))))
+ (values
+ prev-thunk_4))))
+ (if (not #f)
+ (for-loop_386
+ prev-thunk_3
+ (+ pos_161 inc_34))
+ prev-thunk_3)))
+ prev-thunk_2)))))
+ for-loop_386)
+ prev-thunk_0
+ start_61))))))
+ (thunk_3 as-tail?_2)))))))))))
+ (if log-performance? (end-performance-region) (void)))))))))))
(define-values
(link-instance-from-compiled-in-memory)
(lambda (cim_11 to-ns_0)
(begin
(let-values (((orig-syntax-literals_0) (compiled-in-memory-syntax-literals cim_11)))
- (let-values (((syntax-literals_3)
+ (let-values (((syntax-literals_8)
(if (not to-ns_0)
- (let-values () orig-syntax-literals_0)
+ orig-syntax-literals_0
(if (namespace-scopes=?
(compiled-in-memory-namespace-scopes cim_11)
(extract-namespace-scopes to-ns_0))
- (let-values () orig-syntax-literals_0)
- (let-values ()
- (let-values (((len_59) (vector-length orig-syntax-literals_0)))
- (begin
- (if (exact-nonnegative-integer? len_59)
- (void)
- (let-values ()
- (raise-argument-error 'for/vector "exact-nonnegative-integer?" len_59)))
- (let-values (((v_198) (make-vector len_59 0)))
- (begin
- (if (zero? len_59)
- (void)
- (let-values ()
- (let-values (((vec_80 len_60)
- (let-values (((vec_81) orig-syntax-literals_0))
- (begin
- (check-vector vec_81)
- (values vec_81 (unsafe-vector-length vec_81))))))
- (begin
- #f
- ((letrec-values (((for-loop_236)
- (lambda (i_194 pos_129)
- (begin
- 'for-loop
- (if (unsafe-fx< pos_129 len_60)
- (let-values (((s_465)
- (unsafe-vector-ref vec_80 pos_129)))
- (let-values (((i_195)
- (let-values (((i_196) i_194))
- (let-values (((i_197)
- (let-values ()
- (begin
- (unsafe-vector*-set!
- v_198
- i_196
- (let-values ()
- (swap-top-level-scopes
- s_465
- (compiled-in-memory-namespace-scopes
- cim_11)
- to-ns_0)))
- (unsafe-fx+
- 1
- i_196)))))
- (values i_197)))))
- (if (if (not
- ((lambda x_84
- (unsafe-fx= i_195 len_59))
- s_465))
- (not #f)
- #f)
- (for-loop_236 i_195 (unsafe-fx+ 1 pos_129))
- i_195)))
- i_194)))))
- for-loop_236)
- 0
- 0)))))
- v_198)))))))))
+ orig-syntax-literals_0
+ (let-values (((len_66) (vector-length orig-syntax-literals_0)))
+ (begin
+ (if (exact-nonnegative-integer? len_66)
+ (void)
+ (1/raise-argument-error 'for/vector "exact-nonnegative-integer?" len_66))
+ (let-values (((v_269) (make-vector len_66 0)))
+ (begin
+ (if (zero? len_66)
+ (void)
+ (let-values (((i_281) (let-values (((i_282) 0)) i_282)))
+ (let-values (((vec_93 len_67)
+ (let-values (((vec_94) orig-syntax-literals_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-vector vec_94))
+ (values vec_94 (unsafe-vector-length vec_94))))))
+ ((letrec-values (((for-loop_388)
+ (lambda (i_283 pos_162)
+ (begin
+ 'for-loop
+ (if (unsafe-fx< pos_162 len_67)
+ (let-values (((s_627)
+ (unsafe-vector-ref vec_93 pos_162)))
+ (let-values (((i_284)
+ (let-values (((i_285)
+ (begin
+ (unsafe-vector*-set!
+ v_269
+ i_283
+ (swap-top-level-scopes
+ s_627
+ (compiled-in-memory-namespace-scopes
+ cim_11)
+ to-ns_0))
+ (unsafe-fx+ 1 i_283))))
+ (values i_285))))
+ (if (if (not
+ ((lambda x_91 (unsafe-fx= i_284 len_66))
+ s_627))
+ (not #f)
+ #f)
+ (for-loop_388 i_284 (unsafe-fx+ 1 pos_162))
+ i_284)))
+ i_283)))))
+ for-loop_388)
+ i_281
+ 0))))
+ v_269))))))))
(1/make-instance
'link
#f
@@ -45378,134 +45160,121 @@
mpi-vector-id
(compiled-in-memory-mpis cim_11)
syntax-literals-id
- syntax-literals_3))))))
+ syntax-literals_8))))))
(define-values (not-available) (gensym 'not-available))
(define-values (get-not-available) (lambda () (begin not-available)))
(define-values
(can-direct-eval?)
- (lambda (p_20 ns_45 self-mpi_3)
+ (lambda (p_54 ns_89 self-mpi_4)
(begin
- (if (parsed-app? p_20)
- (let-values ()
- (if (can-direct-eval? (parsed-app-rator p_20) ns_45 self-mpi_3)
- (let-values (((lst_102) (parsed-app-rands p_20)))
+ (if (parsed-app? p_54)
+ (if (can-direct-eval? (parsed-app-rator p_54) ns_89 self-mpi_4)
+ (let-values (((result_224) (let-values (((result_225) #t)) result_225)))
+ (let-values (((lst_454) (parsed-app-rands p_54)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_102)))
- ((letrec-values (((for-loop_112)
- (lambda (result_122 lst_88)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_454))
+ ((letrec-values (((for-loop_389)
+ (lambda (result_226 lst_455)
(begin
'for-loop
- (if (pair? lst_88)
- (let-values (((r_38) (unsafe-car lst_88)) ((rest_49) (unsafe-cdr lst_88)))
- (let-values (((result_85)
- (let-values ()
- (let-values (((result_123)
- (let-values ()
- (let-values ()
- (can-direct-eval? r_38 ns_45 self-mpi_3)))))
- (values result_123)))))
- (if (if (not ((lambda x_85 (not result_85)) r_38)) (not #f) #f)
- (for-loop_112 result_85 rest_49)
- result_85)))
- result_122)))))
- for-loop_112)
- #t
- lst_102)))
- #f))
- (if (parsed-id? p_20)
- (let-values () (not (eq? (get-id-value p_20 ns_45 self-mpi_3) not-available)))
- (if (parsed-quote? p_20)
- (let-values () #t)
- (if (parsed-quote-syntax? p_20) (let-values () #t) (let-values () #f))))))))
+ (if (pair? lst_455)
+ (let-values (((r_47) (unsafe-car lst_455)) ((rest_223) (unsafe-cdr lst_455)))
+ (let-values (((result_227)
+ (let-values (((result_228)
+ (can-direct-eval? r_47 ns_89 self-mpi_4)))
+ (values result_228))))
+ (if (if (not ((lambda x_92 (not result_227)) r_47)) (not #f) #f)
+ (for-loop_389 result_227 rest_223)
+ result_227)))
+ result_226)))))
+ for-loop_389)
+ result_224
+ lst_454))))
+ #f)
+ (if (parsed-id? p_54)
+ (not (eq? (get-id-value p_54 ns_89 self-mpi_4) not-available))
+ (if (parsed-quote? p_54) #t (if (parsed-quote-syntax? p_54) #t #f)))))))
(define-values
(direct-eval)
- (lambda (p_47 ns_72 self-mpi_4)
+ (lambda (p_55 ns_90 self-mpi_5)
(begin
- (if (parsed-app? p_47)
- (let-values ()
- (apply
- (direct-eval (parsed-app-rator p_47) ns_72 self-mpi_4)
- (reverse$1
- (let-values (((lst_46) (parsed-app-rands p_47)))
+ (if (parsed-app? p_55)
+ (apply
+ (direct-eval (parsed-app-rator p_55) ns_90 self-mpi_5)
+ (reverse$1
+ (let-values (((fold-var_470) (let-values (((fold-var_471) null)) fold-var_471)))
+ (let-values (((lst_456) (parsed-app-rands p_55)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_46)))
- ((letrec-values (((for-loop_55)
- (lambda (fold-var_33 lst_23)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_456))
+ ((letrec-values (((for-loop_390)
+ (lambda (fold-var_472 lst_457)
(begin
'for-loop
- (if (pair? lst_23)
- (let-values (((r_41) (unsafe-car lst_23)) ((rest_20) (unsafe-cdr lst_23)))
- (let-values (((fold-var_34)
- (let-values (((fold-var_35) fold-var_33))
- (let-values (((fold-var_36)
- (let-values ()
- (cons
- (let-values ()
- (direct-eval r_41 ns_72 self-mpi_4))
- fold-var_35))))
- (values fold-var_36)))))
- (if (not #f) (for-loop_55 fold-var_34 rest_20) fold-var_34)))
- fold-var_33)))))
- for-loop_55)
- null
- lst_46))))))
- (if (parsed-id? p_47)
- (let-values () (get-id-value p_47 ns_72 self-mpi_4))
- (if (parsed-quote? p_47)
- (let-values () (parsed-quote-datum p_47))
- (if (parsed-quote-syntax? p_47) (let-values () (parsed-quote-syntax-datum p_47)) (let-values () #f))))))))
+ (if (pair? lst_457)
+ (let-values (((r_48) (unsafe-car lst_457)) ((rest_224) (unsafe-cdr lst_457)))
+ (let-values (((fold-var_473)
+ (let-values (((fold-var_474)
+ (cons
+ (direct-eval r_48 ns_90 self-mpi_5)
+ fold-var_472)))
+ (values fold-var_474))))
+ (if (not #f) (for-loop_390 fold-var_473 rest_224) fold-var_473)))
+ fold-var_472)))))
+ for-loop_390)
+ fold-var_470
+ lst_456))))))
+ (if (parsed-id? p_55)
+ (get-id-value p_55 ns_90 self-mpi_5)
+ (if (parsed-quote? p_55)
+ (parsed-quote-datum p_55)
+ (if (parsed-quote-syntax? p_55) (parsed-quote-syntax-datum p_55) #f)))))))
(define-values
(get-id-value)
- (lambda (p_48 ns_77 self-mpi_5)
- (begin
- (let-values (((b_93) (parsed-id-binding p_48)))
- (if (parsed-primitive-id? p_48)
- (let-values () (hash-ref (1/primitive-table '#%kernel) (module-binding-sym b_93) get-not-available))
- (if (let-values (((or-part_5) (parsed-top-id? p_48)))
- (if or-part_5
- or-part_5
- (let-values (((or-part_6) (not b_93)))
- (if or-part_6 or-part_6 (eq? self-mpi_5 (module-binding-module b_93))))))
- (let-values ()
- (namespace-get-variable
- ns_77
- (if b_93 (module-binding-phase b_93) (namespace-phase ns_77))
- (if b_93 (module-binding-sym b_93) (syntax-e$1 (parsed-s p_48)))
- get-not-available))
- (let-values ()
- (let-values (((mi_21)
- (let-values (((ns1_2) ns_77)
- ((temp2_4) (1/module-path-index-resolve (module-binding-module b_93)))
- ((temp3_4) (phase- (namespace-phase ns_77) (module-binding-phase b_93))))
- (namespace->module-instance.1 #f #f void ns1_2 temp2_4 temp3_4))))
- (if (not mi_21)
- (let-values () not-available)
- (if (check-single-require-access
- mi_21
- (module-binding-phase b_93)
- (module-binding-sym b_93)
- (module-binding-extra-inspector b_93))
- (let-values ()
- (namespace-get-variable
- (module-instance-namespace mi_21)
- (module-binding-phase b_93)
- (module-binding-sym b_93)
- get-not-available))
- (let-values () not-available)))))))))))
+ (lambda (p_56 ns_91 self-mpi_6)
+ (begin
+ (let-values (((b_125) (parsed-id-binding p_56)))
+ (if (parsed-primitive-id? p_56)
+ (hash-ref (1/primitive-table '#%kernel) (module-binding-sym b_125) get-not-available)
+ (if (let-values (((or-part_449) (parsed-top-id? p_56)))
+ (if or-part_449
+ or-part_449
+ (let-values (((or-part_450) (not b_125)))
+ (if or-part_450 or-part_450 (eq? self-mpi_6 (module-binding-module b_125))))))
+ (namespace-get-variable
+ ns_91
+ (if b_125 (module-binding-phase b_125) (namespace-phase ns_91))
+ (if b_125 (module-binding-sym b_125) (syntax-e$1 (parsed-s p_56)))
+ get-not-available)
+ (let-values (((mi_22)
+ (let-values (((ns1_2) ns_91)
+ ((temp2_4) (1/module-path-index-resolve (module-binding-module b_125)))
+ ((temp3_4) (phase- (namespace-phase ns_91) (module-binding-phase b_125))))
+ (namespace->module-instance.1 #f #f void ns1_2 temp2_4 temp3_4))))
+ (if (not mi_22)
+ not-available
+ (if (check-single-require-access
+ mi_22
+ (module-binding-phase b_125)
+ (module-binding-sym b_125)
+ (module-binding-extra-inspector b_125))
+ (namespace-get-variable
+ (module-instance-namespace mi_22)
+ (module-binding-phase b_125)
+ (module-binding-sym b_125)
+ get-not-available)
+ not-available)))))))))
(define-values (runtime-scope) (new-multi-scope))
(define-values (runtime-stx) (add-scope empty-syntax runtime-scope))
(define-values (runtime-module-name) (1/make-resolved-module-path '#%runtime))
- (define-values (runtime-mpi) (1/module-path-index-join ''#%runtime #f))
+ (define-values (runtime-mpi) (module-path-index-join* ''#%runtime #f))
(define-values
(add-runtime-primitive!)
- (lambda (sym_76)
+ (lambda (sym_91)
(begin
(let-values (((temp1_4) (syntax-scope-set runtime-stx 0))
- ((sym2_0) sym_76)
+ ((sym2_0) sym_91)
((temp3_5)
- (let-values (((runtime-mpi4_0) runtime-mpi) ((temp5_6) 0) ((sym6_1) sym_76))
+ (let-values (((runtime-mpi4_0) runtime-mpi) ((temp5_6) 0) ((sym6_1) sym_91))
(make-module-binding.1
#f
null
@@ -45531,297 +45300,275 @@
(define-values
(runtime-instances)
'(#%kernel #%paramz #%foreign #%unsafe #%flfxnum #%extfl #%network #%place #%futures #%terminal))
- (define-values (box-cons!) (lambda (b_16 v_54) (begin (set-box! b_16 (cons v_54 (unbox b_16))))))
- (define-values (box-clear!) (lambda (b_22) (begin (begin0 (reverse$1 (unbox b_22)) (set-box! b_22 null)))))
+ (define-values (box-cons!) (lambda (b_126 v_270) (begin (set-box! b_126 (cons v_270 (unbox b_126))))))
+ (define-values (box-clear!) (lambda (b_127) (begin (begin0 (reverse$1 (unbox b_127)) (set-box! b_127 null)))))
(define-values
(struct:lift-context lift-context1.1 lift-context? lift-context-convert lift-context-lifts lift-context-module*-ok?)
- (let-values (((struct:_64 make-_64 ?_64 -ref_64 -set!_64)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'lift-context
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'lift-context)))))
+ (let-values (((struct:_115 make-_115 ?_115 -ref_115 -set!_115)
+ (make-struct-type
+ 'lift-context
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'lift-context)))
(values
- struct:_64
- make-_64
- ?_64
- (make-struct-field-accessor -ref_64 0 'convert)
- (make-struct-field-accessor -ref_64 1 'lifts)
- (make-struct-field-accessor -ref_64 2 'module*-ok?))))
+ struct:_115
+ make-_115
+ ?_115
+ (make-struct-field-accessor -ref_115 0 'convert)
+ (make-struct-field-accessor -ref_115 1 'lifts)
+ (make-struct-field-accessor -ref_115 2 'module*-ok?))))
(define-values
(struct:lifted-bind lifted-bind2.1 lifted-bind? lifted-bind-ids lifted-bind-keys lifted-bind-rhs)
- (let-values (((struct:_34 make-_34 ?_34 -ref_34 -set!_34)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'lifted-bind
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'lifted-bind)))))
+ (let-values (((struct:_116 make-_116 ?_116 -ref_116 -set!_116)
+ (make-struct-type
+ 'lifted-bind
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'lifted-bind)))
(values
- struct:_34
- make-_34
- ?_34
- (make-struct-field-accessor -ref_34 0 'ids)
- (make-struct-field-accessor -ref_34 1 'keys)
- (make-struct-field-accessor -ref_34 2 'rhs))))
+ struct:_116
+ make-_116
+ ?_116
+ (make-struct-field-accessor -ref_116 0 'ids)
+ (make-struct-field-accessor -ref_116 1 'keys)
+ (make-struct-field-accessor -ref_116 2 'rhs))))
(define-values
(make-lift-context.1)
(lambda (module*-ok?3_0 convert5_0)
(begin
'make-lift-context
(let-values (((convert_0) convert5_0))
- (let-values (((module*-ok?_0) module*-ok?3_0))
- (let-values () (lift-context1.1 convert_0 (box null) module*-ok?_0)))))))
+ (let-values (((module*-ok?_0) module*-ok?3_0)) (lift-context1.1 convert_0 (box null) module*-ok?_0))))))
(define-values
(add-lifted!)
- (lambda (lifts_1 ids_17 rhs_12 phase_107)
+ (lambda (lifts_1 ids_18 rhs_13 phase_129)
(begin
- (let-values (((lifted-ids_0 lifted_0) ((lift-context-convert lifts_1) ids_17 rhs_12 phase_107)))
+ (let-values (((lifted-ids_0 lifted_0) ((lift-context-convert lifts_1) ids_18 rhs_13 phase_129)))
(begin (box-cons! (lift-context-lifts lifts_1) lifted_0) lifted-ids_0)))))
(define-values (get-and-clear-lifts!) (lambda (lifts_2) (begin (box-clear! (lift-context-lifts lifts_2)))))
(define-values
(make-local-lift)
(lambda (lift-env_1 counter_3 local-sym_1)
(begin
- (lambda (ids_18 rhs_13 phase_108)
- (let-values (((keys_2)
+ (lambda (ids_19 rhs_14 phase_130)
+ (let-values (((keys_3)
(reverse$1
- (let-values (((lst_232) ids_18))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_232)))
- ((letrec-values (((for-loop_267)
- (lambda (fold-var_9 lst_285)
- (begin
- 'for-loop
- (if (pair? lst_285)
- (let-values (((id_68) (unsafe-car lst_285))
- ((rest_157) (unsafe-cdr lst_285)))
- (let-values (((fold-var_255)
- (let-values (((fold-var_256) fold-var_9))
- (let-values (((fold-var_69)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((key_89)
- (let-values (((id29_2)
- id_68)
- ((phase30_1)
- phase_108)
- ((counter31_0)
- counter_3)
- ((local-sym32_0)
- local-sym_1))
- (add-local-binding!.1
- #f
- #f
- local-sym32_0
- id29_2
- phase30_1
- counter31_0))))
- (begin
- (set-box!
- lift-env_1
- (env-extend
- (unbox lift-env_1)
- key_89
- variable))
- key_89)))
- fold-var_256))))
- (values fold-var_69)))))
- (if (not #f) (for-loop_267 fold-var_255 rest_157) fold-var_255)))
- fold-var_9)))))
- for-loop_267)
- null
- lst_232))))))
- (values ids_18 (lifted-bind2.1 ids_18 keys_2 rhs_13)))))))
+ (let-values (((fold-var_475) (let-values (((fold-var_476) null)) fold-var_476)))
+ (let-values (((lst_458) ids_19))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_458))
+ ((letrec-values (((for-loop_391)
+ (lambda (fold-var_477 lst_459)
+ (begin
+ 'for-loop
+ (if (pair? lst_459)
+ (let-values (((id_77) (unsafe-car lst_459))
+ ((rest_225) (unsafe-cdr lst_459)))
+ (let-values (((fold-var_478)
+ (let-values (((fold-var_479)
+ (cons
+ (let-values (((key_101)
+ (let-values (((id29_2)
+ id_77)
+ ((phase30_1)
+ phase_130)
+ ((counter31_0)
+ counter_3)
+ ((local-sym32_0)
+ local-sym_1))
+ (add-local-binding!.1
+ #f
+ #f
+ local-sym32_0
+ id29_2
+ phase30_1
+ counter31_0))))
+ (begin
+ (set-box!
+ lift-env_1
+ (env-extend
+ (unbox lift-env_1)
+ key_101
+ variable))
+ key_101))
+ fold-var_477)))
+ (values fold-var_479))))
+ (if (not #f)
+ (for-loop_391 fold-var_478 rest_225)
+ fold-var_478)))
+ fold-var_477)))))
+ for-loop_391)
+ fold-var_475
+ lst_458)))))))
+ (values ids_19 (lifted-bind2.1 ids_19 keys_3 rhs_14)))))))
(define-values
(make-top-level-lift)
- (lambda (ctx_12)
+ (lambda (ctx_14)
(begin
- (lambda (ids_19 rhs_14 phase_45)
+ (lambda (ids_20 rhs_15 phase_131)
(let-values (((post-scope_0)
(post-expansion-scope
(root-expand-context-post-expansion
- (namespace-get-root-expand-ctx (expand-context-namespace ctx_12))))))
+ (namespace-get-root-expand-ctx (expand-context-namespace ctx_14))))))
(let-values (((tl-ids_1)
(reverse$1
- (let-values (((lst_97) ids_19))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_97)))
- ((letrec-values (((for-loop_268)
- (lambda (fold-var_76 lst_296)
- (begin
- 'for-loop
- (if (pair? lst_296)
- (let-values (((id_69) (unsafe-car lst_296))
- ((rest_158) (unsafe-cdr lst_296)))
- (let-values (((fold-var_91)
- (let-values (((fold-var_92) fold-var_76))
- (let-values (((fold-var_245)
- (let-values ()
- (cons
- (let-values ()
- (add-scope
- id_69
- post-scope_0))
- fold-var_92))))
- (values fold-var_245)))))
- (if (not #f) (for-loop_268 fold-var_91 rest_158) fold-var_91)))
- fold-var_76)))))
- for-loop_268)
- null
- lst_97))))))
- (let-values (((syms_21) (select-defined-syms-and-bind!/ctx tl-ids_1 ctx_12)))
- (values tl-ids_1 (lifted-bind2.1 tl-ids_1 syms_21 rhs_14)))))))))
+ (let-values (((fold-var_480) (let-values (((fold-var_481) null)) fold-var_481)))
+ (let-values (((lst_460) ids_20))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_460))
+ ((letrec-values (((for-loop_392)
+ (lambda (fold-var_482 lst_461)
+ (begin
+ 'for-loop
+ (if (pair? lst_461)
+ (let-values (((id_78) (unsafe-car lst_461))
+ ((rest_226) (unsafe-cdr lst_461)))
+ (let-values (((fold-var_483)
+ (let-values (((fold-var_484)
+ (cons
+ (add-scope id_78 post-scope_0)
+ fold-var_482)))
+ (values fold-var_484))))
+ (if (not #f)
+ (for-loop_392 fold-var_483 rest_226)
+ fold-var_483)))
+ fold-var_482)))))
+ for-loop_392)
+ fold-var_480
+ lst_460)))))))
+ (let-values (((syms_29) (select-defined-syms-and-bind!/ctx tl-ids_1 ctx_14)))
+ (values tl-ids_1 (lifted-bind2.1 tl-ids_1 syms_29 rhs_15)))))))))
(define-values
(wrap-lifts-as-let)
- (lambda (lifts_3 body_5 phase_77)
+ (lambda (lifts_3 body_5 phase_132)
(begin
(datum->syntax$1
#f
- (let-values (((lst_199) (reverse$1 lifts_3)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_199)))
- ((letrec-values (((for-loop_264)
- (lambda (body_6 lst_30)
- (begin
- 'for-loop
- (if (pair? lst_30)
- (let-values (((lift_0) (unsafe-car lst_30)) ((rest_159) (unsafe-cdr lst_30)))
- (let-values (((body_7)
- (let-values (((body_8) body_6))
- (let-values (((body_9)
- (let-values ()
- (begin
- (if (lifted-bind? lift_0)
- (void)
- (let-values ()
- (error "non-bindings in `lift-context`")))
+ (let-values (((body_6) (let-values (((body_7) body_5)) body_7)))
+ (let-values (((lst_462) (reverse$1 lifts_3)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_462))
+ ((letrec-values (((for-loop_393)
+ (lambda (body_8 lst_463)
+ (begin
+ 'for-loop
+ (if (pair? lst_463)
+ (let-values (((lift_0) (unsafe-car lst_463)) ((rest_227) (unsafe-cdr lst_463)))
+ (let-values (((body_9)
+ (let-values (((body_10)
+ (begin
+ (if (lifted-bind? lift_0)
+ (void)
+ (error "non-bindings in `lift-context`"))
+ (list
+ (datum->syntax$1
+ (syntax-shift-phase-level$1 core-stx phase_132)
+ 'let-values)
+ (list
(list
- (datum->syntax$1
- (syntax-shift-phase-level$1 core-stx phase_77)
- 'let-values)
- (list
- (list
- (lifted-bind-ids lift_0)
- (lifted-bind-rhs lift_0)))
- body_8)))))
- (values body_9)))))
- (if (not #f) (for-loop_264 body_7 rest_159) body_7)))
- body_6)))))
- for-loop_264)
- body_5
- lst_199)))))))
+ (lifted-bind-ids lift_0)
+ (lifted-bind-rhs lift_0)))
+ body_8))))
+ (values body_10))))
+ (if (not #f) (for-loop_393 body_9 rest_227) body_9)))
+ body_8)))))
+ for-loop_393)
+ body_6
+ lst_462))))))))
(define-values
(wrap-lifts-as-begin.1)
(lambda (adjust-body8_0 adjust-form7_0 lifts11_0 body12_0 phase13_0)
(begin
'wrap-lifts-as-begin
(let-values (((lifts_4) lifts11_0))
- (let-values (((body_10) body12_0))
- (let-values (((phase_109) phase13_0))
+ (let-values (((body_11) body12_0))
+ (let-values (((phase_133) phase13_0))
(let-values (((adjust-form_0) (if (eq? adjust-form7_0 unsafe-undefined) values adjust-form7_0)))
(let-values (((adjust-body_0) (if (eq? adjust-body8_0 unsafe-undefined) values adjust-body8_0)))
- (let-values ()
- (datum->syntax$1
- #f
- (cons
- (datum->syntax$1 (syntax-shift-phase-level$1 core-stx phase_109) 'begin)
- (append
- (reverse$1
- (let-values (((lst_16) lifts_4))
+ (datum->syntax$1
+ #f
+ (cons
+ (datum->syntax$1 (syntax-shift-phase-level$1 core-stx phase_133) 'begin)
+ (append
+ (reverse$1
+ (let-values (((fold-var_485) (let-values (((fold-var_486) null)) fold-var_486)))
+ (let-values (((lst_464) lifts_4))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_16)))
- ((letrec-values (((for-loop_217)
- (lambda (fold-var_98 lst_200)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_464))
+ ((letrec-values (((for-loop_394)
+ (lambda (fold-var_487 lst_465)
(begin
'for-loop
- (if (pair? lst_200)
- (let-values (((lift_1) (unsafe-car lst_200))
- ((rest_103) (unsafe-cdr lst_200)))
- (let-values (((fold-var_99)
- (let-values (((fold-var_46) fold-var_98))
- (let-values (((fold-var_47)
- (let-values ()
- (cons
- (let-values ()
- (adjust-form_0
- (if (lifted-bind? lift_1)
- (let-values ()
- (datum->syntax$1
- #f
- (list
- (datum->syntax$1
- (syntax-shift-phase-level$1
- core-stx
- phase_109)
- 'define-values)
- (lifted-bind-ids lift_1)
- (lifted-bind-rhs
- lift_1))))
- (let-values () lift_1))))
- fold-var_46))))
- (values fold-var_47)))))
- (if (not #f) (for-loop_217 fold-var_99 rest_103) fold-var_99)))
- fold-var_98)))))
- for-loop_217)
- null
- lst_16))))
- (list (adjust-body_0 body_10))))))))))))))
+ (if (pair? lst_465)
+ (let-values (((lift_1) (unsafe-car lst_465))
+ ((rest_228) (unsafe-cdr lst_465)))
+ (let-values (((fold-var_488)
+ (let-values (((fold-var_489)
+ (cons
+ (adjust-form_0
+ (if (lifted-bind? lift_1)
+ (datum->syntax$1
+ #f
+ (list
+ (datum->syntax$1
+ (syntax-shift-phase-level$1
+ core-stx
+ phase_133)
+ 'define-values)
+ (lifted-bind-ids lift_1)
+ (lifted-bind-rhs lift_1)))
+ lift_1))
+ fold-var_487)))
+ (values fold-var_489))))
+ (if (not #f) (for-loop_394 fold-var_488 rest_228) fold-var_488)))
+ fold-var_487)))))
+ for-loop_394)
+ fold-var_485
+ lst_464)))))
+ (list (adjust-body_0 body_11)))))))))))))
(define-values
(get-lifts-as-lists)
(lambda (lifts_5)
(begin
(reverse$1
- (let-values (((lst_297) lifts_5))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_297)))
- ((letrec-values (((for-loop_7)
- (lambda (fold-var_257 lst_171)
- (begin
- 'for-loop
- (if (pair? lst_171)
- (let-values (((lift_2) (unsafe-car lst_171)) ((rest_160) (unsafe-cdr lst_171)))
- (let-values (((fold-var_258)
- (let-values (((fold-var_259) fold-var_257))
- (let-values (((fold-var_215)
- (let-values ()
- (cons
- (let-values ()
- (list
- (lifted-bind-ids lift_2)
- (lifted-bind-keys lift_2)
- (lifted-bind-rhs lift_2)))
- fold-var_259))))
- (values fold-var_215)))))
- (if (not #f) (for-loop_7 fold-var_258 rest_160) fold-var_258)))
- fold-var_257)))))
- for-loop_7)
- null
- lst_297)))))))
+ (let-values (((fold-var_490) (let-values (((fold-var_491) null)) fold-var_491)))
+ (let-values (((lst_466) lifts_5))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_466))
+ ((letrec-values (((for-loop_395)
+ (lambda (fold-var_492 lst_467)
+ (begin
+ 'for-loop
+ (if (pair? lst_467)
+ (let-values (((lift_2) (unsafe-car lst_467)) ((rest_229) (unsafe-cdr lst_467)))
+ (let-values (((fold-var_493)
+ (let-values (((fold-var_494)
+ (cons
+ (list
+ (lifted-bind-ids lift_2)
+ (lifted-bind-keys lift_2)
+ (lifted-bind-rhs lift_2))
+ fold-var_492)))
+ (values fold-var_494))))
+ (if (not #f) (for-loop_395 fold-var_493 rest_229) fold-var_493)))
+ fold-var_492)))))
+ for-loop_395)
+ fold-var_490
+ lst_466))))))))
(define-values
(struct:module-lift-context
module-lift-context15.1
@@ -45829,65 +45576,60 @@
module-lift-context-wrt-phase
module-lift-context-lifts
module-lift-context-module*-ok?)
- (let-values (((struct:_65 make-_65 ?_65 -ref_65 -set!_65)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'module-lift-context
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'module-lift-context)))))
+ (let-values (((struct:_117 make-_117 ?_117 -ref_117 -set!_117)
+ (make-struct-type
+ 'module-lift-context
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'module-lift-context)))
(values
- struct:_65
- make-_65
- ?_65
- (make-struct-field-accessor -ref_65 0 'wrt-phase)
- (make-struct-field-accessor -ref_65 1 'lifts)
- (make-struct-field-accessor -ref_65 2 'module*-ok?))))
+ struct:_117
+ make-_117
+ ?_117
+ (make-struct-field-accessor -ref_117 0 'wrt-phase)
+ (make-struct-field-accessor -ref_117 1 'lifts)
+ (make-struct-field-accessor -ref_117 2 'module*-ok?))))
(define-values
(make-module-lift-context)
- (lambda (phase_110 module*-ok?_1) (begin (module-lift-context15.1 phase_110 (box null) module*-ok?_1))))
+ (lambda (phase_134 module*-ok?_1) (begin (module-lift-context15.1 phase_134 (box null) module*-ok?_1))))
(define-values
(get-and-clear-module-lifts!)
(lambda (module-lifts_1) (begin (box-clear! (module-lift-context-lifts module-lifts_1)))))
(define-values
(add-lifted-module!)
- (lambda (module-lifts_2 s_466 phase_111)
+ (lambda (module-lifts_2 s_628 phase_135)
(begin
(begin
- (if (let-values (((or-part_226)
+ (if (let-values (((or-part_451)
(if (module-lift-context? module-lifts_2)
(module-lift-context-module*-ok? module-lifts_2)
#f)))
- (if or-part_226
- or-part_226
+ (if or-part_451
+ or-part_451
(if (lift-context? module-lifts_2) (lift-context-module*-ok? module-lifts_2) #f)))
(void)
- (let-values ()
- (let-values (((tmp_32) (core-form-sym s_466 phase_111)))
- (if (equal? tmp_32 'module)
- (let-values () (void))
- (if (equal? tmp_32 'module*)
- (let-values ()
- (raise-arguments-error
- 'syntax-local-lift-module
- "cannot lift `module*' to a top-level context"
- "syntax"
- s_466))
- (let-values ()
- (raise-arguments-error 'syntax-local-lift-module "not a `module' declaration" "syntax" s_466)))))))
+ (let-values (((tmp_34) (core-form-sym s_628 phase_135)))
+ (if (equal? tmp_34 'module)
+ (void)
+ (if (equal? tmp_34 'module*)
+ (raise-arguments-error
+ 'syntax-local-lift-module
+ "cannot lift `module*' to a top-level context"
+ "syntax"
+ s_628)
+ (raise-arguments-error 'syntax-local-lift-module "not a `module' declaration" "syntax" s_628)))))
(if (module-lift-context? module-lifts_2)
- (let-values () (box-cons! (module-lift-context-lifts module-lifts_2) s_466))
+ (box-cons! (module-lift-context-lifts module-lifts_2) s_628)
(if (lift-context? module-lifts_2)
- (let-values () (box-cons! (lift-context-lifts module-lifts_2) s_466))
- (let-values () (error "internal error: unrecognized lift-context type for module lift"))))))))
+ (box-cons! (lift-context-lifts module-lifts_2) s_628)
+ (error "internal error: unrecognized lift-context type for module lift")))))))
(define-values
(struct:require-lift-context
require-lift-context16.1
@@ -45895,28 +45637,26 @@
require-lift-context-do-require
require-lift-context-wrt-phase
require-lift-context-requires)
- (let-values (((struct:_66 make-_66 ?_66 -ref_66 -set!_66)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'require-lift-context
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'require-lift-context)))))
+ (let-values (((struct:_118 make-_118 ?_118 -ref_118 -set!_118)
+ (make-struct-type
+ 'require-lift-context
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'require-lift-context)))
(values
- struct:_66
- make-_66
- ?_66
- (make-struct-field-accessor -ref_66 0 'do-require)
- (make-struct-field-accessor -ref_66 1 'wrt-phase)
- (make-struct-field-accessor -ref_66 2 'requires))))
+ struct:_118
+ make-_118
+ ?_118
+ (make-struct-field-accessor -ref_118 0 'do-require)
+ (make-struct-field-accessor -ref_118 1 'wrt-phase)
+ (make-struct-field-accessor -ref_118 2 'requires))))
(define-values
(make-require-lift-context)
(let-values (((make-require-lift-context_0)
@@ -45926,8 +45666,7 @@
(let-values (((wrt-phase_0) wrt-phase18_0))
(let-values (((do-require_0) do-require19_0))
(let-values (((initial-lifts_0) initial-lifts17_0))
- (let-values ()
- (require-lift-context16.1 do-require_0 wrt-phase_0 (box initial-lifts_0))))))))))
+ (require-lift-context16.1 do-require_0 wrt-phase_0 (box initial-lifts_0)))))))))
(case-lambda
((wrt-phase_1 do-require_1) (begin (make-require-lift-context_0 wrt-phase_1 do-require_1 null)))
((wrt-phase_2 do-require_2 initial-lifts17_1)
@@ -45940,10 +45679,10 @@
(lambda (require-lifts_2) (begin (box-clear! (require-lift-context-requires require-lifts_2)))))
(define-values
(add-lifted-require!)
- (lambda (require-lifts_3 s_467 phase_34)
+ (lambda (require-lifts_3 s_629 phase_136)
(begin
- (let-values (((r_42) ((require-lift-context-do-require require-lifts_3) s_467 phase_34)))
- (box-cons! (require-lift-context-requires require-lifts_3) r_42)))))
+ (let-values (((r_49) ((require-lift-context-do-require require-lifts_3) s_629 phase_136)))
+ (box-cons! (require-lift-context-requires require-lifts_3) r_49)))))
(define-values
(struct:to-module-lift-context
to-module-lift-context20.1
@@ -45952,38 +45691,36 @@
to-module-lift-context-provides
to-module-lift-context-end-as-expressions?
to-module-lift-context-ends)
- (let-values (((struct:_67 make-_67 ?_67 -ref_67 -set!_67)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'to-module-lift-context
- #f
- 4
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3)
- #f
- 'to-module-lift-context)))))
+ (let-values (((struct:_119 make-_119 ?_119 -ref_119 -set!_119)
+ (make-struct-type
+ 'to-module-lift-context
+ #f
+ 4
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3)
+ #f
+ 'to-module-lift-context)))
(values
- struct:_67
- make-_67
- ?_67
- (make-struct-field-accessor -ref_67 0 'wrt-phase)
- (make-struct-field-accessor -ref_67 1 'provides)
- (make-struct-field-accessor -ref_67 2 'end-as-expressions?)
- (make-struct-field-accessor -ref_67 3 'ends))))
+ struct:_119
+ make-_119
+ ?_119
+ (make-struct-field-accessor -ref_119 0 'wrt-phase)
+ (make-struct-field-accessor -ref_119 1 'provides)
+ (make-struct-field-accessor -ref_119 2 'end-as-expressions?)
+ (make-struct-field-accessor -ref_119 3 'ends))))
(define-values
(make-to-module-lift-context.1)
(lambda (end-as-expressions?22_0 shared-module-ends21_0 phase25_0)
(begin
'make-to-module-lift-context
- (let-values (((phase_112) phase25_0))
+ (let-values (((phase_137) phase25_0))
(let-values (((ends_0) shared-module-ends21_0))
(let-values (((end-as-expressions?_0) end-as-expressions?22_0))
- (let-values () (to-module-lift-context20.1 phase_112 (box null) end-as-expressions?_0 ends_0))))))))
+ (to-module-lift-context20.1 phase_137 (box null) end-as-expressions?_0 ends_0)))))))
(define-values (make-shared-module-ends) (lambda () (begin (box null))))
(define-values
(get-and-clear-end-lifts!)
@@ -45993,123 +45730,104 @@
(lambda (to-module-lifts_2) (begin (box-clear! (to-module-lift-context-provides to-module-lifts_2)))))
(define-values
(add-lifted-to-module-provide!)
- (lambda (to-module-lifts_3 s_206 phase_113)
- (begin (box-cons! (to-module-lift-context-provides to-module-lifts_3) s_206))))
+ (lambda (to-module-lifts_3 s_630 phase_138)
+ (begin (box-cons! (to-module-lift-context-provides to-module-lifts_3) s_630))))
(define-values
(add-lifted-to-module-end!)
- (lambda (to-module-lifts_4 s_468 phase_114)
- (begin (box-cons! (to-module-lift-context-ends to-module-lifts_4) s_468))))
+ (lambda (to-module-lifts_4 s_631 phase_139)
+ (begin (box-cons! (to-module-lift-context-ends to-module-lifts_4) s_631))))
(define-values
(struct:already-expanded already-expanded1.1 already-expanded? already-expanded-s already-expanded-binding-layer)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'expanded-syntax
- #f
- 2
- 0
- #f
- null
- (current-inspector)
- #f
- '(0 1)
- #f
- 'already-expanded)))))
+ (let-values (((struct:_120 make-_120 ?_120 -ref_120 -set!_120)
+ (make-struct-type 'expanded-syntax #f 2 0 #f null (current-inspector) #f '(0 1) #f 'already-expanded)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 's)
- (make-struct-field-accessor -ref_2 1 'binding-layer))))
+ struct:_120
+ make-_120
+ ?_120
+ (make-struct-field-accessor -ref_120 0 's)
+ (make-struct-field-accessor -ref_120 1 '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-values
(struct:liberal-define-context make-liberal-define-context 1/liberal-define-context?)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'liberal-define-context
- #f
- 0
- 0
- #f
- (list (cons 1/prop:liberal-define-context #t))
- (current-inspector)
- #f
- '()
- #f
- 'make-liberal-define-context)))))
- (values struct:_2 make-_2 ?_2)))
+ (let-values (((struct:_121 make-_121 ?_121 -ref_121 -set!_121)
+ (make-struct-type
+ 'liberal-define-context
+ #f
+ 0
+ 0
+ #f
+ (list (cons 1/prop:liberal-define-context #t))
+ (current-inspector)
+ #f
+ '()
+ #f
+ 'make-liberal-define-context)))
+ (values struct:_121 make-_121 ?_121)))
(define-values
(1/prop:expansion-contexts expansion-contexts? expansion-contexts-ref)
(make-struct-type-property
'expansion-contexts
- (lambda (v_29 info_0)
+ (lambda (v_271 info_7)
(begin
- (if (if (list? v_29)
- (let-values (((lst_85) v_29))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_85)))
- ((letrec-values (((for-loop_100)
- (lambda (result_83 lst_86)
- (begin
- 'for-loop
- (if (pair? lst_86)
- (let-values (((s_325) (unsafe-car lst_86)) ((rest_40) (unsafe-cdr lst_86)))
- (let-values (((result_61)
- (let-values ()
- (let-values (((result_124)
- (let-values ()
- (let-values ()
- (memq
- s_325
- '(expression
- top-level
- module
- module-begin
- definition-context))))))
- (values result_124)))))
- (if (if (not ((lambda x_86 (not result_61)) s_325)) (not #f) #f)
- (for-loop_100 result_61 rest_40)
- result_61)))
- result_83)))))
- for-loop_100)
- #t
- lst_85)))
+ (if (if (list? v_271)
+ (let-values (((result_229) (let-values (((result_230) #t)) result_230)))
+ (let-values (((lst_468) v_271))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_468))
+ ((letrec-values (((for-loop_396)
+ (lambda (result_231 lst_469)
+ (begin
+ 'for-loop
+ (if (pair? lst_469)
+ (let-values (((s_632) (unsafe-car lst_469))
+ ((rest_230) (unsafe-cdr lst_469)))
+ (let-values (((result_232)
+ (let-values (((result_233)
+ (memq
+ s_632
+ '(expression
+ top-level
+ module
+ module-begin
+ definition-context))))
+ (values result_233))))
+ (if (if (not ((lambda x_93 (not result_232)) s_632)) (not #f) #f)
+ (for-loop_396 result_232 rest_230)
+ result_232)))
+ result_231)))))
+ for-loop_396)
+ result_229
+ lst_468))))
#f)
(void)
- (let-values ()
- (raise-argument-error
- 'guard-for-prop:expansion-contexts
- "(listof (or/c 'expression 'top-level 'module 'module-begin 'definition-context))"
- v_29)))
- v_29))))
+ (raise-argument-error
+ 'guard-for-prop:expansion-contexts
+ "(listof (or/c 'expression 'top-level 'module 'module-begin 'definition-context))"
+ v_271))
+ v_271))))
(define-values
(not-in-this-expand-context?)
- (lambda (t_20 ctx_13)
+ (lambda (t_24 ctx_15)
(begin
- (if (expansion-contexts? t_20)
- (not (memq (context->symbol (expand-context-context ctx_13)) (expansion-contexts-ref t_20)))
+ (if (expansion-contexts? t_24)
+ (not (memq (context->symbol (expand-context-context ctx_15)) (expansion-contexts-ref t_24)))
#f))))
(define-values (context->symbol) (lambda (context_5) (begin (if (symbol? context_5) context_5 'definition-context))))
(define-values
(avoid-current-expand-context)
- (lambda (s_48 t_14 ctx_14)
+ (lambda (s_633 t_25 ctx_16)
(begin
(let-values (((wrap_1)
- (lambda (sym_77)
+ (lambda (sym_92)
(begin
'wrap
(datum->syntax$1
#f
(list
- (syntax-shift-phase-level$1 (datum->syntax$1 core-stx sym_77) (expand-context-phase ctx_14))
- s_48))))))
+ (syntax-shift-phase-level$1 (datum->syntax$1 core-stx sym_92) (expand-context-phase ctx_16))
+ s_633))))))
(let-values (((fail_0)
(lambda ()
(begin
@@ -46118,14 +45836,14 @@
#f
(format
"not allowed in context\n expansion context: ~a"
- (context->symbol (expand-context-context ctx_14)))
- s_48)))))
- (let-values (((tmp_33) (context->symbol (expand-context-context ctx_14))))
- (if (equal? tmp_33 'module-begin)
- (let-values () (wrap_1 'begin))
- (if (if (equal? tmp_33 'module) #t (if (equal? tmp_33 'top-level) #t (equal? tmp_33 'definition-context)))
- (let-values () (if (memq 'expression (expansion-contexts-ref t_14)) (wrap_1 '#%expression) (fail_0)))
- (let-values () (fail_0))))))))))
+ (context->symbol (expand-context-context ctx_16)))
+ s_633)))))
+ (let-values (((tmp_35) (context->symbol (expand-context-context ctx_16))))
+ (if (equal? tmp_35 'module-begin)
+ (wrap_1 'begin)
+ (if (if (equal? tmp_35 'module) #t (if (equal? tmp_35 'top-level) #t (equal? tmp_35 'definition-context)))
+ (if (memq 'expression (expansion-contexts-ref t_25)) (wrap_1 '#%expression) (fail_0))
+ (fail_0)))))))))
(define-values
(struct:reference-record
reference-record1.1
@@ -46136,125 +45854,116 @@
set-reference-record-already-bound!
set-reference-record-reference-before-bound!
set-reference-record-all-referenced?!)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'reference-record
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- #f
- #f
- '()
- #f
- 'reference-record)))))
+ (let-values (((struct:_122 make-_122 ?_122 -ref_122 -set!_122)
+ (make-struct-type
+ 'reference-record
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ #f
+ #f
+ '()
+ #f
+ 'reference-record)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'already-bound)
- (make-struct-field-accessor -ref_2 1 'reference-before-bound)
- (make-struct-field-accessor -ref_2 2 'all-referenced?)
- (make-struct-field-mutator -set!_2 0 'already-bound)
- (make-struct-field-mutator -set!_2 1 'reference-before-bound)
- (make-struct-field-mutator -set!_2 2 'all-referenced?))))
+ struct:_122
+ make-_122
+ ?_122
+ (make-struct-field-accessor -ref_122 0 'already-bound)
+ (make-struct-field-accessor -ref_122 1 'reference-before-bound)
+ (make-struct-field-accessor -ref_122 2 'all-referenced?)
+ (make-struct-field-mutator -set!_122 0 'already-bound)
+ (make-struct-field-mutator -set!_122 1 'reference-before-bound)
+ (make-struct-field-mutator -set!_122 2 'all-referenced?))))
(define-values (make-reference-record) (lambda () (begin (reference-record1.1 (seteq) (seteq) #f))))
(define-values
(reference-record-used!)
- (lambda (rr_0 key_90)
+ (lambda (rr_0 key_102)
(begin
- (if (set-member? (reference-record-already-bound rr_0) key_90)
+ (if (set-member? (reference-record-already-bound rr_0) key_102)
(void)
- (let-values ()
- (set-reference-record-reference-before-bound!
- rr_0
- (set-add (reference-record-reference-before-bound rr_0) key_90)))))))
+ (set-reference-record-reference-before-bound!
+ rr_0
+ (set-add (reference-record-reference-before-bound rr_0) key_102))))))
(define-values
(reference-records-all-used!)
(lambda (rrs_0)
(begin
(begin
- (let-values (((lst_89) rrs_0))
+ (let-values (((lst_470) rrs_0))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_89)))
- ((letrec-values (((for-loop_171)
- (lambda (lst_234)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_470))
+ ((letrec-values (((for-loop_397)
+ (lambda (lst_471)
(begin
'for-loop
- (if (pair? lst_234)
- (let-values (((rr_1) (unsafe-car lst_234)) ((rest_161) (unsafe-cdr lst_234)))
- (let-values ()
- (let-values (((next-k-proc_0)
- (lambda () (begin 'next-k-proc (for-loop_171 rest_161)))))
- (let-values ()
- (if (reference-record-all-referenced? rr_1)
- (values)
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (set-reference-record-all-referenced?! rr_1 #t))
- (values)))))
- (next-k-proc_0))))))))
+ (if (pair? lst_471)
+ (let-values (((rr_1) (unsafe-car lst_471)) ((rest_231) (unsafe-cdr lst_471)))
+ (let-values (((next-k-proc_0)
+ (lambda () (begin 'next-k-proc (for-loop_397 rest_231)))))
+ (if (reference-record-all-referenced? rr_1)
+ (values)
+ (let-values ((()
+ (begin
+ (set-reference-record-all-referenced?! rr_1 #t)
+ (values))))
+ (next-k-proc_0)))))
(values))))))
- for-loop_171)
- lst_89)))
+ for-loop_397)
+ lst_470)))
(void)))))
(define-values
(reference-record-bound!)
- (lambda (rr_2 keys_3)
+ (lambda (rr_2 keys_4)
(begin
(begin
(set-reference-record-already-bound!
rr_2
- (let-values (((lst_283) keys_3))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_283)))
- ((letrec-values (((for-loop_254)
- (lambda (ab_3 lst_298)
- (begin
- 'for-loop
- (if (pair? lst_298)
- (let-values (((key_75) (unsafe-car lst_298)) ((rest_162) (unsafe-cdr lst_298)))
- (let-values (((ab_4)
- (let-values (((ab_5) ab_3))
- (let-values (((ab_6) (let-values () (set-add ab_5 key_75))))
- (values ab_6)))))
- (if (not #f) (for-loop_254 ab_4 rest_162) ab_4)))
- ab_3)))))
- for-loop_254)
- (reference-record-already-bound rr_2)
- lst_283))))
+ (let-values (((ab_3) (let-values (((ab_4) (reference-record-already-bound rr_2))) ab_4)))
+ (let-values (((lst_472) keys_4))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_472))
+ ((letrec-values (((for-loop_398)
+ (lambda (ab_5 lst_473)
+ (begin
+ 'for-loop
+ (if (pair? lst_473)
+ (let-values (((key_103) (unsafe-car lst_473)) ((rest_232) (unsafe-cdr lst_473)))
+ (let-values (((ab_6)
+ (let-values (((ab_7) (set-add ab_5 key_103))) (values ab_7))))
+ (if (not #f) (for-loop_398 ab_6 rest_232) ab_6)))
+ ab_5)))))
+ for-loop_398)
+ ab_3
+ lst_472)))))
(set-reference-record-reference-before-bound!
rr_2
- (let-values (((lst_299) keys_3))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_299)))
- ((letrec-values (((for-loop_102)
- (lambda (rbb_0 lst_104)
- (begin
- 'for-loop
- (if (pair? lst_104)
- (let-values (((key_91) (unsafe-car lst_104)) ((rest_163) (unsafe-cdr lst_104)))
- (let-values (((rbb_1)
- (let-values (((rbb_2) rbb_0))
- (let-values (((rbb_3) (let-values () (set-remove rbb_2 key_91))))
- (values rbb_3)))))
- (if (not #f) (for-loop_102 rbb_1 rest_163) rbb_1)))
- rbb_0)))))
- for-loop_102)
- (reference-record-reference-before-bound rr_2)
- lst_299))))))))
+ (let-values (((rbb_0) (let-values (((rbb_1) (reference-record-reference-before-bound rr_2))) rbb_1)))
+ (let-values (((lst_474) keys_4))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_474))
+ ((letrec-values (((for-loop_399)
+ (lambda (rbb_2 lst_475)
+ (begin
+ 'for-loop
+ (if (pair? lst_475)
+ (let-values (((key_104) (unsafe-car lst_475)) ((rest_233) (unsafe-cdr lst_475)))
+ (let-values (((rbb_3)
+ (let-values (((rbb_4) (set-remove rbb_2 key_104)))
+ (values rbb_4))))
+ (if (not #f) (for-loop_399 rbb_3 rest_233) rbb_3)))
+ rbb_2)))))
+ for-loop_399)
+ rbb_0
+ lst_474)))))))))
(define-values
(reference-record-forward-references?)
(lambda (rr_3)
(begin
- (let-values (((or-part_276) (reference-record-all-referenced? rr_3)))
- (if or-part_276 or-part_276 (positive? (set-count (reference-record-reference-before-bound rr_3))))))))
+ (let-values (((or-part_452) (reference-record-all-referenced? rr_3)))
+ (if or-part_452 or-part_452 (positive? (set-count (reference-record-reference-before-bound rr_3))))))))
(define-values
(reference-record-clear!)
(lambda (rr_4)
@@ -46262,19 +45971,19 @@
(begin (set-reference-record-already-bound! rr_4 #f) (set-reference-record-reference-before-bound! rr_4 #f)))))
(define-values
(call-expand-observe)
- (lambda (obs_0 key_92 . args_6)
+ (lambda (obs_0 key_105 . args_9)
(begin
(begin
- (let-values (((c1_31) (hash-ref key->arity key_92 #f)))
- (if c1_31
+ (let-values (((cond-val_23) (hash-ref key->arity key_105 #f)))
+ (if cond-val_23
((lambda (arity_2)
- (if (let-values (((or-part_277) (eq? arity_2 'any)))
- (if or-part_277 or-part_277 (eqv? (length args_6) arity_2)))
+ (if (let-values (((or-part_453) (eq? arity_2 'any)))
+ (if or-part_453 or-part_453 (eqv? (length args_9) arity_2)))
(void)
- (let-values () (error 'call-expand-observe "wrong arity for ~s: ~e" key_92 args_6))))
- c1_31)
- (let-values () (error 'call-expand-observe "bad key: ~s" key_92))))
- (obs_0 key_92 (if (null? args_6) (let-values () #f) (let-values () (apply list* args_6))))))))
+ (error 'call-expand-observe "wrong arity for ~s: ~e" key_105 args_9)))
+ cond-val_23)
+ (error 'call-expand-observe "bad key: ~s" key_105)))
+ (obs_0 key_105 (if (null? args_9) #f (apply list* args_9)))))))
(define-values
(key->arity)
'#hash((block->letrec . 3)
@@ -46374,33 +46083,31 @@
(lambda (track?1_0 orig-s3_0 new4_0)
(begin
'rebuild
- (let-values (((orig-s_35) orig-s3_0))
+ (let-values (((orig-s_36) orig-s3_0))
(let-values (((new_3) new4_0))
(let-values (((track?_0) track?1_0))
- (let-values () (datum->syntax$1 orig-s_35 new_3 orig-s_35 (if track?_0 orig-s_35 #f)))))))))
+ (datum->syntax$1 orig-s_36 new_3 orig-s_36 (if track?_0 orig-s_36 #f))))))))
(define-values
(struct:expanded+parsed expanded+parsed1.1 expanded+parsed? expanded+parsed-s expanded+parsed-parsed)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'expanded+parsed
- #f
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'expanded+parsed)))))
+ (let-values (((struct:_123 make-_123 ?_123 -ref_123 -set!_123)
+ (make-struct-type
+ 'expanded+parsed
+ #f
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'expanded+parsed)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 's)
- (make-struct-field-accessor -ref_2 1 'parsed))))
+ struct:_123
+ make-_123
+ ?_123
+ (make-struct-field-accessor -ref_123 0 's)
+ (make-struct-field-accessor -ref_123 1 'parsed))))
(define-values
(struct:semi-parsed-define-values
semi-parsed-define-values2.1
@@ -46409,917 +46116,792 @@
semi-parsed-define-values-syms
semi-parsed-define-values-ids
semi-parsed-define-values-rhs)
- (let-values (((struct:_3 make-_3 ?_3 -ref_3 -set!_3)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'semi-parsed-define-values
- #f
- 4
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3)
- #f
- 'semi-parsed-define-values)))))
+ (let-values (((struct:_124 make-_124 ?_124 -ref_124 -set!_124)
+ (make-struct-type
+ 'semi-parsed-define-values
+ #f
+ 4
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3)
+ #f
+ 'semi-parsed-define-values)))
(values
- struct:_3
- make-_3
- ?_3
- (make-struct-field-accessor -ref_3 0 's)
- (make-struct-field-accessor -ref_3 1 'syms)
- (make-struct-field-accessor -ref_3 2 'ids)
- (make-struct-field-accessor -ref_3 3 'rhs))))
+ struct:_124
+ make-_124
+ ?_124
+ (make-struct-field-accessor -ref_124 0 's)
+ (make-struct-field-accessor -ref_124 1 'syms)
+ (make-struct-field-accessor -ref_124 2 'ids)
+ (make-struct-field-accessor -ref_124 3 'rhs))))
(define-values
(struct:semi-parsed-begin-for-syntax
semi-parsed-begin-for-syntax3.1
semi-parsed-begin-for-syntax?
semi-parsed-begin-for-syntax-s
semi-parsed-begin-for-syntax-body)
- (let-values (((struct:_6 make-_6 ?_6 -ref_6 -set!_6)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'semi-parsed-begin-for-syntax
- #f
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'semi-parsed-begin-for-syntax)))))
+ (let-values (((struct:_125 make-_125 ?_125 -ref_125 -set!_125)
+ (make-struct-type
+ 'semi-parsed-begin-for-syntax
+ #f
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'semi-parsed-begin-for-syntax)))
(values
- struct:_6
- make-_6
- ?_6
- (make-struct-field-accessor -ref_6 0 's)
- (make-struct-field-accessor -ref_6 1 'body))))
- (define-values (extract-syntax) (lambda (s_4) (begin (if (expanded+parsed? s_4) (expanded+parsed-s s_4) s_4))))
+ struct:_125
+ make-_125
+ ?_125
+ (make-struct-field-accessor -ref_125 0 's)
+ (make-struct-field-accessor -ref_125 1 'body))))
+ (define-values (extract-syntax) (lambda (s_634) (begin (if (expanded+parsed? s_634) (expanded+parsed-s s_634) s_634))))
(define-values
(parsed-only)
- (lambda (l_57)
+ (lambda (l_68)
(begin
(reverse$1
- (let-values (((lst_298) l_57))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_298)))
- ((letrec-values (((for-loop_269)
- (lambda (fold-var_34 lst_192)
- (begin
- 'for-loop
- (if (pair? lst_192)
- (let-values (((i_198) (unsafe-car lst_192)) ((rest_164) (unsafe-cdr lst_192)))
- (let-values (((fold-var_207)
- (let-values (((fold-var_81) fold-var_34))
- (if (let-values (((or-part_4) (parsed? i_198)))
- (if or-part_4
- or-part_4
- (let-values (((or-part_5) (expanded+parsed? i_198)))
- (if or-part_5
- or-part_5
- (semi-parsed-begin-for-syntax? i_198)))))
- (let-values (((fold-var_30) fold-var_81))
- (let-values (((fold-var_31)
- (let-values ()
- (cons
- (let-values ()
- (if (expanded+parsed? i_198)
- (let-values ()
- (expanded+parsed-parsed i_198))
- (if (semi-parsed-begin-for-syntax? i_198)
- (let-values ()
- (parsed-begin-for-syntax21.1
- (semi-parsed-begin-for-syntax-s
- i_198)
- (parsed-only
- (semi-parsed-begin-for-syntax-body
- i_198))))
- (let-values () i_198))))
- fold-var_30))))
- (values fold-var_31)))
- fold-var_81))))
- (if (not #f) (for-loop_269 fold-var_207 rest_164) fold-var_207)))
- fold-var_34)))))
- for-loop_269)
- null
- lst_298)))))))
+ (let-values (((fold-var_495) (let-values (((fold-var_496) null)) fold-var_496)))
+ (let-values (((lst_476) l_68))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_476))
+ ((letrec-values (((for-loop_400)
+ (lambda (fold-var_497 lst_477)
+ (begin
+ 'for-loop
+ (if (pair? lst_477)
+ (let-values (((i_286) (unsafe-car lst_477)) ((rest_234) (unsafe-cdr lst_477)))
+ (let-values (((fold-var_498)
+ (if (let-values (((or-part_454) (parsed? i_286)))
+ (if or-part_454
+ or-part_454
+ (let-values (((or-part_455) (expanded+parsed? i_286)))
+ (if or-part_455
+ or-part_455
+ (semi-parsed-begin-for-syntax? i_286)))))
+ (let-values (((fold-var_499)
+ (cons
+ (if (expanded+parsed? i_286)
+ (expanded+parsed-parsed i_286)
+ (if (semi-parsed-begin-for-syntax? i_286)
+ (parsed-begin-for-syntax22.1
+ (semi-parsed-begin-for-syntax-s i_286)
+ (parsed-only
+ (semi-parsed-begin-for-syntax-body i_286)))
+ i_286))
+ fold-var_497)))
+ (values fold-var_499))
+ fold-var_497)))
+ (if (not #f) (for-loop_400 fold-var_498 rest_234) fold-var_498)))
+ fold-var_497)))))
+ for-loop_400)
+ fold-var_495
+ lst_476))))))))
(define-values
(syntax-only)
- (lambda (l_54)
+ (lambda (l_69)
(begin
(reverse$1
- (let-values (((lst_106) l_54))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_106)))
- ((letrec-values (((for-loop_270)
- (lambda (fold-var_208 lst_194)
- (begin
- 'for-loop
- (if (pair? lst_194)
- (let-values (((i_181) (unsafe-car lst_194)) ((rest_44) (unsafe-cdr lst_194)))
- (let-values (((fold-var_130)
- (let-values (((fold-var_84) fold-var_208))
- (if (let-values (((or-part_99) (syntax?$1 i_181)))
- (if or-part_99
- or-part_99
- (let-values (((or-part_105) (expanded+parsed? i_181)))
- (if or-part_105
- or-part_105
- (semi-parsed-begin-for-syntax? i_181)))))
- (let-values (((fold-var_196) fold-var_84))
- (let-values (((fold-var_209)
- (let-values ()
- (cons
- (let-values ()
- (if (expanded+parsed? i_181)
- (let-values () (expanded+parsed-s i_181))
- (if (semi-parsed-begin-for-syntax? i_181)
- (let-values ()
- (let-values (((s_86)
- (semi-parsed-begin-for-syntax-s
- i_181)))
- (let-values (((nested-bodys_0)
- (semi-parsed-begin-for-syntax-body
- i_181)))
- (let-values (((ok?_31
- begin-for-syntax7_0
- _8_0)
- (let-values (((s_469)
- s_86))
- (let-values (((orig-s_36)
- s_469))
- (let-values (((begin-for-syntax7_1
- _8_1)
- (let-values (((s_470)
- (if (syntax?$1
- s_469)
- (syntax-e$1
- s_469)
- s_469)))
- (if (pair?
- s_470)
- (let-values (((begin-for-syntax9_0)
- (let-values (((s_176)
- (car
- s_470)))
- s_176))
- ((_10_0)
- (let-values (((s_81)
- (cdr
- s_470)))
- (let-values (((s_471)
- (if (syntax?$1
- s_81)
- (syntax-e$1
- s_81)
- s_81)))
- (let-values (((flat-s_21)
- (to-syntax-list.1
- s_471)))
- (if (not
- flat-s_21)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_36))
- (let-values ()
- flat-s_21)))))))
- (values
- begin-for-syntax9_0
- _10_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_36)))))
- (values
- #t
- begin-for-syntax7_1
- _8_1))))))
- (let-values (((s11_0) s_86)
- ((temp12_5)
- (list*
- begin-for-syntax7_0
- (syntax-only
- nested-bodys_0))))
- (rebuild.1
- #t
- s11_0
- temp12_5))))))
- (let-values () i_181))))
- fold-var_196))))
- (values fold-var_209)))
- fold-var_84))))
- (if (not #f) (for-loop_270 fold-var_130 rest_44) fold-var_130)))
- fold-var_208)))))
- for-loop_270)
- null
- lst_106)))))))
+ (let-values (((fold-var_500) (let-values (((fold-var_501) null)) fold-var_501)))
+ (let-values (((lst_478) l_69))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_478))
+ ((letrec-values (((for-loop_401)
+ (lambda (fold-var_502 lst_479)
+ (begin
+ 'for-loop
+ (if (pair? lst_479)
+ (let-values (((i_287) (unsafe-car lst_479)) ((rest_235) (unsafe-cdr lst_479)))
+ (let-values (((fold-var_503)
+ (if (let-values (((or-part_456) (syntax?$1 i_287)))
+ (if or-part_456
+ or-part_456
+ (let-values (((or-part_457) (expanded+parsed? i_287)))
+ (if or-part_457
+ or-part_457
+ (semi-parsed-begin-for-syntax? i_287)))))
+ (let-values (((fold-var_504)
+ (cons
+ (if (expanded+parsed? i_287)
+ (expanded+parsed-s i_287)
+ (if (semi-parsed-begin-for-syntax? i_287)
+ (let-values (((s_635)
+ (semi-parsed-begin-for-syntax-s
+ i_287)))
+ (let-values (((nested-bodys_0)
+ (semi-parsed-begin-for-syntax-body
+ i_287)))
+ (let-values (((ok?_32
+ begin-for-syntax7_0
+ _8_0)
+ (let-values (((s_636)
+ s_635))
+ (let-values (((orig-s_37)
+ s_636))
+ (let-values (((begin-for-syntax7_1
+ _8_1)
+ (let-values (((s_637)
+ (if (syntax?$1
+ s_636)
+ (syntax-e$1
+ s_636)
+ s_636)))
+ (if (pair?
+ s_637)
+ (let-values (((begin-for-syntax9_0)
+ (let-values (((s_638)
+ (car
+ s_637)))
+ s_638))
+ ((_10_0)
+ (let-values (((s_639)
+ (cdr
+ s_637)))
+ (let-values (((s_640)
+ (if (syntax?$1
+ s_639)
+ (syntax-e$1
+ s_639)
+ s_639)))
+ (let-values (((flat-s_22)
+ (to-syntax-list.1
+ s_640)))
+ (if (not
+ flat-s_22)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_37)
+ flat-s_22))))))
+ (values
+ begin-for-syntax9_0
+ _10_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_37)))))
+ (values
+ #t
+ begin-for-syntax7_1
+ _8_1))))))
+ (let-values (((s11_0) s_635)
+ ((temp12_5)
+ (list*
+ begin-for-syntax7_0
+ (syntax-only
+ nested-bodys_0))))
+ (rebuild.1 #t s11_0 temp12_5)))))
+ i_287))
+ fold-var_502)))
+ (values fold-var_504))
+ fold-var_502)))
+ (if (not #f) (for-loop_401 fold-var_503 rest_235) fold-var_503)))
+ fold-var_502)))))
+ for-loop_401)
+ fold-var_500
+ lst_478))))))))
(define-values (implicit-made-explicit-properties) (hasheq 'implicit-made-explicit #t))
(define-values
(original-implicit-made-explicit-properties)
(hash-set implicit-made-explicit-properties original-property-sym #t))
(define-values
(raise-bindings-arity-error)
- (lambda (who_0 ids_1 vals_3)
+ (lambda (who_27 ids_21 vals_3)
(begin
(apply
raise-result-arity-error
- who_0
- (length ids_1)
- (if (null? ids_1)
- (let-values () "")
- (let-values ()
- (format "\n in: definition of ~a~a" (syntax-e$1 (car ids_1)) (if (pair? (cdr ids_1)) " ..." ""))))
+ who_27
+ (length ids_21)
+ (if (null? ids_21)
+ ""
+ (format "\n in: definition of ~a~a" (syntax-e$1 (car ids_21)) (if (pair? (cdr ids_21)) " ..." "")))
vals_3))))
(define-values
(expand.1)
(lambda (alternate-id1_0 fail-non-transformer2_0 s5_2 ctx6_0)
(begin
'expand
- (let-values (((s_472) s5_2))
- (let-values (((ctx_15) ctx6_0))
+ (let-values (((s_641) s5_2))
+ (let-values (((ctx_17) ctx6_0))
(let-values (((alternate-id_0) alternate-id1_0))
(let-values (((fail-non-transformer_0) fail-non-transformer2_0))
- (let-values ()
- (let-values ((()
- (begin
- (let-values (((obs_1) (expand-context-observer ctx_15)))
- (if obs_1
- (let-values () (let-values () (call-expand-observe obs_1 'visit s_472)))
- (void)))
- (values))))
- (let-values (((content_21) (syntax-content s_472)))
- (if (symbol? content_21)
- (let-values () (expand-identifier s_472 ctx_15 alternate-id_0))
- (if (if (pair? content_21) (syntax-identifier? (car content_21)) #f)
- (let-values ()
- (let-values (((s109_0) s_472)
- ((ctx110_0) ctx_15)
- ((alternate-id111_0) alternate-id_0)
- ((fail-non-transformer112_0) fail-non-transformer_0))
- (expand-id-application-form.1 fail-non-transformer112_0 s109_0 ctx110_0 alternate-id111_0)))
- (if (let-values (((or-part_278) (pair? content_21)))
- (if or-part_278 or-part_278 (null? content_21)))
- (let-values () (expand-implicit '#%app s_472 ctx_15 #f))
- (if (already-expanded? content_21)
- (let-values () (expand-already-expanded s_472 ctx_15))
- (let-values () (expand-implicit '#%datum s_472 ctx_15 #f))))))))))))))))
+ (let-values ((()
+ (begin
+ (let-values (((obs_1) (expand-context-observer ctx_17)))
+ (if obs_1 (call-expand-observe obs_1 'visit s_641) (void)))
+ (values))))
+ (let-values (((content_21) (syntax-content s_641)))
+ (if (symbol? content_21)
+ (expand-identifier s_641 ctx_17 alternate-id_0)
+ (if (if (pair? content_21) (syntax-identifier? (car content_21)) #f)
+ (let-values (((s109_0) s_641)
+ ((ctx110_0) ctx_17)
+ ((alternate-id111_0) alternate-id_0)
+ ((fail-non-transformer112_0) fail-non-transformer_0))
+ (expand-id-application-form.1 fail-non-transformer112_0 s109_0 ctx110_0 alternate-id111_0))
+ (if (let-values (((or-part_458) (pair? content_21)))
+ (if or-part_458 or-part_458 (null? content_21)))
+ (expand-implicit '#%app s_641 ctx_17 #f)
+ (if (already-expanded? content_21)
+ (expand-already-expanded s_641 ctx_17)
+ (expand-implicit '#%datum s_641 ctx_17 #f))))))))))))))
(define-values
(expand-identifier)
- (lambda (s_97 ctx_16 alternate-id_1)
+ (lambda (s_642 ctx_18 alternate-id_1)
(begin
- (let-values (((id_70) (let-values (((or-part_231) alternate-id_1)) (if or-part_231 or-part_231 s_97))))
- (if (if (not (free-id-set-empty? (expand-context-stops ctx_16)))
- (free-id-set-member? (expand-context-stops ctx_16) (expand-context-phase ctx_16) id_70)
+ (let-values (((id_79) (let-values (((or-part_459) alternate-id_1)) (if or-part_459 or-part_459 s_642))))
+ (if (if (not (free-id-set-empty? (expand-context-stops ctx_18)))
+ (free-id-set-member? (expand-context-stops ctx_18) (expand-context-phase ctx_18) id_79)
#f)
- (let-values ()
+ (begin
+ (let-values (((obs_2) (expand-context-observer ctx_18)))
+ (if obs_2
+ (begin (call-expand-observe obs_2 'resolve id_79) (call-expand-observe obs_2 'stop/return s_642))
+ (void)))
+ s_642)
+ (let-values (((binding_19)
+ (let-values (((id113_0) id_79)
+ ((temp114_0) (expand-context-phase ctx_18))
+ ((temp115_0) 'ambiguous)
+ ((temp116_0) #t))
+ (resolve+shift.1 temp115_0 #f null temp116_0 #f id113_0 temp114_0))))
(begin
- (let-values (((obs_2) (expand-context-observer ctx_16)))
- (if obs_2
- (let-values ()
- (let-values ()
- (begin (call-expand-observe obs_2 'resolve id_70) (call-expand-observe obs_2 'stop/return s_97))))
- (void)))
- s_97))
- (let-values ()
- (let-values (((binding_18)
- (let-values (((id113_1) id_70)
- ((temp114_0) (expand-context-phase ctx_16))
- ((temp115_0) 'ambiguous)
- ((temp116_0) #t))
- (resolve+shift.1 temp115_0 #f null temp116_0 #f id113_1 temp114_0))))
- (begin
- (let-values (((obs_3) (expand-context-observer ctx_16)))
- (if obs_3 (let-values () (let-values () (call-expand-observe obs_3 'resolve id_70))) (void)))
- (if (eq? binding_18 'ambiguous)
- (let-values () (raise-ambiguous-error id_70 ctx_16))
- (if (not binding_18)
- (let-values () (expand-implicit '#%top (substitute-alternate-id s_97 alternate-id_1) ctx_16 s_97))
- (let-values ()
- (let-values (((t_21 primitive?_2 insp-of-t_0 protected?_4)
- (let-values (((binding125_0) binding_18)
- ((ctx126_0) ctx_16)
- ((id127_0) id_70)
- ((temp128_2) (if alternate-id_1 s_97 #f))
- ((temp129_2) (expand-context-in-local-expand? ctx_16)))
- (lookup.1 temp128_2 temp129_2 binding125_0 ctx126_0 id127_0))))
- (let-values (((t117_0) t_21)
- ((insp-of-t118_0) insp-of-t_0)
- ((s119_0) s_97)
- ((id120_0) id_70)
- ((ctx121_0) ctx_16)
- ((binding122_0) binding_18)
- ((primitive?123_0) primitive?_2)
- ((protected?124_0) protected?_4))
- (dispatch.1
- #f
- t117_0
- insp-of-t118_0
- s119_0
- id120_0
- ctx121_0
- binding122_0
- primitive?123_0
- protected?124_0))))))))))))))
+ (let-values (((obs_3) (expand-context-observer ctx_18)))
+ (if obs_3 (call-expand-observe obs_3 'resolve id_79) (void)))
+ (if (eq? binding_19 'ambiguous)
+ (raise-ambiguous-error id_79 ctx_18)
+ (if (not binding_19)
+ (expand-implicit '#%top (substitute-alternate-id s_642 alternate-id_1) ctx_18 s_642)
+ (let-values (((t_26 primitive?_2 insp-of-t_0 protected?_4)
+ (let-values (((binding125_0) binding_19)
+ ((ctx126_0) ctx_18)
+ ((id127_0) id_79)
+ ((temp128_1) (if alternate-id_1 s_642 #f))
+ ((temp129_1) (expand-context-in-local-expand? ctx_18)))
+ (lookup.1 temp128_1 temp129_1 binding125_0 ctx126_0 id127_0))))
+ (let-values (((t117_0) t_26)
+ ((insp-of-t118_0) insp-of-t_0)
+ ((s119_0) s_642)
+ ((id120_0) id_79)
+ ((ctx121_0) ctx_18)
+ ((binding122_0) binding_19)
+ ((primitive?123_0) primitive?_2)
+ ((protected?124_0) protected?_4))
+ (dispatch.1
+ #f
+ t117_0
+ insp-of-t118_0
+ s119_0
+ id120_0
+ ctx121_0
+ binding122_0
+ primitive?123_0
+ protected?124_0))))))))))))
(define-values
(expand-id-application-form.1)
(lambda (fail-non-transformer8_0 s10_1 ctx11_0 alternate-id12_0)
(begin
'expand-id-application-form
- (let-values (((s_473) s10_1))
- (let-values (((ctx_17) ctx11_0))
+ (let-values (((s_643) s10_1))
+ (let-values (((ctx_19) ctx11_0))
(let-values (((alternate-id_2) alternate-id12_0))
(let-values (((fail-non-transformer_1) fail-non-transformer8_0))
- (let-values ()
- (let-values (((id_10)
- (let-values (((or-part_149) alternate-id_2))
- (if or-part_149 or-part_149 (car (syntax-e$1 s_473))))))
- (if (if (not (free-id-set-empty? (expand-context-stops ctx_17)))
- (free-id-set-member? (expand-context-stops ctx_17) (expand-context-phase ctx_17) id_10)
- #f)
- (let-values ()
- (begin
- (let-values (((obs_4) (expand-context-observer ctx_17)))
- (if obs_4
- (let-values ()
- (let-values ()
- (begin
- (call-expand-observe obs_4 'resolve id_10)
- (call-expand-observe obs_4 'stop/return s_473))))
- (void)))
- s_473))
- (let-values ()
- (let-values (((binding_19)
- (let-values (((id130_0) id_10)
- ((temp131_0) (expand-context-phase ctx_17))
- ((temp132_2) 'ambiguous)
- ((temp133_1) #t))
- (resolve+shift.1 temp132_2 #f null temp133_1 #f id130_0 temp131_0))))
+ (let-values (((id_80)
+ (let-values (((or-part_460) alternate-id_2))
+ (if or-part_460 or-part_460 (car (syntax-e$1 s_643))))))
+ (if (if (not (free-id-set-empty? (expand-context-stops ctx_19)))
+ (free-id-set-member? (expand-context-stops ctx_19) (expand-context-phase ctx_19) id_80)
+ #f)
+ (begin
+ (let-values (((obs_4) (expand-context-observer ctx_19)))
+ (if obs_4
(begin
- (let-values (((obs_5) (expand-context-observer ctx_17)))
- (if obs_5
- (let-values () (let-values () (call-expand-observe obs_5 'resolve id_10)))
- (void)))
- (if (eq? binding_19 'ambiguous)
- (let-values ()
+ (call-expand-observe obs_4 'resolve id_80)
+ (call-expand-observe obs_4 'stop/return s_643))
+ (void)))
+ s_643)
+ (let-values (((binding_20)
+ (let-values (((id130_0) id_80)
+ ((temp131_0) (expand-context-phase ctx_19))
+ ((temp132_1) 'ambiguous)
+ ((temp133_0) #t))
+ (resolve+shift.1 temp132_1 #f null temp133_0 #f id130_0 temp131_0))))
+ (begin
+ (let-values (((obs_5) (expand-context-observer ctx_19)))
+ (if obs_5 (call-expand-observe obs_5 'resolve id_80) (void)))
+ (if (eq? binding_20 'ambiguous)
+ (begin
+ (if fail-non-transformer_1 (fail-non-transformer_1) (void))
+ (raise-ambiguous-error id_80 ctx_19))
+ (if (not binding_20)
+ (begin
+ (if fail-non-transformer_1 (fail-non-transformer_1) (void))
+ (expand-implicit '#%app (substitute-alternate-id s_643 alternate-id_2) ctx_19 id_80))
+ (let-values (((t_27 primitive?_3 insp-of-t_1 protected?_5)
+ (let-values (((binding134_0) binding_20)
+ ((ctx135_0) ctx_19)
+ ((id136_0) id_80)
+ ((temp137_1) (if alternate-id_2 (car (syntax-e$1 s_643)) #f))
+ ((temp138_0) (expand-context-in-local-expand? ctx_19)))
+ (lookup.1 temp137_1 temp138_0 binding134_0 ctx135_0 id136_0))))
+ (if (variable? t_27)
(begin
- (if fail-non-transformer_1 (let-values () (fail-non-transformer_1)) (void))
- (raise-ambiguous-error id_10 ctx_17)))
- (if (not binding_19)
- (let-values ()
- (begin
- (if fail-non-transformer_1 (let-values () (fail-non-transformer_1)) (void))
- (expand-implicit '#%app (substitute-alternate-id s_473 alternate-id_2) ctx_17 id_10)))
- (let-values ()
- (let-values (((t_22 primitive?_3 insp-of-t_1 protected?_5)
- (let-values (((binding134_0) binding_19)
- ((ctx135_0) ctx_17)
- ((id136_0) id_10)
- ((temp137_0) (if alternate-id_2 (car (syntax-e$1 s_473)) #f))
- ((temp138_0) (expand-context-in-local-expand? ctx_17)))
- (lookup.1 temp137_0 temp138_0 binding134_0 ctx135_0 id136_0))))
- (if (variable? t_22)
- (let-values ()
- (begin
- (if fail-non-transformer_1 (let-values () (fail-non-transformer_1)) (void))
- (expand-implicit
- '#%app
- (substitute-alternate-id s_473 alternate-id_2)
- ctx_17
- id_10)))
- (let-values ()
- (let-values (((t139_0) t_22)
- ((insp-of-t140_0) insp-of-t_1)
- ((s141_0) s_473)
- ((id142_1) id_10)
- ((ctx143_0) ctx_17)
- ((binding144_0) binding_19)
- ((primitive?145_0) primitive?_3)
- ((protected?146_0) protected?_5)
- ((fail-non-transformer147_0) fail-non-transformer_1))
- (dispatch.1
- fail-non-transformer147_0
- t139_0
- insp-of-t140_0
- s141_0
- id142_1
- ctx143_0
- binding144_0
- primitive?145_0
- protected?146_0)))))))))))))))))))))
+ (if fail-non-transformer_1 (fail-non-transformer_1) (void))
+ (expand-implicit '#%app (substitute-alternate-id s_643 alternate-id_2) ctx_19 id_80))
+ (let-values (((t139_0) t_27)
+ ((insp-of-t140_0) insp-of-t_1)
+ ((s141_0) s_643)
+ ((id142_0) id_80)
+ ((ctx143_0) ctx_19)
+ ((binding144_0) binding_20)
+ ((primitive?145_0) primitive?_3)
+ ((protected?146_0) protected?_5)
+ ((fail-non-transformer147_0) fail-non-transformer_1))
+ (dispatch.1
+ fail-non-transformer147_0
+ t139_0
+ insp-of-t140_0
+ s141_0
+ id142_0
+ ctx143_0
+ binding144_0
+ primitive?145_0
+ protected?146_0)))))))))))))))))
(define-values
(expand-implicit)
- (lambda (sym_56 s_465 ctx_18 trigger-id_1)
+ (lambda (sym_93 s_644 ctx_20 trigger-id_1)
(begin
- (if (expand-context-only-immediate? ctx_18)
- (let-values ()
- (begin
- (let-values (((obs_6) (expand-context-observer ctx_18)))
- (if obs_6 (let-values () (let-values () (call-expand-observe obs_6 'stop/return s_465))) (void)))
- s_465))
- (let-values ()
- (let-values (((id_71) (datum->syntax$1 s_465 sym_56)))
- (if (if (not (free-id-set-empty? (expand-context-stops ctx_18)))
- (free-id-set-member? (expand-context-stops ctx_18) (expand-context-phase ctx_18) id_71)
- #f)
- (let-values ()
- (begin
- (let-values (((obs_7) (expand-context-observer ctx_18)))
- (if obs_7
- (let-values ()
- (let-values ()
- (begin
- (call-expand-observe obs_7 'resolve id_71)
- (call-expand-observe obs_7 'stop/return s_465))))
- (void)))
- s_465))
- (let-values ()
- (let-values (((b_94)
- (let-values (((id148_0) id_71)
- ((temp149_1) (expand-context-phase ctx_18))
- ((temp150_1) 'ambiguous)
- ((temp151_0) #t))
- (resolve+shift.1 temp150_1 #f null temp151_0 #f id148_0 temp149_1))))
- (begin
- (let-values (((obs_8) (expand-context-observer ctx_18)))
- (if obs_8 (let-values () (let-values () (call-expand-observe obs_8 'resolve id_71))) (void)))
- (if (eq? b_94 'ambiguous)
- (let-values () (raise-ambiguous-error id_71 ctx_18))
- (let-values ()
- (let-values (((t_23 primitive?_4 insp-of-t_2 protected?_6)
- (if b_94
- (let-values (((b152_0) b_94) ((ctx153_0) ctx_18) ((id154_0) id_71))
- (lookup.1 #f #f b152_0 ctx153_0 id154_0))
- (values #f #f #f #f))))
- (if (transformer? t_23)
- (let-values ()
- (let-values (((fail-non-transformer_2)
- (if (1/rename-transformer? t_23)
- (lambda ()
- (begin
- 'fail-non-transformer
- (raise-syntax-implicit-error s_465 sym_56 trigger-id_1 ctx_18)))
- #f)))
- (let-values (((t155_0) t_23)
- ((insp-of-t156_0) insp-of-t_2)
- ((temp157_1) (make-explicit ctx_18 sym_56 s_465))
- ((id158_0) id_71)
- ((ctx159_0) ctx_18)
- ((b160_0) b_94)
- ((fail-non-transformer161_0) fail-non-transformer_2))
- (dispatch-transformer.1
- fail-non-transformer161_0
- t155_0
- insp-of-t156_0
- temp157_1
- id158_0
- ctx159_0
- b160_0))))
- (if (core-form? t_23)
- (let-values ()
- (if (if (eq? sym_56 '#%top)
- (if (eq? (core-form-name t_23) '#%top)
- (expand-context-in-local-expand? ctx_18)
- #f)
- #f)
- (let-values () (dispatch-implicit-#%top-core-form t_23 s_465 ctx_18))
- (let-values () (dispatch-core-form t_23 (make-explicit ctx_18 sym_56 s_465) ctx_18))))
- (let-values ()
- (let-values (((tl-id_0)
- (if (eq? sym_56 '#%top)
- (if (root-expand-context-top-level-bind-scope ctx_18)
- (add-scope s_465 (root-expand-context-top-level-bind-scope ctx_18))
- #f)
- #f)))
- (let-values (((tl-b_0)
- (if tl-id_0
- (let-values (((tl-id162_0) tl-id_0)
- ((temp163_0) (expand-context-phase ctx_18)))
- (resolve.1 #f #f null #f tl-id162_0 temp163_0))
- #f)))
- (if tl-b_0
- (let-values ()
- (if (if (expand-context-to-parsed? ctx_18)
- (free-id-set-empty? (expand-context-stops ctx_18))
- #f)
- (parsed-id2.1 tl-id_0 tl-b_0 #f)
- (begin
- (let-values (((obs_9) (expand-context-observer ctx_18)))
- (if obs_9
- (let-values ()
- (let-values ()
- (begin
- (call-expand-observe obs_9 'variable tl-id_0)
- (call-expand-observe obs_9 'return tl-id_0))))
- (void)))
- tl-id_0)))
- (let-values ()
- (raise-syntax-implicit-error
- s_465
- sym_56
- trigger-id_1
- ctx_18)))))))))))))))))))))
+ (if (expand-context-only-immediate? ctx_20)
+ (begin
+ (let-values (((obs_6) (expand-context-observer ctx_20)))
+ (if obs_6 (call-expand-observe obs_6 'stop/return s_644) (void)))
+ s_644)
+ (let-values (((id_81) (datum->syntax$1 s_644 sym_93)))
+ (if (if (not (free-id-set-empty? (expand-context-stops ctx_20)))
+ (free-id-set-member? (expand-context-stops ctx_20) (expand-context-phase ctx_20) id_81)
+ #f)
+ (begin
+ (let-values (((obs_7) (expand-context-observer ctx_20)))
+ (if obs_7
+ (begin (call-expand-observe obs_7 'resolve id_81) (call-expand-observe obs_7 'stop/return s_644))
+ (void)))
+ s_644)
+ (let-values (((b_128)
+ (let-values (((id148_0) id_81)
+ ((temp149_0) (expand-context-phase ctx_20))
+ ((temp150_0) 'ambiguous)
+ ((temp151_0) #t))
+ (resolve+shift.1 temp150_0 #f null temp151_0 #f id148_0 temp149_0))))
+ (begin
+ (let-values (((obs_8) (expand-context-observer ctx_20)))
+ (if obs_8 (call-expand-observe obs_8 'resolve id_81) (void)))
+ (if (eq? b_128 'ambiguous)
+ (raise-ambiguous-error id_81 ctx_20)
+ (let-values (((t_28 primitive?_4 insp-of-t_2 protected?_6)
+ (if b_128
+ (let-values (((b152_0) b_128) ((ctx153_0) ctx_20) ((id154_0) id_81))
+ (lookup.1 #f #f b152_0 ctx153_0 id154_0))
+ (values #f #f #f #f))))
+ (if (transformer? t_28)
+ (let-values (((fail-non-transformer_2)
+ (if (1/rename-transformer? t_28)
+ (lambda ()
+ (begin
+ 'fail-non-transformer
+ (raise-syntax-implicit-error s_644 sym_93 trigger-id_1 ctx_20)))
+ #f)))
+ (let-values (((t155_0) t_28)
+ ((insp-of-t156_0) insp-of-t_2)
+ ((temp157_1) (make-explicit ctx_20 sym_93 s_644))
+ ((id158_1) id_81)
+ ((ctx159_0) ctx_20)
+ ((b160_0) b_128)
+ ((fail-non-transformer161_0) fail-non-transformer_2))
+ (dispatch-transformer.1
+ fail-non-transformer161_0
+ t155_0
+ insp-of-t156_0
+ temp157_1
+ id158_1
+ ctx159_0
+ b160_0)))
+ (if (core-form? t_28)
+ (if (if (eq? sym_93 '#%top)
+ (if (eq? (core-form-name t_28) '#%top) (expand-context-in-local-expand? ctx_20) #f)
+ #f)
+ (dispatch-implicit-#%top-core-form t_28 s_644 ctx_20)
+ (dispatch-core-form t_28 (make-explicit ctx_20 sym_93 s_644) ctx_20))
+ (let-values (((tl-id_0)
+ (if (eq? sym_93 '#%top)
+ (if (root-expand-context-top-level-bind-scope ctx_20)
+ (add-scope s_644 (root-expand-context-top-level-bind-scope ctx_20))
+ #f)
+ #f)))
+ (let-values (((tl-b_0)
+ (if tl-id_0
+ (let-values (((tl-id162_0) tl-id_0)
+ ((temp163_1) (expand-context-phase ctx_20)))
+ (resolve.1 #f #f null #f tl-id162_0 temp163_1))
+ #f)))
+ (if tl-b_0
+ (if (if (expand-context-to-parsed? ctx_20)
+ (free-id-set-empty? (expand-context-stops ctx_20))
+ #f)
+ (parsed-id2.1 tl-id_0 tl-b_0 #f)
+ (begin
+ (let-values (((obs_9) (expand-context-observer ctx_20)))
+ (if obs_9
+ (begin
+ (call-expand-observe obs_9 'variable tl-id_0)
+ (call-expand-observe obs_9 'return tl-id_0))
+ (void)))
+ tl-id_0))
+ (raise-syntax-implicit-error s_644 sym_93 trigger-id_1 ctx_20))))))))))))))))
(define-values
(expand-already-expanded)
- (lambda (s_92 ctx_19)
+ (lambda (s_645 ctx_21)
(begin
- (let-values (((ae_0) (syntax-e$1 s_92)))
+ (let-values (((ae_0) (syntax-e$1 s_645)))
(let-values (((exp-s_0) (already-expanded-s ae_0)))
(begin
- (if (let-values (((or-part_178) (syntax-any-macro-scopes? s_92)))
- (if or-part_178
- or-part_178
- (let-values (((or-part_279)
+ (if (let-values (((or-part_461) (syntax-any-macro-scopes? s_645)))
+ (if or-part_461
+ or-part_461
+ (let-values (((or-part_462)
(not
- (eq? (expand-context-binding-layer ctx_19) (already-expanded-binding-layer ae_0)))))
- (if or-part_279
- or-part_279
+ (eq? (expand-context-binding-layer ctx_21) (already-expanded-binding-layer ae_0)))))
+ (if or-part_462
+ or-part_462
(if (parsed? exp-s_0)
(not
- (if (expand-context-to-parsed? ctx_19)
- (free-id-set-empty? (expand-context-stops ctx_19))
+ (if (expand-context-to-parsed? ctx_21)
+ (free-id-set-empty? (expand-context-stops ctx_21))
#f))
#f)))))
- (let-values ()
- (raise-syntax-error$1
- #f
- (string-append
- "expanded syntax not in its original lexical context;\n"
- " extra bindings or scopes in the current context")
- (if (not (parsed? exp-s_0)) exp-s_0 #f)))
+ (raise-syntax-error$1
+ #f
+ (string-append
+ "expanded syntax not in its original lexical context;\n"
+ " extra bindings or scopes in the current context")
+ (if (not (parsed? exp-s_0)) exp-s_0 #f))
(void))
- (if (expand-context-only-immediate? ctx_19)
- (let-values ()
- (begin
- (let-values (((obs_10) (expand-context-observer ctx_19)))
- (if obs_10 (let-values () (let-values () (call-expand-observe obs_10 'stop/return s_92))) (void)))
- s_92))
+ (if (expand-context-only-immediate? ctx_21)
+ (begin
+ (let-values (((obs_10) (expand-context-observer ctx_21)))
+ (if obs_10 (call-expand-observe obs_10 'stop/return s_645) (void)))
+ s_645)
(if (parsed? exp-s_0)
- (let-values () exp-s_0)
- (let-values ()
- (let-values (((result-s_1) (syntax-track-origin$1 exp-s_0 s_92)))
- (begin
- (let-values (((obs_11) (expand-context-observer ctx_19)))
- (if obs_11
- (let-values () (let-values () (call-expand-observe obs_11 'opaque-expr result-s_1)))
- (void)))
- (if (if (expand-context-to-parsed? ctx_19) (free-id-set-empty? (expand-context-stops ctx_19)) #f)
- (let-values (((result-s164_0) result-s_1) ((ctx165_0) ctx_19))
- (expand.1 #f #f result-s164_0 ctx165_0))
- result-s_1))))))))))))
+ exp-s_0
+ (let-values (((result-s_1) (syntax-track-origin$1 exp-s_0 s_645)))
+ (begin
+ (let-values (((obs_11) (expand-context-observer ctx_21)))
+ (if obs_11 (call-expand-observe obs_11 'opaque-expr result-s_1) (void)))
+ (if (if (expand-context-to-parsed? ctx_21) (free-id-set-empty? (expand-context-stops ctx_21)) #f)
+ (let-values (((result-s164_0) result-s_1) ((ctx165_0) ctx_21))
+ (expand.1 #f #f result-s164_0 ctx165_0))
+ result-s_1)))))))))))
(define-values
(make-explicit)
- (lambda (ctx_20 sym_78 s_474)
+ (lambda (ctx_22 sym_94 s_646)
(begin
(let-values (((insp_16) (current-module-code-inspector)))
(let-values (((sym-s_0)
(immediate-datum->syntax
- s_474
- sym_78
- s_474
- (if (syntax-has-property? s_474 original-property-sym)
+ s_646
+ sym_94
+ s_646
+ (if (syntax-has-property? s_646 original-property-sym)
original-implicit-made-explicit-properties
implicit-made-explicit-properties)
insp_16)))
(let-values (((new-s_0)
- (immediate-datum->syntax s_474 (cons sym-s_0 s_474) s_474 (syntax-props s_474) insp_16)))
+ (immediate-datum->syntax s_646 (cons sym-s_0 s_646) s_646 (syntax-props s_646) insp_16)))
(begin
- (let-values (((obs_12) (expand-context-observer ctx_20)))
- (if obs_12 (let-values () (let-values () (call-expand-observe obs_12 'tag2 new-s_0 s_474))) (void)))
+ (let-values (((obs_12) (expand-context-observer ctx_22)))
+ (if obs_12 (call-expand-observe obs_12 'tag2 new-s_0 s_646) (void)))
new-s_0)))))))
(define-values
(dispatch.1)
(lambda (fail-non-transformer14_0 t16_0 insp-of-t17_0 s18_0 id19_0 ctx20_0 binding21_1 primitive?22_0 protected?23_0)
(begin
'dispatch
- (let-values (((t_24) t16_0))
+ (let-values (((t_29) t16_0))
(let-values (((insp-of-t_3) insp-of-t17_0))
- (let-values (((s_475) s18_0))
- (let-values (((id_72) id19_0))
- (let-values (((ctx_21) ctx20_0))
- (let-values (((binding_20) binding21_1))
+ (let-values (((s_647) s18_0))
+ (let-values (((id_82) id19_0))
+ (let-values (((ctx_23) ctx20_0))
+ (let-values (((binding_21) binding21_1))
(let-values (((primitive?_5) primitive?22_0))
(let-values (((protected?_7) protected?23_0))
(let-values (((fail-non-transformer_3) fail-non-transformer14_0))
- (let-values ()
- (if (core-form? t_24)
- (let-values () (dispatch-core-form t_24 s_475 ctx_21))
- (if (transformer? t_24)
- (let-values ()
- (let-values (((t166_0) t_24)
- ((insp-of-t167_0) insp-of-t_3)
- ((s168_0) s_475)
- ((id169_0) id_72)
- ((ctx170_0) ctx_21)
- ((binding171_1) binding_20)
- ((fail-non-transformer172_0) fail-non-transformer_3))
- (dispatch-transformer.1
- fail-non-transformer172_0
- t166_0
- insp-of-t167_0
- s168_0
- id169_0
- ctx170_0
- binding171_1)))
- (if (variable? t_24)
- (let-values ()
- (dispatch-variable t_24 s_475 id_72 ctx_21 binding_20 primitive?_5 protected?_7))
- (let-values ()
- (raise-syntax-error$1
- #f
- "illegal use of syntax"
- s_475
- #f
- null
- (format
- "\n value at phase ~s: ~e"
- (add1 (expand-context-phase ctx_21))
- t_24)))))))))))))))))))
+ (if (core-form? t_29)
+ (dispatch-core-form t_29 s_647 ctx_23)
+ (if (transformer? t_29)
+ (let-values (((t166_0) t_29)
+ ((insp-of-t167_0) insp-of-t_3)
+ ((s168_0) s_647)
+ ((id169_0) id_82)
+ ((ctx170_0) ctx_23)
+ ((binding171_0) binding_21)
+ ((fail-non-transformer172_0) fail-non-transformer_3))
+ (dispatch-transformer.1
+ fail-non-transformer172_0
+ t166_0
+ insp-of-t167_0
+ s168_0
+ id169_0
+ ctx170_0
+ binding171_0))
+ (if (variable? t_29)
+ (dispatch-variable t_29 s_647 id_82 ctx_23 binding_21 primitive?_5 protected?_7)
+ (raise-syntax-error$1
+ #f
+ "illegal use of syntax"
+ s_647
+ #f
+ null
+ (format
+ "\n value at phase ~s: ~e"
+ (add1 (expand-context-phase ctx_23))
+ t_29)))))))))))))))))
(define-values
(dispatch-core-form)
- (lambda (t_25 s_476 ctx_22)
+ (lambda (t_30 s_648 ctx_24)
(begin
- (if (expand-context-only-immediate? ctx_22)
- (let-values ()
- (begin
- (let-values (((obs_13) (expand-context-observer ctx_22)))
- (if obs_13 (let-values () (let-values () (call-expand-observe obs_13 'stop/return s_476))) (void)))
- s_476))
- (if (expand-context-observer ctx_22)
- (let-values ()
- (let-values ((()
- (begin
- (let-values (((obs_14) (expand-context-observer ctx_22)))
- (if obs_14
- (let-values () (let-values () (call-expand-observe obs_14 'enter-prim s_476)))
- (void)))
- (values))))
- (let-values (((result-s_2) ((core-form-expander t_25) s_476 ctx_22)))
- (begin
- (let-values (((obs_15) (expand-context-observer ctx_22)))
- (if obs_15
- (let-values ()
- (let-values () (call-expand-observe obs_15 'exit-prim/return (extract-syntax result-s_2))))
- (void)))
- result-s_2))))
- (let-values () ((core-form-expander t_25) s_476 ctx_22)))))))
+ (if (expand-context-only-immediate? ctx_24)
+ (begin
+ (let-values (((obs_13) (expand-context-observer ctx_24)))
+ (if obs_13 (call-expand-observe obs_13 'stop/return s_648) (void)))
+ s_648)
+ (if (expand-context-observer ctx_24)
+ (let-values ((()
+ (begin
+ (let-values (((obs_14) (expand-context-observer ctx_24)))
+ (if obs_14 (call-expand-observe obs_14 'enter-prim s_648) (void)))
+ (values))))
+ (let-values (((result-s_2) ((core-form-expander t_30) s_648 ctx_24)))
+ (begin
+ (let-values (((obs_15) (expand-context-observer ctx_24)))
+ (if obs_15 (call-expand-observe obs_15 'exit-prim/return (extract-syntax result-s_2)) (void)))
+ result-s_2)))
+ ((core-form-expander t_30) s_648 ctx_24))))))
(define-values
(dispatch-implicit-#%top-core-form)
- (lambda (t_26 s_477 ctx_23)
+ (lambda (t_31 s_649 ctx_25)
(begin
(let-values ((()
(begin
- (let-values (((obs_16) (expand-context-observer ctx_23)))
- (if obs_16
- (let-values () (let-values () (call-expand-observe obs_16 'enter-prim s_477)))
- (void)))
+ (let-values (((obs_16) (expand-context-observer ctx_25)))
+ (if obs_16 (call-expand-observe obs_16 'enter-prim s_649) (void)))
(values))))
- (let-values (((result-s_3) ((core-form-expander t_26) s_477 ctx_23 #t)))
+ (let-values (((result-s_3) ((core-form-expander t_31) s_649 ctx_25 #t)))
(begin
- (let-values (((obs_17) (expand-context-observer ctx_23)))
- (if obs_17
- (let-values () (let-values () (call-expand-observe obs_17 'exit-prim/return result-s_3)))
- (void)))
+ (let-values (((obs_17) (expand-context-observer ctx_25)))
+ (if obs_17 (call-expand-observe obs_17 'exit-prim/return result-s_3) (void)))
result-s_3))))))
(define-values
(dispatch-transformer.1)
(lambda (fail-non-transformer25_0 t27_0 insp-of-t28_0 s29_2 id30_1 ctx31_0 binding32_0)
(begin
'dispatch-transformer
- (let-values (((t_27) t27_0))
+ (let-values (((t_32) t27_0))
(let-values (((insp-of-t_4) insp-of-t28_0))
- (let-values (((s_478) s29_2))
- (let-values (((id_73) id30_1))
- (let-values (((ctx_24) ctx31_0))
- (let-values (((binding_21) binding32_0))
+ (let-values (((s_650) s29_2))
+ (let-values (((id_83) id30_1))
+ (let-values (((ctx_26) ctx31_0))
+ (let-values (((binding_22) binding32_0))
(let-values (((fail-non-transformer_4) fail-non-transformer25_0))
- (let-values ()
- (if (not-in-this-expand-context? t_27 ctx_24)
- (let-values ()
- (let-values (((adj-s_0)
- (avoid-current-expand-context
- (substitute-alternate-id s_478 id_73)
- t_27
- ctx_24)))
- (begin
- (let-values (((obs_18) (expand-context-observer ctx_24)))
- (if obs_18
- (let-values () (let-values () (call-expand-observe obs_18 'tag/context adj-s_0)))
- (void)))
- (let-values (((adj-s173_0) adj-s_0) ((ctx174_0) ctx_24))
- (expand.1 #f #f adj-s173_0 ctx174_0)))))
- (if (if (expand-context-parsing-expanded? ctx_24) (not (1/rename-transformer? t_27)) #f)
- (let-values ()
- (raise-syntax-error$1
- #f
- "encountered a macro binding in form that should be fully expanded"
- s_478))
- (if (1/rename-transformer? t_27)
- (let-values ()
- (if (expand-context-just-once? ctx_24)
- (let-values () s_478)
- (let-values ()
- (let-values (((alt-id_0) (apply-rename-transformer t_27 id_73 ctx_24)))
- (begin
- (let-values (((obs_19) (expand-context-observer ctx_24)))
- (if obs_19
- (let-values ()
- (let-values () (call-expand-observe obs_19 'rename-transformer alt-id_0)))
- (void)))
- (let-values (((s175_0) s_478)
- ((ctx176_0) ctx_24)
- ((alt-id177_0) alt-id_0)
- ((fail-non-transformer178_0) fail-non-transformer_4))
- (expand.1 alt-id177_0 fail-non-transformer178_0 s175_0 ctx176_0)))))))
- (let-values ()
- (let-values (((exp-s_1 re-ctx_0)
- (let-values (((t179_0) t_27)
- ((insp-of-t180_0) insp-of-t_4)
- ((s181_0) s_478)
- ((id182_0) id_73)
- ((ctx183_0) ctx_24)
- ((binding184_0) binding_21))
- (apply-transformer.1
- #f
- t179_0
- insp-of-t180_0
- s181_0
- id182_0
- ctx183_0
- binding184_0))))
- (if (expand-context-just-once? ctx_24)
- (let-values () exp-s_1)
- (let-values ()
- (let-values (((exp-s185_0) exp-s_1) ((re-ctx186_0) re-ctx_0))
- (expand.1 #f #f exp-s185_0 re-ctx186_0))))))))))))))))))))
+ (if (not-in-this-expand-context? t_32 ctx_26)
+ (let-values (((adj-s_0)
+ (avoid-current-expand-context (substitute-alternate-id s_650 id_83) t_32 ctx_26)))
+ (begin
+ (let-values (((obs_18) (expand-context-observer ctx_26)))
+ (if obs_18 (call-expand-observe obs_18 'tag/context adj-s_0) (void)))
+ (let-values (((adj-s173_0) adj-s_0) ((ctx174_0) ctx_26))
+ (expand.1 #f #f adj-s173_0 ctx174_0))))
+ (if (if (expand-context-parsing-expanded? ctx_26) (not (1/rename-transformer? t_32)) #f)
+ (raise-syntax-error$1
+ #f
+ "encountered a macro binding in form that should be fully expanded"
+ s_650)
+ (if (1/rename-transformer? t_32)
+ (if (expand-context-just-once? ctx_26)
+ s_650
+ (let-values (((alt-id_0) (apply-rename-transformer t_32 id_83 ctx_26)))
+ (begin
+ (let-values (((obs_19) (expand-context-observer ctx_26)))
+ (if obs_19 (call-expand-observe obs_19 'rename-transformer alt-id_0) (void)))
+ (let-values (((s175_0) s_650)
+ ((ctx176_0) ctx_26)
+ ((alt-id177_0) alt-id_0)
+ ((fail-non-transformer178_0) fail-non-transformer_4))
+ (expand.1 alt-id177_0 fail-non-transformer178_0 s175_0 ctx176_0)))))
+ (let-values (((exp-s_1 re-ctx_0)
+ (let-values (((t179_0) t_32)
+ ((insp-of-t180_0) insp-of-t_4)
+ ((s181_0) s_650)
+ ((id182_0) id_83)
+ ((ctx183_0) ctx_26)
+ ((binding184_0) binding_22))
+ (apply-transformer.1
+ #f
+ t179_0
+ insp-of-t180_0
+ s181_0
+ id182_0
+ ctx183_0
+ binding184_0))))
+ (if (expand-context-just-once? ctx_26)
+ exp-s_1
+ (let-values (((exp-s185_0) exp-s_1) ((re-ctx186_0) re-ctx_0))
+ (expand.1 #f #f exp-s185_0 re-ctx186_0)))))))))))))))))
(define-values
(dispatch-variable)
- (lambda (t_28 s_224 id_74 ctx_25 binding_22 primitive?_6 protected?_8)
+ (lambda (t_33 s_651 id_84 ctx_27 binding_23 primitive?_6 protected?_8)
(begin
- (if (expand-context-only-immediate? ctx_25)
- (let-values ()
- (begin
- (let-values (((obs_20) (expand-context-observer ctx_25)))
- (if obs_20 (let-values () (let-values () (call-expand-observe obs_20 'stop/return id_74))) (void)))
- id_74))
- (let-values ()
- (let-values ((()
- (begin
- (let-values (((obs_21) (expand-context-observer ctx_25)))
- (if obs_21
- (let-values () (let-values () (call-expand-observe obs_21 'variable s_224 id_74)))
- (void)))
- (values))))
- (let-values ((() (begin (register-variable-referenced-if-local! binding_22 ctx_25) (values))))
- (let-values (((result-s_4)
- (let-values (((id187_0) id_74)
- ((t188_0) t_28)
- ((temp189_0)
- (free-id-set-empty-or-just-module*? (expand-context-stops ctx_25))))
- (substitute-variable.1 temp189_0 id187_0 t188_0))))
- (if (if (expand-context-to-parsed? ctx_25) (free-id-set-empty? (expand-context-stops ctx_25)) #f)
- (let-values ()
- (let-values (((prop-s_0) (keep-properties-only~ result-s_4)))
- (let-values (((insp_17) (syntax-inspector result-s_4)))
- (if primitive?_6
- (parsed-primitive-id3.1 prop-s_0 binding_22 insp_17)
- (parsed-id2.1 prop-s_0 binding_22 insp_17)))))
- (let-values ()
- (let-values (((protected-result-s_0)
- (if protected?_8 (syntax-property$1 result-s_4 'protected #t) result-s_4)))
+ (if (expand-context-only-immediate? ctx_27)
+ (begin
+ (let-values (((obs_20) (expand-context-observer ctx_27)))
+ (if obs_20 (call-expand-observe obs_20 'stop/return id_84) (void)))
+ id_84)
+ (let-values ((()
(begin
- (let-values (((obs_22) (expand-context-observer ctx_25)))
- (if obs_22
- (let-values () (let-values () (call-expand-observe obs_22 'return protected-result-s_0)))
- (void)))
- protected-result-s_0))))))))))))
+ (let-values (((obs_21) (expand-context-observer ctx_27)))
+ (if obs_21 (call-expand-observe obs_21 'variable s_651 id_84) (void)))
+ (values))))
+ (let-values ((() (begin (register-variable-referenced-if-local! binding_23 ctx_27) (values))))
+ (let-values (((result-s_4)
+ (let-values (((id187_0) id_84)
+ ((t188_0) t_33)
+ ((temp189_0) (free-id-set-empty-or-just-module*? (expand-context-stops ctx_27))))
+ (substitute-variable.1 temp189_0 id187_0 t188_0))))
+ (if (if (expand-context-to-parsed? ctx_27) (free-id-set-empty? (expand-context-stops ctx_27)) #f)
+ (let-values (((prop-s_0) (keep-properties-only~ result-s_4)))
+ (let-values (((insp_17) (syntax-inspector result-s_4)))
+ (if primitive?_6
+ (parsed-primitive-id3.1 prop-s_0 binding_23 insp_17)
+ (parsed-id2.1 prop-s_0 binding_23 insp_17))))
+ (let-values (((protected-result-s_0)
+ (if protected?_8 (syntax-property$1 result-s_4 'protected #t) result-s_4)))
+ (begin
+ (let-values (((obs_22) (expand-context-observer ctx_27)))
+ (if obs_22 (call-expand-observe obs_22 'return protected-result-s_0) (void)))
+ protected-result-s_0))))))))))
(define-values
(apply-transformer.1)
(lambda (origin-id34_0 t36_0 insp-of-t37_0 s38_0 id39_0 ctx40_0 binding41_0)
(begin
'apply-transformer
- (let-values (((t_29) t36_0))
+ (let-values (((t_34) t36_0))
(let-values (((insp-of-t_5) insp-of-t37_0))
- (let-values (((s_479) s38_0))
- (let-values (((id_75) id39_0))
- (let-values (((ctx_26) ctx40_0))
- (let-values (((binding_23) binding41_0))
+ (let-values (((s_652) s38_0))
+ (let-values (((id_85) id39_0))
+ (let-values (((ctx_28) ctx40_0))
+ (let-values (((binding_24) binding41_0))
(let-values (((origin-id_0) origin-id34_0))
- (let-values ()
- (begin
- (if log-performance? (let-values () (start-performance-region 'expand '_ 'macro)) (void))
- (begin0
- (let-values ()
- (let-values ((()
- (begin
- (let-values (((obs_23) (expand-context-observer ctx_26)))
- (if obs_23
- (let-values ()
- (let-values () (call-expand-observe obs_23 'enter-macro s_479 s_479)))
- (void)))
- (values))))
- (let-values (((intro-scope_0) (new-scope 'macro)))
- (let-values (((intro-s_0) (flip-scope s_479 intro-scope_0)))
- (let-values (((use-scopes_0) (maybe-create-use-site-scope ctx_26 binding_23)))
- (let-values (((use-s_0) (add-scopes intro-s_0 use-scopes_0)))
- (let-values (((def-ctx-scopes_1) (box null)))
- (let-values (((transformed-s_0)
- (apply-transformer-in-context$1
- t_29
- use-s_0
- ctx_26
- insp-of-t_5
- intro-scope_0
- use-scopes_0
- def-ctx-scopes_1
- id_75)))
- (let-values (((result-s_5) (flip-scope transformed-s_0 intro-scope_0)))
- (let-values (((post-s_0) (maybe-add-post-expansion result-s_5 ctx_26)))
- (let-values (((tracked-s_0)
- (syntax-track-origin$1
- post-s_0
- use-s_0
- (let-values (((or-part_280) origin-id_0))
- (if or-part_280
- or-part_280
- (if (syntax-identifier? s_479)
- s_479
- (car (syntax-e$1 s_479))))))))
- (begin
- (let-values (((obs_24) (expand-context-observer ctx_26)))
- (if obs_24
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_24
- 'exit-macro
- tracked-s_0
- post-s_0)))
- (void)))
- (values
- tracked-s_0
- (accumulate-def-ctx-scopes ctx_26 def-ctx-scopes_1))))))))))))))
- (if log-performance? (let-values () (end-performance-region)) (void)))))))))))))))
+ (begin
+ (if log-performance? (start-performance-region 'expand '_ 'macro) (void))
+ (begin0
+ (let-values ((()
+ (begin
+ (let-values (((obs_23) (expand-context-observer ctx_28)))
+ (if obs_23 (call-expand-observe obs_23 'enter-macro s_652 s_652) (void)))
+ (values))))
+ (let-values (((intro-scope_0) (new-scope 'macro)))
+ (let-values (((intro-s_0) (flip-scope s_652 intro-scope_0)))
+ (let-values (((use-scopes_0) (maybe-create-use-site-scope ctx_28 binding_24)))
+ (let-values (((use-s_0) (add-scopes intro-s_0 use-scopes_0)))
+ (let-values (((def-ctx-scopes_1) (box null)))
+ (let-values (((transformed-s_0)
+ (apply-transformer-in-context$1
+ t_34
+ use-s_0
+ ctx_28
+ insp-of-t_5
+ intro-scope_0
+ use-scopes_0
+ def-ctx-scopes_1
+ id_85)))
+ (let-values (((result-s_5) (flip-scope transformed-s_0 intro-scope_0)))
+ (let-values (((post-s_0) (maybe-add-post-expansion result-s_5 ctx_28)))
+ (let-values (((tracked-s_0)
+ (syntax-track-origin$1
+ post-s_0
+ use-s_0
+ (let-values (((or-part_463) origin-id_0))
+ (if or-part_463
+ or-part_463
+ (if (syntax-identifier? s_652)
+ s_652
+ (car (syntax-e$1 s_652))))))))
+ (begin
+ (let-values (((obs_24) (expand-context-observer ctx_28)))
+ (if obs_24
+ (call-expand-observe obs_24 'exit-macro tracked-s_0 post-s_0)
+ (void)))
+ (values
+ tracked-s_0
+ (accumulate-def-ctx-scopes ctx_28 def-ctx-scopes_1)))))))))))))
+ (if log-performance? (end-performance-region) (void))))))))))))))
(define-values
(apply-transformer-in-context$1)
- (lambda (t_30 use-s_1 ctx_27 insp-of-t_6 intro-scope_1 use-scopes_1 def-ctx-scopes_2 id_76)
+ (lambda (t_35 use-s_1 ctx_29 insp-of-t_6 intro-scope_1 use-scopes_1 def-ctx-scopes_2 id_86)
(begin
'apply-transformer-in-context
(let-values ((()
(begin
- (let-values (((obs_25) (expand-context-observer ctx_27)))
- (if obs_25
- (let-values () (let-values () (call-expand-observe obs_25 'macro-pre-x use-s_1)))
- (void)))
+ (let-values (((obs_25) (expand-context-observer ctx_29)))
+ (if obs_25 (call-expand-observe obs_25 'macro-pre-x use-s_1) (void)))
(values))))
(let-values (((confine-def-ctx-scopes?_0)
(not
- (let-values (((or-part_281) (expand-context-only-immediate? ctx_27)))
- (if or-part_281
- or-part_281
- (not (free-id-set-empty-or-just-module*? (expand-context-stops ctx_27))))))))
+ (let-values (((or-part_464) (expand-context-only-immediate? ctx_29)))
+ (if or-part_464
+ or-part_464
+ (not (free-id-set-empty-or-just-module*? (expand-context-stops ctx_29))))))))
(let-values (((accum-ctx_0)
(if (if confine-def-ctx-scopes?_0
- (if (expand-context-def-ctx-scopes ctx_27)
- (not (null? (unbox (expand-context-def-ctx-scopes ctx_27))))
+ (if (expand-context-def-ctx-scopes ctx_29)
+ (not (null? (unbox (expand-context-def-ctx-scopes ctx_29))))
#f)
#f)
- (accumulate-def-ctx-scopes ctx_27 (expand-context-def-ctx-scopes ctx_27))
- ctx_27)))
+ (accumulate-def-ctx-scopes ctx_29 (expand-context-def-ctx-scopes ctx_29))
+ ctx_29)))
(let-values (((m-ctx_0)
- (let-values (((v_199) accum-ctx_0))
- (let-values (((the-struct_53) v_199))
- (if (expand-context/outer? the-struct_53)
+ (let-values (((v_272) accum-ctx_0))
+ (let-values (((the-struct_57) v_272))
+ (if (expand-context/outer? the-struct_57)
(let-values (((current-introduction-scopes190_0) (list intro-scope_1))
((current-use-scopes191_0) use-scopes_1)
((def-ctx-scopes192_0)
(if confine-def-ctx-scopes?_0
def-ctx-scopes_2
- (expand-context-def-ctx-scopes ctx_27)))
- ((inner193_0) (root-expand-context/outer-inner v_199)))
+ (expand-context-def-ctx-scopes ctx_29)))
+ ((inner193_0) (root-expand-context/outer-inner v_272)))
(expand-context/outer1.1
inner193_0
- (root-expand-context/outer-post-expansion the-struct_53)
- (root-expand-context/outer-use-site-scopes the-struct_53)
- (root-expand-context/outer-frame-id the-struct_53)
- (expand-context/outer-context the-struct_53)
- (expand-context/outer-env the-struct_53)
- (expand-context/outer-scopes the-struct_53)
+ (root-expand-context/outer-post-expansion the-struct_57)
+ (root-expand-context/outer-use-site-scopes the-struct_57)
+ (root-expand-context/outer-frame-id the-struct_57)
+ (expand-context/outer-context the-struct_57)
+ (expand-context/outer-env the-struct_57)
+ (expand-context/outer-scopes the-struct_57)
def-ctx-scopes192_0
- (expand-context/outer-binding-layer the-struct_53)
- (expand-context/outer-reference-records the-struct_53)
- (expand-context/outer-only-immediate? the-struct_53)
- (expand-context/outer-need-eventually-defined the-struct_53)
+ (expand-context/outer-binding-layer the-struct_57)
+ (expand-context/outer-reference-records the-struct_57)
+ (expand-context/outer-only-immediate? the-struct_57)
+ (expand-context/outer-need-eventually-defined the-struct_57)
current-introduction-scopes190_0
current-use-scopes191_0
- (expand-context/outer-name the-struct_53)))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_53))))))
+ (expand-context/outer-name the-struct_57)))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_57))))))
(let-values (((transformed-s_1)
(with-continuation-mark
parameterization-key
@@ -47327,692 +46909,649 @@
(continuation-mark-set-first #f parameterization-key)
1/current-namespace
(namespace->namespace-at-phase
- (expand-context-namespace ctx_27)
- (add1 (expand-context-phase ctx_27))))
- (let-values ()
- (with-continuation-mark
- current-expand-context
- m-ctx_0
- (with-continuation-mark
- current-module-code-inspector
- insp-of-t_6
- (let-values ()
- (call-with-continuation-barrier
- (lambda () ((transformer->procedure t_30) use-s_1))))))))))
+ (expand-context-namespace ctx_29)
+ (add1 (expand-context-phase ctx_29))))
+ (with-continuation-mark
+ current-expand-context
+ m-ctx_0
+ (with-continuation-mark
+ current-module-code-inspector
+ insp-of-t_6
+ (call-with-continuation-barrier (lambda () ((transformer->procedure t_35) use-s_1))))))))
(begin
- (let-values (((obs_26) (expand-context-observer ctx_27)))
- (if obs_26
- (let-values () (let-values () (call-expand-observe obs_26 'macro-post-x transformed-s_1 use-s_1)))
- (void)))
+ (let-values (((obs_26) (expand-context-observer ctx_29)))
+ (if obs_26 (call-expand-observe obs_26 'macro-post-x transformed-s_1 use-s_1) (void)))
(if (syntax?$1 transformed-s_1)
(void)
- (let-values ()
- (raise-arguments-error
- (syntax-e$1 id_76)
- "received value from syntax expander was not syntax"
- "received"
- transformed-s_1)))
+ (raise-arguments-error
+ (syntax-e$1 id_86)
+ "received value from syntax expander was not syntax"
+ "received"
+ transformed-s_1))
transformed-s_1)))))))))
(define-values
(maybe-create-use-site-scope)
- (lambda (ctx_28 binding_24)
+ (lambda (ctx_30 binding_25)
(begin
- (if (if (root-expand-context-use-site-scopes ctx_28)
- (let-values (((or-part_282) (not binding_24)))
- (if or-part_282
- or-part_282
- (matching-frame? (root-expand-context-frame-id ctx_28) (binding-frame-id binding_24))))
+ (if (if (root-expand-context-use-site-scopes ctx_30)
+ (let-values (((or-part_465) (not binding_25)))
+ (if or-part_465
+ or-part_465
+ (matching-frame? (root-expand-context-frame-id ctx_30) (binding-frame-id binding_25))))
#f)
- (let-values ()
- (let-values (((sc_32) (new-scope 'use-site)))
- (let-values (((b_95) (root-expand-context-use-site-scopes ctx_28)))
- (let-values ((() (begin (set-box! b_95 (cons sc_32 (unbox b_95))) (values))))
- (let-values (((def-ctx-b_0) (expand-context-def-ctx-scopes ctx_28)))
- (begin
- (if def-ctx-b_0 (let-values () (set-box! def-ctx-b_0 (cons sc_32 (unbox def-ctx-b_0)))) (void))
- (list sc_32)))))))
- (let-values () null)))))
+ (let-values (((sc_37) (new-scope 'use-site)))
+ (let-values (((b_129) (root-expand-context-use-site-scopes ctx_30)))
+ (let-values ((() (begin (set-box! b_129 (cons sc_37 (unbox b_129))) (values))))
+ (let-values (((def-ctx-b_0) (expand-context-def-ctx-scopes ctx_30)))
+ (begin (if def-ctx-b_0 (set-box! def-ctx-b_0 (cons sc_37 (unbox def-ctx-b_0))) (void)) (list sc_37))))))
+ null))))
(define-values
(matching-frame?)
(lambda (current-frame-id_0 bind-frame-id_0)
(begin
(if current-frame-id_0
- (let-values (((or-part_283) (eq? current-frame-id_0 bind-frame-id_0)))
- (if or-part_283 or-part_283 (eq? current-frame-id_0 'all)))
+ (let-values (((or-part_466) (eq? current-frame-id_0 bind-frame-id_0)))
+ (if or-part_466 or-part_466 (eq? current-frame-id_0 'all)))
#f))))
(define-values
(maybe-add-post-expansion)
- (lambda (s_361 ctx_29) (begin (apply-post-expansion (root-expand-context-post-expansion ctx_29) s_361))))
+ (lambda (s_653 ctx_31) (begin (apply-post-expansion (root-expand-context-post-expansion ctx_31) s_653))))
(define-values
(accumulate-def-ctx-scopes)
- (lambda (ctx_30 def-ctx-scopes_3)
+ (lambda (ctx_32 def-ctx-scopes_3)
(begin
(if (null? (unbox def-ctx-scopes_3))
- ctx_30
- (let-values (((v_200) ctx_30))
- (let-values (((the-struct_19) v_200))
- (if (expand-context/outer? the-struct_19)
- (let-values (((scopes194_0) (append (unbox def-ctx-scopes_3) (expand-context-scopes ctx_30)))
- ((inner195_0) (root-expand-context/outer-inner v_200)))
+ ctx_32
+ (let-values (((v_273) ctx_32))
+ (let-values (((the-struct_58) v_273))
+ (if (expand-context/outer? the-struct_58)
+ (let-values (((scopes194_0) (append (unbox def-ctx-scopes_3) (expand-context-scopes ctx_32)))
+ ((inner195_0) (root-expand-context/outer-inner v_273)))
(expand-context/outer1.1
inner195_0
- (root-expand-context/outer-post-expansion the-struct_19)
- (root-expand-context/outer-use-site-scopes the-struct_19)
- (root-expand-context/outer-frame-id the-struct_19)
- (expand-context/outer-context the-struct_19)
- (expand-context/outer-env the-struct_19)
+ (root-expand-context/outer-post-expansion the-struct_58)
+ (root-expand-context/outer-use-site-scopes the-struct_58)
+ (root-expand-context/outer-frame-id the-struct_58)
+ (expand-context/outer-context the-struct_58)
+ (expand-context/outer-env the-struct_58)
scopes194_0
- (expand-context/outer-def-ctx-scopes the-struct_19)
- (expand-context/outer-binding-layer the-struct_19)
- (expand-context/outer-reference-records the-struct_19)
- (expand-context/outer-only-immediate? the-struct_19)
- (expand-context/outer-need-eventually-defined the-struct_19)
- (expand-context/outer-current-introduction-scopes the-struct_19)
- (expand-context/outer-current-use-scopes the-struct_19)
- (expand-context/outer-name the-struct_19)))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_19))))))))
+ (expand-context/outer-def-ctx-scopes the-struct_58)
+ (expand-context/outer-binding-layer the-struct_58)
+ (expand-context/outer-reference-records the-struct_58)
+ (expand-context/outer-only-immediate? the-struct_58)
+ (expand-context/outer-need-eventually-defined the-struct_58)
+ (expand-context/outer-current-introduction-scopes the-struct_58)
+ (expand-context/outer-current-use-scopes the-struct_58)
+ (expand-context/outer-name the-struct_58)))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_58))))))))
(define-values
(apply-rename-transformer)
- (lambda (t_31 id_77 ctx_31)
+ (lambda (t_36 id_87 ctx_33)
(begin
- (let-values (((target-id_0) (rename-transformer-target-in-context t_31 ctx_31)))
+ (let-values (((target-id_0) (rename-transformer-target-in-context t_36 ctx_33)))
(let-values (((intro-scope_2) (new-scope 'macro)))
(let-values (((intro-id_0) (add-scope target-id_0 intro-scope_2)))
- (syntax-track-origin$1 (transfer-srcloc intro-id_0 id_77) id_77 id_77)))))))
+ (syntax-track-origin$1 (transfer-srcloc intro-id_0 id_87) id_87 id_87)))))))
(define-values
(lookup.1)
(lambda (in43_0 out-of-context-as-variable?44_0 b47_0 ctx48_0 id49_0)
(begin
'lookup
- (let-values (((b_96) b47_0))
- (let-values (((ctx_32) ctx48_0))
- (let-values (((id_78) id49_0))
+ (let-values (((b_130) b47_0))
+ (let-values (((ctx_34) ctx48_0))
+ (let-values (((id_88) id49_0))
(let-values (((in-s_7) in43_0))
(let-values (((out-of-context-as-variable?_1) out-of-context-as-variable?44_0))
- (let-values ()
- (let-values (((b196_0) b_96)
- ((temp197_0) (expand-context-env ctx_32))
- ((temp198_0) (expand-context-lift-envs ctx_32))
- ((temp199_0) (expand-context-namespace ctx_32))
- ((temp200_0) (expand-context-phase ctx_32))
- ((id201_0) id_78)
- ((in-s202_0) in-s_7)
- ((out-of-context-as-variable?203_0) out-of-context-as-variable?_1))
- (binding-lookup.1
- #t
- in-s202_0
- out-of-context-as-variable?203_0
- b196_0
- temp197_0
- temp198_0
- temp199_0
- temp200_0
- id201_0)))))))))))
+ (let-values (((b196_0) b_130)
+ ((temp197_0) (expand-context-env ctx_34))
+ ((temp198_0) (expand-context-lift-envs ctx_34))
+ ((temp199_0) (expand-context-namespace ctx_34))
+ ((temp200_0) (expand-context-phase ctx_34))
+ ((id201_0) id_88)
+ ((in-s202_0) in-s_7)
+ ((out-of-context-as-variable?203_0) out-of-context-as-variable?_1))
+ (binding-lookup.1
+ #t
+ in-s202_0
+ out-of-context-as-variable?203_0
+ b196_0
+ temp197_0
+ temp198_0
+ temp199_0
+ temp200_0
+ id201_0))))))))))
(define-values
(substitute-alternate-id)
- (lambda (s_480 alternate-id_3)
+ (lambda (s_654 alternate-id_3)
(begin
(if (not alternate-id_3)
- (let-values () s_480)
- (if (syntax-identifier? s_480)
- (let-values () (syntax-track-origin$1 alternate-id_3 s_480))
- (let-values ()
- (syntax-track-origin$1
- (datum->syntax$1 s_480 (cons alternate-id_3 (cdr (syntax-e$1 s_480))) s_480)
- s_480)))))))
+ s_654
+ (if (syntax-identifier? s_654)
+ (syntax-track-origin$1 alternate-id_3 s_654)
+ (syntax-track-origin$1
+ (datum->syntax$1 s_654 (cons alternate-id_3 (cdr (syntax-e$1 s_654))) s_654)
+ s_654))))))
(define-values
(register-variable-referenced-if-local!)
- (lambda (binding_25 ctx_33)
+ (lambda (binding_26 ctx_35)
(begin
- (if (if (local-binding? binding_25)
- (if (reference-record? (binding-frame-id binding_25)) (not (expand-context-parsing-expanded? ctx_33)) #f)
+ (if (if (local-binding? binding_26)
+ (if (reference-record? (binding-frame-id binding_26)) (not (expand-context-parsing-expanded? ctx_35)) #f)
#f)
- (let-values () (reference-record-used! (binding-frame-id binding_25) (local-binding-key binding_25)))
+ (reference-record-used! (binding-frame-id binding_26) (local-binding-key binding_26))
(void)))))
(define-values
(expand/capture-lifts.1)
(lambda (always-wrap?54_0 begin-form?52_0 expand-lifts?51_0 lift-key53_0 s59_0 ctx60_0)
(begin
'expand/capture-lifts
- (let-values (((s_481) s59_0))
- (let-values (((ctx_34) ctx60_0))
+ (let-values (((s_655) s59_0))
+ (let-values (((ctx_36) ctx60_0))
(let-values (((expand-lifts?_0) expand-lifts?51_0))
(let-values (((begin-form?_0) begin-form?52_0))
(let-values (((lift-key_2) (if (eq? lift-key53_0 unsafe-undefined) (generate-lift-key) lift-key53_0)))
(let-values (((always-wrap?_0) always-wrap?54_0))
- (let-values ()
- (let-values (((context_6) (expand-context-context ctx_34)))
- (let-values (((phase_115) (expand-context-phase ctx_34)))
- (let-values (((local?_0) (not begin-form?_0)))
- ((letrec-values (((loop_97)
- (lambda (s_253 always-wrap?_1 ctx_35)
- (begin
- 'loop
- (let-values (((lift-env_2) (if local?_0 (box empty-env) #f)))
- (let-values (((lift-ctx_0)
- (let-values (((temp204_0)
- (if local?_0
- (make-local-lift
- lift-env_2
- (root-expand-context-counter ctx_35)
- (if (expand-context-normalize-locals?
- ctx_35)
- 'lift
- #f))
- (make-top-level-lift ctx_35)))
- ((temp205_1)
- (if (not local?_0)
- (eq? context_6 'module)
- #f)))
- (make-lift-context.1 temp205_1 temp204_0))))
- (let-values (((capture-ctx_0)
- (let-values (((v_201) ctx_35))
- (let-values (((the-struct_54) v_201))
- (if (expand-context/outer? the-struct_54)
- (let-values (((inner206_0)
- (let-values (((the-struct_55)
- (root-expand-context/outer-inner
- v_201)))
- (if (expand-context/inner?
- the-struct_55)
- (let-values (((lift-key207_0)
- lift-key_2)
- ((lifts208_0)
- lift-ctx_0)
- ((lift-envs209_0)
- (if local?_0
- (cons
- lift-env_2
- (expand-context-lift-envs
- ctx_35))
- (expand-context-lift-envs
- ctx_35)))
- ((module-lifts210_0)
- (if (let-values (((or-part_284)
- local?_0))
- (if or-part_284
- or-part_284
- (not
- (memq
- context_6
- '(top-level
- module)))))
- (expand-context-module-lifts
- ctx_35)
- lift-ctx_0)))
- (expand-context/inner2.1
- (root-expand-context/inner-self-mpi
- the-struct_55)
- (root-expand-context/inner-module-scopes
- the-struct_55)
- (root-expand-context/inner-top-level-bind-scope
- the-struct_55)
- (root-expand-context/inner-all-scopes-stx
- the-struct_55)
- (root-expand-context/inner-defined-syms
- the-struct_55)
- (root-expand-context/inner-counter
- the-struct_55)
- lift-key207_0
- (expand-context/inner-to-parsed?
- the-struct_55)
- (expand-context/inner-phase
- the-struct_55)
- (expand-context/inner-namespace
- the-struct_55)
- (expand-context/inner-just-once?
- the-struct_55)
- (expand-context/inner-module-begin-k
- the-struct_55)
- (expand-context/inner-allow-unbound?
- the-struct_55)
- (expand-context/inner-in-local-expand?
- the-struct_55)
- (expand-context/inner-keep-#%expression?
- the-struct_55)
- (expand-context/inner-stops
- the-struct_55)
- (expand-context/inner-declared-submodule-names
- the-struct_55)
- lifts208_0
- lift-envs209_0
- module-lifts210_0
- (expand-context/inner-require-lifts
- the-struct_55)
- (expand-context/inner-to-module-lifts
- the-struct_55)
- (expand-context/inner-requires+provides
- the-struct_55)
- (expand-context/inner-observer
- the-struct_55)
- (expand-context/inner-for-serializable?
- the-struct_55)
- (expand-context/inner-to-correlated-linklet?
- the-struct_55)
- (expand-context/inner-normalize-locals?
- the-struct_55)
- (expand-context/inner-parsing-expanded?
- the-struct_55)
- (expand-context/inner-skip-visit-available?
- the-struct_55)))
- (raise-argument-error
- 'struct-copy
- "expand-context/inner?"
- the-struct_55)))))
- (expand-context/outer1.1
- inner206_0
- (root-expand-context/outer-post-expansion
- the-struct_54)
- (root-expand-context/outer-use-site-scopes
- the-struct_54)
- (root-expand-context/outer-frame-id
- the-struct_54)
- (expand-context/outer-context the-struct_54)
- (expand-context/outer-env the-struct_54)
- (expand-context/outer-scopes the-struct_54)
- (expand-context/outer-def-ctx-scopes
- the-struct_54)
- (expand-context/outer-binding-layer
- the-struct_54)
- (expand-context/outer-reference-records
- the-struct_54)
- (expand-context/outer-only-immediate?
- the-struct_54)
- (expand-context/outer-need-eventually-defined
- the-struct_54)
- (expand-context/outer-current-introduction-scopes
- the-struct_54)
- (expand-context/outer-current-use-scopes
- the-struct_54)
- (expand-context/outer-name the-struct_54)))
- (raise-argument-error
- 'struct-copy
- "expand-context/outer?"
- the-struct_54))))))
- (let-values (((rebuild-s_0) (keep-properties-only s_253)))
- (let-values (((exp-s_2)
- (let-values (((s211_0) s_253)
- ((capture-ctx212_0) capture-ctx_0))
- (expand.1 #f #f s211_0 capture-ctx212_0))))
- (let-values (((lifts_6)
- (get-and-clear-lifts!
- (expand-context-lifts capture-ctx_0))))
- (let-values (((with-lifts-s_0)
- (if (let-values (((or-part_285)
- (pair? lifts_6)))
- (if or-part_285
- or-part_285
- always-wrap?_1))
- (let-values ()
- (if (expand-context-to-parsed? ctx_35)
- (let-values ()
- (begin
- (if expand-lifts?_0
- (void)
- (let-values ()
- (error
- "internal error: to-parsed mode without expanding lifts")))
- (wrap-lifts-as-parsed-let
- lifts_6
- exp-s_2
- rebuild-s_0
- ctx_35
- (lambda (rhs_15 rhs-ctx_0)
- (loop_97 rhs_15 #f rhs-ctx_0)))))
- (let-values ()
- (if begin-form?_0
- (let-values (((lifts213_0) lifts_6)
- ((exp-s214_0) exp-s_2)
- ((phase215_0)
- phase_115))
- (wrap-lifts-as-begin.1
- unsafe-undefined
- unsafe-undefined
- lifts213_0
- exp-s214_0
- phase215_0))
- (wrap-lifts-as-let
- lifts_6
- exp-s_2
- phase_115)))))
- (let-values () exp-s_2))))
- (if (let-values (((or-part_286) (not expand-lifts?_0)))
- (if or-part_286
- or-part_286
- (let-values (((or-part_287) (null? lifts_6)))
- (if or-part_287
- or-part_287
- (expand-context-to-parsed? ctx_35)))))
- (let-values () with-lifts-s_0)
- (let-values ()
- (begin
- (let-values (((obs_27)
- (expand-context-observer ctx_35)))
- (if obs_27
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_27
- 'letlift-loop
- with-lifts-s_0)))
- (void)))
- (loop_97 with-lifts-s_0 #f ctx_35)))))))))))))))
- loop_97)
- s_481
- always-wrap?_0
- ctx_34))))))))))))))
+ (let-values (((context_6) (expand-context-context ctx_36)))
+ (let-values (((phase_140) (expand-context-phase ctx_36)))
+ (let-values (((local?_0) (not begin-form?_0)))
+ ((letrec-values (((loop_111)
+ (lambda (s_656 always-wrap?_1 ctx_37)
+ (begin
+ 'loop
+ (let-values (((lift-env_2) (if local?_0 (box empty-env) #f)))
+ (let-values (((lift-ctx_0)
+ (let-values (((temp204_0)
+ (if local?_0
+ (make-local-lift
+ lift-env_2
+ (root-expand-context-counter ctx_37)
+ (if (expand-context-normalize-locals?
+ ctx_37)
+ 'lift
+ #f))
+ (make-top-level-lift ctx_37)))
+ ((temp205_0)
+ (if (not local?_0)
+ (eq? context_6 'module)
+ #f)))
+ (make-lift-context.1 temp205_0 temp204_0))))
+ (let-values (((capture-ctx_0)
+ (let-values (((v_274) ctx_37))
+ (let-values (((the-struct_59) v_274))
+ (if (expand-context/outer? the-struct_59)
+ (let-values (((inner206_0)
+ (let-values (((the-struct_60)
+ (root-expand-context/outer-inner
+ v_274)))
+ (if (expand-context/inner?
+ the-struct_60)
+ (let-values (((lift-key207_0)
+ lift-key_2)
+ ((lifts208_0)
+ lift-ctx_0)
+ ((lift-envs209_0)
+ (if local?_0
+ (cons
+ lift-env_2
+ (expand-context-lift-envs
+ ctx_37))
+ (expand-context-lift-envs
+ ctx_37)))
+ ((module-lifts210_0)
+ (if (let-values (((or-part_467)
+ local?_0))
+ (if or-part_467
+ or-part_467
+ (not
+ (memq
+ context_6
+ '(top-level
+ module)))))
+ (expand-context-module-lifts
+ ctx_37)
+ lift-ctx_0)))
+ (expand-context/inner2.1
+ (root-expand-context/inner-self-mpi
+ the-struct_60)
+ (root-expand-context/inner-module-scopes
+ the-struct_60)
+ (root-expand-context/inner-top-level-bind-scope
+ the-struct_60)
+ (root-expand-context/inner-all-scopes-stx
+ the-struct_60)
+ (root-expand-context/inner-defined-syms
+ the-struct_60)
+ (root-expand-context/inner-counter
+ the-struct_60)
+ lift-key207_0
+ (expand-context/inner-to-parsed?
+ the-struct_60)
+ (expand-context/inner-phase
+ the-struct_60)
+ (expand-context/inner-namespace
+ the-struct_60)
+ (expand-context/inner-just-once?
+ the-struct_60)
+ (expand-context/inner-module-begin-k
+ the-struct_60)
+ (expand-context/inner-allow-unbound?
+ the-struct_60)
+ (expand-context/inner-in-local-expand?
+ the-struct_60)
+ (expand-context/inner-keep-#%expression?
+ the-struct_60)
+ (expand-context/inner-stops
+ the-struct_60)
+ (expand-context/inner-declared-submodule-names
+ the-struct_60)
+ lifts208_0
+ lift-envs209_0
+ module-lifts210_0
+ (expand-context/inner-require-lifts
+ the-struct_60)
+ (expand-context/inner-to-module-lifts
+ the-struct_60)
+ (expand-context/inner-requires+provides
+ the-struct_60)
+ (expand-context/inner-observer
+ the-struct_60)
+ (expand-context/inner-for-serializable?
+ the-struct_60)
+ (expand-context/inner-to-correlated-linklet?
+ the-struct_60)
+ (expand-context/inner-normalize-locals?
+ the-struct_60)
+ (expand-context/inner-parsing-expanded?
+ the-struct_60)
+ (expand-context/inner-skip-visit-available?
+ the-struct_60)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/inner?"
+ the-struct_60)))))
+ (expand-context/outer1.1
+ inner206_0
+ (root-expand-context/outer-post-expansion
+ the-struct_59)
+ (root-expand-context/outer-use-site-scopes
+ the-struct_59)
+ (root-expand-context/outer-frame-id
+ the-struct_59)
+ (expand-context/outer-context the-struct_59)
+ (expand-context/outer-env the-struct_59)
+ (expand-context/outer-scopes the-struct_59)
+ (expand-context/outer-def-ctx-scopes
+ the-struct_59)
+ (expand-context/outer-binding-layer
+ the-struct_59)
+ (expand-context/outer-reference-records
+ the-struct_59)
+ (expand-context/outer-only-immediate?
+ the-struct_59)
+ (expand-context/outer-need-eventually-defined
+ the-struct_59)
+ (expand-context/outer-current-introduction-scopes
+ the-struct_59)
+ (expand-context/outer-current-use-scopes
+ the-struct_59)
+ (expand-context/outer-name the-struct_59)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/outer?"
+ the-struct_59))))))
+ (let-values (((rebuild-s_0) (keep-properties-only s_656)))
+ (let-values (((exp-s_2)
+ (let-values (((s211_0) s_656)
+ ((capture-ctx212_0) capture-ctx_0))
+ (expand.1 #f #f s211_0 capture-ctx212_0))))
+ (let-values (((lifts_6)
+ (get-and-clear-lifts!
+ (expand-context-lifts capture-ctx_0))))
+ (let-values (((with-lifts-s_0)
+ (if (let-values (((or-part_468)
+ (pair? lifts_6)))
+ (if or-part_468
+ or-part_468
+ always-wrap?_1))
+ (if (expand-context-to-parsed? ctx_37)
+ (begin
+ (if expand-lifts?_0
+ (void)
+ (error
+ "internal error: to-parsed mode without expanding lifts"))
+ (wrap-lifts-as-parsed-let
+ lifts_6
+ exp-s_2
+ rebuild-s_0
+ ctx_37
+ (lambda (rhs_16 rhs-ctx_0)
+ (loop_111 rhs_16 #f rhs-ctx_0))))
+ (if begin-form?_0
+ (let-values (((lifts213_0) lifts_6)
+ ((exp-s214_0) exp-s_2)
+ ((phase215_0) phase_140))
+ (wrap-lifts-as-begin.1
+ unsafe-undefined
+ unsafe-undefined
+ lifts213_0
+ exp-s214_0
+ phase215_0))
+ (wrap-lifts-as-let
+ lifts_6
+ exp-s_2
+ phase_140)))
+ exp-s_2)))
+ (if (let-values (((or-part_469) (not expand-lifts?_0)))
+ (if or-part_469
+ or-part_469
+ (let-values (((or-part_470) (null? lifts_6)))
+ (if or-part_470
+ or-part_470
+ (expand-context-to-parsed? ctx_37)))))
+ with-lifts-s_0
+ (begin
+ (let-values (((obs_27)
+ (expand-context-observer ctx_37)))
+ (if obs_27
+ (call-expand-observe
+ obs_27
+ 'letlift-loop
+ with-lifts-s_0)
+ (void)))
+ (loop_111 with-lifts-s_0 #f ctx_37))))))))))))))
+ loop_111)
+ s_655
+ always-wrap?_0
+ ctx_36)))))))))))))
(define-values
(expand-transformer.1)
(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
'expand-transformer
- (let-values (((s_482) s74_0))
- (let-values (((ctx_36) ctx75_0))
+ (let-values (((s_657) s74_0))
+ (let-values (((ctx_38) ctx75_0))
(let-values (((context_7) context62_0))
(let-values (((begin-form?_1) begin-form?63_0))
(let-values (((expand-lifts?_1) expand-lifts?64_0))
(let-values (((lift-key_3) (if (eq? lift-key65_0 unsafe-undefined) (generate-lift-key) lift-key65_0)))
(let-values (((always-wrap?_2) always-wrap?66_0))
(let-values (((keep-stops?_0) keep-stops?67_0))
- (let-values ()
- (begin
- (if log-performance? (let-values () (start-performance-region 'expand 'transformer)) (void))
- (begin0
- (let-values ()
- (let-values (((trans-ctx_0)
- (let-values (((ctx222_0) ctx_36)
- ((context223_0) context_7)
- ((keep-stops?224_0) keep-stops?_0))
- (context->transformer-context.1 keep-stops?224_0 ctx222_0 context223_0))))
- (let-values (((s216_0) s_482)
- ((trans-ctx217_0) trans-ctx_0)
- ((expand-lifts?218_0) expand-lifts?_1)
- ((begin-form?219_0) begin-form?_1)
- ((lift-key220_0) lift-key_3)
- ((always-wrap?221_0) always-wrap?_2))
- (expand/capture-lifts.1
- always-wrap?221_0
- begin-form?219_0
- expand-lifts?218_0
- lift-key220_0
- s216_0
- trans-ctx217_0))))
- (if log-performance? (let-values () (end-performance-region)) (void))))))))))))))))
+ (begin
+ (if log-performance? (start-performance-region 'expand 'transformer) (void))
+ (begin0
+ (let-values (((trans-ctx_0)
+ (let-values (((ctx222_0) ctx_38)
+ ((context223_0) context_7)
+ ((keep-stops?224_0) keep-stops?_0))
+ (context->transformer-context.1 keep-stops?224_0 ctx222_0 context223_0))))
+ (let-values (((s216_0) s_657)
+ ((trans-ctx217_0) trans-ctx_0)
+ ((expand-lifts?218_0) expand-lifts?_1)
+ ((begin-form?219_0) begin-form?_1)
+ ((lift-key220_0) lift-key_3)
+ ((always-wrap?221_0) always-wrap?_2))
+ (expand/capture-lifts.1
+ always-wrap?221_0
+ begin-form?219_0
+ expand-lifts?218_0
+ lift-key220_0
+ s216_0
+ trans-ctx217_0)))
+ (if log-performance? (end-performance-region) (void)))))))))))))))
(define-values
(context->transformer-context.1)
(lambda (keep-stops?77_0 ctx80_0 context79_0)
(begin
'context->transformer-context
- (let-values (((ctx_37) ctx80_0))
+ (let-values (((ctx_39) ctx80_0))
(let-values (((context_8) context79_0))
(let-values (((keep-stops?_1) keep-stops?77_0))
- (let-values ()
- (let-values (((phase_116) (add1 (expand-context-phase ctx_37))))
- (let-values (((ns_78) (namespace->namespace-at-phase (expand-context-namespace ctx_37) phase_116)))
- (begin
- (namespace-visit-available-modules! ns_78 phase_116)
- (let-values (((v_74) ctx_37))
- (let-values (((the-struct_56) v_74))
- (if (expand-context/outer? the-struct_56)
- (let-values (((context225_0) context_8)
- ((scopes226_0) null)
- ((env227_0) empty-env)
- ((only-immediate?228_0)
- (if keep-stops?_1 (expand-context-only-immediate? ctx_37) #f))
- ((def-ctx-scopes229_0) #f)
- ((post-expansion230_0) #f)
- ((inner231_0)
- (let-values (((the-struct_57) (root-expand-context/outer-inner v_74)))
- (if (expand-context/inner? the-struct_57)
- (let-values (((phase232_0) phase_116)
- ((namespace233_0) ns_78)
- ((in-local-expand?234_0) #f)
- ((stops235_0)
- (if keep-stops?_1
- (expand-context-stops ctx_37)
- empty-free-id-set)))
- (expand-context/inner2.1
- (root-expand-context/inner-self-mpi the-struct_57)
- (root-expand-context/inner-module-scopes the-struct_57)
- (root-expand-context/inner-top-level-bind-scope the-struct_57)
- (root-expand-context/inner-all-scopes-stx the-struct_57)
- (root-expand-context/inner-defined-syms the-struct_57)
- (root-expand-context/inner-counter the-struct_57)
- (root-expand-context/inner-lift-key the-struct_57)
- (expand-context/inner-to-parsed? the-struct_57)
- phase232_0
- namespace233_0
- (expand-context/inner-just-once? the-struct_57)
- (expand-context/inner-module-begin-k the-struct_57)
- (expand-context/inner-allow-unbound? the-struct_57)
- in-local-expand?234_0
- (expand-context/inner-keep-#%expression? the-struct_57)
- stops235_0
- (expand-context/inner-declared-submodule-names the-struct_57)
- (expand-context/inner-lifts the-struct_57)
- (expand-context/inner-lift-envs the-struct_57)
- (expand-context/inner-module-lifts the-struct_57)
- (expand-context/inner-require-lifts the-struct_57)
- (expand-context/inner-to-module-lifts the-struct_57)
- (expand-context/inner-requires+provides the-struct_57)
- (expand-context/inner-observer the-struct_57)
- (expand-context/inner-for-serializable? the-struct_57)
- (expand-context/inner-to-correlated-linklet? the-struct_57)
- (expand-context/inner-normalize-locals? the-struct_57)
- (expand-context/inner-parsing-expanded? the-struct_57)
- (expand-context/inner-skip-visit-available? the-struct_57)))
- (raise-argument-error
- 'struct-copy
- "expand-context/inner?"
- the-struct_57)))))
- (expand-context/outer1.1
- inner231_0
- post-expansion230_0
- (root-expand-context/outer-use-site-scopes the-struct_56)
- (root-expand-context/outer-frame-id the-struct_56)
- context225_0
- env227_0
- scopes226_0
- def-ctx-scopes229_0
- (expand-context/outer-binding-layer the-struct_56)
- (expand-context/outer-reference-records the-struct_56)
- only-immediate?228_0
- (expand-context/outer-need-eventually-defined the-struct_56)
- (expand-context/outer-current-introduction-scopes the-struct_56)
- (expand-context/outer-current-use-scopes the-struct_56)
- (expand-context/outer-name the-struct_56)))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_56))))))))))))))
+ (let-values (((phase_141) (add1 (expand-context-phase ctx_39))))
+ (let-values (((ns_92) (namespace->namespace-at-phase (expand-context-namespace ctx_39) phase_141)))
+ (begin
+ (namespace-visit-available-modules! ns_92 phase_141)
+ (let-values (((v_275) ctx_39))
+ (let-values (((the-struct_61) v_275))
+ (if (expand-context/outer? the-struct_61)
+ (let-values (((context225_0) context_8)
+ ((scopes226_0) null)
+ ((env227_0) empty-env)
+ ((only-immediate?228_0)
+ (if keep-stops?_1 (expand-context-only-immediate? ctx_39) #f))
+ ((def-ctx-scopes229_0) #f)
+ ((use-site-scopes230_0) (box null))
+ ((post-expansion231_0) #f)
+ ((inner232_0)
+ (let-values (((the-struct_62) (root-expand-context/outer-inner v_275)))
+ (if (expand-context/inner? the-struct_62)
+ (let-values (((phase233_0) phase_141)
+ ((namespace234_0) ns_92)
+ ((in-local-expand?235_0) #f)
+ ((stops236_0)
+ (if keep-stops?_1
+ (expand-context-stops ctx_39)
+ empty-free-id-set)))
+ (expand-context/inner2.1
+ (root-expand-context/inner-self-mpi the-struct_62)
+ (root-expand-context/inner-module-scopes the-struct_62)
+ (root-expand-context/inner-top-level-bind-scope the-struct_62)
+ (root-expand-context/inner-all-scopes-stx the-struct_62)
+ (root-expand-context/inner-defined-syms the-struct_62)
+ (root-expand-context/inner-counter the-struct_62)
+ (root-expand-context/inner-lift-key the-struct_62)
+ (expand-context/inner-to-parsed? the-struct_62)
+ phase233_0
+ namespace234_0
+ (expand-context/inner-just-once? the-struct_62)
+ (expand-context/inner-module-begin-k the-struct_62)
+ (expand-context/inner-allow-unbound? the-struct_62)
+ in-local-expand?235_0
+ (expand-context/inner-keep-#%expression? the-struct_62)
+ stops236_0
+ (expand-context/inner-declared-submodule-names the-struct_62)
+ (expand-context/inner-lifts the-struct_62)
+ (expand-context/inner-lift-envs the-struct_62)
+ (expand-context/inner-module-lifts the-struct_62)
+ (expand-context/inner-require-lifts the-struct_62)
+ (expand-context/inner-to-module-lifts the-struct_62)
+ (expand-context/inner-requires+provides the-struct_62)
+ (expand-context/inner-observer the-struct_62)
+ (expand-context/inner-for-serializable? the-struct_62)
+ (expand-context/inner-to-correlated-linklet? the-struct_62)
+ (expand-context/inner-normalize-locals? the-struct_62)
+ (expand-context/inner-parsing-expanded? the-struct_62)
+ (expand-context/inner-skip-visit-available? the-struct_62)))
+ (raise-argument-error 'struct-copy "expand-context/inner?" the-struct_62)))))
+ (expand-context/outer1.1
+ inner232_0
+ post-expansion231_0
+ use-site-scopes230_0
+ (root-expand-context/outer-frame-id the-struct_61)
+ context225_0
+ env227_0
+ scopes226_0
+ def-ctx-scopes229_0
+ (expand-context/outer-binding-layer the-struct_61)
+ (expand-context/outer-reference-records the-struct_61)
+ only-immediate?228_0
+ (expand-context/outer-need-eventually-defined the-struct_61)
+ (expand-context/outer-current-introduction-scopes the-struct_61)
+ (expand-context/outer-current-use-scopes the-struct_61)
+ (expand-context/outer-name the-struct_61)))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_61)))))))))))))
(define-values
(expand+eval-for-syntaxes-binding.1)
(lambda (log-next?82_0 wrap83_0 who86_0 rhs87_0 ids88_0 ctx89_0)
(begin
'expand+eval-for-syntaxes-binding
- (let-values (((who_17) who86_0))
- (let-values (((rhs_16) rhs87_0))
- (let-values (((ids_20) ids88_0))
- (let-values (((ctx_38) ctx89_0))
+ (let-values (((who_28) who86_0))
+ (let-values (((rhs_17) rhs87_0))
+ (let-values (((ids_22) ids88_0))
+ (let-values (((ctx_40) ctx89_0))
(let-values (((log-next?_0) log-next?82_0))
(let-values (((wrap_2) wrap83_0))
- (let-values ()
- (let-values (((exp-rhs_0)
- (let-values (((rhs236_0) rhs_16) ((temp237_0) (as-named-context ctx_38 ids_20)))
- (expand-transformer.1
- #f
- #f
- 'expression
- #t
- #f
- unsafe-undefined
- rhs236_0
- temp237_0))))
- (let-values (((phase_117) (add1 (expand-context-phase ctx_38))))
- (let-values (((parsed-rhs_0)
- (if (expand-context-to-parsed? ctx_38)
- exp-rhs_0
- (let-values (((exp-rhs238_0) exp-rhs_0)
- ((temp239_0)
- (let-values (((temp240_0) (as-to-parsed-context ctx_38)))
- (context->transformer-context.1 #f temp240_0 'expression))))
- (expand.1 #f #f exp-rhs238_0 temp239_0)))))
- (begin
- (if log-next?_0
- (let-values ()
- (let-values (((obs_28) (expand-context-observer ctx_38)))
- (if obs_28
- (let-values () (let-values () (call-expand-observe obs_28 'next)))
- (void))))
- (void))
- (values
- exp-rhs_0
- parsed-rhs_0
- (let-values (((who241_0) who_17)
- ((ids242_0) ids_20)
- ((parsed-rhs243_0) parsed-rhs_0)
- ((phase244_0) phase_117)
- ((temp245_0)
- (namespace->namespace-at-phase (expand-context-namespace ctx_38) phase_117))
- ((ctx246_0) ctx_38)
- ((wrap247_0) wrap_2))
- (eval-for-bindings.1
- wrap247_0
- who241_0
- ids242_0
- parsed-rhs243_0
- phase244_0
- temp245_0
- ctx246_0)))))))))))))))))
+ (let-values (((exp-rhs_0)
+ (let-values (((rhs237_0) rhs_17) ((temp238_0) (as-named-context ctx_40 ids_22)))
+ (expand-transformer.1 #f #f 'expression #t #f unsafe-undefined rhs237_0 temp238_0))))
+ (let-values (((phase_142) (add1 (expand-context-phase ctx_40))))
+ (let-values (((parsed-rhs_0)
+ (if (expand-context-to-parsed? ctx_40)
+ exp-rhs_0
+ (let-values (((exp-rhs239_0) exp-rhs_0)
+ ((temp240_0)
+ (let-values (((temp241_1) (as-to-parsed-context ctx_40)))
+ (context->transformer-context.1 #f temp241_1 'expression))))
+ (expand.1 #f #f exp-rhs239_0 temp240_0)))))
+ (begin
+ (if log-next?_0
+ (let-values (((obs_28) (expand-context-observer ctx_40)))
+ (if obs_28 (call-expand-observe obs_28 'next) (void)))
+ (void))
+ (values
+ exp-rhs_0
+ parsed-rhs_0
+ (let-values (((who242_0) who_28)
+ ((ids243_0) ids_22)
+ ((parsed-rhs244_0) parsed-rhs_0)
+ ((phase245_0) phase_142)
+ ((temp246_1)
+ (namespace->namespace-at-phase (expand-context-namespace ctx_40) phase_142))
+ ((ctx247_0) ctx_40)
+ ((wrap248_0) wrap_2))
+ (eval-for-bindings.1
+ wrap248_0
+ who242_0
+ ids243_0
+ parsed-rhs244_0
+ phase245_0
+ temp246_1
+ ctx247_0))))))))))))))))
(define-values
(eval-for-syntaxes-binding)
- (lambda (who_18 rhs_17 ids_21 ctx_39)
+ (lambda (who_29 rhs_18 ids_23 ctx_41)
(begin
(let-values (((exp-rhs_1 parsed-rhs_1 vals_4)
- (let-values (((who248_0) who_18) ((rhs249_0) rhs_17) ((ids250_0) ids_21) ((ctx251_0) ctx_39))
- (expand+eval-for-syntaxes-binding.1 #t #f who248_0 rhs249_0 ids250_0 ctx251_0))))
+ (let-values (((who249_0) who_29) ((rhs250_0) rhs_18) ((ids251_0) ids_23) ((ctx252_0) ctx_41))
+ (expand+eval-for-syntaxes-binding.1 #t #f who249_0 rhs250_0 ids251_0 ctx252_0))))
vals_4))))
(define-values
(eval-for-bindings.1)
(lambda (wrap91_0 who93_0 ids94_0 p95_0 phase96_0 ns97_0 ctx98_0)
(begin
'eval-for-bindings
- (let-values (((who_19) who93_0))
- (let-values (((ids_22) ids94_0))
- (let-values (((p_49) p95_0))
- (let-values (((phase_118) phase96_0))
- (let-values (((ns_79) ns97_0))
- (let-values (((ctx_40) ctx98_0))
+ (let-values (((who_30) who93_0))
+ (let-values (((ids_24) ids94_0))
+ (let-values (((p_57) p95_0))
+ (let-values (((phase_143) phase96_0))
+ (let-values (((ns_93) ns97_0))
+ (let-values (((ctx_42) ctx98_0))
(let-values (((wrap_3) wrap91_0))
- (let-values ()
- (let-values (((compiled_0)
- (if (can-direct-eval? p_49 ns_79 (root-expand-context-self-mpi ctx_40))
- #f
- (compile-single
- p_49
- (let-values (((ns252_0) ns_79) ((phase253_0) phase_118))
- (make-compile-context.1
- #f
- unsafe-undefined
- #f
- ns252_0
- phase253_0
- unsafe-undefined))))))
- (let-values (((vals_5)
- (call-with-values
- (lambda ()
- (call-with-continuation-barrier
- (lambda ()
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first #f parameterization-key)
- 1/current-namespace
- ns_79
- eval-jit-enabled
- #f)
- (let-values ()
- (with-continuation-mark
- current-expand-context
- ctx_40
- (let-values ()
- (if compiled_0
- (if wrap_3
- (wrap_3 (lambda () (eval-single-top compiled_0 ns_79)))
- (eval-single-top compiled_0 ns_79))
- (let-values (((self-mpi_6) (root-expand-context-self-mpi ctx_40)))
- (if wrap_3
- (wrap_3 (lambda () (direct-eval p_49 ns_79 self-mpi_6)))
- (direct-eval p_49 ns_79 self-mpi_6)))))))))))
- list)))
- (begin
- (if (let-values (((or-part_288) wrap_3))
- (if or-part_288 or-part_288 (= (length vals_5) (length ids_22))))
- (void)
- (let-values () (raise-bindings-arity-error who_19 ids_22 vals_5)))
- vals_5))))))))))))))
- (define-values (keep-properties-only) (lambda (s_483) (begin (datum->syntax$1 #f 'props s_483 s_483))))
- (define-values (keep-properties-only~) (lambda (s_484) (begin #f)))
+ (let-values (((compiled_0)
+ (if (can-direct-eval? p_57 ns_93 (root-expand-context-self-mpi ctx_42))
+ #f
+ (compile-single
+ p_57
+ (let-values (((ns253_0) ns_93) ((phase254_0) phase_143))
+ (make-compile-context.1
+ #f
+ unsafe-undefined
+ #f
+ ns253_0
+ phase254_0
+ unsafe-undefined))))))
+ (let-values (((vals_5)
+ (call-with-values
+ (lambda ()
+ (call-with-continuation-barrier
+ (lambda ()
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first #f parameterization-key)
+ 1/current-namespace
+ ns_93
+ eval-jit-enabled
+ #f)
+ (with-continuation-mark
+ current-expand-context
+ ctx_42
+ (if compiled_0
+ (if wrap_3
+ (wrap_3 (lambda () (eval-single-top compiled_0 ns_93)))
+ (eval-single-top compiled_0 ns_93))
+ (let-values (((self-mpi_7) (root-expand-context-self-mpi ctx_42)))
+ (if wrap_3
+ (wrap_3 (lambda () (direct-eval p_57 ns_93 self-mpi_7)))
+ (direct-eval p_57 ns_93 self-mpi_7)))))))))
+ list)))
+ (begin
+ (if (let-values (((or-part_471) wrap_3))
+ (if or-part_471 or-part_471 (= (length vals_5) (length ids_24))))
+ (void)
+ (raise-bindings-arity-error who_30 ids_24 vals_5))
+ vals_5)))))))))))))
+ (define-values (keep-properties-only) (lambda (s_658) (begin (datum->syntax$1 #f 'props s_658 s_658))))
+ (define-values (keep-properties-only~) (lambda (s_659) (begin #f)))
(define-values
(keep-as-needed.1)
(lambda (for-track?100_0 keep-for-error?102_0 keep-for-parsed?101_0 ctx106_0 s107_0)
(begin
'keep-as-needed
- (let-values (((ctx_41) ctx106_0))
- (let-values (((s_485) s107_0))
+ (let-values (((ctx_43) ctx106_0))
+ (let-values (((s_660) s107_0))
(let-values (((for-track?_0) for-track?100_0))
(let-values (((keep-for-parsed?_0) keep-for-parsed?101_0))
(let-values (((keep-for-error?_0) keep-for-error?102_0))
- (let-values ()
- (let-values (((d_39) (syntax-e$1 s_485)))
- (let-values (((keep-e_0)
- (if (symbol? d_39)
- (let-values () d_39)
- (if (if (pair? d_39) (syntax-identifier? (car d_39)) #f)
- (let-values () (syntax-e$1 (car d_39)))
- (let-values () #f)))))
- (if (expand-context-to-parsed? ctx_41)
- (let-values ()
- (if (let-values (((or-part_289) keep-for-parsed?_0))
- (if or-part_289 or-part_289 keep-for-error?_0))
- (datum->syntax$1 #f keep-e_0 s_485 s_485)
- #f))
- (if (if for-track?_0 (if (pair? d_39) keep-e_0 #f) #f)
- (let-values () (datum->syntax$1 #f (list (car d_39)) s_485 s_485))
- (let-values () (datum->syntax$1 s_485 keep-e_0 s_485 s_485)))))))))))))))
+ (let-values (((d_39) (syntax-e$1 s_660)))
+ (let-values (((keep-e_0)
+ (if (symbol? d_39)
+ d_39
+ (if (if (pair? d_39) (syntax-identifier? (car d_39)) #f)
+ (syntax-e$1 (car d_39))
+ #f))))
+ (if (expand-context-to-parsed? ctx_43)
+ (if (let-values (((or-part_472) keep-for-parsed?_0))
+ (if or-part_472 or-part_472 keep-for-error?_0))
+ (datum->syntax$1 #f keep-e_0 s_660 s_660)
+ #f)
+ (if (if for-track?_0 (if (pair? d_39) keep-e_0 #f) #f)
+ (datum->syntax$1 #f (list (car d_39)) s_660 s_660)
+ (datum->syntax$1 s_660 keep-e_0 s_660 s_660)))))))))))))
(define-values
(attach-disappeared-transformer-bindings)
- (lambda (s_486 trans-idss_0)
+ (lambda (s_661 trans-idss_0)
(begin
(if (null? trans-idss_0)
- (let-values () s_486)
- (let-values ()
- (syntax-property$1
- s_486
- 'disappeared-binding
- (append
- (apply append trans-idss_0)
- (let-values (((or-part_290) (syntax-property$1 s_486 'disappeared-binding)))
- (if or-part_290 or-part_290 null)))))))))
+ s_661
+ (syntax-property$1
+ s_661
+ 'disappeared-binding
+ (append
+ (apply append trans-idss_0)
+ (let-values (((or-part_473) (syntax-property$1 s_661 'disappeared-binding)))
+ (if or-part_473 or-part_473 null))))))))
(define-values
(increment-binding-layer)
- (lambda (ids_23 ctx_42 layer-val_0)
+ (lambda (ids_25 ctx_44 layer-val_0)
(begin
- (if ((letrec-values (((loop_98)
- (lambda (ids_24)
+ (if ((letrec-values (((loop_112)
+ (lambda (ids_26)
(begin
'loop
- (let-values (((or-part_291) (identifier? ids_24)))
- (if or-part_291
- or-part_291
- (if (pair? ids_24)
- (let-values (((or-part_292) (loop_98 (car ids_24))))
- (if or-part_292 or-part_292 (loop_98 (cdr ids_24))))
+ (let-values (((or-part_474) (identifier? ids_26)))
+ (if or-part_474
+ or-part_474
+ (if (pair? ids_26)
+ (let-values (((or-part_475) (loop_112 (car ids_26))))
+ (if or-part_475 or-part_475 (loop_112 (cdr ids_26))))
#f)))))))
- loop_98)
- ids_23)
+ loop_112)
+ ids_25)
layer-val_0
- (expand-context-binding-layer ctx_42)))))
+ (expand-context-binding-layer ctx_44)))))
(define-values
(wrap-lifts-as-parsed-let)
- (lambda (lifts_7 exp-s_3 rebuild-s_1 ctx_43 parse-rhs_0)
+ (lambda (lifts_7 exp-s_3 rebuild-s_1 ctx_45 parse-rhs_0)
(begin
(let-values (((idss+keyss+rhss_0) (get-lifts-as-lists lifts_7)))
((letrec-values (((lets-loop_0)
@@ -48020,113 +47559,110 @@
(begin
'lets-loop
(if (null? idss+keyss+rhss_1)
- (let-values () exp-s_3)
- (let-values ()
- (let-values (((ids_25) (caar idss+keyss+rhss_1)))
- (let-values (((keys_4) (cadar idss+keyss+rhss_1)))
- (let-values (((rhs_18) (caddar idss+keyss+rhss_1)))
- (let-values (((exp-rhs_2) (parse-rhs_0 rhs_18 rhs-ctx_1)))
- (parsed-let-values17.1
- rebuild-s_1
- (list ids_25)
- (list (list keys_4 exp-rhs_2))
- (list
- (lets-loop_0
- (cdr idss+keyss+rhss_1)
- (let-values (((v_177) rhs-ctx_1))
- (let-values (((the-struct_58) v_177))
- (if (expand-context/outer? the-struct_58)
- (let-values (((env254_0)
- (let-values (((lst_300) ids_25) ((lst_301) keys_4))
+ exp-s_3
+ (let-values (((ids_27) (caar idss+keyss+rhss_1)))
+ (let-values (((keys_5) (cadar idss+keyss+rhss_1)))
+ (let-values (((rhs_19) (caddar idss+keyss+rhss_1)))
+ (let-values (((exp-rhs_2) (parse-rhs_0 rhs_19 rhs-ctx_1)))
+ (parsed-let-values18.1
+ rebuild-s_1
+ (list ids_27)
+ (list (list keys_5 exp-rhs_2))
+ (list
+ (lets-loop_0
+ (cdr idss+keyss+rhss_1)
+ (let-values (((v_276) rhs-ctx_1))
+ (let-values (((the-struct_63) v_276))
+ (if (expand-context/outer? the-struct_63)
+ (let-values (((env255_0)
+ (let-values (((env_4)
+ (let-values (((env_5)
+ (expand-context-env
+ rhs-ctx_1)))
+ env_5)))
+ (let-values (((lst_480) ids_27) ((lst_481) keys_5))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_300)))
+ (check-list lst_480))
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_301)))
- ((letrec-values (((for-loop_243)
- (lambda (env_4 lst_263 lst_264)
+ (check-list lst_481))
+ ((letrec-values (((for-loop_402)
+ (lambda (env_6 lst_482 lst_483)
(begin
'for-loop
- (if (if (pair? lst_263)
- (pair? lst_264)
+ (if (if (pair? lst_482)
+ (pair? lst_483)
#f)
- (let-values (((id_79)
+ (let-values (((id_89)
(unsafe-car
- lst_263))
- ((rest_135)
+ lst_482))
+ ((rest_236)
(unsafe-cdr
- lst_263))
- ((key_93)
+ lst_482))
+ ((key_106)
(unsafe-car
- lst_264))
- ((rest_136)
+ lst_483))
+ ((rest_237)
(unsafe-cdr
- lst_264)))
- (let-values (((env_5)
- (let-values (((env_6)
- env_4))
- (let-values (((env_7)
- (let-values ()
- (env-extend
- env_6
- key_93
- (local-variable1.1
- id_79)))))
- (values
- env_7)))))
+ lst_483)))
+ (let-values (((env_7)
+ (let-values (((env_8)
+ (env-extend
+ env_6
+ key_106
+ (local-variable1.1
+ id_89))))
+ (values
+ env_8))))
(if (not #f)
- (for-loop_243
- env_5
- rest_135
- rest_136)
- env_5)))
- env_4)))))
- for-loop_243)
- (expand-context-env rhs-ctx_1)
- lst_300
- lst_301))))
- ((inner255_0) (root-expand-context/outer-inner v_177)))
- (expand-context/outer1.1
- inner255_0
- (root-expand-context/outer-post-expansion the-struct_58)
- (root-expand-context/outer-use-site-scopes the-struct_58)
- (root-expand-context/outer-frame-id the-struct_58)
- (expand-context/outer-context the-struct_58)
- env254_0
- (expand-context/outer-scopes the-struct_58)
- (expand-context/outer-def-ctx-scopes the-struct_58)
- (expand-context/outer-binding-layer the-struct_58)
- (expand-context/outer-reference-records the-struct_58)
- (expand-context/outer-only-immediate? the-struct_58)
- (expand-context/outer-need-eventually-defined the-struct_58)
- (expand-context/outer-current-introduction-scopes the-struct_58)
- (expand-context/outer-current-use-scopes the-struct_58)
- (expand-context/outer-name the-struct_58)))
- (raise-argument-error
- 'struct-copy
- "expand-context/outer?"
- the-struct_58)))))))))))))))))
+ (for-loop_402
+ env_7
+ rest_236
+ rest_237)
+ env_7)))
+ env_6)))))
+ for-loop_402)
+ env_4
+ lst_480
+ lst_481)))))
+ ((inner256_0) (root-expand-context/outer-inner v_276)))
+ (expand-context/outer1.1
+ inner256_0
+ (root-expand-context/outer-post-expansion the-struct_63)
+ (root-expand-context/outer-use-site-scopes the-struct_63)
+ (root-expand-context/outer-frame-id the-struct_63)
+ (expand-context/outer-context the-struct_63)
+ env255_0
+ (expand-context/outer-scopes the-struct_63)
+ (expand-context/outer-def-ctx-scopes the-struct_63)
+ (expand-context/outer-binding-layer the-struct_63)
+ (expand-context/outer-reference-records the-struct_63)
+ (expand-context/outer-only-immediate? the-struct_63)
+ (expand-context/outer-need-eventually-defined the-struct_63)
+ (expand-context/outer-current-introduction-scopes the-struct_63)
+ (expand-context/outer-current-use-scopes the-struct_63)
+ (expand-context/outer-name the-struct_63)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/outer?"
+ the-struct_63))))))))))))))))
lets-loop_0)
idss+keyss+rhss_0
- ctx_43)))))
+ ctx_45)))))
(define-values
(rename-transformer-target-in-context)
- (lambda (t_32 ctx_44)
- (begin (with-continuation-mark current-expand-context ctx_44 (let-values () (1/rename-transformer-target t_32))))))
+ (lambda (t_37 ctx_46)
+ (begin (with-continuation-mark current-expand-context ctx_46 (1/rename-transformer-target t_37)))))
(define-values
(maybe-install-free=id-in-context!)
- (lambda (val_72 id_80 phase_119 ctx_45)
+ (lambda (val_80 id_90 phase_144 ctx_47)
(begin
- (if (1/rename-transformer? val_72)
- (let-values ()
- (with-continuation-mark
- current-expand-context
- ctx_45
- (let-values () (maybe-install-free=id! val_72 id_80 phase_119))))
+ (if (1/rename-transformer? val_80)
+ (with-continuation-mark current-expand-context ctx_47 (maybe-install-free=id! val_80 id_90 phase_144))
(void)))))
(define-values
(transfer-srcloc)
@@ -48134,63 +47670,55 @@
(begin
(let-values (((srcloc_9) (syntax-srcloc$1 old-s_0)))
(if srcloc_9
- (let-values (((the-struct_59) new-s_1))
- (if (syntax?$1 the-struct_59)
- (let-values (((srcloc256_0) srcloc_9))
+ (let-values (((the-struct_64) new-s_1))
+ (if (syntax?$1 the-struct_64)
+ (let-values (((srcloc257_0) srcloc_9))
(syntax2.1
- (syntax-content* the-struct_59)
- (syntax-scopes the-struct_59)
- (syntax-shifted-multi-scopes the-struct_59)
- (syntax-mpi-shifts the-struct_59)
- srcloc256_0
- (syntax-props the-struct_59)
- (syntax-inspector the-struct_59)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_59)))
+ (syntax-content* the-struct_64)
+ (syntax-scopes the-struct_64)
+ (syntax-shifted-multi-scopes the-struct_64)
+ (syntax-mpi-shifts the-struct_64)
+ srcloc257_0
+ (syntax-props the-struct_64)
+ (syntax-inspector the-struct_64)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_64)))
new-s_1)))))
(define-values
(stop-ids->all-stop-ids)
- (lambda (stop-ids_0 phase_52)
+ (lambda (stop-ids_0 phase_145)
(begin
(if (null? stop-ids_0)
- (let-values () stop-ids_0)
- (let-values ()
- (let-values (((p-core-stx_0) (syntax-shift-phase-level$1 core-stx phase_52)))
- (if (if (= 1 (length stop-ids_0))
- (free-identifier=?$1 (car stop-ids_0) (datum->syntax$1 p-core-stx_0 'module*) phase_52 phase_52)
- #f)
- (let-values () stop-ids_0)
- (let-values ()
- (append
- stop-ids_0
- (reverse$1
- (let-values (((lst_102) auto-stop-syms))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_102)))
- ((letrec-values (((for-loop_112)
- (lambda (fold-var_103 lst_88)
- (begin
- 'for-loop
- (if (pair? lst_88)
- (let-values (((sym_55) (unsafe-car lst_88))
- ((rest_49) (unsafe-cdr lst_88)))
- (let-values (((fold-var_104)
- (let-values (((fold-var_105) fold-var_103))
- (let-values (((fold-var_66)
- (let-values ()
- (cons
- (let-values ()
- (datum->syntax$1
- p-core-stx_0
- sym_55))
- fold-var_105))))
- (values fold-var_66)))))
- (if (not #f) (for-loop_112 fold-var_104 rest_49) fold-var_104)))
- fold-var_103)))))
- for-loop_112)
- null
- lst_102)))))))))))))
+ stop-ids_0
+ (let-values (((p-core-stx_0) (syntax-shift-phase-level$1 core-stx phase_145)))
+ (if (if (= 1 (length stop-ids_0))
+ (free-identifier=?$1 (car stop-ids_0) (datum->syntax$1 p-core-stx_0 'module*) phase_145 phase_145)
+ #f)
+ stop-ids_0
+ (append
+ stop-ids_0
+ (reverse$1
+ (let-values (((fold-var_505) (let-values (((fold-var_506) null)) fold-var_506)))
+ (let-values (((lst_484) auto-stop-syms))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_484))
+ ((letrec-values (((for-loop_403)
+ (lambda (fold-var_507 lst_485)
+ (begin
+ 'for-loop
+ (if (pair? lst_485)
+ (let-values (((sym_95) (unsafe-car lst_485))
+ ((rest_238) (unsafe-cdr lst_485)))
+ (let-values (((fold-var_508)
+ (let-values (((fold-var_509)
+ (cons
+ (datum->syntax$1 p-core-stx_0 sym_95)
+ fold-var_507)))
+ (values fold-var_509))))
+ (if (not #f) (for-loop_403 fold-var_508 rest_238) fold-var_508)))
+ fold-var_507)))))
+ for-loop_403)
+ fold-var_505
+ lst_484))))))))))))
(define-values
(auto-stop-syms)
'(begin
@@ -48210,33 +47738,31 @@
#%variable-reference))
(define-values
(module-expand-stop-ids)
- (lambda (phase_1)
+ (lambda (phase_146)
(begin
- (let-values (((p-core-stx_1) (syntax-shift-phase-level$1 core-stx phase_1)))
+ (let-values (((p-core-stx_1) (syntax-shift-phase-level$1 core-stx phase_146)))
(reverse$1
- (let-values (((lst_101) module-stop-syms))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_101)))
- ((letrec-values (((for-loop_111)
- (lambda (fold-var_248 lst_283)
- (begin
- 'for-loop
- (if (pair? lst_283)
- (let-values (((sym_18) (unsafe-car lst_283)) ((rest_165) (unsafe-cdr lst_283)))
- (let-values (((fold-var_260)
- (let-values (((fold-var_250) fold-var_248))
- (let-values (((fold-var_34)
- (let-values ()
- (cons
- (let-values ()
- (datum->syntax$1 p-core-stx_1 sym_18))
- fold-var_250))))
- (values fold-var_34)))))
- (if (not #f) (for-loop_111 fold-var_260 rest_165) fold-var_260)))
- fold-var_248)))))
- for-loop_111)
- null
- lst_101))))))))
+ (let-values (((fold-var_510) (let-values (((fold-var_511) null)) fold-var_511)))
+ (let-values (((lst_486) module-stop-syms))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_486))
+ ((letrec-values (((for-loop_404)
+ (lambda (fold-var_512 lst_487)
+ (begin
+ 'for-loop
+ (if (pair? lst_487)
+ (let-values (((sym_96) (unsafe-car lst_487)) ((rest_239) (unsafe-cdr lst_487)))
+ (let-values (((fold-var_513)
+ (let-values (((fold-var_514)
+ (cons
+ (datum->syntax$1 p-core-stx_1 sym_96)
+ fold-var_512)))
+ (values fold-var_514))))
+ (if (not #f) (for-loop_404 fold-var_513 rest_239) fold-var_513)))
+ fold-var_512)))))
+ for-loop_404)
+ fold-var_510
+ lst_486)))))))))
(define-values
(module-stop-syms)
(append
@@ -48253,46 +47779,42 @@
internal-definition-context-env-mixins
internal-definition-context-use-site-scopes
internal-definition-context-parent-ctx)
- (let-values (((struct:_68 make-_68 ?_68 -ref_68 -set!_68)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'internal-definition-context
- #f
- 7
- 0
- #f
- null
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6)
- #f
- 'internal-definition-context)))))
+ (let-values (((struct:_126 make-_126 ?_126 -ref_126 -set!_126)
+ (make-struct-type
+ 'internal-definition-context
+ #f
+ 7
+ 0
+ #f
+ null
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 6)
+ #f
+ 'internal-definition-context)))
(values
- struct:_68
- make-_68
- ?_68
- (make-struct-field-accessor -ref_68 0 'frame-id)
- (make-struct-field-accessor -ref_68 1 'outside-edge)
- (make-struct-field-accessor -ref_68 2 'inside-edge)
- (make-struct-field-accessor -ref_68 3 'add-scope?)
- (make-struct-field-accessor -ref_68 4 'env-mixins)
- (make-struct-field-accessor -ref_68 5 'use-site-scopes)
- (make-struct-field-accessor -ref_68 6 'parent-ctx))))
+ struct:_126
+ make-_126
+ ?_126
+ (make-struct-field-accessor -ref_126 0 'frame-id)
+ (make-struct-field-accessor -ref_126 1 'outside-edge)
+ (make-struct-field-accessor -ref_126 2 'inside-edge)
+ (make-struct-field-accessor -ref_126 3 'add-scope?)
+ (make-struct-field-accessor -ref_126 4 'env-mixins)
+ (make-struct-field-accessor -ref_126 5 'use-site-scopes)
+ (make-struct-field-accessor -ref_126 6 'parent-ctx))))
(define-values
(struct:env-mixin env-mixin2.1 env-mixin? env-mixin-id env-mixin-sym env-mixin-value env-mixin-cache)
- (let-values (((struct:_69 make-_69 ?_69 -ref_69 -set!_69)
- (let-values ()
- (let-values ()
- (make-struct-type 'env-mixin #f 4 0 #f null (current-inspector) #f '(0 1 2 3) #f 'env-mixin)))))
+ (let-values (((struct:_127 make-_127 ?_127 -ref_127 -set!_127)
+ (make-struct-type 'env-mixin #f 4 0 #f null (current-inspector) #f '(0 1 2 3) #f 'env-mixin)))
(values
- struct:_69
- make-_69
- ?_69
- (make-struct-field-accessor -ref_69 0 'id)
- (make-struct-field-accessor -ref_69 1 'sym)
- (make-struct-field-accessor -ref_69 2 'value)
- (make-struct-field-accessor -ref_69 3 'cache))))
+ struct:_127
+ make-_127
+ ?_127
+ (make-struct-field-accessor -ref_127 0 'id)
+ (make-struct-field-accessor -ref_127 1 'sym)
+ (make-struct-field-accessor -ref_127 2 'value)
+ (make-struct-field-accessor -ref_127 3 'cache))))
(define-values
(1/syntax-local-make-definition-context)
(let-values (((syntax-local-make-definition-context_0)
@@ -48301,626 +47823,670 @@
'syntax-local-make-definition-context
(let-values (((parent-ctx_0) parent-ctx3_0))
(let-values (((add-scope?_0) add-scope?4_0))
- (let-values ()
- (let-values ((()
- (begin
- (if (let-values (((or-part_91) (not parent-ctx_0)))
- (if or-part_91
- or-part_91
- (1/internal-definition-context? parent-ctx_0)))
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-make-definition-context
- "(or/c #f internal-definition-context?)"
- parent-ctx_0)))
- (values))))
- (let-values (((ctx_46)
- (let-values (((temp39_3) 'syntax-local-make-definition-context))
- (get-current-expand-context.1 #f temp39_3))))
- (let-values (((frame-id_8)
- (let-values (((or-part_105)
- (if parent-ctx_0
- (internal-definition-context-frame-id parent-ctx_0)
- #f)))
- (if or-part_105
- or-part_105
- (let-values (((or-part_293)
- (if (not
- (eq? 'expression (expand-context-context ctx_46)))
- (root-expand-context-frame-id ctx_46)
- #f)))
- (if or-part_293 or-part_293 (gensym)))))))
- (let-values (((outside-edge_0) (new-scope 'intdef-outside)))
- (let-values (((inside-edge_0) (new-scope 'intdef)))
- (let-values (((def-ctx-scopes_4) (expand-context-def-ctx-scopes ctx_46)))
- (let-values ((()
- (begin
- (if def-ctx-scopes_4
- (let-values ()
- (set-box!
- def-ctx-scopes_4
- (cons
- inside-edge_0
- (cons outside-edge_0 (unbox def-ctx-scopes_4)))))
- (void))
- (values))))
- (let-values (((use-site-scopes_2) (box '())))
- (internal-definition-context1.1
- frame-id_8
- outside-edge_0
- inside-edge_0
- add-scope?_0
- (box null)
- use-site-scopes_2
- parent-ctx_0))))))))))))))))
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_476) (not parent-ctx_0)))
+ (if or-part_476
+ or-part_476
+ (1/internal-definition-context? parent-ctx_0)))
+ (void)
+ (raise-argument-error
+ 'syntax-local-make-definition-context
+ "(or/c #f internal-definition-context?)"
+ parent-ctx_0))
+ (values))))
+ (let-values (((ctx_48)
+ (let-values (((temp40_1) 'syntax-local-make-definition-context))
+ (get-current-expand-context.1 #f temp40_1))))
+ (let-values (((frame-id_8)
+ (let-values (((or-part_477)
+ (if parent-ctx_0
+ (internal-definition-context-frame-id parent-ctx_0)
+ #f)))
+ (if or-part_477
+ or-part_477
+ (let-values (((or-part_478)
+ (if (not (eq? 'expression (expand-context-context ctx_48)))
+ (root-expand-context-frame-id ctx_48)
+ #f)))
+ (if or-part_478 or-part_478 (gensym)))))))
+ (let-values (((outside-edge_0) (new-scope 'intdef-outside)))
+ (let-values (((inside-edge_0) (new-scope 'intdef)))
+ (let-values (((def-ctx-scopes_4) (expand-context-def-ctx-scopes ctx_48)))
+ (let-values ((()
+ (begin
+ (if def-ctx-scopes_4
+ (set-box!
+ def-ctx-scopes_4
+ (cons
+ inside-edge_0
+ (cons outside-edge_0 (unbox def-ctx-scopes_4))))
+ (void))
+ (values))))
+ (let-values (((use-site-scopes_2) (box '())))
+ (internal-definition-context1.1
+ frame-id_8
+ outside-edge_0
+ inside-edge_0
+ add-scope?_0
+ (box null)
+ use-site-scopes_2
+ parent-ctx_0)))))))))))))))
(case-lambda
(() (begin 'syntax-local-make-definition-context (syntax-local-make-definition-context_0 #f #t)))
((parent-ctx_1 add-scope?4_1) (syntax-local-make-definition-context_0 parent-ctx_1 add-scope?4_1))
((parent-ctx3_1) (syntax-local-make-definition-context_0 parent-ctx3_1 #t)))))
+ (define-values
+ (1/syntax-local-make-definition-context-introducer)
+ (let-values (((syntax-local-make-definition-context-introducer_0)
+ (lambda (name5_0)
+ (begin
+ 'syntax-local-make-definition-context-introducer
+ (let-values (((name_78) name5_0))
+ (let-values ((()
+ (begin
+ (if ((lambda (name_79) (if (symbol? name_79) (not (eq? name_79 'macro)) #f))
+ name_78)
+ (void)
+ (raise-argument-error
+ 'syntax-local-make-definition-context-introducer
+ "(and/c symbol? (not/c 'macro))"
+ name_78))
+ (values))))
+ (let-values (((ctx_49)
+ (let-values (((who42_0) 'syntax-local-make-definition-context-introducer))
+ (get-current-expand-context.1 #f who42_0))))
+ (let-values (((scope_1) (new-scope name_78)))
+ (let-values (((def-ctx-scopes_5) (expand-context-def-ctx-scopes ctx_49)))
+ (begin
+ (if def-ctx-scopes_5
+ (set-box! def-ctx-scopes_5 (cons scope_1 (unbox def-ctx-scopes_5)))
+ (void))
+ (let-values (((...finition-context.rkt:86:2_0)
+ (lambda (s44_0 mode43_1)
+ (begin
+ '...finition-context.rkt:86:2
+ (let-values (((s_662) s44_0))
+ (let-values (((mode_15) mode43_1))
+ (let-values (((who_31) 'definition-context-introducer))
+ (let-values ((()
+ (begin
+ (if (syntax?$1 s_662)
+ (void)
+ (raise-argument-error who_31 "syntax?" s_662))
+ (values))))
+ (let-values (((new-s_2)
+ (let-values (((tmp_36) mode_15))
+ (if (equal? tmp_36 'add)
+ (add-scope s_662 scope_1)
+ (if (equal? tmp_36 'remove)
+ (remove-scope s_662 scope_1)
+ (if (equal? tmp_36 'flip)
+ (flip-scope s_662 scope_1)
+ (raise-argument-error
+ who_31
+ "(or/c 'add 'remove 'flip)"
+ mode_15)))))))
+ (let-values (((ctx_50)
+ (let-values (((temp45_0) #t))
+ (get-current-expand-context.1
+ temp45_0
+ 'unexpected))))
+ (begin
+ (if ctx_50
+ (let-values (((obs_29)
+ (expand-context-observer ctx_50)))
+ (if obs_29
+ (call-expand-observe
+ obs_29
+ 'track-syntax
+ who_31
+ new-s_2
+ s_662)
+ (void)))
+ (void))
+ new-s_2)))))))))))
+ (case-lambda
+ ((s_663)
+ (begin '...finition-context.rkt:86:2 (...finition-context.rkt:86:2_0 s_663 'flip)))
+ ((s_664 mode43_2) (...finition-context.rkt:86:2_0 s_664 mode43_2))))))))))))))
+ (case-lambda
+ (()
+ (begin
+ 'syntax-local-make-definition-context-introducer
+ (syntax-local-make-definition-context-introducer_0 'intdef)))
+ ((name5_1) (syntax-local-make-definition-context-introducer_0 name5_1)))))
(define-values
(1/syntax-local-bind-syntaxes)
(let-values (((syntax-local-bind-syntaxes_0)
- (lambda (ids6_0 s7_0 intdef8_0 extra-intdefs5_0)
+ (lambda (ids7_0 s8_0 intdef9_0 extra-intdefs6_0)
(begin
'syntax-local-bind-syntaxes
- (let-values (((ids_26) ids6_0))
- (let-values (((s_487) s7_0))
- (let-values (((intdef_0) intdef8_0))
- (let-values (((extra-intdefs_0) extra-intdefs5_0))
- (let-values ()
+ (let-values (((ids_28) ids7_0))
+ (let-values (((s_665) s8_0))
+ (let-values (((intdef_0) intdef9_0))
+ (let-values (((extra-intdefs_0) extra-intdefs6_0))
+ (let-values ((()
+ (begin
+ (if (if (list? ids_28) (andmap2 identifier? ids_28) #f)
+ (void)
+ (raise-argument-error
+ 'syntax-local-bind-syntaxes
+ "(listof identifier?)"
+ ids_28))
+ (values))))
(let-values ((()
(begin
- (if (if (list? ids_26) (andmap2 identifier? ids_26) #f)
+ (if (let-values (((or-part_479) (not s_665)))
+ (if or-part_479 or-part_479 (syntax?$1 s_665)))
(void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-bind-syntaxes
- "(listof identifier?)"
- ids_26)))
+ (raise-argument-error
+ 'syntax-local-bind-syntaxes
+ "(or/c syntax? #f)"
+ s_665))
(values))))
(let-values ((()
(begin
- (if (let-values (((or-part_8) (not s_487)))
- (if or-part_8 or-part_8 (syntax?$1 s_487)))
+ (if (1/internal-definition-context? intdef_0)
(void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-bind-syntaxes
- "(or/c syntax? #f)"
- s_487)))
+ (raise-argument-error
+ 'syntax-local-bind-syntaxes
+ "internal-definition-context?"
+ intdef_0))
(values))))
(let-values ((()
(begin
- (if (1/internal-definition-context? intdef_0)
+ (if (intdefs? extra-intdefs_0)
(void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-bind-syntaxes
- "internal-definition-context?"
- intdef_0)))
+ (raise-argument-error
+ 'syntax-local-bind-syntaxes
+ intdefs?-string
+ extra-intdefs_0))
(values))))
- (let-values ((()
- (begin
- (if (intdefs? extra-intdefs_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-bind-syntaxes
- intdefs?-string
- extra-intdefs_0)))
- (values))))
- (let-values (((ctx_47)
- (let-values (((temp40_1) 'local-expand))
- (get-current-expand-context.1 #f temp40_1))))
- (let-values ((()
- (begin
- (let-values (((obs_29) (expand-context-observer ctx_47)))
- (if obs_29
- (let-values ()
- (let-values ()
- (call-expand-observe obs_29 'local-bind ids_26)))
- (void)))
- (values))))
- (let-values (((phase_120) (expand-context-phase ctx_47)))
- (let-values (((all-intdefs_0)
- (if (null? extra-intdefs_0)
- intdef_0
- (if (list? extra-intdefs_0)
- (cons intdef_0 extra-intdefs_0)
- (list intdef_0 extra-intdefs_0)))))
- (let-values (((intdef-ids_0)
- (reverse$1
- (let-values (((lst_96) ids_26))
+ (let-values (((ctx_51)
+ (let-values (((temp46_1) 'local-expand))
+ (get-current-expand-context.1 #f temp46_1))))
+ (let-values ((()
+ (begin
+ (let-values (((obs_30) (expand-context-observer ctx_51)))
+ (if obs_30
+ (call-expand-observe obs_30 'local-bind ids_28)
+ (void)))
+ (values))))
+ (let-values (((phase_147) (expand-context-phase ctx_51)))
+ (let-values (((all-intdefs_0)
+ (if (null? extra-intdefs_0)
+ intdef_0
+ (if (list? extra-intdefs_0)
+ (cons intdef_0 extra-intdefs_0)
+ (list intdef_0 extra-intdefs_0)))))
+ (let-values (((intdef-ids_0)
+ (reverse$1
+ (let-values (((fold-var_515)
+ (let-values (((fold-var_516) null))
+ fold-var_516)))
+ (let-values (((lst_488) ids_28))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_96)))
- ((letrec-values (((for-loop_215)
- (lambda (fold-var_210 lst_197)
+ (check-list lst_488))
+ ((letrec-values (((for-loop_405)
+ (lambda (fold-var_517 lst_489)
(begin
'for-loop
- (if (pair? lst_197)
- (let-values (((id_81)
+ (if (pair? lst_489)
+ (let-values (((id_91)
(unsafe-car
- lst_197))
- ((rest_152)
+ lst_489))
+ ((rest_240)
(unsafe-cdr
- lst_197)))
- (let-values (((fold-var_76)
- (let-values (((fold-var_77)
- fold-var_210))
- (let-values (((fold-var_110)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((pre-id_0)
- (remove-intdef-use-site-scopes
- (flip-introduction-scopes
- id_81
- ctx_47)
- intdef_0)))
- (let-values (((temp41_2)
- (let-values (((pre-id43_0)
- pre-id_0)
- ((intdef44_0)
- intdef_0)
- ((temp45_1)
- #t))
- (add-intdef-scopes.1
- unsafe-undefined
- temp45_1
- pre-id43_0
- intdef44_0)))
- ((extra-intdefs42_0)
- extra-intdefs_0))
- (add-intdef-scopes.1
- unsafe-undefined
- #f
- temp41_2
- extra-intdefs42_0))))
- fold-var_77))))
- (values
- fold-var_110)))))
+ lst_489)))
+ (let-values (((fold-var_518)
+ (let-values (((fold-var_519)
+ (cons
+ (let-values (((pre-id_0)
+ (remove-intdef-use-site-scopes
+ (flip-introduction-scopes
+ id_91
+ ctx_51)
+ intdef_0)))
+ (let-values (((temp47_1)
+ (let-values (((pre-id49_0)
+ pre-id_0)
+ ((intdef50_0)
+ intdef_0)
+ ((temp51_2)
+ #t))
+ (add-intdef-scopes.1
+ unsafe-undefined
+ temp51_2
+ pre-id49_0
+ intdef50_0)))
+ ((extra-intdefs48_0)
+ extra-intdefs_0))
+ (add-intdef-scopes.1
+ unsafe-undefined
+ #f
+ temp47_1
+ extra-intdefs48_0)))
+ fold-var_517)))
+ (values
+ fold-var_519))))
(if (not #f)
- (for-loop_215
- fold-var_76
- rest_152)
- fold-var_76)))
- fold-var_210)))))
- for-loop_215)
- null
- lst_96))))))
- (let-values ((()
- (begin
- (let-values (((obs_30)
- (expand-context-observer ctx_47)))
- (if obs_30
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_30
- 'rename-list
- intdef-ids_0)))
- (void)))
- (values))))
- (let-values (((counter_4) (root-expand-context-counter ctx_47)))
- (let-values (((local-sym_2)
- (if (expand-context-normalize-locals? ctx_47)
- 'loc
- #f)))
- (let-values (((syms_22)
- (reverse$1
- (let-values (((lst_238) intdef-ids_0))
+ (for-loop_405
+ fold-var_518
+ rest_240)
+ fold-var_518)))
+ fold-var_517)))))
+ for-loop_405)
+ fold-var_515
+ lst_488)))))))
+ (let-values ((()
+ (begin
+ (let-values (((obs_31) (expand-context-observer ctx_51)))
+ (if obs_31
+ (call-expand-observe obs_31 'rename-list intdef-ids_0)
+ (void)))
+ (values))))
+ (let-values (((counter_4) (root-expand-context-counter ctx_51)))
+ (let-values (((local-sym_2)
+ (if (expand-context-normalize-locals? ctx_51) 'loc #f)))
+ (let-values (((syms_30)
+ (reverse$1
+ (let-values (((fold-var_520)
+ (let-values (((fold-var_521) null))
+ fold-var_521)))
+ (let-values (((lst_490) intdef-ids_0))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_238)))
- ((letrec-values (((for-loop_83)
- (lambda (fold-var_21 lst_239)
+ (check-list lst_490))
+ ((letrec-values (((for-loop_406)
+ (lambda (fold-var_522
+ lst_491)
(begin
'for-loop
- (if (pair? lst_239)
+ (if (pair? lst_491)
(let-values (((intdef-id_0)
(unsafe-car
- lst_239))
- ((rest_166)
+ lst_491))
+ ((rest_241)
(unsafe-cdr
- lst_239)))
- (let-values (((fold-var_79)
- (let-values (((fold-var_80)
- fold-var_21))
- (let-values (((fold-var_17)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((intdef-id46_0)
- intdef-id_0)
- ((phase47_0)
- phase_120)
- ((counter48_0)
- counter_4)
- ((temp49_1)
- (internal-definition-context-frame-id
- intdef_0))
- ((local-sym50_0)
- local-sym_2))
- (add-local-binding!.1
- temp49_1
- #f
- local-sym50_0
- intdef-id46_0
- phase47_0
- counter48_0)))
- fold-var_80))))
- (values
- fold-var_17)))))
+ lst_491)))
+ (let-values (((fold-var_523)
+ (let-values (((fold-var_524)
+ (cons
+ (let-values (((intdef-id52_0)
+ intdef-id_0)
+ ((phase53_1)
+ phase_147)
+ ((counter54_0)
+ counter_4)
+ ((temp55_2)
+ (internal-definition-context-frame-id
+ intdef_0))
+ ((local-sym56_0)
+ local-sym_2))
+ (add-local-binding!.1
+ temp55_2
+ #f
+ local-sym56_0
+ intdef-id52_0
+ phase53_1
+ counter54_0))
+ fold-var_522)))
+ (values
+ fold-var_524))))
(if (not #f)
- (for-loop_83
- fold-var_79
- rest_166)
- fold-var_79)))
- fold-var_21)))))
- for-loop_83)
- null
- lst_238))))))
- (let-values (((local-ctx_0)
- (if s_487
- (let-values ()
- (let-values (((tmp-env_0)
- (let-values (((lst_302) syms_22)
- ((lst_303)
- intdef-ids_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_302)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list lst_303)))
- ((letrec-values (((for-loop_271)
- (lambda (env_8
- lst_157
- lst_200)
- (begin
- 'for-loop
- (if (if (pair?
- lst_157)
- (pair?
- lst_200)
- #f)
- (let-values (((sym_79)
- (unsafe-car
- lst_157))
- ((rest_103)
- (unsafe-cdr
- lst_157))
- ((intdef-id_1)
- (unsafe-car
- lst_200))
- ((rest_167)
- (unsafe-cdr
- lst_200)))
- (let-values (((env_9)
- (let-values (((env_10)
- env_8))
- (let-values (((env_11)
- (let-values ()
- (env-extend
- env_10
- sym_79
- (local-variable1.1
- intdef-id_1)))))
- (values
- env_11)))))
- (if (not
- #f)
- (for-loop_271
- env_9
- rest_103
- rest_167)
- env_9)))
- env_8)))))
- for-loop_271)
- (expand-context-env ctx_47)
- lst_302
- lst_303)))))
- (let-values (((temp51_2)
- (let-values (((v_202) ctx_47))
- (let-values (((the-struct_60)
- v_202))
- (if (expand-context/outer?
- the-struct_60)
- (let-values (((env55_0)
- tmp-env_0)
- ((inner56_0)
- (root-expand-context/outer-inner
- v_202)))
- (expand-context/outer1.1
- inner56_0
- (root-expand-context/outer-post-expansion
- the-struct_60)
- (root-expand-context/outer-use-site-scopes
- the-struct_60)
- (root-expand-context/outer-frame-id
- the-struct_60)
- (expand-context/outer-context
- the-struct_60)
- env55_0
- (expand-context/outer-scopes
- the-struct_60)
- (expand-context/outer-def-ctx-scopes
- the-struct_60)
- (expand-context/outer-binding-layer
- the-struct_60)
- (expand-context/outer-reference-records
- the-struct_60)
- (expand-context/outer-only-immediate?
- the-struct_60)
- (expand-context/outer-need-eventually-defined
- the-struct_60)
- (expand-context/outer-current-introduction-scopes
- the-struct_60)
- (expand-context/outer-current-use-scopes
- the-struct_60)
- (expand-context/outer-name
- the-struct_60)))
- (raise-argument-error
- 'struct-copy
- "expand-context/outer?"
- the-struct_60)))))
- ((temp52_1) 'expression)
- ((all-intdefs53_0)
- all-intdefs_0)
- ((temp54_2) #f))
- (make-local-expand-context.1
- temp52_1
- temp54_2
- all-intdefs53_0
- #t
- unsafe-undefined
- #f
- #f
- #f
- temp51_2))))
- #f)))
- (let-values (((vals_6)
- (if s_487
- (let-values ()
- (let-values (((input-s_0)
- (flip-introduction-scopes
- (let-values (((s57_0) s_487)
- ((all-intdefs58_0)
- all-intdefs_0))
- (add-intdef-scopes.1
- unsafe-undefined
- #f
- s57_0
- all-intdefs58_0))
- ctx_47)))
- (let-values ((()
- (begin
- (let-values (((obs_31)
- (expand-context-observer
- ctx_47)))
- (if obs_31
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_31
- 'enter-bind)))
- (void)))
- (values))))
- (let-values (((vals_7)
- (eval-for-syntaxes-binding
- 'syntax-local-bind-syntaxes
- input-s_0
- ids_26
- local-ctx_0)))
- (begin
- (let-values (((obs_32)
- (expand-context-observer
- ctx_47)))
- (if obs_32
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_32
- 'exit-bind)))
- (void)))
- vals_7)))))
- (let-values ()
- (reverse$1
- (let-values (((lst_304) intdef-ids_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_304)))
- ((letrec-values (((for-loop_36)
- (lambda (fold-var_261
- lst_113)
- (begin
- 'for-loop
- (if (pair?
- lst_113)
- (let-values (((intdef-id_2)
- (unsafe-car
- lst_113))
- ((rest_108)
- (unsafe-cdr
- lst_113)))
- (let-values (((fold-var_262)
- (let-values (((fold-var_263)
- fold-var_261))
- (let-values (((fold-var_212)
- (let-values ()
- (cons
- (let-values ()
- (local-variable1.1
- intdef-id_2))
- fold-var_263))))
- (values
- fold-var_212)))))
- (if (not
- #f)
- (for-loop_36
- fold-var_262
- rest_108)
- fold-var_262)))
- fold-var_261)))))
- for-loop_36)
- null
- lst_304))))))))
- (let-values (((env-mixins_0)
- (internal-definition-context-env-mixins
- intdef_0)))
- (begin
- (set-box!
- env-mixins_0
- (append
- (reverse$1
- (let-values (((lst_297) intdef-ids_0)
- ((lst_185) syms_22)
- ((lst_186) vals_6))
+ (for-loop_406
+ fold-var_523
+ rest_241)
+ fold-var_523)))
+ fold-var_522)))))
+ for-loop_406)
+ fold-var_520
+ lst_490)))))))
+ (let-values (((local-ctx_0)
+ (if s_665
+ (let-values (((tmp-env_0)
+ (let-values (((env_9)
+ (let-values (((env_10)
+ (expand-context-env
+ ctx_51)))
+ env_10)))
+ (let-values (((lst_492) syms_30)
+ ((lst_493)
+ intdef-ids_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_492))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_493))
+ ((letrec-values (((for-loop_407)
+ (lambda (env_11
+ lst_494
+ lst_495)
+ (begin
+ 'for-loop
+ (if (if (pair?
+ lst_494)
+ (pair?
+ lst_495)
+ #f)
+ (let-values (((sym_97)
+ (unsafe-car
+ lst_494))
+ ((rest_242)
+ (unsafe-cdr
+ lst_494))
+ ((intdef-id_1)
+ (unsafe-car
+ lst_495))
+ ((rest_243)
+ (unsafe-cdr
+ lst_495)))
+ (let-values (((env_12)
+ (let-values (((env_13)
+ (env-extend
+ env_11
+ sym_97
+ (local-variable1.1
+ intdef-id_1))))
+ (values
+ env_13))))
+ (if (not
+ #f)
+ (for-loop_407
+ env_12
+ rest_242
+ rest_243)
+ env_12)))
+ env_11)))))
+ for-loop_407)
+ env_9
+ lst_492
+ lst_493))))))
+ (let-values (((temp57_1)
+ (let-values (((v_277) ctx_51))
+ (let-values (((the-struct_65)
+ v_277))
+ (if (expand-context/outer?
+ the-struct_65)
+ (let-values (((env61_0)
+ tmp-env_0)
+ ((inner62_0)
+ (root-expand-context/outer-inner
+ v_277)))
+ (expand-context/outer1.1
+ inner62_0
+ (root-expand-context/outer-post-expansion
+ the-struct_65)
+ (root-expand-context/outer-use-site-scopes
+ the-struct_65)
+ (root-expand-context/outer-frame-id
+ the-struct_65)
+ (expand-context/outer-context
+ the-struct_65)
+ env61_0
+ (expand-context/outer-scopes
+ the-struct_65)
+ (expand-context/outer-def-ctx-scopes
+ the-struct_65)
+ (expand-context/outer-binding-layer
+ the-struct_65)
+ (expand-context/outer-reference-records
+ the-struct_65)
+ (expand-context/outer-only-immediate?
+ the-struct_65)
+ (expand-context/outer-need-eventually-defined
+ the-struct_65)
+ (expand-context/outer-current-introduction-scopes
+ the-struct_65)
+ (expand-context/outer-current-use-scopes
+ the-struct_65)
+ (expand-context/outer-name
+ the-struct_65)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/outer?"
+ the-struct_65)))))
+ ((temp58_1) 'expression)
+ ((all-intdefs59_0) all-intdefs_0)
+ ((temp60_3) #f))
+ (make-local-expand-context.1
+ temp58_1
+ temp60_3
+ all-intdefs59_0
+ #t
+ unsafe-undefined
+ #f
+ #f
+ #f
+ temp57_1)))
+ #f)))
+ (let-values (((vals_6)
+ (if s_665
+ (let-values (((input-s_0)
+ (flip-introduction-scopes
+ (let-values (((s63_0) s_665)
+ ((all-intdefs64_0)
+ all-intdefs_0))
+ (add-intdef-scopes.1
+ unsafe-undefined
+ #f
+ s63_0
+ all-intdefs64_0))
+ ctx_51)))
+ (let-values ((()
+ (begin
+ (let-values (((obs_32)
+ (expand-context-observer
+ ctx_51)))
+ (if obs_32
+ (call-expand-observe
+ obs_32
+ 'enter-bind)
+ (void)))
+ (values))))
+ (let-values (((vals_7)
+ (eval-for-syntaxes-binding
+ 'syntax-local-bind-syntaxes
+ input-s_0
+ ids_28
+ local-ctx_0)))
+ (begin
+ (let-values (((obs_33)
+ (expand-context-observer
+ ctx_51)))
+ (if obs_33
+ (call-expand-observe
+ obs_33
+ 'exit-bind)
+ (void)))
+ vals_7))))
+ (reverse$1
+ (let-values (((fold-var_525)
+ (let-values (((fold-var_526)
+ null))
+ fold-var_526)))
+ (let-values (((lst_496) intdef-ids_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_496))
+ ((letrec-values (((for-loop_408)
+ (lambda (fold-var_527
+ lst_497)
+ (begin
+ 'for-loop
+ (if (pair? lst_497)
+ (let-values (((intdef-id_2)
+ (unsafe-car
+ lst_497))
+ ((rest_244)
+ (unsafe-cdr
+ lst_497)))
+ (let-values (((fold-var_528)
+ (let-values (((fold-var_529)
+ (cons
+ (local-variable1.1
+ intdef-id_2)
+ fold-var_527)))
+ (values
+ fold-var_529))))
+ (if (not #f)
+ (for-loop_408
+ fold-var_528
+ rest_244)
+ fold-var_528)))
+ fold-var_527)))))
+ for-loop_408)
+ fold-var_525
+ lst_496))))))))
+ (let-values (((env-mixins_0)
+ (internal-definition-context-env-mixins
+ intdef_0)))
+ (begin
+ (set-box!
+ env-mixins_0
+ (append
+ (reverse$1
+ (let-values (((fold-var_530)
+ (let-values (((fold-var_531) null))
+ fold-var_531)))
+ (let-values (((lst_498) intdef-ids_0)
+ ((lst_499) syms_30)
+ ((lst_500) vals_6))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_297)))
+ (check-list lst_498))
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_185)))
+ (check-list lst_499))
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_186)))
- ((letrec-values (((for-loop_211)
- (lambda (fold-var_201
- lst_187
- lst_188
- lst_172)
+ (check-list lst_500))
+ ((letrec-values (((for-loop_409)
+ (lambda (fold-var_532
+ lst_501
+ lst_502
+ lst_503)
(begin
'for-loop
- (if (if (pair? lst_187)
- (if (pair? lst_188)
- (pair? lst_172)
+ (if (if (pair? lst_501)
+ (if (pair? lst_502)
+ (pair? lst_503)
#f)
#f)
(let-values (((intdef-id_3)
(unsafe-car
- lst_187))
- ((rest_86)
+ lst_501))
+ ((rest_245)
(unsafe-cdr
- lst_187))
- ((sym_80)
+ lst_501))
+ ((sym_98)
(unsafe-car
- lst_188))
- ((rest_168)
+ lst_502))
+ ((rest_246)
(unsafe-cdr
- lst_188))
- ((val_73)
+ lst_502))
+ ((val_81)
(unsafe-car
- lst_172))
- ((rest_169)
+ lst_503))
+ ((rest_247)
(unsafe-cdr
- lst_172)))
- (let-values (((fold-var_264)
- (let-values (((fold-var_0)
- fold-var_201))
- (let-values (((fold-var_4)
- (let-values ()
- (cons
- (let-values ()
- (begin
- (if local-ctx_0
- (let-values ()
- (maybe-install-free=id-in-context!
- val_73
- intdef-id_3
- phase_120
- local-ctx_0))
- (void))
- (env-mixin2.1
- intdef-id_3
- sym_80
- val_73
- (make-weak-hasheq))))
- fold-var_0))))
- (values
- fold-var_4)))))
+ lst_503)))
+ (let-values (((fold-var_533)
+ (let-values (((fold-var_534)
+ (cons
+ (begin
+ (if local-ctx_0
+ (maybe-install-free=id-in-context!
+ val_81
+ intdef-id_3
+ phase_147
+ local-ctx_0)
+ (void))
+ (env-mixin2.1
+ intdef-id_3
+ sym_98
+ val_81
+ (make-weak-hasheq)))
+ fold-var_532)))
+ (values
+ fold-var_534))))
(if (not #f)
- (for-loop_211
- fold-var_264
- rest_86
- rest_168
- rest_169)
- fold-var_264)))
- fold-var_201)))))
- for-loop_211)
- null
- lst_297
- lst_185
- lst_186))))
- (unbox env-mixins_0)))
- (let-values (((obs_33)
- (expand-context-observer ctx_47)))
- (if obs_33
- (let-values ()
- (let-values ()
- (call-expand-observe obs_33 'exit-local-bind)))
- (void)))
- (reverse$1
- (let-values (((lst_191) intdef-ids_0))
+ (for-loop_409
+ fold-var_533
+ rest_245
+ rest_246
+ rest_247)
+ fold-var_533)))
+ fold-var_532)))))
+ for-loop_409)
+ fold-var_530
+ lst_498
+ lst_499
+ lst_500)))))
+ (unbox env-mixins_0)))
+ (let-values (((obs_34) (expand-context-observer ctx_51)))
+ (if obs_34
+ (call-expand-observe obs_34 'exit-local-bind)
+ (void)))
+ (reverse$1
+ (let-values (((fold-var_535)
+ (let-values (((fold-var_536) null))
+ fold-var_536)))
+ (let-values (((lst_504) intdef-ids_0))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_191)))
- ((letrec-values (((for-loop_272)
- (lambda (fold-var_3 lst_241)
+ (check-list lst_504))
+ ((letrec-values (((for-loop_410)
+ (lambda (fold-var_537 lst_505)
(begin
'for-loop
- (if (pair? lst_241)
- (let-values (((id_55)
+ (if (pair? lst_505)
+ (let-values (((id_92)
(unsafe-car
- lst_241))
- ((rest_97)
+ lst_505))
+ ((rest_248)
(unsafe-cdr
- lst_241)))
- (let-values (((fold-var_206)
- (let-values (((fold-var_180)
- fold-var_3))
- (let-values (((fold-var_181)
- (let-values ()
- (cons
- (let-values ()
- (flip-introduction-scopes
- id_55
- ctx_47))
- fold-var_180))))
- (values
- fold-var_181)))))
+ lst_505)))
+ (let-values (((fold-var_538)
+ (let-values (((fold-var_539)
+ (cons
+ (flip-introduction-scopes
+ id_92
+ ctx_51)
+ fold-var_537)))
+ (values
+ fold-var_539))))
(if (not #f)
- (for-loop_272
- fold-var_206
- rest_97)
- fold-var_206)))
- fold-var_3)))))
- for-loop_272)
- null
- lst_191))))))))))))))))))))))))))))))
+ (for-loop_410
+ fold-var_538
+ rest_248)
+ fold-var_538)))
+ fold-var_537)))))
+ for-loop_410)
+ fold-var_535
+ lst_504))))))))))))))))))))))))))))))
(case-lambda
- ((ids_27 s_62 intdef_1)
- (begin 'syntax-local-bind-syntaxes (syntax-local-bind-syntaxes_0 ids_27 s_62 intdef_1 '())))
- ((ids_28 s_488 intdef_2 extra-intdefs5_1) (syntax-local-bind-syntaxes_0 ids_28 s_488 intdef_2 extra-intdefs5_1)))))
+ ((ids_29 s_666 intdef_1)
+ (begin 'syntax-local-bind-syntaxes (syntax-local-bind-syntaxes_0 ids_29 s_666 intdef_1 '())))
+ ((ids_30 s_667 intdef_2 extra-intdefs6_1) (syntax-local-bind-syntaxes_0 ids_30 s_667 intdef_2 extra-intdefs6_1)))))
(define-values
(1/internal-definition-context-binding-identifiers)
(lambda (intdef_3)
@@ -48929,106 +48495,95 @@
(begin
(if (1/internal-definition-context? intdef_3)
(void)
- (let-values ()
- (raise-argument-error
- 'internal-definition-context-binding-identifiers
- "internal-definition-context?"
- intdef_3)))
+ (raise-argument-error
+ 'internal-definition-context-binding-identifiers
+ "internal-definition-context?"
+ intdef_3))
(reverse$1
- (let-values (((lst_305) (unbox (internal-definition-context-env-mixins intdef_3))))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_305)))
- ((letrec-values (((for-loop_273)
- (lambda (fold-var_187 lst_306)
- (begin
- 'for-loop
- (if (pair? lst_306)
- (let-values (((env-mixin_0) (unsafe-car lst_306))
- ((rest_170) (unsafe-cdr lst_306)))
- (let-values (((fold-var_265)
- (let-values (((fold-var_188) fold-var_187))
- (let-values (((fold-var_266)
- (let-values ()
- (cons
- (let-values () (env-mixin-id env-mixin_0))
- fold-var_188))))
- (values fold-var_266)))))
- (if (not #f) (for-loop_273 fold-var_265 rest_170) fold-var_265)))
- fold-var_187)))))
- for-loop_273)
- null
- lst_305))))))))
+ (let-values (((fold-var_540) (let-values (((fold-var_541) null)) fold-var_541)))
+ (let-values (((lst_506) (unbox (internal-definition-context-env-mixins intdef_3))))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_506))
+ ((letrec-values (((for-loop_411)
+ (lambda (fold-var_542 lst_507)
+ (begin
+ 'for-loop
+ (if (pair? lst_507)
+ (let-values (((env-mixin_0) (unsafe-car lst_507))
+ ((rest_249) (unsafe-cdr lst_507)))
+ (let-values (((fold-var_543)
+ (let-values (((fold-var_544)
+ (cons (env-mixin-id env-mixin_0) fold-var_542)))
+ (values fold-var_544))))
+ (if (not #f) (for-loop_411 fold-var_543 rest_249) fold-var_543)))
+ fold-var_542)))))
+ for-loop_411)
+ fold-var_540
+ lst_506)))))))))
(define-values
(1/internal-definition-context-introduce)
(let-values (((internal-definition-context-introduce_0)
- (lambda (intdef10_0 s11_1 mode9_0)
+ (lambda (intdef11_0 s12_0 mode10_0)
(begin
'internal-definition-context-introduce
- (let-values (((intdef_4) intdef10_0))
- (let-values (((s_459) s11_1))
- (let-values (((mode_12) mode9_0))
- (let-values ()
+ (let-values (((intdef_4) intdef11_0))
+ (let-values (((s_668) s12_0))
+ (let-values (((mode_16) mode10_0))
+ (let-values ((()
+ (begin
+ (if (1/internal-definition-context? intdef_4)
+ (void)
+ (raise-argument-error
+ 'internal-definition-context-introduce
+ "internal-definition-context?"
+ intdef_4))
+ (values))))
(let-values ((()
(begin
- (if (1/internal-definition-context? intdef_4)
+ (if (syntax?$1 s_668)
(void)
- (let-values ()
- (raise-argument-error
- 'internal-definition-context-introduce
- "internal-definition-context?"
- intdef_4)))
+ (raise-argument-error
+ 'internal-definition-context-introduce
+ "syntax?"
+ s_668))
(values))))
- (let-values ((()
- (begin
- (if (syntax?$1 s_459)
- (void)
- (let-values ()
- (raise-argument-error
- 'internal-definition-context-introduce
- "syntax?"
- s_459)))
- (values))))
- (let-values (((new-s_2)
- (let-values (((s59_1) s_459)
- ((intdef60_0) intdef_4)
- ((temp61_2) #t)
- ((temp62_1)
- (let-values (((tmp_34) mode_12))
- (if (equal? tmp_34 'add)
- (let-values () add-scope)
- (if (equal? tmp_34 'remove)
- (let-values () remove-scope)
- (if (equal? tmp_34 'flip)
- (let-values () flip-scope)
- (let-values ()
- (raise-argument-error
- 'internal-definition-context-introduce
- "(or/c 'add 'remove 'flip)"
- mode_12))))))))
- (add-intdef-scopes.1 temp62_1 temp61_2 s59_1 intdef60_0))))
- (let-values (((ctx_48)
- (let-values (((temp63_2) #t))
- (get-current-expand-context.1 temp63_2 'unexpected))))
- (begin
- (if ctx_48
- (let-values ()
- (let-values (((obs_10) (expand-context-observer ctx_48)))
- (if obs_10
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_10
- 'track-syntax
- 'internal-definition-context-introduce
- new-s_2
- s_459)))
- (void))))
- (void))
- new-s_2)))))))))))))
+ (let-values (((new-s_3)
+ (let-values (((s65_0) s_668)
+ ((intdef66_0) intdef_4)
+ ((temp67_2) #t)
+ ((temp68_3)
+ (let-values (((tmp_37) mode_16))
+ (if (equal? tmp_37 'add)
+ add-scope
+ (if (equal? tmp_37 'remove)
+ remove-scope
+ (if (equal? tmp_37 'flip)
+ flip-scope
+ (raise-argument-error
+ 'internal-definition-context-introduce
+ "(or/c 'add 'remove 'flip)"
+ mode_16)))))))
+ (add-intdef-scopes.1 temp68_3 temp67_2 s65_0 intdef66_0))))
+ (let-values (((ctx_52)
+ (let-values (((temp69_1) #t))
+ (get-current-expand-context.1 temp69_1 'unexpected))))
+ (begin
+ (if ctx_52
+ (let-values (((obs_35) (expand-context-observer ctx_52)))
+ (if obs_35
+ (call-expand-observe
+ obs_35
+ 'track-syntax
+ 'internal-definition-context-introduce
+ new-s_3
+ s_668)
+ (void)))
+ (void))
+ new-s_3))))))))))))
(case-lambda
- ((intdef_5 s_489)
- (begin 'internal-definition-context-introduce (internal-definition-context-introduce_0 intdef_5 s_489 'flip)))
- ((intdef_6 s_490 mode9_1) (internal-definition-context-introduce_0 intdef_6 s_490 mode9_1)))))
+ ((intdef_5 s_669)
+ (begin 'internal-definition-context-introduce (internal-definition-context-introduce_0 intdef_5 s_669 'flip)))
+ ((intdef_6 s_670 mode10_1) (internal-definition-context-introduce_0 intdef_6 s_670 mode10_1)))))
(define-values
(1/internal-definition-context-seal)
(lambda (intdef_7)
@@ -49037,486 +48592,455 @@
(begin
(if (1/internal-definition-context? intdef_7)
(void)
- (let-values ()
- (raise-argument-error 'internal-definition-context-seal "internal-definition-context?" intdef_7)))
+ (raise-argument-error 'internal-definition-context-seal "internal-definition-context?" intdef_7))
(void)))))
(define-values
(1/identifier-remove-from-definition-context)
- (lambda (id_82 intdef_8)
+ (lambda (id_93 intdef_8)
(begin
'identifier-remove-from-definition-context
(begin
- (if (identifier? id_82)
+ (if (identifier? id_93)
(void)
- (let-values () (raise-argument-error 'identifier-remove-from-definition-context "identifier?" id_82)))
- (if (let-values (((or-part_67) (1/internal-definition-context? intdef_8)))
- (if or-part_67 or-part_67 (if (list? intdef_8) (andmap2 1/internal-definition-context? intdef_8) #f)))
+ (raise-argument-error 'identifier-remove-from-definition-context "identifier?" id_93))
+ (if (let-values (((or-part_480) (1/internal-definition-context? intdef_8)))
+ (if or-part_480 or-part_480 (if (list? intdef_8) (andmap2 1/internal-definition-context? intdef_8) #f)))
(void)
- (let-values ()
- (raise-argument-error
- 'identifier-remove-from-definition-context
- "(or/c internal-definition-context? (listof internal-definition-context?))"
- intdef_8)))
- (let-values (((x_87)
- (let-values (((a_42) intdef_8))
- (if (list? a_42)
- (let-values () (reverse$1 a_42))
- (if (not a_42) (let-values () null) (let-values () (list a_42)))))))
- (begin
- #t
- ((letrec-values (((for-loop_274)
- (lambda (id_83 a_43)
- (begin
- 'for-loop
- (if (pair? a_43)
- (let-values (((intdef_9) (car a_43)))
- (let-values (((id_84)
- (let-values (((id_85) id_83))
- (let-values (((id_86)
- (let-values ()
- (1/internal-definition-context-introduce
- intdef_9
- id_85
- 'remove))))
- (values id_86)))))
- (if (not #f) (for-loop_274 id_84 (cdr a_43)) id_84)))
- id_83)))))
- for-loop_274)
- id_82
- x_87)))))))
+ (raise-argument-error
+ 'identifier-remove-from-definition-context
+ "(or/c internal-definition-context? (listof internal-definition-context?))"
+ intdef_8))
+ (let-values (((id_94) (let-values (((id_95) id_93)) id_95)))
+ (let-values (((x_94)
+ (let-values (((a_48) intdef_8))
+ (if (list? a_48) (reverse$1 a_48) (if (not a_48) null (list a_48))))))
+ (begin
+ #t
+ ((letrec-values (((for-loop_412)
+ (lambda (id_96 a_49)
+ (begin
+ 'for-loop
+ (if (pair? a_49)
+ (let-values (((intdef_9) (car a_49)))
+ (let-values (((id_97)
+ (let-values (((id_98)
+ (1/internal-definition-context-introduce
+ intdef_9
+ id_96
+ 'remove)))
+ (values id_98))))
+ (if (not #f) (for-loop_412 id_97 (cdr a_49)) id_97)))
+ id_96)))))
+ for-loop_412)
+ id_94
+ x_94))))))))
(define-values
(1/internal-definition-context-add-scopes)
- (lambda (intdef_10 s_207)
+ (lambda (intdef_10 s_671)
(begin
'internal-definition-context-add-scopes
(begin
- (if (syntax?$1 s_207)
- (void)
- (let-values () (raise-argument-error 'internal-definition-context-add-scopes "syntax?" s_207)))
+ (if (syntax?$1 s_671) (void) (raise-argument-error 'internal-definition-context-add-scopes "syntax?" s_671))
(if (1/internal-definition-context? intdef_10)
(void)
- (let-values ()
- (raise-argument-error 'internal-definition-context-add-scopes "internal-definition-context?" intdef_10)))
+ (raise-argument-error 'internal-definition-context-add-scopes "internal-definition-context?" intdef_10))
(add-scope
- (add-scope s_207 (internal-definition-context-inside-edge intdef_10))
+ (add-scope s_671 (internal-definition-context-inside-edge intdef_10))
(internal-definition-context-outside-edge intdef_10))))))
(define-values
(1/internal-definition-context-splice-binding-identifier)
- (lambda (intdef_11 id_87)
+ (lambda (intdef_11 id_99)
(begin
'internal-definition-context-splice-binding-identifier
(begin
- (if (identifier? id_87)
+ (if (identifier? id_99)
(void)
- (let-values ()
- (raise-argument-error 'internal-definition-context-splice-binding-identifier "identifier?" id_87)))
+ (raise-argument-error 'internal-definition-context-splice-binding-identifier "identifier?" id_99))
(if (1/internal-definition-context? intdef_11)
(void)
- (let-values ()
- (raise-argument-error
- 'internal-definition-context-splice-binding-identifier
- "internal-definition-context?"
- intdef_11)))
+ (raise-argument-error
+ 'internal-definition-context-splice-binding-identifier
+ "internal-definition-context?"
+ intdef_11))
(remove-intdef-use-site-scopes
(remove-scope
- (remove-scope id_87 (internal-definition-context-inside-edge intdef_11))
+ (remove-scope id_99 (internal-definition-context-inside-edge intdef_11))
(internal-definition-context-outside-edge intdef_11))
intdef_11)))))
(define-values
(intdefs?)
- (lambda (x_88)
+ (lambda (x_95)
(begin
- (let-values (((or-part_112) (1/internal-definition-context? x_88)))
- (if or-part_112 or-part_112 (if (list? x_88) (andmap2 1/internal-definition-context? x_88) #f))))))
+ (let-values (((or-part_481) (1/internal-definition-context? x_95)))
+ (if or-part_481 or-part_481 (if (list? x_95) (andmap2 1/internal-definition-context? x_95) #f))))))
(define-values (intdefs?-string) "(or/c internal-definition-context? (listof internal-definition-context?))")
(define-values
(intdefs-or-false?)
- (lambda (x_89) (begin (let-values (((or-part_294) (not x_89))) (if or-part_294 or-part_294 (intdefs? x_89))))))
+ (lambda (x_96) (begin (let-values (((or-part_482) (not x_96))) (if or-part_482 or-part_482 (intdefs? x_96))))))
(define-values
(intdefs-or-false?-string)
"(or/c internal-definition-context? (listof internal-definition-context?) #f)")
(define-values
(add-intdef-bindings)
- (lambda (env_12 intdefs_0)
+ (lambda (env_14 intdefs_0)
(begin
- (let-values (((x_90)
- (let-values (((a_44) intdefs_0))
- (if (list? a_44)
- (let-values () (reverse$1 a_44))
- (if (not a_44) (let-values () null) (let-values () (list a_44)))))))
- (begin
- #t
- ((letrec-values (((for-loop_275)
- (lambda (env_13 a_45)
- (begin
- 'for-loop
- (if (pair? a_45)
- (let-values (((intdef_12) (car a_45)))
- (let-values (((env_14)
- (let-values (((env_15) env_13))
- (let-values (((env_16)
- (let-values ()
- (let-values (((parent-ctx_2)
- (internal-definition-context-parent-ctx
- intdef_12)))
- (let-values (((parent-env_0)
- (if parent-ctx_2
- (add-intdef-bindings
- env_15
- parent-ctx_2)
- env_15)))
- (let-values (((env-mixins_1)
- (unbox
- (internal-definition-context-env-mixins
- intdef_12))))
- ((letrec-values (((loop_99)
- (lambda (env_17
- env-mixins_2)
- (begin
- 'loop
- (if (null? env-mixins_2)
- (let-values () env_17)
- (let-values ()
- (let-values (((env-mixin_1)
- (car
- env-mixins_2)))
- (let-values (((or-part_295)
- (hash-ref
- (env-mixin-cache
+ (let-values (((env_15) (let-values (((env_16) env_14)) env_16)))
+ (let-values (((x_97)
+ (let-values (((a_50) intdefs_0))
+ (if (list? a_50) (reverse$1 a_50) (if (not a_50) null (list a_50))))))
+ (begin
+ #t
+ ((letrec-values (((for-loop_413)
+ (lambda (env_17 a_51)
+ (begin
+ 'for-loop
+ (if (pair? a_51)
+ (let-values (((intdef_12) (car a_51)))
+ (let-values (((env_18)
+ (let-values (((env_19)
+ (let-values (((parent-ctx_2)
+ (internal-definition-context-parent-ctx
+ intdef_12)))
+ (let-values (((parent-env_0)
+ (if parent-ctx_2
+ (add-intdef-bindings
+ env_17
+ parent-ctx_2)
+ env_17)))
+ (let-values (((env-mixins_1)
+ (unbox
+ (internal-definition-context-env-mixins
+ intdef_12))))
+ ((letrec-values (((loop_113)
+ (lambda (env_20 env-mixins_2)
+ (begin
+ 'loop
+ (if (null? env-mixins_2)
+ env_20
+ (let-values (((env-mixin_1)
+ (car
+ env-mixins_2)))
+ (let-values (((or-part_483)
+ (hash-ref
+ (env-mixin-cache
+ env-mixin_1)
+ env_20
+ #f)))
+ (if or-part_483
+ or-part_483
+ (let-values (((new-env_0)
+ (env-extend
+ (loop_113
+ env_20
+ (cdr
+ env-mixins_2))
+ (env-mixin-sym
env-mixin_1)
- env_17
- #f)))
- (if or-part_295
- or-part_295
- (let-values (((new-env_0)
- (env-extend
- (loop_99
- env_17
- (cdr
- env-mixins_2))
- (env-mixin-sym
- env-mixin_1)
- (env-mixin-value
- env-mixin_1))))
- (begin
- (hash-set!
- (env-mixin-cache
- env-mixin_1)
- env_17
- new-env_0)
- new-env_0)))))))))))
- loop_99)
- parent-env_0
- env-mixins_1)))))))
- (values env_16)))))
- (if (not #f) (for-loop_275 env_14 (cdr a_45)) env_14)))
- env_13)))))
- for-loop_275)
- env_12
- x_90))))))
+ (env-mixin-value
+ env-mixin_1))))
+ (begin
+ (hash-set!
+ (env-mixin-cache
+ env-mixin_1)
+ env_20
+ new-env_0)
+ new-env_0))))))))))
+ loop_113)
+ parent-env_0
+ env-mixins_1))))))
+ (values env_19))))
+ (if (not #f) (for-loop_413 env_18 (cdr a_51)) env_18)))
+ env_17)))))
+ for-loop_413)
+ env_15
+ x_97)))))))
(define-values
(add-intdef-scopes.1)
- (lambda (action13_0 always?12_0 s16_0 intdefs17_0)
+ (lambda (action14_0 always?13_0 s17_0 intdefs18_0)
(begin
'add-intdef-scopes
- (let-values (((s_491) s16_0))
- (let-values (((intdefs_1) intdefs17_0))
- (let-values (((always?_0) always?12_0))
- (let-values (((action_0) (if (eq? action13_0 unsafe-undefined) add-scope action13_0)))
- (let-values ()
- (let-values (((x_91)
- (let-values (((a_46) intdefs_1))
- (if (list? a_46)
- (let-values () (reverse$1 a_46))
- (if (not a_46) (let-values () null) (let-values () (list a_46)))))))
+ (let-values (((s_672) s17_0))
+ (let-values (((intdefs_1) intdefs18_0))
+ (let-values (((always?_0) always?13_0))
+ (let-values (((action_0) (if (eq? action14_0 unsafe-undefined) add-scope action14_0)))
+ (let-values (((s_673) (let-values (((s_674) s_672)) s_674)))
+ (let-values (((x_98)
+ (let-values (((a_52) intdefs_1))
+ (if (list? a_52) (reverse$1 a_52) (if (not a_52) null (list a_52))))))
(begin
#t
- ((letrec-values (((for-loop_276)
- (lambda (s_492 a_47)
+ ((letrec-values (((for-loop_414)
+ (lambda (s_675 a_53)
(begin
'for-loop
- (if (pair? a_47)
- (let-values (((intdef_13) (car a_47)))
- (let-values (((s_493)
- (let-values (((s_494) s_492))
- (if (let-values (((or-part_296) always?_0))
- (if or-part_296
- or-part_296
- (internal-definition-context-add-scope?
- intdef_13)))
- (let-values (((s_109) s_494))
- (let-values (((s_110)
- (let-values ()
- (action_0
- s_109
- (internal-definition-context-inside-edge
- intdef_13)))))
- (values s_110)))
- s_494))))
- (if (not #f) (for-loop_276 s_493 (cdr a_47)) s_493)))
- s_492)))))
- for-loop_276)
- s_491
- x_91)))))))))))
+ (if (pair? a_53)
+ (let-values (((intdef_13) (car a_53)))
+ (let-values (((s_676)
+ (if (let-values (((or-part_484) always?_0))
+ (if or-part_484
+ or-part_484
+ (internal-definition-context-add-scope? intdef_13)))
+ (let-values (((s_677)
+ (action_0
+ s_675
+ (internal-definition-context-inside-edge
+ intdef_13))))
+ (values s_677))
+ s_675)))
+ (if (not #f) (for-loop_414 s_676 (cdr a_53)) s_676)))
+ s_675)))))
+ for-loop_414)
+ s_673
+ x_98)))))))))))
(define-values
(make-local-expand-context.1)
- (lambda (context19_0
- in-local-expand?26_0
- intdefs21_0
- keep-#%expression?25_0
- phase20_0
- stop-ids22_0
- to-parsed-ok?23_0
- track-to-be-defined?24_0
- ctx35_0)
+ (lambda (context20_0
+ in-local-expand?27_0
+ intdefs22_0
+ keep-#%expression?26_0
+ phase21_0
+ stop-ids23_0
+ to-parsed-ok?24_0
+ track-to-be-defined?25_0
+ ctx36_0)
(begin
'make-local-expand-context
- (let-values (((ctx_49) ctx35_0))
- (let-values (((context_9) context19_0))
- (let-values (((phase_86) (if (eq? phase20_0 unsafe-undefined) (expand-context-phase ctx_49) phase20_0)))
- (let-values (((intdefs_2) intdefs21_0))
- (let-values (((stop-ids_1) stop-ids22_0))
- (let-values (((to-parsed-ok?_0) to-parsed-ok?23_0))
- (let-values (((track-to-be-defined?_0) track-to-be-defined?24_0))
- (let-values (((keep-#%expression?_1) keep-#%expression?25_0))
- (let-values (((in-local-expand?_1) in-local-expand?26_0))
- (let-values ()
- (let-values (((same-kind?_0)
- (let-values (((or-part_297) (eq? context_9 (expand-context-context ctx_49))))
- (if or-part_297
- or-part_297
- (if (list? context_9) (list? (expand-context-context ctx_49)) #f)))))
- (let-values (((all-stop-ids_0)
- (if stop-ids_1 (stop-ids->all-stop-ids stop-ids_1 phase_86) #f)))
- (let-values (((def-ctx-scopes_5)
- (if (expand-context-def-ctx-scopes ctx_49)
- (unbox (expand-context-def-ctx-scopes ctx_49))
- null)))
- (let-values (((v_203) ctx_49))
- (let-values (((the-struct_61) v_203))
- (if (expand-context/outer? the-struct_61)
- (let-values (((context64_0) context_9)
- ((env65_0)
- (add-intdef-bindings (expand-context-env ctx_49) intdefs_2))
- ((use-site-scopes66_0)
- (if (let-values (((or-part_298) (eq? context_9 'module)))
- (if or-part_298
- or-part_298
- (let-values (((or-part_299) (eq? context_9 'module-begin)))
- (if or-part_299 or-part_299 (list? context_9)))))
- (if (1/internal-definition-context? intdefs_2)
- (internal-definition-context-use-site-scopes intdefs_2)
- (let-values (((or-part_300)
- (root-expand-context-use-site-scopes ctx_49)))
- (if or-part_300 or-part_300 (box null))))
- #f))
- ((frame-id67_0)
+ (let-values (((ctx_53) ctx36_0))
+ (let-values (((context_9) context20_0))
+ (let-values (((phase_148) (if (eq? phase21_0 unsafe-undefined) (expand-context-phase ctx_53) phase21_0)))
+ (let-values (((intdefs_2) intdefs22_0))
+ (let-values (((stop-ids_1) stop-ids23_0))
+ (let-values (((to-parsed-ok?_0) to-parsed-ok?24_0))
+ (let-values (((track-to-be-defined?_0) track-to-be-defined?25_0))
+ (let-values (((keep-#%expression?_1) keep-#%expression?26_0))
+ (let-values (((in-local-expand?_1) in-local-expand?27_0))
+ (let-values (((same-kind?_0)
+ (let-values (((or-part_485) (eq? context_9 (expand-context-context ctx_53))))
+ (if or-part_485
+ or-part_485
+ (if (list? context_9) (list? (expand-context-context ctx_53)) #f)))))
+ (let-values (((all-stop-ids_0)
+ (if stop-ids_1 (stop-ids->all-stop-ids stop-ids_1 phase_148) #f)))
+ (let-values (((def-ctx-scopes_6)
+ (if (expand-context-def-ctx-scopes ctx_53)
+ (unbox (expand-context-def-ctx-scopes ctx_53))
+ null)))
+ (let-values (((v_278) ctx_53))
+ (let-values (((the-struct_66) v_278))
+ (if (expand-context/outer? the-struct_66)
+ (let-values (((context70_0) context_9)
+ ((env71_0) (add-intdef-bindings (expand-context-env ctx_53) intdefs_2))
+ ((use-site-scopes72_0)
+ (if (let-values (((or-part_486) (eq? context_9 'module)))
+ (if or-part_486
+ or-part_486
+ (let-values (((or-part_487) (eq? context_9 'module-begin)))
+ (if or-part_487 or-part_487 (list? context_9)))))
(if (1/internal-definition-context? intdefs_2)
- (let-values () (internal-definition-context-frame-id intdefs_2))
- (if (not intdefs_2)
- (let-values () (root-expand-context-frame-id ctx_49))
- (if (list? intdefs_2)
- (let-values ()
- (let-values (((x_92)
- (let-values (((a_48) intdefs_2))
- (if (list? a_48)
- (let-values () (reverse$1 a_48))
- (if (not a_48)
- (let-values () null)
- (let-values () (list a_48)))))))
- (begin
- #t
- ((letrec-values (((for-loop_277)
- (lambda (frame-id_9 a_49)
- (begin
- 'for-loop
- (if (pair? a_49)
- (let-values (((intdef_14)
- (car a_49)))
- (let-values (((frame-id_10)
- (let-values (((frame-id_11)
- frame-id_9))
- (let-values (((frame-id_12)
- (let-values ()
- (let-values (((i-frame-id_0)
- (internal-definition-context-frame-id
- intdef_14)))
- (if (if frame-id_11
- (if i-frame-id_0
- (not
- (eq?
- frame-id_11
- i-frame-id_0))
- #f)
- #f)
- (let-values ()
- 'all)
- (let-values ()
- (let-values (((or-part_301)
- frame-id_11))
- (if or-part_301
- or-part_301
- i-frame-id_0))))))))
- (values
- frame-id_12)))))
- (if (not #f)
- (for-loop_277
- frame-id_10
- (cdr a_49))
- frame-id_10)))
- frame-id_9)))))
- for-loop_277)
- (if (not
- (eq? 'expression (expand-context-context ctx_49)))
- (root-expand-context-frame-id ctx_49)
- #f)
- x_92))))
- (void)))))
- ((post-expansion68_0)
- (let-values (((pe_2)
- (if same-kind?_0
- (if (let-values (((or-part_302) (pair? context_9)))
- (if or-part_302
- or-part_302
- (memq
- context_9
- '(module module-begin top-level))))
- (root-expand-context-post-expansion ctx_49)
- #f)
- #f)))
- (if (if intdefs_2 (not (null? intdefs_2)) #f)
- (let-values ()
- (lambda (s_495)
+ (internal-definition-context-use-site-scopes intdefs_2)
+ (let-values (((or-part_488)
+ (root-expand-context-use-site-scopes ctx_53)))
+ (if or-part_488 or-part_488 (box null))))
+ #f))
+ ((frame-id73_0)
+ (if (1/internal-definition-context? intdefs_2)
+ (internal-definition-context-frame-id intdefs_2)
+ (if (not intdefs_2)
+ (root-expand-context-frame-id ctx_53)
+ (if (list? intdefs_2)
+ (let-values (((frame-id_9)
+ (let-values (((frame-id_10)
+ (if (not
+ (eq?
+ 'expression
+ (expand-context-context
+ ctx_53)))
+ (root-expand-context-frame-id
+ ctx_53)
+ #f)))
+ frame-id_10)))
+ (let-values (((x_99)
+ (let-values (((a_54) intdefs_2))
+ (if (list? a_54)
+ (reverse$1 a_54)
+ (if (not a_54) null (list a_54))))))
(begin
- 'post-expansion68
- (let-values (((temp74_0)
- (apply-post-expansion pe_2 s_495))
- ((intdefs75_0) intdefs_2))
- (add-intdef-scopes.1
- unsafe-undefined
- #f
- temp74_0
- intdefs75_0)))))
- (let-values () pe_2))))
- ((scopes69_0)
- (append def-ctx-scopes_5 (expand-context-scopes ctx_49)))
- ((only-immediate?70_0) (not stop-ids_1))
- ((current-introduction-scopes71_0) null)
- ((need-eventually-defined72_0)
- (let-values (((ht_160)
- (expand-context-need-eventually-defined ctx_49)))
- (if track-to-be-defined?_0
- (let-values () ht_160)
- (if ht_160 (let-values () (make-hasheqv)) (let-values () #f)))))
- ((inner73_0)
- (let-values (((the-struct_62)
- (root-expand-context/outer-inner v_203)))
- (if (expand-context/inner? the-struct_62)
- (let-values (((to-parsed?76_0)
- (if to-parsed-ok?_0
- (expand-context-to-parsed? ctx_49)
- #f))
- ((just-once?77_0) #f)
- ((in-local-expand?78_0) in-local-expand?_1)
- ((keep-#%expression?79_0) keep-#%expression?_1)
- ((stops80_0)
- (free-id-set
- phase_86
- (let-values (((or-part_303) all-stop-ids_0))
- (if or-part_303 or-part_303 null)))))
- (expand-context/inner2.1
- (root-expand-context/inner-self-mpi the-struct_62)
- (root-expand-context/inner-module-scopes the-struct_62)
- (root-expand-context/inner-top-level-bind-scope
- the-struct_62)
- (root-expand-context/inner-all-scopes-stx the-struct_62)
- (root-expand-context/inner-defined-syms the-struct_62)
- (root-expand-context/inner-counter the-struct_62)
- (root-expand-context/inner-lift-key the-struct_62)
- to-parsed?76_0
- (expand-context/inner-phase the-struct_62)
- (expand-context/inner-namespace the-struct_62)
- just-once?77_0
- (expand-context/inner-module-begin-k the-struct_62)
- (expand-context/inner-allow-unbound? the-struct_62)
- in-local-expand?78_0
- keep-#%expression?79_0
- stops80_0
- (expand-context/inner-declared-submodule-names the-struct_62)
- (expand-context/inner-lifts the-struct_62)
- (expand-context/inner-lift-envs the-struct_62)
- (expand-context/inner-module-lifts the-struct_62)
- (expand-context/inner-require-lifts the-struct_62)
- (expand-context/inner-to-module-lifts the-struct_62)
- (expand-context/inner-requires+provides the-struct_62)
- (expand-context/inner-observer the-struct_62)
- (expand-context/inner-for-serializable? the-struct_62)
- (expand-context/inner-to-correlated-linklet? the-struct_62)
- (expand-context/inner-normalize-locals? the-struct_62)
- (expand-context/inner-parsing-expanded? the-struct_62)
- (expand-context/inner-skip-visit-available? the-struct_62)))
- (raise-argument-error
- 'struct-copy
- "expand-context/inner?"
- the-struct_62)))))
- (expand-context/outer1.1
- inner73_0
- post-expansion68_0
- use-site-scopes66_0
- frame-id67_0
- context64_0
- env65_0
- scopes69_0
- (expand-context/outer-def-ctx-scopes the-struct_61)
- (expand-context/outer-binding-layer the-struct_61)
- (expand-context/outer-reference-records the-struct_61)
- only-immediate?70_0
- need-eventually-defined72_0
- current-introduction-scopes71_0
- (expand-context/outer-current-use-scopes the-struct_61)
- (expand-context/outer-name the-struct_61)))
- (raise-argument-error
- 'struct-copy
- "expand-context/outer?"
- the-struct_61))))))))))))))))))))
+ #t
+ ((letrec-values (((for-loop_415)
+ (lambda (frame-id_11 a_55)
+ (begin
+ 'for-loop
+ (if (pair? a_55)
+ (let-values (((intdef_14)
+ (car a_55)))
+ (let-values (((frame-id_12)
+ (let-values (((frame-id_13)
+ (let-values (((i-frame-id_0)
+ (internal-definition-context-frame-id
+ intdef_14)))
+ (if (if frame-id_11
+ (if i-frame-id_0
+ (not
+ (eq?
+ frame-id_11
+ i-frame-id_0))
+ #f)
+ #f)
+ 'all
+ (let-values (((or-part_489)
+ frame-id_11))
+ (if or-part_489
+ or-part_489
+ i-frame-id_0))))))
+ (values
+ frame-id_13))))
+ (if (not #f)
+ (for-loop_415
+ frame-id_12
+ (cdr a_55))
+ frame-id_12)))
+ frame-id_11)))))
+ for-loop_415)
+ frame-id_9
+ x_99))))
+ (void)))))
+ ((post-expansion74_0)
+ (let-values (((pe_2)
+ (if same-kind?_0
+ (if (let-values (((or-part_490) (pair? context_9)))
+ (if or-part_490
+ or-part_490
+ (memq
+ context_9
+ '(module module-begin top-level))))
+ (root-expand-context-post-expansion ctx_53)
+ #f)
+ #f)))
+ (if (if intdefs_2 (not (null? intdefs_2)) #f)
+ (lambda (s_678)
+ (begin
+ 'post-expansion74
+ (let-values (((temp80_0) (apply-post-expansion pe_2 s_678))
+ ((intdefs81_0) intdefs_2))
+ (add-intdef-scopes.1
+ unsafe-undefined
+ #f
+ temp80_0
+ intdefs81_0))))
+ pe_2)))
+ ((scopes75_0) (append def-ctx-scopes_6 (expand-context-scopes ctx_53)))
+ ((only-immediate?76_0) (not stop-ids_1))
+ ((current-introduction-scopes77_0) null)
+ ((need-eventually-defined78_0)
+ (let-values (((ht_216)
+ (expand-context-need-eventually-defined ctx_53)))
+ (if track-to-be-defined?_0 ht_216 (if ht_216 (make-hasheqv) #f))))
+ ((inner79_0)
+ (let-values (((the-struct_67)
+ (root-expand-context/outer-inner v_278)))
+ (if (expand-context/inner? the-struct_67)
+ (let-values (((to-parsed?82_0)
+ (if to-parsed-ok?_0
+ (expand-context-to-parsed? ctx_53)
+ #f))
+ ((just-once?83_0) #f)
+ ((in-local-expand?84_0) in-local-expand?_1)
+ ((keep-#%expression?85_0) keep-#%expression?_1)
+ ((stops86_0)
+ (free-id-set
+ phase_148
+ (let-values (((or-part_491) all-stop-ids_0))
+ (if or-part_491 or-part_491 null)))))
+ (expand-context/inner2.1
+ (root-expand-context/inner-self-mpi the-struct_67)
+ (root-expand-context/inner-module-scopes the-struct_67)
+ (root-expand-context/inner-top-level-bind-scope the-struct_67)
+ (root-expand-context/inner-all-scopes-stx the-struct_67)
+ (root-expand-context/inner-defined-syms the-struct_67)
+ (root-expand-context/inner-counter the-struct_67)
+ (root-expand-context/inner-lift-key the-struct_67)
+ to-parsed?82_0
+ (expand-context/inner-phase the-struct_67)
+ (expand-context/inner-namespace the-struct_67)
+ just-once?83_0
+ (expand-context/inner-module-begin-k the-struct_67)
+ (expand-context/inner-allow-unbound? the-struct_67)
+ in-local-expand?84_0
+ keep-#%expression?85_0
+ stops86_0
+ (expand-context/inner-declared-submodule-names the-struct_67)
+ (expand-context/inner-lifts the-struct_67)
+ (expand-context/inner-lift-envs the-struct_67)
+ (expand-context/inner-module-lifts the-struct_67)
+ (expand-context/inner-require-lifts the-struct_67)
+ (expand-context/inner-to-module-lifts the-struct_67)
+ (expand-context/inner-requires+provides the-struct_67)
+ (expand-context/inner-observer the-struct_67)
+ (expand-context/inner-for-serializable? the-struct_67)
+ (expand-context/inner-to-correlated-linklet? the-struct_67)
+ (expand-context/inner-normalize-locals? the-struct_67)
+ (expand-context/inner-parsing-expanded? the-struct_67)
+ (expand-context/inner-skip-visit-available? the-struct_67)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/inner?"
+ the-struct_67)))))
+ (expand-context/outer1.1
+ inner79_0
+ post-expansion74_0
+ use-site-scopes72_0
+ frame-id73_0
+ context70_0
+ env71_0
+ scopes75_0
+ (expand-context/outer-def-ctx-scopes the-struct_66)
+ (expand-context/outer-binding-layer the-struct_66)
+ (expand-context/outer-reference-records the-struct_66)
+ only-immediate?76_0
+ need-eventually-defined78_0
+ current-introduction-scopes77_0
+ (expand-context/outer-current-use-scopes the-struct_66)
+ (expand-context/outer-name the-struct_66)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/outer?"
+ the-struct_66)))))))))))))))))))
(define-values
(flip-introduction-scopes)
- (lambda (s_137 ctx_50) (begin (flip-scopes s_137 (expand-context-current-introduction-scopes ctx_50)))))
+ (lambda (s_679 ctx_54) (begin (flip-scopes s_679 (expand-context-current-introduction-scopes ctx_54)))))
(define-values
(flip-introduction-and-use-scopes)
- (lambda (s_171 ctx_51)
- (begin (flip-scopes (flip-introduction-scopes s_171 ctx_51) (expand-context-current-use-scopes ctx_51)))))
+ (lambda (s_680 ctx_55)
+ (begin (flip-scopes (flip-introduction-scopes s_680 ctx_55) (expand-context-current-use-scopes ctx_55)))))
(define-values
(remove-intdef-use-site-scopes)
- (lambda (s_496 intdef_15)
+ (lambda (s_681 intdef_15)
(begin
(let-values (((use-sites_1) (internal-definition-context-use-site-scopes intdef_15)))
- (if (syntax?$1 s_496)
- (remove-scopes s_496 (unbox use-sites_1))
+ (if (syntax?$1 s_681)
+ (remove-scopes s_681 (unbox use-sites_1))
(reverse$1
- (let-values (((lst_307) s_496))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_307)))
- ((letrec-values (((for-loop_278)
- (lambda (fold-var_267 lst_308)
- (begin
- 'for-loop
- (if (pair? lst_308)
- (let-values (((id_88) (unsafe-car lst_308)) ((rest_171) (unsafe-cdr lst_308)))
- (let-values (((fold-var_268)
- (let-values (((fold-var_269) fold-var_267))
- (let-values (((fold-var_270)
- (let-values ()
- (cons
- (let-values ()
- (remove-scopes id_88 (unbox use-sites_1)))
- fold-var_269))))
- (values fold-var_270)))))
- (if (not #f) (for-loop_278 fold-var_268 rest_171) fold-var_268)))
- fold-var_267)))))
- for-loop_278)
- null
- lst_307)))))))))
+ (let-values (((fold-var_545) (let-values (((fold-var_546) null)) fold-var_546)))
+ (let-values (((lst_508) s_681))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_508))
+ ((letrec-values (((for-loop_416)
+ (lambda (fold-var_547 lst_509)
+ (begin
+ 'for-loop
+ (if (pair? lst_509)
+ (let-values (((id_100) (unsafe-car lst_509)) ((rest_250) (unsafe-cdr lst_509)))
+ (let-values (((fold-var_548)
+ (let-values (((fold-var_549)
+ (cons
+ (remove-scopes id_100 (unbox use-sites_1))
+ fold-var_547)))
+ (values fold-var_549))))
+ (if (not #f) (for-loop_416 fold-var_548 rest_250) fold-var_548)))
+ fold-var_547)))))
+ for-loop_416)
+ fold-var_545
+ lst_508))))))))))
(define-values
(1/syntax-transforming?)
(lambda ()
@@ -49528,130 +49052,123 @@
(lambda ()
(begin
'syntax-transforming-with-lifts?
- (let-values (((ctx_52) (let-values (((temp49_2) #t)) (get-current-expand-context.1 temp49_2 'unexpected))))
- (if ctx_52 (if (expand-context-lifts ctx_52) #t #f) #f)))))
+ (let-values (((ctx_56) (let-values (((temp49_1) #t)) (get-current-expand-context.1 temp49_1 'unexpected))))
+ (if ctx_56 (if (expand-context-lifts ctx_56) #t #f) #f)))))
(define-values
(1/syntax-transforming-module-expression?)
(lambda ()
(begin
'syntax-transforming-module-expression?
- (let-values (((ctx_53) (let-values (((temp50_1) #t)) (get-current-expand-context.1 temp50_1 'unexpected))))
- (if ctx_53 (if (expand-context-to-module-lifts ctx_53) #t #f) #f)))))
+ (let-values (((ctx_57) (let-values (((temp50_2) #t)) (get-current-expand-context.1 temp50_2 'unexpected))))
+ (if ctx_57 (if (expand-context-to-module-lifts ctx_57) #t #f) #f)))))
(define-values
(1/syntax-local-transforming-module-provides?)
(lambda ()
(begin
'syntax-local-transforming-module-provides?
- (let-values (((ctx_54) (let-values (((temp51_3) #t)) (get-current-expand-context.1 temp51_3 'unexpected))))
- (if ctx_54 (if (expand-context-requires+provides ctx_54) #t #f) #f)))))
+ (let-values (((ctx_58) (let-values (((temp51_3) #t)) (get-current-expand-context.1 temp51_3 'unexpected))))
+ (if ctx_58 (if (expand-context-requires+provides ctx_58) #t #f) #f)))))
+ (define-values
+ (1/syntax-local-compiling-module?)
+ (lambda ()
+ (begin
+ 'syntax-local-compiling-module?
+ (let-values (((ctx_59) (let-values (((temp52_0) #t)) (get-current-expand-context.1 temp52_0 'unexpected))))
+ (if ctx_59
+ (if (eq? (expand-context-context ctx_59) 'module-begin)
+ (if (expand-context-to-parsed? ctx_59)
+ (module-path-index-resolved (root-expand-context-self-mpi ctx_59))
+ #f)
+ #f)
+ #f)))))
(define-values
(1/syntax-local-context)
(lambda ()
(begin
'syntax-local-context
- (let-values (((ctx_55)
- (let-values (((temp52_2) 'syntax-local-context)) (get-current-expand-context.1 #f temp52_2))))
- (expand-context-context ctx_55)))))
+ (let-values (((ctx_60)
+ (let-values (((temp53_2) 'syntax-local-context)) (get-current-expand-context.1 #f temp53_2))))
+ (expand-context-context ctx_60)))))
(define-values
(1/syntax-local-introduce)
- (lambda (s_180)
+ (lambda (s_682)
(begin
'syntax-local-introduce
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (syntax?$1 s_180)
- (void)
- (let-values () (raise-argument-error 'syntax-local-introduce "syntax?" s_180)))
- (values))))
- (let-values (((ctx_56)
- (let-values (((temp54_3) 'syntax-local-introduce))
- (get-current-expand-context.1 #f temp54_3))))
- (let-values (((new-s_3) (flip-introduction-and-use-scopes s_180 ctx_56)))
- (begin
- (let-values (((obs_34) (expand-context-observer ctx_56)))
- (if obs_34
- (let-values ()
- (let-values ()
- (call-expand-observe obs_34 'track-syntax 'syntax-local-introduce new-s_3 s_180)))
- (void)))
- new-s_3)))))))))
+ (let-values ((()
+ (begin
+ (if (syntax?$1 s_682) (void) (raise-argument-error 'syntax-local-introduce "syntax?" s_682))
+ (values))))
+ (let-values (((ctx_61)
+ (let-values (((temp55_3) 'syntax-local-introduce)) (get-current-expand-context.1 #f temp55_3))))
+ (let-values (((new-s_4) (flip-introduction-and-use-scopes s_682 ctx_61)))
+ (begin
+ (let-values (((obs_36) (expand-context-observer ctx_61)))
+ (if obs_36 (call-expand-observe obs_36 'track-syntax 'syntax-local-introduce new-s_4 s_682) (void)))
+ new-s_4)))))))
(define-values
(1/syntax-local-identifier-as-binding)
(let-values (((syntax-local-identifier-as-binding_0)
(lambda (id2_0 intdef1_0)
(begin
'syntax-local-identifier-as-binding
- (let-values (((id_89) id2_0))
+ (let-values (((id_101) id2_0))
(let-values (((intdef_16) intdef1_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (identifier? id_89)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-identifier-as-binding
- "identifier?"
- id_89)))
- (values))))
- (let-values ((()
- (begin
- (if intdef_16
- (let-values ()
- (if (1/internal-definition-context? intdef_16)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-identifier-as-binding
- "internal-definition-context?"
- intdef_16))))
- (void))
- (values))))
- (let-values (((ctx_15)
- (let-values (((temp56_1) 'syntax-local-identifier-as-binding))
- (get-current-expand-context.1 #f temp56_1))))
- (let-values (((new-id_0)
- (if intdef_16
- (remove-intdef-use-site-scopes id_89 intdef_16)
- (remove-use-site-scopes id_89 ctx_15))))
+ (let-values ((()
(begin
- (let-values (((obs_35) (expand-context-observer ctx_15)))
- (if obs_35
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_35
- 'track-syntax
- 'syntax-local-identifier-as-binding
- new-id_0
- id_89)))
- (void)))
- new-id_0))))))))))))))
+ (if (identifier? id_101)
+ (void)
+ (raise-argument-error
+ 'syntax-local-identifier-as-binding
+ "identifier?"
+ id_101))
+ (values))))
+ (let-values ((()
+ (begin
+ (if intdef_16
+ (if (1/internal-definition-context? intdef_16)
+ (void)
+ (raise-argument-error
+ 'syntax-local-identifier-as-binding
+ "internal-definition-context?"
+ intdef_16))
+ (void))
+ (values))))
+ (let-values (((ctx_62)
+ (let-values (((temp57_2) 'syntax-local-identifier-as-binding))
+ (get-current-expand-context.1 #f temp57_2))))
+ (let-values (((new-id_0)
+ (if intdef_16
+ (remove-intdef-use-site-scopes id_101 intdef_16)
+ (remove-use-site-scopes id_101 ctx_62))))
+ (begin
+ (let-values (((obs_37) (expand-context-observer ctx_62)))
+ (if obs_37
+ (call-expand-observe
+ obs_37
+ 'track-syntax
+ 'syntax-local-identifier-as-binding
+ new-id_0
+ id_101)
+ (void)))
+ new-id_0)))))))))))
(case-lambda
- ((id_90) (begin 'syntax-local-identifier-as-binding (syntax-local-identifier-as-binding_0 id_90 #f)))
- ((id_91 intdef1_1) (syntax-local-identifier-as-binding_0 id_91 intdef1_1)))))
+ ((id_102) (begin 'syntax-local-identifier-as-binding (syntax-local-identifier-as-binding_0 id_102 #f)))
+ ((id_103 intdef1_1) (syntax-local-identifier-as-binding_0 id_103 intdef1_1)))))
(define-values
(1/syntax-local-phase-level)
(lambda ()
(begin
'syntax-local-phase-level
- (let-values (((ctx_57) (let-values (((temp57_0) #t)) (get-current-expand-context.1 temp57_0 'unexpected))))
- (if ctx_57 (expand-context-phase ctx_57) 0)))))
+ (let-values (((ctx_63) (let-values (((temp58_2) #t)) (get-current-expand-context.1 temp58_2 'unexpected))))
+ (if ctx_63 (expand-context-phase ctx_63) 0)))))
(define-values
(1/syntax-local-name)
(lambda ()
(begin
'syntax-local-name
- (let-values ()
- (let-values ()
- (let-values (((ctx_58)
- (let-values (((who59_0) 'syntax-local-name)) (get-current-expand-context.1 #f who59_0))))
- (let-values (((id_92) (expand-context-name ctx_58)))
- (if id_92 (datum->syntax$1 #f (syntax-e$1 id_92) id_92) #f))))))))
+ (let-values (((ctx_64) (let-values (((who60_1) 'syntax-local-name)) (get-current-expand-context.1 #f who60_1))))
+ (let-values (((id_104) (expand-context-name ctx_64)))
+ (if id_104 (datum->syntax$1 #f (syntax-e$1 id_104) id_104) #f))))))
(define-values
(1/make-syntax-introducer)
(let-values (((make-syntax-introducer_0)
@@ -49659,7 +49176,7 @@
(begin
'make-syntax-introducer
(let-values (((as-use-site?_0) as-use-site?3_0))
- (let-values () (do-make-syntax-introducer (new-scope (if as-use-site?_0 'use-site 'macro)))))))))
+ (do-make-syntax-introducer (new-scope (if as-use-site?_0 'use-site 'macro))))))))
(case-lambda
(() (begin 'make-syntax-introducer (make-syntax-introducer_0 #f)))
((as-use-site?3_1) (make-syntax-introducer_0 as-use-site?3_1)))))
@@ -49668,62 +49185,53 @@
(lambda (sym-key_0)
(begin
'make-interned-syntax-introducer
- (let-values ()
- (let-values ()
- (begin
- (if ((lambda (v_168) (if (symbol? v_168) (symbol-interned? v_168) #f)) sym-key_0)
- (void)
- (let-values ()
- (raise-argument-error 'make-interned-syntax-introducer "(and/c symbol? symbol-interned?)" sym-key_0)))
- (do-make-syntax-introducer (make-interned-scope sym-key_0))))))))
- (define-values
- (do-make-syntax-introducer)
- (lambda (sc_33)
- (begin
- (let-values (((do-make-syntax-introducer_0)
- (lambda (s62_0 mode61_0)
- (begin
- 'do-make-syntax-introducer
- (let-values (((s_330) s62_0))
- (let-values (((mode_13) mode61_0))
- (let-values ()
- (let-values ((()
- (begin
- (if (syntax?$1 s_330)
- (void)
- (let-values ()
- (raise-argument-error 'syntax-introducer "syntax?" s_330)))
- (values))))
- (let-values (((new-s_4)
- (let-values (((tmp_35) mode_13))
- (if (equal? tmp_35 'add)
- (let-values () (add-scope s_330 sc_33))
- (if (equal? tmp_35 'remove)
- (let-values () (remove-scope s_330 sc_33))
- (if (equal? tmp_35 'flip)
- (let-values () (flip-scope s_330 sc_33))
- (let-values ()
- (raise-argument-error
- 'syntax-introducer
- "(or/c 'add 'remove 'flip)"
- mode_13))))))))
- (let-values (((ctx_59)
- (let-values (((temp63_3) #t))
- (get-current-expand-context.1 temp63_3 'unexpected))))
- (begin
- (if ctx_59
- (let-values ()
- (let-values (((obs_36) (expand-context-observer ctx_59)))
- (if obs_36
- (let-values ()
- (let-values ()
- (call-expand-observe obs_36 'track-syntax mode_13 new-s_4 s_330)))
- (void))))
- (void))
- new-s_4)))))))))))
+ (begin
+ (if ((lambda (v_279) (if (symbol? v_279) (symbol-interned? v_279) #f)) sym-key_0)
+ (void)
+ (raise-argument-error 'make-interned-syntax-introducer "(and/c symbol? symbol-interned?)" sym-key_0))
+ (do-make-syntax-introducer (make-interned-scope sym-key_0))))))
+ (define-values
+ (do-make-syntax-introducer)
+ (lambda (sc_38)
+ (begin
+ (let-values (((...and/syntax-local.rkt:148:2_0)
+ (lambda (s63_1 mode62_0)
+ (begin
+ '...and/syntax-local.rkt:148:2
+ (let-values (((s_683) s63_1))
+ (let-values (((mode_17) mode62_0))
+ (let-values ((()
+ (begin
+ (if (syntax?$1 s_683)
+ (void)
+ (raise-argument-error 'syntax-introducer "syntax?" s_683))
+ (values))))
+ (let-values (((new-s_5)
+ (let-values (((tmp_38) mode_17))
+ (if (equal? tmp_38 'add)
+ (add-scope s_683 sc_38)
+ (if (equal? tmp_38 'remove)
+ (remove-scope s_683 sc_38)
+ (if (equal? tmp_38 'flip)
+ (flip-scope s_683 sc_38)
+ (raise-argument-error
+ 'syntax-introducer
+ "(or/c 'add 'remove 'flip)"
+ mode_17)))))))
+ (let-values (((ctx_65)
+ (let-values (((temp64_1) #t))
+ (get-current-expand-context.1 temp64_1 'unexpected))))
+ (begin
+ (if ctx_65
+ (let-values (((obs_38) (expand-context-observer ctx_65)))
+ (if obs_38
+ (call-expand-observe obs_38 'track-syntax mode_17 new-s_5 s_683)
+ (void)))
+ (void))
+ new-s_5))))))))))
(case-lambda
- ((s_97) (begin 'do-make-syntax-introducer (do-make-syntax-introducer_0 s_97 'flip)))
- ((s_497 mode61_1) (do-make-syntax-introducer_0 s_497 mode61_1)))))))
+ ((s_684) (begin '...and/syntax-local.rkt:148:2 (...and/syntax-local.rkt:148:2_0 s_684 'flip)))
+ ((s_685 mode62_1) (...and/syntax-local.rkt:148:2_0 s_685 mode62_1)))))))
(define-values
(1/make-syntax-delta-introducer)
(let-values (((make-syntax-delta-introducer_0)
@@ -49732,170 +49240,141 @@
'make-syntax-delta-introducer
(let-values (((ext-s_0) ext-s5_0))
(let-values (((base-s_0) base-s6_0))
- (let-values (((phase_121)
+ (let-values (((phase_149)
(if (eq? phase4_0 unsafe-undefined) (1/syntax-local-phase-level) phase4_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (syntax?$1 ext-s_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'make-syntax-delta-introducer
- "syntax?"
- ext-s_0)))
- (values))))
- (let-values ((()
- (begin
- (if ((lambda (x_93)
- (let-values (((or-part_217) (not x_93)))
- (if or-part_217 or-part_217 (syntax?$1 x_93))))
- base-s_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'make-syntax-delta-introducer
- "(or/c syntax? #f)"
- base-s_0)))
- (values))))
- (let-values ((()
- (begin
- (if (phase? phase_121)
- (void)
- (let-values ()
- (raise-argument-error
- 'make-syntax-delta-introducer
- phase?-string
- phase_121)))
- (values))))
- (let-values (((ext-scs_0) (syntax-scope-set ext-s_0 phase_121)))
- (let-values (((base-scs_0)
- (syntax-scope-set
- (let-values (((or-part_29) base-s_0))
- (if or-part_29 or-part_29 empty-syntax))
- phase_121)))
- (let-values (((use-base-scs_0)
- (if (subset? base-scs_0 ext-scs_0)
- base-scs_0
- (let-values (((or-part_225)
- (if (identifier? base-s_0)
- (let-values (((base-s65_0) base-s_0)
- ((phase66_0) phase_121)
- ((temp67_2) #t))
- (resolve.1
- #f
- #f
- null
- temp67_2
- base-s65_0
- phase66_0))
- #f)))
- (if or-part_225 or-part_225 (seteq))))))
- (let-values (((delta-scs_0)
- (set->list (set-subtract ext-scs_0 use-base-scs_0))))
- (let-values (((maybe-taint_0)
- (if (syntax-clean? ext-s_0) values syntax-taint$1)))
- (let-values (((shifts_5) (syntax-mpi-shifts ext-s_0)))
- (let-values (((make-syntax-delta-introducer_1)
- (lambda (s69_0 mode68_0)
- (begin
- 'make-syntax-delta-introducer
- (let-values (((s_38) s69_0))
- (let-values (((mode_14) mode68_0))
- (let-values ()
- (let-values ((()
- (begin
- (if (syntax?$1 s_38)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-introducer
- "syntax?"
- s_38)))
- (values))))
- (let-values (((new-s_5)
- (maybe-taint_0
- (let-values (((tmp_36)
- mode_14))
- (if (equal? tmp_36 'add)
- (let-values ()
- (let-values (((temp70_2)
- (add-scopes
- s_38
- delta-scs_0))
- ((shifts71_0)
- shifts_5)
- ((temp72_1)
- #t))
- (syntax-add-shifts.1
- temp72_1
- temp70_2
- shifts71_0
- #f)))
- (if (equal?
- tmp_36
- 'remove)
- (let-values ()
- (remove-scopes
- s_38
- delta-scs_0))
- (if (equal?
- tmp_36
- 'flip)
- (let-values ()
- (let-values (((temp73_1)
- (flip-scopes
- s_38
- delta-scs_0))
- ((shifts74_0)
- shifts_5)
- ((temp75_0)
- #t))
- (syntax-add-shifts.1
- temp75_0
- temp73_1
- shifts74_0
- #f)))
- (let-values ()
- (raise-argument-error
- 'syntax-introducer
- "(or/c 'add 'remove 'flip)"
- mode_14)))))))))
- (let-values (((ctx_60)
- (let-values (((temp76_0)
- #t))
- (get-current-expand-context.1
- temp76_0
- 'unexpected))))
+ (let-values ((()
+ (begin
+ (if (syntax?$1 ext-s_0)
+ (void)
+ (raise-argument-error 'make-syntax-delta-introducer "syntax?" ext-s_0))
+ (values))))
+ (let-values ((()
+ (begin
+ (if ((lambda (x_100)
+ (let-values (((or-part_492) (not x_100)))
+ (if or-part_492 or-part_492 (syntax?$1 x_100))))
+ base-s_0)
+ (void)
+ (raise-argument-error
+ 'make-syntax-delta-introducer
+ "(or/c syntax? #f)"
+ base-s_0))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (phase? phase_149)
+ (void)
+ (raise-argument-error
+ 'make-syntax-delta-introducer
+ phase?-string
+ phase_149))
+ (values))))
+ (let-values (((ext-scs_0) (syntax-scope-set ext-s_0 phase_149)))
+ (let-values (((base-scs_0)
+ (syntax-scope-set
+ (let-values (((or-part_493) base-s_0))
+ (if or-part_493 or-part_493 empty-syntax))
+ phase_149)))
+ (let-values (((use-base-scs_0)
+ (if (subset? base-scs_0 ext-scs_0)
+ base-scs_0
+ (let-values (((or-part_494)
+ (if (identifier? base-s_0)
+ (let-values (((base-s66_0) base-s_0)
+ ((phase67_0) phase_149)
+ ((temp68_4) #t))
+ (resolve.1
+ #f
+ #f
+ null
+ temp68_4
+ base-s66_0
+ phase67_0))
+ #f)))
+ (if or-part_494 or-part_494 (seteq))))))
+ (let-values (((delta-scs_0) (set->list (set-subtract ext-scs_0 use-base-scs_0))))
+ (let-values (((maybe-taint_0)
+ (if (syntax-clean? ext-s_0) values syntax-taint$1)))
+ (let-values (((shifts_5) (syntax-mpi-shifts ext-s_0)))
+ (let-values (((...and/syntax-local.rkt:174:2_0)
+ (lambda (s70_0 mode69_0)
+ (begin
+ '...and/syntax-local.rkt:174:2
+ (let-values (((s_686) s70_0))
+ (let-values (((mode_18) mode69_0))
+ (let-values ((()
(begin
- (if ctx_60
- (let-values ()
- (let-values (((obs_37)
- (expand-context-observer
- ctx_60)))
- (if obs_37
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_37
- 'track-syntax
- mode_14
- new-s_5
- s_38)))
- (void))))
- (void))
- new-s_5)))))))))))
- (case-lambda
- ((s_498)
- (begin
- 'make-syntax-delta-introducer
- (make-syntax-delta-introducer_1 s_498 'add)))
- ((s_499 mode68_1)
- (make-syntax-delta-introducer_1
- s_499
- mode68_1)))))))))))))))))))))))
+ (if (syntax?$1 s_686)
+ (void)
+ (raise-argument-error
+ 'syntax-introducer
+ "syntax?"
+ s_686))
+ (values))))
+ (let-values (((new-s_6)
+ (maybe-taint_0
+ (let-values (((tmp_39) mode_18))
+ (if (equal? tmp_39 'add)
+ (let-values (((temp71_0)
+ (add-scopes
+ s_686
+ delta-scs_0))
+ ((shifts72_0)
+ shifts_5)
+ ((temp73_1) #t))
+ (syntax-add-shifts.1
+ temp73_1
+ temp71_0
+ shifts72_0
+ #f))
+ (if (equal? tmp_39 'remove)
+ (remove-scopes
+ s_686
+ delta-scs_0)
+ (if (equal? tmp_39 'flip)
+ (let-values (((temp74_0)
+ (flip-scopes
+ s_686
+ delta-scs_0))
+ ((shifts75_0)
+ shifts_5)
+ ((temp76_1) #t))
+ (syntax-add-shifts.1
+ temp76_1
+ temp74_0
+ shifts75_0
+ #f))
+ (raise-argument-error
+ 'syntax-introducer
+ "(or/c 'add 'remove 'flip)"
+ mode_18))))))))
+ (let-values (((ctx_66)
+ (let-values (((temp77_0) #t))
+ (get-current-expand-context.1
+ temp77_0
+ 'unexpected))))
+ (begin
+ (if ctx_66
+ (let-values (((obs_39)
+ (expand-context-observer
+ ctx_66)))
+ (if obs_39
+ (call-expand-observe
+ obs_39
+ 'track-syntax
+ mode_18
+ new-s_6
+ s_686)
+ (void)))
+ (void))
+ new-s_6))))))))))
+ (case-lambda
+ ((s_687)
+ (begin
+ '...and/syntax-local.rkt:174:2
+ (...and/syntax-local.rkt:174:2_0 s_687 'add)))
+ ((s_688 mode69_1)
+ (...and/syntax-local.rkt:174:2_0 s_688 mode69_1))))))))))))))))))))
(case-lambda
((ext-s_1 base-s_1)
(begin 'make-syntax-delta-introducer (make-syntax-delta-introducer_0 ext-s_1 base-s_1 unsafe-undefined)))
@@ -49905,411 +49384,326 @@
(lambda (id-stx_1)
(begin
'syntax-local-make-delta-introducer
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? id-stx_1)
- (void)
- (let-values () (raise-argument-error 'syntax-local-make-delta-introducer "identifier?" id-stx_1)))
- (raise
- (exn:fail:unsupported
- "syntax-local-make-delta-introducer: not supported anymore"
- (current-continuation-marks)))))))))
+ (begin
+ (if (identifier? id-stx_1)
+ (void)
+ (raise-argument-error 'syntax-local-make-delta-introducer "identifier?" id-stx_1))
+ (raise
+ (exn:fail:unsupported
+ "syntax-local-make-delta-introducer: not supported anymore"
+ (current-continuation-marks)))))))
(define-values
(do-syntax-local-value.1)
(lambda (immediate?7_0 who9_0 id10_1 intdefs11_0 failure-thunk12_0)
(begin
'do-syntax-local-value
- (let-values (((who_20) who9_0))
- (let-values (((id_93) id10_1))
+ (let-values (((who_32) who9_0))
+ (let-values (((id_105) id10_1))
(let-values (((intdefs_3) intdefs11_0))
(let-values (((failure-thunk_0) failure-thunk12_0))
(let-values (((immediate?_1) immediate?7_0))
- (let-values ()
+ (let-values ((()
+ (begin
+ (if (identifier? id_105) (void) (raise-argument-error who_32 "identifier?" id_105))
+ (values))))
(let-values ((()
(begin
- (if (identifier? id_93)
+ (if ((lambda (x_101)
+ (let-values (((or-part_495) (not x_101)))
+ (if or-part_495
+ or-part_495
+ ((lambda (p_58)
+ (if (procedure? p_58) (procedure-arity-includes? p_58 0) #f))
+ x_101))))
+ failure-thunk_0)
(void)
- (let-values () (raise-argument-error who_20 "identifier?" id_93)))
+ (raise-argument-error
+ who_32
+ "(or/c #f (procedure-arity-includes/c 0))"
+ failure-thunk_0))
(values))))
(let-values ((()
(begin
- (if ((lambda (x_49)
- (let-values (((or-part_43) (not x_49)))
- (if or-part_43
- or-part_43
- ((lambda (p_50)
- (if (procedure? p_50) (procedure-arity-includes? p_50 0) #f))
- x_49))))
- failure-thunk_0)
+ (if (intdefs-or-false? intdefs_3)
(void)
- (let-values ()
- (raise-argument-error
- who_20
- "(or/c #f (procedure-arity-includes/c 0))"
- failure-thunk_0)))
+ (raise-argument-error who_32 intdefs-or-false?-string intdefs_3))
(values))))
- (let-values ((()
- (begin
- (if (intdefs-or-false? intdefs_3)
- (void)
- (let-values ()
- (raise-argument-error who_20 intdefs-or-false?-string intdefs_3)))
- (values))))
- (let-values (((current-ctx_0)
- (let-values (((who78_0) who_20)) (get-current-expand-context.1 #f who78_0))))
- (let-values (((ctx_61)
- (if intdefs_3
- (let-values (((v_204) current-ctx_0))
- (let-values (((the-struct_63) v_204))
- (if (expand-context/outer? the-struct_63)
- (let-values (((env79_0)
- (add-intdef-bindings
- (expand-context-env current-ctx_0)
- intdefs_3))
- ((inner80_0) (root-expand-context/outer-inner v_204)))
- (expand-context/outer1.1
- inner80_0
- (root-expand-context/outer-post-expansion the-struct_63)
- (root-expand-context/outer-use-site-scopes the-struct_63)
- (root-expand-context/outer-frame-id the-struct_63)
- (expand-context/outer-context the-struct_63)
- env79_0
- (expand-context/outer-scopes the-struct_63)
- (expand-context/outer-def-ctx-scopes the-struct_63)
- (expand-context/outer-binding-layer the-struct_63)
- (expand-context/outer-reference-records the-struct_63)
- (expand-context/outer-only-immediate? the-struct_63)
- (expand-context/outer-need-eventually-defined the-struct_63)
- (expand-context/outer-current-introduction-scopes the-struct_63)
- (expand-context/outer-current-use-scopes the-struct_63)
- (expand-context/outer-name the-struct_63)))
- (raise-argument-error
- 'struct-copy
- "expand-context/outer?"
- the-struct_63))))
- current-ctx_0)))
- (let-values ((()
- (begin
- (let-values (((obs_38) (expand-context-observer ctx_61)))
- (if obs_38
- (let-values ()
- (let-values () (call-expand-observe obs_38 'local-value id_93)))
- (void)))
- (values))))
- (let-values (((phase_122) (expand-context-phase ctx_61)))
- ((letrec-values (((loop_100)
- (lambda (id_20)
- (begin
- 'loop
- (let-values (((b_97)
- (if immediate?_1
- (let-values (((id81_0) id_20)
- ((phase82_0) phase_122)
- ((temp83_1) #t))
- (resolve+shift.1
- #f
- #f
- null
- temp83_1
- #f
- id81_0
- phase82_0))
- (resolve+shift/extra-inspector
- id_20
- phase_122
- (expand-context-namespace ctx_61)))))
- (begin
- (let-values (((obs_39) (expand-context-observer ctx_61)))
- (if obs_39
- (let-values ()
- (let-values ()
- (call-expand-observe obs_39 'resolve id_20)))
- (void)))
- (if (not b_97)
- (let-values ()
+ (let-values (((current-ctx_0)
+ (let-values (((who79_0) who_32)) (get-current-expand-context.1 #f who79_0))))
+ (let-values (((ctx_67)
+ (if intdefs_3
+ (let-values (((v_280) current-ctx_0))
+ (let-values (((the-struct_68) v_280))
+ (if (expand-context/outer? the-struct_68)
+ (let-values (((env80_0)
+ (add-intdef-bindings
+ (expand-context-env current-ctx_0)
+ intdefs_3))
+ ((inner81_0) (root-expand-context/outer-inner v_280)))
+ (expand-context/outer1.1
+ inner81_0
+ (root-expand-context/outer-post-expansion the-struct_68)
+ (root-expand-context/outer-use-site-scopes the-struct_68)
+ (root-expand-context/outer-frame-id the-struct_68)
+ (expand-context/outer-context the-struct_68)
+ env80_0
+ (expand-context/outer-scopes the-struct_68)
+ (expand-context/outer-def-ctx-scopes the-struct_68)
+ (expand-context/outer-binding-layer the-struct_68)
+ (expand-context/outer-reference-records the-struct_68)
+ (expand-context/outer-only-immediate? the-struct_68)
+ (expand-context/outer-need-eventually-defined the-struct_68)
+ (expand-context/outer-current-introduction-scopes the-struct_68)
+ (expand-context/outer-current-use-scopes the-struct_68)
+ (expand-context/outer-name the-struct_68)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/outer?"
+ the-struct_68))))
+ current-ctx_0)))
+ (let-values ((()
+ (begin
+ (let-values (((obs_40) (expand-context-observer ctx_67)))
+ (if obs_40 (call-expand-observe obs_40 'local-value id_105) (void)))
+ (values))))
+ (let-values (((phase_150) (expand-context-phase ctx_67)))
+ ((letrec-values (((loop_114)
+ (lambda (id_106)
+ (begin
+ 'loop
+ (let-values (((b_131)
+ (if immediate?_1
+ (let-values (((id82_0) id_106)
+ ((phase83_2) phase_150)
+ ((temp84_0) #t))
+ (resolve+shift.1
+ #f
+ #f
+ null
+ temp84_0
+ #f
+ id82_0
+ phase83_2))
+ (resolve+shift/extra-inspector
+ id_106
+ phase_150
+ (expand-context-namespace ctx_67)))))
+ (begin
+ (let-values (((obs_41) (expand-context-observer ctx_67)))
+ (if obs_41
+ (call-expand-observe obs_41 'resolve id_106)
+ (void)))
+ (if (not b_131)
+ (begin
+ (let-values (((obs_42) (expand-context-observer ctx_67)))
+ (if obs_42
+ (call-expand-observe obs_42 'local-value-result #f)
+ (void)))
+ (if failure-thunk_0
+ (failure-thunk_0)
+ (error who_32 "unbound identifier: ~v" id_106)))
+ (let-values (((v_281 primitive?_7 insp_18 protected?_9)
+ (let-values (((b85_0) b_131)
+ ((ctx86_0) ctx_67)
+ ((id87_0) id_106)
+ ((temp88_1) #t))
+ (lookup.1 #f temp88_1 b85_0 ctx86_0 id87_0))))
+ (if (let-values (((or-part_496) (variable? v_281)))
+ (if or-part_496 or-part_496 (core-form? v_281)))
(begin
- (let-values (((obs_40)
- (expand-context-observer ctx_61)))
- (if obs_40
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_40
- 'local-value-result
- #f)))
+ (let-values (((obs_43)
+ (expand-context-observer ctx_67)))
+ (if obs_43
+ (call-expand-observe obs_43 'local-value-result #f)
(void)))
(if failure-thunk_0
(failure-thunk_0)
- (error who_20 "unbound identifier: ~v" id_20))))
- (let-values ()
- (let-values (((v_205 primitive?_7 insp_18 protected?_9)
- (let-values (((b84_0) b_97)
- ((ctx85_0) ctx_61)
- ((id86_0) id_20)
- ((temp87_1) #t))
- (lookup.1
- #f
- temp87_1
- b84_0
- ctx85_0
- id86_0))))
- (if (let-values (((or-part_304) (variable? v_205)))
- (if or-part_304 or-part_304 (core-form? v_205)))
- (let-values ()
- (begin
- (let-values (((obs_41)
- (expand-context-observer ctx_61)))
- (if obs_41
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_41
- 'local-value-result
- #f)))
- (void)))
- (if failure-thunk_0
- (failure-thunk_0)
- (error
- who_20
- "identifier is not bound to syntax: ~v"
- id_20))))
- (let-values ()
- (begin
- (let-values (((obs_42)
- (expand-context-observer ctx_61)))
- (if obs_42
- (let-values ()
- (if (not
- (if (1/rename-transformer? v_205)
- (not immediate?_1)
- #f))
- (let-values ()
- (call-expand-observe
- obs_42
- 'local-value-result
- #t))
- (void)))
- (void)))
- (if (1/rename-transformer? v_205)
- (let-values ()
- (if immediate?_1
- (values
- v_205
- (rename-transformer-target-in-context
- v_205
- ctx_61))
- (loop_100
- (rename-transformer-target-in-context
- v_205
- ctx_61))))
- (if immediate?_1
- (let-values () (values v_205 #f))
- (let-values () v_205)))))))))))))))
- loop_100)
- (flip-introduction-scopes id_93 ctx_61))))))))))))))))))
+ (error
+ who_32
+ "identifier is not bound to syntax: ~v"
+ id_106)))
+ (begin
+ (let-values (((obs_44)
+ (expand-context-observer ctx_67)))
+ (if obs_44
+ (if (not
+ (if (1/rename-transformer? v_281)
+ (not immediate?_1)
+ #f))
+ (call-expand-observe
+ obs_44
+ 'local-value-result
+ #t)
+ (void))
+ (void)))
+ (if (1/rename-transformer? v_281)
+ (if immediate?_1
+ (values
+ v_281
+ (rename-transformer-target-in-context
+ v_281
+ ctx_67))
+ (loop_114
+ (rename-transformer-target-in-context
+ v_281
+ ctx_67)))
+ (if immediate?_1 (values v_281 #f) v_281))))))))))))
+ loop_114)
+ (flip-introduction-scopes id_105 ctx_67)))))))))))))))))
(define-values
(1/syntax-local-value)
(let-values (((syntax-local-value_0)
(lambda (id16_0 failure-thunk14_0 intdef15_0)
(begin
'syntax-local-value
- (let-values (((id_94) id16_0))
+ (let-values (((id_107) id16_0))
(let-values (((failure-thunk_1) failure-thunk14_0))
(let-values (((intdef_17) intdef15_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((who89_0) 'syntax-local-value)
- ((temp90_0) #f)
- ((id91_0) id_94)
- ((intdef92_0) intdef_17)
- ((failure-thunk93_0) failure-thunk_1))
- (do-syntax-local-value.1
- temp90_0
- who89_0
- id91_0
- intdef92_0
- failure-thunk93_0))))))))))))
+ (let-values (((who90_0) 'syntax-local-value)
+ ((temp91_0) #f)
+ ((id92_0) id_107)
+ ((intdef93_0) intdef_17)
+ ((failure-thunk94_0) failure-thunk_1))
+ (do-syntax-local-value.1 temp91_0 who90_0 id92_0 intdef93_0 failure-thunk94_0)))))))))
(case-lambda
- ((id_95) (begin 'syntax-local-value (syntax-local-value_0 id_95 #f #f)))
- ((id_96 failure-thunk_2 intdef15_1) (syntax-local-value_0 id_96 failure-thunk_2 intdef15_1))
- ((id_97 failure-thunk14_1) (syntax-local-value_0 id_97 failure-thunk14_1 #f)))))
+ ((id_108) (begin 'syntax-local-value (syntax-local-value_0 id_108 #f #f)))
+ ((id_109 failure-thunk_2 intdef15_1) (syntax-local-value_0 id_109 failure-thunk_2 intdef15_1))
+ ((id_110 failure-thunk14_1) (syntax-local-value_0 id_110 failure-thunk14_1 #f)))))
(define-values
(1/syntax-local-value/immediate)
(let-values (((syntax-local-value/immediate_0)
(lambda (id19_1 failure-thunk17_0 intdef18_0)
(begin
'syntax-local-value/immediate
- (let-values (((id_98) id19_1))
+ (let-values (((id_111) id19_1))
(let-values (((failure-thunk_3) failure-thunk17_0))
(let-values (((intdef_18) intdef18_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((who95_0) 'syntax-local-value/immediate)
- ((temp96_1) #t)
- ((id97_0) id_98)
- ((intdef98_0) intdef_18)
- ((failure-thunk99_0) failure-thunk_3))
- (do-syntax-local-value.1
- temp96_1
- who95_0
- id97_0
- intdef98_0
- failure-thunk99_0))))))))))))
+ (let-values (((who96_0) 'syntax-local-value/immediate)
+ ((temp97_1) #t)
+ ((id98_0) id_111)
+ ((intdef99_0) intdef_18)
+ ((failure-thunk100_0) failure-thunk_3))
+ (do-syntax-local-value.1 temp97_1 who96_0 id98_0 intdef99_0 failure-thunk100_0)))))))))
(case-lambda
- ((id_99) (begin 'syntax-local-value/immediate (syntax-local-value/immediate_0 id_99 #f #f)))
- ((id_100 failure-thunk_4 intdef18_1) (syntax-local-value/immediate_0 id_100 failure-thunk_4 intdef18_1))
- ((id_101 failure-thunk17_1) (syntax-local-value/immediate_0 id_101 failure-thunk17_1 #f)))))
+ ((id_112) (begin 'syntax-local-value/immediate (syntax-local-value/immediate_0 id_112 #f #f)))
+ ((id_113 failure-thunk_4 intdef18_1) (syntax-local-value/immediate_0 id_113 failure-thunk_4 intdef18_1))
+ ((id_114 failure-thunk17_1) (syntax-local-value/immediate_0 id_114 failure-thunk17_1 #f)))))
(define-values
(do-lift-values-expression)
- (lambda (who_21 n_33 s_500)
+ (lambda (who_33 n_33 s_689)
(begin
- (let-values ((()
- (begin
- (if (syntax?$1 s_500) (void) (let-values () (raise-argument-error who_21 "syntax?" s_500)))
- (values))))
+ (let-values ((() (begin (if (syntax?$1 s_689) (void) (raise-argument-error who_33 "syntax?" s_689)) (values))))
(let-values ((()
(begin
(if (exact-nonnegative-integer? n_33)
(void)
- (let-values () (raise-argument-error who_21 "exact-nonnegative-integer?" n_33)))
+ (raise-argument-error who_33 "exact-nonnegative-integer?" n_33))
(values))))
- (let-values (((ctx_6) (let-values (((who100_0) who_21)) (get-current-expand-context.1 #f who100_0))))
- (let-values (((lifts_8) (expand-context-lifts ctx_6)))
- (let-values ((()
- (begin
- (if lifts_8 (void) (let-values () (raise-arguments-error who_21 "no lift target")))
- (values))))
- (let-values (((counter_5) (root-expand-context-counter ctx_6)))
- (let-values (((ids_29)
+ (let-values (((ctx_68) (let-values (((who101_0) who_33)) (get-current-expand-context.1 #f who101_0))))
+ (let-values (((lifts_8) (expand-context-lifts ctx_68)))
+ (let-values ((() (begin (if lifts_8 (void) (raise-arguments-error who_33 "no lift target")) (values))))
+ (let-values (((counter_5) (root-expand-context-counter ctx_68)))
+ (let-values (((ids_31)
(reverse$1
- (let-values (((start_51) 0) ((end_38) n_33) ((inc_32) 1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-range start_51 end_38 inc_32)))
- ((letrec-values (((for-loop_173)
- (lambda (fold-var_271 pos_130)
- (begin
- 'for-loop
- (if (< pos_130 end_38)
- (let-values ()
- (let-values (((fold-var_272)
- (let-values (((fold-var_273) fold-var_271))
- (let-values (((fold-var_274)
- (let-values ()
- (cons
- (let-values ()
- (let-values ((()
- (begin
- (set-box!
- counter_5
- (add1
- (unbox
- counter_5)))
- (values))))
- (let-values (((name_69)
- (string->unreadable-symbol
- (format
- "lifted/~a"
- (unbox
- counter_5)))))
- (add-scope
- (datum->syntax$1
- #f
- name_69)
- (new-scope
- 'macro)))))
- fold-var_273))))
- (values fold-var_274)))))
- (if (not #f)
- (for-loop_173 fold-var_272 (+ pos_130 inc_32))
- fold-var_272)))
- fold-var_271)))))
- for-loop_173)
- null
- start_51))))))
- (let-values (((added-s_0) (flip-introduction-scopes s_500 ctx_6)))
+ (let-values (((fold-var_550) (let-values (((fold-var_551) null)) fold-var_551)))
+ (let-values (((start_62) 0) ((end_41) n_33) ((inc_35) 1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-range start_62 end_41 inc_35))
+ ((letrec-values (((for-loop_417)
+ (lambda (fold-var_552 pos_163)
+ (begin
+ 'for-loop
+ (if (< pos_163 end_41)
+ (let-values ()
+ (let-values (((fold-var_553)
+ (let-values (((fold-var_554)
+ (cons
+ (let-values ((()
+ (begin
+ (set-box!
+ counter_5
+ (add1
+ (unbox
+ counter_5)))
+ (values))))
+ (let-values (((name_80)
+ (string->unreadable-symbol
+ (format
+ "lifted/~a"
+ (unbox
+ counter_5)))))
+ (add-scope
+ (datum->syntax$1
+ #f
+ name_80)
+ (new-scope 'macro))))
+ fold-var_552)))
+ (values fold-var_554))))
+ (if (not #f)
+ (for-loop_417 fold-var_553 (+ pos_163 inc_35))
+ fold-var_553)))
+ fold-var_552)))))
+ for-loop_417)
+ fold-var_550
+ start_62)))))))
+ (let-values (((added-s_0) (flip-introduction-scopes s_689 ctx_68)))
(begin
- (let-values (((obs_43) (expand-context-observer ctx_6)))
- (if obs_43
- (let-values ()
- (let-values () (call-expand-observe obs_43 'lift-expr ids_29 s_500 added-s_0)))
- (void)))
+ (let-values (((obs_45) (expand-context-observer ctx_68)))
+ (if obs_45 (call-expand-observe obs_45 'lift-expr ids_31 s_689 added-s_0) (void)))
(map2
- (lambda (id_102) (flip-introduction-scopes id_102 ctx_6))
- (add-lifted! lifts_8 ids_29 added-s_0 (expand-context-phase ctx_6)))))))))))))))
+ (lambda (id_115) (flip-introduction-scopes id_115 ctx_68))
+ (add-lifted! lifts_8 ids_31 added-s_0 (expand-context-phase ctx_68)))))))))))))))
(define-values
(1/syntax-local-lift-expression)
- (lambda (s_464)
- (begin
- 'syntax-local-lift-expression
- (let-values () (let-values () (car (do-lift-values-expression 'syntax-local-lift-expression 1 s_464)))))))
+ (lambda (s_690)
+ (begin 'syntax-local-lift-expression (car (do-lift-values-expression 'syntax-local-lift-expression 1 s_690)))))
(define-values
(1/syntax-local-lift-values-expression)
- (lambda (n_34 s_79)
+ (lambda (n_34 s_691)
(begin
'syntax-local-lift-values-expression
- (let-values () (let-values () (do-lift-values-expression 'syntax-local-lift-values-expression n_34 s_79))))))
+ (do-lift-values-expression 'syntax-local-lift-values-expression n_34 s_691))))
(define-values
(1/syntax-local-lift-context)
(lambda ()
(begin
'syntax-local-lift-context
- (let-values ()
- (let-values ()
- (let-values (((ctx_62)
- (let-values (((who104_0) 'syntax-local-lift-context))
- (get-current-expand-context.1 #f who104_0))))
- (root-expand-context-lift-key ctx_62)))))))
+ (let-values (((ctx_69)
+ (let-values (((who105_0) 'syntax-local-lift-context)) (get-current-expand-context.1 #f who105_0))))
+ (root-expand-context-lift-key ctx_69)))))
(define-values
(1/syntax-local-lift-module)
- (lambda (s_493)
+ (lambda (s_692)
(begin
'syntax-local-lift-module
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (syntax?$1 s_493)
- (void)
- (let-values () (raise-argument-error 'syntax-local-lift-module "syntax?" s_493)))
- (values))))
- (let-values (((ctx_63)
- (let-values (((who106_0) 'syntax-local-lift-module))
- (get-current-expand-context.1 #f who106_0))))
- (let-values (((phase_123) (expand-context-phase ctx_63)))
- (let-values (((tmp_37) (core-form-sym s_493 phase_123)))
- (if (if (equal? tmp_37 'module) #t (equal? tmp_37 'module*))
- (let-values ()
- (let-values (((lifts_9) (expand-context-module-lifts ctx_63)))
- (let-values ((()
- (begin
- (if lifts_9
- (void)
- (let-values ()
- (raise-arguments-error
- 'syntax-local-lift-module
- "not currently transforming within a module declaration or top level"
- "form to lift"
- s_493)))
- (values))))
- (let-values (((added-s_1) (flip-introduction-scopes s_493 ctx_63)))
- (begin
- (add-lifted-module! lifts_9 added-s_1 phase_123)
- (let-values (((obs_44) (expand-context-observer ctx_63)))
- (if obs_44
- (let-values ()
- (let-values () (call-expand-observe obs_44 'lift-module s_493 added-s_1)))
- (void))))))))
- (let-values ()
- (raise-arguments-error
- 'syntax-local-lift-module
- "not a module form"
- "given form"
- s_493))))))))))))
+ (let-values ((()
+ (begin
+ (if (syntax?$1 s_692) (void) (raise-argument-error 'syntax-local-lift-module "syntax?" s_692))
+ (values))))
+ (let-values (((ctx_70)
+ (let-values (((who107_0) 'syntax-local-lift-module)) (get-current-expand-context.1 #f who107_0))))
+ (let-values (((phase_151) (expand-context-phase ctx_70)))
+ (let-values (((tmp_40) (core-form-sym s_692 phase_151)))
+ (if (if (equal? tmp_40 'module) #t (equal? tmp_40 'module*))
+ (let-values (((lifts_9) (expand-context-module-lifts ctx_70)))
+ (let-values ((()
+ (begin
+ (if lifts_9
+ (void)
+ (raise-arguments-error
+ 'syntax-local-lift-module
+ "not currently transforming within a module declaration or top level"
+ "form to lift"
+ s_692))
+ (values))))
+ (let-values (((added-s_1) (flip-introduction-scopes s_692 ctx_70)))
+ (begin
+ (add-lifted-module! lifts_9 added-s_1 phase_151)
+ (let-values (((obs_46) (expand-context-observer ctx_70)))
+ (if obs_46 (call-expand-observe obs_46 'lift-module s_692 added-s_1) (void)))))))
+ (raise-arguments-error 'syntax-local-lift-module "not a module form" "given form" s_692)))))))))
(define-values
(do-local-lift-to-module.1)
(lambda (add-lifted!25_0
@@ -50326,8 +49720,8 @@
s41_0)
(begin
'do-local-lift-to-module
- (let-values (((who_22) who40_0))
- (let-values (((s_342) s41_0))
+ (let-values (((who_34) who40_0))
+ (let-values (((s_693) s41_0))
(let-values (((log-tag_0) log-tag20_0))
(let-values (((no-target-msg_0) no-target-msg21_0))
(let-values (((intro?_0) intro?22_0))
@@ -50337,747 +49731,657 @@
(let-values (((get-wrt-phase_0) get-wrt-phase26_0))
(let-values (((pre-wrap_0)
(if (eq? pre-wrap27_0 unsafe-undefined)
- (lambda (s_501 phase_124 lift-ctx_1) (begin 'pre-wrap s_501))
+ (lambda (s_694 phase_152 lift-ctx_1) (begin 'pre-wrap s_694))
pre-wrap27_0)))
(let-values (((shift-wrap_0)
(if (eq? shift-wrap28_0 unsafe-undefined)
- (lambda (s_502 phase_86 lift-ctx_2) (begin 'shift-wrap s_502))
+ (lambda (s_695 phase_153 lift-ctx_2) (begin 'shift-wrap s_695))
shift-wrap28_0)))
(let-values (((post-wrap_0)
(if (eq? post-wrap29_0 unsafe-undefined)
- (lambda (s_117 phase_125 lift-ctx_3) (begin 'post-wrap s_117))
+ (lambda (s_696 phase_154 lift-ctx_3) (begin 'post-wrap s_696))
post-wrap29_0)))
- (let-values ()
- (let-values ((()
- (begin
- (if (syntax?$1 s_342)
- (void)
- (let-values () (raise-argument-error who_22 "syntax?" s_342)))
- (values))))
- (let-values ((() (begin (more-checks_0) (values))))
- (let-values (((ctx_64)
- (let-values (((who107_0) who_22))
- (get-current-expand-context.1 #f who107_0))))
- (let-values (((lift-ctx_4) (get-lift-ctx_0 ctx_64)))
- (let-values ((()
- (begin
- (if lift-ctx_4
- (void)
- (let-values ()
- (raise-arguments-error
- who_22
- no-target-msg_0
- "form to lift"
- s_342)))
- (values))))
- (let-values (((phase_126) (expand-context-phase ctx_64)))
- (let-values (((wrt-phase_3) (get-wrt-phase_0 lift-ctx_4)))
- (let-values (((added-s_2)
- (if intro?_0
- (flip-introduction-scopes s_342 ctx_64)
- s_342)))
- (let-values (((pre-s_0) (pre-wrap_0 added-s_2 phase_126 lift-ctx_4)))
- (let-values (((shift-s_0)
- (let-values (((start_52) phase_126)
- ((end_39) wrt-phase_3)
- ((inc_33) -1))
+ (let-values ((()
+ (begin
+ (if (syntax?$1 s_693)
+ (void)
+ (raise-argument-error who_34 "syntax?" s_693))
+ (values))))
+ (let-values ((() (begin (more-checks_0) (values))))
+ (let-values (((ctx_71)
+ (let-values (((who108_0) who_34))
+ (get-current-expand-context.1 #f who108_0))))
+ (let-values (((lift-ctx_4) (get-lift-ctx_0 ctx_71)))
+ (let-values ((()
+ (begin
+ (if lift-ctx_4
+ (void)
+ (raise-arguments-error
+ who_34
+ no-target-msg_0
+ "form to lift"
+ s_693))
+ (values))))
+ (let-values (((phase_155) (expand-context-phase ctx_71)))
+ (let-values (((wrt-phase_3) (get-wrt-phase_0 lift-ctx_4)))
+ (let-values (((added-s_2)
+ (if intro?_0 (flip-introduction-scopes s_693 ctx_71) s_693)))
+ (let-values (((pre-s_0) (pre-wrap_0 added-s_2 phase_155 lift-ctx_4)))
+ (let-values (((shift-s_0)
+ (let-values (((s_697)
+ (let-values (((s_698) pre-s_0)) s_698)))
+ (let-values (((start_63) phase_155)
+ ((end_42) wrt-phase_3)
+ ((inc_36) -1))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-range start_52 end_39 inc_33)))
- ((letrec-values (((for-loop_279)
- (lambda (s_503 pos_131)
+ (check-range start_63 end_42 inc_36))
+ ((letrec-values (((for-loop_418)
+ (lambda (s_699 pos_164)
(begin
'for-loop
- (if (> pos_131 end_39)
- (let-values (((phase_127)
- pos_131))
- (let-values (((s_119)
- (let-values (((s_504)
- s_503))
- (let-values (((s_505)
- (let-values ()
- (shift-wrap_0
- s_504
- (sub1
- phase_127)
- lift-ctx_4))))
- (values
- s_505)))))
+ (if (> pos_164 end_42)
+ (let-values (((phase_156)
+ pos_164))
+ (let-values (((s_700)
+ (let-values (((s_701)
+ (shift-wrap_0
+ s_699
+ (sub1
+ phase_156)
+ lift-ctx_4)))
+ (values
+ s_701))))
(if (not #f)
- (for-loop_279
- s_119
- (+ pos_131 inc_33))
- s_119)))
- s_503)))))
- for-loop_279)
- pre-s_0
- start_52)))))
- (let-values (((post-s_1)
- (post-wrap_0 shift-s_0 wrt-phase_3 lift-ctx_4)))
- (begin
- (if log-tag_0
- (let-values ()
- (let-values (((obs_45) (expand-context-observer ctx_64)))
- (if obs_45
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_45
- log-tag_0
- s_342
- added-s_2
- post-s_1)))
- (void))))
- (void))
- (add-lifted!_0 lift-ctx_4 post-s_1 wrt-phase_3)
- (values ctx_64 post-s_1)))))))))))))))))))))))))))))
+ (for-loop_418
+ s_700
+ (+ pos_164 inc_36))
+ s_700)))
+ s_699)))))
+ for-loop_418)
+ s_697
+ start_63))))))
+ (let-values (((post-s_1)
+ (post-wrap_0 shift-s_0 wrt-phase_3 lift-ctx_4)))
+ (begin
+ (if log-tag_0
+ (let-values (((obs_47) (expand-context-observer ctx_71)))
+ (if obs_47
+ (call-expand-observe
+ obs_47
+ log-tag_0
+ s_693
+ added-s_2
+ post-s_1)
+ (void)))
+ (void))
+ (add-lifted!_0 lift-ctx_4 post-s_1 wrt-phase_3)
+ (values ctx_71 post-s_1))))))))))))))))))))))))))))
(define-values
(1/syntax-local-lift-require)
(let-values (((syntax-local-lift-require_0)
- (lambda (s44_0 use-s45_0 new-scope?43_0)
- (begin
- 'syntax-local-lift-require
- (let-values (((s_506) s44_0))
- (let-values (((use-s_2) use-s45_0))
- (let-values (((new-scope?_0) new-scope?43_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((sc_34) (if new-scope?_0 (new-scope 'lifted-require) #f)))
- (let-values (((ctx_65 added-s_3)
- (let-values (((who109_0) 'syntax-local-lift-require)
- ((temp110_2) (datum->syntax$1 #f s_506))
- ((temp111_2) "could not find target context")
- ((temp112_0) #f)
- ((temp113_0)
- (lambda ()
- (if (syntax?$1 use-s_2)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-lift-require
- "syntax?"
- use-s_2)))))
- ((expand-context-require-lifts114_0)
- expand-context-require-lifts)
- ((require-lift-context-wrt-phase115_0)
- require-lift-context-wrt-phase)
- ((add-lifted-require!116_0) add-lifted-require!)
- ((temp117_1)
- (lambda (s_507 phase_128 require-lift-ctx_0)
- (require-spec-shift-for-syntax s_507)))
- ((temp118_1)
- (lambda (s_227 phase_129 require-lift-ctx_1)
- (wrap-form
- '#%require
- (if sc_34 (add-scope s_227 sc_34) s_227)
- phase_129))))
- (do-local-lift-to-module.1
- add-lifted-require!116_0
- expand-context-require-lifts114_0
- require-lift-context-wrt-phase115_0
- temp112_0
- #f
- temp113_0
- temp111_2
- temp118_1
- unsafe-undefined
- temp117_1
- who109_0
- temp110_2))))
- (let-values ((()
- (begin
- (with-continuation-mark
- current-expand-context
- #f
- (let-values ()
- (namespace-visit-available-modules!
- (expand-context-namespace ctx_65)
- (expand-context-phase ctx_65))))
- (values))))
- (let-values (((result-s_6) (if sc_34 (add-scope use-s_2 sc_34) use-s_2)))
- (begin
- (let-values (((obs_46) (expand-context-observer ctx_65)))
- (if obs_46
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_46
- 'lift-require
- added-s_3
- use-s_2
- result-s_6)))
- (void)))
- result-s_6)))))))))))))))
+ (lambda (s44_1 use-s45_0 new-scope?43_0)
+ (begin
+ 'syntax-local-lift-require
+ (let-values (((s_702) s44_1))
+ (let-values (((use-s_2) use-s45_0))
+ (let-values (((new-scope?_0) new-scope?43_0))
+ (let-values (((sc_39) (if new-scope?_0 (new-scope 'lifted-require) #f)))
+ (let-values (((ctx_72 added-s_3)
+ (let-values (((who110_0) 'syntax-local-lift-require)
+ ((temp111_1) (datum->syntax$1 #f s_702))
+ ((temp112_1) "could not find target context")
+ ((temp113_1) #f)
+ ((temp114_1)
+ (lambda ()
+ (if (syntax?$1 use-s_2)
+ (void)
+ (raise-argument-error
+ 'syntax-local-lift-require
+ "syntax?"
+ use-s_2))))
+ ((expand-context-require-lifts115_0)
+ expand-context-require-lifts)
+ ((require-lift-context-wrt-phase116_0)
+ require-lift-context-wrt-phase)
+ ((add-lifted-require!117_0) add-lifted-require!)
+ ((temp118_1)
+ (lambda (s_703 phase_157 require-lift-ctx_0)
+ (require-spec-shift-for-syntax s_703)))
+ ((temp119_1)
+ (lambda (s_704 phase_158 require-lift-ctx_1)
+ (wrap-form
+ '#%require
+ (if sc_39 (add-scope s_704 sc_39) s_704)
+ phase_158))))
+ (do-local-lift-to-module.1
+ add-lifted-require!117_0
+ expand-context-require-lifts115_0
+ require-lift-context-wrt-phase116_0
+ temp113_1
+ #f
+ temp114_1
+ temp112_1
+ temp119_1
+ unsafe-undefined
+ temp118_1
+ who110_0
+ temp111_1))))
+ (let-values ((()
+ (begin
+ (with-continuation-mark
+ current-expand-context
+ #f
+ (namespace-visit-available-modules!
+ (expand-context-namespace ctx_72)
+ (expand-context-phase ctx_72)))
+ (values))))
+ (let-values (((result-s_6) (if sc_39 (add-scope use-s_2 sc_39) use-s_2)))
+ (begin
+ (let-values (((obs_48) (expand-context-observer ctx_72)))
+ (if obs_48
+ (call-expand-observe obs_48 'lift-require added-s_3 use-s_2 result-s_6)
+ (void)))
+ result-s_6))))))))))))
(case-lambda
- ((s_508 use-s_3) (begin 'syntax-local-lift-require (syntax-local-lift-require_0 s_508 use-s_3 #t)))
- ((s_140 use-s_4 new-scope?43_1) (syntax-local-lift-require_0 s_140 use-s_4 new-scope?43_1)))))
+ ((s_705 use-s_3) (begin 'syntax-local-lift-require (syntax-local-lift-require_0 s_705 use-s_3 #t)))
+ ((s_706 use-s_4 new-scope?43_1) (syntax-local-lift-require_0 s_706 use-s_4 new-scope?43_1)))))
(define-values
(1/syntax-local-lift-provide)
- (lambda (s_509)
+ (lambda (s_707)
(begin
'syntax-local-lift-provide
- (let-values ()
- (let-values ()
- (let-values (((ctx_66 result-s_7)
- (let-values (((who120_1) 'syntax-local-lift-provide)
- ((s121_0) s_509)
- ((temp122_0) "not expanding in a module run-time body")
- ((expand-context-to-module-lifts123_0) expand-context-to-module-lifts)
- ((to-module-lift-context-wrt-phase124_0) to-module-lift-context-wrt-phase)
- ((add-lifted-to-module-provide!125_0) add-lifted-to-module-provide!)
- ((temp126_1)
- (lambda (s_143 phase_130 to-module-lift-ctx_0) (wrap-form 'for-syntax s_143 #f)))
- ((temp127_0)
- (lambda (s_510 phase_36 to-module-lift-ctx_1)
- (wrap-form '#%provide s_510 phase_36))))
- (do-local-lift-to-module.1
- add-lifted-to-module-provide!125_0
- expand-context-to-module-lifts123_0
- to-module-lift-context-wrt-phase124_0
- #t
- #f
- void
- temp122_0
- temp127_0
- unsafe-undefined
- temp126_1
- who120_1
- s121_0))))
- (let-values (((obs_47) (expand-context-observer ctx_66)))
- (if obs_47
- (let-values () (let-values () (call-expand-observe obs_47 'lift-provide result-s_7)))
- (void)))))))))
+ (let-values (((ctx_73 result-s_7)
+ (let-values (((who121_0) 'syntax-local-lift-provide)
+ ((s122_0) s_707)
+ ((temp123_0) "not expanding in a module run-time body")
+ ((expand-context-to-module-lifts124_0) expand-context-to-module-lifts)
+ ((to-module-lift-context-wrt-phase125_0) to-module-lift-context-wrt-phase)
+ ((add-lifted-to-module-provide!126_0) add-lifted-to-module-provide!)
+ ((temp127_0)
+ (lambda (s_708 phase_159 to-module-lift-ctx_0) (wrap-form 'for-syntax s_708 #f)))
+ ((temp128_2)
+ (lambda (s_709 phase_160 to-module-lift-ctx_1)
+ (wrap-form '#%provide s_709 phase_160))))
+ (do-local-lift-to-module.1
+ add-lifted-to-module-provide!126_0
+ expand-context-to-module-lifts124_0
+ to-module-lift-context-wrt-phase125_0
+ #t
+ #f
+ void
+ temp123_0
+ temp128_2
+ unsafe-undefined
+ temp127_0
+ who121_0
+ s122_0))))
+ (let-values (((obs_49) (expand-context-observer ctx_73)))
+ (if obs_49 (call-expand-observe obs_49 'lift-provide result-s_7) (void)))))))
(define-values
(1/syntax-local-lift-module-end-declaration)
- (lambda (s_511)
+ (lambda (s_710)
(begin
'syntax-local-lift-module-end-declaration
- (let-values ()
- (let-values ()
- (let-values (((ctx_67 also-s_0)
- (let-values (((who129_0) 'syntax-local-lift-module-end-declaration)
- ((s130_0) s_511)
- ((temp131_1) 'lift-end-decl)
- ((temp132_3)
- "not currently transforming an expression within a module declaration")
- ((expand-context-to-module-lifts133_0) expand-context-to-module-lifts)
- ((temp134_1) (lambda (lift-ctx_5) 0))
- ((add-lifted-to-module-end!135_0) add-lifted-to-module-end!)
- ((temp136_2)
- (lambda (orig-s_37 phase_131 to-module-lift-ctx_2)
- (if (to-module-lift-context-end-as-expressions? to-module-lift-ctx_2)
- (wrap-form '#%expression orig-s_37 phase_131)
- orig-s_37)))
- ((temp137_1)
- (lambda (s_238 phase_132 to-module-lift-ctx_3)
- (wrap-form 'begin-for-syntax s_238 phase_132))))
- (do-local-lift-to-module.1
- add-lifted-to-module-end!135_0
- expand-context-to-module-lifts133_0
- temp134_1
- #t
- temp131_1
- void
- temp132_3
- unsafe-undefined
- temp136_2
- temp137_1
- who129_0
- s130_0))))
- (void)))))))
+ (let-values (((ctx_74 also-s_0)
+ (let-values (((who130_0) 'syntax-local-lift-module-end-declaration)
+ ((s131_0) s_710)
+ ((temp132_2) 'lift-end-decl)
+ ((temp133_1) "not currently transforming an expression within a module declaration")
+ ((expand-context-to-module-lifts134_0) expand-context-to-module-lifts)
+ ((temp135_0) (lambda (lift-ctx_5) 0))
+ ((add-lifted-to-module-end!136_0) add-lifted-to-module-end!)
+ ((temp137_2)
+ (lambda (orig-s_38 phase_161 to-module-lift-ctx_2)
+ (if (to-module-lift-context-end-as-expressions? to-module-lift-ctx_2)
+ (wrap-form '#%expression orig-s_38 phase_161)
+ orig-s_38)))
+ ((temp138_1)
+ (lambda (s_711 phase_162 to-module-lift-ctx_3)
+ (wrap-form 'begin-for-syntax s_711 phase_162))))
+ (do-local-lift-to-module.1
+ add-lifted-to-module-end!136_0
+ expand-context-to-module-lifts134_0
+ temp135_0
+ #t
+ temp132_2
+ void
+ temp133_1
+ unsafe-undefined
+ temp137_2
+ temp138_1
+ who130_0
+ s131_0))))
+ (void)))))
(define-values
(wrap-form)
- (lambda (sym_81 s_355 phase_133)
+ (lambda (sym_99 s_712 phase_163)
(begin
(datum->syntax$1
#f
- (list (datum->syntax$1 (if phase_133 (syntax-shift-phase-level$1 core-stx phase_133) #f) sym_81) s_355)))))
+ (list (datum->syntax$1 (if phase_163 (syntax-shift-phase-level$1 core-stx phase_163) #f) sym_99) s_712)))))
(define-values
(1/syntax-local-module-defined-identifiers)
(lambda ()
(begin
'syntax-local-module-defined-identifiers
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/syntax-local-transforming-module-provides?)
- (void)
- (let-values ()
- (raise-arguments-error
- 'syntax-local-module-defined-identifiers
- "not currently transforming module provides")))
- (values))))
- (let-values (((ctx_68)
- (let-values (((temp139_0) 'syntax-local-module-defined-identifiers))
- (get-current-expand-context.1 #f temp139_0))))
- (requireds->phase-ht (extract-module-definitions (expand-context-requires+provides ctx_68))))))))))
+ (let-values ((()
+ (begin
+ (if (1/syntax-local-transforming-module-provides?)
+ (void)
+ (raise-arguments-error
+ 'syntax-local-module-defined-identifiers
+ "not currently transforming module provides"))
+ (values))))
+ (let-values (((ctx_75)
+ (let-values (((temp140_1) 'syntax-local-module-defined-identifiers))
+ (get-current-expand-context.1 #f temp140_1))))
+ (requireds->phase-ht (extract-module-definitions (expand-context-requires+provides ctx_75))))))))
(define-values
(1/syntax-local-module-required-identifiers)
- (lambda (mod-path_8 phase+space-shift_10)
+ (lambda (mod-path_9 phase+space-shift_10)
(begin
'syntax-local-module-required-identifiers
- (let-values ()
- (let-values ()
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_497) (not mod-path_9)))
+ (if or-part_497 or-part_497 (1/module-path? mod-path_9)))
+ (void)
+ (raise-argument-error
+ 'syntax-local-module-required-identifiers
+ "(or/c module-path? #f)"
+ mod-path_9))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_498) (eq? phase+space-shift_10 #t)))
+ (if or-part_498 or-part_498 (phase+space-shift? phase+space-shift_10)))
+ (void)
+ (raise-argument-error
+ 'syntax-local-module-required-identifiers
+ (format "(or/c ~a #t)" phase+space-shift?-string)
+ phase+space-shift_10))
+ (values))))
(let-values ((()
(begin
- (if (let-values (((or-part_305) (not mod-path_8)))
- (if or-part_305 or-part_305 (1/module-path? mod-path_8)))
+ (if (1/syntax-local-transforming-module-provides?)
(void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-module-required-identifiers
- "(or/c module-path? #f)"
- mod-path_8)))
+ (raise-arguments-error
+ 'syntax-local-module-required-identifiers
+ "not currently transforming module provides"))
(values))))
- (let-values ((()
- (begin
- (if (let-values (((or-part_306) (eq? phase+space-shift_10 #t)))
- (if or-part_306 or-part_306 (phase+space-shift? phase+space-shift_10)))
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-module-required-identifiers
- (format "(or/c ~a #t)" phase+space-shift?-string)
- phase+space-shift_10)))
- (values))))
- (let-values ((()
- (begin
- (if (1/syntax-local-transforming-module-provides?)
- (void)
- (let-values ()
- (raise-arguments-error
- 'syntax-local-module-required-identifiers
- "not currently transforming module provides")))
- (values))))
- (let-values (((ctx_30)
- (let-values (((temp141_0) 'syntax-local-module-required-identifiers))
- (get-current-expand-context.1 #f temp141_0))))
- (let-values (((requires+provides_6) (expand-context-requires+provides ctx_30)))
- (let-values (((mpi_54) (if mod-path_8 (module-path->mpi/context mod-path_8 ctx_30) #f)))
- (let-values (((requireds_0)
- (extract-all-module-requires
- requires+provides_6
- mpi_54
- (if (eq? phase+space-shift_10 #t)
- 'all
- (intern-phase+space-shift phase+space-shift_10)))))
- (if requireds_0
- (reverse$1
- (let-values (((ht_0) (requireds->phase-ht requireds_0)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_0)))
- ((letrec-values (((for-loop_154)
- (lambda (fold-var_147 i_134)
- (begin
- 'for-loop
- (if i_134
- (let-values (((phase+space-shift_11 ids_30)
- (hash-iterate-key+value ht_0 i_134)))
- (let-values (((fold-var_275)
- (let-values (((fold-var_276) fold-var_147))
- (let-values (((fold-var_277)
- (let-values ()
- (cons
- (let-values ()
- (cons
- phase+space-shift_11
- ids_30))
- fold-var_276))))
- (values fold-var_277)))))
- (if (not #f)
- (for-loop_154 fold-var_275 (hash-iterate-next ht_0 i_134))
- fold-var_275)))
- fold-var_147)))))
- for-loop_154)
- null
- (hash-iterate-first ht_0)))))
- #f)))))))))))))
+ (let-values (((ctx_76)
+ (let-values (((temp142_1) 'syntax-local-module-required-identifiers))
+ (get-current-expand-context.1 #f temp142_1))))
+ (let-values (((requires+provides_6) (expand-context-requires+provides ctx_76)))
+ (let-values (((mpi_75) (if mod-path_9 (module-path->mpi/context mod-path_9 ctx_76) #f)))
+ (let-values (((requireds_0)
+ (extract-all-module-requires
+ requires+provides_6
+ mpi_75
+ (if (eq? phase+space-shift_10 #t)
+ 'all
+ (intern-phase+space-shift phase+space-shift_10)))))
+ (if requireds_0
+ (reverse$1
+ (let-values (((fold-var_555) (let-values (((fold-var_556) null)) fold-var_556)))
+ (let-values (((ht_217) (requireds->phase-ht requireds_0)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_217))
+ ((letrec-values (((for-loop_419)
+ (lambda (fold-var_557 i_288)
+ (begin
+ 'for-loop
+ (if i_288
+ (let-values (((phase+space-shift_11 ids_32)
+ (hash-iterate-key+value ht_217 i_288)))
+ (let-values (((fold-var_558)
+ (let-values (((fold-var_559)
+ (cons
+ (cons phase+space-shift_11 ids_32)
+ fold-var_557)))
+ (values fold-var_559))))
+ (if (not #f)
+ (for-loop_419 fold-var_558 (hash-iterate-next ht_217 i_288))
+ fold-var_558)))
+ fold-var_557)))))
+ for-loop_419)
+ fold-var_555
+ (hash-iterate-first ht_217))))))
+ #f)))))))))))
(define-values
(requireds->phase-ht)
(lambda (requireds_1)
(begin
- (let-values (((lst_309) requireds_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_309)))
- ((letrec-values (((for-loop_280)
- (lambda (ht_3 lst_310)
- (begin
- 'for-loop
- (if (pair? lst_310)
- (let-values (((r_43) (unsafe-car lst_310)) ((rest_172) (unsafe-cdr lst_310)))
- (let-values (((ht_4)
- (let-values (((ht_161) ht_3))
- (let-values (((ht_162)
- (let-values ()
- (hash-update
- ht_161
- (required-phase+space r_43)
- (lambda (l_58) (cons (required-id r_43) l_58))
- null))))
- (values ht_162)))))
- (if (not #f) (for-loop_280 ht_4 rest_172) ht_4)))
- ht_3)))))
- for-loop_280)
- (hasheqv)
- lst_309))))))
+ (let-values (((ht_218) (let-values (((ht_219) (hasheqv))) ht_219)))
+ (let-values (((lst_510) requireds_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_510))
+ ((letrec-values (((for-loop_420)
+ (lambda (ht_220 lst_511)
+ (begin
+ 'for-loop
+ (if (pair? lst_511)
+ (let-values (((r_50) (unsafe-car lst_511)) ((rest_251) (unsafe-cdr lst_511)))
+ (let-values (((ht_221)
+ (let-values (((ht_222)
+ (hash-update
+ ht_220
+ (required-phase+space r_50)
+ (lambda (l_70) (cons (required-id r_50) l_70))
+ null)))
+ (values ht_222))))
+ (if (not #f) (for-loop_420 ht_221 rest_251) ht_221)))
+ ht_220)))))
+ for-loop_420)
+ ht_218
+ lst_510)))))))
(define-values
(1/syntax-local-module-exports)
- (lambda (mod-path_9)
+ (lambda (mod-path_10)
(begin
'syntax-local-module-exports
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (let-values (((or-part_307) (1/module-path? mod-path_9)))
- (if or-part_307
- or-part_307
- (if (syntax?$1 mod-path_9) (1/module-path? (syntax->datum$1 mod-path_9)) #f)))
- (void)
- (let-values ()
- (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_9)))
- (values))))
- (let-values (((ctx_69)
- (let-values (((temp143_0) 'syntax-local-module-exports))
- (get-current-expand-context.1 #f temp143_0))))
- (let-values (((ns_80) (expand-context-namespace ctx_69)))
- (let-values (((mod-name_20)
- (1/module-path-index-resolve
- (module-path->mpi/context
- (if (syntax?$1 mod-path_9) (syntax->datum$1 mod-path_9) mod-path_9)
- ctx_69)
- #t)))
- (let-values (((m_22) (namespace->module ns_80 mod-name_20)))
+ (let-values ((()
(begin
- (if m_22
+ (if (let-values (((or-part_499) (1/module-path? mod-path_10)))
+ (if or-part_499
+ or-part_499
+ (if (syntax?$1 mod-path_10) (1/module-path? (syntax->datum$1 mod-path_10)) #f)))
(void)
- (let-values () (raise-unknown-module-error 'syntax-local-module-exports mod-name_20)))
- (reverse$1
- (let-values (((ht_163) (module-provides m_22)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_163)))
- ((letrec-values (((for-loop_281)
- (lambda (fold-var_278 i_199)
- (begin
- 'for-loop
- (if i_199
- (let-values (((phase_134 syms_23)
- (hash-iterate-key+value ht_163 i_199)))
- (let-values (((fold-var_279)
- (let-values (((fold-var_280) fold-var_278))
- (let-values (((fold-var_281)
- (let-values ()
- (cons
- (let-values ()
- (cons
- phase_134
- (reverse$1
- (let-values (((ht_164)
- syms_23))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash-keys
- ht_164)))
- ((letrec-values (((for-loop_282)
- (lambda (fold-var_282
- i_200)
- (begin
- 'for-loop
- (if i_200
- (let-values (((sym_82)
- (hash-iterate-key
- ht_164
- i_200)))
- (let-values (((fold-var_283)
- (let-values (((fold-var_284)
- fold-var_282))
- (let-values (((fold-var_285)
- (let-values ()
- (cons
- (let-values ()
- sym_82)
- fold-var_284))))
- (values
- fold-var_285)))))
- (if (not
- #f)
- (for-loop_282
- fold-var_283
- (hash-iterate-next
- ht_164
- i_200))
- fold-var_283)))
- fold-var_282)))))
- for-loop_282)
- null
- (hash-iterate-first
- ht_164)))))))
- fold-var_280))))
- (values fold-var_281)))))
- (if (not #f)
- (for-loop_281 fold-var_279 (hash-iterate-next ht_163 i_199))
- fold-var_279)))
- fold-var_278)))))
- for-loop_281)
- null
- (hash-iterate-first ht_163))))))))))))))))
+ (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_10))
+ (values))))
+ (let-values (((ctx_77)
+ (let-values (((temp144_0) 'syntax-local-module-exports))
+ (get-current-expand-context.1 #f temp144_0))))
+ (let-values (((ns_94) (expand-context-namespace ctx_77)))
+ (let-values (((mod-name_21)
+ (1/module-path-index-resolve
+ (module-path->mpi/context
+ (if (syntax?$1 mod-path_10) (syntax->datum$1 mod-path_10) mod-path_10)
+ ctx_77)
+ #t)))
+ (let-values (((m_27) (namespace->module ns_94 mod-name_21)))
+ (begin
+ (if m_27 (void) (raise-unknown-module-error 'syntax-local-module-exports mod-name_21))
+ (reverse$1
+ (let-values (((fold-var_560) (let-values (((fold-var_561) null)) fold-var_561)))
+ (let-values (((ht_223) (module-provides m_27)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_223))
+ ((letrec-values (((for-loop_421)
+ (lambda (fold-var_562 i_289)
+ (begin
+ 'for-loop
+ (if i_289
+ (let-values (((phase_164 syms_31)
+ (hash-iterate-key+value ht_223 i_289)))
+ (let-values (((fold-var_563)
+ (let-values (((fold-var_564)
+ (cons
+ (cons
+ phase_164
+ (reverse$1
+ (let-values (((fold-var_565)
+ (let-values (((fold-var_566)
+ null))
+ fold-var_566)))
+ (let-values (((ht_224) syms_31))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash-keys ht_224))
+ ((letrec-values (((for-loop_422)
+ (lambda (fold-var_567
+ i_290)
+ (begin
+ 'for-loop
+ (if i_290
+ (let-values (((sym_100)
+ (hash-iterate-key
+ ht_224
+ i_290)))
+ (let-values (((fold-var_568)
+ (let-values (((fold-var_569)
+ (cons
+ sym_100
+ fold-var_567)))
+ (values
+ fold-var_569))))
+ (if (not
+ #f)
+ (for-loop_422
+ fold-var_568
+ (hash-iterate-next
+ ht_224
+ i_290))
+ fold-var_568)))
+ fold-var_567)))))
+ for-loop_422)
+ fold-var_565
+ (hash-iterate-first
+ ht_224)))))))
+ fold-var_562)))
+ (values fold-var_564))))
+ (if (not #f)
+ (for-loop_421 fold-var_563 (hash-iterate-next ht_223 i_289))
+ fold-var_563)))
+ fold-var_562)))))
+ for-loop_421)
+ fold-var_560
+ (hash-iterate-first ht_223)))))))))))))))
(define-values
(1/syntax-local-submodules)
(lambda ()
(begin
'syntax-local-submodules
- (let-values ()
- (let-values ()
- (let-values (((ctx_70)
- (let-values (((who145_0) 'syntax-local-submodules))
- (get-current-expand-context.1 #f who145_0))))
- (let-values (((submods_3) (expand-context-declared-submodule-names ctx_70)))
- (reverse$1
- (let-values (((ht_165) submods_3))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_165)))
- ((letrec-values (((for-loop_283)
- (lambda (fold-var_286 i_201)
- (begin
- 'for-loop
- (if i_201
- (let-values (((name_70 kind_10) (hash-iterate-key+value ht_165 i_201)))
- (let-values (((fold-var_287)
- (let-values (((fold-var_288) fold-var_286))
- (if (eq? kind_10 'module)
- (let-values (((fold-var_289) fold-var_288))
- (let-values (((fold-var_290)
- (let-values ()
- (cons
- (let-values () name_70)
- fold-var_289))))
- (values fold-var_290)))
- fold-var_288))))
- (if (not #f)
- (for-loop_283 fold-var_287 (hash-iterate-next ht_165 i_201))
- fold-var_287)))
- fold-var_286)))))
- for-loop_283)
- null
- (hash-iterate-first ht_165))))))))))))
+ (let-values (((ctx_78)
+ (let-values (((who146_0) 'syntax-local-submodules)) (get-current-expand-context.1 #f who146_0))))
+ (let-values (((submods_3) (expand-context-declared-submodule-names ctx_78)))
+ (reverse$1
+ (let-values (((fold-var_570) (let-values (((fold-var_571) null)) fold-var_571)))
+ (let-values (((ht_225) submods_3))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_225))
+ ((letrec-values (((for-loop_423)
+ (lambda (fold-var_572 i_291)
+ (begin
+ 'for-loop
+ (if i_291
+ (let-values (((name_81 kind_10) (hash-iterate-key+value ht_225 i_291)))
+ (let-values (((fold-var_573)
+ (if (eq? kind_10 'module)
+ (let-values (((fold-var_574) (cons name_81 fold-var_572)))
+ (values fold-var_574))
+ fold-var_572)))
+ (if (not #f)
+ (for-loop_423 fold-var_573 (hash-iterate-next ht_225 i_291))
+ fold-var_573)))
+ fold-var_572)))))
+ for-loop_423)
+ fold-var_570
+ (hash-iterate-first ht_225)))))))))))
(define-values
(1/syntax-local-module-interned-scope-symbols)
(lambda ()
(begin
'syntax-local-module-interned-scope-symbols
- (let-values ()
- (let-values ()
- (begin
- (void
- (let-values (((who147_0) 'syntax-local-module-interned-scope-symbols))
- (get-current-expand-context.1 #f who147_0)))
- (interned-scope-symbols)))))))
+ (begin
+ (void
+ (let-values (((who148_0) 'syntax-local-module-interned-scope-symbols))
+ (get-current-expand-context.1 #f who148_0)))
+ (interned-scope-symbols)))))
(define-values
(syntax-local-expand-observer)
(lambda ()
(begin
- (let-values ()
- (let-values ()
- (let-values (((ctx_71)
- (let-values (((temp149_2) 'syntax-local-expand-observer))
- (get-current-expand-context.1 #f temp149_2))))
- (expand-context-observer ctx_71)))))))
+ (let-values (((ctx_79)
+ (let-values (((temp150_1) 'syntax-local-expand-observer))
+ (get-current-expand-context.1 #f temp150_1))))
+ (expand-context-observer ctx_79)))))
(define-values
(1/syntax-local-get-shadower)
(let-values (((syntax-local-get-shadower_0)
(lambda (id47_0 only-generated?46_0)
(begin
'syntax-local-get-shadower
- (let-values (((id_103) id47_0))
+ (let-values (((id_116) id47_0))
(let-values ()
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (identifier? id_103)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-get-shadower
- "identifier?"
- id_103)))
- (values))))
- (let-values (((ctx_72)
- (let-values (((who151_1) 'syntax-local-get-shadower))
- (get-current-expand-context.1 #f who151_1))))
- (let-values (((new-id_1) (add-scopes id_103 (expand-context-scopes ctx_72))))
- (if (syntax-clean? id_103) new-id_1 (syntax-taint$1 new-id_1))))))))))))))
+ (let-values ((()
+ (begin
+ (if (identifier? id_116)
+ (void)
+ (raise-argument-error 'syntax-local-get-shadower "identifier?" id_116))
+ (values))))
+ (let-values (((ctx_80)
+ (let-values (((who152_0) 'syntax-local-get-shadower))
+ (get-current-expand-context.1 #f who152_0))))
+ (let-values (((new-id_1) (add-scopes id_116 (expand-context-scopes ctx_80))))
+ (if (syntax-clean? id_116) new-id_1 (syntax-taint$1 new-id_1)))))))))))
(case-lambda
- ((id_104) (begin 'syntax-local-get-shadower (syntax-local-get-shadower_0 id_104 #f)))
- ((id_105 only-generated?46_1) (syntax-local-get-shadower_0 id_105 only-generated?46_1)))))
+ ((id_117) (begin 'syntax-local-get-shadower (syntax-local-get-shadower_0 id_117 #f)))
+ ((id_118 only-generated?46_1) (syntax-local-get-shadower_0 id_118 only-generated?46_1)))))
(define-values
(1/syntax-source)
- (lambda (s_48)
+ (lambda (s_713)
(begin
'syntax-source
(let-values ((()
(begin
- (if (syntax?$1 s_48) (void) (let-values () (raise-argument-error 'syntax-source "syntax?" s_48)))
+ (if (syntax?$1 s_713) (void) (raise-argument-error 'syntax-source "syntax?" s_713))
(values))))
- (let-values (((srcloc_10) (syntax-srcloc$1 s_48))) (if srcloc_10 (srcloc-source srcloc_10) #f))))))
+ (let-values (((srcloc_10) (syntax-srcloc$1 s_713))) (if srcloc_10 (srcloc-source srcloc_10) #f))))))
(define-values
(1/syntax-line)
- (lambda (s_512)
+ (lambda (s_714)
(begin
'syntax-line
(let-values ((()
- (begin
- (if (syntax?$1 s_512) (void) (let-values () (raise-argument-error 'syntax-line "syntax?" s_512)))
- (values))))
- (let-values (((srcloc_11) (syntax-srcloc$1 s_512))) (if srcloc_11 (srcloc-line srcloc_11) #f))))))
+ (begin (if (syntax?$1 s_714) (void) (raise-argument-error 'syntax-line "syntax?" s_714)) (values))))
+ (let-values (((srcloc_11) (syntax-srcloc$1 s_714))) (if srcloc_11 (srcloc-line srcloc_11) #f))))))
(define-values
(1/syntax-column)
- (lambda (s_47)
+ (lambda (s_715)
(begin
'syntax-column
(let-values ((()
(begin
- (if (syntax?$1 s_47) (void) (let-values () (raise-argument-error 'syntax-column "syntax?" s_47)))
+ (if (syntax?$1 s_715) (void) (raise-argument-error 'syntax-column "syntax?" s_715))
(values))))
- (let-values (((srcloc_12) (syntax-srcloc$1 s_47))) (if srcloc_12 (srcloc-column srcloc_12) #f))))))
+ (let-values (((srcloc_12) (syntax-srcloc$1 s_715))) (if srcloc_12 (srcloc-column srcloc_12) #f))))))
(define-values
(1/syntax-position)
- (lambda (s_5)
+ (lambda (s_716)
(begin
'syntax-position
(let-values ((()
(begin
- (if (syntax?$1 s_5) (void) (let-values () (raise-argument-error 'syntax-position "syntax?" s_5)))
+ (if (syntax?$1 s_716) (void) (raise-argument-error 'syntax-position "syntax?" s_716))
(values))))
- (let-values (((srcloc_13) (syntax-srcloc$1 s_5))) (if srcloc_13 (srcloc-position srcloc_13) #f))))))
+ (let-values (((srcloc_13) (syntax-srcloc$1 s_716))) (if srcloc_13 (srcloc-position srcloc_13) #f))))))
(define-values
(1/syntax-span)
- (lambda (s_180)
+ (lambda (s_717)
(begin
'syntax-span
(let-values ((()
- (begin
- (if (syntax?$1 s_180) (void) (let-values () (raise-argument-error 'syntax-span "syntax?" s_180)))
- (values))))
- (let-values (((srcloc_14) (syntax-srcloc$1 s_180))) (if srcloc_14 (srcloc-span srcloc_14) #f))))))
+ (begin (if (syntax?$1 s_717) (void) (raise-argument-error 'syntax-span "syntax?" s_717)) (values))))
+ (let-values (((srcloc_14) (syntax-srcloc$1 s_717))) (if srcloc_14 (srcloc-span srcloc_14) #f))))))
(define-values
(encoded-srcloc?)
- (lambda (v_166)
+ (lambda (v_282)
(begin
- (let-values (((or-part_308)
- (if (list? v_166) (if (= (length v_166) 5) (srcloc-vector? (list->vector v_166)) #f) #f)))
- (if or-part_308
- or-part_308
- (if (vector? v_166) (if (= (vector-length v_166) 5) (srcloc-vector? v_166) #f) #f))))))
+ (let-values (((or-part_500)
+ (if (list? v_282) (if (= (length v_282) 5) (srcloc-vector? (list->vector v_282)) #f) #f)))
+ (if or-part_500
+ or-part_500
+ (if (vector? v_282) (if (= (vector-length v_282) 5) (srcloc-vector? v_282) #f) #f))))))
(define-values
(srcloc-vector?)
- (lambda (v_32)
- (begin
- (if (let-values (((or-part_4) (not (vector-ref v_32 1))))
- (if or-part_4 or-part_4 (exact-positive-integer? (vector-ref v_32 1))))
- (if (let-values (((or-part_5) (not (vector-ref v_32 2))))
- (if or-part_5 or-part_5 (exact-nonnegative-integer? (vector-ref v_32 2))))
- (if (let-values (((or-part_6) (not (vector-ref v_32 3))))
- (if or-part_6 or-part_6 (exact-positive-integer? (vector-ref v_32 3))))
- (let-values (((or-part_7) (not (vector-ref v_32 4))))
- (if or-part_7 or-part_7 (exact-nonnegative-integer? (vector-ref v_32 4))))
+ (lambda (v_283)
+ (begin
+ (if (let-values (((or-part_501) (not (vector-ref v_283 1))))
+ (if or-part_501 or-part_501 (exact-positive-integer? (vector-ref v_283 1))))
+ (if (let-values (((or-part_502) (not (vector-ref v_283 2))))
+ (if or-part_502 or-part_502 (exact-nonnegative-integer? (vector-ref v_283 2))))
+ (if (let-values (((or-part_503) (not (vector-ref v_283 3))))
+ (if or-part_503 or-part_503 (exact-positive-integer? (vector-ref v_283 3))))
+ (let-values (((or-part_504) (not (vector-ref v_283 4))))
+ (if or-part_504 or-part_504 (exact-nonnegative-integer? (vector-ref v_283 4))))
#f)
#f)
#f))))
(define-values
(to-srcloc-stx)
- (lambda (v_66)
+ (lambda (v_284)
(begin
- (if (srcloc? v_66)
- (let-values ()
- (let-values (((the-struct_64) empty-syntax))
- (if (syntax?$1 the-struct_64)
- (let-values (((srcloc1_4) v_66))
- (syntax2.1
- (syntax-content* the-struct_64)
- (syntax-scopes the-struct_64)
- (syntax-shifted-multi-scopes the-struct_64)
- (syntax-mpi-shifts the-struct_64)
- srcloc1_4
- (syntax-props the-struct_64)
- (syntax-inspector the-struct_64)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_64))))
- (if (pair? v_66)
- (let-values () (to-srcloc-stx (list->vector v_66)))
- (if (vector? v_66)
- (let-values ()
- (let-values (((the-struct_65) empty-syntax))
- (if (syntax?$1 the-struct_65)
- (let-values (((srcloc2_0)
- (srcloc
- (vector-ref v_66 0)
- (vector-ref v_66 1)
- (vector-ref v_66 2)
- (vector-ref v_66 3)
- (vector-ref v_66 4))))
- (syntax2.1
- (syntax-content* the-struct_65)
- (syntax-scopes the-struct_65)
- (syntax-shifted-multi-scopes the-struct_65)
- (syntax-mpi-shifts the-struct_65)
- srcloc2_0
- (syntax-props the-struct_65)
- (syntax-inspector the-struct_65)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_65))))
- (let-values () v_66)))))))
+ (if (srcloc? v_284)
+ (let-values (((the-struct_69) empty-syntax))
+ (if (syntax?$1 the-struct_69)
+ (let-values (((srcloc1_4) v_284))
+ (syntax2.1
+ (syntax-content* the-struct_69)
+ (syntax-scopes the-struct_69)
+ (syntax-shifted-multi-scopes the-struct_69)
+ (syntax-mpi-shifts the-struct_69)
+ srcloc1_4
+ (syntax-props the-struct_69)
+ (syntax-inspector the-struct_69)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_69)))
+ (if (pair? v_284)
+ (to-srcloc-stx (list->vector v_284))
+ (if (vector? v_284)
+ (let-values (((the-struct_70) empty-syntax))
+ (if (syntax?$1 the-struct_70)
+ (let-values (((srcloc2_0)
+ (srcloc
+ (vector-ref v_284 0)
+ (vector-ref v_284 1)
+ (vector-ref v_284 2)
+ (vector-ref v_284 3)
+ (vector-ref v_284 4))))
+ (syntax2.1
+ (syntax-content* the-struct_70)
+ (syntax-scopes the-struct_70)
+ (syntax-shifted-multi-scopes the-struct_70)
+ (syntax-mpi-shifts the-struct_70)
+ srcloc2_0
+ (syntax-props the-struct_70)
+ (syntax-inspector the-struct_70)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_70)))
+ v_284))))))
(define-values
(1/syntax-e)
- (lambda (s_0)
+ (lambda (s_718)
(begin
'syntax-e
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_0) (void) (let-values () (raise-argument-error 'syntax-e "syntax?" s_0)))
- (syntax-e$1 s_0)))))))
+ (begin (if (syntax?$1 s_718) (void) (raise-argument-error 'syntax-e "syntax?" s_718)) (syntax-e$1 s_718)))))
(define-values
(1/syntax-srcloc)
- (lambda (s_10)
+ (lambda (s_719)
(begin
'syntax-srcloc
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_10) (void) (let-values () (raise-argument-error 'syntax-srcloc "syntax?" s_10)))
- (syntax-srcloc$1 s_10)))))))
+ (begin
+ (if (syntax?$1 s_719) (void) (raise-argument-error 'syntax-srcloc "syntax?" s_719))
+ (syntax-srcloc$1 s_719)))))
(define-values
(1/syntax->datum)
- (lambda (s_11)
+ (lambda (s_720)
(begin
'syntax->datum
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_11) (void) (let-values () (raise-argument-error 'syntax->datum "syntax?" s_11)))
- (syntax->datum$1 s_11)))))))
- (define-values (maybe-syntax->datum) (lambda (s_325) (begin (if (syntax?$1 s_325) (syntax->datum$1 s_325) s_325))))
+ (begin
+ (if (syntax?$1 s_720) (void) (raise-argument-error 'syntax->datum "syntax?" s_720))
+ (syntax->datum$1 s_720)))))
+ (define-values (maybe-syntax->datum) (lambda (s_721) (begin (if (syntax?$1 s_721) (syntax->datum$1 s_721) s_721))))
(define-values
(1/datum->syntax)
(let-values (((datum->syntax_1)
@@ -51085,59 +50389,51 @@
(begin
'datum->syntax
(let-values (((stx-c_5) stx-c4_0))
- (let-values (((s_513) s5_3))
+ (let-values (((s_722) s5_3))
(let-values (((stx-l_3) stx-l1_0))
(let-values (((stx-p_1) stx-p2_0))
(let-values ()
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (let-values (((or-part_34) (not stx-c_5)))
- (if or-part_34 or-part_34 (syntax?$1 stx-c_5)))
- (void)
- (let-values ()
- (raise-argument-error 'datum->syntax "(or/c #f syntax?)" stx-c_5)))
- (if (let-values (((or-part_85) (not stx-l_3)))
- (if or-part_85
- or-part_85
- (let-values (((or-part_74) (syntax?$1 stx-l_3)))
- (if or-part_74
- or-part_74
- (let-values (((or-part_86) (srcloc? stx-l_3)))
- (if or-part_86 or-part_86 (encoded-srcloc? stx-l_3)))))))
- (void)
- (let-values ()
- (raise-argument-error
- 'datum->syntax
- (string-append
- "(or/c #f syntax?\n"
- " srcloc?\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-l_3)))
- (if (let-values (((or-part_75) (not stx-p_1)))
- (if or-part_75 or-part_75 (syntax?$1 stx-p_1)))
- (void)
- (let-values ()
- (raise-argument-error 'datum->syntax "(or/c #f syntax?)" stx-p_1)))
- (datum->syntax$1 stx-c_5 s_513 (to-srcloc-stx stx-l_3) stx-p_1))))))))))))))
+ (begin
+ (if (let-values (((or-part_505) (not stx-c_5)))
+ (if or-part_505 or-part_505 (syntax?$1 stx-c_5)))
+ (void)
+ (raise-argument-error 'datum->syntax "(or/c #f syntax?)" stx-c_5))
+ (if (let-values (((or-part_506) (not stx-l_3)))
+ (if or-part_506
+ or-part_506
+ (let-values (((or-part_507) (syntax?$1 stx-l_3)))
+ (if or-part_507
+ or-part_507
+ (let-values (((or-part_508) (srcloc? stx-l_3)))
+ (if or-part_508 or-part_508 (encoded-srcloc? stx-l_3)))))))
+ (void)
+ (raise-argument-error
+ 'datum->syntax
+ (string-append
+ "(or/c #f syntax?\n"
+ " srcloc?\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-l_3))
+ (if (let-values (((or-part_509) (not stx-p_1)))
+ (if or-part_509 or-part_509 (syntax?$1 stx-p_1)))
+ (void)
+ (raise-argument-error 'datum->syntax "(or/c #f syntax?)" stx-p_1))
+ (datum->syntax$1 stx-c_5 s_722 (to-srcloc-stx stx-l_3) stx-p_1)))))))))))
(case-lambda
- ((stx-c_6 s_514) (begin 'datum->syntax (datum->syntax_1 stx-c_6 s_514 #f #f #f)))
- ((stx-c_7 s_515 stx-l_4 stx-p_2 ignored3_1) (datum->syntax_1 stx-c_7 s_515 stx-l_4 stx-p_2 ignored3_1))
- ((stx-c_8 s_516 stx-l_5 stx-p2_1) (datum->syntax_1 stx-c_8 s_516 stx-l_5 stx-p2_1 #f))
- ((stx-c_9 s_177 stx-l1_1) (datum->syntax_1 stx-c_9 s_177 stx-l1_1 #f #f)))))
- (define-values
- (1/syntax-binding-set)
- (lambda () (begin 'syntax-binding-set (let-values () (let-values () (syntax-binding-set1.1 null))))))
+ ((stx-c_6 s_723) (begin 'datum->syntax (datum->syntax_1 stx-c_6 s_723 #f #f #f)))
+ ((stx-c_7 s_724 stx-l_4 stx-p_2 ignored3_1) (datum->syntax_1 stx-c_7 s_724 stx-l_4 stx-p_2 ignored3_1))
+ ((stx-c_8 s_725 stx-l_5 stx-p2_1) (datum->syntax_1 stx-c_8 s_725 stx-l_5 stx-p2_1 #f))
+ ((stx-c_9 s_726 stx-l1_1) (datum->syntax_1 stx-c_9 s_726 stx-l1_1 #f #f)))))
+ (define-values (1/syntax-binding-set) (lambda () (begin 'syntax-binding-set (syntax-binding-set1.1 null))))
(define-values
(1/syntax-binding-set-extend)
(let-values (((syntax-binding-set-extend_0)
@@ -51157,125 +50453,99 @@
(let-values (((bs_4) bs13_0))
(let-values (((as-sym_1) as-sym14_0))
(let-values (((as-phase_1) as-phase15_0))
- (let-values (((mpi_55) mpi16_0))
- (let-values (((sym_63) (if (eq? sym6_2 unsafe-undefined) as-sym_1 sym6_2)))
- (let-values (((phase_135) (if (eq? phase7_1 unsafe-undefined) as-phase_1 phase7_1)))
+ (let-values (((mpi_76) mpi16_0))
+ (let-values (((sym_101) (if (eq? sym6_2 unsafe-undefined) as-sym_1 sym6_2)))
+ (let-values (((phase_165) (if (eq? phase7_1 unsafe-undefined) as-phase_1 phase7_1)))
(let-values (((nominal-mpi_1)
- (if (eq? nominal-mpi8_0 unsafe-undefined) mpi_55 nominal-mpi8_0)))
+ (if (eq? nominal-mpi8_0 unsafe-undefined) mpi_76 nominal-mpi8_0)))
(let-values (((nominal-phase+space_4)
(if (eq? nominal-phase+space9_0 unsafe-undefined)
- phase_135
+ phase_165
nominal-phase+space9_0)))
(let-values (((nominal-sym_5)
- (if (eq? nominal-sym10_0 unsafe-undefined) sym_63 nominal-sym10_0)))
+ (if (eq? nominal-sym10_0 unsafe-undefined) sym_101 nominal-sym10_0)))
(let-values (((nominal-require-phase+space-shift_5)
nominal-require-phase+space-shift11_0))
(let-values (((insp_19) insp12_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (1/syntax-binding-set? bs_4)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- "syntax-binding-set?"
- bs_4)))
- (if (symbol? as-sym_1)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- "symbol?"
- as-sym_1)))
- (if (phase? as-phase_1)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- phase?-string
- as-phase_1)))
- (if (1/module-path-index? mpi_55)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- "module-path-index?"
- mpi_55)))
- (if (symbol? sym_63)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- "symbol?"
- sym_63)))
- (if (phase? phase_135)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- phase?-string
- phase_135)))
- (if (1/module-path-index? nominal-mpi_1)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- "module-path-index?"
- nominal-mpi_1)))
- (if (phase+space? nominal-phase+space_4)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- phase+space?-string
- nominal-phase+space_4)))
- (if (symbol? nominal-sym_5)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- "symbol?"
- nominal-sym_5)))
- (if (phase+space-shift? nominal-require-phase+space-shift_5)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- phase+space-shift?-string
- nominal-require-phase+space-shift_5)))
- (if ((lambda (x_94)
- (let-values (((or-part_309) (not x_94)))
- (if or-part_309 or-part_309 (inspector? x_94))))
- insp_19)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-binding-set-extend
- "(or/c inspector? #f)"
- insp_19)))
- (syntax-binding-set-extend$1
- bs_4
- as-sym_1
- as-phase_1
- mpi_55
- sym_63
- phase_135
- nominal-mpi_1
- (intern-phase+space nominal-phase+space_4)
- nominal-sym_5
- (intern-phase+space-shift nominal-require-phase+space-shift_5)
- insp_19))))))))))))))))))))
+ (begin
+ (if (1/syntax-binding-set? bs_4)
+ (void)
+ (raise-argument-error
+ 'syntax-binding-set-extend
+ "syntax-binding-set?"
+ bs_4))
+ (if (symbol? as-sym_1)
+ (void)
+ (raise-argument-error 'syntax-binding-set-extend "symbol?" as-sym_1))
+ (if (phase? as-phase_1)
+ (void)
+ (raise-argument-error
+ 'syntax-binding-set-extend
+ phase?-string
+ as-phase_1))
+ (if (1/module-path-index? mpi_76)
+ (void)
+ (raise-argument-error
+ 'syntax-binding-set-extend
+ "module-path-index?"
+ mpi_76))
+ (if (symbol? sym_101)
+ (void)
+ (raise-argument-error 'syntax-binding-set-extend "symbol?" sym_101))
+ (if (phase? phase_165)
+ (void)
+ (raise-argument-error 'syntax-binding-set-extend phase?-string phase_165))
+ (if (1/module-path-index? nominal-mpi_1)
+ (void)
+ (raise-argument-error
+ 'syntax-binding-set-extend
+ "module-path-index?"
+ nominal-mpi_1))
+ (if (phase+space? nominal-phase+space_4)
+ (void)
+ (raise-argument-error
+ 'syntax-binding-set-extend
+ phase+space?-string
+ nominal-phase+space_4))
+ (if (symbol? nominal-sym_5)
+ (void)
+ (raise-argument-error 'syntax-binding-set-extend "symbol?" nominal-sym_5))
+ (if (phase+space-shift? nominal-require-phase+space-shift_5)
+ (void)
+ (raise-argument-error
+ 'syntax-binding-set-extend
+ phase+space-shift?-string
+ nominal-require-phase+space-shift_5))
+ (if ((lambda (x_102)
+ (let-values (((or-part_510) (not x_102)))
+ (if or-part_510 or-part_510 (inspector? x_102))))
+ insp_19)
+ (void)
+ (raise-argument-error
+ 'syntax-binding-set-extend
+ "(or/c inspector? #f)"
+ insp_19))
+ (syntax-binding-set-extend$1
+ bs_4
+ as-sym_1
+ as-phase_1
+ mpi_76
+ sym_101
+ phase_165
+ nominal-mpi_1
+ (intern-phase+space nominal-phase+space_4)
+ nominal-sym_5
+ (intern-phase+space-shift nominal-require-phase+space-shift_5)
+ insp_19)))))))))))))))))
(case-lambda
- ((bs_5 as-sym_2 as-phase_2 mpi_56)
+ ((bs_5 as-sym_2 as-phase_2 mpi_77)
(begin
'syntax-binding-set-extend
(syntax-binding-set-extend_0
bs_5
as-sym_2
as-phase_2
- mpi_56
+ mpi_77
unsafe-undefined
unsafe-undefined
unsafe-undefined
@@ -51286,9 +50556,9 @@
((bs_6
as-sym_3
as-phase_3
- mpi_57
- sym_83
- phase_136
+ mpi_78
+ sym_102
+ phase_166
nominal-mpi_2
nominal-phase+space_5
nominal-sym_6
@@ -51298,9 +50568,9 @@
bs_6
as-sym_3
as-phase_3
- mpi_57
- sym_83
- phase_136
+ mpi_78
+ sym_102
+ phase_166
nominal-mpi_2
nominal-phase+space_5
nominal-sym_6
@@ -51309,9 +50579,9 @@
((bs_7
as-sym_4
as-phase_4
- mpi_58
- sym_52
- phase_23
+ mpi_79
+ sym_103
+ phase_167
nominal-mpi_3
nominal-phase+space_6
nominal-sym_7
@@ -51320,72 +50590,72 @@
bs_7
as-sym_4
as-phase_4
- mpi_58
- sym_52
- phase_23
+ mpi_79
+ sym_103
+ phase_167
nominal-mpi_3
nominal-phase+space_6
nominal-sym_7
nominal-require-phase+space-shift11_1
#f))
- ((bs_8 as-sym_5 as-phase_5 mpi_17 sym_84 phase_73 nominal-mpi_4 nominal-phase+space_7 nominal-sym10_1)
+ ((bs_8 as-sym_5 as-phase_5 mpi_80 sym_104 phase_168 nominal-mpi_4 nominal-phase+space_7 nominal-sym10_1)
(syntax-binding-set-extend_0
bs_8
as-sym_5
as-phase_5
- mpi_17
- sym_84
- phase_73
+ mpi_80
+ sym_104
+ phase_168
nominal-mpi_4
nominal-phase+space_7
nominal-sym10_1
0
#f))
- ((bs_9 as-sym_6 as-phase_6 mpi_59 sym_85 phase_137 nominal-mpi_5 nominal-phase+space9_1)
+ ((bs_9 as-sym_6 as-phase_6 mpi_81 sym_105 phase_169 nominal-mpi_5 nominal-phase+space9_1)
(syntax-binding-set-extend_0
bs_9
as-sym_6
as-phase_6
- mpi_59
- sym_85
- phase_137
+ mpi_81
+ sym_105
+ phase_169
nominal-mpi_5
nominal-phase+space9_1
unsafe-undefined
0
#f))
- ((bs_10 as-sym_7 as-phase_7 mpi_60 sym_62 phase_138 nominal-mpi8_1)
+ ((bs_10 as-sym_7 as-phase_7 mpi_82 sym_106 phase_170 nominal-mpi8_1)
(syntax-binding-set-extend_0
bs_10
as-sym_7
as-phase_7
- mpi_60
- sym_62
- phase_138
+ mpi_82
+ sym_106
+ phase_170
nominal-mpi8_1
unsafe-undefined
unsafe-undefined
0
#f))
- ((bs_11 as-sym_8 as-phase_8 mpi_1 sym_86 phase7_2)
+ ((bs_11 as-sym_8 as-phase_8 mpi_83 sym_107 phase7_2)
(syntax-binding-set-extend_0
bs_11
as-sym_8
as-phase_8
- mpi_1
- sym_86
+ mpi_83
+ sym_107
phase7_2
unsafe-undefined
unsafe-undefined
unsafe-undefined
0
#f))
- ((bs_12 as-sym_9 as-phase_9 mpi_4 sym6_3)
+ ((bs_12 as-sym_9 as-phase_9 mpi_84 sym6_3)
(syntax-binding-set-extend_0
bs_12
as-sym_9
as-phase_9
- mpi_4
+ mpi_84
sym6_3
unsafe-undefined
unsafe-undefined
@@ -51395,1305 +50665,1342 @@
#f)))))
(define-values
(1/syntax-binding-set->syntax)
- (lambda (bs_13 datum_3)
+ (lambda (bs_13 datum_4)
(begin
'syntax-binding-set->syntax
- (let-values ()
- (let-values ()
- (begin
- (if (1/syntax-binding-set? bs_13)
- (void)
- (let-values () (raise-argument-error 'syntax-binding-set->syntax "syntax-binding-set?" bs_13)))
- (syntax-binding-set->syntax$1 bs_13 datum_3)))))))
+ (begin
+ (if (1/syntax-binding-set? bs_13)
+ (void)
+ (raise-argument-error 'syntax-binding-set->syntax "syntax-binding-set?" bs_13))
+ (syntax-binding-set->syntax$1 bs_13 datum_4)))))
(define-values
(1/syntax->list)
- (lambda (s_332)
+ (lambda (s_727)
(begin
'syntax->list
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_332) (void) (let-values () (raise-argument-error 'syntax->list "syntax?" s_332)))
- (syntax->list$1 s_332)))))))
+ (begin
+ (if (syntax?$1 s_727) (void) (raise-argument-error 'syntax->list "syntax?" s_727))
+ (syntax->list$1 s_727)))))
(define-values
(1/syntax-original?)
- (lambda (s_517)
+ (lambda (s_728)
(begin
'syntax-original?
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_517) (void) (let-values () (raise-argument-error 'syntax-original? "syntax?" s_517)))
- (if (syntax-property$1 s_517 original-property-sym) (not (syntax-any-macro-scopes? s_517)) #f)))))))
+ (begin
+ (if (syntax?$1 s_728) (void) (raise-argument-error 'syntax-original? "syntax?" s_728))
+ (if (syntax-property$1 s_728 original-property-sym) (not (syntax-any-macro-scopes? s_728)) #f)))))
(define-values
(1/bound-identifier=?)
(let-values (((bound-identifier=?_0)
(lambda (a18_0 b19_0 phase17_1)
(begin
'bound-identifier=?
- (let-values (((a_50) a18_0))
- (let-values (((b_98) b19_0))
- (let-values (((phase_139)
+ (let-values (((a_56) a18_0))
+ (let-values (((b_132) b19_0))
+ (let-values (((phase_171)
(if (eq? phase17_1 unsafe-undefined) (1/syntax-local-phase-level) phase17_1)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? a_50)
- (void)
- (let-values () (raise-argument-error 'bound-identifier=? "identifier?" a_50)))
- (if (identifier? b_98)
- (void)
- (let-values () (raise-argument-error 'bound-identifier=? "identifier?" b_98)))
- (if (phase? phase_139)
- (void)
- (let-values () (raise-argument-error 'bound-identifier=? phase?-string phase_139)))
- (bound-identifier=?$1 a_50 b_98 phase_139))))))))))))
+ (begin
+ (if (identifier? a_56) (void) (raise-argument-error 'bound-identifier=? "identifier?" a_56))
+ (if (identifier? b_132)
+ (void)
+ (raise-argument-error 'bound-identifier=? "identifier?" b_132))
+ (if (phase? phase_171)
+ (void)
+ (raise-argument-error 'bound-identifier=? phase?-string phase_171))
+ (bound-identifier=?$1 a_56 b_132 phase_171)))))))))
(case-lambda
- ((a_51 b_99) (begin 'bound-identifier=? (bound-identifier=?_0 a_51 b_99 unsafe-undefined)))
- ((a_52 b_100 phase17_2) (bound-identifier=?_0 a_52 b_100 phase17_2)))))
+ ((a_57 b_133) (begin 'bound-identifier=? (bound-identifier=?_0 a_57 b_133 unsafe-undefined)))
+ ((a_58 b_134 phase17_2) (bound-identifier=?_0 a_58 b_134 phase17_2)))))
(define-values
(1/free-identifier=?)
(let-values (((free-identifier=?_0)
(lambda (a22_0 b23_0 a-phase20_0 b-phase21_0)
(begin
'free-identifier=?
- (let-values (((a_53) a22_0))
- (let-values (((b_101) b23_0))
+ (let-values (((a_59) a22_0))
+ (let-values (((b_135) b23_0))
(let-values (((a-phase_1)
(if (eq? a-phase20_0 unsafe-undefined) (1/syntax-local-phase-level) a-phase20_0)))
(let-values (((b-phase_1) (if (eq? b-phase21_0 unsafe-undefined) a-phase_1 b-phase21_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? a_53)
- (void)
- (let-values () (raise-argument-error 'free-identifier=? "identifier?" a_53)))
- (if (identifier? b_101)
- (void)
- (let-values () (raise-argument-error 'free-identifier=? "identifier?" b_101)))
- (if (phase? a-phase_1)
- (void)
- (let-values () (raise-argument-error 'free-identifier=? phase?-string a-phase_1)))
- (if (phase? b-phase_1)
- (void)
- (let-values () (raise-argument-error 'free-identifier=? phase?-string b-phase_1)))
- (free-identifier=?$1 a_53 b_101 a-phase_1 b-phase_1)))))))))))))
+ (begin
+ (if (identifier? a_59)
+ (void)
+ (raise-argument-error 'free-identifier=? "identifier?" a_59))
+ (if (identifier? b_135)
+ (void)
+ (raise-argument-error 'free-identifier=? "identifier?" b_135))
+ (if (phase? a-phase_1)
+ (void)
+ (raise-argument-error 'free-identifier=? phase?-string a-phase_1))
+ (if (phase? b-phase_1)
+ (void)
+ (raise-argument-error 'free-identifier=? phase?-string b-phase_1))
+ (free-identifier=?$1 a_59 b_135 a-phase_1 b-phase_1))))))))))
(case-lambda
- ((a_54 b_97) (begin 'free-identifier=? (free-identifier=?_0 a_54 b_97 unsafe-undefined unsafe-undefined)))
- ((a_55 b_102 a-phase_2 b-phase21_1) (free-identifier=?_0 a_55 b_102 a-phase_2 b-phase21_1))
- ((a_56 b_103 a-phase20_1) (free-identifier=?_0 a_56 b_103 a-phase20_1 unsafe-undefined)))))
+ ((a_60 b_136) (begin 'free-identifier=? (free-identifier=?_0 a_60 b_136 unsafe-undefined unsafe-undefined)))
+ ((a_61 b_137 a-phase_2 b-phase21_1) (free-identifier=?_0 a_61 b_137 a-phase_2 b-phase21_1))
+ ((a_62 b_138 a-phase20_1) (free-identifier=?_0 a_62 b_138 a-phase20_1 unsafe-undefined)))))
(define-values
(1/free-transformer-identifier=?)
- (lambda (a_57 b_104)
+ (lambda (a_63 b_139)
(begin
'free-transformer-identifier=?
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (identifier? a_57)
- (void)
- (let-values () (raise-argument-error 'free-transformer-identifier=? "identifier?" a_57)))
- (values))))
- (let-values ((()
- (begin
- (if (identifier? b_104)
- (void)
- (let-values () (raise-argument-error 'free-transformer-identifier=? "identifier?" b_104)))
- (values))))
- (let-values (((phase_140) (add1 (1/syntax-local-phase-level))))
- (free-identifier=?$1 a_57 b_104 phase_140 phase_140)))))))))
+ (let-values ((()
+ (begin
+ (if (identifier? a_63)
+ (void)
+ (raise-argument-error 'free-transformer-identifier=? "identifier?" a_63))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (identifier? b_139)
+ (void)
+ (raise-argument-error 'free-transformer-identifier=? "identifier?" b_139))
+ (values))))
+ (let-values (((phase_172) (add1 (1/syntax-local-phase-level))))
+ (free-identifier=?$1 a_63 b_139 phase_172 phase_172)))))))
(define-values
(1/free-template-identifier=?)
- (lambda (a_58 b_105)
+ (lambda (a_64 b_140)
(begin
'free-template-identifier=?
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (identifier? a_58)
- (void)
- (let-values () (raise-argument-error 'free-template-identifier=? "identifier?" a_58)))
- (values))))
- (let-values ((()
- (begin
- (if (identifier? b_105)
- (void)
- (let-values () (raise-argument-error 'free-template-identifier=? "identifier?" b_105)))
- (values))))
- (let-values (((phase_141) (sub1 (1/syntax-local-phase-level))))
- (free-identifier=?$1 a_58 b_105 phase_141 phase_141)))))))))
+ (let-values ((()
+ (begin
+ (if (identifier? a_64)
+ (void)
+ (raise-argument-error 'free-template-identifier=? "identifier?" a_64))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (identifier? b_140)
+ (void)
+ (raise-argument-error 'free-template-identifier=? "identifier?" b_140))
+ (values))))
+ (let-values (((phase_173) (sub1 (1/syntax-local-phase-level))))
+ (free-identifier=?$1 a_64 b_140 phase_173 phase_173)))))))
(define-values
(1/free-label-identifier=?)
- (lambda (a_59 b_106)
+ (lambda (a_65 b_141)
(begin
'free-label-identifier=?
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? a_59)
- (void)
- (let-values () (raise-argument-error 'free-label-identifier=? "identifier?" a_59)))
- (if (identifier? b_106)
- (void)
- (let-values () (raise-argument-error 'free-label-identifier=? "identifier?" b_106)))
- (free-identifier=?$1 a_59 b_106 #f #f)))))))
+ (begin
+ (if (identifier? a_65) (void) (raise-argument-error 'free-label-identifier=? "identifier?" a_65))
+ (if (identifier? b_141) (void) (raise-argument-error 'free-label-identifier=? "identifier?" b_141))
+ (free-identifier=?$1 a_65 b_141 #f #f)))))
(define-values
(1/identifier-binding)
(let-values (((identifier-binding_0)
(lambda (id27_1 phase24_0 top-level-symbol?25_0 exactly?26_0)
(begin
'identifier-binding
- (let-values (((id_106) id27_1))
- (let-values (((phase_7)
+ (let-values (((id_119) id27_1))
+ (let-values (((phase_174)
(if (eq? phase24_0 unsafe-undefined) (1/syntax-local-phase-level) phase24_0)))
(let-values (((top-level-symbol?_2) top-level-symbol?25_0))
- (let-values (((exactly?_5) exactly?26_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? id_106)
- (void)
- (let-values () (raise-argument-error 'identifier-binding "identifier?" id_106)))
- (if (phase? phase_7)
- (void)
- (let-values () (raise-argument-error 'identifier-binding phase?-string phase_7)))
- (let-values (((id61_2) id_106)
- ((phase62_2) phase_7)
- ((top-level-symbol?63_1) top-level-symbol?_2)
- ((exactly?64_0) exactly?_5))
- (identifier-binding.1
- exactly?64_0
- id61_2
- phase62_2
- top-level-symbol?63_1))))))))))))))
+ (let-values (((exactly?_7) exactly?26_0))
+ (begin
+ (if (identifier? id_119)
+ (void)
+ (raise-argument-error 'identifier-binding "identifier?" id_119))
+ (if (phase? phase_174)
+ (void)
+ (raise-argument-error 'identifier-binding phase?-string phase_174))
+ (let-values (((id64_1) id_119)
+ ((phase65_1) phase_174)
+ ((top-level-symbol?66_0) top-level-symbol?_2)
+ ((exactly?67_0) exactly?_7))
+ (identifier-binding.1 exactly?67_0 id64_1 phase65_1 top-level-symbol?66_0)))))))))))
(case-lambda
- ((id_107) (begin 'identifier-binding (identifier-binding_0 id_107 unsafe-undefined #f #f)))
- ((id_108 phase_142 top-level-symbol?_3 exactly?26_1)
- (identifier-binding_0 id_108 phase_142 top-level-symbol?_3 exactly?26_1))
- ((id_94 phase_143 top-level-symbol?25_1) (identifier-binding_0 id_94 phase_143 top-level-symbol?25_1 #f))
- ((id_109 phase24_1) (identifier-binding_0 id_109 phase24_1 #f #f)))))
+ ((id_120) (begin 'identifier-binding (identifier-binding_0 id_120 unsafe-undefined #f #f)))
+ ((id_121 phase_175 top-level-symbol?_3 exactly?26_1)
+ (identifier-binding_0 id_121 phase_175 top-level-symbol?_3 exactly?26_1))
+ ((id_122 phase_176 top-level-symbol?25_1) (identifier-binding_0 id_122 phase_176 top-level-symbol?25_1 #f))
+ ((id_123 phase24_1) (identifier-binding_0 id_123 phase24_1 #f #f)))))
(define-values
(1/identifier-transformer-binding)
(let-values (((identifier-transformer-binding_0)
(lambda (id29_3 phase28_1)
(begin
'identifier-transformer-binding
- (let-values (((id_110) id29_3))
- (let-values (((phase_144)
+ (let-values (((id_124) id29_3))
+ (let-values (((phase_177)
(if (eq? phase28_1 unsafe-undefined) (1/syntax-local-phase-level) phase28_1)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? id_110)
- (void)
- (let-values ()
- (raise-argument-error 'identifier-transformer-binding "identifier?" id_110)))
- (let-values (((id66_0) id_110) ((temp67_3) (if phase_144 (add1 phase_144) #f)))
- (identifier-binding.1 #f id66_0 temp67_3 #f))))))))))))
+ (begin
+ (if (identifier? id_124)
+ (void)
+ (raise-argument-error 'identifier-transformer-binding "identifier?" id_124))
+ (let-values (((id69_0) id_124) ((temp70_1) (if phase_177 (add1 phase_177) #f)))
+ (identifier-binding.1 #f id69_0 temp70_1 #f)))))))))
(case-lambda
- ((id_22) (begin 'identifier-transformer-binding (identifier-transformer-binding_0 id_22 unsafe-undefined)))
- ((id_97 phase28_2) (identifier-transformer-binding_0 id_97 phase28_2)))))
+ ((id_125) (begin 'identifier-transformer-binding (identifier-transformer-binding_0 id_125 unsafe-undefined)))
+ ((id_126 phase28_2) (identifier-transformer-binding_0 id_126 phase28_2)))))
(define-values
(1/identifier-template-binding)
- (lambda (id_111)
+ (lambda (id_127)
(begin
'identifier-template-binding
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? id_111)
- (void)
- (let-values () (raise-argument-error 'identifier-template-binding "identifier?" id_111)))
- (let-values (((id69_0) id_111) ((temp70_3) (sub1 (1/syntax-local-phase-level))))
- (identifier-binding.1 #f id69_0 temp70_3 #f))))))))
+ (begin
+ (if (identifier? id_127) (void) (raise-argument-error 'identifier-template-binding "identifier?" id_127))
+ (let-values (((id72_0) id_127) ((temp73_2) (sub1 (1/syntax-local-phase-level))))
+ (identifier-binding.1 #f id72_0 temp73_2 #f))))))
(define-values
(1/identifier-label-binding)
- (lambda (id_98)
+ (lambda (id_128)
(begin
'identifier-label-binding
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? id_98)
- (void)
- (let-values () (raise-argument-error 'identifier-label-binding "identifier?" id_98)))
- (let-values (((id72_0) id_98) ((temp73_2) #f)) (identifier-binding.1 #f id72_0 temp73_2 #f))))))))
+ (begin
+ (if (identifier? id_128) (void) (raise-argument-error 'identifier-label-binding "identifier?" id_128))
+ (let-values (((id75_0) id_128) ((temp76_2) #f)) (identifier-binding.1 #f id75_0 temp76_2 #f))))))
(define-values
(1/identifier-binding-symbol)
(let-values (((identifier-binding-symbol_0)
(lambda (id31_1 phase30_2)
(begin
'identifier-binding-symbol
- (let-values (((id_87) id31_1))
- (let-values (((phase_114)
+ (let-values (((id_129) id31_1))
+ (let-values (((phase_178)
(if (eq? phase30_2 unsafe-undefined) (1/syntax-local-phase-level) phase30_2)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? id_87)
- (void)
- (let-values () (raise-argument-error 'identifier-binding-symbol "identifier?" id_87)))
- (if (phase? phase_114)
- (void)
- (let-values ()
- (raise-argument-error 'identifier-binding-symbol phase?-string phase_114)))
- (identifier-binding-symbol$1 id_87 phase_114)))))))))))
+ (begin
+ (if (identifier? id_129)
+ (void)
+ (raise-argument-error 'identifier-binding-symbol "identifier?" id_129))
+ (if (phase? phase_178)
+ (void)
+ (raise-argument-error 'identifier-binding-symbol phase?-string phase_178))
+ (identifier-binding-symbol$1 id_129 phase_178))))))))
(case-lambda
- ((id_99) (begin 'identifier-binding-symbol (identifier-binding-symbol_0 id_99 unsafe-undefined)))
- ((id_100 phase30_3) (identifier-binding-symbol_0 id_100 phase30_3)))))
+ ((id_130) (begin 'identifier-binding-symbol (identifier-binding-symbol_0 id_130 unsafe-undefined)))
+ ((id_131 phase30_3) (identifier-binding-symbol_0 id_131 phase30_3)))))
(define-values
(1/identifier-distinct-binding)
(let-values (((identifier-distinct-binding_1)
(lambda (id34_0 other-id35_0 phase32_0 top-level-symbol?33_0)
(begin
'identifier-distinct-binding
- (let-values (((id_112) id34_0))
+ (let-values (((id_132) id34_0))
(let-values (((other-id_3) other-id35_0))
- (let-values (((phase_101)
+ (let-values (((phase_179)
(if (eq? phase32_0 unsafe-undefined) (1/syntax-local-phase-level) phase32_0)))
(let-values (((top-level-symbol?_4) top-level-symbol?33_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? id_112)
- (void)
- (let-values ()
- (raise-argument-error 'identifier-distinct-binding "identifier?" id_112)))
- (if (identifier? other-id_3)
- (void)
- (let-values ()
- (raise-argument-error 'identifier-distinct-binding "identifier?" other-id_3)))
- (if (phase? phase_101)
- (void)
- (let-values ()
- (raise-argument-error 'identifier-distinct-binding phase?-string phase_101)))
- (identifier-distinct-binding$1
- id_112
- other-id_3
- phase_101
- top-level-symbol?_4)))))))))))))
+ (begin
+ (if (identifier? id_132)
+ (void)
+ (raise-argument-error 'identifier-distinct-binding "identifier?" id_132))
+ (if (identifier? other-id_3)
+ (void)
+ (raise-argument-error 'identifier-distinct-binding "identifier?" other-id_3))
+ (if (phase? phase_179)
+ (void)
+ (raise-argument-error 'identifier-distinct-binding phase?-string phase_179))
+ (identifier-distinct-binding$1 id_132 other-id_3 phase_179 top-level-symbol?_4))))))))))
(case-lambda
- ((id_113 other-id_4)
- (begin 'identifier-distinct-binding (identifier-distinct-binding_1 id_113 other-id_4 unsafe-undefined #f)))
- ((id_114 other-id_5 phase_4 top-level-symbol?33_1)
- (identifier-distinct-binding_1 id_114 other-id_5 phase_4 top-level-symbol?33_1))
- ((id_115 other-id_6 phase32_1) (identifier-distinct-binding_1 id_115 other-id_6 phase32_1 #f)))))
+ ((id_133 other-id_4)
+ (begin 'identifier-distinct-binding (identifier-distinct-binding_1 id_133 other-id_4 unsafe-undefined #f)))
+ ((id_134 other-id_5 phase_180 top-level-symbol?33_1)
+ (identifier-distinct-binding_1 id_134 other-id_5 phase_180 top-level-symbol?33_1))
+ ((id_135 other-id_6 phase32_1) (identifier-distinct-binding_1 id_135 other-id_6 phase32_1 #f)))))
(define-values
(1/identifier-binding-portal-syntax)
(let-values (((identifier-binding-portal-syntax_0)
(lambda (id37_0 phase36_0)
(begin
'identifier-binding-portal-syntax
- (let-values (((id_116) id37_0))
- (let-values (((phase_145)
+ (let-values (((id_136) id37_0))
+ (let-values (((phase_181)
(if (eq? phase36_0 unsafe-undefined) (1/syntax-local-phase-level) phase36_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (identifier? id_116)
- (void)
- (let-values ()
- (raise-argument-error
- 'identifier-binding-portal-syntax
- "identifier?"
- id_116)))
- (values))))
- (let-values ((()
- (begin
- (if (phase? phase_145)
- (void)
- (let-values ()
- (raise-argument-error
- 'identifier-binding-portal-syntax
- phase?-string
- phase_145)))
- (values))))
- (let-values (((b_107)
- (let-values (((id77_0) id_116) ((phase78_0) phase_145) ((temp79_1) #t))
- (resolve+shift.1
- #f
- #f
- null
- unsafe-undefined
- temp79_1
- id77_0
- phase78_0))))
- (if (module-binding? b_107)
- (let-values ()
- (let-values (((ctx_73)
- (let-values (((temp80_0) #t))
- (get-current-expand-context.1 temp80_0 'unexpected))))
- (let-values (((phase-shift_18)
- (phase- phase_145 (module-binding-phase b_107))))
- (let-values (((portal-syntax-lookup_0)
- (namespace-module-get-portal-syntax-lookup
- (if ctx_73
- (expand-context-namespace ctx_73)
- (1/current-namespace))
- (module-binding-module b_107)
- phase-shift_18)))
- (portal-syntax-lookup_0
- (module-binding-phase b_107)
- (module-binding-sym b_107))))))
- (let-values () #f))))))))))))))
+ (let-values ((()
+ (begin
+ (if (identifier? id_136)
+ (void)
+ (raise-argument-error 'identifier-binding-portal-syntax "identifier?" id_136))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (phase? phase_181)
+ (void)
+ (raise-argument-error
+ 'identifier-binding-portal-syntax
+ phase?-string
+ phase_181))
+ (values))))
+ (let-values (((b_142)
+ (let-values (((id80_0) id_136) ((phase81_1) phase_181) ((temp82_1) #t))
+ (resolve+shift.1 #f #f null unsafe-undefined temp82_1 id80_0 phase81_1))))
+ (if (module-binding? b_142)
+ (let-values (((ctx_81)
+ (let-values (((temp83_1) #t))
+ (get-current-expand-context.1 temp83_1 'unexpected))))
+ (let-values (((phase-shift_20)
+ (if (module-binding-phase b_142)
+ (phase- phase_181 (module-binding-phase b_142))
+ 0)))
+ (let-values (((portal-syntax-lookup_0)
+ (namespace-module-get-portal-syntax-lookup
+ (if ctx_81 (expand-context-namespace ctx_81) (1/current-namespace))
+ (module-binding-module b_142)
+ phase-shift_20)))
+ (portal-syntax-lookup_0
+ (module-binding-phase b_142)
+ (module-binding-sym b_142)))))
+ #f))))))))))
(case-lambda
- ((id_117) (begin 'identifier-binding-portal-syntax (identifier-binding-portal-syntax_0 id_117 unsafe-undefined)))
- ((id_118 phase36_1) (identifier-binding-portal-syntax_0 id_118 phase36_1)))))
+ ((id_137) (begin 'identifier-binding-portal-syntax (identifier-binding-portal-syntax_0 id_137 unsafe-undefined)))
+ ((id_138 phase36_1) (identifier-binding-portal-syntax_0 id_138 phase36_1)))))
(define-values
(1/identifier-prune-lexical-context)
(let-values (((identifier-prune-lexical-context_0)
(lambda (id39_1 syms38_0)
(begin
'identifier-prune-lexical-context
- (let-values (((id_119) id39_1))
- (let-values (((syms_24) syms38_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (identifier? id_119)
- (void)
- (let-values ()
- (raise-argument-error 'identifier-prune-lexical-context "identifier?" id_119)))
- (if (if (list? syms_24) (andmap2 symbol? syms_24) #f)
- (void)
- (let-values ()
- (raise-argument-error
- 'identifier-prune-lexical-context
- "(listof symbol?)"
- syms_24)))
- id_119))))))))))
+ (let-values (((id_139) id39_1))
+ (let-values (((syms_32) syms38_0))
+ (begin
+ (if (identifier? id_139)
+ (void)
+ (raise-argument-error 'identifier-prune-lexical-context "identifier?" id_139))
+ (if (if (list? syms_32) (andmap2 symbol? syms_32) #f)
+ (void)
+ (raise-argument-error 'identifier-prune-lexical-context "(listof symbol?)" syms_32))
+ id_139)))))))
(case-lambda
- ((id_23) (begin 'identifier-prune-lexical-context (identifier-prune-lexical-context_0 id_23 null)))
- ((id_24 syms38_1) (identifier-prune-lexical-context_0 id_24 syms38_1)))))
+ ((id_140) (begin 'identifier-prune-lexical-context (identifier-prune-lexical-context_0 id_140 null)))
+ ((id_141 syms38_1) (identifier-prune-lexical-context_0 id_141 syms38_1)))))
(define-values
(1/syntax-debug-info)
(let-values (((syntax-debug-info_0)
- (lambda (s42_1 phase40_0 all-bindings?41_0)
+ (lambda (s42_0 phase40_0 all-bindings?41_0)
(begin
'syntax-debug-info
- (let-values (((s_518) s42_1))
- (let-values (((phase_146)
+ (let-values (((s_729) s42_0))
+ (let-values (((phase_182)
(if (eq? phase40_0 unsafe-undefined) (1/syntax-local-phase-level) phase40_0)))
(let-values (((all-bindings?_1) all-bindings?41_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_518)
- (void)
- (let-values () (raise-argument-error 'syntax-debug-info "syntax?" s_518)))
- (if (phase? phase_146)
- (void)
- (let-values () (raise-argument-error 'syntax-debug-info phase?-string phase_146)))
- (syntax-debug-info$1 s_518 phase_146 all-bindings?_1))))))))))))
+ (begin
+ (if (syntax?$1 s_729) (void) (raise-argument-error 'syntax-debug-info "syntax?" s_729))
+ (if (phase? phase_182)
+ (void)
+ (raise-argument-error 'syntax-debug-info phase?-string phase_182))
+ (syntax-debug-info$1 s_729 phase_182 all-bindings?_1)))))))))
(case-lambda
- ((s_519) (begin 'syntax-debug-info (syntax-debug-info_0 s_519 unsafe-undefined #f)))
- ((s_520 phase_147 all-bindings?41_1) (syntax-debug-info_0 s_520 phase_147 all-bindings?41_1))
- ((s_80 phase40_1) (syntax-debug-info_0 s_80 phase40_1 #f)))))
+ ((s_730) (begin 'syntax-debug-info (syntax-debug-info_0 s_730 unsafe-undefined #f)))
+ ((s_731 phase_183 all-bindings?41_1) (syntax-debug-info_0 s_731 phase_183 all-bindings?41_1))
+ ((s_732 phase40_1) (syntax-debug-info_0 s_732 phase40_1 #f)))))
(define-values
(1/syntax-shift-phase-level)
- (lambda (s_342 phase_148)
+ (lambda (s_733 phase_184)
(begin
'syntax-shift-phase-level
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_342)
- (void)
- (let-values () (raise-argument-error 'syntax-shift-phase-level "syntax?" s_342)))
- (if (phase? phase_148)
- (void)
- (let-values () (raise-argument-error 'syntax-shift-phase-level phase?-string phase_148)))
- (syntax-shift-phase-level$1 s_342 phase_148)))))))
+ (begin
+ (if (syntax?$1 s_733) (void) (raise-argument-error 'syntax-shift-phase-level "syntax?" s_733))
+ (if (phase? phase_184) (void) (raise-argument-error 'syntax-shift-phase-level phase?-string phase_184))
+ (syntax-shift-phase-level$1 s_733 phase_184)))))
(define-values
(1/syntax-track-origin)
- (lambda (new-stx_8 old-stx_4 id_120)
+ (lambda (new-stx_10 old-stx_4 id_142)
(begin
'syntax-track-origin
- (let-values ()
- (let-values ()
+ (let-values ((()
+ (begin
+ (if (syntax?$1 new-stx_10)
+ (void)
+ (raise-argument-error 'syntax-track-origin "syntax?" new-stx_10))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (syntax?$1 old-stx_4)
+ (void)
+ (raise-argument-error 'syntax-track-origin "syntax?" old-stx_4))
+ (values))))
(let-values ((()
(begin
- (if (syntax?$1 new-stx_8)
+ (if (identifier? id_142)
(void)
- (let-values () (raise-argument-error 'syntax-track-origin "syntax?" new-stx_8)))
+ (raise-argument-error 'syntax-track-origin "identifier?" id_142))
(values))))
- (let-values ((()
- (begin
- (if (syntax?$1 old-stx_4)
- (void)
- (let-values () (raise-argument-error 'syntax-track-origin "syntax?" old-stx_4)))
- (values))))
- (let-values ((()
- (begin
- (if (identifier? id_120)
- (void)
- (let-values () (raise-argument-error 'syntax-track-origin "identifier?" id_120)))
- (values))))
- (let-values (((s_521) (syntax-track-origin$1 new-stx_8 old-stx_4 id_120)))
- (let-values (((ctx_74)
- (let-values (((temp85_0) #t)) (get-current-expand-context.1 temp85_0 'unexpected))))
- (begin
- (if ctx_74
- (let-values ()
- (let-values (((obs_48) (expand-context-observer ctx_74)))
- (if obs_48
- (let-values ()
- (let-values ()
- (call-expand-observe obs_48 'track-syntax 'track-origin new-stx_8 s_521)))
- (void))))
- (void))
- s_521)))))))))))
+ (let-values (((s_734) (syntax-track-origin$1 new-stx_10 old-stx_4 id_142)))
+ (let-values (((ctx_82)
+ (let-values (((temp88_2) #t)) (get-current-expand-context.1 temp88_2 'unexpected))))
+ (begin
+ (if ctx_82
+ (let-values (((obs_50) (expand-context-observer ctx_82)))
+ (if obs_50 (call-expand-observe obs_50 'track-syntax 'track-origin new-stx_10 s_734) (void)))
+ (void))
+ s_734)))))))))
(define-values
(1/syntax-bound-symbols)
(let-values (((syntax-bound-symbols_0)
(lambda (stx45_0 phase43_0 exactly?44_0)
(begin
'syntax-bound-symbols
- (let-values (((stx_15) stx45_0))
- (let-values (((phase_149)
+ (let-values (((stx_19) stx45_0))
+ (let-values (((phase_185)
(if (eq? phase43_0 unsafe-undefined) (1/syntax-local-phase-level) phase43_0)))
- (let-values (((exactly?_6) exactly?44_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 stx_15)
- (void)
- (let-values () (raise-argument-error 'syntax-bound-symbols "syntax?" stx_15)))
- (set->list
- (let-values (((stx87_0) stx_15)
- ((phase88_1) phase_149)
- ((temp89_1) #t)
- ((exactly?90_0) exactly?_6))
- (syntax-mapped-names.1 exactly?90_0 temp89_1 stx87_0 phase88_1))))))))))))))
+ (let-values (((exactly?_8) exactly?44_0))
+ (begin
+ (if (syntax?$1 stx_19) (void) (raise-argument-error 'syntax-bound-symbols "syntax?" stx_19))
+ (set->list
+ (let-values (((stx90_0) stx_19)
+ ((phase91_0) phase_185)
+ ((temp92_1) #t)
+ ((exactly?93_0) exactly?_8))
+ (syntax-mapped-names.1 exactly?93_0 temp92_1 stx90_0 phase91_0)))))))))))
(case-lambda
- ((stx_16) (begin 'syntax-bound-symbols (syntax-bound-symbols_0 stx_16 unsafe-undefined #f)))
- ((stx_17 phase_150 exactly?44_1) (syntax-bound-symbols_0 stx_17 phase_150 exactly?44_1))
- ((stx_18 phase43_1) (syntax-bound-symbols_0 stx_18 phase43_1 #f)))))
+ ((stx_20) (begin 'syntax-bound-symbols (syntax-bound-symbols_0 stx_20 unsafe-undefined #f)))
+ ((stx_21 phase_186 exactly?44_1) (syntax-bound-symbols_0 stx_21 phase_186 exactly?44_1))
+ ((stx_22 phase43_1) (syntax-bound-symbols_0 stx_22 phase43_1 #f)))))
(define-values
(1/syntax-bound-phases)
- (lambda (stx_19)
+ (lambda (stx_23)
(begin
'syntax-bound-phases
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 stx_19) (void) (let-values () (raise-argument-error 'syntax-bound-phases "syntax?" stx_19)))
- (set->list (syntax-mapped-phases stx_19))))))))
+ (begin
+ (if (syntax?$1 stx_23) (void) (raise-argument-error 'syntax-bound-phases "syntax?" stx_23))
+ (set->list (syntax-mapped-phases stx_23))))))
+ (define-values
+ (1/syntax-bound-interned-scope-symbols)
+ (let-values (((syntax-bound-interned-scope-symbols_0)
+ (lambda (stx48_0 phase46_0 exactly?47_0)
+ (begin
+ 'syntax-bound-interned-scope-symbols
+ (let-values (((stx_24) stx48_0))
+ (let-values (((phase_187)
+ (if (eq? phase46_0 unsafe-undefined) (1/syntax-local-phase-level) phase46_0)))
+ (let-values (((exactly?_9) exactly?47_0))
+ (begin
+ (if (syntax?$1 stx_24)
+ (void)
+ (raise-argument-error 'syntax-bound-interned-scope-symbols "syntax?" stx_24))
+ (set->list
+ (let-values (((stx96_0) stx_24) ((phase97_0) phase_187) ((exactly?98_0) exactly?_9))
+ (syntax-mapped-interned-scope-symbols.1 exactly?98_0 stx96_0 phase97_0)))))))))))
+ (case-lambda
+ ((stx_25)
+ (begin 'syntax-bound-interned-scope-symbols (syntax-bound-interned-scope-symbols_0 stx_25 unsafe-undefined #f)))
+ ((stx_26 phase_188 exactly?47_1) (syntax-bound-interned-scope-symbols_0 stx_26 phase_188 exactly?47_1))
+ ((stx_27 phase46_1) (syntax-bound-interned-scope-symbols_0 stx_27 phase46_1 #f)))))
(define-values
(1/namespace-attach-module)
(let-values (((namespace-attach-module_0)
(lambda (src-namespace2_0 mod-path3_1 dest-namespace1_0)
(begin
'namespace-attach-module
- (let-values (((src-namespace_0) src-namespace2_0))
- (let-values (((mod-path_10) mod-path3_1))
- (let-values (((dest-namespace_0)
+ (let-values (((src-namespace_1) src-namespace2_0))
+ (let-values (((mod-path_11) mod-path3_1))
+ (let-values (((dest-namespace_1)
(if (eq? dest-namespace1_0 unsafe-undefined)
(1/current-namespace)
dest-namespace1_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((who15_0) 'namespace-attach-module)
- ((src-namespace16_0) src-namespace_0)
- ((mod-path17_0) mod-path_10)
- ((dest-namespace18_0) dest-namespace_0)
- ((temp19_4) #t))
- (do-attach-module.1
- temp19_4
- who15_0
- src-namespace16_0
- mod-path17_0
- dest-namespace18_0))))))))))))
+ (let-values (((who15_0) 'namespace-attach-module)
+ ((src-namespace16_0) src-namespace_1)
+ ((mod-path17_0) mod-path_11)
+ ((dest-namespace18_0) dest-namespace_1)
+ ((temp19_5) #t))
+ (do-attach-module.1
+ temp19_5
+ who15_0
+ src-namespace16_0
+ mod-path17_0
+ dest-namespace18_0)))))))))
(case-lambda
- ((src-namespace_1 mod-path_11)
- (begin 'namespace-attach-module (namespace-attach-module_0 src-namespace_1 mod-path_11 unsafe-undefined)))
- ((src-namespace_2 mod-path_12 dest-namespace1_1)
- (namespace-attach-module_0 src-namespace_2 mod-path_12 dest-namespace1_1)))))
+ ((src-namespace_2 mod-path_12)
+ (begin 'namespace-attach-module (namespace-attach-module_0 src-namespace_2 mod-path_12 unsafe-undefined)))
+ ((src-namespace_3 mod-path_13 dest-namespace1_1)
+ (namespace-attach-module_0 src-namespace_3 mod-path_13 dest-namespace1_1)))))
(define-values
(1/namespace-attach-module-declaration)
(let-values (((namespace-attach-module-declaration_0)
(lambda (src-namespace5_0 mod-path6_1 dest-namespace4_0)
(begin
'namespace-attach-module-declaration
- (let-values (((src-namespace_3) src-namespace5_0))
- (let-values (((mod-path_13) mod-path6_1))
- (let-values (((dest-namespace_1)
+ (let-values (((src-namespace_4) src-namespace5_0))
+ (let-values (((mod-path_14) mod-path6_1))
+ (let-values (((dest-namespace_2)
(if (eq? dest-namespace4_0 unsafe-undefined)
(1/current-namespace)
dest-namespace4_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((who21_0) 'namespace-attach-module-declaration)
- ((src-namespace22_0) src-namespace_3)
- ((mod-path23_0) mod-path_13)
- ((dest-namespace24_0) dest-namespace_1)
- ((temp25_1) #f))
- (do-attach-module.1
- temp25_1
- who21_0
- src-namespace22_0
- mod-path23_0
- dest-namespace24_0))))))))))))
+ (let-values (((who21_0) 'namespace-attach-module-declaration)
+ ((src-namespace22_0) src-namespace_4)
+ ((mod-path23_0) mod-path_14)
+ ((dest-namespace24_0) dest-namespace_2)
+ ((temp25_1) #f))
+ (do-attach-module.1
+ temp25_1
+ who21_0
+ src-namespace22_0
+ mod-path23_0
+ dest-namespace24_0)))))))))
(case-lambda
- ((src-namespace_4 mod-path_14)
+ ((src-namespace_5 mod-path_15)
(begin
'namespace-attach-module-declaration
- (namespace-attach-module-declaration_0 src-namespace_4 mod-path_14 unsafe-undefined)))
- ((src-namespace_5 mod-path_15 dest-namespace4_1)
- (namespace-attach-module-declaration_0 src-namespace_5 mod-path_15 dest-namespace4_1)))))
+ (namespace-attach-module-declaration_0 src-namespace_5 mod-path_15 unsafe-undefined)))
+ ((src-namespace_6 mod-path_16 dest-namespace4_1)
+ (namespace-attach-module-declaration_0 src-namespace_6 mod-path_16 dest-namespace4_1)))))
(define-values
(do-attach-module.1)
(lambda (attach-instances?7_0 who9_1 src-namespace10_0 mod-path11_0 dest-namespace12_0)
(begin
'do-attach-module
- (let-values (((who_23) who9_1))
- (let-values (((src-namespace_6) src-namespace10_0))
- (let-values (((mod-path_16) mod-path11_0))
- (let-values (((dest-namespace_2) dest-namespace12_0))
+ (let-values (((who_35) who9_1))
+ (let-values (((src-namespace_7) src-namespace10_0))
+ (let-values (((mod-path_17) mod-path11_0))
+ (let-values (((dest-namespace_3) dest-namespace12_0))
(let-values (((attach-instances?_0) attach-instances?7_0))
- (let-values ()
+ (let-values ((()
+ (begin
+ (if (1/namespace? src-namespace_7)
+ (void)
+ (raise-argument-error who_35 "namespace?" src-namespace_7))
+ (values))))
(let-values ((()
(begin
- (if (1/namespace? src-namespace_6)
+ (if (let-values (((or-part_511) (1/module-path? mod-path_17)))
+ (if or-part_511 or-part_511 (1/resolved-module-path? mod-path_17)))
(void)
- (let-values () (raise-argument-error who_23 "namespace?" src-namespace_6)))
+ (raise-argument-error
+ who_35
+ "(or/c module-path? resolved-module-path?)"
+ mod-path_17))
(values))))
(let-values ((()
(begin
- (if (let-values (((or-part_168) (1/module-path? mod-path_16)))
- (if or-part_168 or-part_168 (1/resolved-module-path? mod-path_16)))
+ (if (1/namespace? dest-namespace_3)
(void)
- (let-values ()
- (raise-argument-error
- who_23
- "(or/c module-path? resolved-module-path?)"
- mod-path_16)))
+ (raise-argument-error who_35 "namespace?" dest-namespace_3))
(values))))
- (let-values ((()
- (begin
- (if (1/namespace? dest-namespace_2)
- (void)
- (let-values () (raise-argument-error who_23 "namespace?" dest-namespace_2)))
- (values))))
- (let-values (((phase_151) (namespace-phase src-namespace_6)))
- (let-values ((()
- (begin
- (if (eqv? phase_151 (namespace-phase dest-namespace_2))
- (void)
- (let-values ()
- (raise-arguments-error
- who_23
- "source and destination namespace phases do not match"
- "source phase"
- phase_151
- "destination phase"
- (namespace-phase dest-namespace_2))))
- (values))))
- (let-values (((todo_0) (make-hasheq)))
- (let-values (((missing_0) '#:missing))
- (let-values ((()
- (begin
- ((letrec-values (((loop_101)
- (lambda (mpi_55
- phase_152
- attach-instances?_1
- attach-phase_0)
- (begin
- 'loop
- (let-values (((mod-name_21)
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first
- #f
- parameterization-key)
- 1/current-namespace
- src-namespace_6)
- (let-values ()
- (1/module-path-index-resolve
- mpi_55)))))
- (let-values (((attach-this-instance?_0)
- (if attach-instances?_1
- (eqv? phase_152 attach-phase_0)
- #f)))
- (let-values (((m-ns_13)
- (hash-ref
- (hash-ref
- todo_0
- mod-name_21
- '#hasheqv())
- phase_152
- missing_0)))
- (if (let-values (((or-part_77)
- (eq? missing_0 m-ns_13)))
- (if or-part_77
- or-part_77
- (if attach-this-instance?_0
- (not m-ns_13)
- #f)))
- (let-values ()
- (let-values (((m_23)
- (namespace->module
- src-namespace_6
- mod-name_21)))
- (begin
- (if m_23
- (void)
- (let-values ()
- (raise-arguments-error
- who_23
- "module not declared (in the source namespace)"
- "module name"
- mod-name_21)))
- (if (if (module-cross-phase-persistent?
- m_23)
- (if (not
- (label-phase? phase_152))
- (not
- (zero-phase? phase_152))
- #f)
- #f)
- (let-values ()
- (loop_101
- mpi_55
- 0
- attach-instances?_1
- 0))
- (let-values ()
- (let-values (((already-m_0)
- (namespace->module
- dest-namespace_2
- mod-name_21)))
- (let-values ((()
- (begin
- (if (if already-m_0
+ (let-values (((phase_189) (namespace-phase src-namespace_7)))
+ (let-values ((()
+ (begin
+ (if (eqv? phase_189 (namespace-phase dest-namespace_3))
+ (void)
+ (raise-arguments-error
+ who_35
+ "source and destination namespace phases do not match"
+ "source phase"
+ phase_189
+ "destination phase"
+ (namespace-phase dest-namespace_3)))
+ (values))))
+ (let-values (((todo_0) (make-hasheq)))
+ (let-values (((missing_0) '#:missing))
+ (let-values ((()
+ (begin
+ ((letrec-values (((loop_115)
+ (lambda (mpi_85
+ maybe-mod-name_0
+ phase_190
+ attach-instances?_1
+ attach-phase_0
+ recur?_2)
+ (begin
+ 'loop
+ (let-values (((mod-name_22)
+ (let-values (((or-part_512)
+ maybe-mod-name_0))
+ (if or-part_512
+ or-part_512
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first
+ #f
+ parameterization-key)
+ 1/current-namespace
+ src-namespace_7)
+ (1/module-path-index-resolve
+ mpi_85))))))
+ (let-values (((m-ns_13)
+ (hash-ref
+ (hash-ref
+ todo_0
+ mod-name_22
+ '#hasheqv())
+ phase_190
+ missing_0)))
+ (if (eq? missing_0 m-ns_13)
+ (let-values (((mi_23)
+ (let-values (((src-namespace26_0)
+ src-namespace_7)
+ ((mod-name27_0)
+ mod-name_22)
+ ((phase28_3)
+ phase_190))
+ (namespace->module-instance.1
+ #f
+ #f
+ void
+ src-namespace26_0
+ mod-name27_0
+ phase28_3))))
+ (let-values (((m_28)
+ (if mi_23
+ (module-instance-module
+ mi_23)
+ (namespace->module
+ src-namespace_7
+ mod-name_22))))
+ (begin
+ (if m_28
+ (void)
+ (raise-arguments-error
+ who_35
+ "module not declared (in the source namespace)"
+ "module name"
+ mod-name_22))
+ (if (if (module-cross-phase-persistent?
+ m_28)
+ (if (not (label-phase? phase_190))
+ (not (zero-phase? phase_190))
+ #f)
+ #f)
+ (loop_115
+ mpi_85
+ mod-name_22
+ 0
+ attach-instances?_1
+ 0
+ recur?_2)
+ (let-values (((already-m_0)
+ (namespace->module
+ dest-namespace_3
+ mod-name_22)))
+ (let-values ((()
+ (begin
+ (if (if already-m_0
+ (not
+ (eq?
+ already-m_0
+ m_28))
+ #f)
+ (raise-arguments-error
+ who_35
+ "a different declaration is already in the destination namespace"
+ "module name"
+ mod-name_22)
+ (void))
+ (values))))
+ (let-values (((attach-this-instance?_0)
+ (if attach-instances?_1
+ (module-instantiates-at-level?
+ m_28
+ (phase-
+ attach-phase_0
+ phase_190))
+ #f)))
+ (let-values (((m-ns_14
+ already?_0)
+ (if (let-values (((or-part_513)
+ attach-this-instance?_0))
+ (if or-part_513
+ or-part_513
+ (if (module-cross-phase-persistent?
+ m_28)
(not
- (eq?
- already-m_0
- m_23))
- #f)
- (let-values ()
- (raise-arguments-error
- who_23
- "a different declaration is already in the destination namespace"
- "module name"
- mod-name_21))
- (void))
- (values))))
- (let-values (((m-ns_14
- already?_0)
- (if (let-values (((or-part_8)
- attach-this-instance?_0))
- (if or-part_8
- or-part_8
- (module-cross-phase-persistent?
- m_23)))
- (let-values ()
- (let-values (((m-ns_15)
- (let-values (((src-namespace26_0)
- src-namespace_6)
- ((mod-name27_0)
- mod-name_21)
- ((phase28_3)
- phase_152))
+ (label-phase?
+ phase_190))
+ #f)))
+ (let-values (((m-ns_15)
+ (let-values (((src-namespace29_0)
+ src-namespace_7)
+ ((mod-name30_0)
+ mod-name_22)
+ ((phase31_1)
+ phase_190))
+ (namespace->module-namespace.1
+ #f
+ #f
+ void
+ src-namespace29_0
+ mod-name30_0
+ phase31_1))))
+ (let-values ((()
+ (begin
+ (if m-ns_15
+ (void)
+ (raise-arguments-error
+ who_35
+ "module not instantiated (in the source namespace)"
+ "module name"
+ mod-name_22
+ "instance phase"
+ phase_190))
+ (values))))
+ (let-values (((already-m-ns_0)
+ (if already-m_0
+ (let-values (((dest-namespace32_0)
+ dest-namespace_3)
+ ((mod-name33_0)
+ mod-name_22)
+ ((phase34_1)
+ phase_190))
(namespace->module-namespace.1
#f
#f
void
- src-namespace26_0
- mod-name27_0
- phase28_3))))
- (let-values ((()
- (begin
- (if m-ns_15
- (void)
- (let-values ()
- (raise-arguments-error
- who_23
- "module not instantiated (in the source namespace)"
- "module name"
- mod-name_21)))
- (values))))
- (let-values (((already-m-ns_0)
- (if already-m_0
- (let-values (((dest-namespace29_0)
- dest-namespace_2)
- ((mod-name30_0)
- mod-name_21)
- ((phase31_1)
- phase_152))
- (namespace->module-namespace.1
- #f
- #f
- void
- dest-namespace29_0
- mod-name30_0
- phase31_1))
- #f)))
- (begin
- (if (if already-m-ns_0
- (if (not
- (eq?
- m-ns_15
- already-m-ns_0))
- (not
- (namespace-same-instance?
- m-ns_15
- already-m-ns_0))
- #f)
- #f)
- (let-values ()
- (raise-arguments-error
- who_23
- "a different instance is already in the destination namespace"
- "module name"
- mod-name_21))
- (void))
- (values
- m-ns_15
- (if already-m-ns_0
- #t
- #f)))))))
- (let-values ()
+ dest-namespace32_0
+ mod-name33_0
+ phase34_1))
+ #f)))
(begin
- (if (if (label-phase?
- phase_152)
- (not
- (let-values (((src-namespace32_0)
- src-namespace_6)
- ((mod-name33_0)
- mod-name_21)
- ((phase34_1)
- phase_152))
- (namespace->module-namespace.1
- #f
- #f
- void
- src-namespace32_0
- mod-name33_0
- phase34_1)))
+ (if (if already-m-ns_0
+ (if (not
+ (eq?
+ m-ns_15
+ already-m-ns_0))
+ (not
+ (namespace-same-instance?
+ m-ns_15
+ already-m-ns_0
+ (phase-
+ attach-phase_0
+ phase_190)))
+ #f)
#f)
- (let-values ()
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first
- #f
- parameterization-key)
- 1/current-namespace
- src-namespace_6)
- (let-values ()
- (let-values (((src-namespace35_0)
- src-namespace_6)
- ((mpi36_0)
- mpi_55)
- ((phase37_0)
- phase_152))
- (namespace-module-instantiate!.1
- #f
- #t
- unsafe-undefined
- '#hasheq()
- null
- #f
- src-namespace35_0
- mpi36_0
- phase37_0)))))
+ (raise-arguments-error
+ who_35
+ "a different instance is already in the destination namespace"
+ "module name"
+ mod-name_22
+ "instance phase"
+ phase_190)
(void))
(values
- #f
- (if already-m_0
+ m-ns_15
+ (if already-m-ns_0
#t
- #f)))))))
- (begin
- (hash-update!
- todo_0
- mod-name_21
- (lambda (ht_166)
- (hash-set
- ht_166
- phase_152
- m-ns_14))
- '#hasheqv())
- (if already?_0
- (void)
- (let-values ()
+ #f))))))
+ (begin
+ (if (if (label-phase?
+ phase_190)
+ (not
+ (let-values (((src-namespace35_0)
+ src-namespace_7)
+ ((mod-name36_0)
+ mod-name_22)
+ ((phase37_0)
+ phase_190))
+ (namespace->module-namespace.1
+ #f
+ #f
+ void
+ src-namespace35_0
+ mod-name36_0
+ phase37_0)))
+ #f)
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first
+ #f
+ parameterization-key)
+ 1/current-namespace
+ src-namespace_7)
+ (let-values (((src-namespace38_0)
+ src-namespace_7)
+ ((mpi39_1)
+ mpi_85)
+ ((phase40_2)
+ phase_190))
+ (namespace-module-instantiate!.1
+ #f
+ #t
+ #t
+ unsafe-undefined
+ '#hasheq()
+ null
+ #f
+ #f
+ src-namespace38_0
+ mpi39_1
+ phase40_2)))
+ (void))
+ (values
+ #f
+ (if already-m_0
+ (not
+ attach-instances?_1)
+ #f))))))
+ (begin
+ (hash-update!
+ todo_0
+ mod-name_22
+ (lambda (ht_226)
+ (hash-set
+ ht_226
+ phase_190
+ m-ns_14))
+ '#hasheqv())
+ (if (let-values (((or-part_514)
+ already?_0))
+ (if or-part_514
+ or-part_514
+ (not recur?_2)))
+ (void)
+ (let-values (((shifted-requires_2)
+ (let-values (((or-part_515)
+ (if mi_23
+ (module-instance-shifted-requires
+ mi_23)
+ #f)))
+ (if or-part_515
+ or-part_515
+ (build-module-instance-shifted-requires
+ src-namespace_7
+ m_28
+ mpi_85
+ mod-name_22)))))
+ (begin
+ (if (not
+ (module-flattened-requires
+ m_28))
(begin
- (let-values (((lst_198)
- (module-requires
- m_23)))
+ (let-values (((lst_512)
+ shifted-requires_2))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-list
- lst_198)))
- ((letrec-values (((for-loop_216)
- (lambda (lst_10)
+ (check-list
+ lst_512))
+ ((letrec-values (((for-loop_424)
+ (lambda (lst_513)
(begin
'for-loop
(if (pair?
- lst_10)
- (let-values (((phase+reqs_1)
+ lst_513)
+ (let-values (((phase+mpis_4)
(unsafe-car
- lst_10))
- ((rest_1)
+ lst_513))
+ ((rest_252)
(unsafe-cdr
- lst_10)))
+ lst_513)))
(let-values ((()
- (let-values ()
- (let-values (((lst_295)
- (cdr
- phase+reqs_1)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_295)))
- ((letrec-values (((for-loop_0)
- (lambda (lst_239)
- (begin
- 'for-loop
- (if (pair?
- lst_239)
- (let-values (((req_5)
- (unsafe-car
- lst_239))
- ((rest_166)
- (unsafe-cdr
- lst_239)))
- (let-values ((()
- (let-values ()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (loop_101
- (module-path-index-shift
- req_5
- (module-self
- m_23)
- mpi_55)
- (phase+
- phase_152
- (car
- phase+reqs_1))
- attach-instances?_1
- attach-phase_0))
- (values)))))
- (values))))))
- (if (not
- #f)
- (for-loop_0
- rest_166)
- (values))))
- (values))))))
- for-loop_0)
- lst_295))))))
+ (let-values (((lst_514)
+ (cdr
+ phase+mpis_4)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_514))
+ ((letrec-values (((for-loop_425)
+ (lambda (lst_515)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_515)
+ (let-values (((mpi_86)
+ (unsafe-car
+ lst_515))
+ ((rest_253)
+ (unsafe-cdr
+ lst_515)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (if mpi_86
+ (loop_115
+ mpi_86
+ #f
+ (phase+
+ phase_190
+ (car
+ phase+mpis_4))
+ attach-instances?_1
+ attach-phase_0
+ #t)
+ (void))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_425
+ rest_253)
+ (values))))
+ (values))))))
+ for-loop_425)
+ lst_514)))))
(if (not
#f)
- (for-loop_216
- rest_1)
+ (for-loop_424
+ rest_252)
(values))))
(values))))))
- for-loop_216)
- lst_198)))
- (void)
- (let-values (((lst_183)
- (module-submodule-names
- m_23)))
+ for-loop_424)
+ lst_512)))
+ (void))
+ (begin
+ (let-values (((lst_516)
+ shifted-requires_2))
(begin
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values ()
- (check-list
- lst_183)))
- ((letrec-values (((for-loop_284)
- (lambda (lst_311)
+ (check-list
+ lst_516))
+ ((letrec-values (((for-loop_426)
+ (lambda (lst_517)
(begin
'for-loop
(if (pair?
- lst_311)
- (let-values (((submod-name_0)
+ lst_517)
+ (let-values (((mpi+phases_4)
(unsafe-car
- lst_311))
- ((rest_173)
+ lst_517))
+ ((rest_254)
(unsafe-cdr
- lst_311)))
+ lst_517)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
+ (let-values ((()
+ (begin
+ (let-values (((mpi_87)
+ (vector-ref
+ mpi+phases_4
+ 0)))
(begin
- (let-values ()
- (loop_101
- (1/module-path-index-join
- (list
- 'submod
- "."
- submod-name_0)
- mpi_55)
- #f
- #f
- attach-phase_0))
- (values)))))
- (values)))))
+ (let-values (((lst_518)
+ (vector-ref
+ mpi+phases_4
+ 1)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_518))
+ ((letrec-values (((for-loop_427)
+ (lambda (lst_519)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_519)
+ (let-values (((req-phase_3)
+ (unsafe-car
+ lst_519))
+ ((rest_255)
+ (unsafe-cdr
+ lst_519)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (loop_115
+ mpi_87
+ #f
+ (phase+
+ phase_190
+ req-phase_3)
+ attach-instances?_1
+ attach-phase_0
+ #f)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_427
+ rest_255)
+ (values))))
+ (values))))))
+ for-loop_427)
+ lst_518)))
+ (void)))
+ (values))))
+ (values))))
(if (not
#f)
- (for-loop_284
- rest_173)
+ (for-loop_426
+ rest_254)
(values))))
(values))))))
- for-loop_284)
- lst_183)))
- (void)
- (if (module-supermodule-name
- m_23)
- (let-values ()
- (loop_101
- (1/module-path-index-join
- '(submod
- "..")
- mpi_55)
- #f
- #f
- attach-phase_0))
- (void))))))))))))))
- (void)))))))))
- loop_101)
- (1/module-path-index-join
- (if (1/resolved-module-path? mod-path_16)
- (resolved-module-path->module-path mod-path_16)
- mod-path_16)
- #f)
- phase_151
- attach-instances?_0
- phase_151)
- (values))))
- (let-values ((()
- (begin
- (let-values (((ht_167) todo_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_167)))
- ((letrec-values (((for-loop_285)
- (lambda (i_36)
- (begin
- 'for-loop
- (if i_36
- (let-values (((mod-name_22 phases_9)
- (hash-iterate-key+value
- ht_167
- i_36)))
- (let-values ((()
- (let-values ()
- (let-values (((ht_168)
- phases_9))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-in-hash
- ht_168)))
- ((letrec-values (((for-loop_286)
- (lambda (i_84)
- (begin
- 'for-loop
- (if i_84
- (let-values (((phase_28
- m-ns_16)
- (hash-iterate-key+value
- ht_168
- i_84)))
- (let-values ((()
- (let-values ()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((m_24)
- (namespace->module
- src-namespace_6
- mod-name_22)))
- (begin
- (module-force-bulk-binding!
- m_24
- src-namespace_6)
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first
- #f
- parameterization-key)
- 1/current-namespace
- dest-namespace_2)
- (let-values ()
- (let-values (((dest-namespace38_0)
- dest-namespace_2)
- ((m39_0)
- m_24)
- ((mod-name40_0)
- mod-name_22))
- (declare-module!.1
- #t
- dest-namespace38_0
- m39_0
- mod-name40_0))))
- (if m-ns_16
- (let-values ()
- (begin
- (namespace-record-module-instance-attached!
- src-namespace_6
- mod-name_22
- phase_28)
- (let-values (((or-part_110)
- (let-values (((dest-namespace41_0)
- dest-namespace_2)
- ((mod-name42_0)
- mod-name_22)
- ((phase43_2)
- phase_28))
- (namespace->module-namespace.1
- #f
- #f
- void
- dest-namespace41_0
- mod-name42_0
- phase43_2))))
- (if or-part_110
- or-part_110
- (namespace-install-module-namespace!
- dest-namespace_2
- mod-name_22
- phase_28
- m_24
- m-ns_16)))))
- (void)))))
- (values)))))
- (values))))))
- (if (not
- #f)
- (for-loop_286
- (hash-iterate-next
- ht_168
- i_84))
- (values))))
- (values))))))
- for-loop_286)
- (hash-iterate-first
- ht_168)))))))
- (if (not #f)
- (for-loop_285
- (hash-iterate-next ht_167 i_36))
- (values))))
- (values))))))
- for-loop_285)
- (hash-iterate-first ht_167))))
- (values))))
- (let-values ()
- (let-values (((mnr_0) (1/current-module-name-resolver)))
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first #f parameterization-key)
- 1/current-namespace
- dest-namespace_2)
- (let-values ()
+ for-loop_426)
+ lst_516)))
+ (void)))
+ (if (non-self-derived-module-path-index?
+ mpi_85)
+ (namespace-save-shifted-requires!
+ src-namespace_7
+ m_28
+ mod-name_22
+ shifted-requires_2)
+ (void))
+ (let-values (((lst_520)
+ (module-submodule-names
+ m_28)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_520))
+ ((letrec-values (((for-loop_428)
+ (lambda (lst_521)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_521)
+ (let-values (((submod-name_0)
+ (unsafe-car
+ lst_521))
+ ((rest_256)
+ (unsafe-cdr
+ lst_521)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (loop_115
+ (module-path-index-join*
+ (list
+ 'submod
+ "."
+ submod-name_0)
+ mpi_85)
+ (1/make-resolved-module-path
+ (let-values (((n_35)
+ (1/resolved-module-path-name
+ mod-name_22)))
+ (if (pair?
+ n_35)
+ (append
+ n_35
+ (list
+ submod-name_0))
+ (list
+ n_35
+ submod-name_0))))
+ #f
+ #f
+ attach-phase_0
+ #t)
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_428
+ rest_256)
+ (values))))
+ (values))))))
+ for-loop_428)
+ lst_520)))
+ (void)
+ (if (module-supermodule-name
+ m_28)
+ (loop_115
+ (module-path-index-join*
+ '(submod "..")
+ mpi_85)
+ #f
+ #f
+ #f
+ attach-phase_0
+ #t)
+ (void))))))))))))))
+ (void))))))))
+ loop_115)
+ (module-path-index-join*
+ (if (1/resolved-module-path? mod-path_17)
+ (resolved-module-path->module-path mod-path_17)
+ mod-path_17)
+ #f)
+ (if (1/resolved-module-path? mod-path_17) mod-path_17 #f)
+ phase_189
+ attach-instances?_0
+ phase_189
+ #t)
+ (values))))
+ (let-values ((()
+ (begin
+ (let-values (((ht_227) todo_0))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash ht_227))
+ ((letrec-values (((for-loop_429)
+ (lambda (i_292)
+ (begin
+ 'for-loop
+ (if i_292
+ (let-values (((mod-name_23 phases_12)
+ (hash-iterate-key+value
+ ht_227
+ i_292)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((m_29)
+ (namespace->module
+ src-namespace_7
+ mod-name_23)))
+ (begin
+ (module-force-bulk-binding!
+ m_29
+ src-namespace_7)
+ (if (eq?
+ m_29
+ (namespace->module
+ dest-namespace_3
+ mod-name_23))
+ (void)
+ (begin
+ (namespace-copy-shifted-requires!
+ dest-namespace_3
+ src-namespace_7
+ mod-name_23)
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first
+ #f
+ parameterization-key)
+ 1/current-namespace
+ dest-namespace_3)
+ (let-values (((dest-namespace41_0)
+ dest-namespace_3)
+ ((m42_0)
+ m_29)
+ ((mod-name43_0)
+ mod-name_23))
+ (declare-module!.1
+ #t
+ dest-namespace41_0
+ m42_0
+ mod-name43_0)))))
+ (let-values (((ht_228)
+ phases_12))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-in-hash
+ ht_228))
+ ((letrec-values (((for-loop_430)
+ (lambda (i_293)
+ (begin
+ 'for-loop
+ (if i_293
+ (let-values (((m-phase_0
+ m-ns_16)
+ (hash-iterate-key+value
+ ht_228
+ i_293)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (if m-ns_16
+ (begin
+ (namespace-record-module-instance-attached!
+ src-namespace_7
+ mod-name_23
+ m-phase_0)
+ (let-values (((or-part_516)
+ (let-values (((dest-namespace44_0)
+ dest-namespace_3)
+ ((mod-name45_0)
+ mod-name_23)
+ ((m-phase46_0)
+ m-phase_0))
+ (namespace->module-namespace.1
+ #f
+ #f
+ void
+ dest-namespace44_0
+ mod-name45_0
+ m-phase46_0))))
+ (if or-part_516
+ or-part_516
+ (namespace-install-module-namespace!
+ dest-namespace_3
+ mod-name_23
+ m-phase_0
+ m_29
+ m-ns_16
+ phase_189))))
+ (void))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_430
+ (hash-iterate-next
+ ht_228
+ i_293))
+ (values))))
+ (values))))))
+ for-loop_430)
+ (hash-iterate-first
+ ht_228))))
+ (void)))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_429
+ (hash-iterate-next ht_227 i_292))
+ (values))))
+ (values))))))
+ for-loop_429)
+ (hash-iterate-first ht_227))))
+ (values))))
+ (let-values ()
+ (let-values (((mnr_0) (1/current-module-name-resolver)))
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first #f parameterization-key)
+ 1/current-namespace
+ dest-namespace_3)
+ (begin
+ (let-values (((ht_229) todo_0))
(begin
- (let-values (((ht_169) todo_0))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash-keys ht_169)))
- ((letrec-values (((for-loop_287)
- (lambda (i_202)
- (begin
- 'for-loop
- (if i_202
- (let-values (((mod-name_23)
- (hash-iterate-key ht_169 i_202)))
- (let-values ((()
- (let-values ()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (mnr_0
- mod-name_23
- src-namespace_6))
- (values)))))
- (values))))))
- (if (not #f)
- (for-loop_287
- (hash-iterate-next ht_169 i_202))
- (values))))
- (values))))))
- for-loop_287)
- (hash-iterate-first ht_169))))
- (void))))))))))))))))))))))))
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash-keys ht_229))
+ ((letrec-values (((for-loop_431)
+ (lambda (i_294)
+ (begin
+ 'for-loop
+ (if i_294
+ (let-values (((mod-name_24)
+ (hash-iterate-key ht_229 i_294)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (mnr_0
+ mod-name_24
+ src-namespace_7)
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_431
+ (hash-iterate-next ht_229 i_294))
+ (values))))
+ (values))))))
+ for-loop_431)
+ (hash-iterate-first ht_229))))
+ (void))))))))))))))))))))))
(define-values
(1/make-empty-namespace)
(lambda ()
(begin
'make-empty-namespace
(let-values (((current-ns_0) (1/current-namespace)))
- (let-values (((phase_52) (namespace-phase current-ns_0)))
- (let-values (((ns_64) (namespace->namespace-at-phase (make-namespace) phase_52)))
+ (let-values (((phase_191) (namespace-phase current-ns_0)))
+ (let-values (((ns_95) (namespace->namespace-at-phase (make-namespace) phase_191)))
(begin
- (1/namespace-attach-module current-ns_0 ''#%kernel ns_64)
- (namespace-primitive-module-visit! ns_64 '#%kernel)
- ns_64)))))))
+ (1/namespace-attach-module current-ns_0 ''#%kernel ns_95)
+ (namespace-primitive-module-visit! ns_95 '#%kernel)
+ ns_95)))))))
(define-values
(1/namespace-syntax-introduce)
(let-values (((namespace-syntax-introduce_0)
(lambda (s2_7 ns1_3)
(begin
'namespace-syntax-introduce
- (let-values (((s_325) s2_7))
- (let-values (((ns_59) (if (eq? ns1_3 unsafe-undefined) (1/current-namespace) ns1_3)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (syntax?$1 s_325)
- (void)
- (let-values ()
- (raise-argument-error 'namespace-syntax-introduce "syntax?" s_325)))
- (values))))
- (let-values ((()
- (begin
- (if (1/namespace? ns_59)
- (void)
- (let-values ()
- (raise-argument-error
- 'namespace-syntax-introduce
- "namespace?"
- ns_59)))
- (values))))
- (let-values (((root-ctx_5) (namespace-get-root-expand-ctx ns_59)))
- (let-values (((post-scope_1)
- (post-expansion-scope
- (root-expand-context-post-expansion root-ctx_5))))
- (let-values (((other-namespace-scopes_0)
- (reverse$1
- (let-values (((ht_170)
- (syntax-scope-set
- (root-expand-context-all-scopes-stx root-ctx_5)
- 0)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-immutable-hash-keys ht_170)))
- ((letrec-values (((for-loop_111)
- (lambda (fold-var_248 i_203)
- (begin
- 'for-loop
- (if i_203
- (let-values (((sc_35)
- (unsafe-immutable-hash-iterate-key
- ht_170
- i_203)))
- (let-values (((fold-var_291)
- (let-values (((fold-var_260)
- fold-var_248))
- (if (equal?
- sc_35
- post-scope_1)
- fold-var_260
- (let-values (((fold-var_250)
- fold-var_260))
- (let-values (((fold-var_34)
- (let-values ()
- (cons
- (let-values ()
- sc_35)
- fold-var_250))))
- (values
- fold-var_34)))))))
- (if (not #f)
- (for-loop_111
- fold-var_291
- (unsafe-immutable-hash-iterate-next
- ht_170
- i_203))
- fold-var_291)))
- fold-var_248)))))
- for-loop_111)
- null
- (unsafe-immutable-hash-iterate-first ht_170)))))))
- (let-values (((add-ns-scopes_0)
- (lambda (s_180)
- (begin
- 'add-ns-scopes
- (let-values (((temp40_2)
- (add-scopes
- (push-scope s_180 post-scope_1)
- other-namespace-scopes_0))
- ((temp41_3)
- (root-expand-context-all-scopes-stx root-ctx_5))
- ((temp42_1)
- (let-values (((or-part_5)
- (namespace-declaration-inspector
- ns_59)))
- (if or-part_5
- or-part_5
- (current-code-inspector))))
- ((temp43_1) #t))
- (syntax-transfer-shifts.1
- temp43_1
- temp40_2
- temp41_3
- temp42_1))))))
- (let-values (((maybe-module-id_0)
- (if (pair? (1/syntax-e s_325))
- (if (identifier? (car (1/syntax-e s_325)))
- (add-ns-scopes_0 (car (1/syntax-e s_325)))
- #f)
- #f)))
- (if (if maybe-module-id_0
- (1/free-identifier=?
- maybe-module-id_0
- (1/namespace-module-identifier ns_59)
- (namespace-phase ns_59))
- #f)
- (let-values ()
- (1/datum->syntax
- s_325
- (cons maybe-module-id_0 (cdr (1/syntax-e s_325)))
- s_325
- s_325))
- (let-values () (add-ns-scopes_0 s_325)))))))))))))))))))
+ (let-values (((s_735) s2_7))
+ (let-values (((ns_96) (if (eq? ns1_3 unsafe-undefined) (1/current-namespace) ns1_3)))
+ (let-values ((()
+ (begin
+ (if (syntax?$1 s_735)
+ (void)
+ (raise-argument-error 'namespace-syntax-introduce "syntax?" s_735))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (1/namespace? ns_96)
+ (void)
+ (raise-argument-error 'namespace-syntax-introduce "namespace?" ns_96))
+ (values))))
+ (let-values (((root-ctx_5) (namespace-get-root-expand-ctx ns_96)))
+ (let-values (((post-scope_1)
+ (post-expansion-scope (root-expand-context-post-expansion root-ctx_5))))
+ (let-values (((other-namespace-scopes_0)
+ (reverse$1
+ (let-values (((fold-var_575)
+ (let-values (((fold-var_576) null)) fold-var_576)))
+ (let-values (((ht_230)
+ (syntax-scope-set
+ (root-expand-context-all-scopes-stx root-ctx_5)
+ 0)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-immutable-hash-keys ht_230))
+ ((letrec-values (((for-loop_432)
+ (lambda (fold-var_577 i_295)
+ (begin
+ 'for-loop
+ (if i_295
+ (let-values (((sc_40)
+ (unsafe-immutable-hash-iterate-key
+ ht_230
+ i_295)))
+ (let-values (((fold-var_578)
+ (if (equal?
+ sc_40
+ post-scope_1)
+ fold-var_577
+ (let-values (((fold-var_579)
+ (cons
+ sc_40
+ fold-var_577)))
+ (values
+ fold-var_579)))))
+ (if (not #f)
+ (for-loop_432
+ fold-var_578
+ (unsafe-immutable-hash-iterate-next
+ ht_230
+ i_295))
+ fold-var_578)))
+ fold-var_577)))))
+ for-loop_432)
+ fold-var_575
+ (unsafe-immutable-hash-iterate-first ht_230))))))))
+ (let-values (((add-ns-scopes_0)
+ (lambda (s_736)
+ (begin
+ 'add-ns-scopes
+ (let-values (((temp40_2)
+ (add-scopes
+ (push-scope s_736 post-scope_1)
+ other-namespace-scopes_0))
+ ((temp41_2)
+ (root-expand-context-all-scopes-stx root-ctx_5))
+ ((temp42_1)
+ (let-values (((or-part_517)
+ (namespace-declaration-inspector
+ ns_96)))
+ (if or-part_517
+ or-part_517
+ (current-code-inspector))))
+ ((temp43_1) #t))
+ (syntax-transfer-shifts.1
+ temp43_1
+ temp40_2
+ temp41_2
+ temp42_1))))))
+ (let-values (((maybe-module-id_0)
+ (if (pair? (1/syntax-e s_735))
+ (if (identifier? (car (1/syntax-e s_735)))
+ (add-ns-scopes_0 (car (1/syntax-e s_735)))
+ #f)
+ #f)))
+ (if (if maybe-module-id_0
+ (1/free-identifier=?
+ maybe-module-id_0
+ (1/namespace-module-identifier ns_96)
+ (namespace-phase ns_96))
+ #f)
+ (1/datum->syntax
+ s_735
+ (cons maybe-module-id_0 (cdr (1/syntax-e s_735)))
+ s_735
+ s_735)
+ (add-ns-scopes_0 s_735)))))))))))))))
(case-lambda
- ((s_522) (begin 'namespace-syntax-introduce (namespace-syntax-introduce_0 s_522 unsafe-undefined)))
- ((s_523 ns1_2) (namespace-syntax-introduce_0 s_523 ns1_2)))))
+ ((s_737) (begin 'namespace-syntax-introduce (namespace-syntax-introduce_0 s_737 unsafe-undefined)))
+ ((s_738 ns1_4) (namespace-syntax-introduce_0 s_738 ns1_4)))))
(define-values
(namespace-datum-introduce)
- (lambda (s_50) (begin (1/namespace-syntax-introduce (1/datum->syntax #f s_50)))))
+ (lambda (s_739) (begin (1/namespace-syntax-introduce (1/datum->syntax #f s_739)))))
(define-values
(1/namespace-module-identifier)
(let-values (((namespace-module-identifier_0)
@@ -52701,38 +52008,30 @@
(begin
'namespace-module-identifier
(let-values (((where_1) (if (eq? where3_0 unsafe-undefined) (1/current-namespace) where3_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (let-values (((or-part_89) (1/namespace? where_1)))
- (if or-part_89 or-part_89 (phase? where_1)))
- (void)
- (let-values ()
- (raise-argument-error
- 'namespace-module-identifier
- (string-append "(or/c namespace? " phase?-string ")")
- where_1)))
- (1/datum->syntax
- (1/syntax-shift-phase-level
- core-stx
- (if (1/namespace? where_1) (namespace-phase where_1) where_1))
- 'module))))))))))
+ (begin
+ (if (let-values (((or-part_518) (1/namespace? where_1)))
+ (if or-part_518 or-part_518 (phase? where_1)))
+ (void)
+ (raise-argument-error
+ 'namespace-module-identifier
+ (string-append "(or/c namespace? " phase?-string ")")
+ where_1))
+ (1/datum->syntax
+ (1/syntax-shift-phase-level
+ core-stx
+ (if (1/namespace? where_1) (namespace-phase where_1) where_1))
+ 'module)))))))
(case-lambda
(() (begin 'namespace-module-identifier (namespace-module-identifier_0 unsafe-undefined)))
((where3_1) (namespace-module-identifier_0 where3_1)))))
(define-values
(1/namespace-symbol->identifier)
- (lambda (sym_71)
+ (lambda (sym_108)
(begin
'namespace-symbol->identifier
- (let-values ()
- (let-values ()
- (begin
- (if (symbol? sym_71)
- (void)
- (let-values () (raise-argument-error 'namespace-symbol->identifier "symbol?" sym_71)))
- (1/namespace-syntax-introduce (1/datum->syntax #f sym_71))))))))
+ (begin
+ (if (symbol? sym_108) (void) (raise-argument-error 'namespace-symbol->identifier "symbol?" sym_108))
+ (1/namespace-syntax-introduce (1/datum->syntax #f sym_108))))))
(define-values
(do-namespace-require.1)
(lambda (copy-variable-as-constant?7_0
@@ -52742,101 +52041,94 @@
visit?5_0
who14_0
req15_0
- ns16_1)
+ ns16_2)
(begin
'do-namespace-require
(let-values (((run?_3) run?4_0))
(let-values (((visit?_3) visit?5_0))
- (let-values (((who_24) who14_0))
+ (let-values (((who_36) who14_0))
(let-values (((req_6) req15_0))
- (let-values (((ns_4) ns16_1))
+ (let-values (((ns_97) ns16_2))
(let-values (((copy-variable-phase-level_2) copy-variable-phase-level6_0))
(let-values (((copy-variable-as-constant?_2) copy-variable-as-constant?7_0))
(let-values (((skip-variable-phase-level_2) skip-variable-phase-level8_0))
- (let-values ()
- (let-values ((()
- (begin
- (if (1/namespace? ns_4)
- (void)
- (let-values () (raise-argument-error who_24 "namespace?" ns_4)))
- (values))))
- (let-values (((ctx-stx_0)
- (add-scopes
- empty-syntax
- (root-expand-context-module-scopes (namespace-get-root-expand-ctx ns_4)))))
- (if (let-values (((or-part_60) (1/module-path-index? req_6)))
- (if or-part_60 or-part_60 (1/module-path? req_6)))
- (let-values ()
- (let-values (((temp46_0)
- (if (1/module-path-index? req_6)
- req_6
- (1/module-path-index-join req_6 #f)))
- ((temp47_0) #f)
- ((temp48_2) #f)
- ((ctx-stx49_0) ctx-stx_0)
- ((ns50_0) ns_4)
- ((run?51_0) run?_3)
- ((visit?52_1) visit?_3)
- ((temp53_1) (namespace-phase ns_4))
- ((temp54_4) (namespace-phase ns_4))
- ((copy-variable-phase-level55_0) copy-variable-phase-level_2)
- ((copy-variable-as-constant?56_0) copy-variable-as-constant?_2)
- ((skip-variable-phase-level57_0) skip-variable-phase-level_2)
- ((who58_0) who_24))
- (perform-require!.1
- #f
- #t
- #f
- copy-variable-as-constant?56_0
- copy-variable-phase-level55_0
- #f
- 'all
- #t
- temp53_1
- #f
- temp54_4
- run?51_0
- skip-variable-phase-level57_0
- unsafe-undefined
- visit?52_1
- who58_0
- temp46_0
- temp47_0
- temp48_2
- ctx-stx49_0
- ns50_0)))
- (let-values ()
- (let-values (((run?59_0) run?_3)
- ((visit?60_0) visit?_3)
- ((temp61_3) (list (1/datum->syntax ctx-stx_0 req_6)))
- ((temp62_2) #f)
- ((ns63_0) ns_4)
- ((temp64_0) (namespace-phase ns_4))
- ((temp65_0)
- (let-values (((temp70_4) #f))
- (make-requires+provides.1 #f unsafe-undefined temp70_4)))
- ((copy-variable-phase-level66_0) copy-variable-phase-level_2)
- ((copy-variable-as-constant?67_0) copy-variable-as-constant?_2)
- ((skip-variable-phase-level68_0) skip-variable-phase-level_2)
- ((who69_0) who_24))
- (parse-and-perform-requires!.1
- #f
- #f
- copy-variable-as-constant?67_0
- copy-variable-phase-level66_0
- '#hasheq()
- #f
- unsafe-undefined
- run?59_0
- #f
- skip-variable-phase-level68_0
- visit?60_0
- who69_0
- temp61_3
- temp62_2
- ns63_0
- temp64_0
- temp65_0))))))))))))))))))
+ (let-values ((()
+ (begin
+ (if (1/namespace? ns_97) (void) (raise-argument-error who_36 "namespace?" ns_97))
+ (values))))
+ (let-values (((ctx-stx_0)
+ (add-scopes
+ empty-syntax
+ (root-expand-context-module-scopes (namespace-get-root-expand-ctx ns_97)))))
+ (if (let-values (((or-part_519) (1/module-path-index? req_6)))
+ (if or-part_519 or-part_519 (1/module-path? req_6)))
+ (let-values (((temp46_2)
+ (if (1/module-path-index? req_6) req_6 (module-path-index-join* req_6 #f)))
+ ((temp47_2) #f)
+ ((temp48_2) #f)
+ ((ctx-stx49_0) ctx-stx_0)
+ ((ns50_0) ns_97)
+ ((run?51_0) run?_3)
+ ((visit?52_1) visit?_3)
+ ((temp53_3) (namespace-phase ns_97))
+ ((temp54_1) (namespace-phase ns_97))
+ ((copy-variable-phase-level55_0) copy-variable-phase-level_2)
+ ((copy-variable-as-constant?56_0) copy-variable-as-constant?_2)
+ ((skip-variable-phase-level57_0) skip-variable-phase-level_2)
+ ((who58_0) who_36))
+ (perform-require!.1
+ #f
+ #t
+ #f
+ copy-variable-as-constant?56_0
+ copy-variable-phase-level55_0
+ #f
+ 'all
+ #t
+ temp53_3
+ #f
+ temp54_1
+ run?51_0
+ skip-variable-phase-level57_0
+ unsafe-undefined
+ visit?52_1
+ who58_0
+ temp46_2
+ temp47_2
+ temp48_2
+ ctx-stx49_0
+ ns50_0))
+ (let-values (((run?59_0) run?_3)
+ ((visit?60_0) visit?_3)
+ ((temp61_1) (list (1/datum->syntax ctx-stx_0 req_6)))
+ ((temp62_1) #f)
+ ((ns63_0) ns_97)
+ ((temp64_2) (namespace-phase ns_97))
+ ((temp65_0)
+ (let-values (((temp70_2) #f))
+ (make-requires+provides.1 #f unsafe-undefined temp70_2)))
+ ((copy-variable-phase-level66_0) copy-variable-phase-level_2)
+ ((copy-variable-as-constant?67_0) copy-variable-as-constant?_2)
+ ((skip-variable-phase-level68_0) skip-variable-phase-level_2)
+ ((who69_0) who_36))
+ (parse-and-perform-requires!.1
+ #f
+ #f
+ copy-variable-as-constant?67_0
+ copy-variable-phase-level66_0
+ '#hasheq()
+ #f
+ unsafe-undefined
+ run?59_0
+ #f
+ skip-variable-phase-level68_0
+ visit?60_0
+ who69_0
+ temp61_1
+ temp62_1
+ ns63_0
+ temp64_2
+ temp65_0))))))))))))))))
(define-values
(1/namespace-require)
(let-values (((namespace-require_0)
@@ -52844,12 +52136,9 @@
(begin
'namespace-require
(let-values (((req_7) req19_0))
- (let-values (((ns_81) (if (eq? ns18_0 unsafe-undefined) (1/current-namespace) ns18_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((who72_0) 'namespace-require) ((req73_0) req_7) ((ns74_0) ns_81))
- (do-namespace-require.1 #f #f #t #f #f who72_0 req73_0 ns74_0)))))))))))
+ (let-values (((ns_98) (if (eq? ns18_0 unsafe-undefined) (1/current-namespace) ns18_0)))
+ (let-values (((who72_0) 'namespace-require) ((req73_0) req_7) ((ns74_0) ns_98))
+ (do-namespace-require.1 #f #f #t #f #f who72_0 req73_0 ns74_0))))))))
(case-lambda
((req_8) (begin 'namespace-require (namespace-require_0 req_8 unsafe-undefined)))
((req_9 ns18_1) (namespace-require_0 req_9 ns18_1)))))
@@ -52860,16 +52149,13 @@
(begin
'namespace-require/expansion-time
(let-values (((req_10) req21_0))
- (let-values (((ns_82) (if (eq? ns20_0 unsafe-undefined) (1/current-namespace) ns20_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((temp76_1) #f)
- ((temp77_0) #t)
- ((who78_1) 'namespace-require/expansion-time)
- ((req79_0) req_10)
- ((ns80_0) ns_82))
- (do-namespace-require.1 #f #f temp76_1 #f temp77_0 who78_1 req79_0 ns80_0)))))))))))
+ (let-values (((ns_99) (if (eq? ns20_0 unsafe-undefined) (1/current-namespace) ns20_0)))
+ (let-values (((temp76_3) #f)
+ ((temp77_1) #t)
+ ((who78_0) 'namespace-require/expansion-time)
+ ((req79_0) req_10)
+ ((ns80_0) ns_99))
+ (do-namespace-require.1 #f #f temp76_3 #f temp77_1 who78_0 req79_0 ns80_0))))))))
(case-lambda
((req_11) (begin 'namespace-require/expansion-time (namespace-require/expansion-time_0 req_11 unsafe-undefined)))
((req_12 ns20_1) (namespace-require/expansion-time_0 req_12 ns20_1)))))
@@ -52880,16 +52166,13 @@
(begin
'namespace-require/constant
(let-values (((req_13) req23_0))
- (let-values (((ns_83) (if (eq? ns22_0 unsafe-undefined) (1/current-namespace) ns22_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((who82_0) 'namespace-require/constant)
- ((req83_0) req_13)
- ((ns84_0) ns_83)
- ((temp85_1) 0)
- ((temp86_0) #t))
- (do-namespace-require.1 temp86_0 temp85_1 #t #f #f who82_0 req83_0 ns84_0)))))))))))
+ (let-values (((ns_100) (if (eq? ns22_0 unsafe-undefined) (1/current-namespace) ns22_0)))
+ (let-values (((who82_0) 'namespace-require/constant)
+ ((req83_0) req_13)
+ ((ns84_0) ns_100)
+ ((temp85_0) 0)
+ ((temp86_0) #t))
+ (do-namespace-require.1 temp86_0 temp85_0 #t #f #f who82_0 req83_0 ns84_0))))))))
(case-lambda
((req_14) (begin 'namespace-require/constant (namespace-require/constant_0 req_14 unsafe-undefined)))
((req_15 ns22_1) (namespace-require/constant_0 req_15 ns22_1)))))
@@ -52900,16 +52183,13 @@
(begin
'namespace-require/copy
(let-values (((req_16) req25_0))
- (let-values (((ns_84) (if (eq? ns24_1 unsafe-undefined) (1/current-namespace) ns24_1)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((who88_0) 'namespace-require/copy)
- ((req89_0) req_16)
- ((ns90_0) ns_84)
- ((temp91_0) 0)
- ((temp92_0) 0))
- (do-namespace-require.1 #f temp91_0 #t temp92_0 #f who88_0 req89_0 ns90_0)))))))))))
+ (let-values (((ns_101) (if (eq? ns24_1 unsafe-undefined) (1/current-namespace) ns24_1)))
+ (let-values (((who88_0) 'namespace-require/copy)
+ ((req89_0) req_16)
+ ((ns90_0) ns_101)
+ ((temp91_1) 0)
+ ((temp92_2) 0))
+ (do-namespace-require.1 #f temp91_1 #t temp92_2 #f who88_0 req89_0 ns90_0))))))))
(case-lambda
((req_17) (begin 'namespace-require/copy (namespace-require/copy_0 req_17 unsafe-undefined)))
((req_18 ns24_2) (namespace-require/copy_0 req_18 ns24_2)))))
@@ -52919,249 +52199,215 @@
(lambda (sym29_0 use-mapping?26_0 failure-thunk27_0 ns28_0)
(begin
'namespace-variable-value
- (let-values (((sym_87) sym29_0))
+ (let-values (((sym_109) sym29_0))
(let-values (((use-mapping?_0) use-mapping?26_0))
(let-values (((failure-thunk_5) failure-thunk27_0))
- (let-values (((ns_85) (if (eq? ns28_0 unsafe-undefined) (1/current-namespace) ns28_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (symbol? sym_87)
- (void)
- (let-values () (raise-argument-error 'namespace-variable-value "symbol?" sym_87)))
- (if (let-values (((or-part_177) (not failure-thunk_5)))
- (if or-part_177
- or-part_177
- (if (procedure? failure-thunk_5)
- (procedure-arity-includes? failure-thunk_5 0)
- #f)))
- (void)
- (let-values ()
- (raise-argument-error
- 'namespace-variable-value
- "(or/c #f (procedure-arity-includes/c 0))"
- failure-thunk_5)))
- (if (1/namespace? ns_85)
- (void)
- (let-values ()
- (raise-argument-error 'namespace-variable-value "namespace?" ns_85)))
- ((call/ec
- (lambda (escape_0)
- (let-values (((var-ns_0 var-phase-level_0 var-sym_3)
- (if use-mapping?_0
- (let-values ()
- (let-values (((id_110) (1/datum->syntax #f sym_87)))
- (let-values (((b_108)
- (resolve+shift/extra-inspector
- (1/namespace-syntax-introduce id_110 ns_85)
- (namespace-phase ns_85)
- ns_85)))
- (let-values ((()
- (begin
- (if b_108
- (let-values ()
- (namespace-visit-available-modules!
- ns_85))
- (void))
- (values))))
- (let-values (((v_206
- primitive?_8
- extra-inspector_8
- protected?_10)
- (if b_108
- (let-values (((b94_0) b_108)
- ((empty-env95_0) empty-env)
- ((null96_0) null)
- ((ns97_1) ns_85)
- ((temp98_1)
- (namespace-phase ns_85))
- ((id99_0) id_110))
- (binding-lookup.1
- #t
- #f
- #f
- b94_0
- empty-env95_0
- null96_0
- ns97_1
- temp98_1
- id99_0))
- (values variable #f #f #f))))
- (begin
- (if (variable? v_206)
- (void)
- (let-values ()
- (escape_0
- (let-values (((or-part_310) failure-thunk_5))
- (if or-part_310
- or-part_310
- (lambda ()
- (raise
- (make-exn:fail:syntax$1
- (format
- (string-append
- "namespace-variable-value: bound to syntax\n"
- " in: ~s")
- sym_87)
- (current-continuation-marks)
- null))))))))
- (if (module-binding? b_108)
- (values
- (if (top-level-module-path-index?
- (module-binding-module b_108))
- ns_85
- (module-instance-namespace
- (binding->module-instance
- b_108
- ns_85
- (namespace-phase ns_85)
- id_110)))
- (module-binding-phase b_108)
- (module-binding-sym b_108))
- (values
- ns_85
- (namespace-phase ns_85)
- sym_87))))))))
- (let-values () (values ns_85 (namespace-phase ns_85) sym_87)))))
- (let-values (((val_74)
- (namespace-get-variable
- var-ns_0
- var-phase-level_0
- var-sym_3
- (lambda ()
- (escape_0
- (let-values (((or-part_311) failure-thunk_5))
- (if or-part_311
- or-part_311
- (raise
- (exn:fail:contract:variable
- (format
- (string-append
- "namespace-variable-value: given name is not defined\n"
- " name: ~s")
- sym_87)
- (current-continuation-marks)
- sym_87)))))))))
- (lambda () val_74))))))))))))))))))
+ (let-values (((ns_102) (if (eq? ns28_0 unsafe-undefined) (1/current-namespace) ns28_0)))
+ (begin
+ (if (symbol? sym_109)
+ (void)
+ (raise-argument-error 'namespace-variable-value "symbol?" sym_109))
+ (if (let-values (((or-part_520) (not failure-thunk_5)))
+ (if or-part_520
+ or-part_520
+ (if (procedure? failure-thunk_5)
+ (procedure-arity-includes? failure-thunk_5 0)
+ #f)))
+ (void)
+ (raise-argument-error
+ 'namespace-variable-value
+ "(or/c #f (procedure-arity-includes/c 0))"
+ failure-thunk_5))
+ (if (1/namespace? ns_102)
+ (void)
+ (raise-argument-error 'namespace-variable-value "namespace?" ns_102))
+ ((call-with-escape-continuation
+ (lambda (escape_0)
+ (let-values (((var-ns_0 var-phase-level_0 var-sym_6)
+ (if use-mapping?_0
+ (let-values (((id_143) (1/datum->syntax #f sym_109)))
+ (let-values (((b_143)
+ (resolve+shift/extra-inspector
+ (1/namespace-syntax-introduce id_143 ns_102)
+ (namespace-phase ns_102)
+ ns_102)))
+ (let-values ((()
+ (begin
+ (if b_143
+ (namespace-visit-available-modules! ns_102)
+ (void))
+ (values))))
+ (let-values (((v_285
+ primitive?_8
+ extra-inspector_9
+ protected?_10)
+ (if b_143
+ (let-values (((b94_0) b_143)
+ ((empty-env95_0) empty-env)
+ ((null96_0) null)
+ ((ns97_1) ns_102)
+ ((temp98_2)
+ (namespace-phase ns_102))
+ ((id99_0) id_143))
+ (binding-lookup.1
+ #t
+ #f
+ #f
+ b94_0
+ empty-env95_0
+ null96_0
+ ns97_1
+ temp98_2
+ id99_0))
+ (values variable #f #f #f))))
+ (begin
+ (if (variable? v_285)
+ (void)
+ (escape_0
+ (let-values (((or-part_521) failure-thunk_5))
+ (if or-part_521
+ or-part_521
+ (lambda ()
+ (raise
+ (make-exn:fail:syntax$1
+ (format
+ (string-append
+ "namespace-variable-value: bound to syntax\n"
+ " in: ~s")
+ sym_109)
+ (current-continuation-marks)
+ null)))))))
+ (if (module-binding? b_143)
+ (values
+ (if (top-level-module-path-index?
+ (module-binding-module b_143))
+ ns_102
+ (module-instance-namespace
+ (binding->module-instance
+ b_143
+ ns_102
+ (namespace-phase ns_102)
+ id_143)))
+ (module-binding-phase b_143)
+ (module-binding-sym b_143))
+ (values ns_102 (namespace-phase ns_102) sym_109)))))))
+ (values ns_102 (namespace-phase ns_102) sym_109))))
+ (let-values (((val_82)
+ (namespace-get-variable
+ var-ns_0
+ var-phase-level_0
+ var-sym_6
+ (lambda ()
+ (escape_0
+ (let-values (((or-part_522) failure-thunk_5))
+ (if or-part_522
+ or-part_522
+ (raise
+ (exn:fail:contract:variable
+ (format
+ (string-append
+ "namespace-variable-value: given name is not defined\n"
+ " name: ~s")
+ sym_109)
+ (current-continuation-marks)
+ sym_109)))))))))
+ (lambda () val_82)))))))))))))))
(case-lambda
- ((sym_88) (begin 'namespace-variable-value (namespace-variable-value_0 sym_88 #t #f unsafe-undefined)))
- ((sym_89 use-mapping?_1 failure-thunk_6 ns28_1)
- (namespace-variable-value_0 sym_89 use-mapping?_1 failure-thunk_6 ns28_1))
- ((sym_90 use-mapping?_2 failure-thunk27_1)
- (namespace-variable-value_0 sym_90 use-mapping?_2 failure-thunk27_1 unsafe-undefined))
- ((sym_91 use-mapping?26_1) (namespace-variable-value_0 sym_91 use-mapping?26_1 #f unsafe-undefined)))))
+ ((sym_110) (begin 'namespace-variable-value (namespace-variable-value_0 sym_110 #t #f unsafe-undefined)))
+ ((sym_111 use-mapping?_1 failure-thunk_6 ns28_1)
+ (namespace-variable-value_0 sym_111 use-mapping?_1 failure-thunk_6 ns28_1))
+ ((sym_112 use-mapping?_2 failure-thunk27_1)
+ (namespace-variable-value_0 sym_112 use-mapping?_2 failure-thunk27_1 unsafe-undefined))
+ ((sym_113 use-mapping?26_1) (namespace-variable-value_0 sym_113 use-mapping?26_1 #f unsafe-undefined)))))
(define-values
(1/namespace-set-variable-value!)
(let-values (((namespace-set-variable-value!_0)
(lambda (sym33_0 val34_0 map?30_0 ns31_0 as-constant?32_0)
(begin
'namespace-set-variable-value!
- (let-values (((sym_92) sym33_0))
- (let-values (((val_75) val34_0))
+ (let-values (((sym_114) sym33_0))
+ (let-values (((val_83) val34_0))
(let-values (((map?_0) map?30_0))
- (let-values (((ns_86) (if (eq? ns31_0 unsafe-undefined) (1/current-namespace) ns31_0)))
+ (let-values (((ns_103) (if (eq? ns31_0 unsafe-undefined) (1/current-namespace) ns31_0)))
(let-values (((as-constant?_2) as-constant?32_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (symbol? sym_92)
- (void)
- (let-values ()
- (raise-argument-error 'namespace-set-variable-value! "symbol?" sym_92)))
- (if (1/namespace? ns_86)
- (void)
- (let-values ()
- (raise-argument-error 'namespace-set-variable-value! "namespace?" ns_86)))
- (namespace-set-variable!
- ns_86
- (namespace-phase ns_86)
- sym_92
- val_75
- as-constant?_2)
- (if map?_0
- (let-values ()
- (let-values ((()
- (begin
- (namespace-unset-transformer!
- ns_86
- (namespace-phase ns_86)
- sym_92)
- (values))))
- (let-values (((id_121) (1/datum->syntax #f sym_92)))
- (let-values (((temp101_1) (1/namespace-syntax-introduce id_121 ns_86))
- ((temp102_1)
- (let-values (((temp104_1) (namespace-mpi ns_86))
- ((temp105_2) (namespace-phase ns_86))
- ((sym106_0) sym_92))
- (make-module-binding.1
- #f
- null
- #f
- #f
- unsafe-undefined
- unsafe-undefined
- 0
- unsafe-undefined
- temp104_1
- temp105_2
- sym106_0)))
- ((temp103_1) (namespace-phase ns_86)))
- (add-binding!.1 #f #f temp101_1 temp102_1 temp103_1)))))
- (void)))))))))))))))
+ (begin
+ (if (symbol? sym_114)
+ (void)
+ (raise-argument-error 'namespace-set-variable-value! "symbol?" sym_114))
+ (if (1/namespace? ns_103)
+ (void)
+ (raise-argument-error 'namespace-set-variable-value! "namespace?" ns_103))
+ (namespace-set-variable! ns_103 (namespace-phase ns_103) sym_114 val_83 as-constant?_2)
+ (if map?_0
+ (let-values ((()
+ (begin
+ (namespace-unset-transformer! ns_103 (namespace-phase ns_103) sym_114)
+ (values))))
+ (let-values (((id_144) (1/datum->syntax #f sym_114)))
+ (let-values (((temp101_2) (1/namespace-syntax-introduce id_144 ns_103))
+ ((temp102_2)
+ (let-values (((temp104_0) (namespace-mpi ns_103))
+ ((temp105_1) (namespace-phase ns_103))
+ ((sym106_0) sym_114))
+ (make-module-binding.1
+ #f
+ null
+ #f
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ 0
+ unsafe-undefined
+ temp104_0
+ temp105_1
+ sym106_0)))
+ ((temp103_2) (namespace-phase ns_103)))
+ (add-binding!.1 #f #f temp101_2 temp102_2 temp103_2))))
+ (void))))))))))))
(case-lambda
- ((sym_93 val_76)
- (begin 'namespace-set-variable-value! (namespace-set-variable-value!_0 sym_93 val_76 #f unsafe-undefined #f)))
- ((sym_94 val_77 map?_1 ns_87 as-constant?32_1)
- (namespace-set-variable-value!_0 sym_94 val_77 map?_1 ns_87 as-constant?32_1))
- ((sym_95 val_78 map?_2 ns31_1) (namespace-set-variable-value!_0 sym_95 val_78 map?_2 ns31_1 #f))
- ((sym_96 val_79 map?30_1) (namespace-set-variable-value!_0 sym_96 val_79 map?30_1 unsafe-undefined #f)))))
+ ((sym_115 val_84)
+ (begin 'namespace-set-variable-value! (namespace-set-variable-value!_0 sym_115 val_84 #f unsafe-undefined #f)))
+ ((sym_116 val_85 map?_1 ns_104 as-constant?32_1)
+ (namespace-set-variable-value!_0 sym_116 val_85 map?_1 ns_104 as-constant?32_1))
+ ((sym_117 val_86 map?_2 ns31_1) (namespace-set-variable-value!_0 sym_117 val_86 map?_2 ns31_1 #f))
+ ((sym_118 val_87 map?30_1) (namespace-set-variable-value!_0 sym_118 val_87 map?30_1 unsafe-undefined #f)))))
(define-values
(1/namespace-undefine-variable!)
(let-values (((namespace-undefine-variable!_0)
- (lambda (sym36_0 ns35_0)
+ (lambda (sym36_1 ns35_0)
(begin
'namespace-undefine-variable!
- (let-values (((sym_97) sym36_0))
- (let-values (((ns_88) (if (eq? ns35_0 unsafe-undefined) (1/current-namespace) ns35_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (symbol? sym_97)
- (void)
- (let-values () (raise-argument-error 'namespace-undefine-variable! "symbol?" sym_97)))
- (if (1/namespace? ns_88)
- (void)
- (let-values ()
- (raise-argument-error 'namespace-undefine-variable! "namespace?" ns_88)))
- (namespace-unset-variable! ns_88 (namespace-phase ns_88) sym_97)))))))))))
+ (let-values (((sym_119) sym36_1))
+ (let-values (((ns_105) (if (eq? ns35_0 unsafe-undefined) (1/current-namespace) ns35_0)))
+ (begin
+ (if (symbol? sym_119)
+ (void)
+ (raise-argument-error 'namespace-undefine-variable! "symbol?" sym_119))
+ (if (1/namespace? ns_105)
+ (void)
+ (raise-argument-error 'namespace-undefine-variable! "namespace?" ns_105))
+ (namespace-unset-variable! ns_105 (namespace-phase ns_105) sym_119))))))))
(case-lambda
- ((sym_98) (begin 'namespace-undefine-variable! (namespace-undefine-variable!_0 sym_98 unsafe-undefined)))
- ((sym_99 ns35_1) (namespace-undefine-variable!_0 sym_99 ns35_1)))))
+ ((sym_120) (begin 'namespace-undefine-variable! (namespace-undefine-variable!_0 sym_120 unsafe-undefined)))
+ ((sym_121 ns35_1) (namespace-undefine-variable!_0 sym_121 ns35_1)))))
(define-values
(1/namespace-mapped-symbols)
(let-values (((namespace-mapped-symbols_0)
(lambda (ns37_0)
(begin
'namespace-mapped-symbols
- (let-values (((ns_89) (if (eq? ns37_0 unsafe-undefined) (1/current-namespace) ns37_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (1/namespace? ns_89)
- (void)
- (let-values () (raise-argument-error 'namespace-mapped-symbols "namespace?" ns_89)))
- (set->list
- (set-union
- (let-values (((temp109_1)
- (root-expand-context-all-scopes-stx
- (namespace-get-root-expand-ctx ns_89)))
- ((temp110_3) (namespace-phase ns_89)))
- (syntax-mapped-names.1 #f #f temp109_1 temp110_3))
- (list->set (1/instance-variable-names (namespace->instance ns_89 0))))))))))))))
+ (let-values (((ns_106) (if (eq? ns37_0 unsafe-undefined) (1/current-namespace) ns37_0)))
+ (begin
+ (if (1/namespace? ns_106)
+ (void)
+ (raise-argument-error 'namespace-mapped-symbols "namespace?" ns_106))
+ (set->list
+ (set-union
+ (let-values (((temp109_1)
+ (root-expand-context-all-scopes-stx (namespace-get-root-expand-ctx ns_106)))
+ ((temp110_1) (namespace-phase ns_106)))
+ (syntax-mapped-names.1 #f #f temp109_1 temp110_1))
+ (list->set (1/instance-variable-names (namespace->instance ns_106 0)))))))))))
(case-lambda
(() (begin 'namespace-mapped-symbols (namespace-mapped-symbols_0 unsafe-undefined)))
((ns37_1) (namespace-mapped-symbols_0 ns37_1)))))
@@ -53171,315 +52417,294 @@
(lambda (ns38_0)
(begin
'namespace-base-phase
- (let-values (((ns_90) (if (eq? ns38_0 unsafe-undefined) (1/current-namespace) ns38_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (1/namespace? ns_90)
- (void)
- (let-values () (raise-argument-error 'namespace-base-phase "namespace?" ns_90)))
- (namespace-phase ns_90))))))))))
+ (let-values (((ns_107) (if (eq? ns38_0 unsafe-undefined) (1/current-namespace) ns38_0)))
+ (begin
+ (if (1/namespace? ns_107)
+ (void)
+ (raise-argument-error 'namespace-base-phase "namespace?" ns_107))
+ (namespace-phase ns_107)))))))
(case-lambda
(() (begin 'namespace-base-phase (namespace-base-phase_0 unsafe-undefined)))
((ns38_1) (namespace-base-phase_0 ns38_1)))))
(define-values
(1/namespace-call-with-registry-lock)
- (lambda (ns_91 thunk_5)
+ (lambda (ns_108 thunk_4)
(begin
'namespace-call-with-registry-lock
- (let-values ()
- (let-values ()
- (begin
- (if (1/namespace? ns_91)
- (void)
- (let-values () (raise-argument-error 'namespace-call-with-registry-lock "namespace?" ns_91)))
- (if ((lambda (p_51) (if (procedure? p_51) (procedure-arity-includes? p_51 0) #f)) thunk_5)
- (void)
- (let-values ()
- (raise-argument-error 'namespace-call-with-registry-lock "(procedure-arity-includes/c 0)" thunk_5)))
- (registry-call-with-lock (namespace-module-registry$1 ns_91) thunk_5)))))))
+ (begin
+ (if (1/namespace? ns_108) (void) (raise-argument-error 'namespace-call-with-registry-lock "namespace?" ns_108))
+ (if ((lambda (p_59) (if (procedure? p_59) (procedure-arity-includes? p_59 0) #f)) thunk_4)
+ (void)
+ (raise-argument-error 'namespace-call-with-registry-lock "(procedure-arity-includes/c 0)" thunk_4))
+ (registry-call-with-lock (namespace-module-registry$1 ns_108) thunk_4)))))
(define-values
(as-expand-time-top-level-bindings)
- (lambda (ids_31 s_89 ctx_75)
+ (lambda (ids_33 s_740 ctx_83)
(begin
- (let-values (((top-level-bind-scope_6) (root-expand-context-top-level-bind-scope ctx_75)))
+ (let-values (((top-level-bind-scope_6) (root-expand-context-top-level-bind-scope ctx_83)))
(let-values (((tl-ids_2)
(reverse$1
- (let-values (((lst_88) ids_31))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_88)))
- ((letrec-values (((for-loop_106)
- (lambda (fold-var_253 lst_89)
- (begin
- 'for-loop
- (if (pair? lst_89)
- (let-values (((id_60) (unsafe-car lst_89))
- ((rest_42) (unsafe-cdr lst_89)))
- (let-values (((fold-var_67)
- (let-values (((fold-var_68) fold-var_253))
- (let-values (((fold-var_254)
- (let-values ()
- (cons
- (let-values ()
- (remove-use-site-scopes
- id_60
- ctx_75))
- fold-var_68))))
- (values fold-var_254)))))
- (if (not #f) (for-loop_106 fold-var_67 rest_42) fold-var_67)))
- fold-var_253)))))
- for-loop_106)
- null
- lst_88))))))
+ (let-values (((fold-var_580) (let-values (((fold-var_581) null)) fold-var_581)))
+ (let-values (((lst_522) ids_33))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_522))
+ ((letrec-values (((for-loop_433)
+ (lambda (fold-var_582 lst_523)
+ (begin
+ 'for-loop
+ (if (pair? lst_523)
+ (let-values (((id_145) (unsafe-car lst_523))
+ ((rest_257) (unsafe-cdr lst_523)))
+ (let-values (((fold-var_583)
+ (let-values (((fold-var_584)
+ (cons
+ (remove-use-site-scopes
+ id_145
+ ctx_83)
+ fold-var_582)))
+ (values fold-var_584))))
+ (if (not #f)
+ (for-loop_433 fold-var_583 rest_257)
+ fold-var_583)))
+ fold-var_582)))))
+ for-loop_433)
+ fold-var_580
+ lst_522)))))))
(let-values ((()
- (begin
- (let-values (((tl-ids1_0) tl-ids_2) ((temp2_5) (expand-context-phase ctx_75)) ((s3_1) s_89))
- (check-no-duplicate-ids.1 unsafe-undefined tl-ids1_0 temp2_5 s3_1 unsafe-undefined))
- (values))))
- (let-values (((tmp-bind-ids_0)
- (reverse$1
- (let-values (((lst_312) tl-ids_2))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_312)))
- ((letrec-values (((for-loop_86)
- (lambda (fold-var_260 lst_90)
- (begin
- 'for-loop
- (if (pair? lst_90)
- (let-values (((id_122) (unsafe-car lst_90))
- ((rest_174) (unsafe-cdr lst_90)))
- (let-values (((fold-var_36)
- (let-values (((fold-var_28) fold-var_260))
- (let-values (((fold-var_207)
- (let-values ()
- (cons
- (let-values ()
- (add-scope
- id_122
- top-level-bind-scope_6))
- fold-var_28))))
- (values fold-var_207)))))
- (if (not #f)
- (for-loop_86 fold-var_36 rest_174)
- fold-var_36)))
- fold-var_260)))))
- for-loop_86)
- null
- lst_312))))))
- (values tl-ids_2 (select-defined-syms-and-bind!/ctx tmp-bind-ids_0 ctx_75)))))))))
+ (begin
+ (let-values (((tl-ids1_0) tl-ids_2) ((temp2_5) (expand-context-phase ctx_83)) ((s3_1) s_740))
+ (check-no-duplicate-ids.1 unsafe-undefined tl-ids1_0 temp2_5 s3_1 unsafe-undefined))
+ (values))))
+ (let-values (((tmp-bind-ids_0)
+ (reverse$1
+ (let-values (((fold-var_585) (let-values (((fold-var_586) null)) fold-var_586)))
+ (let-values (((lst_524) tl-ids_2))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_524))
+ ((letrec-values (((for-loop_434)
+ (lambda (fold-var_587 lst_525)
+ (begin
+ 'for-loop
+ (if (pair? lst_525)
+ (let-values (((id_146) (unsafe-car lst_525))
+ ((rest_258) (unsafe-cdr lst_525)))
+ (let-values (((fold-var_588)
+ (let-values (((fold-var_589)
+ (cons
+ (add-scope
+ id_146
+ top-level-bind-scope_6)
+ fold-var_587)))
+ (values fold-var_589))))
+ (if (not #f)
+ (for-loop_434 fold-var_588 rest_258)
+ fold-var_588)))
+ fold-var_587)))))
+ for-loop_434)
+ fold-var_585
+ lst_524)))))))
+ (values tl-ids_2 (select-defined-syms-and-bind!/ctx tmp-bind-ids_0 ctx_83)))))))))
(define-values
(make-top-add-defined-portal)
- (lambda (ns_92 ctx_8 generated-syms_0)
+ (lambda (ns_109 ctx_84 generated-syms_0)
(begin
- (lambda (id_14 phase_53 portal-stx_3 orig-s_38)
- (let-values (((ids_32 syms_25) (as-expand-time-top-level-bindings (list id_14) orig-s_38 ctx_8)))
- (let-values (((sym_100) (car syms_25)))
+ (lambda (id_147 phase_192 portal-stx_2 orig-s_39)
+ (let-values (((ids_34 syms_33) (as-expand-time-top-level-bindings (list id_147) orig-s_39 ctx_84)))
+ (let-values (((sym_122) (car syms_33)))
(begin
- (if phase_53
- (let-values ()
- (let-values (((t_33) (portal-syntax1.1 portal-stx_3)))
- (namespace-set-transformer! ns_92 phase_53 sym_100 t_33)))
+ (if phase_192
+ (let-values (((t_38) (portal-syntax1.1 portal-stx_2 #f)))
+ (namespace-set-transformer! ns_109 phase_192 sym_122 t_38))
(void))
- (set-box! generated-syms_0 (cons sym_100 (unbox generated-syms_0)))
- sym_100)))))))
+ (set-box! generated-syms_0 (cons sym_122 (unbox generated-syms_0)))
+ sym_122)))))))
(define-values
(1/eval)
(let-values (((eval_0)
- (lambda (s3_2 ns1_4 compile2_0)
+ (lambda (s3_2 ns1_5 compile2_0)
(begin
'eval
- (let-values (((s_524) s3_2))
- (let-values (((ns_93) (if (eq? ns1_4 unsafe-undefined) (1/current-namespace) ns1_4)))
+ (let-values (((s_741) s3_2))
+ (let-values (((ns_110) (if (eq? ns1_5 unsafe-undefined) (1/current-namespace) ns1_5)))
(let-values (((compile_2)
(if (eq? compile2_0 unsafe-undefined)
- (lambda (s_515 ns_94) (begin 'compile (1/compile s_515 ns_94 #f)))
+ (lambda (s_742 ns_111) (begin 'compile (1/compile s_742 ns_111 #f)))
compile2_0)))
- (let-values ()
- (if (let-values (((or-part_5) (compiled-in-memory? s_524)))
- (if or-part_5
- or-part_5
- (let-values (((or-part_6) (linklet-directory?$1 s_524)))
- (if or-part_6 or-part_6 (1/linklet-bundle? s_524)))))
- (let-values () (eval-compiled s_524 ns_93))
- (if (if (syntax?$1 s_524)
- (let-values (((or-part_7) (compiled-in-memory? (1/syntax-e s_524))))
- (if or-part_7
- or-part_7
- (let-values (((or-part_312) (linklet-directory?$1 (1/syntax-e s_524))))
- (if or-part_312 or-part_312 (1/linklet-bundle? (1/syntax-e s_524))))))
- #f)
- (let-values () (eval-compiled (1/syntax->datum s_524) ns_93))
- (let-values ()
- (let-values (((s63_0) s_524)
- ((ns64_0) ns_93)
- ((temp65_1)
- (lambda (s_6 ns_95 tail?_48)
- (eval-compiled (compile_2 s_6 ns_95) ns_95 tail?_48)))
- ((temp66_3) #f))
- (per-top-level.1 #f #f temp66_3 #t #f temp65_1 #f s63_0 ns64_0)))))))))))))
+ (if (let-values (((or-part_523) (compiled-in-memory? s_741)))
+ (if or-part_523
+ or-part_523
+ (let-values (((or-part_524) (linklet-directory?$1 s_741)))
+ (if or-part_524 or-part_524 (linklet-bundle?$1 s_741)))))
+ (eval-compiled s_741 ns_110)
+ (if (if (syntax?$1 s_741)
+ (let-values (((or-part_525) (compiled-in-memory? (1/syntax-e s_741))))
+ (if or-part_525
+ or-part_525
+ (let-values (((or-part_526) (linklet-directory?$1 (1/syntax-e s_741))))
+ (if or-part_526 or-part_526 (linklet-bundle?$1 (1/syntax-e s_741))))))
+ #f)
+ (eval-compiled (1/syntax->datum s_741) ns_110)
+ (let-values (((s63_2) s_741)
+ ((ns64_0) ns_110)
+ ((temp65_1)
+ (lambda (s_743 ns_112 tail?_49)
+ (eval-compiled (compile_2 s_743 ns_112) ns_112 tail?_49)))
+ ((temp66_2) #f))
+ (per-top-level.1 #f #f temp66_2 #t #f temp65_1 #f s63_2 ns64_0)))))))))))
(case-lambda
- ((s_525) (begin 'eval (eval_0 s_525 unsafe-undefined unsafe-undefined)))
- ((s_52 ns_96 compile2_1) (eval_0 s_52 ns_96 compile2_1))
- ((s_86 ns1_5) (eval_0 s_86 ns1_5 unsafe-undefined)))))
+ ((s_744) (begin 'eval (eval_0 s_744 unsafe-undefined unsafe-undefined)))
+ ((s_745 ns_113 compile2_1) (eval_0 s_745 ns_113 compile2_1))
+ ((s_746 ns1_6) (eval_0 s_746 ns1_6 unsafe-undefined)))))
(define-values
(eval-compiled)
(let-values (((eval-compiled_3)
(lambda (c5_0 ns6_1 as-tail?4_0)
(begin
'eval-compiled
- (let-values (((c_67) c5_0))
- (let-values (((ns_3) ns6_1))
+ (let-values (((c_88) c5_0))
+ (let-values (((ns_114) ns6_1))
(let-values (((as-tail?_3) as-tail?4_0))
- (let-values ()
- (if (1/compiled-module-expression? c_67)
- (let-values ()
- (let-values (((c67_0) c_67) ((ns68_0) ns_3)) (eval-module.1 ns68_0 #f #t c67_0)))
- (let-values () (eval-top c_67 ns_3 eval-compiled as-tail?_3)))))))))))
+ (if (1/compiled-module-expression? c_88)
+ (let-values (((c67_0) c_88) ((ns68_0) ns_114)) (eval-module.1 ns68_0 #f #t c67_0))
+ (eval-top c_88 ns_114 eval-compiled as-tail?_3)))))))))
(case-lambda
- ((c_68 ns_66) (begin (eval-compiled_3 c_68 ns_66 #t)))
- ((c_33 ns_7 as-tail?4_1) (eval-compiled_3 c_33 ns_7 as-tail?4_1)))))
+ ((c_89 ns_115) (begin (eval-compiled_3 c_89 ns_115 #t)))
+ ((c_90 ns_116 as-tail?4_1) (eval-compiled_3 c_90 ns_116 as-tail?4_1)))))
(define-values
(1/compile)
(let-values (((compile_3)
(lambda (s10_2 ns7_0 serializable?8_0 expand9_0)
(begin
'compile
- (let-values (((s_470) s10_2))
- (let-values (((ns_8) (if (eq? ns7_0 unsafe-undefined) (1/current-namespace) ns7_0)))
+ (let-values (((s_747) s10_2))
+ (let-values (((ns_117) (if (eq? ns7_0 unsafe-undefined) (1/current-namespace) ns7_0)))
(let-values (((serializable?_5) serializable?8_0))
(let-values (((expand_0) (if (eq? expand9_0 unsafe-undefined) expand$1 expand9_0)))
- (let-values ()
- (let-values (((to-correlated-linklet?_6)
- (if serializable?_5 (not (current-compile-target-machine)) #f)))
- (let-values (((cs_0)
- (if (1/compiled-expression? s_470)
- (let-values () (list s_470))
- (if (if (syntax?$1 s_470)
- (1/compiled-expression? (1/syntax-e s_470))
- #f)
- (let-values () (list (1/syntax-e s_470)))
- (let-values ()
- (let-values (((s69_1) s_470)
- ((ns70_0) ns_8)
- ((temp71_0)
- (lambda (s_18 ns_97 as-tail?_4)
- (list
- (let-values (((s74_1) s_18)
- ((ns75_0) ns_97)
- ((expand76_0) expand_0)
- ((serializable?77_0) serializable?_5)
- ((to-correlated-linklet?78_0)
- to-correlated-linklet?_6))
- (compile-single.1
- serializable?77_0
- to-correlated-linklet?78_0
- s74_1
- ns75_0
- expand76_0)))))
- ((append72_0) append)
- ((temp73_3) #f))
- (per-top-level.1
- append72_0
- #f
- temp73_3
- #t
- #f
- temp71_0
- #f
- s69_1
- ns70_0)))))))
- (if (if (= 1 (length cs_0)) (not (compiled-multiple-top? (car cs_0))) #f)
- (car cs_0)
- (let-values (((cs79_0) cs_0)
- ((to-correlated-linklet?80_0) to-correlated-linklet?_6)
- ((serializable?81_0) serializable?_5)
- ((ns82_0) ns_8))
- (compiled-tops->compiled-top.1
- serializable?81_0
- ns82_0
- to-correlated-linklet?80_0
- cs79_0))))))))))))))
+ (let-values (((to-correlated-linklet?_8)
+ (if serializable?_5 (not (current-compile-target-machine)) #f)))
+ (let-values (((cs_0)
+ (if (1/compiled-expression? s_747)
+ (list s_747)
+ (if (if (syntax?$1 s_747) (1/compiled-expression? (1/syntax-e s_747)) #f)
+ (list (1/syntax-e s_747))
+ (let-values (((s69_0) s_747)
+ ((ns70_0) ns_117)
+ ((temp71_1)
+ (lambda (s_748 ns_118 as-tail?_4)
+ (list
+ (let-values (((s74_1) s_748)
+ ((ns75_0) ns_118)
+ ((expand76_0) expand_0)
+ ((serializable?77_0) serializable?_5)
+ ((to-correlated-linklet?78_0)
+ to-correlated-linklet?_8))
+ (compile-single.1
+ serializable?77_0
+ to-correlated-linklet?78_0
+ s74_1
+ ns75_0
+ expand76_0)))))
+ ((append72_0) append)
+ ((temp73_3) #f))
+ (per-top-level.1
+ append72_0
+ #f
+ temp73_3
+ #t
+ #f
+ temp71_1
+ #f
+ s69_0
+ ns70_0))))))
+ (if (if (= 1 (length cs_0)) (not (compiled-multiple-top? (car cs_0))) #f)
+ (car cs_0)
+ (let-values (((cs79_0) cs_0)
+ ((to-correlated-linklet?80_0) to-correlated-linklet?_8)
+ ((serializable?81_0) serializable?_5)
+ ((ns82_0) ns_117))
+ (compiled-tops->compiled-top.1
+ serializable?81_0
+ ns82_0
+ to-correlated-linklet?80_0
+ cs79_0)))))))))))))
(case-lambda
- ((s_526) (begin 'compile (compile_3 s_526 unsafe-undefined #t unsafe-undefined)))
- ((s_26 ns_98 serializable?_6 expand9_1) (compile_3 s_26 ns_98 serializable?_6 expand9_1))
- ((s_527 ns_13 serializable?8_1) (compile_3 s_527 ns_13 serializable?8_1 unsafe-undefined))
- ((s_528 ns7_1) (compile_3 s_528 ns7_1 #t unsafe-undefined)))))
+ ((s_749) (begin 'compile (compile_3 s_749 unsafe-undefined #t unsafe-undefined)))
+ ((s_750 ns_119 serializable?_6 expand9_1) (compile_3 s_750 ns_119 serializable?_6 expand9_1))
+ ((s_751 ns_120 serializable?8_1) (compile_3 s_751 ns_120 serializable?8_1 unsafe-undefined))
+ ((s_752 ns7_1) (compile_3 s_752 ns7_1 #t unsafe-undefined)))))
(define-values
(struct:lifted-parsed-begin
lifted-parsed-begin11.1
lifted-parsed-begin?
lifted-parsed-begin-seq
lifted-parsed-begin-last)
- (let-values (((struct:_70 make-_70 ?_70 -ref_70 -set!_70)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'lifted-parsed-begin
- #f
- 2
- 0
- #f
- null
- (current-inspector)
- #f
- '(0 1)
- #f
- 'lifted-parsed-begin)))))
+ (let-values (((struct:_128 make-_128 ?_128 -ref_128 -set!_128)
+ (make-struct-type
+ 'lifted-parsed-begin
+ #f
+ 2
+ 0
+ #f
+ null
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'lifted-parsed-begin)))
(values
- struct:_70
- make-_70
- ?_70
- (make-struct-field-accessor -ref_70 0 'seq)
- (make-struct-field-accessor -ref_70 1 'last))))
+ struct:_128
+ make-_128
+ ?_128
+ (make-struct-field-accessor -ref_128 0 'seq)
+ (make-struct-field-accessor -ref_128 1 'last))))
(define-values
(compile-single.1)
- (lambda (serializable?12_1 to-correlated-linklet?13_0 s16_1 ns17_1 expand18_0)
+ (lambda (serializable?12_1 to-correlated-linklet?13_0 s16_0 ns17_1 expand18_0)
(begin
'compile-single
- (let-values (((s_529) s16_1))
- (let-values (((ns_99) ns17_1))
+ (let-values (((s_753) s16_0))
+ (let-values (((ns_121) ns17_1))
(let-values (((expand_1) expand18_0))
(let-values (((serializable?_7) serializable?12_1))
- (let-values (((to-correlated-linklet?_7) to-correlated-linklet?13_0))
- (let-values ()
- (let-values (((exp-s_4) (expand_1 s_529 ns_99 #f #t serializable?_7 to-correlated-linklet?_7)))
- ((letrec-values (((loop_102)
- (lambda (exp-s_5)
- (begin
- 'loop
+ (let-values (((to-correlated-linklet?_9) to-correlated-linklet?13_0))
+ (let-values (((exp-s_4) (expand_1 s_753 ns_121 #f #t serializable?_7 to-correlated-linklet?_9)))
+ ((letrec-values (((loop_116)
+ (lambda (exp-s_5)
+ (begin
+ 'loop
+ (if (parsed-bundle? exp-s_5)
+ (1/compiled-expression-recompile (parsed-bundle-bundle exp-s_5))
(if (parsed-module? exp-s_5)
- (let-values ()
- (let-values (((exp-s84_0) exp-s_5)
- ((temp85_2)
- (let-values (((ns88_0) ns_99))
- (make-compile-context.1
- #f
- unsafe-undefined
- #f
- ns88_0
- unsafe-undefined
- unsafe-undefined)))
- ((serializable?86_0) serializable?_7)
- ((to-correlated-linklet?87_0) to-correlated-linklet?_7))
- (compile-module.1
- #f
- unsafe-undefined
- #t
- serializable?86_0
- to-correlated-linklet?87_0
- exp-s84_0
- temp85_2)))
+ (let-values (((exp-s84_0) exp-s_5)
+ ((temp85_1)
+ (let-values (((ns88_0) ns_121))
+ (make-compile-context.1
+ #f
+ unsafe-undefined
+ #f
+ ns88_0
+ unsafe-undefined
+ unsafe-undefined)))
+ ((serializable?86_0) serializable?_7)
+ ((to-correlated-linklet?87_0) to-correlated-linklet?_9))
+ (compile-module.1
+ #f
+ unsafe-undefined
+ #t
+ serializable?86_0
+ to-correlated-linklet?87_0
+ exp-s84_0
+ temp85_1))
(if (lifted-parsed-begin? exp-s_5)
- (let-values ()
- (let-values (((to-correlated-linklet?89_0) to-correlated-linklet?_7)
- ((temp90_1)
- (reverse$1
- (let-values (((lst_185)
+ (let-values (((to-correlated-linklet?89_0) to-correlated-linklet?_9)
+ ((temp90_0)
+ (reverse$1
+ (let-values (((fold-var_590)
+ (let-values (((fold-var_591) null))
+ fold-var_591)))
+ (let-values (((lst_526)
(append
(lifted-parsed-begin-seq exp-s_5)
(list
@@ -53488,352 +52713,325 @@
(if (variable-reference-from-unsafe?
(#%variable-reference))
(void)
- (let-values () (check-list lst_185)))
- ((letrec-values (((for-loop_288)
- (lambda (fold-var_292 lst_288)
+ (check-list lst_526))
+ ((letrec-values (((for-loop_435)
+ (lambda (fold-var_592 lst_527)
(begin
'for-loop
- (if (pair? lst_288)
- (let-values (((e_83)
+ (if (pair? lst_527)
+ (let-values (((e_92)
(unsafe-car
- lst_288))
- ((rest_175)
+ lst_527))
+ ((rest_259)
(unsafe-cdr
- lst_288)))
- (let-values (((fold-var_259)
- (let-values (((fold-var_215)
- fold-var_292))
- (let-values (((fold-var_216)
- (let-values ()
- (cons
- (let-values ()
- (loop_102
- e_83))
- fold-var_215))))
- (values
- fold-var_216)))))
+ lst_527)))
+ (let-values (((fold-var_593)
+ (let-values (((fold-var_594)
+ (cons
+ (loop_116
+ e_92)
+ fold-var_592)))
+ (values
+ fold-var_594))))
(if (not #f)
- (for-loop_288
- fold-var_259
- rest_175)
- fold-var_259)))
- fold-var_292)))))
- for-loop_288)
- null
- lst_185))))))
- (compiled-tops->compiled-top.1
- #f
- #f
- to-correlated-linklet?89_0
- temp90_1)))
- (let-values ()
- (let-values (((exp-s91_0) exp-s_5)
- ((temp92_1)
- (let-values (((ns95_0) ns_99))
- (make-compile-context.1
- #f
- unsafe-undefined
- #f
- ns95_0
- unsafe-undefined
- unsafe-undefined)))
- ((serializable?93_0) serializable?_7)
- ((to-correlated-linklet?94_0) to-correlated-linklet?_7))
- (compile-top.1
- serializable?93_0
- #f
- to-correlated-linklet?94_0
- exp-s91_0
- temp92_1)))))))))
- loop_102)
- exp-s_4)))))))))))
+ (for-loop_435
+ fold-var_593
+ rest_259)
+ fold-var_593)))
+ fold-var_592)))))
+ for-loop_435)
+ fold-var_590
+ lst_526)))))))
+ (compiled-tops->compiled-top.1
+ #f
+ #f
+ to-correlated-linklet?89_0
+ temp90_0))
+ (let-values (((exp-s91_0) exp-s_5)
+ ((temp92_3)
+ (let-values (((ns95_0) ns_121))
+ (make-compile-context.1
+ #f
+ unsafe-undefined
+ #f
+ ns95_0
+ unsafe-undefined
+ unsafe-undefined)))
+ ((serializable?93_0) serializable?_7)
+ ((to-correlated-linklet?94_0) to-correlated-linklet?_9))
+ (compile-top.1
+ serializable?93_0
+ #f
+ to-correlated-linklet?94_0
+ exp-s91_0
+ temp92_3)))))))))
+ loop_116)
+ exp-s_4))))))))))
(define-values
(expand$1)
(let-values (((expand_2)
(lambda (s25_1 ns20_2 observable?21_0 to-parsed?22_0 serializable?23_0 to-correlated-linklet?24_0)
(begin
'expand
- (let-values (((s_202) s25_1))
- (let-values (((ns_100) (if (eq? ns20_2 unsafe-undefined) (1/current-namespace) ns20_2)))
+ (let-values (((s_754) s25_1))
+ (let-values (((ns_122) (if (eq? ns20_2 unsafe-undefined) (1/current-namespace) ns20_2)))
(let-values (((observable?_0) observable?21_0))
(let-values (((to-parsed?_2) to-parsed?22_0))
(let-values (((serializable?_8) serializable?23_0))
- (let-values (((to-correlated-linklet?_8) to-correlated-linklet?24_0))
- (let-values ()
- (let-values (((observer_2) (if observable?_0 (current-expand-observe) #f)))
- (begin
- (if observer_2 (let-values () (call-expand-observe observer_2 'start-top)) (void))
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first #f parameterization-key)
- current-expand-observe
- #f)
- (let-values ()
- (let-values (((s96_0) s_202)
- ((ns97_2) ns_100)
- ((temp98_2)
- (lambda (s_340 ns_101 as-tail?_5)
- (let-values (((s102_0) s_340)
- ((ns103_0) ns_101)
- ((observer104_0) observer_2)
- ((to-parsed?105_0) to-parsed?_2)
- ((serializable?106_0) serializable?_8)
- ((to-correlated-linklet?107_0)
- to-correlated-linklet?_8))
- (expand-single.1
- serializable?106_0
- to-correlated-linklet?107_0
- s102_0
- ns103_0
- observer104_0
- to-parsed?105_0))))
- ((cons99_0) cons)
- ((re-pair100_0) re-pair)
- ((observer101_0) observer_2))
- (per-top-level.1
- cons99_0
- #f
- observer101_0
- #t
- #f
- temp98_2
- re-pair100_0
- s96_0
- ns97_2)))))))))))))))))
+ (let-values (((to-correlated-linklet?_10) to-correlated-linklet?24_0))
+ (let-values (((observer_2) (if observable?_0 (current-expand-observe) #f)))
+ (begin
+ (if observer_2 (call-expand-observe observer_2 'start-top) (void))
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first #f parameterization-key)
+ current-expand-observe
+ #f)
+ (let-values (((s96_0) s_754)
+ ((ns97_2) ns_122)
+ ((temp98_3)
+ (lambda (s_755 ns_123 as-tail?_5)
+ (let-values (((s102_0) s_755)
+ ((ns103_0) ns_123)
+ ((observer104_0) observer_2)
+ ((to-parsed?105_0) to-parsed?_2)
+ ((serializable?106_0) serializable?_8)
+ ((to-correlated-linklet?107_0)
+ to-correlated-linklet?_10))
+ (expand-single.1
+ serializable?106_0
+ to-correlated-linklet?107_0
+ s102_0
+ ns103_0
+ observer104_0
+ to-parsed?105_0))))
+ ((cons99_0) cons)
+ ((re-pair100_0) re-pair)
+ ((observer101_0) observer_2))
+ (per-top-level.1
+ cons99_0
+ #f
+ observer101_0
+ #t
+ #f
+ temp98_3
+ re-pair100_0
+ s96_0
+ ns97_2)))))))))))))))
(case-lambda
- ((s_530) (begin 'expand (expand_2 s_530 unsafe-undefined #f #f #f #f)))
- ((s_531 ns_102 observable?_1 to-parsed?_3 serializable?_9 to-correlated-linklet?24_1)
- (expand_2 s_531 ns_102 observable?_1 to-parsed?_3 serializable?_9 to-correlated-linklet?24_1))
- ((s_462 ns_103 observable?_2 to-parsed?_4 serializable?23_1)
- (expand_2 s_462 ns_103 observable?_2 to-parsed?_4 serializable?23_1 #f))
- ((s_532 ns_104 observable?_3 to-parsed?22_1) (expand_2 s_532 ns_104 observable?_3 to-parsed?22_1 #f #f))
- ((s_104 ns_105 observable?21_1) (expand_2 s_104 ns_105 observable?21_1 #f #f #f))
- ((s_533 ns20_3) (expand_2 s_533 ns20_3 #f #f #f #f)))))
+ ((s_756) (begin 'expand (expand_2 s_756 unsafe-undefined #f #f #f #f)))
+ ((s_757 ns_124 observable?_1 to-parsed?_3 serializable?_9 to-correlated-linklet?24_1)
+ (expand_2 s_757 ns_124 observable?_1 to-parsed?_3 serializable?_9 to-correlated-linklet?24_1))
+ ((s_758 ns_125 observable?_2 to-parsed?_4 serializable?23_1)
+ (expand_2 s_758 ns_125 observable?_2 to-parsed?_4 serializable?23_1 #f))
+ ((s_759 ns_126 observable?_3 to-parsed?22_1) (expand_2 s_759 ns_126 observable?_3 to-parsed?22_1 #f #f))
+ ((s_760 ns_127 observable?21_1) (expand_2 s_760 ns_127 observable?21_1 #f #f #f))
+ ((s_761 ns20_3) (expand_2 s_761 ns20_3 #f #f #f #f)))))
(define-values
(expand-single.1)
(lambda (serializable?26_0 to-correlated-linklet?27_0 s30_0 ns31_2 observer32_0 to-parsed?33_0)
(begin
'expand-single
- (let-values (((s_82) s30_0))
- (let-values (((ns_106) ns31_2))
+ (let-values (((s_762) s30_0))
+ (let-values (((ns_128) ns31_2))
(let-values (((observer_3) observer32_0))
(let-values (((to-parsed?_5) to-parsed?33_0))
(let-values (((serializable?_10) serializable?26_0))
- (let-values (((to-correlated-linklet?_9) to-correlated-linklet?27_0))
- (let-values ()
- (let-values (((rebuild-s_2) (keep-properties-only s_82)))
- (let-values (((ctx_76)
- (let-values (((ns108_0) ns_106)
- ((to-parsed?109_0) to-parsed?_5)
- ((serializable?110_0) serializable?_10)
- ((to-correlated-linklet?111_0) to-correlated-linklet?_9)
- ((observer112_0) observer_3))
- (make-expand-context.1
- serializable?110_0
- observer112_0
- #f
- to-correlated-linklet?111_0
- to-parsed?109_0
- ns108_0))))
- (let-values (((require-lifts_4 lifts_10 exp-s_6) (expand-capturing-lifts s_82 ctx_76)))
- (if (if (null? require-lifts_4) (null? lifts_10) #f)
- (let-values () exp-s_6)
- (if to-parsed?_5
- (let-values ()
- (let-values (((require-lifts113_0) require-lifts_4)
- ((lifts114_0) lifts_10)
- ((exp-s115_0) exp-s_6)
- ((rebuild-s116_0) rebuild-s_2)
- ((temp117_2)
- (lambda (form_0)
- (let-values (((form118_0) form_0)
- ((ns119_0) ns_106)
- ((observer120_0) observer_3)
- ((to-parsed?121_0) to-parsed?_5)
- ((serializable?122_0) serializable?_10))
- (expand-single.1
- serializable?122_0
- #f
- form118_0
- ns119_0
- observer120_0
- to-parsed?121_0)))))
- (wrap-lifts-as-lifted-parsed-begin.1
- temp117_2
- require-lifts113_0
- lifts114_0
- exp-s115_0
- rebuild-s116_0)))
- (let-values ()
- (let-values (((new-s_6)
- (let-values (((temp128_3)
- (append (map2 parsed-s require-lifts_4) lifts_10))
- ((exp-s129_0) exp-s_6)
- ((temp130_0) (namespace-phase ns_106)))
- (wrap-lifts-as-begin.1
- unsafe-undefined
- unsafe-undefined
- temp128_3
- exp-s129_0
- temp130_0))))
- (begin
- (let-values (((obs_49) (expand-context-observer ctx_76)))
- (if obs_49
- (let-values () (let-values () (call-expand-observe obs_49 'lift-loop new-s_6)))
- (void)))
- (let-values (((new-s123_0) new-s_6)
- ((ns124_0) ns_106)
- ((observer125_0) observer_3)
- ((to-parsed?126_0) to-parsed?_5)
- ((serializable?127_0) serializable?_10))
- (expand-single.1
- serializable?127_0
- #f
- new-s123_0
- ns124_0
- observer125_0
- to-parsed?126_0))))))))))))))))))))
+ (let-values (((to-correlated-linklet?_11) to-correlated-linklet?27_0))
+ (let-values (((rebuild-s_2) (keep-properties-only s_762)))
+ (let-values (((ctx_85)
+ (let-values (((ns108_0) ns_128)
+ ((to-parsed?109_0) to-parsed?_5)
+ ((serializable?110_0) serializable?_10)
+ ((to-correlated-linklet?111_0) to-correlated-linklet?_11)
+ ((observer112_0) observer_3))
+ (make-expand-context.1
+ serializable?110_0
+ observer112_0
+ #f
+ to-correlated-linklet?111_0
+ to-parsed?109_0
+ ns108_0))))
+ (let-values (((require-lifts_4 lifts_10 exp-s_6) (expand-capturing-lifts s_762 ctx_85)))
+ (if (if (null? require-lifts_4) (null? lifts_10) #f)
+ exp-s_6
+ (if to-parsed?_5
+ (let-values (((require-lifts113_0) require-lifts_4)
+ ((lifts114_0) lifts_10)
+ ((exp-s115_0) exp-s_6)
+ ((rebuild-s116_0) rebuild-s_2)
+ ((temp117_0)
+ (lambda (form_0)
+ (let-values (((form118_0) form_0)
+ ((ns119_0) ns_128)
+ ((observer120_0) observer_3)
+ ((to-parsed?121_0) to-parsed?_5)
+ ((serializable?122_0) serializable?_10))
+ (expand-single.1
+ serializable?122_0
+ #f
+ form118_0
+ ns119_0
+ observer120_0
+ to-parsed?121_0)))))
+ (wrap-lifts-as-lifted-parsed-begin.1
+ temp117_0
+ require-lifts113_0
+ lifts114_0
+ exp-s115_0
+ rebuild-s116_0))
+ (let-values (((new-s_7)
+ (let-values (((temp128_3) (append (map2 parsed-s require-lifts_4) lifts_10))
+ ((exp-s129_0) exp-s_6)
+ ((temp130_0) (namespace-phase ns_128)))
+ (wrap-lifts-as-begin.1
+ unsafe-undefined
+ unsafe-undefined
+ temp128_3
+ exp-s129_0
+ temp130_0))))
+ (begin
+ (let-values (((obs_51) (expand-context-observer ctx_85)))
+ (if obs_51 (call-expand-observe obs_51 'lift-loop new-s_7) (void)))
+ (let-values (((new-s123_0) new-s_7)
+ ((ns124_0) ns_128)
+ ((observer125_0) observer_3)
+ ((to-parsed?126_0) to-parsed?_5)
+ ((serializable?127_0) serializable?_10))
+ (expand-single.1
+ serializable?127_0
+ #f
+ new-s123_0
+ ns124_0
+ observer125_0
+ to-parsed?126_0))))))))))))))))))
(define-values
(expand-once$1)
(let-values (((expand-once_0)
(lambda (s36_0 ns35_2)
(begin
'expand-once
- (let-values (((s_214) s36_0))
- (let-values (((ns_107) (if (eq? ns35_2 unsafe-undefined) (1/current-namespace) ns35_2)))
- (let-values ()
- (let-values (((s131_0) s_214)
- ((ns132_0) ns_107)
- ((temp133_2)
- (lambda (s_219 ns_108 as-tail?_6) (expand-single-once s_219 ns_108)))
- ((cons134_0) cons)
- ((re-pair135_0) re-pair)
- ((temp136_3) #t)
- ((temp137_2) #f))
- (per-top-level.1
- cons134_0
- temp136_3
- temp137_2
- #t
- #f
- temp133_2
- re-pair135_0
- s131_0
- ns132_0)))))))))
+ (let-values (((s_763) s36_0))
+ (let-values (((ns_129) (if (eq? ns35_2 unsafe-undefined) (1/current-namespace) ns35_2)))
+ (let-values (((s131_1) s_763)
+ ((ns132_0) ns_129)
+ ((temp133_2) (lambda (s_764 ns_130 as-tail?_6) (expand-single-once s_764 ns_130)))
+ ((cons134_0) cons)
+ ((re-pair135_0) re-pair)
+ ((temp136_3) #t)
+ ((temp137_3) #f))
+ (per-top-level.1
+ cons134_0
+ temp136_3
+ temp137_3
+ #t
+ #f
+ temp133_2
+ re-pair135_0
+ s131_1
+ ns132_0))))))))
(case-lambda
- ((s_534) (begin 'expand-once (expand-once_0 s_534 unsafe-undefined)))
- ((s_535 ns35_3) (expand-once_0 s_535 ns35_3)))))
+ ((s_765) (begin 'expand-once (expand-once_0 s_765 unsafe-undefined)))
+ ((s_766 ns35_3) (expand-once_0 s_766 ns35_3)))))
(define-values
(expand-single-once)
- (lambda (s_118 ns_109)
+ (lambda (s_767 ns_131)
(begin
(let-values (((require-lifts_5 lifts_11 exp-s_7)
(expand-capturing-lifts
- s_118
- (let-values (((v_207)
- (let-values (((ns138_0) ns_109)) (make-expand-context.1 #f #f #f #f #f ns138_0))))
- (let-values (((the-struct_66) v_207))
- (if (expand-context/outer? the-struct_66)
+ s_767
+ (let-values (((v_286)
+ (let-values (((ns138_1) ns_131)) (make-expand-context.1 #f #f #f #f #f ns138_1))))
+ (let-values (((the-struct_71) v_286))
+ (if (expand-context/outer? the-struct_71)
(let-values (((inner139_0)
- (let-values (((the-struct_67) (root-expand-context/outer-inner v_207)))
- (if (expand-context/inner? the-struct_67)
+ (let-values (((the-struct_72) (root-expand-context/outer-inner v_286)))
+ (if (expand-context/inner? the-struct_72)
(let-values (((just-once?140_0) #t))
(expand-context/inner2.1
- (root-expand-context/inner-self-mpi the-struct_67)
- (root-expand-context/inner-module-scopes the-struct_67)
- (root-expand-context/inner-top-level-bind-scope the-struct_67)
- (root-expand-context/inner-all-scopes-stx the-struct_67)
- (root-expand-context/inner-defined-syms the-struct_67)
- (root-expand-context/inner-counter the-struct_67)
- (root-expand-context/inner-lift-key the-struct_67)
- (expand-context/inner-to-parsed? the-struct_67)
- (expand-context/inner-phase the-struct_67)
- (expand-context/inner-namespace the-struct_67)
+ (root-expand-context/inner-self-mpi the-struct_72)
+ (root-expand-context/inner-module-scopes the-struct_72)
+ (root-expand-context/inner-top-level-bind-scope the-struct_72)
+ (root-expand-context/inner-all-scopes-stx the-struct_72)
+ (root-expand-context/inner-defined-syms the-struct_72)
+ (root-expand-context/inner-counter the-struct_72)
+ (root-expand-context/inner-lift-key the-struct_72)
+ (expand-context/inner-to-parsed? the-struct_72)
+ (expand-context/inner-phase the-struct_72)
+ (expand-context/inner-namespace the-struct_72)
just-once?140_0
- (expand-context/inner-module-begin-k the-struct_67)
- (expand-context/inner-allow-unbound? the-struct_67)
- (expand-context/inner-in-local-expand? the-struct_67)
- (expand-context/inner-keep-#%expression? the-struct_67)
- (expand-context/inner-stops the-struct_67)
- (expand-context/inner-declared-submodule-names the-struct_67)
- (expand-context/inner-lifts the-struct_67)
- (expand-context/inner-lift-envs the-struct_67)
- (expand-context/inner-module-lifts the-struct_67)
- (expand-context/inner-require-lifts the-struct_67)
- (expand-context/inner-to-module-lifts the-struct_67)
- (expand-context/inner-requires+provides the-struct_67)
- (expand-context/inner-observer the-struct_67)
- (expand-context/inner-for-serializable? the-struct_67)
- (expand-context/inner-to-correlated-linklet? the-struct_67)
- (expand-context/inner-normalize-locals? the-struct_67)
- (expand-context/inner-parsing-expanded? the-struct_67)
- (expand-context/inner-skip-visit-available? the-struct_67)))
+ (expand-context/inner-module-begin-k the-struct_72)
+ (expand-context/inner-allow-unbound? the-struct_72)
+ (expand-context/inner-in-local-expand? the-struct_72)
+ (expand-context/inner-keep-#%expression? the-struct_72)
+ (expand-context/inner-stops the-struct_72)
+ (expand-context/inner-declared-submodule-names the-struct_72)
+ (expand-context/inner-lifts the-struct_72)
+ (expand-context/inner-lift-envs the-struct_72)
+ (expand-context/inner-module-lifts the-struct_72)
+ (expand-context/inner-require-lifts the-struct_72)
+ (expand-context/inner-to-module-lifts the-struct_72)
+ (expand-context/inner-requires+provides the-struct_72)
+ (expand-context/inner-observer the-struct_72)
+ (expand-context/inner-for-serializable? the-struct_72)
+ (expand-context/inner-to-correlated-linklet? the-struct_72)
+ (expand-context/inner-normalize-locals? the-struct_72)
+ (expand-context/inner-parsing-expanded? the-struct_72)
+ (expand-context/inner-skip-visit-available? the-struct_72)))
(raise-argument-error
'struct-copy
"expand-context/inner?"
- the-struct_67)))))
+ the-struct_72)))))
(expand-context/outer1.1
inner139_0
- (root-expand-context/outer-post-expansion the-struct_66)
- (root-expand-context/outer-use-site-scopes the-struct_66)
- (root-expand-context/outer-frame-id the-struct_66)
- (expand-context/outer-context the-struct_66)
- (expand-context/outer-env the-struct_66)
- (expand-context/outer-scopes the-struct_66)
- (expand-context/outer-def-ctx-scopes the-struct_66)
- (expand-context/outer-binding-layer the-struct_66)
- (expand-context/outer-reference-records the-struct_66)
- (expand-context/outer-only-immediate? the-struct_66)
- (expand-context/outer-need-eventually-defined the-struct_66)
- (expand-context/outer-current-introduction-scopes the-struct_66)
- (expand-context/outer-current-use-scopes the-struct_66)
- (expand-context/outer-name the-struct_66)))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_66)))))))
+ (root-expand-context/outer-post-expansion the-struct_71)
+ (root-expand-context/outer-use-site-scopes the-struct_71)
+ (root-expand-context/outer-frame-id the-struct_71)
+ (expand-context/outer-context the-struct_71)
+ (expand-context/outer-env the-struct_71)
+ (expand-context/outer-scopes the-struct_71)
+ (expand-context/outer-def-ctx-scopes the-struct_71)
+ (expand-context/outer-binding-layer the-struct_71)
+ (expand-context/outer-reference-records the-struct_71)
+ (expand-context/outer-only-immediate? the-struct_71)
+ (expand-context/outer-need-eventually-defined the-struct_71)
+ (expand-context/outer-current-introduction-scopes the-struct_71)
+ (expand-context/outer-current-use-scopes the-struct_71)
+ (expand-context/outer-name the-struct_71)))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_71)))))))
(if (if (null? require-lifts_5) (null? lifts_11) #f)
- (let-values () exp-s_7)
- (let-values ()
- (let-values (((temp141_1) (append (map2 parsed-s require-lifts_5) lifts_11))
- ((exp-s142_0) exp-s_7)
- ((temp143_1) (namespace-phase ns_109)))
- (wrap-lifts-as-begin.1 unsafe-undefined unsafe-undefined temp141_1 exp-s142_0 temp143_1))))))))
+ exp-s_7
+ (let-values (((temp141_1) (append (map2 parsed-s require-lifts_5) lifts_11))
+ ((exp-s142_0) exp-s_7)
+ ((temp143_1) (namespace-phase ns_131)))
+ (wrap-lifts-as-begin.1 unsafe-undefined unsafe-undefined temp141_1 exp-s142_0 temp143_1)))))))
(define-values
(expand-to-top-form$1)
(let-values (((expand-to-top-form_0)
(lambda (s38_1 ns37_2)
(begin
'expand-to-top-form
- (let-values (((s_346) s38_1))
- (let-values (((ns_110) (if (eq? ns37_2 unsafe-undefined) (1/current-namespace) ns37_2)))
- (let-values ()
- (let-values (((observer_4) (current-expand-observe)))
- (begin
- (if observer_4 (let-values () (call-expand-observe observer_4 'start-top)) (void))
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first #f parameterization-key)
- current-expand-observe
- #f)
- (let-values ()
- (let-values (((s144_0) s_346)
- ((ns145_0) ns_110)
- ((temp146_1) #f)
- ((temp147_0) #f)
- ((observer148_0) observer_4))
- (per-top-level.1
- #f
- #f
- observer148_0
- temp147_0
- #f
- temp146_1
- #f
- s144_0
- ns145_0)))))))))))))
+ (let-values (((s_768) s38_1))
+ (let-values (((ns_132) (if (eq? ns37_2 unsafe-undefined) (1/current-namespace) ns37_2)))
+ (let-values (((observer_4) (current-expand-observe)))
+ (begin
+ (if observer_4 (call-expand-observe observer_4 'start-top) (void))
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first #f parameterization-key)
+ current-expand-observe
+ #f)
+ (let-values (((s144_0) s_768)
+ ((ns145_0) ns_132)
+ ((temp146_0) #f)
+ ((temp147_0) #f)
+ ((observer148_0) observer_4))
+ (per-top-level.1 #f #f observer148_0 temp147_0 #f temp146_0 #f s144_0 ns145_0)))))))))))
(case-lambda
- ((s_324) (begin 'expand-to-top-form (expand-to-top-form_0 s_324 unsafe-undefined)))
- ((s_222 ns37_3) (expand-to-top-form_0 s_222 ns37_3)))))
+ ((s_769) (begin 'expand-to-top-form (expand-to-top-form_0 s_769 unsafe-undefined)))
+ ((s_770 ns37_3) (expand-to-top-form_0 s_770 ns37_3)))))
(define-values
(per-top-level.1)
(lambda (combine40_0
@@ -53848,7 +53046,7 @@
(begin
'per-top-level
(let-values (((given-s_0) given-s53_0))
- (let-values (((ns_111) ns54_0))
+ (let-values (((ns_133) ns54_0))
(let-values (((single_0) single39_0))
(let-values (((combine_0) combine40_0))
(let-values (((wrap_4) wrap41_0))
@@ -53856,828 +53054,760 @@
(let-values (((quick-immediate?_0) quick-immediate?43_0))
(let-values (((serializable?_11) serializable?44_0))
(let-values (((observer_5) observer45_0))
- (let-values ()
- (let-values (((s_536) (maybe-intro given-s_0 ns_111)))
- (let-values (((ctx_77)
- (let-values (((ns149_0) ns_111) ((observer150_0) observer_5))
- (make-expand-context.1 #f observer150_0 #f #f #f ns149_0))))
- (let-values (((phase_153) (namespace-phase ns_111)))
- ((letrec-values (((loop_103)
- (lambda (s_479 phase_154 ns_112 as-tail?_7)
- (begin
- 'loop
- (let-values (((tl-ctx_0)
- (let-values (((v_208) ctx_77))
- (let-values (((the-struct_68) v_208))
- (if (expand-context/outer? the-struct_68)
- (let-values (((inner151_0)
- (let-values (((the-struct_69)
- (root-expand-context/outer-inner
- v_208)))
- (if (expand-context/inner?
- the-struct_69)
- (let-values (((phase152_0)
- phase_154)
- ((namespace153_0)
- ns_112)
- ((just-once?154_0)
- just-once?_1)
- ((for-serializable?155_0)
- serializable?_11))
- (expand-context/inner2.1
- (root-expand-context/inner-self-mpi
- the-struct_69)
- (root-expand-context/inner-module-scopes
- the-struct_69)
- (root-expand-context/inner-top-level-bind-scope
- the-struct_69)
- (root-expand-context/inner-all-scopes-stx
- the-struct_69)
- (root-expand-context/inner-defined-syms
- the-struct_69)
- (root-expand-context/inner-counter
- the-struct_69)
- (root-expand-context/inner-lift-key
- the-struct_69)
- (expand-context/inner-to-parsed?
- the-struct_69)
- phase152_0
- namespace153_0
- just-once?154_0
- (expand-context/inner-module-begin-k
- the-struct_69)
- (expand-context/inner-allow-unbound?
- the-struct_69)
- (expand-context/inner-in-local-expand?
- the-struct_69)
- (expand-context/inner-keep-#%expression?
- the-struct_69)
- (expand-context/inner-stops
- the-struct_69)
- (expand-context/inner-declared-submodule-names
- the-struct_69)
- (expand-context/inner-lifts
- the-struct_69)
- (expand-context/inner-lift-envs
- the-struct_69)
- (expand-context/inner-module-lifts
- the-struct_69)
- (expand-context/inner-require-lifts
- the-struct_69)
- (expand-context/inner-to-module-lifts
- the-struct_69)
- (expand-context/inner-requires+provides
- the-struct_69)
- (expand-context/inner-observer
- the-struct_69)
- for-serializable?155_0
- (expand-context/inner-to-correlated-linklet?
- the-struct_69)
- (expand-context/inner-normalize-locals?
- the-struct_69)
- (expand-context/inner-parsing-expanded?
- the-struct_69)
- (expand-context/inner-skip-visit-available?
- the-struct_69)))
- (raise-argument-error
- 'struct-copy
- "expand-context/inner?"
- the-struct_69)))))
- (expand-context/outer1.1
- inner151_0
- (root-expand-context/outer-post-expansion
- the-struct_68)
- (root-expand-context/outer-use-site-scopes
- the-struct_68)
- (root-expand-context/outer-frame-id
- the-struct_68)
- (expand-context/outer-context
- the-struct_68)
- (expand-context/outer-env the-struct_68)
- (expand-context/outer-scopes the-struct_68)
- (expand-context/outer-def-ctx-scopes
- the-struct_68)
- (expand-context/outer-binding-layer
- the-struct_68)
- (expand-context/outer-reference-records
- the-struct_68)
- (expand-context/outer-only-immediate?
- the-struct_68)
- (expand-context/outer-need-eventually-defined
- the-struct_68)
- (expand-context/outer-current-introduction-scopes
- the-struct_68)
- (expand-context/outer-current-use-scopes
- the-struct_68)
- (expand-context/outer-name the-struct_68)))
- (raise-argument-error
- 'struct-copy
- "expand-context/outer?"
- the-struct_68))))))
- (let-values (((wb-s_0) (if just-once?_1 s_479 #f)))
- (let-values ((()
- (begin
- (let-values (((obs_50)
- (expand-context-observer
- tl-ctx_0)))
- (if obs_50
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_50
- 'visit
- s_479)))
- (void)))
- (values))))
- (let-values (((require-lifts_6 lifts_12 exp-s_8)
- (expand-capturing-lifts
- s_479
- (let-values (((v_209) tl-ctx_0))
- (let-values (((the-struct_70) v_209))
- (if (expand-context/outer? the-struct_70)
- (let-values (((only-immediate?156_0)
- #t)
- ((inner157_0)
- (let-values (((the-struct_71)
- (root-expand-context/outer-inner
- v_209)))
- (if (expand-context/inner?
- the-struct_71)
- (let-values (((phase158_1)
- phase_154)
- ((namespace159_0)
- ns_112))
- (expand-context/inner2.1
- (root-expand-context/inner-self-mpi
- the-struct_71)
- (root-expand-context/inner-module-scopes
- the-struct_71)
- (root-expand-context/inner-top-level-bind-scope
- the-struct_71)
- (root-expand-context/inner-all-scopes-stx
- the-struct_71)
- (root-expand-context/inner-defined-syms
- the-struct_71)
- (root-expand-context/inner-counter
- the-struct_71)
- (root-expand-context/inner-lift-key
- the-struct_71)
- (expand-context/inner-to-parsed?
- the-struct_71)
- phase158_1
- namespace159_0
- (expand-context/inner-just-once?
- the-struct_71)
- (expand-context/inner-module-begin-k
- the-struct_71)
- (expand-context/inner-allow-unbound?
- the-struct_71)
- (expand-context/inner-in-local-expand?
- the-struct_71)
- (expand-context/inner-keep-#%expression?
- the-struct_71)
- (expand-context/inner-stops
- the-struct_71)
- (expand-context/inner-declared-submodule-names
- the-struct_71)
- (expand-context/inner-lifts
- the-struct_71)
- (expand-context/inner-lift-envs
- the-struct_71)
- (expand-context/inner-module-lifts
- the-struct_71)
- (expand-context/inner-require-lifts
- the-struct_71)
- (expand-context/inner-to-module-lifts
- the-struct_71)
- (expand-context/inner-requires+provides
- the-struct_71)
- (expand-context/inner-observer
- the-struct_71)
- (expand-context/inner-for-serializable?
- the-struct_71)
- (expand-context/inner-to-correlated-linklet?
- the-struct_71)
- (expand-context/inner-normalize-locals?
- the-struct_71)
- (expand-context/inner-parsing-expanded?
- the-struct_71)
- (expand-context/inner-skip-visit-available?
- the-struct_71)))
- (raise-argument-error
- 'struct-copy
- "expand-context/inner?"
- the-struct_71)))))
- (expand-context/outer1.1
- inner157_0
- (root-expand-context/outer-post-expansion
- the-struct_70)
- (root-expand-context/outer-use-site-scopes
- the-struct_70)
- (root-expand-context/outer-frame-id
- the-struct_70)
- (expand-context/outer-context
- the-struct_70)
- (expand-context/outer-env
- the-struct_70)
- (expand-context/outer-scopes
- the-struct_70)
- (expand-context/outer-def-ctx-scopes
- the-struct_70)
- (expand-context/outer-binding-layer
- the-struct_70)
- (expand-context/outer-reference-records
- the-struct_70)
- only-immediate?156_0
- (expand-context/outer-need-eventually-defined
- the-struct_70)
- (expand-context/outer-current-introduction-scopes
- the-struct_70)
- (expand-context/outer-current-use-scopes
- the-struct_70)
- (expand-context/outer-name
- the-struct_70)))
- (raise-argument-error
- 'struct-copy
- "expand-context/outer?"
- the-struct_70)))))))
- (if (let-values (((or-part_313) (pair? require-lifts_6)))
- (if or-part_313 or-part_313 (pair? lifts_12)))
- (let-values ()
- (let-values (((new-s_7)
- (let-values (((temp160_0)
- (append
- (map2
- parsed-s
- require-lifts_6)
- lifts_12))
- ((exp-s161_0) exp-s_8)
- ((phase162_1) phase_154))
- (wrap-lifts-as-begin.1
- unsafe-undefined
- unsafe-undefined
- temp160_0
- exp-s161_0
- phase162_1))))
- (begin
- (let-values (((obs_51)
- (expand-context-observer tl-ctx_0)))
- (if obs_51
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_51
- 'lift-loop
- new-s_7)))
- (void)))
- (if just-once?_1
- new-s_7
- (loop_103
- new-s_7
- phase_154
- ns_112
- as-tail?_7)))))
- (if (not single_0)
- (let-values ()
- (begin
- (let-values (((obs_52)
- (expand-context-observer tl-ctx_0)))
- (if obs_52
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_52
- 'return
- exp-s_8)))
- (void)))
- exp-s_8))
- (if (if just-once?_1 (not (eq? exp-s_8 wb-s_0)) #f)
- (let-values () exp-s_8)
- (let-values ()
- (let-values (((tmp_38)
- (core-form-sym exp-s_8 phase_154)))
- (if (equal? tmp_38 'begin)
- (let-values ()
- (let-values ((()
- (begin
- (let-values (((obs_53)
- (expand-context-observer
- ctx_77)))
- (if obs_53
- (let-values ()
- (let-values ()
+ (let-values (((s_771) (maybe-intro given-s_0 ns_133)))
+ (let-values (((ctx_86)
+ (let-values (((ns149_0) ns_133) ((observer150_0) observer_5))
+ (make-expand-context.1 #f observer150_0 #f #f #f ns149_0))))
+ (let-values (((phase_193) (namespace-phase ns_133)))
+ ((letrec-values (((loop_117)
+ (lambda (s_772 phase_194 ns_134 as-tail?_7)
+ (begin
+ 'loop
+ (let-values (((tl-ctx_0)
+ (let-values (((v_287) ctx_86))
+ (let-values (((the-struct_73) v_287))
+ (if (expand-context/outer? the-struct_73)
+ (let-values (((inner151_0)
+ (let-values (((the-struct_74)
+ (root-expand-context/outer-inner
+ v_287)))
+ (if (expand-context/inner?
+ the-struct_74)
+ (let-values (((phase152_0)
+ phase_194)
+ ((namespace153_0)
+ ns_134)
+ ((just-once?154_0)
+ just-once?_1)
+ ((for-serializable?155_0)
+ serializable?_11))
+ (expand-context/inner2.1
+ (root-expand-context/inner-self-mpi
+ the-struct_74)
+ (root-expand-context/inner-module-scopes
+ the-struct_74)
+ (root-expand-context/inner-top-level-bind-scope
+ the-struct_74)
+ (root-expand-context/inner-all-scopes-stx
+ the-struct_74)
+ (root-expand-context/inner-defined-syms
+ the-struct_74)
+ (root-expand-context/inner-counter
+ the-struct_74)
+ (root-expand-context/inner-lift-key
+ the-struct_74)
+ (expand-context/inner-to-parsed?
+ the-struct_74)
+ phase152_0
+ namespace153_0
+ just-once?154_0
+ (expand-context/inner-module-begin-k
+ the-struct_74)
+ (expand-context/inner-allow-unbound?
+ the-struct_74)
+ (expand-context/inner-in-local-expand?
+ the-struct_74)
+ (expand-context/inner-keep-#%expression?
+ the-struct_74)
+ (expand-context/inner-stops
+ the-struct_74)
+ (expand-context/inner-declared-submodule-names
+ the-struct_74)
+ (expand-context/inner-lifts
+ the-struct_74)
+ (expand-context/inner-lift-envs
+ the-struct_74)
+ (expand-context/inner-module-lifts
+ the-struct_74)
+ (expand-context/inner-require-lifts
+ the-struct_74)
+ (expand-context/inner-to-module-lifts
+ the-struct_74)
+ (expand-context/inner-requires+provides
+ the-struct_74)
+ (expand-context/inner-observer
+ the-struct_74)
+ for-serializable?155_0
+ (expand-context/inner-to-correlated-linklet?
+ the-struct_74)
+ (expand-context/inner-normalize-locals?
+ the-struct_74)
+ (expand-context/inner-parsing-expanded?
+ the-struct_74)
+ (expand-context/inner-skip-visit-available?
+ the-struct_74)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/inner?"
+ the-struct_74)))))
+ (expand-context/outer1.1
+ inner151_0
+ (root-expand-context/outer-post-expansion
+ the-struct_73)
+ (root-expand-context/outer-use-site-scopes
+ the-struct_73)
+ (root-expand-context/outer-frame-id
+ the-struct_73)
+ (expand-context/outer-context the-struct_73)
+ (expand-context/outer-env the-struct_73)
+ (expand-context/outer-scopes the-struct_73)
+ (expand-context/outer-def-ctx-scopes
+ the-struct_73)
+ (expand-context/outer-binding-layer
+ the-struct_73)
+ (expand-context/outer-reference-records
+ the-struct_73)
+ (expand-context/outer-only-immediate?
+ the-struct_73)
+ (expand-context/outer-need-eventually-defined
+ the-struct_73)
+ (expand-context/outer-current-introduction-scopes
+ the-struct_73)
+ (expand-context/outer-current-use-scopes
+ the-struct_73)
+ (expand-context/outer-name the-struct_73)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/outer?"
+ the-struct_73))))))
+ (let-values (((wb-s_0) (if just-once?_1 s_772 #f)))
+ (let-values ((()
+ (begin
+ (let-values (((obs_52)
+ (expand-context-observer
+ tl-ctx_0)))
+ (if obs_52
+ (call-expand-observe obs_52 'visit s_772)
+ (void)))
+ (values))))
+ (let-values (((require-lifts_6 lifts_12 exp-s_8)
+ (expand-capturing-lifts
+ s_772
+ (let-values (((v_288) tl-ctx_0))
+ (let-values (((the-struct_75) v_288))
+ (if (expand-context/outer? the-struct_75)
+ (let-values (((only-immediate?156_0) #t)
+ ((inner157_0)
+ (let-values (((the-struct_76)
+ (root-expand-context/outer-inner
+ v_288)))
+ (if (expand-context/inner?
+ the-struct_76)
+ (let-values (((phase158_0)
+ phase_194)
+ ((namespace159_0)
+ ns_134))
+ (expand-context/inner2.1
+ (root-expand-context/inner-self-mpi
+ the-struct_76)
+ (root-expand-context/inner-module-scopes
+ the-struct_76)
+ (root-expand-context/inner-top-level-bind-scope
+ the-struct_76)
+ (root-expand-context/inner-all-scopes-stx
+ the-struct_76)
+ (root-expand-context/inner-defined-syms
+ the-struct_76)
+ (root-expand-context/inner-counter
+ the-struct_76)
+ (root-expand-context/inner-lift-key
+ the-struct_76)
+ (expand-context/inner-to-parsed?
+ the-struct_76)
+ phase158_0
+ namespace159_0
+ (expand-context/inner-just-once?
+ the-struct_76)
+ (expand-context/inner-module-begin-k
+ the-struct_76)
+ (expand-context/inner-allow-unbound?
+ the-struct_76)
+ (expand-context/inner-in-local-expand?
+ the-struct_76)
+ (expand-context/inner-keep-#%expression?
+ the-struct_76)
+ (expand-context/inner-stops
+ the-struct_76)
+ (expand-context/inner-declared-submodule-names
+ the-struct_76)
+ (expand-context/inner-lifts
+ the-struct_76)
+ (expand-context/inner-lift-envs
+ the-struct_76)
+ (expand-context/inner-module-lifts
+ the-struct_76)
+ (expand-context/inner-require-lifts
+ the-struct_76)
+ (expand-context/inner-to-module-lifts
+ the-struct_76)
+ (expand-context/inner-requires+provides
+ the-struct_76)
+ (expand-context/inner-observer
+ the-struct_76)
+ (expand-context/inner-for-serializable?
+ the-struct_76)
+ (expand-context/inner-to-correlated-linklet?
+ the-struct_76)
+ (expand-context/inner-normalize-locals?
+ the-struct_76)
+ (expand-context/inner-parsing-expanded?
+ the-struct_76)
+ (expand-context/inner-skip-visit-available?
+ the-struct_76)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/inner?"
+ the-struct_76)))))
+ (expand-context/outer1.1
+ inner157_0
+ (root-expand-context/outer-post-expansion
+ the-struct_75)
+ (root-expand-context/outer-use-site-scopes
+ the-struct_75)
+ (root-expand-context/outer-frame-id
+ the-struct_75)
+ (expand-context/outer-context
+ the-struct_75)
+ (expand-context/outer-env
+ the-struct_75)
+ (expand-context/outer-scopes
+ the-struct_75)
+ (expand-context/outer-def-ctx-scopes
+ the-struct_75)
+ (expand-context/outer-binding-layer
+ the-struct_75)
+ (expand-context/outer-reference-records
+ the-struct_75)
+ only-immediate?156_0
+ (expand-context/outer-need-eventually-defined
+ the-struct_75)
+ (expand-context/outer-current-introduction-scopes
+ the-struct_75)
+ (expand-context/outer-current-use-scopes
+ the-struct_75)
+ (expand-context/outer-name
+ the-struct_75)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/outer?"
+ the-struct_75)))))))
+ (if (let-values (((or-part_527) (pair? require-lifts_6)))
+ (if or-part_527 or-part_527 (pair? lifts_12)))
+ (let-values (((new-s_8)
+ (let-values (((temp160_1)
+ (append
+ (map2
+ parsed-s
+ require-lifts_6)
+ lifts_12))
+ ((exp-s161_0) exp-s_8)
+ ((phase162_1) phase_194))
+ (wrap-lifts-as-begin.1
+ unsafe-undefined
+ unsafe-undefined
+ temp160_1
+ exp-s161_0
+ phase162_1))))
+ (begin
+ (let-values (((obs_53)
+ (expand-context-observer tl-ctx_0)))
+ (if obs_53
+ (call-expand-observe obs_53 'lift-loop new-s_8)
+ (void)))
+ (if just-once?_1
+ new-s_8
+ (loop_117 new-s_8 phase_194 ns_134 as-tail?_7))))
+ (if (not single_0)
+ (begin
+ (let-values (((obs_54)
+ (expand-context-observer tl-ctx_0)))
+ (if obs_54
+ (call-expand-observe obs_54 'return exp-s_8)
+ (void)))
+ exp-s_8)
+ (if (if just-once?_1 (not (eq? exp-s_8 wb-s_0)) #f)
+ exp-s_8
+ (let-values (((tmp_41)
+ (core-form-sym exp-s_8 phase_194)))
+ (if (equal? tmp_41 'begin)
+ (let-values ((()
+ (begin
+ (let-values (((obs_55)
+ (expand-context-observer
+ ctx_86)))
+ (if obs_55
+ (call-expand-observe
+ obs_55
+ 'prim-begin
+ exp-s_8)
+ (void)))
+ (values))))
+ (let-values (((ok?_33 begin163_0 e164_0)
+ (let-values (((s_773) exp-s_8))
+ (let-values (((orig-s_40)
+ s_773))
+ (let-values (((begin163_1
+ e164_1)
+ (let-values (((s_774)
+ (if (syntax?$1
+ s_773)
+ (syntax-e$1
+ s_773)
+ s_773)))
+ (if (pair?
+ s_774)
+ (let-values (((begin165_0)
+ (let-values (((s_775)
+ (car
+ s_774)))
+ s_775))
+ ((e166_0)
+ (let-values (((s_776)
+ (cdr
+ s_774)))
+ (let-values (((s_777)
+ (if (syntax?$1
+ s_776)
+ (syntax-e$1
+ s_776)
+ s_776)))
+ (let-values (((flat-s_23)
+ (to-syntax-list.1
+ s_777)))
+ (if (not
+ flat-s_23)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_40)
+ flat-s_23))))))
+ (values
+ begin165_0
+ e166_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_40)))))
+ (values
+ #t
+ begin163_1
+ e164_1))))))
+ (letrec-values (((begin-loop_0)
+ (lambda (es_2)
+ (begin
+ 'begin-loop
+ (if (null? es_2)
+ (if combine_0
+ null
+ (void))
+ (if (if (not combine_0)
+ (null?
+ (cdr es_2))
+ #f)
+ (loop_117
+ (car es_2)
+ phase_194
+ ns_134
+ as-tail?_7)
+ (let-values ((()
+ (begin
+ (let-values (((obs_56)
+ (expand-context-observer
+ tl-ctx_0)))
+ (if obs_56
+ (call-expand-observe
+ obs_56
+ 'next)
+ (void)))
+ (values))))
+ (let-values (((a_66)
+ (if combine_0
+ (loop_117
+ (car
+ es_2)
+ phase_194
+ ns_134
+ #f)
+ (begin
+ (loop_117
+ (car
+ es_2)
+ phase_194
+ ns_134
+ #f)
+ (void)))))
+ (if combine_0
+ (combine_0
+ a_66
+ (begin-loop_0
+ (cdr es_2)))
+ (begin-loop_0
+ (cdr
+ es_2)))))))))))
+ (if wrap_4
+ (let-values (((new-s_9)
+ (wrap_4
+ begin163_0
+ exp-s_8
+ (begin-loop_0 e164_0))))
+ (begin
+ (let-values (((obs_57)
+ (expand-context-observer
+ tl-ctx_0)))
+ (if obs_57
+ (call-expand-observe
+ obs_57
+ 'return
+ new-s_9)
+ (void)))
+ new-s_9))
+ (begin-loop_0 e164_0)))))
+ (if (equal? tmp_41 'begin-for-syntax)
+ (let-values ((()
+ (begin
+ (let-values (((obs_58)
+ (expand-context-observer
+ tl-ctx_0)))
+ (if obs_58
+ (call-expand-observe
+ obs_58
+ 'prim-begin-for-syntax
+ exp-s_8)
+ (void)))
+ (values))))
+ (let-values (((ok?_34
+ begin-for-syntax167_0
+ e168_0)
+ (let-values (((s_778) exp-s_8))
+ (let-values (((orig-s_41)
+ s_778))
+ (let-values (((begin-for-syntax167_1
+ e168_1)
+ (let-values (((s_779)
+ (if (syntax?$1
+ s_778)
+ (syntax-e$1
+ s_778)
+ s_778)))
+ (if (pair?
+ s_779)
+ (let-values (((begin-for-syntax169_0)
+ (let-values (((s_780)
+ (car
+ s_779)))
+ s_780))
+ ((e170_0)
+ (let-values (((s_781)
+ (cdr
+ s_779)))
+ (let-values (((s_782)
+ (if (syntax?$1
+ s_781)
+ (syntax-e$1
+ s_781)
+ s_781)))
+ (let-values (((flat-s_24)
+ (to-syntax-list.1
+ s_782)))
+ (if (not
+ flat-s_24)
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_41)
+ flat-s_24))))))
+ (values
+ begin-for-syntax169_0
+ e170_0))
+ (raise-syntax-error$1
+ #f
+ "bad syntax"
+ orig-s_41)))))
+ (values
+ #t
+ begin-for-syntax167_1
+ e168_1))))))
+ (let-values (((next-phase_0)
+ (add1 phase_194)))
+ (let-values (((next-ns_0)
+ (namespace->namespace-at-phase
+ ns_134
+ next-phase_0)))
+ (let-values ((()
+ (begin
+ (let-values (((obs_59)
+ (expand-context-observer
+ tl-ctx_0)))
+ (if obs_59
(call-expand-observe
- obs_53
- 'prim-begin
- exp-s_8)))
- (void)))
- (values))))
- (let-values (((ok?_32 begin163_0 e164_0)
- (let-values (((s_537)
- exp-s_8))
- (let-values (((orig-s_39)
- s_537))
- (let-values (((begin163_1
- e164_1)
- (let-values (((s_538)
- (if (syntax?$1
- s_537)
- (syntax-e$1
- s_537)
- s_537)))
- (if (pair?
- s_538)
- (let-values (((begin165_0)
- (let-values (((s_233)
- (car
- s_538)))
- s_233))
- ((e166_0)
- (let-values (((s_234)
- (cdr
- s_538)))
- (let-values (((s_235)
- (if (syntax?$1
- s_234)
- (syntax-e$1
- s_234)
- s_234)))
- (let-values (((flat-s_22)
- (to-syntax-list.1
- s_235)))
- (if (not
- flat-s_22)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_39))
- (let-values ()
- flat-s_22)))))))
- (values
- begin165_0
- e166_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_39)))))
- (values
- #t
- begin163_1
- e164_1))))))
- (letrec-values (((begin-loop_0)
- (lambda (es_2)
- (begin
- 'begin-loop
- (if (null? es_2)
- (let-values ()
- (if combine_0
- null
- (void)))
- (if (if (not
- combine_0)
- (null?
- (cdr
- es_2))
- #f)
- (let-values ()
- (loop_103
- (car es_2)
- phase_154
- ns_112
- as-tail?_7))
- (let-values ()
- (let-values ((()
- (begin
- (let-values (((obs_54)
- (expand-context-observer
- tl-ctx_0)))
- (if obs_54
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_54
- 'next)))
- (void)))
- (values))))
- (let-values (((a_60)
- (if combine_0
- (loop_103
- (car
- es_2)
- phase_154
- ns_112
- #f)
- (begin
- (loop_103
- (car
- es_2)
- phase_154
- ns_112
- #f)
- (void)))))
- (if combine_0
- (combine_0
- a_60
- (begin-loop_0
- (cdr
- es_2)))
- (begin-loop_0
- (cdr
- es_2))))))))))))
- (if wrap_4
- (let-values ()
- (let-values (((new-s_8)
- (wrap_4
- begin163_0
- exp-s_8
- (begin-loop_0
- e164_0))))
- (begin
- (let-values (((obs_55)
- (expand-context-observer
- tl-ctx_0)))
- (if obs_55
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_55
- 'return
- new-s_8)))
- (void)))
- new-s_8)))
- (let-values ()
- (begin-loop_0 e164_0)))))))
- (if (equal? tmp_38 'begin-for-syntax)
- (let-values ()
- (let-values ((()
+ obs_59
+ 'prepare-env)
+ (void)))
+ (values))))
+ (let-values ((()
+ (begin
+ (if quick-immediate?_0
+ (namespace-visit-available-modules!
+ ns_134)
+ (void))
+ (values))))
+ (let-values ((()
+ (begin
+ (namespace-visit-available-modules!
+ next-ns_0)
+ (values))))
+ (let-values (((l_71)
+ (reverse$1
+ (let-values (((fold-var_595)
+ (let-values (((fold-var_596)
+ null))
+ fold-var_596)))
+ (let-values (((lst_528)
+ e168_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list
+ lst_528))
+ ((letrec-values (((for-loop_436)
+ (lambda (fold-var_597
+ lst_529)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_529)
+ (let-values (((s_783)
+ (unsafe-car
+ lst_529))
+ ((rest_260)
+ (unsafe-cdr
+ lst_529)))
+ (let-values (((fold-var_598)
+ (let-values (((fold-var_599)
+ (cons
+ (begin
+ (let-values (((obs_60)
+ (expand-context-observer
+ tl-ctx_0)))
+ (if obs_60
+ (call-expand-observe
+ obs_60
+ 'next)
+ (void)))
+ (loop_117
+ s_783
+ next-phase_0
+ next-ns_0
+ #f))
+ fold-var_597)))
+ (values
+ fold-var_599))))
+ (if (not
+ #f)
+ (for-loop_436
+ fold-var_598
+ rest_260)
+ fold-var_598)))
+ fold-var_597)))))
+ for-loop_436)
+ fold-var_595
+ lst_528)))))))
+ (if wrap_4
+ (let-values (((new-s_10)
+ (wrap_4
+ begin-for-syntax167_0
+ exp-s_8
+ l_71)))
(begin
- (let-values (((obs_56)
+ (let-values (((obs_61)
(expand-context-observer
tl-ctx_0)))
- (if obs_56
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_56
- 'prim-begin-for-syntax
- exp-s_8)))
+ (if obs_61
+ (call-expand-observe
+ obs_61
+ 'return
+ new-s_10)
(void)))
- (values))))
- (let-values (((ok?_33
- begin-for-syntax167_0
- e168_0)
- (let-values (((s_367)
- exp-s_8))
- (let-values (((orig-s_40)
- s_367))
- (let-values (((begin-for-syntax167_1
- e168_1)
- (let-values (((s_539)
- (if (syntax?$1
- s_367)
- (syntax-e$1
- s_367)
- s_367)))
- (if (pair?
- s_539)
- (let-values (((begin-for-syntax169_0)
- (let-values (((s_368)
- (car
- s_539)))
- s_368))
- ((e170_0)
- (let-values (((s_369)
- (cdr
- s_539)))
- (let-values (((s_540)
- (if (syntax?$1
- s_369)
- (syntax-e$1
- s_369)
- s_369)))
- (let-values (((flat-s_23)
- (to-syntax-list.1
- s_540)))
- (if (not
- flat-s_23)
- (let-values ()
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_40))
- (let-values ()
- flat-s_23)))))))
- (values
- begin-for-syntax169_0
- e170_0))
- (raise-syntax-error$1
- #f
- "bad syntax"
- orig-s_40)))))
- (values
- #t
- begin-for-syntax167_1
- e168_1))))))
- (let-values (((next-phase_0)
- (add1 phase_154)))
- (let-values (((next-ns_0)
- (namespace->namespace-at-phase
- ns_112
- next-phase_0)))
- (let-values ((()
- (begin
- (let-values (((obs_57)
- (expand-context-observer
- tl-ctx_0)))
- (if obs_57
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_57
- 'prepare-env)))
- (void)))
- (values))))
- (let-values ((()
- (begin
- (if quick-immediate?_0
- (let-values ()
- (namespace-visit-available-modules!
- ns_112))
- (void))
- (values))))
- (let-values ((()
- (begin
- (namespace-visit-available-modules!
- next-ns_0)
- (values))))
- (let-values (((l_59)
- (reverse$1
- (let-values (((lst_313)
- e168_0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-list
- lst_313)))
- ((letrec-values (((for-loop_289)
- (lambda (fold-var_293
- lst_314)
- (begin
- 'for-loop
- (if (pair?
- lst_314)
- (let-values (((s_245)
- (unsafe-car
- lst_314))
- ((rest_176)
- (unsafe-cdr
- lst_314)))
- (let-values (((fold-var_294)
- (let-values (((fold-var_295)
- fold-var_293))
- (let-values (((fold-var_296)
- (let-values ()
- (cons
- (let-values ()
- (begin
- (let-values (((obs_58)
- (expand-context-observer
- tl-ctx_0)))
- (if obs_58
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_58
- 'next)))
- (void)))
- (loop_103
- s_245
- next-phase_0
- next-ns_0
- #f)))
- fold-var_295))))
- (values
- fold-var_296)))))
- (if (not
- #f)
- (for-loop_289
- fold-var_294
- rest_176)
- fold-var_294)))
- fold-var_293)))))
- for-loop_289)
- null
- lst_313))))))
- (if wrap_4
- (let-values ()
- (let-values (((new-s_9)
- (wrap_4
- begin-for-syntax167_0
- exp-s_8
- l_59)))
- (begin
- (let-values (((obs_59)
- (expand-context-observer
- tl-ctx_0)))
- (if obs_59
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_59
- 'return
- new-s_9)))
- (void)))
- new-s_9)))
- (if combine_0
- (let-values ()
- (apply append l_59))
- (let-values ()
- (void)))))))))))))
- (let-values ()
- (single_0
- exp-s_8
- ns_112
- as-tail?_7)))))))))))))))))
- loop_103)
- s_536
- phase_153
- ns_111
- #t)))))))))))))))))
+ new-s_10))
+ (if combine_0
+ (apply append l_71)
+ (void)))))))))))
+ (single_0
+ exp-s_8
+ ns_134
+ as-tail?_7)))))))))))))))
+ loop_117)
+ s_771
+ phase_193
+ ns_133
+ #t))))))))))))))))
(define-values
(maybe-intro)
- (lambda (s_541 ns_113)
- (begin (if (syntax?$1 s_541) s_541 (1/namespace-syntax-introduce (1/datum->syntax #f s_541) ns_113)))))
+ (lambda (s_784 ns_135)
+ (begin (if (syntax?$1 s_784) s_784 (1/namespace-syntax-introduce (1/datum->syntax #f s_784) ns_135)))))
(define-values
(re-pair)
- (lambda (form-id_0 s_250 r_44) (begin (1/datum->syntax s_250 (cons form-id_0 r_44) s_250 s_250))))
+ (lambda (form-id_0 s_785 r_51) (begin (1/datum->syntax s_785 (cons form-id_0 r_51) s_785 s_785))))
(define-values
(expand-capturing-lifts)
- (lambda (s_252 ctx_78)
+ (lambda (s_786 ctx_87)
(begin
(begin
- (if log-performance? (let-values () (start-performance-region 'expand 'top)) (void))
+ (if log-performance? (start-performance-region 'expand 'top) (void))
(begin0
- (let-values ()
- (let-values (((ns_114) (expand-context-namespace ctx_78)))
- (let-values ((() (begin (namespace-visit-available-modules! ns_114) (values))))
- (let-values (((lift-ctx_6)
- (let-values (((temp171_0) (make-top-level-lift ctx_78)))
- (make-lift-context.1 #f temp171_0))))
- (let-values (((require-lift-ctx_2)
- (make-require-lift-context
- (namespace-phase ns_114)
- (make-parse-top-lifted-require ns_114 ctx_78))))
- (let-values (((exp-s_9)
- (let-values (((s172_0) s_252)
- ((temp173_1)
- (let-values (((v_210) ctx_78))
- (let-values (((the-struct_72) v_210))
- (if (expand-context/outer? the-struct_72)
- (let-values (((inner174_0)
- (let-values (((the-struct_22)
- (root-expand-context/outer-inner
- v_210)))
- (if (expand-context/inner? the-struct_22)
- (let-values (((lifts175_0) lift-ctx_6)
- ((module-lifts176_0) lift-ctx_6)
- ((require-lifts177_0)
- require-lift-ctx_2))
- (expand-context/inner2.1
- (root-expand-context/inner-self-mpi
- the-struct_22)
- (root-expand-context/inner-module-scopes
- the-struct_22)
- (root-expand-context/inner-top-level-bind-scope
- the-struct_22)
- (root-expand-context/inner-all-scopes-stx
- the-struct_22)
- (root-expand-context/inner-defined-syms
- the-struct_22)
- (root-expand-context/inner-counter
- the-struct_22)
- (root-expand-context/inner-lift-key
- the-struct_22)
- (expand-context/inner-to-parsed?
- the-struct_22)
- (expand-context/inner-phase the-struct_22)
- (expand-context/inner-namespace
- the-struct_22)
- (expand-context/inner-just-once?
- the-struct_22)
- (expand-context/inner-module-begin-k
- the-struct_22)
- (expand-context/inner-allow-unbound?
- the-struct_22)
- (expand-context/inner-in-local-expand?
- the-struct_22)
- (expand-context/inner-keep-#%expression?
- the-struct_22)
- (expand-context/inner-stops the-struct_22)
- (expand-context/inner-declared-submodule-names
- the-struct_22)
- lifts175_0
- (expand-context/inner-lift-envs
- the-struct_22)
- module-lifts176_0
- require-lifts177_0
- (expand-context/inner-to-module-lifts
- the-struct_22)
- (expand-context/inner-requires+provides
- the-struct_22)
- (expand-context/inner-observer the-struct_22)
- (expand-context/inner-for-serializable?
- the-struct_22)
- (expand-context/inner-to-correlated-linklet?
- the-struct_22)
- (expand-context/inner-normalize-locals?
- the-struct_22)
- (expand-context/inner-parsing-expanded?
- the-struct_22)
- (expand-context/inner-skip-visit-available?
- the-struct_22)))
- (raise-argument-error
- 'struct-copy
- "expand-context/inner?"
- the-struct_22)))))
- (expand-context/outer1.1
- inner174_0
- (root-expand-context/outer-post-expansion the-struct_72)
- (root-expand-context/outer-use-site-scopes the-struct_72)
- (root-expand-context/outer-frame-id the-struct_72)
- (expand-context/outer-context the-struct_72)
- (expand-context/outer-env the-struct_72)
- (expand-context/outer-scopes the-struct_72)
- (expand-context/outer-def-ctx-scopes the-struct_72)
- (expand-context/outer-binding-layer the-struct_72)
- (expand-context/outer-reference-records the-struct_72)
- (expand-context/outer-only-immediate? the-struct_72)
- (expand-context/outer-need-eventually-defined the-struct_72)
- (expand-context/outer-current-introduction-scopes
- the-struct_72)
- (expand-context/outer-current-use-scopes the-struct_72)
- (expand-context/outer-name the-struct_72)))
- (raise-argument-error
- 'struct-copy
- "expand-context/outer?"
- the-struct_72))))))
- (expand.1 #f #f s172_0 temp173_1))))
- (values
- (get-and-clear-require-lifts! require-lift-ctx_2)
- (get-and-clear-lifts! lift-ctx_6)
- exp-s_9)))))))
- (if log-performance? (let-values () (end-performance-region)) (void)))))))
+ (let-values (((ns_136) (expand-context-namespace ctx_87)))
+ (let-values ((() (begin (namespace-visit-available-modules! ns_136) (values))))
+ (let-values (((lift-ctx_6)
+ (let-values (((temp171_0) (make-top-level-lift ctx_87)))
+ (make-lift-context.1 #f temp171_0))))
+ (let-values (((require-lift-ctx_2)
+ (make-require-lift-context
+ (namespace-phase ns_136)
+ (make-parse-top-lifted-require ns_136 ctx_87))))
+ (let-values (((exp-s_9)
+ (let-values (((s172_0) s_786)
+ ((temp173_0)
+ (let-values (((v_289) ctx_87))
+ (let-values (((the-struct_77) v_289))
+ (if (expand-context/outer? the-struct_77)
+ (let-values (((inner174_0)
+ (let-values (((the-struct_78)
+ (root-expand-context/outer-inner
+ v_289)))
+ (if (expand-context/inner? the-struct_78)
+ (let-values (((lifts175_0) lift-ctx_6)
+ ((module-lifts176_0) lift-ctx_6)
+ ((require-lifts177_0)
+ require-lift-ctx_2))
+ (expand-context/inner2.1
+ (root-expand-context/inner-self-mpi
+ the-struct_78)
+ (root-expand-context/inner-module-scopes
+ the-struct_78)
+ (root-expand-context/inner-top-level-bind-scope
+ the-struct_78)
+ (root-expand-context/inner-all-scopes-stx
+ the-struct_78)
+ (root-expand-context/inner-defined-syms
+ the-struct_78)
+ (root-expand-context/inner-counter
+ the-struct_78)
+ (root-expand-context/inner-lift-key
+ the-struct_78)
+ (expand-context/inner-to-parsed? the-struct_78)
+ (expand-context/inner-phase the-struct_78)
+ (expand-context/inner-namespace the-struct_78)
+ (expand-context/inner-just-once? the-struct_78)
+ (expand-context/inner-module-begin-k
+ the-struct_78)
+ (expand-context/inner-allow-unbound?
+ the-struct_78)
+ (expand-context/inner-in-local-expand?
+ the-struct_78)
+ (expand-context/inner-keep-#%expression?
+ the-struct_78)
+ (expand-context/inner-stops the-struct_78)
+ (expand-context/inner-declared-submodule-names
+ the-struct_78)
+ lifts175_0
+ (expand-context/inner-lift-envs the-struct_78)
+ module-lifts176_0
+ require-lifts177_0
+ (expand-context/inner-to-module-lifts
+ the-struct_78)
+ (expand-context/inner-requires+provides
+ the-struct_78)
+ (expand-context/inner-observer the-struct_78)
+ (expand-context/inner-for-serializable?
+ the-struct_78)
+ (expand-context/inner-to-correlated-linklet?
+ the-struct_78)
+ (expand-context/inner-normalize-locals?
+ the-struct_78)
+ (expand-context/inner-parsing-expanded?
+ the-struct_78)
+ (expand-context/inner-skip-visit-available?
+ the-struct_78)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/inner?"
+ the-struct_78)))))
+ (expand-context/outer1.1
+ inner174_0
+ (root-expand-context/outer-post-expansion the-struct_77)
+ (root-expand-context/outer-use-site-scopes the-struct_77)
+ (root-expand-context/outer-frame-id the-struct_77)
+ (expand-context/outer-context the-struct_77)
+ (expand-context/outer-env the-struct_77)
+ (expand-context/outer-scopes the-struct_77)
+ (expand-context/outer-def-ctx-scopes the-struct_77)
+ (expand-context/outer-binding-layer the-struct_77)
+ (expand-context/outer-reference-records the-struct_77)
+ (expand-context/outer-only-immediate? the-struct_77)
+ (expand-context/outer-need-eventually-defined the-struct_77)
+ (expand-context/outer-current-introduction-scopes the-struct_77)
+ (expand-context/outer-current-use-scopes the-struct_77)
+ (expand-context/outer-name the-struct_77)))
+ (raise-argument-error
+ 'struct-copy
+ "expand-context/outer?"
+ the-struct_77))))))
+ (expand.1 #f #f s172_0 temp173_0))))
+ (values
+ (get-and-clear-require-lifts! require-lift-ctx_2)
+ (get-and-clear-lifts! lift-ctx_6)
+ exp-s_9))))))
+ (if log-performance? (end-performance-region) (void)))))))
(define-values
(make-parse-top-lifted-require)
- (lambda (ns_115 ctx_79)
+ (lambda (ns_137 ctx_88)
(begin
- (lambda (s_388 phase_155)
- (let-values (((ok?_34 #%require178_0 req179_0)
- (let-values (((s_260) s_388))
- (let-values (((orig-s_41) s_260))
+ (lambda (s_787 phase_195)
+ (let-values (((ok?_35 #%require178_0 req179_0)
+ (let-values (((s_788) s_787))
+ (let-values (((orig-s_42) s_788))
(let-values (((#%require178_1 req179_1)
- (let-values (((s_261) (if (syntax?$1 s_260) (syntax-e$1 s_260) s_260)))
- (if (pair? s_261)
- (let-values (((#%require180_0) (let-values (((s_542) (car s_261))) s_542))
+ (let-values (((s_789) (if (syntax?$1 s_788) (syntax-e$1 s_788) s_788)))
+ (if (pair? s_789)
+ (let-values (((#%require180_0) (let-values (((s_790) (car s_789))) s_790))
((req181_0)
- (let-values (((s_543) (cdr s_261)))
- (let-values (((s_264)
- (if (syntax?$1 s_543)
- (syntax-e$1 s_543)
- s_543)))
- (if (pair? s_264)
+ (let-values (((s_791) (cdr s_789)))
+ (let-values (((s_792)
+ (if (syntax?$1 s_791)
+ (syntax-e$1 s_791)
+ s_791)))
+ (if (pair? s_792)
(let-values (((req182_0)
- (let-values (((s_147) (car s_264)))
- s_147))
+ (let-values (((s_793) (car s_792)))
+ s_793))
(()
- (let-values (((s_544) (cdr s_264)))
- (let-values (((s_401)
- (if (syntax?$1 s_544)
- (syntax-e$1 s_544)
- s_544)))
- (if (null? s_401)
+ (let-values (((s_794) (cdr s_792)))
+ (let-values (((s_795)
+ (if (syntax?$1 s_794)
+ (syntax-e$1 s_794)
+ s_794)))
+ (if (null? s_795)
(values)
(raise-syntax-error$1
#f
"bad syntax"
- orig-s_41))))))
+ orig-s_42))))))
(values req182_0))
- (raise-syntax-error$1 #f "bad syntax" orig-s_41))))))
+ (raise-syntax-error$1 #f "bad syntax" orig-s_42))))))
(values #%require180_0 req181_0))
- (raise-syntax-error$1 #f "bad syntax" orig-s_41)))))
+ (raise-syntax-error$1 #f "bad syntax" orig-s_42)))))
(values #t #%require178_1 req179_1))))))
- (let-values (((syms_26) (box null)))
+ (let-values (((syms_34) (box null)))
(begin
- (let-values (((temp183_0) (list req179_0))
- ((s184_0) s_388)
- ((ns185_0) ns_115)
- ((phase186_1) phase_155)
- ((phase187_0) phase_155)
- ((temp188_0)
+ (let-values (((temp183_1) (list req179_0))
+ ((s184_0) s_787)
+ ((ns185_0) ns_137)
+ ((phase186_0) phase_195)
+ ((phase187_0) phase_195)
+ ((temp188_1)
(let-values (((temp191_0) #f)) (make-requires+provides.1 #f unsafe-undefined temp191_0)))
- ((temp189_1) (make-top-add-defined-portal ns_115 ctx_79 syms_26))
+ ((temp189_1) (make-top-add-defined-portal ns_137 ctx_88 syms_34))
((temp190_0) 'require))
(parse-and-perform-requires!.1
temp189_1
@@ -54692,12 +53822,12 @@
#f
#t
temp190_0
- temp183_0
+ temp183_1
s184_0
ns185_0
- phase186_1
- temp188_0))
- (parsed-require23.1 s_388 (reverse$1 (unbox syms_26))))))))))
+ phase186_0
+ temp188_1))
+ (parsed-require24.1 s_787 (reverse$1 (unbox syms_34))))))))))
(define-values
(wrap-lifts-as-lifted-parsed-begin.1)
(lambda (adjust-form56_0 require-lifts58_0 lifts59_0 exp-s60_0 rebuild-s61_0)
@@ -54708,493 +53838,412 @@
(let-values (((exp-s_10) exp-s60_0))
(let-values (((rebuild-s_3) rebuild-s61_0))
(let-values (((adjust-form_1) adjust-form56_0))
- (let-values ()
- (lifted-parsed-begin11.1
- (append
- require-lifts_7
- (reverse$1
- (let-values (((lst_315) (get-lifts-as-lists lifts_13)))
+ (lifted-parsed-begin11.1
+ (append
+ require-lifts_7
+ (reverse$1
+ (let-values (((fold-var_600) (let-values (((fold-var_601) null)) fold-var_601)))
+ (let-values (((lst_530) (get-lifts-as-lists lifts_13)))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_315)))
- ((letrec-values (((for-loop_290)
- (lambda (fold-var_297 lst_316)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_530))
+ ((letrec-values (((for-loop_437)
+ (lambda (fold-var_602 lst_531)
(begin
'for-loop
- (if (pair? lst_316)
- (let-values (((ids+syms+rhs_0) (unsafe-car lst_316))
- ((rest_177) (unsafe-cdr lst_316)))
- (let-values (((fold-var_298)
- (let-values (((fold-var_299) fold-var_297))
- (let-values (((fold-var_300)
- (let-values ()
- (cons
- (let-values ()
- (let-values (((exp-rhs_3)
- (adjust-form_1
- (caddr
- ids+syms+rhs_0))))
- (let-values (((just-rhs_0)
- (if (lifted-parsed-begin?
- exp-rhs_3)
- (lifted-parsed-begin-last
- exp-rhs_3)
- exp-rhs_3)))
- (let-values (((dv_0)
- (parsed-define-values19.1
- rebuild-s_3
- (car
- ids+syms+rhs_0)
- (cadr
- ids+syms+rhs_0)
- just-rhs_0)))
- (if (lifted-parsed-begin?
- exp-rhs_3)
- (let-values (((the-struct_73)
- exp-rhs_3))
+ (if (pair? lst_531)
+ (let-values (((ids+syms+rhs_0) (unsafe-car lst_531))
+ ((rest_261) (unsafe-cdr lst_531)))
+ (let-values (((fold-var_603)
+ (let-values (((fold-var_604)
+ (cons
+ (let-values (((exp-rhs_3)
+ (adjust-form_1
+ (caddr ids+syms+rhs_0))))
+ (let-values (((just-rhs_0)
(if (lifted-parsed-begin?
- the-struct_73)
- (let-values (((last192_0)
- dv_0))
- (lifted-parsed-begin11.1
- (lifted-parsed-begin-seq
- the-struct_73)
- last192_0))
- (raise-argument-error
- 'struct-copy
- "lifted-parsed-begin?"
- the-struct_73)))
- dv_0)))))
- fold-var_299))))
- (values fold-var_300)))))
- (if (not #f) (for-loop_290 fold-var_298 rest_177) fold-var_298)))
- fold-var_297)))))
- for-loop_290)
- null
- lst_315)))))
- exp-s_10))))))))))
- (define-values (replace-me) (lambda (who_0) (begin (lambda args_7 (error who_0 "this stub must be replaced")))))
+ exp-rhs_3)
+ (lifted-parsed-begin-last
+ exp-rhs_3)
+ exp-rhs_3)))
+ (let-values (((dv_0)
+ (parsed-define-values20.1
+ rebuild-s_3
+ (car ids+syms+rhs_0)
+ (cadr ids+syms+rhs_0)
+ just-rhs_0)))
+ (if (lifted-parsed-begin?
+ exp-rhs_3)
+ (let-values (((the-struct_79)
+ exp-rhs_3))
+ (if (lifted-parsed-begin?
+ the-struct_79)
+ (let-values (((last192_0)
+ dv_0))
+ (lifted-parsed-begin11.1
+ (lifted-parsed-begin-seq
+ the-struct_79)
+ last192_0))
+ (raise-argument-error
+ 'struct-copy
+ "lifted-parsed-begin?"
+ the-struct_79)))
+ dv_0))))
+ fold-var_602)))
+ (values fold-var_604))))
+ (if (not #f) (for-loop_437 fold-var_603 rest_261) fold-var_603)))
+ fold-var_602)))))
+ for-loop_437)
+ fold-var_600
+ lst_530))))))
+ exp-s_10)))))))))
+ (define-values (replace-me) (lambda (who_37) (begin (lambda args_10 (error who_37 "this stub must be replaced")))))
(define-values
(1/current-eval)
- (let-values ()
- (let-values ()
- (make-parameter
- (replace-me 'current-eval)
- (lambda (p_52)
- (begin
- (if ((lambda (p_53) (if (procedure? p_53) (procedure-arity-includes? p_53 1) #f)) p_52)
- (void)
- (let-values () (raise-argument-error 'current-eval "(procedure-arity-includes/c 1)" p_52)))
- p_52))
- 'current-eval))))
+ (make-parameter
+ (replace-me 'current-eval)
+ (lambda (p_60)
+ (begin
+ (if ((lambda (p_61) (if (procedure? p_61) (procedure-arity-includes? p_61 1) #f)) p_60)
+ (void)
+ (raise-argument-error 'current-eval "(procedure-arity-includes/c 1)" p_60))
+ p_60))
+ 'current-eval))
(define-values
(1/current-compile)
- (let-values ()
- (let-values ()
- (make-parameter
- (replace-me 'current-compile)
- (lambda (p_19)
- (begin
- (if ((lambda (p_21) (if (procedure? p_21) (procedure-arity-includes? p_21 2) #f)) p_19)
- (void)
- (let-values () (raise-argument-error 'current-compile "(procedure-arity-includes/c 2)" p_19)))
- p_19))
- 'current-compile))))
+ (make-parameter
+ (replace-me 'current-compile)
+ (lambda (p_62)
+ (begin
+ (if ((lambda (p_63) (if (procedure? p_63) (procedure-arity-includes? p_63 2) #f)) p_62)
+ (void)
+ (raise-argument-error 'current-compile "(procedure-arity-includes/c 2)" p_62))
+ p_62))
+ 'current-compile))
(define-values
(1/current-load)
- (let-values ()
- (let-values ()
- (make-parameter
- (replace-me 'current-load)
- (lambda (p_1)
- (begin
- (if ((lambda (p_34) (if (procedure? p_34) (procedure-arity-includes? p_34 2) #f)) p_1)
- (void)
- (let-values () (raise-argument-error 'current-load "(procedure-arity-includes/c 2)" p_1)))
- p_1))
- 'current-load))))
+ (make-parameter
+ (replace-me 'current-load)
+ (lambda (p_64)
+ (begin
+ (if ((lambda (p_65) (if (procedure? p_65) (procedure-arity-includes? p_65 2) #f)) p_64)
+ (void)
+ (raise-argument-error 'current-load "(procedure-arity-includes/c 2)" p_64))
+ p_64))
+ 'current-load))
(define-values
(1/current-load/use-compiled)
- (let-values ()
- (let-values ()
- (make-parameter
- (replace-me 'current-load/use-compiled)
- (lambda (p_43)
- (begin
- (if ((lambda (p_47) (if (procedure? p_47) (procedure-arity-includes? p_47 2) #f)) p_43)
- (void)
- (let-values () (raise-argument-error 'current-load/use-compiled "(procedure-arity-includes/c 2)" p_43)))
- p_43))
- 'current-load/use-compiled))))
+ (make-parameter
+ (replace-me 'current-load/use-compiled)
+ (lambda (p_66)
+ (begin
+ (if ((lambda (p_67) (if (procedure? p_67) (procedure-arity-includes? p_67 2) #f)) p_66)
+ (void)
+ (raise-argument-error 'current-load/use-compiled "(procedure-arity-includes/c 2)" p_66))
+ p_66))
+ 'current-load/use-compiled))
(define-values
(1/current-library-collection-paths)
- (let-values ()
- (let-values ()
- (make-parameter
- null
- (lambda (l_60)
- (begin
- (if ((lambda (l_61) (if (list? l_61) (andmap2 complete-path-string? l_61) #f)) l_60)
- (void)
- (let-values ()
- (raise-argument-error
- 'current-library-collection-paths
- "(listof (and/c path-string? complete-path?))"
- l_60)))
- (map2 to-path l_60)))
- 'current-library-collection-paths))))
+ (make-parameter
+ null
+ (lambda (l_72)
+ (begin
+ (if ((lambda (l_73) (if (list? l_73) (andmap2 complete-path-string? l_73) #f)) l_72)
+ (void)
+ (raise-argument-error 'current-library-collection-paths "(listof (and/c path-string? complete-path?))" l_72))
+ (map2 to-path l_72)))
+ 'current-library-collection-paths))
(define-values
(1/current-library-collection-links)
- (let-values ()
- (let-values ()
- (make-parameter
- null
- (lambda (l_7)
- (begin
- (if ((lambda (l_57)
- (if (list? l_57)
- (andmap2
- (lambda (p_54)
- (let-values (((or-part_74) (not p_54)))
- (if or-part_74
- or-part_74
- (let-values (((or-part_86) (complete-path-string? p_54)))
- (if or-part_86
- or-part_86
- (if (hash? p_54)
- (let-values (((ht_49) p_54))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_49)))
- ((letrec-values (((for-loop_54)
- (lambda (result_21 i_65)
- (begin
- 'for-loop
- (if i_65
- (let-values (((k_21 v_67)
- (hash-iterate-key+value ht_49 i_65)))
- (let-values (((result_125)
- (let-values ()
- (let-values (((result_63)
- (let-values ()
- (let-values ()
- (if (let-values (((or-part_312)
- (not
- k_21)))
- (if or-part_312
- or-part_312
- (if (symbol?
- k_21)
- (1/module-path?
- k_21)
- #f)))
- (if (list? v_67)
- (andmap2
- complete-path-string?
- v_67)
- #f)
- #f)))))
- (values result_63)))))
- (if (if (not
- ((lambda x_95 (not result_125)) k_21 v_67))
- (not #f)
- #f)
- (for-loop_54
- result_125
- (hash-iterate-next ht_49 i_65))
- result_125)))
- result_21)))))
- for-loop_54)
- #t
- (hash-iterate-first ht_49))))
- #f))))))
- l_57)
- #f))
- l_7)
- (void)
- (let-values ()
- (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_7)))
- (map2
- (lambda (p_55)
- (if (not p_55)
- (let-values () #f)
- (if (path? p_55)
- (let-values () p_55)
- (if (string? p_55)
- (let-values () (string->path p_55))
- (let-values ()
- (let-values (((ht_171) p_55))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_171)))
- ((letrec-values (((for-loop_291)
- (lambda (table_226 i_204)
- (begin
- 'for-loop
- (if i_204
- (let-values (((k_53 v_50) (hash-iterate-key+value ht_171 i_204)))
- (let-values (((table_192)
- (let-values (((table_202) table_226))
- (let-values (((table_11)
- (let-values ()
- (let-values (((key_94 val_80)
- (let-values ()
- (values
- k_53
- (to-path v_50)))))
- (hash-set
- table_202
- key_94
- val_80)))))
- (values table_11)))))
- (if (not #f)
- (for-loop_291 table_192 (hash-iterate-next ht_171 i_204))
- table_192)))
- table_226)))))
- for-loop_291)
- '#hash()
- (hash-iterate-first ht_171)))))))))
- l_7)))
- 'current-library-collection-links))))
+ (make-parameter
+ null
+ (lambda (l_74)
+ (begin
+ (if ((lambda (l_75)
+ (if (list? l_75)
+ (andmap2
+ (lambda (p_68)
+ (let-values (((or-part_528) (not p_68)))
+ (if or-part_528
+ or-part_528
+ (let-values (((or-part_529) (complete-path-string? p_68)))
+ (if or-part_529
+ or-part_529
+ (if (hash? p_68)
+ (let-values (((result_234) (let-values (((result_235) #t)) result_235)))
+ (let-values (((ht_231) p_68))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-in-hash ht_231))
+ ((letrec-values (((for-loop_438)
+ (lambda (result_236 i_296)
+ (begin
+ 'for-loop
+ (if i_296
+ (let-values (((k_60 v_290)
+ (hash-iterate-key+value ht_231 i_296)))
+ (let-values (((result_237)
+ (let-values (((result_238)
+ (if (let-values (((or-part_530)
+ (not k_60)))
+ (if or-part_530
+ or-part_530
+ (if (symbol? k_60)
+ (1/module-path? k_60)
+ #f)))
+ (if (list? v_290)
+ (andmap2
+ complete-path-string?
+ v_290)
+ #f)
+ #f)))
+ (values result_238))))
+ (if (if (not
+ ((lambda x_103 (not result_237)) k_60 v_290))
+ (not #f)
+ #f)
+ (for-loop_438
+ result_237
+ (hash-iterate-next ht_231 i_296))
+ result_237)))
+ result_236)))))
+ for-loop_438)
+ result_234
+ (hash-iterate-first ht_231)))))
+ #f))))))
+ l_75)
+ #f))
+ l_74)
+ (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_74))
+ (map2
+ (lambda (p_69)
+ (if (not p_69)
+ #f
+ (if (path? p_69)
+ p_69
+ (if (string? p_69)
+ (string->path p_69)
+ (let-values (((table_305) (let-values (((table_306) '#hash())) table_306)))
+ (let-values (((ht_232) p_69))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_232))
+ ((letrec-values (((for-loop_439)
+ (lambda (table_307 i_297)
+ (begin
+ 'for-loop
+ (if i_297
+ (let-values (((k_61 v_291) (hash-iterate-key+value ht_232 i_297)))
+ (let-values (((table_308)
+ (let-values (((table_309)
+ (let-values (((key_107 val_88)
+ (values
+ k_61
+ (to-path v_291))))
+ (hash-set table_307 key_107 val_88))))
+ (values table_309))))
+ (if (not #f)
+ (for-loop_439 table_308 (hash-iterate-next ht_232 i_297))
+ table_308)))
+ table_307)))))
+ for-loop_439)
+ table_305
+ (hash-iterate-first ht_232)))))))))
+ l_74)))
+ 'current-library-collection-links))
(define-values
(1/use-compiled-file-paths)
- (let-values ()
- (let-values ()
- (make-parameter
- (list (string->path "compiled"))
- (lambda (l_35)
- (begin
- (if ((lambda (l_62) (if (list? l_62) (andmap2 relative-path-string?$1 l_62) #f)) l_35)
- (void)
- (let-values ()
- (raise-argument-error 'use-compiled-file-paths "(listof (and/c path-string? relative-path?))" l_35)))
- (map2 to-path l_35)))
- 'use-compiled-file-paths))))
+ (make-parameter
+ (list (string->path "compiled"))
+ (lambda (l_76)
+ (begin
+ (if ((lambda (l_77) (if (list? l_77) (andmap2 relative-path-string?$1 l_77) #f)) l_76)
+ (void)
+ (raise-argument-error 'use-compiled-file-paths "(listof (and/c path-string? relative-path?))" l_76))
+ (map2 to-path l_76)))
+ 'use-compiled-file-paths))
(define-values
(1/current-compiled-file-roots)
- (let-values ()
- (let-values ()
- (make-parameter
- '(same)
- (lambda (l_63)
- (begin
- (if ((lambda (l_64)
- (if (list? l_64)
- (andmap2
- (lambda (p_14)
- (let-values (((or-part_169) (path-string? p_14))) (if or-part_169 or-part_169 (eq? p_14 'same))))
- l_64)
- #f))
- l_63)
- (void)
- (let-values ()
- (raise-argument-error 'current-compiled-file-roots "(listof (or/c path-string? 'same))" l_63)))
- (map2 to-path l_63)))
- 'current-compiled-file-roots))))
+ (make-parameter
+ '(same)
+ (lambda (l_78)
+ (begin
+ (if ((lambda (l_79)
+ (if (list? l_79)
+ (andmap2
+ (lambda (p_70)
+ (let-values (((or-part_531) (path-string? p_70))) (if or-part_531 or-part_531 (eq? p_70 'same))))
+ l_79)
+ #f))
+ l_78)
+ (void)
+ (raise-argument-error 'current-compiled-file-roots "(listof (or/c path-string? 'same))" l_78))
+ (map2 to-path l_78)))
+ 'current-compiled-file-roots))
(define-values
(1/use-compiled-file-check)
- (let-values ()
- (let-values ()
- (make-parameter
- 'modify-seconds
- (lambda (v_168)
- (begin
- (if ((lambda (v_197)
- (let-values (((or-part_38) (eq? v_197 'modify-seconds)))
- (if or-part_38 or-part_38 (eq? v_197 'exists))))
- v_168)
- (void)
- (let-values () (raise-argument-error 'use-compiled-file-check "(or/c 'modify-seconds 'exists)" v_168)))
- v_168))
- 'use-compiled-file-check))))
+ (make-parameter
+ 'modify-seconds
+ (lambda (v_292)
+ (begin
+ (if ((lambda (v_293)
+ (let-values (((or-part_532) (eq? v_293 'modify-seconds)))
+ (if or-part_532 or-part_532 (eq? v_293 'exists))))
+ v_292)
+ (void)
+ (raise-argument-error 'use-compiled-file-check "(or/c 'modify-seconds 'exists)" v_292))
+ v_292))
+ 'use-compiled-file-check))
(define-values
(1/use-collection-link-paths)
- (make-parameter #t (lambda (v_211) (if v_211 #t #f)) 'use-collection-link-paths))
+ (make-parameter #t (lambda (v_294) (if v_294 #t #f)) 'use-collection-link-paths))
(define-values
(1/use-user-specific-search-paths)
- (make-parameter #t (lambda (v_212) (if v_212 #t #f)) 'use-user-specific-search-paths))
- (define-values (complete-path-string?) (lambda (p_56) (begin (if (path-string? p_56) (complete-path? p_56) #f))))
+ (make-parameter #t (lambda (v_295) (if v_295 #t #f)) 'use-user-specific-search-paths))
+ (define-values (complete-path-string?) (lambda (p_71) (begin (if (path-string? p_71) (complete-path? p_71) #f))))
(define-values
(relative-path-string?$1)
- (lambda (p_0) (begin 'relative-path-string? (if (path-string? p_0) (relative-path? p_0) #f))))
- (define-values (to-path) (lambda (p_32) (begin (if (string? p_32) (string->path p_32) p_32))))
+ (lambda (p_72) (begin 'relative-path-string? (if (path-string? p_72) (relative-path? p_72) #f))))
+ (define-values (to-path) (lambda (p_73) (begin (if (string? p_73) (string->path p_73) p_73))))
(define-values
(eval$1)
- (let-values ()
- (let-values ()
- (case-lambda
- ((s_89) (begin 'eval ((1/current-eval) (intro s_89))))
- ((s_10 ns_70)
- (begin
- (if (1/namespace? ns_70) (void) (let-values () (raise-argument-error 'eval "namespace?" ns_70)))
- (with-continuation-mark
- parameterization-key
- (extend-parameterization (continuation-mark-set-first #f parameterization-key) 1/current-namespace ns_70)
- (let-values () ((1/current-eval) (intro s_10 ns_70))))))))))
- (define-values
- (1/eval-syntax)
- (let-values ()
- (let-values ()
- (case-lambda
- ((s_12)
- (begin
- 'eval-syntax
- (begin
- (if (syntax?$1 s_12) (void) (let-values () (raise-argument-error 'eval-syntax "syntax?" s_12)))
- ((1/current-eval) s_12))))
- ((s_325 ns_59)
- (begin
- (if (syntax?$1 s_325) (void) (let-values () (raise-argument-error 'eval-syntax "syntax?" s_325)))
- (if (1/namespace? ns_59) (void) (let-values () (raise-argument-error 'eval-syntax "namespace?" ns_59)))
- (with-continuation-mark
- parameterization-key
- (extend-parameterization (continuation-mark-set-first #f parameterization-key) 1/current-namespace ns_59)
- (let-values () ((1/current-eval) s_325)))))))))
- (define-values (compile$1) (lambda (s_545) (begin 'compile ((1/current-compile) (intro s_545) #f))))
+ (case-lambda
+ ((s_796) (begin 'eval ((1/current-eval) (intro s_796))))
+ ((s_797 ns_138)
+ (begin
+ (if (1/namespace? ns_138) (void) (raise-argument-error 'eval "namespace?" ns_138))
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization (continuation-mark-set-first #f parameterization-key) 1/current-namespace ns_138)
+ ((1/current-eval) (intro s_797 ns_138)))))))
+ (define-values
+ (1/eval-syntax)
+ (case-lambda
+ ((s_798)
+ (begin
+ 'eval-syntax
+ (begin
+ (if (syntax?$1 s_798) (void) (raise-argument-error 'eval-syntax "syntax?" s_798))
+ ((1/current-eval) s_798))))
+ ((s_799 ns_139)
+ (begin
+ (if (syntax?$1 s_799) (void) (raise-argument-error 'eval-syntax "syntax?" s_799))
+ (if (1/namespace? ns_139) (void) (raise-argument-error 'eval-syntax "namespace?" ns_139))
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization (continuation-mark-set-first #f parameterization-key) 1/current-namespace ns_139)
+ ((1/current-eval) s_799))))))
+ (define-values (compile$1) (lambda (s_800) (begin 'compile ((1/current-compile) (intro s_800) #f))))
(define-values
(1/compile-syntax)
- (lambda (s_2)
+ (lambda (s_801)
(begin
'compile-syntax
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_2) (void) (let-values () (raise-argument-error 'compile-syntax "syntax?" s_2)))
- ((1/current-compile) s_2 #f)))))))
+ (begin
+ (if (syntax?$1 s_801) (void) (raise-argument-error 'compile-syntax "syntax?" s_801))
+ ((1/current-compile) s_801 #f)))))
(define-values
(1/expand)
(let-values (((expand_3)
(lambda (s2_8 insp1_0)
(begin
'expand
- (let-values (((s_513) s2_8))
+ (let-values (((s_802) s2_8))
(let-values (((insp_20) (if (eq? insp1_0 unsafe-undefined) (current-code-inspector) insp1_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (inspector? insp_20)
- (void)
- (let-values () (raise-argument-error 'expand "inspector?" insp_20)))
- (maybe-taint-expanded
- insp_20
- (expand$1 (intro s_513) (1/current-namespace) #t))))))))))))
- (case-lambda ((s_512) (begin 'expand (expand_3 s_512 unsafe-undefined))) ((s_4 insp1_1) (expand_3 s_4 insp1_1)))))
+ (begin
+ (if (inspector? insp_20) (void) (raise-argument-error 'expand "inspector?" insp_20))
+ (maybe-taint-expanded insp_20 (expand$1 (intro s_802) (1/current-namespace) #t)))))))))
+ (case-lambda
+ ((s_803) (begin 'expand (expand_3 s_803 unsafe-undefined)))
+ ((s_804 insp1_1) (expand_3 s_804 insp1_1)))))
(define-values
(1/expand-syntax)
(let-values (((expand-syntax_0)
(lambda (s4_0 insp3_0)
(begin
'expand-syntax
- (let-values (((s_180) s4_0))
+ (let-values (((s_805) s4_0))
(let-values (((insp_21) (if (eq? insp3_0 unsafe-undefined) (current-code-inspector) insp3_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_180)
- (void)
- (let-values () (raise-argument-error 'expand-syntax "syntax?" s_180)))
- (if (inspector? insp_21)
- (void)
- (let-values () (raise-argument-error 'expand-syntax "inspector?" insp_21)))
- (maybe-taint-expanded insp_21 (expand$1 s_180 (1/current-namespace) #t))))))))))))
+ (begin
+ (if (syntax?$1 s_805) (void) (raise-argument-error 'expand-syntax "syntax?" s_805))
+ (if (inspector? insp_21) (void) (raise-argument-error 'expand-syntax "inspector?" insp_21))
+ (maybe-taint-expanded insp_21 (expand$1 s_805 (1/current-namespace) #t)))))))))
(case-lambda
- ((s_49) (begin 'expand-syntax (expand-syntax_0 s_49 unsafe-undefined)))
- ((s_515 insp3_1) (expand-syntax_0 s_515 insp3_1)))))
+ ((s_806) (begin 'expand-syntax (expand-syntax_0 s_806 unsafe-undefined)))
+ ((s_807 insp3_1) (expand-syntax_0 s_807 insp3_1)))))
(define-values
(1/expand-once)
(let-values (((expand-once_1)
(lambda (s6_3 insp5_0)
(begin
'expand-once
- (let-values (((s_516) s6_3))
+ (let-values (((s_808) s6_3))
(let-values (((insp_22) (if (eq? insp5_0 unsafe-undefined) (current-code-inspector) insp5_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (inspector? insp_22)
- (void)
- (let-values () (raise-argument-error 'expand-once "inspector?" insp_22)))
- (maybe-taint-expanded insp_22 (expand-once$1 (intro s_516)))))))))))))
+ (begin
+ (if (inspector? insp_22) (void) (raise-argument-error 'expand-once "inspector?" insp_22))
+ (maybe-taint-expanded insp_22 (expand-once$1 (intro s_808))))))))))
(case-lambda
- ((s_83) (begin 'expand-once (expand-once_1 s_83 unsafe-undefined)))
- ((s_177 insp5_1) (expand-once_1 s_177 insp5_1)))))
+ ((s_809) (begin 'expand-once (expand-once_1 s_809 unsafe-undefined)))
+ ((s_810 insp5_1) (expand-once_1 s_810 insp5_1)))))
(define-values
(1/expand-syntax-once)
(let-values (((expand-syntax-once_0)
- (lambda (s8_0 insp7_0)
+ (lambda (s8_1 insp7_0)
(begin
'expand-syntax-once
- (let-values (((s_525) s8_0))
+ (let-values (((s_811) s8_1))
(let-values (((insp_23) (if (eq? insp7_0 unsafe-undefined) (current-code-inspector) insp7_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_525)
- (void)
- (let-values () (raise-argument-error 'expand-syntax-once "syntax?" s_525)))
- (if (inspector? insp_23)
- (void)
- (let-values () (raise-argument-error 'expand-syntax-once "inspector?" insp_23)))
- (maybe-taint-expanded insp_23 (expand-once$1 s_525))))))))))))
+ (begin
+ (if (syntax?$1 s_811) (void) (raise-argument-error 'expand-syntax-once "syntax?" s_811))
+ (if (inspector? insp_23)
+ (void)
+ (raise-argument-error 'expand-syntax-once "inspector?" insp_23))
+ (maybe-taint-expanded insp_23 (expand-once$1 s_811)))))))))
(case-lambda
- ((s_85) (begin 'expand-syntax-once (expand-syntax-once_0 s_85 unsafe-undefined)))
- ((s_86 insp7_1) (expand-syntax-once_0 s_86 insp7_1)))))
+ ((s_812) (begin 'expand-syntax-once (expand-syntax-once_0 s_812 unsafe-undefined)))
+ ((s_813 insp7_1) (expand-syntax-once_0 s_813 insp7_1)))))
(define-values
(1/expand-to-top-form)
(let-values (((expand-to-top-form_1)
(lambda (s10_3 insp9_0)
(begin
'expand-to-top-form
- (let-values (((s_185) s10_3))
+ (let-values (((s_814) s10_3))
(let-values (((insp_24) (if (eq? insp9_0 unsafe-undefined) (current-code-inspector) insp9_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (inspector? insp_24)
- (void)
- (let-values () (raise-argument-error 'expand-to-top-form "inspector?" insp_24)))
- (maybe-taint-expanded insp_24 (expand-to-top-form$1 (intro s_185)))))))))))))
+ (begin
+ (if (inspector? insp_24)
+ (void)
+ (raise-argument-error 'expand-to-top-form "inspector?" insp_24))
+ (maybe-taint-expanded insp_24 (expand-to-top-form$1 (intro s_814))))))))))
(case-lambda
- ((s_487) (begin 'expand-to-top-form (expand-to-top-form_1 s_487 unsafe-undefined)))
- ((s_461 insp9_1) (expand-to-top-form_1 s_461 insp9_1)))))
+ ((s_815) (begin 'expand-to-top-form (expand-to-top-form_1 s_815 unsafe-undefined)))
+ ((s_816 insp9_1) (expand-to-top-form_1 s_816 insp9_1)))))
(define-values
(1/expand-syntax-to-top-form)
(let-values (((expand-syntax-to-top-form_0)
- (lambda (s12_0 insp11_0)
+ (lambda (s12_1 insp11_0)
(begin
'expand-syntax-to-top-form
- (let-values (((s_329) s12_0))
+ (let-values (((s_817) s12_1))
(let-values (((insp_25) (if (eq? insp11_0 unsafe-undefined) (current-code-inspector) insp11_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_329)
- (void)
- (let-values () (raise-argument-error 'expand-syntax-to-top-form "syntax?" s_329)))
- (if (inspector? insp_25)
- (void)
- (let-values ()
- (raise-argument-error 'expand-syntax-to-top-form "inspector?" insp_25)))
- (maybe-taint-expanded insp_25 (expand-to-top-form$1 s_329))))))))))))
+ (begin
+ (if (syntax?$1 s_817)
+ (void)
+ (raise-argument-error 'expand-syntax-to-top-form "syntax?" s_817))
+ (if (inspector? insp_25)
+ (void)
+ (raise-argument-error 'expand-syntax-to-top-form "inspector?" insp_25))
+ (maybe-taint-expanded insp_25 (expand-to-top-form$1 s_817)))))))))
(case-lambda
- ((s_95) (begin 'expand-syntax-to-top-form (expand-syntax-to-top-form_0 s_95 unsafe-undefined)))
- ((s_469 insp11_1) (expand-syntax-to-top-form_0 s_469 insp11_1)))))
+ ((s_818) (begin 'expand-syntax-to-top-form (expand-syntax-to-top-form_0 s_818 unsafe-undefined)))
+ ((s_819 insp11_1) (expand-syntax-to-top-form_0 s_819 insp11_1)))))
(define-values
(intro)
(let-values (((intro_0)
@@ -55202,522 +54251,505 @@
(begin
'intro
(let-values (((given-s_1) given-s14_0))
- (let-values (((ns_116) (if (eq? ns13_1 unsafe-undefined) (1/current-namespace) ns13_1)))
- (let-values ()
- (let-values (((s_176) (if (syntax?$1 given-s_1) given-s_1 (1/datum->syntax #f given-s_1))))
- (1/namespace-syntax-introduce s_176 ns_116)))))))))
+ (let-values (((ns_140) (if (eq? ns13_1 unsafe-undefined) (1/current-namespace) ns13_1)))
+ (let-values (((s_820) (if (syntax?$1 given-s_1) given-s_1 (1/datum->syntax #f given-s_1))))
+ (1/namespace-syntax-introduce s_820 ns_140))))))))
(case-lambda
((given-s_2) (begin (intro_0 given-s_2 unsafe-undefined)))
((given-s_3 ns13_2) (intro_0 given-s_3 ns13_2)))))
(define-values
(maybe-taint-expanded)
- (lambda (insp_26 s_98) (begin (if (eq? insp_26 initial-code-inspector) s_98 (syntax-taint$1 s_98)))))
+ (lambda (insp_26 s_821) (begin (if (eq? insp_26 initial-code-inspector) s_821 (syntax-taint$1 s_821)))))
(define-values
(do-dynamic-require)
(let-values (((do-dynamic-require_0)
- (lambda (who2_0 mod-path3_1 sym4_1 fail-k1_0)
+ (lambda (who3_0 mod-path4_0 sym5_0 fail-k1_0 syntax-k2_0)
(begin
'do-dynamic-require
- (let-values (((who_25) who2_0))
- (let-values (((mod-path_5) mod-path3_1))
- (let-values (((sym_55) sym4_1))
- (let-values (((fail-k_2)
- (if (eq? fail-k1_0 unsafe-undefined)
- default-dynamic-require-fail-thunk
- fail-k1_0)))
- (let-values ()
+ (let-values (((who_38) who3_0))
+ (let-values (((mod-path_18) mod-path4_0))
+ (let-values (((sym_123) sym5_0))
+ (let-values (((fail-k_2) fail-k1_0))
+ (let-values (((syntax-k_0) syntax-k2_0))
(let-values ((()
(begin
- (if (let-values (((or-part_14) (1/module-path? mod-path_5)))
- (if or-part_14
- or-part_14
- (let-values (((or-part_83) (1/module-path-index? mod-path_5)))
- (if or-part_83
- or-part_83
- (1/resolved-module-path? mod-path_5)))))
+ (if (let-values (((or-part_533) (1/module-path? mod-path_18)))
+ (if or-part_533
+ or-part_533
+ (let-values (((or-part_534) (1/module-path-index? mod-path_18)))
+ (if or-part_534
+ or-part_534
+ (1/resolved-module-path? mod-path_18)))))
(void)
- (let-values ()
- (raise-argument-error
- who_25
- "(or/c module-path? module-path-index? resolved-module-path?)"
- mod-path_5)))
+ (raise-argument-error
+ who_38
+ "(or/c module-path? module-path-index? resolved-module-path?)"
+ mod-path_18))
(values))))
(let-values ((()
(begin
- (if (let-values (((or-part_15) (symbol? sym_55)))
- (if or-part_15
- or-part_15
- (let-values (((or-part_73) (not sym_55)))
- (if or-part_73
- or-part_73
- (let-values (((or-part_84) (equal? sym_55 0)))
- (if or-part_84 or-part_84 (void? sym_55)))))))
+ (if (let-values (((or-part_535) (symbol? sym_123)))
+ (if or-part_535
+ or-part_535
+ (let-values (((or-part_536) (not sym_123)))
+ (if or-part_536
+ or-part_536
+ (let-values (((or-part_537) (equal? sym_123 0)))
+ (if or-part_537 or-part_537 (void? sym_123)))))))
(void)
- (let-values ()
- (raise-argument-error who_25 "(or/c symbol? #f 0 void?)" sym_55)))
+ (raise-argument-error who_38 "(or/c symbol? #f 0 void?)" sym_123))
(values))))
(let-values ((()
(begin
- (if (if (procedure? fail-k_2)
- (procedure-arity-includes? fail-k_2 0)
- #f)
+ (if (let-values (((or-part_538) (eq? fail-k_2 'error)))
+ (if or-part_538
+ or-part_538
+ (if (procedure? fail-k_2)
+ (procedure-arity-includes? fail-k_2 0)
+ #f)))
(void)
- (let-values () (raise-argument-error who_25 "(-> any)" fail-k_2)))
+ (raise-argument-error who_38 "(or/c 'error (-> any))" fail-k_2))
(values))))
- (let-values (((ns_117) (1/current-namespace)))
- (let-values (((mpi_61)
- (if (1/module-path? mod-path_5)
- (let-values () (1/module-path-index-join mod-path_5 #f))
- (if (1/module-path-index? mod-path_5)
- (let-values () mod-path_5)
- (let-values ()
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_539) (eq? syntax-k_0 'eval)))
+ (if or-part_539
+ or-part_539
+ (if (procedure? syntax-k_0)
+ (procedure-arity-includes? syntax-k_0 0)
+ #f)))
+ (void)
+ (raise-argument-error who_38 "(or/c 'eval (-> any))" syntax-k_0))
+ (values))))
+ (let-values (((ns_141) (1/current-namespace)))
+ (let-values (((mpi_88)
+ (if (1/module-path? mod-path_18)
+ (1/module-path-index-join mod-path_18 #f)
+ (if (1/module-path-index? mod-path_18)
+ mod-path_18
(1/module-path-index-join
- (resolved-module-path->module-path mod-path_5)
- #f))))))
- (let-values (((mod-name_24) (1/module-path-index-resolve mpi_61 #t)))
- (let-values (((phase_1) (namespace-phase ns_117)))
- (if (not sym_55)
- (let-values ()
- (let-values (((ns11_1) ns_117)
- ((mpi12_0) mpi_61)
- ((phase13_1) phase_1)
- ((phase14_4) phase_1)
- ((temp15_6) #f))
+ (resolved-module-path->module-path mod-path_18)
+ #f)))))
+ (let-values (((mod-name_25) (1/module-path-index-resolve mpi_88 #t)))
+ (let-values (((phase_196) (namespace-phase ns_141)))
+ (if (not sym_123)
+ (let-values (((ns14_2) ns_141)
+ ((mpi15_0) mpi_88)
+ ((phase16_0) phase_196)
+ ((phase17_3) phase_196)
+ ((temp18_6) #f))
(namespace-module-instantiate!.1
#f
- temp15_6
- phase14_4
+ temp18_6
+ #t
+ phase17_3
'#hasheq()
null
#f
- ns11_1
- mpi12_0
- phase13_1)))
- (if (equal? sym_55 0)
- (let-values ()
- (let-values (((ns16_2) ns_117)
- ((mpi17_1) mpi_61)
- ((phase18_1) phase_1)
- ((phase19_1) phase_1))
+ #f
+ ns14_2
+ mpi15_0
+ phase16_0))
+ (if (equal? sym_123 0)
+ (let-values (((ns19_0) ns_141)
+ ((mpi20_0) mpi_88)
+ ((phase21_1) phase_196)
+ ((phase22_3) phase_196))
(namespace-module-instantiate!.1
#f
#t
- phase19_1
+ #t
+ phase22_3
'#hasheq()
null
#f
- ns16_2
- mpi17_1
- phase18_1)))
- (if (void? sym_55)
- (let-values ()
+ #f
+ ns19_0
+ mpi20_0
+ phase21_1))
+ (if (void? sym_123)
(begin
- (namespace-visit-available-modules! ns_117 phase_1)
- (let-values (((ns20_4) ns_117)
- ((mpi21_0) mpi_61)
- ((phase22_3) phase_1)
- ((phase23_0) phase_1))
+ (namespace-visit-available-modules! ns_141 phase_196)
+ (let-values (((ns23_0) ns_141)
+ ((mpi24_0) mpi_88)
+ ((phase25_1) phase_196)
+ ((phase26_0) phase_196))
(namespace-module-visit!.1
- phase23_0
- ns20_4
- mpi21_0
- phase22_3))))
- (let-values ()
- (let-values (((m_25) (namespace->module ns_117 mod-name_24)))
+ #f
+ phase26_0
+ ns23_0
+ mpi24_0
+ phase25_1)))
+ (let-values (((m_30) (namespace->module ns_141 mod-name_25)))
(let-values ((()
(begin
- (if m_25
+ (if m_30
(void)
- (let-values ()
- (raise-unknown-module-error
- 'dynamic-require
- mod-name_24)))
+ (raise-unknown-module-error
+ 'dynamic-require
+ mod-name_25))
(values))))
- (let-values (((binding/p_5)
+ (let-values (((binding/p_6)
(hash-ref
- (hash-ref (module-provides m_25) 0 '#hasheq())
- sym_55
+ (hash-ref (module-provides m_30) 0 '#hasheq())
+ sym_123
#f)))
- (if (not binding/p_5)
- (let-values ()
- (if (eq? fail-k_2 default-dynamic-require-fail-thunk)
- (raise-arguments-error
- 'dynamic-require
- "name is not provided"
- "name"
- sym_55
- "module"
- mod-name_24)
- (fail-k_2)))
- (let-values ()
- (let-values (((binding_26)
- (provided-as-binding binding/p_5)))
- (let-values (((ex-sym_2)
- (module-binding-sym binding_26)))
- (let-values (((ex-phase_0)
- (module-binding-phase binding_26)))
- (let-values ((()
- (begin
- (let-values (((ns24_3) ns_117)
- ((mpi25_0) mpi_61)
- ((phase26_0) phase_1)
- ((phase27_0) phase_1)
- ((temp28_3) #f))
- (namespace-module-instantiate!.1
- #f
- temp28_3
- phase27_0
- '#hasheq()
- null
+ (if (not binding/p_6)
+ (if (eq? fail-k_2 'error)
+ (raise-arguments-error
+ 'dynamic-require
+ "name is not provided"
+ "name"
+ sym_123
+ "module"
+ mod-name_25)
+ (fail-k_2))
+ (let-values (((binding_27)
+ (provided-as-binding binding/p_6)))
+ (let-values (((ex-sym_2) (module-binding-sym binding_27)))
+ (let-values (((ex-phase_0)
+ (module-binding-phase binding_27)))
+ (let-values ((()
+ (begin
+ (let-values (((ns27_0) ns_141)
+ ((mpi28_0) mpi_88)
+ ((phase29_0) phase_196)
+ ((phase30_4) phase_196)
+ ((temp31_2) #f))
+ (namespace-module-instantiate!.1
+ #f
+ temp31_2
+ #t
+ phase30_4
+ '#hasheq()
+ null
+ #f
+ #f
+ ns27_0
+ mpi28_0
+ phase29_0))
+ (values))))
+ (let-values (((ex-mod-name_0)
+ (1/module-path-index-resolve
+ (module-path-index-shift
+ (module-binding-module binding_27)
+ (module-self m_30)
+ mpi_88))))
+ (let-values (((m-ns_17)
+ (let-values (((ns32_0) ns_141)
+ ((ex-mod-name33_0)
+ ex-mod-name_0)
+ ((temp34_3)
+ (phase-
+ phase_196
+ ex-phase_0))
+ ((temp35_2) #t))
+ (namespace->module-namespace.1
#f
- ns24_3
- mpi25_0
- phase26_0))
- (values))))
- (let-values (((ex-mod-name_0)
- (1/module-path-index-resolve
- (module-path-index-shift
- (module-binding-module binding_26)
- (module-self m_25)
- mpi_61))))
- (let-values (((m-ns_17)
- (let-values (((ns29_0) ns_117)
- ((ex-mod-name30_0)
- ex-mod-name_0)
- ((temp31_1)
- (phase-
- phase_1
- ex-phase_0))
- ((temp32_3) #t))
- (namespace->module-namespace.1
- #f
- temp32_3
- void
- ns29_0
- ex-mod-name30_0
- temp31_1))))
- (let-values (((ex-m_0)
- (namespace->module
- ns_117
- ex-mod-name_0)))
- (let-values (((access_4)
- (let-values (((or-part_36)
- (module-access
- ex-m_0)))
- (if or-part_36
- or-part_36
- (module-compute-access!
- ex-m_0)))))
- (let-values ((()
- (begin
- (if (if (not
- (eq?
- 'provided
- (hash-ref
- (hash-ref
- access_4
- ex-phase_0
- '#hasheq())
- ex-sym_2
- #f)))
- (if (not
- (inspector-superior?
- (current-code-inspector)
- (namespace-inspector
- m-ns_17)))
- (not
- (if (module-binding-extra-inspector
- binding_26)
- (inspector-superior?
- (module-binding-extra-inspector
- binding_26)
- (namespace-inspector
- m-ns_17))
- #f))
- #f)
+ temp35_2
+ void
+ ns32_0
+ ex-mod-name33_0
+ temp34_3))))
+ (let-values (((ex-m_0)
+ (namespace->module
+ ns_141
+ ex-mod-name_0)))
+ (let-values (((access_9)
+ (let-values (((or-part_540)
+ (module-access
+ ex-m_0)))
+ (if or-part_540
+ or-part_540
+ (module-compute-access!
+ ex-m_0)))))
+ (let-values ((()
+ (begin
+ (if (if (not
+ (eq?
+ 'provided
+ (hash-ref
+ (hash-ref
+ access_9
+ ex-phase_0
+ '#hasheq())
+ ex-sym_2
+ #f)))
+ (if (not
+ (inspector-superior?
+ (current-code-inspector)
+ (namespace-inspector
+ m-ns_17)))
+ (not
+ (if (module-binding-extra-inspector
+ binding_27)
+ (inspector-superior?
+ (module-binding-extra-inspector
+ binding_27)
+ (namespace-inspector
+ m-ns_17))
+ #f))
#f)
- (let-values ()
+ #f)
+ (raise-arguments-error
+ 'dynamic-require
+ "name is protected"
+ "name"
+ sym_123
+ "module"
+ mod-name_25)
+ (void))
+ (values))))
+ (let-values (((fail_1)
+ (lambda ()
+ (begin
+ 'fail
+ (if (eq?
+ fail-k_2
+ 'error)
(raise-arguments-error
'dynamic-require
- "name is protected"
+ "name's binding is missing"
"name"
- sym_55
+ sym_123
"module"
- mod-name_24))
- (void))
- (values))))
- (let-values (((fail_1)
- (lambda ()
- (begin
- 'fail
- (if (eq?
- fail-k_2
- default-dynamic-require-fail-thunk)
- (raise-arguments-error
- 'dynamic-require
- "name's binding is missing"
- "name"
- sym_55
- "module"
- mod-name_24)
- (fail-k_2))))))
- (if (not
- (provided-as-transformer?
- binding/p_5))
- (let-values ()
- (namespace-get-variable
- m-ns_17
- ex-phase_0
- ex-sym_2
- fail_1))
- (let-values ()
- (let-values (((missing_1)
- (gensym 'missing)))
- (let-values ((()
- (begin
- (let-values (((ns33_0)
- ns_117)
- ((mpi34_0)
- mpi_61)
- ((phase35_0)
- phase_1)
- ((phase36_2)
- phase_1))
- (namespace-module-visit!.1
- phase36_2
- ns33_0
- mpi34_0
- phase35_0))
- (values))))
- (let-values (((t_34)
- (namespace-get-transformer
- m-ns_17
- ex-phase_0
- ex-sym_2
- missing_1)))
- (if (eq? t_34 missing_1)
- (let-values () (fail_1))
- (let-values ()
- (let-values (((tmp-ns_0)
- (let-values (((ns37_4)
- ns_117))
- (new-namespace.1
- #t
- unsafe-undefined
- ns37_4))))
- (let-values (((mod-path_17)
- (resolved-module-path->module-path
- mod-name_24)))
+ mod-name_25)
+ (fail-k_2))))))
+ (if (not
+ (provided-as-transformer?
+ binding/p_6))
+ (namespace-get-variable
+ m-ns_17
+ ex-phase_0
+ ex-sym_2
+ fail_1)
+ (if (not (eq? syntax-k_0 'eval))
+ (syntax-k_0)
+ (let-values (((missing_1)
+ (gensym 'missing)))
+ (let-values ((()
(begin
- (1/namespace-require
- mod-path_17
- tmp-ns_0)
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first
+ (let-values (((ns36_0)
+ ns_141)
+ ((mpi37_0)
+ mpi_88)
+ ((phase38_0)
+ phase_196)
+ ((phase39_0)
+ phase_196))
+ (namespace-module-visit!.1
#f
- parameterization-key)
- 1/current-namespace
- tmp-ns_0)
- (let-values ()
- (1/eval
- sym_55
- tmp-ns_0))))))))))))))))))))))))))))))))))))))))))))))))
+ phase39_0
+ ns36_0
+ mpi37_0
+ phase38_0))
+ (values))))
+ (let-values (((t_39)
+ (namespace-get-transformer
+ m-ns_17
+ ex-phase_0
+ ex-sym_2
+ missing_1)))
+ (if (eq? t_39 missing_1)
+ (fail_1)
+ (let-values (((tmp-ns_0)
+ (let-values (((ns40_0)
+ ns_141))
+ (new-namespace.1
+ #t
+ unsafe-undefined
+ ns40_0))))
+ (let-values (((mod-path_19)
+ (resolved-module-path->module-path
+ mod-name_25)))
+ (begin
+ (1/namespace-require
+ mod-path_19
+ tmp-ns_0)
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first
+ #f
+ parameterization-key)
+ 1/current-namespace
+ tmp-ns_0)
+ (1/eval
+ sym_123
+ tmp-ns_0)))))))))))))))))))))))))))))))))))))))))))))
(case-lambda
- ((who_26 mod-path_18 sym_101) (begin (do-dynamic-require_0 who_26 mod-path_18 sym_101 unsafe-undefined)))
- ((who_27 mod-path_19 sym_102 fail-k1_1) (do-dynamic-require_0 who_27 mod-path_19 sym_102 fail-k1_1)))))
- (define-values (default-dynamic-require-fail-thunk) (lambda () (begin (error "failed"))))
+ ((who_39 mod-path_20 sym_124) (begin (do-dynamic-require_0 who_39 mod-path_20 sym_124 'error 'eval)))
+ ((who_40 mod-path_21 sym_125 fail-k_3 syntax-k2_1)
+ (do-dynamic-require_0 who_40 mod-path_21 sym_125 fail-k_3 syntax-k2_1))
+ ((who_41 mod-path_22 sym_126 fail-k1_1) (do-dynamic-require_0 who_41 mod-path_22 sym_126 fail-k1_1 'eval)))))
(define-values
(1/dynamic-require)
(let-values (((dynamic-require_0)
- (lambda (mod-path6_2 sym7_0 fail-k5_0)
+ (lambda (mod-path8_0 sym9_0 fail-k6_0 syntax-k7_0)
(begin
'dynamic-require
- (let-values (((mod-path_20) mod-path6_2))
- (let-values (((sym_103) sym7_0))
- (let-values (((fail-k_3)
- (if (eq? fail-k5_0 unsafe-undefined)
- default-dynamic-require-fail-thunk
- fail-k5_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (do-dynamic-require 'dynamic-require mod-path_20 sym_103 fail-k_3)))))))))))
+ (let-values (((mod-path_23) mod-path8_0))
+ (let-values (((sym_127) sym9_0))
+ (let-values (((fail-k_4) fail-k6_0))
+ (let-values (((syntax-k_1) syntax-k7_0))
+ (do-dynamic-require 'dynamic-require mod-path_23 sym_127 fail-k_4 syntax-k_1)))))))))
(case-lambda
- ((mod-path_21 sym_104) (begin 'dynamic-require (dynamic-require_0 mod-path_21 sym_104 unsafe-undefined)))
- ((mod-path_22 sym_52 fail-k5_1) (dynamic-require_0 mod-path_22 sym_52 fail-k5_1)))))
+ ((mod-path_24 sym_128) (begin 'dynamic-require (dynamic-require_0 mod-path_24 sym_128 'error 'eval)))
+ ((mod-path_25 sym_129 fail-k_5 syntax-k7_1) (dynamic-require_0 mod-path_25 sym_129 fail-k_5 syntax-k7_1))
+ ((mod-path_26 sym_130 fail-k6_1) (dynamic-require_0 mod-path_26 sym_130 fail-k6_1 'eval)))))
(define-values
(1/dynamic-require-for-syntax)
(let-values (((dynamic-require-for-syntax_0)
- (lambda (mod-path9_0 sym10_1 fail-k8_0)
+ (lambda (mod-path12_0 sym13_1 fail-k10_0 syntax-k11_0)
(begin
'dynamic-require-for-syntax
- (let-values (((mod-path_23) mod-path9_0))
- (let-values (((sym_105) sym10_1))
- (let-values (((fail-k_4)
- (if (eq? fail-k8_0 unsafe-undefined)
- default-dynamic-require-fail-thunk
- fail-k8_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first #f parameterization-key)
- 1/current-namespace
- (let-values (((ns_12) (1/current-namespace)))
- (namespace->namespace-at-phase ns_12 (add1 (namespace-phase ns_12)))))
- (let-values ()
- (do-dynamic-require
- 'dynamic-require-for-syntax
- mod-path_23
- sym_105
- fail-k_4)))))))))))))
+ (let-values (((mod-path_27) mod-path12_0))
+ (let-values (((sym_131) sym13_1))
+ (let-values (((fail-k_6) fail-k10_0))
+ (let-values (((syntax-k_2) syntax-k11_0))
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first #f parameterization-key)
+ 1/current-namespace
+ (let-values (((ns_142) (1/current-namespace)))
+ (namespace->namespace-at-phase ns_142 (add1 (namespace-phase ns_142)))))
+ (do-dynamic-require
+ 'dynamic-require-for-syntax
+ mod-path_27
+ sym_131
+ fail-k_6
+ syntax-k_2))))))))))
(case-lambda
- ((mod-path_24 sym_53)
- (begin 'dynamic-require-for-syntax (dynamic-require-for-syntax_0 mod-path_24 sym_53 unsafe-undefined)))
- ((mod-path_25 sym_106 fail-k8_1) (dynamic-require-for-syntax_0 mod-path_25 sym_106 fail-k8_1)))))
+ ((mod-path_28 sym_132)
+ (begin 'dynamic-require-for-syntax (dynamic-require-for-syntax_0 mod-path_28 sym_132 'error 'eval)))
+ ((mod-path_29 sym_133 fail-k_7 syntax-k11_1)
+ (dynamic-require-for-syntax_0 mod-path_29 sym_133 fail-k_7 syntax-k11_1))
+ ((mod-path_30 sym_134 fail-k10_1) (dynamic-require-for-syntax_0 mod-path_30 sym_134 fail-k10_1 'eval)))))
(define-values
(1/load)
- (lambda (s_0)
+ (lambda (s_822)
(begin
'load
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (path-string? s_0) (void) (let-values () (raise-argument-error 'load "path-string?" s_0)))
- (values))))
- (let-values (((p_57) (->path s_0)))
- (call-with-current-load-relative-directory p_57 (lambda () ((1/current-load) p_57 #f))))))))))
+ (let-values ((()
+ (begin
+ (if (path-string? s_822) (void) (raise-argument-error 'load "path-string?" s_822))
+ (values))))
+ (let-values (((p_74) (->path s_822)))
+ (call-with-current-load-relative-directory p_74 (lambda () ((1/current-load) p_74 #f))))))))
(define-values
(1/load-extension)
- (lambda (s_1)
+ (lambda (s_823)
(begin
'load-extension
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (path-string? s_1)
- (void)
- (let-values () (raise-argument-error 'load-extension "path-string?" s_1)))
- (values))))
- (let-values (((p_58) (->path s_1)))
- (call-with-current-load-relative-directory p_58 (lambda () ((current-load-extension) p_58 #f))))))))))
+ (let-values ((()
+ (begin
+ (if (path-string? s_823) (void) (raise-argument-error 'load-extension "path-string?" s_823))
+ (values))))
+ (let-values (((p_75) (->path s_823)))
+ (call-with-current-load-relative-directory p_75 (lambda () ((current-load-extension) p_75 #f))))))))
(define-values
(call-with-current-load-relative-directory)
- (lambda (p_19 thunk_6)
+ (lambda (p_76 thunk_5)
(begin
- (let-values (((base_19 name_38 dir?_5) (split-path p_19)))
+ (let-values (((base_21 name_82 dir?_5) (split-path p_76)))
(with-continuation-mark
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
current-load-relative-directory
- (if (eq? base_19 'relative) (current-directory) (path->complete-path base_19)))
- (let-values () (thunk_6)))))))
+ (if (eq? base_21 'relative) (current-directory) (path->complete-path base_21)))
+ (thunk_5))))))
(define-values
(1/load/use-compiled)
- (lambda (f_26)
+ (lambda (f_39)
(begin
'load/use-compiled
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (path-string? f_26)
- (void)
- (let-values () (raise-argument-error 'load/use-compiled "path-string?" f_26)))
- (values))))
- (let-values (((p_47) (->path f_26))) ((1/current-load/use-compiled) p_47 #f))))))))
+ (let-values ((()
+ (begin
+ (if (path-string? f_39) (void) (raise-argument-error 'load/use-compiled "path-string?" f_39))
+ (values))))
+ (let-values (((p_77) (->path f_39))) ((1/current-load/use-compiled) p_77 #f))))))
(define-values
(embedded-load)
(let-values (((embedded-load_0)
(lambda (start2_0 end3_0 bstr4_0 as-predefined?5_0 in-path1_0)
(begin
'embedded-load
- (let-values (((start_53) start2_0))
- (let-values (((end_40) end3_0))
+ (let-values (((start_64) start2_0))
+ (let-values (((end_43) end3_0))
(let-values (((bstr_18) bstr4_0))
(let-values (((as-predefined?_0) as-predefined?5_0))
(let-values (((in-path_0) in-path1_0))
- (let-values ()
- (let-values (((s_514)
- (if bstr_18
- bstr_18
- (let-values (((path_10)
- (if (bytes? in-path_0)
- (let-values () (bytes->path in-path_0))
- (if (string? in-path_0)
- (let-values () in-path_0)
- (let-values ()
- (find-executable-path
- (find-system-path 'exec-file)
- #f))))))
- (let-values (((start_54)
- (if (string? start_53)
- (let-values (((or-part_4)
- (1/string->number start_53)))
- (if or-part_4 or-part_4 0))
- start_53)))
- (let-values (((end_41)
- (if (string? end_40)
- (let-values (((or-part_6)
- (1/string->number end_40)))
- (if or-part_6 or-part_6 0))
- (let-values (((or-part_7) end_40))
- (if or-part_7 or-part_7 (file-size path_10))))))
- (let-values (((path9_0) path_10)
- ((temp10_4)
- (lambda ()
- (begin
- (file-position (current-input-port) start_54)
- (read-bytes (max 0 (- end_41 start_54)))))))
- (with-input-from-file.1 'binary path9_0 temp10_4))))))))
- (let-values (((p_55) (open-input-bytes s_514)))
- ((letrec-values (((loop_96)
- (lambda ()
- (begin
- 'loop
- (let-values (((e_84)
- (with-continuation-mark
- 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)
- (let-values () (1/read p_55)))))
- (if (eof-object? e_84)
- (void)
- (let-values ()
- (begin
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first
- #f
- parameterization-key)
- current-module-declare-as-predefined
- as-predefined?_0)
- (let-values () ((1/current-eval) e_84)))
- (loop_96)))))))))
- loop_96))))))))))))))
+ (let-values (((s_824)
+ (if bstr_18
+ bstr_18
+ (let-values (((path_9)
+ (if (bytes? in-path_0)
+ (bytes->path in-path_0)
+ (if (string? in-path_0)
+ in-path_0
+ (find-executable-path
+ (find-system-path 'exec-file)
+ #f)))))
+ (let-values (((start_65)
+ (if (string? start_64)
+ (let-values (((or-part_541)
+ (1/string->number start_64)))
+ (if or-part_541 or-part_541 0))
+ start_64)))
+ (let-values (((end_44)
+ (if (string? end_43)
+ (let-values (((or-part_542)
+ (1/string->number end_43)))
+ (if or-part_542 or-part_542 0))
+ (let-values (((or-part_543) end_43))
+ (if or-part_543 or-part_543 (file-size path_9))))))
+ (let-values (((path9_0) path_9)
+ ((temp10_4)
+ (lambda ()
+ (begin
+ (file-position (current-input-port) start_65)
+ (read-bytes (max 0 (- end_44 start_65)))))))
+ (with-input-from-file.1 'binary path9_0 temp10_4))))))))
+ (let-values (((p_78) (open-input-bytes s_824)))
+ ((letrec-values (((loop_118)
+ (lambda ()
+ (begin
+ 'loop
+ (let-values (((e_93)
+ (with-continuation-mark
+ 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_78))))
+ (if (eof-object? e_93)
+ (void)
+ (begin
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first #f parameterization-key)
+ current-module-declare-as-predefined
+ as-predefined?_0)
+ ((1/current-eval) e_93))
+ (loop_118))))))))
+ loop_118)))))))))))))
(case-lambda
- ((start_48 end_34 bstr_19 as-predefined?_1) (begin (embedded-load_0 start_48 end_34 bstr_19 as-predefined?_1 #f)))
- ((start_55 end_42 bstr_20 as-predefined?_2 in-path1_1)
- (embedded-load_0 start_55 end_42 bstr_20 as-predefined?_2 in-path1_1)))))
- (define-values (->path) (lambda (s_87) (begin (if (string? s_87) (string->path s_87) s_87))))
+ ((start_66 end_45 bstr_19 as-predefined?_1) (begin (embedded-load_0 start_66 end_45 bstr_19 as-predefined?_1 #f)))
+ ((start_67 end_46 bstr_20 as-predefined?_2 in-path1_1)
+ (embedded-load_0 start_67 end_46 bstr_20 as-predefined?_2 in-path1_1)))))
+ (define-values (->path) (lambda (s_825) (begin (if (string? s_825) (string->path s_825) s_825))))
(define-values
(find-main-collects)
(lambda ()
@@ -55731,25 +54763,23 @@
(lambda (collects-path_0)
(begin
(if (complete-path? collects-path_0)
- (let-values () (simplify-path collects-path_0))
+ (simplify-path collects-path_0)
(if (absolute-path? collects-path_0)
- (let-values ()
- (let-values (((exec_0)
- (call-in-original-directory
- (lambda ()
- (path->complete-path
- (find-executable-path (find-system-path 'exec-file))
- (find-system-path 'orig-dir))))))
- (let-values (((base_20 name_56 dir?_6) (split-path exec_0)))
- (simplify-path (path->complete-path collects-path_0 base_20)))))
- (let-values ()
- (let-values (((p_58)
- (call-in-original-directory
- (lambda () (find-executable-path (find-system-path 'exec-file) collects-path_0 #t)))))
- (if p_58 (simplify-path p_58) #f))))))))
+ (let-values (((exec_0)
+ (call-in-original-directory
+ (lambda ()
+ (path->complete-path
+ (find-executable-path (find-system-path 'exec-file))
+ (find-system-path 'orig-dir))))))
+ (let-values (((base_22 name_83 dir?_6) (split-path exec_0)))
+ (simplify-path (path->complete-path collects-path_0 base_22))))
+ (let-values (((p_79)
+ (call-in-original-directory
+ (lambda () (find-executable-path (find-system-path 'exec-file) collects-path_0 #t)))))
+ (if p_79 (simplify-path p_79) #f)))))))
(define-values
(call-in-original-directory)
- (lambda (thunk_7)
+ (lambda (thunk_6)
(begin
(with-continuation-mark
parameterization-key
@@ -55757,272 +54787,257 @@
(continuation-mark-set-first #f parameterization-key)
current-directory
(find-system-path 'orig-dir))
- (thunk_7)))))
+ (thunk_6)))))
(define-values
(encoded-link-path?)
- (lambda (p_20)
+ (lambda (p_80)
(begin
- (let-values (((or-part_1) (path-string? p_20)))
- (if or-part_1
- or-part_1
- (let-values (((or-part_2) (path-bytes? p_20)))
- (if or-part_2
- or-part_2
- (if (pair? p_20) (if (list? p_20) (andmap2 path-element-bytes/same/up? p_20) #f) #f))))))))
+ (let-values (((or-part_544) (path-string? p_80)))
+ (if or-part_544
+ or-part_544
+ (let-values (((or-part_545) (path-bytes? p_80)))
+ (if or-part_545
+ or-part_545
+ (if (pair? p_80) (if (list? p_80) (andmap2 path-element-bytes/same/up? p_80) #f) #f))))))))
(define-values
(path-bytes?)
- (lambda (p_52)
+ (lambda (p_81)
(begin
- (if (bytes? p_52)
- (if (positive? (bytes-length p_52))
- (let-values (((vec_82 len_61)
- (let-values (((vec_83) p_52))
- (begin (check-bytes vec_83) (values vec_83 (unsafe-bytes-length vec_83))))))
- (begin
- #f
- ((letrec-values (((for-loop_106)
- (lambda (result_61 pos_132)
+ (if (bytes? p_81)
+ (if (positive? (bytes-length p_81))
+ (let-values (((result_239) (let-values (((result_240) #t)) result_240)))
+ (let-values (((vec_95 len_68)
+ (let-values (((vec_96) p_81))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-bytes vec_96))
+ (values vec_96 (unsafe-bytes-length vec_96))))))
+ ((letrec-values (((for-loop_440)
+ (lambda (result_241 pos_165)
(begin
'for-loop
- (if (unsafe-fx< pos_132 len_61)
- (let-values (((c_31) (unsafe-bytes-ref vec_82 pos_132)))
- (let-values (((result_123)
- (let-values ()
- (let-values (((result_126)
- (let-values ()
- (let-values () (not (eqv? c_31 0))))))
- (values result_126)))))
- (if (if (not ((lambda x_96 (not result_123)) c_31)) (not #f) #f)
- (for-loop_106 result_123 (unsafe-fx+ 1 pos_132))
- result_123)))
- result_61)))))
- for-loop_106)
- #t
+ (if (unsafe-fx< pos_165 len_68)
+ (let-values (((c_91) (unsafe-bytes-ref vec_95 pos_165)))
+ (let-values (((result_242)
+ (let-values (((result_243) (not (eqv? c_91 0))))
+ (values result_243))))
+ (if (if (not ((lambda x_104 (not result_242)) c_91)) (not #f) #f)
+ (for-loop_440 result_242 (unsafe-fx+ 1 pos_165))
+ result_242)))
+ result_241)))))
+ for-loop_440)
+ result_239
0)))
#f)
#f))))
(define-values
(path-element-bytes/same/up?)
- (lambda (p_35)
- (begin
- (let-values (((or-part_73) (eq? p_35 'up)))
- (if or-part_73
- or-part_73
- (let-values (((or-part_84) (eq? p_35 'same)))
- (if or-part_84
- or-part_84
- (if (path-bytes? p_35)
- (let-values (((p_59) (bytes->path-element p_35 (system-path-convention-type) #t)))
- (if p_59 (relative-path? p_59) #f))
+ (lambda (p_82)
+ (begin
+ (let-values (((or-part_546) (eq? p_82 'up)))
+ (if or-part_546
+ or-part_546
+ (let-values (((or-part_547) (eq? p_82 'same)))
+ (if or-part_547
+ or-part_547
+ (if (path-bytes? p_82)
+ (let-values (((p_83) (bytes->path-element p_82 (system-path-convention-type) #t)))
+ (if p_83 (relative-path? p_83) #f))
#f))))))))
(define-values
(decode-link-path)
- (lambda (p_2)
- (begin
- (if (path-string? p_2)
- (let-values () p_2)
- (if (bytes? p_2)
- (let-values () (bytes->path p_2))
- (let-values ()
- ((letrec-values (((loop_104)
- (lambda (path_11 p_60)
- (begin
- 'loop
- (if (null? p_60)
- (let-values () path_11)
- (let-values ()
- (let-values (((elem_0)
- (if (bytes? (car p_60))
- (bytes->path-element (car p_60))
- (car p_60))))
- (loop_104 (if path_11 (build-path path_11 elem_0) elem_0) (cdr p_60)))))))))
- loop_104)
- #f
- p_2)))))))
+ (lambda (p_84)
+ (begin
+ (if (path-string? p_84)
+ p_84
+ (if (bytes? p_84)
+ (bytes->path p_84)
+ ((letrec-values (((loop_119)
+ (lambda (path_10 p_85)
+ (begin
+ 'loop
+ (if (null? p_85)
+ path_10
+ (let-values (((elem_2)
+ (if (bytes? (car p_85)) (bytes->path-element (car p_85)) (car p_85))))
+ (loop_119 (if path_10 (build-path path_10 elem_2) elem_2) (cdr p_85))))))))
+ loop_119)
+ #f
+ p_84))))))
(define-values
(struct:shadow-directory shadow-directory1.1 shadow-directory? shadow-directory-evt shadow-directory-table)
- (let-values (((struct:_4 make-_4 ?_4 -ref_4 -set!_4)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'shadow-directory
- #f
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'shadow-directory)))))
+ (let-values (((struct:_129 make-_129 ?_129 -ref_129 -set!_129)
+ (make-struct-type
+ 'shadow-directory
+ #f
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'shadow-directory)))
(values
- struct:_4
- make-_4
- ?_4
- (make-struct-field-accessor -ref_4 0 'evt)
- (make-struct-field-accessor -ref_4 1 'table))))
+ struct:_129
+ make-_129
+ ?_129
+ (make-struct-field-accessor -ref_129 0 'evt)
+ (make-struct-field-accessor -ref_129 1 'table))))
(define-values
(use-shadow-directory?)
- (let-values (((v_166) (system-type 'fs-change)))
- (if (eq? 'scalable (vector-ref v_166 1)) (eq? 'low-latency (vector-ref v_166 2)) #f)))
+ (let-values (((v_296) (system-type 'fs-change)))
+ (if (eq? 'scalable (vector-ref v_296 1)) (eq? 'low-latency (vector-ref v_296 2)) #f)))
(define-values (make-cache) (lambda () (begin (if use-shadow-directory? (make-weak-hash) #f))))
(define-values (cell.1$2) (unsafe-make-place-local (make-cache)))
+ (define-values (cell.2$2) (unsafe-make-place-local (make-uninterruptible-lock)))
(define-values (shadow-directory-place-init!) (lambda () (begin (unsafe-place-local-set! cell.1$2 (make-cache)))))
(define-values
(lookup-shadow-directory)
(lambda (orig_0)
(begin
- (let-values (((sd_0) (call-as-atomic (lambda () (hash-ref (unsafe-place-local-ref cell.1$2) orig_0 #f)))))
- (if sd_0
- (let-values ()
- (if (sync/timeout 0 (shadow-directory-evt sd_0))
- (let-values ()
+ (let-values ((() (begin (uninterruptible-lock-acquire (unsafe-place-local-ref cell.2$2)) (values))))
+ (let-values (((sd_0) (hash-ref (unsafe-place-local-ref cell.1$2) orig_0 #f)))
+ (begin
+ (uninterruptible-lock-release (unsafe-place-local-ref cell.2$2))
+ (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)))
- (let-values () sd_0)))
- (let-values ()
- (let-values (((evt_0) (filesystem-change-evt orig_0 (lambda () #f))))
- (if evt_0
- (let-values ()
- (let-values (((table_204)
- (let-values (((lst_92) (directory-list orig_0)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_92)))
- ((letrec-values (((for-loop_202)
- (lambda (table_227 lst_170)
- (begin
- 'for-loop
- (if (pair? lst_170)
- (let-values (((p_61) (unsafe-car lst_170))
- ((rest_85) (unsafe-cdr lst_170)))
- (let-values (((table_226)
- (let-values (((table_113) table_227))
+ (uninterruptible-lock-acquire (unsafe-place-local-ref cell.2$2))
+ (hash-remove! (unsafe-place-local-ref cell.1$2) orig_0)
+ (uninterruptible-lock-release (unsafe-place-local-ref cell.2$2))
+ (lookup-shadow-directory orig_0))
+ sd_0)
+ (let-values (((evt_0) (filesystem-change-evt orig_0 (lambda () #f))))
+ (if evt_0
+ (let-values (((table_310)
+ (let-values (((table_311) (let-values (((table_312) '#hash())) table_312)))
+ (let-values (((lst_532) (directory-list orig_0)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_532))
+ ((letrec-values (((for-loop_441)
+ (lambda (table_313 lst_533)
+ (begin
+ 'for-loop
+ (if (pair? lst_533)
+ (let-values (((p_86) (unsafe-car lst_533))
+ ((rest_262) (unsafe-cdr lst_533)))
+ (let-values (((table_314)
(if (directory-exists?
- (build-path orig_0 p_61))
- (let-values (((table_10) table_113))
- (let-values (((table_201)
- (let-values ()
- (let-values (((key_95
- val_81)
- (let-values ()
- (values
- (normal-case-path
- p_61)
- #t))))
- (hash-set
- table_10
- key_95
- val_81)))))
- (values table_201)))
- table_113))))
- (if (not #f)
- (for-loop_202 table_226 rest_85)
- table_226)))
- table_227)))))
- for-loop_202)
- '#hash()
- lst_92)))))
- (let-values (((sd_1) (shadow-directory1.1 evt_0 table_204)))
+ (build-path orig_0 p_86))
+ (let-values (((table_315)
+ (let-values (((key_108
+ val_89)
+ (values
+ (normal-case-path
+ p_86)
+ #t)))
+ (hash-set
+ table_313
+ key_108
+ val_89))))
+ (values table_315))
+ table_313)))
+ (if (not #f)
+ (for-loop_441 table_314 rest_262)
+ table_314)))
+ table_313)))))
+ for-loop_441)
+ table_311
+ lst_532))))))
+ (let-values (((sd_1) (shadow-directory1.1 evt_0 table_310)))
(begin
- (call-as-atomic (lambda () (hash-set! (unsafe-place-local-ref cell.1$2) orig_0 sd_1)))
- sd_1))))
- (let-values () #f)))))))))
+ (uninterruptible-lock-acquire (unsafe-place-local-ref cell.2$2))
+ (hash-set! (unsafe-place-local-ref cell.1$2) orig_0 sd_1)
+ (uninterruptible-lock-release (unsafe-place-local-ref cell.2$2))
+ sd_1)))
+ #f)))))))))
(define-values
(directory-exists?/shadow-filesystem)
- (lambda (p_62 orig_1 subpath_0)
+ (lambda (p_87 orig_1 subpath_0)
(begin
(if (not (unsafe-place-local-ref cell.1$2))
- (let-values () (directory-exists? p_62))
- (let-values ()
- (let-values (((sd_2) (lookup-shadow-directory orig_1)))
- (if (not sd_2)
- (let-values () (directory-exists? p_62))
- (if sd_2
- (let-values ()
- (let-values (((ht_172) (shadow-directory-table sd_2)))
- (hash-ref ht_172 (normal-case-path subpath_0) #f)))
- (void)))))))))
- (define-values (relative-path-string?) (lambda (s_47) (begin (if (path-string? s_47) (relative-path? s_47) #f))))
+ (directory-exists? p_87)
+ (let-values (((sd_2) (lookup-shadow-directory orig_1)))
+ (if (not sd_2)
+ (directory-exists? p_87)
+ (if sd_2
+ (let-values (((ht_233) (shadow-directory-table sd_2))) (hash-ref ht_233 (normal-case-path subpath_0) #f))
+ (void))))))))
+ (define-values (relative-path-string?) (lambda (s_826) (begin (if (path-string? s_826) (relative-path? s_826) #f))))
(define-values
(check-collection)
- (lambda (who_28 s_5 l_8)
+ (lambda (who_42 s_827 l_80)
(begin
(begin
- (if (relative-path-string? s_5)
+ (if (relative-path-string? s_827)
(void)
- (let-values () (raise-argument-error who_28 "(and/c path-string? relative-path?)" s_5)))
- (if ((lambda (l_65) (if (list? l_65) (andmap2 relative-path-string? l_65) #f)) l_8)
+ (raise-argument-error who_42 "(and/c path-string? relative-path?)" s_827))
+ (if ((lambda (l_81) (if (list? l_81) (andmap2 relative-path-string? l_81) #f)) l_80)
(void)
- (let-values () (raise-argument-error who_28 "(listof (and/c path-string? relative-path?))" l_8)))))))
+ (raise-argument-error who_42 "(listof (and/c path-string? relative-path?))" l_80))))))
(define-values
(check-fail)
- (lambda (who_29 fail_2)
+ (lambda (who_43 fail_2)
(begin
- (if ((lambda (p_63) (if (procedure? p_63) (procedure-arity-includes? p_63 1) #f)) fail_2)
+ (if ((lambda (p_88) (if (procedure? p_88) (procedure-arity-includes? p_88 1) #f)) fail_2)
(void)
- (let-values () (raise-argument-error who_29 "(procedure-arity-includes/c 1)" fail_2))))))
+ (raise-argument-error who_43 "(procedure-arity-includes/c 1)" fail_2)))))
(define-values
(1/collection-path)
(lambda (fail_3 collection_0 collection-path_0)
(begin
'collection-path
- (let-values ()
- (let-values ()
- (begin
- (check-collection 'collection-path collection_0 collection-path_0)
- (check-fail 'collection-path fail_3)
- (find-col-file fail_3 collection_0 collection-path_0 #f #f)))))))
+ (begin
+ (check-collection 'collection-path collection_0 collection-path_0)
+ (check-fail 'collection-path fail_3)
+ (find-col-file fail_3 collection_0 collection-path_0 #f #f)))))
(define-values
(1/collection-file-path)
(lambda (fail_4 check-compiled?_0 file-name_0 collection_1 collection-path_1)
(begin
'collection-file-path
- (let-values ()
- (let-values ()
- (begin
- (if (relative-path-string? file-name_0)
- (void)
- (let-values ()
- (raise-argument-error 'collection-file-path "(and/c path-string? relative-path?)" file-name_0)))
- (check-collection 'collection-file-path collection_1 collection-path_1)
- (check-fail 'collection-file-path fail_4)
- (find-col-file fail_4 collection_1 collection-path_1 file-name_0 check-compiled?_0)))))))
+ (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_1 collection-path_1)
+ (check-fail 'collection-file-path fail_4)
+ (find-col-file fail_4 collection_1 collection-path_1 file-name_0 check-compiled?_0)))))
(define-values
(1/read-installation-configuration-table)
(lambda ()
(begin
'read-installation-configuration-table
(let-values (((d_40) (find-main-config)))
- (let-values (((p_64) (if d_40 (build-path d_40 "config.rktd") #f)))
- (let-values (((or-part_90)
- (if p_64
- (if (file-exists? p_64)
+ (let-values (((p_89) (if d_40 (build-path d_40 "config.rktd") #f)))
+ (let-values (((or-part_548)
+ (if p_89
+ (if (file-exists? p_89)
(let-values (((with-handlers-predicate11_0) exn:fail?)
((with-handlers-handler12_0)
- (lambda (exn_3) (begin 'with-handlers-handler12 '#hash()))))
+ (lambda (exn_2) (begin 'with-handlers-handler12 '#hash()))))
(let-values (((bpz_5) (continuation-mark-set-first #f break-enabled-key)))
(call-handled-body
bpz_5
- (lambda (e_85)
+ (lambda (e_94)
(select-handler/no-breaks
- e_85
+ e_94
bpz_5
(list (cons with-handlers-predicate11_0 with-handlers-handler12_0))))
(lambda ()
- (let-values (((p13_0) p_64)
+ (let-values (((p13_0) p_89)
((temp14_5)
(lambda ()
- (let-values (((v_213)
+ (let-values (((v_297)
(call-with-default-reading-parameterization 1/read)))
- (if (hash? v_213) v_213 #f)))))
+ (if (hash? v_297) v_297 #f)))))
(with-input-from-file.1 'binary p13_0 temp14_5))))))
#f)
#f)))
- (if or-part_90 or-part_90 '#hash())))))))
+ (if or-part_548 or-part_548 '#hash())))))))
(define-values
(get-installation-name)
(let-values (((get-installation-name_0)
@@ -56033,68 +55048,61 @@
(if (eq? config-table1_0 unsafe-undefined)
(1/read-installation-configuration-table)
config-table1_0)))
- (let-values ()
- (begin
- (if (hash? config-table_0)
- (void)
- (let-values () (raise-argument-error 'get-installation-name "hash?" config-table_0)))
- (let-values (((base-name_0) (hash-ref config-table_0 'installation-name (version))))
- (if (not (1/use-user-specific-search-paths))
- (let-values () base-name_0)
- (let-values ()
- (let-values (((addon-dir_0) (find-system-path 'addon-dir)))
- (let-values (((other-version-name_0) "other-version"))
- (if (directory-exists? (build-path addon-dir_0 base-name_0))
- (let-values () base-name_0)
- (if (directory-exists? (build-path addon-dir_0 other-version-name_0))
- (let-values () other-version-name_0)
- (let-values () base-name_0)))))))))))))))
+ (begin
+ (if (hash? config-table_0)
+ (void)
+ (raise-argument-error 'get-installation-name "hash?" config-table_0))
+ (let-values (((base-name_0) (hash-ref config-table_0 'installation-name (version))))
+ (if (not (1/use-user-specific-search-paths))
+ base-name_0
+ (let-values (((addon-dir_0) (find-system-path 'addon-dir)))
+ (let-values (((other-version-name_0) "other-version"))
+ (if (directory-exists? (build-path addon-dir_0 base-name_0))
+ base-name_0
+ (if (directory-exists? (build-path addon-dir_0 other-version-name_0))
+ other-version-name_0
+ base-name_0))))))))))))
(case-lambda
(() (begin (get-installation-name_0 unsafe-undefined)))
((config-table1_1) (get-installation-name_0 config-table1_1)))))
(define-values
(coerce-to-relative-path)
- (lambda (p_65)
- (begin
- (if (string? p_65)
- (let-values () (string->path p_65))
- (if (bytes? p_65) (let-values () (bytes->path p_65)) (let-values () p_65))))))
+ (lambda (p_90) (begin (if (string? p_90) (string->path p_90) (if (bytes? p_90) (bytes->path p_90) p_90)))))
(define-values
(coerce-to-path)
- (lambda (p_7)
+ (lambda (p_91)
(begin
- (if (string? p_7)
- (let-values () (collects-relative-path->complete-path (string->path p_7)))
- (if (bytes? p_7)
- (let-values () (collects-relative-path->complete-path (bytes->path p_7)))
- (if (path? p_7) (let-values () (collects-relative-path->complete-path p_7)) (let-values () p_7)))))))
+ (if (string? p_91)
+ (collects-relative-path->complete-path (string->path p_91))
+ (if (bytes? p_91)
+ (collects-relative-path->complete-path (bytes->path p_91))
+ (if (path? p_91) (collects-relative-path->complete-path p_91) p_91))))))
(define-values
(collects-relative-path->complete-path)
- (lambda (p_41)
+ (lambda (p_92)
(begin
- (if (complete-path? p_41)
- (let-values () p_41)
- (let-values ()
- (path->complete-path
- p_41
- (let-values (((or-part_59) (find-main-collects))) (if or-part_59 or-part_59 (current-directory)))))))))
+ (if (complete-path? p_92)
+ p_92
+ (path->complete-path
+ p_92
+ (let-values (((or-part_549) (find-main-collects))) (if or-part_549 or-part_549 (current-directory))))))))
(define-values
(add-config-search)
- (lambda (ht_144 key_89 orig-l_2)
+ (lambda (ht_234 key_109 orig-l_2)
(begin
- (let-values (((l_66) (hash-ref ht_144 key_89 #f)))
- (if l_66
- ((letrec-values (((loop_105)
- (lambda (l_67)
+ (let-values (((l_82) (hash-ref ht_234 key_109 #f)))
+ (if l_82
+ ((letrec-values (((loop_120)
+ (lambda (l_83)
(begin
'loop
- (if (null? l_67)
- (let-values () null)
- (if (not (car l_67))
- (let-values () (append orig-l_2 (loop_105 (cdr l_67))))
- (let-values () (cons (coerce-to-path (car l_67)) (loop_105 (cdr l_67))))))))))
- loop_105)
- l_66)
+ (if (null? l_83)
+ null
+ (if (not (car l_83))
+ (append orig-l_2 (loop_120 (cdr l_83)))
+ (cons (coerce-to-path (car l_83)) (loop_120 (cdr l_83)))))))))
+ loop_120)
+ l_82)
orig-l_2)))))
(define-values
(1/find-library-collection-links)
@@ -56110,286 +55118,269 @@
(if (eq? installation-name3_0 unsafe-undefined)
(if (hash? config-table_1) (get-installation-name config-table_1) #f)
installation-name3_0)))
- (let-values ()
+ (let-values ((()
+ (begin
+ (if (hash? config-table_1)
+ (void)
+ (raise-argument-error 'find-library-collection-links "hash?" config-table_1))
+ (values))))
(let-values ((()
(begin
- (if (hash? config-table_1)
+ (if (string? installation-name_0)
(void)
- (let-values ()
- (raise-argument-error
- 'find-library-collection-links
- "hash?"
- config-table_1)))
+ (raise-argument-error
+ 'find-library-collection-links
+ "string?"
+ installation-name_0))
(values))))
- (let-values ((()
- (begin
- (if (string? installation-name_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'find-library-collection-links
- "string?"
- installation-name_0)))
- (values))))
- (let-values (((lf_0)
- (coerce-to-path
- (let-values (((or-part_39) (hash-ref config-table_1 'links-file #f)))
- (if or-part_39
- or-part_39
- (build-path
- (let-values (((or-part_231) (hash-ref config-table_1 'share-dir #f)))
- (if or-part_231 or-part_231 (build-path 'up "share")))
- "links.rktd"))))))
- (append
- (list #f)
- (if (if (1/use-user-specific-search-paths) (1/use-collection-link-paths) #f)
- (list (build-path (find-system-path 'addon-dir) installation-name_0 "links.rktd"))
- null)
- (if (1/use-collection-link-paths)
- (add-config-search config-table_1 'links-search-files (list lf_0))
- null))))))))))))
+ (let-values (((lf_0)
+ (coerce-to-path
+ (let-values (((or-part_550) (hash-ref config-table_1 'links-file #f)))
+ (if or-part_550
+ or-part_550
+ (build-path
+ (let-values (((or-part_551) (hash-ref config-table_1 'share-dir #f)))
+ (if or-part_551 or-part_551 (build-path 'up "share")))
+ "links.rktd"))))))
+ (append
+ (list #f)
+ (if (if (1/use-user-specific-search-paths) (1/use-collection-link-paths) #f)
+ (list (build-path (find-system-path 'addon-dir) installation-name_0 "links.rktd"))
+ null)
+ (if (1/use-collection-link-paths)
+ (add-config-search config-table_1 'links-search-files (list lf_0))
+ null)))))))))))
(case-lambda
(() (begin 'find-library-collection-links (find-library-collection-links_0 unsafe-undefined unsafe-undefined)))
((config-table_2 installation-name3_1) (find-library-collection-links_0 config-table_2 installation-name3_1))
((config-table2_1) (find-library-collection-links_0 config-table2_1 unsafe-undefined)))))
(define-values (cell.1$1) (unsafe-make-place-local (make-weak-hash)))
- (define-values (collection-place-init!) (lambda () (begin (unsafe-place-local-set! cell.1$1 (make-weak-hash)))))
+ (define-values (cell.2$1) (unsafe-make-place-local (make-uninterruptible-lock)))
+ (define-values
+ (collection-place-init!)
+ (lambda ()
+ (begin
+ (begin
+ (unsafe-place-local-set! cell.1$1 (make-weak-hash))
+ (unsafe-place-local-set! cell.2$1 (make-uninterruptible-lock))))))
(define-values (stamp-prompt-tag) (make-continuation-prompt-tag 'stamp))
(define-values
(file->stamp)
- (lambda (path_12 old-stamp_0)
+ (lambda (path_11 old-stamp_0)
(begin
- (if (if old-stamp_0 (if (cdr old-stamp_0) (not (sync/timeout 0 (cdr old-stamp_0))) #f) #f)
- (let-values () old-stamp_0)
- (let-values ()
- (call-with-continuation-prompt
- (lambda ()
- (call-with-exception-handler
- (lambda (exn_4)
- (abort-current-continuation
- stamp-prompt-tag
- (if (exn:fail:filesystem? exn_4) (lambda () #f) (lambda () (raise exn_4)))))
- (lambda ()
- (let-values (((dir-evt_0)
- (if (vector-ref (system-type 'fs-change) 2)
- ((letrec-values (((loop_106)
- (lambda (path_5)
- (begin
- 'loop
- (let-values (((base_21 name_71 dir?_7) (split-path path_5)))
- (if (path? base_21)
- (if (directory-exists? base_21)
- (filesystem-change-evt base_21 (lambda () #f))
- (loop_106 base_21))
- #f))))))
- loop_106)
- path_12)
- #f)))
- (if (not (file-exists? path_12))
- (let-values () (cons #f dir-evt_0))
- (let-values ()
- (let-values (((evt_1)
- (if (vector-ref (system-type 'fs-change) 2)
- (filesystem-change-evt path_12 (lambda () #f))
- #f)))
- (begin
- (if dir-evt_0 (let-values () (filesystem-change-evt-cancel dir-evt_0)) (void))
- (cons (file->bytes path_12) evt_1)))))))))
- stamp-prompt-tag))))))
+ (if (if old-stamp_0 (if (cdr old-stamp_0) (not (filesystem-change-evt-ready? (cdr old-stamp_0))) #f) #f)
+ old-stamp_0
+ (call-with-continuation-prompt
+ (lambda ()
+ (call-with-exception-handler
+ (lambda (exn_3)
+ (abort-current-continuation
+ stamp-prompt-tag
+ (if (exn:fail:filesystem? exn_3) (lambda () #f) (lambda () (raise exn_3)))))
+ (lambda ()
+ (let-values (((dir-evt_0)
+ (if (vector-ref (system-type 'fs-change) 2)
+ ((letrec-values (((loop_121)
+ (lambda (path_12)
+ (begin
+ 'loop
+ (let-values (((base_23 name_84 dir?_7) (split-path path_12)))
+ (if (path? base_23)
+ (if (directory-exists? base_23)
+ (filesystem-change-evt base_23 (lambda () #f))
+ (loop_121 base_23))
+ #f))))))
+ loop_121)
+ path_11)
+ #f)))
+ (if (not (file-exists? path_11))
+ (cons #f dir-evt_0)
+ (let-values (((evt_1)
+ (if (vector-ref (system-type 'fs-change) 2)
+ (filesystem-change-evt path_11 (lambda () #f))
+ #f)))
+ (begin
+ (if dir-evt_0 (filesystem-change-evt-cancel dir-evt_0) (void))
+ (cons (file->bytes path_11) evt_1))))))))
+ stamp-prompt-tag)))))
(define-values
(file->bytes)
(lambda (path_13)
(begin
(let-values (((path15_0) path_13)
((temp16_7)
- (lambda (p_66)
- (let-values (((bstr_21) (read-bytes 8192 p_66)))
+ (lambda (p_93)
+ (let-values (((bstr_21) (read-bytes 8192 p_93)))
(if (if (bytes? bstr_21) (>= (bytes-length bstr_21) 8192) #f)
(apply
bytes-append
(cons
bstr_21
- ((letrec-values (((loop_107)
+ ((letrec-values (((loop_122)
(lambda ()
(begin
'loop
- (let-values (((bstr_22) (read-bytes 8192 p_66)))
- (if (eof-object? bstr_22) null (cons bstr_22 (loop_107))))))))
- loop_107))))
+ (let-values (((bstr_22) (read-bytes 8192 p_93)))
+ (if (eof-object? bstr_22) null (cons bstr_22 (loop_122))))))))
+ loop_122))))
bstr_21)))))
(call-with-input-file*.1 'binary path15_0 temp16_7)))))
(define-values
(no-file-stamp?)
- (lambda (a_61) (begin (let-values (((or-part_274) (not a_61))) (if or-part_274 or-part_274 (not (car a_61)))))))
+ (lambda (a_67) (begin (let-values (((or-part_552) (not a_67))) (if or-part_552 or-part_552 (not (car a_67)))))))
(define-values
(get-linked-collections)
(lambda (links-path_0)
(begin
- (call/ec
+ (call-with-escape-continuation
(lambda (esc_1)
(let-values (((make-handler_0)
(lambda (ts_0)
(begin
'make-handler
- (lambda (exn_5)
+ (lambda (exn_4)
(begin
- (if (exn:fail? exn_5)
- (let-values (((l_68) (current-logger)))
- (if (log-level? l_68 'error)
- (let-values ()
- (log-message
- l_68
- 'error
- (format
- "error reading collection links file ~s: ~a"
- links-path_0
- (exn-message exn_5))
- (current-continuation-marks)))
+ (if (exn:fail? exn_4)
+ (let-values (((l_84) (current-logger)))
+ (if (log-level? l_84 'error)
+ (log-message
+ l_84
+ 'error
+ (format
+ "error reading collection links file ~s: ~a"
+ links-path_0
+ (exn-message exn_4))
+ (current-continuation-marks))
(void)))
(void))
(if ts_0
- (let-values ()
- (call-as-atomic
- (lambda ()
- (hash-set!
- (unsafe-place-local-ref cell.1$1)
- links-path_0
- (cons ts_0 '#hasheq())))))
+ (begin
+ (uninterruptible-lock-acquire (unsafe-place-local-ref cell.2$1))
+ (hash-set! (unsafe-place-local-ref cell.1$1) links-path_0 (cons ts_0 '#hasheq()))
+ (uninterruptible-lock-release (unsafe-place-local-ref cell.2$1)))
(void))
- (if (exn:fail? exn_5) (esc_1 (make-hasheq)) exn_5)))))))
+ (if (exn:fail? exn_4) (esc_1 (make-hasheq)) exn_4)))))))
(call-with-exception-handler
(make-handler_0 #f)
(lambda ()
- (let-values (((links-stamp+cache_0)
- (call-as-atomic
- (lambda () (hash-ref (unsafe-place-local-ref cell.1$1) links-path_0 '(#f . #hasheq()))))))
- (let-values (((a-links-stamp_0) (car links-stamp+cache_0)))
- (let-values (((ts_1) (file->stamp links-path_0 a-links-stamp_0)))
- (if (equal? ts_1 a-links-stamp_0)
- (let-values () (cdr links-stamp+cache_0))
- (let-values ()
- (call-with-exception-handler
- (make-handler_0 ts_1)
- (lambda ()
- (call-with-default-reading-parameterization
- (lambda ()
- (let-values (((v_118)
- (if (no-file-stamp? ts_1)
- null
- (let-values (((links-path17_0) links-path_0)
- ((temp18_6)
- (lambda (p_67)
- (begin0
- (1/read p_67)
- (if (eof-object? (1/read p_67))
- (void)
- (let-values ()
- (error "expected a single S-expression")))))))
- (call-with-input-file*.1 'binary links-path17_0 temp18_6)))))
- (let-values ((()
- (begin
- (if (if (list? v_118)
- (andmap2
- (lambda (p_68)
- (if (list? p_68)
- (if (let-values (((or-part_110) (= 2 (length p_68))))
- (if or-part_110 or-part_110 (= 3 (length p_68))))
- (if (let-values (((or-part_27) (string? (car p_68))))
- (if or-part_27
- or-part_27
- (let-values (((or-part_174)
- (eq? 'root (car p_68))))
- (if or-part_174
- or-part_174
- (eq? 'static-root (car p_68))))))
- (if (encoded-link-path? (cadr p_68))
- (let-values (((or-part_148) (null? (cddr p_68))))
- (if or-part_148 or-part_148 (regexp? (caddr p_68))))
+ (let-values ((() (begin (uninterruptible-lock-acquire (unsafe-place-local-ref cell.2$1)) (values))))
+ (let-values (((links-stamp+cache_0)
+ (hash-ref (unsafe-place-local-ref cell.1$1) links-path_0 '(#f . #hasheq()))))
+ (let-values ((() (begin (uninterruptible-lock-release (unsafe-place-local-ref cell.2$1)) (values))))
+ (let-values (((a-links-stamp_0) (car links-stamp+cache_0)))
+ (let-values (((ts_1) (file->stamp links-path_0 a-links-stamp_0)))
+ (if (equal? ts_1 a-links-stamp_0)
+ (cdr links-stamp+cache_0)
+ (call-with-exception-handler
+ (make-handler_0 ts_1)
+ (lambda ()
+ (call-with-default-reading-parameterization
+ (lambda ()
+ (let-values (((v_298)
+ (if (no-file-stamp? ts_1)
+ null
+ (let-values (((links-path17_0) links-path_0)
+ ((temp18_7)
+ (lambda (p_94)
+ (begin0
+ (1/read p_94)
+ (if (eof-object? (1/read p_94))
+ (void)
+ (error "expected a single S-expression"))))))
+ (call-with-input-file*.1 'binary links-path17_0 temp18_7)))))
+ (let-values ((()
+ (begin
+ (if (if (list? v_298)
+ (andmap2
+ (lambda (p_95)
+ (if (list? p_95)
+ (if (let-values (((or-part_553) (= 2 (length p_95))))
+ (if or-part_553 or-part_553 (= 3 (length p_95))))
+ (if (let-values (((or-part_554) (string? (car p_95))))
+ (if or-part_554
+ or-part_554
+ (let-values (((or-part_555)
+ (eq? 'root (car p_95))))
+ (if or-part_555
+ or-part_555
+ (eq? 'static-root (car p_95))))))
+ (if (encoded-link-path? (cadr p_95))
+ (let-values (((or-part_556) (null? (cddr p_95))))
+ (if or-part_556
+ or-part_556
+ (regexp? (caddr p_95))))
+ #f)
#f)
#f)
- #f)
- #f))
- v_118)
- #f)
- (void)
- (let-values () (error "ill-formed content")))
- (values))))
- (let-values (((ht_173) (make-hasheq)))
- (let-values (((dir_0)
- (let-values (((base_22 name_72 dir?_8) (split-path links-path_0)))
- base_22)))
- (begin
- (for-each2
- (lambda (p_46)
- (if (let-values (((or-part_314) (null? (cddr p_46))))
- (if or-part_314 or-part_314 (regexp-match? (caddr p_46) (version))))
- (let-values ()
+ #f))
+ v_298)
+ #f)
+ (void)
+ (error "ill-formed content"))
+ (values))))
+ (let-values (((ht_235) (make-hasheq)))
+ (let-values (((dir_0)
+ (let-values (((base_24 name_85 dir?_8) (split-path links-path_0)))
+ base_24)))
+ (begin
+ (for-each2
+ (lambda (p_96)
+ (if (let-values (((or-part_557) (null? (cddr p_96))))
+ (if or-part_557 or-part_557 (regexp-match? (caddr p_96) (version))))
(let-values (((dir_1)
(simplify-path
(path->complete-path
- (decode-link-path (cadr p_46))
+ (decode-link-path (cadr p_96))
dir_0))))
- (if (eq? (car p_46) 'static-root)
- (let-values ()
- (for-each2
- (lambda (sub_1)
- (if (directory-exists? (build-path dir_1 sub_1))
- (let-values ()
- (let-values (((k_54) (string->symbol (path->string sub_1))))
- (hash-set!
- ht_173
- k_54
- (cons dir_1 (hash-ref ht_173 k_54 null)))))
- (void)))
- (directory-list dir_1)))
- (if (eq? (car p_46) 'root)
- (let-values ()
- (begin
- (if (hash-ref ht_173 #f #f)
- (void)
- (let-values () (hash-set! ht_173 #f null)))
- (hash-for-each
- ht_173
- (lambda (k_26 v_214)
- (hash-set! ht_173 k_26 (cons dir_1 v_214))))))
- (let-values ()
- (let-values (((s_167) (string->symbol (car p_46))))
- (hash-set!
- ht_173
- s_167
- (cons (box dir_1) (hash-ref ht_173 s_167 null)))))))))
- (void)))
- v_118)
- (hash-for-each
- ht_173
- (lambda (k_8 v_27) (hash-set! ht_173 k_8 (reverse$1 v_27))))
- (call-as-atomic
- (lambda ()
- (hash-set!
- (unsafe-place-local-ref cell.1$1)
- links-path_0
- (cons ts_1 ht_173))))
- ht_173))))))))))))))))))))))
+ (if (eq? (car p_96) 'static-root)
+ (for-each2
+ (lambda (sub_1)
+ (if (directory-exists? (build-path dir_1 sub_1))
+ (let-values (((k_62) (string->symbol (path->string sub_1))))
+ (hash-set!
+ ht_235
+ k_62
+ (cons dir_1 (hash-ref ht_235 k_62 null))))
+ (void)))
+ (directory-list dir_1))
+ (if (eq? (car p_96) 'root)
+ (begin
+ (if (hash-ref ht_235 #f #f) (void) (hash-set! ht_235 #f null))
+ (hash-for-each
+ ht_235
+ (lambda (k_63 v_299)
+ (hash-set! ht_235 k_63 (cons dir_1 v_299)))))
+ (let-values (((s_828) (string->symbol (car p_96))))
+ (hash-set!
+ ht_235
+ s_828
+ (cons (box dir_1) (hash-ref ht_235 s_828 null)))))))
+ (void)))
+ v_298)
+ (hash-for-each
+ ht_235
+ (lambda (k_64 v_300) (hash-set! ht_235 k_64 (reverse$1 v_300))))
+ (uninterruptible-lock-acquire (unsafe-place-local-ref cell.2$1))
+ (hash-set! (unsafe-place-local-ref cell.1$1) links-path_0 (cons ts_1 ht_235))
+ (uninterruptible-lock-release (unsafe-place-local-ref cell.2$1))
+ ht_235)))))))))))))))))))))))
(define-values
(normalize-collection-reference)
(lambda (collection_2 collection-path_2)
(begin
(if (string? collection_2)
- (let-values ()
- (let-values (((m_26) (regexp-match-positions '#rx"/+" collection_2)))
- (if m_26
- (if (= (caar m_26) (sub1 (string-length collection_2)))
- (let-values () (values (substring collection_2 0 (caar m_26)) collection-path_2))
- (let-values ()
- (values
- (substring collection_2 0 (caar m_26))
- (cons (substring collection_2 (cdar m_26)) collection-path_2))))
- (values collection_2 collection-path_2))))
- (let-values ()
- (let-values (((base_8 name_73 dir?_9) (split-path collection_2)))
- (if (eq? base_8 'relative)
- (values name_73 collection-path_2)
- (normalize-collection-reference base_8 (cons name_73 collection-path_2)))))))))
+ (let-values (((m_31) (regexp-match-positions '#rx"/+" collection_2)))
+ (if m_31
+ (if (= (caar m_31) (sub1 (string-length collection_2)))
+ (values (substring collection_2 0 (caar m_31)) collection-path_2)
+ (values
+ (substring collection_2 0 (caar m_31))
+ (cons (substring collection_2 (cdar m_31)) collection-path_2)))
+ (values collection_2 collection-path_2)))
+ (let-values (((base_25 name_86 dir?_9) (split-path collection_2)))
+ (if (eq? base_25 'relative)
+ (values name_86 collection-path_2)
+ (normalize-collection-reference base_25 (cons name_86 collection-path_2))))))))
(define-values
(find-col-file)
(lambda (fail_5 collection-in_0 collection-path-in_0 file-name_1 check-compiled?_1)
@@ -56397,45 +55388,42 @@
(let-values (((collection_3 collection-path_3)
(normalize-collection-reference collection-in_0 collection-path-in_0)))
(let-values (((all-paths_0)
- (let-values (((sym_107)
+ (let-values (((sym_135)
(string->symbol
(if (path? collection_3) (path->string collection_3) collection_3))))
- ((letrec-values (((loop_108)
- (lambda (l_27)
+ ((letrec-values (((loop_123)
+ (lambda (l_85)
(begin
'loop
- (if (null? l_27)
- (let-values () null)
- (if (not (car l_27))
- (let-values ()
- (append (1/current-library-collection-paths) (loop_108 (cdr l_27))))
- (if (hash? (car l_27))
- (let-values ()
+ (if (null? l_85)
+ null
+ (if (not (car l_85))
+ (append (1/current-library-collection-paths) (loop_123 (cdr l_85)))
+ (if (hash? (car l_85))
+ (append
+ (map2 box (hash-ref (car l_85) sym_135 null))
+ (hash-ref (car l_85) #f null)
+ (loop_123 (cdr l_85)))
+ (let-values (((ht_236) (get-linked-collections (car l_85))))
(append
- (map2 box (hash-ref (car l_27) sym_107 null))
- (hash-ref (car l_27) #f null)
- (loop_108 (cdr l_27))))
- (let-values ()
- (let-values (((ht_128) (get-linked-collections (car l_27))))
- (append
- (hash-ref ht_128 sym_107 null)
- (hash-ref ht_128 #f null)
- (loop_108 (cdr l_27))))))))))))
- loop_108)
+ (hash-ref ht_236 sym_135 null)
+ (hash-ref ht_236 #f null)
+ (loop_123 (cdr l_85)))))))))))
+ loop_123)
(1/current-library-collection-links)))))
- (let-values (((done_1) (lambda (p_69) (begin 'done (if file-name_1 (build-path p_69 file-name_1) p_69)))))
+ (let-values (((done_1) (lambda (p_97) (begin 'done (if file-name_1 (build-path p_97 file-name_1) p_97)))))
(let-values (((*build-path-rep_0)
- (lambda (p_70 c_69)
- (begin '*build-path-rep (if (path? p_70) (build-path p_70 c_69) (unbox p_70))))))
+ (lambda (p_98 c_92)
+ (begin '*build-path-rep (if (path? p_98) (build-path p_98 c_92) (unbox p_98))))))
(let-values (((*directory-exists?_0)
- (lambda (orig_2 collection_4 p_71)
+ (lambda (orig_2 collection_4 p_99)
(begin
'*directory-exists?
(if (path? orig_2)
- (directory-exists?/shadow-filesystem p_71 orig_2 collection_4)
+ (directory-exists?/shadow-filesystem p_99 orig_2 collection_4)
#t)))))
(let-values (((to-string_0)
- (lambda (p_72) (begin 'to-string (if (path? p_72) (path->string p_72) p_72)))))
+ (lambda (p_100) (begin 'to-string (if (path? p_100) (path->string p_100) p_100)))))
((letrec-values (((cloop_0)
(lambda (paths_1 found-col_0)
(begin
@@ -56448,7 +55436,7 @@
""
(apply
string-append
- ((letrec-values (((loop_109)
+ ((letrec-values (((loop_124)
(lambda (cp_0)
(begin
'loop
@@ -56457,18 +55445,18 @@
(list*
(to-string_0 (car cp_0))
"/"
- (loop_109 (cdr cp_0))))))))
- loop_109)
+ (loop_124 (cdr cp_0))))))))
+ loop_124)
collection-path_3)))))
(letrec-values (((filter_1)
- (lambda (f_39 l_69)
+ (lambda (f_40 l_86)
(begin
'filter
- (if (null? l_69)
+ (if (null? l_86)
null
- (if (f_39 (car l_69))
- (cons (car l_69) (filter_1 f_39 (cdr l_69)))
- (filter_1 f_39 (cdr l_69))))))))
+ (if (f_40 (car l_86))
+ (cons (car l_86) (filter_1 f_40 (cdr l_86)))
+ (filter_1 f_40 (cdr l_86))))))))
(fail_5
(format
"collection not found\n collection: ~s\n in collection directories:~a~a"
@@ -56478,18 +55466,18 @@
(apply
string-append
(map2
- (lambda (p_73) (format "\n ~a ~a" " " p_73))
- (let-values (((len_62) (length all-paths_0))
+ (lambda (p_101) (format "\n ~a ~a" " " p_101))
+ (let-values (((len_69) (length all-paths_0))
((clen_0)
(length (1/current-library-collection-paths))))
- (if (< (- len_62 clen_0) 5)
+ (if (< (- len_69 clen_0) 5)
all-paths_0
(append
(1/current-library-collection-paths)
(list
(format
"... [~a additional linked and package directories]"
- (- len_62 clen_0))))))))
+ (- len_69 clen_0))))))))
(if (ormap2 box? all-paths_0)
(format
"\n sub-collection: ~s\n in parent directories:~a"
@@ -56497,7 +55485,7 @@
(apply
string-append
(map2
- (lambda (p_74) (format "\n ~a" (unbox p_74)))
+ (lambda (p_102) (format "\n ~a" (unbox p_102)))
(filter_1 box? all-paths_0))))
""))))))
(let-values (((dir_2) (*build-path-rep_0 (car paths_1) collection_3)))
@@ -56505,31 +55493,31 @@
(let-values (((cpath_0) (apply build-path dir_2 collection-path_3)))
(if (if (null? collection-path_3) #t (directory-exists? cpath_0))
(if file-name_1
- (if (let-values (((or-part_304)
+ (if (let-values (((or-part_558)
(file-exists?/maybe-compiled
cpath_0
file-name_1
check-compiled?_1)))
- (if or-part_304
- or-part_304
+ (if or-part_558
+ or-part_558
(let-values (((alt-file-name_0)
(let-values (((file-name_2)
(if (path? file-name_1)
(path->string file-name_1)
file-name_1)))
- (let-values (((len_63)
+ (let-values (((len_70)
(string-length file-name_2)))
- (if (>= len_63 4)
+ (if (>= len_70 4)
(if (string=?
".rkt"
(substring
file-name_2
- (- len_63 4)))
+ (- len_70 4)))
(string-append
(substring
file-name_2
0
- (- len_63 4))
+ (- len_70 4))
".ss")
#f)
#f)))))
@@ -56542,8 +55530,8 @@
(done_1 cpath_0)
(cloop_0
(cdr paths_1)
- (let-values (((or-part_51) found-col_0))
- (if or-part_51 or-part_51 cpath_0))))
+ (let-values (((or-part_559) found-col_0))
+ (if or-part_559 or-part_559 cpath_0))))
(done_1 cpath_0))
(cloop_0 (cdr paths_1) found-col_0)))
(cloop_0 (cdr paths_1) found-col_0))))))))
@@ -56554,9 +55542,9 @@
(file-exists?/maybe-compiled)
(lambda (dir_3 path_14 check-compiled?_2)
(begin
- (let-values (((or-part_54) (file-exists? (build-path dir_3 path_14))))
- (if or-part_54
- or-part_54
+ (let-values (((or-part_560) (file-exists? (build-path dir_3 path_14))))
+ (if or-part_560
+ or-part_560
(if check-compiled?_2
(let-values (((try-path_0) (path-add-extension path_14 #".zo"))
((modes_0) (1/use-compiled-file-paths))
@@ -56564,15 +55552,13 @@
(ormap2
(lambda (d_41)
(ormap2
- (lambda (mode_15)
+ (lambda (mode_19)
(file-exists?
(let-values (((dir_4)
(if (eq? d_41 'same)
- (let-values () dir_3)
- (if (relative-path? d_41)
- (let-values () (build-path dir_3 d_41))
- (let-values () (reroot-path dir_3 d_41))))))
- (build-path dir_4 mode_15 try-path_0))))
+ dir_3
+ (if (relative-path? d_41) (build-path dir_3 d_41) (reroot-path dir_3 d_41)))))
+ (build-path dir_4 mode_19 try-path_0))))
modes_0))
roots_0))
#f))))))
@@ -56592,72 +55578,64 @@
(if (eq? installation-name7_0 unsafe-undefined)
(if (hash? config-table_3) (get-installation-name config-table_3) #f)
installation-name7_0)))
- (let-values ()
- (begin
- (if (if (list? extra-collects-dirs_0) (andmap2 path-string? extra-collects-dirs_0) #f)
- (void)
- (let-values ()
- (raise-argument-error
- 'find-library-collection-paths
- "(listof path-string?)"
- extra-collects-dirs_0)))
- (if (if (list? post-collects-dirs_0) (andmap2 path-string? post-collects-dirs_0) #f)
- (void)
- (let-values ()
- (raise-argument-error
- 'find-library-collection-paths
- "(listof path-string?)"
- post-collects-dirs_0)))
- (if (hash? config-table_3)
- (void)
- (let-values ()
- (raise-argument-error 'find-library-collection-paths "hash?" config-table_3)))
- (if (string? installation-name_1)
- (void)
- (let-values ()
- (raise-argument-error
- 'find-library-collection-paths
- "string?"
- installation-name_1)))
- (let-values (((user-too?_0) (1/use-user-specific-search-paths))
- ((cons-if_0)
- (lambda (f_40 r_45) (begin 'cons-if (if f_40 (cons f_40 r_45) r_45)))))
- (path-list-string->path-list
+ (begin
+ (if (if (list? extra-collects-dirs_0) (andmap2 path-string? extra-collects-dirs_0) #f)
+ (void)
+ (raise-argument-error
+ 'find-library-collection-paths
+ "(listof path-string?)"
+ extra-collects-dirs_0))
+ (if (if (list? post-collects-dirs_0) (andmap2 path-string? post-collects-dirs_0) #f)
+ (void)
+ (raise-argument-error
+ 'find-library-collection-paths
+ "(listof path-string?)"
+ post-collects-dirs_0))
+ (if (hash? config-table_3)
+ (void)
+ (raise-argument-error 'find-library-collection-paths "hash?" config-table_3))
+ (if (string? installation-name_1)
+ (void)
+ (raise-argument-error 'find-library-collection-paths "string?" installation-name_1))
+ (let-values (((user-too?_0) (1/use-user-specific-search-paths))
+ ((cons-if_0)
+ (lambda (f_41 r_52) (begin 'cons-if (if f_41 (cons f_41 r_52) r_52)))))
+ (path-list-string->path-list
+ (if user-too?_0
+ (let-values (((c_93)
+ (environment-variables-ref
+ (current-environment-variables)
+ #"PLTCOLLECTS")))
+ (if c_93 (bytes->string/locale c_93 '#\?) ""))
+ "")
+ (add-config-search
+ config-table_3
+ 'collects-search-dirs
+ (cons-if_0
(if user-too?_0
- (let-values (((c_70)
- (environment-variables-ref
- (current-environment-variables)
- #"PLTCOLLECTS")))
- (if c_70 (bytes->string/locale c_70 '#\?) ""))
- "")
- (add-config-search
- config-table_3
- 'collects-search-dirs
- (cons-if_0
- (if user-too?_0
- (build-path (find-system-path 'addon-dir) installation-name_1 "collects")
- #f)
- ((letrec-values (((loop_110)
- (lambda (l_70)
- (begin
- 'loop
- (if (null? l_70)
- null
- (let-values (((collects-path_1) (car l_70)))
- (let-values (((v_215)
- (exe-relative-path->complete-path
- collects-path_1)))
- (if v_215
- (cons
- (simplify-path
- (path->complete-path v_215 (current-directory)))
- (loop_110 (cdr l_70)))
- (loop_110 (cdr l_70))))))))))
- loop_110)
- (append
- extra-collects-dirs_0
- (list (find-system-path 'collects-dir))
- post-collects-dirs_0))))))))))))))))
+ (build-path (find-system-path 'addon-dir) installation-name_1 "collects")
+ #f)
+ ((letrec-values (((loop_125)
+ (lambda (l_87)
+ (begin
+ 'loop
+ (if (null? l_87)
+ null
+ (let-values (((collects-path_1) (car l_87)))
+ (let-values (((v_301)
+ (exe-relative-path->complete-path
+ collects-path_1)))
+ (if v_301
+ (cons
+ (simplify-path
+ (path->complete-path v_301 (current-directory)))
+ (loop_125 (cdr l_87)))
+ (loop_125 (cdr l_87))))))))))
+ loop_125)
+ (append
+ extra-collects-dirs_0
+ (list (find-system-path 'collects-dir))
+ post-collects-dirs_0)))))))))))))))
(case-lambda
(()
(begin
@@ -56677,38 +55655,34 @@
(lambda (ht8_0)
(begin
'find-compiled-file-roots
- (let-values (((ht_174)
+ (let-values (((ht_237)
(if (eq? ht8_0 unsafe-undefined) (1/read-installation-configuration-table) ht8_0)))
- (let-values ()
- (let-values ((()
- (begin
- (if (hash? ht_174)
- (void)
- (let-values ()
- (raise-argument-error 'find-compiled-file-roots "hash?" ht_174)))
- (values))))
- (let-values (((paths_2) (hash-ref ht_174 'compiled-file-roots #f)))
- (let-values (((or-part_109) (if (list? paths_2) (map2 coerce-to-relative-path paths_2) #f)))
- (if or-part_109 or-part_109 (list 'same)))))))))))
+ (let-values ((()
+ (begin
+ (if (hash? ht_237)
+ (void)
+ (raise-argument-error 'find-compiled-file-roots "hash?" ht_237))
+ (values))))
+ (let-values (((paths_2) (hash-ref ht_237 'compiled-file-roots #f)))
+ (let-values (((or-part_561) (if (list? paths_2) (map2 coerce-to-relative-path paths_2) #f)))
+ (if or-part_561 or-part_561 (list 'same))))))))))
(case-lambda
(() (begin 'find-compiled-file-roots (find-compiled-file-roots_0 unsafe-undefined)))
((ht8_1) (find-compiled-file-roots_0 ht8_1)))))
(define-values (prop:readtable prop:readtable? prop:readtable-ref) (make-struct-type-property 'readtable))
(define-values
(1/current-readtable)
- (let-values ()
- (let-values ()
- (make-parameter
- #f
- (lambda (v_216)
- (begin
- (if ((lambda (x_97)
- (let-values (((or-part_12) (not x_97))) (if or-part_12 or-part_12 (prop:readtable? x_97))))
- v_216)
- (void)
- (let-values () (raise-argument-error 'current-readtable "(or/c prop:readtable? #f)" v_216)))
- v_216))
- 'current-readtable))))
+ (make-parameter
+ #f
+ (lambda (v_302)
+ (begin
+ (if ((lambda (x_105)
+ (let-values (((or-part_562) (not x_105))) (if or-part_562 or-part_562 (prop:readtable? x_105))))
+ v_302)
+ (void)
+ (raise-argument-error 'current-readtable "(or/c prop:readtable? #f)" v_302))
+ v_302))
+ 'current-readtable))
(define-values
(struct:read-config/outer
read-config/outer1.1
@@ -56720,32 +55694,30 @@
read-config/outer-pos
read-config/outer-indentations
read-config/outer-keep-comment?)
- (let-values (((struct:_29 make-_29 ?_29 -ref_29 -set!_29)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'read-config
- #f
- 7
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3 4 5 6)
- #f
- 'read-config/outer)))))
+ (let-values (((struct:_130 make-_130 ?_130 -ref_130 -set!_130)
+ (make-struct-type
+ 'read-config
+ #f
+ 7
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4 5 6)
+ #f
+ 'read-config/outer)))
(values
- struct:_29
- make-_29
- ?_29
- (make-struct-field-accessor -ref_29 0 'inner)
- (make-struct-field-accessor -ref_29 1 'wrap)
- (make-struct-field-accessor -ref_29 2 'line)
- (make-struct-field-accessor -ref_29 3 'col)
- (make-struct-field-accessor -ref_29 4 'pos)
- (make-struct-field-accessor -ref_29 5 'indentations)
- (make-struct-field-accessor -ref_29 6 'keep-comment?))))
+ struct:_130
+ make-_130
+ ?_130
+ (make-struct-field-accessor -ref_130 0 'inner)
+ (make-struct-field-accessor -ref_130 1 'wrap)
+ (make-struct-field-accessor -ref_130 2 'line)
+ (make-struct-field-accessor -ref_130 3 'col)
+ (make-struct-field-accessor -ref_130 4 'pos)
+ (make-struct-field-accessor -ref_130 5 'indentations)
+ (make-struct-field-accessor -ref_130 6 'keep-comment?))))
(define-values
(struct:read-config/inner
read-config/inner2.1
@@ -56763,38 +55735,36 @@
read-config/inner-parameter-override
read-config/inner-parameter-cache
read-config/inner-st)
- (let-values (((struct:_30 make-_30 ?_30 -ref_30 -set!_30)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'read-config/inner
- #f
- 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)))))
+ (let-values (((struct:_131 make-_131 ?_131 -ref_131 -set!_131)
+ (make-struct-type
+ 'read-config/inner
+ #f
+ 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)))
(values
- struct:_30
- make-_30
- ?_30
- (make-struct-field-accessor -ref_30 0 'readtable)
- (make-struct-field-accessor -ref_30 1 'next-readtable)
- (make-struct-field-accessor -ref_30 2 'for-syntax?)
- (make-struct-field-accessor -ref_30 3 'source)
- (make-struct-field-accessor -ref_30 4 'read-compiled)
- (make-struct-field-accessor -ref_30 5 'call-with-root-namespace)
- (make-struct-field-accessor -ref_30 6 'dynamic-require)
- (make-struct-field-accessor -ref_30 7 'module-declared?)
- (make-struct-field-accessor -ref_30 8 'coerce)
- (make-struct-field-accessor -ref_30 9 'coerce-key)
- (make-struct-field-accessor -ref_30 10 'parameter-override)
- (make-struct-field-accessor -ref_30 11 'parameter-cache)
- (make-struct-field-accessor -ref_30 12 'st))))
+ struct:_131
+ make-_131
+ ?_131
+ (make-struct-field-accessor -ref_131 0 'readtable)
+ (make-struct-field-accessor -ref_131 1 'next-readtable)
+ (make-struct-field-accessor -ref_131 2 'for-syntax?)
+ (make-struct-field-accessor -ref_131 3 'source)
+ (make-struct-field-accessor -ref_131 4 'read-compiled)
+ (make-struct-field-accessor -ref_131 5 'call-with-root-namespace)
+ (make-struct-field-accessor -ref_131 6 'dynamic-require)
+ (make-struct-field-accessor -ref_131 7 'module-declared?)
+ (make-struct-field-accessor -ref_131 8 'coerce)
+ (make-struct-field-accessor -ref_131 9 'coerce-key)
+ (make-struct-field-accessor -ref_131 10 'parameter-override)
+ (make-struct-field-accessor -ref_131 11 'parameter-cache)
+ (make-struct-field-accessor -ref_131 12 'st))))
(define-values
(read-config/make)
(lambda (readtable_0
@@ -56810,7 +55780,7 @@
coerce-key_0
line_1
col_0
- pos_108
+ pos_166
indentations_0
keep-comment?_0
parameter-override_0
@@ -56835,50 +55805,52 @@
wrap_5
line_1
col_0
- pos_108
+ pos_166
indentations_0
keep-comment?_0))))
- (define-values (read-config-wrap) (lambda (v_81) (begin (read-config/outer-wrap v_81))))
- (define-values (read-config-line) (lambda (v_35) (begin (read-config/outer-line v_35))))
- (define-values (read-config-col) (lambda (v_217) (begin (read-config/outer-col v_217))))
- (define-values (read-config-pos) (lambda (v_50) (begin (read-config/outer-pos v_50))))
- (define-values (read-config-indentations) (lambda (v_218) (begin (read-config/outer-indentations v_218))))
- (define-values (read-config-keep-comment?) (lambda (v_219) (begin (read-config/outer-keep-comment? v_219))))
+ (define-values (read-config-wrap) (lambda (v_303) (begin (read-config/outer-wrap v_303))))
+ (define-values (read-config-line) (lambda (v_304) (begin (read-config/outer-line v_304))))
+ (define-values (read-config-col) (lambda (v_305) (begin (read-config/outer-col v_305))))
+ (define-values (read-config-pos) (lambda (v_306) (begin (read-config/outer-pos v_306))))
+ (define-values (read-config-indentations) (lambda (v_307) (begin (read-config/outer-indentations v_307))))
+ (define-values (read-config-keep-comment?) (lambda (v_308) (begin (read-config/outer-keep-comment? v_308))))
(define-values
(read-config-readtable)
- (lambda (v_57) (begin (read-config/inner-readtable (read-config/outer-inner v_57)))))
+ (lambda (v_309) (begin (read-config/inner-readtable (read-config/outer-inner v_309)))))
(define-values
(read-config-next-readtable)
- (lambda (v_167) (begin (read-config/inner-next-readtable (read-config/outer-inner v_167)))))
+ (lambda (v_310) (begin (read-config/inner-next-readtable (read-config/outer-inner v_310)))))
(define-values
(read-config-for-syntax?)
- (lambda (v_220) (begin (read-config/inner-for-syntax? (read-config/outer-inner v_220)))))
- (define-values (read-config-source) (lambda (v_51) (begin (read-config/inner-source (read-config/outer-inner v_51)))))
+ (lambda (v_311) (begin (read-config/inner-for-syntax? (read-config/outer-inner v_311)))))
+ (define-values
+ (read-config-source)
+ (lambda (v_312) (begin (read-config/inner-source (read-config/outer-inner v_312)))))
(define-values
(read-config-read-compiled)
- (lambda (v_213) (begin (read-config/inner-read-compiled (read-config/outer-inner v_213)))))
+ (lambda (v_313) (begin (read-config/inner-read-compiled (read-config/outer-inner v_313)))))
(define-values
(read-config-call-with-root-namespace)
- (lambda (v_221) (begin (read-config/inner-call-with-root-namespace (read-config/outer-inner v_221)))))
+ (lambda (v_314) (begin (read-config/inner-call-with-root-namespace (read-config/outer-inner v_314)))))
(define-values
(read-config-dynamic-require)
- (lambda (v_196) (begin (read-config/inner-dynamic-require (read-config/outer-inner v_196)))))
+ (lambda (v_315) (begin (read-config/inner-dynamic-require (read-config/outer-inner v_315)))))
(define-values
(read-config-module-declared?)
- (lambda (v_84) (begin (read-config/inner-module-declared? (read-config/outer-inner v_84)))))
+ (lambda (v_316) (begin (read-config/inner-module-declared? (read-config/outer-inner v_316)))))
(define-values
(read-config-coerce)
- (lambda (v_222) (begin (read-config/inner-coerce (read-config/outer-inner v_222)))))
+ (lambda (v_317) (begin (read-config/inner-coerce (read-config/outer-inner v_317)))))
(define-values
(read-config-coerce-key)
- (lambda (v_165) (begin (read-config/inner-coerce-key (read-config/outer-inner v_165)))))
+ (lambda (v_318) (begin (read-config/inner-coerce-key (read-config/outer-inner v_318)))))
(define-values
(read-config-parameter-override)
- (lambda (v_41) (begin (read-config/inner-parameter-override (read-config/outer-inner v_41)))))
+ (lambda (v_319) (begin (read-config/inner-parameter-override (read-config/outer-inner v_319)))))
(define-values
(read-config-parameter-cache)
- (lambda (v_223) (begin (read-config/inner-parameter-cache (read-config/outer-inner v_223)))))
- (define-values (read-config-st) (lambda (v_168) (begin (read-config/inner-st (read-config/outer-inner v_168)))))
+ (lambda (v_320) (begin (read-config/inner-parameter-cache (read-config/outer-inner v_320)))))
+ (define-values (read-config-st) (lambda (v_321) (begin (read-config/inner-st (read-config/outer-inner v_321)))))
(define-values
(struct:read-config-state
read-config-state3.1
@@ -56887,29 +55859,16 @@
read-config-state-graph
set-read-config-state-accum-str!
set-read-config-state-graph!)
- (let-values (((struct:_0 make-_0 ?_0 -ref_0 -set!_0)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'read-config-state
- #f
- 2
- 0
- #f
- null
- (current-inspector)
- #f
- '()
- #f
- 'read-config-state)))))
+ (let-values (((struct:_132 make-_132 ?_132 -ref_132 -set!_132)
+ (make-struct-type 'read-config-state #f 2 0 #f null (current-inspector) #f '() #f 'read-config-state)))
(values
- struct:_0
- make-_0
- ?_0
- (make-struct-field-accessor -ref_0 0 'accum-str)
- (make-struct-field-accessor -ref_0 1 'graph)
- (make-struct-field-mutator -set!_0 0 'accum-str)
- (make-struct-field-mutator -set!_0 1 'graph))))
+ struct:_132
+ make-_132
+ ?_132
+ (make-struct-field-accessor -ref_132 0 'accum-str)
+ (make-struct-field-accessor -ref_132 1 'graph)
+ (make-struct-field-mutator -set!_132 0 'accum-str)
+ (make-struct-field-mutator -set!_132 1 'graph))))
(define-values (default-val.1) #f)
(define-values
(current-read-config)
@@ -56943,42 +55902,41 @@
(let-values (((coerce_1) coerce13_0))
(let-values (((coerce-key_1) coerce-key14_0))
(let-values (((keep-comment?_1) keep-comment?15_0))
- (let-values ()
- (read-config/make
- readtable_1
- next-readtable_1
- for-syntax?_1
- source_2
- wrap_6
- (let-values (((or-part_217) read-compiled_1))
- (if or-part_217
- or-part_217
- (lambda (in_1) (error 'read "no `read-compiled` provided"))))
- (let-values (((or-part_225) call-with-root-namespace_1))
- (if or-part_225
- or-part_225
- (lambda (thunk_8) (error 'read "no `call-with-root-namespace` provided"))))
- (let-values (((or-part_315) dynamic-require_2))
- (if or-part_315
- or-part_315
- (lambda (mod-path_26 sym_108 failure-k_0)
- (error 'read "no `dynamic-require` provided"))))
- (let-values (((or-part_274) module-declared?_1))
- (if or-part_274
- or-part_274
- (lambda (mod-path_24) (error 'read "no `module-declare?` provided"))))
- (let-values (((or-part_42) coerce_1))
- (if or-part_42 or-part_42 (lambda (for-syntax?_2 v_113 srcloc_15) v_113)))
- (let-values (((or-part_81) coerce-key_1))
- (if or-part_81 or-part_81 (lambda (for-syntax?_3 v_116) v_116)))
- #f
- #f
- #f
- null
- keep-comment?_1
- '#hasheq()
- (make-hasheq)
- (read-config-state3.1 #f #f))))))))))))))))))
+ (read-config/make
+ readtable_1
+ next-readtable_1
+ for-syntax?_1
+ source_2
+ wrap_6
+ (let-values (((or-part_563) read-compiled_1))
+ (if or-part_563
+ or-part_563
+ (lambda (in_1) (error 'read "no `read-compiled` provided"))))
+ (let-values (((or-part_564) call-with-root-namespace_1))
+ (if or-part_564
+ or-part_564
+ (lambda (thunk_7) (error 'read "no `call-with-root-namespace` provided"))))
+ (let-values (((or-part_565) dynamic-require_2))
+ (if or-part_565
+ or-part_565
+ (lambda (mod-path_31 sym_136 failure-k_0)
+ (error 'read "no `dynamic-require` provided"))))
+ (let-values (((or-part_566) module-declared?_1))
+ (if or-part_566
+ or-part_566
+ (lambda (mod-path_32) (error 'read "no `module-declare?` provided"))))
+ (let-values (((or-part_567) coerce_1))
+ (if or-part_567 or-part_567 (lambda (for-syntax?_2 v_322 srcloc_15) v_322)))
+ (let-values (((or-part_568) coerce-key_1))
+ (if or-part_568 or-part_568 (lambda (for-syntax?_3 v_323) v_323)))
+ #f
+ #f
+ #f
+ null
+ keep-comment?_1
+ '#hasheq()
+ (make-hasheq)
+ (read-config-state3.1 #f #f)))))))))))))))))
(define-values
(read-config-update.1)
(lambda (for-syntax?29_0 keep-comment?34_0 next-readtable32_0 readtable31_0 reset-graph?33_0 wrap30_0 config41_0)
@@ -56994,48 +55952,47 @@
next-readtable32_0)))
(let-values (((local-graph?_0) reset-graph?33_0))
(let-values (((keep-comment?_2) keep-comment?34_0))
- (let-values ()
- (let-values (((v_224) config_0))
- (let-values (((the-struct_74) v_224))
- (if (read-config/outer? the-struct_74)
- (let-values (((wrap51_0) wrap_7)
- ((keep-comment?52_0) keep-comment?_2)
- ((inner53_0)
- (let-values (((the-struct_75) (read-config/outer-inner v_224)))
- (if (read-config/inner? the-struct_75)
- (let-values (((for-syntax?54_0) for-syntax?_4)
- ((readtable55_0) readtable_2)
- ((next-readtable56_0) next-readtable_2)
- ((st57_0)
- (if local-graph?_0
- (read-config-state3.1 #f #f)
- (read-config-st config_0)))
- ((parameter-override58_0) '#hasheq())
- ((parameter-cache59_0) (make-hasheq)))
- (read-config/inner2.1
- readtable55_0
- next-readtable56_0
- for-syntax?54_0
- (read-config/inner-source the-struct_75)
- (read-config/inner-read-compiled the-struct_75)
- (read-config/inner-call-with-root-namespace the-struct_75)
- (read-config/inner-dynamic-require the-struct_75)
- (read-config/inner-module-declared? the-struct_75)
- (read-config/inner-coerce the-struct_75)
- (read-config/inner-coerce-key the-struct_75)
- parameter-override58_0
- parameter-cache59_0
- st57_0))
- (raise-argument-error 'struct-copy "read-config/inner?" the-struct_75)))))
- (read-config/outer1.1
- inner53_0
- wrap51_0
- (read-config/outer-line the-struct_74)
- (read-config/outer-col the-struct_74)
- (read-config/outer-pos the-struct_74)
- (read-config/outer-indentations the-struct_74)
- keep-comment?52_0))
- (raise-argument-error 'struct-copy "read-config/outer?" the-struct_74)))))))))))))))
+ (let-values (((v_324) config_0))
+ (let-values (((the-struct_80) v_324))
+ (if (read-config/outer? the-struct_80)
+ (let-values (((wrap51_0) wrap_7)
+ ((keep-comment?52_0) keep-comment?_2)
+ ((inner53_0)
+ (let-values (((the-struct_81) (read-config/outer-inner v_324)))
+ (if (read-config/inner? the-struct_81)
+ (let-values (((for-syntax?54_0) for-syntax?_4)
+ ((readtable55_0) readtable_2)
+ ((next-readtable56_0) next-readtable_2)
+ ((st57_0)
+ (if local-graph?_0
+ (read-config-state3.1 #f #f)
+ (read-config-st config_0)))
+ ((parameter-override58_0) '#hasheq())
+ ((parameter-cache59_0) (make-hasheq)))
+ (read-config/inner2.1
+ readtable55_0
+ next-readtable56_0
+ for-syntax?54_0
+ (read-config/inner-source the-struct_81)
+ (read-config/inner-read-compiled the-struct_81)
+ (read-config/inner-call-with-root-namespace the-struct_81)
+ (read-config/inner-dynamic-require the-struct_81)
+ (read-config/inner-module-declared? the-struct_81)
+ (read-config/inner-coerce the-struct_81)
+ (read-config/inner-coerce-key the-struct_81)
+ parameter-override58_0
+ parameter-cache59_0
+ st57_0))
+ (raise-argument-error 'struct-copy "read-config/inner?" the-struct_81)))))
+ (read-config/outer1.1
+ inner53_0
+ wrap51_0
+ (read-config/outer-line the-struct_80)
+ (read-config/outer-col the-struct_80)
+ (read-config/outer-pos the-struct_80)
+ (read-config/outer-indentations the-struct_80)
+ keep-comment?52_0))
+ (raise-argument-error 'struct-copy "read-config/outer?" the-struct_80))))))))))))))
(define-values
(port+config->srcloc.1)
(lambda (end-pos43_0 in45_0 config46_0)
@@ -57044,234 +56001,232 @@
(let-values (((in_2) in45_0))
(let-values (((config_1) config46_0))
(let-values (((given-end-pos_0) end-pos43_0))
- (let-values ()
- (let-values (((end-pos_1)
- (let-values (((or-part_97) given-end-pos_0))
- (if or-part_97
- or-part_97
- (let-values (((end-line_0 end-col_0 end-pos_2) (port-next-location in_2)))
- end-pos_2)))))
- (srcloc
- (let-values (((or-part_295) (read-config-source config_1)))
- (if or-part_295
- or-part_295
- (let-values (((or-part_275) (object-name in_2))) (if or-part_275 or-part_275 "UNKNOWN"))))
- (read-config-line config_1)
- (read-config-col config_1)
- (read-config-pos config_1)
- (if (read-config-pos config_1)
- (if end-pos_1 (max 0 (- end-pos_1 (read-config-pos config_1))) #f)
- #f))))))))))
+ (let-values (((end-pos_1)
+ (let-values (((or-part_569) given-end-pos_0))
+ (if or-part_569
+ or-part_569
+ (let-values (((end-line_0 end-col_0 end-pos_2) (port-next-location in_2))) end-pos_2)))))
+ (srcloc
+ (let-values (((or-part_570) (read-config-source config_1)))
+ (if or-part_570
+ or-part_570
+ (let-values (((or-part_571) (object-name in_2))) (if or-part_571 or-part_571 "UNKNOWN"))))
+ (read-config-line config_1)
+ (read-config-col config_1)
+ (read-config-pos config_1)
+ (if (read-config-pos config_1)
+ (if end-pos_1 (max 0 (- end-pos_1 (read-config-pos config_1))) #f)
+ #f)))))))))
(define-values
(reading-at)
- (lambda (config_2 line_2 col_1 pos_23)
+ (lambda (config_2 line_2 col_1 pos_167)
(begin
- (let-values (((v_225) config_2))
- (let-values (((the-struct_76) v_225))
- (if (read-config/outer? the-struct_76)
+ (let-values (((v_325) config_2))
+ (let-values (((the-struct_82) v_325))
+ (if (read-config/outer? the-struct_82)
(let-values (((line60_0) line_2)
((col61_0) col_1)
- ((pos62_0) pos_23)
- ((inner63_0) (read-config/outer-inner v_225)))
+ ((pos62_0) pos_167)
+ ((inner63_0) (read-config/outer-inner v_325)))
(read-config/outer1.1
inner63_0
- (read-config/outer-wrap the-struct_76)
+ (read-config/outer-wrap the-struct_82)
line60_0
col61_0
pos62_0
- (read-config/outer-indentations the-struct_76)
- (read-config/outer-keep-comment? the-struct_76)))
- (raise-argument-error 'struct-copy "read-config/outer?" the-struct_76)))))))
+ (read-config/outer-indentations the-struct_82)
+ (read-config/outer-keep-comment? the-struct_82)))
+ (raise-argument-error 'struct-copy "read-config/outer?" the-struct_82)))))))
(define-values
(disable-wrapping)
(lambda (config_3)
(begin
- (let-values (((v_226) config_3))
- (let-values (((the-struct_77) v_226))
- (if (read-config/outer? the-struct_77)
- (let-values (((wrap64_0) #f) ((inner65_0) (read-config/outer-inner v_226)))
+ (let-values (((v_326) config_3))
+ (let-values (((the-struct_83) v_326))
+ (if (read-config/outer? the-struct_83)
+ (let-values (((wrap64_0) #f) ((inner65_0) (read-config/outer-inner v_326)))
(read-config/outer1.1
inner65_0
wrap64_0
- (read-config/outer-line the-struct_77)
- (read-config/outer-col the-struct_77)
- (read-config/outer-pos the-struct_77)
- (read-config/outer-indentations the-struct_77)
- (read-config/outer-keep-comment? the-struct_77)))
- (raise-argument-error 'struct-copy "read-config/outer?" the-struct_77)))))))
+ (read-config/outer-line the-struct_83)
+ (read-config/outer-col the-struct_83)
+ (read-config/outer-pos the-struct_83)
+ (read-config/outer-indentations the-struct_83)
+ (read-config/outer-keep-comment? the-struct_83)))
+ (raise-argument-error 'struct-copy "read-config/outer?" the-struct_83)))))))
(define-values
(keep-comment)
(lambda (config_4)
(begin
- (let-values (((v_227) config_4))
- (let-values (((the-struct_78) v_227))
- (if (read-config/outer? the-struct_78)
- (let-values (((keep-comment?66_0) #t) ((inner67_0) (read-config/outer-inner v_227)))
+ (let-values (((v_327) config_4))
+ (let-values (((the-struct_84) v_327))
+ (if (read-config/outer? the-struct_84)
+ (let-values (((keep-comment?66_0) #t) ((inner67_0) (read-config/outer-inner v_327)))
(read-config/outer1.1
inner67_0
- (read-config/outer-wrap the-struct_78)
- (read-config/outer-line the-struct_78)
- (read-config/outer-col the-struct_78)
- (read-config/outer-pos the-struct_78)
- (read-config/outer-indentations the-struct_78)
+ (read-config/outer-wrap the-struct_84)
+ (read-config/outer-line the-struct_84)
+ (read-config/outer-col the-struct_84)
+ (read-config/outer-pos the-struct_84)
+ (read-config/outer-indentations the-struct_84)
keep-comment?66_0))
- (raise-argument-error 'struct-copy "read-config/outer?" the-struct_78)))))))
+ (raise-argument-error 'struct-copy "read-config/outer?" the-struct_84)))))))
(define-values
(discard-comment)
(lambda (config_5)
(begin
(if (not (read-config-keep-comment? config_5))
- (let-values () config_5)
- (let-values ()
- (let-values (((v_228) config_5))
- (let-values (((the-struct_79) v_228))
- (if (read-config/outer? the-struct_79)
- (let-values (((keep-comment?68_0) #f) ((inner69_0) (read-config/outer-inner v_228)))
- (read-config/outer1.1
- inner69_0
- (read-config/outer-wrap the-struct_79)
- (read-config/outer-line the-struct_79)
- (read-config/outer-col the-struct_79)
- (read-config/outer-pos the-struct_79)
- (read-config/outer-indentations the-struct_79)
- keep-comment?68_0))
- (raise-argument-error 'struct-copy "read-config/outer?" the-struct_79)))))))))
+ config_5
+ (let-values (((v_328) config_5))
+ (let-values (((the-struct_85) v_328))
+ (if (read-config/outer? the-struct_85)
+ (let-values (((keep-comment?68_0) #f) ((inner69_0) (read-config/outer-inner v_328)))
+ (read-config/outer1.1
+ inner69_0
+ (read-config/outer-wrap the-struct_85)
+ (read-config/outer-line the-struct_85)
+ (read-config/outer-col the-struct_85)
+ (read-config/outer-pos the-struct_85)
+ (read-config/outer-indentations the-struct_85)
+ keep-comment?68_0))
+ (raise-argument-error 'struct-copy "read-config/outer?" the-struct_85))))))))
(define-values
(next-readtable)
(lambda (config_6)
(begin
(if (eq? (read-config-readtable config_6) (read-config-next-readtable config_6))
- (let-values () config_6)
- (let-values ()
- (let-values (((v_229) config_6))
- (let-values (((the-struct_80) v_229))
- (if (read-config/outer? the-struct_80)
- (let-values (((inner70_0)
- (let-values (((the-struct_81) (read-config/outer-inner v_229)))
- (if (read-config/inner? the-struct_81)
- (let-values (((readtable71_0) (read-config-next-readtable config_6)))
- (read-config/inner2.1
- readtable71_0
- (read-config/inner-next-readtable the-struct_81)
- (read-config/inner-for-syntax? the-struct_81)
- (read-config/inner-source the-struct_81)
- (read-config/inner-read-compiled the-struct_81)
- (read-config/inner-call-with-root-namespace the-struct_81)
- (read-config/inner-dynamic-require the-struct_81)
- (read-config/inner-module-declared? the-struct_81)
- (read-config/inner-coerce the-struct_81)
- (read-config/inner-coerce-key the-struct_81)
- (read-config/inner-parameter-override the-struct_81)
- (read-config/inner-parameter-cache the-struct_81)
- (read-config/inner-st the-struct_81)))
- (raise-argument-error 'struct-copy "read-config/inner?" the-struct_81)))))
- (read-config/outer1.1
- inner70_0
- (read-config/outer-wrap the-struct_80)
- (read-config/outer-line the-struct_80)
- (read-config/outer-col the-struct_80)
- (read-config/outer-pos the-struct_80)
- (read-config/outer-indentations the-struct_80)
- (read-config/outer-keep-comment? the-struct_80)))
- (raise-argument-error 'struct-copy "read-config/outer?" the-struct_80)))))))))
+ config_6
+ (let-values (((v_329) config_6))
+ (let-values (((the-struct_86) v_329))
+ (if (read-config/outer? the-struct_86)
+ (let-values (((inner70_0)
+ (let-values (((the-struct_87) (read-config/outer-inner v_329)))
+ (if (read-config/inner? the-struct_87)
+ (let-values (((readtable71_0) (read-config-next-readtable config_6)))
+ (read-config/inner2.1
+ readtable71_0
+ (read-config/inner-next-readtable the-struct_87)
+ (read-config/inner-for-syntax? the-struct_87)
+ (read-config/inner-source the-struct_87)
+ (read-config/inner-read-compiled the-struct_87)
+ (read-config/inner-call-with-root-namespace the-struct_87)
+ (read-config/inner-dynamic-require the-struct_87)
+ (read-config/inner-module-declared? the-struct_87)
+ (read-config/inner-coerce the-struct_87)
+ (read-config/inner-coerce-key the-struct_87)
+ (read-config/inner-parameter-override the-struct_87)
+ (read-config/inner-parameter-cache the-struct_87)
+ (read-config/inner-st the-struct_87)))
+ (raise-argument-error 'struct-copy "read-config/inner?" the-struct_87)))))
+ (read-config/outer1.1
+ inner70_0
+ (read-config/outer-wrap the-struct_86)
+ (read-config/outer-line the-struct_86)
+ (read-config/outer-col the-struct_86)
+ (read-config/outer-pos the-struct_86)
+ (read-config/outer-indentations the-struct_86)
+ (read-config/outer-keep-comment? the-struct_86)))
+ (raise-argument-error 'struct-copy "read-config/outer?" the-struct_86))))))))
(define-values
(coerce)
- (lambda (val_82 in_3 config_7)
+ (lambda (val_90 in_3 config_7)
(begin
(let-values (((for-syntax?_5) (read-config-for-syntax? config_7)))
((read-config-coerce config_7)
for-syntax?_5
- val_82
+ val_90
(if for-syntax?_5
(let-values (((in1_0) in_3) ((config2_0) config_7)) (port+config->srcloc.1 #f in1_0 config2_0))
#f))))))
- (define-values (default-reader-guard$1) (lambda (v_230) (begin 'default-reader-guard v_230)))
+ (define-values (default-reader-guard$1) (lambda (v_330) (begin 'default-reader-guard v_330)))
(define-values
(1/current-reader-guard)
(make-parameter
default-reader-guard$1
- (lambda (v_231)
+ (lambda (v_331)
(begin
- (if (if (procedure? v_231) (procedure-arity-includes? v_231 1) #f)
+ (if (if (procedure? v_331) (procedure-arity-includes? v_331 1) #f)
(void)
- (let-values () (raise-argument-error 'current-reader-guard "(procedure-arity-includes/c 1)" v_231)))
- v_231))
+ (raise-argument-error 'current-reader-guard "(procedure-arity-includes/c 1)" v_331))
+ v_331))
'current-reader-guard))
(define-values
(1/read-square-bracket-as-paren)
- (make-parameter #t (lambda (v_232) (if v_232 #t #f)) 'read-square-bracket-as-paren))
+ (make-parameter #t (lambda (v_332) (if v_332 #t #f)) 'read-square-bracket-as-paren))
(define-values
(1/read-curly-brace-as-paren)
- (make-parameter #t (lambda (v_46) (if v_46 #t #f)) 'read-curly-brace-as-paren))
+ (make-parameter #t (lambda (v_333) (if v_333 #t #f)) 'read-curly-brace-as-paren))
(define-values
(1/read-square-bracket-with-tag)
- (make-parameter #f (lambda (v_125) (if v_125 #t #f)) 'read-square-bracket-with-tag))
+ (make-parameter #f (lambda (v_334) (if v_334 #t #f)) 'read-square-bracket-with-tag))
(define-values
(1/read-curly-brace-with-tag)
- (make-parameter #f (lambda (v_233) (if v_233 #t #f)) 'read-curly-brace-with-tag))
- (define-values (1/read-cdot) (make-parameter #f (lambda (v_24) (if v_24 #t #f)) 'read-cdot))
- (define-values (1/read-accept-graph) (make-parameter #t (lambda (v_89) (if v_89 #t #f)) 'read-accept-graph))
+ (make-parameter #f (lambda (v_335) (if v_335 #t #f)) 'read-curly-brace-with-tag))
+ (define-values (1/read-cdot) (make-parameter #f (lambda (v_336) (if v_336 #t #f)) 'read-cdot))
+ (define-values (1/read-accept-graph) (make-parameter #t (lambda (v_337) (if v_337 #t #f)) 'read-accept-graph))
(define-values
(1/read-syntax-accept-graph)
- (make-parameter #f (lambda (v_85) (if v_85 #t #f)) 'read-syntax-accept-graph))
- (define-values (1/read-accept-compiled) (make-parameter #f (lambda (v_49) (if v_49 #t #f)) 'read-accept-compiled))
- (define-values (1/read-accept-box) (make-parameter #t (lambda (v_166) (if v_166 #t #f)) 'read-accept-box))
- (define-values (1/read-single-flonum) (make-parameter #f (lambda (v_234) (if v_234 #t #f)) 'read-single-flonum))
+ (make-parameter #f (lambda (v_338) (if v_338 #t #f)) 'read-syntax-accept-graph))
+ (define-values (1/read-accept-compiled) (make-parameter #f (lambda (v_339) (if v_339 #t #f)) 'read-accept-compiled))
+ (define-values (1/read-accept-box) (make-parameter #t (lambda (v_340) (if v_340 #t #f)) 'read-accept-box))
+ (define-values (1/read-single-flonum) (make-parameter #f (lambda (v_341) (if v_341 #t #f)) 'read-single-flonum))
(define-values
(1/read-decimal-as-inexact)
- (make-parameter #t (lambda (v_32) (if v_32 #t #f)) 'read-decimal-as-inexact))
- (define-values (1/read-accept-dot) (make-parameter #t (lambda (v_67) (if v_67 #t #f)) 'read-accept-dot))
- (define-values (1/read-accept-infix-dot) (make-parameter #t (lambda (v_33) (if v_33 #t #f)) 'read-accept-infix-dot))
- (define-values (1/read-accept-quasiquote) (make-parameter #t (lambda (v_76) (if v_76 #t #f)) 'read-accept-quasiquote))
- (define-values (1/read-accept-reader) (make-parameter #f (lambda (v_34) (if v_34 #t #f)) 'read-accept-reader))
- (define-values (1/read-accept-lang) (make-parameter #t (lambda (v_66) (if v_66 #t #f)) 'read-accept-lang))
+ (make-parameter #t (lambda (v_342) (if v_342 #t #f)) 'read-decimal-as-inexact))
+ (define-values (1/read-accept-dot) (make-parameter #t (lambda (v_343) (if v_343 #t #f)) 'read-accept-dot))
+ (define-values (1/read-accept-infix-dot) (make-parameter #t (lambda (v_344) (if v_344 #t #f)) 'read-accept-infix-dot))
+ (define-values
+ (1/read-accept-quasiquote)
+ (make-parameter #t (lambda (v_345) (if v_345 #t #f)) 'read-accept-quasiquote))
+ (define-values (1/read-accept-reader) (make-parameter #f (lambda (v_346) (if v_346 #t #f)) 'read-accept-reader))
+ (define-values (1/read-accept-lang) (make-parameter #t (lambda (v_347) (if v_347 #t #f)) 'read-accept-lang))
(define-values (unknown) (gensym 'unknown))
(define-values
(check-parameter)
(lambda (param_0 config_8)
(begin
(let-values (((cache_1) (read-config-parameter-cache config_8)))
- (let-values (((v_0)
+ (let-values (((v_348)
(hash-ref (read-config-parameter-override config_8) param_0 (hash-ref cache_1 param_0 unknown))))
- (if (eq? v_0 unknown)
- (let-values () (let-values (((v_235) (param_0))) (begin (hash-set! cache_1 param_0 v_235) v_235)))
- (let-values () v_0)))))))
+ (if (eq? v_348 unknown)
+ (let-values (((v_349) (param_0))) (begin (hash-set! cache_1 param_0 v_349) v_349))
+ v_348))))))
(define-values
(override-parameter)
- (lambda (param_1 config_9 v_31)
+ (lambda (param_1 config_9 v_350)
(begin
- (let-values (((v_55) config_9))
- (let-values (((the-struct_5) v_55))
- (if (read-config/outer? the-struct_5)
+ (let-values (((v_351) config_9))
+ (let-values (((the-struct_88) v_351))
+ (if (read-config/outer? the-struct_88)
(let-values (((inner1_0)
- (let-values (((the-struct_82) (read-config/outer-inner v_55)))
- (if (read-config/inner? the-struct_82)
+ (let-values (((the-struct_89) (read-config/outer-inner v_351)))
+ (if (read-config/inner? the-struct_89)
(let-values (((parameter-override2_0)
- (hash-set (read-config-parameter-override config_9) param_1 v_31)))
+ (hash-set (read-config-parameter-override config_9) param_1 v_350)))
(read-config/inner2.1
- (read-config/inner-readtable the-struct_82)
- (read-config/inner-next-readtable the-struct_82)
- (read-config/inner-for-syntax? the-struct_82)
- (read-config/inner-source the-struct_82)
- (read-config/inner-read-compiled the-struct_82)
- (read-config/inner-call-with-root-namespace the-struct_82)
- (read-config/inner-dynamic-require the-struct_82)
- (read-config/inner-module-declared? the-struct_82)
- (read-config/inner-coerce the-struct_82)
- (read-config/inner-coerce-key the-struct_82)
+ (read-config/inner-readtable the-struct_89)
+ (read-config/inner-next-readtable the-struct_89)
+ (read-config/inner-for-syntax? the-struct_89)
+ (read-config/inner-source the-struct_89)
+ (read-config/inner-read-compiled the-struct_89)
+ (read-config/inner-call-with-root-namespace the-struct_89)
+ (read-config/inner-dynamic-require the-struct_89)
+ (read-config/inner-module-declared? the-struct_89)
+ (read-config/inner-coerce the-struct_89)
+ (read-config/inner-coerce-key the-struct_89)
parameter-override2_0
- (read-config/inner-parameter-cache the-struct_82)
- (read-config/inner-st the-struct_82)))
- (raise-argument-error 'struct-copy "read-config/inner?" the-struct_82)))))
+ (read-config/inner-parameter-cache the-struct_89)
+ (read-config/inner-st the-struct_89)))
+ (raise-argument-error 'struct-copy "read-config/inner?" the-struct_89)))))
(read-config/outer1.1
inner1_0
- (read-config/outer-wrap the-struct_5)
- (read-config/outer-line the-struct_5)
- (read-config/outer-col the-struct_5)
- (read-config/outer-pos the-struct_5)
- (read-config/outer-indentations the-struct_5)
- (read-config/outer-keep-comment? the-struct_5)))
- (raise-argument-error 'struct-copy "read-config/outer?" the-struct_5)))))))
+ (read-config/outer-wrap the-struct_88)
+ (read-config/outer-line the-struct_88)
+ (read-config/outer-col the-struct_88)
+ (read-config/outer-pos the-struct_88)
+ (read-config/outer-indentations the-struct_88)
+ (read-config/outer-keep-comment? the-struct_88)))
+ (raise-argument-error 'struct-copy "read-config/outer?" the-struct_88)))))))
(define-values
(force-parameters!)
(lambda (config_10)
@@ -57279,45 +56234,42 @@
(let-values (((cache_2) (read-config-parameter-cache config_10)))
(if (hash-ref cache_2 'all-forced #f)
(void)
- (let-values ()
- (begin
- (hash-set! cache_2 'all-forced #t)
- (check-parameter read-case-sensitive config_10)
- (check-parameter 1/read-square-bracket-as-paren config_10)
- (check-parameter 1/read-curly-brace-as-paren config_10)
- (check-parameter 1/read-square-bracket-with-tag config_10)
- (check-parameter 1/read-curly-brace-with-tag config_10)
- (check-parameter 1/read-cdot config_10)
- (check-parameter 1/read-accept-graph config_10)
- (check-parameter 1/read-syntax-accept-graph config_10)
- (check-parameter 1/read-accept-compiled config_10)
- (check-parameter 1/read-accept-box config_10)
- (check-parameter read-accept-bar-quote config_10)
- (check-parameter 1/read-decimal-as-inexact config_10)
- (check-parameter 1/read-single-flonum config_10)
- (check-parameter 1/read-accept-dot config_10)
- (check-parameter 1/read-accept-infix-dot config_10)
- (check-parameter 1/read-accept-quasiquote config_10)
- (check-parameter 1/read-accept-reader config_10)
- (check-parameter 1/read-accept-lang config_10))))))))
+ (begin
+ (hash-set! cache_2 'all-forced #t)
+ (check-parameter read-case-sensitive config_10)
+ (check-parameter 1/read-square-bracket-as-paren config_10)
+ (check-parameter 1/read-curly-brace-as-paren config_10)
+ (check-parameter 1/read-square-bracket-with-tag config_10)
+ (check-parameter 1/read-curly-brace-with-tag config_10)
+ (check-parameter 1/read-cdot config_10)
+ (check-parameter 1/read-accept-graph config_10)
+ (check-parameter 1/read-syntax-accept-graph config_10)
+ (check-parameter 1/read-accept-compiled config_10)
+ (check-parameter 1/read-accept-box config_10)
+ (check-parameter read-accept-bar-quote config_10)
+ (check-parameter 1/read-decimal-as-inexact config_10)
+ (check-parameter 1/read-single-flonum config_10)
+ (check-parameter 1/read-accept-dot config_10)
+ (check-parameter 1/read-accept-infix-dot config_10)
+ (check-parameter 1/read-accept-quasiquote config_10)
+ (check-parameter 1/read-accept-reader config_10)
+ (check-parameter 1/read-accept-lang config_10)))))))
(define-values
(struct:special-comment 1/make-special-comment 1/special-comment? 1/special-comment-value)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'special-comment
- #f
- 1
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0)
- #f
- 'make-special-comment)))))
- (values struct:_2 make-_2 ?_2 (make-struct-field-accessor -ref_2 0 'value))))
+ (let-values (((struct:_133 make-_133 ?_133 -ref_133 -set!_133)
+ (make-struct-type
+ 'special-comment
+ #f
+ 1
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0)
+ #f
+ 'make-special-comment)))
+ (values struct:_133 make-_133 ?_133 (make-struct-field-accessor -ref_133 0 'value))))
(define-values
(struct:readtable
readtable1.1
@@ -57326,422 +56278,376 @@
readtable-char-ht
readtable-dispatch-ht
readtable-delimiter-ht)
- (let-values (((struct:_71 make-_71 ?_71 -ref_71 -set!_71)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'readtable
- #f
- 4
- 0
- #f
- (list (cons prop:authentic #t) (cons prop:readtable #t))
- (current-inspector)
- #f
- '(0 1 2 3)
- #f
- 'readtable)))))
+ (let-values (((struct:_134 make-_134 ?_134 -ref_134 -set!_134)
+ (make-struct-type
+ 'readtable
+ #f
+ 4
+ 0
+ #f
+ (list (cons prop:authentic #t) (cons prop:readtable #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3)
+ #f
+ 'readtable)))
(values
- struct:_71
- make-_71
- ?_71
- (make-struct-field-accessor -ref_71 0 'symbol-parser)
- (make-struct-field-accessor -ref_71 1 'char-ht)
- (make-struct-field-accessor -ref_71 2 'dispatch-ht)
- (make-struct-field-accessor -ref_71 3 'delimiter-ht))))
+ struct:_134
+ make-_134
+ ?_134
+ (make-struct-field-accessor -ref_134 0 'symbol-parser)
+ (make-struct-field-accessor -ref_134 1 'char-ht)
+ (make-struct-field-accessor -ref_134 2 'dispatch-ht)
+ (make-struct-field-accessor -ref_134 3 'delimiter-ht))))
(define-values
(1/make-readtable)
- (lambda (rt_0 . args_8)
+ (lambda (rt_0 . args_11)
(begin
'make-readtable
(begin
- (if (let-values (((or-part_76) (not rt_0))) (if or-part_76 or-part_76 (1/readtable? rt_0)))
+ (if (let-values (((or-part_572) (not rt_0))) (if or-part_572 or-part_572 (1/readtable? rt_0)))
(void)
- (let-values () (raise-argument-error 'make-readtable "(or/c readtable? #f)" rt_0)))
- ((letrec-values (((loop_111)
- (lambda (args_9 symbol-parser_0 char-ht_0 dispatch-ht_0 delimiter-ht_0)
+ (raise-argument-error 'make-readtable "(or/c readtable? #f)" rt_0))
+ ((letrec-values (((loop_126)
+ (lambda (args_12 symbol-parser_0 char-ht_0 dispatch-ht_0 delimiter-ht_0)
(begin
'loop
- (if (null? args_9)
- (let-values () (readtable1.1 symbol-parser_0 char-ht_0 dispatch-ht_0 delimiter-ht_0))
- (let-values ()
- (let-values (((key_96) (car args_9)))
+ (if (null? args_12)
+ (readtable1.1 symbol-parser_0 char-ht_0 dispatch-ht_0 delimiter-ht_0)
+ (let-values (((key_110) (car args_12)))
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_573) (not key_110)))
+ (if or-part_573 or-part_573 (char? key_110)))
+ (void)
+ (raise-argument-error 'make-readtable "(or/c char? #f)" key_110))
+ (values))))
(let-values ((()
(begin
- (if (let-values (((or-part_316) (not key_96)))
- (if or-part_316 or-part_316 (char? key_96)))
- (void)
- (let-values ()
- (raise-argument-error
+ (if (null? (cdr args_12))
+ (if key_110
+ (raise-arguments-error
+ 'make-readtable
+ (string-append
+ "expected 'terminating-macro, 'non-terminating-macro, 'dispatch-macro,"
+ " or character argument after character argument")
+ "character"
+ key_110)
+ (raise-arguments-error
'make-readtable
- "(or/c char? #f)"
- key_96)))
+ "expected 'non-terminating-macro after #f"))
+ (void))
(values))))
- (let-values ((()
- (begin
- (if (null? (cdr args_9))
- (let-values ()
- (if key_96
- (let-values ()
- (raise-arguments-error
- 'make-readtable
- (string-append
- "expected 'terminating-macro, 'non-terminating-macro, 'dispatch-macro,"
- " or character argument after character argument")
- "character"
- key_96))
- (let-values ()
- (raise-arguments-error
- 'make-readtable
- "expected 'non-terminating-macro after #f"))))
- (void))
- (values))))
- (let-values (((mode_16) (cadr args_9)))
- (let-values ((()
- (begin
- (if key_96
- (let-values ()
- (if (let-values (((or-part_146)
- (eq? mode_16 'terminating-macro)))
- (if or-part_146
- or-part_146
- (let-values (((or-part_317)
- (eq?
- mode_16
- 'non-terminating-macro)))
- (if or-part_317
- or-part_317
- (let-values (((or-part_318)
- (eq? mode_16 'dispatch-macro)))
- (if or-part_318
- or-part_318
- (char? mode_16)))))))
- (void)
- (let-values ()
- (raise-argument-error
- 'make-readtable
- "(or/c 'terminating-macro 'non-terminating-macro 'dispatch-macro char?)"
- mode_16))))
- (let-values ()
- (if (eq? mode_16 'non-terminating-macro)
- (void)
- (let-values ()
- (raise-arguments-error
- 'make-readtable
- "expected 'non-terminating-macro after #f")))))
- (values))))
- (let-values ((()
- (begin
- (if (null? (cddr args_9))
- (let-values ()
- (raise-arguments-error
- 'make-readtable
- (if (char? mode_16)
- "expected readtable or #f argument after character argument"
- "expected procedure argument after symbol argument")
- (if (char? mode_16) "character" "symbol")
- mode_16))
- (void))
- (values))))
- (let-values (((target_0) (caddr args_9)))
- (let-values (((rest-args_0) (cdddr args_9)))
- (if (not key_96)
- (let-values ()
+ (let-values (((mode_20) (cadr args_12)))
+ (let-values ((()
(begin
- (if (if (procedure? target_0)
- (procedure-arity-includes? target_0 6)
- #f)
- (void)
- (let-values ()
+ (if key_110
+ (if (let-values (((or-part_574)
+ (eq? mode_20 'terminating-macro)))
+ (if or-part_574
+ or-part_574
+ (let-values (((or-part_575)
+ (eq? mode_20 'non-terminating-macro)))
+ (if or-part_575
+ or-part_575
+ (let-values (((or-part_576)
+ (eq? mode_20 'dispatch-macro)))
+ (if or-part_576
+ or-part_576
+ (char? mode_20)))))))
+ (void)
(raise-argument-error
'make-readtable
- "(procedure-arity-includes/c 6)"
- target_0)))
- (loop_111
- rest-args_0
- target_0
- char-ht_0
- dispatch-ht_0
- delimiter-ht_0)))
- (if (eq? mode_16 'dispatch-macro)
- (let-values ()
- (begin
- (if (if (procedure? target_0)
- (procedure-arity-includes? target_0 6)
- #f)
+ "(or/c 'terminating-macro 'non-terminating-macro 'dispatch-macro char?)"
+ mode_20))
+ (if (eq? mode_20 'non-terminating-macro)
(void)
- (let-values ()
- (raise-argument-error
- 'make-readtable
- "(procedure-arity-includes/c 6)"
- target_0)))
- (loop_111
- rest-args_0
- symbol-parser_0
- char-ht_0
- (hash-set dispatch-ht_0 key_96 target_0)
- delimiter-ht_0)))
- (if (char? mode_16)
- (let-values ()
- (let-values ((()
- (begin
- (if (let-values (((or-part_169)
- (not target_0)))
- (if or-part_169
- or-part_169
- (1/readtable? target_0)))
- (void)
- (let-values ()
- (raise-argument-error
- 'make-readtable
- "(or/c readtable? #f)"
- target_0)))
- (values))))
- (let-values (((actual-target_0)
- (let-values (((or-part_319)
- (if target_0
- (hash-ref
- (readtable-char-ht target_0)
- mode_16
- #f)
- #f)))
- (if or-part_319 or-part_319 mode_16))))
- (let-values (((new-char-ht_0)
- (if actual-target_0
- (hash-set
- char-ht_0
- key_96
- actual-target_0)
- (hash-remove char-ht_0 key_96))))
- (let-values (((new-delimiter-ht_0)
- (hash-set
- delimiter-ht_0
- key_96
- (if target_0
- (hash-ref
- (readtable-delimiter-ht target_0)
- mode_16
- mode_16)
- mode_16))))
- (loop_111
- rest-args_0
- symbol-parser_0
- new-char-ht_0
- dispatch-ht_0
- new-delimiter-ht_0))))))
- (let-values ()
- (let-values ((()
- (begin
- (if (if (procedure? target_0)
- (procedure-arity-includes? target_0 6)
- #f)
- (void)
- (let-values ()
- (raise-argument-error
- 'make-readtable
- "(procedure-arity-includes/c 6)"
- target_0)))
- (values))))
- (let-values (((new-char-ht_1)
- (hash-set char-ht_0 key_96 target_0)))
- (let-values (((new-delimiter-ht_1)
- (hash-set
- delimiter-ht_0
- key_96
- (if (eq? mode_16 'terminating-macro)
- 'delimit
- 'no-delimit))))
- (loop_111
- rest-args_0
- symbol-parser_0
- new-char-ht_1
- dispatch-ht_0
- new-delimiter-ht_1))))))))))))))))))))))
- loop_111)
- args_8
+ (raise-arguments-error
+ 'make-readtable
+ "expected 'non-terminating-macro after #f")))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (null? (cddr args_12))
+ (raise-arguments-error
+ 'make-readtable
+ (if (char? mode_20)
+ "expected readtable or #f argument after character argument"
+ "expected procedure argument after symbol argument")
+ (if (char? mode_20) "character" "symbol")
+ mode_20)
+ (void))
+ (values))))
+ (let-values (((target_0) (caddr args_12)))
+ (let-values (((rest-args_0) (cdddr args_12)))
+ (if (not key_110)
+ (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_126
+ rest-args_0
+ target_0
+ char-ht_0
+ dispatch-ht_0
+ delimiter-ht_0))
+ (if (eq? mode_20 '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_126
+ rest-args_0
+ symbol-parser_0
+ char-ht_0
+ (hash-set dispatch-ht_0 key_110 target_0)
+ delimiter-ht_0))
+ (if (char? mode_20)
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_577) (not target_0)))
+ (if or-part_577
+ or-part_577
+ (1/readtable? target_0)))
+ (void)
+ (raise-argument-error
+ 'make-readtable
+ "(or/c readtable? #f)"
+ target_0))
+ (values))))
+ (let-values (((actual-target_0)
+ (let-values (((or-part_578)
+ (if target_0
+ (hash-ref
+ (readtable-char-ht target_0)
+ mode_20
+ #f)
+ #f)))
+ (if or-part_578 or-part_578 mode_20))))
+ (let-values (((new-char-ht_0)
+ (if actual-target_0
+ (hash-set char-ht_0 key_110 actual-target_0)
+ (hash-remove char-ht_0 key_110))))
+ (let-values (((new-delimiter-ht_0)
+ (hash-set
+ delimiter-ht_0
+ key_110
+ (if target_0
+ (hash-ref
+ (readtable-delimiter-ht target_0)
+ mode_20
+ mode_20)
+ mode_20))))
+ (loop_126
+ rest-args_0
+ symbol-parser_0
+ new-char-ht_0
+ dispatch-ht_0
+ new-delimiter-ht_0)))))
+ (let-values ((()
+ (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))
+ (values))))
+ (let-values (((new-char-ht_1)
+ (hash-set char-ht_0 key_110 target_0)))
+ (let-values (((new-delimiter-ht_1)
+ (hash-set
+ delimiter-ht_0
+ key_110
+ (if (eq? mode_20 'terminating-macro)
+ 'delimit
+ 'no-delimit))))
+ (loop_126
+ rest-args_0
+ symbol-parser_0
+ new-char-ht_1
+ dispatch-ht_0
+ new-delimiter-ht_1))))))))))))))))))))
+ loop_126)
+ args_11
(if rt_0 (readtable-symbol-parser rt_0) #f)
(if rt_0 (readtable-char-ht rt_0) '#hasheqv())
(if rt_0 (readtable-dispatch-ht rt_0) '#hasheqv())
(if rt_0 (readtable-delimiter-ht rt_0) '#hasheqv()))))))
(define-values
(*readtable-effective-char)
- (lambda (rt_1 c_71 handler_0)
+ (lambda (rt_1 c_94 handler_0)
(begin
- (let-values (((target_1) (hash-ref (readtable-char-ht rt_1) c_71 #f)))
- (if (not target_1)
- (let-values () c_71)
- (if (char? target_1) (let-values () target_1) (let-values () handler_0)))))))
+ (let-values (((target_1) (hash-ref (readtable-char-ht rt_1) c_94 #f)))
+ (if (not target_1) c_94 (if (char? target_1) target_1 handler_0))))))
(define-values
(readtable-effective-char/#)
- (lambda (rt_2 c_72)
- (begin (if (if rt_2 (hash-ref (readtable-dispatch-ht rt_2) c_72 #f) #f) (let-values () #f) (let-values () c_72)))))
+ (lambda (rt_2 c_95) (begin (if (if rt_2 (hash-ref (readtable-dispatch-ht rt_2) c_95 #f) #f) #f c_95))))
(define-values
(effective-char)
- (lambda (c_34 config_11)
+ (lambda (c_96 config_11)
(begin
- (let-values (((rt_3) (read-config-readtable config_11)) ((c_73) c_34) ((handler_1) '#\x))
- (if (let-values (((or-part_10) (not rt_3))) (if or-part_10 or-part_10 (not (char? c_73))))
- (let-values () c_73)
- (let-values () (*readtable-effective-char rt_3 c_73 handler_1)))))))
+ (let-values (((rt_3) (read-config-readtable config_11)) ((c_97) c_96) ((handler_1) '#\x))
+ (if (let-values (((or-part_579) (not rt_3))) (if or-part_579 or-part_579 (not (char? c_97))))
+ c_97
+ (*readtable-effective-char rt_3 c_97 handler_1))))))
(define-values
(readtable-handler)
- (lambda (config_12 c_74)
+ (lambda (config_12 c_98)
(begin
(let-values (((rt_4) (read-config-readtable config_12)))
(if rt_4
- (let-values (((target_2) (hash-ref (readtable-char-ht rt_4) c_74 #f)))
+ (let-values (((target_2) (hash-ref (readtable-char-ht rt_4) c_98 #f)))
(if target_2 (if (not (char? target_2)) target_2 #f) #f))
#f)))))
(define-values
(readtable-dispatch-handler)
- (lambda (config_13 c_75)
+ (lambda (config_13 c_99)
(begin
(let-values ((() (begin (force-parameters! config_13) (values))))
(let-values (((rt_5) (read-config-readtable config_13)))
- (if rt_5 (hash-ref (readtable-dispatch-ht rt_5) c_75 #f) #f))))))
+ (if rt_5 (hash-ref (readtable-dispatch-ht rt_5) c_99 #f) #f))))))
(define-values
(readtable-apply)
- (lambda (handler_2 c_76 in_4 config_14 line_3 col_2 pos_111)
+ (lambda (handler_2 c_100 in_4 config_14 line_3 col_2 pos_168)
(begin
(let-values (((for-syntax?_6) (read-config-for-syntax? config_14)))
- (let-values (((v_101)
+ (let-values (((v_352)
(if (not for-syntax?_6)
- (let-values ()
- (with-continuation-mark
- current-read-config
- config_14
- (let-values ()
- (if (procedure-arity-includes? handler_2 2)
- (handler_2 c_76 in_4)
- (handler_2 c_76 in_4 #f line_3 col_2 pos_111)))))
- (let-values ()
- (with-continuation-mark
- current-read-config
- config_14
- (let-values ()
- (handler_2 c_76 in_4 (read-config-source config_14) line_3 col_2 pos_111)))))))
- (if (1/special-comment? v_101) v_101 (coerce v_101 in_4 config_14)))))))
+ (with-continuation-mark
+ current-read-config
+ config_14
+ (if (procedure-arity-includes? handler_2 2)
+ (handler_2 c_100 in_4)
+ (handler_2 c_100 in_4 #f line_3 col_2 pos_168)))
+ (with-continuation-mark
+ current-read-config
+ config_14
+ (handler_2 c_100 in_4 (read-config-source config_14) line_3 col_2 pos_168)))))
+ (if (1/special-comment? v_352) v_352 (coerce v_352 in_4 config_14)))))))
(define-values
(1/readtable-mapping)
- (lambda (rt_6 c_77)
+ (lambda (rt_6 c_101)
(begin
'readtable-mapping
(let-values ((()
(begin
- (if (1/readtable? rt_6)
- (void)
- (let-values () (raise-argument-error 'readtable-mapping "readtable?" rt_6)))
+ (if (1/readtable? rt_6) (void) (raise-argument-error 'readtable-mapping "readtable?" rt_6))
(values))))
(let-values ((()
(begin
- (if (char? c_77) (void) (let-values () (raise-argument-error 'readtable-mapping "char?" c_77)))
+ (if (char? c_101) (void) (raise-argument-error 'readtable-mapping "char?" c_101))
(values))))
- (let-values (((handler_3) (hash-ref (readtable-char-ht rt_6) c_77 #f)))
+ (let-values (((handler_3) (hash-ref (readtable-char-ht rt_6) c_101 #f)))
(values
- (let-values (((or-part_225)
+ (let-values (((or-part_580)
(if handler_3
(if (char? handler_3)
- (let-values () handler_3)
- (if (eq? 'delimit (hash-ref (readtable-delimiter-ht rt_6) c_77 #f))
- (let-values () 'terminating-macro)
- (let-values () 'non-terminating-macro)))
+ handler_3
+ (if (eq? 'delimit (hash-ref (readtable-delimiter-ht rt_6) c_101 #f))
+ 'terminating-macro
+ 'non-terminating-macro))
#f)))
- (if or-part_225 or-part_225 c_77))
+ (if or-part_580 or-part_580 c_101))
(if (char? handler_3) #f handler_3)
- (hash-ref (readtable-dispatch-ht rt_6) c_77 #f))))))))
+ (hash-ref (readtable-dispatch-ht rt_6) c_101 #f))))))))
(define-values
(readtable-equivalent-chars)
- (lambda (rt_7 c_78)
+ (lambda (rt_7 c_102)
(begin
- (let-values (((ht_67) (readtable-char-ht rt_7)))
+ (let-values (((ht_238) (readtable-char-ht rt_7)))
(append
- (if (hash-ref ht_67 c_78 #f) null (list c_78))
+ (if (hash-ref ht_238 c_102 #f) null (list c_102))
(reverse$1
- (let-values (((ht_175) ht_67))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-in-hash ht_175)))
- ((letrec-values (((for-loop_284)
- (lambda (fold-var_17 i_35)
- (begin
- 'for-loop
- (if i_35
- (let-values (((k_55 v_112) (hash-iterate-key+value ht_175 i_35)))
- (let-values (((fold-var_301)
- (let-values (((fold-var_302) fold-var_17))
- (if (eqv? v_112 c_78)
- (let-values (((fold-var_95) fold-var_302))
- (let-values (((fold-var_198)
- (let-values ()
- (cons (let-values () k_55) fold-var_95))))
- (values fold-var_198)))
- fold-var_302))))
- (if (not #f)
- (for-loop_284 fold-var_301 (hash-iterate-next ht_175 i_35))
- fold-var_301)))
- fold-var_17)))))
- for-loop_284)
- null
- (hash-iterate-first ht_175))))))))))
+ (let-values (((fold-var_605) (let-values (((fold-var_606) null)) fold-var_606)))
+ (let-values (((ht_239) ht_238))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-in-hash ht_239))
+ ((letrec-values (((for-loop_442)
+ (lambda (fold-var_607 i_298)
+ (begin
+ 'for-loop
+ (if i_298
+ (let-values (((k_65 v_353) (hash-iterate-key+value ht_239 i_298)))
+ (let-values (((fold-var_608)
+ (if (eqv? v_353 c_102)
+ (let-values (((fold-var_609) (cons k_65 fold-var_607)))
+ (values fold-var_609))
+ fold-var_607)))
+ (if (not #f)
+ (for-loop_442 fold-var_608 (hash-iterate-next ht_239 i_298))
+ fold-var_608)))
+ fold-var_607)))))
+ for-loop_442)
+ fold-var_605
+ (hash-iterate-first ht_239)))))))))))
(define-values
(struct:special special1.1 special? special-value)
- (let-values (((struct:_72 make-_72 ?_72 -ref_72 -set!_72)
- (let-values ()
- (let-values () (make-struct-type 'special #f 1 0 #f null (current-inspector) #f '(0) #f 'special)))))
- (values struct:_72 make-_72 ?_72 (make-struct-field-accessor -ref_72 0 'value))))
+ (let-values (((struct:_135 make-_135 ?_135 -ref_135 -set!_135)
+ (make-struct-type 'special #f 1 0 #f null (current-inspector) #f '(0) #f 'special)))
+ (values struct:_135 make-_135 ?_135 (make-struct-field-accessor -ref_135 0 'value))))
(define-values
(wrap)
- (lambda (s-exp_3 in_3 config_7 rep_0)
+ (lambda (s-exp_3 in_5 config_15 rep_0)
(begin
- (let-values (((wrap_8) (read-config-wrap config_7)))
+ (let-values (((wrap_8) (read-config-wrap config_15)))
(if wrap_8
(wrap_8
s-exp_3
- (let-values (((in1_1) in_3) ((config2_1) config_7)) (port+config->srcloc.1 #f in1_1 config2_1))
+ (let-values (((in1_1) in_5) ((config2_1) config_15)) (port+config->srcloc.1 #f in1_1 config2_1))
rep_0)
s-exp_3)))))
- (define-values (consume-char) (lambda (in_5 c_48) (begin (begin (read-char in_5) (void)))))
+ (define-values (consume-char) (lambda (in_6 c_103) (begin (begin (read-char in_6) (void)))))
(define-values
(consume-char/special)
- (lambda (in_6 config_15 c_39)
- (begin (begin (read-char-or-special in_6 special1.1 (read-config-source config_15)) (void)))))
+ (lambda (in_7 config_16 c_104)
+ (begin (begin (read-char-or-special in_7 special1.1 (read-config-source config_16)) (void)))))
(define-values
(reader-error.1)
- (lambda (continuation-marks1_0 due-to2_0 end-pos4_0 who3_0 in9_0 config10_0 str11_0 new-rest_0)
+ (lambda (continuation-marks1_0 due-to2_0 end-pos4_0 who3_1 in9_0 config10_0 str11_0 new-rest_0)
(begin
'reader-error
- (let-values (((in_7) in9_0))
- (let-values (((config_16) config10_0))
+ (let-values (((in_8) in9_0))
+ (let-values (((config_17) config10_0))
(let-values (((continuation-marks_0)
(if (eq? continuation-marks1_0 unsafe-undefined)
(current-continuation-marks)
continuation-marks1_0)))
(let-values (((due-to_0) due-to2_0))
- (let-values (((who_30)
- (if (eq? who3_0 unsafe-undefined)
- (if (read-config-for-syntax? config_16) 'read-syntax 'read)
- who3_0)))
+ (let-values (((who_44)
+ (if (eq? who3_1 unsafe-undefined)
+ (if (read-config-for-syntax? config_17) 'read-syntax 'read)
+ who3_1)))
(let-values (((end-pos_3) end-pos4_0))
(let-values (((str_26) str11_0))
- (let-values (((args_10) new-rest_0))
- (let-values (((msg_0) (format "~a: ~a" who_30 (apply format str_26 args_10))))
+ (let-values (((args_13) new-rest_0))
+ (let-values (((msg_0) (format "~a: ~a" who_44 (apply format str_26 args_13))))
(let-values (((srcloc_16)
- (if in_7
- (let-values (((in19_0) in_7) ((config20_0) config_16) ((end-pos21_0) end-pos_3))
+ (if in_8
+ (let-values (((in19_0) in_8) ((config20_0) config_17) ((end-pos21_0) end-pos_3))
(port+config->srcloc.1 end-pos21_0 in19_0 config20_0))
#f)))
(raise
((if (eof-object? due-to_0)
- (let-values () exn:fail:read:eof)
- (if (not (char? due-to_0))
- (let-values () exn:fail:read:non-char)
- (let-values () exn:fail:read)))
- (let-values (((s_546)
+ exn:fail:read:eof
+ (if (not (char? due-to_0)) exn:fail:read:non-char exn:fail:read))
+ (let-values (((s_829)
(if (error-print-source-location)
(if srcloc_16 (srcloc->string srcloc_16) #f)
#f)))
- (if s_546 (string-append s_546 ": " msg_0) msg_0))
+ (if s_829 (string-append s_829 ": " msg_0) msg_0))
continuation-marks_0
(if srcloc_16 (list srcloc_16) null))))))))))))))))
(define-values
@@ -57749,41 +56655,40 @@
(lambda (due-to13_0 in15_0 config16_0 str17_0)
(begin
'bad-syntax-error
- (let-values (((in_8) in15_0))
- (let-values (((config_17) config16_0))
+ (let-values (((in_9) in15_0))
+ (let-values (((config_18) config16_0))
(let-values (((str_27) str17_0))
(let-values (((due-to_1) due-to13_0))
- (let-values ()
- (let-values (((in22_0) in_8)
- ((config23_0) config_17)
- ((due-to24_0) due-to_1)
- ((temp25_2) "bad syntax `~a`")
- ((str26_0) str_27))
- (reader-error.1
- unsafe-undefined
- due-to24_0
- #f
- unsafe-undefined
- in22_0
- config23_0
- temp25_2
- (list str26_0)))))))))))
+ (let-values (((in22_0) in_9)
+ ((config23_0) config_18)
+ ((due-to24_0) due-to_1)
+ ((temp25_2) "bad syntax `~a`")
+ ((str26_0) str_27))
+ (reader-error.1
+ unsafe-undefined
+ due-to24_0
+ #f
+ unsafe-undefined
+ in22_0
+ config23_0
+ temp25_2
+ (list str26_0))))))))))
(define-values
(catch-and-reraise-as-reader/proc)
- (lambda (in_9 config_18 thunk_9)
+ (lambda (in_10 config_19 thunk_8)
(begin
(let-values (((with-handlers-predicate27_0) exn:fail?)
((with-handlers-handler28_0)
- (lambda (exn_6)
+ (lambda (exn_5)
(begin
'with-handlers-handler28
- (let-values (((in29_0) in_9)
- ((config30_0) config_18)
- ((temp31_2) "~a")
- ((temp32_4)
- (let-values (((s_168) (exn-message exn_6)))
- (regexp-replace "^[a-z-]*: " s_168 "")))
- ((temp33_5) (exn-continuation-marks exn_6)))
+ (let-values (((in29_0) in_10)
+ ((config30_0) config_19)
+ ((temp31_3) "~a")
+ ((temp32_3)
+ (let-values (((s_830) (exn-message exn_5)))
+ (regexp-replace "^[a-z-]*: " s_830 "")))
+ ((temp33_5) (exn-continuation-marks exn_5)))
(reader-error.1
temp33_5
'#\x
@@ -57791,403 +56696,385 @@
unsafe-undefined
in29_0
config30_0
- temp31_2
- (list temp32_4)))))))
+ temp31_3
+ (list temp32_3)))))))
(let-values (((bpz_6) (continuation-mark-set-first #f break-enabled-key)))
(call-handled-body
bpz_6
- (lambda (e_86)
- (select-handler/no-breaks e_86 bpz_6 (list (cons with-handlers-predicate27_0 with-handlers-handler28_0))))
- (lambda () (thunk_9))))))))
+ (lambda (e_95)
+ (select-handler/no-breaks e_95 bpz_6 (list (cons with-handlers-predicate27_0 with-handlers-handler28_0))))
+ (lambda () (thunk_8))))))))
(define-values
(port-next-location*)
- (lambda (in_5 init-c_0)
+ (lambda (in_11 init-c_0)
(begin
(if (not init-c_0)
- (let-values () (port-next-location in_5))
- (let-values ()
- (let-values (((line_4 col_3 pos_133) (port-next-location in_5)))
- (values line_4 (if col_3 (max 0 (sub1 col_3)) #f) (if pos_133 (max 1 (sub1 pos_133)) #f))))))))
+ (port-next-location in_11)
+ (let-values (((line_4 col_3 pos_169) (port-next-location in_11)))
+ (let-values (((delta_2)
+ (if (port-counts-lines? in_11) 1 (if (char? init-c_0) (char-utf-8-length init-c_0) 1))))
+ (values line_4 (if col_3 (max 0 (- col_3 delta_2)) #f) (if pos_169 (max 1 (- pos_169 delta_2)) #f))))))))
(define-values
(read-char/skip-whitespace-and-comments)
- (lambda (init-c_1 read-one_0 in_6 config_15)
+ (lambda (init-c_1 read-one_0 in_12 config_20)
(begin
- (let-values (((rt_8) (read-config-readtable config_15)))
- (let-values (((source_3) (read-config-source config_15)))
+ (let-values (((rt_8) (read-config-readtable config_20)))
+ (let-values (((source_3) (read-config-source config_20)))
((letrec-values (((skip-loop_0)
(lambda (init-c_2)
(begin
'skip-loop
- (let-values (((c_47)
- (let-values (((or-part_0) init-c_2))
- (if or-part_0
- or-part_0
- (let-values (((in_10) in_6) ((source_4) source_3))
- (read-char-or-special in_10 special1.1 source_4))))))
+ (let-values (((c_105)
+ (let-values (((or-part_581) init-c_2))
+ (if or-part_581
+ or-part_581
+ (let-values (((in_13) in_12) ((source_4) source_3))
+ (read-char-or-special in_13 special1.1 source_4))))))
(let-values (((ec_0)
- (let-values (((rt_9) rt_8) ((c_52) c_47) ((handler_4) '#\x))
- (if (let-values (((or-part_84) (not rt_9)))
- (if or-part_84 or-part_84 (not (char? c_52))))
- (let-values () c_52)
- (let-values () (*readtable-effective-char rt_9 c_52 handler_4))))))
+ (let-values (((rt_9) rt_8) ((c_106) c_105) ((handler_4) '#\x))
+ (if (let-values (((or-part_582) (not rt_9)))
+ (if or-part_582 or-part_582 (not (char? c_106))))
+ c_106
+ (*readtable-effective-char rt_9 c_106 handler_4)))))
(if (eof-object? ec_0)
- (let-values () c_47)
+ c_105
(if (not (char? ec_0))
- (let-values ()
- (let-values (((v_46) (special-value c_47)))
- (if (if (1/special-comment? v_46)
- (not (read-config-keep-comment? config_15))
- #f)
- (let-values () (skip-loop_0 #f))
- (let-values () c_47))))
- (if (let-values (((or-part_34) (char-whitespace? ec_0)))
- (if or-part_34 or-part_34 (eqv? '#\uFEFF ec_0)))
- (let-values () (skip-loop_0 #f))
+ (let-values (((v_354) (special-value c_105)))
+ (if (if (1/special-comment? v_354)
+ (not (read-config-keep-comment? config_20))
+ #f)
+ (skip-loop_0 #f)
+ c_105))
+ (if (let-values (((or-part_583) (char-whitespace? ec_0)))
+ (if or-part_583 or-part_583 (eqv? '#\uFEFF ec_0)))
+ (skip-loop_0 #f)
(if (char=? '#\; ec_0)
- (let-values ()
- (begin
- ((letrec-values (((loop_112)
- (lambda ()
- (begin
- 'loop
- (let-values (((c_79)
- (let-values (((in_11) in_6)
- ((source_5) source_3))
- (read-char-or-special
- in_11
- special1.1
- source_5))))
- (if (let-values (((or-part_88)
- (eof-object? c_79)))
- (if or-part_88
- or-part_88
- (eqv?
- '#\newline
- (effective-char c_79 config_15))))
- (void)
- (let-values () (loop_112))))))))
- loop_112))
- (if (read-config-keep-comment? config_15)
- (result-special-comment)
- (skip-loop_0 #f))))
+ (begin
+ ((letrec-values (((loop_127)
+ (lambda ()
+ (begin
+ 'loop
+ (let-values (((c_107)
+ (let-values (((in_14) in_12)
+ ((source_5) source_3))
+ (read-char-or-special
+ in_14
+ special1.1
+ source_5))))
+ (if (let-values (((or-part_584)
+ (eof-object? c_107)))
+ (if or-part_584
+ or-part_584
+ (eqv?
+ '#\newline
+ (effective-char c_107 config_20))))
+ (void)
+ (loop_127)))))))
+ loop_127))
+ (if (read-config-keep-comment? config_20)
+ (result-special-comment)
+ (skip-loop_0 #f)))
(if (if (char=? '#\# ec_0)
(eqv?
'#\|
(readtable-effective-char/#
rt_8
- (let-values (((in_7) in_6) ((skip-count_0) 0) ((source_6) source_3))
- (let-values (((c_80)
+ (let-values (((in_15) in_12)
+ ((skip-count_0) 0)
+ ((source_6) source_3))
+ (let-values (((c_108)
(peek-char-or-special
- in_7
+ in_15
skip-count_0
'special
source_6)))
- (if (eq? c_80 'special) (special1.1 'special) c_80)))))
+ (if (eq? c_108 'special) (special1.1 'special) c_108)))))
#f)
- (let-values ()
- (begin
- (skip-pipe-comment! c_47 in_6 config_15)
- (if (read-config-keep-comment? config_15)
- (result-special-comment)
- (skip-loop_0 #f))))
+ (begin
+ (skip-pipe-comment! c_105 in_12 config_20)
+ (if (read-config-keep-comment? config_20)
+ (result-special-comment)
+ (skip-loop_0 #f)))
(if (if (char=? '#\# ec_0)
(if (eqv?
'#\!
(readtable-effective-char/#
rt_8
- (let-values (((in_12) in_6)
+ (let-values (((in_16) in_12)
((skip-count_1) 0)
((source_7) source_3))
- (let-values (((c_57)
+ (let-values (((c_109)
(peek-char-or-special
- in_12
+ in_16
skip-count_1
'special
source_7)))
- (if (eq? c_57 'special) (special1.1 'special) c_57)))))
- (let-values (((c3_3)
- (let-values (((in_13) in_6)
+ (if (eq? c_109 'special) (special1.1 'special) c_109)))))
+ (let-values (((c3_1)
+ (let-values (((in_17) in_12)
((skip-count_2) 1)
((source_8) source_3))
- (let-values (((c_81)
+ (let-values (((c_110)
(peek-char-or-special
- in_13
+ in_17
skip-count_2
'special
source_8)))
- (if (eq? c_81 'special)
+ (if (eq? c_110 'special)
(special1.1 'special)
- c_81)))))
- (let-values (((or-part_105) (eqv? '#\space c3_3)))
- (if or-part_105 or-part_105 (eqv? '#\/ c3_3))))
+ c_110)))))
+ (let-values (((or-part_585) (eqv? '#\space c3_1)))
+ (if or-part_585 or-part_585 (eqv? '#\/ c3_1))))
#f)
#f)
- (let-values ()
- (begin
- (skip-unix-line-comment! in_6 config_15)
- (if (read-config-keep-comment? config_15)
- (result-special-comment)
- (skip-loop_0 #f))))
+ (begin
+ (skip-unix-line-comment! in_12 config_20)
+ (if (read-config-keep-comment? config_20)
+ (result-special-comment)
+ (skip-loop_0 #f)))
(if (if (char=? '#\# ec_0)
(eqv?
'#\;
(readtable-effective-char/#
rt_8
- (let-values (((in_14) in_6)
+ (let-values (((in_18) in_12)
((skip-count_3) 0)
((source_9) source_3))
- (let-values (((c_82)
+ (let-values (((c_111)
(peek-char-or-special
- in_14
+ in_18
skip-count_3
'special
source_9)))
- (if (eq? c_82 'special) (special1.1 'special) c_82)))))
+ (if (eq? c_111 'special) (special1.1 'special) c_111)))))
#f)
- (let-values ()
- (let-values ((() (begin (consume-char in_6 '#\;) (values))))
- (let-values (((v_221) (read-one_0 #f in_6 config_15)))
- (begin
- (if (eof-object? v_221)
- (let-values ()
- (let-values (((in1_2) in_6)
- ((config2_2) config_15)
- ((v3_0) v_221)
- ((temp4_3)
- "expected a commented-out element for `~a;`, but found end-of-file")
- ((ec5_0) ec_0))
- (reader-error.1
- unsafe-undefined
- v3_0
- #f
- unsafe-undefined
- in1_2
- config2_2
- temp4_3
- (list ec5_0))))
- (void))
- (if (read-config-keep-comment? config_15)
- (result-special-comment)
- (skip-loop_0 #f))))))
- (let-values () c_47))))))))))))))
+ (let-values ((() (begin (consume-char in_12 '#\;) (values))))
+ (let-values (((v_355) (read-one_0 #f in_12 config_20)))
+ (begin
+ (if (eof-object? v_355)
+ (let-values (((in1_2) in_12)
+ ((config2_2) config_20)
+ ((v3_0) v_355)
+ ((temp4_3)
+ "expected a commented-out element for `~a;`, but found end-of-file")
+ ((ec5_0) ec_0))
+ (reader-error.1
+ unsafe-undefined
+ v3_0
+ #f
+ unsafe-undefined
+ in1_2
+ config2_2
+ temp4_3
+ (list ec5_0)))
+ (void))
+ (if (read-config-keep-comment? config_20)
+ (result-special-comment)
+ (skip-loop_0 #f)))))
+ c_105)))))))))))))
skip-loop_0)
init-c_1))))))
(define-values (result-special-comment) (lambda () (begin (special1.1 (1/make-special-comment #f)))))
(define-values
(skip-pipe-comment!)
- (lambda (init-c_3 in_15 config_19)
+ (lambda (init-c_3 in_19 config_21)
(begin
- (let-values (((source_10) (read-config-source config_19)))
- (let-values (((line_5 col_4 pos_118) (port-next-location in_15)))
+ (let-values (((source_10) (read-config-source config_21)))
+ (let-values (((line_5 col_4 pos_170) (port-next-location in_19)))
(begin
- (consume-char in_15 '#\|)
- ((letrec-values (((loop_113)
+ (consume-char in_19 '#\|)
+ ((letrec-values (((loop_128)
(lambda (prev-c_0 depth_9)
(begin
'loop
- (let-values (((c_36)
- (let-values (((in_16) in_15) ((source_11) source_10))
- (read-char-or-special in_16 special1.1 source_11))))
- (if (eof-object? c_36)
- (let-values ()
- (let-values (((in6_0) in_15)
- ((temp7_6) (reading-at config_19 line_5 col_4 pos_118))
- ((c8_1) c_36)
- ((temp9_5) "end of file in `#|` comment"))
- (reader-error.1
- unsafe-undefined
- c8_1
- #f
- unsafe-undefined
- in6_0
- temp7_6
- temp9_5
- (list))))
- (if (not (char? c_36))
- (let-values () (loop_113 #f depth_9))
- (if (if (char=? '#\| c_36) (eqv? prev-c_0 '#\#) #f)
- (let-values () (loop_113 #f (add1 depth_9)))
- (if (if (char=? '#\# c_36) (eqv? prev-c_0 '#\|) #f)
- (let-values ()
- (if (positive? depth_9)
- (let-values () (loop_113 #f (sub1 depth_9)))
- (void)))
- (let-values () (loop_113 c_36 depth_9)))))))))))
- loop_113)
+ (let-values (((c_112)
+ (let-values (((in_20) in_19) ((source_11) source_10))
+ (read-char-or-special in_20 special1.1 source_11))))
+ (if (eof-object? c_112)
+ (let-values (((in6_0) in_19)
+ ((temp7_8) (reading-at config_21 line_5 col_4 pos_170))
+ ((c8_1) c_112)
+ ((temp9_5) "end of file in `#|` comment"))
+ (reader-error.1
+ unsafe-undefined
+ c8_1
+ #f
+ unsafe-undefined
+ in6_0
+ temp7_8
+ temp9_5
+ (list)))
+ (if (not (char? c_112))
+ (loop_128 #f depth_9)
+ (if (if (char=? '#\| c_112) (eqv? prev-c_0 '#\#) #f)
+ (loop_128 #f (add1 depth_9))
+ (if (if (char=? '#\# c_112) (eqv? prev-c_0 '#\|) #f)
+ (if (positive? depth_9) (loop_128 #f (sub1 depth_9)) (void))
+ (loop_128 c_112 depth_9))))))))))
+ loop_128)
#f
0)))))))
(define-values
(skip-unix-line-comment!)
- (lambda (in_17 config_20)
+ (lambda (in_21 config_22)
(begin
- ((letrec-values (((loop_37)
+ ((letrec-values (((loop_129)
(lambda (backslash?_0)
(begin
'loop
- (let-values (((c_83)
- (let-values (((in_18) in_17) ((source_12) (read-config-source config_20)))
- (read-char-or-special in_18 special1.1 source_12))))
- (if (eof-object? c_83)
- (let-values () (void))
- (if (not (char? c_83))
- (let-values () (loop_37 #f))
- (if (char=? c_83 '#\newline)
- (let-values () (if backslash?_0 (let-values () (loop_37 #f)) (void)))
- (if (char=? c_83 '#\\)
- (let-values () (loop_37 #t))
- (let-values () (loop_37 #f)))))))))))
- loop_37)
+ (let-values (((c_113)
+ (let-values (((in_22) in_21) ((source_12) (read-config-source config_22)))
+ (read-char-or-special in_22 special1.1 source_12))))
+ (if (eof-object? c_113)
+ (void)
+ (if (not (char? c_113))
+ (loop_129 #f)
+ (if (char=? c_113 '#\newline)
+ (if backslash?_0 (loop_129 #f) (void))
+ (if (char=? c_113 '#\\) (loop_129 #t) (loop_129 #f))))))))))
+ loop_129)
#f))))
(define-values
(special-comment-via-readtable?)
- (lambda (c_84 read-one_1 in_19 config_21)
+ (lambda (c_114 read-one_1 in_23 config_23)
(begin
- (let-values (((v_103)
- (if (if (char? c_84)
+ (let-values (((v_356)
+ (if (if (char? c_114)
(let-values (((ec_1)
- (let-values (((rt_10) (read-config-readtable config_21))
- ((c_85) c_84)
+ (let-values (((rt_10) (read-config-readtable config_23))
+ ((c_115) c_114)
((handler_5) #f))
- (if (let-values (((or-part_273) (not rt_10)))
- (if or-part_273 or-part_273 (not (char? c_85))))
- (let-values () c_85)
- (let-values () (*readtable-effective-char rt_10 c_85 handler_5))))))
- (let-values (((or-part_40) (not ec_1)))
- (if or-part_40
- or-part_40
+ (if (let-values (((or-part_586) (not rt_10)))
+ (if or-part_586 or-part_586 (not (char? c_115))))
+ c_115
+ (*readtable-effective-char rt_10 c_115 handler_5)))))
+ (let-values (((or-part_587) (not ec_1)))
+ (if or-part_587
+ or-part_587
(if (char=? ec_1 '#\#)
- (let-values (((c2_5) (peek-char in_19)))
- (if (char? c2_5)
- (not (readtable-effective-char/# (read-config-readtable config_21) c2_5))
+ (let-values (((c2_2) (peek-char in_23)))
+ (if (char? c2_2)
+ (not (readtable-effective-char/# (read-config-readtable config_23) c2_2))
#f))
#f))))
#f)
- (let-values () (read-one_1 c_84 in_19 (keep-comment config_21)))
- (let-values () c_84))))
- (if (1/special-comment? v_103) v_103 #f)))))
+ (read-one_1 c_114 in_23 (keep-comment config_23))
+ c_114)))
+ (if (1/special-comment? v_356) v_356 #f)))))
(define-values
(readtable-char-delimiter?)
- (lambda (rt_11 c_48 config_7)
+ (lambda (rt_11 c_116 config_24)
(begin
(let-values (((dc_0)
- (let-values (((or-part_3) (if rt_11 (hash-ref (readtable-delimiter-ht rt_11) c_48 #f) #f)))
- (if or-part_3 or-part_3 c_48))))
+ (let-values (((or-part_588) (if rt_11 (hash-ref (readtable-delimiter-ht rt_11) c_116 #f) #f)))
+ (if or-part_588 or-part_588 c_116))))
(if (eq? dc_0 'no-delimit)
- (let-values () #f)
+ #f
(if (not (char? dc_0))
- (let-values () #t)
- (let-values ()
- (let-values (((or-part_31) (char-whitespace? dc_0)))
- (if or-part_31
- or-part_31
- (let-values (((or-part_71) (char=? dc_0 '#\()))
- (if or-part_71
- or-part_71
- (let-values (((or-part_11) (char=? dc_0 '#\))))
- (if or-part_11
- or-part_11
- (let-values (((or-part_32) (char=? dc_0 '#\[)))
- (if or-part_32
- or-part_32
- (let-values (((or-part_33) (char=? dc_0 '#\])))
- (if or-part_33
- or-part_33
- (let-values (((or-part_0) (char=? dc_0 '#\{)))
- (if or-part_0
- or-part_0
- (let-values (((or-part_72) (char=? dc_0 '#\})))
- (if or-part_72
- or-part_72
- (let-values (((or-part_13) (char=? dc_0 '#\')))
- (if or-part_13
- or-part_13
- (let-values (((or-part_14) (char=? dc_0 '#\`)))
- (if or-part_14
- or-part_14
- (let-values (((or-part_83) (char=? dc_0 '#\,)))
- (if or-part_83
- or-part_83
- (let-values (((or-part_15) (char=? dc_0 '#\;)))
- (if or-part_15
- or-part_15
- (let-values (((or-part_73) (char=? dc_0 '#\")))
- (if or-part_73
- or-part_73
- (let-values (((or-part_84) (char=? dc_0 '#\uFEFF)))
- (if or-part_84
- or-part_84
- (if (char=? dc_0 '#\.)
- (check-parameter 1/read-cdot config_7)
- #f))))))))))))))))))))))))))))))))))
+ #t
+ (let-values (((or-part_589) (char-whitespace? dc_0)))
+ (if or-part_589
+ or-part_589
+ (let-values (((or-part_590) (char=? dc_0 '#\()))
+ (if or-part_590
+ or-part_590
+ (let-values (((or-part_591) (char=? dc_0 '#\))))
+ (if or-part_591
+ or-part_591
+ (let-values (((or-part_592) (char=? dc_0 '#\[)))
+ (if or-part_592
+ or-part_592
+ (let-values (((or-part_593) (char=? dc_0 '#\])))
+ (if or-part_593
+ or-part_593
+ (let-values (((or-part_594) (char=? dc_0 '#\{)))
+ (if or-part_594
+ or-part_594
+ (let-values (((or-part_595) (char=? dc_0 '#\})))
+ (if or-part_595
+ or-part_595
+ (let-values (((or-part_596) (char=? dc_0 '#\')))
+ (if or-part_596
+ or-part_596
+ (let-values (((or-part_597) (char=? dc_0 '#\`)))
+ (if or-part_597
+ or-part_597
+ (let-values (((or-part_598) (char=? dc_0 '#\,)))
+ (if or-part_598
+ or-part_598
+ (let-values (((or-part_599) (char=? dc_0 '#\;)))
+ (if or-part_599
+ or-part_599
+ (let-values (((or-part_600) (char=? dc_0 '#\")))
+ (if or-part_600
+ or-part_600
+ (let-values (((or-part_601) (char=? dc_0 '#\uFEFF)))
+ (if or-part_601
+ or-part_601
+ (if (char=? dc_0 '#\.)
+ (check-parameter 1/read-cdot config_24)
+ #f)))))))))))))))))))))))))))))))))
(define-values
(char-delimiter?)
- (lambda (c_86 config_22) (begin (readtable-char-delimiter? (read-config-readtable config_22) c_86 config_22))))
+ (lambda (c_117 config_25) (begin (readtable-char-delimiter? (read-config-readtable config_25) c_117 config_25))))
(define-values
(char-closer?)
- (lambda (ec_2 config_8)
+ (lambda (ec_2 config_26)
(begin
(if (not (eof-object? ec_2))
- (let-values (((or-part_2) (char=? ec_2 '#\))))
- (if or-part_2
- or-part_2
- (let-values (((or-part_12) (char=? ec_2 '#\]))) (if or-part_12 or-part_12 (char=? ec_2 '#\})))))
+ (let-values (((or-part_602) (char=? ec_2 '#\))))
+ (if or-part_602
+ or-part_602
+ (let-values (((or-part_603) (char=? ec_2 '#\]))) (if or-part_603 or-part_603 (char=? ec_2 '#\})))))
#f))))
- (define-values (closer-name) (lambda (c_39 config_23) (begin (effective-char-names c_39 config_23 "closer"))))
- (define-values (opener-name) (lambda (c_61 config_24) (begin (effective-char-names c_61 config_24 "opener"))))
+ (define-values (closer-name) (lambda (c_118 config_27) (begin (effective-char-names c_118 config_27 "closer"))))
+ (define-values (opener-name) (lambda (c_119 config_28) (begin (effective-char-names c_119 config_28 "opener"))))
(define-values
(effective-char-names)
- (lambda (c_47 config_25 fallback-str_0)
+ (lambda (c_120 config_29 fallback-str_0)
(begin
- (let-values (((rt_12) (read-config-readtable config_25)))
+ (let-values (((rt_12) (read-config-readtable config_29)))
(if (not rt_12)
- (let-values () (format "`~a`" c_47))
- (let-values ()
- (let-values (((cs_1) (readtable-equivalent-chars rt_12 c_47)))
- (if (null? cs_1)
- (let-values () fallback-str_0)
- (if (null? (cdr cs_1))
- (let-values () (format "`~a`" (car cs_1)))
- (if (null? (cddr cs_1))
- (let-values () (format "`~a` or `~a`" (car cs_1) (cadr cs_1)))
- (let-values ()
- (apply
- string-append
- ((letrec-values (((loop_2)
- (lambda (cs_2)
- (begin
- 'loop
- (if (null? (cdr cs_2))
- (let-values () (list (format "or `~a`" (car cs_2))))
- (let-values ()
- (cons (format "`~a`, " (car cs_2)) (loop_2 (cdr cs_2)))))))))
- loop_2)
- cs_1)))))))))))))
+ (format "`~a`" c_120)
+ (let-values (((cs_1) (readtable-equivalent-chars rt_12 c_120)))
+ (if (null? cs_1)
+ fallback-str_0
+ (if (null? (cdr cs_1))
+ (format "`~a`" (car cs_1))
+ (if (null? (cddr cs_1))
+ (format "`~a` or `~a`" (car cs_1) (cadr cs_1))
+ (apply
+ string-append
+ ((letrec-values (((loop_130)
+ (lambda (cs_2)
+ (begin
+ 'loop
+ (if (null? (cdr cs_2))
+ (list (format "or `~a`" (car cs_2)))
+ (cons (format "`~a`, " (car cs_2)) (loop_130 (cdr cs_2))))))))
+ loop_130)
+ cs_1)))))))))))
(define-values
(closer->opener)
- (lambda (c_52)
+ (lambda (c_121)
(begin
- (let-values (((tmp_39) c_52))
- (if (equal? tmp_39 '#\))
- (let-values () '#\()
- (if (equal? tmp_39 '#\])
- (let-values () '#\[)
- (if (equal? tmp_39 '#\}) (let-values () '#\{) (let-values () c_52))))))))
- (define-values (dot-name) (lambda (config_26) (begin "`.`")))
+ (let-values (((tmp_42) c_121))
+ (if (equal? tmp_42 '#\)) '#\( (if (equal? tmp_42 '#\]) '#\[ (if (equal? tmp_42 '#\}) '#\{ c_121)))))))
+ (define-values (dot-name) (lambda (config_30) (begin "`.`")))
(define-values
(all-openers-str)
- (lambda (config_27)
- (begin
- (let-values (((p_10) (opener-name '#\( config_27)))
- (let-values (((s_547)
- (if (check-parameter 1/read-square-bracket-as-paren config_27) (opener-name '#\[ config_27) #f)))
- (let-values (((c_79)
- (if (check-parameter 1/read-curly-brace-as-paren config_27) (opener-name '#\{ config_27) #f)))
- (if (if s_547 c_79 #f)
- (let-values () (format "~a, ~a, or ~a" p_10 s_547 c_79))
- (if (let-values (((or-part_86) s_547)) (if or-part_86 or-part_86 c_79))
- (let-values ()
- (format "~a or ~a" p_10 (let-values (((or-part_75) s_547)) (if or-part_75 or-part_75 c_79))))
- (let-values () p_10)))))))))
+ (lambda (config_31)
+ (begin
+ (let-values (((p_103) (opener-name '#\( config_31)))
+ (let-values (((s_831)
+ (if (check-parameter 1/read-square-bracket-as-paren config_31) (opener-name '#\[ config_31) #f)))
+ (let-values (((c_122)
+ (if (check-parameter 1/read-curly-brace-as-paren config_31) (opener-name '#\{ config_31) #f)))
+ (if (if s_831 c_122 #f)
+ (format "~a, ~a, or ~a" p_103 s_831 c_122)
+ (if (let-values (((or-part_604) s_831)) (if or-part_604 or-part_604 c_122))
+ (format "~a or ~a" p_103 (let-values (((or-part_605) s_831)) (if or-part_605 or-part_605 c_122)))
+ p_103))))))))
(define-values
(struct:accum-string
accum-string1.1
@@ -58196,94 +57083,88 @@
accum-string-str
set-accum-string-pos!
set-accum-string-str!)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'accum-string
- #f
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '()
- #f
- 'accum-string)))))
+ (let-values (((struct:_136 make-_136 ?_136 -ref_136 -set!_136)
+ (make-struct-type
+ 'accum-string
+ #f
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '()
+ #f
+ 'accum-string)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'pos)
- (make-struct-field-accessor -ref_2 1 'str)
- (make-struct-field-mutator -set!_2 0 'pos)
- (make-struct-field-mutator -set!_2 1 'str))))
+ struct:_136
+ make-_136
+ ?_136
+ (make-struct-field-accessor -ref_136 0 'pos)
+ (make-struct-field-accessor -ref_136 1 'str)
+ (make-struct-field-mutator -set!_136 0 'pos)
+ (make-struct-field-mutator -set!_136 1 'str))))
(define-values
(accum-string-init!)
- (lambda (config_9)
+ (lambda (config_32)
(begin
- (let-values (((st_1) (read-config-st config_9)))
- (let-values (((a_62) (read-config-state-accum-str st_1)))
- (if a_62
- (let-values () (begin (set-read-config-state-accum-str! st_1 #f) (set-accum-string-pos! a_62 0) a_62))
- (let-values () (accum-string1.1 0 (make-string 32)))))))))
+ (let-values (((st_1) (read-config-st config_32)))
+ (let-values (((a_68) (read-config-state-accum-str st_1)))
+ (if a_68
+ (begin (set-read-config-state-accum-str! st_1 #f) (set-accum-string-pos! a_68 0) a_68)
+ (accum-string1.1 0 (make-string 32))))))))
(define-values
(accum-string-add!)
- (lambda (a_63 c_31)
+ (lambda (a_69 c_123)
(begin
- (let-values (((pos_134) (accum-string-pos a_63)))
- (let-values (((str_28) (accum-string-str a_63)))
+ (let-values (((pos_171) (accum-string-pos a_69)))
+ (let-values (((str_28) (accum-string-str a_69)))
(let-values (((str2_0)
- (if (fx< pos_134 (string-length str_28))
- (let-values () str_28)
- (let-values ()
- (let-values (((str2_1) (make-string (fx* (string-length str_28) 2))))
- (begin (string-copy! str2_1 0 str_28) (set-accum-string-str! a_63 str2_1) str2_1))))))
- (begin (string-set! str2_0 pos_134 c_31) (set-accum-string-pos! a_63 (fx+ 1 pos_134)))))))))
- (define-values (accum-string-count) (lambda (a_64) (begin (accum-string-pos a_64))))
- (define-values (set-accum-string-count!) (lambda (a_65 pos_135) (begin (set-accum-string-pos! a_65 pos_135))))
+ (if (fx< pos_171 (string-length str_28))
+ str_28
+ (let-values (((str2_1) (make-string (fx* (string-length str_28) 2))))
+ (begin (string-copy! str2_1 0 str_28) (set-accum-string-str! a_69 str2_1) str2_1)))))
+ (begin (string-set! str2_0 pos_171 c_123) (set-accum-string-pos! a_69 (fx+ 1 pos_171)))))))))
+ (define-values (accum-string-count) (lambda (a_70) (begin (accum-string-pos a_70))))
+ (define-values (set-accum-string-count!) (lambda (a_71 pos_172) (begin (set-accum-string-pos! a_71 pos_172))))
(define-values
(accum-string-convert!)
- (lambda (a_66 convert_1 start-pos_8)
+ (lambda (a_72 convert_1 start-pos_8)
(begin
- (let-values (((str_29) (accum-string-str a_66)))
- (let-values (((s_14) (convert_1 (substring str_29 start-pos_8 (accum-string-pos a_66)))))
- (let-values (((len_64) (string-length s_14)))
+ (let-values (((str_29) (accum-string-str a_72)))
+ (let-values (((s_832) (convert_1 (substring str_29 start-pos_8 (accum-string-pos a_72)))))
+ (let-values (((len_71) (string-length s_832)))
(begin
- (if (fx< (fx+ len_64 start-pos_8) (string-length str_29))
+ (if (fx< (fx+ len_71 start-pos_8) (string-length str_29))
(void)
- (let-values ()
- (let-values (((str2_2) (make-string (fx+ start-pos_8 len_64))))
- (begin (string-copy! str2_2 0 str_29 0 start-pos_8) (set-accum-string-str! a_66 str2_2)))))
- (string-copy! (accum-string-str a_66) start-pos_8 s_14)
- (set-accum-string-pos! a_66 (fx+ start-pos_8 len_64)))))))))
+ (let-values (((str2_2) (make-string (fx+ start-pos_8 len_71))))
+ (begin (string-copy! str2_2 0 str_29 0 start-pos_8) (set-accum-string-str! a_72 str2_2))))
+ (string-copy! (accum-string-str a_72) start-pos_8 s_832)
+ (set-accum-string-pos! a_72 (fx+ start-pos_8 len_71)))))))))
(define-values
(accum-string-get!.1)
(lambda (start-pos2_0 a4_0 config5_0)
(begin
'accum-string-get!
- (let-values (((a_67) a4_0))
- (let-values (((config_28) config5_0))
+ (let-values (((a_73) a4_0))
+ (let-values (((config_33) config5_0))
(let-values (((start-pos_9) start-pos2_0))
- (let-values ()
- (let-values (((s_523) (substring (accum-string-str a_67) start-pos_9 (accum-string-pos a_67))))
- (begin (accum-string-abandon! a_67 config_28) s_523)))))))))
+ (let-values (((s_833) (substring (accum-string-str a_73) start-pos_9 (accum-string-pos a_73))))
+ (begin (accum-string-abandon! a_73 config_33) s_833))))))))
(define-values
(accum-string-get-bytes!.1)
(lambda (start-pos7_0 a9_0 config10_1)
(begin
'accum-string-get-bytes!
- (let-values (((a_68) a9_0))
- (let-values (((config_29) config10_1))
+ (let-values (((a_74) a9_0))
+ (let-values (((config_34) config10_1))
(let-values (((start-pos_10) start-pos7_0))
- (let-values ()
- (let-values (((bstr_23)
- (string->bytes/latin-1 (accum-string-str a_68) #f start-pos_10 (accum-string-pos a_68))))
- (begin (accum-string-abandon! a_68 config_29) bstr_23)))))))))
+ (let-values (((bstr_23)
+ (string->bytes/latin-1 (accum-string-str a_74) #f start-pos_10 (accum-string-pos a_74))))
+ (begin (accum-string-abandon! a_74 config_34) bstr_23))))))))
(define-values
(accum-string-abandon!)
- (lambda (a_69 config_30) (begin (set-read-config-state-accum-str! (read-config-st config_30) a_69))))
+ (lambda (a_75 config_35) (begin (set-read-config-state-accum-str! (read-config-st config_35) a_75))))
(define-values
(struct:indentation
indentation1.1
@@ -58302,131 +57183,120 @@
set-indentation-suspicious-line!
set-indentation-max-indent!
set-indentation-suspicious-quote!)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type 'indentation #f 8 0 #f null (current-inspector) #f '(0 3) #f 'indentation)))))
+ (let-values (((struct:_137 make-_137 ?_137 -ref_137 -set!_137)
+ (make-struct-type 'indentation #f 8 0 #f null (current-inspector) #f '(0 3) #f 'indentation)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'closer)
- (make-struct-field-accessor -ref_2 1 'suspicious-closer)
- (make-struct-field-accessor -ref_2 2 'multiline?)
- (make-struct-field-accessor -ref_2 3 'start-line)
- (make-struct-field-accessor -ref_2 4 'last-line)
- (make-struct-field-accessor -ref_2 5 'suspicious-line)
- (make-struct-field-accessor -ref_2 6 'max-indent)
- (make-struct-field-accessor -ref_2 7 'suspicious-quote)
- (make-struct-field-mutator -set!_2 1 'suspicious-closer)
- (make-struct-field-mutator -set!_2 2 'multiline?)
- (make-struct-field-mutator -set!_2 4 'last-line)
- (make-struct-field-mutator -set!_2 5 'suspicious-line)
- (make-struct-field-mutator -set!_2 6 'max-indent)
- (make-struct-field-mutator -set!_2 7 'suspicious-quote))))
+ struct:_137
+ make-_137
+ ?_137
+ (make-struct-field-accessor -ref_137 0 'closer)
+ (make-struct-field-accessor -ref_137 1 'suspicious-closer)
+ (make-struct-field-accessor -ref_137 2 'multiline?)
+ (make-struct-field-accessor -ref_137 3 'start-line)
+ (make-struct-field-accessor -ref_137 4 'last-line)
+ (make-struct-field-accessor -ref_137 5 'suspicious-line)
+ (make-struct-field-accessor -ref_137 6 'max-indent)
+ (make-struct-field-accessor -ref_137 7 'suspicious-quote)
+ (make-struct-field-mutator -set!_137 1 'suspicious-closer)
+ (make-struct-field-mutator -set!_137 2 'multiline?)
+ (make-struct-field-mutator -set!_137 4 'last-line)
+ (make-struct-field-mutator -set!_137 5 'suspicious-line)
+ (make-struct-field-mutator -set!_137 6 'max-indent)
+ (make-struct-field-mutator -set!_137 7 'suspicious-quote))))
(define-values
(make-indentation)
- (lambda (closer_0 in_20 config_31)
+ (lambda (closer_0 in_24 config_36)
(begin
- (let-values (((line_6 col_5 pos_134) (port-next-location in_20)))
+ (let-values (((line_6 col_5 pos_173) (port-next-location in_24)))
(indentation1.1 closer_0 #f #f line_6 line_6 #f (if col_5 (add1 col_5) #f) #f)))))
(define-values
(track-indentation!)
- (lambda (config_32 line_7 col_6)
+ (lambda (config_37 line_7 col_6)
(begin
- (let-values (((indts_0) (read-config-indentations config_32)))
+ (let-values (((indts_0) (read-config-indentations config_37)))
(let-values (((indt_0) (if (pair? indts_0) (car indts_0) #f)))
(if (if indt_0
(if line_7 (if (indentation-last-line indt_0) (> line_7 (indentation-last-line indt_0)) #f) #f)
#f)
- (let-values ()
- (begin
- (set-indentation-last-line! indt_0 line_7)
- (set-indentation-multiline?! indt_0 #t)
- (if (>= col_6 (indentation-max-indent indt_0))
- (let-values () (set-indentation-max-indent! indt_0 col_6))
- (let-values ()
- (if (indentation-suspicious-line indt_0)
- (void)
- (let-values ()
- (begin
- (set-indentation-suspicious-closer! indt_0 (indentation-closer indt_0))
- (set-indentation-suspicious-line! indt_0 line_7))))))))
+ (begin
+ (set-indentation-last-line! indt_0 line_7)
+ (set-indentation-multiline?! indt_0 #t)
+ (if (>= col_6 (indentation-max-indent indt_0))
+ (set-indentation-max-indent! indt_0 col_6)
+ (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_7)))))
(void)))))))
(define-values
(indentation-possible-cause)
- (lambda (config_26)
+ (lambda (config_38)
(begin
- (let-values (((indt_1) (car (read-config-indentations config_26))))
+ (let-values (((indt_1) (car (read-config-indentations config_38))))
(if (indentation-suspicious-line indt_1)
- (let-values ()
- (format
- "\n possible cause: indentation suggests a missing ~a before line ~a"
- (closer-name (indentation-suspicious-closer indt_1) config_26)
- (indentation-suspicious-line indt_1)))
- (let-values () ""))))))
+ (format
+ "\n possible cause: indentation suggests a missing ~a before line ~a"
+ (closer-name (indentation-suspicious-closer indt_1) config_38)
+ (indentation-suspicious-line indt_1))
+ "")))))
(define-values
(indentation-unexpected-closer-message)
- (lambda (ec_3 c_62 config_33)
+ (lambda (ec_3 c_124 config_39)
(begin
- (let-values (((indts_1) (read-config-indentations config_33)))
+ (let-values (((indts_1) (read-config-indentations config_39)))
(if (null? indts_1)
- (let-values () (format "unexpected `~a`" c_62))
- (let-values ()
- (let-values (((indt_2) (car indts_1)))
- (string-append
- (if (char=? ec_3 (indentation-closer indt_2))
- (let-values () (format "unexpected `~a`" c_62))
- (let-values ()
- (let-values (((missing_2)
- (let-values (((or-part_308)
- (let-values (((lst_193) (cdr indts_1)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_193)))
- ((letrec-values (((for-loop_203)
- (lambda (result_125 lst_290)
- (begin
- 'for-loop
- (if (pair? lst_290)
- (let-values (((indt_3) (unsafe-car lst_290))
- ((rest_99)
- (unsafe-cdr lst_290)))
- (let-values (((result_127)
- (let-values ()
- (let-values (((result_128)
- (let-values ()
- (let-values ()
- (if (char=?
- ec_3
- (indentation-closer
- indt_3))
- "missing"
- #f)))))
- (values result_128)))))
- (if (if (not
- ((lambda x_98 result_127)
- indt_3))
- (not #f)
- #f)
- (for-loop_203 result_127 rest_99)
- result_127)))
- result_125)))))
- for-loop_203)
- #f
- lst_193)))))
- (if or-part_308 or-part_308 "expected"))))
- (let-values (((opener-str_0) (opener-name (closer->opener (indentation-closer indt_2)) config_33)))
- (format
- "~a ~a to close ~a, found instead `~a`"
- missing_2
- (closer-name (indentation-closer indt_2) config_33)
- (if (indentation-multiline? indt_2)
- (let-values () (format "~a on line ~a" opener-str_0 (indentation-start-line indt_2)))
- (let-values () (format "preceding ~a" opener-str_0)))
- c_62)))))
- (indentation-possible-cause config_33)))))))))
+ (format "unexpected `~a`" c_124)
+ (let-values (((indt_2) (car indts_1)))
+ (string-append
+ (if (char=? ec_3 (indentation-closer indt_2))
+ (format "unexpected `~a`" c_124)
+ (let-values (((missing_2)
+ (let-values (((or-part_606)
+ (let-values (((result_244) (let-values (((result_245) #f)) result_245)))
+ (let-values (((lst_534) (cdr indts_1)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_534))
+ ((letrec-values (((for-loop_443)
+ (lambda (result_246 lst_535)
+ (begin
+ 'for-loop
+ (if (pair? lst_535)
+ (let-values (((indt_3) (unsafe-car lst_535))
+ ((rest_263) (unsafe-cdr lst_535)))
+ (let-values (((result_247)
+ (let-values (((result_248)
+ (if (char=?
+ ec_3
+ (indentation-closer
+ indt_3))
+ "missing"
+ #f)))
+ (values result_248))))
+ (if (if (not
+ ((lambda x_106 result_247)
+ indt_3))
+ (not #f)
+ #f)
+ (for-loop_443 result_247 rest_263)
+ result_247)))
+ result_246)))))
+ for-loop_443)
+ result_244
+ lst_534))))))
+ (if or-part_606 or-part_606 "expected"))))
+ (let-values (((opener-str_0) (opener-name (closer->opener (indentation-closer indt_2)) config_39)))
+ (format
+ "~a ~a to close ~a, found instead `~a`"
+ missing_2
+ (closer-name (indentation-closer indt_2) config_39)
+ (if (indentation-multiline? indt_2)
+ (format "~a on line ~a" opener-str_0 (indentation-start-line indt_2))
+ (format "preceding ~a" opener-str_0))
+ c_124))))
+ (indentation-possible-cause config_39))))))))
(define-values
(read-unwrapped-sequence.1)
(lambda (dot-mode2_0
@@ -58446,7 +57316,7 @@
(let-values (((opener-c_0) opener-c12_0))
(let-values (((opener_0) opener13_0))
(let-values (((closer_1) closer14_0))
- (let-values (((in_21) in15_1))
+ (let-values (((in_25) in15_1))
(let-values (((seq-config_0) seq-config16_0))
(let-values (((elem-config_0)
(if (eq? elem-config1_0 unsafe-undefined)
@@ -58460,485 +57330,457 @@
whitespace-read-one4_0)))
(let-values (((first-read-one_0)
(if (eq? first-read-one5_0 unsafe-undefined) read-one_2 first-read-one5_0)))
- (let-values ()
- (let-values (((head_1) #f))
- (let-values (((indentation_0) (make-indentation closer_1 in_21 seq-config_0)))
- (let-values (((config_34)
- (let-values (((v_66) elem-config_0))
- (let-values (((the-struct_64) v_66))
- (if (read-config/outer? the-struct_64)
- (let-values (((indentations18_0)
- (cons
- indentation_0
- (read-config-indentations seq-config_0)))
- ((inner19_0) (read-config/outer-inner v_66)))
- (read-config/outer1.1
- inner19_0
- (read-config/outer-wrap the-struct_64)
- (read-config/outer-line the-struct_64)
- (read-config/outer-col the-struct_64)
- (read-config/outer-pos the-struct_64)
- indentations18_0
- (read-config/outer-keep-comment? the-struct_64)))
- (raise-argument-error
- 'struct-copy
- "read-config/outer?"
- the-struct_64))))))
- (let-values (((open-end-line_0 open-end-col_0 open-end-pos_0)
- (port-next-location in_21)))
- (let-values (((config/keep-comment_0) (keep-comment config_34)))
- (let-values (((read-one/not-eof_0)
- (lambda (init-c_4 read-one_3 config_35)
- (begin
- 'read-one/not-eof
- (let-values (((e_87) (read-one_3 init-c_4 in_21 config_35)))
- (begin
- (if (eof-object? e_87)
- (let-values ()
- (let-values (((in20_0) in_21)
- ((seq-config21_0) seq-config_0)
- ((e22_0) e_87)
- ((open-end-pos23_0) open-end-pos_0)
- ((temp24_4)
- "expected a ~a to close `~a`~a")
- ((temp25_3)
- (closer-name closer_1 config_35))
- ((opener-c26_0) opener-c_0)
- ((temp27_2)
- (indentation-possible-cause config_35)))
- (reader-error.1
- unsafe-undefined
- e22_0
- open-end-pos23_0
- unsafe-undefined
- in20_0
- seq-config21_0
- temp24_4
- (list temp25_3 opener-c26_0 temp27_2))))
- (void))
- e_87))))))
- (let-values (((seq_0)
- ((letrec-values (((loop_3)
- (lambda (depth_10
- accum_12
- init-c_5
- first?_1
- first-read-one_1
- closing_0)
- (begin
- 'loop
- (let-values (((c_32)
- (read-char/skip-whitespace-and-comments
- init-c_5
- whitespace-read-one_0
- in_21
+ (let-values (((head_1) #f))
+ (let-values (((indentation_0) (make-indentation closer_1 in_25 seq-config_0)))
+ (let-values (((config_40)
+ (let-values (((v_357) elem-config_0))
+ (let-values (((the-struct_90) v_357))
+ (if (read-config/outer? the-struct_90)
+ (let-values (((indentations18_0)
+ (cons
+ indentation_0
+ (read-config-indentations seq-config_0)))
+ ((inner19_0) (read-config/outer-inner v_357)))
+ (read-config/outer1.1
+ inner19_0
+ (read-config/outer-wrap the-struct_90)
+ (read-config/outer-line the-struct_90)
+ (read-config/outer-col the-struct_90)
+ (read-config/outer-pos the-struct_90)
+ indentations18_0
+ (read-config/outer-keep-comment? the-struct_90)))
+ (raise-argument-error
+ 'struct-copy
+ "read-config/outer?"
+ the-struct_90))))))
+ (let-values (((open-end-line_0 open-end-col_0 open-end-pos_0)
+ (port-next-location in_25)))
+ (let-values (((config/keep-comment_0) (keep-comment config_40)))
+ (let-values (((read-one/not-eof_0)
+ (lambda (init-c_4 read-one_3 config_41)
+ (begin
+ 'read-one/not-eof
+ (let-values (((e_96) (read-one_3 init-c_4 in_25 config_41)))
+ (begin
+ (if (eof-object? e_96)
+ (let-values (((in20_0) in_25)
+ ((seq-config21_0) seq-config_0)
+ ((e22_0) e_96)
+ ((open-end-pos23_0) open-end-pos_0)
+ ((temp24_3) "expected a ~a to close `~a`~a")
+ ((temp25_3) (closer-name closer_1 config_41))
+ ((opener-c26_0) opener-c_0)
+ ((temp27_1)
+ (indentation-possible-cause config_41)))
+ (reader-error.1
+ unsafe-undefined
+ e22_0
+ open-end-pos23_0
+ unsafe-undefined
+ in20_0
+ seq-config21_0
+ temp24_3
+ (list temp25_3 opener-c26_0 temp27_1)))
+ (void))
+ e_96))))))
+ (let-values (((seq_0)
+ ((letrec-values (((loop_131)
+ (lambda (depth_10
+ accum_15
+ init-c_5
+ first?_1
+ first-read-one_1
+ closing_0)
+ (begin
+ 'loop
+ (let-values (((c_125)
+ (read-char/skip-whitespace-and-comments
+ init-c_5
+ whitespace-read-one_0
+ in_25
+ seq-config_0)))
+ (let-values (((ec_4)
+ (effective-char
+ c_125
seq-config_0)))
- (let-values (((ec_4)
- (effective-char
- c_32
- seq-config_0)))
- (if (eqv? ec_4 closer_1)
- (let-values ()
- (begin
- (closing_0)
- (if (null? accum_12)
- null
- (reverse$1 accum_12))))
- (if (if (not first?_1)
- (if (eqv? ec_4 '#\.)
- (if (check-parameter
- 1/read-accept-dot
- config_34)
- (char-delimiter?
- (let-values (((in_22)
- in_21)
- ((skip-count_4)
- 0)
- ((source_13)
- (read-config-source
- config_34)))
- (let-values (((c_72)
- (peek-char-or-special
- in_22
- skip-count_4
- 'special
- source_13)))
- (if (eq?
- c_72
- 'special)
- (special1.1
+ (if (eqv? ec_4 closer_1)
+ (begin
+ (closing_0)
+ (if (null? accum_15)
+ null
+ (reverse$1 accum_15)))
+ (if (if (not first?_1)
+ (if (eqv? ec_4 '#\.)
+ (if (check-parameter
+ 1/read-accept-dot
+ config_40)
+ (char-delimiter?
+ (let-values (((in_26)
+ in_25)
+ ((skip-count_4)
+ 0)
+ ((source_13)
+ (read-config-source
+ config_40)))
+ (let-values (((c_126)
+ (peek-char-or-special
+ in_26
+ skip-count_4
+ 'special
+ source_13)))
+ (if (eq?
+ c_126
'special)
- c_72)))
- seq-config_0)
- #f)
+ (special1.1 'special)
+ c_126)))
+ seq-config_0)
#f)
#f)
- (let-values ()
- (let-values (((dot-line_0
- dot-col_0
- dot-pos_0)
- (port-next-location*
- in_21
- c_32)))
- (let-values ((()
- (begin
- (track-indentation!
- config_34
- dot-line_0
- dot-col_0)
- (values))))
- (let-values ((()
- (begin
- (if (if dot-mode_0
- (not
- head_1)
- #f)
- (void)
- (let-values ()
- (let-values (((in28_0)
- in_21)
- ((temp29_4)
- (reading-at
- config_34
- dot-line_0
- dot-col_0
- dot-pos_0))
- ((temp30_3)
- "illegal use of `.`"))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in28_0
- temp29_4
- temp30_3
- (list)))))
- (values))))
- (let-values (((v_236)
- (read-one/not-eof_0
+ #f)
+ (let-values (((dot-line_0
+ dot-col_0
+ dot-pos_0)
+ (port-next-location*
+ in_25
+ c_125)))
+ (let-values ((()
+ (begin
+ (track-indentation!
+ config_40
+ dot-line_0
+ dot-col_0)
+ (values))))
+ (let-values ((()
+ (begin
+ (if (if dot-mode_0
+ (not
+ head_1)
+ #f)
+ (void)
+ (let-values (((in28_0)
+ in_25)
+ ((temp29_2)
+ (reading-at
+ config_40
+ dot-line_0
+ dot-col_0
+ dot-pos_0))
+ ((temp30_3)
+ "illegal use of `.`"))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
#f
- first-read-one_1
- config_34)))
- ((letrec-values (((post-dot-loop_0)
- (lambda ()
- (begin
- 'post-dot-loop
- (let-values (((rest-c_0)
- (read-char/skip-whitespace-and-comments
- #f
- whitespace-read-one_0
- in_21
- seq-config_0)))
- (let-values (((rest-ec_0)
- (effective-char
- rest-c_0
- seq-config_0)))
- (if (eqv?
- rest-ec_0
- closer_1)
- (let-values ()
- (if (null?
- accum_12)
- v_236
- (append
- (reverse$1
- accum_12)
- v_236)))
- (if (if (eqv?
- rest-ec_0
- '#\.)
- (if (check-parameter
- 1/read-accept-dot
- config_34)
- (if (check-parameter
- 1/read-accept-infix-dot
- config_34)
- (char-delimiter?
- (let-values (((in_23)
- in_21)
- ((skip-count_5)
- 0)
- ((source_14)
- (read-config-source
- config_34)))
- (let-values (((c_76)
- (peek-char-or-special
- in_23
- skip-count_5
- 'special
- source_14)))
- (if (eq?
- c_76
- 'special)
- (special1.1
- 'special)
- c_76)))
- seq-config_0)
- #f)
- #f)
- #f)
- (let-values ()
- (let-values ((()
- (begin
- (set! head_1
- (box
- v_236))
- (values))))
- (let-values (((dot2-line_0
- dot2-col_0
- dot2-pos_0)
- (port-next-location
- in_21)))
- (let-values ((()
- (begin
- (track-indentation!
- config_34
- dot2-line_0
- dot2-col_0)
- (values))))
- (let-values (((post-c_0)
- (read-char/skip-whitespace-and-comments
- #f
- whitespace-read-one_0
- in_21
- seq-config_0)))
- (let-values (((post-ec_0)
- (effective-char
- post-c_0
- seq-config_0)))
- (let-values (((closing-after-dot_0)
- (lambda ()
- (begin
- 'closing-after-dot
- (let-values (((in31_0)
- in_21)
- ((temp32_5)
- (reading-at
- config_34
- dot-line_0
- dot-col_0
- dot-pos_0))
- ((post-ec33_0)
- post-ec_0)
- ((temp34_3)
- "illegal use of `.`"))
- (reader-error.1
- unsafe-undefined
- post-ec33_0
- #f
- unsafe-undefined
- in31_0
- temp32_5
- temp34_3
- (list)))))))
- (loop_3
- depth_10
- accum_12
- post-c_0
- #f
- read-one_2
- closing-after-dot_0))))))))
- (if (special-comment-via-readtable?
+ unsafe-undefined
+ in28_0
+ temp29_2
+ temp30_3
+ (list))))
+ (values))))
+ (let-values (((v_358)
+ (read-one/not-eof_0
+ #f
+ first-read-one_1
+ config_40)))
+ ((letrec-values (((post-dot-loop_0)
+ (lambda ()
+ (begin
+ 'post-dot-loop
+ (let-values (((rest-c_0)
+ (read-char/skip-whitespace-and-comments
+ #f
+ whitespace-read-one_0
+ in_25
+ seq-config_0)))
+ (let-values (((rest-ec_0)
+ (effective-char
rest-c_0
- read-one_2
- in_21
+ seq-config_0)))
+ (if (eqv?
+ rest-ec_0
+ closer_1)
+ (if (null?
+ accum_15)
+ v_358
+ (append
+ (reverse$1
+ accum_15)
+ v_358))
+ (if (if (eqv?
+ rest-ec_0
+ '#\.)
+ (if (check-parameter
+ 1/read-accept-dot
+ config_40)
+ (if (check-parameter
+ 1/read-accept-infix-dot
+ config_40)
+ (char-delimiter?
+ (let-values (((in_27)
+ in_25)
+ ((skip-count_5)
+ 0)
+ ((source_14)
+ (read-config-source
+ config_40)))
+ (let-values (((c_127)
+ (peek-char-or-special
+ in_27
+ skip-count_5
+ 'special
+ source_14)))
+ (if (eq?
+ c_127
+ 'special)
+ (special1.1
+ 'special)
+ c_127)))
seq-config_0)
- (let-values ()
- (post-dot-loop_0))
- (let-values ()
- (let-values (((in35_0)
- in_21)
- ((temp36_3)
- (reading-at
- config_34
- dot-line_0
- dot-col_0
- dot-pos_0))
- ((rest-c37_0)
- rest-c_0)
- ((temp38_1)
- "illegal use of `.`"))
- (reader-error.1
- unsafe-undefined
- rest-c37_0
- #f
- unsafe-undefined
- in35_0
- temp36_3
- temp38_1
- (list)))))))))))))
- post-dot-loop_0)))))))
- (let-values ()
- (let-values (((v_110)
- (read-one/not-eof_0
- c_32
- first-read-one_1
- config/keep-comment_0)))
- (if (1/special-comment? v_110)
- (let-values ()
- (loop_3
- depth_10
- accum_12
- #f
- #f
- read-one_2
- closing_0))
- (if (> depth_10 1024)
- (let-values ()
- (loop_3
- depth_10
- (cons v_110 accum_12)
- #f
- #f
- read-one_2
- void))
- (let-values ()
- (cons
- v_110
- (loop_3
- (add1 depth_10)
- null
- #f
- #f
- read-one_2
- void)))))))))))))))
- loop_3)
- 0
- null
- #f
- #t
- first-read-one_0
- void)))
- (let-values (((full-seq_0) (if head_1 (cons (unbox head_1) seq_0) seq_0)))
- (if shape-tag?_0
- (add-shape-tag opener_0 in_21 config_34 full-seq_0)
- full-seq_0))))))))))))))))))))))))
+ #f)
+ #f)
+ #f)
+ (let-values ((()
+ (begin
+ (set! head_1
+ (box
+ v_358))
+ (values))))
+ (let-values (((dot2-line_0
+ dot2-col_0
+ dot2-pos_0)
+ (port-next-location
+ in_25)))
+ (let-values ((()
+ (begin
+ (track-indentation!
+ config_40
+ dot2-line_0
+ dot2-col_0)
+ (values))))
+ (let-values (((post-c_1)
+ (read-char/skip-whitespace-and-comments
+ #f
+ whitespace-read-one_0
+ in_25
+ seq-config_0)))
+ (let-values (((post-ec_0)
+ (effective-char
+ post-c_1
+ seq-config_0)))
+ (let-values (((closing-after-dot_0)
+ (lambda ()
+ (begin
+ 'closing-after-dot
+ (let-values (((in31_0)
+ in_25)
+ ((temp32_4)
+ (reading-at
+ config_40
+ dot-line_0
+ dot-col_0
+ dot-pos_0))
+ ((post-ec33_0)
+ post-ec_0)
+ ((temp34_4)
+ "illegal use of `.`"))
+ (reader-error.1
+ unsafe-undefined
+ post-ec33_0
+ #f
+ unsafe-undefined
+ in31_0
+ temp32_4
+ temp34_4
+ (list)))))))
+ (loop_131
+ depth_10
+ accum_15
+ post-c_1
+ #f
+ read-one_2
+ closing-after-dot_0)))))))
+ (if (special-comment-via-readtable?
+ rest-c_0
+ read-one_2
+ in_25
+ seq-config_0)
+ (post-dot-loop_0)
+ (let-values (((in35_0)
+ in_25)
+ ((temp36_4)
+ (reading-at
+ config_40
+ dot-line_0
+ dot-col_0
+ dot-pos_0))
+ ((rest-c37_0)
+ rest-c_0)
+ ((temp38_3)
+ "illegal use of `.`"))
+ (reader-error.1
+ unsafe-undefined
+ rest-c37_0
+ #f
+ unsafe-undefined
+ in35_0
+ temp36_4
+ temp38_3
+ (list))))))))))))
+ post-dot-loop_0))))))
+ (let-values (((v_359)
+ (read-one/not-eof_0
+ c_125
+ first-read-one_1
+ config/keep-comment_0)))
+ (if (1/special-comment? v_359)
+ (loop_131
+ depth_10
+ accum_15
+ #f
+ #f
+ read-one_2
+ closing_0)
+ (if (> depth_10 1024)
+ (loop_131
+ depth_10
+ (cons v_359 accum_15)
+ #f
+ #f
+ read-one_2
+ void)
+ (cons
+ v_359
+ (loop_131
+ (add1 depth_10)
+ null
+ #f
+ #f
+ read-one_2
+ void)))))))))))))
+ loop_131)
+ 0
+ null
+ #f
+ #t
+ first-read-one_0
+ void)))
+ (let-values (((full-seq_0) (if head_1 (cons (unbox head_1) seq_0) seq_0)))
+ (if shape-tag?_0
+ (add-shape-tag opener_0 in_25 config_40 full-seq_0)
+ full-seq_0)))))))))))))))))))))))
(define-values
(add-shape-tag)
- (lambda (opener_1 in_24 config_36 seq_1)
+ (lambda (opener_1 in_28 config_42 seq_1)
(begin
(let-values (((tag_0)
- (let-values (((tmp_40) opener_1))
- (if (equal? tmp_40 '#\[)
- (let-values () (if (check-parameter 1/read-square-bracket-with-tag config_36) '#%brackets #f))
- (if (equal? tmp_40 '#\{)
- (let-values () (if (check-parameter 1/read-curly-brace-with-tag config_36) '#%braces #f))
- (let-values () #f))))))
- (if tag_0 (cons (wrap tag_0 in_24 config_36 #f) seq_1) seq_1)))))
- (define-values (not-an-fX.1$1) (lambda (who_7 v_26) (begin 'not-an-fX (raise-argument-error who_7 "flonum?" v_26))))
+ (let-values (((tmp_43) opener_1))
+ (if (equal? tmp_43 '#\[)
+ (if (check-parameter 1/read-square-bracket-with-tag config_42) '#%brackets #f)
+ (if (equal? tmp_43 '#\{)
+ (if (check-parameter 1/read-curly-brace-with-tag config_42) '#%braces #f)
+ #f)))))
+ (if tag_0 (cons (wrap tag_0 in_28 config_42 #f) seq_1) seq_1)))))
(define-values
(read-digits.1)
(lambda (base1_1 init3_0 max-count2_0 zero-digits-result4_0 in10_0 config11_0 accum-str9_0)
(begin
'read-digits
- (let-values (((in_7) in10_0))
- (let-values (((config_16) config11_0))
+ (let-values (((in_29) in10_0))
+ (let-values (((config_43) config11_0))
(let-values (((accum-str_0) accum-str9_0))
- (let-values (((base_5) base1_1))
+ (let-values (((base_26) base1_1))
(let-values (((max-count_0) max-count2_0))
(let-values (((init-v_0) init3_0))
(let-values (((zero-digits-result_0) zero-digits-result4_0))
- (let-values ()
- (let-values (((c_53)
- (let-values (((in_25) in_7)
- ((skip-count_6) 0)
- ((source_15) (read-config-source config_16)))
- (let-values (((c_58)
- (peek-char-or-special in_25 skip-count_6 'special source_15)))
- (if (eq? c_58 'special) (special1.1 'special) c_58)))))
- (if (digit? c_53 base_5)
- (let-values ()
- (begin
- (consume-char in_7 c_53)
- (if accum-str_0 (let-values () (accum-string-add! accum-str_0 c_53)) (void))
- ((letrec-values (((loop_114)
- (lambda (v_50 max-count_1)
- (begin
- 'loop
- (if (zero? max-count_1)
- (let-values () v_50)
- (let-values ()
- (let-values (((c_87)
- (let-values (((in_14) in_7)
- ((skip-count_3) 0)
- ((source_9)
- (read-config-source config_16)))
- (let-values (((c_82)
- (peek-char-or-special
- in_14
- skip-count_3
- 'special
- source_9)))
- (if (eq? c_82 'special)
- (special1.1 'special)
- c_82)))))
- (if (digit? c_87 base_5)
- (let-values ()
- (begin
- (consume-char in_7 c_87)
- (if accum-str_0
- (let-values () (accum-string-add! accum-str_0 c_87))
- (void))
- (loop_114
- (+ (digit->number c_87) (* v_50 base_5))
- (sub1 max-count_1))))
- (let-values () v_50)))))))))
- loop_114)
- (+ (digit->number c_53) (* init-v_0 base_5))
- (sub1 max-count_0))))
- (if zero-digits-result_0
- (let-values () zero-digits-result_0)
- (let-values () c_53)))))))))))))))
+ (let-values (((c_128)
+ (let-values (((in_30) in_29)
+ ((skip-count_6) 0)
+ ((source_15) (read-config-source config_43)))
+ (let-values (((c_129) (peek-char-or-special in_30 skip-count_6 'special source_15)))
+ (if (eq? c_129 'special) (special1.1 'special) c_129)))))
+ (if (digit? c_128 base_26)
+ (begin
+ (consume-char in_29 c_128)
+ (if accum-str_0 (accum-string-add! accum-str_0 c_128) (void))
+ ((letrec-values (((loop_132)
+ (lambda (v_360 max-count_1)
+ (begin
+ 'loop
+ (if (zero? max-count_1)
+ v_360
+ (let-values (((c_130)
+ (let-values (((in_31) in_29)
+ ((skip-count_7) 0)
+ ((source_16)
+ (read-config-source config_43)))
+ (let-values (((c_131)
+ (peek-char-or-special
+ in_31
+ skip-count_7
+ 'special
+ source_16)))
+ (if (eq? c_131 'special)
+ (special1.1 'special)
+ c_131)))))
+ (if (digit? c_130 base_26)
+ (begin
+ (consume-char in_29 c_130)
+ (if accum-str_0 (accum-string-add! accum-str_0 c_130) (void))
+ (loop_132
+ (+ (digit->number c_130) (* v_360 base_26))
+ (sub1 max-count_1)))
+ v_360)))))))
+ loop_132)
+ (+ (digit->number c_128) (* init-v_0 base_26))
+ (sub1 max-count_0)))
+ (if zero-digits-result_0 zero-digits-result_0 c_128)))))))))))))
(define-values
(digit?)
- (lambda (c_88 base_23)
+ (lambda (c_132 base_27)
(begin
- (if (not (char? c_88))
- (let-values () #f)
- (if (= base_23 8)
- (let-values () (octal-digit? c_88))
- (if (= base_23 16) (let-values () (hex-digit? c_88)) (let-values () (decimal-digit? c_88))))))))
- (define-values (decimal-digit?) (lambda (c_83) (begin (if (char>=? c_83 '#\0) (char<=? c_83 '#\9) #f))))
- (define-values (octal-digit?) (lambda (c_89) (begin (if (char>=? c_89 '#\0) (char<=? c_89 '#\7) #f))))
+ (if (not (char? c_132))
+ #f
+ (if (= base_27 8) (octal-digit? c_132) (if (= base_27 16) (hex-digit? c_132) (decimal-digit? c_132)))))))
+ (define-values (decimal-digit?) (lambda (c_133) (begin (if (char>=? c_133 '#\0) (char<=? c_133 '#\9) #f))))
+ (define-values (octal-digit?) (lambda (c_134) (begin (if (char>=? c_134 '#\0) (char<=? c_134 '#\7) #f))))
(define-values
(hex-digit?)
- (lambda (c_90)
+ (lambda (c_135)
(begin
- (let-values (((or-part_320) (if (char>=? c_90 '#\0) (char<=? c_90 '#\9) #f)))
- (if or-part_320
- or-part_320
- (let-values (((or-part_321) (if (char>=? c_90 '#\A) (char<=? c_90 '#\F) #f)))
- (if or-part_321 or-part_321 (if (char>=? c_90 '#\a) (char<=? c_90 '#\f) #f))))))))
+ (let-values (((or-part_607) (if (char>=? c_135 '#\0) (char<=? c_135 '#\9) #f)))
+ (if or-part_607
+ or-part_607
+ (let-values (((or-part_608) (if (char>=? c_135 '#\A) (char<=? c_135 '#\F) #f)))
+ (if or-part_608 or-part_608 (if (char>=? c_135 '#\a) (char<=? c_135 '#\f) #f))))))))
(define-values
(digit->number)
- (lambda (c_91)
+ (lambda (c_136)
(begin
- (if (if (char>=? c_91 '#\0) (char<=? c_91 '#\9) #f)
- (let-values () (- (char->integer c_91) (char->integer '#\0)))
- (if (if (char>=? c_91 '#\A) (char<=? c_91 '#\F) #f)
- (let-values () (- (char->integer c_91) (- (char->integer '#\A) 10)))
- (let-values () (- (char->integer c_91) (- (char->integer '#\a) 10))))))))
+ (if (if (char>=? c_136 '#\0) (char<=? c_136 '#\9) #f)
+ (- (char->integer c_136) (char->integer '#\0))
+ (if (if (char>=? c_136 '#\A) (char<=? c_136 '#\F) #f)
+ (- (char->integer c_136) (- (char->integer '#\A) 10))
+ (- (char->integer c_136) (- (char->integer '#\a) 10)))))))
(define-values
(maybe-digit)
- (lambda (c_92 radix_0)
+ (lambda (c_137 radix_0)
(begin
- (let-values (((v_237) (char->integer c_92)))
- (if (fx< v_237 (char->integer '#\0))
- (let-values () c_92)
- (if (fx< v_237 (fx+ (fxmin radix_0 10) (char->integer '#\0)))
- (let-values () (fx- v_237 (char->integer '#\0)))
+ (let-values (((v_361) (char->integer c_137)))
+ (if (fx< v_361 (char->integer '#\0))
+ c_137
+ (if (fx< v_361 (fx+ (fxmin radix_0 10) (char->integer '#\0)))
+ (fx- v_361 (char->integer '#\0))
(if (fx<= radix_0 10)
- (let-values () c_92)
- (if (fx< v_237 (char->integer '#\A))
- (let-values () c_92)
- (if (fx< v_237 (+ radix_0 (- (char->integer '#\A) 10)))
- (let-values () (fx- v_237 (- (char->integer '#\A) 10)))
- (if (fx< v_237 (char->integer '#\a))
- (let-values () c_92)
- (if (fx< v_237 (+ radix_0 (- (char->integer '#\a) 10)))
- (let-values () (fx- v_237 (- (char->integer '#\a) 10)))
- (let-values () c_92))))))))))))
+ c_137
+ (if (fx< v_361 (char->integer '#\A))
+ c_137
+ (if (fx< v_361 (+ radix_0 (- (char->integer '#\A) 10)))
+ (fx- v_361 (- (char->integer '#\A) 10))
+ (if (fx< v_361 (char->integer '#\a))
+ c_137
+ (if (fx< v_361 (+ radix_0 (- (char->integer '#\a) 10)))
+ (fx- v_361 (- (char->integer '#\a) 10))
+ c_137)))))))))))
(define-values (string->number$1) string->number)
(define-values
(1/string->number)
@@ -58946,7 +57788,7 @@
(lambda (s5_4 radix1_0 convert-mode2_0 decimal-mode3_0 single-mode4_0)
(begin
'string->number
- (let-values (((s_548) s5_4))
+ (let-values (((s_834) s5_4))
(let-values (((radix_1) radix1_0))
(let-values (((convert-mode_0) convert-mode2_0))
(let-values (((decimal-mode_0)
@@ -58957,69 +57799,54 @@
(if (eq? single-mode4_0 unsafe-undefined)
(if (1/read-single-flonum) 'single 'double)
single-mode4_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (string? s_548)
- (void)
- (let-values () (raise-argument-error 'string->number "string?" s_548)))
- (if ((lambda (p_75) (if (exact-integer? radix_1) (<= 2 radix_1 16) #f)) radix_1)
- (void)
- (let-values ()
- (raise-argument-error 'string->number "(integer-in 2 16)" radix_1)))
- (if ((lambda (p_76)
- (let-values (((or-part_144) (eq? p_76 'number-or-false)))
- (if or-part_144 or-part_144 (eq? p_76 'read))))
- convert-mode_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'string->number
- "(or/c 'number-or-false 'read)"
- convert-mode_0)))
- (if ((lambda (p_14)
- (let-values (((or-part_169) (eq? p_14 'decimal-as-inexact)))
- (if or-part_169 or-part_169 (eq? p_14 'decimal-as-exact))))
- decimal-mode_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'string->number
- "(or/c 'decimal-as-inexact 'decimal-as-exact)"
- decimal-mode_0)))
- (if ((lambda (p_77)
- (let-values (((or-part_36) (eq? p_77 'single)))
- (if or-part_36 or-part_36 (eq? p_77 'double))))
- single-mode_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'string->number
- "(or/c 'single 'double)"
- single-mode_0)))
- (unchecked-string->number
- s_548
- radix_1
- convert-mode_0
- decimal-mode_0
- single-mode_0))))))))))))))
+ (begin
+ (if (string? s_834) (void) (raise-argument-error 'string->number "string?" s_834))
+ (if ((lambda (p_104) (if (exact-integer? radix_1) (<= 2 radix_1 16) #f)) radix_1)
+ (void)
+ (raise-argument-error 'string->number "(integer-in 2 16)" radix_1))
+ (if ((lambda (p_105)
+ (let-values (((or-part_609) (eq? p_105 'number-or-false)))
+ (if or-part_609 or-part_609 (eq? p_105 'read))))
+ convert-mode_0)
+ (void)
+ (raise-argument-error 'string->number "(or/c 'number-or-false 'read)" convert-mode_0))
+ (if ((lambda (p_106)
+ (let-values (((or-part_610) (eq? p_106 'decimal-as-inexact)))
+ (if or-part_610 or-part_610 (eq? p_106 'decimal-as-exact))))
+ decimal-mode_0)
+ (void)
+ (raise-argument-error
+ 'string->number
+ "(or/c 'decimal-as-inexact 'decimal-as-exact)"
+ decimal-mode_0))
+ (if ((lambda (p_107)
+ (let-values (((or-part_611) (eq? p_107 'single)))
+ (if or-part_611 or-part_611 (eq? p_107 'double))))
+ single-mode_0)
+ (void)
+ (raise-argument-error 'string->number "(or/c 'single 'double)" single-mode_0))
+ (unchecked-string->number
+ s_834
+ radix_1
+ convert-mode_0
+ decimal-mode_0
+ single-mode_0)))))))))))
(case-lambda
- ((s_8) (begin 'string->number (string->number_0 s_8 10 'number-or-false unsafe-undefined unsafe-undefined)))
- ((s_94 radix_2 convert-mode_1 decimal-mode_1 single-mode4_1)
- (string->number_0 s_94 radix_2 convert-mode_1 decimal-mode_1 single-mode4_1))
- ((s_95 radix_3 convert-mode_2 decimal-mode3_1)
- (string->number_0 s_95 radix_3 convert-mode_2 decimal-mode3_1 unsafe-undefined))
- ((s_549 radix_4 convert-mode2_1)
- (string->number_0 s_549 radix_4 convert-mode2_1 unsafe-undefined unsafe-undefined))
- ((s_497 radix1_1) (string->number_0 s_497 radix1_1 'number-or-false unsafe-undefined unsafe-undefined)))))
+ ((s_835) (begin 'string->number (string->number_0 s_835 10 'number-or-false unsafe-undefined unsafe-undefined)))
+ ((s_836 radix_2 convert-mode_1 decimal-mode_1 single-mode4_1)
+ (string->number_0 s_836 radix_2 convert-mode_1 decimal-mode_1 single-mode4_1))
+ ((s_837 radix_3 convert-mode_2 decimal-mode3_1)
+ (string->number_0 s_837 radix_3 convert-mode_2 decimal-mode3_1 unsafe-undefined))
+ ((s_838 radix_4 convert-mode2_1)
+ (string->number_0 s_838 radix_4 convert-mode2_1 unsafe-undefined unsafe-undefined))
+ ((s_839 radix1_1) (string->number_0 s_839 radix1_1 'number-or-false unsafe-undefined unsafe-undefined)))))
(define-values
(unchecked-string->number)
- (lambda (s_81 radix_5 convert-mode_3 decimal-mode_2 single-mode_1)
+ (lambda (s_840 radix_5 convert-mode_3 decimal-mode_2 single-mode_1)
(begin
- (let-values (((s44_1) s_81)
- ((temp45_2) 0)
- ((temp46_1) (string-length s_81))
+ (let-values (((s44_2) s_840)
+ ((temp45_1) 0)
+ ((temp46_3) (string-length s_840))
((radix47_0) radix_5)
((temp48_3) #f)
((decimal-mode49_0) decimal-mode_2)
@@ -59027,9 +57854,9 @@
((single-mode51_0) single-mode_1))
(do-string->number.1
temp48_3
- s44_1
- temp45_2
- temp46_1
+ s44_2
+ temp45_1
+ temp46_3
radix47_0
decimal-mode49_0
convert-mode50_0
@@ -59043,1469 +57870,1316 @@
parse-state-can-single?
parse-state-fst
parse-state-other-exactness)
- (let-values (((struct:_73 make-_73 ?_73 -ref_73 -set!_73)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'parse-state
- #f
- 5
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2 3 4)
- #f
- 'parse-state)))))
+ (let-values (((struct:_138 make-_138 ?_138 -ref_138 -set!_138)
+ (make-struct-type
+ 'parse-state
+ #f
+ 5
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2 3 4)
+ #f
+ 'parse-state)))
(values
- struct:_73
- make-_73
- ?_73
- (make-struct-field-accessor -ref_73 0 'exactness)
- (make-struct-field-accessor -ref_73 1 'convert-mode)
- (make-struct-field-accessor -ref_73 2 'can-single?)
- (make-struct-field-accessor -ref_73 3 'fst)
- (make-struct-field-accessor -ref_73 4 'other-exactness))))
+ struct:_138
+ make-_138
+ ?_138
+ (make-struct-field-accessor -ref_138 0 'exactness)
+ (make-struct-field-accessor -ref_138 1 'convert-mode)
+ (make-struct-field-accessor -ref_138 2 'can-single?)
+ (make-struct-field-accessor -ref_138 3 'fst)
+ (make-struct-field-accessor -ref_138 4 'other-exactness))))
(define-values
(struct:rect-prefix rect-prefix7.1 rect-prefix? rect-prefix-sgn/z rect-prefix-n rect-prefix-start)
- (let-values (((struct:_74 make-_74 ?_74 -ref_74 -set!_74)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'rect-prefix
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'rect-prefix)))))
+ (let-values (((struct:_139 make-_139 ?_139 -ref_139 -set!_139)
+ (make-struct-type
+ 'rect-prefix
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'rect-prefix)))
(values
- struct:_74
- make-_74
- ?_74
- (make-struct-field-accessor -ref_74 0 'sgn/z)
- (make-struct-field-accessor -ref_74 1 'n)
- (make-struct-field-accessor -ref_74 2 'start))))
+ struct:_139
+ make-_139
+ ?_139
+ (make-struct-field-accessor -ref_139 0 'sgn/z)
+ (make-struct-field-accessor -ref_139 1 'n)
+ (make-struct-field-accessor -ref_139 2 'start))))
(define-values
(struct:polar-prefix polar-prefix8.1 polar-prefix? polar-prefix-sgn/z polar-prefix-n polar-prefix-start)
- (let-values (((struct:_75 make-_75 ?_75 -ref_75 -set!_75)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'polar-prefix
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'polar-prefix)))))
+ (let-values (((struct:_140 make-_140 ?_140 -ref_140 -set!_140)
+ (make-struct-type
+ 'polar-prefix
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'polar-prefix)))
(values
- struct:_75
- make-_75
- ?_75
- (make-struct-field-accessor -ref_75 0 'sgn/z)
- (make-struct-field-accessor -ref_75 1 'n)
- (make-struct-field-accessor -ref_75 2 'start))))
+ struct:_140
+ make-_140
+ ?_140
+ (make-struct-field-accessor -ref_140 0 'sgn/z)
+ (make-struct-field-accessor -ref_140 1 'n)
+ (make-struct-field-accessor -ref_140 2 'start))))
(define-values
(init-state)
(lambda (exactness_0 convert-mode_4 single-mode_2 fst_0)
(begin (parse-state6.1 exactness_0 convert-mode_4 (eq? single-mode_2 'single) fst_0 exactness_0))))
(define-values
(state-has-first-half?)
- (lambda (state_27) (begin (let-values (((fst_1) (parse-state-fst state_27))) (if fst_1 (not (eq? fst_1 '+/-)) #f)))))
+ (lambda (state_29) (begin (let-values (((fst_1) (parse-state-fst state_29))) (if fst_1 (not (eq? fst_1 '+/-)) #f)))))
(define-values
(state-set-first-half)
- (lambda (state_20 fst_2)
+ (lambda (state_30 fst_2)
(begin
- (let-values (((the-struct_83) state_20))
- (if (parse-state? the-struct_83)
+ (let-values (((the-struct_91) state_30))
+ (if (parse-state? the-struct_91)
(let-values (((fst55_0) fst_2)
- ((exactness56_0) (parse-state-other-exactness state_20))
- ((other-exactness57_0) (parse-state-exactness state_20)))
+ ((exactness56_0) (parse-state-other-exactness state_30))
+ ((other-exactness57_0) (parse-state-exactness state_30)))
(parse-state6.1
exactness56_0
- (parse-state-convert-mode the-struct_83)
- (parse-state-can-single? the-struct_83)
+ (parse-state-convert-mode the-struct_91)
+ (parse-state-can-single? the-struct_91)
fst55_0
other-exactness57_0))
- (raise-argument-error 'struct-copy "parse-state?" the-struct_83))))))
+ (raise-argument-error 'struct-copy "parse-state?" the-struct_91))))))
(define-values
(state-first-half)
- (lambda (state_28)
+ (lambda (state_31)
(begin
(init-state
- (parse-state-other-exactness state_28)
- (parse-state-convert-mode state_28)
- (if (parse-state-can-single? state_28) 'single 'double)
+ (parse-state-other-exactness state_31)
+ (parse-state-convert-mode state_31)
+ (if (parse-state-can-single? state_31) 'single 'double)
#f))))
(define-values
(state-second-half)
- (lambda (state_29)
+ (lambda (state_32)
(begin
(init-state
- (parse-state-exactness state_29)
- (parse-state-convert-mode state_29)
- (if (parse-state-can-single? state_29) 'single 'double)
+ (parse-state-exactness state_32)
+ (parse-state-convert-mode state_32)
+ (if (parse-state-can-single? state_32) 'single 'double)
#f))))
(define-values
(state->convert-mode)
- (lambda (state_30) (begin (if (parse-state? state_30) (parse-state-convert-mode state_30) state_30))))
+ (lambda (state_33) (begin (if (parse-state? state_33) (parse-state-convert-mode state_33) state_33))))
(define-values
(state->dbz-convert-mode)
- (lambda (state_31)
+ (lambda (state_34)
(begin
- (let-values (((convert-mode_5) (parse-state-convert-mode state_31)))
+ (let-values (((convert-mode_5) (parse-state-convert-mode state_34)))
(if (eq? convert-mode_5 'read) 'must-read convert-mode_5)))))
(define-values
(bad-digit)
- (lambda (c_93 s_550 state_32)
+ (lambda (c_138 s_841 state_35)
(begin
- (if (char=? c_93 '#\nul)
- (let-values ()
- (if (eq? (state->convert-mode state_32) 'must-read)
- (let-values () (format "nul character in `~.a`" s_550))
- (let-values () #f)))
- (let-values ()
- (if (eq? (state->convert-mode state_32) 'must-read)
- (let-values () (format "bad digit `~a`" c_93))
- (let-values () #f)))))))
+ (if (char=? c_138 '#\nul)
+ (if (eq? (state->convert-mode state_35) 'must-read) (format "nul character in `~.a`" s_841) #f)
+ (if (eq? (state->convert-mode state_35) 'must-read) (format "bad digit `~a`" c_138) #f)))))
(define-values
(bad-mixed-decimal-fraction)
- (lambda (s_551 state_33)
+ (lambda (s_842 state_36)
(begin
- (if (eq? (state->convert-mode state_33) 'must-read)
- (let-values () (format "decimal points and fractions cannot be mixed in `~.a`" s_551))
- (let-values () #f)))))
+ (if (eq? (state->convert-mode state_36) 'must-read)
+ (format "decimal points and fractions cannot be mixed in `~.a`" s_842)
+ #f))))
(define-values
(bad-misplaced)
- (lambda (what_3 s_168 state_34)
- (begin
- (if (eq? (state->convert-mode state_34) 'must-read)
- (let-values () (format "misplaced `~a` in `~.a`" what_3 s_168))
- (let-values () #f)))))
+ (lambda (what_4 s_843 state_37)
+ (begin (if (eq? (state->convert-mode state_37) 'must-read) (format "misplaced `~a` in `~.a`" what_4 s_843) #f))))
(define-values
(bad-no-digits)
- (lambda (after_0 s_30 state_35)
+ (lambda (after_0 s_844 state_38)
(begin
- (if (eq? (state->convert-mode state_35) 'must-read)
- (let-values () (format "missing digits after `~a` in `~.a`" after_0 s_30))
- (let-values () #f)))))
+ (if (eq? (state->convert-mode state_38) 'must-read)
+ (format "missing digits after `~a` in `~.a`" after_0 s_844)
+ #f))))
(define-values
(bad-extflonum-for-complex)
- (lambda (i_187 s_31 state_36)
+ (lambda (i_299 s_845 state_39)
(begin
- (if (eq? (state->convert-mode state_36) 'must-read)
- (let-values () (format "cannot combine extflonum `~a` into a complex number" i_187))
- (let-values () #f)))))
+ (if (eq? (state->convert-mode state_39) 'must-read)
+ (format "cannot combine extflonum `~a` into a complex number" i_299)
+ #f))))
(define-values
(struct:lazy-expt lazy-expt9.1 lazy-expt? lazy-expt-n lazy-expt-radix lazy-expt-exp)
- (let-values (((struct:_76 make-_76 ?_76 -ref_76 -set!_76)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'lazy-expt
- #f
- 3
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1 2)
- #f
- 'lazy-expt)))))
+ (let-values (((struct:_141 make-_141 ?_141 -ref_141 -set!_141)
+ (make-struct-type
+ 'lazy-expt
+ #f
+ 3
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1 2)
+ #f
+ 'lazy-expt)))
(values
- struct:_76
- make-_76
- ?_76
- (make-struct-field-accessor -ref_76 0 'n)
- (make-struct-field-accessor -ref_76 1 'radix)
- (make-struct-field-accessor -ref_76 2 'exp))))
+ struct:_141
+ make-_141
+ ?_141
+ (make-struct-field-accessor -ref_141 0 'n)
+ (make-struct-field-accessor -ref_141 1 'radix)
+ (make-struct-field-accessor -ref_141 2 'exp))))
(define-values
(struct:lazy-rational lazy-rational10.1 lazy-rational? lazy-rational-n lazy-rational-d)
- (let-values (((struct:_77 make-_77 ?_77 -ref_77 -set!_77)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'lazy-rational
- #f
- 2
- 0
- #f
- (list (cons prop:authentic #t))
- (current-inspector)
- #f
- '(0 1)
- #f
- 'lazy-rational)))))
+ (let-values (((struct:_142 make-_142 ?_142 -ref_142 -set!_142)
+ (make-struct-type
+ 'lazy-rational
+ #f
+ 2
+ 0
+ #f
+ (list (cons prop:authentic #t))
+ (current-inspector)
+ #f
+ '(0 1)
+ #f
+ 'lazy-rational)))
(values
- struct:_77
- make-_77
- ?_77
- (make-struct-field-accessor -ref_77 0 'n)
- (make-struct-field-accessor -ref_77 1 'd))))
+ struct:_142
+ make-_142
+ ?_142
+ (make-struct-field-accessor -ref_142 0 'n)
+ (make-struct-field-accessor -ref_142 1 'd))))
(define-values
(lazy-number)
- (lambda (n_15 radix_6 exp_0)
+ (lambda (n_36 radix_6 exp_0)
(begin
- (if (eq? n_15 'dbz)
- (let-values () n_15)
- (if (eq? n_15 'dbz!)
- (let-values () n_15)
- (let-values ()
- (if (if (< exp_0 30) (> exp_0 -30) #f)
- (* n_15 (expt radix_6 exp_0))
- (lazy-expt9.1 n_15 radix_6 exp_0))))))))
+ (if (eq? n_36 'dbz)
+ n_36
+ (if (eq? n_36 'dbz!)
+ n_36
+ (if (if (< exp_0 30) (> exp_0 -30) #f) (* n_36 (expt radix_6 exp_0)) (lazy-expt9.1 n_36 radix_6 exp_0)))))))
(define-values
(lazy-divide)
- (lambda (n_35 d_42 d-exactness_0)
+ (lambda (n_37 d_42 d-exactness_0)
(begin
(if (eqv? d_42 0)
- (let-values () (if (eq? d-exactness_0 'exact) 'dbz! 'dbz))
- (if (let-values (((or-part_46) (lazy-expt? n_35))) (if or-part_46 or-part_46 (lazy-expt? d_42)))
- (let-values () (lazy-rational10.1 n_35 d_42))
- (let-values () (/ n_35 d_42)))))))
+ (if (eq? d-exactness_0 'exact) 'dbz! 'dbz)
+ (if (let-values (((or-part_612) (lazy-expt? n_37))) (if or-part_612 or-part_612 (lazy-expt? d_42)))
+ (lazy-rational10.1 n_37 d_42)
+ (/ n_37 d_42))))))
(define-values
(simplify-lazy-divide)
(lambda (n0_0)
(begin
(if (lazy-rational? n0_0)
- (let-values ()
- (let-values (((n_36) (lazy-rational-n n0_0)))
- (let-values (((d_43) (lazy-rational-d n0_0)))
- (let-values (((n-n_0) (if (lazy-expt? n_36) (lazy-expt-n n_36) n_36)))
- (let-values (((n-exp_0) (if (lazy-expt? n_36) (lazy-expt-exp n_36) 0)))
- (let-values (((d-n_0) (if (lazy-expt? d_43) (lazy-expt-n d_43) d_43)))
- (let-values (((d-exp_0) (if (lazy-expt? d_43) (lazy-expt-exp d_43) 0)))
- (let-values (((radix_7) (if (lazy-expt? n_36) (lazy-expt-radix n_36) (lazy-expt-radix d_43))))
- (lazy-number (/ n-n_0 d-n_0) radix_7 (- n-exp_0 d-exp_0))))))))))
- (let-values () n0_0)))))
+ (let-values (((n_38) (lazy-rational-n n0_0)))
+ (let-values (((d_43) (lazy-rational-d n0_0)))
+ (let-values (((n-n_0) (if (lazy-expt? n_38) (lazy-expt-n n_38) n_38)))
+ (let-values (((n-exp_0) (if (lazy-expt? n_38) (lazy-expt-exp n_38) 0)))
+ (let-values (((d-n_0) (if (lazy-expt? d_43) (lazy-expt-n d_43) d_43)))
+ (let-values (((d-exp_0) (if (lazy-expt? d_43) (lazy-expt-exp d_43) 0)))
+ (let-values (((radix_7) (if (lazy-expt? n_38) (lazy-expt-radix n_38) (lazy-expt-radix d_43))))
+ (lazy-number (/ n-n_0 d-n_0) radix_7 (- n-exp_0 d-exp_0)))))))))
+ n0_0))))
(define-values
(force-lazy-exact)
- (lambda (n0_1 state_23 s_552)
+ (lambda (n0_1 state_40 s_846)
(begin
- (let-values (((n_37) (simplify-lazy-divide n0_1)))
- (if (let-values (((or-part_322) (eq? n_37 'dbz))) (if or-part_322 or-part_322 (eq? n_37 'dbz!)))
- (let-values ()
- (if (eq? (state->convert-mode (state->dbz-convert-mode state_23)) 'must-read)
- (let-values () (format "division by zero in `~.a`" s_552))
- (let-values () #f)))
- (if (lazy-expt? n_37)
- (let-values () (* (lazy-expt-n n_37) (expt (lazy-expt-radix n_37) (lazy-expt-exp n_37))))
- (let-values () n_37)))))))
+ (let-values (((n_39) (simplify-lazy-divide n0_1)))
+ (if (let-values (((or-part_613) (eq? n_39 'dbz))) (if or-part_613 or-part_613 (eq? n_39 'dbz!)))
+ (if (eq? (state->convert-mode (state->dbz-convert-mode state_40)) 'must-read)
+ (format "division by zero in `~.a`" s_846)
+ #f)
+ (if (lazy-expt? n_39) (* (lazy-expt-n n_39) (expt (lazy-expt-radix n_39) (lazy-expt-exp n_39))) n_39))))))
(define-values
(force-lazy-inexact)
(let-values (((force-lazy-inexact_0)
- (lambda (sgn/z12_0 n013_0 state14_0 s15_1 precision11_0)
+ (lambda (sgn/z12_0 n013_0 state14_0 s15_2 precision11_0)
(begin
'force-lazy-inexact
(let-values (((sgn/z_0) sgn/z12_0))
(let-values (((n0_2) n013_0))
- (let-values (((state_37) state14_0))
- (let-values (((s_337) s15_1))
+ (let-values (((state_41) state14_0))
+ (let-values (((s_847) s15_2))
(let-values (((precision_0) precision11_0))
- (let-values ()
- (let-values (((n1_1) (simplify-lazy-divide n0_2)))
- (if (eq? n0_2 'dbz)
- (let-values () (if (fx= sgn/z_0 -1) -inf.0 +inf.0))
- (if (eq? n0_2 'dbz!)
- (let-values ()
- (if (eq? (state->convert-mode (state->dbz-convert-mode state_37)) 'must-read)
- (let-values () (format "division by zero in `~.a`" s_337))
- (let-values () #f)))
- (if (lazy-expt? n1_1)
- (let-values ()
- (let-values (((n_38) (lazy-expt-n n1_1)))
- (let-values (((exp_1) (lazy-expt-exp n1_1)))
- (let-values (((radix_8) (lazy-expt-radix n1_1)))
- (let-values (((approx-expt_0)
- (+
- (/
- (if (integer? n_38)
- (integer-length n_38)
- (-
- (integer-length (numerator n_38))
- (integer-length (denominator n_38))))
- (log radix_8 2))
- exp_1)))
- (if (eqv? n_38 0)
- (let-values () (if (fx= sgn/z_0 -1) (- 0.0) 0.0))
- (if (> approx-expt_0 precision_0)
- (let-values () (if (fx= sgn/z_0 -1) -inf.0 +inf.0))
- (if (< approx-expt_0 (- precision_0))
- (let-values () (if (fx= sgn/z_0 -1) (- 0.0) 0.0))
- (let-values () (* n_38 (expt radix_8 exp_1)))))))))))
- (if (eqv? n1_1 0)
- (let-values () (if (fx= sgn/z_0 -1) (- 0.0) 0.0))
- (let-values () n1_1))))))))))))))))
+ (let-values (((n1_1) (simplify-lazy-divide n0_2)))
+ (if (eq? n0_2 'dbz)
+ (if (fx= sgn/z_0 -1) -inf.0 +inf.0)
+ (if (eq? n0_2 'dbz!)
+ (if (eq? (state->convert-mode (state->dbz-convert-mode state_41)) 'must-read)
+ (format "division by zero in `~.a`" s_847)
+ #f)
+ (if (lazy-expt? n1_1)
+ (let-values (((n_40) (lazy-expt-n n1_1)))
+ (let-values (((exp_1) (lazy-expt-exp n1_1)))
+ (let-values (((radix_8) (lazy-expt-radix n1_1)))
+ (let-values (((approx-expt_0)
+ (+
+ (/
+ (if (integer? n_40)
+ (integer-length n_40)
+ (-
+ (integer-length (numerator n_40))
+ (integer-length (denominator n_40))))
+ (log radix_8 2))
+ exp_1)))
+ (if (eqv? n_40 0)
+ (if (fx= sgn/z_0 -1) (- 0.0) 0.0)
+ (if (> approx-expt_0 precision_0)
+ (if (fx= sgn/z_0 -1) -inf.0 +inf.0)
+ (if (< approx-expt_0 (- precision_0))
+ (if (fx= sgn/z_0 -1) (- 0.0) 0.0)
+ (* n_40 (expt radix_8 exp_1)))))))))
+ (if (eqv? n1_1 0) (if (fx= sgn/z_0 -1) (- 0.0) 0.0) n1_1))))))))))))))
(case-lambda
- ((sgn/z_1 n0_3 state_38 s_40) (begin (force-lazy-inexact_0 sgn/z_1 n0_3 state_38 s_40 2048)))
- ((sgn/z_2 n0_4 state_39 s_460 precision11_1) (force-lazy-inexact_0 sgn/z_2 n0_4 state_39 s_460 precision11_1)))))
+ ((sgn/z_1 n0_3 state_42 s_848) (begin (force-lazy-inexact_0 sgn/z_1 n0_3 state_42 s_848 2048)))
+ ((sgn/z_2 n0_4 state_43 s_849 precision11_1) (force-lazy-inexact_0 sgn/z_2 n0_4 state_43 s_849 precision11_1)))))
(define-values
(fast-inexact)
- (lambda (state_40 sgn_0 n_19 radix_9 exp_2 sgn2_0 exp2_0)
+ (lambda (state_44 sgn_0 n_41 radix_9 exp_2 sgn2_0 exp2_0)
(begin
- (let-values (((tmp_41) (parse-state-exactness state_40)))
- (if (if (equal? tmp_41 'double) #t (equal? tmp_41 'approx))
- (let-values ()
- (if (state-has-first-half? state_40)
- (let-values () #f)
- (if (eqv? n_19 0)
- (let-values () (if (fx= sgn_0 1) 0.0 (- 0.0)))
- (if (if (fixnum? n_19) (if (< n_19 (expt 2 50)) (> n_19 (- (expt 2 50))) #f) #f)
- (let-values ()
- (let-values (((exp_3) (+ exp_2 (* sgn2_0 exp2_0))))
- (if (if (fixnum? exp_3)
- (if (fx<= radix_9 10)
- (let-values () (fx<= -15 exp_3 15))
- (let-values () (fx<= -12 exp_3 12)))
- #f)
- (let-values ()
- (let-values (((m_27) (fx->fl (if (fx= sgn_0 -1) (fx- 0 n_19) n_19))))
- (if (eqv? exp_3 0)
- (let-values () m_27)
- (if (not (fixnum? exp_3))
- (let-values () #f)
- (let-values ()
- (let-values (((fradix_0) (if (fx= radix_9 10) 10.0 (fx->fl radix_9))))
- (if (fx< exp_3 0)
- (let-values () (/ m_27 (expt fradix_0 (fx- 0 exp_3))))
- (let-values () (* m_27 (expt fradix_0 exp_3))))))))))
- (let-values () #f))))
- (let-values () #f)))))
- (let-values () #f))))))
+ (let-values (((tmp_44) (parse-state-exactness state_44)))
+ (if (if (equal? tmp_44 'double) #t (equal? tmp_44 'approx))
+ (if (state-has-first-half? state_44)
+ #f
+ (if (eqv? n_41 0)
+ (if (fx= sgn_0 1) 0.0 (- 0.0))
+ (if (if (fixnum? n_41) (if (< n_41 (expt 2 50)) (> n_41 (- (expt 2 50))) #f) #f)
+ (let-values (((exp_3) (+ exp_2 (* sgn2_0 exp2_0))))
+ (if (if (fixnum? exp_3) (if (fx<= radix_9 10) (fx<= -15 exp_3 15) (fx<= -12 exp_3 12)) #f)
+ (let-values (((m_32) (fx->fl (if (fx= sgn_0 -1) (fx- 0 n_41) n_41))))
+ (if (eqv? exp_3 0)
+ m_32
+ (if (not (fixnum? exp_3))
+ #f
+ (let-values (((fradix_0) (if (fx= radix_9 10) 10.0 (fx->fl radix_9))))
+ (if (fx< exp_3 0) (/ m_32 (expt fradix_0 (fx- 0 exp_3))) (* m_32 (expt fradix_0 exp_3)))))))
+ #f))
+ #f)))
+ #f)))))
(define-values
(finish.1)
(lambda (range16_0 sgn/z18_0 n19_0 s20_1 state21_0)
(begin
'finish
(let-values (((sgn/z_3) sgn/z18_0))
- (let-values (((n_39) n19_0))
- (let-values (((s_553) s20_1))
- (let-values (((state_41) state21_0))
+ (let-values (((n_42) n19_0))
+ (let-values (((s_850) s20_1))
+ (let-values (((state_45) state21_0))
(let-values (((range_0) range16_0))
- (let-values ()
- (let-values (((fst_3) (parse-state-fst state_41)))
- (if (let-values (((or-part_57) (not fst_3))) (if or-part_57 or-part_57 (eq? fst_3 '+/-)))
- (let-values ()
- (let-values (((tmp_42) (parse-state-exactness state_41)))
- (if (equal? tmp_42 'single)
- (let-values ()
- (let-values (((v_238) (force-lazy-inexact sgn/z_3 n_39 state_41 s_553)))
- (if (let-values (((or-part_311) (not v_238)))
- (if or-part_311 or-part_311 (string? v_238)))
- v_238
- ((lambda (r_46)
- (if (parse-state-can-single? state_41)
- (if (single-flonum-available?)
- (real->single-flonum r_46)
- (raise
- (exn:fail:unsupported
- (string-append
- "read: single-flonums are not supported on this platform\n"
- " conversion from: "
- (number->string r_46))
- (current-continuation-marks))))
- (exact->inexact r_46)))
- v_238))))
- (if (equal? tmp_42 'exact)
- (let-values ()
- (let-values (((tmp_43) n_39))
- (if (if (equal? tmp_43 +inf.0)
- #t
- (if (equal? tmp_43 -inf.0) #t (equal? tmp_43 +nan.0)))
- (let-values ()
- (if (eq? (state->convert-mode state_41) 'must-read)
- (let-values () (format "no exact representation for ~a" n_39))
- (let-values () #f)))
- (let-values ()
- (let-values (((v_239) (force-lazy-exact n_39 state_41 s_553)))
- (if (let-values (((or-part_323) (not v_239)))
- (if or-part_323 or-part_323 (string? v_239)))
- v_239
- ((lambda (r_47) (inexact->exact r_47)) v_239)))))))
- (if (equal? tmp_42 'extended)
- (let-values ()
- (if (eq? (parse-state-convert-mode state_41) 'number-or-false)
- (let-values () #f)
- (if (extflonum-available?)
- (let-values ()
- (let-values (((v_240) (force-lazy-inexact sgn/z_3 n_39 state_41 s_553 32768)))
- (if (let-values (((or-part_324) (not v_240)))
- (if or-part_324 or-part_324 (string? v_240)))
- v_240
- ((lambda (r_48) (real->extfl r_48)) v_240))))
- (let-values ()
- (let-values (((trim-s_0)
- (trim-number
- s_553
- (if range_0 (car range_0) 0)
- (if range_0 (cdr range_0) (string-length s_553)))))
- (string->number$1 trim-s_0 10 'read))))))
- (if (if (equal? tmp_42 'double)
- #t
- (if (equal? tmp_42 'inexact) #t (equal? tmp_42 'approx)))
- (let-values ()
- (let-values (((v_241) (force-lazy-inexact sgn/z_3 n_39 state_41 s_553)))
- (if (let-values (((or-part_325) (not v_241)))
- (if or-part_325 or-part_325 (string? v_241)))
- v_241
- ((lambda (r0_0) (exact->inexact r0_0)) v_241))))
- (if (equal? tmp_42 'extflonum->inexact)
- (let-values ()
- (if (eq? (state->convert-mode state_41) 'must-read)
- (let-values () (format "cannot convert extflonum to inexact in `~a`" s_553))
- (let-values () #f)))
- (if (equal? tmp_42 'extflonum->exact)
- (let-values ()
- (if (eq? (state->convert-mode state_41) 'must-read)
- (let-values () (format "cannot convert extflonum to exact in `~a`" s_553))
- (let-values () #f)))
- (let-values () (force-lazy-exact n_39 state_41 s_553))))))))))
- (if (polar-prefix? fst_3)
- (let-values ()
- (let-values (((pos_136) (polar-prefix-start fst_3)))
- (let-values (((m_28)
- (let-values (((temp60_3) (polar-prefix-sgn/z fst_3))
- ((temp61_4) (polar-prefix-n fst_3))
- ((s62_1) s_553)
- ((temp63_4) (state-first-half state_41))
- ((temp64_1) (cons 0 pos_136)))
- (finish.1 temp64_1 temp60_3 temp61_4 s62_1 temp63_4))))
- (let-values (((a_70)
- (let-values (((sgn/z65_0) sgn/z_3)
- ((n66_0) n_39)
- ((s67_0) s_553)
- ((temp68_3) (state-second-half state_41))
- ((temp69_2) (cons pos_136 (string-length s_553))))
- (finish.1 temp69_2 sgn/z65_0 n66_0 s67_0 temp68_3))))
- (if (extflonum? m_28)
- (let-values () (bad-extflonum-for-complex m_28 s_553 state_41))
- (if (extflonum? a_70)
- (let-values () (bad-extflonum-for-complex a_70 s_553 state_41))
- (let-values ()
- (let-values (((v_242) m_28))
- (if (let-values (((or-part_295) (not v_242)))
- (if or-part_295 or-part_295 (string? v_242)))
- v_242
- ((lambda (m_29)
- (let-values (((v_243) a_70))
- (if (let-values (((or-part_326) (not v_243)))
- (if or-part_326 or-part_326 (string? v_243)))
- v_243
- ((lambda (a_71)
- (let-values (((cn_0) (make-polar m_29 a_71)))
- (let-values (((tmp_44) (parse-state-exactness state_41)))
- (if (equal? tmp_44 'exact)
- (let-values () (inexact->exact cn_0))
- (let-values () cn_0)))))
- v_243))))
- v_242))))))))))
- (if fst_3
- (let-values ()
- (if (eq? (state->convert-mode state_41) 'must-read)
- (let-values () (format "missing `i` for complex number in `~.a`" s_553))
- (let-values () #f)))
- (void))))))))))))))
+ (let-values (((fst_3) (parse-state-fst state_45)))
+ (if (let-values (((or-part_614) (not fst_3))) (if or-part_614 or-part_614 (eq? fst_3 '+/-)))
+ (let-values (((tmp_45) (parse-state-exactness state_45)))
+ (if (equal? tmp_45 'single)
+ (let-values (((v_362) (force-lazy-inexact sgn/z_3 n_42 state_45 s_850)))
+ (if (let-values (((or-part_615) (not v_362))) (if or-part_615 or-part_615 (string? v_362)))
+ v_362
+ ((lambda (r_53)
+ (if (parse-state-can-single? state_45)
+ (if (single-flonum-available?)
+ (real->single-flonum r_53)
+ (raise
+ (exn:fail:unsupported
+ (string-append
+ "read: single-flonums are not supported on this platform\n"
+ " conversion from: "
+ (number->string r_53))
+ (current-continuation-marks))))
+ (exact->inexact r_53)))
+ v_362)))
+ (if (equal? tmp_45 'exact)
+ (let-values (((tmp_46) n_42))
+ (if (if (equal? tmp_46 +inf.0) #t (if (equal? tmp_46 -inf.0) #t (equal? tmp_46 +nan.0)))
+ (if (eq? (state->convert-mode state_45) 'must-read)
+ (format "no exact representation for ~a" n_42)
+ #f)
+ (let-values (((v_363) (force-lazy-exact n_42 state_45 s_850)))
+ (if (let-values (((or-part_616) (not v_363)))
+ (if or-part_616 or-part_616 (string? v_363)))
+ v_363
+ ((lambda (r_54) (inexact->exact r_54)) v_363)))))
+ (if (equal? tmp_45 'extended)
+ (if (eq? (parse-state-convert-mode state_45) 'number-or-false)
+ #f
+ (if (extflonum-available?)
+ (let-values (((v_364) (force-lazy-inexact sgn/z_3 n_42 state_45 s_850 32768)))
+ (if (let-values (((or-part_617) (not v_364)))
+ (if or-part_617 or-part_617 (string? v_364)))
+ v_364
+ ((lambda (r_55) (real->extfl r_55)) v_364)))
+ (let-values (((trim-s_0)
+ (trim-number
+ s_850
+ (if range_0 (car range_0) 0)
+ (if range_0 (cdr range_0) (string-length s_850)))))
+ (string->number$1 trim-s_0 10 'read))))
+ (if (if (equal? tmp_45 'double) #t (if (equal? tmp_45 'inexact) #t (equal? tmp_45 'approx)))
+ (let-values (((v_365) (force-lazy-inexact sgn/z_3 n_42 state_45 s_850)))
+ (if (let-values (((or-part_618) (not v_365)))
+ (if or-part_618 or-part_618 (string? v_365)))
+ v_365
+ ((lambda (r0_0) (exact->inexact r0_0)) v_365)))
+ (if (equal? tmp_45 'extflonum->inexact)
+ (if (eq? (state->convert-mode state_45) 'must-read)
+ (format "cannot convert extflonum to inexact in `~a`" s_850)
+ #f)
+ (if (equal? tmp_45 'extflonum->exact)
+ (if (eq? (state->convert-mode state_45) 'must-read)
+ (format "cannot convert extflonum to exact in `~a`" s_850)
+ #f)
+ (force-lazy-exact n_42 state_45 s_850))))))))
+ (if (polar-prefix? fst_3)
+ (let-values (((pos_174) (polar-prefix-start fst_3)))
+ (let-values (((m_33)
+ (let-values (((temp60_4) (polar-prefix-sgn/z fst_3))
+ ((temp61_2) (polar-prefix-n fst_3))
+ ((s62_0) s_850)
+ ((temp63_2) (state-first-half state_45))
+ ((temp64_3) (cons 0 pos_174)))
+ (finish.1 temp64_3 temp60_4 temp61_2 s62_0 temp63_2))))
+ (let-values (((a_76)
+ (let-values (((sgn/z65_0) sgn/z_3)
+ ((n66_0) n_42)
+ ((s67_0) s_850)
+ ((temp68_5) (state-second-half state_45))
+ ((temp69_2) (cons pos_174 (string-length s_850))))
+ (finish.1 temp69_2 sgn/z65_0 n66_0 s67_0 temp68_5))))
+ (if (extflonum? m_33)
+ (bad-extflonum-for-complex m_33 s_850 state_45)
+ (if (extflonum? a_76)
+ (bad-extflonum-for-complex a_76 s_850 state_45)
+ (let-values (((v_366) m_33))
+ (if (let-values (((or-part_619) (not v_366)))
+ (if or-part_619 or-part_619 (string? v_366)))
+ v_366
+ ((lambda (m_34)
+ (let-values (((v_367) a_76))
+ (if (let-values (((or-part_620) (not v_367)))
+ (if or-part_620 or-part_620 (string? v_367)))
+ v_367
+ ((lambda (a_77)
+ (let-values (((cn_0) (make-polar m_34 a_77)))
+ (let-values (((tmp_47) (parse-state-exactness state_45)))
+ (if (equal? tmp_47 'exact) (inexact->exact cn_0) cn_0))))
+ v_367))))
+ v_366))))))))
+ (if fst_3
+ (if (eq? (state->convert-mode state_45) 'must-read)
+ (format "missing `i` for complex number in `~.a`" s_850)
+ #f)
+ (void)))))))))))))
(define-values
(finish-imaginary)
- (lambda (sgn/z_4 n_40 s_46 start_56 end_43 state_42)
- (begin
- (let-values (((fst_4) (parse-state-fst state_42)))
- (if (if (eq? fst_4 '+/-) (fx= start_56 end_43) #f)
- (let-values ()
- (let-values (((v_244)
- (let-values (((sgn/z70_0) sgn/z_4) ((n71_0) n_40) ((s72_0) s_46) ((state73_0) state_42))
- (finish.1 #f sgn/z70_0 n71_0 s72_0 state73_0))))
- (if (let-values (((or-part_327) (not v_244))) (if or-part_327 or-part_327 (string? v_244)))
- v_244
- ((lambda (i_205)
- (if (extflonum? i_205)
- (let-values () (bad-extflonum-for-complex i_205 s_46 state_42))
- (let-values ()
- (let-values (((zero_0)
- (let-values (((tmp_45) (parse-state-other-exactness state_42)))
- (if (equal? tmp_45 'inexact) (let-values () 0.0) (let-values () 0)))))
- (make-rectangular zero_0 i_205)))))
- v_244))))
- (if (if (rect-prefix? fst_4) (fx= start_56 end_43) #f)
- (let-values ()
- (let-values (((pos_137) (rect-prefix-start fst_4)))
- (let-values (((r_49)
- (let-values (((temp74_1) (rect-prefix-sgn/z fst_4))
- ((temp75_1) (rect-prefix-n fst_4))
- ((s76_0) s_46)
- ((temp77_1) (state-first-half state_42))
- ((temp78_1) (cons 0 pos_137)))
- (finish.1 temp78_1 temp74_1 temp75_1 s76_0 temp77_1))))
- (let-values (((i_206)
- (let-values (((sgn/z79_0) sgn/z_4)
- ((n80_0) n_40)
- ((s81_0) s_46)
- ((temp82_1) (state-second-half state_42))
- ((temp83_2) (cons pos_137 (string-length s_46))))
- (finish.1 temp83_2 sgn/z79_0 n80_0 s81_0 temp82_1))))
- (if (extflonum? r_49)
- (let-values () (bad-extflonum-for-complex r_49 s_46 state_42))
- (if (extflonum? i_206)
- (let-values () (bad-extflonum-for-complex r_49 i_206 state_42))
- (let-values ()
- (let-values (((v_245) r_49))
- (if (let-values (((or-part_328) (not v_245))) (if or-part_328 or-part_328 (string? v_245)))
- v_245
- ((lambda (r_50)
- (let-values (((v_246) i_206))
- (if (let-values (((or-part_329) (not v_246)))
- (if or-part_329 or-part_329 (string? v_246)))
- v_246
- ((lambda (i_207) (make-rectangular r_50 i_207)) v_246))))
- v_245))))))))))
- (let-values () (bad-misplaced "i" s_46 state_42))))))))
+ (lambda (sgn/z_4 n_43 s_851 start_68 end_47 state_46)
+ (begin
+ (let-values (((fst_4) (parse-state-fst state_46)))
+ (if (if (eq? fst_4 '+/-) (fx= start_68 end_47) #f)
+ (let-values (((v_368)
+ (let-values (((sgn/z70_0) sgn/z_4) ((n71_0) n_43) ((s72_0) s_851) ((state73_0) state_46))
+ (finish.1 #f sgn/z70_0 n71_0 s72_0 state73_0))))
+ (if (let-values (((or-part_621) (not v_368))) (if or-part_621 or-part_621 (string? v_368)))
+ v_368
+ ((lambda (i_300)
+ (if (extflonum? i_300)
+ (bad-extflonum-for-complex i_300 s_851 state_46)
+ (let-values (((zero_0)
+ (let-values (((tmp_48) (parse-state-other-exactness state_46)))
+ (if (equal? tmp_48 'inexact) 0.0 0))))
+ (make-rectangular zero_0 i_300))))
+ v_368)))
+ (if (if (rect-prefix? fst_4) (fx= start_68 end_47) #f)
+ (let-values (((pos_175) (rect-prefix-start fst_4)))
+ (let-values (((r_56)
+ (let-values (((temp74_1) (rect-prefix-sgn/z fst_4))
+ ((temp75_1) (rect-prefix-n fst_4))
+ ((s76_0) s_851)
+ ((temp77_2) (state-first-half state_46))
+ ((temp78_1) (cons 0 pos_175)))
+ (finish.1 temp78_1 temp74_1 temp75_1 s76_0 temp77_2))))
+ (let-values (((i_301)
+ (let-values (((sgn/z79_0) sgn/z_4)
+ ((n80_0) n_43)
+ ((s81_0) s_851)
+ ((temp82_2) (state-second-half state_46))
+ ((temp83_2) (cons pos_175 (string-length s_851))))
+ (finish.1 temp83_2 sgn/z79_0 n80_0 s81_0 temp82_2))))
+ (if (extflonum? r_56)
+ (bad-extflonum-for-complex r_56 s_851 state_46)
+ (if (extflonum? i_301)
+ (bad-extflonum-for-complex r_56 i_301 state_46)
+ (let-values (((v_369) r_56))
+ (if (let-values (((or-part_622) (not v_369))) (if or-part_622 or-part_622 (string? v_369)))
+ v_369
+ ((lambda (r_57)
+ (let-values (((v_370) i_301))
+ (if (let-values (((or-part_623) (not v_370)))
+ (if or-part_623 or-part_623 (string? v_370)))
+ v_370
+ ((lambda (i_302) (make-rectangular r_57 i_302)) v_370))))
+ v_369))))))))
+ (bad-misplaced "i" s_851 state_46)))))))
(define-values
(set-exactness.1)
(lambda (override?23_0 state25_0 new-exactness26_0)
(begin
'set-exactness
- (let-values (((state_43) state25_0))
+ (let-values (((state_47) state25_0))
(let-values (((new-exactness_0) new-exactness26_0))
(let-values (((override?_0) override?23_0))
- (let-values ()
- (let-values (((exactness_1) (parse-state-exactness state_43)))
- (let-values (((result-exactness_0)
- (let-values (((tmp_46) new-exactness_0))
- (if (if (equal? tmp_46 'single) #t (equal? tmp_46 'double))
- (let-values ()
- (let-values (((tmp_47) exactness_1))
- (if (equal? tmp_47 'exact)
- (let-values () 'exact)
- (if (equal? tmp_47 'decimal-as-exact)
- (let-values () (if override?_0 new-exactness_0 'decimal-as-exact))
- (let-values () new-exactness_0)))))
- (if (equal? tmp_46 'approx)
- (let-values ()
- (let-values (((tmp_48) exactness_1))
- (if (if (equal? tmp_48 'exact)
- #t
- (if (equal? tmp_48 'inexact) #t (equal? tmp_48 'decimal-as-exact)))
- (let-values () exactness_1)
- (let-values () new-exactness_0))))
- (if (equal? tmp_46 'extended)
- (let-values ()
- (let-values (((tmp_49) exactness_1))
- (if (equal? tmp_49 'inexact)
- (let-values () 'extflonum->inexact)
- (if (equal? tmp_49 'exact)
- (let-values () 'extflonum->exact)
- (let-values () 'extended)))))
- (let-values () new-exactness_0)))))))
- (if (eq? exactness_1 result-exactness_0)
- state_43
- (let-values (((the-struct_84) state_43))
- (if (parse-state? the-struct_84)
- (let-values (((exactness84_0) result-exactness_0))
- (parse-state6.1
- exactness84_0
- (parse-state-convert-mode the-struct_84)
- (parse-state-can-single? the-struct_84)
- (parse-state-fst the-struct_84)
- (parse-state-other-exactness the-struct_84)))
- (raise-argument-error 'struct-copy "parse-state?" the-struct_84)))))))))))))
+ (let-values (((exactness_1) (parse-state-exactness state_47)))
+ (let-values (((result-exactness_0)
+ (let-values (((tmp_49) new-exactness_0))
+ (if (if (equal? tmp_49 'single) #t (equal? tmp_49 'double))
+ (let-values (((tmp_50) exactness_1))
+ (if (equal? tmp_50 'exact)
+ 'exact
+ (if (equal? tmp_50 'decimal-as-exact)
+ (if override?_0 new-exactness_0 'decimal-as-exact)
+ new-exactness_0)))
+ (if (equal? tmp_49 'approx)
+ (let-values (((tmp_51) exactness_1))
+ (if (if (equal? tmp_51 'exact)
+ #t
+ (if (equal? tmp_51 'inexact) #t (equal? tmp_51 'decimal-as-exact)))
+ exactness_1
+ new-exactness_0))
+ (if (equal? tmp_49 'extended)
+ (let-values (((tmp_52) exactness_1))
+ (if (equal? tmp_52 'inexact)
+ 'extflonum->inexact
+ (if (equal? tmp_52 'exact) 'extflonum->exact 'extended)))
+ new-exactness_0))))))
+ (if (eq? exactness_1 result-exactness_0)
+ state_47
+ (let-values (((the-struct_92) state_47))
+ (if (parse-state? the-struct_92)
+ (let-values (((exactness84_0) result-exactness_0))
+ (parse-state6.1
+ exactness84_0
+ (parse-state-convert-mode the-struct_92)
+ (parse-state-can-single? the-struct_92)
+ (parse-state-fst the-struct_92)
+ (parse-state-other-exactness the-struct_92)))
+ (raise-argument-error 'struct-copy "parse-state?" the-struct_92))))))))))))
(define-values
(set-exactness-by-char.1)
(lambda (override?28_0 state30_0 c31_0)
(begin
'set-exactness-by-char
- (let-values (((state_44) state30_0))
- (let-values (((c_20) c31_0))
+ (let-values (((state_48) state30_0))
+ (let-values (((c_139) c31_0))
(let-values (((override?_1) override?28_0))
- (let-values ()
- (let-values (((state85_0) state_44)
- ((temp86_1)
- (let-values (((tmp_50) c_20))
- (let-values (((index_4)
- (if (char? tmp_50)
- (let-values (((codepoint_0) (char->integer tmp_50)))
- (if (if (unsafe-fx>= codepoint_0 48) (unsafe-fx< codepoint_0 117) #f)
- (let-values (((tbl_1)
- '#(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_1 (unsafe-fx- codepoint_0 48)))
- 0))
- 0)))
- (if (unsafe-fx< index_4 1)
- (let-values () (void))
- (if (unsafe-fx< index_4 2)
- (let-values () 'double)
- (if (unsafe-fx< index_4 3) (let-values () 'single) (let-values () 'extended)))))))
- ((override?87_0) override?_1))
- (set-exactness.1 override?87_0 state85_0 temp86_1)))))))))
+ (let-values (((state85_0) state_48)
+ ((temp86_1)
+ (let-values (((tmp_53) c_139))
+ (let-values (((index_4)
+ (if (char? tmp_53)
+ (let-values (((codepoint_0) (char->integer tmp_53)))
+ (if (if (unsafe-fx>= codepoint_0 48) (unsafe-fx< codepoint_0 117) #f)
+ (let-values (((tbl_1)
+ '#(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_1 (unsafe-fx- codepoint_0 48)))
+ 0))
+ 0)))
+ (if (unsafe-fx< index_4 1)
+ (void)
+ (if (unsafe-fx< index_4 2) 'double (if (unsafe-fx< index_4 3) 'single 'extended))))))
+ ((override?87_0) override?_1))
+ (set-exactness.1 override?87_0 state85_0 temp86_1))))))))
(define-values
(trim-number)
- (lambda (s_554 start_57 end_44)
+ (lambda (s_852 start_69 end_48)
(begin
- (if (eqv? (string-ref s_554 start_57) '#\#)
- (let-values () (trim-number s_554 (fx+ 2 start_57) end_44))
- (if (let-values (((c_94) (string-ref s_554 (fx- end_44 1))))
- (let-values (((or-part_330) (eqv? c_94 '#\i))) (if or-part_330 or-part_330 (eqv? c_94 '#\I))))
- (let-values () (trim-number s_554 start_57 (fx- end_44 1)))
- (let-values () (substring s_554 start_57 end_44)))))))
+ (if (eqv? (string-ref s_852 start_69) '#\#)
+ (trim-number s_852 (fx+ 2 start_69) end_48)
+ (if (let-values (((c_140) (string-ref s_852 (fx- end_48 1))))
+ (let-values (((or-part_624) (eqv? c_140 '#\i))) (if or-part_624 or-part_624 (eqv? c_140 '#\I))))
+ (trim-number s_852 start_69 (fx- end_48 1))
+ (substring s_852 start_69 end_48))))))
(define-values
(add-digit)
- (lambda (d_44 c_95 radix_10)
+ (lambda (d_44 c_141 radix_10)
(begin
(if (pair? d_44)
- (let-values ()
- (let-values (((p_78) (car d_44)))
- (let-values (((digits_0) (add-digit (car p_78) c_95 radix_10)))
- (if (pair? digits_0)
- (list* (car digits_0) (cons (cdr digits_0) (cdr p_78)) (cdr d_44))
- (cons (cons digits_0 (fx+ 1 (cdr p_78))) (cdr d_44))))))
- (if (eqv? d_44 0)
- (let-values () c_95)
- (if (< d_44 (expt 2 100))
- (let-values () (+ (* d_44 radix_10) c_95))
- (let-values () (cons (cons c_95 1) d_44))))))))
+ (let-values (((p_108) (car d_44)))
+ (let-values (((digits_0) (add-digit (car p_108) c_141 radix_10)))
+ (if (pair? digits_0)
+ (list* (car digits_0) (cons (cdr digits_0) (cdr p_108)) (cdr d_44))
+ (cons (cons digits_0 (fx+ 1 (cdr p_108))) (cdr d_44)))))
+ (if (eqv? d_44 0) c_141 (if (< d_44 (expt 2 100)) (+ (* d_44 radix_10) c_141) (cons (cons c_141 1) d_44)))))))
(define-values
(digits->integer)
(lambda (d_45 radix_11)
(begin
(if (pair? d_45)
- (let-values ()
- (let-values (((len_65)
- ((letrec-values (((loop_115)
- (lambda (d_46)
- (begin 'loop (if (pair? d_46) (fx+ 1 (loop_115 (cdr d_46))) 1)))))
- loop_115)
- d_45)))
- ((letrec-values (((loop_116)
- (lambda (d_47 len_66)
- (begin
- 'loop
- (if (fx= len_66 1)
- (let-values () (if (pair? d_47) (caar d_47) d_47))
- (let-values ()
- (let-values (((hi-len_0) (fxrshift len_66 1)))
- (let-values (((lo-len_0) (fx- len_66 hi-len_0)))
- (let-values (((hi_4) (loop_116 d_47 hi-len_0)))
- ((letrec-values (((split-loop_0)
- (lambda (shift_6 hi-len_1 d_48)
- (begin
- 'split-loop
- (if (fx= hi-len_1 0)
- (+
- hi_4
- (*
- (expt radix_11 shift_6)
- (loop_116 d_48 lo-len_0)))
- (split-loop_0
- (fx+ shift_6 (cdar d_48))
- (fx- hi-len_1 1)
- (cdr d_48)))))))
- split-loop_0)
- 0
- hi-len_0
- d_47))))))))))
- loop_116)
- d_45
- len_65)))
- (let-values () d_45)))))
+ (let-values (((len_72)
+ ((letrec-values (((loop_133)
+ (lambda (d_46)
+ (begin 'loop (if (pair? d_46) (fx+ 1 (loop_133 (cdr d_46))) 1)))))
+ loop_133)
+ d_45)))
+ ((letrec-values (((loop_134)
+ (lambda (d_47 len_73)
+ (begin
+ 'loop
+ (if (fx= len_73 1)
+ (if (pair? d_47) (caar d_47) d_47)
+ (let-values (((hi-len_0) (fxrshift len_73 1)))
+ (let-values (((lo-len_0) (fx- len_73 hi-len_0)))
+ (let-values (((hi_4) (loop_134 d_47 hi-len_0)))
+ ((letrec-values (((split-loop_0)
+ (lambda (shift_6 hi-len_1 d_48)
+ (begin
+ 'split-loop
+ (if (fx= hi-len_1 0)
+ (+
+ hi_4
+ (* (expt radix_11 shift_6) (loop_134 d_48 lo-len_0)))
+ (split-loop_0
+ (fx+ shift_6 (cdar d_48))
+ (fx- hi-len_1 1)
+ (cdr d_48)))))))
+ split-loop_0)
+ 0
+ hi-len_0
+ d_47)))))))))
+ loop_134)
+ d_45
+ len_72))
+ d_45))))
(define-values
(do-string->number.1)
(lambda (radix-set?33_0 s35_0 start36_0 end37_0 radix38_0 exactness39_0 convert-mode40_0 single-mode41_0)
(begin
'do-string->number
- (let-values (((s_174) s35_0))
- (let-values (((start_58) start36_0))
- (let-values (((end_45) end37_0))
+ (let-values (((s_853) s35_0))
+ (let-values (((start_70) start36_0))
+ (let-values (((end_49) end37_0))
(let-values (((radix_12) radix38_0))
(let-values (((radix-set?_0) radix-set?33_0))
(let-values (((exactness_2) exactness39_0))
(let-values (((convert-mode_6) convert-mode40_0))
(let-values (((single-mode_3) single-mode41_0))
- (let-values ()
- (let-values (((c_96)
- (if (fx= start_58 end_45)
- 'eof
- (let-values (((c_97) (string-ref s_174 start_58)))
- (maybe-digit c_97 radix_12)))))
- (if (let-values (((or-part_331) (eqv? c_96 'eof))) (if or-part_331 or-part_331 #f))
- (let-values ()
- (if (eq? (state->convert-mode convert-mode_6) 'must-read)
- (let-values () (format "no digits"))
- (let-values () #f)))
- (if (let-values (((or-part_332) (fixnum? c_96))) (if or-part_332 or-part_332 #f))
- (let-values ()
- (read-integer
+ (let-values (((c_142)
+ (if (fx= start_70 end_49)
+ 'eof
+ (let-values (((c_143) (string-ref s_853 start_70)))
+ (maybe-digit c_143 radix_12)))))
+ (if (let-values (((or-part_625) (eqv? c_142 'eof))) (if or-part_625 or-part_625 #f))
+ (if (eq? (state->convert-mode convert-mode_6) 'must-read) (format "no digits") #f)
+ (if (let-values (((or-part_626) (fixnum? c_142))) (if or-part_626 or-part_626 #f))
+ (read-integer
+ 1
+ c_142
+ s_853
+ (fx+ 1 start_70)
+ end_49
+ radix_12
+ (init-state exactness_2 convert-mode_6 single-mode_3 #f))
+ (if (let-values (((or-part_627) (eqv? c_142 '#\#))) (if or-part_627 or-part_627 #f))
+ (let-values (((next_4) (fx+ 1 start_70)))
+ (let-values (((i_303)
+ (if (fx= next_4 end_49)
+ 'eof
+ (let-values (((c_144) (string-ref s_853 next_4)))
+ (maybe-digit c_144 10)))))
+ (if (let-values (((or-part_628) (eqv? i_303 'eof))) (if or-part_628 or-part_628 #f))
+ (if (eq? (state->convert-mode convert-mode_6) 'must-read)
+ (format "no character after `#` indicator in `~.a`" s_853)
+ #f)
+ (if (let-values (((or-part_629) (eqv? i_303 '#\e)))
+ (if or-part_629
+ or-part_629
+ (let-values (((or-part_630) (eqv? i_303 '#\E)))
+ (if or-part_630
+ or-part_630
+ (let-values (((or-part_631) (eqv? i_303 '#\i)))
+ (if or-part_631
+ or-part_631
+ (let-values (((or-part_632) (eqv? i_303 '#\I)))
+ (if or-part_632 or-part_632 #f))))))))
+ (if (let-values (((or-part_633) (eq? exactness_2 'exact)))
+ (if or-part_633 or-part_633 (eq? exactness_2 'inexact)))
+ (if (eq? (state->convert-mode convert-mode_6) 'must-read)
+ (format
+ "misplaced exactness specification at `~.a`"
+ (substring s_853 start_70 end_49))
+ #f)
+ (let-values (((s88_0) s_853)
+ ((temp89_2) (fx+ 1 next_4))
+ ((end90_0) end_49)
+ ((radix91_0) radix_12)
+ ((radix-set?92_0) radix-set?_0)
+ ((temp93_0)
+ (if (let-values (((or-part_634) (char=? i_303 '#\e)))
+ (if or-part_634 or-part_634 (char=? i_303 '#\E)))
+ 'exact
+ 'inexact))
+ ((temp94_0)
+ (if (eq? convert-mode_6 'read) 'must-read convert-mode_6))
+ ((single-mode95_0) single-mode_3))
+ (do-string->number.1
+ radix-set?92_0
+ s88_0
+ temp89_2
+ end90_0
+ radix91_0
+ temp93_0
+ temp94_0
+ single-mode95_0)))
+ (if (let-values (((or-part_635) (eqv? i_303 '#\b)))
+ (if or-part_635
+ or-part_635
+ (let-values (((or-part_636) (eqv? i_303 '#\B)))
+ (if or-part_636
+ or-part_636
+ (let-values (((or-part_637) (eqv? i_303 '#\o)))
+ (if or-part_637
+ or-part_637
+ (let-values (((or-part_638) (eqv? i_303 '#\O)))
+ (if or-part_638
+ or-part_638
+ (let-values (((or-part_639) (eqv? i_303 '#\d)))
+ (if or-part_639
+ or-part_639
+ (let-values (((or-part_640) (eqv? i_303 '#\D)))
+ (if or-part_640
+ or-part_640
+ (let-values (((or-part_641) (eqv? i_303 '#\x)))
+ (if or-part_641
+ or-part_641
+ (let-values (((or-part_642) (eqv? i_303 '#\X)))
+ (if or-part_642 or-part_642 #f))))))))))))))))
+ (if radix-set?_0
+ (if (eq? (state->convert-mode convert-mode_6) 'must-read)
+ (format
+ "misplaced radix specification at `~.a`"
+ (substring s_853 start_70 end_49))
+ #f)
+ (let-values (((radix_13)
+ (let-values (((tmp_54) i_303))
+ (if (if (equal? tmp_54 '#\b) #t (equal? tmp_54 '#\B))
+ 2
+ (if (if (equal? tmp_54 '#\o) #t (equal? tmp_54 '#\O))
+ 8
+ (if (if (equal? tmp_54 '#\d) #t (equal? tmp_54 '#\D))
+ 10
+ 16))))))
+ (let-values (((s96_1) s_853)
+ ((temp97_2) (fx+ 1 next_4))
+ ((end98_0) end_49)
+ ((radix99_0) radix_13)
+ ((temp100_0) #t)
+ ((exactness101_0) exactness_2)
+ ((temp102_3)
+ (if (eq? convert-mode_6 'read) 'must-read convert-mode_6))
+ ((single-mode103_0) single-mode_3))
+ (do-string->number.1
+ temp100_0
+ s96_1
+ temp97_2
+ end98_0
+ radix99_0
+ exactness101_0
+ temp102_3
+ single-mode103_0))))
+ (if (eq?
+ (state->convert-mode
+ (if (eq? convert-mode_6 'read) 'must-read convert-mode_6))
+ 'must-read)
+ (format
+ "bad `#` indicator `~a` at `~.a`"
+ i_303
+ (substring s_853 start_70 end_49))
+ #f))))))
+ (if (let-values (((or-part_643) (eqv? c_142 '#\+))) (if or-part_643 or-part_643 #f))
+ (read-signed
1
- c_96
- s_174
- (fx+ 1 start_58)
- end_45
+ s_853
+ (fx+ 1 start_70)
+ end_49
radix_12
- (init-state exactness_2 convert-mode_6 single-mode_3 #f)))
- (if (let-values (((or-part_333) (eqv? c_96 '#\#))) (if or-part_333 or-part_333 #f))
- (let-values ()
- (let-values (((next_4) (fx+ 1 start_58)))
- (let-values (((i_208)
- (if (fx= next_4 end_45)
- 'eof
- (let-values (((c_98) (string-ref s_174 next_4)))
- (maybe-digit c_98 10)))))
- (if (let-values (((or-part_334) (eqv? i_208 'eof)))
- (if or-part_334 or-part_334 #f))
- (let-values ()
- (if (eq? (state->convert-mode convert-mode_6) 'must-read)
- (let-values () (format "no character after `#` indicator in `~.a`" s_174))
- (let-values () #f)))
- (if (let-values (((or-part_335) (eqv? i_208 '#\e)))
- (if or-part_335
- or-part_335
- (let-values (((or-part_336) (eqv? i_208 '#\E)))
- (if or-part_336
- or-part_336
- (let-values (((or-part_281) (eqv? i_208 '#\i)))
- (if or-part_281
- or-part_281
- (let-values (((or-part_337) (eqv? i_208 '#\I)))
- (if or-part_337 or-part_337 #f))))))))
- (let-values ()
- (if (let-values (((or-part_338) (eq? exactness_2 'exact)))
- (if or-part_338 or-part_338 (eq? exactness_2 'inexact)))
- (let-values ()
- (if (eq? (state->convert-mode convert-mode_6) 'must-read)
- (let-values ()
- (format
- "misplaced exactness specification at `~.a`"
- (substring s_174 start_58 end_45)))
- (let-values () #f)))
- (let-values ()
- (let-values (((s88_0) s_174)
- ((temp89_2) (fx+ 1 next_4))
- ((end90_0) end_45)
- ((radix91_0) radix_12)
- ((radix-set?92_0) radix-set?_0)
- ((temp93_1)
- (if (let-values (((or-part_339) (char=? i_208 '#\e)))
- (if or-part_339 or-part_339 (char=? i_208 '#\E)))
- 'exact
- 'inexact))
- ((temp94_1)
- (if (eq? convert-mode_6 'read) 'must-read convert-mode_6))
- ((single-mode95_0) single-mode_3))
- (do-string->number.1
- radix-set?92_0
- s88_0
- temp89_2
- end90_0
- radix91_0
- temp93_1
- temp94_1
- single-mode95_0)))))
- (if (let-values (((or-part_340) (eqv? i_208 '#\b)))
- (if or-part_340
- or-part_340
- (let-values (((or-part_341) (eqv? i_208 '#\B)))
- (if or-part_341
- or-part_341
- (let-values (((or-part_342) (eqv? i_208 '#\o)))
- (if or-part_342
- or-part_342
- (let-values (((or-part_283) (eqv? i_208 '#\O)))
- (if or-part_283
- or-part_283
- (let-values (((or-part_343) (eqv? i_208 '#\d)))
- (if or-part_343
- or-part_343
- (let-values (((or-part_162) (eqv? i_208 '#\D)))
- (if or-part_162
- or-part_162
- (let-values (((or-part_344) (eqv? i_208 '#\x)))
- (if or-part_344
- or-part_344
- (let-values (((or-part_345)
- (eqv? i_208 '#\X)))
- (if or-part_345
- or-part_345
- #f))))))))))))))))
- (let-values ()
- (if radix-set?_0
- (let-values ()
- (if (eq? (state->convert-mode convert-mode_6) 'must-read)
- (let-values ()
- (format
- "misplaced radix specification at `~.a`"
- (substring s_174 start_58 end_45)))
- (let-values () #f)))
- (let-values ()
- (let-values (((radix_13)
- (let-values (((tmp_51) i_208))
- (if (if (equal? tmp_51 '#\b) #t (equal? tmp_51 '#\B))
- (let-values () 2)
- (if (if (equal? tmp_51 '#\o)
- #t
- (equal? tmp_51 '#\O))
- (let-values () 8)
- (if (if (equal? tmp_51 '#\d)
- #t
- (equal? tmp_51 '#\D))
- (let-values () 10)
- (let-values () 16)))))))
- (let-values (((s96_1) s_174)
- ((temp97_1) (fx+ 1 next_4))
- ((end98_0) end_45)
- ((radix99_0) radix_13)
- ((temp100_0) #t)
- ((exactness101_0) exactness_2)
- ((temp102_2)
- (if (eq? convert-mode_6 'read)
- 'must-read
- convert-mode_6))
- ((single-mode103_0) single-mode_3))
- (do-string->number.1
- temp100_0
- s96_1
- temp97_1
- end98_0
- radix99_0
- exactness101_0
- temp102_2
- single-mode103_0))))))
- (let-values ()
- (if (eq?
- (state->convert-mode
- (if (eq? convert-mode_6 'read) 'must-read convert-mode_6))
- 'must-read)
- (let-values ()
- (format
- "bad `#` indicator `~a` at `~.a`"
- i_208
- (substring s_174 start_58 end_45)))
- (let-values () #f)))))))))
- (if (let-values (((or-part_346) (eqv? c_96 '#\+))) (if or-part_346 or-part_346 #f))
- (let-values ()
- (read-signed
+ (init-state exactness_2 convert-mode_6 single-mode_3 '+/-))
+ (if (let-values (((or-part_644) (eqv? c_142 '#\-))) (if or-part_644 or-part_644 #f))
+ (read-signed
+ -1
+ s_853
+ (fx+ 1 start_70)
+ end_49
+ radix_12
+ (init-state exactness_2 convert-mode_6 single-mode_3 '+/-))
+ (if (let-values (((or-part_645) (eqv? c_142 '#\.))) (if or-part_645 or-part_645 #f))
+ (read-decimal
1
- s_174
- (fx+ 1 start_58)
- end_45
+ #f
+ 0
+ s_853
+ (fx+ 1 start_70)
+ end_49
radix_12
- (init-state exactness_2 convert-mode_6 single-mode_3 '+/-)))
- (if (let-values (((or-part_347) (eqv? c_96 '#\-))) (if or-part_347 or-part_347 #f))
- (let-values ()
- (read-signed
- -1
- s_174
- (fx+ 1 start_58)
- end_45
- radix_12
- (init-state exactness_2 convert-mode_6 single-mode_3 '+/-)))
- (if (let-values (((or-part_348) (eqv? c_96 '#\.))) (if or-part_348 or-part_348 #f))
- (let-values ()
- (read-decimal
- 1
- #f
- 0
- s_174
- (fx+ 1 start_58)
- end_45
- radix_12
- (let-values (((temp104_2)
- (init-state exactness_2 convert-mode_6 single-mode_3 #f))
- ((temp105_3) 'approx))
- (set-exactness.1 #f temp104_2 temp105_3))))
- (let-values () (bad-digit c_96 s_174 convert-mode_6)))))))))))))))))))))
+ (let-values (((temp104_1) (init-state exactness_2 convert-mode_6 single-mode_3 #f))
+ ((temp105_2) 'approx))
+ (set-exactness.1 #f temp104_1 temp105_2)))
+ (bad-digit c_142 s_853 convert-mode_6)))))))))))))))))))
(define-values
(read-signed)
- (lambda (sgn_1 s_555 start_59 end_46 radix_14 state_45)
+ (lambda (sgn_1 s_854 start_71 end_50 radix_14 state_49)
(begin
- (let-values (((c_99)
- (if (fx= start_59 end_46)
+ (let-values (((c_145)
+ (if (fx= start_71 end_50)
'eof
- (let-values (((c_100) (string-ref s_555 start_59))) (maybe-digit c_100 radix_14)))))
- (if (let-values (((or-part_18) (eqv? c_99 'eof))) (if or-part_18 or-part_18 #f))
- (let-values ()
- (if (eq? (state->convert-mode state_45) 'must-read)
- (let-values () (format "no digits in `~.a`" s_555))
- (let-values () #f)))
- (if (let-values (((or-part_349) (fixnum? c_99))) (if or-part_349 or-part_349 #f))
- (let-values () (read-integer sgn_1 c_99 s_555 (fx+ 1 start_59) end_46 radix_14 state_45))
- (if (let-values (((or-part_185) (eqv? c_99 '#\.))) (if or-part_185 or-part_185 #f))
- (let-values ()
- (read-decimal
- sgn_1
- #f
- 0
- s_555
- (fx+ 1 start_59)
- end_46
- radix_14
- (let-values (((state106_0) state_45) ((temp107_0) 'approx))
- (set-exactness.1 #f state106_0 temp107_0))))
- (if (let-values (((or-part_350) (eqv? c_99 '#\i)))
- (if or-part_350
- or-part_350
- (let-values (((or-part_351) (eqv? c_99 '#\I))) (if or-part_351 or-part_351 #f))))
- (let-values ()
- (let-values (((c2_6)
- (if (fx= (fx+ 1 start_59) end_46)
- 'eof
- (let-values (((c_101) (string-ref s_555 (fx+ 1 start_59))))
- (maybe-digit c_101 radix_14)))))
- (if (let-values (((or-part_124) (eqv? c2_6 'eof))) (if or-part_124 or-part_124 #f))
- (let-values () (finish-imaginary sgn_1 sgn_1 s_555 (fx+ 1 start_59) end_46 state_45))
- (if (let-values (((or-part_352) (eqv? c2_6 '#\n)))
- (if or-part_352
- or-part_352
- (let-values (((or-part_353) (eqv? c2_6 '#\N))) (if or-part_353 or-part_353 #f))))
- (let-values () (read-infinity sgn_1 c_99 s_555 (fx+ 2 start_59) end_46 radix_14 state_45))
- (let-values () (bad-digit c_99 s_555 state_45))))))
- (if (let-values (((or-part_354) (eqv? c_99 '#\n)))
- (if or-part_354
- or-part_354
- (let-values (((or-part_355) (eqv? c_99 '#\N))) (if or-part_355 or-part_355 #f))))
- (let-values () (read-nan c_99 s_555 (fx+ 1 start_59) end_46 radix_14 state_45))
- (let-values () (bad-digit c_99 s_555 state_45)))))))))))
+ (let-values (((c_146) (string-ref s_854 start_71))) (maybe-digit c_146 radix_14)))))
+ (if (let-values (((or-part_646) (eqv? c_145 'eof))) (if or-part_646 or-part_646 #f))
+ (if (eq? (state->convert-mode state_49) 'must-read) (format "no digits in `~.a`" s_854) #f)
+ (if (let-values (((or-part_647) (fixnum? c_145))) (if or-part_647 or-part_647 #f))
+ (read-integer sgn_1 c_145 s_854 (fx+ 1 start_71) end_50 radix_14 state_49)
+ (if (let-values (((or-part_648) (eqv? c_145 '#\.))) (if or-part_648 or-part_648 #f))
+ (read-decimal
+ sgn_1
+ #f
+ 0
+ s_854
+ (fx+ 1 start_71)
+ end_50
+ radix_14
+ (let-values (((state106_0) state_49) ((temp107_0) 'approx)) (set-exactness.1 #f state106_0 temp107_0)))
+ (if (let-values (((or-part_649) (eqv? c_145 '#\i)))
+ (if or-part_649
+ or-part_649
+ (let-values (((or-part_650) (eqv? c_145 '#\I))) (if or-part_650 or-part_650 #f))))
+ (let-values (((c2_3)
+ (if (fx= (fx+ 1 start_71) end_50)
+ 'eof
+ (let-values (((c_147) (string-ref s_854 (fx+ 1 start_71))))
+ (maybe-digit c_147 radix_14)))))
+ (if (let-values (((or-part_651) (eqv? c2_3 'eof))) (if or-part_651 or-part_651 #f))
+ (finish-imaginary sgn_1 sgn_1 s_854 (fx+ 1 start_71) end_50 state_49)
+ (if (let-values (((or-part_652) (eqv? c2_3 '#\n)))
+ (if or-part_652
+ or-part_652
+ (let-values (((or-part_653) (eqv? c2_3 '#\N))) (if or-part_653 or-part_653 #f))))
+ (read-infinity sgn_1 c_145 s_854 (fx+ 2 start_71) end_50 radix_14 state_49)
+ (bad-digit c_145 s_854 state_49))))
+ (if (let-values (((or-part_654) (eqv? c_145 '#\n)))
+ (if or-part_654
+ or-part_654
+ (let-values (((or-part_655) (eqv? c_145 '#\N))) (if or-part_655 or-part_655 #f))))
+ (read-nan c_145 s_854 (fx+ 1 start_71) end_50 radix_14 state_49)
+ (bad-digit c_145 s_854 state_49))))))))))
(define-values
(read-integer)
- (lambda (sgn_2 n_41 s_556 start_60 end_47 radix_15 state_46)
+ (lambda (sgn_2 n_44 s_855 start_72 end_51 radix_15 state_50)
(begin
- (let-values (((get-n_0) (lambda () (begin 'get-n (* sgn_2 (digits->integer n_41 radix_15))))))
- (let-values (((c_102)
- (if (fx= start_60 end_47)
+ (let-values (((get-n_0) (lambda () (begin 'get-n (* sgn_2 (digits->integer n_44 radix_15))))))
+ (let-values (((c_148)
+ (if (fx= start_72 end_51)
'eof
- (let-values (((c_103) (string-ref s_556 start_60))) (maybe-digit c_103 radix_15)))))
- (if (let-values (((or-part_356) (eqv? c_102 'eof))) (if or-part_356 or-part_356 #f))
- (let-values ()
- (let-values (((sgn108_0) sgn_2) ((temp109_2) (get-n_0)) ((s110_0) s_556) ((state111_0) state_46))
- (finish.1 #f sgn108_0 temp109_2 s110_0 state111_0)))
- (if (let-values (((or-part_199) (fixnum? c_102))) (if or-part_199 or-part_199 #f))
- (let-values ()
- (read-integer sgn_2 (add-digit n_41 c_102 radix_15) s_556 (fx+ 1 start_60) end_47 radix_15 state_46))
- (if (let-values (((or-part_357) (eqv? c_102 '#\.))) (if or-part_357 or-part_357 #f))
- (let-values ()
- (read-decimal
+ (let-values (((c_149) (string-ref s_855 start_72))) (maybe-digit c_149 radix_15)))))
+ (if (let-values (((or-part_656) (eqv? c_148 'eof))) (if or-part_656 or-part_656 #f))
+ (let-values (((sgn108_0) sgn_2) ((temp109_2) (get-n_0)) ((s110_0) s_855) ((state111_0) state_50))
+ (finish.1 #f sgn108_0 temp109_2 s110_0 state111_0))
+ (if (let-values (((or-part_657) (fixnum? c_148))) (if or-part_657 or-part_657 #f))
+ (read-integer sgn_2 (add-digit n_44 c_148 radix_15) s_855 (fx+ 1 start_72) end_51 radix_15 state_50)
+ (if (let-values (((or-part_658) (eqv? c_148 '#\.))) (if or-part_658 or-part_658 #f))
+ (read-decimal
+ sgn_2
+ (digits->integer n_44 radix_15)
+ 0
+ s_855
+ (fx+ 1 start_72)
+ end_51
+ radix_15
+ (let-values (((state112_0) state_50) ((temp113_2) 'approx)) (set-exactness.1 #f state112_0 temp113_2)))
+ (if (let-values (((or-part_659) (eqv? c_148 '#\e)))
+ (if or-part_659
+ or-part_659
+ (let-values (((or-part_660) (eqv? c_148 '#\E)))
+ (if or-part_660
+ or-part_660
+ (let-values (((or-part_661) (eqv? c_148 '#\d)))
+ (if or-part_661
+ or-part_661
+ (let-values (((or-part_662) (eqv? c_148 '#\D)))
+ (if or-part_662
+ or-part_662
+ (let-values (((or-part_663) (eqv? c_148 '#\l)))
+ (if or-part_663
+ or-part_663
+ (let-values (((or-part_664) (eqv? c_148 '#\L)))
+ (if or-part_664
+ or-part_664
+ (let-values (((or-part_665) (eqv? c_148 '#\f)))
+ (if or-part_665
+ or-part_665
+ (let-values (((or-part_666) (eqv? c_148 '#\F)))
+ (if or-part_666
+ or-part_666
+ (let-values (((or-part_667) (eqv? c_148 '#\s)))
+ (if or-part_667
+ or-part_667
+ (let-values (((or-part_668) (eqv? c_148 '#\S)))
+ (if or-part_668
+ or-part_668
+ (let-values (((or-part_669) (eqv? c_148 '#\t)))
+ (if or-part_669
+ or-part_669
+ (let-values (((or-part_670) (eqv? c_148 '#\T)))
+ (if or-part_670 or-part_670 #f))))))))))))))))))))))))
+ (read-exponent
sgn_2
- (digits->integer n_41 radix_15)
+ (get-n_0)
0
- s_556
- (fx+ 1 start_60)
- end_47
+ s_855
+ (fx+ 1 start_72)
+ end_51
radix_15
- (let-values (((state112_0) state_46) ((temp113_1) 'approx))
- (set-exactness.1 #f state112_0 temp113_1))))
- (if (let-values (((or-part_358) (eqv? c_102 '#\e)))
- (if or-part_358
- or-part_358
- (let-values (((or-part_359) (eqv? c_102 '#\E)))
- (if or-part_359
- or-part_359
- (let-values (((or-part_360) (eqv? c_102 '#\d)))
- (if or-part_360
- or-part_360
- (let-values (((or-part_125) (eqv? c_102 '#\D)))
- (if or-part_125
- or-part_125
- (let-values (((or-part_361) (eqv? c_102 '#\l)))
- (if or-part_361
- or-part_361
- (let-values (((or-part_362) (eqv? c_102 '#\L)))
- (if or-part_362
- or-part_362
- (let-values (((or-part_229) (eqv? c_102 '#\f)))
- (if or-part_229
- or-part_229
- (let-values (((or-part_363) (eqv? c_102 '#\F)))
- (if or-part_363
- or-part_363
- (let-values (((or-part_364) (eqv? c_102 '#\s)))
- (if or-part_364
- or-part_364
- (let-values (((or-part_365) (eqv? c_102 '#\S)))
- (if or-part_365
- or-part_365
- (let-values (((or-part_126) (eqv? c_102 '#\t)))
- (if or-part_126
- or-part_126
- (let-values (((or-part_127) (eqv? c_102 '#\T)))
- (if or-part_127 or-part_127 #f))))))))))))))))))))))))
- (let-values ()
- (read-exponent
- sgn_2
- (get-n_0)
- 0
- s_556
- (fx+ 1 start_60)
- end_47
- radix_15
- (let-values (((state114_0) state_46) ((c115_0) c_102))
- (set-exactness-by-char.1 #f state114_0 c115_0))))
- (if (let-values (((or-part_366) (eqv? c_102 '#\/))) (if or-part_366 or-part_366 #f))
- (let-values () (read-rational sgn_2 (get-n_0) #f s_556 (fx+ 1 start_60) end_47 radix_15 state_46))
- (if (let-values (((or-part_367) (eqv? c_102 '#\#))) (if or-part_367 or-part_367 #f))
- (let-values ()
- (read-approx
+ (let-values (((state114_0) state_50) ((c115_0) c_148))
+ (set-exactness-by-char.1 #f state114_0 c115_0)))
+ (if (let-values (((or-part_671) (eqv? c_148 '#\/))) (if or-part_671 or-part_671 #f))
+ (read-rational sgn_2 (get-n_0) #f s_855 (fx+ 1 start_72) end_51 radix_15 state_50)
+ (if (let-values (((or-part_672) (eqv? c_148 '#\#))) (if or-part_672 or-part_672 #f))
+ (read-approx
+ sgn_2
+ (digits->integer n_44 radix_15)
+ 1
+ #f
+ s_855
+ (fx+ 1 start_72)
+ end_51
+ radix_15
+ (let-values (((state116_0) state_50) ((temp117_1) 'approx))
+ (set-exactness.1 #f state116_0 temp117_1)))
+ (if (let-values (((or-part_673) (eqv? c_148 '#\+)))
+ (if or-part_673
+ or-part_673
+ (let-values (((or-part_674) (eqv? c_148 '#\-))) (if or-part_674 or-part_674 #f))))
+ (read-imag
+ c_148
sgn_2
- (digits->integer n_41 radix_15)
- 1
- #f
- s_556
- (fx+ 1 start_60)
- end_47
+ (get-n_0)
+ (if (eqv? c_148 '#\+) 1 -1)
+ s_855
+ (fx+ 1 start_72)
+ end_51
radix_15
- (let-values (((state116_0) state_46) ((temp117_3) 'approx))
- (set-exactness.1 #f state116_0 temp117_3))))
- (if (let-values (((or-part_368) (eqv? c_102 '#\+)))
- (if or-part_368
- or-part_368
- (let-values (((or-part_285) (eqv? c_102 '#\-))) (if or-part_285 or-part_285 #f))))
- (let-values ()
- (read-imag
- c_102
- sgn_2
- (get-n_0)
- (if (eqv? c_102 '#\+) 1 -1)
- s_556
- (fx+ 1 start_60)
- end_47
- radix_15
- state_46))
- (if (let-values (((or-part_369) (eqv? c_102 '#\@))) (if or-part_369 or-part_369 #f))
- (let-values () (read-polar sgn_2 (get-n_0) s_556 (fx+ 1 start_60) end_47 radix_15 state_46))
- (if (let-values (((or-part_370) (eqv? c_102 '#\i)))
- (if or-part_370
- or-part_370
- (let-values (((or-part_371) (eqv? c_102 '#\I))) (if or-part_371 or-part_371 #f))))
- (let-values () (finish-imaginary sgn_2 (get-n_0) s_556 (fx+ 1 start_60) end_47 state_46))
- (let-values () (bad-digit c_102 s_556 state_46))))))))))))))))
+ state_50)
+ (if (let-values (((or-part_675) (eqv? c_148 '#\@))) (if or-part_675 or-part_675 #f))
+ (read-polar sgn_2 (get-n_0) s_855 (fx+ 1 start_72) end_51 radix_15 state_50)
+ (if (let-values (((or-part_676) (eqv? c_148 '#\i)))
+ (if or-part_676
+ or-part_676
+ (let-values (((or-part_677) (eqv? c_148 '#\I))) (if or-part_677 or-part_677 #f))))
+ (finish-imaginary sgn_2 (get-n_0) s_855 (fx+ 1 start_72) end_51 state_50)
+ (bad-digit c_148 s_855 state_50)))))))))))))))
(define-values
(read-decimal)
- (lambda (sgn_3 n_42 exp_4 s_557 start_61 end_48 radix_16 state_47)
+ (lambda (sgn_3 n_45 exp_4 s_856 start_73 end_52 radix_16 state_51)
(begin
(let-values (((get-n_1)
(lambda ()
(begin
'get-n
- (if n_42
- (lazy-number (* sgn_3 (digits->integer n_42 radix_16)) radix_16 (- exp_4))
- (bad-no-digits "." s_557 state_47))))))
- (let-values (((c_104)
- (if (fx= start_61 end_48)
+ (if n_45
+ (lazy-number (* sgn_3 (digits->integer n_45 radix_16)) radix_16 (- exp_4))
+ (bad-no-digits "." s_856 state_51))))))
+ (let-values (((c_150)
+ (if (fx= start_73 end_52)
'eof
- (let-values (((c_105) (string-ref s_557 start_61))) (maybe-digit c_105 radix_16)))))
- (if (let-values (((or-part_372) (eqv? c_104 'eof))) (if or-part_372 or-part_372 #f))
- (let-values ()
- (let-values (((or-part_373)
- (if n_42
- (fast-inexact state_47 sgn_3 (digits->integer n_42 radix_16) radix_16 0 -1 exp_4)
- #f)))
- (if or-part_373
- or-part_373
- (let-values (((v_247) (get-n_1)))
- (if (let-values (((or-part_374) (not v_247))) (if or-part_374 or-part_374 (string? v_247)))
- v_247
- ((lambda (n_43)
- (let-values (((sgn118_0) sgn_3) ((n119_0) n_43) ((s120_0) s_557) ((state121_0) state_47))
- (finish.1 #f sgn118_0 n119_0 s120_0 state121_0)))
- v_247))))))
- (if (let-values (((or-part_375) (fixnum? c_104))) (if or-part_375 or-part_375 #f))
- (let-values ()
- (let-values (((next_5) (fx+ 1 start_61)))
- (if (if (eqv? c_104 '#\0) (fx= next_5 end_48) #f)
- (let-values ()
- (read-decimal
- sgn_3
- (let-values (((or-part_376) n_42)) (if or-part_376 or-part_376 0))
- exp_4
- s_557
- next_5
- end_48
- radix_16
- state_47))
- (let-values ()
- (read-decimal
- sgn_3
- (add-digit (let-values (((or-part_377) n_42)) (if or-part_377 or-part_377 0)) c_104 radix_16)
- (fx+ 1 exp_4)
- s_557
- (fx+ 1 start_61)
- end_48
- radix_16
- state_47)))))
- (if (let-values (((or-part_378) (eqv? c_104 '#\.))) (if or-part_378 or-part_378 #f))
- (let-values () (bad-misplaced "." s_557 state_47))
- (if (let-values (((or-part_379) (eqv? c_104 '#\e)))
- (if or-part_379
- or-part_379
- (let-values (((or-part_380) (eqv? c_104 '#\E)))
- (if or-part_380
- or-part_380
- (let-values (((or-part_381) (eqv? c_104 '#\d)))
- (if or-part_381
- or-part_381
- (let-values (((or-part_382) (eqv? c_104 '#\D)))
- (if or-part_382
- or-part_382
- (let-values (((or-part_383) (eqv? c_104 '#\l)))
- (if or-part_383
- or-part_383
- (let-values (((or-part_200) (eqv? c_104 '#\L)))
- (if or-part_200
- or-part_200
- (let-values (((or-part_201) (eqv? c_104 '#\f)))
- (if or-part_201
- or-part_201
- (let-values (((or-part_384) (eqv? c_104 '#\F)))
- (if or-part_384
- or-part_384
- (let-values (((or-part_385) (eqv? c_104 '#\s)))
- (if or-part_385
- or-part_385
- (let-values (((or-part_386) (eqv? c_104 '#\S)))
- (if or-part_386
- or-part_386
- (let-values (((or-part_387) (eqv? c_104 '#\t)))
- (if or-part_387
- or-part_387
- (let-values (((or-part_234) (eqv? c_104 '#\T)))
- (if or-part_234 or-part_234 #f))))))))))))))))))))))))
- (let-values ()
- (if n_42
- (read-exponent
- sgn_3
- (* sgn_3 (digits->integer n_42 radix_16))
- (- exp_4)
- s_557
- (fx+ 1 start_61)
- end_48
- radix_16
- (let-values (((state122_0) state_47) ((c123_0) c_104))
- (set-exactness-by-char.1 #f state122_0 c123_0)))
- (bad-no-digits "." s_557 state_47)))
- (if (let-values (((or-part_388) (eqv? c_104 '#\/))) (if or-part_388 or-part_388 #f))
- (let-values () (bad-mixed-decimal-fraction s_557 state_47))
- (if (let-values (((or-part_389) (eqv? c_104 '#\#))) (if or-part_389 or-part_389 #f))
- (let-values ()
- (if n_42
- (read-approx
+ (let-values (((c_151) (string-ref s_856 start_73))) (maybe-digit c_151 radix_16)))))
+ (if (let-values (((or-part_678) (eqv? c_150 'eof))) (if or-part_678 or-part_678 #f))
+ (let-values (((or-part_679)
+ (if n_45
+ (fast-inexact state_51 sgn_3 (digits->integer n_45 radix_16) radix_16 0 -1 exp_4)
+ #f)))
+ (if or-part_679
+ or-part_679
+ (let-values (((v_371) (get-n_1)))
+ (if (let-values (((or-part_680) (not v_371))) (if or-part_680 or-part_680 (string? v_371)))
+ v_371
+ ((lambda (n_46)
+ (let-values (((sgn118_0) sgn_3) ((n119_0) n_46) ((s120_0) s_856) ((state121_0) state_51))
+ (finish.1 #f sgn118_0 n119_0 s120_0 state121_0)))
+ v_371)))))
+ (if (let-values (((or-part_681) (fixnum? c_150))) (if or-part_681 or-part_681 #f))
+ (let-values (((next_5) (fx+ 1 start_73)))
+ (if (if (eqv? c_150 '#\0) (fx= next_5 end_52) #f)
+ (read-decimal
+ sgn_3
+ (let-values (((or-part_682) n_45)) (if or-part_682 or-part_682 0))
+ exp_4
+ s_856
+ next_5
+ end_52
+ radix_16
+ state_51)
+ (read-decimal
+ sgn_3
+ (add-digit (let-values (((or-part_683) n_45)) (if or-part_683 or-part_683 0)) c_150 radix_16)
+ (fx+ 1 exp_4)
+ s_856
+ (fx+ 1 start_73)
+ end_52
+ radix_16
+ state_51)))
+ (if (let-values (((or-part_684) (eqv? c_150 '#\.))) (if or-part_684 or-part_684 #f))
+ (bad-misplaced "." s_856 state_51)
+ (if (let-values (((or-part_685) (eqv? c_150 '#\e)))
+ (if or-part_685
+ or-part_685
+ (let-values (((or-part_686) (eqv? c_150 '#\E)))
+ (if or-part_686
+ or-part_686
+ (let-values (((or-part_687) (eqv? c_150 '#\d)))
+ (if or-part_687
+ or-part_687
+ (let-values (((or-part_688) (eqv? c_150 '#\D)))
+ (if or-part_688
+ or-part_688
+ (let-values (((or-part_689) (eqv? c_150 '#\l)))
+ (if or-part_689
+ or-part_689
+ (let-values (((or-part_690) (eqv? c_150 '#\L)))
+ (if or-part_690
+ or-part_690
+ (let-values (((or-part_691) (eqv? c_150 '#\f)))
+ (if or-part_691
+ or-part_691
+ (let-values (((or-part_692) (eqv? c_150 '#\F)))
+ (if or-part_692
+ or-part_692
+ (let-values (((or-part_693) (eqv? c_150 '#\s)))
+ (if or-part_693
+ or-part_693
+ (let-values (((or-part_694) (eqv? c_150 '#\S)))
+ (if or-part_694
+ or-part_694
+ (let-values (((or-part_695) (eqv? c_150 '#\t)))
+ (if or-part_695
+ or-part_695
+ (let-values (((or-part_696) (eqv? c_150 '#\T)))
+ (if or-part_696 or-part_696 #f))))))))))))))))))))))))
+ (if n_45
+ (read-exponent
+ sgn_3
+ (* sgn_3 (digits->integer n_45 radix_16))
+ (- exp_4)
+ s_856
+ (fx+ 1 start_73)
+ end_52
+ radix_16
+ (let-values (((state122_0) state_51) ((c123_0) c_150))
+ (set-exactness-by-char.1 #f state122_0 c123_0)))
+ (bad-no-digits "." s_856 state_51))
+ (if (let-values (((or-part_697) (eqv? c_150 '#\/))) (if or-part_697 or-part_697 #f))
+ (bad-mixed-decimal-fraction s_856 state_51)
+ (if (let-values (((or-part_698) (eqv? c_150 '#\#))) (if or-part_698 or-part_698 #f))
+ (if n_45
+ (read-approx
+ sgn_3
+ (digits->integer n_45 radix_16)
+ (fx- 0 exp_4)
+ #t
+ s_856
+ (fx+ 1 start_73)
+ end_52
+ radix_16
+ state_51)
+ (bad-misplaced "#" s_856 state_51))
+ (if (let-values (((or-part_699) (eqv? c_150 '#\+)))
+ (if or-part_699
+ or-part_699
+ (let-values (((or-part_700) (eqv? c_150 '#\-))) (if or-part_700 or-part_700 #f))))
+ (if n_45
+ (read-imag
+ c_150
sgn_3
- (digits->integer n_42 radix_16)
- (fx- 0 exp_4)
- #t
- s_557
- (fx+ 1 start_61)
- end_48
+ (get-n_1)
+ (if (eqv? c_150 '#\+) 1 -1)
+ s_856
+ (fx+ 1 start_73)
+ end_52
radix_16
- state_47)
- (bad-misplaced "#" s_557 state_47)))
- (if (let-values (((or-part_390) (eqv? c_104 '#\+)))
- (if or-part_390
- or-part_390
- (let-values (((or-part_391) (eqv? c_104 '#\-))) (if or-part_391 or-part_391 #f))))
- (let-values ()
- (if n_42
- (read-imag
- c_104
- sgn_3
- (get-n_1)
- (if (eqv? c_104 '#\+) 1 -1)
- s_557
- (fx+ 1 start_61)
- end_48
- radix_16
- state_47)
- (bad-no-digits "." s_557 state_47)))
- (if (let-values (((or-part_392) (eqv? c_104 '#\@))) (if or-part_392 or-part_392 #f))
- (let-values ()
- (let-values (((v_248) (get-n_1)))
- (if (let-values (((or-part_128) (not v_248)))
- (if or-part_128 or-part_128 (string? v_248)))
- v_248
- ((lambda (n_44) (read-polar sgn_3 n_44 s_557 (fx+ 1 start_61) end_48 radix_16 state_47))
- v_248))))
- (if (let-values (((or-part_130) (eqv? c_104 '#\i)))
- (if or-part_130
- or-part_130
- (let-values (((or-part_393) (eqv? c_104 '#\I))) (if or-part_393 or-part_393 #f))))
- (let-values ()
- (let-values (((v_249) (get-n_1)))
- (if (let-values (((or-part_164) (not v_249)))
- (if or-part_164 or-part_164 (string? v_249)))
- v_249
- ((lambda (n_45) (finish-imaginary sgn_3 n_45 s_557 (fx+ 1 start_61) end_48 state_47))
- v_249))))
- (let-values () (bad-digit c_104 s_557 state_47))))))))))))))))
+ state_51)
+ (bad-no-digits "." s_856 state_51))
+ (if (let-values (((or-part_701) (eqv? c_150 '#\@))) (if or-part_701 or-part_701 #f))
+ (let-values (((v_372) (get-n_1)))
+ (if (let-values (((or-part_702) (not v_372))) (if or-part_702 or-part_702 (string? v_372)))
+ v_372
+ ((lambda (n_47) (read-polar sgn_3 n_47 s_856 (fx+ 1 start_73) end_52 radix_16 state_51))
+ v_372)))
+ (if (let-values (((or-part_703) (eqv? c_150 '#\i)))
+ (if or-part_703
+ or-part_703
+ (let-values (((or-part_704) (eqv? c_150 '#\I))) (if or-part_704 or-part_704 #f))))
+ (let-values (((v_373) (get-n_1)))
+ (if (let-values (((or-part_705) (not v_373)))
+ (if or-part_705 or-part_705 (string? v_373)))
+ v_373
+ ((lambda (n_48) (finish-imaginary sgn_3 n_48 s_856 (fx+ 1 start_73) end_52 state_51))
+ v_373)))
+ (bad-digit c_150 s_856 state_51)))))))))))))))
(define-values
(read-approx)
- (lambda (sgn_4 n_46 exp_5 saw-.?_0 s_266 start_62 end_49 radix_17 state_48)
+ (lambda (sgn_4 n_49 exp_5 saw-.?_0 s_857 start_74 end_53 radix_17 state_52)
(begin
- (let-values (((get-n_2) (lambda () (begin 'get-n (lazy-number (* sgn_4 n_46) radix_17 exp_5)))))
- (let-values (((c_106)
- (if (fx= start_62 end_49)
+ (let-values (((get-n_2) (lambda () (begin 'get-n (lazy-number (* sgn_4 n_49) radix_17 exp_5)))))
+ (let-values (((c_152)
+ (if (fx= start_74 end_53)
'eof
- (let-values (((c_107) (string-ref s_266 start_62))) (maybe-digit c_107 radix_17)))))
- (if (let-values (((or-part_394) (eqv? c_106 'eof))) (if or-part_394 or-part_394 #f))
- (let-values ()
- (let-values (((sgn124_0) sgn_4) ((temp125_0) (get-n_2)) ((s126_0) s_266) ((state127_0) state_48))
- (finish.1 #f sgn124_0 temp125_0 s126_0 state127_0)))
- (if (let-values (((or-part_395) (fixnum? c_106))) (if or-part_395 or-part_395 #f))
- (let-values () (bad-misplaced "#" s_266 state_48))
- (if (let-values (((or-part_396) (eqv? c_106 '#\.))) (if or-part_396 or-part_396 #f))
- (let-values ()
- (if saw-.?_0
- (bad-misplaced "." s_266 state_48)
- (read-approx sgn_4 n_46 exp_5 #t s_266 (fx+ 1 start_62) end_49 radix_17 state_48)))
- (if (let-values (((or-part_397) (eqv? c_106 '#\#))) (if or-part_397 or-part_397 #f))
- (let-values ()
- (read-approx
+ (let-values (((c_153) (string-ref s_857 start_74))) (maybe-digit c_153 radix_17)))))
+ (if (let-values (((or-part_706) (eqv? c_152 'eof))) (if or-part_706 or-part_706 #f))
+ (let-values (((sgn124_0) sgn_4) ((temp125_1) (get-n_2)) ((s126_0) s_857) ((state127_0) state_52))
+ (finish.1 #f sgn124_0 temp125_1 s126_0 state127_0))
+ (if (let-values (((or-part_707) (fixnum? c_152))) (if or-part_707 or-part_707 #f))
+ (bad-misplaced "#" s_857 state_52)
+ (if (let-values (((or-part_708) (eqv? c_152 '#\.))) (if or-part_708 or-part_708 #f))
+ (if saw-.?_0
+ (bad-misplaced "." s_857 state_52)
+ (read-approx sgn_4 n_49 exp_5 #t s_857 (fx+ 1 start_74) end_53 radix_17 state_52))
+ (if (let-values (((or-part_709) (eqv? c_152 '#\#))) (if or-part_709 or-part_709 #f))
+ (read-approx
+ sgn_4
+ n_49
+ (if saw-.?_0 exp_5 (fx+ 1 exp_5))
+ saw-.?_0
+ s_857
+ (fx+ 1 start_74)
+ end_53
+ radix_17
+ state_52)
+ (if (let-values (((or-part_710) (eqv? c_152 '#\e)))
+ (if or-part_710
+ or-part_710
+ (let-values (((or-part_711) (eqv? c_152 '#\E)))
+ (if or-part_711
+ or-part_711
+ (let-values (((or-part_712) (eqv? c_152 '#\d)))
+ (if or-part_712
+ or-part_712
+ (let-values (((or-part_713) (eqv? c_152 '#\D)))
+ (if or-part_713
+ or-part_713
+ (let-values (((or-part_714) (eqv? c_152 '#\l)))
+ (if or-part_714
+ or-part_714
+ (let-values (((or-part_715) (eqv? c_152 '#\L)))
+ (if or-part_715
+ or-part_715
+ (let-values (((or-part_716) (eqv? c_152 '#\f)))
+ (if or-part_716
+ or-part_716
+ (let-values (((or-part_717) (eqv? c_152 '#\F)))
+ (if or-part_717
+ or-part_717
+ (let-values (((or-part_718) (eqv? c_152 '#\s)))
+ (if or-part_718
+ or-part_718
+ (let-values (((or-part_719) (eqv? c_152 '#\S)))
+ (if or-part_719
+ or-part_719
+ (let-values (((or-part_720) (eqv? c_152 '#\t)))
+ (if or-part_720
+ or-part_720
+ (let-values (((or-part_721) (eqv? c_152 '#\T)))
+ (if or-part_721
+ or-part_721
+ #f))))))))))))))))))))))))
+ (read-exponent
sgn_4
- n_46
- (if saw-.?_0 exp_5 (fx+ 1 exp_5))
- saw-.?_0
- s_266
- (fx+ 1 start_62)
- end_49
+ (* sgn_4 n_49)
+ exp_5
+ s_857
+ (fx+ 1 start_74)
+ end_53
radix_17
- state_48))
- (if (let-values (((or-part_398) (eqv? c_106 '#\e)))
- (if or-part_398
- or-part_398
- (let-values (((or-part_399) (eqv? c_106 '#\E)))
- (if or-part_399
- or-part_399
- (let-values (((or-part_202) (eqv? c_106 '#\d)))
- (if or-part_202
- or-part_202
- (let-values (((or-part_400) (eqv? c_106 '#\D)))
- (if or-part_400
- or-part_400
- (let-values (((or-part_401) (eqv? c_106 '#\l)))
- (if or-part_401
- or-part_401
- (let-values (((or-part_402) (eqv? c_106 '#\L)))
- (if or-part_402
- or-part_402
- (let-values (((or-part_236) (eqv? c_106 '#\f)))
- (if or-part_236
- or-part_236
- (let-values (((or-part_403) (eqv? c_106 '#\F)))
- (if or-part_403
- or-part_403
- (let-values (((or-part_404) (eqv? c_106 '#\s)))
- (if or-part_404
- or-part_404
- (let-values (((or-part_405) (eqv? c_106 '#\S)))
- (if or-part_405
- or-part_405
- (let-values (((or-part_165) (eqv? c_106 '#\t)))
- (if or-part_165
- or-part_165
- (let-values (((or-part_166) (eqv? c_106 '#\T)))
- (if or-part_166
- or-part_166
- #f))))))))))))))))))))))))
- (let-values ()
- (read-exponent
- sgn_4
- (* sgn_4 n_46)
- exp_5
- s_266
- (fx+ 1 start_62)
- end_49
- radix_17
- (let-values (((state128_0) state_48) ((c129_0) c_106))
- (set-exactness-by-char.1 #f state128_0 c129_0))))
- (if (let-values (((or-part_406) (eqv? c_106 '#\/))) (if or-part_406 or-part_406 #f))
- (let-values ()
- (if saw-.?_0
- (bad-mixed-decimal-fraction s_266 state_48)
- (read-rational sgn_4 (get-n_2) #f s_266 (fx+ 1 start_62) end_49 radix_17 state_48)))
- (if (let-values (((or-part_407) (eqv? c_106 '#\+)))
- (if or-part_407
- or-part_407
- (let-values (((or-part_408) (eqv? c_106 '#\-))) (if or-part_408 or-part_408 #f))))
- (let-values ()
- (read-imag
- c_106
- sgn_4
- (get-n_2)
- (if (eqv? c_106 '#\+) 1 -1)
- s_266
- (fx+ 1 start_62)
- end_49
- radix_17
- state_48))
- (if (let-values (((or-part_409) (eqv? c_106 '#\@))) (if or-part_409 or-part_409 #f))
- (let-values () (read-polar sgn_4 (get-n_2) s_266 (fx+ 1 start_62) end_49 radix_17 state_48))
- (if (let-values (((or-part_410) (eqv? c_106 '#\i)))
- (if or-part_410
- or-part_410
- (let-values (((or-part_411) (eqv? c_106 '#\I))) (if or-part_411 or-part_411 #f))))
- (let-values () (finish-imaginary sgn_4 (get-n_2) s_266 (fx+ 1 start_62) end_49 state_48))
- (let-values () (bad-digit c_106 s_266 state_48))))))))))))))))
+ (let-values (((state128_0) state_52) ((c129_0) c_152))
+ (set-exactness-by-char.1 #f state128_0 c129_0)))
+ (if (let-values (((or-part_722) (eqv? c_152 '#\/))) (if or-part_722 or-part_722 #f))
+ (if saw-.?_0
+ (bad-mixed-decimal-fraction s_857 state_52)
+ (read-rational sgn_4 (get-n_2) #f s_857 (fx+ 1 start_74) end_53 radix_17 state_52))
+ (if (let-values (((or-part_723) (eqv? c_152 '#\+)))
+ (if or-part_723
+ or-part_723
+ (let-values (((or-part_724) (eqv? c_152 '#\-))) (if or-part_724 or-part_724 #f))))
+ (read-imag
+ c_152
+ sgn_4
+ (get-n_2)
+ (if (eqv? c_152 '#\+) 1 -1)
+ s_857
+ (fx+ 1 start_74)
+ end_53
+ radix_17
+ state_52)
+ (if (let-values (((or-part_725) (eqv? c_152 '#\@))) (if or-part_725 or-part_725 #f))
+ (read-polar sgn_4 (get-n_2) s_857 (fx+ 1 start_74) end_53 radix_17 state_52)
+ (if (let-values (((or-part_726) (eqv? c_152 '#\i)))
+ (if or-part_726
+ or-part_726
+ (let-values (((or-part_727) (eqv? c_152 '#\I))) (if or-part_727 or-part_727 #f))))
+ (finish-imaginary sgn_4 (get-n_2) s_857 (fx+ 1 start_74) end_53 state_52)
+ (bad-digit c_152 s_857 state_52)))))))))))))))
(define-values
(read-exponent)
- (lambda (sgn_5 sgn-n_0 exp_6 s_417 start_63 end_50 radix_18 state_49)
+ (lambda (sgn_5 sgn-n_0 exp_6 s_858 start_75 end_54 radix_18 state_53)
(begin
- (let-values (((c_108)
- (if (fx= start_63 end_50)
+ (let-values (((c_154)
+ (if (fx= start_75 end_54)
'eof
- (let-values (((c_109) (string-ref s_417 start_63))) (maybe-digit c_109 radix_18)))))
- (if (let-values (((or-part_412) (eqv? c_108 'eof)))
- (if or-part_412
- or-part_412
- (let-values (((or-part_413) (eqv? c_108 '#\@))) (if or-part_413 or-part_413 #f))))
- (let-values ()
- (if (eq? (state->convert-mode state_49) 'must-read)
- (let-values () (format "empty exponent `~.a`" s_417))
- (let-values () #f)))
- (if (let-values (((or-part_414) (fixnum? c_108))) (if or-part_414 or-part_414 #f))
- (let-values ()
- (read-signed-exponent sgn_5 sgn-n_0 exp_6 1 c_108 s_417 (fx+ 1 start_63) end_50 radix_18 state_49))
- (if (let-values (((or-part_415) (eqv? c_108 '#\+)))
- (if or-part_415
- or-part_415
- (let-values (((or-part_416) (eqv? c_108 '#\-))) (if or-part_416 or-part_416 #f))))
- (let-values ()
- (let-values (((sgn2_1) (if (eqv? c_108 '#\+) 1 -1)))
- (read-signed-exponent sgn_5 sgn-n_0 exp_6 sgn2_1 #f s_417 (fx+ 1 start_63) end_50 radix_18 state_49)))
- (if (let-values (((or-part_417) (eqv? c_108 '#\.)))
- (if or-part_417
- or-part_417
- (let-values (((or-part_418) (eqv? c_108 '#\#)))
- (if or-part_418
- or-part_418
- (let-values (((or-part_21) (eqv? c_108 '#\/)))
- (if or-part_21
- or-part_21
- (let-values (((or-part_419) (eqv? c_108 '#\e)))
- (if or-part_419
- or-part_419
- (let-values (((or-part_420) (eqv? c_108 '#\E)))
- (if or-part_420
- or-part_420
- (let-values (((or-part_421) (eqv? c_108 '#\d)))
- (if or-part_421
- or-part_421
- (let-values (((or-part_422) (eqv? c_108 '#\D)))
- (if or-part_422
- or-part_422
- (let-values (((or-part_423) (eqv? c_108 '#\l)))
- (if or-part_423
- or-part_423
- (let-values (((or-part_424) (eqv? c_108 '#\L)))
- (if or-part_424
- or-part_424
- (let-values (((or-part_425) (eqv? c_108 '#\f)))
- (if or-part_425
- or-part_425
- (let-values (((or-part_426) (eqv? c_108 '#\F)))
- (if or-part_426
- or-part_426
- (let-values (((or-part_427) (eqv? c_108 '#\s)))
- (if or-part_427
- or-part_427
- (let-values (((or-part_428) (eqv? c_108 '#\S)))
- (if or-part_428
- or-part_428
- (let-values (((or-part_429) (eqv? c_108 '#\t)))
- (if or-part_429
- or-part_429
- (let-values (((or-part_430)
- (eqv? c_108 '#\T)))
- (if or-part_430
- or-part_430
+ (let-values (((c_155) (string-ref s_858 start_75))) (maybe-digit c_155 radix_18)))))
+ (if (let-values (((or-part_728) (eqv? c_154 'eof)))
+ (if or-part_728
+ or-part_728
+ (let-values (((or-part_729) (eqv? c_154 '#\@))) (if or-part_729 or-part_729 #f))))
+ (if (eq? (state->convert-mode state_53) 'must-read) (format "empty exponent `~.a`" s_858) #f)
+ (if (let-values (((or-part_730) (fixnum? c_154))) (if or-part_730 or-part_730 #f))
+ (read-signed-exponent sgn_5 sgn-n_0 exp_6 1 c_154 s_858 (fx+ 1 start_75) end_54 radix_18 state_53)
+ (if (let-values (((or-part_731) (eqv? c_154 '#\+)))
+ (if or-part_731
+ or-part_731
+ (let-values (((or-part_732) (eqv? c_154 '#\-))) (if or-part_732 or-part_732 #f))))
+ (let-values (((sgn2_1) (if (eqv? c_154 '#\+) 1 -1)))
+ (read-signed-exponent sgn_5 sgn-n_0 exp_6 sgn2_1 #f s_858 (fx+ 1 start_75) end_54 radix_18 state_53))
+ (if (let-values (((or-part_733) (eqv? c_154 '#\.)))
+ (if or-part_733
+ or-part_733
+ (let-values (((or-part_734) (eqv? c_154 '#\#)))
+ (if or-part_734
+ or-part_734
+ (let-values (((or-part_735) (eqv? c_154 '#\/)))
+ (if or-part_735
+ or-part_735
+ (let-values (((or-part_736) (eqv? c_154 '#\e)))
+ (if or-part_736
+ or-part_736
+ (let-values (((or-part_737) (eqv? c_154 '#\E)))
+ (if or-part_737
+ or-part_737
+ (let-values (((or-part_738) (eqv? c_154 '#\d)))
+ (if or-part_738
+ or-part_738
+ (let-values (((or-part_739) (eqv? c_154 '#\D)))
+ (if or-part_739
+ or-part_739
+ (let-values (((or-part_740) (eqv? c_154 '#\l)))
+ (if or-part_740
+ or-part_740
+ (let-values (((or-part_741) (eqv? c_154 '#\L)))
+ (if or-part_741
+ or-part_741
+ (let-values (((or-part_742) (eqv? c_154 '#\f)))
+ (if or-part_742
+ or-part_742
+ (let-values (((or-part_743) (eqv? c_154 '#\F)))
+ (if or-part_743
+ or-part_743
+ (let-values (((or-part_744) (eqv? c_154 '#\s)))
+ (if or-part_744
+ or-part_744
+ (let-values (((or-part_745) (eqv? c_154 '#\S)))
+ (if or-part_745
+ or-part_745
+ (let-values (((or-part_746) (eqv? c_154 '#\t)))
+ (if or-part_746
+ or-part_746
+ (let-values (((or-part_747)
+ (eqv? c_154 '#\T)))
+ (if or-part_747
+ or-part_747
#f))))))))))))))))))))))))))))))
- (let-values () (bad-misplaced c_108 s_417 state_49))
- (if (let-values (((or-part_431) (eqv? c_108 '#\i)))
- (if or-part_431
- or-part_431
- (let-values (((or-part_432) (eqv? c_108 '#\I))) (if or-part_432 or-part_432 #f))))
- (let-values ()
- (if (state-has-first-half? state_49)
- (if (eq? (state->convert-mode state_49) 'must-read)
- (let-values () (format "empty exponent `~.a`" s_417))
- (let-values () #f))
- (bad-misplaced "i" s_417 state_49)))
- (let-values () (bad-digit c_108 s_417 state_49)))))))))))
+ (bad-misplaced c_154 s_858 state_53)
+ (if (let-values (((or-part_748) (eqv? c_154 '#\i)))
+ (if or-part_748
+ or-part_748
+ (let-values (((or-part_749) (eqv? c_154 '#\I))) (if or-part_749 or-part_749 #f))))
+ (if (state-has-first-half? state_53)
+ (if (eq? (state->convert-mode state_53) 'must-read) (format "empty exponent `~.a`" s_858) #f)
+ (bad-misplaced "i" s_858 state_53))
+ (bad-digit c_154 s_858 state_53))))))))))
(define-values
(read-signed-exponent)
- (lambda (sgn_6 sgn-n_1 exp_7 sgn2_2 exp2_1 s_430 start_64 end_51 radix_19 state_50)
+ (lambda (sgn_6 sgn-n_1 exp_7 sgn2_2 exp2_1 s_859 start_76 end_55 radix_19 state_54)
(begin
(let-values (((get-n_3)
(lambda ()
@@ -60513,359 +59187,318 @@
'get-n
(if exp2_1
(lazy-number sgn-n_1 radix_19 (+ exp_7 (* sgn2_2 (digits->integer exp2_1 radix_19))))
- (if (eq? (state->convert-mode state_50) 'must-read)
- (let-values () (format "empty exponent `~.a`" s_430))
- (let-values () #f)))))))
- (let-values (((c_110)
- (if (fx= start_64 end_51)
+ (if (eq? (state->convert-mode state_54) 'must-read)
+ (format "empty exponent `~.a`" s_859)
+ #f))))))
+ (let-values (((c_156)
+ (if (fx= start_76 end_55)
'eof
- (let-values (((c_111) (string-ref s_430 start_64))) (maybe-digit c_111 radix_19)))))
- (if (let-values (((or-part_433) (eqv? c_110 'eof))) (if or-part_433 or-part_433 #f))
- (let-values ()
- (let-values (((or-part_434)
- (if exp2_1
- (if (number? sgn-n_1)
- (fast-inexact
- state_50
- (if (eqv? sgn-n_1 0) sgn_6 1)
- sgn-n_1
- radix_19
- exp_7
- sgn2_2
- (digits->integer exp2_1 radix_19))
- #f)
- #f)))
- (if or-part_434
- or-part_434
- (let-values (((v_250) (get-n_3)))
- (if (let-values (((or-part_435) (not v_250))) (if or-part_435 or-part_435 (string? v_250)))
- v_250
- ((lambda (n_47)
- (let-values (((sgn130_0) sgn_6) ((n131_0) n_47) ((s132_0) s_430) ((state133_0) state_50))
- (finish.1 #f sgn130_0 n131_0 s132_0 state133_0)))
- v_250))))))
- (if (let-values (((or-part_436) (fixnum? c_110))) (if or-part_436 or-part_436 #f))
- (let-values ()
- (let-values (((new-exp2_0)
- (add-digit
- (let-values (((or-part_237) exp2_1)) (if or-part_237 or-part_237 0))
- c_110
- radix_19)))
- (read-signed-exponent
- sgn_6
- sgn-n_1
- exp_7
- sgn2_2
- new-exp2_0
- s_430
- (fx+ 1 start_64)
- end_51
- radix_19
- state_50)))
- (if (let-values (((or-part_437) (eqv? c_110 '#\+)))
- (if or-part_437
- or-part_437
- (let-values (((or-part_207) (eqv? c_110 '#\-))) (if or-part_207 or-part_207 #f))))
- (let-values ()
- (let-values (((v_251) (get-n_3)))
- (if (let-values (((or-part_438) (not v_251))) (if or-part_438 or-part_438 (string? v_251)))
- v_251
- ((lambda (n_48)
- (read-imag
- c_110
- sgn_6
- n_48
- (if (eqv? c_110 '#\+) 1 -1)
- s_430
- (fx+ 1 start_64)
- end_51
- radix_19
- state_50))
- v_251))))
- (if (let-values (((or-part_439) (eqv? c_110 '#\.)))
- (if or-part_439
- or-part_439
- (let-values (((or-part_440) (eqv? c_110 '#\#)))
- (if or-part_440
- or-part_440
- (let-values (((or-part_441) (eqv? c_110 '#\/)))
- (if or-part_441
- or-part_441
- (let-values (((or-part_442) (eqv? c_110 '#\e)))
- (if or-part_442
- or-part_442
- (let-values (((or-part_443) (eqv? c_110 '#\E)))
- (if or-part_443
- or-part_443
- (let-values (((or-part_444) (eqv? c_110 '#\d)))
- (if or-part_444
- or-part_444
- (let-values (((or-part_445) (eqv? c_110 '#\D)))
- (if or-part_445
- or-part_445
- (let-values (((or-part_446) (eqv? c_110 '#\l)))
- (if or-part_446
- or-part_446
- (let-values (((or-part_447) (eqv? c_110 '#\L)))
- (if or-part_447
- or-part_447
- (let-values (((or-part_448) (eqv? c_110 '#\f)))
- (if or-part_448
- or-part_448
- (let-values (((or-part_449) (eqv? c_110 '#\F)))
- (if or-part_449
- or-part_449
- (let-values (((or-part_450) (eqv? c_110 '#\s)))
- (if or-part_450
- or-part_450
- (let-values (((or-part_451) (eqv? c_110 '#\S)))
- (if or-part_451
- or-part_451
- (let-values (((or-part_452) (eqv? c_110 '#\t)))
- (if or-part_452
- or-part_452
- (let-values (((or-part_453)
- (eqv? c_110 '#\T)))
- (if or-part_453
- or-part_453
+ (let-values (((c_157) (string-ref s_859 start_76))) (maybe-digit c_157 radix_19)))))
+ (if (let-values (((or-part_750) (eqv? c_156 'eof))) (if or-part_750 or-part_750 #f))
+ (let-values (((or-part_751)
+ (if exp2_1
+ (if (number? sgn-n_1)
+ (fast-inexact
+ state_54
+ (if (eqv? sgn-n_1 0) sgn_6 1)
+ sgn-n_1
+ radix_19
+ exp_7
+ sgn2_2
+ (digits->integer exp2_1 radix_19))
+ #f)
+ #f)))
+ (if or-part_751
+ or-part_751
+ (let-values (((v_374) (get-n_3)))
+ (if (let-values (((or-part_752) (not v_374))) (if or-part_752 or-part_752 (string? v_374)))
+ v_374
+ ((lambda (n_50)
+ (let-values (((sgn130_0) sgn_6) ((n131_0) n_50) ((s132_0) s_859) ((state133_0) state_54))
+ (finish.1 #f sgn130_0 n131_0 s132_0 state133_0)))
+ v_374)))))
+ (if (let-values (((or-part_753) (fixnum? c_156))) (if or-part_753 or-part_753 #f))
+ (let-values (((new-exp2_0)
+ (add-digit
+ (let-values (((or-part_754) exp2_1)) (if or-part_754 or-part_754 0))
+ c_156
+ radix_19)))
+ (read-signed-exponent
+ sgn_6
+ sgn-n_1
+ exp_7
+ sgn2_2
+ new-exp2_0
+ s_859
+ (fx+ 1 start_76)
+ end_55
+ radix_19
+ state_54))
+ (if (let-values (((or-part_755) (eqv? c_156 '#\+)))
+ (if or-part_755
+ or-part_755
+ (let-values (((or-part_756) (eqv? c_156 '#\-))) (if or-part_756 or-part_756 #f))))
+ (let-values (((v_375) (get-n_3)))
+ (if (let-values (((or-part_757) (not v_375))) (if or-part_757 or-part_757 (string? v_375)))
+ v_375
+ ((lambda (n_51)
+ (read-imag
+ c_156
+ sgn_6
+ n_51
+ (if (eqv? c_156 '#\+) 1 -1)
+ s_859
+ (fx+ 1 start_76)
+ end_55
+ radix_19
+ state_54))
+ v_375)))
+ (if (let-values (((or-part_758) (eqv? c_156 '#\.)))
+ (if or-part_758
+ or-part_758
+ (let-values (((or-part_759) (eqv? c_156 '#\#)))
+ (if or-part_759
+ or-part_759
+ (let-values (((or-part_760) (eqv? c_156 '#\/)))
+ (if or-part_760
+ or-part_760
+ (let-values (((or-part_761) (eqv? c_156 '#\e)))
+ (if or-part_761
+ or-part_761
+ (let-values (((or-part_762) (eqv? c_156 '#\E)))
+ (if or-part_762
+ or-part_762
+ (let-values (((or-part_763) (eqv? c_156 '#\d)))
+ (if or-part_763
+ or-part_763
+ (let-values (((or-part_764) (eqv? c_156 '#\D)))
+ (if or-part_764
+ or-part_764
+ (let-values (((or-part_765) (eqv? c_156 '#\l)))
+ (if or-part_765
+ or-part_765
+ (let-values (((or-part_766) (eqv? c_156 '#\L)))
+ (if or-part_766
+ or-part_766
+ (let-values (((or-part_767) (eqv? c_156 '#\f)))
+ (if or-part_767
+ or-part_767
+ (let-values (((or-part_768) (eqv? c_156 '#\F)))
+ (if or-part_768
+ or-part_768
+ (let-values (((or-part_769) (eqv? c_156 '#\s)))
+ (if or-part_769
+ or-part_769
+ (let-values (((or-part_770) (eqv? c_156 '#\S)))
+ (if or-part_770
+ or-part_770
+ (let-values (((or-part_771) (eqv? c_156 '#\t)))
+ (if or-part_771
+ or-part_771
+ (let-values (((or-part_772)
+ (eqv? c_156 '#\T)))
+ (if or-part_772
+ or-part_772
#f))))))))))))))))))))))))))))))
- (let-values () (bad-misplaced c_110 s_430 state_50))
- (if (let-values (((or-part_454) (eqv? c_110 '#\@))) (if or-part_454 or-part_454 #f))
- (let-values ()
- (let-values (((v_252) (get-n_3)))
- (if (let-values (((or-part_455) (not v_252))) (if or-part_455 or-part_455 (string? v_252)))
- v_252
- ((lambda (n_49) (read-polar sgn_6 n_49 s_430 (fx+ 1 start_64) end_51 radix_19 state_50))
- v_252))))
- (if (let-values (((or-part_456) (eqv? c_110 '#\i)))
- (if or-part_456
- or-part_456
- (let-values (((or-part_457) (eqv? c_110 '#\I))) (if or-part_457 or-part_457 #f))))
- (let-values ()
- (let-values (((v_253) (get-n_3)))
- (if (let-values (((or-part_458) (not v_253))) (if or-part_458 or-part_458 (string? v_253)))
- v_253
- ((lambda (n_50) (finish-imaginary sgn_6 n_50 s_430 (fx+ 1 start_64) end_51 state_50))
- v_253))))
- (let-values () (bad-digit c_110 s_430 state_50)))))))))))))
+ (bad-misplaced c_156 s_859 state_54)
+ (if (let-values (((or-part_773) (eqv? c_156 '#\@))) (if or-part_773 or-part_773 #f))
+ (let-values (((v_376) (get-n_3)))
+ (if (let-values (((or-part_774) (not v_376))) (if or-part_774 or-part_774 (string? v_376)))
+ v_376
+ ((lambda (n_52) (read-polar sgn_6 n_52 s_859 (fx+ 1 start_76) end_55 radix_19 state_54))
+ v_376)))
+ (if (let-values (((or-part_775) (eqv? c_156 '#\i)))
+ (if or-part_775
+ or-part_775
+ (let-values (((or-part_776) (eqv? c_156 '#\I))) (if or-part_776 or-part_776 #f))))
+ (let-values (((v_377) (get-n_3)))
+ (if (let-values (((or-part_777) (not v_377))) (if or-part_777 or-part_777 (string? v_377)))
+ v_377
+ ((lambda (n_53) (finish-imaginary sgn_6 n_53 s_859 (fx+ 1 start_76) end_55 state_54)) v_377)))
+ (bad-digit c_156 s_859 state_54))))))))))))
(define-values
(read-infinity)
- (lambda (sgn_7 c_112 s_438 start_65 end_52 radix_20 state_51)
- (begin
- (let-values (((fail_6) (lambda () (begin 'fail (bad-digit c_112 s_438 state_51)))))
- (let-values (((start+n_0) (fx+ start_65 0)))
- (let-values (((var_0) (if (fx= start+n_0 end_52) 'eof (string-ref s_438 start+n_0))))
- (let-values (((tmp_52) var_0))
- (if (if (equal? tmp_52 '#\f) #t (equal? tmp_52 '#\F))
- (let-values ()
- (let-values (((fail_7) (lambda () (begin 'fail (fail_6)))))
- (let-values (((start+n_1) (fx+ start_65 (+ 0 1))))
- (let-values (((var_1) (if (fx= start+n_1 end_52) 'eof (string-ref s_438 start+n_1))))
- (let-values (((tmp_53) var_1))
- (if (equal? tmp_53 '#\.)
- (let-values ()
- (let-values (((fail_8) (lambda () (begin 'fail (fail_7)))))
- (let-values (((start+n_2) (fx+ start_65 (+ (+ 0 1) 1))))
- (let-values (((var_2) (if (fx= start+n_2 end_52) 'eof (string-ref s_438 start+n_2))))
- (let-values (((tmp_54) var_2))
- (if (if (equal? tmp_54 '#\0)
+ (lambda (sgn_7 c_158 s_860 start_77 end_56 radix_20 state_55)
+ (begin
+ (let-values (((fail_6) (lambda () (begin 'fail (bad-digit c_158 s_860 state_55)))))
+ (let-values (((start+n_0) (fx+ start_77 0)))
+ (let-values (((var_0) (if (fx= start+n_0 end_56) 'eof (string-ref s_860 start+n_0))))
+ (let-values (((tmp_55) var_0))
+ (if (if (equal? tmp_55 '#\f) #t (equal? tmp_55 '#\F))
+ (let-values (((fail_7) (lambda () (begin 'fail (fail_6)))))
+ (let-values (((start+n_1) (fx+ start_77 (+ 0 1))))
+ (let-values (((var_1) (if (fx= start+n_1 end_56) 'eof (string-ref s_860 start+n_1))))
+ (let-values (((tmp_56) var_1))
+ (if (equal? tmp_56 '#\.)
+ (let-values (((fail_8) (lambda () (begin 'fail (fail_7)))))
+ (let-values (((start+n_2) (fx+ start_77 (+ (+ 0 1) 1))))
+ (let-values (((var_2) (if (fx= start+n_2 end_56) 'eof (string-ref s_860 start+n_2))))
+ (let-values (((tmp_57) var_2))
+ (if (if (equal? tmp_57 '#\0)
+ #t
+ (if (equal? tmp_57 '#\f)
+ #t
+ (if (equal? tmp_57 '#\t)
#t
- (if (equal? tmp_54 '#\f)
- #t
- (if (equal? tmp_54 '#\t)
- #t
- (if (equal? tmp_54 '#\F) #t (equal? tmp_54 '#\T)))))
- (let-values ()
- (let-values ()
- (let-values (((n_51) (if (negative? sgn_7) -inf.0 +inf.0)))
- (let-values (((new-state_0)
- (let-values (((state134_0) state_51)
- ((temp135_1)
- (string-ref s_438 (fx+ start_65 2)))
- ((temp136_4) #t))
- (set-exactness-by-char.1
- temp136_4
- state134_0
- temp135_1))))
- (let-values (((c2_7)
- (if (fx= (fx+ 3 start_65) end_52)
- 'eof
- (let-values (((c_113)
- (string-ref s_438 (fx+ 3 start_65))))
- (maybe-digit c_113 radix_20)))))
- (if (let-values (((or-part_459) (eqv? c2_7 'eof)))
- (if or-part_459 or-part_459 #f))
- (let-values ()
- (let-values (((sgn137_0) sgn_7)
- ((n138_0) n_51)
- ((s139_0) s_438)
- ((new-state140_0) new-state_0))
- (finish.1 #f sgn137_0 n138_0 s139_0 new-state140_0)))
- (if (let-values (((or-part_460) (eqv? c2_7 '#\+)))
- (if or-part_460
- or-part_460
- (let-values (((or-part_461) (eqv? c2_7 '#\-)))
- (if or-part_461 or-part_461 #f))))
- (let-values ()
+ (if (equal? tmp_57 '#\F) #t (equal? tmp_57 '#\T)))))
+ (let-values (((n_54) (if (negative? sgn_7) -inf.0 +inf.0)))
+ (let-values (((new-state_0)
+ (let-values (((state134_0) state_55)
+ ((temp135_1) (string-ref s_860 (fx+ start_77 2)))
+ ((temp136_4) #t))
+ (set-exactness-by-char.1 temp136_4 state134_0 temp135_1))))
+ (let-values (((c2_4)
+ (if (fx= (fx+ 3 start_77) end_56)
+ 'eof
+ (let-values (((c_159) (string-ref s_860 (fx+ 3 start_77))))
+ (maybe-digit c_159 radix_20)))))
+ (if (let-values (((or-part_778) (eqv? c2_4 'eof)))
+ (if or-part_778 or-part_778 #f))
+ (let-values (((sgn137_0) sgn_7)
+ ((n138_0) n_54)
+ ((s139_0) s_860)
+ ((new-state140_0) new-state_0))
+ (finish.1 #f sgn137_0 n138_0 s139_0 new-state140_0))
+ (if (let-values (((or-part_779) (eqv? c2_4 '#\+)))
+ (if or-part_779
+ or-part_779
+ (let-values (((or-part_780) (eqv? c2_4 '#\-)))
+ (if or-part_780 or-part_780 #f))))
+ (read-imag
+ c2_4
+ sgn_7
+ n_54
+ (if (eqv? c2_4 '#\+) 1 -1)
+ s_860
+ (fx+ 4 start_77)
+ end_56
+ radix_20
+ new-state_0)
+ (if (let-values (((or-part_781) (eqv? c2_4 '#\@)))
+ (if or-part_781 or-part_781 #f))
+ (read-polar
+ sgn_7
+ n_54
+ s_860
+ (fx+ 4 start_77)
+ end_56
+ radix_20
+ new-state_0)
+ (if (let-values (((or-part_782) (eqv? c2_4 '#\i)))
+ (if or-part_782
+ or-part_782
+ (let-values (((or-part_783) (eqv? c2_4 '#\I)))
+ (if or-part_783 or-part_783 #f))))
+ (finish-imaginary
+ sgn_7
+ n_54
+ s_860
+ (fx+ 4 start_77)
+ end_56
+ new-state_0)
+ (bad-digit c_158 s_860 state_55))))))))
+ (fail_8))))))
+ (fail_7))))))
+ (fail_6)))))))))
+ (define-values
+ (read-nan)
+ (lambda (c_160 s_861 start_78 end_57 radix_21 state_56)
+ (begin
+ (let-values (((fail_9) (lambda () (begin 'fail (bad-digit c_160 s_861 state_56)))))
+ (let-values (((start+n_3) (fx+ start_78 0)))
+ (let-values (((var_3) (if (fx= start+n_3 end_57) 'eof (string-ref s_861 start+n_3))))
+ (let-values (((tmp_58) var_3))
+ (if (if (equal? tmp_58 '#\a) #t (equal? tmp_58 '#\A))
+ (let-values (((fail_10) (lambda () (begin 'fail (fail_9)))))
+ (let-values (((start+n_4) (fx+ start_78 (+ 0 1))))
+ (let-values (((var_4) (if (fx= start+n_4 end_57) 'eof (string-ref s_861 start+n_4))))
+ (let-values (((tmp_59) var_4))
+ (if (if (equal? tmp_59 '#\n) #t (equal? tmp_59 '#\N))
+ (let-values (((fail_11) (lambda () (begin 'fail (fail_10)))))
+ (let-values (((start+n_5) (fx+ start_78 (+ (+ 0 1) 1))))
+ (let-values (((var_5) (if (fx= start+n_5 end_57) 'eof (string-ref s_861 start+n_5))))
+ (let-values (((tmp_60) var_5))
+ (if (equal? tmp_60 '#\.)
+ (let-values (((fail_12) (lambda () (begin 'fail (fail_11)))))
+ (let-values (((start+n_6) (fx+ start_78 (+ (+ (+ 0 1) 1) 1))))
+ (let-values (((var_6)
+ (if (fx= start+n_6 end_57) 'eof (string-ref s_861 start+n_6))))
+ (let-values (((tmp_61) var_6))
+ (if (if (equal? tmp_61 '#\0)
+ #t
+ (if (equal? tmp_61 '#\f)
+ #t
+ (if (equal? tmp_61 '#\t)
+ #t
+ (if (equal? tmp_61 '#\F) #t (equal? tmp_61 '#\T)))))
+ (let-values (((n_55) +nan.0))
+ (let-values (((new-state_1)
+ (let-values (((state141_0) state_56)
+ ((temp142_2)
+ (string-ref s_861 (fx+ start_78 3)))
+ ((temp143_2) #t))
+ (set-exactness-by-char.1
+ temp143_2
+ state141_0
+ temp142_2))))
+ (let-values (((c2_5)
+ (if (fx= (fx+ 4 start_78) end_57)
+ 'eof
+ (let-values (((c_161)
+ (string-ref s_861 (fx+ 4 start_78))))
+ (maybe-digit c_161 radix_21)))))
+ (if (let-values (((or-part_784) (eqv? c2_5 'eof)))
+ (if or-part_784 or-part_784 #f))
+ (let-values (((temp144_1) 1)
+ ((n145_0) n_55)
+ ((s146_0) s_861)
+ ((new-state147_0) new-state_1))
+ (finish.1 #f temp144_1 n145_0 s146_0 new-state147_0))
+ (if (let-values (((or-part_785) (eqv? c2_5 '#\+)))
+ (if or-part_785
+ or-part_785
+ (let-values (((or-part_786) (eqv? c2_5 '#\-)))
+ (if or-part_786 or-part_786 #f))))
(read-imag
- c2_7
- sgn_7
- n_51
- (if (eqv? c2_7 '#\+) 1 -1)
- s_438
- (fx+ 4 start_65)
- end_52
- radix_20
- new-state_0))
- (if (let-values (((or-part_462) (eqv? c2_7 '#\@)))
- (if or-part_462 or-part_462 #f))
- (let-values ()
+ c2_5
+ 1
+ n_55
+ (if (eqv? c2_5 '#\+) 1 -1)
+ s_861
+ (fx+ 5 start_78)
+ end_57
+ radix_21
+ new-state_1)
+ (if (let-values (((or-part_787) (eqv? c2_5 '#\@)))
+ (if or-part_787 or-part_787 #f))
(read-polar
- sgn_7
- n_51
- s_438
- (fx+ 4 start_65)
- end_52
- radix_20
- new-state_0))
- (if (let-values (((or-part_463) (eqv? c2_7 '#\i)))
- (if or-part_463
- or-part_463
- (let-values (((or-part_464) (eqv? c2_7 '#\I)))
- (if or-part_464 or-part_464 #f))))
- (let-values ()
+ 1
+ n_55
+ s_861
+ (fx+ 5 start_78)
+ end_57
+ radix_21
+ new-state_1)
+ (if (let-values (((or-part_788) (eqv? c2_5 '#\i)))
+ (if or-part_788
+ or-part_788
+ (let-values (((or-part_789) (eqv? c2_5 '#\I)))
+ (if or-part_789 or-part_789 #f))))
(finish-imaginary
- sgn_7
- n_51
- s_438
- (fx+ 4 start_65)
- end_52
- new-state_0))
- (let-values () (bad-digit c_112 s_438 state_51)))))))))))
- (let-values () (fail_8))))))))
- (let-values () (fail_7))))))))
- (let-values () (fail_6))))))))))
- (define-values
- (read-nan)
- (lambda (c_114 s_196 start_66 end_53 radix_21 state_52)
- (begin
- (let-values (((fail_9) (lambda () (begin 'fail (bad-digit c_114 s_196 state_52)))))
- (let-values (((start+n_3) (fx+ start_66 0)))
- (let-values (((var_3) (if (fx= start+n_3 end_53) 'eof (string-ref s_196 start+n_3))))
- (let-values (((tmp_55) var_3))
- (if (if (equal? tmp_55 '#\a) #t (equal? tmp_55 '#\A))
- (let-values ()
- (let-values (((fail_10) (lambda () (begin 'fail (fail_9)))))
- (let-values (((start+n_4) (fx+ start_66 (+ 0 1))))
- (let-values (((var_4) (if (fx= start+n_4 end_53) 'eof (string-ref s_196 start+n_4))))
- (let-values (((tmp_56) var_4))
- (if (if (equal? tmp_56 '#\n) #t (equal? tmp_56 '#\N))
- (let-values ()
- (let-values (((fail_11) (lambda () (begin 'fail (fail_10)))))
- (let-values (((start+n_5) (fx+ start_66 (+ (+ 0 1) 1))))
- (let-values (((var_5) (if (fx= start+n_5 end_53) 'eof (string-ref s_196 start+n_5))))
- (let-values (((tmp_57) var_5))
- (if (equal? tmp_57 '#\.)
- (let-values ()
- (let-values (((fail_12) (lambda () (begin 'fail (fail_11)))))
- (let-values (((start+n_6) (fx+ start_66 (+ (+ (+ 0 1) 1) 1))))
- (let-values (((var_6)
- (if (fx= start+n_6 end_53)
- 'eof
- (string-ref s_196 start+n_6))))
- (let-values (((tmp_58) var_6))
- (if (if (equal? tmp_58 '#\0)
- #t
- (if (equal? tmp_58 '#\f)
- #t
- (if (equal? tmp_58 '#\t)
- #t
- (if (equal? tmp_58 '#\F) #t (equal? tmp_58 '#\T)))))
- (let-values ()
- (let-values ()
- (let-values (((n_52) +nan.0))
- (let-values (((new-state_1)
- (let-values (((state141_0) state_52)
- ((temp142_0)
- (string-ref
- s_196
- (fx+ start_66 3)))
- ((temp143_2) #t))
- (set-exactness-by-char.1
- temp143_2
- state141_0
- temp142_0))))
- (let-values (((c2_8)
- (if (fx= (fx+ 4 start_66) end_53)
- 'eof
- (let-values (((c_115)
- (string-ref
- s_196
- (fx+ 4 start_66))))
- (maybe-digit c_115 radix_21)))))
- (if (let-values (((or-part_465) (eqv? c2_8 'eof)))
- (if or-part_465 or-part_465 #f))
- (let-values ()
- (let-values (((temp144_1) 1)
- ((n145_0) n_52)
- ((s146_0) s_196)
- ((new-state147_0) new-state_1))
- (finish.1
- #f
- temp144_1
- n145_0
- s146_0
- new-state147_0)))
- (if (let-values (((or-part_466) (eqv? c2_8 '#\+)))
- (if or-part_466
- or-part_466
- (let-values (((or-part_467) (eqv? c2_8 '#\-)))
- (if or-part_467 or-part_467 #f))))
- (let-values ()
- (read-imag
- c2_8
- 1
- n_52
- (if (eqv? c2_8 '#\+) 1 -1)
- s_196
- (fx+ 5 start_66)
- end_53
- radix_21
- new-state_1))
- (if (let-values (((or-part_468) (eqv? c2_8 '#\@)))
- (if or-part_468 or-part_468 #f))
- (let-values ()
- (read-polar
- 1
- n_52
- s_196
- (fx+ 5 start_66)
- end_53
- radix_21
- new-state_1))
- (if (let-values (((or-part_469) (eqv? c2_8 '#\i)))
- (if or-part_469
- or-part_469
- (let-values (((or-part_470)
- (eqv? c2_8 '#\I)))
- (if or-part_470 or-part_470 #f))))
- (let-values ()
- (finish-imaginary
- 1
- n_52
- s_196
- (fx+ 5 start_66)
- end_53
- new-state_1))
- (let-values ()
- (bad-digit c_114 s_196 state_52)))))))))))
- (let-values () (fail_12))))))))
- (let-values () (fail_11))))))))
- (let-values () (fail_10))))))))
- (let-values () (fail_9))))))))))
+ 1
+ n_55
+ s_861
+ (fx+ 5 start_78)
+ end_57
+ new-state_1)
+ (bad-digit c_160 s_861 state_56))))))))
+ (fail_12))))))
+ (fail_11))))))
+ (fail_10))))))
+ (fail_9)))))))))
(define-values
(read-rational)
- (lambda (sgn_8 sgn-n_2 d_49 s_558 start_67 end_54 radix_22 state_53)
+ (lambda (sgn_8 sgn-n_2 d_49 s_862 start_79 end_58 radix_22 state_57)
(begin
(let-values (((get-n_4)
(lambda ()
@@ -60873,1467 +59506,1339 @@
'get-n
(if d_49
(lazy-divide sgn-n_2 (digits->integer d_49 radix_22) 'exact)
- (bad-no-digits "/" s_558 state_53))))))
- (let-values (((c_116)
- (if (fx= start_67 end_54)
+ (bad-no-digits "/" s_862 state_57))))))
+ (let-values (((c_162)
+ (if (fx= start_79 end_58)
'eof
- (let-values (((c_117) (string-ref s_558 start_67))) (maybe-digit c_117 radix_22)))))
- (if (let-values (((or-part_471) (eqv? c_116 'eof))) (if or-part_471 or-part_471 #f))
- (let-values ()
- (let-values (((v_254) (get-n_4)))
- (if (let-values (((or-part_241) (not v_254))) (if or-part_241 or-part_241 (string? v_254)))
- v_254
- ((lambda (n_53)
- (let-values (((sgn148_0) sgn_8) ((n149_0) n_53) ((s150_0) s_558) ((state151_0) state_53))
- (finish.1 #f sgn148_0 n149_0 s150_0 state151_0)))
- v_254))))
- (if (let-values (((or-part_472) (fixnum? c_116))) (if or-part_472 or-part_472 #f))
- (let-values ()
- (read-rational
- sgn_8
- sgn-n_2
- (add-digit (let-values (((or-part_473) d_49)) (if or-part_473 or-part_473 0)) c_116 radix_22)
- s_558
- (fx+ 1 start_67)
- end_54
- radix_22
- state_53))
- (if (let-values (((or-part_474) (eqv? c_116 '#\.))) (if or-part_474 or-part_474 #f))
- (let-values () (bad-mixed-decimal-fraction s_558 state_53))
- (if (let-values (((or-part_475) (eqv? c_116 '#\#))) (if or-part_475 or-part_475 #f))
- (let-values ()
- (if d_49
- (read-denom-approx
- sgn_8
- sgn-n_2
- (digits->integer d_49 radix_22)
- 1
- s_558
- (fx+ 1 start_67)
- end_54
- radix_22
- (let-values (((state152_0) state_53) ((temp153_2) 'approx))
- (set-exactness.1 #f state152_0 temp153_2)))
- (bad-misplaced "#" s_558 state_53)))
- (if (let-values (((or-part_476) (eqv? c_116 '#\e)))
- (if or-part_476
- or-part_476
- (let-values (((or-part_477) (eqv? c_116 '#\E)))
- (if or-part_477
- or-part_477
- (let-values (((or-part_478) (eqv? c_116 '#\d)))
- (if or-part_478
- or-part_478
- (let-values (((or-part_479) (eqv? c_116 '#\D)))
- (if or-part_479
- or-part_479
- (let-values (((or-part_480) (eqv? c_116 '#\l)))
- (if or-part_480
- or-part_480
- (let-values (((or-part_289) (eqv? c_116 '#\L)))
- (if or-part_289
- or-part_289
- (let-values (((or-part_135) (eqv? c_116 '#\f)))
- (if or-part_135
- or-part_135
- (let-values (((or-part_136) (eqv? c_116 '#\F)))
- (if or-part_136
- or-part_136
- (let-values (((or-part_137) (eqv? c_116 '#\s)))
- (if or-part_137
- or-part_137
- (let-values (((or-part_481) (eqv? c_116 '#\S)))
- (if or-part_481
- or-part_481
- (let-values (((or-part_482) (eqv? c_116 '#\t)))
- (if or-part_482
- or-part_482
- (let-values (((or-part_483) (eqv? c_116 '#\T)))
- (if or-part_483
- or-part_483
+ (let-values (((c_163) (string-ref s_862 start_79))) (maybe-digit c_163 radix_22)))))
+ (if (let-values (((or-part_790) (eqv? c_162 'eof))) (if or-part_790 or-part_790 #f))
+ (let-values (((v_378) (get-n_4)))
+ (if (let-values (((or-part_791) (not v_378))) (if or-part_791 or-part_791 (string? v_378)))
+ v_378
+ ((lambda (n_56)
+ (let-values (((sgn148_0) sgn_8) ((n149_0) n_56) ((s150_0) s_862) ((state151_0) state_57))
+ (finish.1 #f sgn148_0 n149_0 s150_0 state151_0)))
+ v_378)))
+ (if (let-values (((or-part_792) (fixnum? c_162))) (if or-part_792 or-part_792 #f))
+ (read-rational
+ sgn_8
+ sgn-n_2
+ (add-digit (let-values (((or-part_793) d_49)) (if or-part_793 or-part_793 0)) c_162 radix_22)
+ s_862
+ (fx+ 1 start_79)
+ end_58
+ radix_22
+ state_57)
+ (if (let-values (((or-part_794) (eqv? c_162 '#\.))) (if or-part_794 or-part_794 #f))
+ (bad-mixed-decimal-fraction s_862 state_57)
+ (if (let-values (((or-part_795) (eqv? c_162 '#\#))) (if or-part_795 or-part_795 #f))
+ (if d_49
+ (read-denom-approx
+ sgn_8
+ sgn-n_2
+ (digits->integer d_49 radix_22)
+ 1
+ s_862
+ (fx+ 1 start_79)
+ end_58
+ radix_22
+ (let-values (((state152_0) state_57) ((temp153_0) 'approx))
+ (set-exactness.1 #f state152_0 temp153_0)))
+ (bad-misplaced "#" s_862 state_57))
+ (if (let-values (((or-part_796) (eqv? c_162 '#\e)))
+ (if or-part_796
+ or-part_796
+ (let-values (((or-part_797) (eqv? c_162 '#\E)))
+ (if or-part_797
+ or-part_797
+ (let-values (((or-part_798) (eqv? c_162 '#\d)))
+ (if or-part_798
+ or-part_798
+ (let-values (((or-part_799) (eqv? c_162 '#\D)))
+ (if or-part_799
+ or-part_799
+ (let-values (((or-part_800) (eqv? c_162 '#\l)))
+ (if or-part_800
+ or-part_800
+ (let-values (((or-part_801) (eqv? c_162 '#\L)))
+ (if or-part_801
+ or-part_801
+ (let-values (((or-part_802) (eqv? c_162 '#\f)))
+ (if or-part_802
+ or-part_802
+ (let-values (((or-part_803) (eqv? c_162 '#\F)))
+ (if or-part_803
+ or-part_803
+ (let-values (((or-part_804) (eqv? c_162 '#\s)))
+ (if or-part_804
+ or-part_804
+ (let-values (((or-part_805) (eqv? c_162 '#\S)))
+ (if or-part_805
+ or-part_805
+ (let-values (((or-part_806) (eqv? c_162 '#\t)))
+ (if or-part_806
+ or-part_806
+ (let-values (((or-part_807) (eqv? c_162 '#\T)))
+ (if or-part_807
+ or-part_807
#f))))))))))))))))))))))))
- (let-values ()
- (let-values (((v_255) (get-n_4)))
- (if (let-values (((or-part_484) (not v_255))) (if or-part_484 or-part_484 (string? v_255)))
- v_255
- ((lambda (sgn-n_3)
- (read-exponent
- sgn_8
- sgn-n_3
- 0
- s_558
- (fx+ 1 start_67)
- end_54
- radix_22
- (let-values (((state154_0) state_53) ((c155_0) c_116))
- (set-exactness-by-char.1 #f state154_0 c155_0))))
- v_255))))
- (if (let-values (((or-part_485) (eqv? c_116 '#\/))) (if or-part_485 or-part_485 #f))
- (let-values () (bad-misplaced "/" s_558 state_53))
- (if (let-values (((or-part_486) (eqv? c_116 '#\+)))
- (if or-part_486
- or-part_486
- (let-values (((or-part_487) (eqv? c_116 '#\-))) (if or-part_487 or-part_487 #f))))
- (let-values ()
- (let-values (((v_256) (get-n_4)))
- (if (let-values (((or-part_488) (not v_256))) (if or-part_488 or-part_488 (string? v_256)))
- v_256
- ((lambda (n_54)
- (read-imag
- c_116
- sgn_8
- n_54
- (if (eqv? c_116 '#\+) 1 -1)
- s_558
- (fx+ 1 start_67)
- end_54
- radix_22
- state_53))
- v_256))))
- (if (let-values (((or-part_489) (eqv? c_116 '#\@))) (if or-part_489 or-part_489 #f))
- (let-values ()
- (let-values (((v_257) (get-n_4)))
- (if (let-values (((or-part_490) (not v_257)))
- (if or-part_490 or-part_490 (string? v_257)))
- v_257
- ((lambda (n_55) (read-polar sgn_8 n_55 s_558 (fx+ 1 start_67) end_54 radix_22 state_53))
- v_257))))
- (if (let-values (((or-part_491) (eqv? c_116 '#\i)))
- (if or-part_491
- or-part_491
- (let-values (((or-part_492) (eqv? c_116 '#\I))) (if or-part_492 or-part_492 #f))))
- (let-values ()
- (let-values (((v_258) (get-n_4)))
- (if (let-values (((or-part_493) (not v_258)))
- (if or-part_493 or-part_493 (string? v_258)))
- v_258
- ((lambda (n_56) (finish-imaginary sgn_8 n_56 s_558 (fx+ 1 start_67) end_54 state_53))
- v_258))))
- (let-values () (bad-digit c_116 s_558 state_53))))))))))))))))
+ (let-values (((v_379) (get-n_4)))
+ (if (let-values (((or-part_808) (not v_379))) (if or-part_808 or-part_808 (string? v_379)))
+ v_379
+ ((lambda (sgn-n_3)
+ (read-exponent
+ sgn_8
+ sgn-n_3
+ 0
+ s_862
+ (fx+ 1 start_79)
+ end_58
+ radix_22
+ (let-values (((state154_0) state_57) ((c155_0) c_162))
+ (set-exactness-by-char.1 #f state154_0 c155_0))))
+ v_379)))
+ (if (let-values (((or-part_809) (eqv? c_162 '#\/))) (if or-part_809 or-part_809 #f))
+ (bad-misplaced "/" s_862 state_57)
+ (if (let-values (((or-part_810) (eqv? c_162 '#\+)))
+ (if or-part_810
+ or-part_810
+ (let-values (((or-part_811) (eqv? c_162 '#\-))) (if or-part_811 or-part_811 #f))))
+ (let-values (((v_380) (get-n_4)))
+ (if (let-values (((or-part_812) (not v_380))) (if or-part_812 or-part_812 (string? v_380)))
+ v_380
+ ((lambda (n_57)
+ (read-imag
+ c_162
+ sgn_8
+ n_57
+ (if (eqv? c_162 '#\+) 1 -1)
+ s_862
+ (fx+ 1 start_79)
+ end_58
+ radix_22
+ state_57))
+ v_380)))
+ (if (let-values (((or-part_813) (eqv? c_162 '#\@))) (if or-part_813 or-part_813 #f))
+ (let-values (((v_381) (get-n_4)))
+ (if (let-values (((or-part_814) (not v_381))) (if or-part_814 or-part_814 (string? v_381)))
+ v_381
+ ((lambda (n_58) (read-polar sgn_8 n_58 s_862 (fx+ 1 start_79) end_58 radix_22 state_57))
+ v_381)))
+ (if (let-values (((or-part_815) (eqv? c_162 '#\i)))
+ (if or-part_815
+ or-part_815
+ (let-values (((or-part_816) (eqv? c_162 '#\I))) (if or-part_816 or-part_816 #f))))
+ (let-values (((v_382) (get-n_4)))
+ (if (let-values (((or-part_817) (not v_382)))
+ (if or-part_817 or-part_817 (string? v_382)))
+ v_382
+ ((lambda (n_59) (finish-imaginary sgn_8 n_59 s_862 (fx+ 1 start_79) end_58 state_57))
+ v_382)))
+ (bad-digit c_162 s_862 state_57)))))))))))))))
(define-values
(read-denom-approx)
- (lambda (sgn_9 sgn-n_4 d_50 exp_8 s_559 start_68 end_55 radix_23 state_54)
+ (lambda (sgn_9 sgn-n_4 d_50 exp_8 s_863 start_80 end_59 radix_23 state_58)
(begin
(let-values (((get-n_5)
(lambda () (begin 'get-n (lazy-divide sgn-n_4 (lazy-number d_50 radix_23 exp_8) 'approx)))))
- (let-values (((c_118)
- (if (fx= start_68 end_55)
+ (let-values (((c_164)
+ (if (fx= start_80 end_59)
'eof
- (let-values (((c_119) (string-ref s_559 start_68))) (maybe-digit c_119 radix_23)))))
- (if (let-values (((or-part_494) (eqv? c_118 'eof))) (if or-part_494 or-part_494 #f))
- (let-values ()
- (let-values (((sgn156_0) sgn_9) ((temp157_2) (get-n_5)) ((s158_0) s_559) ((state159_0) state_54))
- (finish.1 #f sgn156_0 temp157_2 s158_0 state159_0)))
- (if (let-values (((or-part_495) (eqv? c_118 '#\#))) (if or-part_495 or-part_495 #f))
- (let-values ()
- (read-denom-approx sgn_9 sgn-n_4 d_50 (fx+ 1 exp_8) s_559 (fx+ 1 start_68) end_55 radix_23 state_54))
- (if (let-values (((or-part_496) (fixnum? c_118))) (if or-part_496 or-part_496 #f))
- (let-values () (bad-misplaced "#" s_559 state_54))
- (if (let-values (((or-part_497) (eqv? c_118 '#\.)))
- (if or-part_497
- or-part_497
- (let-values (((or-part_498) (eqv? c_118 '#\/))) (if or-part_498 or-part_498 #f))))
- (let-values () (bad-misplaced c_118 s_559 state_54))
- (if (let-values (((or-part_499) (eqv? c_118 '#\e)))
- (if or-part_499
- or-part_499
- (let-values (((or-part_500) (eqv? c_118 '#\E)))
- (if or-part_500
- or-part_500
- (let-values (((or-part_501) (eqv? c_118 '#\d)))
- (if or-part_501
- or-part_501
- (let-values (((or-part_502) (eqv? c_118 '#\D)))
- (if or-part_502
- or-part_502
- (let-values (((or-part_503) (eqv? c_118 '#\l)))
- (if or-part_503
- or-part_503
- (let-values (((or-part_504) (eqv? c_118 '#\L)))
- (if or-part_504
- or-part_504
- (let-values (((or-part_505) (eqv? c_118 '#\f)))
- (if or-part_505
- or-part_505
- (let-values (((or-part_242) (eqv? c_118 '#\F)))
- (if or-part_242
- or-part_242
- (let-values (((or-part_243) (eqv? c_118 '#\s)))
- (if or-part_243
- or-part_243
- (let-values (((or-part_506) (eqv? c_118 '#\S)))
- (if or-part_506
- or-part_506
- (let-values (((or-part_507) (eqv? c_118 '#\t)))
- (if or-part_507
- or-part_507
- (let-values (((or-part_508) (eqv? c_118 '#\T)))
- (if or-part_508
- or-part_508
+ (let-values (((c_165) (string-ref s_863 start_80))) (maybe-digit c_165 radix_23)))))
+ (if (let-values (((or-part_818) (eqv? c_164 'eof))) (if or-part_818 or-part_818 #f))
+ (let-values (((sgn156_0) sgn_9) ((temp157_2) (get-n_5)) ((s158_0) s_863) ((state159_0) state_58))
+ (finish.1 #f sgn156_0 temp157_2 s158_0 state159_0))
+ (if (let-values (((or-part_819) (eqv? c_164 '#\#))) (if or-part_819 or-part_819 #f))
+ (read-denom-approx sgn_9 sgn-n_4 d_50 (fx+ 1 exp_8) s_863 (fx+ 1 start_80) end_59 radix_23 state_58)
+ (if (let-values (((or-part_820) (fixnum? c_164))) (if or-part_820 or-part_820 #f))
+ (bad-misplaced "#" s_863 state_58)
+ (if (let-values (((or-part_821) (eqv? c_164 '#\.)))
+ (if or-part_821
+ or-part_821
+ (let-values (((or-part_822) (eqv? c_164 '#\/))) (if or-part_822 or-part_822 #f))))
+ (bad-misplaced c_164 s_863 state_58)
+ (if (let-values (((or-part_823) (eqv? c_164 '#\e)))
+ (if or-part_823
+ or-part_823
+ (let-values (((or-part_824) (eqv? c_164 '#\E)))
+ (if or-part_824
+ or-part_824
+ (let-values (((or-part_825) (eqv? c_164 '#\d)))
+ (if or-part_825
+ or-part_825
+ (let-values (((or-part_826) (eqv? c_164 '#\D)))
+ (if or-part_826
+ or-part_826
+ (let-values (((or-part_827) (eqv? c_164 '#\l)))
+ (if or-part_827
+ or-part_827
+ (let-values (((or-part_828) (eqv? c_164 '#\L)))
+ (if or-part_828
+ or-part_828
+ (let-values (((or-part_829) (eqv? c_164 '#\f)))
+ (if or-part_829
+ or-part_829
+ (let-values (((or-part_830) (eqv? c_164 '#\F)))
+ (if or-part_830
+ or-part_830
+ (let-values (((or-part_831) (eqv? c_164 '#\s)))
+ (if or-part_831
+ or-part_831
+ (let-values (((or-part_832) (eqv? c_164 '#\S)))
+ (if or-part_832
+ or-part_832
+ (let-values (((or-part_833) (eqv? c_164 '#\t)))
+ (if or-part_833
+ or-part_833
+ (let-values (((or-part_834) (eqv? c_164 '#\T)))
+ (if or-part_834
+ or-part_834
#f))))))))))))))))))))))))
- (let-values ()
- (read-exponent
+ (read-exponent
+ sgn_9
+ (get-n_5)
+ 0
+ s_863
+ (fx+ 1 start_80)
+ end_59
+ radix_23
+ (let-values (((state160_0) state_58) ((c161_0) c_164))
+ (set-exactness-by-char.1 #f state160_0 c161_0)))
+ (if (let-values (((or-part_835) (eqv? c_164 '#\+)))
+ (if or-part_835
+ or-part_835
+ (let-values (((or-part_836) (eqv? c_164 '#\-))) (if or-part_836 or-part_836 #f))))
+ (read-imag
+ c_164
sgn_9
(get-n_5)
- 0
- s_559
- (fx+ 1 start_68)
- end_55
+ (if (eqv? c_164 '#\+) 1 -1)
+ s_863
+ (fx+ 1 start_80)
+ end_59
radix_23
- (let-values (((state160_0) state_54) ((c161_0) c_118))
- (set-exactness-by-char.1 #f state160_0 c161_0))))
- (if (let-values (((or-part_509) (eqv? c_118 '#\+)))
- (if or-part_509
- or-part_509
- (let-values (((or-part_510) (eqv? c_118 '#\-))) (if or-part_510 or-part_510 #f))))
- (let-values ()
- (read-imag
- c_118
- sgn_9
- (get-n_5)
- (if (eqv? c_118 '#\+) 1 -1)
- s_559
- (fx+ 1 start_68)
- end_55
- radix_23
- state_54))
- (if (let-values (((or-part_511) (eqv? c_118 '#\@))) (if or-part_511 or-part_511 #f))
- (let-values () (read-polar sgn_9 (get-n_5) s_559 (fx+ 1 start_68) end_55 radix_23 state_54))
- (if (let-values (((or-part_512) (eqv? c_118 '#\i)))
- (if or-part_512
- or-part_512
- (let-values (((or-part_513) (eqv? c_118 '#\I))) (if or-part_513 or-part_513 #f))))
- (let-values () (finish-imaginary sgn_9 (get-n_5) s_559 (fx+ 1 start_68) end_55 state_54))
- (let-values () (bad-digit c_118 s_559 state_54)))))))))))))))
+ state_58)
+ (if (let-values (((or-part_837) (eqv? c_164 '#\@))) (if or-part_837 or-part_837 #f))
+ (read-polar sgn_9 (get-n_5) s_863 (fx+ 1 start_80) end_59 radix_23 state_58)
+ (if (let-values (((or-part_838) (eqv? c_164 '#\i)))
+ (if or-part_838
+ or-part_838
+ (let-values (((or-part_839) (eqv? c_164 '#\I))) (if or-part_839 or-part_839 #f))))
+ (finish-imaginary sgn_9 (get-n_5) s_863 (fx+ 1 start_80) end_59 state_58)
+ (bad-digit c_164 s_863 state_58))))))))))))))
(define-values
(read-imag)
- (lambda (c_120 real-sgn_0 real_0 sgn_10 s_560 start_42 end_30 radix_24 state_55)
- (begin
- (if (let-values (((or-part_514) (state-has-first-half? state_55)))
- (if or-part_514 or-part_514 (eq? 'extended (parse-state-exactness state_55))))
- (let-values () (bad-misplaced c_120 s_560 state_55))
- (let-values ()
- (read-signed
- sgn_10
- s_560
- start_42
- end_30
- radix_24
- (state-set-first-half state_55 (rect-prefix7.1 real-sgn_0 real_0 (fx- start_42 1)))))))))
+ (lambda (c_166 real-sgn_0 real_0 sgn_10 s_864 start_81 end_60 radix_24 state_59)
+ (begin
+ (if (let-values (((or-part_840) (state-has-first-half? state_59)))
+ (if or-part_840 or-part_840 (eq? 'extended (parse-state-exactness state_59))))
+ (bad-misplaced c_166 s_864 state_59)
+ (read-signed
+ sgn_10
+ s_864
+ start_81
+ end_60
+ radix_24
+ (state-set-first-half state_59 (rect-prefix7.1 real-sgn_0 real_0 (fx- start_81 1))))))))
(define-values
(read-polar)
- (lambda (real-sgn_1 real_1 s_561 start_69 end_56 radix_25 state_56)
+ (lambda (real-sgn_1 real_1 s_865 start_82 end_61 radix_25 state_60)
(begin
- (if (let-values (((or-part_209) (state-has-first-half? state_56)))
- (if or-part_209 or-part_209 (eq? 'extended (parse-state-exactness state_56))))
- (let-values () (bad-misplaced "@" s_561 state_56))
- (let-values ()
- (let-values (((c_121)
- (if (fx= start_69 end_56)
- 'eof
- (let-values (((c_30) (string-ref s_561 start_69))) (maybe-digit c_30 radix_25)))))
- (if (let-values (((or-part_246) (eqv? c_121 'eof))) (if or-part_246 or-part_246 #f))
- (let-values () (bad-misplaced "@" s_561 state_56))
- (if (let-values (((or-part_515) (eqv? c_121 '#\+)))
- (if or-part_515
- or-part_515
- (let-values (((or-part_516) (eqv? c_121 '#\-))) (if or-part_516 or-part_516 #f))))
- (let-values ()
- (let-values (((new-state_2)
- (state-set-first-half state_56 (polar-prefix8.1 real-sgn_1 real_1 start_69))))
- (read-signed (if (eq? c_121 '#\+) 1 -1) s_561 (fx+ 1 start_69) end_56 radix_25 new-state_2)))
- (if (let-values (((or-part_517) (fixnum? c_121))) (if or-part_517 or-part_517 #f))
- (let-values ()
- (let-values (((new-state_3)
- (state-set-first-half state_56 (polar-prefix8.1 real-sgn_1 real_1 start_69))))
- (read-integer 1 c_121 s_561 (fx+ 1 start_69) end_56 radix_25 new-state_3)))
- (let-values () (bad-digit c_121 s_561 state_56)))))))))))
+ (if (let-values (((or-part_841) (state-has-first-half? state_60)))
+ (if or-part_841 or-part_841 (eq? 'extended (parse-state-exactness state_60))))
+ (bad-misplaced "@" s_865 state_60)
+ (let-values (((c_167)
+ (if (fx= start_82 end_61)
+ 'eof
+ (let-values (((c_168) (string-ref s_865 start_82))) (maybe-digit c_168 radix_25)))))
+ (if (let-values (((or-part_842) (eqv? c_167 'eof))) (if or-part_842 or-part_842 #f))
+ (bad-misplaced "@" s_865 state_60)
+ (if (let-values (((or-part_843) (eqv? c_167 '#\+)))
+ (if or-part_843
+ or-part_843
+ (let-values (((or-part_844) (eqv? c_167 '#\-))) (if or-part_844 or-part_844 #f))))
+ (let-values (((new-state_2) (state-set-first-half state_60 (polar-prefix8.1 real-sgn_1 real_1 start_82))))
+ (read-signed (if (eq? c_167 '#\+) 1 -1) s_865 (fx+ 1 start_82) end_61 radix_25 new-state_2))
+ (if (let-values (((or-part_845) (fixnum? c_167))) (if or-part_845 or-part_845 #f))
+ (let-values (((new-state_3)
+ (state-set-first-half state_60 (polar-prefix8.1 real-sgn_1 real_1 start_82))))
+ (read-integer 1 c_167 s_865 (fx+ 1 start_82) end_61 radix_25 new-state_3))
+ (if (let-values (((or-part_846) (eqv? c_167 '#\.))) (if or-part_846 or-part_846 #f))
+ (let-values (((new-state_4)
+ (state-set-first-half state_60 (polar-prefix8.1 real-sgn_1 real_1 start_82))))
+ (read-decimal
+ 1
+ #f
+ 0
+ s_865
+ (fx+ 1 start_82)
+ end_61
+ radix_25
+ (let-values (((new-state162_0) new-state_4) ((temp163_2) 'approx))
+ (set-exactness.1 #f new-state162_0 temp163_2))))
+ (bad-digit c_167 s_865 state_60))))))))))
(define-values
(read-symbol-or-number.1)
(lambda (extra-prefix2_0 mode1_1 init-c5_0 in6_1 orig-config7_0)
(begin
'read-symbol-or-number
(let-values (((init-c_6) init-c5_0))
- (let-values (((in_26) in6_1))
+ (let-values (((in_32) in6_1))
(let-values (((orig-config_0) orig-config7_0))
- (let-values (((mode_10) mode1_1))
+ (let-values (((mode_21) mode1_1))
(let-values (((extra-prefix_0) extra-prefix2_0))
- (let-values ()
- (let-values (((config_37)
- (if (string? mode_10) (override-parameter 1/read-cdot orig-config_0 #f) orig-config_0)))
- (let-values (((rt_12) (read-config-readtable config_37)))
- (let-values (((c1_32)
- (if rt_12
- (if (let-values (((or-part_14) (eq? mode_10 'symbol-or-number)))
- (if or-part_14 or-part_14 (eq? mode_10 'symbol/indirect)))
- (readtable-symbol-parser rt_12)
- #f)
- #f)))
- (if c1_32
- ((lambda (handler_6)
- (readtable-apply
- handler_6
- init-c_6
- in_26
- config_37
- (read-config-line config_37)
- (read-config-col config_37)
- (read-config-pos config_37)))
- c1_32)
- (let-values ()
- (let-values (((accum-str_1) (accum-string-init! config_37)))
- (let-values (((quoted-ever?_0) #f))
- (let-values (((case-sens?_0) (check-parameter read-case-sensitive config_37)))
- (let-values ((()
- (begin
- (if extra-prefix_0
- (let-values () (accum-string-add! accum-str_1 extra-prefix_0))
- (void))
- (values))))
- (let-values (((source_16) (read-config-source config_37)))
- (let-values (((unexpected-quoted_0)
- (lambda (c_63 after-c_0)
- (begin
- 'unexpected-quoted
- (let-values (((in9_1) in_26)
- ((config10_2) config_37)
- ((c11_1) c_63)
- ((temp12_6) "~a following `~a` in ~a")
- ((temp13_7)
- (if (eof-object? c_63)
- "end-of-file"
- "non-character"))
- ((after-c14_0) after-c_0)
- ((temp15_7)
- (if (eq? mode_10 'keyword)
- (let-values () "keyword")
- (if (string? mode_10)
- (let-values () "number")
- (let-values () "symbol")))))
- (reader-error.1
- unsafe-undefined
- c11_1
- #f
- unsafe-undefined
- in9_1
- config10_2
- temp12_6
- (list temp13_7 after-c14_0 temp15_7)))))))
- (let-values ((()
- (begin
- ((letrec-values (((loop_117)
- (lambda (init-c_7
- pipe-quote-c_0
- foldcase-from_0)
- (begin
- 'loop
- (let-values (((c_122)
- (let-values (((or-part_89)
- init-c_7))
- (if or-part_89
- or-part_89
- (let-values (((in_27)
- in_26)
- ((skip-count_7)
- 0)
- ((source_17)
- source_16))
- (let-values (((c_66)
- (peek-char-or-special
- in_27
- skip-count_7
- 'special
- source_17)))
- (if (eq?
- c_66
- 'special)
- (special1.1
- 'special)
- c_66)))))))
- (let-values (((ec_5)
- (let-values (((rt_13)
- rt_12)
- ((c_123)
- c_122)
- ((handler_7)
- '#\x))
- (if (let-values (((or-part_146)
- (not
- rt_13)))
- (if or-part_146
- or-part_146
- (not
- (char?
- c_123))))
- (let-values () c_123)
- (let-values ()
- (*readtable-effective-char
- rt_13
- c_123
- handler_7))))))
+ (let-values (((config_44)
+ (if (string? mode_21) (override-parameter 1/read-cdot orig-config_0 #f) orig-config_0)))
+ (let-values (((rt_13) (read-config-readtable config_44)))
+ (let-values (((cond-val_24)
+ (if rt_13
+ (if (let-values (((or-part_847) (eq? mode_21 'symbol-or-number)))
+ (if or-part_847 or-part_847 (eq? mode_21 'symbol/indirect)))
+ (readtable-symbol-parser rt_13)
+ #f)
+ #f)))
+ (if cond-val_24
+ ((lambda (handler_6)
+ (readtable-apply
+ handler_6
+ init-c_6
+ in_32
+ config_44
+ (read-config-line config_44)
+ (read-config-col config_44)
+ (read-config-pos config_44)))
+ cond-val_24)
+ (let-values (((accum-str_1) (accum-string-init! config_44)))
+ (let-values (((quoted-ever?_0) #f))
+ (let-values (((case-sens?_0) (check-parameter read-case-sensitive config_44)))
+ (let-values ((()
+ (begin
+ (if extra-prefix_0 (accum-string-add! accum-str_1 extra-prefix_0) (void))
+ (values))))
+ (let-values (((source_17) (read-config-source config_44)))
+ (let-values (((unexpected-quoted_0)
+ (lambda (c_169 after-c_0)
+ (begin
+ 'unexpected-quoted
+ (let-values (((in9_1) in_32)
+ ((config10_2) config_44)
+ ((c11_1) c_169)
+ ((temp12_6) "~a following `~a` in ~a")
+ ((temp13_8)
+ (if (eof-object? c_169)
+ "end-of-file"
+ "non-character"))
+ ((after-c14_0) after-c_0)
+ ((temp15_7)
+ (if (eq? mode_21 'keyword)
+ "keyword"
+ (if (string? mode_21) "number" "symbol"))))
+ (reader-error.1
+ unsafe-undefined
+ c11_1
+ #f
+ unsafe-undefined
+ in9_1
+ config10_2
+ temp12_6
+ (list temp13_8 after-c14_0 temp15_7)))))))
+ (let-values ((()
+ (begin
+ ((letrec-values (((loop_135)
+ (lambda (init-c_7 pipe-quote-c_0 foldcase-from_0)
+ (begin
+ 'loop
+ (let-values (((c_170)
+ (let-values (((or-part_848)
+ init-c_7))
+ (if or-part_848
+ or-part_848
+ (let-values (((in_33) in_32)
+ ((skip-count_8)
+ 0)
+ ((source_18)
+ source_17))
+ (let-values (((c_171)
+ (peek-char-or-special
+ in_33
+ skip-count_8
+ 'special
+ source_18)))
+ (if (eq? c_171 'special)
+ (special1.1 'special)
+ c_171)))))))
+ (let-values (((ec_5)
+ (let-values (((rt_14) rt_13)
+ ((c_172) c_170)
+ ((handler_7)
+ '#\x))
+ (if (let-values (((or-part_849)
+ (not
+ rt_14)))
+ (if or-part_849
+ or-part_849
+ (not
+ (char? c_172))))
+ c_172
+ (*readtable-effective-char
+ rt_14
+ c_172
+ handler_7)))))
+ (if (if pipe-quote-c_0
+ (not (char? ec_5))
+ #f)
+ (begin
+ (if init-c_7
+ (void)
+ (consume-char/special
+ in_32
+ config_44
+ c_170))
+ (unexpected-quoted_0
+ c_170
+ pipe-quote-c_0))
+ (if (if (not pipe-quote-c_0)
+ (readtable-char-delimiter?
+ rt_13
+ c_170
+ config_44)
+ #f)
+ (if case-sens?_0
+ (void)
+ (accum-string-convert!
+ accum-str_1
+ string-foldcase
+ foldcase-from_0))
(if (if pipe-quote-c_0
- (not (char? ec_5))
+ (char=? c_170 pipe-quote-c_0)
#f)
- (let-values ()
+ (begin
+ (if init-c_7
+ (void)
+ (consume-char in_32 c_170))
+ (loop_135
+ #f
+ #f
+ (accum-string-count
+ accum-str_1)))
+ (if (if (char=? ec_5 '#\|)
+ (check-parameter
+ read-accept-bar-quote
+ config_44)
+ #f)
(begin
(if init-c_7
(void)
- (let-values ()
- (consume-char/special
- in_26
- config_37
- c_122)))
- (unexpected-quoted_0
- c_122
- pipe-quote-c_0)))
- (if (if (not pipe-quote-c_0)
- (readtable-char-delimiter?
- rt_12
- c_122
- config_37)
- #f)
- (let-values ()
+ (consume-char in_32 c_170))
+ (set! quoted-ever?_0 #t)
(if case-sens?_0
(void)
- (let-values ()
- (accum-string-convert!
- accum-str_1
- string-foldcase
- foldcase-from_0))))
- (if (if pipe-quote-c_0
- (char=?
- c_122
- pipe-quote-c_0)
+ (accum-string-convert!
+ accum-str_1
+ string-foldcase
+ foldcase-from_0))
+ (loop_135
+ #f
+ c_170
+ (accum-string-count
+ accum-str_1)))
+ (if (if (char=? ec_5 '#\\)
+ (not pipe-quote-c_0)
#f)
- (let-values ()
- (begin
- (if init-c_7
- (void)
- (let-values ()
- (consume-char
- in_26
- c_122)))
- (loop_117
- #f
- #f
- (accum-string-count
- accum-str_1))))
- (if (if (char=? ec_5 '#\|)
- (check-parameter
- read-accept-bar-quote
- config_37)
- #f)
- (let-values ()
+ (let-values ((()
+ (begin
+ (if init-c_7
+ (void)
+ (consume-char
+ in_32
+ c_170))
+ (values))))
+ (let-values (((next-c_0)
+ (let-values (((in_34)
+ in_32)
+ ((source_19)
+ source_17))
+ (read-char-or-special
+ in_34
+ special1.1
+ source_19))))
(begin
- (if init-c_7
+ (if (char? next-c_0)
(void)
- (let-values ()
- (consume-char
- in_26
- c_122)))
- (set! quoted-ever?_0 #t)
- (if case-sens?_0
+ (unexpected-quoted_0
+ next-c_0
+ c_170))
+ (if (let-values (((or-part_850)
+ pipe-quote-c_0))
+ (if or-part_850
+ or-part_850
+ case-sens?_0))
(void)
- (let-values ()
- (accum-string-convert!
- accum-str_1
- string-foldcase
- foldcase-from_0)))
- (loop_117
+ (accum-string-convert!
+ accum-str_1
+ string-foldcase
+ foldcase-from_0))
+ (accum-string-add!
+ accum-str_1
+ next-c_0)
+ (set! quoted-ever?_0 #t)
+ (loop_135
+ #f
#f
- c_122
(accum-string-count
- accum-str_1))))
- (if (if (char=? ec_5 '#\\)
- (not pipe-quote-c_0)
- #f)
- (let-values ()
- (let-values ((()
- (begin
- (if init-c_7
- (void)
- (let-values ()
- (consume-char
- in_26
- c_122)))
- (values))))
- (let-values (((next-c_0)
- (let-values (((in_28)
- in_26)
- ((source_18)
- source_16))
- (read-char-or-special
- in_28
- special1.1
- source_18))))
- (begin
- (if (char? next-c_0)
- (void)
- (let-values ()
- (unexpected-quoted_0
- next-c_0
- c_122)))
- (if (let-values (((or-part_168)
- pipe-quote-c_0))
- (if or-part_168
- or-part_168
- case-sens?_0))
- (void)
- (let-values ()
- (accum-string-convert!
- accum-str_1
- string-foldcase
- foldcase-from_0)))
- (accum-string-add!
- accum-str_1
- next-c_0)
- (set! quoted-ever?_0
- #t)
- (loop_117
- #f
- #f
- (accum-string-count
- accum-str_1))))))
- (let-values ()
- (begin
- (if init-c_7
- (void)
- (let-values ()
- (consume-char
- in_26
- c_122)))
- (accum-string-add!
- accum-str_1
- c_122)
- (loop_117
- #f
- pipe-quote-c_0
- foldcase-from_0))))))))))))))
- loop_117)
- init-c_6
- #f
- 0)
- (values))))
- (let-values (((str_30)
- (let-values (((accum-str16_0) accum-str_1)
- ((config17_0) config_37))
- (accum-string-get!.1 0 accum-str16_0 config17_0))))
- (let-values ((()
- (begin
- (if (if (= 1 (string-length str_30))
- (if (not quoted-ever?_0)
- (char=?
- '#\.
- (effective-char (string-ref str_30 0) config_37))
- #f)
- #f)
- (let-values ()
- (let-values (((in18_0) in_26)
- ((config19_0) config_37)
- ((temp20_5) "illegal use of `.`"))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in18_0
- config19_0
- temp20_5
- (list))))
- (void))
- (values))))
- (let-values (((num_0)
- (if (let-values (((or-part_59)
- (eq? mode_10 'symbol-or-number)))
- (if or-part_59 or-part_59 (string? mode_10)))
+ accum-str_1)))))
+ (begin
+ (if init-c_7
+ (void)
+ (consume-char in_32 c_170))
+ (accum-string-add!
+ accum-str_1
+ c_170)
+ (loop_135
+ #f
+ pipe-quote-c_0
+ foldcase-from_0)))))))))))))
+ loop_135)
+ init-c_6
+ #f
+ 0)
+ (values))))
+ (let-values (((str_30)
+ (let-values (((accum-str16_0) accum-str_1) ((config17_0) config_44))
+ (accum-string-get!.1 0 accum-str16_0 config17_0))))
+ (let-values ((()
+ (begin
+ (if (if (= 1 (string-length str_30))
(if (not quoted-ever?_0)
- (unchecked-string->number
- (if (string? mode_10)
- (string-append mode_10 str_30)
- str_30)
- 10
- 'read
- (if (check-parameter
- 1/read-decimal-as-inexact
- config_37)
- 'decimal-as-inexact
- 'decimal-as-exact)
- (if (check-parameter 1/read-single-flonum config_37)
- 'single
- 'double))
+ (char=?
+ '#\.
+ (effective-char (string-ref str_30 0) config_44))
#f)
- #f)))
- (begin
- (if (string? num_0)
- (let-values ()
- (let-values (((in21_0) in_26)
- ((config22_0) config_37)
- ((temp23_5) "~a")
- ((num24_0) num_0))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in21_0
- config22_0
- temp23_5
- (list num24_0))))
- (void))
- (if (if (not num_0) (string? mode_10) #f)
- (let-values ()
- (let-values (((in25_0) in_26)
- ((config26_0) config_37)
- ((temp27_3) "bad number: `~a`")
- ((temp28_4) (string-append mode_10 str_30)))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in25_0
- config26_0
- temp27_3
- (list temp28_4))))
- (void))
- (wrap
- (let-values (((or-part_9) num_0))
- (if or-part_9
- or-part_9
- (let-values (((or-part_10)
- (if (eq? mode_10 'keyword)
- (string->keyword str_30)
- #f)))
- (if or-part_10 or-part_10 (string->symbol str_30)))))
- in_26
- config_37
- str_30))))))))))))))))))))))))))
+ #f)
+ (let-values (((in18_0) in_32)
+ ((config19_0) config_44)
+ ((temp20_5) "illegal use of `.`"))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in18_0
+ config19_0
+ temp20_5
+ (list)))
+ (void))
+ (values))))
+ (let-values (((num_0)
+ (if (let-values (((or-part_851)
+ (eq? mode_21 'symbol-or-number)))
+ (if or-part_851 or-part_851 (string? mode_21)))
+ (if (not quoted-ever?_0)
+ (unchecked-string->number
+ (if (string? mode_21)
+ (string-append mode_21 str_30)
+ str_30)
+ 10
+ 'read
+ (if (check-parameter 1/read-decimal-as-inexact config_44)
+ 'decimal-as-inexact
+ 'decimal-as-exact)
+ (if (check-parameter 1/read-single-flonum config_44)
+ 'single
+ 'double))
+ #f)
+ #f)))
+ (begin
+ (if (string? num_0)
+ (let-values (((in21_0) in_32)
+ ((config22_0) config_44)
+ ((temp23_5) "~a")
+ ((num24_0) num_0))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in21_0
+ config22_0
+ temp23_5
+ (list num24_0)))
+ (void))
+ (if (if (not num_0) (string? mode_21) #f)
+ (let-values (((in25_0) in_32)
+ ((config26_0) config_44)
+ ((temp27_2) "bad number: `~a`")
+ ((temp28_3) (string-append mode_21 str_30)))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in25_0
+ config26_0
+ temp27_2
+ (list temp28_3)))
+ (void))
+ (wrap
+ (let-values (((or-part_852) num_0))
+ (if or-part_852
+ or-part_852
+ (let-values (((or-part_853)
+ (if (eq? mode_21 'keyword)
+ (string->keyword str_30)
+ #f)))
+ (if or-part_853 or-part_853 (string->symbol str_30)))))
+ in_32
+ config_44
+ str_30))))))))))))))))))))))))
(define-values
(read-number-literal)
- (lambda (read-one_4 init-c_0 in_6 config_15 mode_17 starts-num?_0 num?_0 num-str_0)
+ (lambda (read-one_4 init-c_8 in_35 config_45 mode_22 starts-num?_0 num?_0 num-str_0)
(begin
- (let-values (((c_47) (read-char/skip-whitespace-and-comments init-c_0 read-one_4 in_6 config_15)))
- (let-values (((line_6 col_5 pos_134) (port-next-location* in_6 c_47)))
+ (let-values (((c_173) (read-char/skip-whitespace-and-comments init-c_8 read-one_4 in_35 config_45)))
+ (let-values (((line_8 col_7 pos_176) (port-next-location* in_35 c_173)))
(let-values (((ec_6)
- (let-values (((rt_14) (read-config-readtable config_15)) ((c_55) c_47) ((handler_8) '#\x))
- (if (let-values (((or-part_73) (not rt_14))) (if or-part_73 or-part_73 (not (char? c_55))))
- (let-values () c_55)
- (let-values () (*readtable-effective-char rt_14 c_55 handler_8))))))
- (if (let-values (((or-part_84) (not (char? c_47)))) (if or-part_84 or-part_84 (starts-num?_0 ec_6)))
- (let-values ()
- (let-values (((v_46)
- (if (char? c_47)
- (let-values (((c1_33) c_47) ((in2_0) in_6) ((config3_0) config_15) ((mode4_0) mode_17))
- (read-symbol-or-number.1 #f mode4_0 c1_33 in2_0 config3_0))
- c_47)))
- (if (num?_0 v_46)
- (let-values () v_46)
- (if (eof-object? v_46)
- (let-values () v_46)
- (if (if (1/special-comment? v_46) (read-config-keep-comment? v_46) #f)
- (let-values () v_46)
- (let-values ()
- (let-values (((in5_0) in_6)
- ((temp6_2) (reading-at config_15 line_6 col_5 pos_134))
- ((temp7_4) "expected a ~a, found ~v")
- ((num-str8_0) num-str_0)
- ((v9_2) v_46))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in5_0
- temp6_2
- temp7_4
- (list num-str8_0 v9_2)))))))))
- (let-values (((c1_34) (special-comment-via-readtable? c_47 read-one_4 in_6 config_15)))
- (if c1_34
- ((lambda (v_76)
- (if (read-config-keep-comment? config_15)
- v_76
- (read-number-literal read-one_4 #f in_6 config_15 mode_17 starts-num?_0 num?_0 num-str_0)))
- c1_34)
- (let-values ()
- (let-values (((in10_1) in_6)
- ((temp11_5) (reading-at config_15 line_6 col_5 pos_134))
- ((temp12_7) "expected a ~a")
- ((num-str13_0) num-str_0))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in10_1
- temp11_5
- temp12_7
- (list num-str13_0)))))))))))))
+ (let-values (((rt_15) (read-config-readtable config_45)) ((c_174) c_173) ((handler_8) '#\x))
+ (if (let-values (((or-part_854) (not rt_15)))
+ (if or-part_854 or-part_854 (not (char? c_174))))
+ c_174
+ (*readtable-effective-char rt_15 c_174 handler_8)))))
+ (if (let-values (((or-part_855) (not (char? c_173)))) (if or-part_855 or-part_855 (starts-num?_0 ec_6)))
+ (let-values (((v_383)
+ (if (char? c_173)
+ (let-values (((c1_17) c_173) ((in2_0) in_35) ((config3_0) config_45) ((mode4_0) mode_22))
+ (read-symbol-or-number.1 #f mode4_0 c1_17 in2_0 config3_0))
+ c_173)))
+ (if (num?_0 v_383)
+ v_383
+ (if (eof-object? v_383)
+ v_383
+ (if (if (1/special-comment? v_383) (read-config-keep-comment? v_383) #f)
+ v_383
+ (let-values (((in5_0) in_35)
+ ((temp6_2) (reading-at config_45 line_8 col_7 pos_176))
+ ((temp7_9) "expected a ~a, found ~v")
+ ((num-str8_0) num-str_0)
+ ((v9_2) v_383))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in5_0
+ temp6_2
+ temp7_9
+ (list num-str8_0 v9_2)))))))
+ (let-values (((cond-val_25) (special-comment-via-readtable? c_173 read-one_4 in_35 config_45)))
+ (if cond-val_25
+ ((lambda (v_384)
+ (if (read-config-keep-comment? config_45)
+ v_384
+ (read-number-literal read-one_4 #f in_35 config_45 mode_22 starts-num?_0 num?_0 num-str_0)))
+ cond-val_25)
+ (let-values (((in10_1) in_35)
+ ((temp11_4) (reading-at config_45 line_8 col_7 pos_176))
+ ((temp12_7) "expected a ~a")
+ ((num-str13_0) num-str_0))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in10_1
+ temp11_4
+ temp12_7
+ (list num-str13_0))))))))))))
(define-values
(starts-fixnum?)
- (lambda (c_57)
+ (lambda (c_175)
(begin
- (let-values (((or-part_276) (char<=? '#\0 c_57 '#\9)))
- (if or-part_276
- or-part_276
- (let-values (((or-part_271) (char=? c_57 '#\-)))
- (if or-part_271
- or-part_271
- (let-values (((or-part_89) (char=? c_57 '#\+))) (if or-part_89 or-part_89 (char=? c_57 '#\#))))))))))
+ (let-values (((or-part_856) (char<=? '#\0 c_175 '#\9)))
+ (if or-part_856
+ or-part_856
+ (let-values (((or-part_857) (char=? c_175 '#\-)))
+ (if or-part_857
+ or-part_857
+ (let-values (((or-part_858) (char=? c_175 '#\+))) (if or-part_858 or-part_858 (char=? c_175 '#\#))))))))))
(define-values
(read-fixnum)
- (lambda (read-one_5 init-c_8 in_29 config_38)
- (begin (read-number-literal read-one_5 init-c_8 in_29 config_38 "#e" starts-fixnum? fixnum? "fixnum"))))
+ (lambda (read-one_5 init-c_9 in_36 config_46)
+ (begin (read-number-literal read-one_5 init-c_9 in_36 config_46 "#e" starts-fixnum? fixnum? "fixnum"))))
(define-values
(starts-flonum?)
- (lambda (c_66)
- (begin (let-values (((or-part_518) (starts-fixnum? c_66))) (if or-part_518 or-part_518 (char=? c_66 '#\.))))))
+ (lambda (c_176)
+ (begin (let-values (((or-part_859) (starts-fixnum? c_176))) (if or-part_859 or-part_859 (char=? c_176 '#\.))))))
(define-values
(read-flonum)
- (lambda (read-one_6 init-c_9 in_30 config_39)
- (begin (read-number-literal read-one_6 init-c_9 in_30 config_39 "#i" starts-flonum? flonum? "flonum"))))
+ (lambda (read-one_6 init-c_10 in_37 config_47)
+ (begin (read-number-literal read-one_6 init-c_10 in_37 config_47 "#i" starts-flonum? flonum? "flonum"))))
(define-values
(read-vector.1)
- (lambda (length2_0 mode1_1 read-one5_0 opener-c6_0 opener7_0 closer8_0 in9_2 config10_3)
+ (lambda (length2_0 mode1_2 read-one5_0 opener-c6_0 opener7_0 closer8_0 in9_2 config10_3)
(begin
'read-vector
(let-values (((read-one_7) read-one5_0))
(let-values (((opener-c_1) opener-c6_0))
(let-values (((opener_2) opener7_0))
(let-values (((closer_2) closer8_0))
- (let-values (((in_31) in9_2))
- (let-values (((config_10) config10_3))
- (let-values (((vector-mode_0) mode1_1))
+ (let-values (((in_38) in9_2))
+ (let-values (((config_48) config10_3))
+ (let-values (((vector-mode_0) mode1_2))
(let-values (((expected-len_0) length2_0))
- (let-values ()
- (let-values (((read-one-element_0)
- (let-values (((tmp_59) vector-mode_0))
- (if (equal? tmp_59 'any)
- (let-values () read-one_7)
- (if (equal? tmp_59 'fixnum)
- (let-values ()
- (lambda (init-c_10 in_32 config_40)
- (begin
- 'read-one-element
- (read-fixnum read-one_7 init-c_10 in_32 config_40))))
- (if (equal? tmp_59 'flonum)
- (let-values ()
- (lambda (init-c_11 in_33 config_41)
+ (let-values (((read-one-element_0)
+ (let-values (((tmp_62) vector-mode_0))
+ (if (equal? tmp_62 'any)
+ read-one_7
+ (if (equal? tmp_62 'fixnum)
+ (lambda (init-c_11 in_39 config_49)
+ (begin
+ 'read-one-element
+ (read-fixnum read-one_7 init-c_11 in_39 config_49)))
+ (if (equal? tmp_62 'flonum)
+ (lambda (init-c_12 in_40 config_50)
+ (begin
+ 'read-one-element
+ (read-flonum read-one_7 init-c_12 in_40 config_50)))
+ (void)))))))
+ (let-values (((seq_2)
+ (let-values (((read-one-element12_0) read-one-element_0)
+ ((opener-c13_0) opener-c_1)
+ ((opener14_0) opener_2)
+ ((closer15_0) closer_2)
+ ((in16_1) in_38)
+ ((config17_1) config_48)
+ ((read-one18_0) read-one_7)
+ ((temp19_6) #f))
+ (read-unwrapped-sequence.1
+ temp19_6
+ unsafe-undefined
+ unsafe-undefined
+ #f
+ read-one18_0
+ read-one-element12_0
+ opener-c13_0
+ opener14_0
+ closer15_0
+ in16_1
+ config17_1))))
+ (let-values (((vec_97)
+ (if (not expected-len_0)
+ (let-values (((tmp_63) vector-mode_0))
+ (if (equal? tmp_63 'any)
+ (list->vector seq_2)
+ (if (equal? tmp_63 'fixnum)
+ (let-values (((len_74) (length seq_2)))
(begin
- 'read-one-element
- (read-flonum read-one_7 init-c_11 in_33 config_41))))
- (let-values () (void))))))))
- (let-values (((seq_2)
- (let-values (((read-one-element12_0) read-one-element_0)
- ((opener-c13_0) opener-c_1)
- ((opener14_0) opener_2)
- ((closer15_0) closer_2)
- ((in16_1) in_31)
- ((config17_1) config_10)
- ((read-one18_0) read-one_7)
- ((temp19_0) #f))
- (read-unwrapped-sequence.1
- temp19_0
- unsafe-undefined
- unsafe-undefined
- #f
- read-one18_0
- read-one-element12_0
- opener-c13_0
- opener14_0
- closer15_0
- in16_1
- config17_1))))
- (let-values (((vec_84)
- (if (not expected-len_0)
- (let-values ()
- (let-values (((tmp_60) vector-mode_0))
- (if (equal? tmp_60 'any)
- (let-values () (list->vector seq_2))
- (if (equal? tmp_60 'fixnum)
- (let-values ()
- (let-values (((len_67) (length seq_2)))
+ (if (exact-nonnegative-integer? len_74)
+ (void)
+ (raise-argument-error
+ 'for/fxvector
+ "exact-nonnegative-integer?"
+ len_74))
+ (let-values (((fill_2) 0))
+ (let-values (((v_385) (make-fxvector len_74 fill_2)))
(begin
- (if (exact-nonnegative-integer? len_67)
+ (if (zero? len_74)
(void)
- (let-values ()
- (raise-argument-error
- 'for/fxvector
- "exact-nonnegative-integer?"
- len_67)))
- (let-values (((fill_0) 0))
- (let-values (((v_35) (make-fxvector len_67 fill_0)))
- (begin
- (if (zero? len_67)
- (void)
- (let-values ()
- (let-values (((lst_66) seq_2))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_66)))
- ((letrec-values (((for-loop_204)
- (lambda (i_172 lst_284)
- (begin
- 'for-loop
- (if (pair? lst_284)
- (let-values (((e_88)
- (unsafe-car
- lst_284))
- ((rest_148)
- (unsafe-cdr
- lst_284)))
- (let-values (((i_0)
- (let-values (((i_209)
- i_172))
- (let-values (((i_44)
- (let-values ()
- (begin
- (let-values (((elem_1)
- (let-values ()
- e_88)))
- (if (fixnum?
- elem_1)
- (unsafe-fxvector-set!
- v_35
- i_209
- elem_1)
- (not-an-fX.1
- 'for*/vector
- elem_1)))
- (unsafe-fx+
- 1
- i_209)))))
- (values
- i_44)))))
- (if (if (not
- ((lambda x_99
- (unsafe-fx=
- i_0
- len_67))
- e_88))
- (not #f)
- #f)
- (for-loop_204
- i_0
- rest_148)
- i_0)))
- i_172)))))
- for-loop_204)
- 0
- lst_66)))))
- v_35))))))
- (if (equal? tmp_60 'flonum)
- (let-values ()
- (let-values (((len_68) (length seq_2)))
+ (let-values (((i_304) (let-values (((i_305) 0)) i_305)))
+ (let-values (((lst_536) seq_2))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_536))
+ ((letrec-values (((for-loop_444)
+ (lambda (i_306 lst_537)
+ (begin
+ 'for-loop
+ (if (pair? lst_537)
+ (let-values (((e_97)
+ (unsafe-car
+ lst_537))
+ ((rest_264)
+ (unsafe-cdr
+ lst_537)))
+ (let-values (((i_307)
+ (let-values (((i_308)
+ (begin
+ (let-values (((elem_3)
+ e_97))
+ (if (fixnum?
+ elem_3)
+ (unsafe-fxvector-set!
+ v_385
+ i_306
+ elem_3)
+ (not-an-fX.1
+ 'for*/vector
+ elem_3)))
+ (unsafe-fx+
+ 1
+ i_306))))
+ (values
+ i_308))))
+ (if (if (not
+ ((lambda x_107
+ (unsafe-fx=
+ i_307
+ len_74))
+ e_97))
+ (not #f)
+ #f)
+ (for-loop_444
+ i_307
+ rest_264)
+ i_307)))
+ i_306)))))
+ for-loop_444)
+ i_304
+ lst_536)))))
+ v_385)))))
+ (if (equal? tmp_63 'flonum)
+ (let-values (((len_75) (length seq_2)))
+ (begin
+ (if (exact-nonnegative-integer? len_75)
+ (void)
+ (raise-argument-error
+ 'for/flvector
+ "exact-nonnegative-integer?"
+ len_75))
+ (let-values (((fill_3) 0.0))
+ (let-values (((v_386) (make-flvector len_75 fill_3)))
(begin
- (if (exact-nonnegative-integer? len_68)
+ (if (zero? len_75)
(void)
- (let-values ()
- (raise-argument-error
- 'for/flvector
- "exact-nonnegative-integer?"
- len_68)))
- (let-values (((fill_1) 0.0))
- (let-values (((v_165) (make-flvector len_68 fill_1)))
+ (let-values (((i_309) (let-values (((i_310) 0)) i_310)))
+ (let-values (((lst_538) seq_2))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_538))
+ ((letrec-values (((for-loop_445)
+ (lambda (i_311 lst_539)
+ (begin
+ 'for-loop
+ (if (pair? lst_539)
+ (let-values (((e_98)
+ (unsafe-car
+ lst_539))
+ ((rest_265)
+ (unsafe-cdr
+ lst_539)))
+ (let-values (((i_312)
+ (let-values (((i_313)
+ (begin
+ (let-values (((elem_4)
+ e_98))
+ (if (flonum?
+ elem_4)
+ (unsafe-flvector-set!
+ v_386
+ i_311
+ elem_4)
+ (not-an-fX.1$1
+ 'for*/vector
+ elem_4)))
+ (unsafe-fx+
+ 1
+ i_311))))
+ (values
+ i_313))))
+ (if (if (not
+ ((lambda x_108
+ (unsafe-fx=
+ i_312
+ len_75))
+ e_98))
+ (not #f)
+ #f)
+ (for-loop_445
+ i_312
+ rest_265)
+ i_312)))
+ i_311)))))
+ for-loop_445)
+ i_309
+ lst_538)))))
+ v_386)))))
+ (void)))))
+ (let-values (((len_76) (length seq_2)))
+ (if (= expected-len_0 len_76)
+ (list->vector seq_2)
+ (if (< expected-len_0 len_76)
+ (let-values (((in20_1) in_38)
+ ((config21_0) config_48)
+ ((temp22_5)
+ "~avector length ~a is too small, ~a values provided")
+ ((temp23_6)
+ (let-values (((tmp_64) vector-mode_0))
+ (if (equal? tmp_64 'any)
+ ""
+ (if (equal? tmp_64 'fixnum)
+ "fx"
+ (if (equal? tmp_64 'flonum) "fl" (void))))))
+ ((expected-len24_0) expected-len_0)
+ ((len25_0) len_76))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in20_1
+ config21_0
+ temp22_5
+ (list temp23_6 expected-len24_0 len25_0)))
+ (let-values (((last-or_0)
+ (lambda (v_387)
(begin
- (if (zero? len_68)
- (void)
- (let-values ()
- (let-values (((lst_64) seq_2))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_64)))
- ((letrec-values (((for-loop_259)
- (lambda (i_3 lst_286)
- (begin
- 'for-loop
- (if (pair? lst_286)
- (let-values (((e_89)
- (unsafe-car
- lst_286))
- ((rest_150)
- (unsafe-cdr
- lst_286)))
- (let-values (((i_210)
- (let-values (((i_93)
- i_3))
- (let-values (((i_189)
- (let-values ()
- (begin
- (let-values (((elem_2)
- (let-values ()
- e_89)))
- (if (flonum?
- elem_2)
- (unsafe-flvector-set!
- v_165
- i_93
- elem_2)
- (not-an-fX.1$1
- 'for*/vector
- elem_2)))
- (unsafe-fx+
- 1
- i_93)))))
- (values
- i_189)))))
- (if (if (not
- ((lambda x_94
- (unsafe-fx=
- i_210
- len_68))
- e_89))
- (not #f)
- #f)
- (for-loop_259
- i_210
- rest_150)
- i_210)))
- i_3)))))
- for-loop_259)
- 0
- lst_64)))))
- v_165))))))
- (let-values () (void)))))))
- (let-values ()
- (let-values (((len_69) (length seq_2)))
- (if (= expected-len_0 len_69)
- (let-values () (list->vector seq_2))
- (if (< expected-len_0 len_69)
- (let-values ()
- (let-values (((in20_1) in_31)
- ((config21_0) config_10)
- ((temp22_5)
- "~avector length ~a is too small, ~a values provided")
- ((temp23_6)
- (let-values (((tmp_61) vector-mode_0))
- (if (equal? tmp_61 'any)
- (let-values () "")
- (if (equal? tmp_61 'fixnum)
- (let-values () "fx")
- (if (equal? tmp_61 'flonum)
- (let-values () "fl")
- (let-values () (void)))))))
- ((expected-len24_0) expected-len_0)
- ((len25_0) len_69))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in20_1
- config21_0
- temp22_5
- (list temp23_6 expected-len24_0 len25_0))))
- (let-values ()
- (let-values (((last-or_0)
- (lambda (v_92)
- (begin
- 'last-or
- (if (null? seq_2)
- (wrap v_92 in_31 config_10 #f)
- ((letrec-values (((loop_92)
- (lambda (seq_3)
- (begin
- 'loop
- (if (null? (cdr seq_3))
- (car seq_3)
- (loop_92
- (cdr seq_3)))))))
- loop_92)
- seq_2))))))
- (let-values ((()
- (begin
- (if (>= (integer-length expected-len_0) 48)
- (let-values ()
- (raise
- (exn:fail:out-of-memory
- "out of memory"
- (current-continuation-marks))))
- (void))
- (values))))
- (let-values (((vec_85)
- (let-values (((tmp_62) vector-mode_0))
- (if (equal? tmp_62 'any)
- (let-values ()
- (make-vector
- expected-len_0
- (last-or_0 0)))
- (if (equal? tmp_62 'fixnum)
- (let-values ()
- (make-fxvector
- expected-len_0
- (last-or_0 0)))
- (if (equal? tmp_62 'flonum)
- (let-values ()
- (make-flvector
- expected-len_0
- (last-or_0 0.0)))
- (let-values () (void))))))))
+ 'last-or
+ (if (null? seq_2)
+ (wrap v_387 in_38 config_48 #f)
+ ((letrec-values (((loop_136)
+ (lambda (seq_3)
+ (begin
+ 'loop
+ (if (null? (cdr seq_3))
+ (car seq_3)
+ (loop_136 (cdr seq_3)))))))
+ loop_136)
+ seq_2))))))
+ (let-values ((()
+ (begin
+ (if (>= (integer-length expected-len_0) 48)
+ (raise
+ (exn:fail:out-of-memory
+ "out of memory"
+ (current-continuation-marks)))
+ (void))
+ (values))))
+ (let-values (((vec_98)
+ (let-values (((tmp_65) vector-mode_0))
+ (if (equal? tmp_65 'any)
+ (make-vector expected-len_0 (last-or_0 0))
+ (if (equal? tmp_65 'fixnum)
+ (make-fxvector expected-len_0 (last-or_0 0))
+ (if (equal? tmp_65 'flonum)
+ (make-flvector expected-len_0 (last-or_0 0.0))
+ (void)))))))
+ (begin
+ (let-values (((tmp_66) vector-mode_0))
+ (if (equal? tmp_66 'any)
(begin
- (let-values (((tmp_63) vector-mode_0))
- (if (equal? tmp_63 'any)
- (let-values ()
- (begin
- (let-values (((lst_317) seq_2) ((start_70) 0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_317)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-naturals start_70)))
- ((letrec-values (((for-loop_116)
- (lambda (lst_198 pos_138)
- (begin
- 'for-loop
- (if (if (pair? lst_198)
- #t
- #f)
- (let-values (((e_90)
- (unsafe-car
- lst_198))
- ((rest_54)
- (unsafe-cdr
- lst_198))
- ((i_28)
- pos_138))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (vector-set!
- vec_85
- i_28
- e_90))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_116
- rest_54
- (+ pos_138 1))
- (values))))
- (values))))))
- for-loop_116)
- lst_317
- start_70)))
- (void)))
- (if (equal? tmp_63 'fixnum)
- (let-values ()
- (begin
- (let-values (((lst_295) seq_2) ((start_71) 0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_295)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-naturals start_71)))
- ((letrec-values (((for-loop_28)
- (lambda (lst_203 pos_139)
- (begin
- 'for-loop
- (if (if (pair?
- lst_203)
- #t
- #f)
- (let-values (((e_91)
- (unsafe-car
- lst_203))
- ((rest_12)
- (unsafe-cdr
- lst_203))
- ((i_211)
- pos_139))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (fxvector-set!
- vec_85
- i_211
- e_91))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_28
- rest_12
- (+
- pos_139
- 1))
- (values))))
- (values))))))
- for-loop_28)
- lst_295
- start_71)))
- (void)))
- (if (equal? tmp_63 'flonum)
- (let-values ()
- (begin
- (let-values (((lst_318) seq_2) ((start_72) 0))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_318)))
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values ()
- (check-naturals start_72)))
- ((letrec-values (((for-loop_292)
- (lambda (lst_98 pos_36)
- (begin
- 'for-loop
- (if (if (pair?
- lst_98)
- #t
- #f)
- (let-values (((e_92)
- (unsafe-car
- lst_98))
- ((rest_178)
- (unsafe-cdr
- lst_98))
- ((i_66)
- pos_36))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (flvector-set!
- vec_85
- i_66
- e_92))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_292
- rest_178
- (+
- pos_36
- 1))
+ (let-values (((lst_540) seq_2) ((start_83) 0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_540))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-naturals start_83))
+ ((letrec-values (((for-loop_446)
+ (lambda (lst_541 pos_177)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_541) #t #f)
+ (let-values (((e_99)
+ (unsafe-car
+ lst_541))
+ ((rest_266)
+ (unsafe-cdr
+ lst_541))
+ ((i_314)
+ pos_177))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (vector-set!
+ vec_98
+ i_314
+ e_99)
+ (values))))
(values))))
- (values))))))
- for-loop_292)
- lst_318
- start_72)))
- (void)))
- (let-values () (void))))))
- vec_85))))))))))))
- (wrap
- (if (read-config-for-syntax? config_10) (vector->immutable-vector vec_84) vec_84)
- in_31
- config_10
- opener_2))))))))))))))))
+ (if (not #f)
+ (for-loop_446
+ rest_266
+ (+ pos_177 1))
+ (values))))
+ (values))))))
+ for-loop_446)
+ lst_540
+ start_83)))
+ (void))
+ (if (equal? tmp_66 'fixnum)
+ (begin
+ (let-values (((lst_542) seq_2) ((start_84) 0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_542))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-naturals start_84))
+ ((letrec-values (((for-loop_447)
+ (lambda (lst_543 pos_178)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_543) #t #f)
+ (let-values (((e_100)
+ (unsafe-car
+ lst_543))
+ ((rest_267)
+ (unsafe-cdr
+ lst_543))
+ ((i_315)
+ pos_178))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (fxvector-set!
+ vec_98
+ i_315
+ e_100)
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_447
+ rest_267
+ (+ pos_178 1))
+ (values))))
+ (values))))))
+ for-loop_447)
+ lst_542
+ start_84)))
+ (void))
+ (if (equal? tmp_66 'flonum)
+ (begin
+ (let-values (((lst_544) seq_2) ((start_85) 0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_544))
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-naturals start_85))
+ ((letrec-values (((for-loop_448)
+ (lambda (lst_545 pos_179)
+ (begin
+ 'for-loop
+ (if (if (pair? lst_545)
+ #t
+ #f)
+ (let-values (((e_101)
+ (unsafe-car
+ lst_545))
+ ((rest_268)
+ (unsafe-cdr
+ lst_545))
+ ((i_316)
+ pos_179))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (flvector-set!
+ vec_98
+ i_316
+ e_101)
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_448
+ rest_268
+ (+ pos_179 1))
+ (values))))
+ (values))))))
+ for-loop_448)
+ lst_544
+ start_85)))
+ (void))
+ (void)))))
+ vec_98))))))))))
+ (wrap
+ (if (read-config-for-syntax? config_48) (vector->immutable-vector vec_97) vec_97)
+ in_38
+ config_48
+ opener_2)))))))))))))))
(define-values
(read-fixnum-or-flonum-vector)
- (lambda (read-one_8 dispatch-c_0 c_124 c2_9 in_34 config_42)
+ (lambda (read-one_8 dispatch-c_0 c_177 c2_6 in_41 config_51)
(begin
- (let-values (((vector-mode_1) (if (char=? c2_9 '#\x) 'fixnum 'flonum)))
- (let-values ((() (begin (consume-char in_34 c2_9) (values))))
+ (let-values (((vector-mode_1) (if (char=? c2_6 '#\x) 'fixnum 'flonum)))
+ (let-values ((() (begin (consume-char in_41 c2_6) (values))))
(let-values ((()
(begin
- (if (read-config-for-syntax? config_42)
- (let-values ()
- (let-values (((in26_1) in_34)
- ((config27_0) config_42)
- ((temp28_5) "literal f~avectors not allowed")
- ((c229_0) c2_9))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in26_1
- config27_0
- temp28_5
- (list c229_0))))
+ (if (read-config-for-syntax? config_51)
+ (let-values (((in26_1) in_41)
+ ((config27_0) config_51)
+ ((temp28_4) "literal f~avectors not allowed")
+ ((c229_0) c2_6))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in26_1
+ config27_0
+ temp28_4
+ (list c229_0)))
(void))
(values))))
- (let-values (((c3_4)
- (let-values (((in_35) in_34) ((source_19) (read-config-source config_42)))
- (read-char-or-special in_35 special1.1 source_19))))
- (let-values (((vector-len_0 len-str_0 c4_1)
- (if (decimal-digit? c3_4)
- (let-values () (read-simple-number in_34 config_42 c3_4))
- (let-values () (values #f "" c3_4)))))
- (let-values (((tmp_64) c4_1))
- (if (equal? tmp_64 '#\()
- (let-values ()
- (let-values (((read-one30_0) read-one_8)
- ((temp31_3) '#\()
- ((temp32_6) '#\()
- ((temp33_6) '#\))
- ((in34_2) in_34)
- ((config35_0) config_42)
- ((vector-mode36_0) vector-mode_1)
- ((vector-len37_0) vector-len_0))
- (read-vector.1
- vector-len37_0
- vector-mode36_0
- read-one30_0
- temp31_3
- temp32_6
- temp33_6
- in34_2
- config35_0)))
- (if (equal? tmp_64 '#\[)
- (let-values ()
- (if (check-parameter 1/read-square-bracket-as-paren config_42)
- (let-values ()
- (let-values (((read-one38_0) read-one_8)
- ((temp39_4) '#\[)
- ((temp40_3) '#\[)
- ((temp41_4) '#\])
- ((in42_0) in_34)
- ((config43_0) config_42)
- ((vector-mode44_0) vector-mode_1)
- ((vector-len45_0) vector-len_0))
- (read-vector.1
- vector-len45_0
- vector-mode44_0
- read-one38_0
- temp39_4
- temp40_3
- temp41_4
- in42_0
- config43_0)))
- (let-values ()
- (let-values (((in46_0) in_34)
- ((config47_0) config_42)
- ((temp48_4) (format "~a~a" dispatch-c_0 (format "~a~a" c_124 c2_9))))
- (bad-syntax-error.1 '#\x in46_0 config47_0 temp48_4)))))
- (if (equal? tmp_64 '#\{)
- (let-values ()
- (if (check-parameter 1/read-curly-brace-as-paren config_42)
- (let-values ()
- (let-values (((read-one49_0) read-one_8)
- ((temp50_2) '#\{)
- ((temp51_4) '#\{)
- ((temp52_3) '#\})
- ((in53_0) in_34)
- ((config54_0) config_42)
- ((vector-mode55_0) vector-mode_1)
- ((vector-len56_0) vector-len_0))
- (read-vector.1
- vector-len56_0
- vector-mode55_0
- read-one49_0
- temp50_2
- temp51_4
- temp52_3
- in53_0
- config54_0)))
- (let-values ()
- (let-values (((in57_0) in_34)
- ((config58_0) config_42)
- ((temp59_0) (format "~a~a" dispatch-c_0 (format "~a~a" c_124 c2_9))))
- (bad-syntax-error.1 '#\x in57_0 config58_0 temp59_0)))))
- (let-values ()
- (let-values (((in60_0) in_34)
- ((config61_0) config_42)
- ((c462_0) c4_1)
- ((temp63_5) "expected `(`, `[`, or `{` after `#~a~a~a`")
- ((c64_0) c_124)
- ((c265_0) c2_9)
- ((len-str66_0) len-str_0))
- (reader-error.1
- unsafe-undefined
- c462_0
- #f
- unsafe-undefined
- in60_0
- config61_0
- temp63_5
- (list c64_0 c265_0 len-str66_0))))))))))))))))
+ (let-values (((c3_2)
+ (let-values (((in_42) in_41) ((source_20) (read-config-source config_51)))
+ (read-char-or-special in_42 special1.1 source_20))))
+ (let-values (((vector-len_0 len-str_0 c4_0)
+ (if (decimal-digit? c3_2) (read-simple-number in_41 config_51 c3_2) (values #f "" c3_2))))
+ (let-values (((tmp_67) c4_0))
+ (if (equal? tmp_67 '#\()
+ (let-values (((read-one30_0) read-one_8)
+ ((temp31_4) '#\()
+ ((temp32_5) '#\()
+ ((temp33_6) '#\))
+ ((in34_2) in_41)
+ ((config35_0) config_51)
+ ((vector-mode36_0) vector-mode_1)
+ ((vector-len37_0) vector-len_0))
+ (read-vector.1
+ vector-len37_0
+ vector-mode36_0
+ read-one30_0
+ temp31_4
+ temp32_5
+ temp33_6
+ in34_2
+ config35_0))
+ (if (equal? tmp_67 '#\[)
+ (if (check-parameter 1/read-square-bracket-as-paren config_51)
+ (let-values (((read-one38_0) read-one_8)
+ ((temp39_3) '#\[)
+ ((temp40_3) '#\[)
+ ((temp41_3) '#\])
+ ((in42_0) in_41)
+ ((config43_0) config_51)
+ ((vector-mode44_0) vector-mode_1)
+ ((vector-len45_0) vector-len_0))
+ (read-vector.1
+ vector-len45_0
+ vector-mode44_0
+ read-one38_0
+ temp39_3
+ temp40_3
+ temp41_3
+ in42_0
+ config43_0))
+ (let-values (((in46_0) in_41)
+ ((config47_0) config_51)
+ ((temp48_4) (format "~a~a" dispatch-c_0 (format "~a~a" c_177 c2_6))))
+ (bad-syntax-error.1 '#\x in46_0 config47_0 temp48_4)))
+ (if (equal? tmp_67 '#\{)
+ (if (check-parameter 1/read-curly-brace-as-paren config_51)
+ (let-values (((read-one49_0) read-one_8)
+ ((temp50_3) '#\{)
+ ((temp51_4) '#\{)
+ ((temp52_1) '#\})
+ ((in53_0) in_41)
+ ((config54_0) config_51)
+ ((vector-mode55_0) vector-mode_1)
+ ((vector-len56_0) vector-len_0))
+ (read-vector.1
+ vector-len56_0
+ vector-mode55_0
+ read-one49_0
+ temp50_3
+ temp51_4
+ temp52_1
+ in53_0
+ config54_0))
+ (let-values (((in57_0) in_41)
+ ((config58_0) config_51)
+ ((temp59_0) (format "~a~a" dispatch-c_0 (format "~a~a" c_177 c2_6))))
+ (bad-syntax-error.1 '#\x in57_0 config58_0 temp59_0)))
+ (let-values (((in60_0) in_41)
+ ((config61_0) config_51)
+ ((c462_0) c4_0)
+ ((temp63_3) "expected `(`, `[`, or `{` after `#~a~a~a`")
+ ((c64_0) c_177)
+ ((c265_0) c2_6)
+ ((len-str66_0) len-str_0))
+ (reader-error.1
+ unsafe-undefined
+ c462_0
+ #f
+ unsafe-undefined
+ in60_0
+ config61_0
+ temp63_3
+ (list c64_0 c265_0 len-str66_0)))))))))))))))
(define-values
(read-simple-number)
- (lambda (in_36 config_43 init-c_12)
- (begin
- (let-values (((accum-str_2) (accum-string-init! config_43)))
- (let-values ((() (begin (accum-string-add! accum-str_2 init-c_12) (values))))
- (let-values (((init-v_1) (digit->number init-c_12)))
- (let-values (((v_259)
- (let-values (((in67_0) in_36)
- ((config68_0) config_43)
+ (lambda (in_43 config_52 init-c_13)
+ (begin
+ (let-values (((accum-str_2) (accum-string-init! config_52)))
+ (let-values ((() (begin (accum-string-add! accum-str_2 init-c_13) (values))))
+ (let-values (((init-v_1) (digit->number init-c_13)))
+ (let-values (((v_388)
+ (let-values (((in67_0) in_43)
+ ((config68_0) config_52)
((accum-str69_0) accum-str_2)
- ((temp70_5) 10)
- ((temp71_1) +inf.0)
+ ((temp70_3) 10)
+ ((temp71_2) +inf.0)
((init-v72_0) init-v_1)
((init-v73_0) init-v_1))
- (read-digits.1 temp70_5 init-v72_0 temp71_1 init-v73_0 in67_0 config68_0 accum-str69_0))))
+ (read-digits.1 temp70_3 init-v72_0 temp71_2 init-v73_0 in67_0 config68_0 accum-str69_0))))
(values
- v_259
- (let-values (((accum-str74_0) accum-str_2) ((config75_0) config_43))
+ v_388
+ (let-values (((accum-str74_0) accum-str_2) ((config75_0) config_52))
(accum-string-get!.1 0 accum-str74_0 config75_0))
- (let-values (((in_37) in_36) ((source_20) (read-config-source config_43)))
- (read-char-or-special in_37 special1.1 source_20))))))))))
+ (let-values (((in_44) in_43) ((source_21) (read-config-source config_52)))
+ (read-char-or-special in_44 special1.1 source_21))))))))))
(define-values
(read-struct)
- (lambda (read-one_4 dispatch-c_1 in_6 config_15)
+ (lambda (read-one_9 dispatch-c_1 in_45 config_53)
(begin
- (let-values (((c_39)
- (let-values (((in_38) in_6) ((source_21) (read-config-source config_15)))
- (read-char-or-special in_38 special1.1 source_21))))
- (let-values (((ec_7) (effective-char c_39 config_15)))
+ (let-values (((c_178)
+ (let-values (((in_46) in_45) ((source_22) (read-config-source config_53)))
+ (read-char-or-special in_46 special1.1 source_22))))
+ (let-values (((ec_7) (effective-char c_178 config_53)))
(let-values (((seq_4)
- (let-values (((tmp_65) ec_7))
- (if (equal? tmp_65 '#\()
- (let-values () (read-struct-sequence read-one_4 c_39 '#\( '#\) in_6 config_15))
- (if (equal? tmp_65 '#\[)
- (let-values ()
- (if (check-parameter 1/read-square-bracket-as-paren config_15)
- (let-values () (read-struct-sequence read-one_4 c_39 '#\[ '#\] in_6 config_15))
- (let-values ()
- (let-values (((in1_3) in_6)
- ((config2_3) config_15)
- ((temp3_6) (format "~as~a" dispatch-c_1 c_39)))
- (bad-syntax-error.1 '#\x in1_3 config2_3 temp3_6)))))
- (if (equal? tmp_65 '#\{)
- (let-values ()
- (if (check-parameter 1/read-curly-brace-as-paren config_15)
- (let-values () (read-struct-sequence read-one_4 c_39 '#\{ '#\} in_6 config_15))
- (let-values ()
- (let-values (((in4_1) in_6)
- ((config5_1) config_15)
- ((temp6_3) (format "~as~a" dispatch-c_1 c_39)))
- (bad-syntax-error.1 '#\x in4_1 config5_1 temp6_3)))))
- (let-values ()
- (let-values (((in7_0) in_6)
- ((config8_0) config_15)
- ((temp9_6) "expected ~a after `~as`")
- ((temp10_5) (all-openers-str config_15))
- ((dispatch-c11_0) dispatch-c_1))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in7_0
- config8_0
- temp9_6
- (list temp10_5 dispatch-c11_0))))))))))
- (let-values ((()
- (begin
- (if (null? seq_4)
- (let-values ()
- (let-values (((in12_1) in_6)
- ((config13_0) config_15)
- ((temp14_6) "missing structure description in `~as` form")
- ((dispatch-c15_0) dispatch-c_1))
+ (let-values (((tmp_68) ec_7))
+ (if (equal? tmp_68 '#\()
+ (read-struct-sequence read-one_9 c_178 '#\( '#\) in_45 config_53)
+ (if (equal? tmp_68 '#\[)
+ (if (check-parameter 1/read-square-bracket-as-paren config_53)
+ (read-struct-sequence read-one_9 c_178 '#\[ '#\] in_45 config_53)
+ (let-values (((in1_3) in_45)
+ ((config2_3) config_53)
+ ((temp3_6) (format "~as~a" dispatch-c_1 c_178)))
+ (bad-syntax-error.1 '#\x in1_3 config2_3 temp3_6)))
+ (if (equal? tmp_68 '#\{)
+ (if (check-parameter 1/read-curly-brace-as-paren config_53)
+ (read-struct-sequence read-one_9 c_178 '#\{ '#\} in_45 config_53)
+ (let-values (((in4_1) in_45)
+ ((config5_1) config_53)
+ ((temp6_3) (format "~as~a" dispatch-c_1 c_178)))
+ (bad-syntax-error.1 '#\x in4_1 config5_1 temp6_3)))
+ (let-values (((in7_0) in_45)
+ ((config8_0) config_53)
+ ((temp9_6) "expected ~a after `~as`")
+ ((temp10_5) (all-openers-str config_53))
+ ((dispatch-c11_0) dispatch-c_1))
(reader-error.1
unsafe-undefined
'#\x
#f
unsafe-undefined
- in12_1
- config13_0
- temp14_6
- (list dispatch-c15_0))))
+ in7_0
+ config8_0
+ temp9_6
+ (list temp10_5 dispatch-c11_0)))))))))
+ (let-values ((()
+ (begin
+ (if (null? seq_4)
+ (let-values (((in12_1) in_45)
+ ((config13_0) config_53)
+ ((temp14_6) "missing structure description in `~as` form")
+ ((dispatch-c15_0) dispatch-c_1))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in12_1
+ config13_0
+ temp14_6
+ (list dispatch-c15_0)))
(void))
(values))))
(let-values ((()
(begin
(if (prefab-key? (car seq_4))
(void)
- (let-values ()
- (let-values (((in16_2) in_6)
- ((config17_2) config_15)
- ((temp18_7) "invalid structure description in `~as` form")
- ((dispatch-c19_0) dispatch-c_1))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in16_2
- config17_2
- temp18_7
- (list dispatch-c19_0)))))
+ (let-values (((in16_2) in_45)
+ ((config17_2) config_53)
+ ((temp18_8) "invalid structure description in `~as` form")
+ ((dispatch-c19_0) dispatch-c_1))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in16_2
+ config17_2
+ temp18_8
+ (list dispatch-c19_0))))
(values))))
(let-values (((st_2)
(let-values (((with-handlers-predicate20_0) exn:fail?)
((with-handlers-handler21_0)
- (lambda (exn_7) (begin 'with-handlers-handler21 #f))))
+ (lambda (exn_6) (begin 'with-handlers-handler21 #f))))
(let-values (((bpz_7) (continuation-mark-set-first #f break-enabled-key)))
(call-handled-body
bpz_7
- (lambda (e_93)
+ (lambda (e_102)
(select-handler/no-breaks
- e_93
+ e_102
bpz_7
(list (cons with-handlers-predicate20_0 with-handlers-handler21_0))))
(lambda () (prefab-key->struct-type (car seq_4) (length (cdr seq_4)))))))))
(begin
(if st_2
(void)
- (let-values ()
- (let-values (((in22_1) in_6)
- ((config23_1) config_15)
- ((temp24_5)
- (string-append
- "mismatch between structure description"
- " and number of provided field values in `~as` form"))
- ((dispatch-c25_0) dispatch-c_1))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in22_1
- config23_1
- temp24_5
- (list dispatch-c25_0)))))
- (if (read-config-for-syntax? config_15)
- (let-values ()
- (if (all-fields-immutable? (car seq_4))
- (void)
- (let-values ()
- (let-values (((in26_2) in_6)
- ((config27_1) config_15)
- ((temp28_6) "cannot read mutable `~as` form as syntax")
- ((dispatch-c29_0) dispatch-c_1))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in26_2
- config27_1
- temp28_6
- (list dispatch-c29_0))))))
+ (let-values (((in22_1) in_45)
+ ((config23_1) config_53)
+ ((temp24_4)
+ (string-append
+ "mismatch between structure description"
+ " and number of provided field values in `~as` form"))
+ ((dispatch-c25_0) dispatch-c_1))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in22_1
+ config23_1
+ temp24_4
+ (list dispatch-c25_0))))
+ (if (read-config-for-syntax? config_53)
+ (if (all-fields-immutable? (car seq_4))
+ (void)
+ (let-values (((in26_2) in_45)
+ ((config27_1) config_53)
+ ((temp28_5) "cannot read mutable `~as` form as syntax")
+ ((dispatch-c29_0) dispatch-c_1))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in26_2
+ config27_1
+ temp28_5
+ (list dispatch-c29_0))))
(void))
- (wrap (apply make-prefab-struct seq_4) in_6 config_15 ec_7)))))))))))
+ (wrap (apply make-prefab-struct seq_4) in_45 config_53 ec_7)))))))))))
(define-values
(read-struct-sequence)
- (lambda (read-one_9 opener-c_2 opener_3 closer_3 in_39 config_11)
+ (lambda (read-one_10 opener-c_2 opener_3 closer_3 in_47 config_54)
(begin
- (let-values (((read-one30_1) read-one_9)
+ (let-values (((read-one30_1) read-one_10)
((opener-c31_0) opener-c_2)
((opener32_0) opener_3)
((closer33_0) closer_3)
- ((in34_3) in_39)
- ((config35_1) config_11)
- ((temp36_4)
- (lambda (init-c_13 in_17 config_20) (read-one_9 init-c_13 in_17 (disable-wrapping config_20)))))
+ ((in34_3) in_47)
+ ((config35_1) config_54)
+ ((temp36_5)
+ (lambda (init-c_14 in_48 config_55) (read-one_10 init-c_14 in_48 (disable-wrapping config_55)))))
(read-unwrapped-sequence.1
'all
unsafe-undefined
- temp36_4
+ temp36_5
#f
unsafe-undefined
read-one30_1
@@ -62344,1800 +60849,1653 @@
config35_1)))))
(define-values
(read-vector-or-graph)
- (lambda (read-one_4 dispatch-c_1 init-c_14 in_40 config_44)
- (begin
- (let-values (((accum-str_3) (accum-string-init! config_44)))
- (let-values ((() (begin (accum-string-add! accum-str_3 init-c_14) (values))))
- (let-values (((init-v_2) (digit->number init-c_14)))
- (let-values (((v_31)
- (let-values (((in1_4) in_40)
- ((config2_4) config_44)
+ (lambda (read-one_11 dispatch-c_2 init-c_15 in_49 config_56)
+ (begin
+ (let-values (((accum-str_3) (accum-string-init! config_56)))
+ (let-values ((() (begin (accum-string-add! accum-str_3 init-c_15) (values))))
+ (let-values (((init-v_2) (digit->number init-c_15)))
+ (let-values (((v_389)
+ (let-values (((in1_4) in_49)
+ ((config2_4) config_56)
((accum-str3_0) accum-str_3)
((temp4_4) 10)
((temp5_7) +inf.0)
((init-v6_0) init-v_2)
((init-v7_0) init-v_2))
(read-digits.1 temp4_4 init-v6_0 temp5_7 init-v7_0 in1_4 config2_4 accum-str3_0))))
- (let-values (((post-line_0 post-col_0 post-pos_0) (port-next-location in_40)))
+ (let-values (((post-line_0 post-col_0 post-pos_0) (port-next-location in_49)))
(let-values (((get-accum_0)
- (lambda (c_125)
+ (lambda (c_179)
(begin
'get-accum
(format
"~a~a~a"
- dispatch-c_1
- (let-values (((accum-str8_0) accum-str_3) ((config9_0) config_44))
+ dispatch-c_2
+ (let-values (((accum-str8_0) accum-str_3) ((config9_0) config_56))
(accum-string-get!.1 0 accum-str8_0 config9_0))
- c_125)))))
- (let-values (((c_80)
- (let-values (((in_14) in_40) ((source_22) (read-config-source config_44)))
- (read-char-or-special in_14 special1.1 source_22))))
- (let-values (((ec_8) (effective-char c_80 config_44)))
- (let-values (((tmp_66) ec_8))
- (if (equal? tmp_66 '#\()
- (let-values ()
+ c_179)))))
+ (let-values (((c_180)
+ (let-values (((in_50) in_49) ((source_23) (read-config-source config_56)))
+ (read-char-or-special in_50 special1.1 source_23))))
+ (let-values (((ec_8) (effective-char c_180 config_56)))
+ (let-values (((tmp_69) ec_8))
+ (if (equal? tmp_69 '#\()
+ (begin
+ (accum-string-abandon! accum-str_3 config_56)
+ (let-values (((read-one10_0) read-one_11)
+ ((c11_2) c_180)
+ ((temp12_8) '#\()
+ ((temp13_9) '#\))
+ ((in14_0) in_49)
+ ((config15_0) config_56)
+ ((v16_0) v_389))
+ (read-vector.1 v16_0 'any read-one10_0 c11_2 temp12_8 temp13_9 in14_0 config15_0)))
+ (if (equal? tmp_69 '#\[)
(begin
- (accum-string-abandon! accum-str_3 config_44)
- (let-values (((read-one10_0) read-one_4)
- ((c11_2) c_80)
- ((temp12_8) '#\()
- ((temp13_2) '#\))
- ((in14_0) in_40)
- ((config15_0) config_44)
- ((v16_0) v_31))
- (read-vector.1 v16_0 'any read-one10_0 c11_2 temp12_8 temp13_2 in14_0 config15_0))))
- (if (equal? tmp_66 '#\[)
- (let-values ()
+ (accum-string-abandon! accum-str_3 config_56)
+ (if (check-parameter 1/read-square-bracket-as-paren config_56)
+ (let-values (((read-one17_0) read-one_11)
+ ((c18_0) c_180)
+ ((temp19_7) '#\[)
+ ((temp20_6) '#\])
+ ((in21_1) in_49)
+ ((config22_1) config_56)
+ ((v23_0) v_389))
+ (read-vector.1 v23_0 'any read-one17_0 c18_0 temp19_7 temp20_6 in21_1 config22_1))
+ (let-values (((in24_0) in_49)
+ ((config25_0) config_56)
+ ((temp26_3) (get-accum_0 (get-accum_0 c_180))))
+ (bad-syntax-error.1 '#\x in24_0 config25_0 temp26_3))))
+ (if (equal? tmp_69 '#\{)
(begin
- (accum-string-abandon! accum-str_3 config_44)
- (if (check-parameter 1/read-square-bracket-as-paren config_44)
- (let-values ()
- (let-values (((read-one17_0) read-one_4)
- ((c18_0) c_80)
- ((temp19_2) '#\[)
- ((temp20_6) '#\])
- ((in21_1) in_40)
- ((config22_1) config_44)
- ((v23_0) v_31))
- (read-vector.1
- v23_0
- 'any
- read-one17_0
- c18_0
- temp19_2
- temp20_6
- in21_1
- config22_1)))
- (let-values ()
- (let-values (((in24_0) in_40)
- ((config25_0) config_44)
- ((temp26_3) (get-accum_0 (get-accum_0 c_80))))
- (bad-syntax-error.1 '#\x in24_0 config25_0 temp26_3))))))
- (if (equal? tmp_66 '#\{)
- (let-values ()
- (begin
- (accum-string-abandon! accum-str_3 config_44)
- (if (check-parameter 1/read-curly-brace-as-paren config_44)
- (let-values ()
- (let-values (((read-one27_0) read-one_4)
- ((c28_0) c_80)
- ((temp29_5) '#\{)
- ((temp30_4) '#\})
- ((in31_1) in_40)
- ((config32_0) config_44)
- ((v33_0) v_31))
- (read-vector.1
- v33_0
- 'any
- read-one27_0
- c28_0
- temp29_5
- temp30_4
- in31_1
- config32_0)))
- (let-values ()
- (let-values (((in34_4) in_40)
- ((config35_2) config_44)
- ((temp36_5) (get-accum_0 (get-accum_0 c_80))))
- (bad-syntax-error.1 '#\x in34_4 config35_2 temp36_5))))))
- (let-values ()
- (let-values (((tmp_62) c_80))
- (if (if (equal? tmp_62 '#\=) #t (equal? tmp_62 '#\#))
- (let-values ()
- (begin
- (if (check-parameter
- (if (read-config-for-syntax? config_44)
- 1/read-syntax-accept-graph
- 1/read-accept-graph)
- config_44)
- (void)
- (let-values ()
- (let-values (((in37_0) in_40)
- ((config38_0) config_44)
- ((temp39_5) "`#...~a` forms not enabled for `~a` mode")
- ((c40_0) c_80)
- ((temp41_5)
- (if (read-config-for-syntax? config_44)
- "read-syntax"
- "read")))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in37_0
- config38_0
- temp39_5
- (list c40_0 temp41_5)))))
- (if (<= (accum-string-count accum-str_3) 8)
- (void)
- (let-values ()
- (let-values (((in42_1) in_40)
- ((config43_1) config_44)
- ((temp44_2) "graph ID too long in `~a~a~a`")
- ((dispatch-c45_0) dispatch-c_1)
- ((temp46_2)
- (let-values (((accum-str48_0) accum-str_3)
- ((config49_0) config_44))
- (accum-string-get!.1 0 accum-str48_0 config49_0)))
- ((c47_0) c_80))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in42_1
- config43_1
- temp44_2
- (list dispatch-c45_0 temp46_2 c47_0)))))
- (let-values (((tmp_67) c_80))
- (if (equal? tmp_67 '#\=)
- (let-values ()
- (let-values (((ph_2) (make-placeholder 'placeholder)))
- (let-values (((ht_176) (get-graph-hash config_44)))
- (let-values ((()
- (begin
- (if (hash-ref ht_176 v_31 #f)
- (let-values ()
- (let-values (((in50_0) in_40)
- ((config51_0) config_44)
- ((temp52_4) "multiple `~a~a~a` tags")
- ((dispatch-c53_0) dispatch-c_1)
- ((temp54_5)
- (let-values (((accum-str56_0)
- accum-str_3)
- ((config57_0)
- config_44))
- (accum-string-get!.1
- 0
- accum-str56_0
- config57_0)))
- ((c55_0) c_80))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in50_0
- config51_0
- temp52_4
- (list dispatch-c53_0 temp54_5 c55_0))))
- (void))
- (values))))
- (let-values ((() (begin (hash-set! ht_176 v_31 ph_2) (values))))
- (let-values (((result-v_0)
- (read-one_4 #f in_40 (next-readtable config_44))))
- (begin
- (if (eof-object? result-v_0)
- (let-values ()
- (let-values (((in58_0) in_40)
- ((config59_0) config_44)
- ((result-v60_0) result-v_0)
- ((temp61_5)
- "expected an element for graph after `~a~a~a`, found end-of-file")
- ((dispatch-c62_0) dispatch-c_1)
- ((temp63_6)
- (let-values (((accum-str65_0) accum-str_3)
- ((config66_0) config_44))
+ (accum-string-abandon! accum-str_3 config_56)
+ (if (check-parameter 1/read-curly-brace-as-paren config_56)
+ (let-values (((read-one27_0) read-one_11)
+ ((c28_0) c_180)
+ ((temp29_3) '#\{)
+ ((temp30_4) '#\})
+ ((in31_1) in_49)
+ ((config32_0) config_56)
+ ((v33_0) v_389))
+ (read-vector.1 v33_0 'any read-one27_0 c28_0 temp29_3 temp30_4 in31_1 config32_0))
+ (let-values (((in34_4) in_49)
+ ((config35_2) config_56)
+ ((temp36_6) (get-accum_0 (get-accum_0 c_180))))
+ (bad-syntax-error.1 '#\x in34_4 config35_2 temp36_6))))
+ (let-values (((tmp_70) c_180))
+ (if (if (equal? tmp_70 '#\=) #t (equal? tmp_70 '#\#))
+ (begin
+ (if (check-parameter
+ (if (read-config-for-syntax? config_56)
+ 1/read-syntax-accept-graph
+ 1/read-accept-graph)
+ config_56)
+ (void)
+ (let-values (((in37_0) in_49)
+ ((config38_0) config_56)
+ ((temp39_4) "`#...~a` forms not enabled for `~a` mode")
+ ((c40_0) c_180)
+ ((temp41_4)
+ (if (read-config-for-syntax? config_56) "read-syntax" "read")))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in37_0
+ config38_0
+ temp39_4
+ (list c40_0 temp41_4))))
+ (if (<= (accum-string-count accum-str_3) 8)
+ (void)
+ (let-values (((in42_1) in_49)
+ ((config43_1) config_56)
+ ((temp44_1) "graph ID too long in `~a~a~a`")
+ ((dispatch-c45_0) dispatch-c_2)
+ ((temp46_4)
+ (let-values (((accum-str48_0) accum-str_3) ((config49_0) config_56))
+ (accum-string-get!.1 0 accum-str48_0 config49_0)))
+ ((c47_0) c_180))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in42_1
+ config43_1
+ temp44_1
+ (list dispatch-c45_0 temp46_4 c47_0))))
+ (let-values (((tmp_71) c_180))
+ (if (equal? tmp_71 '#\=)
+ (let-values (((ph_2) (make-placeholder 'placeholder)))
+ (let-values (((ht_240) (get-graph-hash config_56)))
+ (let-values ((()
+ (begin
+ (if (hash-ref ht_240 v_389 #f)
+ (let-values (((in50_0) in_49)
+ ((config51_0) config_56)
+ ((temp52_2) "multiple `~a~a~a` tags")
+ ((dispatch-c53_0) dispatch-c_2)
+ ((temp54_2)
+ (let-values (((accum-str56_0) accum-str_3)
+ ((config57_0) config_56))
(accum-string-get!.1
0
- accum-str65_0
- config66_0)))
- ((c64_1) c_80))
+ accum-str56_0
+ config57_0)))
+ ((c55_0) c_180))
(reader-error.1
unsafe-undefined
- result-v60_0
+ '#\x
#f
unsafe-undefined
- in58_0
- config59_0
- temp61_5
- (list dispatch-c62_0 temp63_6 c64_1))))
- (void))
- (accum-string-abandon! accum-str_3 config_44)
- (placeholder-set! ph_2 result-v_0)
- (wrap ph_2 in_40 config_44 ph_2))))))))
- (if (equal? tmp_67 '#\#)
- (let-values ()
- (let-values (((ph_3)
- (hash-ref
- (let-values (((or-part_148)
- (read-config-state-graph
- (read-config-st config_44))))
- (if or-part_148 or-part_148 '#hash()))
- v_31
- (lambda ()
- (let-values (((in67_1) in_40)
- ((config68_1) config_44)
- ((temp69_3)
- "no preceding `~a~a=` for `~a~a~a`")
- ((dispatch-c70_0) dispatch-c_1)
- ((v71_0) v_31)
- ((dispatch-c72_0) dispatch-c_1)
- ((temp73_4)
- (let-values (((accum-str75_0)
- accum-str_3)
- ((config76_0) config_44))
- (accum-string-get!.1
- 0
- accum-str75_0
- config76_0)))
- ((c74_0) c_80))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in67_1
- config68_1
- temp69_3
- (list
- dispatch-c70_0
- v71_0
- dispatch-c72_0
- temp73_4
- c74_0)))))))
+ in50_0
+ config51_0
+ temp52_2
+ (list dispatch-c53_0 temp54_2 c55_0)))
+ (void))
+ (values))))
+ (let-values ((() (begin (hash-set! ht_240 v_389 ph_2) (values))))
+ (let-values (((result-v_0)
+ (read-one_11 #f in_49 (next-readtable config_56))))
(begin
- (accum-string-abandon! accum-str_3 config_44)
- (wrap ph_3 in_40 config_44 ph_3))))
- (let-values () (void)))))))
- (let-values ()
- (let-values (((in77_0) in_40)
- ((config78_0) config_44)
- ((c79_0) c_80)
- ((temp80_1) "bad syntax `~a`")
- ((temp81_2) (get-accum_0 c_80)))
- (reader-error.1
- unsafe-undefined
- c79_0
- #f
- unsafe-undefined
- in77_0
- config78_0
- temp80_1
- (list temp81_2))))))))))))))))))))))
+ (if (eof-object? result-v_0)
+ (let-values (((in58_0) in_49)
+ ((config59_0) config_56)
+ ((result-v60_0) result-v_0)
+ ((temp61_3)
+ "expected an element for graph after `~a~a~a`, found end-of-file")
+ ((dispatch-c62_0) dispatch-c_2)
+ ((temp63_4)
+ (let-values (((accum-str65_0) accum-str_3)
+ ((config66_0) config_56))
+ (accum-string-get!.1 0 accum-str65_0 config66_0)))
+ ((c64_1) c_180))
+ (reader-error.1
+ unsafe-undefined
+ result-v60_0
+ #f
+ unsafe-undefined
+ in58_0
+ config59_0
+ temp61_3
+ (list dispatch-c62_0 temp63_4 c64_1)))
+ (void))
+ (accum-string-abandon! accum-str_3 config_56)
+ (placeholder-set! ph_2 result-v_0)
+ (wrap ph_2 in_49 config_56 ph_2)))))))
+ (if (equal? tmp_71 '#\#)
+ (let-values (((ph_3)
+ (hash-ref
+ (let-values (((or-part_860)
+ (read-config-state-graph
+ (read-config-st config_56))))
+ (if or-part_860 or-part_860 '#hash()))
+ v_389
+ (lambda ()
+ (let-values (((in67_1) in_49)
+ ((config68_1) config_56)
+ ((temp69_3) "no preceding `~a~a=` for `~a~a~a`")
+ ((dispatch-c70_0) dispatch-c_2)
+ ((v71_0) v_389)
+ ((dispatch-c72_0) dispatch-c_2)
+ ((temp73_4)
+ (let-values (((accum-str75_0) accum-str_3)
+ ((config76_0) config_56))
+ (accum-string-get!.1
+ 0
+ accum-str75_0
+ config76_0)))
+ ((c74_0) c_180))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in67_1
+ config68_1
+ temp69_3
+ (list
+ dispatch-c70_0
+ v71_0
+ dispatch-c72_0
+ temp73_4
+ c74_0)))))))
+ (begin
+ (accum-string-abandon! accum-str_3 config_56)
+ (wrap ph_3 in_49 config_56 ph_3)))
+ (void)))))
+ (let-values (((in77_0) in_49)
+ ((config78_0) config_56)
+ ((c79_0) c_180)
+ ((temp80_1) "bad syntax `~a`")
+ ((temp81_1) (get-accum_0 c_180)))
+ (reader-error.1
+ unsafe-undefined
+ c79_0
+ #f
+ unsafe-undefined
+ in77_0
+ config78_0
+ temp80_1
+ (list temp81_1))))))))))))))))))))
(define-values
(get-graph-hash)
- (lambda (config_45)
+ (lambda (config_57)
(begin
- (let-values (((st_3) (read-config-st config_45)))
- (let-values (((or-part_519) (read-config-state-graph st_3)))
- (if or-part_519
- or-part_519
- (let-values (((ht_131) (make-hasheqv))) (begin (set-read-config-state-graph! st_3 ht_131) ht_131))))))))
+ (let-values (((st_3) (read-config-st config_57)))
+ (let-values (((or-part_861) (read-config-state-graph st_3)))
+ (if or-part_861
+ or-part_861
+ (let-values (((ht_241) (make-hasheqv))) (begin (set-read-config-state-graph! st_3 ht_241) ht_241))))))))
(define-values
(coerce-key)
- (lambda (key_97 config_8)
+ (lambda (key_111 config_58)
(begin
- (let-values (((for-syntax?_7) (read-config-for-syntax? config_8)))
- ((read-config-coerce-key config_8) for-syntax?_7 key_97)))))
+ (let-values (((for-syntax?_7) (read-config-for-syntax? config_58)))
+ ((read-config-coerce-key config_58) for-syntax?_7 key_111)))))
(define-values
(read-hash)
- (lambda (read-one_4 dispatch-c_1 init-c_14 in_40 config_44)
+ (lambda (read-one_12 dispatch-c_3 init-c_16 in_51 config_59)
(begin
- (let-values (((accum-str_3) (accum-string-init! config_44)))
- (let-values ((() (begin (accum-string-add! accum-str_3 dispatch-c_1) (values))))
- (let-values ((() (begin (accum-string-add! accum-str_3 init-c_14) (values))))
+ (let-values (((accum-str_4) (accum-string-init! config_59)))
+ (let-values ((() (begin (accum-string-add! accum-str_4 dispatch-c_3) (values))))
+ (let-values ((() (begin (accum-string-add! accum-str_4 init-c_16) (values))))
(let-values (((get-next!_0)
(lambda (expect-c_0 expect-alt-c_0)
(begin
'get-next!
- (let-values (((c_51)
- (let-values (((in_41) in_40) ((source_23) (read-config-source config_44)))
- (read-char-or-special in_41 special1.1 source_23))))
+ (let-values (((c_181)
+ (let-values (((in_52) in_51) ((source_24) (read-config-source config_59)))
+ (read-char-or-special in_52 special1.1 source_24))))
(begin
- (if (let-values (((or-part_84) (eqv? c_51 expect-c_0)))
- (if or-part_84 or-part_84 (eqv? c_51 expect-alt-c_0)))
+ (if (let-values (((or-part_862) (eqv? c_181 expect-c_0)))
+ (if or-part_862 or-part_862 (eqv? c_181 expect-alt-c_0)))
(void)
- (let-values ()
- (let-values (((in1_5) in_40)
- ((config2_5) config_44)
- ((c3_5) c_51)
- ((temp4_5) "expected `~a` after `~a`")
- ((expect-c5_0) expect-c_0)
- ((temp6_4)
- (let-values (((accum-str7_0) accum-str_3) ((config8_1) config_44))
- (accum-string-get!.1 0 accum-str7_0 config8_1))))
- (reader-error.1
- unsafe-undefined
- c3_5
- #f
- unsafe-undefined
- in1_5
- config2_5
- temp4_5
- (list expect-c5_0 temp6_4)))))
- (accum-string-add! accum-str_3 c_51)))))))
+ (let-values (((in1_5) in_51)
+ ((config2_5) config_59)
+ ((c3_3) c_181)
+ ((temp4_5) "expected `~a` after `~a`")
+ ((expect-c5_0) expect-c_0)
+ ((temp6_4)
+ (let-values (((accum-str7_0) accum-str_4) ((config8_1) config_59))
+ (accum-string-get!.1 0 accum-str7_0 config8_1))))
+ (reader-error.1
+ unsafe-undefined
+ c3_3
+ #f
+ unsafe-undefined
+ in1_5
+ config2_5
+ temp4_5
+ (list expect-c5_0 temp6_4))))
+ (accum-string-add! accum-str_4 c_181)))))))
(let-values ((() (begin (get-next!_0 '#\a '#\A) (values))))
(let-values ((() (begin (get-next!_0 '#\s '#\S) (values))))
(let-values ((() (begin (get-next!_0 '#\h '#\H) (values))))
- (let-values (((content_22 opener_4 mode_18)
- ((letrec-values (((loop_118)
- (lambda (mode_19)
+ (let-values (((content_22 opener_4 mode_23)
+ ((letrec-values (((loop_137)
+ (lambda (mode_24)
(begin
'loop
- (let-values (((c_65)
- (let-values (((in_12) in_40)
- ((source_24)
- (read-config-source config_44)))
+ (let-values (((c_182)
+ (let-values (((in_53) in_51)
+ ((source_25)
+ (read-config-source config_59)))
(read-char-or-special
- in_12
+ in_53
special1.1
- source_24))))
- (let-values (((ec_9) (effective-char c_65 config_44)))
- (let-values (((tmp_68) ec_9))
- (if (equal? tmp_68 '#\()
- (let-values ()
- (let-values (((open-end-line_1
- open-end-col_1
- open-end-pos_1)
- (port-next-location in_40)))
- (let-values (((read-one-key+value_0)
- (make-read-one-key+value
- read-one_4
- c_65
- '#\)
- open-end-pos_1)))
- (values
- (let-values (((read-one-key+value9_0)
- read-one-key+value_0)
- ((c10_1) c_65)
- ((temp11_6) '#\()
- ((temp12_9) '#\))
- ((in13_0) in_40)
- ((config14_0) config_44)
- ((config15_1) config_44)
- ((temp16_8) #f))
- (read-unwrapped-sequence.1
- temp16_8
- config15_1
- unsafe-undefined
- #f
- unsafe-undefined
- read-one-key+value9_0
- c10_1
- temp11_6
- temp12_9
- in13_0
- config14_0))
- ec_9
- mode_19))))
- (if (equal? tmp_68 '#\[)
- (let-values ()
+ source_25))))
+ (let-values (((ec_9) (effective-char c_182 config_59)))
+ (let-values (((tmp_72) ec_9))
+ (if (equal? tmp_72 '#\()
+ (let-values (((open-end-line_1
+ open-end-col_1
+ open-end-pos_1)
+ (port-next-location in_51)))
+ (let-values (((read-one-key+value_0)
+ (make-read-one-key+value
+ read-one_12
+ c_182
+ '#\)
+ open-end-pos_1)))
+ (values
+ (let-values (((read-one-key+value9_0)
+ read-one-key+value_0)
+ ((c10_1) c_182)
+ ((temp11_5) '#\()
+ ((temp12_9) '#\))
+ ((in13_0) in_51)
+ ((config14_0) config_59)
+ ((config15_1) config_59)
+ ((temp16_8) #f))
+ (read-unwrapped-sequence.1
+ temp16_8
+ config15_1
+ unsafe-undefined
+ #f
+ unsafe-undefined
+ read-one-key+value9_0
+ c10_1
+ temp11_5
+ temp12_9
+ in13_0
+ config14_0))
+ ec_9
+ mode_24)))
+ (if (equal? tmp_72 '#\[)
+ (if (check-parameter
+ 1/read-square-bracket-as-paren
+ config_59)
+ (let-values (((open-end-line_2
+ open-end-col_2
+ open-end-pos_2)
+ (port-next-location in_51)))
+ (let-values (((read-one-key+value_1)
+ (make-read-one-key+value
+ read-one_12
+ c_182
+ '#\]
+ open-end-pos_2)))
+ (values
+ (let-values (((read-one-key+value17_0)
+ read-one-key+value_1)
+ ((c18_1) c_182)
+ ((temp19_8) '#\[)
+ ((temp20_7) '#\])
+ ((in21_2) in_51)
+ ((config22_2) config_59)
+ ((config23_2) config_59)
+ ((temp24_5) #f))
+ (read-unwrapped-sequence.1
+ temp24_5
+ config23_2
+ unsafe-undefined
+ #f
+ unsafe-undefined
+ read-one-key+value17_0
+ c18_1
+ temp19_8
+ temp20_7
+ in21_2
+ config22_2))
+ ec_9
+ mode_24)))
+ (let-values (((in25_1) in_51)
+ ((config26_1) config_59)
+ ((temp27_3) "illegal use of `~a`")
+ ((c28_1) c_182))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in25_1
+ config26_1
+ temp27_3
+ (list c28_1))))
+ (if (equal? tmp_72 '#\{)
(if (check-parameter
- 1/read-square-bracket-as-paren
- config_44)
- (let-values ()
- (let-values (((open-end-line_2
- open-end-col_2
- open-end-pos_2)
- (port-next-location in_40)))
- (let-values (((read-one-key+value_1)
- (make-read-one-key+value
- read-one_4
- c_65
- '#\]
- open-end-pos_2)))
- (values
- (let-values (((read-one-key+value17_0)
- read-one-key+value_1)
- ((c18_1) c_65)
- ((temp19_5) '#\[)
- ((temp20_7) '#\])
- ((in21_2) in_40)
- ((config22_2) config_44)
- ((config23_2) config_44)
- ((temp24_6) #f))
- (read-unwrapped-sequence.1
- temp24_6
- config23_2
- unsafe-undefined
- #f
- unsafe-undefined
- read-one-key+value17_0
- c18_1
- temp19_5
- temp20_7
- in21_2
- config22_2))
- ec_9
- mode_19))))
- (let-values ()
- (let-values (((in25_1) in_40)
- ((config26_1) config_44)
- ((temp27_4) "illegal use of `~a`")
- ((c28_1) c_65))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in25_1
- config26_1
- temp27_4
- (list c28_1))))))
- (if (equal? tmp_68 '#\{)
- (let-values ()
- (if (check-parameter
- 1/read-curly-brace-as-paren
- config_44)
- (let-values ()
- (let-values (((open-end-line_3
- open-end-col_3
- open-end-pos_3)
- (port-next-location in_40)))
- (let-values (((read-one-key+value_2)
- (make-read-one-key+value
- read-one_4
- c_65
- '#\}
- open-end-pos_3)))
- (values
- (let-values (((read-one-key+value29_0)
- read-one-key+value_2)
- ((c30_0) c_65)
- ((temp31_4) '#\{)
- ((temp32_7) '#\})
- ((in33_0) in_40)
- ((config34_0) config_44)
- ((config35_3) config_44)
- ((temp36_6) #f))
- (read-unwrapped-sequence.1
- temp36_6
- config35_3
- unsafe-undefined
- #f
- unsafe-undefined
- read-one-key+value29_0
- c30_0
- temp31_4
- temp32_7
- in33_0
- config34_0))
- ec_9
- mode_19))))
- (let-values ()
- (let-values (((in37_0) in_40)
- ((config38_0) config_44)
- ((temp39_5)
- "illegal use of `~a`")
- ((c40_0) c_65))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in37_0
- config38_0
- temp39_5
- (list c40_0))))))
- (if (if (equal? tmp_68 '#\e)
+ 1/read-curly-brace-as-paren
+ config_59)
+ (let-values (((open-end-line_3
+ open-end-col_3
+ open-end-pos_3)
+ (port-next-location in_51)))
+ (let-values (((read-one-key+value_2)
+ (make-read-one-key+value
+ read-one_12
+ c_182
+ '#\}
+ open-end-pos_3)))
+ (values
+ (let-values (((read-one-key+value29_0)
+ read-one-key+value_2)
+ ((c30_0) c_182)
+ ((temp31_5) '#\{)
+ ((temp32_6) '#\})
+ ((in33_0) in_51)
+ ((config34_0) config_59)
+ ((config35_3) config_59)
+ ((temp36_7) #f))
+ (read-unwrapped-sequence.1
+ temp36_7
+ config35_3
+ unsafe-undefined
+ #f
+ unsafe-undefined
+ read-one-key+value29_0
+ c30_0
+ temp31_5
+ temp32_6
+ in33_0
+ config34_0))
+ ec_9
+ mode_24)))
+ (let-values (((in37_1) in_51)
+ ((config38_1) config_59)
+ ((temp39_5) "illegal use of `~a`")
+ ((c40_1) c_182))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in37_1
+ config38_1
+ temp39_5
+ (list c40_1))))
+ (if (if (equal? tmp_72 '#\e)
#t
- (equal? tmp_68 '#\E))
- (let-values ()
- (begin
- (accum-string-add! accum-str_3 c_65)
- (get-next!_0 '#\q '#\Q)
- (loop_118 'eq)))
- (if (if (equal? tmp_68 '#\v)
+ (equal? tmp_72 '#\E))
+ (begin
+ (accum-string-add! accum-str_4 c_182)
+ (get-next!_0 '#\q '#\Q)
+ (loop_137 'eq))
+ (if (if (equal? tmp_72 '#\v)
#t
- (equal? tmp_68 '#\V))
- (let-values ()
+ (equal? tmp_72 '#\V))
+ (begin
+ (accum-string-add! accum-str_4 c_182)
+ (if (eq? mode_24 'eq)
+ (loop_137 'eqv)
+ (let-values (((in41_0) in_51)
+ ((config42_0) config_59)
+ ((temp43_2) "bad syntax `~a`")
+ ((temp44_2)
+ (let-values (((accum-str45_0)
+ accum-str_4)
+ ((config46_1)
+ config_59))
+ (accum-string-get!.1
+ 0
+ accum-str45_0
+ config46_1))))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in41_0
+ config42_0
+ temp43_2
+ (list temp44_2)))))
+ (if (if (equal? tmp_72 '#\a)
+ #t
+ (equal? tmp_72 '#\A))
(begin
- (accum-string-add! accum-str_3 c_65)
- (if (eq? mode_19 'eq)
- (loop_118 'eqv)
- (let-values (((in41_0) in_40)
- ((config42_0) config_44)
- ((temp43_2)
+ (accum-string-add! accum-str_4 c_182)
+ (get-next!_0 '#\l '#\L)
+ (get-next!_0 '#\w '#\W)
+ (if (eq? mode_24 'equal)
+ (loop_137 'equal-always)
+ (let-values (((in47_0) in_51)
+ ((config48_0) config_59)
+ ((temp49_2)
"bad syntax `~a`")
- ((temp44_2)
- (let-values (((accum-str45_0)
- accum-str_3)
- ((config46_1)
- config_44))
+ ((temp50_4)
+ (let-values (((accum-str51_0)
+ accum-str_4)
+ ((config52_0)
+ config_59))
(accum-string-get!.1
0
- accum-str45_0
- config46_1))))
+ accum-str51_0
+ config52_0))))
(reader-error.1
unsafe-undefined
'#\x
#f
unsafe-undefined
- in41_0
- config42_0
- temp43_2
- (list temp44_2))))))
- (if (if (equal? tmp_68 '#\a)
- #t
- (equal? tmp_68 '#\A))
- (let-values ()
- (begin
- (accum-string-add! accum-str_3 c_65)
- (get-next!_0 '#\l '#\L)
- (get-next!_0 '#\w '#\W)
- (if (eq? mode_19 'equal)
- (loop_118 'equal-always)
- (let-values (((in47_0) in_40)
- ((config48_0) config_44)
- ((temp49_3)
- "bad syntax `~a`")
- ((temp50_3)
- (let-values (((accum-str51_0)
- accum-str_3)
- ((config52_0)
- config_44))
- (accum-string-get!.1
- 0
- accum-str51_0
- config52_0))))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in47_0
- config48_0
- temp49_3
- (list temp50_3))))))
- (let-values ()
- (begin
- (if (char? c_65)
- (let-values ()
- (accum-string-add! accum-str_3 c_65))
- (void))
- (let-values (((in53_1) in_40)
- ((config54_1) config_44)
- ((c55_1) c_65)
- ((temp56_2)
- "bad syntax `~a`")
- ((temp57_1)
- (let-values (((accum-str58_0)
- accum-str_3)
- ((config59_1)
- config_44))
- (accum-string-get!.1
- 0
- accum-str58_0
- config59_1))))
- (reader-error.1
- unsafe-undefined
- c55_1
- #f
- unsafe-undefined
- in53_1
- config54_1
- temp56_2
- (list temp57_1))))))))))))))))))
- loop_118)
+ in47_0
+ config48_0
+ temp49_2
+ (list temp50_4)))))
+ (begin
+ (if (char? c_182)
+ (accum-string-add! accum-str_4 c_182)
+ (void))
+ (let-values (((in53_1) in_51)
+ ((config54_1) config_59)
+ ((c55_1) c_182)
+ ((temp56_1) "bad syntax `~a`")
+ ((temp57_3)
+ (let-values (((accum-str58_0)
+ accum-str_4)
+ ((config59_1)
+ config_59))
+ (accum-string-get!.1
+ 0
+ accum-str58_0
+ config59_1))))
+ (reader-error.1
+ unsafe-undefined
+ c55_1
+ #f
+ unsafe-undefined
+ in53_1
+ config54_1
+ temp56_1
+ (list temp57_3)))))))))))))))))
+ loop_137)
'equal)))
- (let-values (((graph?_0) (if (read-config-state-graph (read-config-st config_44)) #t #f)))
+ (let-values (((graph?_0) (if (read-config-state-graph (read-config-st config_59)) #t #f)))
(wrap
- (let-values (((tmp_69) mode_18))
- (if (equal? tmp_69 'equal)
- (let-values ()
- (if graph?_0 (make-hash-placeholder content_22) (make-immutable-hash content_22)))
- (if (equal? tmp_69 'eq)
- (let-values ()
- (if graph?_0 (make-hasheq-placeholder content_22) (make-immutable-hasheq content_22)))
- (if (equal? tmp_69 'eqv)
- (let-values ()
+ (let-values (((tmp_73) mode_23))
+ (if (equal? tmp_73 'equal)
+ (if graph?_0 (make-hash-placeholder content_22) (make-immutable-hash content_22))
+ (if (equal? tmp_73 'eq)
+ (if graph?_0 (make-hasheq-placeholder content_22) (make-immutable-hasheq content_22))
+ (if (equal? tmp_73 'eqv)
+ (if graph?_0 (make-hasheqv-placeholder content_22) (make-immutable-hasheqv content_22))
+ (if (equal? tmp_73 'equal-always)
(if graph?_0
- (make-hasheqv-placeholder content_22)
- (make-immutable-hasheqv content_22)))
- (if (equal? tmp_69 'equal-always)
- (let-values ()
- (if graph?_0
- (make-hashalw-placeholder content_22)
- (make-immutable-hashalw content_22)))
- (let-values () (void)))))))
- in_40
- config_44
+ (make-hashalw-placeholder content_22)
+ (make-immutable-hashalw content_22))
+ (void))))))
+ in_51
+ config_59
opener_4)))))))))))))
(define-values
(make-read-one-key+value)
- (lambda (read-one_10 overall-opener-c_0 overall-closer-ec_0 prefix-end-pos_0)
- (begin
- (lambda (init-c_15 in_42 config/maybe-keep-comment_0)
- (let-values (((config_46) (discard-comment config/maybe-keep-comment_0)))
- (let-values (((c_126) (read-char/skip-whitespace-and-comments init-c_15 read-one_10 in_42 config_46)))
- (let-values (((open-line_0 open-col_0 open-pos_0) (port-next-location* in_42 c_126)))
- (let-values (((ec_10) (effective-char c_126 config_46)))
- (let-values (((elem-config_1) (next-readtable config_46)))
+ (lambda (read-one_13 overall-opener-c_0 overall-closer-ec_0 prefix-end-pos_0)
+ (begin
+ (lambda (init-c_17 in_54 config/maybe-keep-comment_0)
+ (let-values (((config_60) (discard-comment config/maybe-keep-comment_0)))
+ (let-values (((c_183) (read-char/skip-whitespace-and-comments init-c_17 read-one_13 in_54 config_60)))
+ (let-values (((open-line_0 open-col_0 open-pos_0) (port-next-location* in_54 c_183)))
+ (let-values (((ec_10) (effective-char c_183 config_60)))
+ (let-values (((elem-config_1) (next-readtable config_60)))
(let-values (((closer_4)
- (let-values (((tmp_70) ec_10))
- (if (equal? tmp_70 '#\()
- (let-values () '#\))
- (if (equal? tmp_70 '#\[)
- (let-values ()
- (if (check-parameter 1/read-square-bracket-as-paren config_46) '#\] #f))
- (if (equal? tmp_70 '#\{)
- (let-values ()
- (if (check-parameter 1/read-curly-brace-as-paren config_46) '#\} #f))
- (let-values () #f)))))))
+ (let-values (((tmp_74) ec_10))
+ (if (equal? tmp_74 '#\()
+ '#\)
+ (if (equal? tmp_74 '#\[)
+ (if (check-parameter 1/read-square-bracket-as-paren config_60) '#\] #f)
+ (if (equal? tmp_74 '#\{)
+ (if (check-parameter 1/read-curly-brace-as-paren config_60) '#\} #f)
+ #f))))))
(if (not closer_4)
- (let-values ()
- (if (eof-object? c_126)
- (let-values ()
- (let-values (((in60_1) in_42)
- ((config61_1) config_46)
- ((c62_0) c_126)
- ((prefix-end-pos63_0) prefix-end-pos_0)
- ((temp64_2) "expected ~a to close `~a`")
- ((temp65_2) (closer-name overall-closer-ec_0 config_46))
- ((overall-opener-c66_0) overall-opener-c_0))
- (reader-error.1
- unsafe-undefined
- c62_0
- prefix-end-pos63_0
- unsafe-undefined
- in60_1
- config61_1
- temp64_2
- (list temp65_2 overall-opener-c66_0))))
- (if (char-closer? ec_10 config_46)
- (let-values ()
- (let-values (((in67_2) in_42)
- ((temp68_4) (reading-at config_46 open-line_0 open-col_0 open-pos_0))
- ((temp69_4) "~a")
- ((temp70_6) (indentation-unexpected-closer-message ec_10 c_126 config_46)))
+ (if (eof-object? c_183)
+ (let-values (((in60_1) in_54)
+ ((config61_1) config_60)
+ ((c62_0) c_183)
+ ((prefix-end-pos63_0) prefix-end-pos_0)
+ ((temp64_4) "expected ~a to close `~a`")
+ ((temp65_2) (closer-name overall-closer-ec_0 config_60))
+ ((overall-opener-c66_0) overall-opener-c_0))
+ (reader-error.1
+ unsafe-undefined
+ c62_0
+ prefix-end-pos63_0
+ unsafe-undefined
+ in60_1
+ config61_1
+ temp64_4
+ (list temp65_2 overall-opener-c66_0)))
+ (if (char-closer? ec_10 config_60)
+ (let-values (((in67_2) in_54)
+ ((temp68_6) (reading-at config_60 open-line_0 open-col_0 open-pos_0))
+ ((temp69_4) "~a")
+ ((temp70_4) (indentation-unexpected-closer-message ec_10 c_183 config_60)))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in67_2
+ temp68_6
+ temp69_4
+ (list temp70_4)))
+ (let-values (((cond-val_26)
+ (special-comment-via-readtable? c_183 read-one_13 in_54 elem-config_1)))
+ (if cond-val_26
+ ((lambda (v_390)
+ (if (read-config-keep-comment? config/maybe-keep-comment_0)
+ v_390
+ ((make-read-one-key+value
+ read-one_13
+ overall-opener-c_0
+ overall-closer-ec_0
+ prefix-end-pos_0)
+ #f
+ in_54
+ config_60)))
+ cond-val_26)
+ (let-values (((in71_0) in_54)
+ ((temp72_2) (reading-at config_60 open-line_0 open-col_0 open-pos_0))
+ ((temp73_5) "expected ~a to start a hash pair")
+ ((temp74_2) (all-openers-str config_60)))
(reader-error.1
unsafe-undefined
'#\x
#f
unsafe-undefined
- in67_2
- temp68_4
- temp69_4
- (list temp70_6))))
- (let-values (((c1_35)
- (special-comment-via-readtable? c_126 read-one_10 in_42 elem-config_1)))
- (if c1_35
- ((lambda (v_260)
- (if (read-config-keep-comment? config/maybe-keep-comment_0)
- v_260
- ((make-read-one-key+value
- read-one_10
- overall-opener-c_0
- overall-closer-ec_0
- prefix-end-pos_0)
- #f
- in_42
- config_46)))
- c1_35)
- (let-values ()
- (let-values (((in71_0) in_42)
- ((temp72_2) (reading-at config_46 open-line_0 open-col_0 open-pos_0))
- ((temp73_5) "expected ~a to start a hash pair")
- ((temp74_2) (all-openers-str config_46)))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in71_0
- temp72_2
- temp73_5
- (list temp74_2)))))))))
- (let-values ()
- (let-values (((k_56) (read-one_10 #f in_42 (disable-wrapping elem-config_1))))
- ((letrec-values (((dot-loop_0)
- (lambda ()
- (begin
- 'dot-loop
- (let-values (((dot-c_0)
- (read-char/skip-whitespace-and-comments
- #f
- read-one_10
- in_42
- config_46)))
- (let-values (((dot-line_1 dot-col_1 dot-pos_1)
- (port-next-location* in_42 dot-c_0)))
- (let-values (((dot-ec_0) (effective-char dot-c_0 config_46)))
- (if (if (eqv? dot-ec_0 '#\.)
- (char-delimiter?
- (let-values (((in_43) in_42)
- ((skip-count_8) 0)
- ((source_25) (read-config-source config_46)))
- (let-values (((c_127)
- (peek-char-or-special
- in_43
- skip-count_8
- 'special
- source_25)))
- (if (eq? c_127 'special) (special1.1 'special) c_127)))
- config_46)
- #f)
- (let-values ()
- (let-values (((v_204) (read-one_10 #f in_42 elem-config_1)))
- ((letrec-values (((closer-loop_0)
- (lambda ()
- (begin
- 'closer-loop
- (let-values (((closer-c_0)
- (read-char/skip-whitespace-and-comments
- #f
- read-one_10
- in_42
- config_46)))
- (let-values (((closer-line_0
- closer-col_0
- closer-pos_0)
- (port-next-location*
- in_42
- closer-c_0)))
- (let-values (((closer-ec_0)
- (effective-char
- closer-c_0
- config_46)))
- (if (eqv? closer-ec_0 closer_4)
- (let-values ()
- (cons
- (coerce-key
- k_56
- elem-config_1)
- v_204))
- (if (special-comment-via-readtable?
- closer-c_0
- read-one_10
- in_42
- config_46)
- (let-values ()
- (closer-loop_0))
- (let-values ()
- (let-values (((in75_0)
- in_42)
- ((temp76_2)
- (reading-at
- config_46
- closer-line_0
- closer-col_0
- closer-pos_0))
- ((closer-c77_0)
- closer-c_0)
- ((temp78_2)
- "expected ~a after value within a hash")
- ((temp79_2)
- (closer-name
- closer_4
- config_46)))
- (reader-error.1
- unsafe-undefined
- closer-c77_0
- #f
- unsafe-undefined
- in75_0
- temp76_2
- temp78_2
- (list
- temp79_2)))))))))))))
- closer-loop_0))))
- (if (special-comment-via-readtable?
- dot-c_0
- read-one_10
- in_42
- config_46)
- (let-values () (dot-loop_0))
- (let-values ()
- (let-values (((in80_0) in_42)
- ((temp81_3)
- (reading-at
- config_46
- dot-line_1
- dot-col_1
- dot-pos_1))
- ((dot-c82_0) dot-c_0)
- ((temp83_3) "expected ~a and value for hash")
- ((temp84_0) (dot-name config_46)))
- (reader-error.1
- unsafe-undefined
- dot-c82_0
- #f
- unsafe-undefined
- in80_0
- temp81_3
- temp83_3
- (list temp84_0)))))))))))))
- dot-loop_0)))))))))))))))
+ in71_0
+ temp72_2
+ temp73_5
+ (list temp74_2)))))))
+ (let-values (((k_66) (read-one_13 #f in_54 (disable-wrapping elem-config_1))))
+ ((letrec-values (((dot-loop_0)
+ (lambda ()
+ (begin
+ 'dot-loop
+ (let-values (((dot-c_0)
+ (read-char/skip-whitespace-and-comments
+ #f
+ read-one_13
+ in_54
+ config_60)))
+ (let-values (((dot-line_1 dot-col_1 dot-pos_1)
+ (port-next-location* in_54 dot-c_0)))
+ (let-values (((dot-ec_0) (effective-char dot-c_0 config_60)))
+ (if (if (eqv? dot-ec_0 '#\.)
+ (char-delimiter?
+ (let-values (((in_55) in_54)
+ ((skip-count_9) 0)
+ ((source_26) (read-config-source config_60)))
+ (let-values (((c_184)
+ (peek-char-or-special
+ in_55
+ skip-count_9
+ 'special
+ source_26)))
+ (if (eq? c_184 'special) (special1.1 'special) c_184)))
+ config_60)
+ #f)
+ (let-values (((v_391) (read-one_13 #f in_54 elem-config_1)))
+ ((letrec-values (((closer-loop_0)
+ (lambda ()
+ (begin
+ 'closer-loop
+ (let-values (((closer-c_0)
+ (read-char/skip-whitespace-and-comments
+ #f
+ read-one_13
+ in_54
+ config_60)))
+ (let-values (((closer-line_0
+ closer-col_0
+ closer-pos_0)
+ (port-next-location*
+ in_54
+ closer-c_0)))
+ (let-values (((closer-ec_0)
+ (effective-char
+ closer-c_0
+ config_60)))
+ (if (eqv? closer-ec_0 closer_4)
+ (cons
+ (coerce-key k_66 elem-config_1)
+ v_391)
+ (if (special-comment-via-readtable?
+ closer-c_0
+ read-one_13
+ in_54
+ config_60)
+ (closer-loop_0)
+ (let-values (((in75_0) in_54)
+ ((temp76_4)
+ (reading-at
+ config_60
+ closer-line_0
+ closer-col_0
+ closer-pos_0))
+ ((closer-c77_0)
+ closer-c_0)
+ ((temp78_2)
+ "expected ~a after value within a hash")
+ ((temp79_1)
+ (closer-name
+ closer_4
+ config_60)))
+ (reader-error.1
+ unsafe-undefined
+ closer-c77_0
+ #f
+ unsafe-undefined
+ in75_0
+ temp76_4
+ temp78_2
+ (list temp79_1))))))))))))
+ closer-loop_0)))
+ (if (special-comment-via-readtable?
+ dot-c_0
+ read-one_13
+ in_54
+ config_60)
+ (dot-loop_0)
+ (let-values (((in80_0) in_54)
+ ((temp81_2)
+ (reading-at
+ config_60
+ dot-line_1
+ dot-col_1
+ dot-pos_1))
+ ((dot-c82_0) dot-c_0)
+ ((temp83_3) "expected ~a and value for hash")
+ ((temp84_1) (dot-name config_60)))
+ (reader-error.1
+ unsafe-undefined
+ dot-c82_0
+ #f
+ unsafe-undefined
+ in80_0
+ temp81_2
+ temp83_3
+ (list temp84_1))))))))))))
+ dot-loop_0))))))))))))))
(define-values
(read-string.1)
- (lambda (mode1_2 in3_0 config4_0)
+ (lambda (mode1_3 in3_0 config4_0)
(begin
'read-string
- (let-values (((in_40) in3_0))
- (let-values (((config_44) config4_0))
- (let-values (((mode_0) mode1_2))
- (let-values ()
- (let-values (((source_26) (read-config-source config_44)))
- (let-values (((open-end-line_4 open-end-col_4 open-end-pos_4) (port-next-location in_40)))
- (let-values (((accum-str_4) (accum-string-init! config_44)))
- (let-values (((bad-end_0)
- (lambda (c_51)
- (begin
- 'bad-end
- (if (eof-object? c_51)
- (let-values ()
- (let-values (((in6_2) in_40)
- ((config7_0) config_44)
- ((c8_2) c_51)
- ((open-end-pos9_0) open-end-pos_4)
- ((temp10_6) "expected a closing `\"`"))
- (reader-error.1
- unsafe-undefined
- c8_2
- open-end-pos9_0
- unsafe-undefined
- in6_2
- config7_0
- temp10_6
- (list))))
- (let-values ()
- (let-values (((in11_0) in_40)
- ((config12_0) config_44)
- ((c13_0) c_51)
- ((temp14_7) "found non-character while reading a ~a")
- ((mode15_0) mode_0))
- (reader-error.1
- unsafe-undefined
- c13_0
- #f
- unsafe-undefined
- in11_0
- config12_0
- temp14_7
- (list mode15_0)))))))))
- (let-values ((()
- (begin
- ((letrec-values (((loop_119)
- (lambda ()
- (begin
- 'loop
- (let-values (((c_18)
- (let-values (((in_44) in_40)
- ((source_27) source_26))
- (read-char-or-special
- in_44
- special1.1
- source_27))))
- (if (not (char? c_18))
- (let-values () (bad-end_0 c_18))
- (if (char=? '#\\ c_18)
- (let-values ()
- (let-values (((escaping-c_0) c_18))
- (let-values (((escaped-c_0)
- (let-values (((in_25) in_40)
- ((source_28)
- source_26))
- (read-char-or-special
- in_25
- special1.1
- source_28))))
- (let-values ((()
+ (let-values (((in_56) in3_0))
+ (let-values (((config_61) config4_0))
+ (let-values (((mode_25) mode1_3))
+ (let-values (((source_27) (read-config-source config_61)))
+ (let-values (((open-end-line_4 open-end-col_4 open-end-pos_4) (port-next-location in_56)))
+ (let-values (((accum-str_5) (accum-string-init! config_61)))
+ (let-values (((bad-end_0)
+ (lambda (c_185)
+ (begin
+ 'bad-end
+ (if (eof-object? c_185)
+ (let-values (((in6_2) in_56)
+ ((config7_0) config_61)
+ ((c8_2) c_185)
+ ((open-end-pos9_0) open-end-pos_4)
+ ((temp10_6) "expected a closing `\"`"))
+ (reader-error.1
+ unsafe-undefined
+ c8_2
+ open-end-pos9_0
+ unsafe-undefined
+ in6_2
+ config7_0
+ temp10_6
+ (list)))
+ (let-values (((in11_0) in_56)
+ ((config12_0) config_61)
+ ((c13_0) c_185)
+ ((temp14_7) "found non-character while reading a ~a")
+ ((mode15_0) mode_25))
+ (reader-error.1
+ unsafe-undefined
+ c13_0
+ #f
+ unsafe-undefined
+ in11_0
+ config12_0
+ temp14_7
+ (list mode15_0))))))))
+ (let-values ((()
+ (begin
+ ((letrec-values (((loop_138)
+ (lambda ()
+ (begin
+ 'loop
+ (let-values (((c_186)
+ (let-values (((in_57) in_56)
+ ((source_28) source_27))
+ (read-char-or-special
+ in_57
+ special1.1
+ source_28))))
+ (if (not (char? c_186))
+ (bad-end_0 c_186)
+ (if (char=? '#\\ c_186)
+ (let-values (((escaping-c_0) c_186))
+ (let-values (((escaped-c_0)
+ (let-values (((in_58) in_56)
+ ((source_29) source_27))
+ (read-char-or-special
+ in_58
+ special1.1
+ source_29))))
+ (let-values ((()
+ (begin
+ (if (not (char? escaped-c_0))
+ (bad-end_0 escaped-c_0)
+ (void))
+ (values))))
+ (let-values (((unknown-error_0)
+ (lambda ()
(begin
- (if (not (char? escaped-c_0))
- (let-values ()
- (bad-end_0 escaped-c_0))
- (void))
- (values))))
- (let-values (((unknown-error_0)
- (lambda ()
+ 'unknown-error
+ (let-values (((in16_3) in_56)
+ ((config17_3)
+ config_61)
+ ((temp18_9)
+ "unknown escape sequence `~a~a` in ~a")
+ ((escaping-c19_0)
+ escaping-c_0)
+ ((escaped-c20_0)
+ escaped-c_0)
+ ((mode21_0)
+ mode_25))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in16_3
+ config17_3
+ temp18_9
+ (list
+ escaping-c19_0
+ escaped-c20_0
+ mode21_0)))))))
+ (begin
+ (let-values (((tmp_75) escaped-c_0))
+ (let-values (((index_5)
+ (if (char? tmp_75)
+ (let-values (((codepoint_1)
+ (char->integer
+ tmp_75)))
+ (if (if (unsafe-fx>=
+ codepoint_1
+ 10)
+ (unsafe-fx<
+ codepoint_1
+ 121)
+ #f)
+ (let-values (((tbl_2)
+ '#(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_2
+ (unsafe-fx-
+ codepoint_1
+ 10)))
+ 0))
+ 0)))
+ (if (unsafe-fx< index_5 7)
+ (if (unsafe-fx< index_5 3)
+ (if (unsafe-fx< index_5 1)
+ (unknown-error_0)
+ (if (unsafe-fx< index_5 2)
+ (accum-string-add!
+ accum-str_5
+ escaped-c_0)
+ (accum-string-add!
+ accum-str_5
+ '#\u0007)))
+ (if (unsafe-fx< index_5 4)
+ (accum-string-add!
+ accum-str_5
+ '#\backspace)
+ (if (unsafe-fx< index_5 5)
+ (accum-string-add!
+ accum-str_5
+ '#\tab)
+ (if (unsafe-fx< index_5 6)
+ (accum-string-add!
+ accum-str_5
+ '#\newline)
+ (accum-string-add!
+ accum-str_5
+ '#\vtab)))))
+ (if (unsafe-fx< index_5 11)
+ (if (unsafe-fx< index_5 8)
+ (accum-string-add!
+ accum-str_5
+ '#\page)
+ (if (unsafe-fx< index_5 9)
+ (accum-string-add!
+ accum-str_5
+ '#\return)
+ (if (unsafe-fx< index_5 10)
+ (accum-string-add!
+ accum-str_5
+ '#\u001B)
+ (void))))
+ (if (unsafe-fx< index_5 13)
+ (if (unsafe-fx< index_5 12)
+ (let-values (((maybe-newline-c_0)
+ (let-values (((in_59)
+ in_56)
+ ((skip-count_10)
+ 0)
+ ((source_30)
+ source_27))
+ (let-values (((c_187)
+ (peek-char-or-special
+ in_59
+ skip-count_10
+ 'special
+ source_30)))
+ (if (eq?
+ c_187
+ 'special)
+ (special1.1
+ 'special)
+ c_187)))))
+ (begin
+ (if (eqv?
+ maybe-newline-c_0
+ '#\newline)
+ (consume-char
+ in_56
+ maybe-newline-c_0)
+ (void))
+ (void)))
+ (let-values (((pos_180)
+ (accum-string-count
+ accum-str_5)))
+ (let-values ((()
+ (begin
+ (accum-string-add!
+ accum-str_5
+ escaped-c_0)
+ (values))))
+ (let-values (((init-v_3)
+ (digit->number
+ escaped-c_0)))
+ (let-values (((v_392)
+ (let-values (((in22_2)
+ in_56)
+ ((config23_3)
+ config_61)
+ ((accum-str24_0)
+ accum-str_5)
+ ((temp25_4)
+ 8)
+ ((temp26_4)
+ 2)
+ ((init-v27_0)
+ init-v_3)
+ ((init-v28_0)
+ init-v_3))
+ (read-digits.1
+ temp25_4
+ init-v27_0
+ temp26_4
+ init-v28_0
+ in22_2
+ config23_3
+ accum-str24_0))))
+ (begin
+ (if (<= v_392 255)
+ (void)
+ (let-values (((in29_1)
+ in_56)
+ ((config30_1)
+ config_61)
+ ((temp31_6)
+ "escape sequence `~a~a` is out of range in ~a")
+ ((escaping-c32_0)
+ escaping-c_0)
+ ((temp33_7)
+ (let-values (((accum-str35_0)
+ accum-str_5)
+ ((config36_0)
+ config_61)
+ ((pos37_0)
+ pos_180))
+ (accum-string-get!.1
+ pos37_0
+ accum-str35_0
+ config36_0)))
+ ((mode34_0)
+ mode_25))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in29_1
+ config30_1
+ temp31_6
+ (list
+ escaping-c32_0
+ temp33_7
+ mode34_0))))
+ (set-accum-string-count!
+ accum-str_5
+ pos_180)
+ (accum-string-add!
+ accum-str_5
+ (integer->char
+ v_392))))))))
+ (if (unsafe-fx< index_5 14)
+ (let-values (((pos_181)
+ (accum-string-count
+ accum-str_5)))
+ (let-values (((v_393)
+ (let-values (((in38_0)
+ in_56)
+ ((config39_0)
+ config_61)
+ ((accum-str40_0)
+ accum-str_5)
+ ((temp41_5)
+ 16)
+ ((temp42_2)
+ 2))
+ (read-digits.1
+ temp41_5
+ 0
+ temp42_2
+ #f
+ in38_0
+ config39_0
+ accum-str40_0))))
(begin
- 'unknown-error
- (let-values (((in16_3)
- in_40)
- ((config17_3)
- config_44)
- ((temp18_8)
- "unknown escape sequence `~a~a` in ~a")
- ((escaping-c19_0)
- escaping-c_0)
- ((escaped-c20_0)
- escaped-c_0)
- ((mode21_0)
- mode_0))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in16_3
- config17_3
- temp18_8
- (list
- escaping-c19_0
- escaped-c20_0
- mode21_0)))))))
- (begin
- (let-values (((tmp_71) escaped-c_0))
- (let-values (((index_5)
- (if (char? tmp_71)
- (let-values (((codepoint_1)
- (char->integer
- tmp_71)))
- (if (if (unsafe-fx>=
- codepoint_1
- 10)
- (unsafe-fx<
- codepoint_1
- 121)
- #f)
- (let-values (((tbl_2)
- '#(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_2
- (unsafe-fx-
- codepoint_1
- 10)))
- 0))
- 0)))
- (if (unsafe-fx< index_5 7)
- (if (unsafe-fx< index_5 3)
- (if (unsafe-fx< index_5 1)
- (let-values ()
- (unknown-error_0))
- (if (unsafe-fx< index_5 2)
- (let-values ()
- (accum-string-add!
- accum-str_4
- escaped-c_0))
- (let-values ()
- (accum-string-add!
- accum-str_4
- '#\u0007))))
- (if (unsafe-fx< index_5 4)
- (let-values ()
- (accum-string-add!
- accum-str_4
- '#\backspace))
- (if (unsafe-fx< index_5 5)
- (let-values ()
- (accum-string-add!
- accum-str_4
- '#\tab))
- (if (unsafe-fx< index_5 6)
- (let-values ()
- (accum-string-add!
- accum-str_4
- '#\newline))
- (let-values ()
- (accum-string-add!
- accum-str_4
- '#\vtab))))))
- (if (unsafe-fx< index_5 11)
- (if (unsafe-fx< index_5 8)
- (let-values ()
- (accum-string-add!
- accum-str_4
- '#\page))
- (if (unsafe-fx< index_5 9)
- (let-values ()
+ (if (integer? v_393)
+ (void)
+ (no-hex-digits
+ in_56
+ config_61
+ v_393
+ escaping-c_0
+ escaped-c_0))
+ (set-accum-string-count!
+ accum-str_5
+ pos_181)
(accum-string-add!
- accum-str_4
- '#\return))
- (if (unsafe-fx< index_5 10)
- (let-values ()
- (accum-string-add!
- accum-str_4
- '#\u001B))
- (let-values () (void)))))
- (if (unsafe-fx< index_5 13)
- (if (unsafe-fx< index_5 12)
- (let-values ()
- (let-values (((maybe-newline-c_0)
- (let-values (((in_0)
- in_40)
- ((skip-count_9)
- 0)
- ((source_18)
- source_26))
- (let-values (((c_128)
- (peek-char-or-special
- in_0
- skip-count_9
- 'special
- source_18)))
- (if (eq?
- c_128
- 'special)
- (special1.1
- 'special)
- c_128)))))
- (begin
- (if (eqv?
- maybe-newline-c_0
- '#\newline)
- (let-values ()
- (consume-char
- in_40
- maybe-newline-c_0))
- (void))
- (void))))
- (let-values ()
- (let-values (((pos_119)
- (accum-string-count
- accum-str_4)))
- (let-values ((()
- (begin
- (accum-string-add!
- accum-str_4
- escaped-c_0)
- (values))))
- (let-values (((init-v_3)
- (digit->number
- escaped-c_0)))
- (let-values (((v_168)
- (let-values (((in22_2)
- in_40)
- ((config23_3)
- config_44)
- ((accum-str24_0)
- accum-str_4)
- ((temp25_4)
- 8)
- ((temp26_4)
- 2)
- ((init-v27_0)
- init-v_3)
- ((init-v28_0)
- init-v_3))
- (read-digits.1
- temp25_4
- init-v27_0
- temp26_4
- init-v28_0
- in22_2
- config23_3
- accum-str24_0))))
- (begin
- (if (<= v_168 255)
- (void)
- (let-values ()
- (let-values (((in29_1)
- in_40)
- ((config30_1)
- config_44)
- ((temp31_5)
- "escape sequence `~a~a` is out of range in ~a")
- ((escaping-c32_0)
- escaping-c_0)
- ((temp33_7)
- (let-values (((accum-str35_0)
- accum-str_4)
- ((config36_0)
- config_44)
- ((pos37_0)
- pos_119))
- (accum-string-get!.1
- pos37_0
- accum-str35_0
- config36_0)))
- ((mode34_0)
- mode_0))
- (reader-error.1
- unsafe-undefined
- '#\x
+ accum-str_5
+ (integer->char v_393)))))
+ (if (unsafe-fx< index_5 15)
+ (let-values ((()
+ (begin
+ (if (eq?
+ mode_25
+ 'string)
+ (void)
+ (unknown-error_0))
+ (values))))
+ (let-values (((pos_182)
+ (accum-string-count
+ accum-str_5)))
+ (let-values (((v_394)
+ (let-values (((in43_1)
+ in_56)
+ ((config44_0)
+ config_61)
+ ((accum-str45_1)
+ accum-str_5)
+ ((temp46_5)
+ 16)
+ ((temp47_3)
+ 4))
+ (read-digits.1
+ temp46_5
+ 0
+ temp47_3
#f
- unsafe-undefined
- in29_1
- config30_1
- temp31_5
- (list
- escaping-c32_0
- temp33_7
- mode34_0)))))
- (set-accum-string-count!
- accum-str_4
- pos_119)
- (accum-string-add!
- accum-str_4
- (integer->char
- v_168)))))))))
- (if (unsafe-fx< index_5 14)
- (let-values ()
- (let-values (((pos_15)
- (accum-string-count
- accum-str_4)))
- (let-values (((v_93)
- (let-values (((in38_0)
- in_40)
- ((config39_0)
- config_44)
- ((accum-str40_0)
- accum-str_4)
- ((temp41_6)
- 16)
- ((temp42_2)
- 2))
- (read-digits.1
- temp41_6
- 0
- temp42_2
- #f
- in38_0
- config39_0
- accum-str40_0))))
- (begin
- (if (integer? v_93)
- (void)
- (let-values ()
- (no-hex-digits
- in_40
- config_44
- v_93
- escaping-c_0
- escaped-c_0)))
- (set-accum-string-count!
- accum-str_4
- pos_15)
- (accum-string-add!
- accum-str_4
- (integer->char
- v_93))))))
- (if (unsafe-fx< index_5 15)
- (let-values ()
- (let-values ((()
- (begin
- (if (eq?
- mode_0
- 'string)
- (void)
- (let-values ()
- (unknown-error_0)))
- (values))))
- (let-values (((pos_111)
- (accum-string-count
- accum-str_4)))
- (let-values (((v_100)
- (let-values (((in43_1)
- in_40)
- ((config44_0)
- config_44)
- ((accum-str45_1)
- accum-str_4)
- ((temp46_3)
- 16)
- ((temp47_1)
- 4))
- (read-digits.1
- temp46_3
- 0
- temp47_1
- #f
- in43_1
- config44_0
- accum-str45_1))))
- (begin
- (if (integer?
- v_100)
- (void)
- (let-values ()
- (no-hex-digits
- in_40
- config_44
- v_100
- escaping-c_0
- escaped-c_0)))
- (if (let-values (((or-part_315)
- (<
- v_100
- 55296)))
- (if or-part_315
- or-part_315
- (>
- v_100
- 57343)))
- (let-values ()
- (begin
- (set-accum-string-count!
- accum-str_4
- pos_111)
- (accum-string-add!
- accum-str_4
- (integer->char
- v_100))))
- (let-values ()
- (let-values (((next!_0)
- (lambda ()
- (begin
- 'next!
- (let-values (((next-c_1)
- (let-values (((in_45)
- in_40)
- ((source_29)
- source_26))
- (read-char-or-special
- in_45
- special1.1
- source_29))))
- (begin
- (if (char?
- next-c_1)
- (let-values ()
- (accum-string-add!
- accum-str_4
- next-c_1))
- (void))
- next-c_1))))))
- (let-values (((v2_2)
- (let-values (((next-c_2)
- (next!_0)))
- (if (char=?
- next-c_2
- '#\\)
- (let-values ()
- (let-values (((next-c_3)
- (next!_0)))
- (if (char=?
- next-c_3
- '#\u)
- (let-values ()
- (let-values (((v2_3)
- (let-values (((in48_0)
- in_40)
- ((config49_1)
- config_44)
- ((accum-str50_0)
- accum-str_4)
- ((temp51_5)
- 16)
- ((temp52_5)
- 4))
- (read-digits.1
- temp51_5
- 0
- temp52_5
- #f
- in48_0
- config49_1
- accum-str50_0))))
- (if (integer?
- v2_3)
- (let-values ()
- (if (>=
- v2_3
- 56320)
- (if (<=
- v2_3
- 57343)
- v2_3
- #f)
- #f))
- (let-values ()
- v2_3))))
- (let-values ()
- next-c_3))))
- (let-values ()
- next-c_2)))))
- (if (integer?
- v2_2)
- (let-values ()
- (let-values (((combined-v_0)
- (+
- (arithmetic-shift
- (-
- v_100
- 55296)
- 10)
- (-
- v2_2
- 56320)
- 65536)))
- (if (>
- combined-v_0
- 1114111)
- (let-values ()
- (let-values (((in53_2)
- in_40)
- ((config54_2)
- config_44)
- ((temp55_0)
- "escape sequence `~au~a` is out of range in string")
- ((escaping-c56_0)
- escaping-c_0)
- ((temp57_2)
- (let-values (((accum-str58_1)
- accum-str_4)
- ((config59_2)
- config_44)
- ((pos60_0)
- pos_111))
- (accum-string-get!.1
- pos60_0
- accum-str58_1
- config59_2))))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in53_2
- config54_2
- temp55_0
- (list
- escaping-c56_0
- temp57_2))))
- (let-values ()
- (begin
- (set-accum-string-count!
- accum-str_4
- pos_111)
+ in43_1
+ config44_0
+ accum-str45_1))))
+ (begin
+ (if (integer? v_394)
+ (void)
+ (no-hex-digits
+ in_56
+ config_61
+ v_394
+ escaping-c_0
+ escaped-c_0))
+ (if (let-values (((or-part_863)
+ (<
+ v_394
+ 55296)))
+ (if or-part_863
+ or-part_863
+ (>
+ v_394
+ 57343)))
+ (begin
+ (set-accum-string-count!
+ accum-str_5
+ pos_182)
+ (accum-string-add!
+ accum-str_5
+ (integer->char
+ v_394)))
+ (let-values (((next!_0)
+ (lambda ()
+ (begin
+ 'next!
+ (let-values (((next-c_1)
+ (let-values (((in_60)
+ in_56)
+ ((source_31)
+ source_27))
+ (read-char-or-special
+ in_60
+ special1.1
+ source_31))))
+ (begin
+ (if (char?
+ next-c_1)
(accum-string-add!
- accum-str_4
- (integer->char
- combined-v_0)))))))
- (let-values ()
- (let-values (((in61_0)
- in_40)
- ((config62_0)
- config_44)
- ((v263_0)
- v2_2)
- ((temp64_3)
- "bad or incomplete surrogate-style encoding at `~au~a`")
- ((escaping-c65_0)
- escaping-c_0)
- ((temp66_4)
- (let-values (((accum-str67_0)
- accum-str_4)
- ((config68_2)
- config_44)
- ((pos69_0)
- pos_111))
- (accum-string-get!.1
- pos69_0
- accum-str67_0
- config68_2))))
- (reader-error.1
- unsafe-undefined
- v263_0
- #f
- unsafe-undefined
- in61_0
- config62_0
- temp64_3
- (list
- escaping-c65_0
- temp66_4))))))))))))))
- (let-values ()
- (let-values ((()
- (begin
- (if (eq?
- mode_0
- 'string)
- (void)
- (let-values ()
- (unknown-error_0)))
- (values))))
- (let-values (((pos_140)
- (accum-string-count
- accum-str_4)))
- (let-values (((v_261)
- (let-values (((in70_0)
- in_40)
- ((config71_0)
- config_44)
- ((accum-str72_0)
- accum-str_4)
- ((temp73_6)
- 16)
- ((temp74_3)
- 8))
- (read-digits.1
- temp73_6
- 0
- temp74_3
- #f
- in70_0
- config71_0
- accum-str72_0))))
- (begin
+ accum-str_5
+ next-c_1)
+ (void))
+ next-c_1))))))
+ (let-values (((v2_2)
+ (let-values (((next-c_2)
+ (next!_0)))
+ (if (char=?
+ next-c_2
+ '#\\)
+ (let-values (((next-c_3)
+ (next!_0)))
+ (if (char=?
+ next-c_3
+ '#\u)
+ (let-values (((v2_3)
+ (let-values (((in48_0)
+ in_56)
+ ((config49_1)
+ config_61)
+ ((accum-str50_0)
+ accum-str_5)
+ ((temp51_5)
+ 16)
+ ((temp52_3)
+ 4))
+ (read-digits.1
+ temp51_5
+ 0
+ temp52_3
+ #f
+ in48_0
+ config49_1
+ accum-str50_0))))
+ (if (integer?
+ v2_3)
+ (if (>=
+ v2_3
+ 56320)
+ (if (<=
+ v2_3
+ 57343)
+ v2_3
+ #f)
+ #f)
+ v2_3))
+ next-c_3))
+ next-c_2))))
(if (integer?
- v_261)
- (void)
- (let-values ()
- (no-hex-digits
- in_40
- config_44
- v_261
- escaping-c_0
- escaped-c_0)))
- (if (if (let-values (((or-part_62)
- (<
- v_261
- 55296)))
- (if or-part_62
- or-part_62
- (>
- v_261
- 57343)))
- (<=
- v_261
- 1114111)
- #f)
- (let-values ()
- (begin
- (set-accum-string-count!
- accum-str_4
- pos_140)
- (accum-string-add!
- accum-str_4
- (integer->char
- v_261))))
- (let-values ()
- (let-values (((in75_1)
- in_40)
- ((config76_1)
- config_44)
- ((temp77_2)
- "escape sequence `~aU~a` is out of range in string")
- ((escaping-c78_0)
- escaping-c_0)
- ((temp79_3)
- (let-values (((accum-str80_0)
- accum-str_4)
- ((config81_0)
- config_44)
- ((pos82_0)
- pos_140))
- (accum-string-get!.1
- pos82_0
- accum-str80_0
- config81_0))))
- (reader-error.1
- unsafe-undefined
- '#\x
+ v2_2)
+ (let-values (((combined-v_0)
+ (+
+ (arithmetic-shift
+ (-
+ v_394
+ 55296)
+ 10)
+ (-
+ v2_2
+ 56320)
+ 65536)))
+ (if (>
+ combined-v_0
+ 1114111)
+ (let-values (((in53_2)
+ in_56)
+ ((config54_2)
+ config_61)
+ ((temp55_4)
+ "escape sequence `~au~a` is out of range in string")
+ ((escaping-c56_0)
+ escaping-c_0)
+ ((temp57_4)
+ (let-values (((accum-str58_1)
+ accum-str_5)
+ ((config59_2)
+ config_61)
+ ((pos60_0)
+ pos_182))
+ (accum-string-get!.1
+ pos60_0
+ accum-str58_1
+ config59_2))))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in53_2
+ config54_2
+ temp55_4
+ (list
+ escaping-c56_0
+ temp57_4)))
+ (begin
+ (set-accum-string-count!
+ accum-str_5
+ pos_182)
+ (accum-string-add!
+ accum-str_5
+ (integer->char
+ combined-v_0)))))
+ (let-values (((in61_0)
+ in_56)
+ ((config62_0)
+ config_61)
+ ((v263_0)
+ v2_2)
+ ((temp64_5)
+ "bad or incomplete surrogate-style encoding at `~au~a`")
+ ((escaping-c65_0)
+ escaping-c_0)
+ ((temp66_3)
+ (let-values (((accum-str67_0)
+ accum-str_5)
+ ((config68_2)
+ config_61)
+ ((pos69_0)
+ pos_182))
+ (accum-string-get!.1
+ pos69_0
+ accum-str67_0
+ config68_2))))
+ (reader-error.1
+ unsafe-undefined
+ v263_0
+ #f
+ unsafe-undefined
+ in61_0
+ config62_0
+ temp64_5
+ (list
+ escaping-c65_0
+ temp66_3)))))))))))
+ (let-values ((()
+ (begin
+ (if (eq?
+ mode_25
+ 'string)
+ (void)
+ (unknown-error_0))
+ (values))))
+ (let-values (((pos_183)
+ (accum-string-count
+ accum-str_5)))
+ (let-values (((v_395)
+ (let-values (((in70_0)
+ in_56)
+ ((config71_0)
+ config_61)
+ ((accum-str72_0)
+ accum-str_5)
+ ((temp73_6)
+ 16)
+ ((temp74_3)
+ 8))
+ (read-digits.1
+ temp73_6
+ 0
+ temp74_3
#f
- unsafe-undefined
- in75_1
- config76_1
- temp77_2
- (list
- escaping-c78_0
- temp79_3)))))))))))))))))
- (loop_119)))))))
- (if (char=? '#\" c_18)
- (let-values () null)
- (let-values ()
- (begin
- (if (eq? mode_0 '|byte string|)
- (let-values ()
- (if (byte? (char->integer c_18))
- (void)
- (let-values ()
- (let-values (((in83_1) in_40)
- ((config84_0) config_44)
- ((temp85_3)
- "character `~a` is out of range in byte string")
- ((c86_0) c_18))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in83_1
- config84_0
- temp85_3
- (list c86_0))))))
- (void))
- (accum-string-add! accum-str_4 c_18)
- (loop_119)))))))))))
- loop_119))
- (values))))
- (let-values (((str_28)
- (if (eq? mode_0 '|byte string|)
- (let-values (((accum-str87_0) accum-str_4) ((config88_0) config_44))
- (accum-string-get-bytes!.1 0 accum-str87_0 config88_0))
- (let-values (((accum-str89_0) accum-str_4) ((config90_0) config_44))
- (accum-string-get!.1 0 accum-str89_0 config90_0)))))
- (wrap str_28 in_40 config_44 str_28))))))))))))))
+ in70_0
+ config71_0
+ accum-str72_0))))
+ (begin
+ (if (integer? v_395)
+ (void)
+ (no-hex-digits
+ in_56
+ config_61
+ v_395
+ escaping-c_0
+ escaped-c_0))
+ (if (if (let-values (((or-part_864)
+ (<
+ v_395
+ 55296)))
+ (if or-part_864
+ or-part_864
+ (>
+ v_395
+ 57343)))
+ (<= v_395 1114111)
+ #f)
+ (begin
+ (set-accum-string-count!
+ accum-str_5
+ pos_183)
+ (accum-string-add!
+ accum-str_5
+ (integer->char
+ v_395)))
+ (let-values (((in75_1)
+ in_56)
+ ((config76_1)
+ config_61)
+ ((temp77_3)
+ "escape sequence `~aU~a` is out of range in string")
+ ((escaping-c78_0)
+ escaping-c_0)
+ ((temp79_2)
+ (let-values (((accum-str80_0)
+ accum-str_5)
+ ((config81_0)
+ config_61)
+ ((pos82_0)
+ pos_183))
+ (accum-string-get!.1
+ pos82_0
+ accum-str80_0
+ config81_0))))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in75_1
+ config76_1
+ temp77_3
+ (list
+ escaping-c78_0
+ temp79_2)))))))))))))))
+ (loop_138))))))
+ (if (char=? '#\" c_186)
+ null
+ (begin
+ (if (eq? mode_25 '|byte string|)
+ (if (byte? (char->integer c_186))
+ (void)
+ (let-values (((in83_1) in_56)
+ ((config84_0) config_61)
+ ((temp85_2)
+ "character `~a` is out of range in byte string")
+ ((c86_0) c_186))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in83_1
+ config84_0
+ temp85_2
+ (list c86_0))))
+ (void))
+ (accum-string-add! accum-str_5 c_186)
+ (loop_138))))))))))
+ loop_138))
+ (values))))
+ (let-values (((str_31)
+ (if (eq? mode_25 '|byte string|)
+ (let-values (((accum-str87_0) accum-str_5) ((config88_0) config_61))
+ (accum-string-get-bytes!.1 0 accum-str87_0 config88_0))
+ (let-values (((accum-str89_0) accum-str_5) ((config90_0) config_61))
+ (accum-string-get!.1 0 accum-str89_0 config90_0)))))
+ (wrap str_31 in_56 config_61 str_31)))))))))))))
(define-values
(read-here-string)
- (lambda (in_46 config_47)
+ (lambda (in_61 config_62)
(begin
- (let-values (((source_30) (read-config-source config_47)))
- (let-values (((open-end-line_5 open-end-col_5 open-end-pos_5) (port-next-location in_46)))
- (let-values (((accum-str_5) (accum-string-init! config_47)))
+ (let-values (((source_32) (read-config-source config_62)))
+ (let-values (((open-end-line_5 open-end-col_5 open-end-pos_5) (port-next-location in_61)))
+ (let-values (((accum-str_6) (accum-string-init! config_62)))
(let-values (((full-terminator_0)
(cons
'#\newline
- ((letrec-values (((loop_120)
+ ((letrec-values (((loop_139)
(lambda ()
(begin
'loop
- (let-values (((c_129)
- (let-values (((in_47) in_46) ((source_31) source_30))
- (read-char-or-special in_47 special1.1 source_31))))
- (if (eof-object? c_129)
- (let-values ()
- (let-values (((in91_0) in_46)
- ((config92_0) config_47)
- ((c93_0) c_129)
- ((temp94_2)
- "found end-of-file after `#<<` and before a newline"))
+ (let-values (((c_188)
+ (let-values (((in_62) in_61) ((source_33) source_32))
+ (read-char-or-special in_62 special1.1 source_33))))
+ (if (eof-object? c_188)
+ (let-values (((in91_0) in_61)
+ ((config92_0) config_62)
+ ((c93_0) c_188)
+ ((temp94_1)
+ "found end-of-file after `#<<` and before a newline"))
+ (reader-error.1
+ unsafe-undefined
+ c93_0
+ #f
+ unsafe-undefined
+ in91_0
+ config92_0
+ temp94_1
+ (list)))
+ (if (not (char? c_188))
+ (let-values (((in95_0) in_61)
+ ((config96_0) config_62)
+ ((c97_0) c_188)
+ ((temp98_4)
+ "found non-character while reading `#<<`"))
(reader-error.1
unsafe-undefined
- c93_0
+ c97_0
#f
unsafe-undefined
- in91_0
- config92_0
- temp94_2
- (list))))
- (if (not (char? c_129))
- (let-values ()
- (let-values (((in95_0) in_46)
- ((config96_0) config_47)
- ((c97_0) c_129)
- ((temp98_3)
- "found non-character while reading `#<<`"))
- (reader-error.1
- unsafe-undefined
- c97_0
- #f
- unsafe-undefined
- in95_0
- config96_0
- temp98_3
- (list))))
- (if (char=? c_129 '#\newline)
- (let-values () null)
- (let-values () (cons c_129 (loop_120)))))))))))
- loop_120)))))
+ in95_0
+ config96_0
+ temp98_4
+ (list)))
+ (if (char=? c_188 '#\newline)
+ null
+ (cons c_188 (loop_139))))))))))
+ loop_139)))))
(let-values ((()
(begin
- ((letrec-values (((loop_121)
+ ((letrec-values (((loop_140)
(lambda (terminator_0 terminator-accum_0)
(begin
'loop
- (let-values (((c_130)
- (let-values (((in_48) in_46) ((source_32) source_30))
- (read-char-or-special in_48 special1.1 source_32))))
- (if (eof-object? c_130)
- (let-values ()
- (if (null? terminator_0)
- (void)
- (let-values ()
- (let-values (((in99_0) in_46)
- ((config100_0) config_47)
- ((c101_0) c_130)
- ((open-end-pos102_0) open-end-pos_5)
- ((temp103_2)
- "found end-of-file before terminating `~a`")
- ((temp104_3)
- (list->string (cdr full-terminator_0))))
- (reader-error.1
- unsafe-undefined
- c101_0
- open-end-pos102_0
- unsafe-undefined
- in99_0
- config100_0
- temp103_2
- (list temp104_3))))))
- (if (not (char? c_130))
- (let-values ()
- (let-values (((in105_0) in_46)
- ((config106_0) config_47)
- ((c107_0) c_130)
- ((temp108_0)
- "found non-character while reading `#<<`"))
- (reader-error.1
- unsafe-undefined
- c107_0
- #f
- unsafe-undefined
- in105_0
- config106_0
- temp108_0
- (list))))
+ (let-values (((c_189)
+ (let-values (((in_63) in_61) ((source_34) source_32))
+ (read-char-or-special in_63 special1.1 source_34))))
+ (if (eof-object? c_189)
+ (if (null? terminator_0)
+ (void)
+ (let-values (((in99_0) in_61)
+ ((config100_0) config_62)
+ ((c101_0) c_189)
+ ((open-end-pos102_0) open-end-pos_5)
+ ((temp103_3)
+ "found end-of-file before terminating `~a`")
+ ((temp104_2)
+ (list->string (cdr full-terminator_0))))
+ (reader-error.1
+ unsafe-undefined
+ c101_0
+ open-end-pos102_0
+ unsafe-undefined
+ in99_0
+ config100_0
+ temp103_3
+ (list temp104_2))))
+ (if (not (char? c_189))
+ (let-values (((in105_0) in_61)
+ ((config106_0) config_62)
+ ((c107_0) c_189)
+ ((temp108_0)
+ "found non-character while reading `#<<`"))
+ (reader-error.1
+ unsafe-undefined
+ c107_0
+ #f
+ unsafe-undefined
+ in105_0
+ config106_0
+ temp108_0
+ (list)))
(if (if (pair? terminator_0)
- (char=? c_130 (car terminator_0))
+ (char=? c_189 (car terminator_0))
#f)
- (let-values ()
- (loop_121
- (cdr terminator_0)
- (cons (car terminator_0) terminator-accum_0)))
- (if (if (null? terminator_0) (char=? c_130 '#\newline) #f)
- (let-values () (void))
- (let-values ()
- (begin
- (if (null? terminator-accum_0)
- (void)
- (let-values ()
- (begin
- (let-values (((lst_244)
- (reverse$1 terminator-accum_0)))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_244)))
- ((letrec-values (((for-loop_293)
- (lambda (lst_319)
- (begin
- 'for-loop
- (if (pair? lst_319)
- (let-values (((c_131)
- (unsafe-car
- lst_319))
- ((rest_179)
- (unsafe-cdr
- lst_319)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (accum-string-add!
- accum-str_5
- c_131))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_293
- rest_179)
- (values))))
- (values))))))
- for-loop_293)
- lst_244)))
- (void))))
- (if (char=? c_130 '#\newline)
- (let-values ()
- (loop_121
- (cdr full-terminator_0)
- (list '#\newline)))
- (let-values ()
+ (loop_140
+ (cdr terminator_0)
+ (cons (car terminator_0) terminator-accum_0))
+ (if (if (null? terminator_0) (char=? c_189 '#\newline) #f)
+ (void)
+ (begin
+ (if (null? terminator-accum_0)
+ (void)
+ (begin
+ (let-values (((lst_546)
+ (reverse$1 terminator-accum_0)))
(begin
- (accum-string-add! accum-str_5 c_130)
- (loop_121 full-terminator_0 null)))))))))))))))
- loop_121)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_546))
+ ((letrec-values (((for-loop_449)
+ (lambda (lst_547)
+ (begin
+ 'for-loop
+ (if (pair? lst_547)
+ (let-values (((c_190)
+ (unsafe-car
+ lst_547))
+ ((rest_269)
+ (unsafe-cdr
+ lst_547)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (accum-string-add!
+ accum-str_6
+ c_190)
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_449
+ rest_269)
+ (values))))
+ (values))))))
+ for-loop_449)
+ lst_546)))
+ (void)))
+ (if (char=? c_189 '#\newline)
+ (loop_140 (cdr full-terminator_0) (list '#\newline))
+ (begin
+ (accum-string-add! accum-str_6 c_189)
+ (loop_140 full-terminator_0 null)))))))))))))
+ loop_140)
(cdr full-terminator_0)
null)
(values))))
- (let-values (((str_31)
- (let-values (((accum-str109_0) accum-str_5) ((config110_0) config_47))
+ (let-values (((str_32)
+ (let-values (((accum-str109_0) accum-str_6) ((config110_0) config_62))
(accum-string-get!.1 0 accum-str109_0 config110_0))))
- (wrap str_31 in_46 config_47 str_31))))))))))
+ (wrap str_32 in_61 config_62 str_32))))))))))
(define-values
(no-hex-digits)
- (lambda (in_49 config_48 c_132 escaping-c_1 escaped-c_1)
+ (lambda (in_64 config_63 c_191 escaping-c_1 escaped-c_1)
(begin
- (let-values (((in111_0) in_49)
- ((config112_0) config_48)
- ((c113_0) c_132)
- ((temp114_1) "no hex digit following `~a~a`")
+ (let-values (((in111_0) in_64)
+ ((config112_0) config_63)
+ ((c113_0) c_191)
+ ((temp114_2) "no hex digit following `~a~a`")
((escaping-c115_0) escaping-c_1)
((escaped-c116_0) escaped-c_1))
(reader-error.1
@@ -64147,631 +62505,576 @@
unsafe-undefined
in111_0
config112_0
- temp114_1
+ temp114_2
(list escaping-c115_0 escaped-c116_0))))))
(define-values
(read-character)
- (lambda (in_5 config_8)
+ (lambda (in_65 config_64)
(begin
- (let-values (((c_49)
- (let-values (((in_50) in_5) ((source_26) (read-config-source config_8)))
- (read-char-or-special in_50 special1.1 source_26))))
+ (let-values (((c_192)
+ (let-values (((in_66) in_65) ((source_35) (read-config-source config_64)))
+ (read-char-or-special in_66 special1.1 source_35))))
(let-values (((char_0)
- (if (eof-object? c_49)
- (let-values ()
- (let-values (((in1_6) in_5)
- ((config2_6) config_8)
- ((c3_6) c_49)
- ((temp4_6) "expected a character after `#\\`"))
- (reader-error.1 unsafe-undefined c3_6 #f unsafe-undefined in1_6 config2_6 temp4_6 (list))))
- (if (not (char? c_49))
- (let-values ()
- (let-values (((in5_1) in_5)
- ((config6_0) config_8)
- ((c7_1) c_49)
- ((temp8_7) "found non-character after `#\\`"))
- (reader-error.1
- unsafe-undefined
- c7_1
- #f
- unsafe-undefined
- in5_1
- config6_0
- temp8_7
- (list))))
- (if (octal-digit? c_49)
- (let-values ()
- (let-values (((c2_10)
- (let-values (((in_51) in_5)
- ((skip-count_10) 0)
- ((source_1) (read-config-source config_8)))
- (let-values (((c_63)
- (peek-char-or-special
- in_51
- skip-count_10
- 'special
- source_1)))
- (if (eq? c_63 'special) (special1.1 'special) c_63)))))
- (if (if (char? c2_10) (octal-digit? c2_10) #f)
- (let-values ()
- (let-values ((() (begin (consume-char in_5 c2_10) (values))))
- (let-values (((c3_7)
- (let-values (((in_52) in_5)
- ((source_33) (read-config-source config_8)))
- (read-char-or-special in_52 special1.1 source_33))))
- (let-values (((v_49)
- (if (if (char? c3_7) (octal-digit? c3_7) #f)
- (let-values ()
- (+
- (arithmetic-shift (digit->number c_49) 6)
- (arithmetic-shift (digit->number c2_10) 3)
- (digit->number c3_7)))
- (let-values () #f))))
- (begin
- (if (if v_49 (<= v_49 255) #f)
- (void)
- (let-values ()
- (let-values (((in9_3) in_5)
- ((config10_4) config_8)
- ((c311_0) c3_7)
- ((temp12_4) "bad character constant `#\\~a~a~a`")
- ((c13_1) c_49)
- ((c214_0) c2_10)
- ((temp15_8) (if (char? c3_7) c3_7 "")))
- (reader-error.1
- unsafe-undefined
- c311_0
- #f
- unsafe-undefined
- in9_3
- config10_4
- temp12_4
- (list c13_1 c214_0 temp15_8)))))
- (integer->char v_49))))))
- (let-values () c_49))))
- (if (let-values (((or-part_276) (char=? c_49 '#\u)))
- (if or-part_276 or-part_276 (char=? c_49 '#\U)))
- (let-values ()
- (let-values (((accum-str_6) (accum-string-init! config_8)))
- (let-values (((v_35)
- (let-values (((in16_4) in_5)
- ((config17_4) config_8)
- ((accum-str18_0) accum-str_6)
- ((temp19_6) 16)
- ((temp20_8) (if (char=? c_49 '#\u) 4 8)))
- (read-digits.1
- temp19_6
- 0
- temp20_8
- #f
- in16_4
- config17_4
- accum-str18_0))))
- (if (integer? v_35)
- (let-values ()
- (if (if (let-values (((or-part_278) (< v_35 55296)))
- (if or-part_278 or-part_278 (> v_35 57343)))
- (<= v_35 1114111)
- #f)
- (let-values ()
- (begin (accum-string-abandon! accum-str_6 config_8) (integer->char v_35)))
- (let-values ()
- (let-values (((in21_3) in_5)
- ((config22_3) config_8)
- ((temp23_7) "bad character constant `#\\u~a`")
- ((temp24_7)
- (let-values (((accum-str25_0) accum-str_6)
- ((config26_2) config_8))
- (accum-string-get!.1 0 accum-str25_0 config26_2))))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in21_3
- config22_3
- temp23_7
- (list temp24_7))))))
- (let-values () (begin (accum-string-abandon! accum-str_6 config_8) c_49))))))
- (if (char-alphabetic? c_49)
- (let-values ()
- (let-values (((next-c_4)
- (let-values (((in_53) in_5)
- ((skip-count_11) 0)
- ((source_34) (read-config-source config_8)))
- (let-values (((c_68)
- (peek-char-or-special
- in_53
- skip-count_11
- 'special
- source_34)))
- (if (eq? c_68 'special) (special1.1 'special) c_68)))))
- (if (if (char? next-c_4) (char-alphabetic? next-c_4) #f)
- (let-values ()
- (let-values (((accum-str_7) (accum-string-init! config_8)))
- (let-values ((() (begin (accum-string-add! accum-str_7 c_49) (values))))
- (let-values ((() (begin (accum-string-add! accum-str_7 next-c_4) (values))))
- (let-values ((() (begin (consume-char in_5 next-c_4) (values))))
- (let-values ((()
- (begin
- ((letrec-values (((loop_122)
- (lambda ()
- (begin
- 'loop
- (let-values (((next-c_5)
- (let-values (((in_54)
- in_5)
- ((skip-count_12)
- 0)
- ((source_35)
- (read-config-source
- config_8)))
- (let-values (((c_73)
- (peek-char-or-special
- in_54
- skip-count_12
- 'special
- source_35)))
- (if (eq?
- c_73
- 'special)
- (special1.1
- 'special)
- c_73)))))
- (if (if (char? next-c_5)
- (char-alphabetic?
- next-c_5)
- #f)
- (let-values ()
- (begin
- (accum-string-add!
- accum-str_7
- next-c_5)
- (consume-char
- in_5
- next-c_5)
- (loop_122)))
- (void)))))))
- loop_122))
- (values))))
- (let-values (((name_74)
- (string-foldcase
- (let-values (((accum-str27_0) accum-str_7)
- ((config28_0) config_8))
- (accum-string-get!.1 0 accum-str27_0 config28_0)))))
- (let-values (((tmp_72) name_74))
- (if (if (equal? tmp_72 "nul") #t (equal? tmp_72 "null"))
- (let-values () '#\nul)
- (if (equal? tmp_72 "backspace")
- (let-values () '#\backspace)
- (if (equal? tmp_72 "tab")
- (let-values () '#\tab)
- (if (if (equal? tmp_72 "newline")
- #t
- (equal? tmp_72 "linefeed"))
- (let-values () '#\newline)
- (if (equal? tmp_72 "vtab")
- (let-values () '#\vtab)
- (if (equal? tmp_72 "page")
- (let-values () '#\page)
- (if (equal? tmp_72 "return")
- (let-values () '#\return)
- (if (equal? tmp_72 "space")
- (let-values () '#\space)
- (if (equal? tmp_72 "rubout")
- (let-values () '#\rubout)
- (let-values ()
- (let-values (((in29_2) in_5)
- ((config30_2) config_8)
- ((temp31_4)
- "bad character constant `#\\~a`")
- ((name32_1) name_74))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in29_2
- config30_2
- temp31_4
- (list name32_1)))))))))))))))))))))
- (let-values () c_49))))
- (let-values () c_49))))))))
- (wrap char_0 in_5 config_8 char_0))))))
+ (if (eof-object? c_192)
+ (let-values (((in1_6) in_65)
+ ((config2_6) config_64)
+ ((c3_4) c_192)
+ ((temp4_6) "expected a character after `#\\`"))
+ (reader-error.1 unsafe-undefined c3_4 #f unsafe-undefined in1_6 config2_6 temp4_6 (list)))
+ (if (not (char? c_192))
+ (let-values (((in5_1) in_65)
+ ((config6_0) config_64)
+ ((c7_1) c_192)
+ ((temp8_5) "found non-character after `#\\`"))
+ (reader-error.1 unsafe-undefined c7_1 #f unsafe-undefined in5_1 config6_0 temp8_5 (list)))
+ (if (octal-digit? c_192)
+ (let-values (((c2_7)
+ (let-values (((in_67) in_65)
+ ((skip-count_11) 0)
+ ((source_36) (read-config-source config_64)))
+ (let-values (((c_193)
+ (peek-char-or-special
+ in_67
+ skip-count_11
+ 'special
+ source_36)))
+ (if (eq? c_193 'special) (special1.1 'special) c_193)))))
+ (if (if (char? c2_7) (octal-digit? c2_7) #f)
+ (let-values ((() (begin (consume-char in_65 c2_7) (values))))
+ (let-values (((c3_5)
+ (let-values (((in_68) in_65)
+ ((source_37) (read-config-source config_64)))
+ (read-char-or-special in_68 special1.1 source_37))))
+ (let-values (((v_396)
+ (if (if (char? c3_5) (octal-digit? c3_5) #f)
+ (+
+ (arithmetic-shift (digit->number c_192) 6)
+ (arithmetic-shift (digit->number c2_7) 3)
+ (digit->number c3_5))
+ #f)))
+ (begin
+ (if (if v_396 (<= v_396 255) #f)
+ (void)
+ (let-values (((in9_3) in_65)
+ ((config10_4) config_64)
+ ((c311_0) c3_5)
+ ((temp12_10) "bad character constant `#\\~a~a~a`")
+ ((c13_1) c_192)
+ ((c214_0) c2_7)
+ ((temp15_8) (if (char? c3_5) c3_5 "")))
+ (reader-error.1
+ unsafe-undefined
+ c311_0
+ #f
+ unsafe-undefined
+ in9_3
+ config10_4
+ temp12_10
+ (list c13_1 c214_0 temp15_8))))
+ (integer->char v_396)))))
+ c_192))
+ (if (let-values (((or-part_865) (char=? c_192 '#\u)))
+ (if or-part_865 or-part_865 (char=? c_192 '#\U)))
+ (let-values (((accum-str_7) (accum-string-init! config_64)))
+ (let-values (((v_397)
+ (let-values (((in16_4) in_65)
+ ((config17_4) config_64)
+ ((accum-str18_0) accum-str_7)
+ ((temp19_9) 16)
+ ((temp20_8) (if (char=? c_192 '#\u) 4 8)))
+ (read-digits.1
+ temp19_9
+ 0
+ temp20_8
+ #f
+ in16_4
+ config17_4
+ accum-str18_0))))
+ (if (integer? v_397)
+ (if (if (let-values (((or-part_866) (< v_397 55296)))
+ (if or-part_866 or-part_866 (> v_397 57343)))
+ (<= v_397 1114111)
+ #f)
+ (begin (accum-string-abandon! accum-str_7 config_64) (integer->char v_397))
+ (let-values (((in21_3) in_65)
+ ((config22_3) config_64)
+ ((temp23_7) "bad character constant `#\\u~a`")
+ ((temp24_6)
+ (let-values (((accum-str25_0) accum-str_7) ((config26_2) config_64))
+ (accum-string-get!.1 0 accum-str25_0 config26_2))))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in21_3
+ config22_3
+ temp23_7
+ (list temp24_6))))
+ (begin (accum-string-abandon! accum-str_7 config_64) c_192))))
+ (if (char-alphabetic? c_192)
+ (let-values (((next-c_4)
+ (let-values (((in_69) in_65)
+ ((skip-count_12) 0)
+ ((source_38) (read-config-source config_64)))
+ (let-values (((c_194)
+ (peek-char-or-special
+ in_69
+ skip-count_12
+ 'special
+ source_38)))
+ (if (eq? c_194 'special) (special1.1 'special) c_194)))))
+ (if (if (char? next-c_4) (char-alphabetic? next-c_4) #f)
+ (let-values (((accum-str_8) (accum-string-init! config_64)))
+ (let-values ((() (begin (accum-string-add! accum-str_8 c_192) (values))))
+ (let-values ((() (begin (accum-string-add! accum-str_8 next-c_4) (values))))
+ (let-values ((() (begin (consume-char in_65 next-c_4) (values))))
+ (let-values ((()
+ (begin
+ ((letrec-values (((loop_141)
+ (lambda ()
+ (begin
+ 'loop
+ (let-values (((next-c_5)
+ (let-values (((in_70)
+ in_65)
+ ((skip-count_13)
+ 0)
+ ((source_39)
+ (read-config-source
+ config_64)))
+ (let-values (((c_195)
+ (peek-char-or-special
+ in_70
+ skip-count_13
+ 'special
+ source_39)))
+ (if (eq?
+ c_195
+ 'special)
+ (special1.1
+ 'special)
+ c_195)))))
+ (if (if (char? next-c_5)
+ (char-alphabetic? next-c_5)
+ #f)
+ (begin
+ (accum-string-add!
+ accum-str_8
+ next-c_5)
+ (consume-char in_65 next-c_5)
+ (loop_141))
+ (void)))))))
+ loop_141))
+ (values))))
+ (let-values (((name_87)
+ (string-foldcase
+ (let-values (((accum-str27_0) accum-str_8)
+ ((config28_0) config_64))
+ (accum-string-get!.1 0 accum-str27_0 config28_0)))))
+ (let-values (((tmp_76) name_87))
+ (if (if (equal? tmp_76 "nul") #t (equal? tmp_76 "null"))
+ '#\nul
+ (if (equal? tmp_76 "backspace")
+ '#\backspace
+ (if (equal? tmp_76 "tab")
+ '#\tab
+ (if (if (equal? tmp_76 "newline") #t (equal? tmp_76 "linefeed"))
+ '#\newline
+ (if (equal? tmp_76 "vtab")
+ '#\vtab
+ (if (equal? tmp_76 "page")
+ '#\page
+ (if (equal? tmp_76 "return")
+ '#\return
+ (if (equal? tmp_76 "space")
+ '#\space
+ (if (equal? tmp_76 "rubout")
+ '#\rubout
+ (let-values (((in29_2) in_65)
+ ((config30_2) config_64)
+ ((temp31_7)
+ "bad character constant `#\\~a`")
+ ((name32_1) name_87))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in29_2
+ config30_2
+ temp31_7
+ (list name32_1)))))))))))))))))))
+ c_192))
+ c_192)))))))
+ (wrap char_0 in_65 config_64 char_0))))))
(define-values
(read-quote)
- (lambda (read-one_4 sym_31 desc_0 c_45 in_50 config_23)
+ (lambda (read-one_14 sym_137 desc_0 c_196 in_71 config_65)
(begin
- (let-values (((wrapped-sym_0) (wrap sym_31 in_50 config_23 c_45)))
- (let-values (((end-line_1 end-col_1 end-pos_4) (port-next-location in_50)))
- (let-values (((e_94) (read-one_4 #f in_50 config_23)))
+ (let-values (((wrapped-sym_0) (wrap sym_137 in_71 config_65 c_196)))
+ (let-values (((end-line_1 end-col_1 end-pos_4) (port-next-location in_71)))
+ (let-values (((e_103) (read-one_14 #f in_71 config_65)))
(begin
- (if (eof-object? e_94)
- (let-values ()
- (let-values (((in1_7) in_50)
- ((config2_7) config_23)
- ((e3_0) e_94)
- ((end-pos4_1) end-pos_4)
- ((temp5_8) "expected an element for ~a, found end-of-file")
- ((desc6_0) desc_0))
- (reader-error.1
- unsafe-undefined
- e3_0
- end-pos4_1
- unsafe-undefined
- in1_7
- config2_7
- temp5_8
- (list desc6_0))))
+ (if (eof-object? e_103)
+ (let-values (((in1_7) in_71)
+ ((config2_7) config_65)
+ ((e3_0) e_103)
+ ((end-pos4_1) end-pos_4)
+ ((temp5_8) "expected an element for ~a, found end-of-file")
+ ((desc6_0) desc_0))
+ (reader-error.1
+ unsafe-undefined
+ e3_0
+ end-pos4_1
+ unsafe-undefined
+ in1_7
+ config2_7
+ temp5_8
+ (list desc6_0)))
(void))
- (wrap (list wrapped-sym_0 e_94) in_50 config_23 #f))))))))
+ (wrap (list wrapped-sym_0 e_103) in_71 config_65 #f))))))))
(define-values
(read-delimited-constant)
- (lambda (init-c_1 can-match?_0 chars_0 val_83 in_50 config_23)
+ (lambda (init-c_18 can-match?_0 chars_0 val_91 in_72 config_66)
(begin
- (let-values (((accum-str_8) (accum-string-init! config_23)))
+ (let-values (((accum-str_9) (accum-string-init! config_66)))
(begin
- (accum-string-add! accum-str_8 init-c_1)
- ((letrec-values (((loop_123)
+ (accum-string-add! accum-str_9 init-c_18)
+ ((letrec-values (((loop_142)
(lambda (chars_1)
(begin
'loop
- (let-values (((c_54)
- (let-values (((in_55) in_50)
- ((skip-count_13) 0)
- ((source_4) (read-config-source config_23)))
- (let-values (((c_55)
+ (let-values (((c_197)
+ (let-values (((in_73) in_72)
+ ((skip-count_14) 0)
+ ((source_40) (read-config-source config_66)))
+ (let-values (((c_198)
(peek-char-or-special
- in_55
- skip-count_13
+ in_73
+ skip-count_14
'special
- source_4)))
- (if (eq? c_55 'special) (special1.1 'special) c_55)))))
- (if (char-delimiter? c_54 config_23)
- (let-values ()
- (if (null? chars_1)
- (void)
- (let-values ()
- (let-values (((in1_8) in_50)
- ((config2_8) config_23)
- ((c3_8) c_54)
- ((temp4_7) "bad syntax `#~a`")
- ((temp5_9)
- (let-values (((accum-str6_0) accum-str_8)
- ((config7_1) config_23))
- (accum-string-get!.1 0 accum-str6_0 config7_1))))
- (reader-error.1
- unsafe-undefined
- c3_8
- #f
- unsafe-undefined
- in1_8
- config2_8
- temp4_7
- (list temp5_9))))))
+ source_40)))
+ (if (eq? c_198 'special) (special1.1 'special) c_198)))))
+ (if (char-delimiter? c_197 config_66)
+ (if (null? chars_1)
+ (void)
+ (let-values (((in1_8) in_72)
+ ((config2_8) config_66)
+ ((c3_6) c_197)
+ ((temp4_7) "bad syntax `#~a`")
+ ((temp5_9)
+ (let-values (((accum-str6_0) accum-str_9) ((config7_1) config_66))
+ (accum-string-get!.1 0 accum-str6_0 config7_1))))
+ (reader-error.1
+ unsafe-undefined
+ c3_6
+ #f
+ unsafe-undefined
+ in1_8
+ config2_8
+ temp4_7
+ (list temp5_9))))
(if (null? chars_1)
- (let-values ()
+ (begin
+ (accum-string-add! accum-str_9 c_197)
+ (let-values (((in8_1) in_72)
+ ((config9_1) config_66)
+ ((temp10_7) "bad syntax `#~a`")
+ ((temp11_6)
+ (let-values (((accum-str12_0) accum-str_9)
+ ((config13_1) config_66))
+ (accum-string-get!.1 0 accum-str12_0 config13_1))))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in8_1
+ config9_1
+ temp10_7
+ (list temp11_6))))
+ (if (if can-match?_0 (char=? c_197 (car chars_1)) #f)
(begin
- (accum-string-add! accum-str_8 c_54)
- (let-values (((in8_1) in_50)
- ((config9_1) config_23)
- ((temp10_7) "bad syntax `#~a`")
- ((temp11_0)
- (let-values (((accum-str12_0) accum-str_8)
- ((config13_1) config_23))
- (accum-string-get!.1 0 accum-str12_0 config13_1))))
+ (consume-char in_72 c_197)
+ (accum-string-add! accum-str_9 c_197)
+ (loop_142 (cdr chars_1)))
+ (begin
+ (consume-char/special in_72 config_66 c_197)
+ (accum-string-add! accum-str_9 c_197)
+ (let-values (((in14_1) in_72)
+ ((config15_2) config_66)
+ ((temp16_9) "bad syntax `#~a`")
+ ((temp17_5)
+ (let-values (((accum-str18_1) accum-str_9)
+ ((config19_1) config_66))
+ (accum-string-get!.1 0 accum-str18_1 config19_1))))
(reader-error.1
unsafe-undefined
'#\x
#f
unsafe-undefined
- in8_1
- config9_1
- temp10_7
- (list temp11_0)))))
- (if (if can-match?_0 (char=? c_54 (car chars_1)) #f)
- (let-values ()
- (begin
- (consume-char in_50 c_54)
- (accum-string-add! accum-str_8 c_54)
- (loop_123 (cdr chars_1))))
- (let-values ()
- (begin
- (consume-char/special in_50 config_23 c_54)
- (accum-string-add! accum-str_8 c_54)
- (let-values (((in14_1) in_50)
- ((config15_2) config_23)
- ((temp16_4) "bad syntax `#~a`")
- ((temp17_1)
- (let-values (((accum-str18_1) accum-str_8)
- ((config19_1) config_23))
- (accum-string-get!.1 0 accum-str18_1 config19_1))))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in14_1
- config15_2
- temp16_4
- (list temp17_1)))))))))))))
- loop_123)
+ in14_1
+ config15_2
+ temp16_9
+ (list temp17_5))))))))))))
+ loop_142)
chars_0)
(wrap
- val_83
- in_50
- config_23
- (let-values (((accum-str20_0) accum-str_8) ((config21_1) config_23))
+ val_91
+ in_72
+ config_66
+ (let-values (((accum-str20_0) accum-str_9) ((config21_1) config_66))
(accum-string-get!.1 0 accum-str20_0 config21_1))))))))
(define-values
(read-box)
- (lambda (read-one_4 dispatch-c_1 in_6 config_15)
+ (lambda (read-one_15 dispatch-c_4 in_74 config_67)
(begin
(let-values ((()
(begin
- (if (check-parameter 1/read-accept-box config_15)
+ (if (check-parameter 1/read-accept-box config_67)
(void)
- (let-values ()
- (let-values (((in1_6) in_6)
- ((config2_6) config_15)
- ((temp3_7) "`~a&` forms not enabled")
- ((dispatch-c4_0) dispatch-c_1))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in1_6
- config2_6
- temp3_7
- (list dispatch-c4_0)))))
+ (let-values (((in1_9) in_74)
+ ((config2_9) config_67)
+ ((temp3_7) "`~a&` forms not enabled")
+ ((dispatch-c4_0) dispatch-c_4))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in1_9
+ config2_9
+ temp3_7
+ (list dispatch-c4_0))))
(values))))
- (let-values (((open-end-line_6 open-end-col_6 open-end-pos_6) (port-next-location in_6)))
- (let-values (((e_95) (read-one_4 #f in_6 (next-readtable config_15))))
+ (let-values (((open-end-line_6 open-end-col_6 open-end-pos_6) (port-next-location in_74)))
+ (let-values (((e_104) (read-one_15 #f in_74 (next-readtable config_67))))
(begin
- (if (eof-object? e_95)
- (let-values ()
- (let-values (((in5_1) in_6)
- ((config6_0) config_15)
- ((e7_1) e_95)
- ((open-end-pos8_0) open-end-pos_6)
- ((temp9_7) "expected an element for `~a&` box, found end-of-file")
- ((dispatch-c10_0) dispatch-c_1))
- (reader-error.1
- unsafe-undefined
- e7_1
- open-end-pos8_0
- unsafe-undefined
- in5_1
- config6_0
- temp9_7
- (list dispatch-c10_0))))
+ (if (eof-object? e_104)
+ (let-values (((in5_2) in_74)
+ ((config6_1) config_67)
+ ((e7_1) e_104)
+ ((open-end-pos8_0) open-end-pos_6)
+ ((temp9_7) "expected an element for `~a&` box, found end-of-file")
+ ((dispatch-c10_0) dispatch-c_4))
+ (reader-error.1
+ unsafe-undefined
+ e7_1
+ open-end-pos8_0
+ unsafe-undefined
+ in5_2
+ config6_1
+ temp9_7
+ (list dispatch-c10_0)))
(void))
- (wrap (if (read-config-for-syntax? config_15) (box-immutable e_95) (box e_95)) in_6 config_15 #f))))))))
+ (wrap
+ (if (read-config-for-syntax? config_67) (box-immutable e_104) (box e_104))
+ in_74
+ config_67
+ #f))))))))
(define-values
(read-regexp)
- (lambda (mode-c_0 accum-str_9 in_6 config_15)
+ (lambda (mode-c_0 accum-str_10 in_75 config_68)
(begin
- (let-values (((c3_9)
- (let-values (((in_20) in_6) ((source_36) (read-config-source config_15)))
- (read-char-or-special in_20 special1.1 source_36))))
- (let-values (((no-wrap-config_0) (disable-wrapping config_15)))
+ (let-values (((c3_7)
+ (let-values (((in_76) in_75) ((source_41) (read-config-source config_68)))
+ (read-char-or-special in_76 special1.1 source_41))))
+ (let-values (((no-wrap-config_0) (disable-wrapping config_68)))
(let-values (((rx_0)
- (let-values (((tmp_73) c3_9))
- (if (equal? tmp_73 '#\")
- (let-values ()
- (let-values ((() (begin (accum-string-abandon! accum-str_9 config_15) (values))))
- (let-values (((str_32)
- (let-values (((in1_7) in_6) ((no-wrap-config2_0) no-wrap-config_0))
- (read-string.1 'string in1_7 no-wrap-config2_0))))
- (catch-and-reraise-as-reader/proc
- in_6
- config_15
- (lambda () ((if (char=? mode-c_0 '#\r) regexp pregexp) str_32))))))
- (if (equal? tmp_73 '#\#)
- (let-values ()
- (let-values ((() (begin (accum-string-add! accum-str_9 c3_9) (values))))
- (let-values (((c4_2)
- (let-values (((in_21) in_6)
- ((source_37) (read-config-source config_15)))
- (read-char-or-special in_21 special1.1 source_37))))
- (let-values (((tmp_74) c4_2))
- (if (equal? tmp_74 '#\")
- (let-values ()
- (let-values ((()
- (begin (accum-string-abandon! accum-str_9 config_15) (values))))
- (let-values (((bstr_24)
- (let-values (((in3_1) in_6)
- ((no-wrap-config4_0) no-wrap-config_0)
- ((temp5_10) '|byte string|))
- (read-string.1 temp5_10 in3_1 no-wrap-config4_0))))
- (catch-and-reraise-as-reader/proc
- in_6
- config_15
- (lambda ()
- ((if (char=? mode-c_0 '#\r) byte-regexp byte-pregexp) bstr_24))))))
- (let-values ()
- (let-values (((in6_3) in_6)
- ((config7_2) config_15)
- ((c48_0) c4_2)
- ((temp9_8) "expected `\"` after `~a`")
- ((temp10_8)
- (let-values (((accum-str11_0) accum-str_9)
- ((config12_1) config_15))
- (accum-string-get!.1 0 accum-str11_0 config12_1))))
- (reader-error.1
- unsafe-undefined
- c48_0
- #f
- unsafe-undefined
- in6_3
- config7_2
- temp9_8
- (list temp10_8)))))))))
- (let-values ()
- (let-values (((in13_1) in_6)
- ((config14_1) config_15)
- ((c315_0) c3_9)
- ((temp16_9) "expected `\"` or `#` after `~a`")
- ((temp17_5)
- (let-values (((accum-str18_2) accum-str_9) ((config19_2) config_15))
- (accum-string-get!.1 0 accum-str18_2 config19_2))))
- (reader-error.1
- unsafe-undefined
- c315_0
- #f
- unsafe-undefined
- in13_1
- config14_1
- temp16_9
- (list temp17_5)))))))))
- (wrap rx_0 in_6 config_15 #f)))))))
+ (let-values (((tmp_77) c3_7))
+ (if (equal? tmp_77 '#\")
+ (let-values ((() (begin (accum-string-abandon! accum-str_10 config_68) (values))))
+ (let-values (((str_33)
+ (let-values (((in1_10) in_75) ((no-wrap-config2_0) no-wrap-config_0))
+ (read-string.1 'string in1_10 no-wrap-config2_0))))
+ (catch-and-reraise-as-reader/proc
+ in_75
+ config_68
+ (lambda () ((if (char=? mode-c_0 '#\r) regexp pregexp) str_33)))))
+ (if (equal? tmp_77 '#\#)
+ (let-values ((() (begin (accum-string-add! accum-str_10 c3_7) (values))))
+ (let-values (((c4_1)
+ (let-values (((in_77) in_75) ((source_42) (read-config-source config_68)))
+ (read-char-or-special in_77 special1.1 source_42))))
+ (let-values (((tmp_78) c4_1))
+ (if (equal? tmp_78 '#\")
+ (let-values ((() (begin (accum-string-abandon! accum-str_10 config_68) (values))))
+ (let-values (((bstr_24)
+ (let-values (((in3_1) in_75)
+ ((no-wrap-config4_0) no-wrap-config_0)
+ ((temp5_10) '|byte string|))
+ (read-string.1 temp5_10 in3_1 no-wrap-config4_0))))
+ (catch-and-reraise-as-reader/proc
+ in_75
+ config_68
+ (lambda () ((if (char=? mode-c_0 '#\r) byte-regexp byte-pregexp) bstr_24)))))
+ (let-values (((in6_3) in_75)
+ ((config7_2) config_68)
+ ((c48_0) c4_1)
+ ((temp9_8) "expected `\"` after `~a`")
+ ((temp10_8)
+ (let-values (((accum-str11_0) accum-str_10)
+ ((config12_1) config_68))
+ (accum-string-get!.1 0 accum-str11_0 config12_1))))
+ (reader-error.1
+ unsafe-undefined
+ c48_0
+ #f
+ unsafe-undefined
+ in6_3
+ config7_2
+ temp9_8
+ (list temp10_8)))))))
+ (let-values (((in13_1) in_75)
+ ((config14_1) config_68)
+ ((c315_0) c3_7)
+ ((temp16_10) "expected `\"` or `#` after `~a`")
+ ((temp17_6)
+ (let-values (((accum-str18_2) accum-str_10) ((config19_2) config_68))
+ (accum-string-get!.1 0 accum-str18_2 config19_2))))
+ (reader-error.1
+ unsafe-undefined
+ c315_0
+ #f
+ unsafe-undefined
+ in13_1
+ config14_1
+ temp16_10
+ (list temp17_6))))))))
+ (wrap rx_0 in_75 config_68 #f)))))))
(define-values
(read-extension-reader)
- (lambda (read-one_11 read-recur_0 dispatch-c_2 in_56 config_25)
+ (lambda (read-one_16 read-recur_0 dispatch-c_5 in_78 config_69)
(begin
(let-values (((extend-str_0)
- (read-extension-prefix (cons dispatch-c_2 '(#\r #\e)) '(#\a #\d #\e #\r) in_56 config_25)))
+ (read-extension-prefix (cons dispatch-c_5 '(#\r #\e)) '(#\a #\d #\e #\r) in_78 config_69)))
(let-values ((()
(begin
- (if (check-parameter 1/read-accept-reader config_25)
+ (if (check-parameter 1/read-accept-reader config_69)
(void)
- (let-values ()
- (let-values (((in46_1) in_56)
- ((config47_1) config_25)
- ((temp48_5) "`~a` not enabled")
- ((extend-str49_0) extend-str_0))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in46_1
- config47_1
- temp48_5
- (list extend-str49_0)))))
+ (let-values (((in46_1) in_78)
+ ((config47_1) config_69)
+ ((temp48_5) "`~a` not enabled")
+ ((extend-str49_0) extend-str_0))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in46_1
+ config47_1
+ temp48_5
+ (list extend-str49_0))))
(values))))
- (let-values (((mod-path-wrapped_0) (read-one_11 #f in_56 (next-readtable config_25))))
+ (let-values (((mod-path-wrapped_0) (read-one_16 #f in_78 (next-readtable config_69))))
(begin
(if (eof-object? mod-path-wrapped_0)
- (let-values ()
- (let-values (((in50_1) in_56)
- ((config51_1) config_25)
- ((mod-path-wrapped52_0) mod-path-wrapped_0)
- ((temp53_2) "expected a datum after `~a`, found end-of-file")
- ((extend-str54_0) extend-str_0))
- (reader-error.1
- unsafe-undefined
- mod-path-wrapped52_0
- #f
- unsafe-undefined
- in50_1
- config51_1
- temp53_2
- (list extend-str54_0))))
+ (let-values (((in50_1) in_78)
+ ((config51_1) config_69)
+ ((mod-path-wrapped52_0) mod-path-wrapped_0)
+ ((temp53_4) "expected a datum after `~a`, found end-of-file")
+ ((extend-str54_0) extend-str_0))
+ (reader-error.1
+ unsafe-undefined
+ mod-path-wrapped52_0
+ #f
+ unsafe-undefined
+ in50_1
+ config51_1
+ temp53_4
+ (list extend-str54_0)))
(void))
- (let-values (((temp41_7) ((read-config-coerce config_25) #f mod-path-wrapped_0 #f))
+ (let-values (((temp41_6) ((read-config-coerce config_69) #f mod-path-wrapped_0 #f))
((read-recur42_0) read-recur_0)
- ((in43_2) in_56)
- ((config44_1) config_25)
+ ((in43_2) in_78)
+ ((config44_1) config_69)
((mod-path-wrapped45_0) mod-path-wrapped_0))
(read-extension.1
#f
mod-path-wrapped45_0
#f
'|#reader|
- temp41_7
+ temp41_6
read-recur42_0
in43_2
config44_1)))))))))
(define-values
(read-extension-lang.1)
- (lambda (get-info?1_0 read-recur3_0 dispatch-c4_1 in5_2 config6_1)
+ (lambda (get-info?1_0 read-recur3_0 dispatch-c4_1 in5_3 config6_2)
(begin
'read-extension-lang
(let-values (((read-recur_1) read-recur3_0))
- (let-values (((dispatch-c_3) dispatch-c4_1))
- (let-values (((in_57) in5_2))
- (let-values (((config_49) config6_1))
+ (let-values (((dispatch-c_6) dispatch-c4_1))
+ (let-values (((in_79) in5_3))
+ (let-values (((config_70) config6_2))
(let-values (((get-info?_0) get-info?1_0))
- (let-values ()
- (let-values (((extend-str_1)
- (read-extension-prefix (cons dispatch-c_3 '(#\l)) '(#\a #\n #\g) in_57 config_49)))
- (let-values (((c_133)
- (let-values (((in_58) in_57) ((source_17) (read-config-source config_49)))
- (read-char-or-special in_58 special1.1 source_17))))
- (begin
- (if (eqv? c_133 '#\space)
- (void)
- (let-values ()
- (let-values (((in62_0) in_57)
- ((config63_0) config_49)
- ((temp64_4) "expected a single space after `~a`")
- ((extend-str65_0) extend-str_1))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in62_0
- config63_0
- temp64_4
- (list extend-str65_0)))))
- (let-values (((extend-str55_0) extend-str_1)
- ((read-recur56_0) read-recur_1)
- ((in57_1) in_57)
- ((config58_1) config_49)
- ((temp59_1) #t)
- ((temp60_4) '|#lang|)
- ((get-info?61_0) get-info?_0))
- (read-lang.1
- get-info?61_0
+ (let-values (((extend-str_1)
+ (read-extension-prefix (cons dispatch-c_6 '(#\l)) '(#\a #\n #\g) in_79 config_70)))
+ (let-values (((c_199)
+ (let-values (((in_80) in_79) ((source_43) (read-config-source config_70)))
+ (read-char-or-special in_80 special1.1 source_43))))
+ (begin
+ (if (eqv? c_199 '#\space)
+ (void)
+ (let-values (((in62_0) in_79)
+ ((config63_0) config_70)
+ ((temp64_6) "expected a single space after `~a`")
+ ((extend-str65_0) extend-str_1))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
#f
- temp59_1
- temp60_4
- extend-str55_0
- read-recur56_0
- in57_1
- config58_1))))))))))))))
+ unsafe-undefined
+ in62_0
+ config63_0
+ temp64_6
+ (list extend-str65_0))))
+ (let-values (((extend-str55_0) extend-str_1)
+ ((read-recur56_0) read-recur_1)
+ ((in57_1) in_79)
+ ((config58_1) config_70)
+ ((temp59_1) #t)
+ ((temp60_5) '|#lang|)
+ ((get-info?61_0) get-info?_0))
+ (read-lang.1
+ get-info?61_0
+ #f
+ temp59_1
+ temp60_5
+ extend-str55_0
+ read-recur56_0
+ in57_1
+ config58_1)))))))))))))
(define-values
(read-extension-#!.1)
(lambda (get-info?8_0 read-recur10_0 dispatch-c11_1 in12_2 config13_2)
(begin
'read-extension-#!
(let-values (((read-recur_2) read-recur10_0))
- (let-values (((dispatch-c_4) dispatch-c11_1))
- (let-values (((in_19) in12_2))
- (let-values (((config_21) config13_2))
+ (let-values (((dispatch-c_7) dispatch-c11_1))
+ (let-values (((in_81) in12_2))
+ (let-values (((config_71) config13_2))
(let-values (((get-info?_1) get-info?8_0))
- (let-values ()
- (let-values (((c_134)
- (let-values (((in_59) in_19) ((source_38) (read-config-source config_21)))
- (read-char-or-special in_59 special1.1 source_38))))
- (begin
- (if (if (char? c_134) (char-lang-nonsep? c_134) #f)
- (void)
- (let-values ()
- (let-values (((in73_0) in_19)
- ((config74_0) config_21)
- ((temp75_2)
- (if (char? c_134) (string dispatch-c_4 '#\! c_134) (string dispatch-c_4 '#\!))))
- (bad-syntax-error.1 '#\x in73_0 config74_0 temp75_2))))
- (let-values (((temp66_5) (string dispatch-c_4 '#\!))
- ((read-recur67_0) read-recur_2)
- ((in68_0) in_19)
- ((config69_0) config_21)
- ((c70_0) c_134)
- ((temp71_2) '|#!|)
- ((get-info?72_0) get-info?_1))
- (read-lang.1
- get-info?72_0
- c70_0
- #f
- temp71_2
- temp66_5
- read-recur67_0
- in68_0
- config69_0)))))))))))))
+ (let-values (((c_200)
+ (let-values (((in_82) in_81) ((source_44) (read-config-source config_71)))
+ (read-char-or-special in_82 special1.1 source_44))))
+ (begin
+ (if (if (char? c_200) (char-lang-nonsep? c_200) #f)
+ (void)
+ (let-values (((in73_0) in_81)
+ ((config74_0) config_71)
+ ((temp75_2)
+ (if (char? c_200) (string dispatch-c_7 '#\! c_200) (string dispatch-c_7 '#\!))))
+ (bad-syntax-error.1 '#\x in73_0 config74_0 temp75_2)))
+ (let-values (((temp66_4) (string dispatch-c_7 '#\!))
+ ((read-recur67_0) read-recur_2)
+ ((in68_0) in_81)
+ ((config69_0) config_71)
+ ((c70_0) c_200)
+ ((temp71_3) '|#!|)
+ ((get-info?72_0) get-info?_1))
+ (read-lang.1 get-info?72_0 c70_0 #f temp71_3 temp66_4 read-recur67_0 in68_0 config69_0))))))))))))
(define-values
(read-lang.1)
(lambda (get-info?17_0 init-c15_0 one-space?16_0 who18_0 extend-str23_0 read-recur24_0 in25_2 config26_3)
@@ -64779,315 +63082,293 @@
'read-lang
(let-values (((extend-str_2) extend-str23_0))
(let-values (((read-recur_3) read-recur24_0))
- (let-values (((in_43) in25_2))
- (let-values (((config_50) config26_3))
- (let-values (((init-c_16) init-c15_0))
+ (let-values (((in_83) in25_2))
+ (let-values (((config_72) config26_3))
+ (let-values (((init-c_19) init-c15_0))
(let-values (((one-space?_0) one-space?16_0))
(let-values (((get-info?_2) get-info?17_0))
- (let-values (((who_31) who18_0))
- (let-values ()
- (let-values ((()
- (begin
- (if (if (check-parameter 1/read-accept-reader config_50)
- (check-parameter 1/read-accept-lang config_50)
- #f)
- (void)
- (let-values ()
- (let-values (((in83_2) in_43)
- ((config84_1) config_50)
- ((temp85_4) "`~a` not enabled\n possible reason: ~a")
- ((extend-str86_0) extend-str_2)
- ((temp87_2)
- (string-append
- "not allowed again inside a module that already starts `#lang`,"
- " or not enabled for interactive evaluation")))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in83_2
- config84_1
- temp85_4
- (list extend-str86_0 temp87_2)))))
- (values))))
- (let-values (((line_8 col_7 pos_141) (port-next-location in_43)))
- (let-values (((accum-str_10) (accum-string-init! config_50)))
+ (let-values (((who_45) who18_0))
+ (let-values ((()
+ (begin
+ (if (if (check-parameter 1/read-accept-reader config_72)
+ (check-parameter 1/read-accept-lang config_72)
+ #f)
+ (void)
+ (let-values (((in83_2) in_83)
+ ((config84_1) config_72)
+ ((temp85_3) "`~a` not enabled\n possible reason: ~a")
+ ((extend-str86_0) extend-str_2)
+ ((temp87_1)
+ (string-append
+ "not allowed again inside a module that already starts `#lang`,"
+ " or not enabled for interactive evaluation")))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in83_2
+ config84_1
+ temp85_3
+ (list extend-str86_0 temp87_1))))
+ (values))))
+ (let-values (((line_9 col_8 pos_184) (port-next-location in_83)))
+ (let-values (((accum-str_11) (accum-string-init! config_72)))
+ (let-values ((()
+ (begin
+ (if init-c_19 (accum-string-add! accum-str_11 init-c_19) (void))
+ (values))))
(let-values ((()
(begin
- (if init-c_16
- (let-values () (accum-string-add! accum-str_10 init-c_16))
- (void))
- (values))))
- (let-values ((()
- (begin
- ((letrec-values (((loop_124)
- (lambda ()
- (begin
- 'loop
- (let-values (((c_14)
- (let-values (((in_60) in_43)
- ((skip-count_14) 0)
- ((source_39)
- (read-config-source
- config_50)))
- (let-values (((c_135)
- (peek-char-or-special
- in_60
- skip-count_14
- 'special
- source_39)))
- (if (eq? c_135 'special)
- (special1.1 'special)
- c_135)))))
- (if (eof-object? c_14)
- (let-values () (void))
- (if (not (char? c_14))
- (let-values ()
- (begin
- (consume-char/special
- in_43
- config_50
- c_14)
- (let-values (((in88_0) in_43)
- ((config89_0) config_50)
- ((c90_0) c_14)
- ((temp91_1)
- "found non-character while reading `#~a`")
- ((extend-str92_0)
- extend-str_2))
- (reader-error.1
- unsafe-undefined
- c90_0
- #f
- unsafe-undefined
- in88_0
- config89_0
- temp91_1
- (list extend-str92_0)))))
- (if (if (char-whitespace? c_14)
- (positive?
- (accum-string-count accum-str_10))
+ ((letrec-values (((loop_143)
+ (lambda ()
+ (begin
+ 'loop
+ (let-values (((c_201)
+ (let-values (((in_84) in_83)
+ ((skip-count_15) 0)
+ ((source_45)
+ (read-config-source
+ config_72)))
+ (let-values (((c_202)
+ (peek-char-or-special
+ in_84
+ skip-count_15
+ 'special
+ source_45)))
+ (if (eq? c_202 'special)
+ (special1.1 'special)
+ c_202)))))
+ (if (eof-object? c_201)
+ (void)
+ (if (not (char? c_201))
+ (begin
+ (consume-char/special in_83 config_72 c_201)
+ (let-values (((in88_0) in_83)
+ ((config89_0) config_72)
+ ((c90_0) c_201)
+ ((temp91_2)
+ "found non-character while reading `#~a`")
+ ((extend-str92_0)
+ extend-str_2))
+ (reader-error.1
+ unsafe-undefined
+ c90_0
+ #f
+ unsafe-undefined
+ in88_0
+ config89_0
+ temp91_2
+ (list extend-str92_0))))
+ (if (if (char-whitespace? c_201)
+ (positive?
+ (accum-string-count accum-str_11))
+ #f)
+ (void)
+ (if (if one-space?_0
+ (char=? c_201 '#\space)
#f)
- (let-values () (void))
- (if (if one-space?_0
- (char=? c_14 '#\space)
- #f)
- (let-values ()
- (let-values (((in93_0) in_43)
- ((config94_0) config_50)
- ((temp95_1)
- "expected a single space after `~a`")
- ((extend-str96_0)
- extend-str_2))
+ (let-values (((in93_0) in_83)
+ ((config94_0) config_72)
+ ((temp95_0)
+ "expected a single space after `~a`")
+ ((extend-str96_0)
+ extend-str_2))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in93_0
+ config94_0
+ temp95_0
+ (list extend-str96_0)))
+ (if (let-values (((or-part_867)
+ (char-lang-nonsep?
+ c_201)))
+ (if or-part_867
+ or-part_867
+ (char=? '#\/ c_201)))
+ (begin
+ (consume-char in_83 c_201)
+ (accum-string-add! accum-str_11 c_201)
+ (loop_143))
+ (begin
+ (consume-char in_83 c_201)
+ (let-values (((in97_0) in_83)
+ ((config98_0) config_72)
+ ((temp99_0)
+ (string-append
+ "expected only alphanumeric, `-`, `+`, `_`, or `/`"
+ " characters for `~a`, found `~a`"))
+ ((extend-str100_0)
+ extend-str_2)
+ ((c101_1) c_201))
(reader-error.1
unsafe-undefined
'#\x
#f
unsafe-undefined
- in93_0
- config94_0
- temp95_1
- (list extend-str96_0))))
- (if (let-values (((or-part_53)
- (char-lang-nonsep?
- c_14)))
- (if or-part_53
- or-part_53
- (char=? '#\/ c_14)))
- (let-values ()
- (begin
- (consume-char in_43 c_14)
- (accum-string-add!
- accum-str_10
- c_14)
- (loop_124)))
- (let-values ()
- (begin
- (consume-char in_43 c_14)
- (let-values (((in97_0) in_43)
- ((config98_0)
- config_50)
- ((temp99_0)
- (string-append
- "expected only alphanumeric, `-`, `+`, `_`, or `/`"
- " characters for `~a`, found `~a`"))
- ((extend-str100_0)
- extend-str_2)
- ((c101_1) c_14))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in97_0
- config98_0
- temp99_0
- (list
- extend-str100_0
- c101_1)))))))))))))))
- loop_124))
- (values))))
- (let-values (((lang-str_0)
- (let-values (((accum-str102_0) accum-str_10) ((config103_0) config_50))
- (accum-string-get!.1 0 accum-str102_0 config103_0))))
+ in97_0
+ config98_0
+ temp99_0
+ (list
+ extend-str100_0
+ c101_1))))))))))))))
+ loop_143))
+ (values))))
+ (let-values (((lang-str_0)
+ (let-values (((accum-str102_0) accum-str_11) ((config103_0) config_72))
+ (accum-string-get!.1 0 accum-str102_0 config103_0))))
+ (let-values ((()
+ (begin
+ (if (equal? lang-str_0 "")
+ (let-values (((in104_0) in_83)
+ ((config105_0) config_72)
+ ((temp106_0)
+ "expected a non-empty sequence of alphanumeric, `-`, `+`, `_`, or `/` after `~a~a`")
+ ((extend-str107_0) extend-str_2)
+ ((temp108_1) (if one-space?_0 " " "")))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in104_0
+ config105_0
+ temp106_0
+ (list extend-str107_0 temp108_1)))
+ (void))
+ (values))))
(let-values ((()
(begin
- (if (equal? lang-str_0 "")
- (let-values ()
- (let-values (((in104_0) in_43)
- ((config105_0) config_50)
- ((temp106_0)
- "expected a non-empty sequence of alphanumeric, `-`, `+`, `_`, or `/` after `~a~a`")
- ((extend-str107_0) extend-str_2)
- ((temp108_1) (if one-space?_0 " " "")))
+ (if (char=? '#\/ (string-ref lang-str_0 0))
+ (let-values (((in109_0) in_83)
+ ((config110_1) config_72)
+ ((temp111_2)
+ "expected a name that does not start `/` after `~a`")
+ ((extend-str112_0) extend-str_2))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in109_0
+ config110_1
+ temp111_2
+ (list extend-str112_0)))
+ (void))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (char=?
+ '#\/
+ (string-ref lang-str_0 (sub1 (string-length lang-str_0))))
+ (let-values (((in113_0) in_83)
+ ((config114_0) config_72)
+ ((temp115_1)
+ "expected a name that does not end `/` after `~a`")
+ ((extend-str116_0) extend-str_2))
(reader-error.1
unsafe-undefined
'#\x
#f
unsafe-undefined
- in104_0
- config105_0
- temp106_0
- (list extend-str107_0 temp108_1))))
- (void))
- (values))))
- (let-values ((()
- (begin
- (if (char=? '#\/ (string-ref lang-str_0 0))
- (let-values ()
- (let-values (((in109_0) in_43)
- ((config110_1) config_50)
- ((temp111_3)
- "expected a name that does not start `/` after `~a`")
- ((extend-str112_0) extend-str_2))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in109_0
- config110_1
- temp111_3
- (list extend-str112_0))))
+ in113_0
+ config114_0
+ temp115_1
+ (list extend-str116_0)))
(void))
(values))))
- (let-values ((()
- (begin
- (if (char=?
- '#\/
- (string-ref lang-str_0 (sub1 (string-length lang-str_0))))
- (let-values ()
- (let-values (((in113_0) in_43)
- ((config114_0) config_50)
- ((temp115_1)
- "expected a name that does not end `/` after `~a`")
- ((extend-str116_0) extend-str_2))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in113_0
- config114_0
- temp115_1
- (list extend-str116_0))))
- (void))
- (values))))
- (let-values (((submod-path_0)
- (list* 'submod (string->symbol lang-str_0) '(reader))))
- (let-values (((reader-path_0)
- (string->symbol (string-append lang-str_0 "/lang/reader"))))
- (let-values (((submod-path76_0) submod-path_0)
- ((reader-path77_0) reader-path_0)
- ((read-recur78_0) read-recur_3)
- ((in79_0) in_43)
- ((temp80_2) (reading-at config_50 line_8 col_7 pos_141))
- ((get-info?81_0) get-info?_2)
- ((who82_1) who_31))
- (read-extension.1
- get-info?81_0
- unsafe-undefined
- submod-path76_0
- who82_1
- reader-path77_0
- read-recur78_0
- in79_0
- temp80_2)))))))))))))))))))))))))
+ (let-values (((submod-path_0)
+ (list* 'submod (string->symbol lang-str_0) '(reader))))
+ (let-values (((reader-path_0)
+ (string->symbol (string-append lang-str_0 "/lang/reader"))))
+ (let-values (((submod-path76_0) submod-path_0)
+ ((reader-path77_0) reader-path_0)
+ ((read-recur78_0) read-recur_3)
+ ((in79_0) in_83)
+ ((temp80_2) (reading-at config_72 line_9 col_8 pos_184))
+ ((get-info?81_0) get-info?_2)
+ ((who82_1) who_45))
+ (read-extension.1
+ get-info?81_0
+ unsafe-undefined
+ submod-path76_0
+ who82_1
+ reader-path77_0
+ read-recur78_0
+ in79_0
+ temp80_2))))))))))))))))))))))))
(define-values
(char-lang-nonsep?)
- (lambda (c_136)
- (begin
- (if (< (char->integer c_136) 128)
- (let-values (((or-part_520) (char-alphabetic? c_136)))
- (if or-part_520
- or-part_520
- (let-values (((or-part_521) (char-numeric? c_136)))
- (if or-part_521
- or-part_521
- (let-values (((or-part_522) (char=? '#\- c_136)))
- (if or-part_522
- or-part_522
- (let-values (((or-part_523) (char=? '#\+ c_136)))
- (if or-part_523 or-part_523 (char=? '#\_ c_136)))))))))
+ (lambda (c_203)
+ (begin
+ (if (< (char->integer c_203) 128)
+ (let-values (((or-part_868) (char-alphabetic? c_203)))
+ (if or-part_868
+ or-part_868
+ (let-values (((or-part_869) (char-numeric? c_203)))
+ (if or-part_869
+ or-part_869
+ (let-values (((or-part_870) (char=? '#\- c_203)))
+ (if or-part_870
+ or-part_870
+ (let-values (((or-part_871) (char=? '#\+ c_203)))
+ (if or-part_871 or-part_871 (char=? '#\_ c_203)))))))))
#f))))
(define-values
(read-extension-prefix)
- (lambda (already_0 wanted_0 in_61 config_51)
+ (lambda (already_0 wanted_0 in_85 config_73)
(begin
- (let-values (((accum-str_11) (accum-string-init! config_51)))
+ (let-values (((accum-str_12) (accum-string-init! config_73)))
(begin
- (let-values (((lst_320) already_0))
+ (let-values (((lst_548) already_0))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_320)))
- ((letrec-values (((for-loop_294)
- (lambda (lst_321)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_548))
+ ((letrec-values (((for-loop_450)
+ (lambda (lst_549)
(begin
'for-loop
- (if (pair? lst_321)
- (let-values (((c_40) (unsafe-car lst_321)) ((rest_180) (unsafe-cdr lst_321)))
+ (if (pair? lst_549)
+ (let-values (((c_204) (unsafe-car lst_549)) ((rest_270) (unsafe-cdr lst_549)))
(let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (accum-string-add! accum-str_11 c_40))
- (values)))))
- (values)))))
- (if (not #f) (for-loop_294 rest_180) (values))))
+ (let-values ((()
+ (begin
+ (accum-string-add! accum-str_12 c_204)
+ (values))))
+ (values))))
+ (if (not #f) (for-loop_450 rest_270) (values))))
(values))))))
- for-loop_294)
- lst_320)))
+ for-loop_450)
+ lst_548)))
(void)
- ((letrec-values (((loop_125)
+ ((letrec-values (((loop_144)
(lambda (wanted_1)
(begin
'loop
(if (null? wanted_1)
(void)
- (let-values ()
- (let-values (((c_41)
- (let-values (((in_62) in_61)
- ((source_40) (read-config-source config_51)))
- (read-char-or-special in_62 special1.1 source_40))))
- (begin
- (if (char? c_41) (let-values () (accum-string-add! accum-str_11 c_41)) (void))
- (if (eqv? c_41 (car wanted_1))
- (void)
- (let-values ()
- (let-values (((in119_0) in_61)
- ((config120_0) config_51)
- ((temp121_0)
- (let-values (((accum-str123_0) accum-str_11)
- ((config124_0) config_51))
- (accum-string-get!.1 0 accum-str123_0 config124_0)))
- ((c122_0) c_41))
- (bad-syntax-error.1 c122_0 in119_0 config120_0 temp121_0))))
- (loop_125 (cdr wanted_1))))))))))
- loop_125)
+ (let-values (((c_205)
+ (let-values (((in_86) in_85)
+ ((source_46) (read-config-source config_73)))
+ (read-char-or-special in_86 special1.1 source_46))))
+ (begin
+ (if (char? c_205) (accum-string-add! accum-str_12 c_205) (void))
+ (if (eqv? c_205 (car wanted_1))
+ (void)
+ (let-values (((in119_0) in_85)
+ ((config120_0) config_73)
+ ((temp121_0)
+ (let-values (((accum-str123_0) accum-str_12)
+ ((config124_0) config_73))
+ (accum-string-get!.1 0 accum-str123_0 config124_0)))
+ ((c122_0) c_205))
+ (bad-syntax-error.1 c122_0 in119_0 config120_0 temp121_0)))
+ (loop_144 (cdr wanted_1)))))))))
+ loop_144)
wanted_0)
- (let-values (((accum-str117_0) accum-str_11) ((config118_0) config_51))
+ (let-values (((accum-str117_0) accum-str_12) ((config118_0) config_73))
(accum-string-get!.1 0 accum-str117_0 config118_0)))))))
(define-values
(read-extension.1)
@@ -65104,186 +63385,155 @@
(let-values (((try-first-mod-path_0) try-first-mod-path28_0))
(let-values (((mod-path-datum_0) mod-path-datum36_0))
(let-values (((read-recur_4) read-recur37_0))
- (let-values (((in_63) in38_1))
- (let-values (((config_52) config39_1))
+ (let-values (((in_87) in38_1))
+ (let-values (((config_74) config39_1))
(let-values (((mod-path-wrapped_1)
(if (eq? mod-path-wrapped29_0 unsafe-undefined)
- ((read-config-coerce config_52)
+ ((read-config-coerce config_74)
#t
mod-path-datum_0
- (let-values (((in125_0) in_63) ((config126_0) config_52))
+ (let-values (((in125_0) in_87) ((config126_0) config_74))
(port+config->srcloc.1 #f in125_0 config126_0)))
mod-path-wrapped29_0)))
(let-values (((get-info?_3) get-info?30_0))
- (let-values (((who_32) who31_0))
- (let-values ()
- (let-values ((() (begin (force-parameters! config_52) (values))))
- (let-values (((guard_0) (1/current-reader-guard)))
- (let-values (((mod-path_27)
- (let-values (((or-part_524)
- (if try-first-mod-path_0
- (let-values (((mod-path_28) (guard_0 try-first-mod-path_0)))
- (if ((read-config-module-declared? config_52)
- try-first-mod-path_0)
- mod-path_28
- #f))
- #f)))
- (if or-part_524 or-part_524 (guard_0 mod-path-datum_0)))))
- ((read-config-call-with-root-namespace config_52)
- (lambda ()
- (let-values (((for-syntax?_8) (read-config-for-syntax? config_52)))
- (let-values (((dynamic-require_3) (read-config-dynamic-require config_52)))
- (let-values (((no-value_0) (gensym)))
- (let-values (((extension_0)
- (if get-info?_3
- (let-values ()
- (dynamic-require_3
- mod-path_27
- 'get-info
- (lambda () no-value_0)))
- (let-values ()
- (dynamic-require_3
- mod-path_27
- (if for-syntax?_8 'read-syntax 'read))))))
- (if (eq? extension_0 no-value_0)
- (let-values () #f)
- (let-values ()
- (let-values (((result-v_1)
- (if (if for-syntax?_8 (not get-info?_3) #f)
- (let-values ()
- (if (procedure-arity-includes? extension_0 6)
- (let-values ()
- (with-continuation-mark
- current-read-config
- config_52
- (let-values ()
- (extension_0
- (read-config-source config_52)
- in_63
- mod-path-wrapped_1
- (read-config-line config_52)
- (read-config-col config_52)
- (read-config-pos config_52)))))
- (if (procedure-arity-includes? extension_0 2)
- (let-values ()
- (with-continuation-mark
- current-read-config
- config_52
- (let-values ()
- (extension_0
- (read-config-source config_52)
- in_63))))
- (let-values ()
- (raise-argument-error
- who_32
- "(or/c (procedure-arity-includes?/c 2) (procedure-arity-includes?/c 6))"
- extension_0)))))
- (let-values ()
- (if (procedure-arity-includes? extension_0 5)
- (let-values ()
- (with-continuation-mark
- current-read-config
- config_52
- (let-values ()
- (extension_0
- in_63
- mod-path-wrapped_1
- (read-config-line config_52)
- (read-config-col config_52)
- (read-config-pos config_52)))))
- (if get-info?_3
- (let-values ()
- (raise-argument-error
- who_32
- "(procedure-arity-includes?/c 5)"
- extension_0))
- (if (procedure-arity-includes? extension_0 1)
- (let-values ()
- (with-continuation-mark
- current-read-config
- config_52
- (let-values () (extension_0 in_63))))
- (let-values ()
- (raise-argument-error
- who_32
- "(or/c (procedure-arity-includes?/c 1) (procedure-arity-includes?/c 5))"
- extension_0)))))))))
- (if get-info?_3
- (let-values ()
- (begin
- (if (if (procedure? result-v_1)
- (procedure-arity-includes? result-v_1 2)
- #f)
- (void)
- (let-values ()
- (raise-result-error
- 'read-language
- "(procedure-arity-includes?/c 2)"
- result-v_1)))
- result-v_1))
- (if (1/special-comment? result-v_1)
- (let-values () (read-recur_4 #f in_63 config_52))
- (let-values ()
- (coerce result-v_1 in_63 config_52))))))))))))))))))))))))))))
+ (let-values (((who_46) who31_0))
+ (let-values ((() (begin (force-parameters! config_74) (values))))
+ (let-values (((guard_0) (1/current-reader-guard)))
+ (let-values (((mod-path_33)
+ (let-values (((or-part_872)
+ (if try-first-mod-path_0
+ (let-values (((mod-path_34) (guard_0 try-first-mod-path_0)))
+ (if ((read-config-module-declared? config_74)
+ try-first-mod-path_0)
+ mod-path_34
+ #f))
+ #f)))
+ (if or-part_872 or-part_872 (guard_0 mod-path-datum_0)))))
+ ((read-config-call-with-root-namespace config_74)
+ (lambda ()
+ (let-values (((for-syntax?_8) (read-config-for-syntax? config_74)))
+ (let-values (((dynamic-require_3) (read-config-dynamic-require config_74)))
+ (let-values (((no-value_0) (gensym)))
+ (let-values (((extension_0)
+ (if get-info?_3
+ (dynamic-require_3 mod-path_33 'get-info (lambda () no-value_0))
+ (dynamic-require_3
+ mod-path_33
+ (if for-syntax?_8 'read-syntax 'read)))))
+ (if (eq? extension_0 no-value_0)
+ #f
+ (let-values (((result-v_1)
+ (if (if for-syntax?_8 (not get-info?_3) #f)
+ (if (procedure-arity-includes? extension_0 6)
+ (with-continuation-mark
+ current-read-config
+ config_74
+ (extension_0
+ (read-config-source config_74)
+ in_87
+ mod-path-wrapped_1
+ (read-config-line config_74)
+ (read-config-col config_74)
+ (read-config-pos config_74)))
+ (if (procedure-arity-includes? extension_0 2)
+ (with-continuation-mark
+ current-read-config
+ config_74
+ (extension_0 (read-config-source config_74) in_87))
+ (raise-argument-error
+ who_46
+ "(or/c (procedure-arity-includes?/c 2) (procedure-arity-includes?/c 6))"
+ extension_0)))
+ (if (procedure-arity-includes? extension_0 5)
+ (with-continuation-mark
+ current-read-config
+ config_74
+ (extension_0
+ in_87
+ mod-path-wrapped_1
+ (read-config-line config_74)
+ (read-config-col config_74)
+ (read-config-pos config_74)))
+ (if get-info?_3
+ (raise-argument-error
+ who_46
+ "(procedure-arity-includes?/c 5)"
+ extension_0)
+ (if (procedure-arity-includes? extension_0 1)
+ (with-continuation-mark
+ current-read-config
+ config_74
+ (extension_0 in_87))
+ (raise-argument-error
+ who_46
+ "(or/c (procedure-arity-includes?/c 1) (procedure-arity-includes?/c 5))"
+ extension_0)))))))
+ (if get-info?_3
+ (begin
+ (if (if (procedure? result-v_1)
+ (procedure-arity-includes? result-v_1 2)
+ #f)
+ (void)
+ (raise-result-error
+ 'read-language
+ "(procedure-arity-includes?/c 2)"
+ result-v_1))
+ result-v_1)
+ (if (1/special-comment? result-v_1)
+ (read-recur_4 #f in_87 config_74)
+ (coerce result-v_1 in_87 config_74)))))))))))))))))))))))))
(define-values
(read-language/get-info)
- (lambda (read-one_4 in_3 config_7 fail-k_5)
+ (lambda (read-one_17 in_88 config_75 fail-k_8)
(begin
- (let-values (((c_39) (read-char/skip-whitespace-and-comments #f read-one_4 in_3 config_7)))
- (let-values (((line_9 col_8 pos_142) (port-next-location* in_3 c_39)))
+ (let-values (((c_206) (read-char/skip-whitespace-and-comments #f read-one_17 in_88 config_75)))
+ (let-values (((line_10 col_9 pos_185) (port-next-location* in_88 c_206)))
(let-values (((l-config_0)
- (override-parameter 1/read-accept-reader (reading-at config_7 line_9 col_8 pos_142) #t)))
- (if (not (eqv? c_39 '#\#))
- (let-values ()
- (if (special-comment-via-readtable? c_39 read-one_4 in_3 config_7)
- (let-values () (read-language/get-info read-one_4 in_3 config_7 fail-k_5))
- (let-values () (if fail-k_5 (fail-k_5) (lang-error in_3 l-config_0 "" c_39)))))
- (let-values ()
- (let-values (((c2_11)
- (let-values (((in_55) in_3) ((source_41) (read-config-source l-config_0)))
- (read-char-or-special in_55 special1.1 source_41))))
- (if (eqv? c2_11 '#\l)
- (let-values ()
- (let-values (((read-one1_0) read-one_4)
- ((c2_12) c_39)
- ((in3_2) in_3)
- ((l-config4_0) l-config_0)
- ((temp5_5) #t))
- (read-extension-lang.1 temp5_5 read-one1_0 c2_12 in3_2 l-config4_0)))
- (if (eqv? c2_11 '#\!)
- (let-values ()
- (let-values (((read-one6_0) read-one_4)
- ((c7_2) c_39)
- ((in8_2) in_3)
- ((l-config9_0) l-config_0)
- ((temp10_9) #t))
- (read-extension-#!.1 temp10_9 read-one6_0 c7_2 in8_2 l-config9_0)))
- (let-values ()
- (if fail-k_5 (fail-k_5) (lang-error in_3 l-config_0 (string c_39) c2_11))))))))))))))
+ (override-parameter 1/read-accept-reader (reading-at config_75 line_10 col_9 pos_185) #t)))
+ (if (not (eqv? c_206 '#\#))
+ (if (special-comment-via-readtable? c_206 read-one_17 in_88 config_75)
+ (read-language/get-info read-one_17 in_88 config_75 fail-k_8)
+ (if fail-k_8 (fail-k_8) (lang-error in_88 l-config_0 "" c_206)))
+ (let-values (((c2_8)
+ (let-values (((in_89) in_88) ((source_47) (read-config-source l-config_0)))
+ (read-char-or-special in_89 special1.1 source_47))))
+ (if (eqv? c2_8 '#\l)
+ (let-values (((read-one1_0) read-one_17)
+ ((c2_9) c_206)
+ ((in3_2) in_88)
+ ((l-config4_0) l-config_0)
+ ((temp5_11) #t))
+ (read-extension-lang.1 temp5_11 read-one1_0 c2_9 in3_2 l-config4_0))
+ (if (eqv? c2_8 '#\!)
+ (let-values (((read-one6_0) read-one_17)
+ ((c7_2) c_206)
+ ((in8_2) in_88)
+ ((l-config9_0) l-config_0)
+ ((temp10_9) #t))
+ (read-extension-#!.1 temp10_9 read-one6_0 c7_2 in8_2 l-config9_0))
+ (if fail-k_8 (fail-k_8) (lang-error in_88 l-config_0 (string c_206) c2_8))))))))))))
(define-values
(lang-error)
- (lambda (in_52 config_53 prefix_9 c_137)
+ (lambda (in_90 config_76 prefix_9 c_207)
(begin
(let-values (((add-prefix_0)
- (lambda (s_522)
+ (lambda (s_866)
(begin
'add-prefix
- (if (string=? prefix_9 "") (format "`~a` followed by ~a" prefix_9 s_522) s_522)))))
- (let-values (((in11_1) in_52)
- ((config12_2) config_53)
- ((c13_2) c_137)
+ (if (string=? prefix_9 "") (format "`~a` followed by ~a" prefix_9 s_866) s_866)))))
+ (let-values (((in11_1) in_90)
+ ((config12_2) config_76)
+ ((c13_2) c_207)
((temp14_8) 'read-language)
((temp15_9)
(string-append
"expected (after whitespace and comments) `#lang ` or `#!` followed"
" immediately by a language name, found ~a"))
- ((temp16_10)
- (if (eof-object? c_137)
- (let-values () (add-prefix_0 "end-of-file"))
- (if (not (char? c_137))
- (let-values () (add-prefix_0 "non-character"))
- (let-values () (format "`~a~a`" prefix_9 c_137))))))
- (reader-error.1 unsafe-undefined c13_2 #f temp14_8 in11_1 config12_2 temp15_9 (list temp16_10)))))))
+ ((temp16_11)
+ (if (eof-object? c_207)
+ (add-prefix_0 "end-of-file")
+ (if (not (char? c_207)) (add-prefix_0 "non-character") (format "`~a~a`" prefix_9 c_207)))))
+ (reader-error.1 unsafe-undefined c13_2 #f temp14_8 in11_1 config12_2 temp15_9 (list temp16_11)))))))
(define-values
(read.1)
(lambda (call-with-root-namespace10_1
@@ -65304,15 +63554,15 @@
in31_2)
(begin
'read
- (let-values (((in_64) in31_2))
+ (let-values (((in_91) in31_2))
(let-values (((wrap_9) wrap1_0))
- (let-values (((init-c_17) init-c2_0))
- (let-values (((next-readtable_0)
+ (let-values (((init-c_20) init-c2_0))
+ (let-values (((next-readtable_3)
(if (eq? next-readtable3_0 unsafe-undefined) (1/current-readtable) next-readtable3_0)))
- (let-values (((readtable_3) (if (eq? readtable4_0 unsafe-undefined) next-readtable_0 readtable4_0)))
+ (let-values (((readtable_3) (if (eq? readtable4_0 unsafe-undefined) next-readtable_3 readtable4_0)))
(let-values (((recursive?_0) recursive?5_0))
(let-values (((local-graph?_1) local-graph?6_0))
- (let-values (((source_42) source7_0))
+ (let-values (((source_48) source7_0))
(let-values (((for-syntax?_9) for-syntax?8_0))
(let-values (((read-compiled_2) read-compiled9_1))
(let-values (((call-with-root-namespace_2) call-with-root-namespace10_1))
@@ -65324,73 +63574,71 @@
(if (eq? keep-comment?15_1 unsafe-undefined)
recursive?_0
keep-comment?15_1)))
- (let-values ()
- (let-values (((config_54)
- (let-values (((c1_36) (if recursive?_0 (current-read-config) #f)))
- (if c1_36
- ((lambda (config_55)
- (let-values (((config52_1) config_55)
- ((for-syntax?53_0) for-syntax?_9)
- ((wrap54_0) wrap_9)
- ((readtable55_1) readtable_3)
- ((next-readtable56_1) next-readtable_0)
- ((local-graph?57_0) local-graph?_1)
- ((keep-comment?58_0) keep-comment?_3))
- (read-config-update.1
- for-syntax?53_0
- keep-comment?58_0
- next-readtable56_1
- readtable55_1
- local-graph?57_0
- wrap54_0
- config52_1)))
- c1_36)
- (let-values ()
- (let-values (((readtable59_0) readtable_3)
- ((next-readtable60_0) next-readtable_0)
- ((source61_0) source_42)
- ((for-syntax?62_0) for-syntax?_9)
- ((wrap63_0) wrap_9)
- ((read-compiled64_0) read-compiled_2)
- ((call-with-root-namespace65_0)
- call-with-root-namespace_2)
- ((dynamic-require66_0) dynamic-require_4)
- ((module-declared?67_0) module-declared?_2)
- ((coerce68_0) coerce_2)
- ((coerce-key69_0) coerce-key_2)
- ((keep-comment?70_0) keep-comment?_3))
- (make-read-config.1
- call-with-root-namespace65_0
- coerce68_0
- coerce-key69_0
- dynamic-require66_0
- for-syntax?62_0
- keep-comment?70_0
- module-declared?67_0
- next-readtable60_0
- read-compiled64_0
- readtable59_0
- source61_0
- wrap63_0)))))))
- (let-values (((v_77) (read-one init-c_17 in_64 config_54)))
- (if (if (let-values (((or-part_38) (not recursive?_0)))
- (if or-part_38 or-part_38 local-graph?_1))
- (read-config-state-graph (read-config-st config_54))
- #f)
- (let-values ()
- (catch-and-reraise-as-reader/proc
- #f
- config_54
- (lambda () (make-reader-graph v_77))))
- (if (if recursive?_0
- (if (not local-graph?_1)
- (if (not for-syntax?_9)
- (if (not (eof-object? v_77)) (not (1/special-comment? v_77)) #f)
- #f)
+ (let-values (((config_77)
+ (let-values (((cond-val_27)
+ (if recursive?_0 (current-read-config) #f)))
+ (if cond-val_27
+ ((lambda (config_78)
+ (let-values (((config52_1) config_78)
+ ((for-syntax?53_0) for-syntax?_9)
+ ((wrap54_0) wrap_9)
+ ((readtable55_1) readtable_3)
+ ((next-readtable56_1) next-readtable_3)
+ ((local-graph?57_0) local-graph?_1)
+ ((keep-comment?58_0) keep-comment?_3))
+ (read-config-update.1
+ for-syntax?53_0
+ keep-comment?58_0
+ next-readtable56_1
+ readtable55_1
+ local-graph?57_0
+ wrap54_0
+ config52_1)))
+ cond-val_27)
+ (let-values (((readtable59_0) readtable_3)
+ ((next-readtable60_0) next-readtable_3)
+ ((source61_0) source_48)
+ ((for-syntax?62_0) for-syntax?_9)
+ ((wrap63_0) wrap_9)
+ ((read-compiled64_0) read-compiled_2)
+ ((call-with-root-namespace65_0)
+ call-with-root-namespace_2)
+ ((dynamic-require66_0) dynamic-require_4)
+ ((module-declared?67_0) module-declared?_2)
+ ((coerce68_0) coerce_2)
+ ((coerce-key69_0) coerce-key_2)
+ ((keep-comment?70_0) keep-comment?_3))
+ (make-read-config.1
+ call-with-root-namespace65_0
+ coerce68_0
+ coerce-key69_0
+ dynamic-require66_0
+ for-syntax?62_0
+ keep-comment?70_0
+ module-declared?67_0
+ next-readtable60_0
+ read-compiled64_0
+ readtable59_0
+ source61_0
+ wrap63_0))))))
+ (let-values (((v_398) (read-one init-c_20 in_91 config_77)))
+ (if (if (let-values (((or-part_873) (not recursive?_0)))
+ (if or-part_873 or-part_873 local-graph?_1))
+ (read-config-state-graph (read-config-st config_77))
+ #f)
+ (catch-and-reraise-as-reader/proc
+ #f
+ config_77
+ (lambda () (make-reader-graph v_398)))
+ (if (if recursive?_0
+ (if (not local-graph?_1)
+ (if (not for-syntax?_9)
+ (if (not (eof-object? v_398)) (not (1/special-comment? v_398)) #f)
#f)
#f)
- (let-values () (begin (get-graph-hash config_54) v_77))
- (let-values () v_77)))))))))))))))))))))))))
+ #f)
+ (begin (get-graph-hash config_77) v_398)
+ v_398)))))))))))))))))))))))
(define-values
(read-language.1)
(lambda (call-with-root-namespace37_0
@@ -65405,8 +63653,8 @@
fail-k50_0)
(begin
'read-language
- (let-values (((in_65) in49_0))
- (let-values (((fail-k_6) fail-k50_0))
+ (let-values (((in_92) in49_0))
+ (let-values (((fail-k_9) fail-k50_0))
(let-values (((for-syntax?_10) for-syntax?33_0))
(let-values (((wrap_10) wrap34_0))
(let-values (((read-compiled_3) read-compiled35_0))
@@ -65415,1129 +63663,981 @@
(let-values (((module-declared?_3) module-declared?38_0))
(let-values (((coerce_3) coerce39_0))
(let-values (((coerce-key_3) coerce-key40_0))
- (let-values ()
- (let-values (((config_56)
- (let-values (((temp71_3) #f)
- ((temp72_3) #f)
- ((for-syntax?73_0) for-syntax?_10)
- ((wrap74_0) wrap_10)
- ((read-compiled75_0) read-compiled_3)
- ((call-with-root-namespace76_0) call-with-root-namespace_3)
- ((dynamic-require77_0) dynamic-require_5)
- ((module-declared?78_0) module-declared?_3)
- ((coerce79_0) coerce_3)
- ((coerce-key80_0) coerce-key_3))
- (make-read-config.1
- call-with-root-namespace76_0
- coerce79_0
- coerce-key80_0
- dynamic-require77_0
- for-syntax?73_0
- #f
- module-declared?78_0
- temp72_3
- read-compiled75_0
- temp71_3
- #f
- wrap74_0))))
- (let-values (((l-config_1) (override-parameter 1/read-accept-reader config_56 #f)))
- (read-language/get-info read-undotted in_65 config_56 fail-k_6)))))))))))))))))
+ (let-values (((config_79)
+ (let-values (((temp71_4) #f)
+ ((temp72_3) #f)
+ ((for-syntax?73_0) for-syntax?_10)
+ ((wrap74_0) wrap_10)
+ ((read-compiled75_0) read-compiled_3)
+ ((call-with-root-namespace76_0) call-with-root-namespace_3)
+ ((dynamic-require77_0) dynamic-require_5)
+ ((module-declared?78_0) module-declared?_3)
+ ((coerce79_0) coerce_3)
+ ((coerce-key80_0) coerce-key_3))
+ (make-read-config.1
+ call-with-root-namespace76_0
+ coerce79_0
+ coerce-key80_0
+ dynamic-require77_0
+ for-syntax?73_0
+ #f
+ module-declared?78_0
+ temp72_3
+ read-compiled75_0
+ temp71_4
+ #f
+ wrap74_0))))
+ (let-values (((l-config_1) (override-parameter 1/read-accept-reader config_79 #f)))
+ (read-language/get-info read-undotted in_92 config_79 fail-k_9))))))))))))))))
(define-values
(read-one)
- (lambda (init-c_18 in_66 config_57)
- (begin
- (if (not (check-parameter 1/read-cdot config_57))
- (let-values () (read-undotted init-c_18 in_66 config_57))
- (if (check-parameter 1/read-cdot config_57)
- (let-values ()
- (let-values (((line_10 col_9 pos_143) (port-next-location in_66)))
- (let-values (((v_69) (read-undotted init-c_18 in_66 config_57)))
- (if (1/special-comment? v_69)
- (let-values () v_69)
- (let-values ()
- ((letrec-values (((loop_64)
- (lambda (v_262)
- (begin
- 'loop
- (let-values (((c_42)
- (let-values (((in_67) in_66)
- ((skip-count_15) 0)
- ((source_43) (read-config-source config_57)))
- (let-values (((c_138)
- (peek-char-or-special
- in_67
- skip-count_15
- 'special
- source_43)))
- (if (eq? c_138 'special) (special1.1 'special) c_138)))))
- (let-values (((ec_11) (effective-char c_42 config_57)))
- (if (not (char? ec_11))
- (let-values () v_262)
- (if (char-whitespace? ec_11)
- (let-values () (begin (consume-char in_66 c_42) (loop_64 v_262)))
- (if (char=? ec_11 '#\.)
- (let-values ()
- (let-values (((dot-line_2 dot-col_2 dot-pos_2)
- (port-next-location in_66)))
- (let-values ((() (begin (consume-char in_66 c_42) (values))))
- (let-values (((pos-config_0)
- (reading-at
- config_57
- dot-line_2
- dot-col_2
- dot-pos_2)))
- (let-values (((cdot_0)
- (wrap '#%dot in_66 pos-config_0 '#\.)))
- (let-values (((post-v_0)
- (read-undotted #f in_66 config_57)))
- (begin
- (if (eof-object? post-v_0)
- (let-values ()
- (let-values (((in81_0) in_66)
- ((pos-config82_0) pos-config_0)
- ((eof83_0) eof)
- ((temp84_1)
- "expected a datum after cdot, found end-of-file"))
- (reader-error.1
- unsafe-undefined
- eof83_0
- #f
- unsafe-undefined
- in81_0
- pos-config82_0
- temp84_1
- (list))))
- (void))
- (loop_64
- (wrap
- (list cdot_0 v_262 post-v_0)
- in_66
- (reading-at config_57 line_10 col_9 pos_143)
- '#\.)))))))))
- (let-values () v_262))))))))))
- loop_64)
- v_69))))))
+ (lambda (init-c_21 in_93 config_80)
+ (begin
+ (if (not (check-parameter 1/read-cdot config_80))
+ (read-undotted init-c_21 in_93 config_80)
+ (if (check-parameter 1/read-cdot config_80)
+ (let-values (((line_11 col_10 pos_186) (port-next-location in_93)))
+ (let-values (((v_399) (read-undotted init-c_21 in_93 config_80)))
+ (if (1/special-comment? v_399)
+ v_399
+ ((letrec-values (((loop_145)
+ (lambda (v_400)
+ (begin
+ 'loop
+ (let-values (((c_208)
+ (let-values (((in_94) in_93)
+ ((skip-count_16) 0)
+ ((source_49) (read-config-source config_80)))
+ (let-values (((c_209)
+ (peek-char-or-special
+ in_94
+ skip-count_16
+ 'special
+ source_49)))
+ (if (eq? c_209 'special) (special1.1 'special) c_209)))))
+ (let-values (((ec_11) (effective-char c_208 config_80)))
+ (if (not (char? ec_11))
+ v_400
+ (if (char-whitespace? ec_11)
+ (begin (consume-char in_93 c_208) (loop_145 v_400))
+ (if (char=? ec_11 '#\.)
+ (let-values (((dot-line_2 dot-col_2 dot-pos_2)
+ (port-next-location in_93)))
+ (let-values ((() (begin (consume-char in_93 c_208) (values))))
+ (let-values (((pos-config_0)
+ (reading-at
+ config_80
+ dot-line_2
+ dot-col_2
+ dot-pos_2)))
+ (let-values (((cdot_0) (wrap '#%dot in_93 pos-config_0 '#\.)))
+ (let-values (((post-v_0) (read-undotted #f in_93 config_80)))
+ (begin
+ (if (eof-object? post-v_0)
+ (let-values (((in81_0) in_93)
+ ((pos-config82_0) pos-config_0)
+ ((eof83_0) eof)
+ ((temp84_2)
+ "expected a datum after cdot, found end-of-file"))
+ (reader-error.1
+ unsafe-undefined
+ eof83_0
+ #f
+ unsafe-undefined
+ in81_0
+ pos-config82_0
+ temp84_2
+ (list)))
+ (void))
+ (loop_145
+ (wrap
+ (list cdot_0 v_400 post-v_0)
+ in_93
+ (reading-at config_80 line_11 col_10 pos_186)
+ '#\.))))))))
+ v_400)))))))))
+ loop_145)
+ v_399))))
(void))))))
(define-values
(read-undotted)
- (lambda (init-c_19 in_68 config_58)
- (begin
- (let-values (((c_139) (read-char/skip-whitespace-and-comments init-c_19 read-one in_68 config_58)))
- (let-values (((line_11 col_10 pos_144) (port-next-location* in_68 c_139)))
- (if (eof-object? c_139)
- (let-values () eof)
- (if (not (char? c_139))
- (let-values ()
- (let-values (((v_263) (special-value c_139)))
- (if (1/special-comment? v_263)
- (let-values () (if (read-config-keep-comment? config_58) v_263 (read-undotted #f in_68 config_58)))
- (let-values () (coerce v_263 in_68 (reading-at config_58 line_11 col_10 pos_144))))))
- (let-values (((c2_13) (readtable-handler config_58 c_139)))
- (if c2_13
+ (lambda (init-c_22 in_95 config_81)
+ (begin
+ (let-values (((c_210) (read-char/skip-whitespace-and-comments init-c_22 read-one in_95 config_81)))
+ (let-values (((line_12 col_11 pos_187) (port-next-location* in_95 c_210)))
+ (if (eof-object? c_210)
+ eof
+ (if (not (char? c_210))
+ (let-values (((v_401) (special-value c_210)))
+ (if (1/special-comment? v_401)
+ (if (read-config-keep-comment? config_81) v_401 (read-undotted #f in_95 config_81))
+ (coerce v_401 in_95 (reading-at config_81 line_12 col_11 pos_187))))
+ (let-values (((cond-val_28) (readtable-handler config_81 c_210)))
+ (if cond-val_28
((lambda (handler_9)
- (let-values (((v_264) (readtable-apply handler_9 c_139 in_68 config_58 line_11 col_10 pos_144)))
- (retry-special-comment v_264 in_68 config_58)))
- c2_13)
- (let-values ()
- (let-values (((ec_12) (effective-char c_139 config_58)))
- (let-values ((()
- (begin
- (if (not (char-closer? ec_12 config_58))
- (let-values () (track-indentation! config_58 line_11 col_10))
- (void))
- (values))))
- (let-values (((r-config_0) (reading-at (discard-comment config_58) line_11 col_10 pos_144)))
- (let-values (((tmp_75) ec_12))
- (let-values (((index_6)
- (if (char? tmp_75)
- (let-values (((codepoint_2) (char->integer tmp_75)))
- (if (if (unsafe-fx>= codepoint_2 34) (unsafe-fx< codepoint_2 126) #f)
- (if (unsafe-fx< codepoint_2 91)
- (if (unsafe-fx< codepoint_2 40)
- (let-values (((tbl_3) '#(11 1 0 0 0 2)))
- (unsafe-vector*-ref tbl_3 (unsafe-fx- codepoint_2 34)))
- (if (unsafe-fx< codepoint_2 42)
- (let-values (((tbl_4) '#(5 6)))
- (unsafe-vector*-ref tbl_4 (unsafe-fx- codepoint_2 40)))
- (if (unsafe-fx< codepoint_2 44)
- 0
- (if (unsafe-fx< codepoint_2 45) 4 0))))
- (let-values (((tbl_5)
- '#(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_5 (unsafe-fx- codepoint_2 91))))
- 0))
- 0)))
- (if (unsafe-fx< index_6 6)
- (if (unsafe-fx< index_6 2)
- (if (unsafe-fx< index_6 1)
- (let-values ()
- (let-values (((v_265)
- (let-values (((c85_0) c_139)
- ((in86_0) in_68)
- ((r-config87_0) r-config_0)
- ((temp88_0)
- (if (let-values (((or-part_297) (eq? c_139 ec_12)))
- (if or-part_297
- or-part_297
- (if (< (char->integer ec_12) 128)
- (char-numeric? ec_12)
- #f)))
- 'symbol-or-number
- 'symbol/indirect)))
- (read-symbol-or-number.1 #f temp88_0 c85_0 in86_0 r-config87_0))))
- (retry-special-comment v_265 in_68 config_58)))
- (let-values () (read-dispatch c_139 in_68 r-config_0 config_58)))
- (if (unsafe-fx< index_6 3)
- (let-values () (read-quote read-one 'quote "quoting \"'\"" c_139 in_68 r-config_0))
- (if (unsafe-fx< index_6 4)
- (let-values ()
- (if (check-parameter 1/read-accept-quasiquote config_58)
- (let-values ()
- (read-quote
- read-one
- 'quasiquote
- "quasiquoting \"`\""
- c_139
- in_68
- r-config_0))
- (let-values ()
- (let-values (((in89_0) in_68)
- ((r-config90_0) r-config_0)
- ((temp91_2) "illegal use of `~a`")
- ((c92_0) c_139))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in89_0
- r-config90_0
- temp91_2
- (list c92_0))))))
- (if (unsafe-fx< index_6 5)
- (let-values ()
- (if (check-parameter 1/read-accept-quasiquote config_58)
- (let-values ()
- (let-values (((c2_14)
- (let-values (((in_69) in_68)
- ((skip-count_16) 0)
- ((source_44) (read-config-source config_58)))
- (let-values (((c_140)
- (peek-char-or-special
- in_69
- skip-count_16
- 'special
- source_44)))
- (if (eq? c_140 'special)
- (special1.1 'special)
- c_140)))))
- (if (eqv? c2_14 '#\@)
- (begin
- (consume-char in_68 c2_14)
- (read-quote
- read-one
- 'unquote-splicing
- "unquoting `,@`"
- c_139
- in_68
- r-config_0))
- (read-quote
- read-one
- 'unquote
- "unquoting `,`"
- c_139
- in_68
- r-config_0))))
- (let-values ()
- (let-values (((in93_1) in_68)
- ((r-config94_0) r-config_0)
- ((temp95_2) "illegal use of `~a`")
- ((c96_0) c_139))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in93_1
- r-config94_0
- temp95_2
- (list c96_0))))))
- (let-values ()
- (wrap
- (let-values (((read-one97_0) read-one)
- ((ec98_0) ec_12)
- ((temp99_1) '#\()
- ((temp100_1) '#\))
- ((in101_0) in_68)
- ((r-config102_0) r-config_0)
- ((temp103_3) #t))
- (read-unwrapped-sequence.1
- 'all
- unsafe-undefined
- unsafe-undefined
- temp103_3
- unsafe-undefined
- read-one97_0
- ec98_0
- temp99_1
- temp100_1
- in101_0
- r-config102_0))
- in_68
- r-config_0
- ec_12))))))
- (if (unsafe-fx< index_6 9)
- (if (unsafe-fx< index_6 7)
- (let-values ()
- (let-values (((in104_1) in_68)
- ((r-config105_0) r-config_0)
- ((temp106_1) "~a")
- ((temp107_1)
- (indentation-unexpected-closer-message ec_12 c_139 r-config_0)))
+ (let-values (((v_402) (readtable-apply handler_9 c_210 in_95 config_81 line_12 col_11 pos_187)))
+ (retry-special-comment v_402 in_95 config_81)))
+ cond-val_28)
+ (let-values (((ec_12) (effective-char c_210 config_81)))
+ (let-values ((()
+ (begin
+ (if (not (char-closer? ec_12 config_81))
+ (track-indentation! config_81 line_12 col_11)
+ (void))
+ (values))))
+ (let-values (((r-config_0) (reading-at (discard-comment config_81) line_12 col_11 pos_187)))
+ (let-values (((tmp_79) ec_12))
+ (let-values (((index_6)
+ (if (char? tmp_79)
+ (let-values (((codepoint_2) (char->integer tmp_79)))
+ (if (if (unsafe-fx>= codepoint_2 34) (unsafe-fx< codepoint_2 126) #f)
+ (if (unsafe-fx< codepoint_2 91)
+ (if (unsafe-fx< codepoint_2 40)
+ (let-values (((tbl_3) '#(11 1 0 0 0 2)))
+ (unsafe-vector*-ref tbl_3 (unsafe-fx- codepoint_2 34)))
+ (if (unsafe-fx< codepoint_2 42)
+ (let-values (((tbl_4) '#(5 6)))
+ (unsafe-vector*-ref tbl_4 (unsafe-fx- codepoint_2 40)))
+ (if (unsafe-fx< codepoint_2 44)
+ 0
+ (if (unsafe-fx< codepoint_2 45) 4 0))))
+ (let-values (((tbl_5)
+ '#(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_5 (unsafe-fx- codepoint_2 91))))
+ 0))
+ 0)))
+ (if (unsafe-fx< index_6 6)
+ (if (unsafe-fx< index_6 2)
+ (if (unsafe-fx< index_6 1)
+ (let-values (((v_403)
+ (let-values (((c85_0) c_210)
+ ((in86_0) in_95)
+ ((r-config87_0) r-config_0)
+ ((temp88_3)
+ (if (let-values (((or-part_874) (eq? c_210 ec_12)))
+ (if or-part_874
+ or-part_874
+ (if (< (char->integer ec_12) 128)
+ (char-numeric? ec_12)
+ #f)))
+ 'symbol-or-number
+ 'symbol/indirect)))
+ (read-symbol-or-number.1 #f temp88_3 c85_0 in86_0 r-config87_0))))
+ (retry-special-comment v_403 in_95 config_81))
+ (read-dispatch c_210 in_95 r-config_0 config_81))
+ (if (unsafe-fx< index_6 3)
+ (read-quote read-one 'quote "quoting \"'\"" c_210 in_95 r-config_0)
+ (if (unsafe-fx< index_6 4)
+ (if (check-parameter 1/read-accept-quasiquote config_81)
+ (read-quote read-one 'quasiquote "quasiquoting \"`\"" c_210 in_95 r-config_0)
+ (let-values (((in89_0) in_95)
+ ((r-config90_0) r-config_0)
+ ((temp91_3) "illegal use of `~a`")
+ ((c92_0) c_210))
(reader-error.1
unsafe-undefined
'#\x
#f
unsafe-undefined
- in104_1
- r-config105_0
- temp106_1
- (list temp107_1))))
- (if (unsafe-fx< index_6 8)
- (let-values ()
- (if (let-values (((or-part_525)
- (check-parameter 1/read-square-bracket-as-paren config_58)))
- (if or-part_525
- or-part_525
- (check-parameter 1/read-square-bracket-with-tag config_58)))
- (let-values ()
- (wrap
- (let-values (((read-one108_0) read-one)
- ((ec109_0) ec_12)
- ((temp110_4) '#\[)
- ((temp111_4) '#\])
- ((in112_0) in_68)
- ((r-config113_0) r-config_0)
- ((temp114_2) #t))
- (read-unwrapped-sequence.1
- 'all
- unsafe-undefined
- unsafe-undefined
- temp114_2
- unsafe-undefined
- read-one108_0
- ec109_0
- temp110_4
- temp111_4
- in112_0
- r-config113_0))
- in_68
- r-config_0
- ec_12))
- (let-values ()
- (let-values (((in115_0) in_68)
- ((r-config116_0) r-config_0)
- ((temp117_4) "illegal use of `~a`")
- ((c118_0) c_139))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in115_0
- r-config116_0
- temp117_4
- (list c118_0))))))
- (let-values ()
- (if (let-values (((or-part_526)
- (check-parameter 1/read-square-bracket-as-paren config_58)))
- (if or-part_526
- or-part_526
- (check-parameter 1/read-square-bracket-with-tag config_58)))
- (let-values ()
- (let-values (((in119_1) in_68)
- ((r-config120_0) r-config_0)
- ((temp121_1) "~a")
- ((temp122_1)
- (indentation-unexpected-closer-message
- ec_12
- c_139
- r-config_0)))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in119_1
- r-config120_0
- temp121_1
- (list temp122_1))))
- (let-values ()
- (let-values (((in123_0) in_68)
- ((r-config124_0) r-config_0)
- ((temp125_1) "illegal use of `~a`")
- ((c126_0) c_139))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in123_0
- r-config124_0
- temp125_1
- (list c126_0))))))))
- (if (unsafe-fx< index_6 10)
- (let-values ()
- (if (let-values (((or-part_527)
- (check-parameter 1/read-curly-brace-as-paren config_58)))
- (if or-part_527
- or-part_527
- (check-parameter 1/read-curly-brace-with-tag config_58)))
- (let-values ()
- (wrap
- (let-values (((read-one127_0) read-one)
- ((ec128_0) ec_12)
- ((temp129_3) '#\{)
- ((temp130_1) '#\})
- ((in131_0) in_68)
- ((r-config132_0) r-config_0)
- ((temp133_3) #t))
- (read-unwrapped-sequence.1
- 'all
- unsafe-undefined
- unsafe-undefined
- temp133_3
- unsafe-undefined
- read-one127_0
- ec128_0
- temp129_3
- temp130_1
- in131_0
- r-config132_0))
- in_68
- r-config_0
- ec_12))
- (let-values ()
- (let-values (((in134_0) in_68)
- ((r-config135_0) r-config_0)
- ((temp136_5) "illegal use of `~a`")
- ((c137_0) c_139))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in134_0
- r-config135_0
- temp136_5
- (list c137_0))))))
- (if (unsafe-fx< index_6 11)
- (let-values ()
- (if (let-values (((or-part_330)
- (check-parameter 1/read-curly-brace-as-paren config_58)))
- (if or-part_330
- or-part_330
- (check-parameter 1/read-curly-brace-with-tag config_58)))
- (let-values ()
- (let-values (((in138_0) in_68)
- ((r-config139_0) r-config_0)
- ((temp140_0) "~a")
- ((temp141_2)
- (indentation-unexpected-closer-message
- ec_12
- c_139
- r-config_0)))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in138_0
- r-config139_0
- temp140_0
- (list temp141_2))))
- (let-values ()
- (let-values (((in142_0) in_68)
- ((r-config143_0) r-config_0)
- ((temp144_2) "illegal use of `~a`")
- ((c145_0) c_139))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in142_0
- r-config143_0
- temp144_2
- (list c145_0))))))
- (if (unsafe-fx< index_6 12)
- (let-values ()
- (let-values (((in146_0) in_68) ((r-config147_0) r-config_0))
- (read-string.1 'string in146_0 r-config147_0)))
- (let-values ()
- (let-values (((c148_0) c_139)
- ((in149_0) in_68)
- ((r-config150_0) r-config_0)
- ((temp151_1) 'symbol))
- (read-symbol-or-number.1
- #f
- temp151_1
- c148_0
- in149_0
- r-config150_0)))))))))))))))))))))))
+ in89_0
+ r-config90_0
+ temp91_3
+ (list c92_0))))
+ (if (unsafe-fx< index_6 5)
+ (if (check-parameter 1/read-accept-quasiquote config_81)
+ (let-values (((c2_10)
+ (let-values (((in_96) in_95)
+ ((skip-count_17) 0)
+ ((source_50) (read-config-source config_81)))
+ (let-values (((c_211)
+ (peek-char-or-special
+ in_96
+ skip-count_17
+ 'special
+ source_50)))
+ (if (eq? c_211 'special) (special1.1 'special) c_211)))))
+ (if (eqv? c2_10 '#\@)
+ (begin
+ (consume-char in_95 c2_10)
+ (read-quote
+ read-one
+ 'unquote-splicing
+ "unquoting `,@`"
+ c_210
+ in_95
+ r-config_0))
+ (read-quote read-one 'unquote "unquoting `,`" c_210 in_95 r-config_0)))
+ (let-values (((in93_1) in_95)
+ ((r-config94_0) r-config_0)
+ ((temp95_1) "illegal use of `~a`")
+ ((c96_0) c_210))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in93_1
+ r-config94_0
+ temp95_1
+ (list c96_0))))
+ (wrap
+ (let-values (((read-one97_0) read-one)
+ ((ec98_0) ec_12)
+ ((temp99_1) '#\()
+ ((temp100_1) '#\))
+ ((in101_0) in_95)
+ ((r-config102_0) r-config_0)
+ ((temp103_4) #t))
+ (read-unwrapped-sequence.1
+ 'all
+ unsafe-undefined
+ unsafe-undefined
+ temp103_4
+ unsafe-undefined
+ read-one97_0
+ ec98_0
+ temp99_1
+ temp100_1
+ in101_0
+ r-config102_0))
+ in_95
+ r-config_0
+ ec_12)))))
+ (if (unsafe-fx< index_6 9)
+ (if (unsafe-fx< index_6 7)
+ (let-values (((in104_1) in_95)
+ ((r-config105_0) r-config_0)
+ ((temp106_1) "~a")
+ ((temp107_1)
+ (indentation-unexpected-closer-message ec_12 c_210 r-config_0)))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in104_1
+ r-config105_0
+ temp106_1
+ (list temp107_1)))
+ (if (unsafe-fx< index_6 8)
+ (if (let-values (((or-part_875)
+ (check-parameter 1/read-square-bracket-as-paren config_81)))
+ (if or-part_875
+ or-part_875
+ (check-parameter 1/read-square-bracket-with-tag config_81)))
+ (wrap
+ (let-values (((read-one108_0) read-one)
+ ((ec109_0) ec_12)
+ ((temp110_2) '#\[)
+ ((temp111_3) '#\])
+ ((in112_0) in_95)
+ ((r-config113_0) r-config_0)
+ ((temp114_3) #t))
+ (read-unwrapped-sequence.1
+ 'all
+ unsafe-undefined
+ unsafe-undefined
+ temp114_3
+ unsafe-undefined
+ read-one108_0
+ ec109_0
+ temp110_2
+ temp111_3
+ in112_0
+ r-config113_0))
+ in_95
+ r-config_0
+ ec_12)
+ (let-values (((in115_0) in_95)
+ ((r-config116_0) r-config_0)
+ ((temp117_2) "illegal use of `~a`")
+ ((c118_0) c_210))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in115_0
+ r-config116_0
+ temp117_2
+ (list c118_0))))
+ (if (let-values (((or-part_876)
+ (check-parameter 1/read-square-bracket-as-paren config_81)))
+ (if or-part_876
+ or-part_876
+ (check-parameter 1/read-square-bracket-with-tag config_81)))
+ (let-values (((in119_1) in_95)
+ ((r-config120_0) r-config_0)
+ ((temp121_1) "~a")
+ ((temp122_0)
+ (indentation-unexpected-closer-message ec_12 c_210 r-config_0)))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in119_1
+ r-config120_0
+ temp121_1
+ (list temp122_0)))
+ (let-values (((in123_0) in_95)
+ ((r-config124_0) r-config_0)
+ ((temp125_2) "illegal use of `~a`")
+ ((c126_0) c_210))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in123_0
+ r-config124_0
+ temp125_2
+ (list c126_0))))))
+ (if (unsafe-fx< index_6 10)
+ (if (let-values (((or-part_877)
+ (check-parameter 1/read-curly-brace-as-paren config_81)))
+ (if or-part_877
+ or-part_877
+ (check-parameter 1/read-curly-brace-with-tag config_81)))
+ (wrap
+ (let-values (((read-one127_0) read-one)
+ ((ec128_0) ec_12)
+ ((temp129_2) '#\{)
+ ((temp130_1) '#\})
+ ((in131_0) in_95)
+ ((r-config132_0) r-config_0)
+ ((temp133_3) #t))
+ (read-unwrapped-sequence.1
+ 'all
+ unsafe-undefined
+ unsafe-undefined
+ temp133_3
+ unsafe-undefined
+ read-one127_0
+ ec128_0
+ temp129_2
+ temp130_1
+ in131_0
+ r-config132_0))
+ in_95
+ r-config_0
+ ec_12)
+ (let-values (((in134_0) in_95)
+ ((r-config135_0) r-config_0)
+ ((temp136_5) "illegal use of `~a`")
+ ((c137_0) c_210))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in134_0
+ r-config135_0
+ temp136_5
+ (list c137_0))))
+ (if (unsafe-fx< index_6 11)
+ (if (let-values (((or-part_878)
+ (check-parameter 1/read-curly-brace-as-paren config_81)))
+ (if or-part_878
+ or-part_878
+ (check-parameter 1/read-curly-brace-with-tag config_81)))
+ (let-values (((in138_0) in_95)
+ ((r-config139_0) r-config_0)
+ ((temp140_2) "~a")
+ ((temp141_2)
+ (indentation-unexpected-closer-message ec_12 c_210 r-config_0)))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in138_0
+ r-config139_0
+ temp140_2
+ (list temp141_2)))
+ (let-values (((in142_0) in_95)
+ ((r-config143_0) r-config_0)
+ ((temp144_2) "illegal use of `~a`")
+ ((c145_0) c_210))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in142_0
+ r-config143_0
+ temp144_2
+ (list c145_0))))
+ (if (unsafe-fx< index_6 12)
+ (let-values (((in146_0) in_95) ((r-config147_0) r-config_0))
+ (read-string.1 'string in146_0 r-config147_0))
+ (let-values (((c148_0) c_210)
+ ((in149_0) in_95)
+ ((r-config150_0) r-config_0)
+ ((temp151_1) 'symbol))
+ (read-symbol-or-number.1
+ #f
+ temp151_1
+ c148_0
+ in149_0
+ r-config150_0)))))))))))))))))))))
(define-values
(read-dispatch)
- (lambda (dispatch-c_5 in_70 config_59 orig-config_1)
- (begin
- (let-values (((c_141)
- (let-values (((in_71) in_70) ((source_45) (read-config-source config_59)))
- (read-char-or-special in_71 special1.1 source_45))))
- (if (eof-object? c_141)
- (let-values ()
- (let-values (((in152_0) in_70)
- ((config153_0) config_59)
- ((c154_0) c_141)
- ((temp155_2) "bad syntax `~a`")
- ((dispatch-c156_0) dispatch-c_5))
+ (lambda (dispatch-c_8 in_97 config_82 orig-config_1)
+ (begin
+ (let-values (((c_212)
+ (let-values (((in_98) in_97) ((source_51) (read-config-source config_82)))
+ (read-char-or-special in_98 special1.1 source_51))))
+ (if (eof-object? c_212)
+ (let-values (((in152_0) in_97)
+ ((config153_0) config_82)
+ ((c154_0) c_212)
+ ((temp155_0) "bad syntax `~a`")
+ ((dispatch-c156_0) dispatch-c_8))
+ (reader-error.1
+ unsafe-undefined
+ c154_0
+ #f
+ unsafe-undefined
+ in152_0
+ config153_0
+ temp155_0
+ (list dispatch-c156_0)))
+ (if (not (char? c_212))
+ (let-values (((in157_0) in_97)
+ ((config158_0) config_82)
+ ((c159_0) c_212)
+ ((temp160_2) "bad syntax `~a`")
+ ((dispatch-c161_0) dispatch-c_8))
(reader-error.1
unsafe-undefined
- c154_0
+ c159_0
#f
unsafe-undefined
- in152_0
- config153_0
- temp155_2
- (list dispatch-c156_0))))
- (if (not (char? c_141))
- (let-values ()
- (let-values (((in157_0) in_70)
- ((config158_0) config_59)
- ((c159_0) c_141)
- ((temp160_1) "bad syntax `~a`")
- ((dispatch-c161_0) dispatch-c_5))
- (reader-error.1
- unsafe-undefined
- c159_0
- #f
- unsafe-undefined
- in157_0
- config158_0
- temp160_1
- (list dispatch-c161_0))))
- (let-values (((c3_10) (readtable-dispatch-handler orig-config_1 c_141)))
- (if c3_10
+ in157_0
+ config158_0
+ temp160_2
+ (list dispatch-c161_0)))
+ (let-values (((cond-val_29) (readtable-dispatch-handler orig-config_1 c_212)))
+ (if cond-val_29
((lambda (handler_10)
- (let-values (((line_12) (read-config-line config_59)))
- (let-values (((col_11) (read-config-col config_59)))
- (let-values (((pos_145) (read-config-pos config_59)))
- (let-values (((v_266)
- (readtable-apply handler_10 c_141 in_70 config_59 line_12 col_11 pos_145)))
- (retry-special-comment v_266 in_70 orig-config_1))))))
- c3_10)
- (let-values ()
- (let-values ()
- (let-values (((tmp_76) c_141))
- (let-values (((index_7)
- (if (char? tmp_76)
- (let-values (((codepoint_3) (char->integer tmp_76)))
- (if (if (unsafe-fx>= codepoint_3 33) (unsafe-fx< codepoint_3 127) #f)
- (let-values (((tbl_6)
- '#(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_6 (unsafe-fx- codepoint_3 33)))
- 0))
- 0)))
- (if (unsafe-fx< index_7 17)
- (if (unsafe-fx< index_7 8)
- (if (unsafe-fx< index_7 3)
- (if (unsafe-fx< index_7 1)
- (let-values ()
- (let-values (((in162_0) in_70)
- ((config163_0) config_59)
- ((temp164_1) "bad syntax `~a~a`")
- ((dispatch-c165_0) dispatch-c_5)
- ((c166_0) c_141))
+ (let-values (((line_13) (read-config-line config_82)))
+ (let-values (((col_12) (read-config-col config_82)))
+ (let-values (((pos_188) (read-config-pos config_82)))
+ (let-values (((v_404)
+ (readtable-apply handler_10 c_212 in_97 config_82 line_13 col_12 pos_188)))
+ (retry-special-comment v_404 in_97 orig-config_1))))))
+ cond-val_29)
+ (let-values (((tmp_80) c_212))
+ (let-values (((index_7)
+ (if (char? tmp_80)
+ (let-values (((codepoint_3) (char->integer tmp_80)))
+ (if (if (unsafe-fx>= codepoint_3 33) (unsafe-fx< codepoint_3 127) #f)
+ (let-values (((tbl_6)
+ '#(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_6 (unsafe-fx- codepoint_3 33)))
+ 0))
+ 0)))
+ (if (unsafe-fx< index_7 17)
+ (if (unsafe-fx< index_7 8)
+ (if (unsafe-fx< index_7 3)
+ (if (unsafe-fx< index_7 1)
+ (let-values (((in162_0) in_97)
+ ((config163_0) config_82)
+ ((temp164_0) "bad syntax `~a~a`")
+ ((dispatch-c165_0) dispatch-c_8)
+ ((c166_0) c_212))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in162_0
+ config163_0
+ temp164_0
+ (list dispatch-c165_0 c166_0)))
+ (if (unsafe-fx< index_7 2)
+ (read-vector-or-graph read-one dispatch-c_8 c_212 in_97 config_82)
+ (let-values (((read-one167_0) read-one)
+ ((temp168_0) '#\()
+ ((temp169_1) '#\()
+ ((temp170_0) '#\))
+ ((in171_0) in_97)
+ ((config172_0) config_82))
+ (read-vector.1
+ #f
+ 'any
+ read-one167_0
+ temp168_0
+ temp169_1
+ temp170_0
+ in171_0
+ config172_0))))
+ (if (unsafe-fx< index_7 5)
+ (if (unsafe-fx< index_7 4)
+ (if (check-parameter 1/read-square-bracket-as-paren config_82)
+ (let-values (((read-one173_0) read-one)
+ ((temp174_0) '#\[)
+ ((temp175_2) '#\[)
+ ((temp176_0) '#\])
+ ((in177_0) in_97)
+ ((config178_0) config_82))
+ (read-vector.1
+ #f
+ 'any
+ read-one173_0
+ temp174_0
+ temp175_2
+ temp176_0
+ in177_0
+ config178_0))
+ (let-values (((in179_0) in_97)
+ ((config180_0) config_82)
+ ((temp181_0) (format "~a~a" dispatch-c_8 c_212)))
+ (bad-syntax-error.1 '#\x in179_0 config180_0 temp181_0)))
+ (if (check-parameter 1/read-curly-brace-as-paren config_82)
+ (let-values (((read-one182_0) read-one)
+ ((temp183_2) '#\{)
+ ((temp184_1) '#\{)
+ ((temp185_0) '#\})
+ ((in186_0) in_97)
+ ((config187_0) config_82))
+ (read-vector.1
+ #f
+ 'any
+ read-one182_0
+ temp183_2
+ temp184_1
+ temp185_0
+ in186_0
+ config187_0))
+ (let-values (((in188_0) in_97)
+ ((config189_0) config_82)
+ ((temp190_1) (format "~a~a" dispatch-c_8 c_212)))
+ (bad-syntax-error.1 '#\x in188_0 config189_0 temp190_1))))
+ (if (unsafe-fx< index_7 6)
+ (read-struct read-one dispatch-c_8 in_97 config_82)
+ (if (unsafe-fx< index_7 7)
+ (read-box read-one dispatch-c_8 in_97 config_82)
+ (read-quote read-one 'syntax "quoting #'" c_212 in_97 config_82)))))
+ (if (unsafe-fx< index_7 12)
+ (if (unsafe-fx< index_7 9)
+ (read-quote read-one 'quasisyntax "quasiquoting #`" c_212 in_97 config_82)
+ (if (unsafe-fx< index_7 10)
+ (let-values (((c2_11)
+ (let-values (((in_99) in_97)
+ ((skip-count_18) 0)
+ ((source_52) (read-config-source config_82)))
+ (let-values (((c_213)
+ (peek-char-or-special
+ in_99
+ skip-count_18
+ 'special
+ source_52)))
+ (if (eq? c_213 'special) (special1.1 'special) c_213)))))
+ (if (eqv? c2_11 '#\@)
+ (begin
+ (consume-char in_97 c2_11)
+ (read-quote read-one 'unsyntax-splicing "unquoting #,@" c_212 in_97 config_82))
+ (read-quote read-one 'unsyntax "unquoting #," c_212 in_97 config_82)))
+ (if (unsafe-fx< index_7 11)
+ (read-character in_97 config_82)
+ (let-values (((in191_0) in_97) ((config192_0) config_82) ((temp193_1) '|byte string|))
+ (read-string.1 temp193_1 in191_0 config192_0)))))
+ (if (unsafe-fx< index_7 14)
+ (if (unsafe-fx< index_7 13)
+ (let-values (((c2_12)
+ (let-values (((in_100) in_97)
+ ((skip-count_19) 0)
+ ((source_53) (read-config-source config_82)))
+ (let-values (((c_214)
+ (peek-char-or-special
+ in_100
+ skip-count_19
+ 'special
+ source_53)))
+ (if (eq? c_214 'special) (special1.1 'special) c_214)))))
+ (if (eqv? '#\< c2_12)
+ (begin (consume-char in_97 '#\<) (read-here-string in_97 config_82))
+ (let-values (((in194_0) in_97)
+ ((config195_0) config_82)
+ ((c2196_0) c2_12)
+ ((temp197_1) "bad syntax `~a<`")
+ ((dispatch-c198_0) dispatch-c_8))
(reader-error.1
unsafe-undefined
- '#\x
+ c2196_0
#f
unsafe-undefined
- in162_0
- config163_0
- temp164_1
- (list dispatch-c165_0 c166_0))))
- (if (unsafe-fx< index_7 2)
- (let-values () (read-vector-or-graph read-one dispatch-c_5 c_141 in_70 config_59))
- (let-values ()
- (let-values (((read-one167_0) read-one)
- ((temp168_0) '#\()
- ((temp169_1) '#\()
- ((temp170_0) '#\))
- ((in171_0) in_70)
- ((config172_0) config_59))
- (read-vector.1
+ in194_0
+ config195_0
+ temp197_1
+ (list dispatch-c198_0)))))
+ (let-values (((c199_0) c_212)
+ ((in200_0) in_97)
+ ((config201_0) config_82)
+ ((dispatch-c202_0) dispatch-c_8)
+ ((temp203_0) 'symbol))
+ (read-symbol-or-number.1 dispatch-c202_0 temp203_0 c199_0 in200_0 config201_0)))
+ (if (unsafe-fx< index_7 15)
+ (let-values (((temp204_1) #f)
+ ((in205_0) in_97)
+ ((config206_0) config_82)
+ ((temp207_0) 'keyword))
+ (read-symbol-or-number.1 #f temp207_0 temp204_1 in205_0 config206_0))
+ (if (unsafe-fx< index_7 16)
+ (let-values (((c2_13)
+ (let-values (((in_101) in_97)
+ ((skip-count_20) 0)
+ ((source_54) (read-config-source config_82)))
+ (let-values (((c_215)
+ (peek-char-or-special
+ in_101
+ skip-count_20
+ 'special
+ source_54)))
+ (if (eq? c_215 'special) (special1.1 'special) c_215)))))
+ (if (char-delimiter? c2_13 config_82)
+ (wrap #t in_97 config_82 c_212)
+ (read-delimited-constant
+ c_212
+ (char=? c_212 '#\t)
+ '(#\r #\u #\e)
+ #t
+ in_97
+ config_82)))
+ (let-values (((c2_14)
+ (let-values (((in_102) in_97)
+ ((skip-count_21) 0)
+ ((source_55) (read-config-source config_82)))
+ (let-values (((c_216)
+ (peek-char-or-special
+ in_102
+ skip-count_21
+ 'special
+ source_55)))
+ (if (eq? c_216 'special) (special1.1 'special) c_216)))))
+ (if (char-delimiter? c2_14 config_82)
+ (wrap #f in_97 config_82 c_212)
+ (if (let-values (((or-part_879) (char=? c2_14 '#\x)))
+ (if or-part_879 or-part_879 (char=? c2_14 '#\l)))
+ (read-fixnum-or-flonum-vector read-one dispatch-c_8 c_212 c2_14 in_97 config_82)
+ (read-delimited-constant
+ c_212
+ (char=? c_212 '#\f)
+ '(#\a #\l #\s #\e)
#f
- 'any
- read-one167_0
- temp168_0
- temp169_1
- temp170_0
- in171_0
- config172_0)))))
- (if (unsafe-fx< index_7 5)
- (if (unsafe-fx< index_7 4)
- (let-values ()
- (if (check-parameter 1/read-square-bracket-as-paren config_59)
- (let-values ()
- (let-values (((read-one173_0) read-one)
- ((temp174_0) '#\[)
- ((temp175_0) '#\[)
- ((temp176_0) '#\])
- ((in177_0) in_70)
- ((config178_0) config_59))
- (read-vector.1
- #f
- 'any
- read-one173_0
- temp174_0
- temp175_0
- temp176_0
- in177_0
- config178_0)))
- (let-values ()
- (let-values (((in179_0) in_70)
- ((config180_0) config_59)
- ((temp181_0) (format "~a~a" dispatch-c_5 c_141)))
- (bad-syntax-error.1 '#\x in179_0 config180_0 temp181_0)))))
- (let-values ()
- (if (check-parameter 1/read-curly-brace-as-paren config_59)
- (let-values ()
- (let-values (((read-one182_0) read-one)
- ((temp183_1) '#\{)
- ((temp184_0) '#\{)
- ((temp185_0) '#\})
- ((in186_0) in_70)
- ((config187_0) config_59))
- (read-vector.1
+ in_97
+ config_82)))))))))
+ (if (unsafe-fx< index_7 26)
+ (if (unsafe-fx< index_7 21)
+ (if (unsafe-fx< index_7 18)
+ (let-values (((temp208_0) #f)
+ ((in209_0) in_97)
+ ((config210_0) config_82)
+ ((temp211_0) "#e"))
+ (read-symbol-or-number.1 #f temp211_0 temp208_0 in209_0 config210_0))
+ (if (unsafe-fx< index_7 19)
+ (let-values (((temp212_0) #f)
+ ((in213_0) in_97)
+ ((config214_0) config_82)
+ ((temp215_0) "#E"))
+ (read-symbol-or-number.1 #f temp215_0 temp212_0 in213_0 config214_0))
+ (if (unsafe-fx< index_7 20)
+ (let-values (((temp216_0) #f)
+ ((in217_0) in_97)
+ ((config218_0) config_82)
+ ((temp219_0) "#i"))
+ (read-symbol-or-number.1 #f temp219_0 temp216_0 in217_0 config218_0))
+ (let-values (((temp220_0) #f)
+ ((in221_0) in_97)
+ ((config222_0) config_82)
+ ((temp223_0) "#I"))
+ (read-symbol-or-number.1 #f temp223_0 temp220_0 in221_0 config222_0)))))
+ (if (unsafe-fx< index_7 23)
+ (if (unsafe-fx< index_7 22)
+ (let-values (((temp224_0) #f)
+ ((in225_0) in_97)
+ ((config226_0) config_82)
+ ((temp227_0) "#d"))
+ (read-symbol-or-number.1 #f temp227_0 temp224_0 in225_0 config226_0))
+ (let-values (((temp228_1) #f)
+ ((in229_0) in_97)
+ ((config230_0) config_82)
+ ((temp231_0) "#B"))
+ (read-symbol-or-number.1 #f temp231_0 temp228_1 in229_0 config230_0)))
+ (if (unsafe-fx< index_7 24)
+ (let-values (((temp232_0) #f)
+ ((in233_0) in_97)
+ ((config234_0) config_82)
+ ((temp235_0) "#o"))
+ (read-symbol-or-number.1 #f temp235_0 temp232_0 in233_0 config234_0))
+ (if (unsafe-fx< index_7 25)
+ (let-values (((temp236_0) #f)
+ ((in237_0) in_97)
+ ((config238_0) config_82)
+ ((temp239_0) "#O"))
+ (read-symbol-or-number.1 #f temp239_0 temp236_0 in237_0 config238_0))
+ (let-values (((temp240_1) #f)
+ ((in241_0) in_97)
+ ((config242_0) config_82)
+ ((temp243_0) "#D"))
+ (read-symbol-or-number.1 #f temp243_0 temp240_1 in241_0 config242_0))))))
+ (if (unsafe-fx< index_7 30)
+ (if (unsafe-fx< index_7 27)
+ (let-values (((temp244_0) #f)
+ ((in245_0) in_97)
+ ((config246_0) config_82)
+ ((temp247_0) "#b"))
+ (read-symbol-or-number.1 #f temp247_0 temp244_0 in245_0 config246_0))
+ (if (unsafe-fx< index_7 28)
+ (let-values (((temp248_0) #f)
+ ((in249_0) in_97)
+ ((config250_0) config_82)
+ ((temp251_0) "#x"))
+ (read-symbol-or-number.1 #f temp251_0 temp248_0 in249_0 config250_0))
+ (if (unsafe-fx< index_7 29)
+ (let-values (((temp252_1) #f)
+ ((in253_0) in_97)
+ ((config254_0) config_82)
+ ((temp255_1) "#X"))
+ (read-symbol-or-number.1 #f temp255_1 temp252_1 in253_0 config254_0))
+ (let-values (((c2_15)
+ (let-values (((in_103) in_97)
+ ((source_56) (read-config-source config_82)))
+ (read-char-or-special in_103 special1.1 source_56))))
+ (let-values (((tmp_81) c2_15))
+ (if (if (equal? tmp_81 '#\s) #t (equal? tmp_81 '#\S))
+ (read-one #f in_97 (override-parameter read-case-sensitive config_82 #t))
+ (if (if (equal? tmp_81 '#\i) #t (equal? tmp_81 '#\I))
+ (read-one #f in_97 (override-parameter read-case-sensitive config_82 #f))
+ (let-values (((in256_0) in_97)
+ ((config257_0) config_82)
+ ((c2258_0) c2_15)
+ ((temp259_1) "expected `s', `S`, `i`, or `I` after `~a~a`")
+ ((dispatch-c260_0) dispatch-c_8)
+ ((c261_0) c_212))
+ (reader-error.1
+ unsafe-undefined
+ c2258_0
#f
- 'any
- read-one182_0
- temp183_1
- temp184_0
- temp185_0
- in186_0
- config187_0)))
- (let-values ()
- (let-values (((in188_0) in_70)
- ((config189_0) config_59)
- ((temp190_1) (format "~a~a" dispatch-c_5 c_141)))
- (bad-syntax-error.1 '#\x in188_0 config189_0 temp190_1))))))
- (if (unsafe-fx< index_7 6)
- (let-values () (read-struct read-one dispatch-c_5 in_70 config_59))
- (if (unsafe-fx< index_7 7)
- (let-values () (read-box read-one dispatch-c_5 in_70 config_59))
- (let-values () (read-quote read-one 'syntax "quoting #'" c_141 in_70 config_59))))))
- (if (unsafe-fx< index_7 12)
- (if (unsafe-fx< index_7 9)
- (let-values ()
- (read-quote read-one 'quasisyntax "quasiquoting #`" c_141 in_70 config_59))
- (if (unsafe-fx< index_7 10)
- (let-values ()
- (let-values (((c2_15)
- (let-values (((in_72) in_70)
- ((skip-count_17) 0)
- ((source_46) (read-config-source config_59)))
- (let-values (((c_142)
- (peek-char-or-special
- in_72
- skip-count_17
- 'special
- source_46)))
- (if (eq? c_142 'special) (special1.1 'special) c_142)))))
- (if (eqv? c2_15 '#\@)
- (begin
- (consume-char in_70 c2_15)
- (read-quote
- read-one
- 'unsyntax-splicing
- "unquoting #,@"
- c_141
- in_70
- config_59))
- (read-quote read-one 'unsyntax "unquoting #," c_141 in_70 config_59))))
- (if (unsafe-fx< index_7 11)
- (let-values () (read-character in_70 config_59))
- (let-values ()
- (let-values (((in191_0) in_70)
- ((config192_0) config_59)
- ((temp193_1) '|byte string|))
- (read-string.1 temp193_1 in191_0 config192_0))))))
- (if (unsafe-fx< index_7 14)
- (if (unsafe-fx< index_7 13)
- (let-values ()
+ unsafe-undefined
+ in256_0
+ config257_0
+ temp259_1
+ (list dispatch-c260_0 c261_0))))))))))
+ (if (unsafe-fx< index_7 32)
+ (if (unsafe-fx< index_7 31)
+ (read-hash read-one dispatch-c_8 c_212 in_97 config_82)
+ (let-values (((accum-str_13) (accum-string-init! config_82)))
+ (let-values ((() (begin (accum-string-add! accum-str_13 dispatch-c_8) (values))))
+ (let-values ((() (begin (accum-string-add! accum-str_13 c_212) (values))))
(let-values (((c2_16)
- (let-values (((in_73) in_70)
- ((skip-count_18) 0)
- ((source_47) (read-config-source config_59)))
- (let-values (((c_143)
- (peek-char-or-special
- in_73
- skip-count_18
- 'special
- source_47)))
- (if (eq? c_143 'special) (special1.1 'special) c_143)))))
- (if (eqv? '#\< c2_16)
- (let-values ()
- (begin (consume-char in_70 '#\<) (read-here-string in_70 config_59)))
- (let-values ()
- (let-values (((in194_0) in_70)
- ((config195_0) config_59)
- ((c2196_0) c2_16)
- ((temp197_1) "bad syntax `~a<`")
- ((dispatch-c198_0) dispatch-c_5))
- (reader-error.1
- unsafe-undefined
- c2196_0
- #f
- unsafe-undefined
- in194_0
- config195_0
- temp197_1
- (list dispatch-c198_0)))))))
- (let-values ()
- (let-values (((c199_0) c_141)
- ((in200_0) in_70)
- ((config201_0) config_59)
- ((dispatch-c202_0) dispatch-c_5)
- ((temp203_0) 'symbol))
- (read-symbol-or-number.1 dispatch-c202_0 temp203_0 c199_0 in200_0 config201_0))))
- (if (unsafe-fx< index_7 15)
- (let-values ()
- (let-values (((temp204_1) #f)
- ((in205_0) in_70)
- ((config206_0) config_59)
- ((temp207_0) 'keyword))
- (read-symbol-or-number.1 #f temp207_0 temp204_1 in205_0 config206_0)))
- (if (unsafe-fx< index_7 16)
- (let-values ()
- (let-values (((c2_17)
- (let-values (((in_74) in_70)
- ((skip-count_19) 0)
- ((source_48) (read-config-source config_59)))
- (let-values (((c_144)
- (peek-char-or-special
- in_74
- skip-count_19
- 'special
- source_48)))
- (if (eq? c_144 'special) (special1.1 'special) c_144)))))
- (if (char-delimiter? c2_17 config_59)
- (let-values () (wrap #t in_70 config_59 c_141))
- (let-values ()
- (read-delimited-constant
- c_141
- (char=? c_141 '#\t)
- '(#\r #\u #\e)
- #t
- in_70
- config_59)))))
- (let-values ()
- (let-values (((c2_18)
- (let-values (((in_75) in_70)
- ((skip-count_20) 0)
- ((source_49) (read-config-source config_59)))
- (let-values (((c_145)
- (peek-char-or-special
- in_75
- skip-count_20
- 'special
- source_49)))
- (if (eq? c_145 'special) (special1.1 'special) c_145)))))
- (if (char-delimiter? c2_18 config_59)
- (let-values () (wrap #f in_70 config_59 c_141))
- (if (let-values (((or-part_528) (char=? c2_18 '#\x)))
- (if or-part_528 or-part_528 (char=? c2_18 '#\l)))
- (let-values ()
- (read-fixnum-or-flonum-vector
+ (let-values (((in_104) in_97)
+ ((source_57) (read-config-source config_82)))
+ (read-char-or-special in_104 special1.1 source_57))))
+ (begin
+ (if (char? c2_16) (accum-string-add! accum-str_13 c2_16) (void))
+ (let-values (((tmp_82) c2_16))
+ (if (equal? tmp_82 '#\x)
+ (read-regexp c_212 accum-str_13 in_97 config_82)
+ (if (equal? tmp_82 '#\e)
+ (read-extension-reader
read-one
- dispatch-c_5
- c_141
- c2_18
- in_70
- config_59))
- (let-values ()
- (read-delimited-constant
- c_141
- (char=? c_141 '#\f)
- '(#\a #\l #\s #\e)
- #f
- in_70
- config_59)))))))))))
- (if (unsafe-fx< index_7 26)
- (if (unsafe-fx< index_7 21)
- (if (unsafe-fx< index_7 18)
- (let-values ()
- (let-values (((temp208_0) #f)
- ((in209_0) in_70)
- ((config210_0) config_59)
- ((temp211_0) "#e"))
- (read-symbol-or-number.1 #f temp211_0 temp208_0 in209_0 config210_0)))
- (if (unsafe-fx< index_7 19)
- (let-values ()
- (let-values (((temp212_1) #f)
- ((in213_0) in_70)
- ((config214_0) config_59)
- ((temp215_0) "#E"))
- (read-symbol-or-number.1 #f temp215_0 temp212_1 in213_0 config214_0)))
- (if (unsafe-fx< index_7 20)
- (let-values ()
- (let-values (((temp216_1) #f)
- ((in217_0) in_70)
- ((config218_0) config_59)
- ((temp219_0) "#i"))
- (read-symbol-or-number.1 #f temp219_0 temp216_1 in217_0 config218_0)))
- (let-values ()
- (let-values (((temp220_0) #f)
- ((in221_0) in_70)
- ((config222_0) config_59)
- ((temp223_1) "#I"))
- (read-symbol-or-number.1 #f temp223_1 temp220_0 in221_0 config222_0))))))
- (if (unsafe-fx< index_7 23)
- (if (unsafe-fx< index_7 22)
- (let-values ()
- (let-values (((temp224_0) #f)
- ((in225_0) in_70)
- ((config226_0) config_59)
- ((temp227_1) "#d"))
- (read-symbol-or-number.1 #f temp227_1 temp224_0 in225_0 config226_0)))
- (let-values ()
- (let-values (((temp228_1) #f)
- ((in229_0) in_70)
- ((config230_0) config_59)
- ((temp231_0) "#B"))
- (read-symbol-or-number.1 #f temp231_0 temp228_1 in229_0 config230_0))))
- (if (unsafe-fx< index_7 24)
- (let-values ()
- (let-values (((temp232_1) #f)
- ((in233_0) in_70)
- ((config234_0) config_59)
- ((temp235_0) "#o"))
- (read-symbol-or-number.1 #f temp235_0 temp232_1 in233_0 config234_0)))
- (if (unsafe-fx< index_7 25)
- (let-values ()
- (let-values (((temp236_0) #f)
- ((in237_0) in_70)
- ((config238_0) config_59)
- ((temp239_1) "#O"))
- (read-symbol-or-number.1 #f temp239_1 temp236_0 in237_0 config238_0)))
- (let-values ()
- (let-values (((temp240_1) #f)
- ((in241_0) in_70)
- ((config242_0) config_59)
- ((temp243_0) "#D"))
- (read-symbol-or-number.1 #f temp243_0 temp240_1 in241_0 config242_0)))))))
- (if (unsafe-fx< index_7 30)
- (if (unsafe-fx< index_7 27)
- (let-values ()
- (let-values (((temp244_0) #f)
- ((in245_0) in_70)
- ((config246_0) config_59)
- ((temp247_0) "#b"))
- (read-symbol-or-number.1 #f temp247_0 temp244_0 in245_0 config246_0)))
- (if (unsafe-fx< index_7 28)
- (let-values ()
- (let-values (((temp248_0) #f)
- ((in249_0) in_70)
- ((config250_0) config_59)
- ((temp251_0) "#x"))
- (read-symbol-or-number.1 #f temp251_0 temp248_0 in249_0 config250_0)))
- (if (unsafe-fx< index_7 29)
- (let-values ()
- (let-values (((temp252_0) #f)
- ((in253_0) in_70)
- ((config254_0) config_59)
- ((temp255_0) "#X"))
- (read-symbol-or-number.1 #f temp255_0 temp252_0 in253_0 config254_0)))
- (let-values ()
- (let-values (((c2_19)
- (let-values (((in_76) in_70)
- ((source_50) (read-config-source config_59)))
- (read-char-or-special in_76 special1.1 source_50))))
- (let-values (((tmp_77) c2_19))
- (if (if (equal? tmp_77 '#\s) #t (equal? tmp_77 '#\S))
- (let-values ()
- (read-one #f in_70 (override-parameter read-case-sensitive config_59 #t)))
- (if (if (equal? tmp_77 '#\i) #t (equal? tmp_77 '#\I))
- (let-values ()
- (read-one
- #f
- in_70
- (override-parameter read-case-sensitive config_59 #f)))
- (let-values ()
- (let-values (((in256_0) in_70)
- ((config257_0) config_59)
- ((c2258_0) c2_19)
- ((temp259_0) "expected `s', `S`, `i`, or `I` after `~a~a`")
- ((dispatch-c260_0) dispatch-c_5)
- ((c261_0) c_141))
- (reader-error.1
- unsafe-undefined
- c2258_0
- #f
- unsafe-undefined
- in256_0
- config257_0
- temp259_0
- (list dispatch-c260_0 c261_0))))))))))))
- (if (unsafe-fx< index_7 32)
- (if (unsafe-fx< index_7 31)
- (let-values () (read-hash read-one dispatch-c_5 c_141 in_70 config_59))
- (let-values ()
- (let-values (((accum-str_12) (accum-string-init! config_59)))
- (let-values ((() (begin (accum-string-add! accum-str_12 dispatch-c_5) (values))))
- (let-values ((() (begin (accum-string-add! accum-str_12 c_141) (values))))
- (let-values (((c2_20)
- (let-values (((in_77) in_70)
- ((source_51) (read-config-source config_59)))
- (read-char-or-special in_77 special1.1 source_51))))
- (begin
- (if (char? c2_20)
- (let-values () (accum-string-add! accum-str_12 c2_20))
- (void))
- (let-values (((tmp_78) c2_20))
- (if (equal? tmp_78 '#\x)
- (let-values () (read-regexp c_141 accum-str_12 in_70 config_59))
- (if (equal? tmp_78 '#\e)
- (let-values ()
- (read-extension-reader
- read-one
- read-undotted
- dispatch-c_5
- in_70
- config_59))
- (let-values ()
- (let-values (((in262_0) in_70)
- ((config263_0) config_59)
- ((c2264_0) c2_20)
- ((temp265_0)
- (let-values (((accum-str266_0) accum-str_12)
- ((config267_0) config_59))
- (accum-string-get!.1
- 0
- accum-str266_0
- config267_0))))
- (bad-syntax-error.1
- c2264_0
- in262_0
- config263_0
- temp265_0)))))))))))))
- (if (unsafe-fx< index_7 33)
- (let-values ()
- (let-values (((accum-str_13) (accum-string-init! config_59)))
- (let-values ((() (begin (accum-string-add! accum-str_13 dispatch-c_5) (values))))
- (let-values ((() (begin (accum-string-add! accum-str_13 c_141) (values))))
- (let-values (((c2_21)
- (let-values (((in_78) in_70)
- ((source_52) (read-config-source config_59)))
- (read-char-or-special in_78 special1.1 source_52))))
- (begin
- (if (char? c2_21)
- (let-values () (accum-string-add! accum-str_13 c2_21))
- (void))
- (let-values (((tmp_79) c2_21))
- (if (equal? tmp_79 '#\x)
- (let-values () (read-regexp c_141 accum-str_13 in_70 config_59))
- (let-values ()
- (let-values (((in268_0) in_70)
- ((config269_0) config_59)
- ((c2270_0) c2_21)
- ((temp271_1)
- (let-values (((accum-str272_0) accum-str_13)
- ((config273_0) config_59))
- (accum-string-get!.1
- 0
- accum-str272_0
- config273_0))))
- (bad-syntax-error.1
- c2270_0
- in268_0
- config269_0
- temp271_1)))))))))))
- (if (unsafe-fx< index_7 34)
- (let-values ()
- (let-values (((read-undotted274_0) read-undotted)
- ((dispatch-c275_0) dispatch-c_5)
- ((in276_0) in_70)
- ((config277_0) config_59))
- (read-extension-lang.1
- #f
- read-undotted274_0
- dispatch-c275_0
- in276_0
- config277_0)))
- (if (unsafe-fx< index_7 35)
- (let-values ()
- (let-values (((read-undotted278_0) read-undotted)
- ((dispatch-c279_0) dispatch-c_5)
- ((in280_0) in_70)
- ((config281_0) config_59))
- (read-extension-#!.1
- #f
- read-undotted278_0
- dispatch-c279_0
- in280_0
- config281_0)))
- (let-values ()
- (if (check-parameter 1/read-accept-compiled config_59)
- (let-values ()
- (wrap ((read-config-read-compiled config_59) in_70) in_70 config_59 c_141))
- (let-values ()
- (let-values (((in282_0) in_70)
- ((config283_0) config_59)
- ((temp284_0) "`~a~~` compiled expressions not enabled")
- ((dispatch-c285_0) dispatch-c_5))
- (reader-error.1
- unsafe-undefined
- '#\x
- #f
- unsafe-undefined
- in282_0
- config283_0
- temp284_0
- (list dispatch-c285_0)))))))))))))))))))))))))
+ read-undotted
+ dispatch-c_8
+ in_97
+ config_82)
+ (let-values (((in262_0) in_97)
+ ((config263_0) config_82)
+ ((c2264_0) c2_16)
+ ((temp265_1)
+ (let-values (((accum-str266_0) accum-str_13)
+ ((config267_0) config_82))
+ (accum-string-get!.1 0 accum-str266_0 config267_0))))
+ (bad-syntax-error.1 c2264_0 in262_0 config263_0 temp265_1)))))))))))
+ (if (unsafe-fx< index_7 33)
+ (let-values (((accum-str_14) (accum-string-init! config_82)))
+ (let-values ((() (begin (accum-string-add! accum-str_14 dispatch-c_8) (values))))
+ (let-values ((() (begin (accum-string-add! accum-str_14 c_212) (values))))
+ (let-values (((c2_17)
+ (let-values (((in_105) in_97)
+ ((source_58) (read-config-source config_82)))
+ (read-char-or-special in_105 special1.1 source_58))))
+ (begin
+ (if (char? c2_17) (accum-string-add! accum-str_14 c2_17) (void))
+ (let-values (((tmp_83) c2_17))
+ (if (equal? tmp_83 '#\x)
+ (read-regexp c_212 accum-str_14 in_97 config_82)
+ (let-values (((in268_0) in_97)
+ ((config269_0) config_82)
+ ((c2270_0) c2_17)
+ ((temp271_0)
+ (let-values (((accum-str272_0) accum-str_14)
+ ((config273_0) config_82))
+ (accum-string-get!.1 0 accum-str272_0 config273_0))))
+ (bad-syntax-error.1 c2270_0 in268_0 config269_0 temp271_0)))))))))
+ (if (unsafe-fx< index_7 34)
+ (let-values (((read-undotted274_0) read-undotted)
+ ((dispatch-c275_0) dispatch-c_8)
+ ((in276_0) in_97)
+ ((config277_0) config_82))
+ (read-extension-lang.1 #f read-undotted274_0 dispatch-c275_0 in276_0 config277_0))
+ (if (unsafe-fx< index_7 35)
+ (let-values (((read-undotted278_0) read-undotted)
+ ((dispatch-c279_0) dispatch-c_8)
+ ((in280_0) in_97)
+ ((config281_0) config_82))
+ (read-extension-#!.1 #f read-undotted278_0 dispatch-c279_0 in280_0 config281_0))
+ (if (check-parameter 1/read-accept-compiled config_82)
+ (wrap ((read-config-read-compiled config_82) in_97) in_97 config_82 c_212)
+ (let-values (((in282_0) in_97)
+ ((config283_0) config_82)
+ ((temp284_0) "`~a~~` compiled expressions not enabled")
+ ((dispatch-c285_0) dispatch-c_8))
+ (reader-error.1
+ unsafe-undefined
+ '#\x
+ #f
+ unsafe-undefined
+ in282_0
+ config283_0
+ temp284_0
+ (list dispatch-c285_0)))))))))))))))))))))
(define-values
(retry-special-comment)
- (lambda (v_267 in_79 config_60)
+ (lambda (v_405 in_106 config_83)
(begin
- (if (1/special-comment? v_267)
- (let-values () (if (read-config-keep-comment? config_60) v_267 (read-undotted #f in_79 config_60)))
- (let-values () v_267)))))
+ (if (1/special-comment? v_405)
+ (if (read-config-keep-comment? config_83) v_405 (read-undotted #f in_106 config_83))
+ v_405))))
(define-values
(1/module-declared?)
(let-values (((module-declared?_4)
@@ -66546,21 +64646,17 @@
'module-declared?
(let-values (((mod_4) mod2_0))
(let-values (((load?_4) load?1_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (module-reference? mod_4)
- (void)
- (let-values ()
- (raise-argument-error 'module-declared? module-reference-str mod_4)))
- (values))))
- (let-values (((ns_118) (1/current-namespace)))
- (let-values (((name_44)
- (let-values (((mod24_0) mod_4) ((load?25_0) load?_4))
- (reference->resolved-module-path.1 load?25_0 mod24_0))))
- (if (namespace->module ns_118 name_44) #t #f)))))))))))))
+ (let-values ((()
+ (begin
+ (if (module-reference? mod_4)
+ (void)
+ (raise-argument-error 'module-declared? module-reference-str mod_4))
+ (values))))
+ (let-values (((ns_143) (1/current-namespace)))
+ (let-values (((name_88)
+ (let-values (((mod24_0) mod_4) ((load?25_0) load?_4))
+ (reference->resolved-module-path.1 load?25_0 mod24_0))))
+ (if (namespace->module ns_143 name_88) #t #f))))))))))
(case-lambda
((mod_5) (begin 'module-declared? (module-declared?_4 mod_5 #f)))
((mod_6 load?1_1) (module-declared?_4 mod_6 load?1_1)))))
@@ -66569,45 +64665,41 @@
(lambda (mod_7)
(begin
'module-predefined?
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (module-reference? mod_7)
- (void)
- (let-values () (raise-argument-error 'module-predefined? module-reference-str mod_7)))
- (values))))
- (let-values (((ns_73) (1/current-namespace)))
- (let-values (((name_75)
- (let-values (((mod27_0) mod_7) ((temp28_7) #f))
- (reference->resolved-module-path.1 temp28_7 mod27_0))))
- (let-values (((m_30) (namespace->module ns_73 name_75)))
- (if m_30 (module-is-predefined? m_30) #f))))))))))
+ (let-values ((()
+ (begin
+ (if (module-reference? mod_7)
+ (void)
+ (raise-argument-error 'module-predefined? module-reference-str mod_7))
+ (values))))
+ (let-values (((ns_144) (1/current-namespace)))
+ (let-values (((name_89)
+ (let-values (((mod27_0) mod_7) ((temp28_6) #f))
+ (reference->resolved-module-path.1 temp28_6 mod27_0))))
+ (let-values (((m_35) (namespace->module ns_144 name_89))) (if m_35 (module-is-predefined? m_35) #f))))))))
(define-values
(module->.1)
(lambda (extra-checks3_0 extract6_0 who7_0 mod8_0 load?5_0)
(begin
'module->
(let-values (((extract_1) extract6_0))
- (let-values (((who_33) who7_0))
+ (let-values (((who_47) who7_0))
(let-values (((mod_8) mod8_0))
(let-values (((load?_5) load?5_0))
(let-values (((extra-checks_0) extra-checks3_0))
- (let-values ()
- (let-values ((()
- (begin
- (if (module-reference? mod_8)
- (void)
- (let-values () (raise-argument-error who_33 module-reference-str mod_8)))
- (values))))
- (let-values ((() (begin (extra-checks_0) (values))))
- (let-values (((m_31)
- (namespace->module/complain
- who_33
- (1/current-namespace)
- (let-values (((mod29_0) mod_8) ((load?30_0) load?_5))
- (reference->resolved-module-path.1 load?30_0 mod29_0)))))
- (extract_1 m_31)))))))))))))
+ (let-values ((()
+ (begin
+ (if (module-reference? mod_8)
+ (void)
+ (raise-argument-error who_47 module-reference-str mod_8))
+ (values))))
+ (let-values ((() (begin (extra-checks_0) (values))))
+ (let-values (((m_36)
+ (namespace->module/complain
+ who_47
+ (1/current-namespace)
+ (let-values (((mod29_0) mod_8) ((load?30_0) load?_5))
+ (reference->resolved-module-path.1 load?30_0 mod29_0)))))
+ (extract_1 m_36))))))))))))
(define-values
(1/module->language-info)
(let-values (((module->language-info_0)
@@ -66616,176 +64708,143 @@
'module->language-info
(let-values (((mod_9) mod11_0))
(let-values (((load?_6) load?10_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((module-language-info32_0) module-language-info)
- ((who33_0) 'module->language-info)
- ((mod34_0) mod_9)
- ((load?35_0) load?_6))
- (module->.1 void module-language-info32_0 who33_0 mod34_0 load?35_0)))))))))))
+ (let-values (((module-language-info32_0) module-language-info)
+ ((who33_0) 'module->language-info)
+ ((mod34_0) mod_9)
+ ((load?35_0) load?_6))
+ (module->.1 void module-language-info32_0 who33_0 mod34_0 load?35_0))))))))
(case-lambda
((mod_10) (begin 'module->language-info (module->language-info_0 mod_10 #f)))
((mod_11 load?10_1) (module->language-info_0 mod_11 load?10_1)))))
(define-values
(1/module->imports)
- (lambda (mod_3)
+ (lambda (mod_12)
(begin
'module->imports
- (let-values ()
- (let-values ()
- (let-values (((module-requires37_0) module-requires) ((who38_1) 'module->imports) ((mod39_0) mod_3))
- (module->.1 void module-requires37_0 who38_1 mod39_0 #f)))))))
+ (let-values (((module-requires37_0) module-requires) ((who38_1) 'module->imports) ((mod39_0) mod_12))
+ (module->.1 void module-requires37_0 who38_1 mod39_0 #f)))))
(define-values
(1/module->exports)
(let-values (((module->exports_0)
(lambda (mod13_0 verbosity12_0)
(begin
'module->exports
- (let-values (((mod_12) mod13_0))
+ (let-values (((mod_13) mod13_0))
(let-values (((verbosity_3) verbosity12_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values (((provides_15 self_30)
- (let-values (((temp41_8)
- (lambda (m_32)
- (values (module-provides m_32) (module-self m_32))))
- ((who42_0) 'module->exports)
- ((mod43_0) mod_12)
- ((temp44_3)
- (lambda ()
- (check-provides-verbosity 'module->exports verbosity_3))))
- (module->.1 temp44_3 temp41_8 who42_0 mod43_0 #f))))
- (provides->api-provides provides_15 self_30 verbosity_3)))))))))))
+ (let-values (((provides_16 self_35)
+ (let-values (((temp41_7)
+ (lambda (m_37) (values (module-provides m_37) (module-self m_37))))
+ ((who42_1) 'module->exports)
+ ((mod43_0) mod_13)
+ ((temp44_3)
+ (lambda ()
+ (check-provides-verbosity 'module->exports verbosity_3))))
+ (module->.1 temp44_3 temp41_7 who42_1 mod43_0 #f))))
+ (provides->api-provides provides_16 self_35 verbosity_3))))))))
(case-lambda
- ((mod_13) (begin 'module->exports (module->exports_0 mod_13 #f)))
- ((mod_14 verbosity12_1) (module->exports_0 mod_14 verbosity12_1)))))
+ ((mod_14) (begin 'module->exports (module->exports_0 mod_14 #f)))
+ ((mod_15 verbosity12_1) (module->exports_0 mod_15 verbosity12_1)))))
(define-values
(1/module->indirect-exports)
- (lambda (mod_15)
+ (lambda (mod_16)
(begin
'module->indirect-exports
- (let-values ()
- (let-values ()
- (let-values (((temp46_4)
- (lambda (m_33)
- (variables->api-nonprovides (module-provides m_33) ((module-get-all-variables m_33)))))
- ((who47_0) 'module->indirect-exports)
- ((mod48_0) mod_15))
- (module->.1 void temp46_4 who47_0 mod48_0 #f)))))))
+ (let-values (((temp46_6)
+ (lambda (m_38)
+ (variables->api-nonprovides (module-provides m_38) ((module-get-all-variables m_38)))))
+ ((who47_0) 'module->indirect-exports)
+ ((mod48_0) mod_16))
+ (module->.1 void temp46_6 who47_0 mod48_0 #f)))))
(define-values
(1/module-provide-protected?)
- (lambda (mod_16 sym_109)
+ (lambda (mod_17 sym_138)
(begin
'module-provide-protected?
- (let-values ()
- (let-values ()
- (let-values (((temp50_4)
- (lambda (m_34)
- (let-values (((b/p_3) (hash-ref (module-provides m_34) sym_109 #f)))
- (let-values (((or-part_529) (not b/p_3)))
- (if or-part_529 or-part_529 (provided-as-protected? b/p_3))))))
- ((who51_0) 'module-provide-protected?)
- ((mod52_0) mod_16))
- (module->.1 void temp50_4 who51_0 mod52_0 #f)))))))
+ (let-values (((temp50_5)
+ (lambda (m_39)
+ (let-values (((b/p_3) (hash-ref (module-provides m_39) sym_138 #f)))
+ (let-values (((or-part_880) (not b/p_3)))
+ (if or-part_880 or-part_880 (provided-as-protected? b/p_3))))))
+ ((who51_0) 'module-provide-protected?)
+ ((mod52_0) mod_17))
+ (module->.1 void temp50_5 who51_0 mod52_0 #f)))))
(define-values
(1/module->realm)
- (lambda (mod_17)
+ (lambda (mod_18)
(begin
'module->realm
- (let-values ()
- (let-values ()
- (let-values (((temp54_6) (lambda (m_35) (module-realm m_35))) ((who55_0) 'module->realm) ((mod56_0) mod_17))
- (module->.1 void temp54_6 who55_0 mod56_0 #f)))))))
+ (let-values (((temp54_3) (lambda (m_40) (module-realm m_40))) ((who55_0) 'module->realm) ((mod56_0) mod_18))
+ (module->.1 void temp54_3 who55_0 mod56_0 #f)))))
(define-values
(1/module->namespace)
(let-values (((module->namespace_0)
(lambda (mod15_0 ns14_3)
(begin
'module->namespace
- (let-values (((mod_18) mod15_0))
- (let-values (((ns_119) (if (eq? ns14_3 unsafe-undefined) (1/current-namespace) ns14_3)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (module-reference? mod_18)
- (void)
- (let-values ()
- (raise-argument-error
- 'module->namespace
- module-reference-str
- mod_18)))
- (values))))
- (let-values ((()
- (begin
- (if (1/namespace? ns_119)
- (void)
- (let-values ()
- (raise-argument-error 'module->namespace "namespace?" ns_119)))
- (values))))
- (let-values (((name_76)
- (let-values (((mod61_0) mod_18) ((temp62_3) #t))
- (reference->resolved-module-path.1 temp62_3 mod61_0))))
- (let-values (((phase_156) (namespace-phase ns_119)))
- (let-values (((m-ns_18)
- (let-values (((ns63_1) ns_119)
- ((name64_0) name_76)
- ((phase65_1) phase_156))
- (namespace->module-namespace.1
- #f
- #f
- void
- ns63_1
- name64_0
- phase65_1))))
+ (let-values (((mod_19) mod15_0))
+ (let-values (((ns_145) (if (eq? ns14_3 unsafe-undefined) (1/current-namespace) ns14_3)))
+ (let-values ((()
+ (begin
+ (if (module-reference? mod_19)
+ (void)
+ (raise-argument-error 'module->namespace module-reference-str mod_19))
+ (values))))
+ (let-values ((()
(begin
- (if m-ns_18
- (void)
- (let-values ()
- (begin
- (namespace->module/complain 'module->namespace ns_119 name_76)
- (raise-arguments-error
- 'module->namespace
- "module not instantiated in the current namespace"
- "name"
- name_76))))
- (if (inspector-superior?
- (current-code-inspector)
- (namespace-inspector m-ns_18))
+ (if (1/namespace? ns_145)
(void)
- (let-values ()
- (raise-arguments-error
- 'module->namespace
- "current code inspector cannot access namespace of module"
- "module name"
- name_76)))
- (if (namespace-get-root-expand-ctx m-ns_18)
- (void)
- (let-values ()
- (namespace-set-root-expand-ctx!
- m-ns_18
- (let-values (((temp66_6) (namespace-mpi m-ns_18)))
- (make-root-expand-context.1
- #f
- null
- unsafe-undefined
- unsafe-undefined
- temp66_6)))))
- (let-values (((ns58_0) ns_119)
- ((temp59_2) (namespace-mpi m-ns_18))
- ((phase60_0) phase_156))
- (namespace-module-make-available!.1
- unsafe-undefined
- ns58_0
- temp59_2
- phase60_0))
- m-ns_18)))))))))))))))
+ (raise-argument-error 'module->namespace "namespace?" ns_145))
+ (values))))
+ (let-values (((name_90)
+ (let-values (((mod61_0) mod_19) ((temp62_2) #t))
+ (reference->resolved-module-path.1 temp62_2 mod61_0))))
+ (let-values (((phase_197) (namespace-phase ns_145)))
+ (let-values (((m-ns_18)
+ (let-values (((ns63_1) ns_145)
+ ((name64_0) name_90)
+ ((phase65_2) phase_197))
+ (namespace->module-namespace.1 #f #f void ns63_1 name64_0 phase65_2))))
+ (begin
+ (if m-ns_18
+ (void)
+ (begin
+ (namespace->module/complain 'module->namespace ns_145 name_90)
+ (raise-arguments-error
+ 'module->namespace
+ "module not instantiated in the current namespace"
+ "name"
+ name_90)))
+ (if (inspector-superior? (current-code-inspector) (namespace-inspector m-ns_18))
+ (void)
+ (raise-arguments-error
+ 'module->namespace
+ "current code inspector cannot access namespace of module"
+ "module name"
+ name_90))
+ (if (namespace-get-root-expand-ctx m-ns_18)
+ (void)
+ (namespace-set-root-expand-ctx!
+ m-ns_18
+ (let-values (((temp66_5) (namespace-mpi m-ns_18)))
+ (make-root-expand-context.1
+ #f
+ null
+ unsafe-undefined
+ unsafe-undefined
+ temp66_5))))
+ (let-values (((ns58_0) ns_145)
+ ((temp59_2) (namespace-mpi m-ns_18))
+ ((phase60_0) phase_197))
+ (namespace-module-make-available!.1
+ #f
+ unsafe-undefined
+ ns58_0
+ temp59_2
+ phase60_0))
+ m-ns_18))))))))))))
(case-lambda
- ((mod_19) (begin 'module->namespace (module->namespace_0 mod_19 unsafe-undefined)))
- ((mod_20 ns14_4) (module->namespace_0 mod_20 ns14_4)))))
+ ((mod_20) (begin 'module->namespace (module->namespace_0 mod_20 unsafe-undefined)))
+ ((mod_21 ns14_4) (module->namespace_0 mod_21 ns14_4)))))
(define-values
(1/namespace-unprotect-module)
(let-values (((namespace-unprotect-module_0)
@@ -66793,376 +64852,344 @@
(begin
'namespace-unprotect-module
(let-values (((insp_27) insp17_0))
- (let-values (((mod_21) mod18_0))
- (let-values (((ns_120) (if (eq? ns16_3 unsafe-undefined) (1/current-namespace) ns16_3)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (inspector? insp_27)
- (void)
- (let-values ()
- (raise-argument-error
- 'namespace-unprotect-module
- "inspector?"
- insp_27)))
- (values))))
- (let-values ((()
- (begin
- (if (1/module-path? mod_21)
- (void)
- (let-values ()
- (raise-argument-error
- 'namespace-unprotect-module
- "module-path?"
- mod_21)))
- (values))))
- (let-values ((()
- (begin
- (if (1/namespace? ns_120)
- (void)
- (let-values ()
- (raise-argument-error
- 'namespace-unprotect-module
- "namespace?"
- ns_120)))
- (values))))
- (let-values (((name_77)
- (let-values (((mod68_0) mod_21) ((temp69_5) #f))
- (reference->resolved-module-path.1 temp69_5 mod68_0))))
- (let-values (((phase_111) (namespace-phase ns_120)))
- (let-values (((m-ns_19)
- (let-values (((ns70_1) ns_120)
- ((name71_0) name_77)
- ((phase72_0) phase_111))
- (namespace->module-namespace.1
- #f
- #f
- void
- ns70_1
- name71_0
- phase72_0))))
+ (let-values (((mod_22) mod18_0))
+ (let-values (((ns_146) (if (eq? ns16_3 unsafe-undefined) (1/current-namespace) ns16_3)))
+ (let-values ((()
+ (begin
+ (if (inspector? insp_27)
+ (void)
+ (raise-argument-error 'namespace-unprotect-module "inspector?" insp_27))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (1/module-path? mod_22)
+ (void)
+ (raise-argument-error 'namespace-unprotect-module "module-path?" mod_22))
+ (values))))
+ (let-values ((()
(begin
- (if m-ns_19
+ (if (1/namespace? ns_146)
(void)
- (let-values ()
- (raise-arguments-error
- 'namespace-unprotect-module
- "module not instantiated"
- "module name"
- name_77)))
- (if (inspector-superior? insp_27 (namespace-inspector m-ns_19))
- (let-values ()
- (set-namespace-inspector!
- m-ns_19
- (make-inspector (current-code-inspector))))
- (void)))))))))))))))))))
+ (raise-argument-error 'namespace-unprotect-module "namespace?" ns_146))
+ (values))))
+ (let-values (((name_91)
+ (let-values (((mod68_0) mod_22) ((temp69_5) #f))
+ (reference->resolved-module-path.1 temp69_5 mod68_0))))
+ (let-values (((phase_198) (namespace-phase ns_146)))
+ (let-values (((m-ns_19)
+ (let-values (((ns70_1) ns_146)
+ ((name71_0) name_91)
+ ((phase72_0) phase_198))
+ (namespace->module-namespace.1
+ #f
+ #f
+ void
+ ns70_1
+ name71_0
+ phase72_0))))
+ (begin
+ (if m-ns_19
+ (void)
+ (raise-arguments-error
+ 'namespace-unprotect-module
+ "module not instantiated"
+ "module name"
+ name_91))
+ (if (inspector-superior? insp_27 (namespace-inspector m-ns_19))
+ (set-namespace-inspector! m-ns_19 (make-inspector (current-code-inspector)))
+ (void))))))))))))))))
(case-lambda
- ((insp_28 mod_22)
- (begin 'namespace-unprotect-module (namespace-unprotect-module_0 insp_28 mod_22 unsafe-undefined)))
- ((insp_29 mod_23 ns16_4) (namespace-unprotect-module_0 insp_29 mod_23 ns16_4)))))
+ ((insp_28 mod_23)
+ (begin 'namespace-unprotect-module (namespace-unprotect-module_0 insp_28 mod_23 unsafe-undefined)))
+ ((insp_29 mod_24 ns16_4) (namespace-unprotect-module_0 insp_29 mod_24 ns16_4)))))
(define-values
(namespace->module/complain)
- (lambda (who_34 ns_121 name_53)
+ (lambda (who_48 ns_147 name_92)
(begin
- (let-values (((or-part_530) (namespace->module ns_121 name_53)))
- (if or-part_530
- or-part_530
- (raise-arguments-error who_34 "unknown module in the current namespace" "name" name_53))))))
+ (let-values (((or-part_881) (namespace->module ns_147 name_92)))
+ (if or-part_881
+ or-part_881
+ (raise-arguments-error who_48 "unknown module in the current namespace" "name" name_92))))))
(define-values
(module-reference?)
- (lambda (mod_24)
+ (lambda (mod_25)
(begin
- (let-values (((or-part_531) (1/module-path? mod_24)))
- (if or-part_531
- or-part_531
- (let-values (((or-part_52) (1/module-path-index? mod_24)))
- (if or-part_52 or-part_52 (1/resolved-module-path? mod_24))))))))
+ (let-values (((or-part_882) (1/module-path? mod_25)))
+ (if or-part_882
+ or-part_882
+ (let-values (((or-part_883) (1/module-path-index? mod_25)))
+ (if or-part_883 or-part_883 (1/resolved-module-path? mod_25))))))))
(define-values (module-reference-str) "(or/c module-path? module-path-index? resolved-module-path?)")
(define-values
(reference->resolved-module-path.1)
(lambda (load?19_0 mod21_0)
(begin
'reference->resolved-module-path
- (let-values (((mod_25) mod21_0))
+ (let-values (((mod_26) mod21_0))
(let-values (((load?_7) load?19_0))
- (let-values ()
- (if (1/resolved-module-path? mod_25)
- (let-values () mod_25)
- (let-values ()
- (let-values (((mpi_62) (if (1/module-path-index? mod_25) mod_25 (1/module-path-index-join mod_25 #f))))
- (1/module-path-index-resolve mpi_62 load?_7))))))))))
+ (if (1/resolved-module-path? mod_26)
+ mod_26
+ (let-values (((mpi_89) (if (1/module-path-index? mod_26) mod_26 (module-path-index-join* mod_26 #f))))
+ (1/module-path-index-resolve mpi_89 load?_7))))))))
(define-values
(read-linklet-bundle-or-directory)
- (lambda (in_5)
+ (lambda (in_107)
(begin
(letrec-values (((read-linklet-or-directory_0)
(lambda (initial?_0)
(begin
'read-linklet-or-directory
- (let-values (((start-pos_11) (- (file-position in_5) 2)))
- (let-values (((vers-len_0) (min 63 (read-byte in_5))))
- (let-values (((vers_0) (read-bytes vers-len_0 in_5)))
+ (let-values (((start-pos_11) (- (file-position in_107) 2)))
+ (let-values (((vers-len_0) (min 63 (read-byte in_107))))
+ (let-values (((vers_0) (read-bytes vers-len_0 in_107)))
(let-values ((()
(begin
(if (equal? vers_0 version-bytes$1)
(void)
- (let-values ()
- (raise-read-error
- '|loading code|
- "version mismatch"
- "expected"
- (version)
- "found"
- (bytes->string/utf-8 vers_0 '#\?)
- "in"
- (let-values (((n_57) (object-name in_5)))
- (if (path? n_57)
- (unquoted-printing-string (path->string n_57))
- in_5))
- "possible solution"
- (unquoted-printing-string
- "running `racket -y`, `raco make`, or `raco setup`"))))
+ (raise-read-error
+ '|loading code|
+ "version mismatch"
+ "expected"
+ (version)
+ "found"
+ (bytes->string/utf-8 vers_0 '#\?)
+ "in"
+ (let-values (((n_60) (object-name in_107)))
+ (if (path? n_60)
+ (unquoted-printing-string (path->string n_60))
+ in_107))
+ "possible solution"
+ (unquoted-printing-string
+ "running `racket -y`, `raco make`, or `raco setup`")))
(values))))
- (let-values (((vm-len_0) (min 63 (read-byte in_5))))
- (let-values (((vm_0) (read-bytes vm-len_0 in_5)))
+ (let-values (((vm-len_0) (min 63 (read-byte in_107))))
+ (let-values (((vm_0) (read-bytes vm-len_0 in_107)))
(let-values (((as-correlated-linklet?_3)
(equal? vm_0 correlated-linklet-vm-bytes)))
(let-values ((()
(begin
- (if (let-values (((or-part_13) as-correlated-linklet?_3))
- (if or-part_13 or-part_13 (equal? vm_0 vm-bytes$1)))
+ (if (let-values (((or-part_884) as-correlated-linklet?_3))
+ (if or-part_884
+ or-part_884
+ (let-values (((or-part_885) (equal? vm_0 vm-bytes$1)))
+ (if or-part_885
+ or-part_885
+ (equal?
+ (equal? vm_0 #"racket")
+ (equal? vm-bytes$1 #"racket"))))))
(void)
- (let-values ()
- (raise-read-error
- '|loading code|
- "virtual-machine mismatch"
- "expected"
- (bytes->string/utf-8 vm-bytes$1)
- "found"
- (bytes->string/utf-8 vm_0 '#\?)
- "in"
- (let-values (((n_58) (object-name in_5)))
- (if (path? n_58)
- (unquoted-printing-string (path->string n_58))
- in_5)))))
- (values))))
- (let-values (((tag_1) (read-byte in_5)))
- (if (eqv? tag_1 (char->integer '#\B))
- (let-values ()
- (let-values (((sha-1_0) (read-bytes 20 in_5)))
- (let-values (((b-ht_0)
- (if as-correlated-linklet?_3
- (read-correlated-linklet-bundle-hash in_5)
- (1/read-linklet-bundle-hash in_5))))
- (begin
- (if (hash? b-ht_0)
- (void)
- (let-values ()
(raise-read-error
- 'read-linklet-bundle-hash
- "bad read result"
+ '|loading code|
+ "machine mismatch"
"expected"
- "hash/c"
+ (bytes->string/utf-8 vm-bytes$1)
"found"
- (format "~s" b-ht_0)
+ (bytes->string/utf-8 vm_0 '#\?)
"in"
- (let-values (((n_59) (object-name in_5)))
- (if (path? n_59) (path->string n_59) in_5)))))
- (1/hash->linklet-bundle
- (add-hash-code
- (if initial?_0 (strip-submodule-references b-ht_0) b-ht_0)
- sha-1_0))))))
- (if (eqv? tag_1 (char->integer '#\D))
- (let-values ()
+ (let-values (((n_61) (object-name in_107)))
+ (if (path? n_61)
+ (unquoted-printing-string (path->string n_61))
+ in_107))))
+ (values))))
+ (let-values (((tag_1) (read-byte in_107)))
+ (if (eqv? tag_1 (char->integer '#\B))
+ (let-values (((sha-1_0) (read-bytes 20 in_107)))
+ (let-values (((b-ht_0)
+ (if as-correlated-linklet?_3
+ (read-correlated-linklet-bundle-hash in_107)
+ (1/read-linklet-bundle-hash
+ in_107
+ (if (not (equal? vm_0 vm-bytes$1))
+ (string->symbol (bytes->string/utf-8 vm_0 '#\?))
+ #f)))))
(begin
- (if initial?_0
+ (if (hash? b-ht_0)
(void)
- (let-values ()
- (raise-read-error
- 'read-compiled-linklet
- "expected a linklet bundle")))
- (read-bundle-directory_0 start-pos_11)))
- (let-values ()
- (raise-read-error
- 'read-compiled-linklet
- "expected a `B` or `D`"))))))))))))))))
+ (raise-read-error
+ 'read-linklet-bundle-hash
+ "bad read result"
+ "expected"
+ "hash/c"
+ "found"
+ (format "~s" b-ht_0)
+ "in"
+ (let-values (((n_62) (object-name in_107)))
+ (if (path? n_62) (path->string n_62) in_107))))
+ (1/hash->linklet-bundle
+ (add-hash-code
+ (if initial?_0 (strip-submodule-references b-ht_0) b-ht_0)
+ sha-1_0)))))
+ (if (eqv? tag_1 (char->integer '#\D))
+ (begin
+ (if initial?_0
+ (void)
+ (raise-read-error
+ 'read-compiled-linklet
+ "expected a linklet bundle"))
+ (read-bundle-directory_0 start-pos_11))
+ (raise-read-error
+ 'read-compiled-linklet
+ "expected a `B` or `D`")))))))))))))))
((read-bundle-directory_0)
- (lambda (pos_135)
+ (lambda (pos_189)
(begin
'read-bundle-directory
- (let-values (((count_1) (read-int in_5)))
+ (let-values (((count_1) (read-int in_107)))
(let-values (((position-to-name_0)
- ((letrec-values (((loop_112)
- (lambda (count_2 accum_10)
+ ((letrec-values (((loop_146)
+ (lambda (count_2 accum_16)
(begin
'loop
(if (zero? count_2)
- (let-values () accum_10)
- (let-values ()
- (let-values (((bstr_25)
- (read-bytes (read-int in_5) in_5)))
- (let-values (((offset_6) (read-int in_5)))
- (let-values (((len_70) (read-int in_5)))
- (begin
- (read-int in_5)
- (read-int in_5)
- (loop_112
- (sub1 count_2)
- (hash-set
- accum_10
- offset_6
- bstr_25))))))))))))
- loop_112)
+ accum_16
+ (let-values (((bstr_25)
+ (read-bytes (read-int in_107) in_107)))
+ (let-values (((offset_6) (read-int in_107)))
+ (let-values (((len_77) (read-int in_107)))
+ (begin
+ (read-int in_107)
+ (read-int in_107)
+ (loop_146
+ (sub1 count_2)
+ (hash-set
+ accum_16
+ offset_6
+ bstr_25)))))))))))
+ loop_146)
count_1
(hasheqv))))
- ((letrec-values (((loop_119)
- (lambda (count_3 accum_13)
+ ((letrec-values (((loop_147)
+ (lambda (count_3 accum_17)
(begin
- 'loop
- (if (zero? count_3)
- (let-values ()
- (list->bundle-directory accum_13 1/hash->linklet-directory))
- (let-values ()
- (let-values (((name_78)
- (hash-ref
- position-to-name_0
- (- (file-position in_5) pos_135)
- #f)))
- (let-values ((()
- (begin
- (if name_78
- (void)
- (let-values ()
+ 'loop
+ (if (zero? count_3)
+ (list->bundle-directory accum_17 1/hash->linklet-directory)
+ (let-values (((name_93)
+ (hash-ref
+ position-to-name_0
+ (- (file-position in_107) pos_189)
+ #f)))
+ (let-values ((()
+ (begin
+ (if name_93
+ (void)
+ (raise-read-error
+ 'read-compiled-linklet
+ "bundle not at an expected file position"))
+ (values))))
+ (let-values (((bstr_26) (read-bytes 2 in_107)))
+ (let-values (((bundle_17)
+ (if (equal? #"#~" bstr_26)
+ (read-linklet-or-directory_0 #f)
+ (if (equal? #"#f" bstr_26)
+ #f
(raise-read-error
'read-compiled-linklet
- "bundle not at an expected file position")))
- (values))))
- (let-values (((bstr_26) (read-bytes 2 in_5)))
- (let-values (((bundle_17)
- (if (equal? #"#~" bstr_26)
- (let-values ()
- (read-linklet-or-directory_0 #f))
- (if (equal? #"#f" bstr_26)
- (let-values () #f)
- (let-values ()
- (raise-read-error
- 'read-compiled-linklet
- "expected a `#~` or `#f` for a bundle"))))))
- (loop_119
- (sub1 count_3)
- (cons
- (cons (decode-name name_78 0) bundle_17)
- accum_13))))))))))))
- loop_119)
+ "expected a `#~` or `#f` for a bundle")))))
+ (loop_147
+ (sub1 count_3)
+ (cons
+ (cons (decode-name name_93 0) bundle_17)
+ accum_17)))))))))))
+ loop_147)
count_1
'())))))))
(read-linklet-or-directory_0 #t)))))
- (define-values (read-int) (lambda (in_80) (begin (integer-bytes->integer (read-bytes 4 in_80) #f #f))))
+ (define-values (read-int) (lambda (in_108) (begin (integer-bytes->integer (read-bytes 4 in_108) #f #f))))
(define-values
(decode-name)
- (lambda (bstr_27 pos_146)
+ (lambda (bstr_27 pos_190)
(begin
(let-values (((blen_0) (bytes-length bstr_27)))
(let-values (((bad-bundle_0)
(lambda () (begin 'bad-bundle (raise-read-error 'read-compiled-linklet "malformed bundle")))))
- (if (= pos_146 blen_0)
- (let-values () '())
- (if (> pos_146 blen_0)
- (let-values () (bad-bundle_0))
- (let-values ()
- (let-values (((len_71) (bytes-ref bstr_27 pos_146)))
- (begin
- (if (> (+ pos_146 len_71 1) blen_0) (let-values () (bad-bundle_0)) (void))
- (if (= len_71 255)
- (let-values ()
- (let-values (((len_72) (integer-bytes->integer bstr_27 #f #f (add1 pos_146) (+ pos_146 5))))
- (begin
- (if (> (+ pos_146 len_72 1) blen_0) (let-values () (bad-bundle_0)) (void))
- (cons
- (string->symbol
- (bytes->string/utf-8 (subbytes bstr_27 (+ pos_146 5) (+ pos_146 5 len_72)) '#\?))
- (decode-name bstr_27 (+ pos_146 5 len_72))))))
- (let-values ()
+ (if (= pos_190 blen_0)
+ '()
+ (if (> pos_190 blen_0)
+ (bad-bundle_0)
+ (let-values (((len_78) (bytes-ref bstr_27 pos_190)))
+ (begin
+ (if (> (+ pos_190 len_78 1) blen_0) (bad-bundle_0) (void))
+ (if (= len_78 255)
+ (let-values (((len_79) (integer-bytes->integer bstr_27 #f #f (add1 pos_190) (+ pos_190 5))))
+ (begin
+ (if (> (+ pos_190 len_79 1) blen_0) (bad-bundle_0) (void))
(cons
(string->symbol
- (bytes->string/utf-8 (subbytes bstr_27 (add1 pos_146) (+ pos_146 1 len_71)) '#\?))
- (decode-name bstr_27 (+ pos_146 1 len_71)))))))))))))))
+ (bytes->string/utf-8 (subbytes bstr_27 (+ pos_190 5) (+ pos_190 5 len_79)) '#\?))
+ (decode-name bstr_27 (+ pos_190 5 len_79)))))
+ (cons
+ (string->symbol (bytes->string/utf-8 (subbytes bstr_27 (add1 pos_190) (+ pos_190 1 len_78)) '#\?))
+ (decode-name bstr_27 (+ pos_190 1 len_78)))))))))))))
(define-values
(list->bundle-directory)
- (lambda (l_11 hash->linklet-directory_0)
+ (lambda (l_88 hash->linklet-directory_0)
(begin
- ((letrec-values (((loop_126)
- (lambda (l_71 prev-len_1 stack_0 accum_14)
+ ((letrec-values (((loop_148)
+ (lambda (l_89 prev-len_1 stack_0 accum_18)
(begin
'loop
(begin
- (if (null? l_71)
- (let-values () (raise-read-error 'read-compiled-linklet "invalid bundle sequence"))
+ (if (null? l_89)
+ (raise-read-error 'read-compiled-linklet "invalid bundle sequence")
(void))
- (let-values (((p_79) (car l_71)))
- (let-values (((path_15) (car p_79)))
- (let-values (((v_221) (cdr p_79)))
- (let-values (((len_73) (length path_15)))
+ (let-values (((p_109) (car l_89)))
+ (let-values (((path_15) (car p_109)))
+ (let-values (((v_406) (cdr p_109)))
+ (let-values (((len_80) (length path_15)))
(begin
- (if (< len_73 prev-len_1)
- (let-values ()
- (raise-read-error 'read-compiled-linklet "invalid bundle sequence"))
+ (if (< len_80 prev-len_1)
+ (raise-read-error 'read-compiled-linklet "invalid bundle sequence")
(void))
((letrec-values (((sloop_0)
- (lambda (prev-len_2 stack_1 accum_15)
+ (lambda (prev-len_2 stack_1 accum_19)
(begin
'sloop
- (if (> len_73 (add1 prev-len_2))
- (let-values ()
- (sloop_0
- (add1 prev-len_2)
- (cons accum_15 stack_1)
- (hasheq)))
- (let-values ()
- (let-values (((path_16)
- (list-tail
- path_15
- (max 0 (sub1 prev-len_2)))))
- (if (= len_73 prev-len_2)
- (let-values ()
- (let-values (((accum_16)
- (if v_221
- (hash-set accum_15 #f v_221)
- accum_15)))
- (if (zero? len_73)
- (hash->linklet-directory_0 accum_16)
- (loop_126
- (cdr l_71)
- (sub1 prev-len_2)
- (cdr stack_1)
- (hash-set
- (car stack_1)
- (car path_16)
- (hash->linklet-directory_0 accum_16))))))
- (let-values ()
- (let-values (((path_17)
- (if (positive? prev-len_2)
- (cdr path_16)
- path_16)))
- (loop_126
- (cdr l_71)
- prev-len_2
- stack_1
- (hash-set
- accum_15
- (car path_17)
- (hash->linklet-directory_0
- (if v_221
- (hasheq #f v_221)
- (hasheq)))))))))))))))
+ (if (> len_80 (add1 prev-len_2))
+ (sloop_0
+ (add1 prev-len_2)
+ (cons accum_19 stack_1)
+ (hasheq))
+ (let-values (((path_16)
+ (list-tail
+ path_15
+ (max 0 (sub1 prev-len_2)))))
+ (if (= len_80 prev-len_2)
+ (let-values (((accum_20)
+ (if v_406
+ (hash-set accum_19 #f v_406)
+ accum_19)))
+ (if (zero? len_80)
+ (hash->linklet-directory_0 accum_20)
+ (loop_148
+ (cdr l_89)
+ (sub1 prev-len_2)
+ (cdr stack_1)
+ (hash-set
+ (car stack_1)
+ (car path_16)
+ (hash->linklet-directory_0 accum_20)))))
+ (let-values (((path_17)
+ (if (positive? prev-len_2)
+ (cdr path_16)
+ path_16)))
+ (loop_148
+ (cdr l_89)
+ prev-len_2
+ stack_1
+ (hash-set
+ accum_19
+ (car path_17)
+ (hash->linklet-directory_0
+ (if v_406
+ (hasheq #f v_406)
+ (hasheq)))))))))))))
sloop_0)
prev-len_1
stack_0
- accum_14)))))))))))
- loop_126)
- l_11
+ accum_18)))))))))))
+ loop_148)
+ l_88
0
'()
(hasheq)))))
@@ -67174,136 +65201,131 @@
(if (bytes=? sha-1_1 #"\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0") b-ht_2 (hash-set b-ht_2 'hash-code sha-1_1)))))
(define-values
(raise-read-error)
- (lambda (who_35 msg_1 . details_0)
+ (lambda (who_49 msg_1 . details_0)
(begin
(raise
(exn:fail:read
(apply
string-append
- (format "~a: ~a" who_35 msg_1)
- ((letrec-values (((loop_105)
+ (format "~a: ~a" who_49 msg_1)
+ ((letrec-values (((loop_149)
(lambda (details_1)
(begin
'loop
(if (null? details_1)
- (let-values () null)
- (let-values ()
- (list*
- "\n "
- (car details_1)
- ": "
- (format "~v" (cadr details_1))
- (loop_105 (cddr details_1)))))))))
- loop_105)
+ null
+ (list*
+ "\n "
+ (car details_1)
+ ": "
+ (format "~v" (cadr details_1))
+ (loop_149 (cddr details_1))))))))
+ loop_149)
details_0))
(current-continuation-marks)
null)))))
(define-values
(read-syntax$1)
- (lambda (src_2 in_26)
+ (lambda (src_2 in_109)
(begin
'read-syntax
- (if (default-read-handler? in_26)
- (let-values ()
- (begin
- (maybe-flush-stdout in_26)
- (let-values (((in18_1) in_26) ((temp19_7) #t) ((src20_0) src_2))
- (read*.1 temp19_7 #f #f unsafe-undefined #f src20_0 in18_1))))
- (let-values () (values ((port-read-handler in_26) in_26 src_2)))))))
+ (if (default-read-handler? in_109)
+ (begin
+ (maybe-flush-stdout in_109)
+ (let-values (((in18_1) in_109) ((temp19_10) #t) ((src20_0) src_2))
+ (read*.1 temp19_10 #f #f unsafe-undefined #f src20_0 in18_1)))
+ (values ((port-read-handler in_109) in_109 src_2))))))
(define-values
(read-syntax/recursive$1)
- (lambda (src_3 in_31 start_73 readtable_4 graph?_1)
+ (lambda (src_3 in_110 start_86 readtable_4 graph?_1)
(begin
'read-syntax/recursive
- (let-values (((in21_4) in_31)
+ (let-values (((in21_4) in_110)
((temp22_6) #t)
((temp23_8) #t)
((src24_0) src_3)
- ((start25_0) start_73)
+ ((start25_0) start_86)
((readtable26_0) readtable_4)
- ((temp27_5) (not graph?_1)))
- (read*.1 temp22_6 start25_0 temp27_5 readtable26_0 temp23_8 src24_0 in21_4)))))
+ ((temp27_4) (not graph?_1)))
+ (read*.1 temp22_6 start25_0 temp27_4 readtable26_0 temp23_8 src24_0 in21_4)))))
(define-values
(read$1)
- (lambda (in_33)
+ (lambda (in_111)
(begin
'read
- (if (default-read-handler? in_33)
- (let-values ()
- (begin
- (maybe-flush-stdout in_33)
- (let-values (((in28_1) in_33) ((temp29_6) #f)) (read*.1 temp29_6 #f #f unsafe-undefined #f #f in28_1))))
- (let-values () (values ((port-read-handler in_33) in_33)))))))
+ (if (default-read-handler? in_111)
+ (begin
+ (maybe-flush-stdout in_111)
+ (let-values (((in28_1) in_111) ((temp29_4) #f)) (read*.1 temp29_4 #f #f unsafe-undefined #f #f in28_1)))
+ (values ((port-read-handler in_111) in_111))))))
(define-values
(read/recursive$1)
- (lambda (in_44 start_74 readtable_5 graph?_2)
+ (lambda (in_112 start_87 readtable_5 graph?_2)
(begin
'read/recursive
- (let-values (((in30_0) in_44)
- ((temp31_6) #f)
- ((temp32_8) #t)
- ((start33_0) start_74)
+ (let-values (((in30_0) in_112)
+ ((temp31_8) #f)
+ ((temp32_7) #t)
+ ((start33_0) start_87)
((readtable34_0) readtable_5)
- ((temp35_2) (not graph?_2)))
- (read*.1 temp31_6 start33_0 temp35_2 readtable34_0 temp32_8 #f in30_0)))))
+ ((temp35_3) (not graph?_2)))
+ (read*.1 temp31_8 start33_0 temp35_3 readtable34_0 temp32_7 #f in30_0)))))
(define-values
(read*.1)
(lambda (for-syntax?1_0 init-c4_0 local-graph?6_1 readtable5_0 recursive?2_0 source3_0 in13_2)
(begin
'read*
- (let-values (((in_81) in13_2))
+ (let-values (((in_113) in13_2))
(let-values (((for-syntax?_11) for-syntax?1_0))
(let-values (((recursive?_1) recursive?2_0))
- (let-values (((source_53) source3_0))
- (let-values (((init-c_20) init-c4_0))
+ (let-values (((source_59) source3_0))
+ (let-values (((init-c_23) init-c4_0))
(let-values (((readtable_6)
(if (eq? readtable5_0 unsafe-undefined) (1/current-readtable) readtable5_0)))
(let-values (((local-graph?_2) local-graph?6_1))
- (let-values ()
- (begin
- (if log-performance? (let-values () (start-performance-region 'read)) (void))
- (begin0
- (let-values ()
- (let-values (((in36_0) in_81)
- ((for-syntax?37_0) for-syntax?_11)
- ((recursive?38_0) recursive?_1)
- ((source39_0) source_53)
- ((temp40_4) (if for-syntax?_11 read-to-syntax #f))
- ((init-c41_0) init-c_20)
- ((readtable42_0) readtable_6)
- ((local-graph?43_0) local-graph?_2)
- ((read-linklet-bundle-or-directory44_0) read-linklet-bundle-or-directory)
- ((call-with-root-namespace45_0) call-with-root-namespace)
- ((locked-dynamic-require46_0) locked-dynamic-require)
- ((read-module-declared?47_0) read-module-declared?)
- ((read-coerce48_0) read-coerce)
- ((read-coerce-key49_0) read-coerce-key))
- (read.1
- call-with-root-namespace45_0
- read-coerce48_0
- read-coerce-key49_0
- locked-dynamic-require46_0
- for-syntax?37_0
- init-c41_0
- unsafe-undefined
- local-graph?43_0
- read-module-declared?47_0
- unsafe-undefined
- read-linklet-bundle-or-directory44_0
- readtable42_0
- recursive?38_0
- source39_0
- temp40_4
- in36_0)))
- (if log-performance? (let-values () (end-performance-region)) (void)))))))))))))))
+ (begin
+ (if log-performance? (start-performance-region 'read) (void))
+ (begin0
+ (let-values (((in36_0) in_113)
+ ((for-syntax?37_0) for-syntax?_11)
+ ((recursive?38_0) recursive?_1)
+ ((source39_0) source_59)
+ ((temp40_4) (if for-syntax?_11 read-to-syntax #f))
+ ((init-c41_0) init-c_23)
+ ((readtable42_0) readtable_6)
+ ((local-graph?43_0) local-graph?_2)
+ ((read-linklet-bundle-or-directory44_0) read-linklet-bundle-or-directory)
+ ((call-with-root-namespace45_0) call-with-root-namespace)
+ ((locked-dynamic-require46_0) locked-dynamic-require)
+ ((read-module-declared?47_0) read-module-declared?)
+ ((read-coerce48_0) read-coerce)
+ ((read-coerce-key49_0) read-coerce-key))
+ (read.1
+ call-with-root-namespace45_0
+ read-coerce48_0
+ read-coerce-key49_0
+ locked-dynamic-require46_0
+ for-syntax?37_0
+ init-c41_0
+ unsafe-undefined
+ local-graph?43_0
+ read-module-declared?47_0
+ unsafe-undefined
+ read-linklet-bundle-or-directory44_0
+ readtable42_0
+ recursive?38_0
+ source39_0
+ temp40_4
+ in36_0))
+ (if log-performance? (end-performance-region) (void))))))))))))))
(define-values
(read-language$1)
- (lambda (in_82 fail-thunk_0)
+ (lambda (in_114 fail-thunk_0)
(begin
'read-language
- (let-values (((in50_2) in_82)
+ (let-values (((in50_2) in_114)
((fail-thunk51_0) fail-thunk_0)
- ((temp52_6) #t)
+ ((temp52_4) #t)
((read-to-syntax53_0) read-to-syntax)
((read-linklet-bundle-or-directory54_0) read-linklet-bundle-or-directory)
((call-with-root-namespace55_0) call-with-root-namespace)
@@ -67316,7 +65338,7 @@
read-coerce58_0
read-coerce-key59_0
locked-dynamic-require56_0
- temp52_6
+ temp52_4
read-module-declared?57_0
read-linklet-bundle-or-directory54_0
read-to-syntax53_0
@@ -67326,26 +65348,24 @@
(read-to-syntax)
(lambda (s-exp_4 srcloc_17 rep_1)
(begin
- (let-values (((the-struct_85) empty-syntax))
- (if (syntax?$1 the-struct_85)
+ (let-values (((the-struct_93) empty-syntax))
+ (if (syntax?$1 the-struct_93)
(let-values (((content*60_1) (datum-intern-literal s-exp_4))
((srcloc61_0) srcloc_17)
((props62_0)
- (let-values (((tmp_24) rep_1))
- (if (equal? tmp_24 '#\[)
- (let-values () original-square-props)
- (if (equal? tmp_24 '#\{)
- (let-values () original-curly-props)
- (let-values () original-props))))))
+ (let-values (((tmp_84) rep_1))
+ (if (equal? tmp_84 '#\[)
+ original-square-props
+ (if (equal? tmp_84 '#\{) original-curly-props original-props)))))
(syntax2.1
content*60_1
- (syntax-scopes the-struct_85)
- (syntax-shifted-multi-scopes the-struct_85)
- (syntax-mpi-shifts the-struct_85)
+ (syntax-scopes the-struct_93)
+ (syntax-shifted-multi-scopes the-struct_93)
+ (syntax-mpi-shifts the-struct_93)
srcloc61_0
props62_0
- (syntax-inspector the-struct_85)))
- (raise-argument-error 'struct-copy "syntax?" the-struct_85))))))
+ (syntax-inspector the-struct_93)))
+ (raise-argument-error 'struct-copy "syntax?" the-struct_93))))))
(define-values (original-props) (syntax-props (syntax-property$1 empty-syntax original-property-sym #t)))
(define-values
(original-square-props)
@@ -67353,106 +65373,96 @@
(define-values
(original-curly-props)
(syntax-props (syntax-property$1 (syntax-property$1 empty-syntax original-property-sym #t) 'paren-shape '#\{)))
- (define-values (read-module-declared?) (lambda (mod-path_29) (begin (1/module-declared? mod-path_29 #t))))
+ (define-values (read-module-declared?) (lambda (mod-path_35) (begin (1/module-declared? mod-path_35 #t))))
(define-values
(read-coerce)
- (lambda (for-syntax?_12 v_214 srcloc_18)
+ (lambda (for-syntax?_12 v_407 srcloc_18)
(begin
(if (not for-syntax?_12)
- (let-values () (if (syntax?$1 v_214) (let-values () (syntax->datum$1 v_214)) (let-values () v_214)))
- (if (syntax?$1 v_214)
- (let-values () v_214)
- (if (list? v_214)
- (let-values ()
- (read-to-syntax
- (reverse$1
- (let-values (((lst_322) v_214))
+ (if (syntax?$1 v_407) (syntax->datum$1 v_407) v_407)
+ (if (syntax?$1 v_407)
+ v_407
+ (if (list? v_407)
+ (read-to-syntax
+ (reverse$1
+ (let-values (((fold-var_610) (let-values (((fold-var_611) null)) fold-var_611)))
+ (let-values (((lst_550) v_407))
(begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_322)))
- ((letrec-values (((for-loop_295)
- (lambda (fold-var_303 lst_207)
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_550))
+ ((letrec-values (((for-loop_451)
+ (lambda (fold-var_612 lst_551)
(begin
'for-loop
- (if (pair? lst_207)
- (let-values (((e_96) (unsafe-car lst_207))
- ((rest_181) (unsafe-cdr lst_207)))
- (let-values (((fold-var_261)
- (let-values (((fold-var_304) fold-var_303))
- (let-values (((fold-var_305)
- (let-values ()
- (cons
- (let-values ()
- (read-coerce #t e_96 srcloc_18))
- fold-var_304))))
- (values fold-var_305)))))
- (if (not #f) (for-loop_295 fold-var_261 rest_181) fold-var_261)))
- fold-var_303)))))
- for-loop_295)
- null
- lst_322))))
+ (if (pair? lst_551)
+ (let-values (((e_105) (unsafe-car lst_551))
+ ((rest_271) (unsafe-cdr lst_551)))
+ (let-values (((fold-var_613)
+ (let-values (((fold-var_614)
+ (cons
+ (read-coerce #t e_105 srcloc_18)
+ fold-var_612)))
+ (values fold-var_614))))
+ (if (not #f) (for-loop_451 fold-var_613 rest_271) fold-var_613)))
+ fold-var_612)))))
+ for-loop_451)
+ fold-var_610
+ lst_550)))))
+ srcloc_18
+ #f)
+ (if (pair? v_407)
+ (read-to-syntax
+ (cons (read-coerce #t (car v_407) srcloc_18) (read-coerce #t (cdr v_407) srcloc_18))
srcloc_18
- #f))
- (if (pair? v_214)
- (let-values ()
- (read-to-syntax
- (cons (read-coerce #t (car v_214) srcloc_18) (read-coerce #t (cdr v_214) srcloc_18))
- srcloc_18
- #f))
- (let-values () (read-to-syntax v_214 srcloc_18 #f)))))))))
+ #f)
+ (read-to-syntax v_407 srcloc_18 #f))))))))
(define-values
(read-coerce-key)
- (lambda (for-syntax?_13 k_27)
- (begin (if for-syntax?_13 (let-values () (datum-intern-literal k_27)) (let-values () k_27)))))
+ (lambda (for-syntax?_13 k_67) (begin (if for-syntax?_13 (datum-intern-literal k_67) k_67))))
(define-values (default-read-handler) #f)
(define-values
(default-read-handler?)
- (lambda (in_83)
+ (lambda (in_115)
(begin
(if (not default-read-handler)
- (let-values () (begin (set! default-read-handler (port-read-handler in_83)) #t))
- (let-values () (eq? default-read-handler (port-read-handler in_83)))))))
+ (begin (set! default-read-handler (port-read-handler in_115)) #t)
+ (eq? default-read-handler (port-read-handler in_115))))))
(define-values (orig-input-port) (current-input-port))
(define-values (orig-output-port) (current-output-port))
(define-values (orig-error-port) (current-error-port))
(define-values
(maybe-flush-stdout)
- (lambda (in_84)
+ (lambda (in_116)
(begin
- (if (eq? in_84 orig-input-port)
- (let-values () (begin (flush-output orig-output-port) (flush-output orig-error-port)))
- (void)))))
+ (if (eq? in_116 orig-input-port) (begin (flush-output orig-output-port) (flush-output orig-error-port)) (void)))))
(define-values
(call-with-root-namespace)
- (lambda (thunk_10)
+ (lambda (thunk_9)
(begin
(let-values (((root-ns_0) (namespace-root-namespace (1/current-namespace))))
(if root-ns_0
(with-continuation-mark
parameterization-key
(extend-parameterization (continuation-mark-set-first #f parameterization-key) 1/current-namespace root-ns_0)
- (let-values () (thunk_10)))
- (thunk_10))))))
+ (thunk_9))
+ (thunk_9))))))
(define-values
(locked-dynamic-require)
(let-values (((locked-dynamic-require_0)
(lambda (mod16_0 sym17_0 fail-thunk15_0)
(begin
'locked-dynamic-require
- (let-values (((mod_26) mod16_0))
- (let-values (((sym_107) sym17_0))
+ (let-values (((mod_27) mod16_0))
+ (let-values (((sym_139) sym17_0))
(let-values (((fail-thunk_1) fail-thunk15_0))
- (let-values ()
- (registry-call-with-lock
- (namespace-module-registry$1 (1/current-namespace))
- (lambda ()
- (if fail-thunk_1
- (1/dynamic-require mod_26 sym_107 fail-thunk_1)
- (1/dynamic-require mod_26 sym_107))))))))))))
+ (registry-call-with-lock
+ (namespace-module-registry$1 (1/current-namespace))
+ (lambda ()
+ (if fail-thunk_1
+ (1/dynamic-require mod_27 sym_139 fail-thunk_1)
+ (1/dynamic-require mod_27 sym_139)))))))))))
(case-lambda
- ((mod_20 sym_80) (begin (locked-dynamic-require_0 mod_20 sym_80 #f)))
- ((mod_27 sym_110 fail-thunk15_1) (locked-dynamic-require_0 mod_27 sym_110 fail-thunk15_1)))))
+ ((mod_28 sym_140) (begin (locked-dynamic-require_0 mod_28 sym_140 #f)))
+ ((mod_29 sym_141 fail-thunk15_1) (locked-dynamic-require_0 mod_29 sym_141 fail-thunk15_1)))))
(define-values
(1/read-syntax)
(let-values (((read-syntax_0)
@@ -67460,15 +65470,10 @@
(begin
'read-syntax
(let-values (((src_4) (if (eq? src1_0 unsafe-undefined) (object-name (current-input-port)) src1_0)))
- (let-values (((in_50) (if (eq? in2_1 unsafe-undefined) (current-input-port) in2_1)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (input-port? in_50)
- (void)
- (let-values () (raise-argument-error 'read-syntax "input-port?" in_50)))
- (read-syntax$1 src_4 in_50)))))))))))
+ (let-values (((in_117) (if (eq? in2_1 unsafe-undefined) (current-input-port) in2_1)))
+ (begin
+ (if (input-port? in_117) (void) (raise-argument-error 'read-syntax "input-port?" in_117))
+ (read-syntax$1 src_4 in_117))))))))
(case-lambda
(() (begin 'read-syntax (read-syntax_0 unsafe-undefined unsafe-undefined)))
((src_5 in2_2) (read-syntax_0 src_5 in2_2))
@@ -67480,43 +65485,35 @@
(begin
'read-syntax/recursive
(let-values (((src_6) (if (eq? src3_0 unsafe-undefined) (object-name (current-input-port)) src3_0)))
- (let-values (((in_64) (if (eq? in4_2 unsafe-undefined) (current-input-port) in4_2)))
- (let-values (((start_75) start5_0))
- (let-values (((readtable_0)
+ (let-values (((in_118) (if (eq? in4_2 unsafe-undefined) (current-input-port) in4_2)))
+ (let-values (((start_88) start5_0))
+ (let-values (((readtable_7)
(if (eq? readtable6_1 unsafe-undefined) (1/current-readtable) readtable6_1)))
(let-values (((graph?_3) graph?7_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (input-port? in_64)
- (void)
- (let-values ()
- (raise-argument-error 'read-syntax/recursive "input-port?" in_64)))
- (if ((lambda (x_100)
- (let-values (((or-part_86) (not x_100)))
- (if or-part_86 or-part_86 (char? x_100))))
- start_75)
- (void)
- (let-values ()
- (raise-argument-error 'read-syntax/recursive "(or/c char? #f)" start_75)))
- (if ((lambda (x_101)
- (let-values (((or-part_87) (not x_101)))
- (if or-part_87 or-part_87 (1/readtable? x_101))))
- readtable_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'read-syntax/recursive
- "(or/c readtable? #f)"
- readtable_0)))
- (read-syntax/recursive$1 src_6 in_64 start_75 readtable_0 graph?_3))))))))))))))
+ (begin
+ (if (input-port? in_118)
+ (void)
+ (raise-argument-error 'read-syntax/recursive "input-port?" in_118))
+ (if ((lambda (x_109)
+ (let-values (((or-part_886) (not x_109)))
+ (if or-part_886 or-part_886 (char? x_109))))
+ start_88)
+ (void)
+ (raise-argument-error 'read-syntax/recursive "(or/c char? #f)" start_88))
+ (if ((lambda (x_110)
+ (let-values (((or-part_887) (not x_110)))
+ (if or-part_887 or-part_887 (1/readtable? x_110))))
+ readtable_7)
+ (void)
+ (raise-argument-error 'read-syntax/recursive "(or/c readtable? #f)" readtable_7))
+ (read-syntax/recursive$1 src_6 in_118 start_88 readtable_7 graph?_3)))))))))))
(case-lambda
(()
(begin 'read-syntax/recursive (read-syntax/recursive_0 unsafe-undefined unsafe-undefined #f unsafe-undefined #t)))
- ((src_7 in_7 start_54 readtable_7 graph?7_1) (read-syntax/recursive_0 src_7 in_7 start_54 readtable_7 graph?7_1))
- ((src_8 in_12 start_17 readtable6_2) (read-syntax/recursive_0 src_8 in_12 start_17 readtable6_2 #t))
- ((src_9 in_57 start5_1) (read-syntax/recursive_0 src_9 in_57 start5_1 unsafe-undefined #t))
+ ((src_7 in_119 start_89 readtable_8 graph?7_1)
+ (read-syntax/recursive_0 src_7 in_119 start_89 readtable_8 graph?7_1))
+ ((src_8 in_120 start_90 readtable6_2) (read-syntax/recursive_0 src_8 in_120 start_90 readtable6_2 #t))
+ ((src_9 in_121 start5_1) (read-syntax/recursive_0 src_9 in_121 start5_1 unsafe-undefined #t))
((src_10 in4_3) (read-syntax/recursive_0 src_10 in4_3 #f unsafe-undefined #t))
((src3_1) (read-syntax/recursive_0 src3_1 unsafe-undefined #f unsafe-undefined #t)))))
(define-values
@@ -67525,15 +65522,10 @@
(lambda (in8_3)
(begin
'read
- (let-values (((in_85) (if (eq? in8_3 unsafe-undefined) (current-input-port) in8_3)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (input-port? in_85)
- (void)
- (let-values () (raise-argument-error 'read "input-port?" in_85)))
- (read$1 in_85))))))))))
+ (let-values (((in_122) (if (eq? in8_3 unsafe-undefined) (current-input-port) in8_3)))
+ (begin
+ (if (input-port? in_122) (void) (raise-argument-error 'read "input-port?" in_122))
+ (read$1 in_122)))))))
(case-lambda (() (begin 'read (read_0 unsafe-undefined))) ((in8_4) (read_0 in8_4)))))
(define-values
(1/read/recursive)
@@ -67541,37 +65533,33 @@
(lambda (in9_4 start10_0 readtable11_0 graph?12_0)
(begin
'read/recursive
- (let-values (((in_81) (if (eq? in9_4 unsafe-undefined) (current-input-port) in9_4)))
- (let-values (((start_76) start10_0))
- (let-values (((readtable_8)
+ (let-values (((in_123) (if (eq? in9_4 unsafe-undefined) (current-input-port) in9_4)))
+ (let-values (((start_91) start10_0))
+ (let-values (((readtable_9)
(if (eq? readtable11_0 unsafe-undefined) (1/current-readtable) readtable11_0)))
(let-values (((graph?_4) graph?12_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (input-port? in_81)
- (void)
- (let-values () (raise-argument-error 'read/recursive "input-port?" in_81)))
- (if ((lambda (x_102)
- (let-values (((or-part_37) (not x_102)))
- (if or-part_37 or-part_37 (char? x_102))))
- start_76)
- (void)
- (let-values () (raise-argument-error 'read/recursive "(or/c char? #f)" start_76)))
- (if ((lambda (x_41)
- (let-values (((or-part_59) (not x_41)))
- (if or-part_59 or-part_59 (1/readtable? x_41))))
- readtable_8)
- (void)
- (let-values ()
- (raise-argument-error 'read/recursive "(or/c readtable? #f)" readtable_8)))
- (read/recursive$1 in_81 start_76 readtable_8 graph?_4)))))))))))))
+ (begin
+ (if (input-port? in_123)
+ (void)
+ (raise-argument-error 'read/recursive "input-port?" in_123))
+ (if ((lambda (x_111)
+ (let-values (((or-part_888) (not x_111)))
+ (if or-part_888 or-part_888 (char? x_111))))
+ start_91)
+ (void)
+ (raise-argument-error 'read/recursive "(or/c char? #f)" start_91))
+ (if ((lambda (x_112)
+ (let-values (((or-part_889) (not x_112)))
+ (if or-part_889 or-part_889 (1/readtable? x_112))))
+ readtable_9)
+ (void)
+ (raise-argument-error 'read/recursive "(or/c readtable? #f)" readtable_9))
+ (read/recursive$1 in_123 start_91 readtable_9 graph?_4))))))))))
(case-lambda
(() (begin 'read/recursive (read/recursive_0 unsafe-undefined #f unsafe-undefined #t)))
- ((in_86 start_44 readtable_9 graph?12_1) (read/recursive_0 in_86 start_44 readtable_9 graph?12_1))
- ((in_39 start_77 readtable11_1) (read/recursive_0 in_39 start_77 readtable11_1 #t))
- ((in_16 start10_1) (read/recursive_0 in_16 start10_1 unsafe-undefined #t))
+ ((in_124 start_92 readtable_10 graph?12_1) (read/recursive_0 in_124 start_92 readtable_10 graph?12_1))
+ ((in_125 start_93 readtable11_1) (read/recursive_0 in_125 start_93 readtable11_1 #t))
+ ((in_126 start10_1) (read/recursive_0 in_126 start10_1 unsafe-undefined #t))
((in9_5) (read/recursive_0 in9_5 #f unsafe-undefined #t)))))
(define-values
(1/read-language)
@@ -67579,157 +65567,143 @@
(lambda (in13_3 fail-thunk14_0)
(begin
'read-language
- (let-values (((in_87) (if (eq? in13_3 unsafe-undefined) (current-input-port) in13_3)))
+ (let-values (((in_127) (if (eq? in13_3 unsafe-undefined) (current-input-port) in13_3)))
(let-values (((fail-thunk_2)
(if (eq? fail-thunk14_0 unsafe-undefined) read-language-fail-thunk fail-thunk14_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (input-port? in_87)
- (void)
- (let-values () (raise-argument-error 'read-language "input-port?" in_87)))
- (if ((lambda (p_24) (if (procedure? p_24) (procedure-arity-includes? p_24 0) #f))
- fail-thunk_2)
- (void)
- (let-values ()
- (raise-argument-error
- 'read-language
- "(procedure-arity-includes/c 0)"
- fail-thunk_2)))
- (read-language$1
- in_87
- (if (eq? fail-thunk_2 read-language-fail-thunk) #f fail-thunk_2))))))))))))
+ (begin
+ (if (input-port? in_127) (void) (raise-argument-error 'read-language "input-port?" in_127))
+ (if ((lambda (p_110) (if (procedure? p_110) (procedure-arity-includes? p_110 0) #f))
+ fail-thunk_2)
+ (void)
+ (raise-argument-error 'read-language "(procedure-arity-includes/c 0)" fail-thunk_2))
+ (read-language$1
+ in_127
+ (if (eq? fail-thunk_2 read-language-fail-thunk) #f fail-thunk_2)))))))))
(case-lambda
(() (begin 'read-language (read-language_0 unsafe-undefined unsafe-undefined)))
- ((in_88 fail-thunk14_1) (read-language_0 in_88 fail-thunk14_1))
+ ((in_128 fail-thunk14_1) (read-language_0 in_128 fail-thunk14_1))
((in13_4) (read-language_0 in13_4 unsafe-undefined)))))
(define-values (read-language-fail-thunk) (lambda () (begin (error "fail"))))
(define-values
(declare-primitive-module!)
- (lambda (name_79 inst_7 in-ns_0 protected_0 cross-phase-persistent?_3)
+ (lambda (name_94 inst_7 in-ns_0 protected_0 cross-phase-persistent?_3)
(begin
- (let-values (((mpi_63) (1/module-path-index-join (list 'quote name_79) #f)))
+ (let-values (((mpi_90) (module-path-index-join* (list 'quote name_94) #f)))
(let-values (((in-ns1_0) in-ns_0)
((temp2_6)
- (let-values (((temp4_0) (1/current-module-declare-source))
+ (let-values (((temp4_8) (1/current-module-declare-source))
((cross-phase-persistent?5_0) cross-phase-persistent?_3)
((temp6_5) (zero? (hash-count protected_0)))
- ((mpi7_0) mpi_63)
- ((temp8_8)
+ ((mpi7_0) mpi_90)
+ ((temp8_6)
(hasheqv
0
- (let-values (((lst_46) (1/instance-variable-names inst_7)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_46)))
- ((letrec-values (((for-loop_55)
- (lambda (table_228 lst_23)
- (begin
- 'for-loop
- (if (pair? lst_23)
- (let-values (((sym_77) (unsafe-car lst_23))
- ((rest_20) (unsafe-cdr lst_23)))
- (let-values (((table_180)
- (let-values (((table_229) table_228))
- (let-values (((table_230)
- (let-values ()
- (let-values (((key_98
- val_84)
- (let-values ()
- (let-values (((binding_27)
- (let-values (((mpi10_0)
- mpi_63)
- ((temp11_7)
- 0)
- ((sym12_0)
- sym_77))
- (make-module-binding.1
- #f
- null
- #f
- #f
- unsafe-undefined
- unsafe-undefined
- 0
- unsafe-undefined
- mpi10_0
- temp11_7
- sym12_0))))
- (values
- sym_77
- (if (hash-ref
- protected_0
- sym_77
- #f)
- (provided1.1
- binding_27
- #t
- #f)
- binding_27))))))
- (hash-set
- table_229
- key_98
- val_84)))))
- (values table_230)))))
- (if (not #f)
- (for-loop_55 table_180 rest_20)
- table_180)))
- table_228)))))
- for-loop_55)
- '#hash()
- lst_46)))))
+ (let-values (((table_316) (let-values (((table_317) '#hash())) table_317)))
+ (let-values (((lst_552) (1/instance-variable-names inst_7)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_552))
+ ((letrec-values (((for-loop_452)
+ (lambda (table_318 lst_553)
+ (begin
+ 'for-loop
+ (if (pair? lst_553)
+ (let-values (((sym_142) (unsafe-car lst_553))
+ ((rest_272) (unsafe-cdr lst_553)))
+ (let-values (((table_319)
+ (let-values (((table_320)
+ (let-values (((key_112
+ val_92)
+ (let-values (((binding_28)
+ (let-values (((mpi10_0)
+ mpi_90)
+ ((temp11_7)
+ 0)
+ ((sym12_0)
+ sym_142))
+ (make-module-binding.1
+ #f
+ null
+ #f
+ #f
+ unsafe-undefined
+ unsafe-undefined
+ 0
+ unsafe-undefined
+ mpi10_0
+ temp11_7
+ sym12_0))))
+ (values
+ sym_142
+ (if (hash-ref
+ protected_0
+ sym_142
+ #f)
+ (provided1.1
+ binding_28
+ #t
+ #f)
+ binding_28)))))
+ (hash-set
+ table_318
+ key_112
+ val_92))))
+ (values table_320))))
+ (if (not #f)
+ (for-loop_452 table_319 rest_272)
+ table_319)))
+ table_318)))))
+ for-loop_452)
+ table_316
+ lst_552))))))
((temp9_9)
(lambda (data-box_8
- ns_122
- phase-shift_19
- phase-level_24
- self_31
- bulk-binding-registry_22
+ ns_148
+ phase-shift_21
+ phase-level_28
+ self_36
+ bulk-binding-registry_23
insp_30)
- (if (= 0 phase-level_24)
- (let-values ()
- (begin
- (let-values (((lst_323) (1/instance-variable-names inst_7)))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference))
- (void)
- (let-values () (check-list lst_323)))
- ((letrec-values (((for-loop_103)
- (lambda (lst_282)
- (begin
- 'for-loop
- (if (pair? lst_282)
- (let-values (((sym_111) (unsafe-car lst_282))
- ((rest_182) (unsafe-cdr lst_282)))
- (let-values ((()
- (let-values ()
- (let-values ((()
- (let-values ()
- (begin
- (let-values ()
- (let-values (((val_85)
- (1/instance-variable-value
- inst_7
- sym_111)))
- (namespace-set-variable!
- ns_122
- 0
- sym_111
- val_85)))
- (values)))))
- (values)))))
- (if (not #f)
- (for-loop_103 rest_182)
- (values))))
- (values))))))
- for-loop_103)
- lst_323)))
- (void)))
+ (if (= 0 phase-level_28)
+ (begin
+ (let-values (((lst_554) (1/instance-variable-names inst_7)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_554))
+ ((letrec-values (((for-loop_453)
+ (lambda (lst_555)
+ (begin
+ 'for-loop
+ (if (pair? lst_555)
+ (let-values (((sym_143) (unsafe-car lst_555))
+ ((rest_273) (unsafe-cdr lst_555)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (let-values (((val_93)
+ (1/instance-variable-value
+ inst_7
+ sym_143)))
+ (namespace-set-variable!
+ ns_148
+ 0
+ sym_143
+ val_93))
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_453 rest_273)
+ (values))))
+ (values))))))
+ for-loop_453)
+ lst_554)))
+ (void))
(void)))))
(make-module.1
cross-phase-persistent?5_0
+ #f
void
unsafe-undefined
unsafe-undefined
@@ -67742,138 +65716,133 @@
#f
void
#f
- temp8_8
+ temp8_6
'racket
+ unsafe-undefined
null
mpi7_0
- temp4_0
+ temp4_8
null
#f)))
- ((temp3_8) (substitute-module-declare-name name_79)))
+ ((temp3_8) (substitute-module-declare-name name_94)))
(declare-module!.1 #t in-ns1_0 temp2_6 temp3_8))))))
(define-values
(1/prop:exn:missing-module 1/exn:missing-module? 1/exn:missing-module-accessor)
(make-struct-type-property
'missing-module
- (lambda (v_29 info_0)
+ (lambda (v_408 info_8)
(begin
- (if (if (procedure? v_29) (procedure-arity-includes? v_29 1) #f)
+ (if (if (procedure? v_408) (procedure-arity-includes? v_408 1) #f)
(void)
- (let-values ()
- (raise-argument-error 'guard-for-prop:exn:missing-module "(procedure-arity-includes/c 1)" v_29)))
- v_29))))
+ (raise-argument-error 'guard-for-prop:exn:missing-module "(procedure-arity-includes/c 1)" v_408))
+ v_408))))
(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)
- (let-values (((struct:_23 make-_23 ?_23 -ref_23 -set!_23)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'exn:fail:filesystem:missing-module
- struct:exn:fail:filesystem
- 1
- 0
- #f
- (list
- (cons 1/prop:exn:missing-module (lambda (e_97) (1/exn:fail:filesystem:missing-module-path e_97))))
- #f
- #f
- '(0)
- #f
- 'exn:fail:filesystem:missing-module)))))
- (values struct:_23 make-_23 ?_23 (make-struct-field-accessor -ref_23 0 'path))))
+ (let-values (((struct:_143 make-_143 ?_143 -ref_143 -set!_143)
+ (make-struct-type
+ 'exn:fail:filesystem:missing-module
+ struct:exn:fail:filesystem
+ 1
+ 0
+ #f
+ (list
+ (cons 1/prop:exn:missing-module (lambda (e_106) (1/exn:fail:filesystem:missing-module-path e_106))))
+ #f
+ #f
+ '(0)
+ #f
+ 'exn:fail:filesystem:missing-module)))
+ (values struct:_143 make-_143 ?_143 (make-struct-field-accessor -ref_143 0 'path))))
(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)
- (let-values (((struct:_61 make-_61 ?_61 -ref_61 -set!_61)
- (let-values ()
- (let-values ()
- (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_98) (1/exn:fail:syntax:missing-module-path e_98))))
- #f
- #f
- '(0)
- #f
- 'exn:fail:syntax:missing-module)))))
- (values struct:_61 make-_61 ?_61 (make-struct-field-accessor -ref_61 0 'path))))
+ (let-values (((struct:_144 make-_144 ?_144 -ref_144 -set!_144)
+ (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_107) (1/exn:fail:syntax:missing-module-path e_107))))
+ #f
+ #f
+ '(0)
+ #f
+ 'exn:fail:syntax:missing-module)))
+ (values struct:_144 make-_144 ?_144 (make-struct-field-accessor -ref_144 0 'path))))
(define-values
(1/current-module-path-for-load)
(make-parameter
#f
- (lambda (v_231)
+ (lambda (v_409)
(begin
- (if (let-values (((or-part_84) (not v_231)))
- (if or-part_84
- or-part_84
- (let-values (((or-part_58) (1/module-path? v_231)))
- (if or-part_58 or-part_58 (if (syntax?$1 v_231) (1/module-path? (syntax->datum$1 v_231)) #f)))))
+ (if (let-values (((or-part_890) (not v_409)))
+ (if or-part_890
+ or-part_890
+ (let-values (((or-part_891) (1/module-path? v_409)))
+ (if or-part_891 or-part_891 (if (syntax?$1 v_409) (1/module-path? (syntax->datum$1 v_409)) #f)))))
(void)
- (let-values ()
- (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_231)))
- v_231))
+ (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_409))
+ v_409))
'current-module-path-for-load))
(define-values
(maybe-raise-missing-module)
- (lambda (name_80 filename_0 pre_0 rel_1 post_0 errstr_0)
+ (lambda (name_95 filename_0 pre_0 rel_1 post_0 errstr_0)
(begin
(let-values (((path_18) (1/current-module-path-for-load)))
(if path_18
- (let-values ()
- (begin
- (if (syntax?$1 path_18)
- (let-values ()
- (raise
- (1/make-exn:fail:syntax:missing-module
- (format
- (string-append
- "~a: cannot open module file\n"
- " module path: ~s\n"
- " path: ~a~a~a~a\n"
- " system error: ~a")
- (if (syntax-srcloc$1 path_18) (srcloc->string (syntax-srcloc$1 path_18)) name_80)
- (syntax->datum$1 path_18)
- filename_0
- pre_0
- rel_1
- post_0
- errstr_0)
- (current-continuation-marks)
- (list path_18)
- (syntax->datum$1 path_18))))
- (void))
+ (begin
+ (if (syntax?$1 path_18)
(raise
- (1/make-exn:fail:filesystem:missing-module
+ (1/make-exn:fail:syntax:missing-module
(format
(string-append
"~a: cannot open module file\n"
- " module path: ~s\n"
+ " module path: ~a\n"
" path: ~a~a~a~a\n"
" system error: ~a")
- name_80
- path_18
+ (if (syntax-srcloc$1 path_18) (srcloc->string (syntax-srcloc$1 path_18)) name_95)
+ ((error-module-path->string-handler) (syntax->datum$1 path_18) (error-print-width))
filename_0
pre_0
rel_1
post_0
errstr_0)
(current-continuation-marks)
- path_18))))
+ (list path_18)
+ (syntax->datum$1 path_18)))
+ (void))
+ (raise
+ (1/make-exn:fail:filesystem:missing-module
+ (error-message->adjusted-string
+ (if (string? name_95) (string->symbol name_95) name_95)
+ 'racket/primitive
+ (format
+ (string-append
+ "cannot open module file\n"
+ " module path: ~a\n"
+ " path: ~a~a~a~a\n"
+ " system error: ~a")
+ ((error-module-path->string-handler) path_18 (error-print-width))
+ filename_0
+ pre_0
+ rel_1
+ post_0
+ errstr_0)
+ 'racket/primitive)
+ (current-continuation-marks)
+ path_18)))
(void))))))
(define-values
(1/local-expand)
@@ -67881,207 +65850,197 @@
(lambda (s2_9 context3_0 stop-ids4_0 intdefs1_0)
(begin
'local-expand
- (let-values (((s_12) s2_9))
+ (let-values (((s_867) s2_9))
(let-values (((context_10) context3_0))
(let-values (((stop-ids_2) stop-ids4_0))
(let-values (((intdefs_4) intdefs1_0))
- (let-values ()
- (let-values (((temp41_9) 'local-expand)
- ((s42_2) s_12)
- ((context43_0) context_10)
- ((stop-ids44_0) stop-ids_2)
- ((intdefs45_0) intdefs_4))
- (do-local-expand.1
- #f
- #f
- #t
- unsafe-undefined
- #f
- #f
- #f
- temp41_9
- s42_2
- context43_0
- stop-ids44_0
- intdefs45_0)))))))))))
+ (let-values (((temp41_8) 'local-expand)
+ ((s42_1) s_867)
+ ((context43_0) context_10)
+ ((stop-ids44_0) stop-ids_2)
+ ((intdefs45_0) intdefs_4))
+ (do-local-expand.1
+ #f
+ #f
+ #t
+ unsafe-undefined
+ #f
+ #f
+ #f
+ temp41_8
+ s42_1
+ context43_0
+ stop-ids44_0
+ intdefs45_0))))))))))
(case-lambda
- ((s_513 context_11 stop-ids_3) (begin 'local-expand (local-expand_0 s_513 context_11 stop-ids_3 #f)))
- ((s_512 context_12 stop-ids_4 intdefs1_1) (local-expand_0 s_512 context_12 stop-ids_4 intdefs1_1)))))
+ ((s_868 context_11 stop-ids_3) (begin 'local-expand (local-expand_0 s_868 context_11 stop-ids_3 #f)))
+ ((s_869 context_12 stop-ids_4 intdefs1_1) (local-expand_0 s_869 context_12 stop-ids_4 intdefs1_1)))))
(define-values
(1/local-expand/capture-lifts)
(let-values (((local-expand/capture-lifts_0)
- (lambda (s7_1 context8_0 stop-ids9_0 intdefs5_0 lift-key6_0)
+ (lambda (s7_0 context8_0 stop-ids9_0 intdefs5_0 lift-key6_0)
(begin
'local-expand/capture-lifts
- (let-values (((s_515) s7_1))
+ (let-values (((s_870) s7_0))
(let-values (((context_13) context8_0))
(let-values (((stop-ids_5) stop-ids9_0))
(let-values (((intdefs_5) intdefs5_0))
(let-values (((lift-key_4)
(if (eq? lift-key6_0 unsafe-undefined) (generate-lift-key) lift-key6_0)))
- (let-values ()
- (let-values (((temp46_5) 'local-expand)
- ((s47_0) s_515)
- ((context48_0) context_13)
- ((stop-ids49_0) stop-ids_5)
- ((intdefs50_0) intdefs_5)
- ((temp51_6) #t)
- ((lift-key52_0) lift-key_4))
- (do-local-expand.1
- #f
- temp51_6
- #t
- lift-key52_0
- #f
- #f
- #f
- temp46_5
- s47_0
- context48_0
- stop-ids49_0
- intdefs50_0))))))))))))
+ (let-values (((temp46_7) 'local-expand)
+ ((s47_0) s_870)
+ ((context48_0) context_13)
+ ((stop-ids49_0) stop-ids_5)
+ ((intdefs50_0) intdefs_5)
+ ((temp51_6) #t)
+ ((lift-key52_0) lift-key_4))
+ (do-local-expand.1
+ #f
+ temp51_6
+ #t
+ lift-key52_0
+ #f
+ #f
+ #f
+ temp46_7
+ s47_0
+ context48_0
+ stop-ids49_0
+ intdefs50_0)))))))))))
(case-lambda
- ((s_546 context_14 stop-ids_6)
+ ((s_871 context_14 stop-ids_6)
(begin
'local-expand/capture-lifts
- (local-expand/capture-lifts_0 s_546 context_14 stop-ids_6 #f unsafe-undefined)))
- ((s_548 context_15 stop-ids_7 intdefs_6 lift-key6_1)
- (local-expand/capture-lifts_0 s_548 context_15 stop-ids_7 intdefs_6 lift-key6_1))
- ((s_562 context_16 stop-ids_8 intdefs5_1)
- (local-expand/capture-lifts_0 s_562 context_16 stop-ids_8 intdefs5_1 unsafe-undefined)))))
+ (local-expand/capture-lifts_0 s_871 context_14 stop-ids_6 #f unsafe-undefined)))
+ ((s_872 context_15 stop-ids_7 intdefs_6 lift-key6_1)
+ (local-expand/capture-lifts_0 s_872 context_15 stop-ids_7 intdefs_6 lift-key6_1))
+ ((s_873 context_16 stop-ids_8 intdefs5_1)
+ (local-expand/capture-lifts_0 s_873 context_16 stop-ids_8 intdefs5_1 unsafe-undefined)))))
(define-values
(1/local-transformer-expand)
(let-values (((local-transformer-expand_0)
- (lambda (s11_2 context12_0 stop-ids13_0 intdefs10_0)
+ (lambda (s11_1 context12_0 stop-ids13_0 intdefs10_0)
(begin
'local-transformer-expand
- (let-values (((s_94) s11_2))
+ (let-values (((s_874) s11_1))
(let-values (((context_17) context12_0))
(let-values (((stop-ids_9) stop-ids13_0))
(let-values (((intdefs_7) intdefs10_0))
- (let-values ()
- (let-values (((temp53_3) 'local-expand)
- ((s54_0) s_94)
- ((context55_0) context_17)
- ((stop-ids56_0) stop-ids_9)
- ((intdefs57_0) intdefs_7)
- ((temp58_1) #t))
- (do-local-expand.1
- temp58_1
- #f
- #t
- unsafe-undefined
- #f
- #f
- #f
- temp53_3
- s54_0
- context55_0
- stop-ids56_0
- intdefs57_0)))))))))))
+ (let-values (((temp53_5) 'local-expand)
+ ((s54_0) s_874)
+ ((context55_0) context_17)
+ ((stop-ids56_0) stop-ids_9)
+ ((intdefs57_0) intdefs_7)
+ ((temp58_3) #t))
+ (do-local-expand.1
+ temp58_3
+ #f
+ #t
+ unsafe-undefined
+ #f
+ #f
+ #f
+ temp53_5
+ s54_0
+ context55_0
+ stop-ids56_0
+ intdefs57_0))))))))))
(case-lambda
- ((s_97 context_18 stop-ids_10)
- (begin 'local-transformer-expand (local-transformer-expand_0 s_97 context_18 stop-ids_10 #f)))
- ((s_81 context_19 stop-ids_11 intdefs10_1) (local-transformer-expand_0 s_81 context_19 stop-ids_11 intdefs10_1)))))
+ ((s_875 context_18 stop-ids_10)
+ (begin 'local-transformer-expand (local-transformer-expand_0 s_875 context_18 stop-ids_10 #f)))
+ ((s_876 context_19 stop-ids_11 intdefs10_1)
+ (local-transformer-expand_0 s_876 context_19 stop-ids_11 intdefs10_1)))))
(define-values
(1/local-transformer-expand/capture-lifts)
(let-values (((local-transformer-expand/capture-lifts_0)
- (lambda (s16_2 context17_0 stop-ids18_0 intdefs14_0 lift-key15_0)
+ (lambda (s16_1 context17_0 stop-ids18_0 intdefs14_0 lift-key15_0)
(begin
'local-transformer-expand/capture-lifts
- (let-values (((s_563) s16_2))
+ (let-values (((s_877) s16_1))
(let-values (((context_20) context17_0))
(let-values (((stop-ids_12) stop-ids18_0))
(let-values (((intdefs_8) intdefs14_0))
(let-values (((lift-key_5)
(if (eq? lift-key15_0 unsafe-undefined) (generate-lift-key) lift-key15_0)))
- (let-values ()
- (let-values (((temp59_3) 'local-expand)
- ((s60_0) s_563)
- ((context61_0) context_20)
- ((stop-ids62_0) stop-ids_12)
- ((intdefs63_0) intdefs_8)
- ((temp64_5) #t)
- ((temp65_3) #t)
- ((lift-key66_0) lift-key_5))
- (do-local-expand.1
- temp64_5
- temp65_3
- #t
- lift-key66_0
- #f
- #f
- #f
- temp59_3
- s60_0
- context61_0
- stop-ids62_0
- intdefs63_0))))))))))))
+ (let-values (((temp59_3) 'local-expand)
+ ((s60_0) s_877)
+ ((context61_0) context_20)
+ ((stop-ids62_0) stop-ids_12)
+ ((intdefs63_0) intdefs_8)
+ ((temp64_7) #t)
+ ((temp65_3) #t)
+ ((lift-key66_0) lift-key_5))
+ (do-local-expand.1
+ temp64_7
+ temp65_3
+ #t
+ lift-key66_0
+ #f
+ #f
+ #f
+ temp59_3
+ s60_0
+ context61_0
+ stop-ids62_0
+ intdefs63_0)))))))))))
(case-lambda
- ((s_27 context_21 stop-ids_13)
+ ((s_878 context_21 stop-ids_13)
(begin
'local-transformer-expand/capture-lifts
- (local-transformer-expand/capture-lifts_0 s_27 context_21 stop-ids_13 #f unsafe-undefined)))
- ((s_527 context_22 stop-ids_14 intdefs_9 lift-key15_1)
- (local-transformer-expand/capture-lifts_0 s_527 context_22 stop-ids_14 intdefs_9 lift-key15_1))
- ((s_564 context_23 stop-ids_15 intdefs14_1)
- (local-transformer-expand/capture-lifts_0 s_564 context_23 stop-ids_15 intdefs14_1 unsafe-undefined)))))
+ (local-transformer-expand/capture-lifts_0 s_878 context_21 stop-ids_13 #f unsafe-undefined)))
+ ((s_879 context_22 stop-ids_14 intdefs_9 lift-key15_1)
+ (local-transformer-expand/capture-lifts_0 s_879 context_22 stop-ids_14 intdefs_9 lift-key15_1))
+ ((s_880 context_23 stop-ids_15 intdefs14_1)
+ (local-transformer-expand/capture-lifts_0 s_880 context_23 stop-ids_15 intdefs14_1 unsafe-undefined)))))
(define-values
(1/syntax-local-expand-expression)
(let-values (((syntax-local-expand-expression_0)
(lambda (s20_2 opaque-only?19_0)
(begin
'syntax-local-expand-expression
- (let-values (((s_565) s20_2))
+ (let-values (((s_881) s20_2))
(let-values (((opaque-only?_0) opaque-only?19_0))
- (let-values ()
- (let-values (((exp-s_11)
- (let-values (((temp67_4) 'syntax-local-expand-expression)
- ((s68_0) s_565)
- ((temp69_6) 'expression)
- ((null70_0) null)
- ((temp71_4) #f)
- ((opaque-only?72_0) opaque-only?_0)
- ((temp73_7) #t)
- ((temp74_4) #t)
- ((temp75_3) #f))
- (do-local-expand.1
- #f
- #f
- temp75_3
- unsafe-undefined
- temp73_7
- opaque-only?72_0
- temp74_4
- temp67_4
- s68_0
- temp69_6
- null70_0
- temp71_4))))
- (let-values (((ctx_80) (let-values () (get-current-expand-context.1 #f 'unexpected))))
- (let-values (((ae_1)
- (flip-introduction-scopes
- (datum->syntax$1
- #f
- (already-expanded1.1
- (if (parsed? exp-s_11)
- exp-s_11
- (flip-introduction-scopes exp-s_11 ctx_80))
- (expand-context-binding-layer ctx_80)))
- ctx_80)))
- (begin
- (let-values (((obs_60) (expand-context-observer ctx_80)))
- (if obs_60
- (let-values () (let-values () (call-expand-observe obs_60 'opaque-expr ae_1)))
- (void)))
- (let-values (((obs_61) (expand-context-observer ctx_80)))
- (if obs_61
- (let-values () (let-values () (call-expand-observe obs_61 'exit-local exp-s_11)))
- (void)))
- (values (if (not opaque-only?_0) exp-s_11 #f) ae_1))))))))))))
+ (let-values (((exp-s_11)
+ (let-values (((temp67_3) 'syntax-local-expand-expression)
+ ((s68_0) s_881)
+ ((temp69_6) 'expression)
+ ((null70_0) null)
+ ((temp71_5) #f)
+ ((opaque-only?72_0) opaque-only?_0)
+ ((temp73_7) #t)
+ ((temp74_4) #t)
+ ((temp75_3) #f))
+ (do-local-expand.1
+ #f
+ #f
+ temp75_3
+ unsafe-undefined
+ temp73_7
+ opaque-only?72_0
+ temp74_4
+ temp67_3
+ s68_0
+ temp69_6
+ null70_0
+ temp71_5))))
+ (let-values (((ctx_89) (get-current-expand-context.1 #f 'unexpected)))
+ (let-values (((ae_1)
+ (flip-introduction-scopes
+ (datum->syntax$1
+ #f
+ (already-expanded1.1
+ (if (parsed? exp-s_11) exp-s_11 (flip-introduction-scopes exp-s_11 ctx_89))
+ (expand-context-binding-layer ctx_89)))
+ ctx_89)))
+ (begin
+ (let-values (((obs_62) (expand-context-observer ctx_89)))
+ (if obs_62 (call-expand-observe obs_62 'opaque-expr ae_1) (void)))
+ (let-values (((obs_63) (expand-context-observer ctx_89)))
+ (if obs_63 (call-expand-observe obs_63 'exit-local exp-s_11) (void)))
+ (values (if (not opaque-only?_0) exp-s_11 #f) ae_1)))))))))))
(case-lambda
- ((s_178) (begin 'syntax-local-expand-expression (syntax-local-expand-expression_0 s_178 #f)))
- ((s_332 opaque-only?19_1) (syntax-local-expand-expression_0 s_332 opaque-only?19_1)))))
+ ((s_882) (begin 'syntax-local-expand-expression (syntax-local-expand-expression_0 s_882 #f)))
+ ((s_883 opaque-only?19_1) (syntax-local-expand-expression_0 s_883 opaque-only?19_1)))))
(define-values
(do-local-expand.1)
(lambda (as-transformer?22_1
@@ -68089,7 +66048,7 @@
keep-#%expression?24_0
lift-key25_0
skip-log-exit?27_0
- to-parsed-ok?23_1
+ to-parsed-ok?23_0
track-to-be-defined?26_0
who36_1
s-or-s-exp37_0
@@ -68098,405 +66057,371 @@
intdefs35_0)
(begin
'do-local-expand
- (let-values (((who_36) who36_1))
+ (let-values (((who_50) who36_1))
(let-values (((s-or-s-exp_0) s-or-s-exp37_0))
(let-values (((context_24) context38_0))
(let-values (((stop-ids_16) stop-ids39_0))
(let-values (((intdefs_10) intdefs35_0))
(let-values (((capture-lifts?_0) capture-lifts?21_0))
(let-values (((as-transformer?_6) as-transformer?22_1))
- (let-values (((to-parsed-ok?_1) to-parsed-ok?23_1))
+ (let-values (((to-parsed-ok?_1) to-parsed-ok?23_0))
(let-values (((keep-#%expression?_2) keep-#%expression?24_0))
(let-values (((lift-key_6)
(if (eq? lift-key25_0 unsafe-undefined)
- (if (let-values (((or-part_46) capture-lifts?_0))
- (if or-part_46 or-part_46 as-transformer?_6))
+ (if (let-values (((or-part_892) capture-lifts?_0))
+ (if or-part_892 or-part_892 as-transformer?_6))
(generate-lift-key)
#f)
lift-key25_0)))
(let-values (((track-to-be-defined?_1) track-to-be-defined?26_0))
(let-values (((skip-log-exit?_0) skip-log-exit?27_0))
- (let-values ()
- (begin
- (if log-performance?
- (let-values () (start-performance-region 'expand 'local-expand))
- (void))
- (begin0
- (let-values ()
- (let-values (((s_57) (datum->syntax$1 #f s-or-s-exp_0)))
+ (begin
+ (if log-performance? (start-performance-region 'expand 'local-expand) (void))
+ (begin0
+ (let-values (((s_884) (datum->syntax$1 #f s-or-s-exp_0)))
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_893) (list? context_24)))
+ (if or-part_893
+ or-part_893
+ (memq
+ context_24
+ (if as-transformer?_6
+ '(expression top-level)
+ '(expression top-level module module-begin)))))
+ (void)
+ (raise-argument-error
+ who_50
+ (if as-transformer?_6
+ "(or/c 'expression 'top-level list?)"
+ "(or/c 'expression 'top-level 'module 'module-begin list?)")
+ context_24))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_894) (not stop-ids_16)))
+ (if or-part_894
+ or-part_894
+ (if (list? stop-ids_16)
+ (andmap2 identifier? stop-ids_16)
+ #f)))
+ (void)
+ (raise-argument-error
+ who_50
+ "(or/c (listof identifier?) #f)"
+ stop-ids_16))
+ (values))))
(let-values ((()
(begin
- (if (let-values (((or-part_50) (list? context_24)))
- (if or-part_50
- or-part_50
- (memq
- context_24
- (if as-transformer?_6
- '(expression top-level)
- '(expression top-level module module-begin)))))
+ (if (intdefs-or-false? intdefs_10)
(void)
- (let-values ()
- (raise-argument-error
- who_36
- (if as-transformer?_6
- "(or/c 'expression 'top-level list?)"
- "(or/c 'expression 'top-level 'module 'module-begin list?)")
- context_24)))
+ (raise-argument-error
+ who_50
+ intdefs-or-false?-string
+ intdefs_10))
(values))))
- (let-values ((()
- (begin
- (if (let-values (((or-part_532) (not stop-ids_16)))
- (if or-part_532
- or-part_532
- (if (list? stop-ids_16)
- (andmap2 identifier? stop-ids_16)
- #f)))
- (void)
- (let-values ()
- (raise-argument-error
- who_36
- "(or/c (listof identifier?) #f)"
- stop-ids_16)))
- (values))))
- (let-values ((()
- (begin
- (if (intdefs-or-false? intdefs_10)
- (void)
- (let-values ()
- (raise-argument-error
- who_36
- intdefs-or-false?-string
- intdefs_10)))
- (values))))
- (let-values (((ctx_81)
- (let-values (((who76_0) who_36))
- (get-current-expand-context.1 #f who76_0))))
- (let-values (((phase_157)
- (if as-transformer?_6
- (add1 (expand-context-phase ctx_81))
- (expand-context-phase ctx_81))))
- (let-values (((local-ctx_1)
- (let-values (((ctx77_0) ctx_81)
- ((context78_0) context_24)
- ((phase79_1) phase_157)
- ((intdefs80_0) intdefs_10)
- ((stop-ids81_0) stop-ids_16)
- ((to-parsed-ok?82_0) to-parsed-ok?_1)
- ((temp83_4)
- (let-values (((or-part_111)
- keep-#%expression?_2))
- (if or-part_111
- or-part_111
- (if (expand-context-in-local-expand?
- ctx_81)
- (expand-context-keep-#%expression?
- ctx_81)
- #f))))
- ((track-to-be-defined?84_0)
- track-to-be-defined?_1))
- (make-local-expand-context.1
- context78_0
- #t
- intdefs80_0
- temp83_4
- phase79_1
- stop-ids81_0
- to-parsed-ok?82_0
- track-to-be-defined?84_0
- ctx77_0))))
- (let-values ((()
- (begin
- (with-continuation-mark
- current-expand-context
+ (let-values (((ctx_90)
+ (let-values (((who76_0) who_50))
+ (get-current-expand-context.1 #f who76_0))))
+ (let-values (((phase_199)
+ (if as-transformer?_6
+ (add1 (expand-context-phase ctx_90))
+ (expand-context-phase ctx_90))))
+ (let-values (((local-ctx_1)
+ (let-values (((ctx77_0) ctx_90)
+ ((context78_0) context_24)
+ ((phase79_1) phase_199)
+ ((intdefs80_0) intdefs_10)
+ ((stop-ids81_0) stop-ids_16)
+ ((to-parsed-ok?82_0) to-parsed-ok?_1)
+ ((temp83_4)
+ (let-values (((or-part_895)
+ keep-#%expression?_2))
+ (if or-part_895
+ or-part_895
+ (if (expand-context-in-local-expand?
+ ctx_90)
+ (expand-context-keep-#%expression?
+ ctx_90)
+ #f))))
+ ((track-to-be-defined?84_0)
+ track-to-be-defined?_1))
+ (make-local-expand-context.1
+ context78_0
+ #t
+ intdefs80_0
+ temp83_4
+ phase79_1
+ stop-ids81_0
+ to-parsed-ok?82_0
+ track-to-be-defined?84_0
+ ctx77_0))))
+ (let-values ((()
+ (begin
+ (with-continuation-mark
+ current-expand-context
+ #f
+ (if (expand-context-skip-visit-available? ctx_90)
+ (void)
+ (namespace-visit-available-modules!
+ (expand-context-namespace ctx_90)
+ phase_199)))
+ (values))))
+ (let-values ((()
+ (begin
+ (let-values (((obs_64)
+ (expand-context-observer local-ctx_1)))
+ (if obs_64
+ (call-expand-observe obs_64 'enter-local s_884)
+ (void)))
+ (values))))
+ (let-values (((input-s_1)
+ (let-values (((temp85_4)
+ (flip-introduction-scopes s_884 ctx_90))
+ ((intdefs86_0) intdefs_10))
+ (add-intdef-scopes.1
+ unsafe-undefined
#f
- (let-values ()
- (if (expand-context-skip-visit-available? ctx_81)
- (void)
- (let-values ()
- (namespace-visit-available-modules!
- (expand-context-namespace ctx_81)
- phase_157)))))
- (values))))
+ temp85_4
+ intdefs86_0))))
(let-values ((()
(begin
- (let-values (((obs_62)
- (expand-context-observer
- local-ctx_1)))
- (if obs_62
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_62
- 'enter-local
- s_57)))
- (void)))
+ (if as-transformer?_6
+ (let-values (((obs_65)
+ (expand-context-observer
+ local-ctx_1)))
+ (if obs_65
+ (call-expand-observe obs_65 'phase-up)
+ (void)))
+ (void))
(values))))
- (let-values (((input-s_1)
- (let-values (((temp85_5)
- (flip-introduction-scopes
- s_57
- ctx_81))
- ((intdefs86_0) intdefs_10))
- (add-intdef-scopes.1
- unsafe-undefined
- #f
- temp85_5
- intdefs86_0))))
+ (let-values ((()
+ (begin
+ (let-values (((obs_66)
+ (expand-context-observer
+ local-ctx_1)))
+ (if obs_66
+ (call-expand-observe
+ obs_66
+ 'local-pre
+ input-s_1)
+ (void)))
+ (values))))
(let-values ((()
(begin
- (if as-transformer?_6
- (let-values ()
- (let-values (((obs_63)
- (expand-context-observer
- local-ctx_1)))
- (if obs_63
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_63
- 'phase-up)))
- (void))))
- (void))
- (values))))
- (let-values ((()
- (begin
- (let-values (((obs_64)
+ (if stop-ids_16
+ (let-values (((obs_67)
(expand-context-observer
local-ctx_1)))
- (if obs_64
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_64
- 'local-pre
- input-s_1)))
+ (if obs_67
+ (call-expand-observe obs_67 'start)
(void)))
- (values))))
+ (void))
+ (values))))
+ (let-values (((output-s_0)
+ (with-continuation-mark
+ current-expand-context
+ #f
+ (if (if as-transformer?_6
+ capture-lifts?_0
+ #f)
+ (let-values (((input-s87_0) input-s_1)
+ ((local-ctx88_0) local-ctx_1)
+ ((context89_0) context_24)
+ ((temp90_1) #f)
+ ((temp91_4) #t)
+ ((lift-key92_0) lift-key_6)
+ ((temp93_1) #t)
+ ((temp94_2) #t))
+ (expand-transformer.1
+ temp93_1
+ temp91_4
+ context89_0
+ temp90_1
+ temp94_2
+ lift-key92_0
+ input-s87_0
+ local-ctx88_0))
+ (if as-transformer?_6
+ (let-values (((input-s95_0) input-s_1)
+ ((local-ctx96_0)
+ local-ctx_1)
+ ((context97_0) context_24)
+ ((temp98_5) #f)
+ ((temp99_2)
+ (eq?
+ 'top-level
+ context_24))
+ ((lift-key100_0) lift-key_6)
+ ((temp101_3) #t))
+ (expand-transformer.1
+ #f
+ temp99_2
+ context97_0
+ temp98_5
+ temp101_3
+ lift-key100_0
+ input-s95_0
+ local-ctx96_0))
+ (if capture-lifts?_0
+ (let-values (((input-s102_0) input-s_1)
+ ((local-ctx103_0)
+ local-ctx_1)
+ ((temp104_3) #t)
+ ((lift-key105_0)
+ lift-key_6)
+ ((temp106_2) #t))
+ (expand/capture-lifts.1
+ temp106_2
+ temp104_3
+ #f
+ lift-key105_0
+ input-s102_0
+ local-ctx103_0))
+ (let-values (((input-s107_0) input-s_1)
+ ((local-ctx108_0)
+ local-ctx_1))
+ (expand.1
+ #f
+ #f
+ input-s107_0
+ local-ctx108_0))))))))
(let-values ((()
(begin
- (if stop-ids_16
- (let-values ()
- (let-values (((obs_65)
- (expand-context-observer
- local-ctx_1)))
- (if obs_65
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_65
- 'start)))
- (void))))
- (void))
+ (let-values (((obs_68)
+ (expand-context-observer
+ local-ctx_1)))
+ (if obs_68
+ (call-expand-observe
+ obs_68
+ 'local-post
+ output-s_0)
+ (void)))
(values))))
- (let-values (((output-s_0)
- (with-continuation-mark
- current-expand-context
- #f
- (let-values ()
- (if (if as-transformer?_6
- capture-lifts?_0
- #f)
- (let-values ()
- (let-values (((input-s87_0)
- input-s_1)
- ((local-ctx88_0)
- local-ctx_1)
- ((context89_0)
- context_24)
- ((temp90_2) #f)
- ((temp91_3) #t)
- ((lift-key92_0)
- lift-key_6)
- ((temp93_2) #t)
- ((temp94_3) #t))
- (expand-transformer.1
- temp93_2
- temp91_3
- context89_0
- temp90_2
- temp94_3
- lift-key92_0
- input-s87_0
- local-ctx88_0)))
- (if as-transformer?_6
- (let-values ()
- (let-values (((input-s95_0)
- input-s_1)
- ((local-ctx96_0)
- local-ctx_1)
- ((context97_0)
- context_24)
- ((temp98_4) #f)
- ((temp99_2)
- (eq?
- 'top-level
- context_24))
- ((lift-key100_0)
- lift-key_6)
- ((temp101_2) #t))
- (expand-transformer.1
- #f
- temp99_2
- context97_0
- temp98_4
- temp101_2
- lift-key100_0
- input-s95_0
- local-ctx96_0)))
- (if capture-lifts?_0
- (let-values ()
- (let-values (((input-s102_0)
- input-s_1)
- ((local-ctx103_0)
- local-ctx_1)
- ((temp104_4) #t)
- ((lift-key105_0)
- lift-key_6)
- ((temp106_2) #t))
- (expand/capture-lifts.1
- temp106_2
- temp104_4
- #f
- lift-key105_0
- input-s102_0
- local-ctx103_0)))
- (let-values ()
- (let-values (((input-s107_0)
- input-s_1)
- ((local-ctx108_0)
- local-ctx_1))
- (expand.1
- #f
- #f
- input-s107_0
- local-ctx108_0))))))))))
- (let-values ((()
- (begin
- (let-values (((obs_66)
- (expand-context-observer
- local-ctx_1)))
- (if obs_66
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_66
- 'local-post
- output-s_0)))
- (void)))
- (values))))
- (let-values (((result-s_8)
- (if (parsed? output-s_0)
- output-s_0
- (flip-introduction-scopes
- output-s_0
- ctx_81))))
- (begin
- (if skip-log-exit?_0
- (void)
- (let-values ()
- (let-values (((obs_67)
- (expand-context-observer
- local-ctx_1)))
- (if obs_67
- (let-values ()
- (let-values ()
- (call-expand-observe
- obs_67
- 'exit-local
- result-s_8)))
- (void)))))
- result-s_8))))))))))))))))))
- (if log-performance?
- (let-values () (end-performance-region))
- (void))))))))))))))))))))
+ (let-values (((result-s_8)
+ (if (parsed? output-s_0)
+ output-s_0
+ (flip-introduction-scopes
+ output-s_0
+ ctx_90))))
+ (begin
+ (if skip-log-exit?_0
+ (void)
+ (let-values (((obs_69)
+ (expand-context-observer
+ local-ctx_1)))
+ (if obs_69
+ (call-expand-observe
+ obs_69
+ 'exit-local
+ result-s_8)
+ (void))))
+ result-s_8)))))))))))))))))
+ (if log-performance? (end-performance-region) (void)))))))))))))))))))
(define-values
(transform-syntax-vals)
- (lambda (f_41 vs_1)
+ (lambda (f_42 vs_1)
(begin
(reverse$1
- (let-values (((lst_85) vs_1))
- (begin
- (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (let-values () (check-list lst_85)))
- ((letrec-values (((for-loop_100)
- (lambda (fold-var_306 lst_86)
- (begin
- 'for-loop
- (if (pair? lst_86)
- (let-values (((v_54) (unsafe-car lst_86)) ((rest_40) (unsafe-cdr lst_86)))
- (let-values (((fold-var_253)
- (let-values (((fold-var_104) fold-var_306))
- (let-values (((fold-var_105)
- (let-values ()
- (cons
- (let-values ()
- (if (syntax?$1 v_54) (f_41 v_54) v_54))
- fold-var_104))))
- (values fold-var_105)))))
- (if (not #f) (for-loop_100 fold-var_253 rest_40) fold-var_253)))
- fold-var_306)))))
- for-loop_100)
- null
- lst_85)))))))
+ (let-values (((fold-var_615) (let-values (((fold-var_616) null)) fold-var_616)))
+ (let-values (((lst_556) vs_1))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference)) (void) (check-list lst_556))
+ ((letrec-values (((for-loop_454)
+ (lambda (fold-var_617 lst_557)
+ (begin
+ 'for-loop
+ (if (pair? lst_557)
+ (let-values (((v_410) (unsafe-car lst_557)) ((rest_274) (unsafe-cdr lst_557)))
+ (let-values (((fold-var_618)
+ (let-values (((fold-var_619)
+ (cons
+ (if (syntax?$1 v_410) (f_42 v_410) v_410)
+ fold-var_617)))
+ (values fold-var_619))))
+ (if (not #f) (for-loop_454 fold-var_618 rest_274) fold-var_618)))
+ fold-var_617)))))
+ for-loop_454)
+ fold-var_615
+ lst_556))))))))
(define-values
(1/syntax-local-apply-transformer)
- (lambda (transformer_0 binding-id_0 context_25 intdef-ctx_0 . args_11)
+ (lambda (transformer_0 binding-id/insp_0 context_25 intdef-ctx_0 . args_14)
(begin
'syntax-local-apply-transformer
- (let-values ()
- (let-values ()
+ (let-values ((()
+ (begin
+ (if (procedure? transformer_0)
+ (void)
+ (raise-argument-error 'syntax-local-apply-transformer "procedure?" transformer_0))
+ (values))))
+ (let-values ((()
+ (begin
+ (if ((lambda (binding-id/insp_1)
+ (let-values (((or-part_896) (eq? binding-id/insp_1 #f)))
+ (if or-part_896
+ or-part_896
+ (let-values (((or-part_897) (identifier? binding-id/insp_1)))
+ (if or-part_897
+ or-part_897
+ (let-values (((or-part_898) (inspector? binding-id/insp_1)))
+ (if or-part_898
+ or-part_898
+ (if (list? binding-id/insp_1)
+ (if (= 2 (length binding-id/insp_1))
+ (if (identifier? (car binding-id/insp_1))
+ (inspector? (cadr binding-id/insp_1))
+ #f)
+ #f)
+ #f))))))))
+ binding-id/insp_0)
+ (void)
+ (raise-argument-error
+ 'syntax-local-apply-transformer
+ "(or/c identifier? inspector? (list/c internal-definition-context? inspector?) #f)"
+ binding-id/insp_0))
+ (values))))
(let-values ((()
(begin
- (if (procedure? transformer_0)
+ (if ((lambda (context_26)
+ (let-values (((or-part_899) (list? context_26)))
+ (if or-part_899
+ or-part_899
+ (memq context_26 '(expression top-level module module-begin)))))
+ context_25)
(void)
- (let-values ()
- (raise-argument-error 'syntax-local-apply-transformer "procedure?" transformer_0)))
+ (raise-argument-error
+ 'syntax-local-apply-transformer
+ "(or/c 'expression 'top-level 'module 'module-begin list?)"
+ context_25))
(values))))
(let-values ((()
(begin
- (if ((lambda (binding-id_1)
- (let-values (((or-part_87) (identifier? binding-id_1)))
- (if or-part_87 or-part_87 (eq? binding-id_1 #f))))
- binding-id_0)
+ (if ((lambda (intdef-ctx_1)
+ (let-values (((or-part_900) (not intdef-ctx_1)))
+ (if or-part_900 or-part_900 (1/internal-definition-context? intdef-ctx_1))))
+ intdef-ctx_0)
(void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-apply-transformer
- "(or/c identifier? #f)"
- binding-id_0)))
+ (raise-argument-error
+ 'syntax-local-apply-transformer
+ "(or/c #f internal-definition-context?)"
+ intdef-ctx_0))
(values))))
- (let-values ((()
- (begin
- (if ((lambda (context_26)
- (let-values (((or-part_308) (list? context_26)))
- (if or-part_308
- or-part_308
- (memq context_26 '(expression top-level module module-begin)))))
- context_25)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-apply-transformer
- "(or/c 'expression 'top-level 'module 'module-begin list?)"
- context_25)))
- (values))))
- (let-values ((()
- (begin
- (if ((lambda (intdef-ctx_1)
- (let-values (((or-part_4) (not intdef-ctx_1)))
- (if or-part_4 or-part_4 (1/internal-definition-context? intdef-ctx_1))))
- intdef-ctx_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-local-apply-transformer
- "(or/c internal-definition-context? #f)"
- intdef-ctx_0)))
- (values))))
- (let-values (((ctx_14)
- (let-values (((who2_1) 'syntax-local-apply-transformer))
- (get-current-expand-context.1 #f who2_1))))
+ (let-values (((binding-id_0)
+ (let-values (((or-part_901) (if (identifier? binding-id/insp_0) binding-id/insp_0 #f)))
+ (if or-part_901 or-part_901 (if (pair? binding-id/insp_0) (car binding-id/insp_0) #f)))))
+ (let-values (((expander-insp_0)
+ (let-values (((or-part_902) (if (inspector? binding-id/insp_0) binding-id/insp_0 #f)))
+ (if or-part_902
+ or-part_902
+ (let-values (((or-part_903)
+ (if (pair? binding-id/insp_0) (cadr binding-id/insp_0) #f)))
+ (if or-part_903 or-part_903 (current-module-code-inspector)))))))
+ (let-values (((ctx_91)
+ (let-values (((who2_0) 'syntax-local-apply-transformer))
+ (get-current-expand-context.1 #f who2_0))))
(let-values (((local-ctx_2)
- (let-values (((ctx3_0) ctx_14)
+ (let-values (((ctx3_0) ctx_91)
((context4_0) context_25)
((intdef-ctx5_0) intdef-ctx_0))
(make-local-expand-context.1
@@ -68511,108 +66436,107 @@
ctx3_0))))
(let-values (((scoped-args_0)
(transform-syntax-vals
- (lambda (s_472)
- (let-values (((temp6_6) (flip-introduction-scopes s_472 ctx_14))
+ (lambda (s_885)
+ (let-values (((temp6_6) (flip-introduction-scopes s_885 ctx_91))
((intdef-ctx7_0) intdef-ctx_0))
(add-intdef-scopes.1 unsafe-undefined #f temp6_6 intdef-ctx7_0)))
- args_11)))
+ args_14)))
(let-values (((scoped-binding-id_0)
- (if binding-id_0 (flip-introduction-scopes binding-id_0 ctx_14) #f)))
+ (if binding-id_0 (flip-introduction-scopes binding-id_0 ctx_91) #f)))
(let-values (((output-vals_0)
(with-continuation-mark
current-expand-context
#f
- (let-values ()
- (apply-transformer
- 'syntax-local-apply-transformer
- transformer_0
- scoped-binding-id_0
- scoped-args_0
- local-ctx_2)))))
+ (apply-transformer
+ 'syntax-local-apply-transformer
+ transformer_0
+ scoped-binding-id_0
+ scoped-args_0
+ local-ctx_2
+ expander-insp_0))))
(let-values (((result-vals_0)
(transform-syntax-vals
- (lambda (s_51) (flip-introduction-scopes s_51 ctx_14))
+ (lambda (s_886) (flip-introduction-scopes s_886 ctx_91))
output-vals_0)))
(apply values result-vals_0))))))))))))))))
(define-values
(apply-transformer)
- (lambda (who_37 transformer_1 binding-id_2 args_12 ctx_57)
+ (lambda (who_51 transformer_1 binding-id_1 args_15 ctx_92 expander-insp_1)
(begin
- (let-values (((binding_28 insp-of-t_7)
- (if binding-id_2
- (let-values (((binding_29)
- (let-values (((binding-id8_0) binding-id_2)
- ((temp9_10) (expand-context-phase ctx_57))
+ (let-values (((binding_29 insp-of-t_7)
+ (if binding-id_1
+ (let-values (((binding_30)
+ (let-values (((binding-id8_0) binding-id_1)
+ ((temp9_10) (expand-context-phase ctx_92))
((temp10_10) 'ambiguous)
((temp11_8) #t))
(resolve+shift.1 temp10_10 #f null temp11_8 #f binding-id8_0 temp9_10))))
(begin
- (if (not binding_29)
- (let-values () (error who_37 "unbound identifier: ~v" binding-id_2))
- (void))
- (let-values (((t_35 primitive?_9 insp-of-t_8 protected?_11)
- (let-values (((binding12_0) binding_29)
- ((ctx13_0) ctx_57)
- ((binding-id14_0) binding-id_2)
+ (if (not binding_30) (error who_51 "unbound identifier: ~v" binding-id_1) (void))
+ (let-values (((t_40 primitive?_9 insp-of-t_8 protected?_11)
+ (let-values (((binding12_0) binding_30)
+ ((ctx13_0) ctx_92)
+ ((binding-id14_0) binding-id_1)
((temp15_10) #t))
(lookup.1 #f temp15_10 binding12_0 ctx13_0 binding-id14_0))))
- (values binding_29 insp-of-t_8))))
+ (values binding_30 insp-of-t_8))))
(values #f #f))))
(let-values (((intro-scope_3) (new-scope 'macro)))
- (let-values (((use-scopes_2) (maybe-create-use-site-scope ctx_57 binding_28)))
+ (let-values (((use-scopes_2) (maybe-create-use-site-scope ctx_92 binding_29)))
(let-values (((scope-arg_0)
- (lambda (s_470)
+ (lambda (s_887)
(begin
'scope-arg
- (let-values (((intro-s_1) (add-scope s_470 intro-scope_3)))
+ (let-values (((intro-s_1) (add-scope s_887 intro-scope_3)))
(let-values (((use-s_5) (add-scopes intro-s_1 use-scopes_2))) use-s_5))))))
- (let-values (((scoped-args_1) (transform-syntax-vals scope-arg_0 args_12)))
+ (let-values (((scoped-args_1) (transform-syntax-vals scope-arg_0 args_15)))
(let-values (((transformed-vals_0)
(apply-transformer-in-context
transformer_1
scoped-args_1
- ctx_57
+ ctx_92
intro-scope_3
use-scopes_2
- binding-id_2
- insp-of-t_7)))
+ binding-id_1
+ insp-of-t_7
+ expander-insp_1)))
(let-values (((scope-res_0)
- (lambda (s_176)
+ (lambda (s_888)
(begin
'scope-res
- (let-values (((result-s_9) (flip-scope s_176 intro-scope_3)))
- (let-values (((post-s_2) (maybe-add-post-expansion result-s_9 ctx_57)))
+ (let-values (((result-s_9) (flip-scope s_888 intro-scope_3)))
+ (let-values (((post-s_2) (maybe-add-post-expansion result-s_9 ctx_92)))
post-s_2))))))
(let-values (((result-vals_1) (transform-syntax-vals scope-res_0 transformed-vals_0)))
result-vals_1)))))))))))
(define-values
(apply-transformer-in-context)
- (lambda (transformer_2 args_13 ctx_82 intro-scope_4 use-scopes_3 binding-id_3 insp-of-t_9)
+ (lambda (transformer_2 args_16 ctx_93 intro-scope_4 use-scopes_3 binding-id_2 insp-of-t_9 expander-insp_2)
(begin
(let-values (((m-ctx_1)
- (let-values (((v_99) ctx_82))
- (let-values (((the-struct_86) v_99))
- (if (expand-context/outer? the-struct_86)
+ (let-values (((v_411) ctx_93))
+ (let-values (((the-struct_94) v_411))
+ (if (expand-context/outer? the-struct_94)
(let-values (((current-introduction-scopes16_0) (list intro-scope_4))
((current-use-scopes17_0) use-scopes_3)
- ((inner18_0) (root-expand-context/outer-inner v_99)))
+ ((inner18_0) (root-expand-context/outer-inner v_411)))
(expand-context/outer1.1
inner18_0
- (root-expand-context/outer-post-expansion the-struct_86)
- (root-expand-context/outer-use-site-scopes the-struct_86)
- (root-expand-context/outer-frame-id the-struct_86)
- (expand-context/outer-context the-struct_86)
- (expand-context/outer-env the-struct_86)
- (expand-context/outer-scopes the-struct_86)
- (expand-context/outer-def-ctx-scopes the-struct_86)
- (expand-context/outer-binding-layer the-struct_86)
- (expand-context/outer-reference-records the-struct_86)
- (expand-context/outer-only-immediate? the-struct_86)
- (expand-context/outer-need-eventually-defined the-struct_86)
+ (root-expand-context/outer-post-expansion the-struct_94)
+ (root-expand-context/outer-use-site-scopes the-struct_94)
+ (root-expand-context/outer-frame-id the-struct_94)
+ (expand-context/outer-context the-struct_94)
+ (expand-context/outer-env the-struct_94)
+ (expand-context/outer-scopes the-struct_94)
+ (expand-context/outer-def-ctx-scopes the-struct_94)
+ (expand-context/outer-binding-layer the-struct_94)
+ (expand-context/outer-reference-records the-struct_94)
+ (expand-context/outer-only-immediate? the-struct_94)
+ (expand-context/outer-need-eventually-defined the-struct_94)
current-introduction-scopes16_0
current-use-scopes17_0
- (expand-context/outer-name the-struct_86)))
- (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_86))))))
+ (expand-context/outer-name the-struct_94)))
+ (raise-argument-error 'struct-copy "expand-context/outer?" the-struct_94))))))
(let-values (((transformed-vals_1)
(with-continuation-mark
parameterization-key
@@ -68620,110 +66544,89 @@
(continuation-mark-set-first #f parameterization-key)
1/current-namespace
(namespace->namespace-at-phase
- (expand-context-namespace ctx_82)
- (add1 (expand-context-phase ctx_82))))
- (let-values ()
- (with-continuation-mark
- current-expand-context
- m-ctx_1
- (with-continuation-mark
- current-module-code-inspector
- (let-values (((a_72) insp-of-t_9) ((b_109) (current-module-code-inspector)))
- (if (eq? a_72 b_109)
- (let-values () a_72)
- (if (not a_72)
- (let-values () #f)
- (if (not b_109)
- (let-values () #f)
- (if (inspector-superior? a_72 b_109)
- (let-values () b_109)
- (if (inspector-superior? b_109 a_72) (let-values () a_72) (let-values () #f)))))))
- (let-values ()
- (call-with-continuation-barrier
- (lambda () (call-with-values (lambda () (apply transformer_2 args_13)) list))))))))))
+ (expand-context-namespace ctx_93)
+ (add1 (expand-context-phase ctx_93))))
+ (with-continuation-mark
+ current-expand-context
+ m-ctx_1
+ (with-continuation-mark
+ current-module-code-inspector
+ (let-values (((a_78) insp-of-t_9) ((b_144) expander-insp_2))
+ (if (eq? a_78 b_144)
+ a_78
+ (if (not a_78)
+ #f
+ (if (not b_144)
+ #f
+ (if (inspector-superior? a_78 b_144)
+ b_144
+ (if (inspector-superior? b_144 a_78) a_78 #f))))))
+ (call-with-continuation-barrier
+ (lambda () (call-with-values (lambda () (apply transformer_2 args_16)) list))))))))
transformed-vals_1)))))
(define-values
(1/syntax-tainted?)
- (lambda (s_0)
+ (lambda (s_889)
(begin
'syntax-tainted?
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_0) (void) (let-values () (raise-argument-error 'syntax-tainted? "syntax?" s_0)))
- (syntax-tainted?$1 s_0)))))))
+ (begin
+ (if (syntax?$1 s_889) (void) (raise-argument-error 'syntax-tainted? "syntax?" s_889))
+ (syntax-tainted?$1 s_889)))))
(define-values
(1/syntax-arm)
(let-values (((syntax-arm_0)
(lambda (s3_3 maybe-insp1_0 use-mode?2_0)
(begin
'syntax-arm
- (let-values (((s_325) s3_3))
+ (let-values (((s_890) s3_3))
(let-values (((maybe-insp_0) maybe-insp1_0))
(let-values ()
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_325)
- (void)
- (let-values () (raise-argument-error 'syntax-arm "syntax?" s_325)))
- (if (let-values (((or-part_0) (not maybe-insp_0)))
- (if or-part_0 or-part_0 (inspector? maybe-insp_0)))
- (void)
- (let-values ()
- (raise-argument-error 'syntax-arm "(or/c inspector? #f)" maybe-insp_0)))
- s_325)))))))))))
+ (begin
+ (if (syntax?$1 s_890) (void) (raise-argument-error 'syntax-arm "syntax?" s_890))
+ (if (let-values (((or-part_904) (not maybe-insp_0)))
+ (if or-part_904 or-part_904 (inspector? maybe-insp_0)))
+ (void)
+ (raise-argument-error 'syntax-arm "(or/c inspector? #f)" maybe-insp_0))
+ s_890))))))))
(case-lambda
- ((s_90) (begin 'syntax-arm (syntax-arm_0 s_90 #f #f)))
- ((s_13 maybe-insp_1 use-mode?2_1) (syntax-arm_0 s_13 maybe-insp_1 use-mode?2_1))
- ((s_48 maybe-insp1_1) (syntax-arm_0 s_48 maybe-insp1_1 #f)))))
+ ((s_891) (begin 'syntax-arm (syntax-arm_0 s_891 #f #f)))
+ ((s_892 maybe-insp_1 use-mode?2_1) (syntax-arm_0 s_892 maybe-insp_1 use-mode?2_1))
+ ((s_893 maybe-insp1_1) (syntax-arm_0 s_893 maybe-insp1_1 #f)))))
(define-values
(1/syntax-disarm)
- (lambda (s_512 maybe-insp_2)
+ (lambda (s_894 maybe-insp_2)
(begin
'syntax-disarm
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_512) (void) (let-values () (raise-argument-error 'syntax-disarm "syntax?" s_512)))
- (if (let-values (((or-part_85) (not maybe-insp_2))) (if or-part_85 or-part_85 (inspector? maybe-insp_2)))
- (void)
- (let-values () (raise-argument-error 'syntax-disarm "(or/c inspector? #f)" maybe-insp_2)))
- s_512))))))
+ (begin
+ (if (syntax?$1 s_894) (void) (raise-argument-error 'syntax-disarm "syntax?" s_894))
+ (if (let-values (((or-part_905) (not maybe-insp_2))) (if or-part_905 or-part_905 (inspector? maybe-insp_2)))
+ (void)
+ (raise-argument-error 'syntax-disarm "(or/c inspector? #f)" maybe-insp_2))
+ s_894))))
(define-values
(1/syntax-rearm)
(let-values (((syntax-rearm_0)
(lambda (s5_5 from-s6_0 use-mode?4_0)
(begin
'syntax-rearm
- (let-values (((s_514) s5_5))
+ (let-values (((s_895) s5_5))
(let-values (((from-s_2) from-s6_0))
(let-values ()
- (let-values ()
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_514)
- (void)
- (let-values () (raise-argument-error 'syntax-rearm "syntax?" s_514)))
- (if (syntax?$1 from-s_2)
- (void)
- (let-values () (raise-argument-error 'syntax-rearm "syntax?" from-s_2)))
- s_514)))))))))))
+ (begin
+ (if (syntax?$1 s_895) (void) (raise-argument-error 'syntax-rearm "syntax?" s_895))
+ (if (syntax?$1 from-s_2) (void) (raise-argument-error 'syntax-rearm "syntax?" from-s_2))
+ s_895))))))))
(case-lambda
- ((s_566 from-s_3) (begin 'syntax-rearm (syntax-rearm_0 s_566 from-s_3 #f)))
- ((s_523 from-s_4 use-mode?4_1) (syntax-rearm_0 s_523 from-s_4 use-mode?4_1)))))
+ ((s_896 from-s_3) (begin 'syntax-rearm (syntax-rearm_0 s_896 from-s_3 #f)))
+ ((s_897 from-s_4 use-mode?4_1) (syntax-rearm_0 s_897 from-s_4 use-mode?4_1)))))
(define-values
(1/syntax-taint)
- (lambda (s_472)
+ (lambda (s_898)
(begin
'syntax-taint
- (let-values ()
- (let-values ()
- (begin
- (if (syntax?$1 s_472) (void) (let-values () (raise-argument-error 'syntax-taint "syntax?" s_472)))
- (syntax-taint$1 s_472)))))))
+ (begin
+ (if (syntax?$1 s_898) (void) (raise-argument-error 'syntax-taint "syntax?" s_898))
+ (syntax-taint$1 s_898)))))
(define-values
(struct:serialized-syntax
serialized-syntax1.1
@@ -68733,484 +66636,674 @@
serialized-syntax-base-mpi-pos
serialized-syntax-data
serialized-syntax-need-registry?)
- (let-values (((struct:_2 make-_2 ?_2 -ref_2 -set!_2)
- (let-values ()
- (let-values ()
- (make-struct-type
- 'serialized-syntax
- #f
- 5
- 0
- #f
- null
- 'prefab
- #f
- '(0 1 2 3 4)
- #f
- 'serialized-syntax)))))
+ (let-values (((struct:_145 make-_145 ?_145 -ref_145 -set!_145)
+ (make-struct-type 'serialized-syntax #f 5 0 #f null 'prefab #f '(0 1 2 3 4) #f 'serialized-syntax)))
(values
- struct:_2
- make-_2
- ?_2
- (make-struct-field-accessor -ref_2 0 'version)
- (make-struct-field-accessor -ref_2 1 'mpis)
- (make-struct-field-accessor -ref_2 2 'base-mpi-pos)
- (make-struct-field-accessor -ref_2 3 'data)
- (make-struct-field-accessor -ref_2 4 'need-registry?))))
+ struct:_145
+ make-_145
+ ?_145
+ (make-struct-field-accessor -ref_145 0 'version)
+ (make-struct-field-accessor -ref_145 1 'mpis)
+ (make-struct-field-accessor -ref_145 2 'base-mpi-pos)
+ (make-struct-field-accessor -ref_145 3 'data)
+ (make-struct-field-accessor -ref_145 4 'need-registry?))))
(define-values
(1/syntax-serialize)
(let-values (((syntax-serialize_0)
- (lambda (stx5_0 base-mpi2_0 preserve-prop-keys3_0 provides-namespace4_0)
+ (lambda (stx10_0
+ base-mpi2_0
+ preserve-prop-keys3_0
+ provides-namespace4_0
+ as-data?5_0
+ init-mpis6_0
+ report-mpi-shifts7_0
+ map-mpi8_0
+ map-binding-symbol9_0)
(begin
'syntax-serialize
- (let-values (((stx_20) stx5_0))
+ (let-values (((stx_28) stx10_0))
(let-values (((base-mpi_0) base-mpi2_0))
(let-values (((preserve-prop-keys_2) preserve-prop-keys3_0))
(let-values (((provides-namespace_0)
(if (eq? provides-namespace4_0 unsafe-undefined)
(1/current-namespace)
provides-namespace4_0)))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (syntax?$1 stx_20)
- (void)
- (let-values ()
- (raise-argument-error 'syntax-serialize "syntax?" stx_20)))
- (values))))
- (let-values ((()
- (begin
- (if ((lambda (x_103)
- (let-values (((or-part_85) (not x_103)))
- (if or-part_85 or-part_85 (1/module-path-index? x_103))))
- base-mpi_0)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-serialize
- "(or/c module-path-index? #f)"
- base-mpi_0)))
- (values))))
+ (let-values (((as-data?_2) as-data?5_0))
+ (let-values (((init-mpis_0) init-mpis6_0))
+ (let-values (((report-mpi-shifts_2) report-mpi-shifts7_0))
+ (let-values (((map-mpi_1)
+ (if (eq? map-mpi8_0 unsafe-undefined)
+ (lambda (mpi_91) (begin 'map-mpi mpi_91))
+ map-mpi8_0)))
+ (let-values (((map-binding-symbol_3)
+ (if (eq? map-binding-symbol9_0 unsafe-undefined)
+ (lambda (mpi_92 sym_144 phase_200)
+ (begin 'map-binding-symbol (values sym_144 phase_200)))
+ map-binding-symbol9_0)))
(let-values ((()
(begin
- (if ((lambda (l_72) (if (list? l_72) (andmap2 symbol? l_72) #f))
- preserve-prop-keys_2)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-serialize
- "(listof symbol?)"
- preserve-prop-keys_2)))
+ (if as-data?_2
+ (if (syntax?$1 stx_28)
+ (void)
+ (raise-argument-error 'syntax-serialize "syntax?" stx_28))
+ (if (vector? stx_28)
+ (void)
+ (raise-argument-error 'syntax-serialize "vector?" stx_28)))
(values))))
(let-values ((()
(begin
- (if ((lambda (x_104)
- (let-values (((or-part_75) (not x_104)))
- (if or-part_75 or-part_75 (1/namespace? x_104))))
- provides-namespace_0)
+ (if ((lambda (x_113)
+ (let-values (((or-part_906) (not x_113)))
+ (if or-part_906
+ or-part_906
+ (1/module-path-index? x_113))))
+ base-mpi_0)
(void)
- (let-values ()
+ (raise-argument-error
+ 'syntax-serialize
+ "(or/c module-path-index? #f)"
+ base-mpi_0))
+ (values))))
+ (let-values ((()
+ (begin
+ (if ((lambda (l_90)
+ (if (list? l_90) (andmap2 symbol? l_90) #f))
+ preserve-prop-keys_2)
+ (void)
(raise-argument-error
'syntax-serialize
- "(or/c namespace? #f)"
- provides-namespace_0)))
- (values))))
- (let-values (((mpis_23) (make-module-path-index-table)))
- (let-values (((base-mpi-pos_0)
- (if base-mpi_0
- (add-module-path-index!/pos mpis_23 base-mpi_0)
- #f)))
- (let-values (((data_2)
- (let-values (((stx10_0) stx_20)
- ((mpis11_0) mpis_23)
- ((temp12_10) #t)
- ((temp13_1)
- (let-values (((lst_290) preserve-prop-keys_2))
- (begin
- (if (variable-reference-from-unsafe?
- (#%variable-reference))
- (void)
- (let-values () (check-list lst_290)))
- ((letrec-values (((for-loop_257)
- (lambda (table_231
- lst_106)
- (begin
- 'for-loop
- (if (pair? lst_106)
- (let-values (((k_57)
- (unsafe-car
- lst_106))
- ((rest_50)
- (unsafe-cdr
- lst_106)))
- (let-values (((table_200)
- (let-values (((table_226)
- table_231))
- (let-values (((table_113)
- (let-values ()
- (let-values (((key_28
- val_86)
- (let-values ()
- (values
- k_57
- #t))))
- (hash-set
- table_226
- key_28
- val_86)))))
- (values
- table_113)))))
- (if (not #f)
- (for-loop_257
- table_200
- rest_50)
- table_200)))
- table_231)))))
- for-loop_257)
- '#hasheq()
- lst_290))))
- ((temp14_2)
- (if provides-namespace_0
- (lambda (modname_0)
- (begin
- 'temp14
- (not
- (namespace->module
- provides-namespace_0
- modname_0))))
- (lambda (modname_1) (begin 'temp14 #t)))))
- (generate-deserialize.1
- temp12_10
- temp14_2
- mpis11_0
- #f
- temp13_1
- #t
- stx10_0))))
- (serialized-syntax1.1
- (version)
- (let-values (((mpis15_0) mpis_23) ((temp16_11) #t))
- (generate-module-path-index-deserialize.1 temp16_11 mpis15_0))
- base-mpi-pos_0
- data_2
- (if provides-namespace_0 #t #f))))))))))))))))))))
+ "(listof symbol?)"
+ preserve-prop-keys_2))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (if (not as-data?_2) (hash? provides-namespace_0) #f)
+ (void)
+ (if ((lambda (x_114)
+ (let-values (((or-part_907) (not x_114)))
+ (if or-part_907
+ or-part_907
+ (1/namespace? x_114))))
+ provides-namespace_0)
+ (void)
+ (raise-argument-error
+ 'syntax-serialize
+ "(or/c namespace? #f)"
+ provides-namespace_0)))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (let-values (((or-part_908) as-data?_2))
+ (if or-part_908
+ or-part_908
+ (eq?
+ (current-code-inspector)
+ initial-code-inspector)))
+ (void)
+ (error
+ 'syntax-serialize
+ "internal serialization disallowed by code inspector"))
+ (values))))
+ (let-values (((mpis_25) (make-module-path-index-table)))
+ (let-values ((()
+ (begin
+ (let-values (((lst_558) init-mpis_0))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_558))
+ ((letrec-values (((for-loop_455)
+ (lambda (lst_559)
+ (begin
+ 'for-loop
+ (if (pair? lst_559)
+ (let-values (((init-mpi_0)
+ (unsafe-car
+ lst_559))
+ ((rest_275)
+ (unsafe-cdr
+ lst_559)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (add-module-path-index!/pos
+ mpis_25
+ init-mpi_0)
+ (values))))
+ (values))))
+ (if (not #f)
+ (for-loop_455
+ rest_275)
+ (values))))
+ (values))))))
+ for-loop_455)
+ lst_558)))
+ (values))))
+ (let-values ()
+ (let-values (((base-mpi-pos_0)
+ (if base-mpi_0
+ (add-module-path-index!/pos mpis_25 base-mpi_0)
+ #f)))
+ (let-values (((data_2)
+ (let-values (((stx13_0) stx_28)
+ ((mpis14_0) mpis_25)
+ ((as-data?15_0) as-data?_2)
+ ((temp16_12)
+ (let-values (((table_321)
+ (let-values (((table_322)
+ '#hasheq()))
+ table_322)))
+ (let-values (((lst_560)
+ preserve-prop-keys_2))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_560))
+ ((letrec-values (((for-loop_456)
+ (lambda (table_323
+ lst_561)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_561)
+ (let-values (((k_68)
+ (unsafe-car
+ lst_561))
+ ((rest_276)
+ (unsafe-cdr
+ lst_561)))
+ (let-values (((table_324)
+ (let-values (((table_325)
+ (let-values (((key_113
+ val_94)
+ (values
+ k_68
+ #t)))
+ (hash-set
+ table_323
+ key_113
+ val_94))))
+ (values
+ table_325))))
+ (if (not
+ #f)
+ (for-loop_456
+ table_324
+ rest_276)
+ table_324)))
+ table_323)))))
+ for-loop_456)
+ table_321
+ lst_560)))))
+ ((temp17_7)
+ (if provides-namespace_0
+ (lambda (modname_0)
+ (begin
+ 'temp17
+ (if (hash?
+ provides-namespace_0)
+ (not
+ (hash-ref
+ provides-namespace_0
+ modname_0
+ #f))
+ (not
+ (namespace->module
+ provides-namespace_0
+ modname_0)))))
+ (lambda (modname_1)
+ (begin 'temp17 #t))))
+ ((map-mpi18_0) map-mpi_1)
+ ((map-binding-symbol19_0)
+ map-binding-symbol_3)
+ ((report-mpi-shifts20_0)
+ report-mpi-shifts_2))
+ (generate-deserialize.1
+ as-data?15_0
+ temp17_7
+ map-binding-symbol19_0
+ map-mpi18_0
+ mpis14_0
+ #f
+ temp16_12
+ report-mpi-shifts20_0
+ #t
+ stx13_0))))
+ (if as-data?_2
+ (serialized-syntax1.1
+ (version)
+ (let-values (((mpis21_0) mpis_25) ((temp22_7) #t))
+ (generate-module-path-index-deserialize.1
+ temp22_7
+ mpis21_0))
+ base-mpi-pos_0
+ data_2
+ (if provides-namespace_0 #t #f))
+ (values
+ data_2
+ (module-path-index-table-mpis
+ mpis_25))))))))))))))))))))))))))
(case-lambda
- ((stx_21) (begin 'syntax-serialize (syntax-serialize_0 stx_21 #f '() unsafe-undefined)))
- ((stx_22 base-mpi_1 preserve-prop-keys_3 provides-namespace4_1)
- (syntax-serialize_0 stx_22 base-mpi_1 preserve-prop-keys_3 provides-namespace4_1))
- ((stx_23 base-mpi_2 preserve-prop-keys3_1)
- (syntax-serialize_0 stx_23 base-mpi_2 preserve-prop-keys3_1 unsafe-undefined))
- ((stx_24 base-mpi2_1) (syntax-serialize_0 stx_24 base-mpi2_1 '() unsafe-undefined)))))
+ ((stx_29)
+ (begin
+ 'syntax-serialize
+ (syntax-serialize_0 stx_29 #f '() unsafe-undefined #t '() #f unsafe-undefined unsafe-undefined)))
+ ((stx_30
+ base-mpi_1
+ preserve-prop-keys_3
+ provides-namespace_1
+ as-data?_3
+ init-mpis_1
+ report-mpi-shifts_3
+ map-mpi_2
+ map-binding-symbol9_1)
+ (syntax-serialize_0
+ stx_30
+ base-mpi_1
+ preserve-prop-keys_3
+ provides-namespace_1
+ as-data?_3
+ init-mpis_1
+ report-mpi-shifts_3
+ map-mpi_2
+ map-binding-symbol9_1))
+ ((stx_31
+ base-mpi_2
+ preserve-prop-keys_4
+ provides-namespace_2
+ as-data?_4
+ init-mpis_2
+ report-mpi-shifts_4
+ map-mpi8_1)
+ (syntax-serialize_0
+ stx_31
+ base-mpi_2
+ preserve-prop-keys_4
+ provides-namespace_2
+ as-data?_4
+ init-mpis_2
+ report-mpi-shifts_4
+ map-mpi8_1
+ unsafe-undefined))
+ ((stx_32 base-mpi_3 preserve-prop-keys_5 provides-namespace_3 as-data?_5 init-mpis_3 report-mpi-shifts7_1)
+ (syntax-serialize_0
+ stx_32
+ base-mpi_3
+ preserve-prop-keys_5
+ provides-namespace_3
+ as-data?_5
+ init-mpis_3
+ report-mpi-shifts7_1
+ unsafe-undefined
+ unsafe-undefined))
+ ((stx_33 base-mpi_4 preserve-prop-keys_6 provides-namespace_4 as-data?_6 init-mpis6_1)
+ (syntax-serialize_0
+ stx_33
+ base-mpi_4
+ preserve-prop-keys_6
+ provides-namespace_4
+ as-data?_6
+ init-mpis6_1
+ #f
+ unsafe-undefined
+ unsafe-undefined))
+ ((stx_34 base-mpi_5 preserve-prop-keys_7 provides-namespace_5 as-data?5_1)
+ (syntax-serialize_0
+ stx_34
+ base-mpi_5
+ preserve-prop-keys_7
+ provides-namespace_5
+ as-data?5_1
+ '()
+ #f
+ unsafe-undefined
+ unsafe-undefined))
+ ((stx_35 base-mpi_6 preserve-prop-keys_8 provides-namespace4_1)
+ (syntax-serialize_0
+ stx_35
+ base-mpi_6
+ preserve-prop-keys_8
+ provides-namespace4_1
+ #t
+ '()
+ #f
+ unsafe-undefined
+ unsafe-undefined))
+ ((stx_36 base-mpi_7 preserve-prop-keys3_1)
+ (syntax-serialize_0
+ stx_36
+ base-mpi_7
+ preserve-prop-keys3_1
+ unsafe-undefined
+ #t
+ '()
+ #f
+ unsafe-undefined
+ unsafe-undefined))
+ ((stx_37 base-mpi2_1)
+ (syntax-serialize_0 stx_37 base-mpi2_1 '() unsafe-undefined #t '() #f unsafe-undefined unsafe-undefined)))))
(define-values
(1/syntax-deserialize)
- (let-values (((syntax-deserialize_0)
- (lambda (data7_0 base-mpi6_0)
+ (case-lambda
+ (()
+ (begin
+ 'syntax-deserialize
+ (let-values ((()
+ (begin
+ (if (eq? (current-code-inspector) initial-code-inspector)
+ (void)
+ (error 'syntax-deserialize "deserialization disallowed by code inspector"))
+ (values))))
+ (let-values (((bulk-binding-registry_24) (make-bulk-binding-registry)))
+ (begin
+ ((letrec-values (((loop_150)
+ (lambda (mod-name_26)
+ (begin
+ 'loop
+ (let-values (((m_41) (namespace->module (1/current-namespace) mod-name_26)))
+ (begin
+ (register-bulk-provide!
+ bulk-binding-registry_24
+ mod-name_26
+ (module-self m_41)
+ (module-provides m_41))
+ (let-values (((lst_562) (module-requires m_41)))
+ (begin
+ (if (variable-reference-from-unsafe? (#%variable-reference))
+ (void)
+ (check-list lst_562))
+ ((letrec-values (((for-loop_457)
+ (lambda (lst_563)
+ (begin
+ 'for-loop
+ (if (pair? lst_563)
+ (let-values (((phase+requires_0) (unsafe-car lst_563))
+ ((rest_277) (unsafe-cdr lst_563)))
+ (let-values ((()
+ (let-values (((lst_564)
+ (cdr phase+requires_0)))
+ (begin
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
+ (void)
+ (check-list lst_564))
+ ((letrec-values (((for-loop_458)
+ (lambda (lst_565)
+ (begin
+ 'for-loop
+ (if (pair?
+ lst_565)
+ (let-values (((req_19)
+ (unsafe-car
+ lst_565))
+ ((rest_278)
+ (unsafe-cdr
+ lst_565)))
+ (let-values ((()
+ (let-values ((()
+ (begin
+ (loop_150
+ (1/module-path-index-resolve
+ req_19))
+ (values))))
+ (values))))
+ (if (not
+ #f)
+ (for-loop_458
+ rest_278)
+ (values))))
+ (values))))))
+ for-loop_458)
+ lst_564)))))
+ (if (not #f) (for-loop_457 rest_277) (values))))
+ (values))))))
+ for-loop_457)
+ lst_562)))
+ (void)))))))
+ loop_150)
+ (1/make-resolved-module-path '#%builtin))
+ (values
+ deserialize-instance
+ bulk-binding-registry_24
+ register-bulk-provide!
+ syntax-shift-module-path-index))))))
+ ((data_3) (1/syntax-deserialize data_3 #f))
+ ((data_4 base-mpi_8)
+ (let-values ((()
(begin
- 'syntax-deserialize
- (let-values (((data_3) data7_0))
- (let-values (((base-mpi_3) base-mpi6_0))
- (let-values ()
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if ((lambda (x_105)
- (let-values (((or-part_9) (not x_105)))
- (if or-part_9 or-part_9 (1/module-path-index? x_105))))
- base-mpi_3)
- (void)
- (let-values ()
- (raise-argument-error
- 'syntax-deserialize
- "(or/c module-path-index? #f)"
- base-mpi_3)))
- (values))))
- (let-values ((()
- (begin
- (if (serialized-syntax? data_3)
- (void)
- (let-values ()
- (raise-arguments-error
- 'syntax-deserialize
- "invalid serialized form"
- "value"
- data_3)))
- (values))))
- (let-values ((()
- (begin
- (if (equal? (version) (serialized-syntax-version data_3))
- (void)
- (let-values ()
- (raise-arguments-error
- 'syntax-deserialize
- "version mismatch"
- "expected"
- (version)
- "found"
- (serialized-syntax-version data_3))))
- (values))))
- (let-values ((()
- (begin
- (if (eq? (current-code-inspector) initial-code-inspector)
- (void)
- (let-values ()
- (error
- 'syntax-deserialize
- "deserialization disallowed by code inspector")))
- (values))))
- (let-values (((orig-mpis_0)
- (deserialize-module-path-index-data
- (serialized-syntax-mpis data_3))))
- (let-values (((orig-base-mpi_0)
- (if base-mpi_3
- (let-values (((pos_128)
- (serialized-syntax-base-mpi-pos data_3)))
- (if pos_128 (vector-ref orig-mpis_0 pos_128) #f))
- #f)))
- (let-values (((shifted-mpis_0)
- (if orig-base-mpi_0
- (let-values (((len_74) (vector-length orig-mpis_0)))
+ (if ((lambda (x_115)
+ (let-values (((or-part_909) (not x_115)))
+ (if or-part_909 or-part_909 (1/module-path-index? x_115))))
+ base-mpi_8)
+ (void)
+ (raise-argument-error 'syntax-deserialize "(or/c module-path-index? #f)" base-mpi_8))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (serialized-syntax? data_4)
+ (void)
+ (raise-arguments-error 'syntax-deserialize "invalid serialized form" "value" data_4))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (equal? (version) (serialized-syntax-version data_4))
+ (void)
+ (raise-arguments-error
+ 'syntax-deserialize
+ "version mismatch"
+ "expected"
+ (version)
+ "found"
+ (serialized-syntax-version data_4)))
+ (values))))
+ (let-values ((()
+ (begin
+ (if (eq? (current-code-inspector) initial-code-inspector)
+ (void)
+ (error 'syntax-deserialize "deserialization disallowed by code inspector"))
+ (values))))
+ (let-values (((orig-mpis_0) (deserialize-module-path-index-data (serialized-syntax-mpis data_4))))
+ (let-values (((orig-base-mpi_0)
+ (if base-mpi_8
+ (let-values (((pos_191) (serialized-syntax-base-mpi-pos data_4)))
+ (if pos_191 (vector-ref orig-mpis_0 pos_191) #f))
+ #f)))
+ (let-values (((shifted-mpis_0)
+ (if orig-base-mpi_0
+ (let-values (((len_81) (vector-length orig-mpis_0)))
+ (begin
+ (if (exact-nonnegative-integer? len_81)
+ (void)
+ (1/raise-argument-error 'for/vector "exact-nonnegative-integer?" len_81))
+ (let-values (((v_412) (make-vector len_81 0)))
+ (begin
+ (if (zero? len_81)
+ (void)
+ (let-values (((i_317) (let-values (((i_318) 0)) i_318)))
+ (let-values (((vec_99 len_82)
+ (let-values (((vec_100) orig-mpis_0))
(begin
- (if (exact-nonnegative-integer? len_74)
+ (if (variable-reference-from-unsafe?
+ (#%variable-reference))
(void)
- (let-values ()
- (raise-argument-error
- 'for/vector
- "exact-nonnegative-integer?"
- len_74)))
- (let-values (((v_37) (make-vector len_74 0)))
- (begin
- (if (zero? len_74)
- (void)
- (let-values ()
- (let-values (((vec_86 len_50)
- (let-values (((vec_85) orig-mpis_0))
- (begin
- (check-vector vec_85)
- (values
- vec_85
- (unsafe-vector-length
- vec_85))))))
- (begin
- #f
- ((letrec-values (((for-loop_268)
- (lambda (i_212 pos_147)
- (begin
- 'for-loop
- (if (unsafe-fx<
- pos_147
- len_50)
- (let-values (((mpi_64)
- (unsafe-vector-ref
- vec_86
- pos_147)))
- (let-values (((i_94)
- (let-values (((i_20)
- i_212))
- (let-values (((i_116)
- (let-values ()
- (begin
- (unsafe-vector*-set!
- v_37
- i_20
- (let-values ()
- (module-path-index-shift
- mpi_64
- orig-base-mpi_0
- base-mpi_3)))
- (unsafe-fx+
- 1
- i_20)))))
- (values
- i_116)))))
- (if (if (not
- ((lambda x_106
- (unsafe-fx=
- i_94
- len_74))
- mpi_64))
- (not #f)
- #f)
- (for-loop_268
- i_94
- (unsafe-fx+
- 1
- pos_147))
- i_94)))
- i_212)))))
- for-loop_268)
- 0
- 0)))))
- v_37))))
- orig-mpis_0)))
- (let-values (((bulk-binding-registry_23)
- (if (serialized-syntax-need-registry? data_3)
- (namespace-bulk-binding-registry (1/current-namespace))
- #f)))
- (deserialize-data
- shifted-mpis_0
- #f
- bulk-binding-registry_23
- (serialized-syntax-data data_3)))))))))))))))))))
- (case-lambda
- ((data_4) (begin 'syntax-deserialize (syntax-deserialize_0 data_4 #f)))
- ((data_5 base-mpi6_1) (syntax-deserialize_0 data_5 base-mpi6_1)))))
+ (check-vector vec_100))
+ (values vec_100 (unsafe-vector-length vec_100))))))
+ ((letrec-values (((for-loop_459)
+ (lambda (i_319 pos_192)
+ (begin
+ 'for-loop
+ (if (unsafe-fx< pos_192 len_82)
+ (let-values (((mpi_93)
+ (unsafe-vector-ref vec_99 pos_192)))
+ (let-values (((i_320)
+ (let-values (((i_321)
+ (begin
+ (unsafe-vector*-set!
+ v_412
+ i_319
+ (module-path-index-shift
+ mpi_93
+ orig-base-mpi_0
+ base-mpi_8))
+ (unsafe-fx+
+ 1
+ i_319))))
+ (values i_321))))
+ (if (if (not
+ ((lambda x_116
+ (unsafe-fx= i_320 len_81))
+ mpi_93))
+ (not #f)
+ #f)
+ (for-loop_459 i_320 (unsafe-fx+ 1 pos_192))
+ i_320)))
+ i_319)))))
+ for-loop_459)
+ i_317
+ 0))))
+ v_412))))
+ orig-mpis_0)))
+ (let-values (((bulk-binding-registry_25)
+ (if (serialized-syntax-need-registry? data_4)
+ (namespace-bulk-binding-registry (1/current-namespace))
+ #f)))
+ (deserialize-data
+ shifted-mpis_0
+ #f
+ bulk-binding-registry_25
+ (serialized-syntax-data data_4)))))))))))))
+ (define-values
+ (syntax-shift-module-path-index)
+ (lambda (stx_38 from-mpi_10 to-mpi_9)
+ (begin
+ (let-values (((stx24_0) stx_38) ((from-mpi25_0) from-mpi_10) ((to-mpi26_0) to-mpi_9))
+ (syntax-module-path-index-shift.1 #f stx24_0 from-mpi25_0 to-mpi26_0 #f)))))
(define-values
(1/variable-reference->empty-namespace)
(lambda (vr_0)
(begin
'variable-reference->empty-namespace
- (let-values ()
- (let-values ()
- (begin
- (if (1/variable-reference? vr_0)
- (void)
- (let-values () (raise-argument-error 'variable-reference->empty-namespace "variable-reference?" vr_0)))
- (let-values (((temp2_7) (1/variable-reference->namespace vr_0)))
- (new-namespace.1 #t unsafe-undefined temp2_7))))))))
+ (begin
+ (if (1/variable-reference? vr_0)
+ (void)
+ (raise-argument-error 'variable-reference->empty-namespace "variable-reference?" vr_0))
+ (let-values (((temp2_7) (1/variable-reference->namespace vr_0)))
+ (new-namespace.1 #t unsafe-undefined temp2_7))))))
(define-values
(1/variable-reference->namespace)
(lambda (vr_1)
(begin
'variable-reference->namespace
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/variable-reference? vr_1)
- (void)
- (let-values ()
- (raise-argument-error 'variable-reference->namespace "variable-reference?" vr_1)))
- (values))))
- (let-values (((ns_65) (variable-reference->namespace* vr_1)))
- (let-values (((mpi_65) (namespace-mpi ns_65)))
- (begin
- (if (non-self-module-path-index? mpi_65)
- (let-values ()
- (with-continuation-mark
- parameterization-key
- (extend-parameterization
- (continuation-mark-set-first #f parameterization-key)
- 1/current-namespace
- ns_65)
- (let-values ()
- (let-values (((ns4_2) ns_65) ((mpi5_1) mpi_65) ((temp6_7) (namespace-0-phase ns_65)))
- (namespace-module-make-available!.1 unsafe-undefined ns4_2 mpi5_1 temp6_7)))))
- (void))
- ns_65)))))))))
+ (let-values ((()
+ (begin
+ (if (1/variable-reference? vr_1)
+ (void)
+ (raise-argument-error 'variable-reference->namespace "variable-reference?" vr_1))
+ (values))))
+ (let-values (((ns_149) (variable-reference->namespace* vr_1)))
+ (let-values (((mpi_94) (namespace-mpi ns_149)))
+ (begin
+ (if (non-self-module-path-index? mpi_94)
+ (with-continuation-mark
+ parameterization-key
+ (extend-parameterization
+ (continuation-mark-set-first #f parameterization-key)
+ 1/current-namespace
+ ns_149)
+ (let-values (((ns4_2) ns_149) ((mpi5_1) mpi_94) ((temp6_7) (namespace-0-phase ns_149)))
+ (namespace-module-make-available!.1 #f unsafe-undefined ns4_2 mpi5_1 temp6_7)))
+ (void))
+ ns_149)))))))
(define-values
(variable-reference->namespace*)
(lambda (vr_2)
(begin
(let-values (((inst_8) (1/variable-reference->instance vr_2)))
(if (symbol? inst_8)
- (let-values ()
- (1/module->namespace (list 'quote inst_8) (1/instance-data (1/variable-reference->instance vr_2 #t))))
- (if (not inst_8)
- (let-values () (1/instance-data (1/variable-reference->instance vr_2 #t)))
- (let-values () (1/instance-data inst_8))))))))
+ (1/module->namespace (list 'quote inst_8) (1/instance-data (1/variable-reference->instance vr_2 #t)))
+ (if (not inst_8) (1/instance-data (1/variable-reference->instance vr_2 #t)) (1/instance-data inst_8)))))))
(define-values
(1/variable-reference->module-path-index)
(lambda (vr_3)
(begin
'variable-reference->module-path-index
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/variable-reference? vr_3)
- (void)
- (let-values ()
- (raise-argument-error 'variable-reference->module-path-index "variable-reference?" vr_3)))
- (values))))
- (let-values (((mpi_66) (namespace-mpi (variable-reference->namespace* vr_3))))
- (if (top-level-module-path-index? mpi_66) #f mpi_66))))))))
+ (let-values ((()
+ (begin
+ (if (1/variable-reference? vr_3)
+ (void)
+ (raise-argument-error 'variable-reference->module-path-index "variable-reference?" vr_3))
+ (values))))
+ (let-values (((mpi_95) (namespace-mpi (variable-reference->namespace* vr_3))))
+ (if (top-level-module-path-index? mpi_95) #f mpi_95))))))
(define-values
(1/variable-reference->resolved-module-path)
(lambda (vr_4)
(begin
'variable-reference->resolved-module-path
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/variable-reference? vr_4)
- (void)
- (let-values ()
- (raise-argument-error
- 'variable-reference->resolved-module-path
- "variable-reference?"
- vr_4)))
- (values))))
- (let-values (((mpi_28) (1/variable-reference->module-path-index vr_4)))
- (if mpi_28 (1/module-path-index-resolve mpi_28) #f))))))))
+ (let-values ((()
+ (begin
+ (if (1/variable-reference? vr_4)
+ (void)
+ (raise-argument-error 'variable-reference->resolved-module-path "variable-reference?" vr_4))
+ (values))))
+ (let-values (((mpi_96) (1/variable-reference->module-path-index vr_4)))
+ (if mpi_96 (1/module-path-index-resolve mpi_96) #f))))))
(define-values
(1/variable-reference->module-source)
(lambda (vr_5)
(begin
'variable-reference->module-source
- (let-values ()
- (let-values ()
- (let-values ((()
- (begin
- (if (1/variable-reference? vr_5)
- (void)
- (let-values ()
- (raise-argument-error 'variable-reference->module-source "variable-reference?" vr_5)))
- (values))))
- (let-values (((ns_123) (variable-reference->namespace* vr_5))) (namespace-source-name ns_123))))))))
+ (let-values ((()
+ (begin
+ (if (1/variable-reference? vr_5)
+ (void)
+ (raise-argument-error 'variable-reference->module-source "variable-reference?" vr_5))
+ (values))))
+ (let-values (((ns_150) (variable-reference->namespace* vr_5))) (namespace-source-name ns_150))))))
(define-values
(1/variable-reference->phase)
(lambda (vr_6)
(begin
'variable-reference->phase
- (let-values ()
- (let-values ()
- (begin
- (if (1/variable-reference? vr_6)
- (void)
- (let-values () (raise-argument-error 'variable-reference->phase "variable-reference?" vr_6)))
- (namespace-phase (variable-reference->namespace* vr_6))))))))
+ (begin
+ (if (1/variable-reference? vr_6)
+ (void)
+ (raise-argument-error 'variable-reference->phase "variable-reference?" vr_6))
+ (namespace-phase (variable-reference->namespace* vr_6))))))
(define-values
(1/variable-reference->module-base-phase)
(lambda (vr_7)
(begin
'variable-reference->module-base-phase
- (let-values ()
- (let-values ()
- (begin
- (if (1/variable-reference? vr_7)
- (void)
- (let-values () (raise-argument-error 'variable-reference->module-base-phase "variable-reference?" vr_7)))
- (namespace-0-phase (variable-reference->namespace* vr_7))))))))
+ (begin
+ (if (1/variable-reference? vr_7)
+ (void)
+ (raise-argument-error 'variable-reference->module-base-phase "variable-reference?" vr_7))
+ (namespace-0-phase (variable-reference->namespace* vr_7))))))
(define-values
(1/variable-reference->module-declaration-inspector)
(lambda (vr_8)
(begin
'variable-reference->module-declaration-inspector
- (let-values ()
- (let-values ()
- (begin
- (if (1/variable-reference? vr_8)
- (void)
- (let-values ()
- (raise-argument-error 'variable-reference->module-declaration-inspector "variable-reference?" vr_8)))
- (if (1/variable-reference->instance vr_8)
- (let-values ()
- (raise-arguments-error
- 'variable-reference->module-declaration-inspector
- "variable reference does not refer to an anonymous module variable"
- "variable reference"
- vr_8))
- (void))
- (let-values (((or-part_533) (namespace-declaration-inspector (variable-reference->namespace* vr_8))))
- (if or-part_533
- or-part_533
- (raise-arguments-error
- 'variable-reference->module-declaration-inspector
- "given variable reference is not from a module")))))))))
+ (begin
+ (if (1/variable-reference? vr_8)
+ (void)
+ (raise-argument-error 'variable-reference->module-declaration-inspector "variable-reference?" vr_8))
+ (if (1/variable-reference->instance vr_8)
+ (raise-arguments-error
+ 'variable-reference->module-declaration-inspector
+ "variable reference does not refer to an anonymous module variable"
+ "variable reference"
+ vr_8)
+ (void))
+ (let-values (((or-part_910) (namespace-declaration-inspector (variable-reference->namespace* vr_8))))
+ (if or-part_910
+ or-part_910
+ (raise-arguments-error
+ 'variable-reference->module-declaration-inspector
+ "given variable reference is not from a module")))))))
(define-values
(primitive-ids)
(seteq
@@ -69238,6 +67331,7 @@
'identifier-prune-to-source-module
'syntax-bound-symbols
'syntax-bound-phases
+ 'syntax-bound-interned-scope-symbols
'syntax-srcloc
'syntax-source
'syntax-line
@@ -69290,6 +67384,7 @@
'syntax-transforming-with-lifts?
'syntax-transforming-module-expression?
'syntax-local-transforming-module-provides?
+ 'syntax-local-compiling-module?
'syntax-local-context
'syntax-local-introduce
'syntax-local-identifier-as-binding
@@ -69322,6 +67417,7 @@
'syntax-local-expand-expression
'internal-definition-context?
'syntax-local-make-definition-context
+ 'syntax-local-make-definition-context-introducer
'syntax-local-bind-syntaxes
'internal-definition-context-binding-identifiers
'internal-definition-context-introduce
@@ -69372,24 +67468,24 @@
(begin
(let-values (((temp1_5) 'syntax?) ((syntax?2_0) syntax?$1)) (add-core-primitive!.1 #f temp1_5 syntax?2_0))
(let-values (((temp3_9) 'syntax-e) ((syntax-e4_0) 1/syntax-e)) (add-core-primitive!.1 #f temp3_9 syntax-e4_0))
- (let-values (((temp5_11) 'syntax->datum) ((syntax->datum6_0) 1/syntax->datum))
- (add-core-primitive!.1 #f temp5_11 syntax->datum6_0))
- (let-values (((temp7_7) 'datum->syntax) ((datum->syntax8_0) 1/datum->syntax))
- (add-core-primitive!.1 #f temp7_7 datum->syntax8_0))
+ (let-values (((temp5_12) 'syntax->datum) ((syntax->datum6_0) 1/syntax->datum))
+ (add-core-primitive!.1 #f temp5_12 syntax->datum6_0))
+ (let-values (((temp7_10) 'datum->syntax) ((datum->syntax8_0) 1/datum->syntax))
+ (add-core-primitive!.1 #f temp7_10 datum->syntax8_0))
(let-values (((temp9_11) 'bound-identifier=?) ((bound-identifier=?10_0) 1/bound-identifier=?))
(add-core-primitive!.1 #f temp9_11 bound-identifier=?10_0))
(let-values (((temp11_9) 'free-identifier=?) ((free-identifier=?12_0) 1/free-identifier=?))
(add-core-primitive!.1 #f temp11_9 free-identifier=?12_0))
- (let-values (((temp13_8) 'free-transformer-identifier=?)
+ (let-values (((temp13_10) 'free-transformer-identifier=?)
((free-transformer-identifier=?14_0) 1/free-transformer-identifier=?))
- (add-core-primitive!.1 #f temp13_8 free-transformer-identifier=?14_0))
+ (add-core-primitive!.1 #f temp13_10 free-transformer-identifier=?14_0))
(let-values (((temp15_11) 'free-template-identifier=?)
((free-template-identifier=?16_0) 1/free-template-identifier=?))
(add-core-primitive!.1 #f temp15_11 free-template-identifier=?16_0))
- (let-values (((temp17_6) 'free-label-identifier=?) ((free-label-identifier=?18_0) 1/free-label-identifier=?))
- (add-core-primitive!.1 #f temp17_6 free-label-identifier=?18_0))
- (let-values (((temp19_8) 'identifier-binding) ((identifier-binding20_0) 1/identifier-binding))
- (add-core-primitive!.1 #f temp19_8 identifier-binding20_0))
+ (let-values (((temp17_8) 'free-label-identifier=?) ((free-label-identifier=?18_0) 1/free-label-identifier=?))
+ (add-core-primitive!.1 #f temp17_8 free-label-identifier=?18_0))
+ (let-values (((temp19_11) 'identifier-binding) ((identifier-binding20_0) 1/identifier-binding))
+ (add-core-primitive!.1 #f temp19_11 identifier-binding20_0))
(let-values (((temp21_9) 'identifier-transformer-binding)
((identifier-transformer-binding22_0) 1/identifier-transformer-binding))
(add-core-primitive!.1 #f temp21_9 identifier-transformer-binding22_0))
@@ -69398,22 +67494,22 @@
(add-core-primitive!.1 #f temp23_9 identifier-template-binding24_0))
(let-values (((temp25_5) 'identifier-label-binding) ((identifier-label-binding26_0) 1/identifier-label-binding))
(add-core-primitive!.1 #f temp25_5 identifier-label-binding26_0))
- (let-values (((temp27_6) 'identifier-binding-symbol) ((identifier-binding-symbol28_0) 1/identifier-binding-symbol))
- (add-core-primitive!.1 #f temp27_6 identifier-binding-symbol28_0))
- (let-values (((temp29_7) 'identifier-distinct-binding)
+ (let-values (((temp27_5) 'identifier-binding-symbol) ((identifier-binding-symbol28_0) 1/identifier-binding-symbol))
+ (add-core-primitive!.1 #f temp27_5 identifier-binding-symbol28_0))
+ (let-values (((temp29_5) 'identifier-distinct-binding)
((identifier-distinct-binding30_0) 1/identifier-distinct-binding))
- (add-core-primitive!.1 #f temp29_7 identifier-distinct-binding30_0))
- (let-values (((temp31_7) 'identifier-binding-portal-syntax)
+ (add-core-primitive!.1 #f temp29_5 identifier-distinct-binding30_0))
+ (let-values (((temp31_9) 'identifier-binding-portal-syntax)
((identifier-binding-portal-syntax32_0) 1/identifier-binding-portal-syntax)
((temp33_8) #t))
- (add-core-primitive!.1 temp33_8 temp31_7 identifier-binding-portal-syntax32_0))
- (let-values (((temp34_4) 'identifier-prune-lexical-context)
+ (add-core-primitive!.1 temp33_8 temp31_9 identifier-binding-portal-syntax32_0))
+ (let-values (((temp34_5) 'identifier-prune-lexical-context)
((identifier-prune-lexical-context35_0) 1/identifier-prune-lexical-context))
- (add-core-primitive!.1 #f temp34_4 identifier-prune-lexical-context35_0))
- (let-values (((temp36_7) 'syntax-debug-info) ((syntax-debug-info37_0) 1/syntax-debug-info))
- (add-core-primitive!.1 #f temp36_7 syntax-debug-info37_0))
- (let-values (((temp38_2) 'syntax-track-origin) ((syntax-track-origin39_0) 1/syntax-track-origin))
- (add-core-primitive!.1 #f temp38_2 syntax-track-origin39_0))
+ (add-core-primitive!.1 #f temp34_5 identifier-prune-lexical-context35_0))
+ (let-values (((temp36_8) 'syntax-debug-info) ((syntax-debug-info37_0) 1/syntax-debug-info))
+ (add-core-primitive!.1 #f temp36_8 syntax-debug-info37_0))
+ (let-values (((temp38_4) 'syntax-track-origin) ((syntax-track-origin39_0) 1/syntax-track-origin))
+ (add-core-primitive!.1 #f temp38_4 syntax-track-origin39_0))
(let-values (((temp40_5) 'syntax-shift-phase-level) ((syntax-shift-phase-level41_0) 1/syntax-shift-phase-level))
(add-core-primitive!.1 #f temp40_5 syntax-shift-phase-level41_0))
(let-values (((temp42_3) 'syntax-source-module) ((syntax-source-module43_0) 1/syntax-source-module))
@@ -69421,881 +67517,860 @@
(let-values (((temp44_4) 'identifier-prune-to-source-module)
((identifier-prune-to-source-module45_0) 1/identifier-prune-to-source-module))
(add-core-primitive!.1 #f temp44_4 identifier-prune-to-source-module45_0))
- (let-values (((temp46_6) 'syntax-bound-symbols) ((syntax-bound-symbols47_0) 1/syntax-bound-symbols))
- (add-core-primitive!.1 #f temp46_6 syntax-bound-symbols47_0))
+ (let-values (((temp46_8) 'syntax-bound-symbols) ((syntax-bound-symbols47_0) 1/syntax-bound-symbols))
+ (add-core-primitive!.1 #f temp46_8 syntax-bound-symbols47_0))
(let-values (((temp48_6) 'syntax-bound-phases) ((syntax-bound-phases49_0) 1/syntax-bound-phases))
(add-core-primitive!.1 #f temp48_6 syntax-bound-phases49_0))
- (let-values (((temp50_5) 'syntax-srcloc) ((syntax-srcloc51_0) 1/syntax-srcloc))
- (add-core-primitive!.1 #f temp50_5 syntax-srcloc51_0))
- (let-values (((temp52_7) 'syntax-source) ((syntax-source53_0) 1/syntax-source))
- (add-core-primitive!.1 #f temp52_7 syntax-source53_0))
- (let-values (((temp54_7) 'syntax-line) ((syntax-line55_0) 1/syntax-line))
- (add-core-primitive!.1 #f temp54_7 syntax-line55_0))
- (let-values (((temp56_3) 'syntax-column) ((syntax-column57_0) 1/syntax-column))
- (add-core-primitive!.1 #f temp56_3 syntax-column57_0))
- (let-values (((temp58_2) 'syntax-position) ((syntax-position59_0) 1/syntax-position))
- (add-core-primitive!.1 #f temp58_2 syntax-position59_0))
- (let-values (((temp60_5) 'syntax-span) ((syntax-span61_0) 1/syntax-span))
- (add-core-primitive!.1 #f temp60_5 syntax-span61_0))
- (let-values (((temp62_4) 'syntax->list) ((syntax->list63_0) 1/syntax->list))
- (add-core-primitive!.1 #f temp62_4 syntax->list63_0))
- (let-values (((temp64_6) 'syntax-property) ((syntax-property65_0) syntax-property$1))
- (add-core-primitive!.1 #f temp64_6 syntax-property65_0))
- (let-values (((temp66_7) 'syntax-property-remove) ((syntax-property-remove67_0) 1/syntax-property-remove))
- (add-core-primitive!.1 #f temp66_7 syntax-property-remove67_0))
- (let-values (((temp68_5) 'syntax-property-preserved?)
- ((syntax-property-preserved?69_0) 1/syntax-property-preserved?))
- (add-core-primitive!.1 #f temp68_5 syntax-property-preserved?69_0))
- (let-values (((temp70_7) 'syntax-property-symbol-keys)
- ((syntax-property-symbol-keys71_0) 1/syntax-property-symbol-keys))
- (add-core-primitive!.1 #f temp70_7 syntax-property-symbol-keys71_0))
- (let-values (((temp72_4) 'syntax-original?) ((syntax-original?73_0) 1/syntax-original?))
- (add-core-primitive!.1 #f temp72_4 syntax-original?73_0))
- (let-values (((temp74_5) 'syntax-tainted?) ((syntax-tainted?75_0) 1/syntax-tainted?))
- (add-core-primitive!.1 #f temp74_5 syntax-tainted?75_0))
- (let-values (((temp76_3) 'syntax-arm) ((syntax-arm77_0) 1/syntax-arm))
- (add-core-primitive!.1 #f temp76_3 syntax-arm77_0))
- (let-values (((temp78_3) 'syntax-disarm) ((syntax-disarm79_0) 1/syntax-disarm))
- (add-core-primitive!.1 #f temp78_3 syntax-disarm79_0))
- (let-values (((temp80_3) 'syntax-rearm) ((syntax-rearm81_0) 1/syntax-rearm))
- (add-core-primitive!.1 #f temp80_3 syntax-rearm81_0))
- (let-values (((temp82_2) 'syntax-taint) ((syntax-taint83_0) 1/syntax-taint))
- (add-core-primitive!.1 #f temp82_2 syntax-taint83_0))
- (let-values (((temp84_2) 'syntax-binding-set) ((syntax-binding-set85_0) 1/syntax-binding-set))
- (add-core-primitive!.1 #f temp84_2 syntax-binding-set85_0))
- (let-values (((temp86_2) 'syntax-binding-set?) ((syntax-binding-set?87_0) 1/syntax-binding-set?))
- (add-core-primitive!.1 #f temp86_2 syntax-binding-set?87_0))
- (let-values (((temp88_1) 'syntax-binding-set-extend) ((syntax-binding-set-extend89_0) 1/syntax-binding-set-extend))
- (add-core-primitive!.1 #f temp88_1 syntax-binding-set-extend89_0))
- (let-values (((temp90_3) 'syntax-binding-set->syntax)
- ((syntax-binding-set->syntax91_0) 1/syntax-binding-set->syntax))
- (add-core-primitive!.1 #f temp90_3 syntax-binding-set->syntax91_0))
- (let-values (((temp92_2) 'syntax-serialize) ((syntax-serialize93_0) 1/syntax-serialize))
- (add-core-primitive!.1 #f temp92_2 syntax-serialize93_0))
- (let-values (((temp94_4) 'syntax-deserialize) ((syntax-deserialize95_0) 1/syntax-deserialize))
- (add-core-primitive!.1 #f temp94_4 syntax-deserialize95_0))
- (let-values (((temp96_2) 'do-raise-syntax-error) ((do-raise-syntax-error97_0) 1/do-raise-syntax-error))
- (add-core-primitive!.1 #f temp96_2 do-raise-syntax-error97_0))
- (let-values (((temp98_5) 'raise-syntax-error) ((raise-syntax-error99_0) raise-syntax-error$1))
- (add-core-primitive!.1 #f temp98_5 raise-syntax-error99_0))
- (let-values (((temp100_2) 'struct:exn:fail:syntax) ((struct:exn:fail:syntax101_0) 1/struct:exn:fail:syntax))
- (add-core-primitive!.1 #f temp100_2 struct:exn:fail:syntax101_0))
- (let-values (((temp102_3) 'exn:fail:syntax) ((exn:fail:syntax103_0) make-exn:fail:syntax$1))
- (add-core-primitive!.1 #f temp102_3 exn:fail:syntax103_0))
- (let-values (((temp104_5) 'make-exn:fail:syntax) ((make-exn:fail:syntax105_0) make-exn:fail:syntax$1))
- (add-core-primitive!.1 #f temp104_5 make-exn:fail:syntax105_0))
- (let-values (((temp106_3) 'exn:fail:syntax?) ((exn:fail:syntax?107_0) 1/exn:fail:syntax?))
- (add-core-primitive!.1 #f temp106_3 exn:fail:syntax?107_0))
- (let-values (((temp108_2) 'exn:fail:syntax-exprs) ((exn:fail:syntax-exprs109_0) 1/exn:fail:syntax-exprs))
- (add-core-primitive!.1 #f temp108_2 exn:fail:syntax-exprs109_0))
- (let-values (((temp110_5) 'struct:exn:fail:syntax:unbound)
- ((struct:exn:fail:syntax:unbound111_0) 1/struct:exn:fail:syntax:unbound))
- (add-core-primitive!.1 #f temp110_5 struct:exn:fail:syntax:unbound111_0))
- (let-values (((temp112_1) 'exn:fail:syntax:unbound) ((exn:fail:syntax:unbound113_0) make-exn:fail:syntax:unbound$1))
- (add-core-primitive!.1 #f temp112_1 exn:fail:syntax:unbound113_0))
- (let-values (((temp114_3) 'make-exn:fail:syntax:unbound)
- ((make-exn:fail:syntax:unbound115_0) make-exn:fail:syntax:unbound$1))
- (add-core-primitive!.1 #f temp114_3 make-exn:fail:syntax:unbound115_0))
- (let-values (((temp116_1) 'exn:fail:syntax:unbound?) ((exn:fail:syntax:unbound?117_0) 1/exn:fail:syntax:unbound?))
- (add-core-primitive!.1 #f temp116_1 exn:fail:syntax:unbound?117_0))
- (let-values (((temp118_2) 'current-module-path-for-load)
- ((current-module-path-for-load119_0) 1/current-module-path-for-load))
- (add-core-primitive!.1 #f temp118_2 current-module-path-for-load119_0))
- (let-values (((temp120_0) 'prop:exn:missing-module) ((prop:exn:missing-module121_0) 1/prop:exn:missing-module))
- (add-core-primitive!.1 #f temp120_0 prop:exn:missing-module121_0))
- (let-values (((temp122_2) 'exn:missing-module?) ((exn:missing-module?123_0) 1/exn:missing-module?))
- (add-core-primitive!.1 #f temp122_2 exn:missing-module?123_0))
- (let-values (((temp124_0) 'exn:missing-module-accessor)
- ((exn:missing-module-accessor125_0) 1/exn:missing-module-accessor))
- (add-core-primitive!.1 #f temp124_0 exn:missing-module-accessor125_0))
- (let-values (((temp126_2) 'struct:exn:fail:filesystem:missing-module)
- ((struct:exn:fail:filesystem:missing-module127_0) 1/struct:exn:fail:filesystem:missing-module))
- (add-core-primitive!.1 #f temp126_2 struct:exn:fail:filesystem:missing-module127_0))
- (let-values (((temp128_4) 'exn:fail:filesystem:missing-module)
- ((exn:fail:filesystem:missing-module129_0) 1/make-exn:fail:filesystem:missing-module))
- (add-core-primitive!.1 #f temp128_4 exn:fail:filesystem:missing-module129_0))
- (let-values (((temp130_2) 'make-exn:fail:filesystem:missing-module)
- ((make-exn:fail:filesystem:missing-module131_0) 1/make-exn:fail:filesystem:missing-module))
- (add-core-primitive!.1 #f temp130_2 make-exn:fail:filesystem:missing-module131_0))
- (let-values (((temp132_4) 'exn:fail:filesystem:missing-module?)
- ((exn:fail:filesystem:missing-module?133_0) 1/exn:fail:filesystem:missing-module?))
- (add-core-primitive!.1 #f temp132_4 exn:fail:filesystem:missing-module?133_0))
- (let-values (((temp134_2) 'exn:fail:filesystem:missing-module-path)
- ((exn:fail:filesystem:missing-module-path135_0) 1/exn:fail:filesystem:missing-module-path))
- (add-core-primitive!.1 #f temp134_2 exn:fail:filesystem:missing-module-path135_0))
- (let-values (((temp136_6) 'struct:exn:fail:syntax:missing-module)
- ((struct:exn:fail:syntax:missing-module137_0) 1/struct:exn:fail:syntax:missing-module))
- (add-core-primitive!.1 #f temp136_6 struct:exn:fail:syntax:missing-module137_0))
- (let-values (((temp138_1) 'exn:fail:syntax:missing-module)
- ((exn:fail:syntax:missing-module139_0) 1/make-exn:fail:syntax:missing-module))
- (add-core-primitive!.1 #f temp138_1 exn:fail:syntax:missing-module139_0))
- (let-values (((temp140_1) 'make-exn:fail:syntax:missing-module)
- ((make-exn:fail:syntax:missing-module141_0) 1/make-exn:fail:syntax:missing-module))
- (add-core-primitive!.1 #f temp140_1 make-exn:fail:syntax:missing-module141_0))
- (let-values (((temp142_1) 'exn:fail:syntax:missing-module?)
- ((exn:fail:syntax:missing-module?143_0) 1/exn:fail:syntax:missing-module?))
- (add-core-primitive!.1 #f temp142_1 exn:fail:syntax:missing-module?143_0))
- (let-values (((temp144_3) 'exn:fail:syntax:missing-module-path)
- ((exn:fail:syntax:missing-module-path145_0) 1/exn:fail:syntax:missing-module-path))
- (add-core-primitive!.1 #f temp144_3 exn:fail:syntax:missing-module-path145_0))
- (let-values (((temp146_2) 'syntax-transforming?) ((syntax-transforming?147_0) 1/syntax-transforming?))
- (add-core-primitive!.1 #f temp146_2 syntax-transforming?147_0))
- (let-values (((temp148_1) 'syntax-transforming-with-lifts?)
- ((syntax-transforming-with-lifts?149_0) 1/syntax-transforming-with-lifts?))
- (add-core-primitive!.1 #f temp148_1 syntax-transforming-with-lifts?149_0))
- (let-values (((temp150_2) 'syntax-transforming-module-expression?)
- ((syntax-transforming-module-expression?151_0) 1/syntax-transforming-module-expression?))
- (add-core-primitive!.1 #f temp150_2 syntax-transforming-module-expression?151_0))
- (let-values (((temp152_1) 'syntax-local-transforming-module-provides?)
- ((syntax-local-transforming-module-provides?153_0) 1/syntax-local-transforming-module-provides?))
- (add-core-primitive!.1 #f temp152_1 syntax-local-transforming-module-provides?153_0))
- (let-values (((temp154_0) 'syntax-local-context) ((syntax-local-context155_0) 1/syntax-local-context))
- (add-core-primitive!.1 #f temp154_0 syntax-local-context155_0))
- (let-values (((temp156_0) 'syntax-local-introduce) ((syntax-local-introduce157_0) 1/syntax-local-introduce))
- (add-core-primitive!.1 #f temp156_0 syntax-local-introduce157_0))
- (let-values (((temp158_1) 'syntax-local-identifier-as-binding)
- ((syntax-local-identifier-as-binding159_0) 1/syntax-local-identifier-as-binding))
- (add-core-primitive!.1 #f temp158_1 syntax-local-identifier-as-binding159_0))
- (let-values (((temp160_2) 'syntax-local-phase-level) ((syntax-local-phase-level161_0) 1/syntax-local-phase-level))
- (add-core-primitive!.1 #f temp160_2 syntax-local-phase-level161_0))
- (let-values (((temp162_0) 'syntax-local-name) ((syntax-local-name163_0) 1/syntax-local-name))
- (add-core-primitive!.1 #f temp162_0 syntax-local-name163_0))
- (let-values (((temp164_2) 'make-syntax-introducer) ((make-syntax-introducer165_0) 1/make-syntax-introducer))
- (add-core-primitive!.1 #f temp164_2 make-syntax-introducer165_0))
- (let-values (((temp166_0) 'make-interned-syntax-introducer)
- ((make-interned-syntax-introducer167_0) 1/make-interned-syntax-introducer))
- (add-core-primitive!.1 #f temp166_0 make-interned-syntax-introducer167_0))
- (let-values (((temp168_1) 'make-syntax-delta-introducer)
- ((make-syntax-delta-introducer169_0) 1/make-syntax-delta-introducer))
- (add-core-primitive!.1 #f temp168_1 make-syntax-delta-introducer169_0))
- (let-values (((temp170_1) 'syntax-local-make-delta-introducer)
- ((syntax-local-make-delta-introducer171_0) 1/syntax-local-make-delta-introducer))
- (add-core-primitive!.1 #f temp170_1 syntax-local-make-delta-introducer171_0))
- (let-values (((temp172_1) 'syntax-local-value) ((syntax-local-value173_0) 1/syntax-local-value) ((temp174_1) #t))
- (add-core-primitive!.1 temp174_1 temp172_1 syntax-local-value173_0))
- (let-values (((temp175_1) 'syntax-local-value/immediate)
- ((syntax-local-value/immediate176_0) 1/syntax-local-value/immediate)
- ((temp177_0) #t))
- (add-core-primitive!.1 temp177_0 temp175_1 syntax-local-value/immediate176_0))
- (let-values (((temp178_0) 'syntax-local-lift-expression)
- ((syntax-local-lift-expression179_0) 1/syntax-local-lift-expression))
- (add-core-primitive!.1 #f temp178_0 syntax-local-lift-expression179_0))
- (let-values (((temp180_0) 'syntax-local-lift-values-expression)
- ((syntax-local-lift-values-expression181_0) 1/syntax-local-lift-values-expression))
- (add-core-primitive!.1 #f temp180_0 syntax-local-lift-values-expression181_0))
- (let-values (((temp182_0) 'syntax-local-lift-context)
- ((syntax-local-lift-context183_0) 1/syntax-local-lift-context))
- (add-core-primitive!.1 #f temp182_0 syntax-local-lift-context183_0))
- (let-values (((temp184_1) 'syntax-local-lift-module) ((syntax-local-lift-module185_0) 1/syntax-local-lift-module))
- (add-core-primitive!.1 #f temp184_1 syntax-local-lift-module185_0))
- (let-values (((temp186_0) 'syntax-local-lift-require)
- ((syntax-local-lift-require187_0) 1/syntax-local-lift-require))
- (add-core-primitive!.1 #f temp186_0 syntax-local-lift-require187_0))
- (let-values (((temp188_1) 'syntax-local-lift-provide)
- ((syntax-local-lift-provide189_0) 1/syntax-local-lift-provide))
- (add-core-primitive!.1 #f temp188_1 syntax-local-lift-provide189_0))
- (let-values (((temp190_2) 'syntax-local-lift-module-end-declaration)
- ((syntax-local-lift-module-end-declaration191_0) 1/syntax-local-lift-module-end-declaration))
- (add-core-primitive!.1 #f temp190_2 syntax-local-lift-module-end-declaration191_0))
- (let-values (((temp192_1) 'syntax-local-module-defined-identifiers)
- ((syntax-local-module-defined-identifi