From 181b9c80ac79807d5f049b73cb86b84d083573ab Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 1 Apr 2021 06:57:56 -0600 Subject: [PATCH] add `syntax-serialize` and `syntax-deserialize` The new functions provide a more direct way to serialize and deserialize syntax objects than compiling and running a `quote-syntax` form. The new functions also offer additional configuration related to preserving extra syntax properties and limiting the use of shared "bulk binding" tables (i.e., tables that must provided by module declarations in the namespace). This change does not add syntax-object support to `serialize` or `s-exp->fasl`, because serialized syntax objects are still in many ways like code: they are version-specific, and their invariants can be broken by mangling the serialized form (in much the same way that compiled code can be broken by mangling, and with similar safetly implications). --- pkgs/base/info.rkt | 2 +- .../scribblings/reference/macros.scrbl | 1 + .../scribblings/reference/stx-serialize.scrbl | 76 + pkgs/racket-test-core/tests/racket/stx.rktl | 27 + racket/collects/racket/private/base.rkt | 2 + .../racket/private/kw-syntax-serialize.rkt | 15 + racket/src/bc/src/startup.inc | 1067 +++- racket/src/cs/schemified/expander.scm | 5145 ++++++++++------- racket/src/expander/boot/core-primitive.rkt | 4 + racket/src/expander/compile/header.rkt | 4 +- .../src/expander/compile/serialize-state.rkt | 12 +- racket/src/expander/compile/serialize.rkt | 163 +- racket/src/expander/demo.rkt | 14 + racket/src/expander/main.rkt | 4 + racket/src/expander/syntax/binding-table.rkt | 34 +- racket/src/expander/syntax/bulk-binding.rkt | 36 +- racket/src/expander/syntax/scope.rkt | 19 +- racket/src/expander/syntax/serialize.rkt | 68 + racket/src/expander/syntax/syntax.rkt | 19 +- racket/src/version/racket_version.h | 2 +- 20 files changed, 4258 insertions(+), 2456 deletions(-) create mode 100644 pkgs/racket-doc/scribblings/reference/stx-serialize.scrbl create mode 100644 racket/collects/racket/private/kw-syntax-serialize.rkt create mode 100644 racket/src/expander/syntax/serialize.rkt diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 0a29a6f837..a46aeb2753 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -14,7 +14,7 @@ ;; In the Racket source repo, this version should change only when ;; "racket_version.h" changes: -(define version "8.0.0.12") +(define version "8.0.0.13") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/macros.scrbl b/pkgs/racket-doc/scribblings/reference/macros.scrbl index 5b380ab99d..5fa8202f31 100644 --- a/pkgs/racket-doc/scribblings/reference/macros.scrbl +++ b/pkgs/racket-doc/scribblings/reference/macros.scrbl @@ -23,5 +23,6 @@ called. @include-section["stx-props.scrbl"] @include-section["stx-taints.scrbl"] @include-section["stx-expand.scrbl"] +@include-section["stx-serialize.scrbl"] @include-section["include.scrbl"] @include-section["syntax-util.scrbl"] diff --git a/pkgs/racket-doc/scribblings/reference/stx-serialize.scrbl b/pkgs/racket-doc/scribblings/reference/stx-serialize.scrbl new file mode 100644 index 0000000000..2101420d47 --- /dev/null +++ b/pkgs/racket-doc/scribblings/reference/stx-serialize.scrbl @@ -0,0 +1,76 @@ +#lang scribble/doc +@(require "mz.rkt" + (for-label racket/fasl + racket/serialize)) + +@title{Serializing Syntax} + +@defproc[(syntax-serialize [stx syntax?] + [#:preserve-property-keys preserve-property-keys (listof symbol)] + [#:provides-namespace provides-namespace (or/c namespace? #f) (current-namespace)] + [#:base-module-path-index base-module-path-index (or/c module-path-index? #f) #f]) + any/c]{ + +Converts @racket[stx] to a serialized form that is suitable for use +with @racket[s-exp->fasl] or @racket[serialize]. Although @racket[stx] +could be serialized with @racket[(compile `(quote-syntax ,stx))] and +then writing the compiled form, @racket[syntax-serialize] provides +more control over serialization: + +@itemlist[ + + @item{The @racket[preserve-property-keys] lists syntax-property keys + to whose values should be preserved in serialization, even if + the property value was not added as preserved with + @racket[syntax-property] (so it would be discarded in compiled + form). The values associated with the properties to preserve + must be serializable in the sense required by + @racket[syntax-property] for a preserved property.} + + @item{The @racket[provides-namespace] argument constrains how much + the serialized syntax object can rely on @deftech{bulk + bindings}, which are shared binding tables provided by + exporting modules. If @racket[provides-namespace] is + @racket[#f], then complete binding information is recorded in + the syntax object's serialized form, and no bulk bindings will + be needed from the namespace at deserialization. Otherwise, + bulk bindings will be used only for modules declared in + @racket[provides-namespace] (i.e., the deserialize-time + namespace will have the same module declarations as + @racket[provides-namespace]); note that supplying a namespace + with no module bindings is equivalent to supplying + @racket[#f].} + + @item{The @racket[base-module-path-index] argument specifies a + @tech{module path index} to which binding information in + @racket[stx] is relative. For example, if a syntax object + originates from @racket[quote-syntax] in the body of a module, + then @racket[base-module-path-index] could usefully be the + enclosing module's module path index as produced by + @racket[(variable-reference->module-path-index + (#%variable-reference))] within the module. On deserialization, + a different module path index can be supplied to substitute in + place of @racket[base-module-path-index], which shifts any + binding that is relative to the serialize-time module's + identity to be relative to the module identity supplied at + deserialize time. If @racket[base-module-path-index] is + @racket[#f], then no shifting is supported at deserialize time, + and any @racket[base-module-path-index] supplied at that time + is ignored.} + +] + +A serialized syntax object is otherwise similar to compiled code: it +is version-specific, and deserialization will require a sufficiently +powerful @tech{code inspector}. + +@history[#:added "8.0.0.13"]} + +@defproc[(syntax-deserialize [v any/c] + [#:base-module-path-index base-module-path-index (or/c module-path-index? #f) #f]) + syntax?]{ + +Converts the result of @racket[syntax-serialize] back to a syntax +object. See @racket[syntax-serialize] for more information. + +@history[#:added "8.0.0.13"]} diff --git a/pkgs/racket-test-core/tests/racket/stx.rktl b/pkgs/racket-test-core/tests/racket/stx.rktl index 15fafd2797..f8c811c078 100644 --- a/pkgs/racket-test-core/tests/racket/stx.rktl +++ b/pkgs/racket-test-core/tests/racket/stx.rktl @@ -2768,6 +2768,33 @@ #rx"key for a preserved property must be an interned symbol" (exn-message exn)))) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(for ([provides-namespace (list (current-namespace) #f)]) + (let ([s (syntax-serialize #'list #:provides-namespace provides-namespace)]) + (test 'list syntax->datum (syntax-deserialize s)) + (let ([id (syntax-deserialize s)]) + (test (identifier-binding #'list) identifier-binding id) + (test (identifier-binding #'cons) identifier-binding (datum->syntax id 'cons))))) + +(let ([s (syntax-serialize (syntax-property #'something 'wicked "this way comes") + #:preserve-property-keys '(wicked))]) + (let ([id (syntax-deserialize s)]) + (test "this way comes" syntax-property id 'wicked))) + +(module has-syntax-to-serialize-with-base-mpi racket/base + (provide id mpi) + (define id #'id) + (define mpi (variable-reference->module-path-index (#%variable-reference)))) + +(let ([id (dynamic-require ''has-syntax-to-serialize-with-base-mpi 'id)] + [mpi (dynamic-require ''has-syntax-to-serialize-with-base-mpi 'mpi)]) + (test (list mpi 'id mpi 'id 0 0 0) identifier-binding id) + (let* ([new-mpi (module-path-index-join 'somewhere-over-the-rainbow #f)] + [id2 (syntax-deserialize (syntax-serialize id #:base-module-path-index mpi) + #:base-module-path-index new-mpi)]) + (test (list new-mpi 'id new-mpi 'id 0 0 0) identifier-binding id2))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Make sure that paths from the current installation are not ;; preserved in marshaled bytecode diff --git a/racket/collects/racket/private/base.rkt b/racket/collects/racket/private/base.rkt index db171250bb..f9d23f853b 100644 --- a/racket/collects/racket/private/base.rkt +++ b/racket/collects/racket/private/base.rkt @@ -13,6 +13,7 @@ "submodule.rkt" "generic-interfaces.rkt" "kw-syntax-binding.rkt" ; shadows `syntax-binding-set-extend` + "kw-syntax-serialize.rkt" ; shadows `syntax-serialize` and `syntax-deserialize (for-syntax "stxcase-scheme.rkt")) (#%provide (all-from-except "pre-base.rkt" @@ -40,6 +41,7 @@ (all-from "submodule.rkt") (all-from "generic-interfaces.rkt") (all-from "kw-syntax-binding.rkt") + (all-from "kw-syntax-serialize.rkt") (for-syntax syntax-rules syntax-id-rules ... _) (rename -open-input-file open-input-file) (rename -open-output-file open-output-file) diff --git a/racket/collects/racket/private/kw-syntax-serialize.rkt b/racket/collects/racket/private/kw-syntax-serialize.rkt new file mode 100644 index 0000000000..c9059bcc29 --- /dev/null +++ b/racket/collects/racket/private/kw-syntax-serialize.rkt @@ -0,0 +1,15 @@ +(module kw-syntax-binding "pre-base.rkt" + (require (prefix-in k: '#%kernel)) + + (provide syntax-serialize + syntax-deserialize) + + (define (syntax-serialize stx + #:base-module-path-index [base-mpi #f] + #:preserve-property-keys [preserve-prop-keys '()] + #:provides-namespace [provides-namespace (current-namespace)]) + (k:syntax-serialize stx base-mpi preserve-prop-keys provides-namespace)) + + (define (syntax-deserialize data + #:base-module-path-index [base-mpi #f]) + (k:syntax-deserialize data base-mpi))) diff --git a/racket/src/bc/src/startup.inc b/racket/src/bc/src/startup.inc index 34c58ce95a..66bb892271 100644 --- a/racket/src/bc/src/startup.inc +++ b/racket/src/bc/src/startup.inc @@ -61,8 +61,10 @@ static const char *startup_source = "(seal seal)" "(1/syntax->datum syntax->datum)" "(1/syntax-debug-info syntax-debug-info)" +"(1/syntax-deserialize syntax-deserialize)" "(1/syntax-e syntax-e)" "(syntax-property$1 syntax-property)" +"(1/syntax-serialize syntax-serialize)" "(1/syntax-shift-phase-level syntax-shift-phase-level)" "(syntax?$1 syntax?)" "(1/use-collection-link-paths use-collection-link-paths)" @@ -5185,20 +5187,22 @@ static const char *startup_source = " serialize-state-props" " serialize-state-interned-props" " serialize-state-syntax-context" -" serialize-state-sharing-syntaxes)" +" serialize-state-sharing-syntaxes" +" serialize-state-preserve-prop-keys" +" serialize-state-keep-provides?)" "(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" "(let-values()" "(let-values()" "(make-struct-type" " 'serialize-state" " #f" -" 12" +" 14" " 0" " #f" "(list(cons prop:authentic #t))" "(current-inspector)" " #f" -" '(0 1 2 3 4 5 6 7 8 9 10 11)" +" '(0 1 2 3 4 5 6 7 8 9 10 11 12 13)" " #f" " 'serialize-state)))))" "(values" @@ -5216,10 +5220,12 @@ static const char *startup_source = "(make-struct-field-accessor -ref_0 8 'props)" "(make-struct-field-accessor -ref_0 9 'interned-props)" "(make-struct-field-accessor -ref_0 10 'syntax-context)" -"(make-struct-field-accessor -ref_0 11 'sharing-syntaxes))))" +"(make-struct-field-accessor -ref_0 11 'sharing-syntaxes)" +"(make-struct-field-accessor -ref_0 12 'preserve-prop-keys)" +"(make-struct-field-accessor -ref_0 13 'keep-provides?))))" "(define-values" "(make-serialize-state)" -"(lambda(reachable-scopes_0)" +"(lambda(reachable-scopes_0 preserve-prop-keys_0 keep-provides?_0)" "(begin" "(let-values(((state_0)" "(serialize-state1.1" @@ -5234,7 +5240,9 @@ static const char *startup_source = "(make-hasheq)" "(make-hash)" "(box null)" -"(make-hasheq))))" +"(make-hasheq)" +" preserve-prop-keys_0" +" keep-provides?_0)))" "(let-values(((empty-seteq_0)(seteq)))" "(begin" "(hash-set!(serialize-state-scopes state_0) empty-seteq_0 empty-seteq_0)" @@ -5909,18 +5917,25 @@ static const char *startup_source = "(cons prop:authentic #t)" "(cons" " prop:reach-scopes" -"(lambda(s_0 reach_0)" +"(lambda(s_0 bulk-shifts_0 reach_0)" "(let-values(((content*_0)(syntax-content* s_0)))" +"(let-values((()" "(begin" "(reach_0" "(if(modified-content? content*_0)" -"(let-values(((prop_0)(modified-content-scope-propagations+tamper content*_0)))" +"(let-values(((prop_0)" +"(modified-content-scope-propagations+tamper content*_0)))" "(if(propagation?$1 prop_0)" "((propagation-ref prop_0) s_0)" "(modified-content-content content*_0)))" -" content*_0))" -"(reach_0(syntax-scopes s_0))" -"(reach_0(syntax-shifted-multi-scopes s_0))" +" content*_0)" +" bulk-shifts_0)" +"(values))))" +"(let-values(((shifts_0)" +"(if bulk-shifts_0(append bulk-shifts_0(syntax-mpi-shifts s_0)) #f)))" +"(begin" +"(reach_0(syntax-scopes s_0) shifts_0)" +"(reach_0(syntax-shifted-multi-scopes s_0) shifts_0)" "(let-values(((ht_0)(syntax-props s_0)))" "(begin" "(if(variable-reference-from-unsafe?(#%variable-reference))" @@ -5945,7 +5960,8 @@ static const char *startup_source = "(let-values()" "(reach_0" "(plain-property-value" -" v_0)))" +" v_0)" +" bulk-shifts_0))" "(values)))))" "(values)))" "(values)))))" @@ -5957,7 +5973,7 @@ static const char *startup_source = " for-loop_0)" "(unsafe-immutable-hash-iterate-first ht_0))))" "(void)" -"(reach_0(syntax-srcloc s_0))))))" +"(reach_0(syntax-srcloc s_0) bulk-shifts_0)))))))" "(cons" " prop:serialize" "(lambda(s_0 ser-push!_0 state_0)" @@ -5974,6 +5990,8 @@ static const char *startup_source = "(intern-properties" "(syntax-props s_0)" "(lambda()" +"(let-values(((preserve-keys_0)" +"(serialize-state-preserve-prop-keys state_0)))" "(let-values(((ht_0)(syntax-props s_0)))" "(begin" "(if(variable-reference-from-unsafe?(#%variable-reference))" @@ -5991,8 +6009,15 @@ static const char *startup_source = "(let-values(((table_1)" "(let-values(((table_1)" " table_0))" -"(if(preserved-property-value?" -" v_0)" +"(if(let-values(((or-part_0)" +"(preserved-property-value?" +" v_0)))" +"(if or-part_0" +" or-part_0" +"(hash-ref" +" preserve-keys_0" +" k_0" +" #f)))" "(let-values(((table_2)" " table_1))" "(let-values(((table_3)" @@ -6020,7 +6045,7 @@ static const char *startup_source = " table_0)))))" " for-loop_0)" " '#hasheq()" -"(hash-iterate-first ht_0)))))" +"(hash-iterate-first ht_0))))))" " state_0)))" "(let-values(((tamper_0)(serialize-tamper(syntax-tamper s_0))))" "(let-values(((context-triple_0)" @@ -6952,7 +6977,7 @@ static const char *startup_source = " #f" "(list" "(cons prop:authentic #t)" -" (cons prop:reach-scopes (lambda (sms_0 reach_0) (error \"shouldn't get here\")))" +" (cons prop:reach-scopes (lambda (sms_0 extra-scopes_0 reach_0) (error \"shouldn't get here\")))" "(cons" " prop:serialize" "(lambda(bba_0 ser-push!_0 state_0)" @@ -6978,20 +7003,21 @@ static const char *startup_source = " bulk-binding-class3.1" " bulk-binding-class?" " bulk-binding-class-get-symbols" -" bulk-binding-class-create)" +" bulk-binding-class-create" +" bulk-binding-class-modname)" "(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" "(let-values()" "(let-values()" "(make-struct-type" " 'bulk-binding-class" " #f" -" 2" +" 3" " 0" " #f" " null" "(current-inspector)" " #f" -" '(0 1)" +" '(0 1 2)" " #f" " 'bulk-binding-class)))))" "(values" @@ -6999,7 +7025,8 @@ static const char *startup_source = " make-_0" " ?_0" "(make-struct-field-accessor -ref_0 0 'get-symbols)" -"(make-struct-field-accessor -ref_0 1 'create))))" +"(make-struct-field-accessor -ref_0 1 'create)" +"(make-struct-field-accessor -ref_0 2 'modname))))" "(define-values" "(bulk-binding-symbols)" "(lambda(b_0 s_0 extra-shifts_0)" @@ -7008,6 +7035,15 @@ static const char *startup_source = " b_0" "(append extra-shifts_0(if s_0(syntax-mpi-shifts s_0) null))))))" "(define-values(bulk-binding-create)(lambda(b_0)(begin(bulk-binding-class-create(bulk-binding-ref b_0)))))" +"(define-values" +"(force-bulk-bindings)" +"(lambda(b_0 bulk-shifts_0)" +"(begin" +"(let-values(((modname-ht_0)(car bulk-shifts_0)))" +"(let-values(((extra-shifts_0)(cdr bulk-shifts_0)))" +"(begin" +"(hash-set! modname-ht_0 b_0((bulk-binding-class-modname(bulk-binding-ref b_0)) b_0 extra-shifts_0))" +"(bulk-binding-symbols b_0 #f extra-shifts_0)))))))" "(define-values(binding-table-empty?)(lambda(bt_0)(begin(if(hash? bt_0)(zero?(hash-count bt_0)) #f))))" "(define-values" "(binding-table-add)" @@ -7544,7 +7580,7 @@ static const char *startup_source = "(begin(hash-set!(serialize-state-bulk-bindings-intern state_0) bt_0 new-bt_0) new-bt_0))))))))))" "(define-values" "(binding-table-register-reachable)" -"(lambda(bt_0 get-reachable-scopes_0 reach_0 register-trigger_0)" +"(lambda(bt_0 get-reachable-scopes_0 bulk-shifts_0 reach_0 register-trigger_0)" "(begin" "(begin" "(let-values(((ht_0)(if(hash? bt_0) bt_0(table-with-bulk-bindings-syms/serialize bt_0))))" @@ -7591,6 +7627,7 @@ static const char *startup_source = " scopes_0" " v_0" " get-reachable-scopes_0" +" bulk-shifts_0" " reach_0" " register-trigger_0)))" "(values)))))" @@ -7631,12 +7668,20 @@ static const char *startup_source = "(let-values()" "(begin" "(let-values()" +"(begin" +"(if bulk-shifts_0" +"(let-values()" +"(force-bulk-bindings" +"(bulk-binding-at-bulk bba_0)" +" bulk-shifts_0))" +"(void))" "(scopes-register-reachable" "(bulk-binding-at-scopes bba_0)" " #f" " get-reachable-scopes_0" +" bulk-shifts_0" " reach_0" -" register-trigger_0))" +" register-trigger_0)))" "(values)))))" "(values)))))" "(if(not #f)(for-loop_0 rest_0)(values))))" @@ -7647,11 +7692,11 @@ static const char *startup_source = "(void))))))" "(define-values" "(scopes-register-reachable)" -"(lambda(scopes_0 v_0 get-reachable-scopes_0 reach_0 register-trigger_0)" +"(lambda(scopes_0 v_0 get-reachable-scopes_0 bulk-shifts_0 reach_0 register-trigger_0)" "(begin" "(let-values(((reachable-scopes_0)(get-reachable-scopes_0)))" "(if(subset? scopes_0 reachable-scopes_0)" -"(let-values()(reach_0 v_0))" +"(let-values()(reach_0 v_0 bulk-shifts_0))" "(let-values()" "(let-values(((pending-scopes_0)" "(let-values(((ht_0) scopes_0))" @@ -7706,7 +7751,7 @@ static const char *startup_source = "(if(zero?(hash-count pending-scopes_0))" "(let-values()" "(begin" -"(reach_1 v_0)" +"(reach_1 v_0 bulk-shifts_0)" "(let-values(((ht_0) scopes_0))" "(begin" "(if(variable-reference-from-unsafe?(#%variable-reference))" @@ -7731,7 +7776,8 @@ static const char *startup_source = " sc_0)" "(let-values()" "(reach_1" -" sc_0))" +" sc_0" +" bulk-shifts_0))" "(void)))" "(values)))))" "(values)))))" @@ -8761,13 +8807,14 @@ static const char *startup_source = "(cons prop:authentic #t)" "(cons" " prop:scope-with-bindings" -"(lambda(s_0 get-reachable-scopes_0 reach_0 register-trigger_0)" +"(lambda(s_0 get-reachable-scopes_0 extra-shifts_0 reach_0 register-trigger_0)" "(binding-table-register-reachable" "(scope-binding-table s_0)" " get-reachable-scopes_0" +" extra-shifts_0" " reach_0" " register-trigger_0)))" -"(cons prop:reach-scopes(lambda(s_0 reach_0)(void)))" +"(cons prop:reach-scopes(lambda(s_0 extra-shifts_0 reach_0)(void)))" "(cons" " prop:serialize-fill!" "(lambda(s_0 ser-push!_0 state_0)" @@ -8877,7 +8924,7 @@ static const char *startup_source = "(cons prop:authentic #t)" "(cons" " prop:scope-with-bindings" -"(lambda(ms_0 get-reachable-scopes_0 reach_0 register-trigger_0)" +"(lambda(ms_0 get-reachable-scopes_0 bulk-shifts_0 reach_0 register-trigger_0)" "(begin" "(let-values(((ht_0)(unbox(multi-scope-scopes ms_0))))" "(begin" @@ -8901,7 +8948,9 @@ static const char *startup_source = " sc_0))" "(void)" "(let-values()" -"(reach_0 sc_0))))" +"(reach_0" +" sc_0" +" bulk-shifts_0))))" "(values)))))" "(values)))))" "(if(not #f)" @@ -8911,7 +8960,7 @@ static const char *startup_source = " for-loop_0)" "(hash-iterate-first ht_0))))" "(void))))" -"(cons prop:reach-scopes(lambda(s_0 reach_0)(void)))" +"(cons prop:reach-scopes(lambda(s_0 extra-shifts_0 reach_0)(void)))" "(cons" " prop:serialize" "(lambda(ms_0 ser-push!_0 state_0)" @@ -9010,7 +9059,9 @@ static const char *startup_source = "(list" "(cons prop:authentic #t)" "(cons prop:implicitly-reachable #t)" -"(cons prop:reach-scopes(lambda(s_0 reach_0)(reach_0(representative-scope-owner s_0))))" +"(cons" +" prop:reach-scopes" +"(lambda(s_0 bulk-shifts_0 reach_0)(reach_0(representative-scope-owner s_0) bulk-shifts_0)))" "(cons" " prop:serialize-fill!" "(lambda(s_0 ser-push!_0 state_0)" @@ -9081,7 +9132,8 @@ static const char *startup_source = "(cons prop:authentic #t)" "(cons" " prop:reach-scopes" -"(lambda(sms_0 reach_0)(reach_0(shifted-multi-scope-multi-scope sms_0))))" +"(lambda(sms_0 bulk-shifts_0 reach_0)" +"(reach_0(shifted-multi-scope-multi-scope sms_0) bulk-shifts_0)))" "(cons" " prop:serialize" "(lambda(sms_0 ser-push!_0 state_0)" @@ -12152,9 +12204,17 @@ static const char *startup_source = "(cons prop:authentic #t)" "(cons" " prop:serialize" -"(lambda(b_0 ser-push!_0 reachable-scopes_0)" +"(lambda(b_0 ser-push!_0 state_0)" "(begin" -"(ser-push!_0 'tag '#:bulk-binding)" +"(if(if(serialize-state-keep-provides? state_0)" +"((serialize-state-keep-provides? state_0) b_0)" +" #f)" +"(let-values()" +"(begin" +"(ser-push!_0 'tag '#:bulk-binding+provides)" +"(ser-push!_0(bulk-binding-provides b_0))" +"(ser-push!_0(bulk-binding-self b_0))))" +"(let-values()(ser-push!_0 'tag '#:bulk-binding)))" "(ser-push!_0(bulk-binding-prefix b_0))" "(ser-push!_0(bulk-binding-excepts b_0))" "(ser-push!_0(bulk-binding-mpi b_0))" @@ -12168,9 +12228,7 @@ static const char *startup_source = "(let-values(((or-part_0)(bulk-binding-provides b_0)))" "(if or-part_0" " or-part_0" -"(let-values(((mod-name_0)" -"(1/module-path-index-resolve" -"(apply-syntax-shifts(bulk-binding-mpi b_0) mpi-shifts_0))))" +"(let-values(((mod-name_0)(bulk-binding-module-name b_0 mpi-shifts_0)))" "(let-values((()" "(begin" "(if(bulk-binding-bulk-binding-registry b_0)" @@ -12235,7 +12293,8 @@ static const char *startup_source = " temp29_0" " temp27_0" " binding25_0" -" temp26_0))))))" +" temp26_0)))" +"(lambda(b_0 mpi-shifts_0)(bulk-binding-module-name b_0 mpi-shifts_0)))))" "(current-inspector)" " #f" " '(1 2 4 5 6 7)" @@ -12261,6 +12320,19 @@ static const char *startup_source = "(begin" "(bulk-binding12.1 #f prefix_0 excepts_0 #f mpi_0 provide-phase-level_0 phase-shift_0 bulk-binding-registry_0))))" "(define-values" +"(deserialize-bulk-binding+provides)" +"(lambda(provides_0 self_0 prefix_0 excepts_0 mpi_0 provide-phase-level_0 phase-shift_0 bulk-binding-registry_0)" +"(begin" +"(bulk-binding12.1" +" provides_0" +" prefix_0" +" excepts_0" +" self_0" +" mpi_0" +" provide-phase-level_0" +" phase-shift_0" +" bulk-binding-registry_0))))" +"(define-values" "(bulk-provides-add-prefix-remove-exceptions)" "(lambda(provides_0 prefix_0 excepts_0)" "(begin" @@ -12302,6 +12374,10 @@ static const char *startup_source = " '#hash()" "(hash-iterate-first ht_0)))))))" "(define-values" +"(bulk-binding-module-name)" +"(lambda(b_0 mpi-shifts_0)" +"(begin(1/module-path-index-resolve(apply-syntax-shifts(bulk-binding-mpi b_0) mpi-shifts_0)))))" +"(define-values" "(struct:bulk-provide bulk-provide13.1 bulk-provide? bulk-provide-self bulk-provide-provides)" "(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" "(let-values()" @@ -20956,9 +21032,13 @@ static const char *startup_source = "(begin(hash-set! positions_0 mpi_1 pos_0) pos_0))))))" "(void))))))" "(define-values" -"(generate-module-path-index-deserialize)" -"(lambda(mpis_0)" +"(generate-module-path-index-deserialize.1)" +"(lambda(as-data?2_0 mpis4_0)" "(begin" +" 'generate-module-path-index-deserialize" +"(let-values(((mpis_0) mpis4_0))" +"(let-values(((as-data?_0) as-data?2_0))" +"(let-values()" "(let-values(((unique-list_0)" "(lambda(v_0)" "(begin" @@ -20985,7 +21065,9 @@ static const char *startup_source = "(let-values() i_0)" " fold-var_1))))" "(values fold-var_2)))))" -"(if(not #f)(for-loop_0 fold-var_1 rest_0) fold-var_1)))" +"(if(not #f)" +"(for-loop_0 fold-var_1 rest_0)" +" fold-var_1)))" " fold-var_0)))))" " for-loop_0)" " null" @@ -21009,7 +21091,8 @@ static const char *startup_source = "(let-values(((table_1) table_0))" "(let-values(((table_2)" "(let-values()" -"(let-values(((key_0 val_0)" +"(let-values(((key_0" +" val_0)" "(let-values()" "(values" " v_0" @@ -21078,7 +21161,9 @@ static const char *startup_source = " mpi_0)))" "(values)))))" "(values)))))" -"(if(not #f)(for-loop_0(+ pos_0 inc_0))(values))))" +"(if(not #f)" +"(for-loop_0(+ pos_0 inc_0))" +"(values))))" "(values))))))" " for-loop_0)" " start_0)))" @@ -21095,7 +21180,8 @@ static const char *startup_source = "(begin" " 'for-loop" "(if i_0" -"(let-values(((k_0 v_0)(hash-iterate-key+value ht_0 i_0)))" +"(let-values(((k_0 v_0)" +"(hash-iterate-key+value ht_0 i_0)))" "(let-values(((table_1)" "(let-values(((table_1) table_0))" "(let-values(((table_2)" @@ -21112,7 +21198,9 @@ static const char *startup_source = " val_0)))))" "(values table_2)))))" "(if(not #f)" -"(for-loop_0 table_1(hash-iterate-next ht_0 i_0))" +"(for-loop_0" +" table_1" +"(hash-iterate-next ht_0 i_0))" " table_1)))" " table_0)))))" " for-loop_0)" @@ -21124,13 +21212,15 @@ static const char *startup_source = "(if(exact-nonnegative-integer? len_0)" "(void)" "(let-values()" -" (raise-argument-error 'for/vector \"exact-nonnegative-integer?\" len_0)))" +" (raise-argument-error 'for/vector \"exact-nonnegative-integer?\" len_0)))" "(let-values(((v_0)(make-vector len_0 0)))" "(begin" "(if(zero? len_0)" "(void)" "(let-values()" -"(let-values(((start_0) 0)((end_0)(hash-count gen-order_0))((inc_0) 1))" +"(let-values(((start_0) 0)" +"((end_0)(hash-count gen-order_0))" +"((inc_0) 1))" "(begin" "(if(variable-reference-from-unsafe?(#%variable-reference))" "(void)" @@ -21142,7 +21232,8 @@ static const char *startup_source = "(if(< pos_0 end_0)" "(let-values(((i_1) pos_0))" "(let-values(((i_2)" -"(let-values(((i_2) i_0))" +"(let-values(((i_2)" +" i_0))" "(let-values(((i_3)" "(let-values()" "(begin" @@ -21204,13 +21295,11 @@ static const char *startup_source = " 0" " start_0)))))" " v_0))))))" -"(list" -" 'deserialize-module-path-indexes" -"(list 'quote gens_0)" -"(list" -" 'quote" +"(let-values(((reorder-vec_0)" "(let-values(((vec_0 i_0)" -"(let-values(((start_0) 0)((end_0)(hash-count rev-positions_0))((inc_0) 1))" +"(let-values(((start_0) 0)" +"((end_0)(hash-count rev-positions_0))" +"((inc_0) 1))" "(begin" "(if(variable-reference-from-unsafe?(#%variable-reference))" "(void)" @@ -21222,9 +21311,12 @@ static const char *startup_source = "(if(< pos_0 end_0)" "(let-values(((i_1) pos_0))" "(let-values(((vec_1 i_2)" -"(let-values(((vec_1) vec_0)" -"((i_2) i_0))" -"(let-values(((vec_2 i_3)" +"(let-values(((vec_1)" +" vec_0)" +"((i_2)" +" i_0))" +"(let-values(((vec_2" +" i_3)" "(let-values()" "(let-values(((new-vec_0)" "(if(eq?" @@ -21249,16 +21341,28 @@ static const char *startup_source = "(unsafe-fx+" " i_2" " 1)))))))" -"(values vec_2 i_3)))))" +"(values" +" vec_2" +" i_3)))))" "(if(not #f)" -"(for-loop_0 vec_1 i_2(+ pos_0 inc_0))" +"(for-loop_0" +" vec_1" +" i_2" +"(+ pos_0 inc_0))" "(values vec_1 i_2))))" "(values vec_0 i_0))))))" " for-loop_0)" "(make-vector 16)" " 0" " start_0)))))" -"(shrink-vector vec_0 i_0)))))))))))))))" +"(shrink-vector vec_0 i_0))))" +"(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)))))))))))))))))))" "(define-values" "(deserialize-module-path-indexes)" "(lambda(gen-vec_0 order-vec_0)" @@ -21356,6 +21460,15 @@ static const char *startup_source = " 0)))))" " v_0)))))))))" "(define-values" +"(deserialize-module-path-index-data)" +"(lambda(v_0)" +"(begin" +"(begin" +"(if(if(vector? v_0)(= 2(vector-length v_0)) #f)" +"(void)" +" (let-values () (error 'syntax-deserialize \"ill-formed serialization\")))" +"(deserialize-module-path-indexes(vector-ref v_0 0)(vector-ref v_0 1))))))" +"(define-values" "(mpis-as-vector)" "(lambda(mpis_0)" "(begin" @@ -21397,7 +21510,10 @@ static const char *startup_source = "(list deserialize-imports)" "(list mpi-vector-id)" "(list* 'define-values(list inspector-id) '((current-code-inspector)))" -"(list 'define-values(list mpi-vector-id)(generate-module-path-index-deserialize mpis_0))))))" +"(list" +" 'define-values" +"(list mpi-vector-id)" +"(let-values(((mpis19_0) mpis_0))(generate-module-path-index-deserialize.1 #f mpis19_0)))))))" "(define-values" "(generate-module-declaration-linklet)" "(lambda(mpis_0 self_0 requires_0 provides_0 phase-to-link-module-uses-expr_0)" @@ -21410,13 +21526,13 @@ static const char *startup_source = "(list" " 'define-values" " '(requires)" -"(let-values(((requires8_0) requires_0)((mpis9_0) mpis_0)((temp10_0) #f))" -"(generate-deserialize.1 temp10_0 requires8_0 mpis9_0)))" +"(let-values(((requires20_0) requires_0)((mpis21_0) mpis_0)((temp22_0) #f))" +"(generate-deserialize.1 #f #f mpis21_0 '#hasheq() temp22_0 requires20_0)))" "(list" " 'define-values" " '(provides)" -"(let-values(((provides11_0) provides_0)((mpis12_0) mpis_0)((temp13_0) #f))" -"(generate-deserialize.1 temp13_0 provides11_0 mpis12_0)))" +"(let-values(((provides23_0) provides_0)((mpis24_0) mpis_0)((temp25_0) #f))" +"(generate-deserialize.1 #f #f mpis24_0 '#hasheq() temp25_0 provides23_0)))" "(list 'define-values '(phase-to-link-modules) phase-to-link-module-uses-expr_0)))))" "(define-values" "(serialize-module-uses)" @@ -21474,8 +21590,8 @@ static const char *startup_source = "(lambda(phase-to-link-module-uses_0 mpis_0)" "(begin" "(let-values(((phases-in-order_0)" -"(let-values(((temp14_0)(hash-keys phase-to-link-module-uses_0))((<15_0) <))" -"(sort.1 #f #f temp14_0 <15_0))))" +"(let-values(((temp26_0)(hash-keys phase-to-link-module-uses_0))((<27_0) <))" +"(sort.1 #f #f temp26_0 <27_0))))" "(list*" " 'hasheqv" "(apply" @@ -21514,15 +21630,28 @@ static const char *startup_source = " lst_0))))))))))" "(define-values" "(generate-deserialize.1)" -"(lambda(syntax-support?2_0 v4_0 mpis5_0)" +"(lambda(as-data?7_0 keep-provides?10_0 mpis6_0 preserve-prop-keys9_0 syntax-support?8_0 v16_0)" "(begin" " 'generate-deserialize" -"(let-values(((v_0) v4_0))" -"(let-values(((mpis_0) mpis5_0))" -"(let-values(((syntax-support?_0) syntax-support?2_0))" +"(let-values(((v_0) v16_0))" +"(let-values(((mpis_0) mpis6_0))" +"(let-values(((as-data?_0) as-data?7_0))" +"(let-values(((syntax-support?_0) syntax-support?8_0))" +"(let-values(((preserve-prop-keys_0) preserve-prop-keys9_0))" +"(let-values(((keep-provides?_0) keep-provides?10_0))" "(let-values()" -"(let-values(((reachable-scopes_0)(find-reachable-scopes v_0)))" -"(let-values(((state_0)(make-serialize-state reachable-scopes_0)))" +"(let-values(((bulk-shifts_0)(if keep-provides?_0(list(make-hasheq)) #f)))" +"(let-values(((reachable-scopes_0)(find-reachable-scopes v_0 bulk-shifts_0)))" +"(let-values(((state_0)" +"(make-serialize-state" +" reachable-scopes_0" +" preserve-prop-keys_0" +"(if keep-provides?_0" +"(lambda(b_0)" +"(let-values(((name_0)(hash-ref(car bulk-shifts_0) b_0 #f)))" +"(let-values(((or-part_0)(not name_0)))" +"(if or-part_0 or-part_0(keep-provides?_0 name_0)))))" +" #f))))" "(let-values(((mutables_0)(make-hasheq)))" "(let-values(((objs_0)(make-hasheq)))" "(let-values(((shares_0)(make-hasheq)))" @@ -21530,7 +21659,8 @@ static const char *startup_source = "(let-values(((frontier_0) null))" "(letrec-values(((add-frontier!_0)" "(case-lambda" -"((v_1)(begin 'add-frontier!(set! frontier_0(cons v_1 frontier_0))))" +"((v_1)" +"(begin 'add-frontier!(set! frontier_0(cons v_1 frontier_0))))" "((kind_0 v_1)(add-frontier!_0 v_1)))))" "(let-values((()" "(begin" @@ -21550,7 +21680,8 @@ static const char *startup_source = " or-part_0" "(1/module-path-index?" " v_2)))" -"(let-values()(void))" +"(let-values()" +"(void))" "(if(hash-ref" " objs_0" " v_2" @@ -21597,7 +21728,8 @@ static const char *startup_source = "(loop_0" " sub-v_0)))" " state_0))" -"(if(pair? v_2)" +"(if(pair?" +" v_2)" "(let-values()" "(begin" "(loop_0" @@ -21856,7 +21988,7 @@ static const char *startup_source = " 1)" "(normalise-inputs" " 'in-vector" -" \"vector\"" +" \"vector\"" "(lambda(x_0)" "(vector?" " x_0))" @@ -21926,7 +22058,7 @@ static const char *startup_source = " 1)" "(normalise-inputs" " 'in-vector" -" \"vector\"" +" \"vector\"" "(lambda(x_0)" "(vector?" " x_0))" @@ -21994,7 +22126,8 @@ static const char *startup_source = "(if(variable-reference-from-unsafe?" "(#%variable-reference))" "(void)" -"(let-values()(check-list lst_0)))" +"(let-values()" +"(check-list lst_0)))" "((letrec-values(((for-loop_0)" "(lambda(lst_1)" "(begin" @@ -22073,15 +22206,17 @@ static const char *startup_source = " null" "(hash-iterate-first ht_0)))))))" "(let-values(((lst_0)" -"(let-values(((share-steps16_0) share-steps_0)" -"((<17_0) <))" -"(sort.1 #f #f share-steps16_0 <17_0)))" +"(let-values(((share-steps28_0) share-steps_0)" +"((<29_0) <))" +"(sort.1 #f #f share-steps28_0 <29_0)))" "((start_0) num-mutables_0))" "(begin" -"(if(variable-reference-from-unsafe?(#%variable-reference))" +"(if(variable-reference-from-unsafe?" +"(#%variable-reference))" "(void)" "(let-values()(check-list lst_0)))" -"(if(variable-reference-from-unsafe?(#%variable-reference))" +"(if(variable-reference-from-unsafe?" +"(#%variable-reference))" "(void)" "(let-values()(check-naturals start_0)))" "((letrec-values(((for-loop_0)" @@ -22089,8 +22224,10 @@ static const char *startup_source = "(begin" " 'for-loop" "(if(if(pair? lst_1) #t #f)" -"(let-values(((step_0)(unsafe-car lst_1))" -"((rest_0)(unsafe-cdr lst_1))" +"(let-values(((step_0)" +"(unsafe-car lst_1))" +"((rest_0)" +"(unsafe-cdr lst_1))" "((pos_1) pos_0))" "(let-values(((table_1)" "(let-values(((table_1)" @@ -22107,7 +22244,8 @@ static const char *startup_source = " table_1" " key_0" " val_0)))))" -"(values table_2)))))" +"(values" +" table_2)))))" "(if(not #f)" "(for-loop_0" " table_1" @@ -22132,7 +22270,9 @@ static const char *startup_source = " stream_0" "(- stream-size_0(add1 pos_0)))))" "(let-values(((or-part_0)(not(keyword? v_1))))" -"(if or-part_0 or-part_0(eq? '#:quote v_1))))))))" +"(if or-part_0" +" or-part_0" +"(eq? '#:quote v_1))))))))" "(let-values(((ser-reset!_0)" "(lambda(pos_0)" "(begin" @@ -22164,7 +22304,10 @@ static const char *startup_source = "(ser-push!_0 'tag '#:ref)" "(ser-push!_0 'exact n_0))))" "(let-values(((c1_0)" -"(hash-ref mutables_0 v_1 #f)))" +"(hash-ref" +" mutables_0" +" v_1" +" #f)))" "(if c1_0" "((lambda(n_0)" "(begin" @@ -22179,9 +22322,11 @@ static const char *startup_source = "(let-values()" "(begin" "(set! stream_0(cons v_1 stream_0))" -"(set! stream-size_0(add1 stream-size_0))))" +"(set! stream-size_0" +"(add1 stream-size_0))))" "(if(equal? tmp_0 'tag)" -"(let-values()(ser-push!_0 'exact v_1))" +"(let-values()" +"(ser-push!_0 'exact v_1))" "(if(equal? tmp_0 'reference)" "(let-values()" "(if(hash-ref shares_0 v_1 #f)" @@ -22189,7 +22334,9 @@ static const char *startup_source = "(let-values(((n_0)" "(hash-ref" " share-step-positions_0" -"(hash-ref objs_0 v_1))))" +"(hash-ref" +" objs_0" +" v_1))))" "(ser-push!_0 'exact n_0)))" "(let-values(((c2_0)" "(hash-ref" @@ -22200,8 +22347,10 @@ static const char *startup_source = "((lambda(n_0)" "(ser-push!_0 'exact n_0))" " c2_0)" -"(let-values()(ser-push!_0 v_1))))))" -"(let-values()(ser-push!_0 v_1)))))))))" +"(let-values()" +"(ser-push!_0 v_1))))))" +"(let-values()" +"(ser-push!_0 v_1)))))))))" "((ser-push-encoded!_0)" "(lambda(v_1)" "(begin" @@ -22217,7 +22366,9 @@ static const char *startup_source = "(ser-push!_0 'tag '#:mpi)" "(ser-push!_0" " 'exact" -"(add-module-path-index!/pos mpis_0 v_1))))" +"(add-module-path-index!/pos" +" mpis_0" +" v_1))))" "(if(serialize? v_1)" "(let-values()" "((serialize-ref v_1)" @@ -22225,7 +22376,9 @@ static const char *startup_source = " ser-push!_0" " state_0))" "(if(if(list? v_1)" -"(if(pair? v_1)(pair?(cdr v_1)) #f)" +"(if(pair? v_1)" +"(pair?(cdr v_1))" +" #f)" " #f)" "(let-values()" "(let-values(((start-pos_0)" @@ -22240,7 +22393,8 @@ static const char *startup_source = "(begin" "(ser-push!_0" " 'exact" -"(length v_1))" +"(length" +" v_1))" "(values))))" "(let-values(((all-quoted?_0)" "(let-values(((lst_0)" @@ -22294,9 +22448,12 @@ static const char *startup_source = "(if all-quoted?_0" "(let-values()" "(begin" -"(ser-reset!_0 start-pos_0)" +"(ser-reset!_0" +" start-pos_0)" "(ser-push-optional-quote!_0)" -"(ser-push!_0 'exact v_1)))" +"(ser-push!_0" +" 'exact" +" v_1)))" "(void)))))))" "(if(pair? v_1)" "(let-values()" @@ -22313,14 +22470,18 @@ static const char *startup_source = "(let-values((()" "(begin" "(ser-push!_0" -"(car v_1))" +"(car" +" v_1))" "(values))))" "(let-values(((d-pos_0)" "(next-push-position_0)))" "(begin" -"(ser-push!_0(cdr v_1))" -"(if(if(quoted?_0 a-pos_0)" -"(quoted?_0 d-pos_0)" +"(ser-push!_0" +"(cdr v_1))" +"(if(if(quoted?_0" +" a-pos_0)" +"(quoted?_0" +" d-pos_0)" " #f)" "(let-values()" "(begin" @@ -22344,8 +22505,10 @@ static const char *startup_source = "(let-values(((v-pos_0)" "(next-push-position_0)))" "(begin" -"(ser-push!_0(unbox v_1))" -"(if(quoted?_0 v-pos_0)" +"(ser-push!_0" +"(unbox v_1))" +"(if(quoted?_0" +" v-pos_0)" "(let-values()" "(begin" "(ser-reset!_0" @@ -22648,7 +22811,7 @@ static const char *startup_source = " 1)" "(normalise-inputs" " 'in-vector" -" \"vector\"" +" \"vector\"" "(lambda(x_0)" "(vector?" " x_0))" @@ -22715,7 +22878,8 @@ static const char *startup_source = "(if(srcloc? v_1)" "(let-values()" "(if(path?" -"(srcloc-source v_1))" +"(srcloc-source" +" v_1))" "(let-values()" "(begin" "(ser-push-optional-quote!_0)" @@ -22728,11 +22892,14 @@ static const char *startup_source = " 'tag" " '#:srcloc)" "(ser-push!_0" -"(srcloc-source v_1))" +"(srcloc-source" +" v_1))" "(ser-push!_0" -"(srcloc-line v_1))" +"(srcloc-line" +" v_1))" "(ser-push!_0" -"(srcloc-column v_1))" +"(srcloc-column" +" v_1))" "(ser-push!_0" "(srcloc-position" " v_1))" @@ -22746,21 +22913,28 @@ static const char *startup_source = " 'exact" " v_1)))))))))))))))))" "((ser-push-optional-quote!_0)" -"(lambda()(begin 'ser-push-optional-quote!(void)))))" +"(lambda()" +"(begin 'ser-push-optional-quote!(void)))))" "(let-values(((ser-shell!_0)" "(lambda(v_1)" "(begin" " 'ser-shell!" "(if(serialize-fill!? v_1)" "(let-values()" -"((serialize-ref v_1) v_1 ser-push!_0 state_0))" +"((serialize-ref v_1)" +" v_1" +" ser-push!_0" +" state_0))" "(if(box? v_1)" -"(let-values()(ser-push!_0 'tag '#:box))" +"(let-values()" +"(ser-push!_0 'tag '#:box))" "(if(vector? v_1)" "(let-values()" "(begin" "(ser-push!_0 'tag '#:vector)" -"(ser-push!_0 'exact(vector-length v_1))))" +"(ser-push!_0" +" 'exact" +"(vector-length v_1))))" "(if(hash? v_1)" "(let-values()" "(ser-push!_0" @@ -22773,7 +22947,7 @@ static const char *startup_source = "(let-values()" "(error" " 'ser-shell" -" \"unknown mutable: ~e\"" +" \"unknown mutable: ~e\"" " v_1))))))))))" "(let-values(((ser-shell-fill!_0)" "(lambda(v_1)" @@ -22793,13 +22967,18 @@ static const char *startup_source = "(if(vector? v_1)" "(let-values()" "(begin" -"(ser-push!_0 'tag '#:set-vector!)" -"(ser-push!_0 'exact(vector-length v_1))" +"(ser-push!_0" +" 'tag" +" '#:set-vector!)" +"(ser-push!_0" +" 'exact" +"(vector-length v_1))" "(let-values(((vec_0 len_0)" "(let-values(((vec_0)" " v_1))" "(begin" -"(check-vector vec_0)" +"(check-vector" +" vec_0)" "(values" " vec_0" "(unsafe-vector-length" @@ -22850,19 +23029,22 @@ static const char *startup_source = "(begin" "(ser-push!_0" " 'exact" -"(hash-count v_1))" +"(hash-count" +" v_1))" "(values))))" "(let-values(((ks_0)" "(sorted-hash-keys" " v_1)))" "(begin" -"(let-values(((lst_0) ks_0))" +"(let-values(((lst_0)" +" ks_0))" "(begin" "(if(variable-reference-from-unsafe?" "(#%variable-reference))" "(void)" "(let-values()" -"(check-list lst_0)))" +"(check-list" +" lst_0)))" "((letrec-values(((for-loop_0)" "(lambda(lst_1)" "(begin" @@ -22902,7 +23084,7 @@ static const char *startup_source = "(let-values()" "(error" " 'ser-shell-fill" -" \"unknown mutable: ~e\"" +" \"unknown mutable: ~e\"" " v_1))))))))))" "(let-values(((rev-mutables_0)" "(let-values(((ht_0) mutables_0))" @@ -22916,7 +23098,8 @@ static const char *startup_source = "(begin" " 'for-loop" "(if i_0" -"(let-values(((k_0 v_1)" +"(let-values(((k_0" +" v_1)" "(hash-iterate-key+value" " ht_0" " i_0)))" @@ -22952,19 +23135,25 @@ static const char *startup_source = "(begin" "(begin" "(let-values(((start_0) 0)" -"((end_0)(hash-count mutables_0))" +"((end_0)" +"(hash-count mutables_0))" "((inc_0) 1))" "(begin" "(if(variable-reference-from-unsafe?" "(#%variable-reference))" "(void)" "(let-values()" -"(check-range start_0 end_0 inc_0)))" +"(check-range" +" start_0" +" end_0" +" inc_0)))" "((letrec-values(((for-loop_0)" "(lambda(pos_0)" "(begin" " 'for-loop" -"(if(< pos_0 end_0)" +"(if(<" +" pos_0" +" end_0)" "(let-values(((i_0)" " pos_0))" "(let-values((()" @@ -22979,7 +23168,8 @@ static const char *startup_source = " i_0)))" "(values)))))" "(values)))))" -"(if(not #f)" +"(if(not" +" #f)" "(for-loop_0" "(+" " pos_0" @@ -22996,9 +23186,11 @@ static const char *startup_source = "(if(variable-reference-from-unsafe?" "(#%variable-reference))" "(void)" -"(let-values()(check-in-hash-keys ht_0)))" +"(let-values()" +"(check-in-hash-keys ht_0)))" "((letrec-values(((for-loop_0)" -"(lambda(table_0 i_0)" +"(lambda(table_0" +" i_0)" "(begin" " 'for-loop" "(if i_0" @@ -23027,7 +23219,8 @@ static const char *startup_source = " val_0)))))" "(values" " table_2)))))" -"(if(not #f)" +"(if(not" +" #f)" "(for-loop_0" " table_1" "(hash-iterate-next" @@ -23041,11 +23234,13 @@ static const char *startup_source = "(let-values(((shared-bindings_0)" "(begin" "(begin" -"(let-values(((start_0) num-mutables_0)" +"(let-values(((start_0)" +" num-mutables_0)" "((end_0)" "(+" " num-mutables_0" -"(hash-count shares_0)))" +"(hash-count" +" shares_0)))" "((inc_0) 1))" "(begin" "(if(variable-reference-from-unsafe?" @@ -23094,7 +23289,8 @@ static const char *startup_source = "(begin" "(let-values(((start_0) 0)" "((end_0)" -"(hash-count mutables_0))" +"(hash-count" +" mutables_0))" "((inc_0) 1))" "(begin" "(if(variable-reference-from-unsafe?" @@ -23142,6 +23338,16 @@ static const char *startup_source = "(begin" "(ser-push!_0 v_0)" "(reap-stream!_0))))" +"(if as-data?_0" +"(let-values()" +"(vector" +"(hash-count mutables_0)" +" mutable-shell-bindings_0" +"(hash-count shares_0)" +" shared-bindings_0" +" mutable-fills_0" +" result_0))" +"(let-values()" "(let-values(((finish_0)" "(lambda(mutable-shell-bindings-expr_0" " shared-bindings-expr_0" @@ -23160,9 +23366,12 @@ static const char *startup_source = " #f)" "(list" " 'quote" -"(hash-count mutables_0))" +"(hash-count" +" mutables_0))" " mutable-shell-bindings-expr_0" -"(list 'quote(hash-count shares_0))" +"(list" +" 'quote" +"(hash-count shares_0))" " shared-bindings-expr_0" " mutable-fills-expr_0" " result-expr_0)))))" @@ -23184,7 +23393,7 @@ static const char *startup_source = " '(unsafe-vector*-ref data 2)" " '(unsafe-vector*-ref" " data" -" 3)))))))))))))))))))))))))))))))))))))" +" 3)))))))))))))))))))))))))))))))))))))))))))" "(define-values" "(sorted-hash-keys)" "(lambda(ht_0)" @@ -23196,15 +23405,15 @@ static const char *startup_source = "(let-values() ks_0)" "(if(andmap2 symbol? ks_0)" "(let-values()" -"(let-values(((ks18_0) ks_0)((symbolimmutable-vector(list->vector(reverse$1(syntax-literals-stxes sl_0)))))" "((mpis22_0) mpis_0))" -"(generate-deserialize.1 #t temp21_0 mpis22_0))))" +"(generate-deserialize.1 #f #f mpis22_0 '#hasheq() #t temp21_0))))" "(list* 'set! deserialize-syntax-id '(#f)))))))))))" "(define-values(generate-lazy-syntax-literal-lookup)(lambda(pos_0)(begin(list get-syntax-literal!-id pos_0))))" "(define-values" @@ -31048,7 +31374,7 @@ static const char *startup_source = " '(ns+stxss)" "(let-values(((temp23_0)(cons(encode-namespace-scopes ns_0)(reverse$1(syntax-literals-stxes sl_0))))" "((mpis24_0) mpis_0))" -"(generate-deserialize.1 #t temp23_0 mpis24_0))))" +"(generate-deserialize.1 #f #f mpis24_0 '#hasheq() #t temp23_0))))" "(list" " 'let-values" " '(((ns-scope-s)(car ns+stxss)))" @@ -34644,7 +34970,8 @@ static const char *startup_source = "(list" " 'define-values" "(list mpi-vector-id)" -"(generate-module-path-index-deserialize mpis_0))" +"(let-values(((mpis6_0) mpis_0))" +"(generate-module-path-index-deserialize.1 #f mpis6_0)))" "(list 'define-values '(mpi-vector-trees)(list 'quote mpi-trees_0))" "(list" " 'define-values" @@ -38108,8 +38435,10 @@ static const char *startup_source = "(list" " 'define-values" "(list mpi-vector-id)" -"(generate-module-path-index-deserialize" -" mpis_0))" +"(let-values(((mpis28_0) mpis_0))" +"(generate-module-path-index-deserialize.1" +" #f" +" mpis28_0)))" "(list" " 'define-values" "(list deserialized-syntax-vector-id)" @@ -64917,6 +65246,336 @@ static const char *startup_source = "(let-values(((or-part_1)(current-module-code-inspector)))" "(if or-part_1 or-part_1(current-code-inspector))))))))" "(define-values" +"(struct:serialized-syntax" +" serialized-syntax1.1" +" serialized-syntax?" +" serialized-syntax-version" +" serialized-syntax-mpis" +" serialized-syntax-base-mpi-pos" +" serialized-syntax-data" +" serialized-syntax-need-registry?)" +"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" +"(let-values()" +"(let-values()" +"(make-struct-type" +" 'serialized-syntax" +" #f" +" 5" +" 0" +" #f" +" null" +" 'prefab" +" #f" +" '(0 1 2 3 4)" +" #f" +" 'serialized-syntax)))))" +"(values" +" struct:_0" +" make-_0" +" ?_0" +"(make-struct-field-accessor -ref_0 0 'version)" +"(make-struct-field-accessor -ref_0 1 'mpis)" +"(make-struct-field-accessor -ref_0 2 'base-mpi-pos)" +"(make-struct-field-accessor -ref_0 3 'data)" +"(make-struct-field-accessor -ref_0 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)" +"(begin" +" 'syntax-serialize" +"(let-values(((stx_0) stx5_0))" +"(let-values(((base-mpi_0) base-mpi2_0))" +"(let-values(((preserve-prop-keys_0) 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_0)" +"(void)" +"(let-values()" +" (raise-argument-error 'syntax-serialize \"syntax?\" stx_0)))" +"(values))))" +"(let-values((()" +"(begin" +"(if((lambda(x_0)" +"(let-values(((or-part_0)(not x_0)))" +"(if or-part_0 or-part_0(1/module-path-index? x_0))))" +" 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_0)(if(list? l_0)(andmap2 symbol? l_0) #f))" +" preserve-prop-keys_0)" +"(void)" +"(let-values()" +"(raise-argument-error" +" 'syntax-serialize" +" \"(listof symbol?)\"" +" preserve-prop-keys_0)))" +"(values))))" +"(let-values((()" +"(begin" +"(if((lambda(x_0)" +"(let-values(((or-part_0)(not x_0)))" +"(if or-part_0 or-part_0(1/namespace? x_0))))" +" provides-namespace_0)" +"(void)" +"(let-values()" +"(raise-argument-error" +" 'syntax-serialize" +" \"(or/c namespace? #f)\"" +" provides-namespace_0)))" +"(values))))" +"(let-values(((mpis_0)(make-module-path-index-table)))" +"(let-values(((base-mpi-pos_0)" +"(if base-mpi_0" +"(add-module-path-index!/pos mpis_0 base-mpi_0)" +" #f)))" +"(let-values(((data_0)" +"(let-values(((stx10_0) stx_0)" +"((mpis11_0) mpis_0)" +"((temp12_0) #t)" +"((temp13_0)" +"(let-values(((lst_0) preserve-prop-keys_0))" +"(begin" +"(if(variable-reference-from-unsafe?" +"(#%variable-reference))" +"(void)" +"(let-values()(check-list lst_0)))" +"((letrec-values(((for-loop_0)" +"(lambda(table_0 lst_1)" +"(begin" +" 'for-loop" +"(if(pair? lst_1)" +"(let-values(((k_0)" +"(unsafe-car" +" lst_1))" +"((rest_0)" +"(unsafe-cdr" +" lst_1)))" +"(let-values(((table_1)" +"(let-values(((table_1)" +" table_0))" +"(let-values(((table_2)" +"(let-values()" +"(let-values(((key_0" +" val_0)" +"(let-values()" +"(values" +" k_0" +" #t))))" +"(hash-set" +" table_1" +" key_0" +" val_0)))))" +"(values" +" table_2)))))" +"(if(not #f)" +"(for-loop_0" +" table_1" +" rest_0)" +" table_1)))" +" table_0)))))" +" for-loop_0)" +" '#hasheq()" +" lst_0))))" +"((temp14_0)" +"(if provides-namespace_0" +"(lambda(modname_0)" +"(begin" +" 'temp14" +"(not" +"(namespace->module" +" provides-namespace_0" +" modname_0))))" +"(lambda(modname_0)(begin 'temp14 #t)))))" +"(generate-deserialize.1" +" temp12_0" +" temp14_0" +" mpis11_0" +" temp13_0" +" #t" +" stx10_0))))" +"(serialized-syntax1.1" +"(version)" +"(let-values(((mpis15_0) mpis_0)((temp16_0) #t))" +"(generate-module-path-index-deserialize.1 temp16_0 mpis15_0))" +" base-mpi-pos_0" +" data_0" +"(if provides-namespace_0 #t #f))))))))))))))))))))" +"(case-lambda" +"((stx_0)(begin 'syntax-serialize(syntax-serialize_0 stx_0 #f '() unsafe-undefined)))" +"((stx_0 base-mpi_0 preserve-prop-keys_0 provides-namespace4_0)" +"(syntax-serialize_0 stx_0 base-mpi_0 preserve-prop-keys_0 provides-namespace4_0))" +"((stx_0 base-mpi_0 preserve-prop-keys3_0)" +"(syntax-serialize_0 stx_0 base-mpi_0 preserve-prop-keys3_0 unsafe-undefined))" +"((stx_0 base-mpi2_0)(syntax-serialize_0 stx_0 base-mpi2_0 '() unsafe-undefined)))))" +"(define-values" +"(1/syntax-deserialize)" +"(let-values(((syntax-deserialize_0)" +"(lambda(data7_0 base-mpi6_0)" +"(begin" +" 'syntax-deserialize" +"(let-values(((data_0) data7_0))" +"(let-values(((base-mpi_0) base-mpi6_0))" +"(let-values()" +"(let-values()" +"(let-values()" +"(let-values((()" +"(begin" +"(if((lambda(x_0)" +"(let-values(((or-part_0)(not x_0)))" +"(if or-part_0 or-part_0(1/module-path-index? x_0))))" +" base-mpi_0)" +"(void)" +"(let-values()" +"(raise-argument-error" +" 'syntax-deserialize" +" \"(or/c module-path-index? #f)\"" +" base-mpi_0)))" +"(values))))" +"(let-values((()" +"(begin" +"(if(serialized-syntax? data_0)" +"(void)" +"(let-values()" +"(raise-arguments-error" +" 'syntax-deserialize" +" \"invalid serialized form\"" +" \"value\"" +" data_0)))" +"(values))))" +"(let-values((()" +"(begin" +"(if(equal?(version)(serialized-syntax-version data_0))" +"(void)" +"(let-values()" +"(raise-arguments-error" +" 'syntax-deserialize" +" \"version mismatch\"" +" \"expected\"" +"(version)" +" \"found\"" +"(serialized-syntax-version data_0))))" +"(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_0))))" +"(let-values(((orig-base-mpi_0)" +"(if base-mpi_0" +"(let-values(((pos_0)(serialized-syntax-base-mpi-pos data_0)))" +"(if pos_0(vector-ref orig-mpis_0 pos_0) #f))" +" #f)))" +"(let-values(((shifted-mpis_0)" +"(if orig-base-mpi_0" +"(let-values(((len_0)(vector-length orig-mpis_0)))" +"(begin" +"(if(exact-nonnegative-integer? len_0)" +"(void)" +"(let-values()" +"(raise-argument-error" +" 'for/vector" +" \"exact-nonnegative-integer?\"" +" len_0)))" +"(let-values(((v_0)(make-vector len_0 0)))" +"(begin" +"(if(zero? len_0)" +"(void)" +"(let-values()" +"(let-values(((vec_0 len_1)" +"(let-values(((vec_0) orig-mpis_0))" +"(begin" +"(check-vector vec_0)" +"(values" +" vec_0" +"(unsafe-vector-length" +" vec_0))))))" +"(begin" +" #f" +"((letrec-values(((for-loop_0)" +"(lambda(i_0 pos_0)" +"(begin" +" 'for-loop" +"(if(unsafe-fx<" +" pos_0" +" len_1)" +"(let-values(((mpi_0)" +"(unsafe-vector-ref" +" vec_0" +" pos_0)))" +"(let-values(((i_1)" +"(let-values(((i_1)" +" i_0))" +"(let-values(((i_2)" +"(let-values()" +"(begin" +"(unsafe-vector*-set!" +" v_0" +" i_1" +"(let-values()" +"(module-path-index-shift" +" mpi_0" +" orig-base-mpi_0" +" base-mpi_0)))" +"(unsafe-fx+" +" 1" +" i_1)))))" +"(values" +" i_2)))))" +"(if(if(not" +"((lambda x_0" +"(unsafe-fx=" +" i_1" +" len_0))" +" mpi_0))" +"(not #f)" +" #f)" +"(for-loop_0" +" i_1" +"(unsafe-fx+" +" 1" +" pos_0))" +" i_1)))" +" i_0)))))" +" for-loop_0)" +" 0" +" 0)))))" +" v_0))))" +" orig-mpis_0)))" +"(let-values(((bulk-binding-registry_0)" +"(if(serialized-syntax-need-registry? data_0)" +"(namespace-bulk-binding-registry(1/current-namespace))" +" #f)))" +"(deserialize-data" +" shifted-mpis_0" +" #f" +" bulk-binding-registry_0" +"(serialized-syntax-data data_0)))))))))))))))))))" +"(case-lambda" +"((data_0)(begin 'syntax-deserialize(syntax-deserialize_0 data_0 #f)))" +"((data_0 base-mpi6_0)(syntax-deserialize_0 data_0 base-mpi6_0)))))" +"(define-values" "(1/variable-reference->empty-namespace)" "(lambda(vr_0)" "(begin" @@ -65113,6 +65772,8 @@ static const char *startup_source = " 'syntax-binding-set?" " 'syntax-binding-set-extend" " 'syntax-binding-set->syntax" +" 'syntax-serialize" +" 'syntax-deserialize" " 'raise-syntax-error" " 'struct:exn:fail:syntax" " 'exn:fail:syntax" @@ -65254,6 +65915,8 @@ static const char *startup_source = "(add-core-primitive! 'syntax-binding-set? 1/syntax-binding-set?)" "(add-core-primitive! 'syntax-binding-set-extend 1/syntax-binding-set-extend)" "(add-core-primitive! 'syntax-binding-set->syntax 1/syntax-binding-set->syntax)" +"(add-core-primitive! 'syntax-serialize 1/syntax-serialize)" +"(add-core-primitive! 'syntax-deserialize 1/syntax-deserialize)" "(add-core-primitive! 'raise-syntax-error raise-syntax-error$1)" "(add-core-primitive! 'struct:exn:fail:syntax 1/struct:exn:fail:syntax)" "(add-core-primitive! 'exn:fail:syntax make-exn:fail:syntax$1)" diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index 65972dc7e7..7ca43a3f87 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -61,8 +61,10 @@ (seal seal) (1/syntax->datum syntax->datum) (1/syntax-debug-info syntax-debug-info) + (1/syntax-deserialize syntax-deserialize) (1/syntax-e syntax-e) (syntax-property$1 syntax-property) + (1/syntax-serialize syntax-serialize) (1/syntax-shift-phase-level syntax-shift-phase-level) (syntax?$1 syntax?) (1/use-collection-link-paths use-collection-link-paths) @@ -106,6 +108,7 @@ (define kw2450 (string->keyword "none")) (define kw2677 (string->keyword "local-binding")) (define kw2897 (string->keyword "provided")) +(define kw2882 (string->keyword "bulk-binding+provides")) (define kw2762 (string->keyword "bulk-binding")) (define kw2607 (string->keyword "bulk-binding-registry")) (define kw2626 (string->keyword "quote")) @@ -126,12 +129,14 @@ (define kw2531 (string->keyword "set-box!")) (define kw3046 (string->keyword "set-vector!")) (define kw2194 (string->keyword "set-hash!")) -(define hash2936 +(define hash2605 (hasheq kw2525 '10 kw2762 '27 + kw2882 + '28 kw2707 '22 kw2607 @@ -163,7 +168,7 @@ kw2931 '15 kw2897 - '28 + '29 kw2626 '8 kw2603 @@ -6545,13 +6550,13 @@ (define finish174 (make-struct-type-install-properties '(serialize-state) - 12 + 14 0 #f (list (cons prop:authentic #t)) (current-inspector) #f - '(0 1 2 3 4 5 6 7 8 9 10 11) + '(0 1 2 3 4 5 6 7 8 9 10 11 12 13) #f 'serialize-state)) (define struct:serialize-state @@ -6561,7 +6566,7 @@ (|#%nongenerative-uid| serialize-state) #f #f - 12 + 14 0)) (define effect_2707 (finish174 struct:serialize-state)) (define serialize-state1.1 @@ -6615,8 +6620,16 @@ (|#%name| serialize-state-sharing-syntaxes (record-accessor struct:serialize-state 11))) +(define serialize-state-preserve-prop-keys + (|#%name| + serialize-state-preserve-prop-keys + (record-accessor struct:serialize-state 12))) +(define serialize-state-keep-provides? + (|#%name| + serialize-state-keep-provides? + (record-accessor struct:serialize-state 13))) (define make-serialize-state - (lambda (reachable-scopes_0) + (lambda (reachable-scopes_0 preserve-prop-keys_0 keep-provides?_0) (let ((state_0 (let ((app_0 (make-hasheq))) (let ((app_1 (make-hasheq))) @@ -6640,7 +6653,9 @@ app_7 app_8 app_9 - (make-hasheq)))))))))))))) + (make-hasheq) + preserve-prop-keys_0 + keep-provides?_0))))))))))))) (let ((empty-seteq_0 (seteq))) (begin (hash-set! @@ -7424,7 +7439,7 @@ (cons prop:authentic #t) (cons prop:reach-scopes - (lambda (s_0 reach_0) + (lambda (s_0 bulk-shifts_0 reach_0) (let ((content*_0 (syntax-content* s_0))) (begin (|#%app| @@ -7435,41 +7450,57 @@ (if (propagation?$1 prop_0) (|#%app| (propagation-ref prop_0) s_0) (modified-content-content content*_0))) - content*_0)) - (|#%app| reach_0 (syntax-scopes s_0)) - (|#%app| reach_0 (syntax-shifted-multi-scopes s_0)) - (let ((ht_0 (syntax-props s_0))) + content*_0) + bulk-shifts_0) + (let ((shifts_0 + (if bulk-shifts_0 + (append bulk-shifts_0 (syntax-mpi-shifts s_0)) + #f))) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (unsafe-immutable-hash-iterate-key+value ht_0 i_0)) - (case-lambda - ((k_0 v_0) - (call-with-values - (lambda () - (if (preserved-property-value? v_0) - (begin - (|#%app| reach_0 (plain-property-value v_0)) - (values)) - (values))) - (case-lambda - (() - (for-loop_0 - (unsafe-immutable-hash-iterate-next ht_0 i_0))) - (args - (raise-binding-result-arity-error 0 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (values))))))) - (for-loop_0 (unsafe-immutable-hash-iterate-first ht_0))))) - (void) - (|#%app| reach_0 (syntax-srcloc s_0)))))) + (|#%app| reach_0 (syntax-scopes s_0) shifts_0) + (|#%app| reach_0 (syntax-shifted-multi-scopes s_0) shifts_0) + (let ((ht_0 (syntax-props s_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (unsafe-immutable-hash-iterate-key+value + ht_0 + i_0)) + (case-lambda + ((k_0 v_0) + (call-with-values + (lambda () + (if (preserved-property-value? v_0) + (begin + (|#%app| + reach_0 + (plain-property-value v_0) + bulk-shifts_0) + (values)) + (values))) + (case-lambda + (() + (for-loop_0 + (unsafe-immutable-hash-iterate-next + ht_0 + i_0))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (args + (raise-binding-result-arity-error 2 args)))) + (values))))))) + (for-loop_0 (unsafe-immutable-hash-iterate-first ht_0))))) + (void) + (|#%app| reach_0 (syntax-srcloc s_0) bulk-shifts_0))))))) (cons prop:serialize (lambda (s_0 ser-push!_0 state_0) @@ -7487,53 +7518,64 @@ (intern-properties (syntax-props s_0) (lambda () - (let ((ht_0 (syntax-props s_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value ht_0 i_0)) - (case-lambda - ((k_0 v_0) - (let ((table_1 - (if (preserved-property-value? - v_0) - (let ((table_1 - (call-with-values - (lambda () - (values - k_0 - (check-value-to-preserve - (plain-property-value - v_0) - syntax?$1))) - (case-lambda - ((key_0 val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)) - table_0))) - (for-loop_0 - table_1 - (hash-iterate-next ht_0 i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 hash2610 (hash-iterate-first ht_0)))))) + (let ((preserve-keys_0 + (serialize-state-preserve-prop-keys state_0))) + (let ((ht_0 (syntax-props s_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value ht_0 i_0)) + (case-lambda + ((k_0 v_0) + (let ((table_1 + (if (let ((or-part_0 + (preserved-property-value? + v_0))) + (if or-part_0 + or-part_0 + (hash-ref + preserve-keys_0 + k_0 + #f))) + (let ((table_1 + (call-with-values + (lambda () + (values + k_0 + (check-value-to-preserve + (plain-property-value + v_0) + syntax?$1))) + (case-lambda + ((key_0 val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)) + table_0))) + (for-loop_0 + table_1 + (hash-iterate-next ht_0 i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2610 + (hash-iterate-first ht_0))))))) state_0))) (let ((tamper_0 (serialize-tamper (syntax-tamper s_0)))) (let ((context-triple_0 @@ -8609,7 +8651,7 @@ (cons prop:authentic #t) (cons prop:reach-scopes - (lambda (sms_0 reach_0) (error "shouldn't get here"))) + (lambda (sms_0 extra-scopes_0 reach_0) (error "shouldn't get here"))) (cons prop:serialize (lambda (bba_0 ser-push!_0 state_0) @@ -8651,13 +8693,13 @@ (define finish242 (make-struct-type-install-properties '(bulk-binding-class) - 2 + 3 0 #f null (current-inspector) #f - '(0 1) + '(0 1 2) #f 'bulk-binding-class)) (define struct:bulk-binding-class @@ -8667,7 +8709,7 @@ (|#%nongenerative-uid| bulk-binding-class) #f #f - 2 + 3 0)) (define effect_2841 (finish242 struct:bulk-binding-class)) (define bulk-binding-class3.1 @@ -8723,6 +8765,24 @@ s 'bulk-binding-class 'create)))))) +(define bulk-binding-class-modname_2547 + (|#%name| + bulk-binding-class-modname + (record-accessor struct:bulk-binding-class 2))) +(define bulk-binding-class-modname + (|#%name| + bulk-binding-class-modname + (lambda (s) + (if (bulk-binding-class?_2308 s) + (bulk-binding-class-modname_2547 s) + ($value + (impersonate-ref + bulk-binding-class-modname_2547 + struct:bulk-binding-class + 2 + s + 'bulk-binding-class + 'modname)))))) (define bulk-binding-symbols (lambda (b_0 s_0 extra-shifts_0) (let ((app_0 (bulk-binding-class-get-symbols (bulk-binding-ref b_0)))) @@ -8732,6 +8792,19 @@ (append extra-shifts_0 (if s_0 (syntax-mpi-shifts s_0) null)))))) (define bulk-binding-create (lambda (b_0) (bulk-binding-class-create (bulk-binding-ref b_0)))) +(define force-bulk-bindings + (lambda (b_0 bulk-shifts_0) + (let ((modname-ht_0 (car bulk-shifts_0))) + (let ((extra-shifts_0 (cdr bulk-shifts_0))) + (begin + (hash-set! + modname-ht_0 + b_0 + (|#%app| + (bulk-binding-class-modname (bulk-binding-ref b_0)) + b_0 + extra-shifts_0)) + (bulk-binding-symbols b_0 #f extra-shifts_0)))))) (define binding-table-empty? (lambda (bt_0) (if (hash? bt_0) (zero? (hash-count bt_0)) #f))) (define binding-table-add @@ -9252,7 +9325,11 @@ new-bt_0) new-bt_0))))))))) (define binding-table-register-reachable - (lambda (bt_0 get-reachable-scopes_0 reach_0 register-trigger_0) + (lambda (bt_0 + get-reachable-scopes_0 + bulk-shifts_0 + reach_0 + register-trigger_0) (begin (let ((ht_0 (if (hash? bt_0) @@ -9301,6 +9378,7 @@ scopes_0 v_0 get-reachable-scopes_0 + bulk-shifts_0 reach_0 register-trigger_0)) (for-loop_1 @@ -9338,22 +9416,34 @@ (let ((bba_0 (unsafe-car lst_1))) (let ((rest_0 (unsafe-cdr lst_1))) (begin - (scopes-register-reachable - (bulk-binding-at-scopes bba_0) - #f - get-reachable-scopes_0 - reach_0 - register-trigger_0) + (begin + (if bulk-shifts_0 + (force-bulk-bindings + (bulk-binding-at-bulk bba_0) + bulk-shifts_0) + (void)) + (scopes-register-reachable + (bulk-binding-at-scopes bba_0) + #f + get-reachable-scopes_0 + bulk-shifts_0 + reach_0 + register-trigger_0)) (for-loop_0 rest_0)))) (values))))))) (for-loop_0 lst_0)))) (void)) (void))))) (define scopes-register-reachable - (lambda (scopes_0 v_0 get-reachable-scopes_0 reach_0 register-trigger_0) + (lambda (scopes_0 + v_0 + get-reachable-scopes_0 + bulk-shifts_0 + reach_0 + register-trigger_0) (let ((reachable-scopes_0 (|#%app| get-reachable-scopes_0))) (if (begin-unsafe (hash-keys-subset? scopes_0 reachable-scopes_0)) - (|#%app| reach_0 v_0) + (|#%app| reach_0 v_0 bulk-shifts_0) (let ((pending-scopes_0 (begin (letrec* @@ -9405,7 +9495,7 @@ (begin (if (zero? (hash-count pending-scopes_0)) (begin - (|#%app| reach_1 v_0) + (|#%app| reach_1 v_0 bulk-shifts_0) (begin (letrec* ((for-loop_0 @@ -9420,7 +9510,10 @@ i_0))) (begin (if (implicitly-reachable? sc_0) - (|#%app| reach_1 sc_0) + (|#%app| + reach_1 + sc_0 + bulk-shifts_0) (void)) (for-loop_0 (unsafe-immutable-hash-iterate-next @@ -10144,7 +10237,7 @@ (lambda (sup-i_0 i_0) (let ((or-part_0 (eq? sup-i_0 i_0))) (if or-part_0 or-part_0 (inspector-superior? sup-i_0 i_0))))) -(define finish295 +(define finish296 (make-struct-type-install-properties '(fallback) 1 @@ -10165,7 +10258,7 @@ #f 1 1)) -(define effect_2114 (finish295 struct:fallback)) +(define effect_2114 (finish296 struct:fallback)) (define fallback1.1 (|#%name| fallback @@ -10266,7 +10359,7 @@ (begin (if c_0 (hash-clear! c_0) (void)) (unsafe-set-box*! (unsafe-place-local-ref cell.2$3) #f)))))) -(define finish299 +(define finish300 (make-struct-type-install-properties '(entry) 4 @@ -10287,7 +10380,7 @@ #f 4 0)) -(define effect_2728 (finish299 struct:entry)) +(define effect_2728 (finish300 struct:entry)) (define entry1.1 (|#%name| entry @@ -10328,7 +10421,7 @@ (define SHIFTED-CACHE-SIZE 16) (define cell.2$3 (unsafe-make-place-local (box #f))) (define cell.3$1 (unsafe-make-place-local 0)) -(define finish301 +(define finish302 (make-struct-type-install-properties '(shifted-entry) 3 @@ -10349,7 +10442,7 @@ #f 3 0)) -(define effect_2358 (finish301 struct:shifted-entry)) +(define effect_2358 (finish302 struct:shifted-entry)) (define shifted-entry2.1 (|#%name| shifted-entry @@ -10538,7 +10631,7 @@ s_0)))))) (define cache-place-init! (lambda () (begin (resolve-cache-place-init!) (sets-place-init!)))) -(define finish303 +(define finish304 (make-struct-type-install-properties '(scope) 3 @@ -10548,13 +10641,18 @@ (cons prop:authentic #t) (cons prop:scope-with-bindings - (lambda (s_0 get-reachable-scopes_0 reach_0 register-trigger_0) + (lambda (s_0 + get-reachable-scopes_0 + extra-shifts_0 + reach_0 + register-trigger_0) (binding-table-register-reachable (scope-binding-table s_0) get-reachable-scopes_0 + extra-shifts_0 reach_0 register-trigger_0))) - (cons prop:reach-scopes (lambda (s_0 reach_0) (void))) + (cons prop:reach-scopes (lambda (s_0 extra-shifts_0 reach_0) (void))) (cons prop:serialize-fill! (lambda (s_0 ser-push!_0 state_0) @@ -10603,7 +10701,7 @@ #f 3 4)) -(define effect_2269 (finish303 struct:scope)) +(define effect_2269 (finish304 struct:scope)) (define scope1.1 (|#%name| scope @@ -10623,7 +10721,7 @@ (scope1.1 (new-deserialize-scope-id!) kind_0 empty-binding-table)))) (define deserialize-scope-fill! (lambda (s_0 bt_0) (set-scope-binding-table! s_0 bt_0))) -(define finish307 +(define finish308 (make-struct-type-install-properties '(interned-scope) 1 @@ -10666,7 +10764,7 @@ #f 1 0)) -(define effect_2498 (finish307 struct:interned-scope)) +(define effect_2498 (finish308 struct:interned-scope)) (define interned-scope2.1 (|#%name| interned-scope @@ -10676,7 +10774,7 @@ (|#%name| interned-scope? (record-predicate struct:interned-scope))) (define interned-scope-key (|#%name| interned-scope-key (record-accessor struct:interned-scope 0))) -(define finish311 +(define finish312 (make-struct-type-install-properties '(multi-scope) 5 @@ -10687,7 +10785,11 @@ (cons prop:authentic #t) (cons prop:scope-with-bindings - (lambda (ms_0 get-reachable-scopes_0 reach_0 register-trigger_0) + (lambda (ms_0 + get-reachable-scopes_0 + bulk-shifts_0 + reach_0 + register-trigger_0) (begin (let ((ht_0 (unbox (multi-scope-scopes ms_0)))) (begin @@ -10703,12 +10805,12 @@ (if (binding-table-empty? (scope-binding-table sc_0)) (void) - (|#%app| reach_0 sc_0)) + (|#%app| reach_0 sc_0 bulk-shifts_0)) (for-loop_0 (hash-iterate-next ht_0 i_0)))) (values))))))) (for-loop_0 (hash-iterate-first ht_0))))) (void)))) - (cons prop:reach-scopes (lambda (s_0 reach_0) (void))) + (cons prop:reach-scopes (lambda (s_0 extra-shifts_0 reach_0) (void))) (cons prop:serialize (lambda (ms_0 ser-push!_0 state_0) @@ -10800,7 +10902,7 @@ #f 5 0)) -(define effect_1895 (finish311 struct:multi-scope)) +(define effect_1895 (finish312 struct:multi-scope)) (define multi-scope3.1 (|#%name| multi-scope @@ -10824,7 +10926,7 @@ (let ((app_1 (box scopes_0))) (let ((app_2 (box (hasheqv)))) (multi-scope3.1 app_0 name_0 app_1 app_2 (box (hash)))))))) -(define finish318 +(define finish319 (make-struct-type-install-properties '(representative-scope) 2 @@ -10835,7 +10937,8 @@ (cons prop:implicitly-reachable #t) (cons prop:reach-scopes - (lambda (s_0 reach_0) (|#%app| reach_0 (representative-scope-owner s_0)))) + (lambda (s_0 bulk-shifts_0 reach_0) + (|#%app| reach_0 (representative-scope-owner s_0) bulk-shifts_0))) (cons prop:serialize-fill! (lambda (s_0 ser-push!_0 state_0) @@ -10882,7 +10985,7 @@ #f 2 3)) -(define effect_2683 (finish318 struct:representative-scope)) +(define effect_2683 (finish319 struct:representative-scope)) (define representative-scope4.1 (|#%name| representative-scope @@ -10923,7 +11026,7 @@ (begin (begin-unsafe (set-scope-binding-table! s_0 bt_0)) (set-representative-scope-owner! s_0 owner_0)))) -(define finish322 +(define finish323 (make-struct-type-install-properties '(shifted-multi-scope) 2 @@ -10934,8 +11037,11 @@ (cons prop:authentic #t) (cons prop:reach-scopes - (lambda (sms_0 reach_0) - (|#%app| reach_0 (shifted-multi-scope-multi-scope sms_0)))) + (lambda (sms_0 bulk-shifts_0 reach_0) + (|#%app| + reach_0 + (shifted-multi-scope-multi-scope sms_0) + bulk-shifts_0))) (cons prop:serialize (lambda (sms_0 ser-push!_0 state_0) @@ -10968,7 +11074,7 @@ #f 2 0)) -(define effect_2854 (finish322 struct:shifted-multi-scope)) +(define effect_2854 (finish323 struct:shifted-multi-scope)) (define shifted-multi-scope5.1 (|#%name| shifted-multi-scope @@ -11032,7 +11138,7 @@ (multi-scope-label-shifted multi-scope_0) phase_0 (lambda () (shifted-multi-scope5.1 phase_0 multi-scope_0))))))))) -(define finish325 +(define finish326 (make-struct-type-install-properties '(shifted-to-label-phase) 1 @@ -11053,7 +11159,7 @@ #f 1 1)) -(define effect_2315 (finish325 struct:shifted-to-label-phase)) +(define effect_2315 (finish326 struct:shifted-to-label-phase)) (define shifted-to-label-phase6.1 (|#%name| shifted-to-label-phase @@ -11896,7 +12002,7 @@ (gf_0 #f s_2))))))))))))) (loop_1 #f s_1 0))))))))) (loop_0 s_0))))))))) -(define finish400 +(define finish401 (make-struct-type-install-properties '(propagation) 7 @@ -11924,7 +12030,7 @@ #f 7 0)) -(define effect_2326 (finish400 struct:propagation)) +(define effect_2326 (finish401 struct:propagation)) (define propagation12.1 (|#%name| propagation @@ -13273,7 +13379,7 @@ (lambda (b_0) (let ((or-part_0 (full-local-binding? b_0))) (if or-part_0 or-part_0 (symbol? b_0))))) -(define finish472 +(define finish473 (make-struct-type-install-properties '(full-local-binding) 1 @@ -13302,7 +13408,7 @@ #f 1 0)) -(define effect_3011 (finish472 struct:full-local-binding)) +(define effect_3011 (finish473 struct:full-local-binding)) (define full-local-binding1.1 (|#%name| full-local-binding @@ -13408,7 +13514,7 @@ "given" id_0)) id_0))))))))))) -(define finish475 +(define finish476 (make-struct-type-install-properties '(rename-transformer) 1 @@ -13429,7 +13535,7 @@ #f 1 0)) -(define effect_2525 (finish475 struct:id-rename-transformer)) +(define effect_2525 (finish476 struct:id-rename-transformer)) (define id-rename-transformer1.1 (|#%name| id-rename-transformer @@ -13652,7 +13758,7 @@ unsafe-undefined b_0) (error "bad binding for free=id:" b_0))))) -(define finish494 +(define finish495 (make-struct-type-install-properties '(non-source-shift) 2 @@ -13673,7 +13779,7 @@ #f 2 3)) -(define effect_3061 (finish494 struct:non-source-shift)) +(define effect_3061 (finish495 struct:non-source-shift)) (define non-source-shift4.1 (|#%name| non-source-shift @@ -14200,7 +14306,7 @@ (syntax-props the-struct_0) (syntax-inspector the-struct_0))) (raise-argument-error 'struct-copy "syntax?" the-struct_0)))))))) -(define finish501 +(define finish502 (make-struct-type-install-properties '(provided) 3 @@ -14230,7 +14336,7 @@ #f 3 0)) -(define effect_2629 (finish501 struct:provided)) +(define effect_2629 (finish502 struct:provided)) (define provided1.1 (|#%name| provided @@ -14284,7 +14390,7 @@ unsafe-undefined unsafe-undefined binding_0)))))))))) -(define finish503 +(define finish504 (make-struct-type-install-properties '(bulk-binding) 8 @@ -14294,9 +14400,16 @@ (cons prop:authentic #t) (cons prop:serialize - (lambda (b_0 ser-push!_0 reachable-scopes_0) + (lambda (b_0 ser-push!_0 state_0) (begin - (|#%app| ser-push!_0 'tag kw2762) + (if (if (serialize-state-keep-provides? state_0) + (|#%app| (serialize-state-keep-provides? state_0) b_0) + #f) + (begin + (|#%app| ser-push!_0 'tag kw2882) + (|#%app| ser-push!_0 (bulk-binding-provides b_0)) + (|#%app| ser-push!_0 (bulk-binding-self b_0))) + (|#%app| ser-push!_0 'tag kw2762)) (|#%app| ser-push!_0 (bulk-binding-prefix b_0)) (|#%app| ser-push!_0 (bulk-binding-excepts b_0)) (|#%app| ser-push!_0 (bulk-binding-mpi b_0)) @@ -14311,10 +14424,11 @@ (if or-part_0 or-part_0 (let ((mod-name_0 - (1/module-path-index-resolve - (apply-syntax-shifts - (bulk-binding-mpi b_0) - mpi-shifts_0)))) + (begin-unsafe + (1/module-path-index-resolve + (apply-syntax-shifts + (bulk-binding-mpi b_0) + mpi-shifts_0))))) (begin (if (bulk-binding-bulk-binding-registry b_0) (void) @@ -14379,7 +14493,11 @@ temp29_1 temp27_1 binding_0 - temp26_1))))))))))) + temp26_1)))))))) + (lambda (b_0 mpi-shifts_0) + (begin-unsafe + (1/module-path-index-resolve + (apply-syntax-shifts (bulk-binding-mpi b_0) mpi-shifts_0))))))) (current-inspector) #f '(1 2 4 5 6 7) @@ -14394,7 +14512,7 @@ #f 8 9)) -(define effect_2834 (finish503 struct:bulk-binding)) +(define effect_2834 (finish504 struct:bulk-binding)) (define bulk-binding12.1 (|#%name| bulk-binding @@ -14442,6 +14560,24 @@ provide-phase-level_0 phase-shift_0 bulk-binding-registry_0))) +(define deserialize-bulk-binding+provides + (lambda (provides_0 + self_0 + prefix_0 + excepts_0 + mpi_0 + provide-phase-level_0 + phase-shift_0 + bulk-binding-registry_0) + (bulk-binding12.1 + provides_0 + prefix_0 + excepts_0 + self_0 + mpi_0 + provide-phase-level_0 + phase-shift_0 + bulk-binding-registry_0))) (define bulk-provides-add-prefix-remove-exceptions (lambda (provides_0 prefix_0 excepts_0) (begin @@ -14482,7 +14618,11 @@ (args (raise-binding-result-arity-error 2 args)))) table_0)))))) (for-loop_0 hash2725 (hash-iterate-first provides_0)))))) -(define finish507 +(define bulk-binding-module-name + (lambda (b_0 mpi-shifts_0) + (1/module-path-index-resolve + (apply-syntax-shifts (bulk-binding-mpi b_0) mpi-shifts_0)))) +(define finish512 (make-struct-type-install-properties '(bulk-provide) 2 @@ -14503,7 +14643,7 @@ #f 2 0)) -(define effect_2392 (finish507 struct:bulk-provide)) +(define effect_2392 (finish512 struct:bulk-provide)) (define bulk-provide13.1 (|#%name| bulk-provide @@ -14553,7 +14693,7 @@ s 'bulk-provide 'provides)))))) -(define finish512 +(define finish517 (make-struct-type-install-properties '(bulk-binding-registry) 1 @@ -14574,7 +14714,7 @@ #f 1 0)) -(define effect_2403 (finish512 struct:bulk-binding-registry)) +(define effect_2403 (finish517 struct:bulk-binding-registry)) (define bulk-binding-registry14.1 (|#%name| bulk-binding-registry @@ -14627,7 +14767,7 @@ #t #f))) (define generate-lift-key (lambda () (gensym 'lift))) -(define finish516 +(define finish521 (make-struct-type-install-properties '(root-expand-context) 4 @@ -14648,7 +14788,7 @@ #f 4 0)) -(define effect_2124 (finish516 struct:root-expand-context/outer)) +(define effect_2124 (finish521 struct:root-expand-context/outer)) (define root-expand-context/outer1.1 (|#%name| root-expand-context/outer @@ -14677,7 +14817,7 @@ (|#%name| root-expand-context-frame-id (record-accessor struct:root-expand-context/outer 3))) -(define finish518 +(define finish523 (make-struct-type-install-properties '(root-expand-context/inner) 7 @@ -14698,7 +14838,7 @@ #f 7 0)) -(define effect_2880 (finish518 struct:root-expand-context/inner)) +(define effect_2880 (finish523 struct:root-expand-context/inner)) (define root-expand-context/inner2.1 (|#%name| root-expand-context/inner @@ -15236,7 +15376,7 @@ (error "broken '#%linklet primitive table; maybe you need to use \"bootstrap-run.rkt\""))) (void))) -(define finish556 +(define finish561 (make-struct-type-install-properties '(module-registry) 2 @@ -15257,7 +15397,7 @@ #f 2 0)) -(define effect_2565 (finish556 struct:module-registry)) +(define effect_2565 (finish561 struct:module-registry)) (define module-registry1.1 (|#%name| module-registry @@ -15356,7 +15496,7 @@ (if or-part_0 or-part_0 never-evt)))) (loop_0)))))))))) (loop_0))))) -(define finish566 +(define finish571 (make-struct-type-install-properties '(namespace) 15 @@ -15402,7 +15542,7 @@ #f 15 4096)) -(define effect_3128 (finish566 struct:namespace)) +(define effect_3128 (finish571 struct:namespace)) (define namespace1.1 (|#%name| namespace @@ -15451,7 +15591,7 @@ (|#%name| namespace-module-instances (record-accessor struct:namespace 14))) (define set-namespace-inspector! (|#%name| set-namespace-inspector! (record-mutator struct:namespace 12))) -(define finish570 +(define finish575 (make-struct-type-install-properties '(definitions) 2 @@ -15472,7 +15612,7 @@ #f 2 0)) -(define effect_2319 (finish570 struct:definitions)) +(define effect_2319 (finish575 struct:definitions)) (define definitions2.1 (|#%name| definitions @@ -15982,7 +16122,7 @@ (for-loop_0 new-stx_2 rest_0)))) new-stx_1)))))) (for-loop_0 new-stx_0 old-stxes_0))))) -(define finish614 +(define finish619 (make-struct-type-install-properties '(syntax-binding-set) 1 @@ -16003,7 +16143,7 @@ #f 1 0)) -(define effect_2582 (finish614 struct:syntax-binding-set)) +(define effect_2582 (finish619 struct:syntax-binding-set)) (define syntax-binding-set1.1 (|#%name| syntax-binding-set @@ -16039,7 +16179,7 @@ s 'syntax-binding-set 'binds)))))) -(define finish618 +(define finish623 (make-struct-type-install-properties '(bind) 3 @@ -16060,7 +16200,7 @@ #f 3 0)) -(define effect_2584 (finish618 struct:bind)) +(define effect_2584 (finish623 struct:bind)) (define bind2.1 (|#%name| bind @@ -16511,7 +16651,7 @@ (define current-previously-unbound (lambda () #f)) (define set-current-previously-unbound! (lambda (proc_0) (set! current-previously-unbound proc_0))) -(define finish629 +(define finish634 (make-struct-type-install-properties '(module-use) 2 @@ -16568,7 +16708,7 @@ #f 2 0)) -(define effect_2097 (finish629 struct:module-use)) +(define effect_2097 (finish634 struct:module-use)) (define module-use1.1 (|#%name| module-use @@ -16616,7 +16756,7 @@ s 'module-use 'phase)))))) -(define finish637 +(define finish642 (make-struct-type-install-properties '(module) 20 @@ -16637,7 +16777,7 @@ #f 20 16)) -(define effect_2640 (finish637 struct:module)) +(define effect_2640 (finish642 struct:module)) (define module1.1 (|#%name| module @@ -16687,7 +16827,7 @@ (|#%name| module-get-all-variables (record-accessor struct:module 19))) (define set-module-access! (|#%name| set-module-access! (record-mutator struct:module 4))) -(define finish639 +(define finish644 (make-struct-type-install-properties '(module-linklet-info) 6 @@ -16708,7 +16848,7 @@ #f 6 0)) -(define effect_2508 (finish639 struct:module-linklet-info)) +(define effect_2508 (finish644 struct:module-linklet-info)) (define module-linklet-info2.1 (|#%name| module-linklet-info @@ -16800,7 +16940,7 @@ submodule-names18_0 supermodule-name19_0 get-all-variables_0))))))))) -(define finish642 +(define finish647 (make-struct-type-install-properties '(module-instance) 7 @@ -16821,7 +16961,7 @@ #f 7 52)) -(define effect_2382 (finish642 struct:module-instance)) +(define effect_2382 (finish647 struct:module-instance)) (define module-instance40.1 (|#%name| module-instance @@ -18364,7 +18504,7 @@ (lambda (s_0) (error "bad syntax:" s_0))))) (lambda (t_0) v_0)))))))) (define 1/make-set!-transformer - (let ((finish742 + (let ((finish747 (make-struct-type-install-properties '(set!-transformer) 1 @@ -18378,7 +18518,7 @@ 'set!-transformer))) (let ((struct:set!-transformer_0 (make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 0))) - (let ((effect743 (finish742 struct:set!-transformer_0))) + (let ((effect748 (finish747 struct:set!-transformer_0))) (let ((set!-transformer1_0 (|#%name| set!-transformer @@ -18451,7 +18591,7 @@ (lambda (t_0) (let ((or-part_0 (eq? t_0 variable))) (if or-part_0 or-part_0 (local-variable? t_0))))) -(define finish745 +(define finish750 (make-struct-type-install-properties '(local-variable) 1 @@ -18472,7 +18612,7 @@ #f 1 0)) -(define effect_2625 (finish745 struct:local-variable)) +(define effect_2625 (finish750 struct:local-variable)) (define local-variable1.1 (|#%name| local-variable @@ -18517,7 +18657,7 @@ (if (1/set!-transformer? t_0) (1/set!-transformer-procedure t_0) (if (1/rename-transformer? t_0) (lambda (s_0) s_0) t_0)))) -(define finish748 +(define finish753 (make-struct-type-install-properties '(core-form) 2 @@ -18538,7 +18678,7 @@ #f 2 0)) -(define effect_2077 (finish748 struct:core-form)) +(define effect_2077 (finish753 struct:core-form)) (define core-form7.1 (|#%name| core-form @@ -18813,7 +18953,7 @@ (for-loop_0 #f lst_0))))))) (define free-id-set-empty-or-just-module*? (lambda (fs_0) (let ((c_0 (hash-count fs_0))) (<= c_0 1)))) -(define finish760 +(define finish765 (make-struct-type-install-properties '(expand-context) 11 @@ -18834,7 +18974,7 @@ #f 11 0)) -(define effect_2851 (finish760 struct:expand-context/outer)) +(define effect_2851 (finish765 struct:expand-context/outer)) (define expand-context/outer1.1 (|#%name| expand-context/outer @@ -18886,7 +19026,7 @@ (|#%name| expand-context-name (record-accessor struct:expand-context/outer 10))) -(define finish762 +(define finish767 (make-struct-type-install-properties '(expand-context/inner) 22 @@ -18907,7 +19047,7 @@ #f 22 0)) -(define effect_3326 (finish762 struct:expand-context/inner)) +(define effect_3326 (finish767 struct:expand-context/inner)) (define expand-context/inner2.1 (|#%name| expand-context/inner @@ -21342,7 +21482,7 @@ fold-var_0)))))) (for-loop_0 null s_0))))) s_0)))) -(define finish922 +(define finish927 (make-struct-type-install-properties '(compile-context) 7 @@ -21363,7 +21503,7 @@ #f 7 0)) -(define effect_2620 (finish922 struct:compile-context)) +(define effect_2620 (finish927 struct:compile-context)) (define compile-context1.1 (|#%name| compile-context @@ -23838,7 +23978,7 @@ (lambda (i_0) (let ((len_0 (|#%app| read-fasl-integer i_0))) (read-bytes/exactly len_0 i_0)))) -(define finish1070 +(define finish1075 (make-struct-type-install-properties '(mpi-intern-table) 2 @@ -23859,7 +23999,7 @@ #f 2 0)) -(define effect_2611 (finish1070 struct:mpi-intern-table)) +(define effect_2611 (finish1075 struct:mpi-intern-table)) (define mpi-intern-table1.1 (|#%name| mpi-intern-table @@ -24094,7 +24234,7 @@ (define top-level-bind!-id (make-built-in-symbol! 'top-level-bind!)) (define top-level-require!-id (make-built-in-symbol! 'top-level-require!)) (define mpi-vector-id (make-built-in-symbol! 'mpi-vector)) -(define finish1079 +(define finish1084 (make-struct-type-install-properties '(module-path-index-table) 2 @@ -24115,7 +24255,7 @@ #f 2 0)) -(define effect_2626 (finish1079 struct:module-path-index-table)) +(define effect_2626 (finish1084 struct:module-path-index-table)) (define module-path-index-table1.1 (|#%name| module-path-index-table @@ -24201,306 +24341,316 @@ (let ((pos_0 (hash-count positions_0))) (begin (hash-set! positions_0 mpi_2 pos_0) pos_0))))))) (void))))) -(define generate-module-path-index-deserialize - (lambda (mpis_0) - (let ((unique-list_0 - (|#%name| - unique-list - (lambda (v_0) - (begin - (if (pair? v_0) - (reverse$1 +(define generate-module-path-index-deserialize.1 + (|#%name| + generate-module-path-index-deserialize + (lambda (as-data?2_0 mpis4_0) + (begin + (let ((unique-list_0 + (|#%name| + unique-list + (lambda (v_0) + (begin + (if (pair? v_0) + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((i_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 (cons i_0 fold-var_0))) + (let ((fold-var_2 (values fold-var_1))) + (for-loop_0 fold-var_2 rest_0))))) + fold-var_0)))))) + (for-loop_0 null v_0)))) + v_0)))))) + (let ((positions_0 (module-path-index-table-positions mpis4_0))) + (let ((gen-order_0 (make-hasheqv))) + (let ((rev-positions_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value positions_0 i_0)) + (case-lambda + ((k_0 v_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () (values v_0 k_0)) + (case-lambda + ((key_0 val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next positions_0 i_0)))) + (args + (raise-binding-result-arity-error 2 args)))) + table_0)))))) + (for-loop_0 + hash2589 + (hash-iterate-first positions_0)))))) + (begin + (let ((end_0 (hash-count rev-positions_0))) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (fold-var_0 lst_0) + (lambda (pos_0) (begin - (if (pair? lst_0) - (let ((i_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 (cons i_0 fold-var_0))) - (let ((fold-var_2 (values fold-var_1))) - (for-loop_0 fold-var_2 rest_0))))) - fold-var_0)))))) - (for-loop_0 null v_0)))) - v_0)))))) - (let ((positions_0 (module-path-index-table-positions mpis_0))) - (let ((gen-order_0 (make-hasheqv))) - (let ((rev-positions_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value positions_0 i_0)) - (case-lambda - ((k_0 v_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () (values v_0 k_0)) - (case-lambda - ((key_0 val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next positions_0 i_0)))) - (args - (raise-binding-result-arity-error 2 args)))) - table_0)))))) - (for-loop_0 - hash2589 - (hash-iterate-first positions_0)))))) - (begin - (let ((end_0 (hash-count rev-positions_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (< pos_0 end_0) - (begin - (let ((mpi_0 (hash-ref rev-positions_0 pos_0))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (mpi_1) - (begin - (if (hash-ref gen-order_0 mpi_1 #f) - (void) - (call-with-values - (lambda () - (1/module-path-index-split mpi_1)) - (case-lambda - ((name_0 base_0) - (begin - (if base_0 - (loop_0 base_0) - (void)) - (hash-set! - gen-order_0 - mpi_1 - (hash-count gen-order_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))) - (loop_0 mpi_0))) - (for-loop_0 (+ pos_0 1))) - (values))))))) - (for-loop_0 0)))) - (let ((rev-gen-order_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value gen-order_0 i_0)) - (case-lambda - ((k_0 v_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () (values v_0 k_0)) - (case-lambda - ((key_0 val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next gen-order_0 i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2589 - (hash-iterate-first gen-order_0)))))) - (let ((gens_0 - (let ((len_0 (hash-count gen-order_0))) - (begin - (if (exact-nonnegative-integer? len_0) - (void) - (raise-argument-error - 'for/vector - "exact-nonnegative-integer?" - len_0)) - (let ((v_0 (make-vector len_0 0))) - (begin - (if (zero? len_0) - (void) - (let ((end_0 (hash-count gen-order_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0 pos_0) - (begin - (if (< pos_0 end_0) - (let ((i_1 i_0)) - (let ((i_2 - (let ((i_2 - (begin - (let ((app_0 - i_1)) - (unsafe-vector*-set! - v_0 - app_0 - (let ((mpi_0 - (hash-ref - rev-gen-order_0 - pos_0))) - (call-with-values - (lambda () - (1/module-path-index-split - mpi_0)) - (case-lambda - ((path_0 - base_0) - (if (begin-unsafe - (eq? - top-level-module-path-index - mpi_0)) - 'top - (if (not - path_0) - (box - (let ((or-part_0 - (unique-list_0 - (1/resolved-module-path-name - (module-path-index-resolved - mpi_0))))) - (if or-part_0 - or-part_0 - 'self))) - (if (not - base_0) - (vector - path_0) - (if base_0 - (vector - path_0 - (hash-ref - gen-order_0 - base_0)) - (void)))))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (unsafe-fx+ - 1 - i_1)))) - (values i_2)))) - (if (if (not - (let ((x_0 - (list - pos_0))) - (unsafe-fx= - i_2 - len_0))) - #t - #f) - (for-loop_0 - i_2 - (+ pos_0 1)) - i_2))) - i_0)))))) - (for-loop_0 0 0))))) - v_0)))))) - (let ((app_0 (list 'quote gens_0))) - (list - 'deserialize-module-path-indexes - app_0 - (list - 'quote - (call-with-values - (lambda () - (let ((end_0 (hash-count rev-positions_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (vec_0 i_0 pos_0) - (begin - (if (< pos_0 end_0) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((new-vec_0 - (if (eq? - i_0 - (unsafe-vector*-length - vec_0)) - (grow-vector vec_0) - vec_0))) - (begin - (unsafe-vector*-set! - new-vec_0 - i_0 - (hash-ref + (if (< pos_0 end_0) + (begin + (let ((mpi_0 + (hash-ref rev-positions_0 pos_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (mpi_1) + (begin + (if (hash-ref gen-order_0 mpi_1 #f) + (void) + (call-with-values + (lambda () + (1/module-path-index-split + mpi_1)) + (case-lambda + ((name_0 base_0) + (begin + (if base_0 + (loop_0 base_0) + (void)) + (hash-set! gen-order_0 - (hash-ref - rev-positions_0 - pos_0))) - (values - new-vec_0 - (unsafe-fx+ i_0 1))))) - (case-lambda - ((vec_1 i_1) (values vec_1 i_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((vec_1 i_1) - (for-loop_0 vec_1 i_1 (+ pos_0 1))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values vec_0 i_0))))))) - (for-loop_0 (make-vector 16) 0 0))))) - (case-lambda - ((vec_0 i_0) (shrink-vector vec_0 i_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))))))))))))) + mpi_1 + (hash-count gen-order_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))))))) + (loop_0 mpi_0))) + (for-loop_0 (+ pos_0 1))) + (values))))))) + (for-loop_0 0)))) + (let ((rev-gen-order_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + gen-order_0 + i_0)) + (case-lambda + ((k_0 v_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values v_0 k_0)) + (case-lambda + ((key_0 val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + gen-order_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2589 + (hash-iterate-first gen-order_0)))))) + (let ((gens_0 + (let ((len_0 (hash-count gen-order_0))) + (begin + (if (exact-nonnegative-integer? len_0) + (void) + (raise-argument-error + 'for/vector + "exact-nonnegative-integer?" + len_0)) + (let ((v_0 (make-vector len_0 0))) + (begin + (if (zero? len_0) + (void) + (let ((end_0 (hash-count gen-order_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0 pos_0) + (begin + (if (< pos_0 end_0) + (let ((i_1 + (let ((i_1 + (begin + (unsafe-vector*-set! + v_0 + i_0 + (let ((mpi_0 + (hash-ref + rev-gen-order_0 + pos_0))) + (call-with-values + (lambda () + (1/module-path-index-split + mpi_0)) + (case-lambda + ((path_0 + base_0) + (if (begin-unsafe + (eq? + top-level-module-path-index + mpi_0)) + 'top + (if (not + path_0) + (box + (let ((or-part_0 + (unique-list_0 + (1/resolved-module-path-name + (module-path-index-resolved + mpi_0))))) + (if or-part_0 + or-part_0 + 'self))) + (if (not + base_0) + (vector + path_0) + (if base_0 + (vector + path_0 + (hash-ref + gen-order_0 + base_0)) + (void)))))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (unsafe-fx+ + 1 + i_0)))) + (values i_1)))) + (if (if (not + (let ((x_0 + (list + pos_0))) + (unsafe-fx= + i_1 + len_0))) + #t + #f) + (for-loop_0 + i_1 + (+ pos_0 1)) + i_1)) + i_0)))))) + (for-loop_0 0 0))))) + v_0)))))) + (let ((reorder-vec_0 + (call-with-values + (lambda () + (let ((end_0 (hash-count rev-positions_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (vec_0 i_0 pos_0) + (begin + (if (< pos_0 end_0) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((new-vec_0 + (if (eq? + i_0 + (unsafe-vector*-length + vec_0)) + (grow-vector vec_0) + vec_0))) + (begin + (unsafe-vector*-set! + new-vec_0 + i_0 + (hash-ref + gen-order_0 + (hash-ref + rev-positions_0 + pos_0))) + (values + new-vec_0 + (unsafe-fx+ i_0 1))))) + (case-lambda + ((vec_1 i_1) + (values vec_1 i_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((vec_1 i_1) + (for-loop_0 + vec_1 + i_1 + (+ pos_0 1))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values vec_0 i_0))))))) + (for-loop_0 (make-vector 16) 0 0))))) + (case-lambda + ((vec_0 i_0) (shrink-vector vec_0 i_0)) + (args + (raise-binding-result-arity-error 2 args)))))) + (if as-data?2_0 + (vector gens_0 reorder-vec_0) + (list + 'deserialize-module-path-indexes + (list 'quote gens_0) + (list 'quote reorder-vec_0))))))))))))))) (define deserialize-module-path-indexes (lambda (gen-vec_0 order-vec_0) (let ((gen_0 (make-vector (vector-length gen-vec_0) #f))) @@ -24608,6 +24758,14 @@ (for-loop_0 0 0)))) (args (raise-binding-result-arity-error 2 args))))) v_0)))))))) +(define deserialize-module-path-index-data + (lambda (v_0) + (begin + (if (if (vector? v_0) (= 2 (vector-length v_0)) #f) + (void) + (error 'syntax-deserialize "ill-formed serialization")) + (let ((app_0 (vector-ref v_0 0))) + (deserialize-module-path-indexes app_0 (vector-ref v_0 1)))))) (define mpis-as-vector (lambda (mpis_0) (let ((positions_0 (module-path-index-table-positions mpis_0))) @@ -24651,7 +24809,7 @@ (list 'define-values app_3 - (generate-module-path-index-deserialize mpis_0))))))))) + (generate-module-path-index-deserialize.1 #f mpis_0))))))))) (define generate-module-declaration-linklet (lambda (mpis_0 self_0 @@ -24668,12 +24826,24 @@ (list 'define-values '(requires) - (generate-deserialize.1 #f requires_0 mpis_0)))) + (generate-deserialize.1 + #f + #f + mpis_0 + hash2610 + #f + requires_0)))) (let ((app_3 (list 'define-values '(provides) - (generate-deserialize.1 #f provides_0 mpis_0)))) + (generate-deserialize.1 + #f + #f + mpis_0 + hash2610 + #f + provides_0)))) (list 'linklet app_0 @@ -24736,8 +24906,8 @@ (define serialize-phase-to-link-module-uses (lambda (phase-to-link-module-uses_0 mpis_0) (let ((phases-in-order_0 - (let ((temp14_0 (hash-keys phase-to-link-module-uses_0))) - (sort.1 #f #f temp14_0 <)))) + (let ((temp26_0 (hash-keys phase-to-link-module-uses_0))) + (sort.1 #f #f temp26_0 <)))) (list* 'hasheqv (apply @@ -24773,130 +24943,106 @@ (define generate-deserialize.1 (|#%name| generate-deserialize - (lambda (syntax-support?2_0 v4_0 mpis5_0) + (lambda (as-data?7_0 + keep-provides?10_0 + mpis6_0 + preserve-prop-keys9_0 + syntax-support?8_0 + v16_0) (begin - (let ((reachable-scopes_0 (find-reachable-scopes v4_0))) - (let ((state_0 (make-serialize-state reachable-scopes_0))) - (let ((mutables_0 (make-hasheq))) - (let ((objs_0 (make-hasheq))) - (let ((shares_0 (make-hasheq))) - (let ((obj-step_0 0)) - (let ((frontier_0 null)) - (letrec* - ((add-frontier!_0 - (|#%name| - add-frontier! - (case-lambda - ((v_0) - (begin (set! frontier_0 (cons v_0 frontier_0)))) - ((kind_0 v_0) (add-frontier!_0 v_0)))))) - (begin - (letrec* - ((frontier-loop_0 - (|#%name| - frontier-loop - (lambda (v_0) - (begin + (let ((bulk-shifts_0 (if keep-provides?10_0 (list (make-hasheq)) #f))) + (let ((reachable-scopes_0 + (find-reachable-scopes v16_0 bulk-shifts_0))) + (let ((state_0 + (make-serialize-state + reachable-scopes_0 + preserve-prop-keys9_0 + (if keep-provides?10_0 + (lambda (b_0) + (let ((name_0 (hash-ref (car bulk-shifts_0) b_0 #f))) + (let ((or-part_0 (not name_0))) + (if or-part_0 + or-part_0 + (|#%app| keep-provides?10_0 name_0))))) + #f)))) + (let ((mutables_0 (make-hasheq))) + (let ((objs_0 (make-hasheq))) + (let ((shares_0 (make-hasheq))) + (let ((obj-step_0 0)) + (let ((frontier_0 null)) + (letrec* + ((add-frontier!_0 + (|#%name| + add-frontier! + (case-lambda + ((v_0) + (begin (set! frontier_0 (cons v_0 frontier_0)))) + ((kind_0 v_0) (add-frontier!_0 v_0)))))) + (begin + (letrec* + ((frontier-loop_0 + (|#%name| + frontier-loop + (lambda (v_0) (begin - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (v_1) - (begin - (if (let ((or-part_0 - (interned-literal? v_1))) - (if or-part_0 - or-part_0 - (1/module-path-index? v_1))) - (void) - (if (hash-ref objs_0 v_1 #f) - (if (hash-ref mutables_0 v_1 #f) - (void) - (hash-set! shares_0 v_1 #t)) - (begin - (if (serialize-fill!? v_1) - (begin - (hash-set! + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_1) + (begin + (if (let ((or-part_0 + (interned-literal? + v_1))) + (if or-part_0 + or-part_0 + (1/module-path-index? + v_1))) + (void) + (if (hash-ref objs_0 v_1 #f) + (if (hash-ref mutables_0 v_1 - (hash-count mutables_0)) - (|#%app| - (serialize-fill!-ref v_1) - v_1 - add-frontier!_0 - state_0)) - (if (serialize? v_1) - (|#%app| - (serialize-ref v_1) - v_1 - (case-lambda - ((sub-v_0) - (loop_0 sub-v_0)) - ((kind_0 sub-v_0) - (loop_0 sub-v_0))) - state_0) - (if (pair? v_1) - (begin - (loop_0 (car v_1)) - (loop_0 (cdr v_1))) - (if (vector? v_1) - (if (let ((or-part_0 - (immutable? - v_1))) - (if or-part_0 - or-part_0 - (zero? - (vector-length - v_1)))) - (begin - (call-with-values - (lambda () - (begin - (check-vector - v_1) - (values - v_1 - (unsafe-vector-length - v_1)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (loop_0 - e_0) - (for-loop_0 - (unsafe-fx+ - 1 - pos_0)))) - (values))))))) - (for-loop_0 - 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (void)) - (begin - (hash-set! - mutables_0 - v_1 - (hash-count - mutables_0)) + #f) + (void) + (hash-set! shares_0 v_1 #t)) + (begin + (if (serialize-fill!? v_1) + (begin + (hash-set! + mutables_0 + v_1 + (hash-count mutables_0)) + (|#%app| + (serialize-fill!-ref + v_1) + v_1 + add-frontier!_0 + state_0)) + (if (serialize? v_1) + (|#%app| + (serialize-ref v_1) + v_1 + (case-lambda + ((sub-v_0) + (loop_0 sub-v_0)) + ((kind_0 sub-v_0) + (loop_0 sub-v_0))) + state_0) + (if (pair? v_1) + (begin + (loop_0 (car v_1)) + (loop_0 (cdr v_1))) + (if (vector? v_1) + (if (let ((or-part_0 + (immutable? + v_1))) + (if or-part_0 + or-part_0 + (zero? + (vector-length + v_1)))) (begin (call-with-values (lambda () @@ -24925,7 +25071,7 @@ vec_0 pos_0))) (begin - (add-frontier!_0 + (loop_0 e_0) (for-loop_0 (unsafe-fx+ @@ -24938,61 +25084,72 @@ (raise-binding-result-arity-error 2 args)))) - (void)))) - (if (box? v_1) - (if (immutable? v_1) - (loop_0 - (unbox v_1)) + (void)) (begin (hash-set! mutables_0 v_1 (hash-count mutables_0)) - (add-frontier!_0 - (unbox v_1)))) - (if (hash? v_1) + (begin + (call-with-values + (lambda () + (begin + (check-vector + v_1) + (values + v_1 + (unsafe-vector-length + v_1)))) + (case-lambda + ((vec_0 + len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (add-frontier!_0 + e_0) + (for-loop_0 + (unsafe-fx+ + 1 + pos_0)))) + (values))))))) + (for-loop_0 + 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (void)))) + (if (box? v_1) (if (immutable? v_1) - (begin - (let ((lst_0 - (sorted-hash-keys - v_1))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? - lst_1) - (let ((k_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (begin - (begin - (loop_0 - k_0) - (loop_0 - (hash-ref - v_1 - k_0))) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 - lst_0)))) - (void)) + (loop_0 + (unbox v_1)) (begin (hash-set! mutables_0 v_1 (hash-count mutables_0)) + (add-frontier!_0 + (unbox v_1)))) + (if (hash? v_1) + (if (immutable? + v_1) (begin (let ((lst_0 (sorted-hash-keys @@ -25014,9 +25171,9 @@ lst_1))) (begin (begin - (add-frontier!_0 + (loop_0 k_0) - (add-frontier!_0 + (loop_0 (hash-ref v_1 k_0))) @@ -25025,433 +25182,420 @@ (values))))))) (for-loop_0 lst_0)))) - (void)))) - (if (prefab-struct-key - v_1) - (begin - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - (struct->vector - v_1) - 1 - #f - 1)) - (case-lambda - ((v*_0 - start*_0 - stop*_0 - step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (begin - (loop_0 - e_0) - (for-loop_0 - (unsafe-fx+ - idx_0 - 1)))) - (values))))))) - (for-loop_0 - start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (void)) - (if (srcloc? v_1) - (if (path? - (srcloc-source - v_1)) - (void) + (void)) + (begin + (hash-set! + mutables_0 + v_1 + (hash-count + mutables_0)) (begin - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - (struct->vector - v_1) - 1 - #f - 1)) - (case-lambda - ((v*_0 - start*_0 - stop*_0 - step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (begin - (loop_0 - e_0) - (for-loop_0 - (unsafe-fx+ - idx_0 - 1)))) - (values))))))) - (for-loop_0 - start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (void))) - (void))))))))) - (hash-set! - objs_0 - v_1 - obj-step_0) - (set! obj-step_0 - (add1 obj-step_0)))))))))) - (loop_0 v_0)) - (if (null? frontier_0) - (void) - (let ((l_0 frontier_0)) - (begin - (set! frontier_0 null) + (let ((lst_0 + (sorted-hash-keys + v_1))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? + lst_1) + (let ((k_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (begin + (begin + (add-frontier!_0 + k_0) + (add-frontier!_0 + (hash-ref + v_1 + k_0))) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + lst_0)))) + (void)))) + (if (prefab-struct-key + v_1) + (begin + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + (struct->vector + v_1) + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + idx_0 + 1)))) + (values))))))) + (for-loop_0 + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (void)) + (if (srcloc? + v_1) + (if (path? + (srcloc-source + v_1)) + (void) + (begin + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + (struct->vector + v_1) + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + idx_0 + 1)))) + (values))))))) + (for-loop_0 + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (void))) + (void))))))))) + (hash-set! + objs_0 + v_1 + obj-step_0) + (set! obj-step_0 + (add1 obj-step_0)))))))))) + (loop_0 v_0)) + (if (null? frontier_0) + (void) + (let ((l_0 frontier_0)) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((v_1 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr + (set! frontier_0 null) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((v_1 + (unsafe-car lst_0))) - (begin - (frontier-loop_0 v_1) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 l_0))) - (void)))))))))) - (frontier-loop_0 v4_0)) - (let ((num-mutables_0 (hash-count mutables_0))) - (let ((share-step-positions_0 - (let ((share-steps_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 i_0) - (begin - (if i_0 - (let ((obj_0 - (hash-iterate-key + (let ((rest_0 + (unsafe-cdr + lst_0))) + (begin + (frontier-loop_0 + v_1) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 l_0))) + (void)))))))))) + (frontier-loop_0 v16_0)) + (let ((num-mutables_0 (hash-count mutables_0))) + (let ((share-step-positions_0 + (let ((share-steps_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 i_0) + (begin + (if i_0 + (let ((obj_0 + (hash-iterate-key + shares_0 + i_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (hash-ref + objs_0 + obj_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + (hash-iterate-next shares_0 - i_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (hash-ref - objs_0 - obj_0) - fold-var_0))) + i_0)))) + fold-var_0)))))) + (for-loop_0 + null + (hash-iterate-first + shares_0))))))) + (let ((lst_0 + (sort.1 #f #f share-steps_0 <))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 lst_1 pos_0) + (begin + (if (if (pair? lst_1) #t #f) + (let ((step_0 + (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + step_0 + pos_0)) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) (values - fold-var_1)))) + table_1)))) (for-loop_0 - fold-var_1 - (hash-iterate-next - shares_0 - i_0)))) - fold-var_0)))))) - (for-loop_0 - null - (hash-iterate-first - shares_0))))))) - (let ((lst_0 - (sort.1 #f #f share-steps_0 <))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 lst_1 pos_0) - (begin - (if (if (pair? lst_1) #t #f) - (let ((step_0 - (unsafe-car lst_1))) - (let ((rest_0 - (unsafe-cdr lst_1))) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - step_0 - pos_0)) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - rest_0 - (+ pos_0 1))))) - table_0)))))) - (for-loop_0 - hash2589 - lst_0 - num-mutables_0))))))) - (let ((stream_0 null)) - (let ((stream-size_0 0)) - (let ((next-push-position_0 - (|#%name| - next-push-position - (lambda () (begin stream-size_0))))) - (let ((quoted?_0 + table_1 + rest_0 + (+ pos_0 1))))) + table_0)))))) + (for-loop_0 + hash2589 + lst_0 + num-mutables_0))))))) + (let ((stream_0 null)) + (let ((stream-size_0 0)) + (let ((next-push-position_0 (|#%name| - quoted? - (lambda (pos_0) - (begin - (let ((v_0 - (let ((app_0 stream_0)) - (list-ref - app_0 - (let ((app_1 - stream-size_0)) - (- - app_1 - (add1 pos_0))))))) - (let ((or-part_0 - (not (keyword? v_0)))) - (if or-part_0 - or-part_0 - (eq? - kw2626 - v_0))))))))) - (let ((ser-reset!_0 + next-push-position + (lambda () (begin stream-size_0))))) + (let ((quoted?_0 (|#%name| - ser-reset! + quoted? (lambda (pos_0) (begin - (begin - (set! stream_0 - (let ((app_0 stream_0)) - (list-tail - app_0 - (- - stream-size_0 - pos_0)))) - (set! stream-size_0 - pos_0))))))) - (let ((reap-stream!_0 + (let ((v_0 + (let ((app_0 stream_0)) + (list-ref + app_0 + (let ((app_1 + stream-size_0)) + (- + app_1 + (add1 pos_0))))))) + (let ((or-part_0 + (not (keyword? v_0)))) + (if or-part_0 + or-part_0 + (eq? + kw2626 + v_0))))))))) + (let ((ser-reset!_0 (|#%name| - reap-stream! - (lambda () + ser-reset! + (lambda (pos_0) (begin - (begin0 - (list->vector - (reverse$1 stream_0)) - (set! stream_0 null) + (begin + (set! stream_0 + (let ((app_0 stream_0)) + (list-tail + app_0 + (- + stream-size_0 + pos_0)))) (set! stream-size_0 - 0))))))) - (letrec* - ((ser-push!_0 - (|#%name| - ser-push! - (case-lambda - ((v_0) - (begin - (if (hash-ref shares_0 v_0 #f) - (let ((n_0 - (hash-ref - share-step-positions_0 - (hash-ref - objs_0 - v_0)))) - (begin - (ser-push!_0 - 'tag - kw2603) - (ser-push!_0 - 'exact - n_0))) - (let ((c1_0 - (hash-ref - mutables_0 - v_0 - #f))) - (if c1_0 + pos_0))))))) + (let ((reap-stream!_0 + (|#%name| + reap-stream! + (lambda () + (begin + (begin0 + (list->vector + (reverse$1 stream_0)) + (set! stream_0 null) + (set! stream-size_0 + 0))))))) + (letrec* + ((ser-push!_0 + (|#%name| + ser-push! + (case-lambda + ((v_0) + (begin + (if (hash-ref + shares_0 + v_0 + #f) + (let ((n_0 + (hash-ref + share-step-positions_0 + (hash-ref + objs_0 + v_0)))) (begin (ser-push!_0 'tag kw2603) (ser-push!_0 'exact - c1_0)) - (ser-push-encoded!_0 - v_0)))))) - ((kind_0 v_0) - (if (eq? kind_0 'exact) - (begin - (set! stream_0 - (cons v_0 stream_0)) - (set! stream-size_0 - (add1 stream-size_0))) - (if (eq? kind_0 'tag) - (ser-push!_0 'exact v_0) - (if (eq? kind_0 'reference) - (if (hash-ref - shares_0 - v_0 - #f) - (let ((n_0 - (hash-ref - share-step-positions_0 - (hash-ref - objs_0 - v_0)))) - (ser-push!_0 - 'exact - n_0)) - (let ((c2_0 - (hash-ref - mutables_0 - v_0 - #f))) - (if c2_0 + n_0))) + (let ((c1_0 + (hash-ref + mutables_0 + v_0 + #f))) + (if c1_0 + (begin + (ser-push!_0 + 'tag + kw2603) (ser-push!_0 'exact - c2_0) - (ser-push!_0 v_0)))) - (ser-push!_0 v_0)))))))) - (ser-push-encoded!_0 - (|#%name| - ser-push-encoded! - (lambda (v_0) - (begin - (if (keyword? v_0) + c1_0)) + (ser-push-encoded!_0 + v_0)))))) + ((kind_0 v_0) + (if (eq? kind_0 'exact) (begin - (ser-push!_0 - 'tag - kw2626) - (ser-push!_0 'exact v_0)) - (if (1/module-path-index? - v_0) + (set! stream_0 + (cons v_0 stream_0)) + (set! stream-size_0 + (add1 stream-size_0))) + (if (eq? kind_0 'tag) + (ser-push!_0 'exact v_0) + (if (eq? kind_0 'reference) + (if (hash-ref + shares_0 + v_0 + #f) + (let ((n_0 + (hash-ref + share-step-positions_0 + (hash-ref + objs_0 + v_0)))) + (ser-push!_0 + 'exact + n_0)) + (let ((c2_0 + (hash-ref + mutables_0 + v_0 + #f))) + (if c2_0 + (ser-push!_0 + 'exact + c2_0) + (ser-push!_0 + v_0)))) + (ser-push!_0 v_0)))))))) + (ser-push-encoded!_0 + (|#%name| + ser-push-encoded! + (lambda (v_0) + (begin + (if (keyword? v_0) (begin (ser-push!_0 'tag - kw3163) - (ser-push!_0 - 'exact - (add-module-path-index!/pos - mpis5_0 - v_0))) - (if (serialize? v_0) - (|#%app| - (serialize-ref v_0) - v_0 - ser-push!_0 - state_0) - (if (if (list? v_0) - (if (pair? v_0) - (pair? (cdr v_0)) + kw2626) + (ser-push!_0 'exact v_0)) + (if (1/module-path-index? + v_0) + (begin + (ser-push!_0 + 'tag + kw3163) + (ser-push!_0 + 'exact + (add-module-path-index!/pos + mpis6_0 + v_0))) + (if (serialize? v_0) + (|#%app| + (serialize-ref v_0) + v_0 + ser-push!_0 + state_0) + (if (if (list? v_0) + (if (pair? v_0) + (pair? + (cdr v_0)) + #f) #f) - #f) - (let ((start-pos_0 - (begin-unsafe - (begin - stream-size_0)))) - (begin - (ser-push!_0 - 'tag - kw2802) - (begin - (ser-push!_0 - 'exact - (length v_0)) - (let ((all-quoted?_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (all-quoted?_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((i_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((all-quoted?_1 - (let ((all-quoted?_1 - (let ((i-pos_0 - (begin-unsafe - (begin - stream-size_0)))) - (begin - (ser-push!_0 - i_0) - (if all-quoted?_0 - (quoted?_0 - i-pos_0) - #f))))) - (values - all-quoted?_1)))) - (for-loop_0 - all-quoted?_1 - rest_0)))) - all-quoted?_0)))))) - (for-loop_0 - #t - v_0))))) - (if all-quoted?_0 - (begin - (ser-reset!_0 - start-pos_0) - (ser-push-optional-quote!_0) - (ser-push!_0 - 'exact - v_0)) - (void)))))) - (if (pair? v_0) (let ((start-pos_0 (begin-unsafe (begin @@ -25459,36 +25603,60 @@ (begin (ser-push!_0 'tag - kw2821) - (let ((a-pos_0 - (begin-unsafe - (begin - stream-size_0)))) - (begin - (ser-push!_0 - (car v_0)) - (let ((d-pos_0 - (begin-unsafe - (begin - stream-size_0)))) + kw2802) + (begin + (ser-push!_0 + 'exact + (length v_0)) + (let ((all-quoted?_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (all-quoted?_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((i_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((all-quoted?_1 + (let ((all-quoted?_1 + (let ((i-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + i_0) + (if all-quoted?_0 + (quoted?_0 + i-pos_0) + #f))))) + (values + all-quoted?_1)))) + (for-loop_0 + all-quoted?_1 + rest_0)))) + all-quoted?_0)))))) + (for-loop_0 + #t + v_0))))) + (if all-quoted?_0 (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) (ser-push!_0 - (cdr - v_0)) - (if (if (quoted?_0 - a-pos_0) - (quoted?_0 - d-pos_0) - #f) - (begin - (ser-reset!_0 - start-pos_0) - (ser-push-optional-quote!_0) - (ser-push!_0 - 'exact - v_0)) - (void)))))))) - (if (box? v_0) + 'exact + v_0)) + (void)))))) + (if (pair? v_0) (let ((start-pos_0 (begin-unsafe (begin @@ -25496,26 +25664,36 @@ (begin (ser-push!_0 'tag - kw2525) - (let ((v-pos_0 + kw2821) + (let ((a-pos_0 (begin-unsafe (begin stream-size_0)))) (begin (ser-push!_0 - (unbox - v_0)) - (if (quoted?_0 - v-pos_0) + (car v_0)) + (let ((d-pos_0 + (begin-unsafe + (begin + stream-size_0)))) (begin - (ser-reset!_0 - start-pos_0) - (ser-push-optional-quote!_0) (ser-push!_0 - 'exact - v_0)) - (void)))))) - (if (vector? v_0) + (cdr + v_0)) + (if (if (quoted?_0 + a-pos_0) + (quoted?_0 + d-pos_0) + #f) + (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0)) + (void)))))))) + (if (box? v_0) (let ((start-pos_0 (begin-unsafe (begin @@ -25523,70 +25701,17 @@ (begin (ser-push!_0 'tag - kw2967) - (begin - (ser-push!_0 - 'exact - (vector-length - v_0)) - (let ((all-quoted?_0 - (call-with-values - (lambda () - (begin - (check-vector - v_0) - (values - v_0 - (unsafe-vector-length - v_0)))) - (case-lambda - ((vec_0 - len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (all-quoted?_0 - pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_0) - (let ((i_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (let ((all-quoted?_1 - (let ((all-quoted?_1 - (let ((i-pos_0 - (begin-unsafe - (begin - stream-size_0)))) - (begin - (ser-push!_0 - i_0) - (if all-quoted?_0 - (quoted?_0 - i-pos_0) - #f))))) - (values - all-quoted?_1)))) - (for-loop_0 - all-quoted?_1 - (unsafe-fx+ - 1 - pos_0)))) - all-quoted?_0)))))) - (for-loop_0 - #t - 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (if all-quoted?_0 + kw2525) + (let ((v-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + (unbox + v_0)) + (if (quoted?_0 + v-pos_0) (begin (ser-reset!_0 start-pos_0) @@ -25595,592 +25720,645 @@ 'exact v_0)) (void)))))) - (if (hash? v_0) + (if (vector? v_0) (let ((start-pos_0 (begin-unsafe (begin stream-size_0)))) - (let ((as-set?_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - i_0) - (begin - (if i_0 - (let ((val_0 - (hash-iterate-value - v_0 - i_0))) - (let ((result_1 - (eq? - val_0 - #t))) - (let ((result_2 - (values - result_1))) - (if (if (not - (let ((x_0 - (list - val_0))) - (not - result_2))) - #t - #f) - (for-loop_0 - result_2 - (hash-iterate-next - v_0 - i_0)) - result_2)))) - result_0)))))) - (for-loop_0 - #t - (hash-iterate-first - v_0)))))) + (begin + (ser-push!_0 + 'tag + kw2967) (begin (ser-push!_0 - 'tag - (if as-set?_0 - (if (hash-eq? - v_0) - kw3357 - (if (hash-eqv? - v_0) - kw2333 - kw2473)) - (if (hash-eq? - v_0) - kw2796 - (if (hash-eqv? - v_0) - kw3245 - kw2582)))) - (begin - (ser-push!_0 - 'exact - (hash-count - v_0)) - (let ((ks_0 - (sorted-hash-keys - v_0))) - (let ((all-quoted?_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (all-quoted?_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((k_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((all-quoted?_1 - (let ((all-quoted?_1 - (let ((k-pos_0 - (begin-unsafe - (begin - stream-size_0)))) - (begin - (ser-push!_0 - k_0) - (let ((v-pos_0 - (begin-unsafe - (begin - stream-size_0)))) - (begin - (if as-set?_0 - (void) - (ser-push!_0 - (hash-ref - v_0 - k_0))) - (if all-quoted?_0 - (if (quoted?_0 - k-pos_0) - (if as-set?_0 - as-set?_0 - (quoted?_0 - v-pos_0)) - #f) - #f))))))) - (values - all-quoted?_1)))) - (for-loop_0 - all-quoted?_1 - rest_0)))) - all-quoted?_0)))))) - (for-loop_0 - #t - ks_0))))) - (if all-quoted?_0 - (begin - (ser-reset!_0 - start-pos_0) - (ser-push-optional-quote!_0) - (ser-push!_0 - 'exact - v_0)) - (void)))))))) - (let ((c3_0 - (prefab-struct-key - v_0))) - (if c3_0 - (let ((vec_0 - (struct->vector - v_0))) - (let ((start-pos_0 - (begin-unsafe - (begin - stream-size_0)))) - (begin - (ser-push!_0 - 'tag - kw2931) + 'exact + (vector-length + v_0)) + (let ((all-quoted?_0 + (call-with-values + (lambda () + (begin + (check-vector + v_0) + (values + v_0 + (unsafe-vector-length + v_0)))) + (case-lambda + ((vec_0 + len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (all-quoted?_0 + pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((i_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (let ((all-quoted?_1 + (let ((all-quoted?_1 + (let ((i-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + i_0) + (if all-quoted?_0 + (quoted?_0 + i-pos_0) + #f))))) + (values + all-quoted?_1)))) + (for-loop_0 + all-quoted?_1 + (unsafe-fx+ + 1 + pos_0)))) + all-quoted?_0)))))) + (for-loop_0 + #t + 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (if all-quoted?_0 (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) (ser-push!_0 'exact - c3_0) + v_0)) + (void)))))) + (if (hash? v_0) + (let ((start-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (let ((as-set?_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + i_0) + (begin + (if i_0 + (let ((val_0 + (hash-iterate-value + v_0 + i_0))) + (let ((result_1 + (eq? + val_0 + #t))) + (let ((result_2 + (values + result_1))) + (if (if (not + (let ((x_0 + (list + val_0))) + (not + result_2))) + #t + #f) + (for-loop_0 + result_2 + (hash-iterate-next + v_0 + i_0)) + result_2)))) + result_0)))))) + (for-loop_0 + #t + (hash-iterate-first + v_0)))))) + (begin + (ser-push!_0 + 'tag + (if as-set?_0 + (if (hash-eq? + v_0) + kw3357 + (if (hash-eqv? + v_0) + kw2333 + kw2473)) + (if (hash-eq? + v_0) + kw2796 + (if (hash-eqv? + v_0) + kw3245 + kw2582)))) + (begin + (ser-push!_0 + 'exact + (hash-count + v_0)) + (let ((ks_0 + (sorted-hash-keys + v_0))) + (let ((all-quoted?_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (all-quoted?_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((k_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((all-quoted?_1 + (let ((all-quoted?_1 + (let ((k-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + k_0) + (let ((v-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (if as-set?_0 + (void) + (ser-push!_0 + (hash-ref + v_0 + k_0))) + (if all-quoted?_0 + (if (quoted?_0 + k-pos_0) + (if as-set?_0 + as-set?_0 + (quoted?_0 + v-pos_0)) + #f) + #f))))))) + (values + all-quoted?_1)))) + (for-loop_0 + all-quoted?_1 + rest_0)))) + all-quoted?_0)))))) + (for-loop_0 + #t + ks_0))))) + (if all-quoted?_0 + (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0)) + (void)))))))) + (let ((c3_0 + (prefab-struct-key + v_0))) + (if c3_0 + (let ((vec_0 + (struct->vector + v_0))) + (let ((start-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + 'tag + kw2931) (begin (ser-push!_0 'exact - (sub1 - (vector-length - vec_0))) - (let ((all-quoted?_0 - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - vec_0 - 1 - #f - 1)) - (case-lambda - ((v*_0 - start*_0 - stop*_0 - step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (all-quoted?_0 - idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((i_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (let ((all-quoted?_1 - (let ((all-quoted?_1 - (let ((i-pos_0 - (begin-unsafe - (begin - stream-size_0)))) - (begin - (ser-push!_0 - i_0) - (if all-quoted?_0 - (quoted?_0 - i-pos_0) - #f))))) - (values - all-quoted?_1)))) - (for-loop_0 - all-quoted?_1 - (unsafe-fx+ - idx_0 - 1)))) - all-quoted?_0)))))) - (for-loop_0 + c3_0) + (begin + (ser-push!_0 + 'exact + (sub1 + (vector-length + vec_0))) + (let ((all-quoted?_0 + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + vec_0 + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin #t - start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))))) - (if all-quoted?_0 - (begin - (ser-reset!_0 - start-pos_0) - (ser-push-optional-quote!_0) - (ser-push!_0 - 'exact - v_0)) - (void)))))))) - (if (srcloc? - v_0) - (if (path? - (srcloc-source - v_0)) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (all-quoted?_0 + idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((i_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (let ((all-quoted?_1 + (let ((all-quoted?_1 + (let ((i-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + i_0) + (if all-quoted?_0 + (quoted?_0 + i-pos_0) + #f))))) + (values + all-quoted?_1)))) + (for-loop_0 + all-quoted?_1 + (unsafe-fx+ + idx_0 + 1)))) + all-quoted?_0)))))) + (for-loop_0 + #t + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))))) + (if all-quoted?_0 + (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0)) + (void)))))))) + (if (srcloc? + v_0) + (if (path? + (srcloc-source + v_0)) + (begin + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0)) + (begin + (ser-push!_0 + 'tag + kw2496) + (ser-push!_0 + (srcloc-source + v_0)) + (ser-push!_0 + (srcloc-line + v_0)) + (ser-push!_0 + (srcloc-column + v_0)) + (ser-push!_0 + (srcloc-position + v_0)) + (ser-push!_0 + (srcloc-span + v_0)))) (begin (ser-push-optional-quote!_0) (ser-push!_0 'exact - v_0)) - (begin - (ser-push!_0 - 'tag - kw2496) - (ser-push!_0 - (srcloc-source - v_0)) - (ser-push!_0 - (srcloc-line - v_0)) - (ser-push!_0 - (srcloc-column - v_0)) - (ser-push!_0 - (srcloc-position - v_0)) - (ser-push!_0 - (srcloc-span - v_0)))) - (begin - (ser-push-optional-quote!_0) - (ser-push!_0 - 'exact - v_0))))))))))))))))) - (ser-push-optional-quote!_0 - (|#%name| - ser-push-optional-quote! - (lambda () (begin (void)))))) - (let ((ser-shell!_0 - (|#%name| - ser-shell! - (lambda (v_0) - (begin - (if (serialize-fill!? v_0) - (|#%app| - (serialize-ref v_0) - v_0 - ser-push!_0 - state_0) - (if (box? v_0) - (ser-push!_0 - 'tag - kw2525) - (if (vector? v_0) - (begin - (ser-push!_0 - 'tag - kw2967) - (ser-push!_0 - 'exact - (vector-length - v_0))) - (if (hash? v_0) - (ser-push!_0 - 'tag - (if (hash-eq? - v_0) - kw2796 - (if (hash-eqv? - v_0) - kw3245 - kw2582))) - (error - 'ser-shell - "unknown mutable: ~e" - v_0)))))))))) - (let ((ser-shell-fill!_0 + v_0))))))))))))))))) + (ser-push-optional-quote!_0 + (|#%name| + ser-push-optional-quote! + (lambda () (begin (void)))))) + (let ((ser-shell!_0 (|#%name| - ser-shell-fill! + ser-shell! (lambda (v_0) (begin (if (serialize-fill!? v_0) (|#%app| - (serialize-fill!-ref - v_0) + (serialize-ref v_0) v_0 ser-push!_0 state_0) (if (box? v_0) - (begin - (ser-push!_0 - 'tag - kw2531) - (ser-push!_0 - (unbox v_0))) + (ser-push!_0 + 'tag + kw2525) (if (vector? v_0) (begin (ser-push!_0 'tag - kw3046) + kw2967) (ser-push!_0 'exact (vector-length - v_0)) - (call-with-values - (lambda () - (begin - (check-vector - v_0) - (values - v_0 - (unsafe-vector-length - v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_0) - (let ((v_1 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (ser-push!_0 - v_1) - (for-loop_0 - (unsafe-fx+ - 1 - pos_0)))) - (values))))))) - (for-loop_0 - 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (void)) + v_0))) (if (hash? v_0) + (ser-push!_0 + 'tag + (if (hash-eq? + v_0) + kw2796 + (if (hash-eqv? + v_0) + kw3245 + kw2582))) + (error + 'ser-shell + "unknown mutable: ~e" + v_0)))))))))) + (let ((ser-shell-fill!_0 + (|#%name| + ser-shell-fill! + (lambda (v_0) + (begin + (if (serialize-fill!? + v_0) + (|#%app| + (serialize-fill!-ref + v_0) + v_0 + ser-push!_0 + state_0) + (if (box? v_0) + (begin + (ser-push!_0 + 'tag + kw2531) + (ser-push!_0 + (unbox v_0))) + (if (vector? v_0) (begin (ser-push!_0 'tag - kw2194) + kw3046) + (ser-push!_0 + 'exact + (vector-length + v_0)) + (call-with-values + (lambda () + (begin + (check-vector + v_0) + (values + v_0 + (unsafe-vector-length + v_0)))) + (case-lambda + ((vec_0 + len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((v_1 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (ser-push!_0 + v_1) + (for-loop_0 + (unsafe-fx+ + 1 + pos_0)))) + (values))))))) + (for-loop_0 + 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (void)) + (if (hash? v_0) (begin (ser-push!_0 - 'exact - (hash-count - v_0)) - (let ((ks_0 - (sorted-hash-keys - v_0))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? - lst_0) - (let ((k_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (begin - (begin - (ser-push!_0 - k_0) - (ser-push!_0 - (hash-ref - v_0 - k_0))) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 - ks_0))) - (void))))) - (error - 'ser-shell-fill - "unknown mutable: ~e" - v_0)))))))))) - (let ((rev-mutables_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - mutables_0 - i_0)) - (case-lambda - ((k_0 v_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - v_0 - k_0)) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - mutables_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2589 - (hash-iterate-first - mutables_0)))))) - (let ((mutable-shell-bindings_0 - (begin - (begin - (let ((end_0 - (hash-count - mutables_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (< - pos_0 - end_0) - (begin - (ser-shell!_0 - (hash-ref - rev-mutables_0 - pos_0)) - (for-loop_0 - (+ - pos_0 - 1))) - (values))))))) - (for-loop_0 - 0)))) - (void)) - (reap-stream!_0)))) - (let ((rev-shares_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 - i_0) - (begin - (if i_0 - (let ((obj_0 - (hash-iterate-key - shares_0 - i_0))) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - (hash-ref - share-step-positions_0 - (hash-ref - objs_0 - obj_0)) - obj_0)) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - shares_0 - i_0)))) - table_0)))))) - (for-loop_0 - hash2589 - (hash-iterate-first - shares_0)))))) - (let ((shared-bindings_0 - (begin - (begin - (let ((end_0 - (+ - num-mutables_0 + 'tag + kw2194) + (begin + (ser-push!_0 + 'exact (hash-count - shares_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (< - pos_0 - end_0) - (begin - (ser-push-encoded!_0 - (hash-ref - rev-shares_0 - pos_0)) - (for-loop_0 - (+ - pos_0 - 1))) - (values))))))) - (for-loop_0 - num-mutables_0)))) - (void)) - (reap-stream!_0)))) - (let ((mutable-fills_0 + v_0)) + (let ((ks_0 + (sorted-hash-keys + v_0))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? + lst_0) + (let ((k_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (begin + (begin + (ser-push!_0 + k_0) + (ser-push!_0 + (hash-ref + v_0 + k_0))) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + ks_0))) + (void))))) + (error + 'ser-shell-fill + "unknown mutable: ~e" + v_0)))))))))) + (let ((rev-mutables_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 + i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + mutables_0 + i_0)) + (case-lambda + ((k_0 v_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + v_0 + k_0)) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + mutables_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2589 + (hash-iterate-first + mutables_0)))))) + (let ((mutable-shell-bindings_0 + (begin + (begin + (let ((end_0 + (hash-count + mutables_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (< + pos_0 + end_0) + (begin + (ser-shell!_0 + (hash-ref + rev-mutables_0 + pos_0)) + (for-loop_0 + (+ + pos_0 + 1))) + (values))))))) + (for-loop_0 + 0)))) + (void)) + (reap-stream!_0)))) + (let ((rev-shares_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 + i_0) + (begin + (if i_0 + (let ((obj_0 + (hash-iterate-key + shares_0 + i_0))) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + (hash-ref + share-step-positions_0 + (hash-ref + objs_0 + obj_0)) + obj_0)) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + shares_0 + i_0)))) + table_0)))))) + (for-loop_0 + hash2589 + (hash-iterate-first + shares_0)))))) + (let ((shared-bindings_0 (begin (begin (let ((end_0 - (hash-count - mutables_0))) + (+ + num-mutables_0 + (hash-count + shares_0)))) (begin (letrec* ((for-loop_0 @@ -26192,9 +26370,9 @@ pos_0 end_0) (begin - (ser-shell-fill!_0 + (ser-push-encoded!_0 (hash-ref - rev-mutables_0 + rev-shares_0 pos_0)) (for-loop_0 (+ @@ -26202,76 +26380,118 @@ 1))) (values))))))) (for-loop_0 - 0)))) + num-mutables_0)))) (void)) (reap-stream!_0)))) - (let ((result_0 + (let ((mutable-fills_0 (begin - (ser-push!_0 - v4_0) + (begin + (let ((end_0 + (hash-count + mutables_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (< + pos_0 + end_0) + (begin + (ser-shell-fill!_0 + (hash-ref + rev-mutables_0 + pos_0)) + (for-loop_0 + (+ + pos_0 + 1))) + (values))))))) + (for-loop_0 + 0)))) + (void)) (reap-stream!_0)))) - (let ((finish_0 - (|#%name| - finish - (lambda (mutable-shell-bindings-expr_0 - shared-bindings-expr_0 - mutable-fills-expr_0 - result-expr_0) - (begin - (let ((app_0 - (if syntax-support?2_0 - inspector-id - #f))) - (let ((app_1 - (if syntax-support?2_0 - bulk-binding-registry-id - #f))) - (let ((app_2 + (let ((result_0 + (begin + (ser-push!_0 + v16_0) + (reap-stream!_0)))) + (if as-data?7_0 + (let ((app_0 + (hash-count + mutables_0))) + (vector + app_0 + mutable-shell-bindings_0 + (hash-count + shares_0) + shared-bindings_0 + mutable-fills_0 + result_0)) + (let ((finish_0 + (|#%name| + finish + (lambda (mutable-shell-bindings-expr_0 + shared-bindings-expr_0 + mutable-fills-expr_0 + result-expr_0) + (begin + (let ((app_0 + (if syntax-support?8_0 + inspector-id + #f))) + (let ((app_1 + (if syntax-support?8_0 + bulk-binding-registry-id + #f))) + (let ((app_2 + (list + 'quote + (hash-count + mutables_0)))) + (list + 'deserialize + mpi-vector-id + app_0 + app_1 + app_2 + mutable-shell-bindings-expr_0 (list 'quote (hash-count - mutables_0)))) - (list - 'deserialize - mpi-vector-id - app_0 - app_1 - app_2 - mutable-shell-bindings-expr_0 - (list - 'quote - (hash-count - shares_0)) - shared-bindings-expr_0 - mutable-fills-expr_0 - result-expr_0))))))))) - (let ((app_0 - (list - (list - '(data) - (list - 'quote - (vector - mutable-shell-bindings_0 - shared-bindings_0 - mutable-fills_0 - result_0)))))) - (list - 'let-values - app_0 - (finish_0 - '(unsafe-vector*-ref - data - 0) - '(unsafe-vector*-ref - data - 1) - '(unsafe-vector*-ref - data - 2) - '(unsafe-vector*-ref - data - 3))))))))))))))))))))))))))))))))))) + shares_0)) + shared-bindings-expr_0 + mutable-fills-expr_0 + result-expr_0))))))))) + (let ((app_0 + (list + (list + '(data) + (list + 'quote + (vector + mutable-shell-bindings_0 + shared-bindings_0 + mutable-fills_0 + result_0)))))) + (list + 'let-values + app_0 + (finish_0 + '(unsafe-vector*-ref + data + 0) + '(unsafe-vector*-ref + data + 1) + '(unsafe-vector*-ref + data + 2) + '(unsafe-vector*-ref + data + 3))))))))))))))))))))))))))))))))))))) (define sorted-hash-keys (lambda (ht_0) (let ((ks_0 (hash-keys ht_0))) @@ -26282,7 +26502,7 @@ (if (andmap_2344 symbol? ks_0) (sort.1 #f #f ks_0 symbolinteger-bytes n_0 4 #f #f) port_0))) -(define finish1426 +(define finish1444 (make-struct-type-install-properties '(linklet-directory) 1 @@ -34970,7 +35355,7 @@ #f 1 0)) -(define effect_2692 (finish1426 struct:linklet-directory)) +(define effect_2692 (finish1444 struct:linklet-directory)) (define linklet-directory1.1 (|#%name| linklet-directory @@ -35004,7 +35389,7 @@ s 'linklet-directory 'ht)))))) -(define finish1430 +(define finish1448 (make-struct-type-install-properties '(linklet-bundle) 1 @@ -35033,7 +35418,7 @@ #f 1 0)) -(define effect_2464 (finish1430 struct:linklet-bundle)) +(define effect_2464 (finish1448 struct:linklet-bundle)) (define linklet-bundle2.1 (|#%name| linklet-bundle @@ -35231,7 +35616,7 @@ (args (raise-binding-result-arity-error 2 args)))) result_0)))))) (for-loop_0 #t (hash-iterate-first ht_0))))))) -(define finish1434 +(define finish1452 (make-struct-type-install-properties '(namespace-scopes) 2 @@ -35252,7 +35637,7 @@ #f 2 3)) -(define effect_2465 (finish1434 struct:namespace-scopes)) +(define effect_2465 (finish1452 struct:namespace-scopes)) (define namespace-scopes1.1 (|#%name| namespace-scopes @@ -35373,7 +35758,7 @@ (let ((app_0 (namespace-scopes-other nss1_0))) (set=? app_0 (namespace-scopes-other nss2_0))) #f))) -(define finish1450 +(define finish1468 (make-struct-type-install-properties '(syntax-literals) 2 @@ -35394,7 +35779,7 @@ #f 2 3)) -(define effect_2822 (finish1450 struct:syntax-literals)) +(define effect_2822 (finish1468 struct:syntax-literals)) (define syntax-literals1.1 (|#%name| syntax-literals @@ -35484,7 +35869,7 @@ v 'syntax-literals 'count)))))) -(define finish1457 +(define finish1475 (make-struct-type-install-properties '(header) 8 @@ -35505,7 +35890,7 @@ #f 8 36)) -(define effect_2459 (finish1457 struct:header)) +(define effect_2459 (finish1475 struct:header)) (define header2.1 (|#%name| header @@ -35694,7 +36079,7 @@ v 'header 'require-vars-in-order)))))) -(define finish1470 +(define finish1488 (make-struct-type-install-properties '(variable-use) 2 @@ -35715,7 +36100,7 @@ #f 2 0)) -(define effect_2838 (finish1470 struct:variable-use)) +(define effect_2838 (finish1488 struct:variable-use)) (define variable-use3.1 (|#%name| variable-use @@ -35951,7 +36336,13 @@ (vector->immutable-vector (list->vector (reverse$1 (syntax-literals-stxes sl_0)))))) - (generate-deserialize.1 #t temp21_0 mpis_0))))))) + (generate-deserialize.1 + #f + #f + mpis_0 + hash2610 + #t + temp21_0))))))) (list 'begin app_2 @@ -35971,7 +36362,13 @@ (cons app_0 (reverse$1 (syntax-literals-stxes sl_0)))))) - (generate-deserialize.1 #t temp23_0 mpis_0)))))) + (generate-deserialize.1 + #f + #f + mpis_0 + hash2610 + #t + temp23_0)))))) (list 'let-values app_0 @@ -37285,7 +37682,7 @@ (if (extra-inspectors-allow? extra-inspectors-1_0 guard-insp_0) (extra-inspectors-allow? extra-inspectors-2_0 guard-insp_0) #f)))))) -(define finish1631 +(define finish1649 (make-struct-type-install-properties '(module-use*) 2 @@ -37306,7 +37703,7 @@ #f 2 3)) -(define effect_2316 (finish1631 struct:module-use*)) +(define effect_2316 (finish1649 struct:module-use*)) (define module-use*1.1 (|#%name| module-use* @@ -37720,7 +38117,7 @@ (set-module-use*-extra-inspectorss! existing-mu*_0 new-extra-inspectorss_0)))))) -(define finish1641 +(define finish1659 (make-struct-type-install-properties '(link-info) 4 @@ -37741,7 +38138,7 @@ #f 4 0)) -(define effect_2792 (finish1641 struct:link-info)) +(define effect_2792 (finish1659 struct:link-info)) (define link-info1.1 (|#%name| link-info @@ -39626,7 +40023,8 @@ (list 'define-values app_2 - (generate-module-path-index-deserialize + (generate-module-path-index-deserialize.1 + #f mpis_0))))) (list 'linklet @@ -39838,7 +40236,7 @@ (let ((app_0 (car cims_1))) (cons app_0 (cdr cims_1))))))))))) (loop_0 cims_0)))) -(define finish1708 +(define finish1726 (make-struct-type-install-properties '(known-defined/delay) 1 @@ -39859,7 +40257,7 @@ #f 1 1)) -(define effect_2998 (finish1708 struct:known-defined/delay)) +(define effect_2998 (finish1726 struct:known-defined/delay)) (define known-defined/delay2.1 (|#%name| known-defined/delay @@ -39897,7 +40295,7 @@ s 'known-defined/delay 'thunk)))))) -(define finish1712 +(define finish1730 (make-struct-type-install-properties '(known-property) 0 @@ -39918,7 +40316,7 @@ #f 0 0)) -(define effect_2476 (finish1712 struct:known-property)) +(define effect_2476 (finish1730 struct:known-property)) (define known-property3.1 (|#%name| known-property @@ -39936,7 +40334,7 @@ (if (impersonator? v) (known-property?_2907 (impersonator-val v)) #f)))))) -(define finish1715 +(define finish1733 (make-struct-type-install-properties '(known-property-of-function) 1 @@ -39963,7 +40361,7 @@ #f 1 1)) -(define effect_2945 (finish1715 struct:known-property-of-function)) +(define effect_2945 (finish1733 struct:known-property-of-function)) (define known-property-of-function4.1 (|#%name| known-property-of-function @@ -40004,7 +40402,7 @@ s 'known-property-of-function 'arity)))))) -(define finish1719 +(define finish1737 (make-struct-type-install-properties '(known-function) 2 @@ -40025,7 +40423,7 @@ #f 2 3)) -(define effect_2741 (finish1719 struct:known-function)) +(define effect_2741 (finish1737 struct:known-function)) (define known-function5.1 (|#%name| known-function @@ -40075,7 +40473,7 @@ s 'known-function 'pure?)))))) -(define finish1724 +(define finish1742 (make-struct-type-install-properties '(known-function-of-satisfying) 1 @@ -40102,7 +40500,7 @@ #f 1 1)) -(define effect_2265 (finish1724 struct:known-function-of-satisfying)) +(define effect_2265 (finish1742 struct:known-function-of-satisfying)) (define known-function-of-satisfying6.1 (|#%name| known-function-of-satisfying @@ -40143,7 +40541,7 @@ s 'known-function-of-satisfying 'arg-predicate-keys)))))) -(define finish1728 +(define finish1746 (make-struct-type-install-properties '(known-predicate) 1 @@ -40164,7 +40562,7 @@ #f 1 1)) -(define effect_2144 (finish1728 struct:known-predicate)) +(define effect_2144 (finish1746 struct:known-predicate)) (define known-predicate7.1 (|#%name| known-predicate @@ -40198,7 +40596,7 @@ s 'known-predicate 'key)))))) -(define finish1732 +(define finish1750 (make-struct-type-install-properties '(known-satisfies) 1 @@ -40219,7 +40617,7 @@ #f 1 1)) -(define effect_1976 (finish1732 struct:known-satisfies)) +(define effect_1976 (finish1750 struct:known-satisfies)) (define known-satisfies8.1 (|#%name| known-satisfies @@ -40255,7 +40653,7 @@ s 'known-satisfies 'predicate-key)))))) -(define finish1736 +(define finish1754 (make-struct-type-install-properties '(known-struct-op) 2 @@ -40276,7 +40674,7 @@ #f 2 3)) -(define effect_2534 (finish1736 struct:known-struct-op)) +(define effect_2534 (finish1754 struct:known-struct-op)) (define known-struct-op9.1 (|#%name| known-struct-op @@ -43488,7 +43886,8 @@ (list 'define-values app_2 - (generate-module-path-index-deserialize + (generate-module-path-index-deserialize.1 + #f mpis_0))))) (let ((app_3 (let ((app_3 @@ -44849,7 +45248,7 @@ ns_0)))))))))))))))))))))))) (args (raise-binding-result-arity-error 4 args)))) (if log-performance? (end-performance-region) (void))))))))) -(define finish1800 +(define finish1818 (make-struct-type-install-properties '(instance-data) 2 @@ -44870,7 +45269,7 @@ #f 2 0)) -(define effect_2595 (finish1800 struct:instance-data)) +(define effect_2595 (finish1818 struct:instance-data)) (define instance-data9.1 (|#%name| instance-data @@ -47302,7 +47701,7 @@ table_0)))))) (for-loop_0 hash2610 (hash-iterate-first ht_0)))))) c_0)))) -(define finish1892 +(define finish1910 (make-struct-type-install-properties '(recompiled) 3 @@ -47323,7 +47722,7 @@ #f 3 0)) -(define effect_1973 (finish1892 struct:recompiled)) +(define effect_1973 (finish1910 struct:recompiled)) (define recompiled1.1 (|#%name| recompiled @@ -48850,7 +49249,7 @@ (define box-cons! (lambda (b_0 v_0) (set-box! b_0 (cons v_0 (unbox b_0))))) (define box-clear! (lambda (b_0) (begin0 (reverse$1 (unbox b_0)) (set-box! b_0 null)))) -(define finish1929 +(define finish1947 (make-struct-type-install-properties '(lift-context) 3 @@ -48871,7 +49270,7 @@ #f 3 0)) -(define effect_1545 (finish1929 struct:lift-context)) +(define effect_1545 (finish1947 struct:lift-context)) (define lift-context1.1 (|#%name| lift-context @@ -48885,7 +49284,7 @@ (|#%name| lift-context-lifts (record-accessor struct:lift-context 1))) (define lift-context-module*-ok? (|#%name| lift-context-module*-ok? (record-accessor struct:lift-context 2))) -(define finish1931 +(define finish1949 (make-struct-type-install-properties '(lifted-bind) 3 @@ -48906,7 +49305,7 @@ #f 3 0)) -(define effect_1767 (finish1931 struct:lifted-bind)) +(define effect_1767 (finish1949 struct:lifted-bind)) (define lifted-bind2.1 (|#%name| lifted-bind @@ -49137,7 +49536,7 @@ (for-loop_0 fold-var_2 rest_0))))) fold-var_0)))))) (for-loop_0 null lifts_0)))))) -(define finish1941 +(define finish1959 (make-struct-type-install-properties '(module-lift-context) 3 @@ -49158,7 +49557,7 @@ #f 3 0)) -(define effect_2649 (finish1941 struct:module-lift-context)) +(define effect_2649 (finish1959 struct:module-lift-context)) (define module-lift-context15.1 (|#%name| module-lift-context @@ -49219,7 +49618,7 @@ (box-cons! (lift-context-lifts module-lifts_0) s_0) (error "internal error: unrecognized lift-context type for module lift")))))) -(define finish1943 +(define finish1961 (make-struct-type-install-properties '(require-lift-context) 3 @@ -49240,7 +49639,7 @@ #f 3 0)) -(define effect_3057 (finish1943 struct:require-lift-context)) +(define effect_3057 (finish1961 struct:require-lift-context)) (define require-lift-context16.1 (|#%name| require-lift-context @@ -49273,7 +49672,7 @@ (begin (|#%app| (require-lift-context-do-require require-lifts_0) s_0 phase_0) (box-cons! (require-lift-context-requires require-lifts_0) s_0)))) -(define finish1945 +(define finish1963 (make-struct-type-install-properties '(to-module-lift-context) 4 @@ -49294,7 +49693,7 @@ #f 4 0)) -(define effect_3069 (finish1945 struct:to-module-lift-context)) +(define effect_3069 (finish1963 struct:to-module-lift-context)) (define to-module-lift-context17.1 (|#%name| to-module-lift-context @@ -49343,7 +49742,7 @@ (define add-lifted-to-module-end! (lambda (to-module-lifts_0 s_0 phase_0) (box-cons! (to-module-lift-context-ends to-module-lifts_0) s_0))) -(define finish1948 +(define finish1966 (make-struct-type-install-properties '(expanded-syntax) 2 @@ -49364,7 +49763,7 @@ #f 2 0)) -(define effect_2568 (finish1948 struct:already-expanded)) +(define effect_2568 (finish1966 struct:already-expanded)) (define already-expanded1.1 (|#%name| already-expanded @@ -49421,7 +49820,7 @@ has-liberal-define-context-property? liberal-define-context-value) (make-struct-type-property 'liberal-define-context)) -(define finish1953 +(define finish1971 (make-struct-type-install-properties '(liberal-define-context) 0 @@ -49442,7 +49841,7 @@ #f 0 0)) -(define effect_2849 (finish1953 struct:liberal-define-context)) +(define effect_2849 (finish1971 struct:liberal-define-context)) (define make-liberal-define-context (|#%name| make-liberal-define-context @@ -49557,7 +49956,7 @@ (wrap_0 '|#%expression|) (fail_0)) (fail_0)))))))) -(define finish1960 +(define finish1978 (make-struct-type-install-properties '(reference-record) 3 @@ -49578,7 +49977,7 @@ #f 3 7)) -(define effect_2371 (finish1960 struct:reference-record)) +(define effect_2371 (finish1978 struct:reference-record)) (define reference-record1.1 (|#%name| reference-record @@ -49723,7 +50122,7 @@ (let ((app_0 (syntax-disarm$1 orig-s3_0))) (datum->syntax$1 app_0 new4_0 orig-s3_0 (if track?1_0 orig-s3_0 #f))) orig-s3_0))))) -(define finish1973 +(define finish1991 (make-struct-type-install-properties '(expanded+parsed) 2 @@ -49744,7 +50143,7 @@ #f 2 0)) -(define effect_2270 (finish1973 struct:expanded+parsed)) +(define effect_2270 (finish1991 struct:expanded+parsed)) (define expanded+parsed1.1 (|#%name| expanded+parsed @@ -49756,7 +50155,7 @@ (|#%name| expanded+parsed-s (record-accessor struct:expanded+parsed 0))) (define expanded+parsed-parsed (|#%name| expanded+parsed-parsed (record-accessor struct:expanded+parsed 1))) -(define finish1975 +(define finish1993 (make-struct-type-install-properties '(semi-parsed-define-values) 4 @@ -49777,7 +50176,7 @@ #f 4 0)) -(define effect_2353 (finish1975 struct:semi-parsed-define-values)) +(define effect_2353 (finish1993 struct:semi-parsed-define-values)) (define semi-parsed-define-values2.1 (|#%name| semi-parsed-define-values @@ -49806,7 +50205,7 @@ (|#%name| semi-parsed-define-values-rhs (record-accessor struct:semi-parsed-define-values 3))) -(define finish1977 +(define finish1995 (make-struct-type-install-properties '(semi-parsed-begin-for-syntax) 2 @@ -49827,7 +50226,7 @@ #f 2 0)) -(define effect_2815 (finish1977 struct:semi-parsed-begin-for-syntax)) +(define effect_2815 (finish1995 struct:semi-parsed-begin-for-syntax)) (define semi-parsed-begin-for-syntax3.1 (|#%name| semi-parsed-begin-for-syntax @@ -51870,7 +52269,7 @@ module* |#%declare| |#%stratified-body|))) -(define finish2119 +(define finish2137 (make-struct-type-install-properties '(internal-definition-context) 5 @@ -51891,7 +52290,7 @@ #f 5 0)) -(define effect_2979 (finish2119 struct:internal-definition-context)) +(define effect_2979 (finish2137 struct:internal-definition-context)) (define internal-definition-context1.1 (|#%name| internal-definition-context @@ -52004,7 +52403,7 @@ s 'internal-definition-context 'parent-ctx)))))) -(define finish2127 +(define finish2145 (make-struct-type-install-properties '(env-mixin) 4 @@ -52025,7 +52424,7 @@ #f 4 0)) -(define effect_2352 (finish2127 struct:env-mixin)) +(define effect_2352 (finish2145 struct:env-mixin)) (define env-mixin2.1 (|#%name| env-mixin @@ -56794,7 +57193,7 @@ ((s_0 ns_0 serializable?8_0) (compile_0 s_0 ns_0 serializable?8_0 unsafe-undefined)) ((s_0 ns7_0) (compile_0 s_0 ns7_0 #t unsafe-undefined)))))) -(define finish2276 +(define finish2294 (make-struct-type-install-properties '(lifted-parsed-begin) 2 @@ -56815,7 +57214,7 @@ #f 2 0)) -(define effect_2583 (finish2276 struct:lifted-parsed-begin)) +(define effect_2583 (finish2294 struct:lifted-parsed-begin)) (define lifted-parsed-begin11.1 (|#%name| lifted-parsed-begin @@ -59064,7 +59463,7 @@ current-directory (find-system-path 'orig-dir))) (|#%app| thunk_0)))) -(define finish2313 +(define finish2331 (make-struct-type-install-properties '(shadow-directory) 2 @@ -59085,7 +59484,7 @@ #f 2 0)) -(define effect_2776 (finish2313 struct:shadow-directory)) +(define effect_2776 (finish2331 struct:shadow-directory)) (define shadow-directory1.1 (|#%name| shadow-directory @@ -59989,7 +60388,7 @@ v_0)) v_0)) 'current-readtable)) -(define finish2343 +(define finish2361 (make-struct-type-install-properties '(read-config) 7 @@ -60010,7 +60409,7 @@ #f 7 0)) -(define effect_2490 (finish2343 struct:read-config/outer)) +(define effect_2490 (finish2361 struct:read-config/outer)) (define read-config/outer1.1 (|#%name| read-config/outer @@ -60036,7 +60435,7 @@ (|#%name| read-config-keep-comment? (record-accessor struct:read-config/outer 6))) -(define finish2345 +(define finish2363 (make-struct-type-install-properties '(read-config/inner) 13 @@ -60057,7 +60456,7 @@ #f 13 0)) -(define effect_2436 (finish2345 struct:read-config/inner)) +(define effect_2436 (finish2363 struct:read-config/inner)) (define read-config/inner2.1 (|#%name| read-config/inner @@ -60200,7 +60599,7 @@ (read-config/inner-parameter-cache (read-config/outer-inner v_0)))) (define read-config-st (lambda (v_0) (read-config/inner-st (read-config/outer-inner v_0)))) -(define finish2348 +(define finish2366 (make-struct-type-install-properties '(read-config-state) 2 @@ -60221,7 +60620,7 @@ #f 2 3)) -(define effect_2073 (finish2348 struct:read-config-state)) +(define effect_2073 (finish2366 struct:read-config-state)) (define read-config-state3.1 (|#%name| read-config-state @@ -60752,7 +61151,7 @@ (check-parameter 1/read-accept-quasiquote config_0) (check-parameter 1/read-accept-reader config_0) (check-parameter 1/read-accept-lang config_0)))))) -(define finish2392 +(define finish2410 (make-struct-type-install-properties '(special-comment) 1 @@ -60773,7 +61172,7 @@ #f 1 0)) -(define effect_3106 (finish2392 struct:special-comment)) +(define effect_3106 (finish2410 struct:special-comment)) (define 1/make-special-comment (|#%name| make-special-comment @@ -60783,7 +61182,7 @@ (|#%name| special-comment? (record-predicate struct:special-comment))) (define 1/special-comment-value (|#%name| special-comment-value (record-accessor struct:special-comment 0))) -(define finish2394 +(define finish2412 (make-struct-type-install-properties '(readtable) 4 @@ -60804,7 +61203,7 @@ #f 4 0)) -(define effect_2167 (finish2394 struct:readtable)) +(define effect_2167 (finish2412 struct:readtable)) (define readtable1.1 (|#%name| readtable @@ -61167,7 +61566,7 @@ (args (raise-binding-result-arity-error 2 args)))) fold-var_0)))))) (for-loop_0 null (hash-iterate-first ht_0)))))))))) -(define finish2408 +(define finish2426 (make-struct-type-install-properties '(special) 1 @@ -61188,7 +61587,7 @@ #f 1 0)) -(define effect_2677 (finish2408 struct:special)) +(define effect_2677 (finish2426 struct:special)) (define special1.1 (|#%name| special @@ -61717,7 +62116,7 @@ (if (if s_0 s_0 c_0) (format "~a or ~a" p_0 (if s_0 s_0 c_0)) p_0))))))) -(define finish2440 +(define finish2458 (make-struct-type-install-properties '(accum-string) 2 @@ -61738,7 +62137,7 @@ #f 2 3)) -(define effect_2784 (finish2440 struct:accum-string)) +(define effect_2784 (finish2458 struct:accum-string)) (define accum-string1.1 (|#%name| accum-string @@ -61841,7 +62240,7 @@ (set-read-config-state-accum-str! (begin-unsafe (read-config/inner-st (read-config/outer-inner config_0))) a_0))) -(define finish2454 +(define finish2472 (make-struct-type-install-properties '(indentation) 8 @@ -61862,7 +62261,7 @@ #f 8 246)) -(define effect_2185 (finish2454 struct:indentation)) +(define effect_2185 (finish2472 struct:indentation)) (define indentation1.1 (|#%name| indentation @@ -62876,7 +63275,7 @@ decimal-mode_0 convert-mode_0 single-mode_0)))) -(define finish2503 +(define finish2521 (make-struct-type-install-properties '(parse-state) 5 @@ -62897,7 +63296,7 @@ #f 5 0)) -(define effect_2177 (finish2503 struct:parse-state)) +(define effect_2177 (finish2521 struct:parse-state)) (define parse-state6.1 (|#%name| parse-state @@ -62917,7 +63316,7 @@ (|#%name| parse-state-other-exactness (record-accessor struct:parse-state 4))) -(define finish2505 +(define finish2523 (make-struct-type-install-properties '(rect-prefix) 3 @@ -62938,7 +63337,7 @@ #f 3 0)) -(define effect_2477 (finish2505 struct:rect-prefix)) +(define effect_2477 (finish2523 struct:rect-prefix)) (define rect-prefix7.1 (|#%name| rect-prefix @@ -62952,7 +63351,7 @@ (|#%name| rect-prefix-n (record-accessor struct:rect-prefix 1))) (define rect-prefix-start (|#%name| rect-prefix-start (record-accessor struct:rect-prefix 2))) -(define finish2507 +(define finish2525 (make-struct-type-install-properties '(polar-prefix) 3 @@ -62973,7 +63372,7 @@ #f 3 0)) -(define effect_2366 (finish2507 struct:polar-prefix)) +(define effect_2366 (finish2525 struct:polar-prefix)) (define polar-prefix8.1 (|#%name| polar-prefix @@ -63075,7 +63474,7 @@ (if (eq? (state->convert-mode state_0) 'must-read) (format "cannot combine extflonum `~a` into a complex number" i_0) #f))) -(define finish2517 +(define finish2535 (make-struct-type-install-properties '(lazy-expt) 3 @@ -63096,7 +63495,7 @@ #f 3 0)) -(define effect_2131 (finish2517 struct:lazy-expt)) +(define effect_2131 (finish2535 struct:lazy-expt)) (define lazy-expt9.1 (|#%name| lazy-expt @@ -63109,7 +63508,7 @@ (|#%name| lazy-expt-radix (record-accessor struct:lazy-expt 1))) (define lazy-expt-exp (|#%name| lazy-expt-exp (record-accessor struct:lazy-expt 2))) -(define finish2519 +(define finish2537 (make-struct-type-install-properties '(lazy-rational) 2 @@ -63130,7 +63529,7 @@ #f 2 0)) -(define effect_3104 (finish2519 struct:lazy-rational)) +(define effect_3104 (finish2537 struct:lazy-rational)) (define lazy-rational10.1 (|#%name| lazy-rational @@ -72281,6 +72680,428 @@ maybe-insp_0 (let ((or-part_0 (current-module-code-inspector))) (if or-part_0 or-part_0 (current-code-inspector)))))) +(define finish2882 + (make-struct-type-install-properties + '(serialized-syntax) + 5 + 0 + #f + null + 'prefab + #f + '(0 1 2 3 4) + #f + 'serialized-syntax)) +(define struct:serialized-syntax + (make-record-type-descriptor* + 'serialized-syntax + #f + (structure-type-lookup-prefab-uid 'serialized-syntax #f 5 0 #f '(0 1 2 3 4)) + #f + #f + 5 + 31)) +(define effect_2423 (finish2882 struct:serialized-syntax)) +(define serialized-syntax1.1 + (|#%name| + serialized-syntax + (record-constructor + (make-record-constructor-descriptor struct:serialized-syntax #f #f)))) +(define serialized-syntax?_2448 + (|#%name| serialized-syntax? (record-predicate struct:serialized-syntax))) +(define serialized-syntax? + (|#%name| + serialized-syntax? + (lambda (v) + (if (serialized-syntax?_2448 v) + #t + ($value + (if (impersonator? v) + (serialized-syntax?_2448 (impersonator-val v)) + #f)))))) +(define serialized-syntax-version_3038 + (|#%name| + serialized-syntax-version + (record-accessor struct:serialized-syntax 0))) +(define serialized-syntax-version + (|#%name| + serialized-syntax-version + (lambda (s) + (if (serialized-syntax?_2448 s) + (serialized-syntax-version_3038 s) + ($value + (impersonate-ref + serialized-syntax-version_3038 + struct:serialized-syntax + 0 + s + 'serialized-syntax + 'version)))))) +(define serialized-syntax-mpis_2591 + (|#%name| + serialized-syntax-mpis + (record-accessor struct:serialized-syntax 1))) +(define serialized-syntax-mpis + (|#%name| + serialized-syntax-mpis + (lambda (s) + (if (serialized-syntax?_2448 s) + (serialized-syntax-mpis_2591 s) + ($value + (impersonate-ref + serialized-syntax-mpis_2591 + struct:serialized-syntax + 1 + s + 'serialized-syntax + 'mpis)))))) +(define serialized-syntax-base-mpi-pos_2382 + (|#%name| + serialized-syntax-base-mpi-pos + (record-accessor struct:serialized-syntax 2))) +(define serialized-syntax-base-mpi-pos + (|#%name| + serialized-syntax-base-mpi-pos + (lambda (s) + (if (serialized-syntax?_2448 s) + (serialized-syntax-base-mpi-pos_2382 s) + ($value + (impersonate-ref + serialized-syntax-base-mpi-pos_2382 + struct:serialized-syntax + 2 + s + 'serialized-syntax + 'base-mpi-pos)))))) +(define serialized-syntax-data_2598 + (|#%name| + serialized-syntax-data + (record-accessor struct:serialized-syntax 3))) +(define serialized-syntax-data + (|#%name| + serialized-syntax-data + (lambda (s) + (if (serialized-syntax?_2448 s) + (serialized-syntax-data_2598 s) + ($value + (impersonate-ref + serialized-syntax-data_2598 + struct:serialized-syntax + 3 + s + 'serialized-syntax + 'data)))))) +(define serialized-syntax-need-registry?_3073 + (|#%name| + serialized-syntax-need-registry? + (record-accessor struct:serialized-syntax 4))) +(define serialized-syntax-need-registry? + (|#%name| + serialized-syntax-need-registry? + (lambda (s) + (if (serialized-syntax?_2448 s) + (serialized-syntax-need-registry?_3073 s) + ($value + (impersonate-ref + serialized-syntax-need-registry?_3073 + struct:serialized-syntax + 4 + s + 'serialized-syntax + 'need-registry?)))))) +(define 1/syntax-serialize + (let ((syntax-serialize_0 + (|#%name| + syntax-serialize + (lambda (stx5_0 + base-mpi2_0 + preserve-prop-keys3_0 + provides-namespace4_0) + (begin + (let ((provides-namespace_0 + (if (eq? provides-namespace4_0 unsafe-undefined) + (1/current-namespace) + provides-namespace4_0))) + (begin + (if (syntax?$1 stx5_0) + (void) + (raise-argument-error 'syntax-serialize "syntax?" stx5_0)) + (begin + (if (let ((or-part_0 (not base-mpi2_0))) + (if or-part_0 + or-part_0 + (1/module-path-index? base-mpi2_0))) + (void) + (raise-argument-error + 'syntax-serialize + "(or/c module-path-index? #f)" + base-mpi2_0)) + (begin + (if (if (list? preserve-prop-keys3_0) + (andmap_2344 symbol? preserve-prop-keys3_0) + #f) + (void) + (raise-argument-error + 'syntax-serialize + "(listof symbol?)" + preserve-prop-keys3_0)) + (begin + (if (let ((or-part_0 (not provides-namespace_0))) + (if or-part_0 + or-part_0 + (1/namespace? provides-namespace_0))) + (void) + (raise-argument-error + 'syntax-serialize + "(or/c namespace? #f)" + provides-namespace_0)) + (let ((mpis_0 (make-module-path-index-table))) + (let ((base-mpi-pos_0 + (if base-mpi2_0 + (add-module-path-index!/pos + mpis_0 + base-mpi2_0) + #f))) + (let ((data_0 + (let ((temp13_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 lst_0) + (begin + (if (pair? lst_0) + (let ((k_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + k_0 + #t)) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + rest_0)))) + table_0)))))) + (for-loop_0 + hash2610 + preserve-prop-keys3_0))))) + (let ((temp14_0 + (if provides-namespace_0 + (|#%name| + temp14 + (lambda (modname_0) + (begin + (not + (namespace->module + provides-namespace_0 + modname_0))))) + (|#%name| + temp14 + (lambda (modname_0) + (begin #t)))))) + (let ((temp13_1 temp13_0)) + (generate-deserialize.1 + #t + temp14_0 + mpis_0 + temp13_1 + #t + stx5_0)))))) + (let ((app_0 + (generate-module-path-index-deserialize.1 + #t + mpis_0))) + (serialized-syntax1.1 + (version) + app_0 + base-mpi-pos_0 + data_0 + (if provides-namespace_0 #t #f)))))))))))))))) + (|#%name| + syntax-serialize + (case-lambda + ((stx_0) (begin (syntax-serialize_0 stx_0 #f '() unsafe-undefined))) + ((stx_0 base-mpi_0 preserve-prop-keys_0 provides-namespace4_0) + (syntax-serialize_0 + stx_0 + base-mpi_0 + preserve-prop-keys_0 + provides-namespace4_0)) + ((stx_0 base-mpi_0 preserve-prop-keys3_0) + (syntax-serialize_0 + stx_0 + base-mpi_0 + preserve-prop-keys3_0 + unsafe-undefined)) + ((stx_0 base-mpi2_0) + (syntax-serialize_0 stx_0 base-mpi2_0 '() unsafe-undefined)))))) +(define 1/syntax-deserialize + (let ((syntax-deserialize_0 + (|#%name| + syntax-deserialize + (lambda (data7_0 base-mpi6_0) + (begin + (begin + (if (let ((or-part_0 (not base-mpi6_0))) + (if or-part_0 + or-part_0 + (1/module-path-index? base-mpi6_0))) + (void) + (raise-argument-error + 'syntax-deserialize + "(or/c module-path-index? #f)" + base-mpi6_0)) + (begin + (if (serialized-syntax? data7_0) + (void) + (raise-arguments-error + 'syntax-deserialize + "invalid serialized form" + "value" + data7_0)) + (begin + (if (equal? (version) (serialized-syntax-version data7_0)) + (void) + (raise-arguments-error + 'syntax-deserialize + "version mismatch" + "expected" + (version) + "found" + (serialized-syntax-version data7_0))) + (begin + (if (eq? (current-code-inspector) initial-code-inspector) + (void) + (error + 'syntax-deserialize + "deserialization disallowed by code inspector")) + (let ((orig-mpis_0 + (deserialize-module-path-index-data + (serialized-syntax-mpis data7_0)))) + (let ((orig-base-mpi_0 + (if base-mpi6_0 + (let ((pos_0 + (serialized-syntax-base-mpi-pos + data7_0))) + (if pos_0 + (vector-ref orig-mpis_0 pos_0) + #f)) + #f))) + (let ((shifted-mpis_0 + (if orig-base-mpi_0 + (let ((len_0 (vector-length orig-mpis_0))) + (begin + (if (exact-nonnegative-integer? len_0) + (void) + (raise-argument-error + 'for/vector + "exact-nonnegative-integer?" + len_0)) + (let ((v_0 (make-vector len_0 0))) + (begin + (if (zero? len_0) + (void) + (call-with-values + (lambda () + (begin + (check-vector orig-mpis_0) + (values + orig-mpis_0 + (unsafe-vector-length + orig-mpis_0)))) + (case-lambda + ((vec_0 len_1) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0 pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_1) + (let ((mpi_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (let ((i_1 + (let ((i_1 + i_0)) + (let ((i_2 + (begin + (unsafe-vector*-set! + v_0 + i_1 + (module-path-index-shift + mpi_0 + orig-base-mpi_0 + base-mpi6_0)) + (unsafe-fx+ + 1 + i_1)))) + (values + i_2))))) + (if (if (not + (let ((x_0 + (list + mpi_0))) + (unsafe-fx= + i_1 + len_0))) + #t + #f) + (for-loop_0 + i_1 + (unsafe-fx+ + 1 + pos_0)) + i_1))) + i_0)))))) + (for-loop_0 0 0)))) + (args + (raise-binding-result-arity-error + 2 + args))))) + v_0)))) + orig-mpis_0))) + (let ((bulk-binding-registry_0 + (if (serialized-syntax-need-registry? + data7_0) + (namespace-bulk-binding-registry + (1/current-namespace)) + #f))) + (deserialize-data + shifted-mpis_0 + #f + bulk-binding-registry_0 + (serialized-syntax-data data7_0))))))))))))))) + (|#%name| + syntax-deserialize + (case-lambda + ((data_0) (begin (syntax-deserialize_0 data_0 #f))) + ((data_0 base-mpi6_0) (syntax-deserialize_0 data_0 base-mpi6_0)))))) (define 1/variable-reference->empty-namespace (|#%name| variable-reference->empty-namespace @@ -72476,6 +73297,8 @@ 'syntax-binding-set? 'syntax-binding-set-extend 'syntax-binding-set->syntax + 'syntax-serialize + 'syntax-deserialize 'raise-syntax-error 'struct:exn:fail:syntax 'exn:fail:syntax @@ -72575,7 +73398,7 @@ 'variable-reference->module-declaration-inspector 'read-syntax 'read-syntax/recursive)) -(define effect_2769 +(define effect_2684 (begin (void (begin @@ -72645,6 +73468,8 @@ (add-core-primitive! 'syntax-binding-set->syntax 1/syntax-binding-set->syntax) + (add-core-primitive! 'syntax-serialize 1/syntax-serialize) + (add-core-primitive! 'syntax-deserialize 1/syntax-deserialize) (add-core-primitive! 'raise-syntax-error raise-syntax-error$1) (add-core-primitive! 'struct:exn:fail:syntax 1/struct:exn:fail:syntax) (add-core-primitive! 'exn:fail:syntax make-exn:fail:syntax$1) diff --git a/racket/src/expander/boot/core-primitive.rkt b/racket/src/expander/boot/core-primitive.rkt index 31439bfb06..d8a6197e6d 100644 --- a/racket/src/expander/boot/core-primitive.rkt +++ b/racket/src/expander/boot/core-primitive.rkt @@ -21,6 +21,7 @@ "../syntax/api.rkt" "../syntax/api-taint.rkt" "../syntax/error.rkt" + "../syntax/serialize.rkt" "../read/api.rkt" "../common/module-path.rkt" "../namespace/variable-reference.rkt" @@ -85,6 +86,9 @@ syntax-binding-set-extend syntax-binding-set->syntax + syntax-serialize + syntax-deserialize + raise-syntax-error struct:exn:fail:syntax exn:fail:syntax diff --git a/racket/src/expander/compile/header.rkt b/racket/src/expander/compile/header.rkt index 92e770bfbe..c577b53628 100644 --- a/racket/src/expander/compile/header.rkt +++ b/racket/src/expander/compile/header.rkt @@ -160,7 +160,7 @@ ,(generate-deserialize (vector->immutable-vector (list->vector (reverse (syntax-literals-stxes sl)))) - mpis))) + #:mpis mpis))) (set! ,deserialize-syntax-id #f)))))])) (define (generate-lazy-syntax-literal-lookup pos) @@ -180,7 +180,7 @@ (encode-namespace-scopes ns) (reverse (syntax-literals-stxes sl))) - mpis)]) + #:mpis mpis)]) (let-values ([(ns-scope-s) (car ns+stxss)]) (list->vector (map (lambda (stx) diff --git a/racket/src/expander/compile/serialize-state.rkt b/racket/src/expander/compile/serialize-state.rkt index 1f0914c834..4e608b7111 100644 --- a/racket/src/expander/compile/serialize-state.rkt +++ b/racket/src/expander/compile/serialize-state.rkt @@ -28,10 +28,14 @@ props ; map full props to previously calculated interned-props ; intern filtered props syntax-context ; used to collapse encoding of syntax literals - sharing-syntaxes) ; record which syntax objects are `datum->syntax` form + sharing-syntaxes ; record which syntax objects are `datum->syntax` form + preserve-prop-keys ; property keys to preserve (that otherwise wouldn't be) + keep-provides?) ; non-#f => predicate for when to keep bulk provides #:authentic) -(define (make-serialize-state reachable-scopes) +(define (make-serialize-state reachable-scopes + preserve-prop-keys + keep-provides?) (define state (serialize-state reachable-scopes (make-hasheq) ; bindings-intern @@ -44,7 +48,9 @@ (make-hasheq) ; props (make-hash) ; interned-props (box null) ; syntax-context - (make-hasheq))) ; sharing-syntaxes + (make-hasheq) ; sharing-syntaxes + preserve-prop-keys + keep-provides?)) ;; Seed intern tables for sets and hashes to use the canonical ;; empty version for consistent sharing: (define empty-seteq (seteq)) diff --git a/racket/src/expander/compile/serialize.rkt b/racket/src/expander/compile/serialize.rkt index eba4871003..f0e1b55d6d 100644 --- a/racket/src/expander/compile/serialize.rkt +++ b/racket/src/expander/compile/serialize.rkt @@ -19,7 +19,7 @@ "built-in-symbol.rkt" "reserved-symbol.rkt") -;; Serialization is mostly for syntax object and module path indexes. +;; Serialization is mostly for syntax objects and module path indexes. ;; ;; Serialization is implemented by a combination of direct handling ;; for some primitive datatypes, `prop:serialize` handlers attached @@ -73,12 +73,14 @@ add-module-path-index! add-module-path-index!/pos generate-module-path-index-deserialize + deserialize-module-path-index-data mpis-as-vector generate-module-data-linklet generate-module-declaration-linklet - generate-deserialize + generate-deserialize ; i.e., `serialize` + deserialize-data deserialize-instance deserialize-imports @@ -112,7 +114,8 @@ (hash-set! positions mpi pos) pos)))])) -(define (generate-module-path-index-deserialize mpis) +(define (generate-module-path-index-deserialize mpis + #:as-data? [as-data? #f]) (define (unique-list v) (if (pair? v) (for/list ([i (in-list v)]) i) ; avoid non-deterministic sharing @@ -150,13 +153,18 @@ (vector path)] [base (vector path (hash-ref gen-order base))]))) - `(deserialize-module-path-indexes - ;; Vector of deserialization instructions, where earlier - ;; must be constructed first: - ',gens - ;; Vector of reordering to match reference order: - ',(for/vector ([i (in-range (hash-count rev-positions))]) - (hash-ref gen-order (hash-ref rev-positions i))))) + (define reorder-vec + (for/vector ([i (in-range (hash-count rev-positions))]) + (hash-ref gen-order (hash-ref rev-positions i)))) + (cond + [as-data? (vector gens reorder-vec)] + [else + `(deserialize-module-path-indexes + ;; Vector of deserialization instructions, where earlier + ;; must be constructed first: + ',gens + ;; Vector of reordering to match reference order: + ',reorder-vec)])) (define (deserialize-module-path-indexes gen-vec order-vec) (define gen (make-vector (vector-length gen-vec) #f)) @@ -175,6 +183,11 @@ (for/vector #:length (vector-length order-vec) ([p (in-vector order-vec)]) (vector*-ref gen p))) +(define (deserialize-module-path-index-data v) + (unless (and (vector? v) (= 2 (vector-length v))) + (error 'syntax-deserialize "ill-formed serialization")) + (deserialize-module-path-indexes (vector-ref v 0) (vector-ref v 1))) + (define (mpis-as-vector mpis) (define positions (module-path-index-table-positions mpis)) (define vec (make-vector (hash-count positions) #f)) @@ -226,8 +239,8 @@ phase-to-link-modules) ;; body (define-values (self-mpi) ,(add-module-path-index! mpis self)) - (define-values (requires) ,(generate-deserialize requires mpis #:syntax-support? #f)) - (define-values (provides) ,(generate-deserialize provides mpis #:syntax-support? #f)) + (define-values (requires) ,(generate-deserialize requires #:mpis mpis #:syntax-support? #f)) + (define-values (provides) ,(generate-deserialize provides #:mpis mpis #:syntax-support? #f)) (define-values (phase-to-link-modules) ,phase-to-link-module-uses-expr))) ;; ---------------------------------------- @@ -261,11 +274,24 @@ ;; ---------------------------------------- ;; Serialization for everything else -(define (generate-deserialize v mpis #:syntax-support? [syntax-support? #t]) - (define reachable-scopes (find-reachable-scopes v)) - - (define state (make-serialize-state reachable-scopes)) - +(define (generate-deserialize v + #:mpis mpis + #:as-data? [as-data? #f] + #:syntax-support? [syntax-support? #t] + #:preserve-prop-keys [preserve-prop-keys #hasheq()] + #:keep-provides? [keep-provides? #f]) + (define bulk-shifts (and keep-provides? (list (make-hasheq)))) + + (define reachable-scopes (find-reachable-scopes v bulk-shifts)) + + (define state (make-serialize-state reachable-scopes + preserve-prop-keys + (and keep-provides? + (lambda (b) + (define name (hash-ref (car bulk-shifts) b #f)) + (or (not name) ; shouldn't happen + (keep-provides? name)))))) + (define mutables (make-hasheq)) ; v -> pos (define objs (make-hasheq)) ; v -> step (define shares (make-hasheq)) ; v -> #t @@ -612,29 +638,38 @@ (reap-stream!))) ;; Put it all together: - (define (finish mutable-shell-bindings-expr shared-bindings-expr mutable-fills-expr result-expr) - `(deserialize - ,mpi-vector-id - ,(if syntax-support? inspector-id #f) - ,(if syntax-support? bulk-binding-registry-id #f) - ',(hash-count mutables) - ,mutable-shell-bindings-expr - ',(hash-count shares) - ,shared-bindings-expr - ,mutable-fills-expr - ,result-expr)) + (cond + [as-data? + (vector (hash-count mutables) + mutable-shell-bindings + (hash-count shares) + shared-bindings + mutable-fills + result)] + [else + (define (finish mutable-shell-bindings-expr shared-bindings-expr mutable-fills-expr result-expr) + `(deserialize + ,mpi-vector-id + ,(if syntax-support? inspector-id #f) + ,(if syntax-support? bulk-binding-registry-id #f) + ',(hash-count mutables) + ,mutable-shell-bindings-expr + ',(hash-count shares) + ,shared-bindings-expr + ,mutable-fills-expr + ,result-expr)) - ;; Putting the quoted-data construction into one vector makes - ;; it easy to specialize in some back ends to a more compact - ;; format. - `(let-values ([(data) ',(vector mutable-shell-bindings - shared-bindings - mutable-fills - result)]) - ,(finish '(unsafe-vector*-ref data 0) - '(unsafe-vector*-ref data 1) - '(unsafe-vector*-ref data 2) - '(unsafe-vector*-ref data 3)))) + ;; Putting the quoted-data construction into one vector makes + ;; it easy to specialize in some back ends to a more compact + ;; format. + `(let-values ([(data) ',(vector mutable-shell-bindings + shared-bindings + mutable-fills + result)]) + ,(finish '(unsafe-vector*-ref data 0) + '(unsafe-vector*-ref data 1) + '(unsafe-vector*-ref data 2) + '(unsafe-vector*-ref data 3)))])) (define (sorted-hash-keys ht) (define ks (hash-keys ht)) @@ -688,6 +723,17 @@ (decode result-vec 0 mpis inspector bulk-binding-registry shared)) result) +(define (deserialize-data mpis inspector bulk-binding-registry data) + (unless (and (vector? data) (= 6 (vector-length data))) + (error 'syntax-deserialize "ill-formed serialization")) + (deserialize mpis inspector bulk-binding-registry + (vector-ref data 0) + (vector-ref data 1) + (vector-ref data 2) + (vector-ref data 3) + (vector-ref data 4) + (vector-ref data 5))) + ;; Decode the construction of a mutable variable (define (decode-shell vec pos mpis inspector bulk-binding-registry shared) (case (vector*-ref vec pos) @@ -825,6 +871,8 @@ (decode* (deserialize-full-local-binding key free=id))] [(#:bulk-binding) (decode* (deserialize-bulk-binding prefix excepts mpi provide-phase-level phase-shift bulk-binding-registry))] + [(#:bulk-binding+provides) + (decode* (deserialize-bulk-binding+provides provides self prefix excepts mpi provide-phase-level phase-shift bulk-binding-registry))] [(#:provided) (decode* (deserialize-provided binding protected? syntax?))] [else @@ -874,13 +922,23 @@ ;; ---------------------------------------- ;; For pruning unreachable scopes in serialization -(define (find-reachable-scopes v) +(define (find-reachable-scopes v bulk-shifts) (define seen (make-hasheq)) (define reachable-scopes (seteq)) (define (get-reachable-scopes) reachable-scopes) (define scope-triggers (make-hasheq)) - (let loop ([v v]) + ;; `bulk-shifts` is used to propagate shifts from a syntax object to + ;; binding tables when bulk-binding provides will be preserved, in + ;; case scope-specific bindings need to be reified; a `bulk-shifts` + ;; list an an `extra-shifts` prefixed by an eq-based table to record + ;; resolved module paths; setting it to #f means that bulk-binding + ;; provides are not preserved (i.e., they will be shared with the + ;; providing module on demand), and no bulk-shifts propagation is + ;; needed; for now, we conservatively force all bulk-binding + ;; provides to be reified when any will be preserved + + (let loop ([v v] [bulk-shifts bulk-shifts]) (cond [(interned-literal? v) (void)] [(hash-ref seen v #f) (void)] @@ -889,8 +947,8 @@ (cond [(scope-with-bindings? v) (set! reachable-scopes (set-add reachable-scopes v)) - - ((reach-scopes-ref v) v loop) + + ((reach-scopes-ref v) v bulk-shifts loop) (for ([proc (in-list (hash-ref scope-triggers v null))]) (proc loop)) @@ -903,6 +961,7 @@ ((scope-with-bindings-ref v) v get-reachable-scopes + bulk-shifts loop (lambda (sc-unreachable b) (hash-update! scope-triggers @@ -910,24 +969,24 @@ (lambda (l) (cons b l)) null)))] [(reach-scopes? v) - ((reach-scopes-ref v) v loop)] + ((reach-scopes-ref v) v bulk-shifts loop)] [(pair? v) - (loop (car v)) - (loop (cdr v))] + (loop (car v) bulk-shifts) + (loop (cdr v) bulk-shifts)] [(vector? v) (for ([e (in-vector v)]) - (loop e))] + (loop e bulk-shifts))] [(box? v) - (loop (unbox v))] + (loop (unbox v) bulk-shifts)] [(hash? v) (for ([(k v) (in-hash v)]) - (loop k) - (loop v))] + (loop k bulk-shifts) + (loop v bulk-shifts))] [(prefab-struct-key v) (for ([e (in-vector (struct->vector v) 1)]) - (loop e))] + (loop e bulk-shifts))] [(srcloc? v) - (loop (srcloc-source v))] + (loop (srcloc-source v) bulk-shifts)] [else (void)])])) diff --git a/racket/src/expander/demo.rkt b/racket/src/expander/demo.rkt index fbb47e95b8..bbc80d0238 100644 --- a/racket/src/expander/demo.rkt +++ b/racket/src/expander/demo.rkt @@ -21,6 +21,10 @@ #:namespace [ns demo-ns] #:serializable? [serializable? #f]) (define exp-e (expand-expression e #:namespace ns)) + (when check-serialize? + (unless (equal? (syntax->datum (syntax-deserialize (syntax-serialize exp-e))) + (syntax->datum exp-e)) + (error "serialization problem"))) (define c (compile (if check-reexpand? exp-e e) ns (or serializable? check-serialize?))) (define ready-c (if check-serialize? @@ -1452,3 +1456,13 @@ (check-print (namespace-require ''to-recompile demo-ns) 0))) + +;; ---------------------------------------- +;; Serialization with otherwise non-preserved properties + +(let ([s (syntax-property (datum->syntax #f 'hello) + 'keep-me + 17)]) + (check-value (syntax-property s 'keep-me) 17) + (check-value (syntax-property (syntax-deserialize (syntax-serialize s)) 'keep-me) #f) + (check-value (syntax-property (syntax-deserialize (syntax-serialize s #f '(keep-me))) 'keep-me) 17)) diff --git a/racket/src/expander/main.rkt b/racket/src/expander/main.rkt index 0d9cabeeae..2d10022bd1 100644 --- a/racket/src/expander/main.rkt +++ b/racket/src/expander/main.rkt @@ -36,6 +36,7 @@ (only-in "syntax/cache.rkt" cache-place-init!) (only-in "syntax/syntax.rkt" syntax-place-init!) (only-in "syntax/scope.rkt" scope-place-init!) + "syntax/serialize.rkt" (only-in "eval/module-cache.rkt" module-cache-place-init!) (only-in "common/performance.rkt" performance-place-init!) (only-in "eval/shadow-directory.rkt" shadow-directory-place-init!)) @@ -135,6 +136,9 @@ syntax-shift-phase-level bound-identifier=? + syntax-serialize + syntax-deserialize + compiled-expression-recompile) ;; ---------------------------------------- diff --git a/racket/src/expander/syntax/binding-table.rkt b/racket/src/expander/syntax/binding-table.rkt index c5e43895fe..fc577a4fa2 100644 --- a/racket/src/expander/syntax/binding-table.rkt +++ b/racket/src/expander/syntax/binding-table.rkt @@ -4,7 +4,8 @@ "../compile/serialize-property.rkt" "../compile/serialize-state.rkt" "syntax.rkt" - "module-binding.rkt") + "module-binding.rkt" + "full-binding.rkt") ;; A binding table within a scope maps symbol plus scope set ;; combinations (where the scope binding the binding table is always @@ -65,7 +66,7 @@ (ser-push! (bulk-binding-at-scopes bba)) (ser-push! (bulk-binding-at-bulk bba))) #:property prop:reach-scopes - (lambda (sms reach) + (lambda (sms extra-scopes reach) ;; bulk bindings are pruned depending on whether all scopes ;; in `scopes` are reachable, and we shouldn't get here ;; when looking for scopes @@ -82,15 +83,24 @@ ;; Value of `prop:bulk-binding` (struct bulk-binding-class (get-symbols ; bulk-binding list-of-shift -> sym -> binding-info - create)) ; bul-binding -> binding-info sym -> binding + create ; bulk-binding -> binding-info sym -> binding + modname)) ; bulk-binding list-of-shift -> resolved-module-path (define (bulk-binding-symbols b s extra-shifts) ;; Providing the identifier `s` supports its shifts ((bulk-binding-class-get-symbols (bulk-binding-ref b)) - b + b (append extra-shifts (if s (syntax-mpi-shifts s) null)))) (define (bulk-binding-create b) (bulk-binding-class-create (bulk-binding-ref b))) +(define (force-bulk-bindings b bulk-shifts) + (define modname-ht (car bulk-shifts)) + (define extra-shifts (cdr bulk-shifts)) + ;; record resolved module path + (hash-set! modname-ht b ((bulk-binding-class-modname (bulk-binding-ref b)) b extra-shifts)) + ;; getting symbols has the effect of forcing: + (bulk-binding-symbols b #f extra-shifts)) + ;; ---------------------------------------- (define (binding-table-empty? bt) @@ -341,7 +351,7 @@ (hash-set! (serialize-state-bulk-bindings-intern state) bt new-bt) new-bt))) -(define (binding-table-register-reachable bt get-reachable-scopes reach register-trigger) +(define (binding-table-register-reachable bt get-reachable-scopes bulk-shifts reach register-trigger) ;; Check symbol-specific scopes for both `free-id=?` reachability and ;; for implicitly reachable scopes (for* ([(sym bindings-for-sym) (in-immutable-hash (if (hash? bt) @@ -350,17 +360,19 @@ [(scopes binding) (in-immutable-hash bindings-for-sym)]) (define v (and (binding-reach-scopes? binding) ((binding-reach-scopes-ref binding) binding))) - (scopes-register-reachable scopes v get-reachable-scopes reach register-trigger)) + (scopes-register-reachable scopes v get-reachable-scopes bulk-shifts reach register-trigger)) ;; Need to check bulk-binding scopes for implicitly reachable (when (table-with-bulk-bindings? bt) (for ([bba (in-list (table-with-bulk-bindings-bulk-bindings bt))]) - (scopes-register-reachable (bulk-binding-at-scopes bba) #f get-reachable-scopes reach register-trigger)))) + (when bulk-shifts ; indicates that bulk bindings will be retained, and maybe they need to be reified + (force-bulk-bindings (bulk-binding-at-bulk bba) bulk-shifts)) + (scopes-register-reachable (bulk-binding-at-scopes bba) #f get-reachable-scopes bulk-shifts reach register-trigger)))) -(define (scopes-register-reachable scopes v get-reachable-scopes reach register-trigger) +(define (scopes-register-reachable scopes v get-reachable-scopes bulk-shifts reach register-trigger) (define reachable-scopes (get-reachable-scopes)) (cond [(subset? scopes reachable-scopes) - (reach v)] + (reach v bulk-shifts)] [else ;; There may be implicitly reachable scopes (i.e., multi-scope ;; representatives that should only be reachable if they @@ -374,10 +386,10 @@ (when (zero? (hash-count pending-scopes)) ;; All scopes became reachable, so make the value reachable, ;; and declare implcitily reachables as explicitly reachable - (reach v) + (reach v bulk-shifts) (for ([sc (in-set scopes)]) (when (implicitly-reachable? sc) - (reach sc))))) + (reach sc bulk-shifts))))) (for ([sc (in-set pending-scopes)]) (register-trigger sc (lambda (reach) (set! pending-scopes (hash-remove pending-scopes sc)) diff --git a/racket/src/expander/syntax/bulk-binding.rkt b/racket/src/expander/syntax/bulk-binding.rkt index 2739ee9e74..ed336aace3 100644 --- a/racket/src/expander/syntax/bulk-binding.rkt +++ b/racket/src/expander/syntax/bulk-binding.rkt @@ -1,5 +1,6 @@ #lang racket/base (require "../compile/serialize-property.rkt" + "../compile/serialize-state.rkt" "binding-table.rkt" ; defines `prop:bulk-binding` "binding.rkt" "../common/module-path.rkt" @@ -14,7 +15,8 @@ bulk-binding bulk-provides-add-prefix-remove-exceptions - deserialize-bulk-binding) + deserialize-bulk-binding + deserialize-bulk-binding+provides) ;; When a require is something like `(require racket/base)`, then ;; we'd like to import the many bindings from `racket/base` in one @@ -82,13 +84,11 @@ #:authentic #:property prop:bulk-binding (bulk-binding-class + ;; get-symbols (lambda (b mpi-shifts) (or (bulk-binding-provides b) ;; Here's where we find provided bindings for unmarshaled syntax - (let ([mod-name (module-path-index-resolve - (apply-syntax-shifts - (bulk-binding-mpi b) - mpi-shifts))]) + (let ([mod-name (bulk-binding-module-name b mpi-shifts)]) (unless (bulk-binding-bulk-binding-registry b) (error "namespace mismatch: no bulk-binding registry available:" mod-name)) @@ -112,6 +112,7 @@ ;; Record the adjusted `provides` table for quick future access: (set-bulk-binding-provides! b adjusted-provides) adjusted-provides))) + ;; create (lambda (b binding sym) ;; Convert the provided binding to a required binding on ;; demand during binding resolution @@ -124,11 +125,21 @@ #:self (bulk-binding-self b) #:mpi (bulk-binding-mpi b) #:provide-phase-level (bulk-binding-provide-phase-level b) - #:phase-shift (bulk-binding-phase-shift b)))) + #:phase-shift (bulk-binding-phase-shift b))) + ;; modname + (lambda (b mpi-shifts) + (bulk-binding-module-name b mpi-shifts))) #:property prop:serialize ;; Serialization drops the `provides` table and the providing module's `self` - (lambda (b ser-push! reachable-scopes) - (ser-push! 'tag '#:bulk-binding) + (lambda (b ser-push! state) + (cond + [(and (serialize-state-keep-provides? state) + ((serialize-state-keep-provides? state) b)) + (ser-push! 'tag '#:bulk-binding+provides) + (ser-push! (bulk-binding-provides b)) + (ser-push! (bulk-binding-self b))] + [else + (ser-push! 'tag '#:bulk-binding)]) (ser-push! (bulk-binding-prefix b)) (ser-push! (bulk-binding-excepts b)) (ser-push! (bulk-binding-mpi b)) @@ -139,6 +150,9 @@ (define (deserialize-bulk-binding prefix excepts mpi provide-phase-level phase-shift bulk-binding-registry) (bulk-binding #f prefix excepts #f mpi provide-phase-level phase-shift bulk-binding-registry)) +(define (deserialize-bulk-binding+provides provides self prefix excepts mpi provide-phase-level phase-shift bulk-binding-registry) + (bulk-binding provides prefix excepts self mpi provide-phase-level phase-shift bulk-binding-registry)) + (define (bulk-provides-add-prefix-remove-exceptions provides prefix excepts) (for/hash ([(sym val) (in-hash provides)] #:unless (hash-ref excepts sym #f) @@ -149,6 +163,12 @@ sym) val))) +(define (bulk-binding-module-name b mpi-shifts) + (module-path-index-resolve + (apply-syntax-shifts + (bulk-binding-mpi b) + mpi-shifts))) + ;; ---------------------------------------- ;; A blk binding registry has just the provde part of a module, for diff --git a/racket/src/expander/syntax/scope.rkt b/racket/src/expander/syntax/scope.rkt index 703a27e10e..82e147339b 100644 --- a/racket/src/expander/syntax/scope.rkt +++ b/racket/src/expander/syntax/scope.rkt @@ -108,13 +108,14 @@ (ser-push! 'tag '#:scope-fill!) (ser-push! (binding-table-prune-to-reachable (scope-binding-table s) state))])) #:property prop:reach-scopes - (lambda (s reach) + (lambda (s extra-shifts reach) ;; the `bindings` field is handled via `prop:scope-with-bindings` (void)) #:property prop:scope-with-bindings - (lambda (s get-reachable-scopes reach register-trigger) + (lambda (s get-reachable-scopes extra-shifts reach register-trigger) (binding-table-register-reachable (scope-binding-table s) get-reachable-scopes + extra-shifts reach register-trigger))) @@ -181,11 +182,11 @@ (hash-set! multi-scope-tables (multi-scope-scopes ms) ht) ht)))) #:property prop:reach-scopes - (lambda (s reach) + (lambda (s extra-shifts reach) ;; the `scopes` field is handled via `prop:scope-with-bindings` (void)) #:property prop:scope-with-bindings - (lambda (ms get-reachable-scopes reach register-trigger) + (lambda (ms get-reachable-scopes bulk-shifts reach register-trigger) ;; This scope is reachable via its multi-scope, but it only ;; matters if it's reachable through a binding (otherwise it ;; can be re-generated later). We don't want to keep a scope @@ -201,7 +202,7 @@ ;; them differently, hence `prop:implicitly-reachable`. (for ([sc (in-hash-values (unbox (multi-scope-scopes ms)))]) (unless (binding-table-empty? (scope-binding-table sc)) - (reach sc))))) + (reach sc bulk-shifts))))) (define (deserialize-multi-scope name scopes) (multi-scope (new-deserialize-scope-id!) name (box scopes) (box (hasheqv)) (box (hash)))) @@ -231,9 +232,9 @@ (ser-push! (binding-table-prune-to-reachable (scope-binding-table s) state)) (ser-push! (representative-scope-owner s))) #:property prop:reach-scopes - (lambda (s reach) + (lambda (s bulk-shifts reach) ;; the inherited `bindings` field is handled via `prop:scope-with-bindings` - (reach (representative-scope-owner s))) + (reach (representative-scope-owner s) bulk-shifts)) ;; Used by `binding-table-register-reachable`: #:property prop:implicitly-reachable #t) @@ -262,8 +263,8 @@ (ser-push! (shifted-multi-scope-phase sms)) (ser-push! (shifted-multi-scope-multi-scope sms))) #:property prop:reach-scopes - (lambda (sms reach) - (reach (shifted-multi-scope-multi-scope sms)))) + (lambda (sms bulk-shifts reach) + (reach (shifted-multi-scope-multi-scope sms) bulk-shifts))) (define (deserialize-shifted-multi-scope phase multi-scope) (intern-shifted-multi-scope phase multi-scope)) diff --git a/racket/src/expander/syntax/serialize.rkt b/racket/src/expander/syntax/serialize.rkt new file mode 100644 index 0000000000..18bc6e45d6 --- /dev/null +++ b/racket/src/expander/syntax/serialize.rkt @@ -0,0 +1,68 @@ +#lang racket/base +(require "../common/contract.rkt" + "../syntax/syntax.rkt" + "../compile/serialize.rkt" + "../common/module-path.rkt" + "../namespace/namespace.rkt" + "../eval/protect.rkt") + +(provide syntax-serialize + syntax-deserialize) + +(struct serialized-syntax (version mpis base-mpi-pos data need-registry?) + #:prefab) + +(define/who (syntax-serialize stx + [base-mpi #f] + [preserve-prop-keys '()] + [provides-namespace (current-namespace)]) + (check who syntax? stx) + (check who module-path-index? #:or-false base-mpi) + (check who (lambda (l) (and (list? l) (andmap symbol? l))) + #:contract "(listof symbol?)" + preserve-prop-keys) + (check who namespace? #:or-false provides-namespace) + (define mpis (make-module-path-index-table)) + (define base-mpi-pos (and base-mpi + (add-module-path-index!/pos mpis base-mpi))) + (define data (generate-deserialize stx + #:mpis mpis + #:as-data? #t + #:preserve-prop-keys (for/hasheq ([k (in-list preserve-prop-keys)]) + (values k #t)) + #:keep-provides? + (if provides-namespace + (lambda (modname) + (not (namespace->module provides-namespace modname))) + (lambda (modname) #t)))) + (serialized-syntax (version) + (generate-module-path-index-deserialize mpis #:as-data? #t) + base-mpi-pos + data + (and provides-namespace #t))) + +(define/who (syntax-deserialize data [base-mpi #f]) + (check who module-path-index? #:or-false base-mpi) + (unless (serialized-syntax? data) + (raise-arguments-error who "invalid serialized form" "value" data)) + (unless (equal? (version) (serialized-syntax-version data)) + (raise-arguments-error who + "version mismatch" + "expected" (version) + "found" (serialized-syntax-version data))) + ;; deserialization is unsafe, so only allow it with the original code inspector: + (unless (eq? (current-code-inspector) initial-code-inspector) + (error who "deserialization disallowed by code inspector")) + (define orig-mpis (deserialize-module-path-index-data (serialized-syntax-mpis data))) + (define orig-base-mpi (and base-mpi + (let ([pos (serialized-syntax-base-mpi-pos data)]) + (and pos + (vector-ref orig-mpis pos))))) + (define shifted-mpis + (if orig-base-mpi + (for/vector #:length (vector-length orig-mpis) ([mpi (in-vector orig-mpis)]) + (module-path-index-shift mpi orig-base-mpi base-mpi)) + orig-mpis)) + (define bulk-binding-registry (and (serialized-syntax-need-registry? data) + (namespace-bulk-binding-registry (current-namespace)))) + (deserialize-data shifted-mpis #f bulk-binding-registry (serialized-syntax-data data))) diff --git a/racket/src/expander/syntax/syntax.rkt b/racket/src/expander/syntax/syntax.rkt index 693ce1ebbf..9e13ea7457 100644 --- a/racket/src/expander/syntax/syntax.rkt +++ b/racket/src/expander/syntax/syntax.rkt @@ -84,8 +84,10 @@ (intern-properties (syntax-props s) (lambda () + (define preserve-keys (serialize-state-preserve-prop-keys state)) (for/hasheq ([(k v) (in-hash (syntax-props s))] - #:when (preserved-property-value? v)) + #:when (or (preserved-property-value? v) + (hash-ref preserve-keys k #f))) (values k (check-value-to-preserve (plain-property-value v) syntax?)))) state)) (define tamper @@ -151,7 +153,7 @@ (equal? (syntax-srcloc s) (syntax-state-srcloc stx-state))) (set-syntax-state-all-sharing?! stx-state #f)))])) #:property prop:reach-scopes - (lambda (s reach) + (lambda (s bulk-shifts reach) (define content* (syntax-content* s)) (reach (if (modified-content? content*) @@ -159,13 +161,16 @@ (if (propagation? prop) ((propagation-ref prop) s) (modified-content-content content*))) - content*)) - (reach (syntax-scopes s)) - (reach (syntax-shifted-multi-scopes s)) + content*) + bulk-shifts) + (define shifts (and bulk-shifts + (append bulk-shifts (syntax-mpi-shifts s)))) + (reach (syntax-scopes s) shifts) + (reach (syntax-shifted-multi-scopes s) shifts) (for ([(k v) (in-immutable-hash (syntax-props s))] #:when (preserved-property-value? v)) - (reach (plain-property-value v))) - (reach (syntax-srcloc s)))) + (reach (plain-property-value v) bulk-shifts)) + (reach (syntax-srcloc s) bulk-shifts))) ;; Property to abstract over handling of propagation for ;; serialization; property value takes a syntax object and diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index 0090cfe8a5..11b11075a8 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 8 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 12 +#define MZSCHEME_VERSION_W 13 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x