From 0523a5311ce95ab9658a585e59c907433db9fdf9 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 13 Feb 2021 07:01:06 -0700 Subject: [PATCH] add structure-type sealing The predicate for a seald structure type can be faster than a predicate for a non-sealed structure type, and Chez Scheme takes advantage of that opportunity. The BC JIT could be improved to take advanatge of sealed structure types, but it isn't. This commit also fixes CS checking of a supertype for certain shapes of prefab struct-type declarations. --- .makefile | 2 +- Makefile | 12 +- pkgs/base/info.rkt | 2 +- .../scribblings/reference/define-struct.scrbl | 14 +- .../reference/struct-inspectors.scrbl | 17 + .../scribblings/reference/struct.scrbl | 16 + .../racket-test-core/tests/racket/struct.rktl | 69 + .../collects/racket/private/define-struct.rkt | 26 +- racket/src/ChezScheme/csug/objects.stex | 2 +- racket/src/ChezScheme/makefiles/Mf-install.in | 2 +- racket/src/ChezScheme/s/cmacros.ss | 3 +- racket/src/ChezScheme/s/cpnanopass.ss | 2 + racket/src/ChezScheme/s/primdata.ss | 2 + racket/src/ChezScheme/s/record.ss | 18 +- racket/src/bc/src/schminc.h | 2 +- racket/src/bc/src/schpriv.h | 14 +- racket/src/bc/src/startup.inc | 7 +- racket/src/bc/src/struct.c | 83 +- racket/src/cs/compile-file.ss | 2 +- racket/src/cs/primitive/internal.ss | 2 +- racket/src/cs/primitive/kernel.ss | 3 + racket/src/cs/rumble.sls | 12 +- racket/src/cs/rumble/error-rewrite.ss | 8 +- racket/src/cs/rumble/struct.ss | 403 +- racket/src/cs/schemified/expander.scm | 3421 +++++++------- racket/src/cs/schemified/io.scm | 1730 +++---- racket/src/cs/schemified/known.scm | 1124 ++--- racket/src/cs/schemified/regexp.scm | 360 +- racket/src/cs/schemified/schemify.scm | 4134 +++++++++-------- racket/src/cs/schemified/thread.scm | 1496 +++--- .../src/expander/compile/built-in-symbol.rkt | 3 +- racket/src/expander/syntax/scope.rkt | 3 + racket/src/expander/syntax/syntax.rkt | 1 + racket/src/schemify/find-definition.rkt | 13 +- racket/src/schemify/inline.rkt | 1 + racket/src/schemify/known.rkt | 9 +- racket/src/schemify/schemify.rkt | 9 +- racket/src/schemify/struct-convert.rkt | 35 +- racket/src/schemify/struct-type-info.rkt | 2 + racket/src/thread/thread.rkt | 1 + racket/src/version/racket_version.h | 2 +- 41 files changed, 6760 insertions(+), 6307 deletions(-) diff --git a/.makefile b/.makefile index d8b3308bfe..3407359659 100644 --- a/.makefile +++ b/.makefile @@ -344,7 +344,7 @@ RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) # This branch name changes each time the pb boot files are updated: -PB_BRANCH == circa-8.0.0.6-3 +PB_BRANCH == circa-8.0.0.7-1 PB_REPO = https://github.com/racket/pb # Alternative source for Chez Scheme boot files, normally set by diff --git a/Makefile b/Makefile index e800e63425..7badf755d7 100644 --- a/Makefile +++ b/Makefile @@ -47,7 +47,7 @@ RACKETCS_SUFFIX = RACKET = RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) -PB_BRANCH = circa-8.0.0.6-3 +PB_BRANCH = circa-8.0.0.7-1 PB_REPO = https://github.com/racket/pb EXTRA_REPOS_BASE = CS_CROSS_SUFFIX = @@ -309,18 +309,18 @@ maybe-fetch-pb-as-is: echo done fetch-pb-from: mkdir -p racket/src/ChezScheme/boot - if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-8.0.0.6-3 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-8.0.0.6-3:remotes/origin/circa-8.0.0.6-3 ; fi - cd racket/src/ChezScheme/boot/pb && git checkout -q circa-8.0.0.6-3 + if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-8.0.0.7-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-8.0.0.7-1:remotes/origin/circa-8.0.0.7-1 ; fi + cd racket/src/ChezScheme/boot/pb && git checkout -q circa-8.0.0.7-1 pb-fetch: $(MAKE) fetch-pb EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" PB_REPO="$(PB_REPO)" pb-build: cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb pb-stage: - cd racket/src/ChezScheme/boot/pb && git branch circa-8.0.0.6-3 - cd racket/src/ChezScheme/boot/pb && git checkout circa-8.0.0.6-3 + cd racket/src/ChezScheme/boot/pb && git branch circa-8.0.0.7-1 + cd racket/src/ChezScheme/boot/pb && git checkout circa-8.0.0.7-1 cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build" pb-push: - cd racket/src/ChezScheme/boot/pb && git push -u origin circa-8.0.0.6-3 + cd racket/src/ChezScheme/boot/pb && git push -u origin circa-8.0.0.7-1 win-cs-base: IF "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-bc-then-cs-base SETUP_BOOT_MODE=--boot WIN32_BUILD_LEVEL=bc PLAIN_RACKET=racket\racketbc DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETBC_SUFFIX="$(RACKETBC_SUFFIX)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" IF not "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-just-cs-base SETUP_BOOT_MODE=--chain DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" RACKET_FOR_BUILD="$(RACKET_FOR_BUILD)" diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 8ee39a3fe9..4eaf49157b 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.6") +(define version "8.0.0.7") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/define-struct.scrbl b/pkgs/racket-doc/scribblings/reference/define-struct.scrbl index a0f84ce2a6..807c0fa35f 100644 --- a/pkgs/racket-doc/scribblings/reference/define-struct.scrbl +++ b/pkgs/racket-doc/scribblings/reference/define-struct.scrbl @@ -25,6 +25,7 @@ (code:line #:property prop-expr val-expr) (code:line #:transparent) (code:line #:prefab) + (code:line #:sealed) (code:line #:authentic) (code:line #:name name-id) (code:line #:extra-name name-id) @@ -155,9 +156,10 @@ so on. By convention, property names start with @racketidfont{prop:}.} The @racket[#:prefab] option obtains a @techlink{prefab} (pre-defined, globally shared) structure type, as opposed to creating a new structure type. Such a structure type is inherently transparent and -cannot have a guard or properties, so using @racket[#:prefab] with +non-sealed, and it cannot have a guard or properties, so using @racket[#:prefab] with @racket[#:transparent], @racket[#:inspector], @racket[#:guard], -@racket[#:property], @racket[#:authentic], or @racket[#:methods] is a syntax error. +@racket[#:property], @racket[#:sealed], @racket[#:authentic], +or @racket[#:methods] is a syntax error. If a supertype is specified, it must also be a @tech{prefab} structure type. @examples[#:eval posn-eval @@ -166,6 +168,11 @@ If a supertype is specified, it must also be a @tech{prefab} structure type. (prefab-point? #s(prefab-point 1 2)) ] +The @racket[#:sealed] option is a shorthand for @racket[#:property +prop:sealed #t], which prevents the structure type from being +used as the supertype of another structure type. See +@racket[prop:sealed] for more information. + The @racket[#:authentic] option is a shorthand for @racket[#:property prop:authentic #t], which prevents instances of the structure type from being impersonated (see @racket[impersonate-struct]), chaperoned @@ -299,7 +306,8 @@ cp For serialization, see @racket[define-serializable-struct]. -@history[#:changed "6.9.0.4" @elem{Added @racket[#:authentic].}]} +@history[#:changed "6.9.0.4" @elem{Added @racket[#:authentic].} + #:changed "8.0.0.7" @elem{Added @racket[#:sealed].}]} @defform[(struct-field-index field-id)]{ diff --git a/pkgs/racket-doc/scribblings/reference/struct-inspectors.scrbl b/pkgs/racket-doc/scribblings/reference/struct-inspectors.scrbl index eb8111673d..957e3b4e53 100644 --- a/pkgs/racket-doc/scribblings/reference/struct-inspectors.scrbl +++ b/pkgs/racket-doc/scribblings/reference/struct-inspectors.scrbl @@ -129,6 +129,23 @@ Returns eight values that provide information about the structure type If the type for @racket[struct-type] is not controlled by the current inspector, the @exnraise[exn:fail:contract].} + +@defproc[(struct-type-sealed? [struct-type struct-type?]) boolean?]{ + +Reports whether @racket[struct-type] has the @racket[prop:sealed] +structure type property. + +@history[#:added "8.0.0.7"]} + + +@defproc[(struct-type-authentic? [struct-type struct-type?]) boolean?]{ + +Reports whether @racket[struct-type] has the @racket[prop:authentic] +structure type property. + +@history[#:added "8.0.0.7"]} + + @defproc[(struct-type-make-constructor [struct-type struct-type?] [constructor-name (or/c symbol? #f) #f]) struct-constructor-procedure?]{ diff --git a/pkgs/racket-doc/scribblings/reference/struct.scrbl b/pkgs/racket-doc/scribblings/reference/struct.scrbl index 543516cd6d..5947aa3df4 100644 --- a/pkgs/racket-doc/scribblings/reference/struct.scrbl +++ b/pkgs/racket-doc/scribblings/reference/struct.scrbl @@ -275,6 +275,22 @@ structure type if @racket[field-name] is a symbol. For examples, see @racket[make-struct-type].} +@defthing[prop:sealed struct-type-property?]{ + +A @tech{structure type property} that declares a structure type as +@deftech{sealed}. The value associated with the property is ignored; +the presence of the property itself makes the structure type +sealed. + +A @tech{sealed} structure type cannot be used as the supertype of +another structure type. Declaring a structure type as @tech{sealed} is +typically just a performance hint, since checking for an instance of a +sealed structure type can be slightly faster than checking for an +instance of a structure type that might have subtypes. + +@history[#:added "8.0.0.7"]} + + @;------------------------------------------------------------------------ @section[#:tag "structprops"]{Structure Type Properties} diff --git a/pkgs/racket-test-core/tests/racket/struct.rktl b/pkgs/racket-test-core/tests/racket/struct.rktl index 0966cef253..1fa1b824a6 100644 --- a/pkgs/racket-test-core/tests/racket/struct.rktl +++ b/pkgs/racket-test-core/tests/racket/struct.rktl @@ -497,6 +497,8 @@ (syntax-test #'(define-struct a (b c) #:prefab #:property 1 10)) (syntax-test #'(define-struct a (b c) #:guard 10 #:prefab)) (syntax-test #'(define-struct a (b c) #:property 1 10 #:prefab)) +(syntax-test #'(define-struct a (b c) #:sealed #:prefab)) +(syntax-test #'(define-struct a (b c) #:prefab #:sealed)) (define-struct base0 ()) (define-struct base1 (a)) @@ -842,6 +844,47 @@ (err/rt-test (make-struct-type 'bad struct:date 2 0 #f null 'prefab)) +;; ------------------------------------------------------------ +;; Sealed + +(err/rt-test (let () + (struct x () #:sealed) + (struct y x ()) + (y)) + exn:fail:contract? + "make-struct-type: cannot make a subtype of a sealed type") + +(err/rt-test (let () + (struct x () #:sealed) + (struct y x () #:sealed) + (y)) + exn:fail:contract? + "make-struct-type: cannot make a subtype of a sealed type") + +(err/rt-test (let () + (define-values (prop:s s? s-ref) + (make-struct-type-property 's #f (list (cons prop:sealed (lambda (x) #t))))) + (struct x () #:property prop:s #t) + (struct y x ()) + (y)) + exn:fail:contract? + "make-struct-type: cannot make a subtype of a sealed type") + +(test '(#f #t) cdr (let () + (struct x ()) + (struct y x () #:sealed) + (list (y) + (struct-type-sealed? struct:x) + (struct-type-sealed? struct:y)))) + +(err/rt-test (let () + (struct x ()) + (struct y x () #:sealed) + (struct z y ()) + (y)) + exn:fail:contract? + "make-struct-type: cannot make a subtype of a sealed type") + ;; ------------------------------------------------------------ ;; Misc. built-in structures @@ -1325,6 +1368,7 @@ (let () (struct posn (x y) #:authentic) (test 1 posn-x (posn 1 2)) + (test #t struct-type-authentic? struct:posn) (err/rt-test (chaperone-struct (posn 1 2) posn-x (lambda (p x) x))) ;; Subtype must be consistent: @@ -1334,6 +1378,7 @@ (let () (struct posn (x y)) + (test #f struct-type-authentic? struct:posn) ;; Subtype must be consistent: (err/rt-test (let () @@ -1566,6 +1611,30 @@ ;; ---------------------------------------- +(err/rt-test + (let () + (struct x ()) + (define unknown struct:x) + (set! unknown unknown) + + (define-values (struct:y y y? y-z) + (let-values ([(struct:_1 make-_2 ?_3 -ref_4 -set!_5) + (let-values () + (let-values () + (make-struct-type 'y unknown 1 0 #f + (list) + 'prefab ; (current-inspector) + #f '() #f 'y)))]) + (values + struct:_1 + make-_2 + ?_3 + (make-struct-field-accessor -ref_4 0 'z)))) + + 'done) + exn:fail:contract? + "generative supertype disallowed for non-generative structure type") + (err/rt-test (let () ;; Should be arity error (as opposed to a crash) diff --git a/racket/collects/racket/private/define-struct.rkt b/racket/collects/racket/private/define-struct.rkt index 3396b932b0..b185c9c4bb 100644 --- a/racket/collects/racket/private/define-struct.rkt +++ b/racket/collects/racket/private/define-struct.rkt @@ -269,6 +269,7 @@ (#:name . #f) (#:only-name? . #f) (#:authentic . #f) + (#:sealed . #f) (#:omit-define-values . #f) (#:omit-define-syntaxes . #f))] [nongen? #f]) @@ -354,6 +355,14 @@ (loop (cdr p) (extend-config config '#:authentic #'#t) nongen?)] + [(eq? '#:sealed (syntax-e (car p))) + (when nongen? + (bad "cannot use" (car p) " for prefab structure type")) + (when (lookup config '#:sealed) + (bad "multiple" "#:sealed" "s" (car p))) + (loop (cdr p) + (extend-config config '#:sealed #'#t) + nongen?)] [(or (eq? '#:constructor-name (syntax-e (car p))) (eq? '#:extra-constructor-name (syntax-e (car p)))) (check-exprs 1 p "identifier") @@ -390,6 +399,8 @@ (bad "multiple" insp-keys "s" (car p))) (when (pair? (lookup config '#:props)) (bad "cannot use" (car p) " for a structure type with properties")) + (when (lookup config '#:sealed) + (bad "cannot use" (car p) " for a sealed structure type")) (when (lookup config '#:guard) (bad "cannot use" (car p) " for a structure type with a guard")) (loop (cdr p) @@ -488,11 +499,16 @@ (values (lookup config '#:inspector) (lookup config '#:super) (let ([l (lookup config '#:props)] - [a (lookup config '#:authentic)]) - (if a - (cons (cons #'prop:authentic #'#t) - l) - l)) + [a? (lookup config '#:authentic)] + [s? (lookup config '#:sealed)]) + (let ([l (if a? + (cons (cons #'prop:authentic #'#t) + l) + l)]) + (if s? + (cons (cons #'prop:sealed #'#t) + l) + l))) (lookup config '#:auto-value) (lookup config '#:guard) (lookup config '#:constructor-name) diff --git a/racket/src/ChezScheme/csug/objects.stex b/racket/src/ChezScheme/csug/objects.stex index 7ff0b00c1e..17581dea56 100644 --- a/racket/src/ChezScheme/csug/objects.stex +++ b/racket/src/ChezScheme/csug/objects.stex @@ -4402,7 +4402,7 @@ count and mutability mask in place of a vector of field descriptions, which results in a record type with anonymous fields. The \var{fields} argument must be a non-negative fixnum for the field count, and it is added to any fields present in \var{parent} to determine the record -type's total numnber of fields. The \var{mutability} argument must be +type's total number of fields. The \var{mutability} argument must be an exact non-negative integer that is treated as a bit array; a \scheme{1} bit indicates the the corresponding field among \var{fields} is mutable. diff --git a/racket/src/ChezScheme/makefiles/Mf-install.in b/racket/src/ChezScheme/makefiles/Mf-install.in index 557cdc48cb..1e59ed658f 100644 --- a/racket/src/ChezScheme/makefiles/Mf-install.in +++ b/racket/src/ChezScheme/makefiles/Mf-install.in @@ -62,7 +62,7 @@ InstallLZ4Target= # no changes should be needed below this point # ############################################################################### -Version=csv9.5.5.3 +Version=csv9.5.5.4 Include=boot/$m PetiteBoot=boot/$m/petite.boot SchemeBoot=boot/$m/scheme.boot diff --git a/racket/src/ChezScheme/s/cmacros.ss b/racket/src/ChezScheme/s/cmacros.ss index 4879349dd3..716f07a095 100644 --- a/racket/src/ChezScheme/s/cmacros.ss +++ b/racket/src/ChezScheme/s/cmacros.ss @@ -357,7 +357,7 @@ ;; --------------------------------------------------------------------- ;; Version and machine types: -(define-constant scheme-version #x09050503) +(define-constant scheme-version #x09050504) (define-syntax define-machine-types (lambda (x) @@ -1640,6 +1640,7 @@ (define-constant rtd-generative #b0001) (define-constant rtd-opaque #b0010) (define-constant rtd-sealed #b0100) +(define-constant rtd-act-sealed #b1000) (define-constant ancestry-parent-offset 2) (define-constant minimum-ancestry-vector-length 2) diff --git a/racket/src/ChezScheme/s/cpnanopass.ss b/racket/src/ChezScheme/s/cpnanopass.ss index 5852635ca8..4d6e285b78 100644 --- a/racket/src/ChezScheme/s/cpnanopass.ss +++ b/racket/src/ChezScheme/s/cpnanopass.ss @@ -11123,6 +11123,8 @@ [(e) (go e (constant rtd-opaque))]) (define-inline 3 record-type-sealed? [(e) (go e (constant rtd-sealed))]) + (define-inline 3 $record-type-act-sealed? + [(e) (go e (fxior (constant rtd-sealed) (constant rtd-act-sealed)))]) (define-inline 3 record-type-generative? [(e) (go e (constant rtd-generative))])) (let () diff --git a/racket/src/ChezScheme/s/primdata.ss b/racket/src/ChezScheme/s/primdata.ss index 8699730048..bc9f8889b2 100644 --- a/racket/src/ChezScheme/s/primdata.ss +++ b/racket/src/ChezScheme/s/primdata.ss @@ -2319,6 +2319,8 @@ ($record-oops [sig [(maybe-who sub-ptr rtd) -> (bottom)]] [flags abort-op]) ($record-ref [sig [(ptr sub-index) -> (ptr)]] [flags single-valued discard cp03]) ($record-set! [sig [(ptr sub-index ptr) -> (void)]] [flags true cptypes2]) + ($record-type-act-sealed! [sig [(ptr) -> (void)]] [flags single-valued true]) + ($record-type-act-sealed? [sig [(ptr) -> (boolean)]] [flags single-valued]) ($record-type-descriptor [flags single-valued pure mifoldable discard true]) ($record-type-field-offsets [flags single-valued pure mifoldable discard true]) ($record-type-field-count [sig [(ptr) -> (fixnum)]] [flags single-valued pure mifoldable discard true]) diff --git a/racket/src/ChezScheme/s/record.ss b/racket/src/ChezScheme/s/record.ss index 473198fb74..c6686292f7 100644 --- a/racket/src/ChezScheme/s/record.ss +++ b/racket/src/ChezScheme/s/record.ss @@ -555,8 +555,8 @@ (define ($mrt who base-rtd name parent uid flags fields mutability-mask extras) (include "layout.ss") (when parent - (when (record-type-sealed? parent) - ($oops who "cannot extend sealed record type ~s" parent)) + (when ($record-type-act-sealed? parent) + ($oops who "cannot extend sealed record type ~s as ~s" parent name)) (if (fixnum? fields) (unless (fixnum? (rtd-flds parent)) ($oops who "cannot make anonymous-field record type ~s from named-field parent record type ~s" name parent)) @@ -901,6 +901,20 @@ ($oops 'record-type-sealed? "~s is not a record type descriptor" rtd)) (#3%record-type-sealed? rtd))) + (set-who! $record-type-act-sealed! + (lambda (rtd) + (unless (record-type-descriptor? rtd) + ($oops who "~s is not a record type descriptor" rtd)) + (unless ($record-type-act-sealed? rtd) + ($object-set! 'scheme-object rtd (constant record-type-flags-disp) + (fxior (rtd-flags rtd) (constant rtd-act-sealed)))))) + + (set-who! $record-type-act-sealed? + (lambda (rtd) + (unless (record-type-descriptor? rtd) + ($oops who "~s is not a record type descriptor" rtd)) + (#3%$record-type-act-sealed? rtd))) + (set! record-type-generative? (lambda (rtd) (unless (record-type-descriptor? rtd) diff --git a/racket/src/bc/src/schminc.h b/racket/src/bc/src/schminc.h index 0f5a6d4ed6..2d8365a69b 100644 --- a/racket/src/bc/src/schminc.h +++ b/racket/src/bc/src/schminc.h @@ -15,7 +15,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1485 +#define EXPECTED_PRIM_COUNT 1488 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/racket/src/bc/src/schpriv.h b/racket/src/bc/src/schpriv.h index 562731e5e8..5bced9c71e 100644 --- a/racket/src/bc/src/schpriv.h +++ b/racket/src/bc/src/schpriv.h @@ -700,6 +700,7 @@ extern Scheme_Object *scheme_app_mark_impersonator_property; extern Scheme_Object *scheme_no_arity_property; extern Scheme_Object *scheme_authentic_property; +extern Scheme_Object *scheme_sealed_property; extern Scheme_Object *scheme_chaperone_undefined_property; @@ -1095,9 +1096,10 @@ typedef struct Scheme_Struct_Type { mzshort num_slots; /* initialized + auto + parent-initialized + parent-auto */ mzshort num_islots; /* initialized + parent-initialized */ mzshort name_pos; - char authentic; /* 1 => chaperones/impersonators disallowed */ - char more_flags; /* STRUCT_TYPE_FLAG_NONFAIL_CONSTRUCTOR => constructor never fails - STRUCT_TYPE_FLAG_SYSTEM_OPAQUE => #f for `object-name`, for example */ + int more_flags; /* STRUCT_TYPE_FLAG_AUTHENTIC => chaperones/impersonators disallowed + STRUCT_TYPE_FLAG_SEALED => subtypes disallowed + STRUCT_TYPE_FLAG_NONFAIL_CONSTRUCTOR => constructor never fails + STRUCT_TYPE_FLAG_SYSTEM_OPAQUE => #f for `object-name`, for example */ Scheme_Object *name; @@ -1131,6 +1133,8 @@ typedef struct Scheme_Struct_Type { /* for `more_flags` field */ #define STRUCT_TYPE_FLAG_NONFAIL_CONSTRUCTOR 0x1 #define STRUCT_TYPE_FLAG_SYSTEM_OPAQUE 0x2 +#define STRUCT_TYPE_FLAG_AUTHENTIC 0x4 +#define STRUCT_TYPE_FLAG_SEALED 0x8 typedef struct Scheme_Structure { @@ -3108,6 +3112,7 @@ typedef struct { int normal_ops; /* are selectors and predicates in the usual order? */ int indexed_ops; /* do selectors have the index built in (as opposed to taking an index argument)? */ int authentic; /* conservatively 0 is ok */ + int sealed; /* conservatively 0 is ok */ int nonfail_constructor; int prefab; int num_gets, num_sets; @@ -3144,7 +3149,8 @@ Scheme_Object *scheme_make_struct_proc_shape(intptr_t k, Scheme_Object *identity #define STRUCT_PROC_SHAPE_GETTER 3 #define STRUCT_PROC_SHAPE_SETTER 4 #define STRUCT_PROC_SHAPE_OTHER 5 -#define STRUCT_PROC_SHAPE_MASK 0xF +#define STRUCT_PROC_SHAPE_MASK 0x7 +#define STRUCT_PROC_SHAPE_SEALED 0x8 #define STRUCT_PROC_SHAPE_AUTHENTIC 0x10 #define STRUCT_PROC_SHAPE_NONFAIL_CONSTR 0x20 #define STRUCT_PROC_SHAPE_PREFAB 0x40 diff --git a/racket/src/bc/src/startup.inc b/racket/src/bc/src/startup.inc index 92afa8cb7b..276f791c31 100644 --- a/racket/src/bc/src/startup.inc +++ b/racket/src/bc/src/startup.inc @@ -5943,6 +5943,7 @@ static const char *startup_source = " 0" " #f" "(list" +"(cons prop:sealed #t)" "(cons prop:authentic #t)" "(cons" " prop:reach-scopes" @@ -8910,6 +8911,7 @@ static const char *startup_source = " 0" " #f" "(list" +"(cons prop:sealed #t)" "(cons prop:authentic #t)" "(cons" " prop:scope-with-bindings" @@ -9113,6 +9115,7 @@ static const char *startup_source = " 0" " #f" "(list" +"(cons prop:sealed #t)" "(cons prop:authentic #t)" "(cons" " prop:reach-scopes" @@ -9976,6 +9979,7 @@ static const char *startup_source = " 0" " #f" "(list" +"(cons prop:sealed #t)" "(cons prop:authentic #t)" "(cons prop:propagation-set-tamper(lambda(p_0 v_0)(propagation-set-tamper p_0 v_0)))" "(cons prop:propagation-tamper(lambda(p_0)(propagation-tamper p_0)))" @@ -20887,13 +20891,14 @@ static const char *startup_source = " record-accessor" " record-mutator" " record-predicate" -" struct-type-install-properties!" +" make-struct-type-install-properties" " #%struct-constructor" " #%struct-predicate" " #%struct-field-accessor" " #%struct-field-mutator" " #%nongenerative-uid" " unsafe-struct?" +" unsafe-sealed-struct?" " unsafe-struct" " raise-binding-result-arity-error" " raise-definition-result-arity-error" diff --git a/racket/src/bc/src/struct.c b/racket/src/bc/src/struct.c index d37b2c0396..d9c9f4ac7c 100644 --- a/racket/src/bc/src/struct.c +++ b/racket/src/bc/src/struct.c @@ -28,6 +28,7 @@ READ_ONLY Scheme_Object *scheme_app_mark_impersonator_property; READ_ONLY Scheme_Object *scheme_object_name_property; READ_ONLY Scheme_Object *scheme_struct_to_vector_proc; READ_ONLY Scheme_Object *scheme_authentic_property; +READ_ONLY Scheme_Object *scheme_sealed_property; READ_ONLY Scheme_Object *scheme_unsafe_poller_proc; READ_ONLY static Scheme_Object *location_struct; @@ -115,6 +116,8 @@ static Scheme_Object *struct_info(int argc, Scheme_Object *argv[]); static Scheme_Object *struct_type_info(int argc, Scheme_Object *argv[]); static Scheme_Object *struct_type_pred(int argc, Scheme_Object *argv[]); static Scheme_Object *struct_type_constr(int argc, Scheme_Object *argv[]); +static Scheme_Object *struct_type_sealed_p(int argc, Scheme_Object *argv[]); +static Scheme_Object *struct_type_authentic_p(int argc, Scheme_Object *argv[]); static Scheme_Object *struct_to_vector(int argc, Scheme_Object *argv[]); static Scheme_Object *prefab_struct_key(int argc, Scheme_Object *argv[]); static Scheme_Object *make_prefab_struct(int argc, Scheme_Object *argv[]); @@ -445,6 +448,12 @@ scheme_init_struct (Scheme_Startup_Env *env) scheme_addto_prim_instance("prop:authentic", scheme_authentic_property, env); } + { + REGISTER_SO(scheme_sealed_property); + scheme_sealed_property = scheme_make_struct_type_property(scheme_intern_symbol("sealed")); + scheme_addto_prim_instance("prop:sealed", scheme_sealed_property, env); + } + REGISTER_SO(scheme_recur_symbol); REGISTER_SO(scheme_display_symbol); REGISTER_SO(scheme_write_special_symbol); @@ -577,6 +586,16 @@ scheme_init_struct (Scheme_Startup_Env *env) "struct-type-make-constructor", 1, 2), env); + scheme_addto_prim_instance("struct-type-sealed?", + scheme_make_prim_w_arity(struct_type_sealed_p, + "struct-type-sealed?", + 1, 1), + env); + scheme_addto_prim_instance("struct-type-authentic?", + scheme_make_prim_w_arity(struct_type_authentic_p, + "struct-type-authentic?", + 1, 1), + env); REGISTER_SO(scheme_struct_to_vector_proc); scheme_struct_to_vector_proc = scheme_make_noncm_prim(struct_to_vector, @@ -2962,6 +2981,24 @@ static Scheme_Object *struct_type_info(int argc, Scheme_Object *argv[]) return scheme_values(mzNUM_ST_INFO, a); } +static Scheme_Object *struct_type_sealed_p(int argc, Scheme_Object *argv[]) { + if (!SCHEME_STRUCT_TYPEP(argv[0])) + scheme_wrong_contract("struct-type-sealed?", "struct-type?", 0, argc, argv); + + return ((((Scheme_Struct_Type *)argv[0])->more_flags & STRUCT_TYPE_FLAG_SEALED) + ? scheme_true + : scheme_false); +} + +static Scheme_Object *struct_type_authentic_p(int argc, Scheme_Object *argv[]) { + if (!SCHEME_STRUCT_TYPEP(argv[0])) + scheme_wrong_contract("struct-type-authentic?", "struct-type?", 0, argc, argv); + + return ((((Scheme_Struct_Type *)argv[0])->more_flags & STRUCT_TYPE_FLAG_AUTHENTIC) + ? scheme_true + : scheme_false); +} + static Scheme_Object *struct_type_pred(int argc, Scheme_Object *argv[]) { Scheme_Struct_Type *stype; @@ -3428,7 +3465,8 @@ intptr_t scheme_get_or_check_structure_shape(Scheme_Object *e, Scheme_Object *ex else want_v = ((st->num_slots << STRUCT_PROC_SHAPE_SHIFT) | STRUCT_PROC_SHAPE_STRUCT - | ((st->authentic && (!expected || (v & STRUCT_PROC_SHAPE_AUTHENTIC))) + | (((st->more_flags & STRUCT_TYPE_FLAG_AUTHENTIC) + && (!expected || (v & STRUCT_PROC_SHAPE_AUTHENTIC))) ? STRUCT_PROC_SHAPE_AUTHENTIC : 0) | (((st->more_flags & STRUCT_TYPE_FLAG_NONFAIL_CONSTRUCTOR) @@ -3455,7 +3493,8 @@ intptr_t scheme_get_or_check_structure_shape(Scheme_Object *e, Scheme_Object *ex } else if (i == SCHEME_PRIM_STRUCT_TYPE_PRED) { st = (Scheme_Struct_Type *)SCHEME_PRIM_CLOSURE_ELS(e)[0]; want_v = (STRUCT_PROC_SHAPE_PRED - | ((st->authentic && (!expected || (v & STRUCT_PROC_SHAPE_AUTHENTIC))) + | (((st->more_flags & STRUCT_TYPE_FLAG_AUTHENTIC) + && (!expected || (v & STRUCT_PROC_SHAPE_AUTHENTIC))) ? STRUCT_PROC_SHAPE_AUTHENTIC : 0)); } else if (i == SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER) { @@ -3471,7 +3510,8 @@ intptr_t scheme_get_or_check_structure_shape(Scheme_Object *e, Scheme_Object *ex pos = 0; /* => unknown, since simple struct info can't track it */ want_v = ((pos << STRUCT_PROC_SHAPE_SHIFT) | STRUCT_PROC_SHAPE_SETTER - | ((st->authentic && (!expected || (v & STRUCT_PROC_SHAPE_AUTHENTIC))) + | (((st->more_flags & STRUCT_TYPE_FLAG_AUTHENTIC) + && (!expected || (v & STRUCT_PROC_SHAPE_AUTHENTIC))) ? STRUCT_PROC_SHAPE_AUTHENTIC : 0)); } else if (i == SCHEME_PRIM_STRUCT_TYPE_INDEXED_GETTER) { @@ -3479,7 +3519,8 @@ intptr_t scheme_get_or_check_structure_shape(Scheme_Object *e, Scheme_Object *ex st = (Scheme_Struct_Type *)SCHEME_PRIM_CLOSURE_ELS(e)[0]; want_v = ((pos << STRUCT_PROC_SHAPE_SHIFT) | STRUCT_PROC_SHAPE_GETTER - | ((st->authentic && (!expected || (v & STRUCT_PROC_SHAPE_AUTHENTIC))) + | (((st->more_flags & STRUCT_TYPE_FLAG_AUTHENTIC) + && (!expected || (v & STRUCT_PROC_SHAPE_AUTHENTIC))) ? STRUCT_PROC_SHAPE_AUTHENTIC : 0)); } else if ((i == SCHEME_PRIM_STRUCT_TYPE_INDEXLESS_SETTER) @@ -4751,7 +4792,6 @@ Scheme_Struct_Type *scheme_make_prefab_struct_type_raw(Scheme_Object *base, struct_type->num_slots = num_fields + num_uninit_fields + (parent_type ? parent_type->num_slots : 0); struct_type->num_islots = num_fields + (parent_type ? parent_type->num_islots : 0); struct_type->name_pos = depth; - struct_type->authentic = 0; struct_type->more_flags = STRUCT_TYPE_FLAG_NONFAIL_CONSTRUCTOR; struct_type->inspector = scheme_false; struct_type->uninit_val = uninit_val; @@ -4946,7 +4986,9 @@ static Scheme_Object *_make_struct_type(Scheme_Object *name, if (SAME_OBJ(prop, scheme_chaperone_undefined_property)) chaperone_undefined = 1; if (SAME_OBJ(prop, scheme_authentic_property)) - struct_type->authentic = 1; + struct_type->more_flags |= STRUCT_TYPE_FLAG_AUTHENTIC; + if (SAME_OBJ(prop, scheme_sealed_property)) + struct_type->more_flags |= STRUCT_TYPE_FLAG_SEALED; propv = guard_property(prop, SCHEME_CDR(a), struct_type); @@ -5008,7 +5050,9 @@ static Scheme_Object *_make_struct_type(Scheme_Object *name, if (SAME_OBJ(prop, scheme_chaperone_undefined_property)) chaperone_undefined = 1; if (SAME_OBJ(prop, scheme_authentic_property)) - struct_type->authentic = 1; + struct_type->more_flags |= STRUCT_TYPE_FLAG_AUTHENTIC; + if (SAME_OBJ(prop, scheme_sealed_property)) + struct_type->more_flags |= STRUCT_TYPE_FLAG_SEALED; propv = guard_property(prop, SCHEME_CDR(a), struct_type); @@ -5062,8 +5106,9 @@ static Scheme_Object *_make_struct_type(Scheme_Object *name, } } - if (parent_type && (parent_type->authentic != struct_type->authentic)) { - if (parent_type->authentic) + if (parent_type && ((parent_type->more_flags & STRUCT_TYPE_FLAG_AUTHENTIC) + != (struct_type->more_flags & STRUCT_TYPE_FLAG_AUTHENTIC))) { + if (parent_type->more_flags & STRUCT_TYPE_FLAG_AUTHENTIC) scheme_contract_error("make-struct-type", "cannot make a non-authentic subtype of an authentic type", "type name", 1, struct_type->name, @@ -5402,8 +5447,24 @@ static Scheme_Object *make_struct_type(int argc, Scheme_Object **argv) uninit_val, immutable_array); } else { + Scheme_Object *parent = SCHEME_FALSEP(argv[1]) ? NULL : argv[1]; + Scheme_Struct_Type *parent_type; + + if (parent && SCHEME_NP_CHAPERONEP(parent)) + parent_type = (Scheme_Struct_Type *)SCHEME_CHAPERONE_VAL(parent); + else + parent_type = (Scheme_Struct_Type *)parent; + + if (parent_type && (parent_type->more_flags & STRUCT_TYPE_FLAG_SEALED)) { + scheme_contract_error("make-struct-type", + "cannot make a subtype of a sealed type", + "type name", 1, argv[0], + "sealed type", 1, parent, + NULL); + } + type = (Scheme_Struct_Type *)_make_struct_type(argv[0], - SCHEME_FALSEP(argv[1]) ? NULL : argv[1], + parent, inspector, initc, uninitc, uninit_val, props, @@ -6247,7 +6308,7 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator, return NULL; } - if (SCHEME_STRUCTP(val) && ((Scheme_Structure *)val)->stype->authentic) { + if (SCHEME_STRUCTP(val) && ((Scheme_Structure *)val)->stype->more_flags & STRUCT_TYPE_FLAG_AUTHENTIC) { scheme_contract_error(name, (is_impersonator ? "cannot impersonate instance of an authentic structure type" diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss index 2967e37d27..198b700e67 100644 --- a/racket/src/cs/compile-file.ss +++ b/racket/src/cs/compile-file.ss @@ -2,7 +2,7 @@ ;; Check to make we're using a build of Chez Scheme ;; that has all the features we need. (define-values (need-maj need-min need-sub need-dev) - (values 9 5 5 1)) + (values 9 5 5 4)) (unless (guard (x [else #f]) (eval 'scheme-fork-version-number)) (error 'compile-file diff --git a/racket/src/cs/primitive/internal.ss b/racket/src/cs/primitive/internal.ss index 85e4495c77..3d1b557a0b 100644 --- a/racket/src/cs/primitive/internal.ss +++ b/racket/src/cs/primitive/internal.ss @@ -8,7 +8,7 @@ [impersonator-val (known-constant)] [impersonate-ref (known-constant)] [impersonate-set! (known-constant)] - [struct-type-install-properties! (known-constant)] + [make-struct-type-install-properties (known-constant)] [structure-type-lookup-prefab-uid (known-constant)] [struct-type-constructor-add-guards (known-constant)] [|#%call-with-values| (known-constant)] diff --git a/racket/src/cs/primitive/kernel.ss b/racket/src/cs/primitive/kernel.ss index 4ece70e872..d232ebfbbc 100644 --- a/racket/src/cs/primitive/kernel.ss +++ b/racket/src/cs/primitive/kernel.ss @@ -686,6 +686,7 @@ [prop:object-name (known-constant)] [prop:output-port (known-constant)] [prop:procedure (known-struct-type-property/immediate-guard)] + [prop:sealed (known-struct-type-property/immediate-guard)] [pseudo-random-generator->vector (known-procedure/no-prompt 2)] [pseudo-random-generator-vector? (known-procedure/no-prompt 2)] [pseudo-random-generator? (known-procedure/pure/folding 2)] @@ -840,12 +841,14 @@ [struct-info (known-procedure 2)] [struct-mutator-procedure? (known-procedure/pure/folding 2)] [struct-predicate-procedure? (known-procedure/pure/folding 2)] + [struct-type-authentic? (known-procedure/single-valued 2)] [struct-type-info (known-procedure 2)] [struct-type-make-constructor (known-procedure/single-valued 6)] [struct-type-make-predicate (known-procedure/single-valued 2)] [struct-type-property-accessor-procedure? (known-procedure/single-valued 2)] [struct-type-property-predicate-procedure? (known-procedure/single-valued 6)] [struct-type-property? (known-procedure/no-prompt 2)] + [struct-type-sealed? (known-procedure/single-valued 2)] [struct-type? (known-procedure/no-prompt 2)] [struct:arity-at-least (known-constant)] [struct:date (known-constant)] diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index 19a3596305..87f26dea19 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -218,8 +218,8 @@ struct-type-property-accessor-procedure? struct-type-property-predicate-procedure? make-struct-type - struct-type-install-properties! ; not exported to Racket - structure-type-lookup-prefab-uid ; not exported to Racket + make-struct-type-install-properties ; not exported to Racket + structure-type-lookup-prefab-uid ; not exported to Racket make-struct-field-accessor make-struct-field-mutator struct-type-constructor-add-guards ; not exported to Racket @@ -237,6 +237,8 @@ struct-type? procedure-struct-type? struct-type-info + struct-type-sealed? + struct-type-authentic? struct-info struct-type-make-constructor struct-type-make-predicate @@ -247,6 +249,7 @@ make-prefab-struct prop:authentic prop:equal+hash + prop:sealed inspector? inspector-superior? impersonate-struct @@ -696,8 +699,9 @@ unsafe-struct*-ref unsafe-struct*-set! unsafe-struct*-cas! - unsafe-struct? ; not exported to racket - unsafe-struct ; not exported to racket + unsafe-struct? ; not exported to racket + unsafe-sealed-struct? ; not exported to racket + unsafe-struct ; not exported to racket unsafe-s16vector-ref unsafe-s16vector-set! diff --git a/racket/src/cs/rumble/error-rewrite.ss b/racket/src/cs/rumble/error-rewrite.ss index fd33d090d7..787950e36d 100644 --- a/racket/src/cs/rumble/error-rewrite.ss +++ b/racket/src/cs/rumble/error-rewrite.ss @@ -59,7 +59,8 @@ fxarithmetic-shift-left fxlshift fxsll/wraparound fxlshift/wraparound real->flonum ->fl - time-utc->date seconds->date) + time-utc->date seconds->date + make-record-type-descriptor* make-struct-type) (set! rewrites-added? #t))) (getprop n 'error-rename n))) @@ -140,6 +141,11 @@ (let ([ctc (desc->contract (substring str (string-length is-not-a-str) (string-length str)))]) (format-error-values (string-append "contract violation\n expected: " ctc "\n given: ~s") irritants))] + [(equal? str "cannot extend sealed record type ~s as ~s") + (format-error-values (string-append "cannot make a subtype of a sealed type\n" + " type name: ~s\n" + " sealed type: ~s") + (reverse irritants))] [(eq? who 'time-utc->date) (values "integer is out-of-range" null)] [else diff --git a/racket/src/cs/rumble/struct.ss b/racket/src/cs/rumble/struct.ss index 69fdc761f4..c476a6b3f4 100644 --- a/racket/src/cs/rumble/struct.ss +++ b/racket/src/cs/rumble/struct.ss @@ -183,8 +183,10 @@ ;; ---------------------------------------- +;; returns a procedure that takes an rtd and finishes creating/installing it (define (check-make-struct-type-arguments who name parent-rtd init-count auto-count - props insp proc-spec immutables guard constructor-name) + props insp proc-spec immutables guard constructor-name + system?) (check who symbol? name) (check who :or-false struct-type? parent-rtd) (check who exact-nonnegative-integer? init-count) @@ -215,120 +217,164 @@ (check who :or-false procedure? guard) (check who :or-false symbol? constructor-name) - ;; The rest has to be delayed until we have an rtd: - (lambda (rtd parent-rtd* all-immutables) - (let ([props-ht - ;; Check for duplicates and record property values - (let ([get-struct-info - (lambda () - (let ([parent-total*-count (if parent-rtd* - (struct-type-total*-field-count parent-rtd*) - 0)]) - (list name - init-count - auto-count - (make-position-based-accessor rtd parent-total*-count (+ init-count auto-count)) - (make-position-based-mutator rtd parent-total*-count (+ init-count auto-count)) - all-immutables - parent-rtd - #f)))]) - (let loop ([props props] [ht empty-hasheq]) + (cond + [(eq? insp 'prefab) + (let ([bad + (or (and (impersonator? parent-rtd) + "chaperoned supertype disallowed for non-generative structure type") + (and parent-rtd + (not (eq? (inspector-ref (strip-impersonator parent-rtd)) 'prefab)) + "generative supertype disallowed for non-generative structure type") + (and (pair? props) + "properties disallowed for non-generative structure type") + (and proc-spec + "procedure specification disallowed for non-generative structure type") + (and guard + "guard disallowed for non-generative structure type"))]) + (when bad + (raise-arguments-error who bad + "structure type name" name)) + ;; everything else to be done for a for prefab must be covered in `prefab-key+count->rtd` + (lambda (rtd) + (void)))] + [else + (when parent-rtd + (when (#%$record-type-act-sealed? (strip-impersonator parent-rtd)) + (raise-arguments-error who + "cannot make a subtype of a sealed type" + "type name" name + "sealed type" parent-rtd))) + + ;; The rest has to be delayed until we have an rtd: + (lambda (rtd) + (let* ([parent-rtd* (strip-impersonator parent-rtd)] + [parent-props + (if parent-rtd* + (eq-hashtable-ref rtd-props parent-rtd* '()) + '())] + [all-immutables (if (integer? proc-spec) + (cons proc-spec immutables) + immutables)]) + (when (not parent-rtd*) + (record-type-equal-procedure rtd default-struct-equal?) + (record-type-hash-procedure rtd default-struct-hash)) + ;; Record properties implemented by this type: + (let ([props (let ([props (append (map car props) parent-props)]) + (if proc-spec + (cons prop:procedure props) + props))]) + (add-to-table! rtd-props rtd props)) + ;; Copy parent properties for this type: + (for-each (lambda (prop) + (let loop ([prop prop]) + (struct-property-set! prop rtd (struct-property-ref prop parent-rtd* #f)) + (for-each (lambda (super) + (loop (car super))) + (struct-type-prop-supers prop)))) + parent-props) + + ;; Finish checking and install new property values: + (let ([props-ht + ;; Check for duplicates and record property values + (let ([get-struct-info + (lambda () + (let ([parent-total*-count (if parent-rtd* + (struct-type-total*-field-count parent-rtd*) + 0)]) + (list name + init-count + auto-count + (make-position-based-accessor rtd parent-total*-count (+ init-count auto-count)) + (make-position-based-mutator rtd parent-total*-count (+ init-count auto-count)) + all-immutables + parent-rtd + #f)))]) + (let loop ([props props] [ht empty-hasheq]) + (cond + [(null? props) + (if proc-spec + (let-values ([(ht props) (check-and-add-property who prop:procedure proc-spec rtd ht '() + get-struct-info)]) + ht) + ht)] + [else + (let-values ([(ht props) (check-and-add-property who (caar props) (cdar props) rtd ht (cdr props) + get-struct-info)]) + (loop props ht))])))]) + + (let loop ([ht empty-hasheqv] [imms immutables]) + (cond + [(null? imms) (void)] + [else + (let ([i (car imms)]) + (when (hash-ref ht i #f) + (raise-arguments-error who + "redundant immutable field index" + "index" i + "in list" immutables)) + (unless (< i init-count) + (raise-arguments-error who + "index for immutable field >= initialized-field count" + "index" i + "initialized-field count" init-count + "in list" immutables)) + (loop (hash-set ht i #t) (cdr imms)))])) + + (let ([v (hash-ref props-ht prop:procedure #f)]) + (when v (cond - [(null? props) - (if proc-spec - (let-values ([(ht props) (check-and-add-property who prop:procedure proc-spec rtd ht '() - get-struct-info)]) - ht) - ht)] - [else - (let-values ([(ht props) (check-and-add-property who (caar props) (cdar props) rtd ht (cdr props) - get-struct-info)]) - (loop props ht))])))]) - - (when (eq? insp 'prefab) - (let ([bad - (or (and (impersonator? parent-rtd) - "chaperoned supertype disallowed for non-generative structure type") - (and parent-rtd - (not (eq? (inspector-ref parent-rtd) 'prefab)) - "generative supertype disallowed for non-generative structure type") - (and (pair? props) - "properties disallowed for non-generative structure type") - (and proc-spec - "procedure specification disallowed for non-generative structure type") - (and guard - "guard disallowed for non-generative structure type"))]) - (when bad - (raise-arguments-error who bad - "structure type name" name)))) - - (let loop ([ht empty-hasheqv] [imms immutables]) - (cond - [(null? imms) (void)] - [else - (let ([i (car imms)]) - (when (hash-ref ht i #f) - (raise-arguments-error who - "redundant immutable field index" - "index" i - "in list" immutables)) - (unless (< i init-count) - (raise-arguments-error who - "index for immutable field >= initialized-field count" - "index" i - "initialized-field count" init-count - "in list" immutables)) - (loop (hash-set ht i #t) (cdr imms)))])) - - (let ([v (hash-ref props-ht prop:procedure #f)]) - (when v - (cond - [(exact-nonnegative-integer? v) - (unless (< v init-count) - (raise-arguments-error who - "index for procedure >= initialized-field count" - "index" v - "field count" init-count)) - (unless (or (eq? v proc-spec) (chez:memv v immutables)) - (raise-arguments-error who - "field is not specified as immutable for a prop:procedure index" - "index" v))] - [(procedure? v) - (void)] - [else - (raise-arguments-error who - "given value did not satisfy the contract for prop:procedure" - "expected" "(or/c procedure? exact-nonnegative-integer?)" - "given" v)]))) - - (let ([parent-rtd* (strip-impersonator parent-rtd)]) - (when parent-rtd* - (let ([authentic? (not (eq? (hash-ref props-ht prop:authentic none) none))] - [authentic-parent? (struct-property-ref prop:authentic parent-rtd* #f)]) - (when (not (eq? authentic? authentic-parent?)) - (if authentic? + [(exact-nonnegative-integer? v) + (unless (< v init-count) + (raise-arguments-error who + "index for procedure >= initialized-field count" + "index" v + "field count" init-count)) + (unless (or (eq? v proc-spec) (chez:memv v immutables)) + (raise-arguments-error who + "field is not specified as immutable for a prop:procedure index" + "index" v))] + [(procedure? v) + (void)] + [else (raise-arguments-error who - "cannot make an authentic subtype of a non-authentic type" - "type name" name - "non-authentic type" parent-rtd) - (raise-arguments-error who - "cannot make a non-authentic subtype of an authentic type" - "type name" name - "authentic type" parent-rtd))))) + "given value did not satisfy the contract for prop:procedure" + "expected" "(or/c procedure? exact-nonnegative-integer?)" + "given" v)]))) - (when guard - (let ([expected-count (+ 1 - init-count - (if parent-rtd* - (get-field-info-init*-count (struct-type-field-info parent-rtd*)) - 0))]) - (unless (procedure-arity-includes? guard expected-count) - (raise-arguments-error who - (string-append - "guard procedure does not accept correct number of arguments;\n" - " should accept one more than the number of constructor arguments") - "guard procedure" guard - "expected arity" expected-count)))))))) + (let ([parent-rtd* (strip-impersonator parent-rtd)]) + (when parent-rtd* + (let ([authentic? (not (eq? (hash-ref props-ht prop:authentic none) none))] + [authentic-parent? (struct-property-ref prop:authentic parent-rtd* #f)]) + (when (not (eq? authentic? authentic-parent?)) + (if authentic? + (raise-arguments-error who + "cannot make an authentic subtype of a non-authentic type" + "type name" name + "non-authentic type" parent-rtd) + (raise-arguments-error who + "cannot make a non-authentic subtype of an authentic type" + "type name" name + "authentic type" parent-rtd))))) + + (when guard + (let ([expected-count (+ 1 + init-count + (if parent-rtd* + (get-field-info-init*-count (struct-type-field-info parent-rtd*)) + 0))]) + (unless (procedure-arity-includes? guard expected-count) + (raise-arguments-error who + (string-append + "guard procedure does not accept correct number of arguments;\n" + " should accept one more than the number of constructor arguments") + "guard procedure" guard + "expected arity" expected-count)))))) + + ;; Record inspector + (unless (and system? insp) + (inspector-set! rtd insp)) + ;; Register guard + (register-guards! rtd parent-rtd guard 'at-start)))])) (define (check-and-add-property who prop val rtd ht props get-struct-info) (let* ([guarded-val @@ -359,17 +405,42 @@ p (lambda (v h) (|#%app| p v h))))) (struct-property-set! 'secondary-hash rtd (cadddr guarded-val))) - (struct-property-set! prop rtd guarded-val) - (values (hash-set ht prop check-val) - (append - (if (eq? old-v none) - (map (lambda (super) - (cons (car super) - (|#%app| (cdr super) guarded-val))) - (struct-type-prop-supers prop)) - ;; skip supers, because property is already added - null) - props)))) + (cond + [(eq? prop prop:sealed) + (#%$record-type-act-sealed! rtd) + (values ht props)] + [else + (struct-property-set! prop rtd guarded-val) + (values (hash-set ht prop check-val) + (append + (if (eq? old-v none) + (map (lambda (super) + (cons (car super) + (|#%app| (cdr super) guarded-val))) + (struct-type-prop-supers prop)) + ;; skip supers, because property is already added + null) + props))]))) + +;; variant of `check-make-struct-type-arguments` called by schemified +(define make-struct-type-install-properties + (case-lambda + [(name init-count auto-count parent-rtd) + (make-struct-type-install-properties name init-count auto-count parent-rtd '() (current-inspector) #f '() #f #f)] + [(name init-count auto-count parent-rtd props) + (make-struct-type-install-properties name init-count auto-count parent-rtd props (current-inspector) #f '() #f #f)] + [(name init-count auto-count parent-rtd props insp) + (make-struct-type-install-properties name init-count auto-count parent-rtd props insp #f '() #f #f)] + [(name init-count auto-count parent-rtd props insp proc-spec) + (make-struct-type-install-properties name init-count auto-count parent-rtd props insp proc-spec '() #f #f)] + [(name init-count auto-count parent-rtd props insp proc-spec immutables) + (make-struct-type-install-properties name init-count auto-count parent-rtd props insp proc-spec immutables #f #f)] + [(name init-count auto-count parent-rtd props insp proc-spec immutables guard) + (make-struct-type-install-properties name init-count auto-count parent-rtd props insp proc-spec immutables guard #f)] + [(name init-count auto-count parent-rtd props insp proc-spec immutables guard constructor-name) + ;; returns a finishing procedure + (check-make-struct-type-arguments 'make-struct-type (if (pair? name) (car name) name) parent-rtd init-count auto-count + props insp proc-spec immutables guard constructor-name (pair? name))])) ;; ---------------------------------------- @@ -488,9 +559,8 @@ [(name parent-rtd init-count auto-count auto-val props insp proc-spec immutables guard) (make-struct-type name parent-rtd init-count auto-count auto-val props insp proc-spec immutables guard #f)] [(name parent-rtd init-count auto-count auto-val props insp proc-spec immutables guard constructor-name) - (let* ([install-props! - (check-make-struct-type-arguments 'make-struct-type name parent-rtd init-count auto-count - props insp proc-spec immutables guard constructor-name)] + (let* ([finish! (check-make-struct-type-arguments 'make-struct-type name parent-rtd init-count auto-count + props insp proc-spec immutables guard constructor-name #f)] [prefab-uid (and (eq? insp 'prefab) (structure-type-lookup-prefab-uid name parent-rtd init-count auto-count auto-val immutables))] [parent-rtd* (strip-impersonator parent-rtd)] @@ -499,7 +569,9 @@ empty-field-info)] [rtd (make-record-type-descriptor* name parent-rtd* - prefab-uid #f #f + prefab-uid + (#%ormap (lambda (p) (eq? prop:sealed (car p))) props) + #f (+ init-count auto-count) (let ([mask (sub1 (general-arithmetic-shift 1 (+ init-count auto-count)))]) (if (eq? insp 'prefab) @@ -527,9 +599,7 @@ (when (or parent-rtd* auto-field-adder) (let ([field-info (make-field-info init*-count auto*-count auto-field-adder)]) (putprop (record-type-uid rtd) 'field-info field-info))) - (struct-type-install-properties! rtd name init-count auto-count parent-rtd - props insp proc-spec immutables guard constructor-name - install-props!) + (finish! rtd) (let ([ctr (struct-type-constructor-add-guards (let ([c (record-constructor rtd)]) (procedure-rename @@ -554,63 +624,6 @@ (make-position-based-accessor rtd parent-total*-count (+ init-count auto-count)) (make-position-based-mutator rtd parent-total*-count (+ init-count auto-count)))))])) -;; Called both by `make-struct-type` and by a `schemify` transformation: -(define struct-type-install-properties! - (case-lambda - [(rtd name init-count auto-count parent-rtd) - (struct-type-install-properties! rtd name init-count auto-count parent-rtd '() (current-inspector) #f '() #f #f #f)] - [(rtd name init-count auto-count parent-rtd props) - (struct-type-install-properties! rtd name init-count auto-count parent-rtd props (current-inspector) #f '() #f #f #f)] - [(rtd name init-count auto-count parent-rtd props insp) - (struct-type-install-properties! rtd name init-count auto-count parent-rtd props insp #f '() #f #f #f)] - [(rtd name init-count auto-count parent-rtd props insp proc-spec) - (struct-type-install-properties! rtd name init-count auto-count parent-rtd props insp proc-spec '() #f #f #f)] - [(rtd name init-count auto-count parent-rtd props insp proc-spec immutables) - (struct-type-install-properties! rtd name init-count auto-count parent-rtd props insp proc-spec immutables #f #f #f)] - [(rtd name init-count auto-count parent-rtd props insp proc-spec immutables guard) - (struct-type-install-properties! rtd name init-count auto-count parent-rtd props insp proc-spec immutables guard #f #f)] - [(rtd name init-count auto-count parent-rtd props insp proc-spec immutables guard constructor-name) - (struct-type-install-properties! rtd name init-count auto-count parent-rtd props insp proc-spec immutables guard constructor-name #f)] - [(rtd name init-count auto-count parent-rtd props insp proc-spec immutables guard constructor-name install-props!) - (let ([install-props! - (or install-props! - (check-make-struct-type-arguments 'make-struct-type (if (pair? name) (car name) name) parent-rtd init-count auto-count - props insp proc-spec immutables guard constructor-name))]) - (unless (eq? insp 'prefab) ; everything for prefab must be covered in `prefab-key+count->rtd` - (let* ([parent-rtd* (strip-impersonator parent-rtd)] - [parent-props - (if parent-rtd* - (eq-hashtable-ref rtd-props parent-rtd* '()) - '())] - [all-immutables (if (integer? proc-spec) - (cons proc-spec immutables) - immutables)]) - (when (not parent-rtd*) - (record-type-equal-procedure rtd default-struct-equal?) - (record-type-hash-procedure rtd default-struct-hash)) - ;; Record properties implemented by this type: - (let ([props (let ([props (append (map car props) parent-props)]) - (if proc-spec - (cons prop:procedure props) - props))]) - (add-to-table! rtd-props rtd props)) - ;; Copy parent properties for this type: - (for-each (lambda (prop) - (let loop ([prop prop]) - (struct-property-set! prop rtd (struct-property-ref prop parent-rtd* #f)) - (for-each (lambda (super) - (loop (car super))) - (struct-type-prop-supers prop)))) - parent-props) - ;; Finish checking and install new property values: - (install-props! rtd parent-rtd* all-immutables) - ;; Record inspector - (unless (and (pair? name) ; pair implies a system structure type - insp) - (inspector-set! rtd insp)) - ;; Register guard - (register-guards! rtd parent-rtd guard 'at-start))))])) - ;; Field count (init + auto) not including parent fields (define (record-type-field-count rtd) (fx- (#%$record-type-field-count rtd) @@ -878,6 +891,14 @@ "current inspector cannot extract info for structure type" "structure type" rtd))) +(define/who (struct-type-sealed? rtd) + (check who struct-type? rtd) + (#%$record-type-act-sealed? (strip-impersonator rtd))) + +(define/who (struct-type-authentic? rtd) + (check who struct-type? rtd) + (struct-property-ref prop:authentic (strip-impersonator rtd) #f)) + (define/who struct-type-make-constructor (case-lambda [(rtd) (struct-type-make-constructor rtd #f)] @@ -1085,6 +1106,8 @@ (#%$record-set! s i v)) (define (unsafe-struct? v r) (#3%record? v r)) +(define (unsafe-sealed-struct? v r) + (#3%$sealed-record? v r)) ;; internal use only, so doesn't need to have 'unsafe-struct as it's name, etc.: (define unsafe-struct #%$record) @@ -1133,6 +1156,12 @@ (define-values (prop:authentic-override authentic-override? authentic-override-ref) (make-struct-type-property 'authentic-override (lambda (val info) #t))) +;; A struct with prop:sealed is normally also `record-type-sealed?`, but +;; the schemify transformation might pessimistically generate a non-sealed +;; record type +(define-values (prop:sealed sealed? sealed-ref) + (make-struct-type-property 'sealed (lambda (val info) #t))) + (define (struct-type-immediate-transparent? rtd) (let ([insp (inspector-ref rtd)]) (and (not (eq? insp none)) diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index 86386ce2be..dba7e77c02 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -3922,18 +3922,8 @@ (define cell.2$4 (unsafe-make-place-local (make-hasheq))) (define performance-place-init! (lambda () (unsafe-place-local-set! cell.2$4 (make-hasheq)))) -(define struct:region - (make-record-type-descriptor* - 'region - #f - (|#%nongenerative-uid| region) - #f - #f - 5 - 30)) -(define effect_2695 - (struct-type-install-properties! - struct:region +(define finish104 + (make-struct-type-install-properties '(region) 5 0 @@ -3944,6 +3934,16 @@ '(0) #f 'region)) +(define struct:region + (make-record-type-descriptor* + 'region + #f + (|#%nongenerative-uid| region) + #f + #f + 5 + 30)) +(define effect_2980 (finish104 struct:region)) (define region1.1 (|#%name| region @@ -4104,18 +4104,8 @@ v 'region 'as-nested-memory)))))) -(define struct:stat - (make-record-type-descriptor* - 'stat - #f - (|#%nongenerative-uid| stat) - #f - #f - 3 - 7)) -(define effect_2612 - (struct-type-install-properties! - struct:stat +(define finish116 + (make-struct-type-install-properties '(stat) 3 0 @@ -4126,6 +4116,16 @@ '() #f 'stat)) +(define struct:stat + (make-record-type-descriptor* + 'stat + #f + (|#%nongenerative-uid| stat) + #f + #f + 3 + 7)) +(define effect_2500 (finish116 struct:stat)) (define stat2.1 (|#%name| stat @@ -5405,18 +5405,8 @@ (for-loop_0 0 start_0)))) #f) #f))) -(define struct:weak-intern-table - (make-record-type-descriptor* - 'weak-intern-table - #f - (|#%nongenerative-uid| weak-intern-table) - #f - #f - 1 - 0)) -(define effect_2381 - (struct-type-install-properties! - struct:weak-intern-table +(define finish154 + (make-struct-type-install-properties '(weak-intern-table) 1 0 @@ -5427,6 +5417,16 @@ '(0) #f 'weak-intern-table)) +(define struct:weak-intern-table + (make-record-type-descriptor* + 'weak-intern-table + #f + (|#%nongenerative-uid| weak-intern-table) + #f + #f + 1 + 0)) +(define effect_2507 (finish154 struct:weak-intern-table)) (define weak-intern-table1.1 (|#%name| weak-intern-table @@ -5438,18 +5438,8 @@ (|#%name| weak-intern-table-box (record-accessor struct:weak-intern-table 0))) -(define struct:table - (make-record-type-descriptor* - 'table - #f - (|#%nongenerative-uid| table) - #f - #f - 3 - 0)) -(define effect_2163 - (struct-type-install-properties! - struct:table +(define finish156 + (make-struct-type-install-properties '(table) 3 0 @@ -5460,6 +5450,16 @@ '(0 1 2) #f 'table)) +(define struct:table + (make-record-type-descriptor* + 'table + #f + (|#%nongenerative-uid| table) + #f + #f + 3 + 0)) +(define effect_2522 (finish156 struct:table)) (define table2.1 (|#%name| table @@ -5639,18 +5639,8 @@ result_0)))))) (for-loop_0 0 (hash-iterate-first new-ht_0)))))) (table2.1 new-ht_0 count_0 (max 128 (* 2 count_0)))))))) -(define struct:resolved-module-path - (make-record-type-descriptor* - 'resolved-module-path - #f - (|#%nongenerative-uid| resolved-module-path) - #f - #f - 1 - 0)) -(define effect_2789 - (struct-type-install-properties! - struct:resolved-module-path +(define finish160 + (make-struct-type-install-properties '(resolved-module-path) 1 0 @@ -5690,6 +5680,16 @@ '(0) #f 'resolved-module-path)) +(define struct:resolved-module-path + (make-record-type-descriptor* + 'resolved-module-path + #f + (|#%nongenerative-uid| resolved-module-path) + #f + #f + 1 + 0)) +(define effect_2442 (finish160 struct:resolved-module-path)) (define resolved-module-path1.1 (|#%name| resolved-module-path @@ -5820,18 +5820,8 @@ (if (pair? name_0) (list* 'submod root-mod-path_0 (cdr name_0)) root-mod-path_0)))))) -(define struct:module-path-index - (make-record-type-descriptor* - 'module-path-index - #f - (|#%nongenerative-uid| module-path-index) - #f - #f - 4 - 12)) -(define effect_3060 - (struct-type-install-properties! - struct:module-path-index +(define finish163 + (make-struct-type-install-properties '(module-path-index) 4 0 @@ -5954,6 +5944,16 @@ '(0 1) #f 'module-path-index)) +(define struct:module-path-index + (make-record-type-descriptor* + 'module-path-index + #f + (|#%nongenerative-uid| module-path-index) + #f + #f + 4 + 12)) +(define effect_2892 (finish163 struct:module-path-index)) (define module-path-index2.1 (|#%name| module-path-index @@ -6515,18 +6515,8 @@ (if (pair? default-name_0) (cons root-name_0 (cdr default-name_0)) root-name_0)))))) -(define struct:promise - (make-record-type-descriptor* - 'promise - #f - (|#%nongenerative-uid| promise) - #f - #f - 2 - 3)) -(define effect_2512 - (struct-type-install-properties! - struct:promise +(define finish175 + (make-struct-type-install-properties '(promise) 2 0 @@ -6537,6 +6527,16 @@ '() #f 'promise)) +(define struct:promise + (make-record-type-descriptor* + 'promise + #f + (|#%nongenerative-uid| promise) + #f + #f + 2 + 3)) +(define effect_2268 (finish175 struct:promise)) (define promise1.1 (|#%name| promise @@ -6582,18 +6582,8 @@ (lambda (small-ht_0 key_0 val_0) (set-box! small-ht_0 (hash-set (unbox small-ht_0) key_0 val_0)))) (define small-hash-keys (lambda (small-ht_0) (hash-keys (unbox small-ht_0)))) -(define struct:serialize-state - (make-record-type-descriptor* - 'serialize-state - #f - (|#%nongenerative-uid| serialize-state) - #f - #f - 12 - 0)) -(define effect_2433 - (struct-type-install-properties! - struct:serialize-state +(define finish177 + (make-struct-type-install-properties '(serialize-state) 12 0 @@ -6604,6 +6594,16 @@ '(0 1 2 3 4 5 6 7 8 9 10 11) #f 'serialize-state)) +(define struct:serialize-state + (make-record-type-descriptor* + 'serialize-state + #f + (|#%nongenerative-uid| serialize-state) + #f + #f + 12 + 0)) +(define effect_2707 (finish177 struct:serialize-state)) (define serialize-state1.1 (|#%name| serialize-state @@ -7203,18 +7203,8 @@ (if (hash? d_0) (if (immutable? d_0) (positive? (hash-count d_0)) #f) #f))))))))))) -(define struct:preserved-property-value - (make-record-type-descriptor* - 'preserved-property-value - #f - (|#%nongenerative-uid| preserved-property-value) - #f - #f - 1 - 0)) -(define effect_2856 - (struct-type-install-properties! - struct:preserved-property-value +(define finish192 + (make-struct-type-install-properties '(preserved-property-value) 1 0 @@ -7225,6 +7215,16 @@ '(0) #f 'preserved-property-value)) +(define struct:preserved-property-value + (make-record-type-descriptor* + 'preserved-property-value + #f + (|#%nongenerative-uid| preserved-property-value) + #f + #f + 1 + 0)) +(define effect_2588 (finish192 struct:preserved-property-value)) (define preserved-property-value1.1 (|#%name| preserved-property-value @@ -7416,18 +7416,8 @@ (make-parameter (seteq) #f 'current-arm-inspectors)) (define deserialize-tamper (lambda (t_0) (if (eq? t_0 'armed) (current-arm-inspectors) t_0))) -(define struct:modified-content - (make-record-type-descriptor* - 'modified-content - #f - (|#%nongenerative-uid| modified-content) - #f - #f - 2 - 0)) -(define effect_2273 - (struct-type-install-properties! - struct:modified-content +(define finish200 + (make-struct-type-install-properties '(modified-content) 2 0 @@ -7438,6 +7428,16 @@ '(0 1) #f 'modified-content)) +(define struct:modified-content + (make-record-type-descriptor* + 'modified-content + #f + (|#%nongenerative-uid| modified-content) + #f + #f + 2 + 0)) +(define effect_2176 (finish200 struct:modified-content)) (define modified-content1.1 (|#%name| modified-content @@ -7453,23 +7453,14 @@ (|#%name| modified-content-scope-propagations+tamper (record-accessor struct:modified-content 1))) -(define struct:syntax - (make-record-type-descriptor* - 'syntax - #f - (|#%nongenerative-uid| syntax) - #f - #f - 7 - 1)) -(define effect_2877 - (struct-type-install-properties! - struct:syntax +(define finish202 + (make-struct-type-install-properties '(syntax) 7 0 #f (list + (cons prop:sealed #t) (cons prop:authentic #t) (cons prop:reach-scopes @@ -7695,6 +7686,16 @@ '(1 2 3 4 5 6) #f 'syntax)) +(define struct:syntax + (make-record-type-descriptor* + 'syntax + #f + (|#%nongenerative-uid| syntax) + #t + #f + 7 + 1)) +(define effect_2447 (finish202 struct:syntax)) (define syntax2.1 (|#%name| syntax @@ -8041,18 +8042,8 @@ s_0)))) (define syntax-place-init! (lambda () (unsafe-place-local-set! cell.1$7 (make-weak-hasheq)))) -(define struct:syntax-state - (make-record-type-descriptor* - 'syntax-state - #f - (|#%nongenerative-uid| syntax-state) - #f - #f - 3 - 1)) -(define effect_2886 - (struct-type-install-properties! - struct:syntax-state +(define finish228 + (make-struct-type-install-properties '(syntax-state) 3 0 @@ -8063,6 +8054,16 @@ '(1 2) #f 'syntax-state)) +(define struct:syntax-state + (make-record-type-descriptor* + 'syntax-state + #f + (|#%nongenerative-uid| syntax-state) + #f + #f + 3 + 1)) +(define effect_2710 (finish228 struct:syntax-state)) (define syntax-state17.1 (|#%name| syntax-state @@ -8167,18 +8168,8 @@ #f inspector_0))) (datum->syntax$1 s_0 content_0 s_0 s_0)))) -(define struct:full-binding - (make-record-type-descriptor* - 'full-binding - #f - (|#%nongenerative-uid| full-binding) - #f - #f - 2 - 0)) -(define effect_3190 - (struct-type-install-properties! - struct:full-binding +(define finish234 + (make-struct-type-install-properties '(full-binding) 2 0 @@ -8191,6 +8182,16 @@ '(0 1) #f 'full-binding)) +(define struct:full-binding + (make-record-type-descriptor* + 'full-binding + #f + (|#%nongenerative-uid| full-binding) + #f + #f + 2 + 0)) +(define effect_2734 (finish234 struct:full-binding)) (define full-binding1.1 (|#%name| full-binding @@ -8343,18 +8344,8 @@ (lambda (b_0) (let ((or-part_0 (simple-module-binding? b_0))) (if or-part_0 or-part_0 (full-module-binding? b_0))))) -(define struct:full-module-binding - (make-record-type-descriptor* - 'full-module-binding - struct:full-binding - (|#%nongenerative-uid| full-module-binding) - #f - #f - 9 - 0)) -(define effect_2690 - (struct-type-install-properties! - struct:full-module-binding +(define finish236 + (make-struct-type-install-properties '(full-module-binding) 9 0 @@ -8405,6 +8396,16 @@ '(0 1 2 3 4 5 6 7 8) #f 'full-module-binding)) +(define struct:full-module-binding + (make-record-type-descriptor* + 'full-module-binding + struct:full-binding + (|#%nongenerative-uid| full-module-binding) + #f + #f + 9 + 0)) +(define effect_2481 (finish236 struct:full-module-binding)) (define full-module-binding45.1 (|#%name| full-module-binding @@ -8450,18 +8451,8 @@ (|#%name| full-module-binding-extra-nominal-bindings (record-accessor struct:full-module-binding 8))) -(define struct:simple-module-binding - (make-record-type-descriptor* - 'simple-module-binding - #f - (|#%nongenerative-uid| simple-module-binding) - #f - #f - 4 - 0)) -(define effect_2369 - (struct-type-install-properties! - struct:simple-module-binding +(define finish238 + (make-struct-type-install-properties '(simple-module-binding) 4 0 @@ -8482,6 +8473,16 @@ '(0 1 2 3) #f 'simple-module-binding)) +(define struct:simple-module-binding + (make-record-type-descriptor* + 'simple-module-binding + #f + (|#%nongenerative-uid| simple-module-binding) + #f + #f + 4 + 0)) +(define effect_2891 (finish238 struct:simple-module-binding)) (define simple-module-binding46.1 (|#%name| simple-module-binding @@ -8579,18 +8580,8 @@ null (full-module-binding-extra-nominal-bindings b_0)))) (define empty-binding-table hash2610) -(define struct:table-with-bulk-bindings - (make-record-type-descriptor* - 'table-with-bulk-bindings - #f - (|#%nongenerative-uid| table-with-bulk-bindings) - #f - #f - 3 - 0)) -(define effect_2600 - (struct-type-install-properties! - struct:table-with-bulk-bindings +(define finish240 + (make-struct-type-install-properties '(table-with-bulk-bindings) 3 0 @@ -8611,6 +8602,16 @@ '(0 1 2) #f 'table-with-bulk-bindings)) +(define struct:table-with-bulk-bindings + (make-record-type-descriptor* + 'table-with-bulk-bindings + #f + (|#%nongenerative-uid| table-with-bulk-bindings) + #f + #f + 3 + 0)) +(define effect_2950 (finish240 struct:table-with-bulk-bindings)) (define table-with-bulk-bindings1.1 (|#%name| table-with-bulk-bindings @@ -8638,18 +8639,8 @@ (define deserialize-table-with-bulk-bindings (lambda (syms_0 bulk-bindings_0) (table-with-bulk-bindings1.1 syms_0 syms_0 bulk-bindings_0))) -(define struct:bulk-binding-at - (make-record-type-descriptor* - 'bulk-binding-at - #f - (|#%nongenerative-uid| bulk-binding-at) - #f - #f - 2 - 0)) -(define effect_2624 - (struct-type-install-properties! - struct:bulk-binding-at +(define finish242 + (make-struct-type-install-properties '(bulk-binding-at) 2 0 @@ -8671,6 +8662,16 @@ '(0 1) #f 'bulk-binding-at)) +(define struct:bulk-binding-at + (make-record-type-descriptor* + 'bulk-binding-at + #f + (|#%nongenerative-uid| bulk-binding-at) + #f + #f + 2 + 0)) +(define effect_2253 (finish242 struct:bulk-binding-at)) (define bulk-binding-at2.1 (|#%name| bulk-binding-at @@ -8687,18 +8688,8 @@ (define-values (prop:bulk-binding bulk-binding?$1 bulk-binding-ref) (make-struct-type-property 'bulk-binding)) -(define struct:bulk-binding-class - (make-record-type-descriptor* - 'bulk-binding-class - #f - (|#%nongenerative-uid| bulk-binding-class) - #f - #f - 2 - 0)) -(define effect_2865 - (struct-type-install-properties! - struct:bulk-binding-class +(define finish245 + (make-struct-type-install-properties '(bulk-binding-class) 2 0 @@ -8709,6 +8700,16 @@ '(0 1) #f 'bulk-binding-class)) +(define struct:bulk-binding-class + (make-record-type-descriptor* + 'bulk-binding-class + #f + (|#%nongenerative-uid| bulk-binding-class) + #f + #f + 2 + 0)) +(define effect_2841 (finish245 struct:bulk-binding-class)) (define bulk-binding-class3.1 (|#%name| bulk-binding-class @@ -10183,18 +10184,8 @@ (lambda (sup-i_0 i_0) (let ((or-part_0 (eq? sup-i_0 i_0))) (if or-part_0 or-part_0 (inspector-superior? sup-i_0 i_0))))) -(define struct:fallback - (make-record-type-descriptor* - 'fallback - #f - (structure-type-lookup-prefab-uid 'fallback #f 1 0 #f '(0)) - #f - #f - 1 - 1)) -(define effect_2304 - (struct-type-install-properties! - struct:fallback +(define finish298 + (make-struct-type-install-properties '(fallback) 1 0 @@ -10205,6 +10196,16 @@ '(0) #f 'fallback)) +(define struct:fallback + (make-record-type-descriptor* + 'fallback + #f + (structure-type-lookup-prefab-uid 'fallback #f 1 0 #f '(0)) + #f + #f + 1 + 1)) +(define effect_2114 (finish298 struct:fallback)) (define fallback1.1 (|#%name| fallback @@ -10305,18 +10306,8 @@ (begin (if c_0 (hash-clear! c_0) (void)) (unsafe-set-box*! (unsafe-place-local-ref cell.2$3) #f)))))) -(define struct:entry - (make-record-type-descriptor* - 'entry - #f - (|#%nongenerative-uid| entry) - #f - #f - 4 - 0)) -(define effect_2019 - (struct-type-install-properties! - struct:entry +(define finish302 + (make-struct-type-install-properties '(entry) 4 0 @@ -10327,6 +10318,16 @@ '(0 1 2 3) #f 'entry)) +(define struct:entry + (make-record-type-descriptor* + 'entry + #f + (|#%nongenerative-uid| entry) + #f + #f + 4 + 0)) +(define effect_2728 (finish302 struct:entry)) (define entry1.1 (|#%name| entry @@ -10367,18 +10368,8 @@ (define SHIFTED-CACHE-SIZE 16) (define cell.2$3 (unsafe-make-place-local (box #f))) (define cell.3$1 (unsafe-make-place-local 0)) -(define struct:shifted-entry - (make-record-type-descriptor* - 'shifted-entry - #f - (|#%nongenerative-uid| shifted-entry) - #f - #f - 3 - 0)) -(define effect_2850 - (struct-type-install-properties! - struct:shifted-entry +(define finish304 + (make-struct-type-install-properties '(shifted-entry) 3 0 @@ -10389,6 +10380,16 @@ '(0 1 2) #f 'shifted-entry)) +(define struct:shifted-entry + (make-record-type-descriptor* + 'shifted-entry + #f + (|#%nongenerative-uid| shifted-entry) + #f + #f + 3 + 0)) +(define effect_2358 (finish304 struct:shifted-entry)) (define shifted-entry2.1 (|#%name| shifted-entry @@ -10577,18 +10578,8 @@ s_0)))))) (define cache-place-init! (lambda () (begin (resolve-cache-place-init!) (sets-place-init!)))) -(define struct:scope - (make-record-type-descriptor* - 'scope - #f - (|#%nongenerative-uid| scope) - #f - #f - 3 - 4)) -(define effect_2404 - (struct-type-install-properties! - struct:scope +(define finish306 + (make-struct-type-install-properties '(scope) 3 0 @@ -10643,6 +10634,16 @@ '(0 1) #f 'scope)) +(define struct:scope + (make-record-type-descriptor* + 'scope + #f + (|#%nongenerative-uid| scope) + #f + #f + 3 + 4)) +(define effect_2269 (finish306 struct:scope)) (define scope1.1 (|#%name| scope @@ -10662,18 +10663,8 @@ (scope1.1 (new-deserialize-scope-id!) kind_0 empty-binding-table)))) (define deserialize-scope-fill! (lambda (s_0 bt_0) (set-scope-binding-table! s_0 bt_0))) -(define struct:interned-scope - (make-record-type-descriptor* - 'interned-scope - struct:scope - (|#%nongenerative-uid| interned-scope) - #f - #f - 1 - 0)) -(define effect_2647 - (struct-type-install-properties! - struct:interned-scope +(define finish310 + (make-struct-type-install-properties '(interned-scope) 1 0 @@ -10706,6 +10697,16 @@ '(0) #f 'interned-scope)) +(define struct:interned-scope + (make-record-type-descriptor* + 'interned-scope + struct:scope + (|#%nongenerative-uid| interned-scope) + #f + #f + 1 + 0)) +(define effect_2498 (finish310 struct:interned-scope)) (define interned-scope2.1 (|#%name| interned-scope @@ -10715,23 +10716,14 @@ (|#%name| interned-scope? (record-predicate struct:interned-scope))) (define interned-scope-key (|#%name| interned-scope-key (record-accessor struct:interned-scope 0))) -(define struct:multi-scope - (make-record-type-descriptor* - 'multi-scope - #f - (|#%nongenerative-uid| multi-scope) - #f - #f - 5 - 0)) -(define effect_2724 - (struct-type-install-properties! - struct:multi-scope +(define finish314 + (make-struct-type-install-properties '(multi-scope) 5 0 #f (list + (cons prop:sealed #t) (cons prop:authentic #t) (cons prop:scope-with-bindings @@ -10839,6 +10831,16 @@ '(0 1 2 3 4) #f 'multi-scope)) +(define struct:multi-scope + (make-record-type-descriptor* + 'multi-scope + #f + (|#%nongenerative-uid| multi-scope) + #t + #f + 5 + 0)) +(define effect_1895 (finish314 struct:multi-scope)) (define multi-scope3.1 (|#%name| multi-scope @@ -10862,18 +10864,8 @@ (let ((app_1 (box scopes_0))) (let ((app_2 (box (hasheqv)))) (multi-scope3.1 app_0 name_0 app_1 app_2 (box (hash)))))))) -(define struct:representative-scope - (make-record-type-descriptor* - 'representative-scope - struct:scope - (|#%nongenerative-uid| representative-scope) - #f - #f - 2 - 3)) -(define effect_2909 - (struct-type-install-properties! - struct:representative-scope +(define finish321 + (make-struct-type-install-properties '(representative-scope) 2 0 @@ -10921,6 +10913,16 @@ '() #f 'representative-scope)) +(define struct:representative-scope + (make-record-type-descriptor* + 'representative-scope + struct:scope + (|#%nongenerative-uid| representative-scope) + #f + #f + 2 + 3)) +(define effect_2683 (finish321 struct:representative-scope)) (define representative-scope4.1 (|#%name| representative-scope @@ -10961,23 +10963,14 @@ (begin (begin-unsafe (set-scope-binding-table! s_0 bt_0)) (set-representative-scope-owner! s_0 owner_0)))) -(define struct:shifted-multi-scope - (make-record-type-descriptor* - 'shifted-multi-scope - #f - (|#%nongenerative-uid| shifted-multi-scope) - #f - #f - 2 - 0)) -(define effect_2293 - (struct-type-install-properties! - struct:shifted-multi-scope +(define finish325 + (make-struct-type-install-properties '(shifted-multi-scope) 2 0 #f (list + (cons prop:sealed #t) (cons prop:authentic #t) (cons prop:reach-scopes @@ -11006,6 +10999,16 @@ '(0 1) #f 'shifted-multi-scope)) +(define struct:shifted-multi-scope + (make-record-type-descriptor* + 'shifted-multi-scope + #f + (|#%nongenerative-uid| shifted-multi-scope) + #t + #f + 2 + 0)) +(define effect_2854 (finish325 struct:shifted-multi-scope)) (define shifted-multi-scope5.1 (|#%name| shifted-multi-scope @@ -11069,18 +11072,8 @@ (multi-scope-label-shifted multi-scope_0) phase_0 (lambda () (shifted-multi-scope5.1 phase_0 multi-scope_0))))))))) -(define struct:shifted-to-label-phase - (make-record-type-descriptor* - 'shifted-to-label-phase - #f - (structure-type-lookup-prefab-uid 'shifted-to-label-phase #f 1 0 #f '(0)) - #f - #f - 1 - 1)) -(define effect_2767 - (struct-type-install-properties! - struct:shifted-to-label-phase +(define finish328 + (make-struct-type-install-properties '(shifted-to-label-phase) 1 0 @@ -11091,6 +11084,16 @@ '(0) #f 'shifted-to-label-phase)) +(define struct:shifted-to-label-phase + (make-record-type-descriptor* + 'shifted-to-label-phase + #f + (structure-type-lookup-prefab-uid 'shifted-to-label-phase #f 1 0 #f '(0)) + #f + #f + 1 + 1)) +(define effect_2315 (finish328 struct:shifted-to-label-phase)) (define shifted-to-label-phase6.1 (|#%name| shifted-to-label-phase @@ -11933,23 +11936,14 @@ (gf_0 #f s_2))))))))))))) (loop_1 #f s_1 0))))))))) (loop_0 s_0))))))))) -(define struct:propagation - (make-record-type-descriptor* - 'propagation - #f - (|#%nongenerative-uid| propagation) - #f - #f - 7 - 0)) -(define effect_2715 - (struct-type-install-properties! - struct:propagation +(define finish403 + (make-struct-type-install-properties '(propagation) 7 0 #f (list + (cons prop:sealed #t) (cons prop:authentic #t) (cons prop:propagation-set-tamper @@ -11961,6 +11955,16 @@ '(0 1 2 3 4 5 6) #f 'propagation)) +(define struct:propagation + (make-record-type-descriptor* + 'propagation + #f + (|#%nongenerative-uid| propagation) + #t + #f + 7 + 0)) +(define effect_2326 (finish403 struct:propagation)) (define propagation12.1 (|#%name| propagation @@ -13309,18 +13313,8 @@ (lambda (b_0) (let ((or-part_0 (full-local-binding? b_0))) (if or-part_0 or-part_0 (symbol? b_0))))) -(define struct:full-local-binding - (make-record-type-descriptor* - 'full-local-binding - struct:full-binding - (|#%nongenerative-uid| full-local-binding) - #f - #f - 1 - 0)) -(define effect_2682 - (struct-type-install-properties! - struct:full-local-binding +(define finish475 + (make-struct-type-install-properties '(full-local-binding) 1 0 @@ -13339,6 +13333,16 @@ '(0) #f 'full-local-binding)) +(define struct:full-local-binding + (make-record-type-descriptor* + 'full-local-binding + struct:full-binding + (|#%nongenerative-uid| full-local-binding) + #f + #f + 1 + 0)) +(define effect_3011 (finish475 struct:full-local-binding)) (define full-local-binding1.1 (|#%name| full-local-binding @@ -13444,18 +13448,8 @@ "given" id_0)) id_0))))))))))) -(define struct:id-rename-transformer - (make-record-type-descriptor* - 'rename-transformer - #f - (|#%nongenerative-uid| rename-transformer) - #f - #f - 1 - 0)) -(define effect_2553 - (struct-type-install-properties! - struct:id-rename-transformer +(define finish478 + (make-struct-type-install-properties '(rename-transformer) 1 0 @@ -13466,6 +13460,16 @@ '(0) #f 'id-rename-transformer)) +(define struct:id-rename-transformer + (make-record-type-descriptor* + 'rename-transformer + #f + (|#%nongenerative-uid| rename-transformer) + #f + #f + 1 + 0)) +(define effect_2525 (finish478 struct:id-rename-transformer)) (define id-rename-transformer1.1 (|#%name| id-rename-transformer @@ -13688,18 +13692,8 @@ unsafe-undefined b_0) (error "bad binding for free=id:" b_0))))) -(define struct:non-source-shift - (make-record-type-descriptor* - 'non-source-shift - #f - (structure-type-lookup-prefab-uid 'non-source-shift #f 2 0 #f '(0 1)) - #f - #f - 2 - 3)) -(define effect_2158 - (struct-type-install-properties! - struct:non-source-shift +(define finish497 + (make-struct-type-install-properties '(non-source-shift) 2 0 @@ -13710,6 +13704,16 @@ '(0 1) #f 'non-source-shift)) +(define struct:non-source-shift + (make-record-type-descriptor* + 'non-source-shift + #f + (structure-type-lookup-prefab-uid 'non-source-shift #f 2 0 #f '(0 1)) + #f + #f + 2 + 3)) +(define effect_3061 (finish497 struct:non-source-shift)) (define non-source-shift4.1 (|#%name| non-source-shift @@ -14236,18 +14240,8 @@ (syntax-props the-struct_0) (syntax-inspector the-struct_0))) (raise-argument-error 'struct-copy "syntax?" the-struct_0)))))))) -(define struct:provided - (make-record-type-descriptor* - 'provided - #f - (|#%nongenerative-uid| provided) - #f - #f - 3 - 0)) -(define effect_1918 - (struct-type-install-properties! - struct:provided +(define finish504 + (make-struct-type-install-properties '(provided) 3 0 @@ -14267,6 +14261,16 @@ '(0 1 2) #f 'provided)) +(define struct:provided + (make-record-type-descriptor* + 'provided + #f + (|#%nongenerative-uid| provided) + #f + #f + 3 + 0)) +(define effect_2629 (finish504 struct:provided)) (define provided1.1 (|#%name| provided @@ -14320,18 +14324,8 @@ unsafe-undefined unsafe-undefined binding_0)))))))))) -(define struct:bulk-binding - (make-record-type-descriptor* - 'bulk-binding - #f - (|#%nongenerative-uid| bulk-binding) - #f - #f - 8 - 9)) -(define effect_2716 - (struct-type-install-properties! - struct:bulk-binding +(define finish506 + (make-struct-type-install-properties '(bulk-binding) 8 0 @@ -14431,6 +14425,16 @@ '(1 2 4 5 6 7) #f 'bulk-binding)) +(define struct:bulk-binding + (make-record-type-descriptor* + 'bulk-binding + #f + (|#%nongenerative-uid| bulk-binding) + #f + #f + 8 + 9)) +(define effect_2834 (finish506 struct:bulk-binding)) (define bulk-binding12.1 (|#%name| bulk-binding @@ -14518,18 +14522,8 @@ (args (raise-binding-result-arity-error 2 args)))) table_0)))))) (for-loop_0 hash2725 (hash-iterate-first provides_0)))))) -(define struct:bulk-provide - (make-record-type-descriptor* - 'bulk-provide - #f - (|#%nongenerative-uid| bulk-provide) - #f - #f - 2 - 0)) -(define effect_2011 - (struct-type-install-properties! - struct:bulk-provide +(define finish510 + (make-struct-type-install-properties '(bulk-provide) 2 0 @@ -14540,6 +14534,16 @@ '(0 1) #f 'bulk-provide)) +(define struct:bulk-provide + (make-record-type-descriptor* + 'bulk-provide + #f + (|#%nongenerative-uid| bulk-provide) + #f + #f + 2 + 0)) +(define effect_2392 (finish510 struct:bulk-provide)) (define bulk-provide13.1 (|#%name| bulk-provide @@ -14589,18 +14593,8 @@ s 'bulk-provide 'provides)))))) -(define struct:bulk-binding-registry - (make-record-type-descriptor* - 'bulk-binding-registry - #f - (|#%nongenerative-uid| bulk-binding-registry) - #f - #f - 1 - 0)) -(define effect_2308 - (struct-type-install-properties! - struct:bulk-binding-registry +(define finish515 + (make-struct-type-install-properties '(bulk-binding-registry) 1 0 @@ -14611,6 +14605,16 @@ '(0) #f 'bulk-binding-registry)) +(define struct:bulk-binding-registry + (make-record-type-descriptor* + 'bulk-binding-registry + #f + (|#%nongenerative-uid| bulk-binding-registry) + #f + #f + 1 + 0)) +(define effect_2403 (finish515 struct:bulk-binding-registry)) (define bulk-binding-registry14.1 (|#%name| bulk-binding-registry @@ -14663,18 +14667,8 @@ #t #f))) (define generate-lift-key (lambda () (gensym 'lift))) -(define struct:root-expand-context/outer - (make-record-type-descriptor* - 'root-expand-context - #f - (|#%nongenerative-uid| root-expand-context) - #f - #f - 4 - 0)) -(define effect_2392 - (struct-type-install-properties! - struct:root-expand-context/outer +(define finish519 + (make-struct-type-install-properties '(root-expand-context) 4 0 @@ -14685,6 +14679,16 @@ '(0 1 2 3) #f 'root-expand-context/outer)) +(define struct:root-expand-context/outer + (make-record-type-descriptor* + 'root-expand-context + #f + (|#%nongenerative-uid| root-expand-context) + #f + #f + 4 + 0)) +(define effect_2124 (finish519 struct:root-expand-context/outer)) (define root-expand-context/outer1.1 (|#%name| root-expand-context/outer @@ -14713,18 +14717,8 @@ (|#%name| root-expand-context-frame-id (record-accessor struct:root-expand-context/outer 3))) -(define struct:root-expand-context/inner - (make-record-type-descriptor* - 'root-expand-context/inner - #f - (|#%nongenerative-uid| root-expand-context/inner) - #f - #f - 7 - 0)) -(define effect_2714 - (struct-type-install-properties! - struct:root-expand-context/inner +(define finish521 + (make-struct-type-install-properties '(root-expand-context/inner) 7 0 @@ -14735,6 +14729,16 @@ '(0 1 2 3 4 5 6) #f 'root-expand-context/inner)) +(define struct:root-expand-context/inner + (make-record-type-descriptor* + 'root-expand-context/inner + #f + (|#%nongenerative-uid| root-expand-context/inner) + #f + #f + 7 + 0)) +(define effect_2880 (finish521 struct:root-expand-context/inner)) (define root-expand-context/inner2.1 (|#%name| root-expand-context/inner @@ -15272,18 +15276,8 @@ (error "broken '#%linklet primitive table; maybe you need to use \"bootstrap-run.rkt\""))) (void))) -(define struct:module-registry - (make-record-type-descriptor* - 'module-registry - #f - (|#%nongenerative-uid| module-registry) - #f - #f - 2 - 0)) -(define effect_2880 - (struct-type-install-properties! - struct:module-registry +(define finish559 + (make-struct-type-install-properties '(module-registry) 2 0 @@ -15294,6 +15288,16 @@ '(0 1) #f 'module-registry)) +(define struct:module-registry + (make-record-type-descriptor* + 'module-registry + #f + (|#%nongenerative-uid| module-registry) + #f + #f + 2 + 0)) +(define effect_2565 (finish559 struct:module-registry)) (define module-registry1.1 (|#%name| module-registry @@ -15392,18 +15396,8 @@ (if or-part_0 or-part_0 never-evt)))) (loop_0)))))))))) (loop_0))))) -(define struct:namespace - (make-record-type-descriptor* - 'namespace - #f - (|#%nongenerative-uid| namespace) - #f - #f - 15 - 4096)) -(define effect_3044 - (struct-type-install-properties! - struct:namespace +(define finish569 + (make-struct-type-install-properties '(namespace) 15 0 @@ -15439,6 +15433,16 @@ '(0 1 2 3 4 5 6 7 8 9 10 11 13 14) #f 'namespace)) +(define struct:namespace + (make-record-type-descriptor* + 'namespace + #f + (|#%nongenerative-uid| namespace) + #f + #f + 15 + 4096)) +(define effect_3128 (finish569 struct:namespace)) (define namespace1.1 (|#%name| namespace @@ -15487,18 +15491,8 @@ (|#%name| namespace-module-instances (record-accessor struct:namespace 14))) (define set-namespace-inspector! (|#%name| set-namespace-inspector! (record-mutator struct:namespace 12))) -(define struct:definitions - (make-record-type-descriptor* - 'definitions - #f - (|#%nongenerative-uid| definitions) - #f - #f - 2 - 0)) -(define effect_2104 - (struct-type-install-properties! - struct:definitions +(define finish573 + (make-struct-type-install-properties '(definitions) 2 0 @@ -15509,6 +15503,16 @@ '(0 1) #f 'definitions)) +(define struct:definitions + (make-record-type-descriptor* + 'definitions + #f + (|#%nongenerative-uid| definitions) + #f + #f + 2 + 0)) +(define effect_2319 (finish573 struct:definitions)) (define definitions2.1 (|#%name| definitions @@ -16018,18 +16022,8 @@ (for-loop_0 new-stx_2 rest_0)))) new-stx_1)))))) (for-loop_0 new-stx_0 old-stxes_0))))) -(define struct:syntax-binding-set - (make-record-type-descriptor* - 'syntax-binding-set - #f - (|#%nongenerative-uid| syntax-binding-set) - #f - #f - 1 - 0)) -(define effect_2958 - (struct-type-install-properties! - struct:syntax-binding-set +(define finish617 + (make-struct-type-install-properties '(syntax-binding-set) 1 0 @@ -16040,6 +16034,16 @@ '(0) #f 'syntax-binding-set)) +(define struct:syntax-binding-set + (make-record-type-descriptor* + 'syntax-binding-set + #f + (|#%nongenerative-uid| syntax-binding-set) + #f + #f + 1 + 0)) +(define effect_2582 (finish617 struct:syntax-binding-set)) (define syntax-binding-set1.1 (|#%name| syntax-binding-set @@ -16075,18 +16079,8 @@ s 'syntax-binding-set 'binds)))))) -(define struct:bind - (make-record-type-descriptor* - 'bind - #f - (|#%nongenerative-uid| bind) - #f - #f - 3 - 0)) -(define effect_2143 - (struct-type-install-properties! - struct:bind +(define finish621 + (make-struct-type-install-properties '(bind) 3 0 @@ -16097,6 +16091,16 @@ '(0 1 2) #f 'bind)) +(define struct:bind + (make-record-type-descriptor* + 'bind + #f + (|#%nongenerative-uid| bind) + #f + #f + 3 + 0)) +(define effect_2584 (finish621 struct:bind)) (define bind2.1 (|#%name| bind @@ -16547,18 +16551,8 @@ (define current-previously-unbound (lambda () #f)) (define set-current-previously-unbound! (lambda (proc_0) (set! current-previously-unbound proc_0))) -(define struct:module-use - (make-record-type-descriptor* - 'module-use - #f - (|#%nongenerative-uid| module-use) - #f - #f - 2 - 0)) -(define effect_2205 - (struct-type-install-properties! - struct:module-use +(define finish632 + (make-struct-type-install-properties '(module-use) 2 0 @@ -16605,6 +16599,16 @@ '(0 1) #f 'module-use)) +(define struct:module-use + (make-record-type-descriptor* + 'module-use + #f + (|#%nongenerative-uid| module-use) + #f + #f + 2 + 0)) +(define effect_2097 (finish632 struct:module-use)) (define module-use1.1 (|#%name| module-use @@ -16652,18 +16656,8 @@ s 'module-use 'phase)))))) -(define struct:module - (make-record-type-descriptor* - 'module - #f - (|#%nongenerative-uid| module) - #f - #f - 20 - 16)) -(define effect_2306 - (struct-type-install-properties! - struct:module +(define finish640 + (make-struct-type-install-properties '(module) 20 0 @@ -16674,6 +16668,16 @@ '(0 1 2 3 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19) #f 'module)) +(define struct:module + (make-record-type-descriptor* + 'module + #f + (|#%nongenerative-uid| module) + #f + #f + 20 + 16)) +(define effect_2640 (finish640 struct:module)) (define module1.1 (|#%name| module @@ -16723,18 +16727,8 @@ (|#%name| module-get-all-variables (record-accessor struct:module 19))) (define set-module-access! (|#%name| set-module-access! (record-mutator struct:module 4))) -(define struct:module-linklet-info - (make-record-type-descriptor* - 'module-linklet-info - #f - (|#%nongenerative-uid| module-linklet-info) - #f - #f - 6 - 0)) -(define effect_2348 - (struct-type-install-properties! - struct:module-linklet-info +(define finish642 + (make-struct-type-install-properties '(module-linklet-info) 6 0 @@ -16745,6 +16739,16 @@ '(0 1 2 3 4 5) #f 'module-linklet-info)) +(define struct:module-linklet-info + (make-record-type-descriptor* + 'module-linklet-info + #f + (|#%nongenerative-uid| module-linklet-info) + #f + #f + 6 + 0)) +(define effect_2508 (finish642 struct:module-linklet-info)) (define module-linklet-info2.1 (|#%name| module-linklet-info @@ -16836,18 +16840,8 @@ submodule-names18_0 supermodule-name19_0 get-all-variables_0))))))))) -(define struct:module-instance - (make-record-type-descriptor* - 'module-instance - #f - (|#%nongenerative-uid| module-instance) - #f - #f - 7 - 52)) -(define effect_3032 - (struct-type-install-properties! - struct:module-instance +(define finish645 + (make-struct-type-install-properties '(module-instance) 7 0 @@ -16858,6 +16852,16 @@ '(0 1 3 6) #f 'module-instance)) +(define struct:module-instance + (make-record-type-descriptor* + 'module-instance + #f + (|#%nongenerative-uid| module-instance) + #f + #f + 7 + 52)) +(define effect_2382 (finish645 struct:module-instance)) (define module-instance40.1 (|#%name| module-instance @@ -18400,75 +18404,75 @@ (lambda (s_0) (error "bad syntax:" s_0))))) (lambda (t_0) v_0)))))))) (define 1/make-set!-transformer - (let ((struct:set!-transformer_0 - (make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 0))) - (let ((effect699 - (struct-type-install-properties! - struct:set!-transformer_0 - '(set!-transformer) - 1 - 0 - #f - (list (cons 1/prop:set!-transformer 0)) - (current-inspector) - #f - '(0) - #f - 'set!-transformer))) - (let ((set!-transformer1_0 - (|#%name| - set!-transformer - (record-constructor - (make-record-constructor-descriptor - struct:set!-transformer_0 - #f - #f))))) - (let ((set!-transformer?_0 + (let ((finish745 + (make-struct-type-install-properties + '(set!-transformer) + 1 + 0 + #f + (list (cons 1/prop:set!-transformer 0)) + (current-inspector) + #f + '(0) + #f + 'set!-transformer))) + (let ((struct:set!-transformer_0 + (make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 0))) + (let ((effect746 (finish745 struct:set!-transformer_0))) + (let ((set!-transformer1_0 (|#%name| - set!-transformer? - (record-predicate struct:set!-transformer_0)))) - (let ((set!-transformer?_1 + set!-transformer + (record-constructor + (make-record-constructor-descriptor + struct:set!-transformer_0 + #f + #f))))) + (let ((set!-transformer?_0 (|#%name| set!-transformer? - (lambda (v) - (if (set!-transformer?_0 v) - #t - ($value - (if (impersonator? v) - (set!-transformer?_0 (impersonator-val v)) - #f))))))) - (let ((set!-transformer-proc_0 + (record-predicate struct:set!-transformer_0)))) + (let ((set!-transformer?_1 (|#%name| - set!-transformer-proc - (record-accessor struct:set!-transformer_0 0)))) - (let ((set!-transformer-proc_1 + set!-transformer? + (lambda (v) + (if (set!-transformer?_0 v) + #t + ($value + (if (impersonator? v) + (set!-transformer?_0 (impersonator-val v)) + #f))))))) + (let ((set!-transformer-proc_0 (|#%name| set!-transformer-proc - (lambda (s) - (if (set!-transformer?_0 s) - (set!-transformer-proc_0 s) - ($value - (impersonate-ref - set!-transformer-proc_0 - struct:set!-transformer_0 - 0 - s - 'set!-transformer - 'proc))))))) - (|#%name| - make-set!-transformer - (lambda (proc_0) - (begin + (record-accessor struct:set!-transformer_0 0)))) + (let ((set!-transformer-proc_1 + (|#%name| + set!-transformer-proc + (lambda (s) + (if (set!-transformer?_0 s) + (set!-transformer-proc_0 s) + ($value + (impersonate-ref + set!-transformer-proc_0 + struct:set!-transformer_0 + 0 + s + 'set!-transformer + 'proc))))))) + (|#%name| + make-set!-transformer + (lambda (proc_0) (begin - (if (if (procedure? proc_0) - (procedure-arity-includes? proc_0 1) - #f) - (void) - (raise-argument-error - 'make-set!-transformer - "(procedure-arity-includes/c 1)" - proc_0)) - (set!-transformer1_0 proc_0))))))))))))) + (begin + (if (if (procedure? proc_0) + (procedure-arity-includes? proc_0 1) + #f) + (void) + (raise-argument-error + 'make-set!-transformer + "(procedure-arity-includes/c 1)" + proc_0)) + (set!-transformer1_0 proc_0)))))))))))))) (define 1/set!-transformer-procedure (|#%name| set!-transformer-procedure @@ -18487,18 +18491,8 @@ (lambda (t_0) (let ((or-part_0 (eq? t_0 variable))) (if or-part_0 or-part_0 (local-variable? t_0))))) -(define struct:local-variable - (make-record-type-descriptor* - 'local-variable - #f - (|#%nongenerative-uid| local-variable) - #f - #f - 1 - 0)) -(define effect_2425 - (struct-type-install-properties! - struct:local-variable +(define finish748 + (make-struct-type-install-properties '(local-variable) 1 0 @@ -18509,6 +18503,16 @@ '(0) #f 'local-variable)) +(define struct:local-variable + (make-record-type-descriptor* + 'local-variable + #f + (|#%nongenerative-uid| local-variable) + #f + #f + 1 + 0)) +(define effect_2625 (finish748 struct:local-variable)) (define local-variable1.1 (|#%name| local-variable @@ -18553,18 +18557,8 @@ (if (1/set!-transformer? t_0) (1/set!-transformer-procedure t_0) (if (1/rename-transformer? t_0) (lambda (s_0) s_0) t_0)))) -(define struct:core-form - (make-record-type-descriptor* - 'core-form - #f - (|#%nongenerative-uid| core-form) - #f - #f - 2 - 0)) -(define effect_2887 - (struct-type-install-properties! - struct:core-form +(define finish751 + (make-struct-type-install-properties '(core-form) 2 0 @@ -18575,6 +18569,16 @@ '(0 1) #f 'core-form)) +(define struct:core-form + (make-record-type-descriptor* + 'core-form + #f + (|#%nongenerative-uid| core-form) + #f + #f + 2 + 0)) +(define effect_2077 (finish751 struct:core-form)) (define core-form7.1 (|#%name| core-form @@ -18849,18 +18853,8 @@ (for-loop_0 #f lst_0))))))) (define free-id-set-empty-or-just-module*? (lambda (fs_0) (let ((c_0 (hash-count fs_0))) (<= c_0 1)))) -(define struct:expand-context/outer - (make-record-type-descriptor* - 'expand-context - struct:root-expand-context/outer - (|#%nongenerative-uid| expand-context) - #f - #f - 11 - 0)) -(define effect_2593 - (struct-type-install-properties! - struct:expand-context/outer +(define finish763 + (make-struct-type-install-properties '(expand-context) 11 0 @@ -18871,6 +18865,16 @@ '(0 1 2 3 4 5 6 7 8 9 10) #f 'expand-context/outer)) +(define struct:expand-context/outer + (make-record-type-descriptor* + 'expand-context + struct:root-expand-context/outer + (|#%nongenerative-uid| expand-context) + #f + #f + 11 + 0)) +(define effect_2851 (finish763 struct:expand-context/outer)) (define expand-context/outer1.1 (|#%name| expand-context/outer @@ -18922,18 +18926,8 @@ (|#%name| expand-context-name (record-accessor struct:expand-context/outer 10))) -(define struct:expand-context/inner - (make-record-type-descriptor* - 'expand-context/inner - struct:root-expand-context/inner - (|#%nongenerative-uid| expand-context/inner) - #f - #f - 22 - 0)) -(define effect_2402 - (struct-type-install-properties! - struct:expand-context/inner +(define finish765 + (make-struct-type-install-properties '(expand-context/inner) 22 0 @@ -18944,6 +18938,16 @@ '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21) #f 'expand-context/inner)) +(define struct:expand-context/inner + (make-record-type-descriptor* + 'expand-context/inner + struct:root-expand-context/inner + (|#%nongenerative-uid| expand-context/inner) + #f + #f + 22 + 0)) +(define effect_3326 (finish765 struct:expand-context/inner)) (define expand-context/inner2.1 (|#%name| expand-context/inner @@ -19653,7 +19657,7 @@ (expand-context/outer-current-use-scopes ctx_0) (expand-context/outer-name ctx_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" ctx_0)))) -(define effect_2554 +(define effect_2553 (begin (|#%call-with-values| (lambda () @@ -21378,18 +21382,8 @@ fold-var_0)))))) (for-loop_0 null s_0))))) s_0)))) -(define struct:compile-context - (make-record-type-descriptor* - 'compile-context - #f - (|#%nongenerative-uid| compile-context) - #f - #f - 7 - 0)) -(define effect_2773 - (struct-type-install-properties! - struct:compile-context +(define finish925 + (make-struct-type-install-properties '(compile-context) 7 0 @@ -21400,6 +21394,16 @@ '(0 1 2 3 4 5 6) #f 'compile-context)) +(define struct:compile-context + (make-record-type-descriptor* + 'compile-context + #f + (|#%nongenerative-uid| compile-context) + #f + #f + 7 + 0)) +(define effect_2620 (finish925 struct:compile-context)) (define compile-context1.1 (|#%name| compile-context @@ -23874,18 +23878,8 @@ (lambda (i_0) (let ((len_0 (|#%app| read-fasl-integer i_0))) (read-bytes/exactly len_0 i_0)))) -(define struct:mpi-intern-table - (make-record-type-descriptor* - 'mpi-intern-table - #f - (|#%nongenerative-uid| mpi-intern-table) - #f - #f - 2 - 0)) -(define effect_2544 - (struct-type-install-properties! - struct:mpi-intern-table +(define finish1073 + (make-struct-type-install-properties '(mpi-intern-table) 2 0 @@ -23896,6 +23890,16 @@ '(0 1) #f 'mpi-intern-table)) +(define struct:mpi-intern-table + (make-record-type-descriptor* + 'mpi-intern-table + #f + (|#%nongenerative-uid| mpi-intern-table) + #f + #f + 2 + 0)) +(define effect_2611 (finish1073 struct:mpi-intern-table)) (define mpi-intern-table1.1 (|#%name| mpi-intern-table @@ -24017,7 +24021,7 @@ (begin (begin-unsafe (hash-set! built-in-symbols built-in-s_0 #t)) built-in-s_0)))) -(define effect_2323 +(define effect_2411 (begin (void (begin @@ -24077,13 +24081,14 @@ record-accessor record-mutator record-predicate - struct-type-install-properties! + make-struct-type-install-properties |#%struct-constructor| |#%struct-predicate| |#%struct-field-accessor| |#%struct-field-mutator| |#%nongenerative-uid| unsafe-struct? + unsafe-sealed-struct? unsafe-struct raise-binding-result-arity-error raise-definition-result-arity-error @@ -24129,18 +24134,8 @@ (define top-level-bind!-id (make-built-in-symbol! 'top-level-bind!)) (define top-level-require!-id (make-built-in-symbol! 'top-level-require!)) (define mpi-vector-id (make-built-in-symbol! 'mpi-vector)) -(define struct:module-path-index-table - (make-record-type-descriptor* - 'module-path-index-table - #f - (|#%nongenerative-uid| module-path-index-table) - #f - #f - 2 - 0)) -(define effect_2393 - (struct-type-install-properties! - struct:module-path-index-table +(define finish1082 + (make-struct-type-install-properties '(module-path-index-table) 2 0 @@ -24151,6 +24146,16 @@ '(0 1) #f 'module-path-index-table)) +(define struct:module-path-index-table + (make-record-type-descriptor* + 'module-path-index-table + #f + (|#%nongenerative-uid| module-path-index-table) + #f + #f + 2 + 0)) +(define effect_2626 (finish1082 struct:module-path-index-table)) (define module-path-index-table1.1 (|#%name| module-path-index-table @@ -27991,18 +27996,8 @@ module-use1.1 'deserialize deserialize)) -(define struct:parsed - (make-record-type-descriptor* - 'parsed - #f - (|#%nongenerative-uid| parsed) - #f - #f - 1 - 0)) -(define effect_2993 - (struct-type-install-properties! - struct:parsed +(define finish1171 + (make-struct-type-install-properties '(parsed) 1 0 @@ -28013,6 +28008,16 @@ '(0) #f 'parsed)) +(define struct:parsed + (make-record-type-descriptor* + 'parsed + #f + (|#%nongenerative-uid| parsed) + #f + #f + 1 + 0)) +(define effect_3056 (finish1171 struct:parsed)) (define parsed1.1 (|#%name| parsed @@ -28020,18 +28025,8 @@ (make-record-constructor-descriptor struct:parsed #f #f)))) (define parsed? (|#%name| parsed? (record-predicate struct:parsed))) (define parsed-s (|#%name| parsed-s (record-accessor struct:parsed 0))) -(define struct:parsed-id - (make-record-type-descriptor* - 'parsed-id - struct:parsed - (|#%nongenerative-uid| parsed-id) - #f - #f - 2 - 0)) -(define effect_2378 - (struct-type-install-properties! - struct:parsed-id +(define finish1173 + (make-struct-type-install-properties '(parsed-id) 2 0 @@ -28042,6 +28037,16 @@ '(0 1) #f 'parsed-id)) +(define struct:parsed-id + (make-record-type-descriptor* + 'parsed-id + struct:parsed + (|#%nongenerative-uid| parsed-id) + #f + #f + 2 + 0)) +(define effect_2596 (finish1173 struct:parsed-id)) (define parsed-id2.1 (|#%name| parsed-id @@ -28052,18 +28057,8 @@ (|#%name| parsed-id-binding (record-accessor struct:parsed-id 0))) (define parsed-id-inspector (|#%name| parsed-id-inspector (record-accessor struct:parsed-id 1))) -(define struct:parsed-primitive-id - (make-record-type-descriptor* - 'parsed-primitive-id - struct:parsed-id - (|#%nongenerative-uid| parsed-primitive-id) - #f - #f - 0 - 0)) -(define effect_2609 - (struct-type-install-properties! - struct:parsed-primitive-id +(define finish1175 + (make-struct-type-install-properties '(parsed-primitive-id) 0 0 @@ -28074,6 +28069,16 @@ '() #f 'parsed-primitive-id)) +(define struct:parsed-primitive-id + (make-record-type-descriptor* + 'parsed-primitive-id + struct:parsed-id + (|#%nongenerative-uid| parsed-primitive-id) + #f + #f + 0 + 0)) +(define effect_2448 (finish1175 struct:parsed-primitive-id)) (define parsed-primitive-id3.1 (|#%name| parsed-primitive-id @@ -28083,18 +28088,8 @@ (|#%name| parsed-primitive-id? (record-predicate struct:parsed-primitive-id))) -(define struct:parsed-top-id - (make-record-type-descriptor* - 'parsed-top-id - struct:parsed-id - (|#%nongenerative-uid| parsed-top-id) - #f - #f - 0 - 0)) -(define effect_2611 - (struct-type-install-properties! - struct:parsed-top-id +(define finish1177 + (make-struct-type-install-properties '(parsed-top-id) 0 0 @@ -28105,6 +28100,16 @@ '() #f 'parsed-top-id)) +(define struct:parsed-top-id + (make-record-type-descriptor* + 'parsed-top-id + struct:parsed-id + (|#%nongenerative-uid| parsed-top-id) + #f + #f + 0 + 0)) +(define effect_2581 (finish1177 struct:parsed-top-id)) (define parsed-top-id4.1 (|#%name| parsed-top-id @@ -28112,18 +28117,8 @@ (make-record-constructor-descriptor struct:parsed-top-id #f #f)))) (define parsed-top-id? (|#%name| parsed-top-id? (record-predicate struct:parsed-top-id))) -(define struct:parsed-lambda - (make-record-type-descriptor* - 'parsed-lambda - struct:parsed - (|#%nongenerative-uid| parsed-lambda) - #f - #f - 2 - 0)) -(define effect_2651 - (struct-type-install-properties! - struct:parsed-lambda +(define finish1179 + (make-struct-type-install-properties '(parsed-lambda) 2 0 @@ -28134,6 +28129,16 @@ '(0 1) #f 'parsed-lambda)) +(define struct:parsed-lambda + (make-record-type-descriptor* + 'parsed-lambda + struct:parsed + (|#%nongenerative-uid| parsed-lambda) + #f + #f + 2 + 0)) +(define effect_2349 (finish1179 struct:parsed-lambda)) (define parsed-lambda5.1 (|#%name| parsed-lambda @@ -28145,18 +28150,8 @@ (|#%name| parsed-lambda-keys (record-accessor struct:parsed-lambda 0))) (define parsed-lambda-body (|#%name| parsed-lambda-body (record-accessor struct:parsed-lambda 1))) -(define struct:parsed-case-lambda - (make-record-type-descriptor* - 'parsed-case-lambda - struct:parsed - (|#%nongenerative-uid| parsed-case-lambda) - #f - #f - 1 - 0)) -(define effect_2439 - (struct-type-install-properties! - struct:parsed-case-lambda +(define finish1181 + (make-struct-type-install-properties '(parsed-case-lambda) 1 0 @@ -28167,6 +28162,16 @@ '(0) #f 'parsed-case-lambda)) +(define struct:parsed-case-lambda + (make-record-type-descriptor* + 'parsed-case-lambda + struct:parsed + (|#%nongenerative-uid| parsed-case-lambda) + #f + #f + 1 + 0)) +(define effect_2437 (finish1181 struct:parsed-case-lambda)) (define parsed-case-lambda6.1 (|#%name| parsed-case-lambda @@ -28178,18 +28183,8 @@ (|#%name| parsed-case-lambda-clauses (record-accessor struct:parsed-case-lambda 0))) -(define struct:parsed-app - (make-record-type-descriptor* - 'parsed-app - struct:parsed - (|#%nongenerative-uid| parsed-app) - #f - #f - 2 - 0)) -(define effect_2370 - (struct-type-install-properties! - struct:parsed-app +(define finish1183 + (make-struct-type-install-properties '(parsed-app) 2 0 @@ -28200,6 +28195,16 @@ '(0 1) #f 'parsed-app)) +(define struct:parsed-app + (make-record-type-descriptor* + 'parsed-app + struct:parsed + (|#%nongenerative-uid| parsed-app) + #f + #f + 2 + 0)) +(define effect_2862 (finish1183 struct:parsed-app)) (define parsed-app7.1 (|#%name| parsed-app @@ -28211,18 +28216,8 @@ (|#%name| parsed-app-rator (record-accessor struct:parsed-app 0))) (define parsed-app-rands (|#%name| parsed-app-rands (record-accessor struct:parsed-app 1))) -(define struct:parsed-if - (make-record-type-descriptor* - 'parsed-if - struct:parsed - (|#%nongenerative-uid| parsed-if) - #f - #f - 3 - 0)) -(define effect_2879 - (struct-type-install-properties! - struct:parsed-if +(define finish1185 + (make-struct-type-install-properties '(parsed-if) 3 0 @@ -28233,6 +28228,16 @@ '(0 1 2) #f 'parsed-if)) +(define struct:parsed-if + (make-record-type-descriptor* + 'parsed-if + struct:parsed + (|#%nongenerative-uid| parsed-if) + #f + #f + 3 + 0)) +(define effect_2506 (finish1185 struct:parsed-if)) (define parsed-if8.1 (|#%name| parsed-if @@ -28245,18 +28250,8 @@ (|#%name| parsed-if-thn (record-accessor struct:parsed-if 1))) (define parsed-if-els (|#%name| parsed-if-els (record-accessor struct:parsed-if 2))) -(define struct:parsed-set! - (make-record-type-descriptor* - 'parsed-set! - struct:parsed - (|#%nongenerative-uid| parsed-set!) - #f - #f - 2 - 0)) -(define effect_2344 - (struct-type-install-properties! - struct:parsed-set! +(define finish1187 + (make-struct-type-install-properties '(parsed-set!) 2 0 @@ -28267,6 +28262,16 @@ '(0 1) #f 'parsed-set!)) +(define struct:parsed-set! + (make-record-type-descriptor* + 'parsed-set! + struct:parsed + (|#%nongenerative-uid| parsed-set!) + #f + #f + 2 + 0)) +(define effect_2747 (finish1187 struct:parsed-set!)) (define parsed-set!9.1 (|#%name| parsed-set! @@ -28278,18 +28283,8 @@ (|#%name| parsed-set!-id (record-accessor struct:parsed-set! 0))) (define parsed-set!-rhs (|#%name| parsed-set!-rhs (record-accessor struct:parsed-set! 1))) -(define struct:parsed-with-continuation-mark - (make-record-type-descriptor* - 'parsed-with-continuation-mark - struct:parsed - (|#%nongenerative-uid| parsed-with-continuation-mark) - #f - #f - 3 - 0)) -(define effect_1825 - (struct-type-install-properties! - struct:parsed-with-continuation-mark +(define finish1189 + (make-struct-type-install-properties '(parsed-with-continuation-mark) 3 0 @@ -28300,6 +28295,16 @@ '(0 1 2) #f 'parsed-with-continuation-mark)) +(define struct:parsed-with-continuation-mark + (make-record-type-descriptor* + 'parsed-with-continuation-mark + struct:parsed + (|#%nongenerative-uid| parsed-with-continuation-mark) + #f + #f + 3 + 0)) +(define effect_2564 (finish1189 struct:parsed-with-continuation-mark)) (define parsed-with-continuation-mark10.1 (|#%name| parsed-with-continuation-mark @@ -28324,18 +28329,8 @@ (|#%name| parsed-with-continuation-mark-body (record-accessor struct:parsed-with-continuation-mark 2))) -(define |struct:parsed-#%variable-reference| - (make-record-type-descriptor* - '|parsed-#%variable-reference| - struct:parsed - (|#%nongenerative-uid| |parsed-#%variable-reference|) - #f - #f - 1 - 0)) -(define effect_2513 - (struct-type-install-properties! - |struct:parsed-#%variable-reference| +(define finish1191 + (make-struct-type-install-properties '(|parsed-#%variable-reference|) 1 0 @@ -28346,6 +28341,16 @@ '(0) #f '|parsed-#%variable-reference|)) +(define |struct:parsed-#%variable-reference| + (make-record-type-descriptor* + '|parsed-#%variable-reference| + struct:parsed + (|#%nongenerative-uid| |parsed-#%variable-reference|) + #f + #f + 1 + 0)) +(define effect_3025 (finish1191 |struct:parsed-#%variable-reference|)) (define |parsed-#%variable-reference11.1| (|#%name| |parsed-#%variable-reference| @@ -28362,18 +28367,8 @@ (|#%name| |parsed-#%variable-reference-id| (record-accessor |struct:parsed-#%variable-reference| 0))) -(define struct:parsed-begin - (make-record-type-descriptor* - 'parsed-begin - struct:parsed - (|#%nongenerative-uid| parsed-begin) - #f - #f - 1 - 0)) -(define effect_2746 - (struct-type-install-properties! - struct:parsed-begin +(define finish1193 + (make-struct-type-install-properties '(parsed-begin) 1 0 @@ -28384,6 +28379,16 @@ '(0) #f 'parsed-begin)) +(define struct:parsed-begin + (make-record-type-descriptor* + 'parsed-begin + struct:parsed + (|#%nongenerative-uid| parsed-begin) + #f + #f + 1 + 0)) +(define effect_2189 (finish1193 struct:parsed-begin)) (define parsed-begin12.1 (|#%name| parsed-begin @@ -28393,18 +28398,8 @@ (|#%name| parsed-begin? (record-predicate struct:parsed-begin))) (define parsed-begin-body (|#%name| parsed-begin-body (record-accessor struct:parsed-begin 0))) -(define struct:parsed-begin0 - (make-record-type-descriptor* - 'parsed-begin0 - struct:parsed - (|#%nongenerative-uid| parsed-begin0) - #f - #f - 1 - 0)) -(define effect_2747 - (struct-type-install-properties! - struct:parsed-begin0 +(define finish1195 + (make-struct-type-install-properties '(parsed-begin0) 1 0 @@ -28415,6 +28410,16 @@ '(0) #f 'parsed-begin0)) +(define struct:parsed-begin0 + (make-record-type-descriptor* + 'parsed-begin0 + struct:parsed + (|#%nongenerative-uid| parsed-begin0) + #f + #f + 1 + 0)) +(define effect_2190 (finish1195 struct:parsed-begin0)) (define parsed-begin013.1 (|#%name| parsed-begin0 @@ -28424,18 +28429,8 @@ (|#%name| parsed-begin0? (record-predicate struct:parsed-begin0))) (define parsed-begin0-body (|#%name| parsed-begin0-body (record-accessor struct:parsed-begin0 0))) -(define struct:parsed-quote - (make-record-type-descriptor* - 'parsed-quote - struct:parsed - (|#%nongenerative-uid| parsed-quote) - #f - #f - 1 - 0)) -(define effect_2069 - (struct-type-install-properties! - struct:parsed-quote +(define finish1197 + (make-struct-type-install-properties '(parsed-quote) 1 0 @@ -28446,6 +28441,16 @@ '(0) #f 'parsed-quote)) +(define struct:parsed-quote + (make-record-type-descriptor* + 'parsed-quote + struct:parsed + (|#%nongenerative-uid| parsed-quote) + #f + #f + 1 + 0)) +(define effect_2174 (finish1197 struct:parsed-quote)) (define parsed-quote14.1 (|#%name| parsed-quote @@ -28455,18 +28460,8 @@ (|#%name| parsed-quote? (record-predicate struct:parsed-quote))) (define parsed-quote-datum (|#%name| parsed-quote-datum (record-accessor struct:parsed-quote 0))) -(define struct:parsed-quote-syntax - (make-record-type-descriptor* - 'parsed-quote-syntax - struct:parsed - (|#%nongenerative-uid| parsed-quote-syntax) - #f - #f - 1 - 0)) -(define effect_2768 - (struct-type-install-properties! - struct:parsed-quote-syntax +(define finish1199 + (make-struct-type-install-properties '(parsed-quote-syntax) 1 0 @@ -28477,6 +28472,16 @@ '(0) #f 'parsed-quote-syntax)) +(define struct:parsed-quote-syntax + (make-record-type-descriptor* + 'parsed-quote-syntax + struct:parsed + (|#%nongenerative-uid| parsed-quote-syntax) + #f + #f + 1 + 0)) +(define effect_3320 (finish1199 struct:parsed-quote-syntax)) (define parsed-quote-syntax15.1 (|#%name| parsed-quote-syntax @@ -28490,18 +28495,8 @@ (|#%name| parsed-quote-syntax-datum (record-accessor struct:parsed-quote-syntax 0))) -(define struct:parsed-let_-values - (make-record-type-descriptor* - 'parsed-let_-values - struct:parsed - (|#%nongenerative-uid| parsed-let_-values) - #f - #f - 3 - 0)) -(define effect_2095 - (struct-type-install-properties! - struct:parsed-let_-values +(define finish1201 + (make-struct-type-install-properties '(parsed-let_-values) 3 0 @@ -28512,6 +28507,16 @@ '(0 1 2) #f 'parsed-let_-values)) +(define struct:parsed-let_-values + (make-record-type-descriptor* + 'parsed-let_-values + struct:parsed + (|#%nongenerative-uid| parsed-let_-values) + #f + #f + 3 + 0)) +(define effect_2494 (finish1201 struct:parsed-let_-values)) (define parsed-let_-values16.1 (|#%name| parsed-let_-values @@ -28531,18 +28536,8 @@ (|#%name| parsed-let_-values-body (record-accessor struct:parsed-let_-values 2))) -(define struct:parsed-let-values - (make-record-type-descriptor* - 'parsed-let-values - struct:parsed-let_-values - (|#%nongenerative-uid| parsed-let-values) - #f - #f - 0 - 0)) -(define effect_2152 - (struct-type-install-properties! - struct:parsed-let-values +(define finish1203 + (make-struct-type-install-properties '(parsed-let-values) 0 0 @@ -28553,6 +28548,16 @@ '() #f 'parsed-let-values)) +(define struct:parsed-let-values + (make-record-type-descriptor* + 'parsed-let-values + struct:parsed-let_-values + (|#%nongenerative-uid| parsed-let-values) + #f + #f + 0 + 0)) +(define effect_2429 (finish1203 struct:parsed-let-values)) (define parsed-let-values17.1 (|#%name| parsed-let-values @@ -28560,18 +28565,8 @@ (make-record-constructor-descriptor struct:parsed-let-values #f #f)))) (define parsed-let-values? (|#%name| parsed-let-values? (record-predicate struct:parsed-let-values))) -(define struct:parsed-letrec-values - (make-record-type-descriptor* - 'parsed-letrec-values - struct:parsed-let_-values - (|#%nongenerative-uid| parsed-letrec-values) - #f - #f - 0 - 0)) -(define effect_2829 - (struct-type-install-properties! - struct:parsed-letrec-values +(define finish1205 + (make-struct-type-install-properties '(parsed-letrec-values) 0 0 @@ -28582,6 +28577,16 @@ '() #f 'parsed-letrec-values)) +(define struct:parsed-letrec-values + (make-record-type-descriptor* + 'parsed-letrec-values + struct:parsed-let_-values + (|#%nongenerative-uid| parsed-letrec-values) + #f + #f + 0 + 0)) +(define effect_2573 (finish1205 struct:parsed-letrec-values)) (define parsed-letrec-values18.1 (|#%name| parsed-letrec-values @@ -28591,18 +28596,8 @@ (|#%name| parsed-letrec-values? (record-predicate struct:parsed-letrec-values))) -(define struct:parsed-define-values - (make-record-type-descriptor* - 'parsed-define-values - struct:parsed - (|#%nongenerative-uid| parsed-define-values) - #f - #f - 3 - 0)) -(define effect_2646 - (struct-type-install-properties! - struct:parsed-define-values +(define finish1207 + (make-struct-type-install-properties '(parsed-define-values) 3 0 @@ -28613,6 +28608,16 @@ '(0 1 2) #f 'parsed-define-values)) +(define struct:parsed-define-values + (make-record-type-descriptor* + 'parsed-define-values + struct:parsed + (|#%nongenerative-uid| parsed-define-values) + #f + #f + 3 + 0)) +(define effect_2826 (finish1207 struct:parsed-define-values)) (define parsed-define-values19.1 (|#%name| parsed-define-values @@ -28634,18 +28639,8 @@ (|#%name| parsed-define-values-rhs (record-accessor struct:parsed-define-values 2))) -(define struct:parsed-define-syntaxes - (make-record-type-descriptor* - 'parsed-define-syntaxes - struct:parsed - (|#%nongenerative-uid| parsed-define-syntaxes) - #f - #f - 3 - 0)) -(define effect_2421 - (struct-type-install-properties! - struct:parsed-define-syntaxes +(define finish1209 + (make-struct-type-install-properties '(parsed-define-syntaxes) 3 0 @@ -28656,6 +28651,16 @@ '(0 1 2) #f 'parsed-define-syntaxes)) +(define struct:parsed-define-syntaxes + (make-record-type-descriptor* + 'parsed-define-syntaxes + struct:parsed + (|#%nongenerative-uid| parsed-define-syntaxes) + #f + #f + 3 + 0)) +(define effect_2530 (finish1209 struct:parsed-define-syntaxes)) (define parsed-define-syntaxes20.1 (|#%name| parsed-define-syntaxes @@ -28677,18 +28682,8 @@ (|#%name| parsed-define-syntaxes-rhs (record-accessor struct:parsed-define-syntaxes 2))) -(define struct:parsed-begin-for-syntax - (make-record-type-descriptor* - 'parsed-begin-for-syntax - struct:parsed - (|#%nongenerative-uid| parsed-begin-for-syntax) - #f - #f - 1 - 0)) -(define effect_2080 - (struct-type-install-properties! - struct:parsed-begin-for-syntax +(define finish1211 + (make-struct-type-install-properties '(parsed-begin-for-syntax) 1 0 @@ -28699,6 +28694,16 @@ '(0) #f 'parsed-begin-for-syntax)) +(define struct:parsed-begin-for-syntax + (make-record-type-descriptor* + 'parsed-begin-for-syntax + struct:parsed + (|#%nongenerative-uid| parsed-begin-for-syntax) + #f + #f + 1 + 0)) +(define effect_2361 (finish1211 struct:parsed-begin-for-syntax)) (define parsed-begin-for-syntax21.1 (|#%name| parsed-begin-for-syntax @@ -28715,18 +28720,8 @@ (|#%name| parsed-begin-for-syntax-body (record-accessor struct:parsed-begin-for-syntax 0))) -(define |struct:parsed-#%declare| - (make-record-type-descriptor* - '|parsed-#%declare| - struct:parsed - (|#%nongenerative-uid| |parsed-#%declare|) - #f - #f - 0 - 0)) -(define effect_1669 - (struct-type-install-properties! - |struct:parsed-#%declare| +(define finish1213 + (make-struct-type-install-properties '(|parsed-#%declare|) 0 0 @@ -28737,6 +28732,16 @@ '() #f '|parsed-#%declare|)) +(define |struct:parsed-#%declare| + (make-record-type-descriptor* + '|parsed-#%declare| + struct:parsed + (|#%nongenerative-uid| |parsed-#%declare|) + #f + #f + 0 + 0)) +(define effect_2603 (finish1213 |struct:parsed-#%declare|)) (define |parsed-#%declare22.1| (|#%name| |parsed-#%declare| @@ -28744,18 +28749,8 @@ (make-record-constructor-descriptor |struct:parsed-#%declare| #f #f)))) (define |parsed-#%declare?| (|#%name| |parsed-#%declare?| (record-predicate |struct:parsed-#%declare|))) -(define struct:parsed-require - (make-record-type-descriptor* - 'parsed-require - struct:parsed - (|#%nongenerative-uid| parsed-require) - #f - #f - 0 - 0)) -(define effect_2183 - (struct-type-install-properties! - struct:parsed-require +(define finish1215 + (make-struct-type-install-properties '(parsed-require) 0 0 @@ -28766,6 +28761,16 @@ '() #f 'parsed-require)) +(define struct:parsed-require + (make-record-type-descriptor* + 'parsed-require + struct:parsed + (|#%nongenerative-uid| parsed-require) + #f + #f + 0 + 0)) +(define effect_2194 (finish1215 struct:parsed-require)) (define parsed-require23.1 (|#%name| parsed-require @@ -28773,18 +28778,8 @@ (make-record-constructor-descriptor struct:parsed-require #f #f)))) (define parsed-require? (|#%name| parsed-require? (record-predicate struct:parsed-require))) -(define |struct:parsed-#%module-begin| - (make-record-type-descriptor* - '|parsed-#%module-begin| - struct:parsed - (|#%nongenerative-uid| |parsed-#%module-begin|) - #f - #f - 1 - 0)) -(define effect_2305 - (struct-type-install-properties! - |struct:parsed-#%module-begin| +(define finish1217 + (make-struct-type-install-properties '(|parsed-#%module-begin|) 1 0 @@ -28795,6 +28790,16 @@ '(0) #f '|parsed-#%module-begin|)) +(define |struct:parsed-#%module-begin| + (make-record-type-descriptor* + '|parsed-#%module-begin| + struct:parsed + (|#%nongenerative-uid| |parsed-#%module-begin|) + #f + #f + 1 + 0)) +(define effect_2515 (finish1217 |struct:parsed-#%module-begin|)) (define |parsed-#%module-begin24.1| (|#%name| |parsed-#%module-begin| @@ -28811,18 +28816,8 @@ (|#%name| |parsed-#%module-begin-body| (record-accessor |struct:parsed-#%module-begin| 0))) -(define struct:parsed-module - (make-record-type-descriptor* - 'parsed-module - struct:parsed - (|#%nongenerative-uid| parsed-module) - #f - #f - 10 - 0)) -(define effect_2478 - (struct-type-install-properties! - struct:parsed-module +(define finish1219 + (make-struct-type-install-properties '(parsed-module) 10 0 @@ -28833,6 +28828,16 @@ '(0 1 2 3 4 5 6 7 8 9) #f 'parsed-module)) +(define struct:parsed-module + (make-record-type-descriptor* + 'parsed-module + struct:parsed + (|#%nongenerative-uid| parsed-module) + #f + #f + 10 + 0)) +(define effect_2433 (finish1219 struct:parsed-module)) (define parsed-module25.1 (|#%name| parsed-module @@ -28948,18 +28953,8 @@ (for-loop_0 (seteq) (unsafe-immutable-hash-iterate-first s-scs_0))))))) -(define struct:requires+provides - (make-record-type-descriptor* - 'requires+provides - #f - (|#%nongenerative-uid| requires+provides) - #f - #f - 9 - 384)) -(define effect_2932 - (struct-type-install-properties! - struct:requires+provides +(define finish1224 + (make-struct-type-install-properties '(requires+provides) 9 0 @@ -28970,6 +28965,16 @@ '(0 1 2 3 4 5 6) #f 'requires+provides)) +(define struct:requires+provides + (make-record-type-descriptor* + 'requires+provides + #f + (|#%nongenerative-uid| requires+provides) + #f + #f + 9 + 384)) +(define effect_3171 (finish1224 struct:requires+provides)) (define requires+provides1.1 (|#%name| requires+provides @@ -29021,18 +29026,8 @@ (|#%name| set-requires+provides-all-bindings-simple?! (record-mutator struct:requires+provides 8))) -(define struct:required - (make-record-type-descriptor* - 'required - #f - (|#%nongenerative-uid| required) - #f - #f - 4 - 0)) -(define effect_2324 - (struct-type-install-properties! - struct:required +(define finish1226 + (make-struct-type-install-properties '(required) 4 0 @@ -29043,6 +29038,16 @@ '(0 1 2 3) #f 'required)) +(define struct:required + (make-record-type-descriptor* + 'required + #f + (|#%nongenerative-uid| required) + #f + #f + 4 + 0)) +(define effect_2757 (finish1226 struct:required)) (define required2.1 (|#%name| required @@ -29056,18 +29061,8 @@ (|#%name| required-can-be-shadowed? (record-accessor struct:required 2))) (define required-as-transformer? (|#%name| required-as-transformer? (record-accessor struct:required 3))) -(define struct:nominal - (make-record-type-descriptor* - 'nominal - #f - (|#%nongenerative-uid| nominal) - #f - #f - 4 - 0)) -(define effect_1895 - (struct-type-install-properties! - struct:nominal +(define finish1228 + (make-struct-type-install-properties '(nominal) 4 0 @@ -29078,6 +29073,16 @@ '(0 1 2 3) #f 'nominal)) +(define struct:nominal + (make-record-type-descriptor* + 'nominal + #f + (|#%nongenerative-uid| nominal) + #f + #f + 4 + 0)) +(define effect_2287 (finish1228 struct:nominal)) (define nominal3.1 (|#%name| nominal @@ -29091,18 +29096,8 @@ (define nominal-require-phase (|#%name| nominal-require-phase (record-accessor struct:nominal 2))) (define nominal-sym (|#%name| nominal-sym (record-accessor struct:nominal 3))) -(define struct:bulk-required - (make-record-type-descriptor* - 'bulk-required - #f - (|#%nongenerative-uid| bulk-required) - #f - #f - 5 - 0)) -(define effect_2708 - (struct-type-install-properties! - struct:bulk-required +(define finish1230 + (make-struct-type-install-properties '(bulk-required) 5 0 @@ -29113,6 +29108,16 @@ '(0 1 2 3 4) #f 'bulk-required)) +(define struct:bulk-required + (make-record-type-descriptor* + 'bulk-required + #f + (|#%nongenerative-uid| bulk-required) + #f + #f + 5 + 0)) +(define effect_3099 (finish1230 struct:bulk-required)) (define bulk-required4.1 (|#%name| bulk-required @@ -30540,18 +30545,8 @@ (args (raise-binding-result-arity-error 2 args)))) table_0)))))) (for-loop_0 hash2589 (hash-iterate-first provides_0)))))) -(define struct:adjust-only - (make-record-type-descriptor* - 'adjust-only - #f - (|#%nongenerative-uid| adjust-only) - #f - #f - 1 - 0)) -(define effect_2628 - (struct-type-install-properties! - struct:adjust-only +(define finish1295 + (make-struct-type-install-properties '(adjust-only) 1 0 @@ -30562,6 +30557,16 @@ '(0) #f 'adjust-only)) +(define struct:adjust-only + (make-record-type-descriptor* + 'adjust-only + #f + (|#%nongenerative-uid| adjust-only) + #f + #f + 1 + 0)) +(define effect_2893 (finish1295 struct:adjust-only)) (define adjust-only1.1 (|#%name| adjust-only @@ -30593,18 +30598,8 @@ s 'adjust-only 'syms)))))) -(define struct:adjust-prefix - (make-record-type-descriptor* - 'adjust-prefix - #f - (|#%nongenerative-uid| adjust-prefix) - #f - #f - 1 - 0)) -(define effect_3295 - (struct-type-install-properties! - struct:adjust-prefix +(define finish1299 + (make-struct-type-install-properties '(adjust-prefix) 1 0 @@ -30615,6 +30610,16 @@ '(0) #f 'adjust-prefix)) +(define struct:adjust-prefix + (make-record-type-descriptor* + 'adjust-prefix + #f + (|#%nongenerative-uid| adjust-prefix) + #f + #f + 1 + 0)) +(define effect_2600 (finish1299 struct:adjust-prefix)) (define adjust-prefix2.1 (|#%name| adjust-prefix @@ -30648,18 +30653,8 @@ s 'adjust-prefix 'sym)))))) -(define struct:adjust-all-except - (make-record-type-descriptor* - 'adjust-all-except - #f - (|#%nongenerative-uid| adjust-all-except) - #f - #f - 2 - 0)) -(define effect_2268 - (struct-type-install-properties! - struct:adjust-all-except +(define finish1303 + (make-struct-type-install-properties '(adjust-all-except) 2 0 @@ -30670,6 +30665,16 @@ '(0 1) #f 'adjust-all-except)) +(define struct:adjust-all-except + (make-record-type-descriptor* + 'adjust-all-except + #f + (|#%nongenerative-uid| adjust-all-except) + #f + #f + 2 + 0)) +(define effect_2205 (finish1303 struct:adjust-all-except)) (define adjust-all-except3.1 (|#%name| adjust-all-except @@ -30723,18 +30728,8 @@ s 'adjust-all-except 'syms)))))) -(define struct:adjust-rename - (make-record-type-descriptor* - 'adjust-rename - #f - (|#%nongenerative-uid| adjust-rename) - #f - #f - 2 - 0)) -(define effect_2090 - (struct-type-install-properties! - struct:adjust-rename +(define finish1308 + (make-struct-type-install-properties '(adjust-rename) 2 0 @@ -30745,6 +30740,16 @@ '(0 1) #f 'adjust-rename)) +(define struct:adjust-rename + (make-record-type-descriptor* + 'adjust-rename + #f + (|#%nongenerative-uid| adjust-rename) + #f + #f + 2 + 0)) +(define effect_3082 (finish1308 struct:adjust-rename)) (define adjust-rename4.1 (|#%name| adjust-rename @@ -33633,18 +33638,8 @@ ns_0 temp14_1 temp15_0))))))))) -(define struct:compiled-in-memory - (make-record-type-descriptor* - 'compiled-in-memory - #f - (|#%nongenerative-uid| compiled-in-memory) - #f - #f - 13 - 0)) -(define effect_2681 - (struct-type-install-properties! - struct:compiled-in-memory +(define finish1354 + (make-struct-type-install-properties '(compiled-in-memory) 13 0 @@ -33659,6 +33654,16 @@ '(0 1 2 3 4 5 6 7 8 9 10 11 12) #f 'compiled-in-memory)) +(define struct:compiled-in-memory + (make-record-type-descriptor* + 'compiled-in-memory + #f + (|#%nongenerative-uid| compiled-in-memory) + #f + #f + 13 + 0)) +(define effect_2572 (finish1354 struct:compiled-in-memory)) (define compiled-in-memory1.1 (|#%name| compiled-in-memory @@ -33975,18 +33980,8 @@ (define correlated-column (lambda (s_0) (syntax-column s_0))) (define correlated-position (lambda (s_0) (syntax-position s_0))) (define correlated-span (lambda (s_0) (syntax-span s_0))) -(define struct:correlated-linklet - (make-record-type-descriptor* - 'correlated-linklet - #f - (|#%nongenerative-uid| correlated-linklet) - #f - #f - 3 - 4)) -(define effect_2157 - (struct-type-install-properties! - struct:correlated-linklet +(define finish1370 + (make-struct-type-install-properties '(correlated-linklet) 3 0 @@ -33997,6 +33992,16 @@ '(0 1) #f 'correlated-linklet)) +(define struct:correlated-linklet + (make-record-type-descriptor* + 'correlated-linklet + #f + (|#%nongenerative-uid| correlated-linklet) + #f + #f + 3 + 4)) +(define effect_2738 (finish1370 struct:correlated-linklet)) (define correlated-linklet1.1 (|#%name| correlated-linklet @@ -34049,6 +34054,18 @@ "cannot evaluate unknown linklet: ~s" l_0)))) (define correlated-linklet-vm-bytes #vu8(108 105 110 107 108 101 116)) +(define finish1373 + (make-struct-type-install-properties + '(faslable-correlated) + 7 + 0 + #f + null + 'prefab + #f + '(0 1 2 3 4 5 6) + #f + 'faslable-correlated)) (define struct:faslable-correlated (make-record-type-descriptor* 'faslable-correlated @@ -34064,19 +34081,7 @@ #f 7 127)) -(define effect_2166 - (struct-type-install-properties! - struct:faslable-correlated - '(faslable-correlated) - 7 - 0 - #f - null - 'prefab - #f - '(0 1 2 3 4 5 6) - #f - 'faslable-correlated)) +(define effect_2370 (finish1373 struct:faslable-correlated)) (define faslable-correlated2.1 (|#%name| faslable-correlated @@ -34222,6 +34227,18 @@ s 'faslable-correlated 'props)))))) +(define finish1383 + (make-struct-type-install-properties + '(faslable-correlated-linklet) + 2 + 0 + #f + null + 'prefab + #f + '(0 1) + #f + 'faslable-correlated-linklet)) (define struct:faslable-correlated-linklet (make-record-type-descriptor* 'faslable-correlated-linklet @@ -34237,19 +34254,7 @@ #f 2 3)) -(define effect_2697 - (struct-type-install-properties! - struct:faslable-correlated-linklet - '(faslable-correlated-linklet) - 2 - 0 - #f - null - 'prefab - #f - '(0 1) - #f - 'faslable-correlated-linklet)) +(define effect_2374 (finish1383 struct:faslable-correlated-linklet)) (define faslable-correlated-linklet3.1 (|#%name| faslable-correlated-linklet @@ -34975,18 +34980,8 @@ (define write-int (lambda (n_0 port_0) (write-bytes (integer->integer-bytes n_0 4 #f #f) port_0))) -(define struct:linklet-directory - (make-record-type-descriptor* - 'linklet-directory - #f - (|#%nongenerative-uid| linklet-directory) - #f - #f - 1 - 0)) -(define effect_3250 - (struct-type-install-properties! - struct:linklet-directory +(define finish1429 + (make-struct-type-install-properties '(linklet-directory) 1 0 @@ -35006,6 +35001,16 @@ '(0) #f 'linklet-directory)) +(define struct:linklet-directory + (make-record-type-descriptor* + 'linklet-directory + #f + (|#%nongenerative-uid| linklet-directory) + #f + #f + 1 + 0)) +(define effect_2692 (finish1429 struct:linklet-directory)) (define linklet-directory1.1 (|#%name| linklet-directory @@ -35039,18 +35044,8 @@ s 'linklet-directory 'ht)))))) -(define struct:linklet-bundle - (make-record-type-descriptor* - 'linklet-bundle - #f - (|#%nongenerative-uid| linklet-bundle) - #f - #f - 1 - 0)) -(define effect_2977 - (struct-type-install-properties! - struct:linklet-bundle +(define finish1433 + (make-struct-type-install-properties '(linklet-bundle) 1 0 @@ -35069,6 +35064,16 @@ '(0) #f 'linklet-bundle)) +(define struct:linklet-bundle + (make-record-type-descriptor* + 'linklet-bundle + #f + (|#%nongenerative-uid| linklet-bundle) + #f + #f + 1 + 0)) +(define effect_2464 (finish1433 struct:linklet-bundle)) (define linklet-bundle2.1 (|#%name| linklet-bundle @@ -35266,18 +35271,8 @@ (args (raise-binding-result-arity-error 2 args)))) result_0)))))) (for-loop_0 #t (hash-iterate-first ht_0))))))) -(define struct:namespace-scopes - (make-record-type-descriptor* - 'namespace-scopes - #f - (structure-type-lookup-prefab-uid 'namespace-scopes #f 2 0 #f '(0 1)) - #f - #f - 2 - 3)) -(define effect_2322 - (struct-type-install-properties! - struct:namespace-scopes +(define finish1437 + (make-struct-type-install-properties '(namespace-scopes) 2 0 @@ -35288,6 +35283,16 @@ '(0 1) #f 'namespace-scopes)) +(define struct:namespace-scopes + (make-record-type-descriptor* + 'namespace-scopes + #f + (structure-type-lookup-prefab-uid 'namespace-scopes #f 2 0 #f '(0 1)) + #f + #f + 2 + 3)) +(define effect_2465 (finish1437 struct:namespace-scopes)) (define namespace-scopes1.1 (|#%name| namespace-scopes @@ -35408,18 +35413,8 @@ (let ((app_0 (namespace-scopes-other nss1_0))) (set=? app_0 (namespace-scopes-other nss2_0))) #f))) -(define struct:syntax-literals - (make-record-type-descriptor* - 'syntax-literals - #f - (|#%nongenerative-uid| syntax-literals) - #f - #f - 2 - 3)) -(define effect_2063 - (struct-type-install-properties! - struct:syntax-literals +(define finish1453 + (make-struct-type-install-properties '(syntax-literals) 2 0 @@ -35430,6 +35425,16 @@ '() #f 'syntax-literals)) +(define struct:syntax-literals + (make-record-type-descriptor* + 'syntax-literals + #f + (|#%nongenerative-uid| syntax-literals) + #f + #f + 2 + 3)) +(define effect_2822 (finish1453 struct:syntax-literals)) (define syntax-literals1.1 (|#%name| syntax-literals @@ -35519,18 +35524,8 @@ v 'syntax-literals 'count)))))) -(define struct:header - (make-record-type-descriptor* - 'header - #f - (|#%nongenerative-uid| header) - #f - #f - 8 - 36)) -(define effect_2390 - (struct-type-install-properties! - struct:header +(define finish1460 + (make-struct-type-install-properties '(header) 8 0 @@ -35541,6 +35536,16 @@ '(0 1 3 4 6 7) #f 'header)) +(define struct:header + (make-record-type-descriptor* + 'header + #f + (|#%nongenerative-uid| header) + #f + #f + 8 + 36)) +(define effect_2459 (finish1460 struct:header)) (define header2.1 (|#%name| header @@ -35729,18 +35734,8 @@ v 'header 'require-vars-in-order)))))) -(define struct:variable-use - (make-record-type-descriptor* - 'variable-use - #f - (|#%nongenerative-uid| variable-use) - #f - #f - 2 - 0)) -(define effect_2290 - (struct-type-install-properties! - struct:variable-use +(define finish1473 + (make-struct-type-install-properties '(variable-use) 2 0 @@ -35751,6 +35746,16 @@ '(0 1) #f 'variable-use)) +(define struct:variable-use + (make-record-type-descriptor* + 'variable-use + #f + (|#%nongenerative-uid| variable-use) + #f + #f + 2 + 0)) +(define effect_2838 (finish1473 struct:variable-use)) (define variable-use3.1 (|#%name| variable-use @@ -37320,18 +37325,8 @@ (if (extra-inspectors-allow? extra-inspectors-1_0 guard-insp_0) (extra-inspectors-allow? extra-inspectors-2_0 guard-insp_0) #f)))))) -(define struct:module-use* - (make-record-type-descriptor* - 'module-use* - struct:module-use - (|#%nongenerative-uid| module-use*) - #f - #f - 2 - 3)) -(define effect_2687 - (struct-type-install-properties! - struct:module-use* +(define finish1634 + (make-struct-type-install-properties '(module-use*) 2 0 @@ -37342,6 +37337,16 @@ '() #f 'module-use*)) +(define struct:module-use* + (make-record-type-descriptor* + 'module-use* + struct:module-use + (|#%nongenerative-uid| module-use*) + #f + #f + 2 + 3)) +(define effect_2316 (finish1634 struct:module-use*)) (define module-use*1.1 (|#%name| module-use* @@ -37755,18 +37760,8 @@ (set-module-use*-extra-inspectorss! existing-mu*_0 new-extra-inspectorss_0)))))) -(define struct:link-info - (make-record-type-descriptor* - 'link-info - #f - (|#%nongenerative-uid| link-info) - #f - #f - 4 - 0)) -(define effect_2897 - (struct-type-install-properties! - struct:link-info +(define finish1644 + (make-struct-type-install-properties '(link-info) 4 0 @@ -37777,6 +37772,16 @@ '(0 1 2 3) #f 'link-info)) +(define struct:link-info + (make-record-type-descriptor* + 'link-info + #f + (|#%nongenerative-uid| link-info) + #f + #f + 4 + 0)) +(define effect_2792 (finish1644 struct:link-info)) (define link-info1.1 (|#%name| link-info @@ -39873,18 +39878,8 @@ (let ((app_0 (car cims_1))) (cons app_0 (cdr cims_1))))))))))) (loop_0 cims_0)))) -(define struct:known-defined/delay - (make-record-type-descriptor* - 'known-defined/delay - #f - (structure-type-lookup-prefab-uid 'known-defined/delay #f 1 0 #f '(0)) - #f - #f - 1 - 1)) -(define effect_2561 - (struct-type-install-properties! - struct:known-defined/delay +(define finish1711 + (make-struct-type-install-properties '(known-defined/delay) 1 0 @@ -39895,6 +39890,16 @@ '(0) #f 'known-defined/delay)) +(define struct:known-defined/delay + (make-record-type-descriptor* + 'known-defined/delay + #f + (structure-type-lookup-prefab-uid 'known-defined/delay #f 1 0 #f '(0)) + #f + #f + 1 + 1)) +(define effect_2998 (finish1711 struct:known-defined/delay)) (define known-defined/delay2.1 (|#%name| known-defined/delay @@ -39932,18 +39937,8 @@ s 'known-defined/delay 'thunk)))))) -(define struct:known-property - (make-record-type-descriptor* - 'known-property - #f - (structure-type-lookup-prefab-uid 'known-property #f 0 0 #f '()) - #f - #f - 0 - 0)) -(define effect_2213 - (struct-type-install-properties! - struct:known-property +(define finish1715 + (make-struct-type-install-properties '(known-property) 0 0 @@ -39954,6 +39949,16 @@ '() #f 'known-property)) +(define struct:known-property + (make-record-type-descriptor* + 'known-property + #f + (structure-type-lookup-prefab-uid 'known-property #f 0 0 #f '()) + #f + #f + 0 + 0)) +(define effect_2476 (finish1715 struct:known-property)) (define known-property3.1 (|#%name| known-property @@ -39971,6 +39976,18 @@ (if (impersonator? v) (known-property?_2907 (impersonator-val v)) #f)))))) +(define finish1718 + (make-struct-type-install-properties + '(known-property-of-function) + 1 + 0 + #f + null + 'prefab + #f + '(0) + #f + 'known-property-of-function)) (define struct:known-property-of-function (make-record-type-descriptor* 'known-property-of-function @@ -39986,19 +40003,7 @@ #f 1 1)) -(define effect_2571 - (struct-type-install-properties! - struct:known-property-of-function - '(known-property-of-function) - 1 - 0 - #f - null - 'prefab - #f - '(0) - #f - 'known-property-of-function)) +(define effect_2945 (finish1718 struct:known-property-of-function)) (define known-property-of-function4.1 (|#%name| known-property-of-function @@ -40039,18 +40044,8 @@ s 'known-property-of-function 'arity)))))) -(define struct:known-function - (make-record-type-descriptor* - 'known-function - #f - (structure-type-lookup-prefab-uid 'known-function #f 2 0 #f '(0 1)) - #f - #f - 2 - 3)) -(define effect_2738 - (struct-type-install-properties! - struct:known-function +(define finish1722 + (make-struct-type-install-properties '(known-function) 2 0 @@ -40061,6 +40056,16 @@ '(0 1) #f 'known-function)) +(define struct:known-function + (make-record-type-descriptor* + 'known-function + #f + (structure-type-lookup-prefab-uid 'known-function #f 2 0 #f '(0 1)) + #f + #f + 2 + 3)) +(define effect_2741 (finish1722 struct:known-function)) (define known-function5.1 (|#%name| known-function @@ -40110,6 +40115,18 @@ s 'known-function 'pure?)))))) +(define finish1727 + (make-struct-type-install-properties + '(known-function-of-satisfying) + 1 + 0 + #f + null + 'prefab + #f + '(0) + #f + 'known-function-of-satisfying)) (define struct:known-function-of-satisfying (make-record-type-descriptor* 'known-function-of-satisfying @@ -40125,19 +40142,7 @@ #f 1 1)) -(define effect_2742 - (struct-type-install-properties! - struct:known-function-of-satisfying - '(known-function-of-satisfying) - 1 - 0 - #f - null - 'prefab - #f - '(0) - #f - 'known-function-of-satisfying)) +(define effect_2265 (finish1727 struct:known-function-of-satisfying)) (define known-function-of-satisfying6.1 (|#%name| known-function-of-satisfying @@ -40178,18 +40183,8 @@ s 'known-function-of-satisfying 'arg-predicate-keys)))))) -(define struct:known-predicate - (make-record-type-descriptor* - 'known-predicate - #f - (structure-type-lookup-prefab-uid 'known-predicate #f 1 0 #f '(0)) - #f - #f - 1 - 1)) -(define effect_2224 - (struct-type-install-properties! - struct:known-predicate +(define finish1731 + (make-struct-type-install-properties '(known-predicate) 1 0 @@ -40200,6 +40195,16 @@ '(0) #f 'known-predicate)) +(define struct:known-predicate + (make-record-type-descriptor* + 'known-predicate + #f + (structure-type-lookup-prefab-uid 'known-predicate #f 1 0 #f '(0)) + #f + #f + 1 + 1)) +(define effect_2144 (finish1731 struct:known-predicate)) (define known-predicate7.1 (|#%name| known-predicate @@ -40233,18 +40238,8 @@ s 'known-predicate 'key)))))) -(define struct:known-satisfies - (make-record-type-descriptor* - 'known-satisfies - #f - (structure-type-lookup-prefab-uid 'known-satisfies #f 1 0 #f '(0)) - #f - #f - 1 - 1)) -(define effect_2200 - (struct-type-install-properties! - struct:known-satisfies +(define finish1735 + (make-struct-type-install-properties '(known-satisfies) 1 0 @@ -40255,6 +40250,16 @@ '(0) #f 'known-satisfies)) +(define struct:known-satisfies + (make-record-type-descriptor* + 'known-satisfies + #f + (structure-type-lookup-prefab-uid 'known-satisfies #f 1 0 #f '(0)) + #f + #f + 1 + 1)) +(define effect_1976 (finish1735 struct:known-satisfies)) (define known-satisfies8.1 (|#%name| known-satisfies @@ -40290,18 +40295,8 @@ s 'known-satisfies 'predicate-key)))))) -(define struct:known-struct-op - (make-record-type-descriptor* - 'known-struct-op - #f - (structure-type-lookup-prefab-uid 'known-struct-op #f 2 0 #f '(0 1)) - #f - #f - 2 - 3)) -(define effect_2316 - (struct-type-install-properties! - struct:known-struct-op +(define finish1739 + (make-struct-type-install-properties '(known-struct-op) 2 0 @@ -40312,6 +40307,16 @@ '(0 1) #f 'known-struct-op)) +(define struct:known-struct-op + (make-record-type-descriptor* + 'known-struct-op + #f + (structure-type-lookup-prefab-uid 'known-struct-op #f 2 0 #f '(0 1)) + #f + #f + 2 + 3)) +(define effect_2534 (finish1739 struct:known-struct-op)) (define known-struct-op9.1 (|#%name| known-struct-op @@ -44884,18 +44889,8 @@ ns_0)))))))))))))))))))))))) (args (raise-binding-result-arity-error 4 args)))) (if log-performance? (end-performance-region) (void))))))))) -(define struct:instance-data - (make-record-type-descriptor* - 'instance-data - #f - (|#%nongenerative-uid| instance-data) - #f - #f - 2 - 0)) -(define effect_2847 - (struct-type-install-properties! - struct:instance-data +(define finish1803 + (make-struct-type-install-properties '(instance-data) 2 0 @@ -44906,6 +44901,16 @@ '(0 1) #f 'instance-data)) +(define struct:instance-data + (make-record-type-descriptor* + 'instance-data + #f + (|#%nongenerative-uid| instance-data) + #f + #f + 2 + 0)) +(define effect_2595 (finish1803 struct:instance-data)) (define instance-data9.1 (|#%name| instance-data @@ -47337,18 +47342,8 @@ table_0)))))) (for-loop_0 hash2610 (hash-iterate-first ht_0)))))) c_0)))) -(define struct:recompiled - (make-record-type-descriptor* - 'recompiled - #f - (|#%nongenerative-uid| recompiled) - #f - #f - 3 - 0)) -(define effect_2894 - (struct-type-install-properties! - struct:recompiled +(define finish1895 + (make-struct-type-install-properties '(recompiled) 3 0 @@ -47359,6 +47354,16 @@ '(0 1 2) #f 'recompiled)) +(define struct:recompiled + (make-record-type-descriptor* + 'recompiled + #f + (|#%nongenerative-uid| recompiled) + #f + #f + 3 + 0)) +(define effect_1973 (finish1895 struct:recompiled)) (define recompiled1.1 (|#%name| recompiled @@ -48885,18 +48890,8 @@ (define box-cons! (lambda (b_0 v_0) (set-box! b_0 (cons v_0 (unbox b_0))))) (define box-clear! (lambda (b_0) (begin0 (reverse$1 (unbox b_0)) (set-box! b_0 null)))) -(define struct:lift-context - (make-record-type-descriptor* - 'lift-context - #f - (|#%nongenerative-uid| lift-context) - #f - #f - 3 - 0)) -(define effect_2898 - (struct-type-install-properties! - struct:lift-context +(define finish1932 + (make-struct-type-install-properties '(lift-context) 3 0 @@ -48907,6 +48902,16 @@ '(0 1 2) #f 'lift-context)) +(define struct:lift-context + (make-record-type-descriptor* + 'lift-context + #f + (|#%nongenerative-uid| lift-context) + #f + #f + 3 + 0)) +(define effect_1545 (finish1932 struct:lift-context)) (define lift-context1.1 (|#%name| lift-context @@ -48920,18 +48925,8 @@ (|#%name| lift-context-lifts (record-accessor struct:lift-context 1))) (define lift-context-module*-ok? (|#%name| lift-context-module*-ok? (record-accessor struct:lift-context 2))) -(define struct:lifted-bind - (make-record-type-descriptor* - 'lifted-bind - #f - (|#%nongenerative-uid| lifted-bind) - #f - #f - 3 - 0)) -(define effect_2240 - (struct-type-install-properties! - struct:lifted-bind +(define finish1934 + (make-struct-type-install-properties '(lifted-bind) 3 0 @@ -48942,6 +48937,16 @@ '(0 1 2) #f 'lifted-bind)) +(define struct:lifted-bind + (make-record-type-descriptor* + 'lifted-bind + #f + (|#%nongenerative-uid| lifted-bind) + #f + #f + 3 + 0)) +(define effect_1767 (finish1934 struct:lifted-bind)) (define lifted-bind2.1 (|#%name| lifted-bind @@ -49172,18 +49177,8 @@ (for-loop_0 fold-var_2 rest_0))))) fold-var_0)))))) (for-loop_0 null lifts_0)))))) -(define struct:module-lift-context - (make-record-type-descriptor* - 'module-lift-context - #f - (|#%nongenerative-uid| module-lift-context) - #f - #f - 3 - 0)) -(define effect_2110 - (struct-type-install-properties! - struct:module-lift-context +(define finish1944 + (make-struct-type-install-properties '(module-lift-context) 3 0 @@ -49194,6 +49189,16 @@ '(0 1 2) #f 'module-lift-context)) +(define struct:module-lift-context + (make-record-type-descriptor* + 'module-lift-context + #f + (|#%nongenerative-uid| module-lift-context) + #f + #f + 3 + 0)) +(define effect_2649 (finish1944 struct:module-lift-context)) (define module-lift-context15.1 (|#%name| module-lift-context @@ -49254,18 +49259,8 @@ (box-cons! (lift-context-lifts module-lifts_0) s_0) (error "internal error: unrecognized lift-context type for module lift")))))) -(define struct:require-lift-context - (make-record-type-descriptor* - 'require-lift-context - #f - (|#%nongenerative-uid| require-lift-context) - #f - #f - 3 - 0)) -(define effect_2608 - (struct-type-install-properties! - struct:require-lift-context +(define finish1946 + (make-struct-type-install-properties '(require-lift-context) 3 0 @@ -49276,6 +49271,16 @@ '(0 1 2) #f 'require-lift-context)) +(define struct:require-lift-context + (make-record-type-descriptor* + 'require-lift-context + #f + (|#%nongenerative-uid| require-lift-context) + #f + #f + 3 + 0)) +(define effect_3057 (finish1946 struct:require-lift-context)) (define require-lift-context16.1 (|#%name| require-lift-context @@ -49308,18 +49313,8 @@ (begin (|#%app| (require-lift-context-do-require require-lifts_0) s_0 phase_0) (box-cons! (require-lift-context-requires require-lifts_0) s_0)))) -(define struct:to-module-lift-context - (make-record-type-descriptor* - 'to-module-lift-context - #f - (|#%nongenerative-uid| to-module-lift-context) - #f - #f - 4 - 0)) -(define effect_2781 - (struct-type-install-properties! - struct:to-module-lift-context +(define finish1948 + (make-struct-type-install-properties '(to-module-lift-context) 4 0 @@ -49330,6 +49325,16 @@ '(0 1 2 3) #f 'to-module-lift-context)) +(define struct:to-module-lift-context + (make-record-type-descriptor* + 'to-module-lift-context + #f + (|#%nongenerative-uid| to-module-lift-context) + #f + #f + 4 + 0)) +(define effect_3069 (finish1948 struct:to-module-lift-context)) (define to-module-lift-context17.1 (|#%name| to-module-lift-context @@ -49378,18 +49383,8 @@ (define add-lifted-to-module-end! (lambda (to-module-lifts_0 s_0 phase_0) (box-cons! (to-module-lift-context-ends to-module-lifts_0) s_0))) -(define struct:already-expanded - (make-record-type-descriptor* - 'expanded-syntax - #f - (|#%nongenerative-uid| expanded-syntax) - #f - #f - 2 - 0)) -(define effect_2784 - (struct-type-install-properties! - struct:already-expanded +(define finish1951 + (make-struct-type-install-properties '(expanded-syntax) 2 0 @@ -49400,6 +49395,16 @@ '(0 1) #f 'already-expanded)) +(define struct:already-expanded + (make-record-type-descriptor* + 'expanded-syntax + #f + (|#%nongenerative-uid| expanded-syntax) + #f + #f + 2 + 0)) +(define effect_2568 (finish1951 struct:already-expanded)) (define already-expanded1.1 (|#%name| already-expanded @@ -49456,18 +49461,8 @@ has-liberal-define-context-property? liberal-define-context-value) (make-struct-type-property 'liberal-define-context)) -(define struct:liberal-define-context - (make-record-type-descriptor* - 'liberal-define-context - #f - (|#%nongenerative-uid| liberal-define-context) - #f - #f - 0 - 0)) -(define effect_2745 - (struct-type-install-properties! - struct:liberal-define-context +(define finish1956 + (make-struct-type-install-properties '(liberal-define-context) 0 0 @@ -49478,6 +49473,16 @@ '() #f 'make-liberal-define-context)) +(define struct:liberal-define-context + (make-record-type-descriptor* + 'liberal-define-context + #f + (|#%nongenerative-uid| liberal-define-context) + #f + #f + 0 + 0)) +(define effect_2849 (finish1956 struct:liberal-define-context)) (define make-liberal-define-context (|#%name| make-liberal-define-context @@ -49592,18 +49597,8 @@ (wrap_0 '|#%expression|) (fail_0)) (fail_0)))))))) -(define struct:reference-record - (make-record-type-descriptor* - 'reference-record - #f - (|#%nongenerative-uid| reference-record) - #f - #f - 3 - 7)) -(define effect_2912 - (struct-type-install-properties! - struct:reference-record +(define finish1963 + (make-struct-type-install-properties '(reference-record) 3 0 @@ -49614,6 +49609,16 @@ '() #f 'reference-record)) +(define struct:reference-record + (make-record-type-descriptor* + 'reference-record + #f + (|#%nongenerative-uid| reference-record) + #f + #f + 3 + 7)) +(define effect_2371 (finish1963 struct:reference-record)) (define reference-record1.1 (|#%name| reference-record @@ -49758,18 +49763,8 @@ (let ((app_0 (syntax-disarm$1 orig-s3_0))) (datum->syntax$1 app_0 new4_0 orig-s3_0 (if track?1_0 orig-s3_0 #f))) orig-s3_0))))) -(define struct:expanded+parsed - (make-record-type-descriptor* - 'expanded+parsed - #f - (|#%nongenerative-uid| expanded+parsed) - #f - #f - 2 - 0)) -(define effect_3028 - (struct-type-install-properties! - struct:expanded+parsed +(define finish1976 + (make-struct-type-install-properties '(expanded+parsed) 2 0 @@ -49780,6 +49775,16 @@ '(0 1) #f 'expanded+parsed)) +(define struct:expanded+parsed + (make-record-type-descriptor* + 'expanded+parsed + #f + (|#%nongenerative-uid| expanded+parsed) + #f + #f + 2 + 0)) +(define effect_2270 (finish1976 struct:expanded+parsed)) (define expanded+parsed1.1 (|#%name| expanded+parsed @@ -49791,18 +49796,8 @@ (|#%name| expanded+parsed-s (record-accessor struct:expanded+parsed 0))) (define expanded+parsed-parsed (|#%name| expanded+parsed-parsed (record-accessor struct:expanded+parsed 1))) -(define struct:semi-parsed-define-values - (make-record-type-descriptor* - 'semi-parsed-define-values - #f - (|#%nongenerative-uid| semi-parsed-define-values) - #f - #f - 4 - 0)) -(define effect_2560 - (struct-type-install-properties! - struct:semi-parsed-define-values +(define finish1978 + (make-struct-type-install-properties '(semi-parsed-define-values) 4 0 @@ -49813,6 +49808,16 @@ '(0 1 2 3) #f 'semi-parsed-define-values)) +(define struct:semi-parsed-define-values + (make-record-type-descriptor* + 'semi-parsed-define-values + #f + (|#%nongenerative-uid| semi-parsed-define-values) + #f + #f + 4 + 0)) +(define effect_2353 (finish1978 struct:semi-parsed-define-values)) (define semi-parsed-define-values2.1 (|#%name| semi-parsed-define-values @@ -49841,18 +49846,8 @@ (|#%name| semi-parsed-define-values-rhs (record-accessor struct:semi-parsed-define-values 3))) -(define struct:semi-parsed-begin-for-syntax - (make-record-type-descriptor* - 'semi-parsed-begin-for-syntax - #f - (|#%nongenerative-uid| semi-parsed-begin-for-syntax) - #f - #f - 2 - 0)) -(define effect_3035 - (struct-type-install-properties! - struct:semi-parsed-begin-for-syntax +(define finish1980 + (make-struct-type-install-properties '(semi-parsed-begin-for-syntax) 2 0 @@ -49863,6 +49858,16 @@ '(0 1) #f 'semi-parsed-begin-for-syntax)) +(define struct:semi-parsed-begin-for-syntax + (make-record-type-descriptor* + 'semi-parsed-begin-for-syntax + #f + (|#%nongenerative-uid| semi-parsed-begin-for-syntax) + #f + #f + 2 + 0)) +(define effect_2815 (finish1980 struct:semi-parsed-begin-for-syntax)) (define semi-parsed-begin-for-syntax3.1 (|#%name| semi-parsed-begin-for-syntax @@ -51905,18 +51910,8 @@ module* |#%declare| |#%stratified-body|))) -(define struct:internal-definition-context - (make-record-type-descriptor* - 'internal-definition-context - #f - (|#%nongenerative-uid| internal-definition-context) - #f - #f - 5 - 0)) -(define effect_2155 - (struct-type-install-properties! - struct:internal-definition-context +(define finish2122 + (make-struct-type-install-properties '(internal-definition-context) 5 0 @@ -51927,6 +51922,16 @@ '(0 1 2 3 4) #f 'internal-definition-context)) +(define struct:internal-definition-context + (make-record-type-descriptor* + 'internal-definition-context + #f + (|#%nongenerative-uid| internal-definition-context) + #f + #f + 5 + 0)) +(define effect_2979 (finish2122 struct:internal-definition-context)) (define internal-definition-context1.1 (|#%name| internal-definition-context @@ -52039,18 +52044,8 @@ s 'internal-definition-context 'parent-ctx)))))) -(define struct:env-mixin - (make-record-type-descriptor* - 'env-mixin - #f - (|#%nongenerative-uid| env-mixin) - #f - #f - 4 - 0)) -(define effect_2757 - (struct-type-install-properties! - struct:env-mixin +(define finish2130 + (make-struct-type-install-properties '(env-mixin) 4 0 @@ -52061,6 +52056,16 @@ '(0 1 2 3) #f 'env-mixin)) +(define struct:env-mixin + (make-record-type-descriptor* + 'env-mixin + #f + (|#%nongenerative-uid| env-mixin) + #f + #f + 4 + 0)) +(define effect_2352 (finish2130 struct:env-mixin)) (define env-mixin2.1 (|#%name| env-mixin @@ -56829,18 +56834,8 @@ ((s_0 ns_0 serializable?8_0) (compile_0 s_0 ns_0 serializable?8_0 unsafe-undefined)) ((s_0 ns7_0) (compile_0 s_0 ns7_0 #t unsafe-undefined)))))) -(define struct:lifted-parsed-begin - (make-record-type-descriptor* - 'lifted-parsed-begin - #f - (|#%nongenerative-uid| lifted-parsed-begin) - #f - #f - 2 - 0)) -(define effect_1982 - (struct-type-install-properties! - struct:lifted-parsed-begin +(define finish2279 + (make-struct-type-install-properties '(lifted-parsed-begin) 2 0 @@ -56851,6 +56846,16 @@ '(0 1) #f 'lifted-parsed-begin)) +(define struct:lifted-parsed-begin + (make-record-type-descriptor* + 'lifted-parsed-begin + #f + (|#%nongenerative-uid| lifted-parsed-begin) + #f + #f + 2 + 0)) +(define effect_2583 (finish2279 struct:lifted-parsed-begin)) (define lifted-parsed-begin11.1 (|#%name| lifted-parsed-begin @@ -59099,18 +59104,8 @@ current-directory (find-system-path 'orig-dir))) (|#%app| thunk_0)))) -(define struct:shadow-directory - (make-record-type-descriptor* - 'shadow-directory - #f - (|#%nongenerative-uid| shadow-directory) - #f - #f - 2 - 0)) -(define effect_2396 - (struct-type-install-properties! - struct:shadow-directory +(define finish2316 + (make-struct-type-install-properties '(shadow-directory) 2 0 @@ -59121,6 +59116,16 @@ '(0 1) #f 'shadow-directory)) +(define struct:shadow-directory + (make-record-type-descriptor* + 'shadow-directory + #f + (|#%nongenerative-uid| shadow-directory) + #f + #f + 2 + 0)) +(define effect_2776 (finish2316 struct:shadow-directory)) (define shadow-directory1.1 (|#%name| shadow-directory @@ -60006,18 +60011,8 @@ v_0)) v_0)) 'current-readtable)) -(define struct:read-config/outer - (make-record-type-descriptor* - 'read-config - #f - (|#%nongenerative-uid| read-config) - #f - #f - 7 - 0)) -(define effect_2997 - (struct-type-install-properties! - struct:read-config/outer +(define finish2346 + (make-struct-type-install-properties '(read-config) 7 0 @@ -60028,6 +60023,16 @@ '(0 1 2 3 4 5 6) #f 'read-config/outer)) +(define struct:read-config/outer + (make-record-type-descriptor* + 'read-config + #f + (|#%nongenerative-uid| read-config) + #f + #f + 7 + 0)) +(define effect_2490 (finish2346 struct:read-config/outer)) (define read-config/outer1.1 (|#%name| read-config/outer @@ -60053,18 +60058,8 @@ (|#%name| read-config-keep-comment? (record-accessor struct:read-config/outer 6))) -(define struct:read-config/inner - (make-record-type-descriptor* - 'read-config/inner - #f - (|#%nongenerative-uid| read-config/inner) - #f - #f - 13 - 0)) -(define effect_2382 - (struct-type-install-properties! - struct:read-config/inner +(define finish2348 + (make-struct-type-install-properties '(read-config/inner) 13 0 @@ -60075,6 +60070,16 @@ '(0 1 2 3 4 5 6 7 8 9 10 11 12) #f 'read-config/inner)) +(define struct:read-config/inner + (make-record-type-descriptor* + 'read-config/inner + #f + (|#%nongenerative-uid| read-config/inner) + #f + #f + 13 + 0)) +(define effect_2436 (finish2348 struct:read-config/inner)) (define read-config/inner2.1 (|#%name| read-config/inner @@ -60217,18 +60222,8 @@ (read-config/inner-parameter-cache (read-config/outer-inner v_0)))) (define read-config-st (lambda (v_0) (read-config/inner-st (read-config/outer-inner v_0)))) -(define struct:read-config-state - (make-record-type-descriptor* - 'read-config-state - #f - (|#%nongenerative-uid| read-config-state) - #f - #f - 2 - 3)) -(define effect_2536 - (struct-type-install-properties! - struct:read-config-state +(define finish2351 + (make-struct-type-install-properties '(read-config-state) 2 0 @@ -60239,6 +60234,16 @@ '() #f 'read-config-state)) +(define struct:read-config-state + (make-record-type-descriptor* + 'read-config-state + #f + (|#%nongenerative-uid| read-config-state) + #f + #f + 2 + 3)) +(define effect_2073 (finish2351 struct:read-config-state)) (define read-config-state3.1 (|#%name| read-config-state @@ -60769,18 +60774,8 @@ (check-parameter 1/read-accept-quasiquote config_0) (check-parameter 1/read-accept-reader config_0) (check-parameter 1/read-accept-lang config_0)))))) -(define struct:special-comment - (make-record-type-descriptor* - 'special-comment - #f - (|#%nongenerative-uid| special-comment) - #f - #f - 1 - 0)) -(define effect_2866 - (struct-type-install-properties! - struct:special-comment +(define finish2395 + (make-struct-type-install-properties '(special-comment) 1 0 @@ -60791,6 +60786,16 @@ '(0) #f 'make-special-comment)) +(define struct:special-comment + (make-record-type-descriptor* + 'special-comment + #f + (|#%nongenerative-uid| special-comment) + #f + #f + 1 + 0)) +(define effect_3106 (finish2395 struct:special-comment)) (define 1/make-special-comment (|#%name| make-special-comment @@ -60800,18 +60805,8 @@ (|#%name| special-comment? (record-predicate struct:special-comment))) (define 1/special-comment-value (|#%name| special-comment-value (record-accessor struct:special-comment 0))) -(define struct:readtable - (make-record-type-descriptor* - 'readtable - #f - (|#%nongenerative-uid| readtable) - #f - #f - 4 - 0)) -(define effect_2769 - (struct-type-install-properties! - struct:readtable +(define finish2397 + (make-struct-type-install-properties '(readtable) 4 0 @@ -60822,6 +60817,16 @@ '(0 1 2 3) #f 'readtable)) +(define struct:readtable + (make-record-type-descriptor* + 'readtable + #f + (|#%nongenerative-uid| readtable) + #f + #f + 4 + 0)) +(define effect_2167 (finish2397 struct:readtable)) (define readtable1.1 (|#%name| readtable @@ -61184,18 +61189,8 @@ (args (raise-binding-result-arity-error 2 args)))) fold-var_0)))))) (for-loop_0 null (hash-iterate-first ht_0)))))))))) -(define struct:special - (make-record-type-descriptor* - 'special - #f - (|#%nongenerative-uid| special) - #f - #f - 1 - 0)) -(define effect_2785 - (struct-type-install-properties! - struct:special +(define finish2411 + (make-struct-type-install-properties '(special) 1 0 @@ -61206,6 +61201,16 @@ '(0) #f 'special)) +(define struct:special + (make-record-type-descriptor* + 'special + #f + (|#%nongenerative-uid| special) + #f + #f + 1 + 0)) +(define effect_2677 (finish2411 struct:special)) (define special1.1 (|#%name| special @@ -61734,18 +61739,8 @@ (if (if s_0 s_0 c_0) (format "~a or ~a" p_0 (if s_0 s_0 c_0)) p_0))))))) -(define struct:accum-string - (make-record-type-descriptor* - 'accum-string - #f - (|#%nongenerative-uid| accum-string) - #f - #f - 2 - 3)) -(define effect_3237 - (struct-type-install-properties! - struct:accum-string +(define finish2443 + (make-struct-type-install-properties '(accum-string) 2 0 @@ -61756,6 +61751,16 @@ '() #f 'accum-string)) +(define struct:accum-string + (make-record-type-descriptor* + 'accum-string + #f + (|#%nongenerative-uid| accum-string) + #f + #f + 2 + 3)) +(define effect_2784 (finish2443 struct:accum-string)) (define accum-string1.1 (|#%name| accum-string @@ -61858,18 +61863,8 @@ (set-read-config-state-accum-str! (begin-unsafe (read-config/inner-st (read-config/outer-inner config_0))) a_0))) -(define struct:indentation - (make-record-type-descriptor* - 'indentation - #f - (|#%nongenerative-uid| indentation) - #f - #f - 8 - 246)) -(define effect_2641 - (struct-type-install-properties! - struct:indentation +(define finish2457 + (make-struct-type-install-properties '(indentation) 8 0 @@ -61880,6 +61875,16 @@ '(0 3) #f 'indentation)) +(define struct:indentation + (make-record-type-descriptor* + 'indentation + #f + (|#%nongenerative-uid| indentation) + #f + #f + 8 + 246)) +(define effect_2185 (finish2457 struct:indentation)) (define indentation1.1 (|#%name| indentation @@ -62893,18 +62898,8 @@ decimal-mode_0 convert-mode_0 single-mode_0)))) -(define struct:parse-state - (make-record-type-descriptor* - 'parse-state - #f - (|#%nongenerative-uid| parse-state) - #f - #f - 5 - 0)) -(define effect_2594 - (struct-type-install-properties! - struct:parse-state +(define finish2506 + (make-struct-type-install-properties '(parse-state) 5 0 @@ -62915,6 +62910,16 @@ '(0 1 2 3 4) #f 'parse-state)) +(define struct:parse-state + (make-record-type-descriptor* + 'parse-state + #f + (|#%nongenerative-uid| parse-state) + #f + #f + 5 + 0)) +(define effect_2177 (finish2506 struct:parse-state)) (define parse-state6.1 (|#%name| parse-state @@ -62934,18 +62939,8 @@ (|#%name| parse-state-other-exactness (record-accessor struct:parse-state 4))) -(define struct:rect-prefix - (make-record-type-descriptor* - 'rect-prefix - #f - (|#%nongenerative-uid| rect-prefix) - #f - #f - 3 - 0)) -(define effect_2253 - (struct-type-install-properties! - struct:rect-prefix +(define finish2508 + (make-struct-type-install-properties '(rect-prefix) 3 0 @@ -62956,6 +62951,16 @@ '(0 1 2) #f 'rect-prefix)) +(define struct:rect-prefix + (make-record-type-descriptor* + 'rect-prefix + #f + (|#%nongenerative-uid| rect-prefix) + #f + #f + 3 + 0)) +(define effect_2477 (finish2508 struct:rect-prefix)) (define rect-prefix7.1 (|#%name| rect-prefix @@ -62969,18 +62974,8 @@ (|#%name| rect-prefix-n (record-accessor struct:rect-prefix 1))) (define rect-prefix-start (|#%name| rect-prefix-start (record-accessor struct:rect-prefix 2))) -(define struct:polar-prefix - (make-record-type-descriptor* - 'polar-prefix - #f - (|#%nongenerative-uid| polar-prefix) - #f - #f - 3 - 0)) -(define effect_2346 - (struct-type-install-properties! - struct:polar-prefix +(define finish2510 + (make-struct-type-install-properties '(polar-prefix) 3 0 @@ -62991,6 +62986,16 @@ '(0 1 2) #f 'polar-prefix)) +(define struct:polar-prefix + (make-record-type-descriptor* + 'polar-prefix + #f + (|#%nongenerative-uid| polar-prefix) + #f + #f + 3 + 0)) +(define effect_2366 (finish2510 struct:polar-prefix)) (define polar-prefix8.1 (|#%name| polar-prefix @@ -63092,18 +63097,8 @@ (if (eq? (state->convert-mode state_0) 'must-read) (format "cannot combine extflonum `~a` into a complex number" i_0) #f))) -(define struct:lazy-expt - (make-record-type-descriptor* - 'lazy-expt - #f - (|#%nongenerative-uid| lazy-expt) - #f - #f - 3 - 0)) -(define effect_2494 - (struct-type-install-properties! - struct:lazy-expt +(define finish2520 + (make-struct-type-install-properties '(lazy-expt) 3 0 @@ -63114,6 +63109,16 @@ '(0 1 2) #f 'lazy-expt)) +(define struct:lazy-expt + (make-record-type-descriptor* + 'lazy-expt + #f + (|#%nongenerative-uid| lazy-expt) + #f + #f + 3 + 0)) +(define effect_2131 (finish2520 struct:lazy-expt)) (define lazy-expt9.1 (|#%name| lazy-expt @@ -63126,18 +63131,8 @@ (|#%name| lazy-expt-radix (record-accessor struct:lazy-expt 1))) (define lazy-expt-exp (|#%name| lazy-expt-exp (record-accessor struct:lazy-expt 2))) -(define struct:lazy-rational - (make-record-type-descriptor* - 'lazy-rational - #f - (|#%nongenerative-uid| lazy-rational) - #f - #f - 2 - 0)) -(define effect_2726 - (struct-type-install-properties! - struct:lazy-rational +(define finish2522 + (make-struct-type-install-properties '(lazy-rational) 2 0 @@ -63148,6 +63143,16 @@ '(0 1) #f 'lazy-rational)) +(define struct:lazy-rational + (make-record-type-descriptor* + 'lazy-rational + #f + (|#%nongenerative-uid| lazy-rational) + #f + #f + 2 + 0)) +(define effect_3104 (finish2522 struct:lazy-rational)) (define lazy-rational10.1 (|#%name| lazy-rational @@ -72515,7 +72520,7 @@ 'variable-reference->module-declaration-inspector 'read-syntax 'read-syntax/recursive)) -(define effect_2770 +(define effect_2769 (begin (void (begin @@ -82159,7 +82164,7 @@ (args (raise-binding-result-arity-error 2 args))))) (|#%app| nonempty-begin_0 s_0 ctx_0))))))) (void))) -(define effect_2642 +(define effect_2641 (begin (void (add-core-form!* @@ -82773,7 +82778,7 @@ disarmed-s_0) s_0) s_0))) -(define effect_2374 +(define effect_2375 (begin (void (add-core-form!* @@ -86292,7 +86297,7 @@ "illegal use (not in a module top-level)" s_0))))) (void))) -(define effect_2371 +(define effect_2372 (begin (void (add-core-form!* @@ -86389,7 +86394,7 @@ "expand-context/outer?" ctx_0))))))) (void))) -(define effect_2522 +(define effect_2523 (begin (void (add-core-form!* @@ -92345,7 +92350,7 @@ (values tl-ids_0 (select-defined-syms-and-bind!/ctx tmp-bind-ids_0 ctx_0)))))))) -(define effect_2375 +(define effect_2376 (begin (void (add-core-form!* @@ -93336,7 +93341,7 @@ (declare-reexporting-module!.1 ns_0 #f '|#%builtin| temp41_0)) (1/current-namespace ns_0) (1/dynamic-require ''|#%kernel| 0)))))) -(define effect_2376 +(define effect_2377 (begin (|#%call-with-values| (lambda () (namespace-init!)) print-values) (void))) diff --git a/racket/src/cs/schemified/io.scm b/racket/src/cs/schemified/io.scm index 9d6cbfb276..124d7bf3f7 100644 --- a/racket/src/cs/schemified/io.scm +++ b/racket/src/cs/schemified/io.scm @@ -2616,6 +2616,18 @@ (define 1/unsafe-add-global-finalizer unsafe-add-global-finalizer) (define 1/malloc-immobile-cell malloc-immobile-cell) (define 1/free-immobile-cell free-immobile-cell) +(define finish65 + (make-struct-type-install-properties + '(sandman) + 11 + 0 + #f + null + 'prefab + #f + '(0 1 2 3 4 5 6 7 8 9 10) + #f + 'sandman)) (define struct:sandman (make-record-type-descriptor* 'sandman @@ -2631,19 +2643,7 @@ #f 11 2047)) -(define effect_2467 - (struct-type-install-properties! - struct:sandman - '(sandman) - 11 - 0 - #f - null - 'prefab - #f - '(0 1 2 3 4 5 6 7 8 9 10) - #f - 'sandman)) +(define effect_2951 (finish65 struct:sandman)) (define sandman1.1 (|#%name| sandman @@ -3589,18 +3589,8 @@ (|#%app| rktio_free h_0) (loop_0 #t)))))))))) (loop_0 #f)))))) -(define struct:exts - (make-record-type-descriptor* - 'exts - #f - (|#%nongenerative-uid| exts) - #f - #f - 2 - 0)) -(define effect_2305 - (struct-type-install-properties! - struct:exts +(define finish319 + (make-struct-type-install-properties '(exts) 2 0 @@ -3611,6 +3601,16 @@ '(0 1) #f 'exts)) +(define struct:exts + (make-record-type-descriptor* + 'exts + #f + (|#%nongenerative-uid| exts) + #f + #f + 2 + 0)) +(define effect_2505 (finish319 struct:exts)) (define exts1.1 (|#%name| exts @@ -3882,18 +3882,8 @@ (if (input-port-evt? p_0) (wrap-evt (|#%app| (input-port-evt-ref p_0) p_0) (lambda (v_0) p_0)) (wrap-evt (|#%app| (output-port-evt-ref p_0) p_0) (lambda (v_0) p_0))))) -(define struct:core-port - (make-record-type-descriptor* - 'core-port - #f - (|#%nongenerative-uid| core-port) - #f - #f - 7 - 124)) -(define effect_2672 - (struct-type-install-properties! - struct:core-port +(define finish334 + (make-struct-type-install-properties '(core-port) 7 0 @@ -3908,6 +3898,16 @@ '(0 1) #f 'create-core-port)) +(define struct:core-port + (make-record-type-descriptor* + 'core-port + #f + (|#%nongenerative-uid| core-port) + #f + #f + 7 + 124)) +(define effect_2337 (finish334 struct:core-port)) (define create-core-port (|#%name| create-core-port @@ -3938,18 +3938,8 @@ (|#%name| set-core-port-offset! (record-mutator struct:core-port 5))) (define set-core-port-count! (|#%name| set-core-port-count! (record-mutator struct:core-port 6))) -(define struct:core-port-methods.1 - (make-record-type-descriptor* - 'core-port-methods - #f - (|#%nongenerative-uid| core-port-methods) - #f - #f - 5 - 0)) -(define effect_2243 - (struct-type-install-properties! - struct:core-port-methods.1 +(define finish337 + (make-struct-type-install-properties '(core-port-methods) 5 0 @@ -3960,6 +3950,16 @@ '(0 1 2 3 4) #f 'core-port-methods)) +(define struct:core-port-methods.1 + (make-record-type-descriptor* + 'core-port-methods + #f + (|#%nongenerative-uid| core-port-methods) + #f + #f + 5 + 0)) +(define effect_2309 (finish337 struct:core-port-methods.1)) (define core-port-methods1.1 (|#%name| core-port-methods @@ -4074,18 +4074,8 @@ #f #f #f)) -(define struct:direct - (make-record-type-descriptor* - 'direct - #f - (|#%nongenerative-uid| direct) - #f - #f - 3 - 7)) -(define effect_2315 - (struct-type-install-properties! - struct:direct +(define finish344 + (make-struct-type-install-properties '(direct) 3 0 @@ -4096,6 +4086,16 @@ '() #f 'direct)) +(define struct:direct + (make-record-type-descriptor* + 'direct + #f + (|#%nongenerative-uid| direct) + #f + #f + 3 + 7)) +(define effect_2682 (finish344 struct:direct)) (define direct2.1 (|#%name| direct @@ -4111,18 +4111,8 @@ (|#%name| set-direct-pos! (record-mutator struct:direct 1))) (define set-direct-end! (|#%name| set-direct-end! (record-mutator struct:direct 2))) -(define struct:location - (make-record-type-descriptor* - 'location - #f - (|#%nongenerative-uid| location) - #f - #f - 5 - 31)) -(define effect_2878 - (struct-type-install-properties! - struct:location +(define finish346 + (make-struct-type-install-properties '(location) 5 0 @@ -4133,6 +4123,16 @@ '() #f 'location)) +(define struct:location + (make-record-type-descriptor* + 'location + #f + (|#%nongenerative-uid| location) + #f + #f + 5 + 31)) +(define effect_3131 (finish346 struct:location)) (define location3.1 (|#%name| location @@ -4218,18 +4218,8 @@ (if who3_0 (raise-argument-error who3_0 "input-port?" v4_0) default_0))))))))) -(define struct:core-input-port - (make-record-type-descriptor* - 'core-input-port - struct:core-port - (|#%nongenerative-uid| core-input-port) - #f - #f - 2 - 3)) -(define effect_2934 - (struct-type-install-properties! - struct:core-input-port +(define finish348 + (make-struct-type-install-properties '(core-input-port) 2 0 @@ -4270,6 +4260,16 @@ '() #f 'create-core-input-port)) +(define struct:core-input-port + (make-record-type-descriptor* + 'core-input-port + struct:core-port + (|#%nongenerative-uid| core-input-port) + #f + #f + 2 + 3)) +(define effect_2528 (finish348 struct:core-input-port)) (define create-core-input-port (|#%name| create-core-input-port @@ -4293,18 +4293,8 @@ (|#%name| set-core-input-port-read-handler! (record-mutator struct:core-input-port 1))) -(define struct:core-input-port-methods.1 - (make-record-type-descriptor* - 'core-input-port-methods - struct:core-port-methods.1 - (|#%nongenerative-uid| core-input-port-methods) - #f - #f - 6 - 0)) -(define effect_2804 - (struct-type-install-properties! - struct:core-input-port-methods.1 +(define finish351 + (make-struct-type-install-properties '(core-input-port-methods) 6 0 @@ -4315,6 +4305,16 @@ '(0 1 2 3 4 5) #f 'core-input-port-methods)) +(define struct:core-input-port-methods.1 + (make-record-type-descriptor* + 'core-input-port-methods + struct:core-port-methods.1 + (|#%nongenerative-uid| core-input-port-methods) + #f + #f + 6 + 0)) +(define effect_2085 (finish351 struct:core-input-port-methods.1)) (define core-input-port-methods6.1 (|#%name| core-input-port-methods @@ -4537,18 +4537,8 @@ (if who3_0 (raise-argument-error who3_0 "output-port?" v4_0) default_0))))))))) -(define struct:core-output-port - (make-record-type-descriptor* - 'core-output-port - struct:core-port - (|#%nongenerative-uid| core-output-port) - #f - #f - 4 - 15)) -(define effect_2929 - (struct-type-install-properties! - struct:core-output-port +(define finish363 + (make-struct-type-install-properties '(core-output-port) 4 0 @@ -4576,6 +4566,16 @@ '() #f 'create-core-output-port)) +(define struct:core-output-port + (make-record-type-descriptor* + 'core-output-port + struct:core-port + (|#%nongenerative-uid| core-output-port) + #f + #f + 4 + 15)) +(define effect_2808 (finish363 struct:core-output-port)) (define create-core-output-port (|#%name| create-core-output-port @@ -4613,18 +4613,8 @@ (|#%name| set-core-output-port-display-handler! (record-mutator struct:core-output-port 3))) -(define struct:core-output-port-methods.1 - (make-record-type-descriptor* - 'core-output-port-methods - struct:core-port-methods.1 - (|#%nongenerative-uid| core-output-port-methods) - #f - #f - 4 - 0)) -(define effect_2086 - (struct-type-install-properties! - struct:core-output-port-methods.1 +(define finish367 + (make-struct-type-install-properties '(core-output-port-methods) 4 0 @@ -4635,6 +4625,16 @@ '(0 1 2 3) #f 'core-output-port-methods)) +(define struct:core-output-port-methods.1 + (make-record-type-descriptor* + 'core-output-port-methods + struct:core-port-methods.1 + (|#%nongenerative-uid| core-output-port-methods) + #f + #f + 4 + 0)) +(define effect_2050 (finish367 struct:core-output-port-methods.1)) (define core-output-port-methods6.1 (|#%name| core-output-port-methods @@ -4784,18 +4784,8 @@ (if (evt? v_0) (values #f (replace-evt v_0 self-evt_0)) (values (list v_0) #f))))))))) -(define struct:write-evt - (make-record-type-descriptor* - 'write-evt - #f - (|#%nongenerative-uid| write-evt) - #f - #f - 1 - 0)) -(define effect_2624 - (struct-type-install-properties! - struct:write-evt +(define finish378 + (make-struct-type-install-properties '(write-evt) 1 0 @@ -4812,6 +4802,16 @@ '(0) #f 'write-evt)) +(define struct:write-evt + (make-record-type-descriptor* + 'write-evt + #f + (|#%nongenerative-uid| write-evt) + #f + #f + 1 + 0)) +(define effect_2493 (finish378 struct:write-evt)) (define write-evt7.1 (|#%name| write-evt @@ -4856,18 +4856,8 @@ #f #f #f)) -(define struct:utf-8-state - (make-record-type-descriptor* - 'utf-8-state - #f - (|#%nongenerative-uid| utf-8-state) - #f - #f - 3 - 0)) -(define effect_2392 - (struct-type-install-properties! - struct:utf-8-state +(define finish382 + (make-struct-type-install-properties '(utf-8-state) 3 0 @@ -4878,6 +4868,16 @@ '(0 1 2) #f 'utf-8-state)) +(define struct:utf-8-state + (make-record-type-descriptor* + 'utf-8-state + #f + (|#%nongenerative-uid| utf-8-state) + #f + #f + 3 + 0)) +(define effect_2751 (finish382 struct:utf-8-state)) (define utf-8-state1.1 (|#%name| utf-8-state @@ -6683,18 +6683,8 @@ (if old-offset_0 (set-core-port-offset! in_0 (+ amt_0 old-offset_0)) (void)))))) -(define struct:commit-manager - (make-record-type-descriptor* - 'commit-manager - #f - (|#%nongenerative-uid| commit-manager) - #f - #f - 3 - 0)) -(define effect_2778 - (struct-type-install-properties! - struct:commit-manager +(define finish462 + (make-struct-type-install-properties '(commit-manager) 3 0 @@ -6705,6 +6695,16 @@ '(0 1 2) #f 'commit-manager)) +(define struct:commit-manager + (make-record-type-descriptor* + 'commit-manager + #f + (|#%nongenerative-uid| commit-manager) + #f + #f + 3 + 0)) +(define effect_2594 (finish462 struct:commit-manager)) (define commit-manager1.1 (|#%name| commit-manager @@ -6774,18 +6774,8 @@ s 'commit-manager 'thread)))))) -(define struct:commit-request - (make-record-type-descriptor* - 'commit-request - #f - (|#%nongenerative-uid| commit-request) - #f - #f - 5 - 0)) -(define effect_2971 - (struct-type-install-properties! - struct:commit-request +(define finish468 + (make-struct-type-install-properties '(commit-request) 5 0 @@ -6796,6 +6786,16 @@ '(0 1 2 3 4) #f 'commit-request)) +(define struct:commit-request + (make-record-type-descriptor* + 'commit-request + #f + (|#%nongenerative-uid| commit-request) + #f + #f + 5 + 0)) +(define effect_2646 (finish468 struct:commit-request)) (define commit-request2.1 (|#%name| commit-request @@ -6899,18 +6899,8 @@ s 'commit-request 'result-ch)))))) -(define struct:commit-response - (make-record-type-descriptor* - 'commit-response - #f - (|#%nongenerative-uid| commit-response) - #f - #f - 2 - 0)) -(define effect_2630 - (struct-type-install-properties! - struct:commit-response +(define finish476 + (make-struct-type-install-properties '(commit-response) 2 0 @@ -6921,6 +6911,16 @@ '(0 1) #f 'commit-response)) +(define struct:commit-response + (make-record-type-descriptor* + 'commit-response + #f + (|#%nongenerative-uid| commit-response) + #f + #f + 2 + 0)) +(define effect_2529 (finish476 struct:commit-response)) (define commit-response3.1 (|#%name| commit-response @@ -7217,18 +7217,8 @@ (sync result-ch_0)) (unsafe-start-atomic)))) (lambda () (semaphore-post abandon-evt_0))))))) -(define struct:commit-input-port - (make-record-type-descriptor* - 'commit-input-port - struct:core-input-port - (|#%nongenerative-uid| commit-input-port) - #f - #f - 2 - 3)) -(define effect_2923 - (struct-type-install-properties! - struct:commit-input-port +(define finish495 + (make-struct-type-install-properties '(commit-input-port) 2 0 @@ -7239,6 +7229,16 @@ '() #f 'create-commit-input-port)) +(define struct:commit-input-port + (make-record-type-descriptor* + 'commit-input-port + struct:core-input-port + (|#%nongenerative-uid| commit-input-port) + #f + #f + 2 + 3)) +(define effect_2802 (finish495 struct:commit-input-port)) (define create-commit-input-port (|#%name| create-commit-input-port @@ -7262,18 +7262,8 @@ (|#%name| set-commit-input-port-commit-manager! (record-mutator struct:commit-input-port 1))) -(define struct:commit-input-port-methods.1 - (make-record-type-descriptor* - 'commit-input-port-methods - struct:core-input-port-methods.1 - (|#%nongenerative-uid| commit-input-port-methods) - #f - #f - 0 - 0)) -(define effect_1933 - (struct-type-install-properties! - struct:commit-input-port-methods.1 +(define finish498 + (make-struct-type-install-properties '(commit-input-port-methods) 0 0 @@ -7284,6 +7274,16 @@ '() #f 'commit-input-port-methods)) +(define struct:commit-input-port-methods.1 + (make-record-type-descriptor* + 'commit-input-port-methods + struct:core-input-port-methods.1 + (|#%nongenerative-uid| commit-input-port-methods) + #f + #f + 0 + 0)) +(define effect_3199 (finish498 struct:commit-input-port-methods.1)) (define commit-input-port-methods5.1 (|#%name| commit-input-port-methods @@ -7437,18 +7437,8 @@ (begin0 (begin (temp3.1$3 d_0) (temp4.1$2 d_0)) (unsafe-end-atomic)))))))) -(define struct:pipe-data - (make-record-type-descriptor* - 'pipe-data - #f - (|#%nongenerative-uid| pipe-data) - #f - #f - 16 - 65534)) -(define effect_2761 - (struct-type-install-properties! - struct:pipe-data +(define finish510 + (make-struct-type-install-properties '(pipe-data) 16 0 @@ -7459,6 +7449,16 @@ '(0) #f 'create-pipe-data)) +(define struct:pipe-data + (make-record-type-descriptor* + 'pipe-data + #f + (|#%nongenerative-uid| pipe-data) + #f + #f + 16 + 65534)) +(define effect_3021 (finish510 struct:pipe-data)) (define create-pipe-data (|#%name| create-pipe-data @@ -7539,18 +7539,8 @@ (|#%name| set-pipe-data-write-ready-evt! (record-mutator struct:pipe-data 15))) -(define struct:pipe-data-methods.1 - (make-record-type-descriptor* - 'pipe-data-methods - #f - (|#%nongenerative-uid| pipe-data-methods) - #f - #f - 0 - 0)) -(define effect_2809 - (struct-type-install-properties! - struct:pipe-data-methods.1 +(define finish513 + (make-struct-type-install-properties '(pipe-data-methods) 0 0 @@ -7561,6 +7551,16 @@ '() #f 'pipe-data-methods)) +(define struct:pipe-data-methods.1 + (make-record-type-descriptor* + 'pipe-data-methods + #f + (|#%nongenerative-uid| pipe-data-methods) + #f + #f + 0 + 0)) +(define effect_2537 (finish513 struct:pipe-data-methods.1)) (define pipe-data-methods10.1 (|#%name| pipe-data-methods @@ -7673,18 +7673,8 @@ (void)))))) (define make-ref (lambda (v_0) (make-weak-box v_0))) (define ref-value (lambda (r_0) (weak-box-value r_0))) -(define struct:pipe-input-port - (make-record-type-descriptor* - 'pipe-input-port - struct:commit-input-port - (|#%nongenerative-uid| pipe-input-port) - #f - #f - 1 - 1)) -(define effect_1840 - (struct-type-install-properties! - struct:pipe-input-port +(define finish517 + (make-struct-type-install-properties '(pipe-input-port) 1 0 @@ -7695,6 +7685,16 @@ '() #f 'create-pipe-input-port)) +(define struct:pipe-input-port + (make-record-type-descriptor* + 'pipe-input-port + struct:commit-input-port + (|#%nongenerative-uid| pipe-input-port) + #f + #f + 1 + 1)) +(define effect_2318 (finish517 struct:pipe-input-port)) (define create-pipe-input-port (|#%name| create-pipe-input-port @@ -7706,18 +7706,8 @@ (|#%name| pipe-input-port-d (record-accessor struct:pipe-input-port 0))) (define set-pipe-input-port-d! (|#%name| set-pipe-input-port-d! (record-mutator struct:pipe-input-port 0))) -(define struct:pipe-input-port-methods.1 - (make-record-type-descriptor* - 'pipe-input-port-methods - struct:commit-input-port-methods.1 - (|#%nongenerative-uid| pipe-input-port-methods) - #f - #f - 0 - 0)) -(define effect_3026 - (struct-type-install-properties! - struct:pipe-input-port-methods.1 +(define finish520 + (make-struct-type-install-properties '(pipe-input-port-methods) 0 0 @@ -7728,6 +7718,16 @@ '() #f 'pipe-input-port-methods)) +(define struct:pipe-input-port-methods.1 + (make-record-type-descriptor* + 'pipe-input-port-methods + struct:commit-input-port-methods.1 + (|#%nongenerative-uid| pipe-input-port-methods) + #f + #f + 0 + 0)) +(define effect_2335 (finish520 struct:pipe-input-port-methods.1)) (define pipe-input-port-methods15.1 (|#%name| pipe-input-port-methods @@ -8069,18 +8069,8 @@ (set-direct-pos! b_0 (direct-end b_0))))) (void)) (temp2.1$2 o_0)))))))) -(define struct:pipe-output-port - (make-record-type-descriptor* - 'pipe-output-port - struct:core-output-port - (|#%nongenerative-uid| pipe-output-port) - #f - #f - 1 - 1)) -(define effect_3143 - (struct-type-install-properties! - struct:pipe-output-port +(define finish539 + (make-struct-type-install-properties '(pipe-output-port) 1 0 @@ -8091,6 +8081,16 @@ '() #f 'create-pipe-output-port)) +(define struct:pipe-output-port + (make-record-type-descriptor* + 'pipe-output-port + struct:core-output-port + (|#%nongenerative-uid| pipe-output-port) + #f + #f + 1 + 1)) +(define effect_2635 (finish539 struct:pipe-output-port)) (define create-pipe-output-port (|#%name| create-pipe-output-port @@ -8104,18 +8104,8 @@ (|#%name| set-pipe-output-port-d! (record-mutator struct:pipe-output-port 0))) -(define struct:pipe-output-port-methods.1 - (make-record-type-descriptor* - 'pipe-output-port-methods - struct:core-output-port-methods.1 - (|#%nongenerative-uid| pipe-output-port-methods) - #f - #f - 0 - 0)) -(define effect_2754 - (struct-type-install-properties! - struct:pipe-output-port-methods.1 +(define finish542 + (make-struct-type-install-properties '(pipe-output-port-methods) 0 0 @@ -8126,6 +8116,16 @@ '() #f 'pipe-output-port-methods)) +(define struct:pipe-output-port-methods.1 + (make-record-type-descriptor* + 'pipe-output-port-methods + struct:core-output-port-methods.1 + (|#%nongenerative-uid| pipe-output-port-methods) + #f + #f + 0 + 0)) +(define effect_3193 (finish542 struct:pipe-output-port-methods.1)) (define pipe-output-port-methods20.1 (|#%name| pipe-output-port-methods @@ -8681,18 +8681,8 @@ (make-pipe_0 limit_0 input-name_0 output-name26_0)) ((limit_0 input-name25_0) (make-pipe_0 limit_0 input-name25_0 'pipe)) ((limit24_0) (make-pipe_0 limit24_0 'pipe 'pipe)))))) -(define struct:pipe-write-poller - (make-record-type-descriptor* - 'pipe-write-poller - #f - (|#%nongenerative-uid| pipe-write-poller) - #f - #f - 1 - 0)) -(define effect_2496 - (struct-type-install-properties! - struct:pipe-write-poller +(define finish578 + (make-struct-type-install-properties '(pipe-write-poller) 1 0 @@ -8733,6 +8723,16 @@ '(0) #f 'pipe-write-poller)) +(define struct:pipe-write-poller + (make-record-type-descriptor* + 'pipe-write-poller + #f + (|#%nongenerative-uid| pipe-write-poller) + #f + #f + 1 + 0)) +(define effect_2599 (finish578 struct:pipe-write-poller)) (define pipe-write-poller27.1 (|#%name| pipe-write-poller @@ -8766,18 +8766,8 @@ s 'pipe-write-poller 'd)))))) -(define struct:pipe-read-poller - (make-record-type-descriptor* - 'pipe-read-poller - #f - (|#%nongenerative-uid| pipe-read-poller) - #f - #f - 1 - 0)) -(define effect_2898 - (struct-type-install-properties! - struct:pipe-read-poller +(define finish583 + (make-struct-type-install-properties '(pipe-read-poller) 1 0 @@ -8818,6 +8808,16 @@ '(0) #f 'pipe-read-poller)) +(define struct:pipe-read-poller + (make-record-type-descriptor* + 'pipe-read-poller + #f + (|#%nongenerative-uid| pipe-read-poller) + #f + #f + 1 + 0)) +(define effect_2907 (finish583 struct:pipe-read-poller)) (define pipe-read-poller28.1 (|#%name| pipe-read-poller @@ -8851,18 +8851,8 @@ s 'pipe-read-poller 'd)))))) -(define struct:peek-via-read-input-port - (make-record-type-descriptor* - 'peek-via-read-input-port - struct:commit-input-port - (|#%nongenerative-uid| peek-via-read-input-port) - #f - #f - 5 - 31)) -(define effect_2594 - (struct-type-install-properties! - struct:peek-via-read-input-port +(define finish587 + (make-struct-type-install-properties '(peek-via-read-input-port) 5 0 @@ -8873,6 +8863,16 @@ '() #f 'create-peek-via-read-input-port)) +(define struct:peek-via-read-input-port + (make-record-type-descriptor* + 'peek-via-read-input-port + struct:commit-input-port + (|#%nongenerative-uid| peek-via-read-input-port) + #f + #f + 5 + 31)) +(define effect_2578 (finish587 struct:peek-via-read-input-port)) (define create-peek-via-read-input-port (|#%name| create-peek-via-read-input-port @@ -8925,18 +8925,8 @@ (|#%name| set-peek-via-read-input-port-buffer-mode! (record-mutator struct:peek-via-read-input-port 4))) -(define struct:peek-via-read-input-port-methods.1 - (make-record-type-descriptor* - 'peek-via-read-input-port-methods - struct:commit-input-port-methods.1 - (|#%nongenerative-uid| peek-via-read-input-port-methods) - #f - #f - 1 - 0)) -(define effect_2499 - (struct-type-install-properties! - struct:peek-via-read-input-port-methods.1 +(define finish590 + (make-struct-type-install-properties '(peek-via-read-input-port-methods) 1 0 @@ -8947,6 +8937,16 @@ '(0) #f 'peek-via-read-input-port-methods)) +(define struct:peek-via-read-input-port-methods.1 + (make-record-type-descriptor* + 'peek-via-read-input-port-methods + struct:commit-input-port-methods.1 + (|#%nongenerative-uid| peek-via-read-input-port-methods) + #f + #f + 1 + 0)) +(define effect_2499 (finish590 struct:peek-via-read-input-port-methods.1)) (define peek-via-read-input-port-methods10.1 (|#%name| peek-via-read-input-port-methods @@ -9631,18 +9631,8 @@ (current-continuation-marks))))))) (void)))) (void))))))) -(define struct:fd-input-port - (make-record-type-descriptor* - 'fd-input-port - struct:peek-via-read-input-port - (|#%nongenerative-uid| fd-input-port) - #f - #f - 3 - 7)) -(define effect_2353 - (struct-type-install-properties! - struct:fd-input-port +(define finish626 + (make-struct-type-install-properties '(fd-input-port) 3 0 @@ -9658,6 +9648,16 @@ '() #f 'create-fd-input-port)) +(define struct:fd-input-port + (make-record-type-descriptor* + 'fd-input-port + struct:peek-via-read-input-port + (|#%nongenerative-uid| fd-input-port) + #f + #f + 3 + 7)) +(define effect_1979 (finish626 struct:fd-input-port)) (define create-fd-input-port (|#%name| create-fd-input-port @@ -9685,18 +9685,8 @@ (|#%name| set-fd-input-port-custodian-reference! (record-mutator struct:fd-input-port 2))) -(define struct:fd-input-port-methods.1 - (make-record-type-descriptor* - 'fd-input-port-methods - struct:peek-via-read-input-port-methods.1 - (|#%nongenerative-uid| fd-input-port-methods) - #f - #f - 2 - 0)) -(define effect_2026 - (struct-type-install-properties! - struct:fd-input-port-methods.1 +(define finish629 + (make-struct-type-install-properties '(fd-input-port-methods) 2 0 @@ -9707,6 +9697,16 @@ '(0 1) #f 'fd-input-port-methods)) +(define struct:fd-input-port-methods.1 + (make-record-type-descriptor* + 'fd-input-port-methods + struct:peek-via-read-input-port-methods.1 + (|#%nongenerative-uid| fd-input-port-methods) + #f + #f + 2 + 0)) +(define effect_2420 (finish629 struct:fd-input-port-methods.1)) (define fd-input-port-methods6.1 (|#%name| fd-input-port-methods @@ -9939,18 +9939,8 @@ p16_0 (register-fd-close cust_0 fd_0 fd-refcount_0 #f p16_0)) (finish-port/count p16_0))))))))) -(define struct:fd-output-port - (make-record-type-descriptor* - 'fd-output-port - struct:core-output-port - (|#%nongenerative-uid| fd-output-port) - #f - #f - 8 - 255)) -(define effect_2985 - (struct-type-install-properties! - struct:fd-output-port +(define finish645 + (make-struct-type-install-properties '(fd-output-port) 8 0 @@ -9990,6 +9980,16 @@ '() #f 'create-fd-output-port)) +(define struct:fd-output-port + (make-record-type-descriptor* + 'fd-output-port + struct:core-output-port + (|#%nongenerative-uid| fd-output-port) + #f + #f + 8 + 255)) +(define effect_2896 (finish645 struct:fd-output-port)) (define create-fd-output-port (|#%name| create-fd-output-port @@ -10051,18 +10051,8 @@ (|#%name| set-fd-output-port-custodian-reference! (record-mutator struct:fd-output-port 7))) -(define struct:fd-output-port-methods.1 - (make-record-type-descriptor* - 'fd-output-port-methods - struct:core-output-port-methods.1 - (|#%nongenerative-uid| fd-output-port-methods) - #f - #f - 2 - 0)) -(define effect_2747 - (struct-type-install-properties! - struct:fd-output-port-methods.1 +(define finish652 + (make-struct-type-install-properties '(fd-output-port-methods) 2 0 @@ -10073,6 +10063,16 @@ '(0 1) #f 'fd-output-port-methods)) +(define struct:fd-output-port-methods.1 + (make-record-type-descriptor* + 'fd-output-port-methods + struct:core-output-port-methods.1 + (|#%nongenerative-uid| fd-output-port-methods) + #f + #f + 2 + 0)) +(define effect_1955 (finish652 struct:fd-output-port-methods.1)) (define fd-output-port-methods26.1 (|#%name| fd-output-port-methods @@ -10652,18 +10652,8 @@ (format-rktio-message 'file-position r_0 base-msg_0))) (|#%app| exn:fail app_0 (current-continuation-marks))))))) (void))))) -(define struct:fd-evt - (make-record-type-descriptor* - 'fd-evt - #f - (|#%nongenerative-uid| fd-evt) - #f - #f - 3 - 4)) -(define effect_2106 - (struct-type-install-properties! - struct:fd-evt +(define finish680 + (make-struct-type-install-properties '(fd-evt) 3 0 @@ -10724,6 +10714,16 @@ '(0 1) #f 'fd-evt)) +(define struct:fd-evt + (make-record-type-descriptor* + 'fd-evt + #f + (|#%nongenerative-uid| fd-evt) + #f + #f + 3 + 4)) +(define effect_2660 (finish680 struct:fd-evt)) (define fd-evt44.1 (|#%name| fd-evt @@ -10791,18 +10791,8 @@ v 'fd-evt 'closed)))))) -(define struct:rktio-fd-flushed-evt - (make-record-type-descriptor* - 'rktio-fd-flushed-evt - #f - (|#%nongenerative-uid| rktio-fd-flushed-evt) - #f - #f - 1 - 0)) -(define effect_1965 - (struct-type-install-properties! - struct:rktio-fd-flushed-evt +(define finish689 + (make-struct-type-install-properties '(rktio-fd-flushed-evt) 1 0 @@ -10837,6 +10827,16 @@ '(0) #f 'rktio-fd-flushed-evt)) +(define struct:rktio-fd-flushed-evt + (make-record-type-descriptor* + 'rktio-fd-flushed-evt + #f + (|#%nongenerative-uid| rktio-fd-flushed-evt) + #f + #f + 1 + 0)) +(define effect_2170 (finish689 struct:rktio-fd-flushed-evt)) (define rktio-fd-flushed-evt45.1 (|#%name| rktio-fd-flushed-evt @@ -11583,18 +11583,8 @@ (loop_0 (fx+ i_0 1)))) (loop_0 (fx+ i_0 1))))))))))) (loop_0 pos_0)))))))))) -(define struct:progress-evt - (make-record-type-descriptor* - 'progress-evt - #f - (|#%nongenerative-uid| progress-evt) - #f - #f - 2 - 0)) -(define effect_2746 - (struct-type-install-properties! - struct:progress-evt +(define finish702 + (make-struct-type-install-properties '(progress-evt) 2 0 @@ -11608,6 +11598,16 @@ '(0 1) #f 'progress-evt)) +(define struct:progress-evt + (make-record-type-descriptor* + 'progress-evt + #f + (|#%nongenerative-uid| progress-evt) + #f + #f + 2 + 0)) +(define effect_2490 (finish702 struct:progress-evt)) (define progress-evt1.1 (|#%name| progress-evt @@ -14906,18 +14906,8 @@ (begin (unsafe-bytes-set! out-bstr_0 j_0 lo_0) (unsafe-bytes-set! out-bstr_0 (+ j_0 1) hi_0))))) -(define struct:utf-8-converter - (make-record-type-descriptor* - 'utf-8-converter - #f - (|#%nongenerative-uid| utf-8-converter) - #f - #f - 2 - 0)) -(define effect_2854 - (struct-type-install-properties! - struct:utf-8-converter +(define finish730 + (make-struct-type-install-properties '(utf-8-converter) 2 0 @@ -14928,6 +14918,16 @@ '(0 1) #f 'utf-8-converter)) +(define struct:utf-8-converter + (make-record-type-descriptor* + 'utf-8-converter + #f + (|#%nongenerative-uid| utf-8-converter) + #f + #f + 2 + 0)) +(define effect_2402 (finish730 struct:utf-8-converter)) (define utf-8-converter1.1 (|#%name| utf-8-converter @@ -15840,18 +15840,8 @@ (done_0 'error))) (continue_0 v_0 (+ i_0 2))))))))))))))) (loop_0 in-start20_0 out-start23_0)))))) -(define struct:bytes-converter - (make-record-type-descriptor* - 'bytes-converter - #f - (|#%nongenerative-uid| bytes-converter) - #f - #f - 2 - 3)) -(define effect_2513 - (struct-type-install-properties! - struct:bytes-converter +(define finish781 + (make-struct-type-install-properties '(bytes-converter) 2 0 @@ -15862,6 +15852,16 @@ '() #f 'bytes-converter)) +(define struct:bytes-converter + (make-record-type-descriptor* + 'bytes-converter + #f + (|#%nongenerative-uid| bytes-converter) + #f + #f + 2 + 3)) +(define effect_2496 (finish781 struct:bytes-converter)) (define bytes-converter1.1 (|#%name| bytes-converter @@ -16717,18 +16717,8 @@ (args (raise-binding-result-arity-error 4 args)))) (void))) (check-not-unsafe-undefined bstr_0 'bstr_119)))))) -(define struct:cache - (make-record-type-descriptor* - 'cache - #f - (|#%nongenerative-uid| cache) - #f - #f - 4 - 15)) -(define effect_2505 - (struct-type-install-properties! - struct:cache +(define finish806 + (make-struct-type-install-properties '(cache) 4 0 @@ -16739,6 +16729,16 @@ '() #f 'cache)) +(define struct:cache + (make-record-type-descriptor* + 'cache + #f + (|#%nongenerative-uid| cache) + #f + #f + 4 + 15)) +(define effect_2561 (finish806 struct:cache)) (define cache1.1 (|#%name| cache @@ -17091,18 +17091,8 @@ (bytes->string/locale_0 in-bstr_0 err-char_0 start6_0 unsafe-undefined)) ((in-bstr_0 err-char5_0) (bytes->string/locale_0 in-bstr_0 err-char5_0 0 unsafe-undefined)))))) -(define struct:path - (make-record-type-descriptor* - 'path - #f - (|#%nongenerative-uid| path) - #f - #f - 2 - 0)) -(define effect_2269 - (struct-type-install-properties! - struct:path +(define finish813 + (make-struct-type-install-properties '(path) 2 0 @@ -17138,6 +17128,16 @@ '(0 1) #f 'path)) +(define struct:path + (make-record-type-descriptor* + 'path + #f + (|#%nongenerative-uid| path) + #f + #f + 2 + 0)) +(define effect_2995 (finish813 struct:path)) (define path1.1 (|#%name| path @@ -18393,18 +18393,8 @@ (case-lambda ((bstr_0) (begin (open-input-bytes_0 bstr_0 'string))) ((bstr_0 name1_0) (open-input-bytes_0 bstr_0 name1_0)))))) -(define struct:bytes-input-port - (make-record-type-descriptor* - 'bytes-input-port - struct:commit-input-port - (|#%nongenerative-uid| bytes-input-port) - #f - #f - 3 - 7)) -(define effect_2303 - (struct-type-install-properties! - struct:bytes-input-port +(define finish822 + (make-struct-type-install-properties '(bytes-input-port) 3 0 @@ -18415,6 +18405,16 @@ '() #f 'create-bytes-input-port)) +(define struct:bytes-input-port + (make-record-type-descriptor* + 'bytes-input-port + struct:commit-input-port + (|#%nongenerative-uid| bytes-input-port) + #f + #f + 3 + 7)) +(define effect_2847 (finish822 struct:bytes-input-port)) (define create-bytes-input-port (|#%name| create-bytes-input-port @@ -18442,18 +18442,8 @@ (|#%name| set-bytes-input-port-alt-pos! (record-mutator struct:bytes-input-port 2))) -(define struct:bytes-input-port-methods.1 - (make-record-type-descriptor* - 'bytes-input-port-methods - struct:commit-input-port-methods.1 - (|#%nongenerative-uid| bytes-input-port-methods) - #f - #f - 0 - 0)) -(define effect_2574 - (struct-type-install-properties! - struct:bytes-input-port-methods.1 +(define finish825 + (make-struct-type-install-properties '(bytes-input-port-methods) 0 0 @@ -18464,6 +18454,16 @@ '() #f 'bytes-input-port-methods)) +(define struct:bytes-input-port-methods.1 + (make-record-type-descriptor* + 'bytes-input-port-methods + struct:commit-input-port-methods.1 + (|#%nongenerative-uid| bytes-input-port-methods) + #f + #f + 0 + 0)) +(define effect_2130 (finish825 struct:bytes-input-port-methods.1)) (define bytes-input-port-methods4.1 (|#%name| bytes-input-port-methods @@ -18673,18 +18673,8 @@ bstr_0 0 #f)))) -(define struct:bytes-output-port - (make-record-type-descriptor* - 'bytes-output-port - struct:core-output-port - (|#%nongenerative-uid| bytes-output-port) - #f - #f - 3 - 7)) -(define effect_2607 - (struct-type-install-properties! - struct:bytes-output-port +(define finish833 + (make-struct-type-install-properties '(bytes-output-port) 3 0 @@ -18695,6 +18685,16 @@ '() #f 'create-bytes-output-port)) +(define struct:bytes-output-port + (make-record-type-descriptor* + 'bytes-output-port + struct:core-output-port + (|#%nongenerative-uid| bytes-output-port) + #f + #f + 3 + 7)) +(define effect_2052 (finish833 struct:bytes-output-port)) (define create-bytes-output-port (|#%name| create-bytes-output-port @@ -18726,18 +18726,8 @@ (|#%name| set-bytes-output-port-max-pos! (record-mutator struct:bytes-output-port 2))) -(define struct:bytes-output-port-methods.1 - (make-record-type-descriptor* - 'bytes-output-port-methods - struct:core-output-port-methods.1 - (|#%nongenerative-uid| bytes-output-port-methods) - #f - #f - 2 - 0)) -(define effect_2007 - (struct-type-install-properties! - struct:bytes-output-port-methods.1 +(define finish836 + (make-struct-type-install-properties '(bytes-output-port-methods) 2 0 @@ -18748,6 +18738,16 @@ '(0 1) #f 'bytes-output-port-methods)) +(define struct:bytes-output-port-methods.1 + (make-record-type-descriptor* + 'bytes-output-port-methods + struct:core-output-port-methods.1 + (|#%nongenerative-uid| bytes-output-port-methods) + #f + #f + 2 + 0)) +(define effect_2430 (finish836 struct:bytes-output-port-methods.1)) (define bytes-output-port-methods8.1 (|#%name| bytes-output-port-methods @@ -19179,18 +19179,8 @@ (if (string? str_0) (1/string->bytes/utf-8 str_0 #f start_0 end_0) (subbytes str_0 start_0 end_0))))))))))) -(define struct:max-output-port - (make-record-type-descriptor* - 'max-output-port - struct:core-output-port - (|#%nongenerative-uid| max-output-port) - #f - #f - 2 - 3)) -(define effect_2654 - (struct-type-install-properties! - struct:max-output-port +(define finish852 + (make-struct-type-install-properties '(max-output-port) 2 0 @@ -19201,6 +19191,16 @@ '() #f 'create-max-output-port)) +(define struct:max-output-port + (make-record-type-descriptor* + 'max-output-port + struct:core-output-port + (|#%nongenerative-uid| max-output-port) + #f + #f + 2 + 3)) +(define effect_3019 (finish852 struct:max-output-port)) (define create-max-output-port (|#%name| create-max-output-port @@ -19220,18 +19220,8 @@ (|#%name| set-max-output-port-max-length! (record-mutator struct:max-output-port 1))) -(define struct:max-output-port-methods.1 - (make-record-type-descriptor* - 'max-output-port-methods - struct:core-output-port-methods.1 - (|#%nongenerative-uid| max-output-port-methods) - #f - #f - 0 - 0)) -(define effect_2484 - (struct-type-install-properties! - struct:max-output-port-methods.1 +(define finish855 + (make-struct-type-install-properties '(max-output-port-methods) 0 0 @@ -19242,6 +19232,16 @@ '() #f 'max-output-port-methods)) +(define struct:max-output-port-methods.1 + (make-record-type-descriptor* + 'max-output-port-methods + struct:core-output-port-methods.1 + (|#%nongenerative-uid| max-output-port-methods) + #f + #f + 0 + 0)) +(define effect_2933 (finish855 struct:max-output-port-methods.1)) (define max-output-port-methods1.1 (|#%name| max-output-port-methods @@ -20142,18 +20142,8 @@ (lambda (mode_0) (let ((or-part_0 (eq? mode_0 0))) (if or-part_0 or-part_0 (eq? mode_0 1))))) -(define struct:nowhere-output-port - (make-record-type-descriptor* - 'nowhere-output-port - struct:core-output-port - (|#%nongenerative-uid| nowhere-output-port) - #f - #f - 0 - 0)) -(define effect_2498 - (struct-type-install-properties! - struct:nowhere-output-port +(define finish869 + (make-struct-type-install-properties '(nowhere-output-port) 0 0 @@ -20164,6 +20154,16 @@ '() #f 'create-nowhere-output-port)) +(define struct:nowhere-output-port + (make-record-type-descriptor* + 'nowhere-output-port + struct:core-output-port + (|#%nongenerative-uid| nowhere-output-port) + #f + #f + 0 + 0)) +(define effect_2267 (finish869 struct:nowhere-output-port)) (define create-nowhere-output-port (|#%name| create-nowhere-output-port @@ -20173,18 +20173,8 @@ (|#%name| nowhere-output-port? (record-predicate struct:nowhere-output-port))) -(define struct:nowhere-output-port-methods.1 - (make-record-type-descriptor* - 'nowhere-output-port-methods - struct:core-output-port-methods.1 - (|#%nongenerative-uid| nowhere-output-port-methods) - #f - #f - 0 - 0)) -(define effect_2432 - (struct-type-install-properties! - struct:nowhere-output-port-methods.1 +(define finish872 + (make-struct-type-install-properties '(nowhere-output-port-methods) 0 0 @@ -20195,6 +20185,16 @@ '() #f 'nowhere-output-port-methods)) +(define struct:nowhere-output-port-methods.1 + (make-record-type-descriptor* + 'nowhere-output-port-methods + struct:core-output-port-methods.1 + (|#%nongenerative-uid| nowhere-output-port-methods) + #f + #f + 0 + 0)) +(define effect_2301 (finish872 struct:nowhere-output-port-methods.1)) (define nowhere-output-port-methods1.1 (|#%name| nowhere-output-port-methods @@ -20420,18 +20420,8 @@ #f) fuel_1))))))))))))) (quick-no-graph?_0 v_0 fuel_0)))) -(define struct:as-constructor - (make-record-type-descriptor* - 'as-constructor - #f - (|#%nongenerative-uid| as-constructor) - #f - #f - 1 - 0)) -(define effect_2500 - (struct-type-install-properties! - struct:as-constructor +(define finish889 + (make-struct-type-install-properties '(as-constructor) 1 0 @@ -20442,6 +20432,16 @@ '(0) #f 'as-constructor)) +(define struct:as-constructor + (make-record-type-descriptor* + 'as-constructor + #f + (|#%nongenerative-uid| as-constructor) + #f + #f + 1 + 0)) +(define effect_2645 (finish889 struct:as-constructor)) (define as-constructor1.1 (|#%name| as-constructor @@ -23418,18 +23418,8 @@ (if (letter-drive-start? s_0 (unsafe-bytes-length s_0)) (just-separators-after? s_0 2) #f)))))) -(define struct:starting-point - (make-record-type-descriptor* - 'starting-point - #f - (|#%nongenerative-uid| starting-point) - #f - #f - 7 - 0)) -(define effect_2733 - (struct-type-install-properties! - struct:starting-point +(define finish969 + (make-struct-type-install-properties '(starting-point) 7 0 @@ -23440,6 +23430,16 @@ '(0 1 2 3 4 5 6) #f 'starting-point)) +(define struct:starting-point + (make-record-type-descriptor* + 'starting-point + #f + (|#%nongenerative-uid| starting-point) + #f + #f + 7 + 0)) +(define effect_2521 (finish969 struct:starting-point)) (define starting-point7.1 (|#%name| starting-point @@ -25400,18 +25400,8 @@ (define port-number? (lambda (v_0) (if (fixnum? v_0) (<= 1 v_0 65535) #f))) (define listen-port-number? (lambda (v_0) (if (fixnum? v_0) (<= 0 v_0 65535) #f))) -(define struct:security-guard - (make-record-type-descriptor* - 'security-guard - #f - (|#%nongenerative-uid| security-guard) - #f - #f - 4 - 0)) -(define effect_2725 - (struct-type-install-properties! - struct:security-guard +(define finish1011 + (make-struct-type-install-properties '(security-guard) 4 0 @@ -25422,6 +25412,16 @@ '(0 1 2 3) #f 'security-guard)) +(define struct:security-guard + (make-record-type-descriptor* + 'security-guard + #f + (|#%nongenerative-uid| security-guard) + #f + #f + 4 + 0)) +(define effect_2369 (finish1011 struct:security-guard)) (define security-guard1.1 (|#%name| security-guard @@ -28686,7 +28686,7 @@ ((v_0 o_0 quote-depth34_0) (.../io/port/handler.rkt:145:24_0 v_0 o_0 quote-depth34_0)))))))) 'global-port-print-handler)) -(define effect_2170 +(define effect_2171 (begin (void (install-do-global-print! @@ -29810,7 +29810,7 @@ (current-directory$1)) '() hash2725)))))) -(define effect_2316 +(define effect_2315 (begin (void (begin-unsafe (set! simplify-path/dl 1/simplify-path))) (void))) (define bytes-no-nuls? (lambda (s_0) @@ -29855,18 +29855,8 @@ (bytes->immutable-bytes (1/string->bytes/locale (string-foldcase (1/bytes->string/locale k_0)))) k_0))) -(define struct:environment-variables - (make-record-type-descriptor* - 'environment-variables - #f - (|#%nongenerative-uid| environment-variables) - #f - #f - 1 - 1)) -(define effect_2324 - (struct-type-install-properties! - struct:environment-variables +(define finish1096 + (make-struct-type-install-properties '(environment-variables) 1 0 @@ -29877,6 +29867,16 @@ '() #f 'environment-variables)) +(define struct:environment-variables + (make-record-type-descriptor* + 'environment-variables + #f + (|#%nongenerative-uid| environment-variables) + #f + #f + 1 + 1)) +(define effect_2329 (finish1096 struct:environment-variables)) (define environment-variables1.1 (|#%name| environment-variables @@ -31589,18 +31589,8 @@ #f)))))) (define adjust-path (lambda (p_0) (if (is-path? p_0) (relative-to-user-directory p_0) p_0))) -(define struct:logger - (make-record-type-descriptor* - 'logger - #f - (|#%nongenerative-uid| logger) - #f - #f - 11 - 376)) -(define effect_2502 - (struct-type-install-properties! - struct:logger +(define finish1173 + (make-struct-type-install-properties '(logger) 11 0 @@ -31611,6 +31601,16 @@ '(0 1 2 7 9 10) #f 'logger)) +(define struct:logger + (make-record-type-descriptor* + 'logger + #f + (|#%nongenerative-uid| logger) + #f + #f + 11 + 376)) +(define effect_2687 (finish1173 struct:logger)) (define logger1.1 (|#%name| logger @@ -32060,18 +32060,8 @@ (loop_0 filters_0 'none)))) (define level->user-representation (lambda (lvl_0) (if (eq? lvl_0 'none) #f lvl_0))) -(define struct:queue - (make-record-type-descriptor* - 'queue - #f - (|#%nongenerative-uid| queue) - #f - #f - 2 - 3)) -(define effect_2212 - (struct-type-install-properties! - struct:queue +(define finish1198 + (make-struct-type-install-properties '(queue) 2 0 @@ -32082,6 +32072,16 @@ '() #f 'queue)) +(define struct:queue + (make-record-type-descriptor* + 'queue + #f + (|#%nongenerative-uid| queue) + #f + #f + 2 + 3)) +(define effect_2998 (finish1198 struct:queue)) (define queue1.1 (|#%name| queue @@ -32094,18 +32094,8 @@ (|#%name| set-queue-start! (record-mutator struct:queue 0))) (define set-queue-end! (|#%name| set-queue-end! (record-mutator struct:queue 1))) -(define struct:node - (make-record-type-descriptor* - 'node - #f - (|#%nongenerative-uid| node) - #f - #f - 3 - 6)) -(define effect_2737 - (struct-type-install-properties! - struct:node +(define finish1200 + (make-struct-type-install-properties '(node) 3 0 @@ -32116,6 +32106,16 @@ '(0) #f 'node)) +(define struct:node + (make-record-type-descriptor* + 'node + #f + (|#%nongenerative-uid| node) + #f + #f + 3 + 6)) +(define effect_2547 (finish1200 struct:node)) (define node2.1 (|#%name| node @@ -32158,18 +32158,8 @@ (if (node-next n_0) (let ((app_0 (node-next n_0))) (set-node-prev! app_0 (node-prev n_0))) (set-queue-end! q_0 (node-prev n_0)))))) -(define struct:log-receiver - (make-record-type-descriptor* - 'log-receiver - #f - (|#%nongenerative-uid| log-receiver) - #f - #f - 1 - 0)) -(define effect_2818 - (struct-type-install-properties! - struct:log-receiver +(define finish1205 + (make-struct-type-install-properties '(log-receiver) 1 0 @@ -32180,6 +32170,16 @@ '(0) #f 'log-receiver)) +(define struct:log-receiver + (make-record-type-descriptor* + 'log-receiver + #f + (|#%nongenerative-uid| log-receiver) + #f + #f + 1 + 0)) +(define effect_2969 (finish1205 struct:log-receiver)) (define log-receiver1.1 (|#%name| log-receiver @@ -32216,18 +32216,8 @@ (define-values (prop:receiver-send receiver-send? receiver-send-ref) (make-struct-type-property 'receiver-send)) -(define struct:queue-log-receiver - (make-record-type-descriptor* - 'log-receiver - struct:log-receiver - (|#%nongenerative-uid| log-receiver) - #f - #f - 3 - 0)) -(define effect_2203 - (struct-type-install-properties! - struct:queue-log-receiver +(define finish1209 + (make-struct-type-install-properties '(log-receiver) 3 0 @@ -32292,6 +32282,16 @@ '(0 1 2) #f 'queue-log-receiver)) +(define struct:queue-log-receiver + (make-record-type-descriptor* + 'log-receiver + struct:log-receiver + (|#%nongenerative-uid| log-receiver) + #f + #f + 3 + 0)) +(define effect_2324 (finish1209 struct:queue-log-receiver)) (define queue-log-receiver2.1 (|#%name| queue-log-receiver @@ -32397,18 +32397,8 @@ (begin-unsafe (not (queue-start q_0)))) (set-box! (queue-log-receiver-backref lr_0) lr_0) (void)))) -(define struct:stdio-log-receiver - (make-record-type-descriptor* - 'stdio-log-receiver - struct:log-receiver - (|#%nongenerative-uid| stdio-log-receiver) - #f - #f - 2 - 0)) -(define effect_1964 - (struct-type-install-properties! - struct:stdio-log-receiver +(define finish1221 + (make-struct-type-install-properties '(stdio-log-receiver) 2 0 @@ -32454,6 +32444,16 @@ '(0 1) #f 'stdio-log-receiver)) +(define struct:stdio-log-receiver + (make-record-type-descriptor* + 'stdio-log-receiver + struct:log-receiver + (|#%nongenerative-uid| stdio-log-receiver) + #f + #f + 2 + 0)) +(define effect_2591 (finish1221 struct:stdio-log-receiver)) (define stdio-log-receiver3.1 (|#%name| stdio-log-receiver @@ -32543,18 +32543,8 @@ args_0 'make-stdio-log-receiver 1))) -(define struct:syslog-log-receiver - (make-record-type-descriptor* - 'syslog-log-receiver - struct:log-receiver - (|#%nongenerative-uid| syslog-log-receiver) - #f - #f - 2 - 0)) -(define effect_2057 - (struct-type-install-properties! - struct:syslog-log-receiver +(define finish1226 + (make-struct-type-install-properties '(syslog-log-receiver) 2 0 @@ -32589,6 +32579,16 @@ '(0 1) #f 'syslog-log-receiver)) +(define struct:syslog-log-receiver + (make-record-type-descriptor* + 'syslog-log-receiver + struct:log-receiver + (|#%nongenerative-uid| syslog-log-receiver) + #f + #f + 2 + 0)) +(define effect_2288 (finish1226 struct:syslog-log-receiver)) (define syslog-log-receiver4.1 (|#%name| syslog-log-receiver @@ -33509,18 +33509,8 @@ (void))))))))) (loop_0 logger_0)) (void))))) -(define struct:fs-change-evt - (make-record-type-descriptor* - 'filesystem-change-evt - #f - (|#%nongenerative-uid| filesystem-change-evt) - #f - #f - 2 - 3)) -(define effect_2420 - (struct-type-install-properties! - struct:fs-change-evt +(define finish1268 + (make-struct-type-install-properties '(filesystem-change-evt) 2 0 @@ -33556,6 +33546,16 @@ '() #f 'fs-change-evt)) +(define struct:fs-change-evt + (make-record-type-descriptor* + 'filesystem-change-evt + #f + (|#%nongenerative-uid| filesystem-change-evt) + #f + #f + 2 + 3)) +(define effect_3368 (finish1268 struct:fs-change-evt)) (define fs-change-evt1.1 (|#%name| fs-change-evt @@ -34011,18 +34011,8 @@ (loop_0 start_0))))) (let ((bstr_0 (make-bytes sz_0))) (begin (|#%app| final_0 p_0 bstr_0) bstr_0)))))))))) -(define struct:subprocess - (make-record-type-descriptor* - 'subprocess - #f - (|#%nongenerative-uid| subprocess) - #f - #f - 3 - 3)) -(define effect_2643 - (struct-type-install-properties! - struct:subprocess +(define finish1280 + (make-struct-type-install-properties '(subprocess) 3 0 @@ -34055,6 +34045,16 @@ '(2) #f 'make-subprocess)) +(define struct:subprocess + (make-record-type-descriptor* + 'subprocess + #f + (|#%nongenerative-uid| subprocess) + #f + #f + 3 + 3)) +(define effect_2289 (finish1280 struct:subprocess)) (define make-subprocess (|#%name| make-subprocess @@ -34200,11 +34200,11 @@ 'subprocess "(or/c (and/c output-port? file-stream-port?) #f 'stdout)" stderr_0)) - (let ((lr1228 unsafe-undefined) + (let ((lr1287 unsafe-undefined) (group_0 unsafe-undefined) (command_0 unsafe-undefined) (exact/args_0 unsafe-undefined)) - (set! lr1228 + (set! lr1287 (call-with-values (lambda () (if (path-string? group/command_0) @@ -34259,9 +34259,9 @@ ((group_1 command_1 exact/args_1) (vector group_1 command_1 exact/args_1)) (args (raise-binding-result-arity-error 3 args))))) - (set! group_0 (unsafe-vector*-ref lr1228 0)) - (set! command_0 (unsafe-vector*-ref lr1228 1)) - (set! exact/args_0 (unsafe-vector*-ref lr1228 2)) + (set! group_0 (unsafe-vector*-ref lr1287 0)) + (set! command_0 (unsafe-vector*-ref lr1287 1)) + (set! exact/args_0 (unsafe-vector*-ref lr1287 2)) (call-with-values (lambda () (if (if (pair? exact/args_0) @@ -34888,18 +34888,8 @@ (define raise-network-option-error (lambda (who_0 mode_0 v_0) (raise-network-error who_0 v_0 (string-append mode_0 "sockopt failed")))) -(define struct:tcp-input-port - (make-record-type-descriptor* - 'tcp-input-port - struct:fd-input-port - (|#%nongenerative-uid| tcp-input-port) - #f - #f - 1 - 1)) -(define effect_2557 - (struct-type-install-properties! - struct:tcp-input-port +(define finish1319 + (make-struct-type-install-properties '(tcp-input-port) 1 0 @@ -34916,6 +34906,16 @@ '() #f 'create-tcp-input-port)) +(define struct:tcp-input-port + (make-record-type-descriptor* + 'tcp-input-port + struct:fd-input-port + (|#%nongenerative-uid| tcp-input-port) + #f + #f + 1 + 1)) +(define effect_2486 (finish1319 struct:tcp-input-port)) (define create-tcp-input-port (|#%name| create-tcp-input-port @@ -34929,18 +34929,8 @@ (|#%name| set-tcp-input-port-abandon?! (record-mutator struct:tcp-input-port 0))) -(define struct:tcp-input-port-methods.1 - (make-record-type-descriptor* - 'tcp-input-port-methods - struct:fd-input-port-methods.1 - (|#%nongenerative-uid| tcp-input-port-methods) - #f - #f - 0 - 0)) -(define effect_2306 - (struct-type-install-properties! - struct:tcp-input-port-methods.1 +(define finish1322 + (make-struct-type-install-properties '(tcp-input-port-methods) 0 0 @@ -34951,6 +34941,16 @@ '() #f 'tcp-input-port-methods)) +(define struct:tcp-input-port-methods.1 + (make-record-type-descriptor* + 'tcp-input-port-methods + struct:fd-input-port-methods.1 + (|#%nongenerative-uid| tcp-input-port-methods) + #f + #f + 0 + 0)) +(define effect_2506 (finish1322 struct:tcp-input-port-methods.1)) (define tcp-input-port-methods1.1 (|#%name| tcp-input-port-methods @@ -35065,18 +35065,8 @@ #f #f))) (finish-fd-input-port.1 unsafe-undefined temp80_0)))))))) -(define struct:tcp-output-port - (make-record-type-descriptor* - 'tcp-output-port - struct:fd-output-port - (|#%nongenerative-uid| tcp-output-port) - #f - #f - 1 - 1)) -(define effect_2686 - (struct-type-install-properties! - struct:tcp-output-port +(define finish1336 + (make-struct-type-install-properties '(tcp-output-port) 1 0 @@ -35093,6 +35083,16 @@ '() #f 'create-tcp-output-port)) +(define struct:tcp-output-port + (make-record-type-descriptor* + 'tcp-output-port + struct:fd-output-port + (|#%nongenerative-uid| tcp-output-port) + #f + #f + 1 + 1)) +(define effect_2179 (finish1336 struct:tcp-output-port)) (define create-tcp-output-port (|#%name| create-tcp-output-port @@ -35108,18 +35108,8 @@ (|#%name| set-tcp-output-port-abandon?! (record-mutator struct:tcp-output-port 0))) -(define struct:tcp-output-port-methods.1 - (make-record-type-descriptor* - 'tcp-output-port-methods - struct:fd-output-port-methods.1 - (|#%nongenerative-uid| tcp-output-port-methods) - #f - #f - 0 - 0)) -(define effect_2463 - (struct-type-install-properties! - struct:tcp-output-port-methods.1 +(define finish1339 + (make-struct-type-install-properties '(tcp-output-port-methods) 0 0 @@ -35130,6 +35120,16 @@ '() #f 'tcp-output-port-methods)) +(define struct:tcp-output-port-methods.1 + (make-record-type-descriptor* + 'tcp-output-port-methods + struct:fd-output-port-methods.1 + (|#%nongenerative-uid| tcp-output-port-methods) + #f + #f + 0 + 0)) +(define effect_2820 (finish1339 struct:tcp-output-port-methods.1)) (define tcp-output-port-methods7.1 (|#%name| tcp-output-port-methods @@ -35265,18 +35265,8 @@ (if (tcp-output-port? cp_0) (begin (set-tcp-output-port-abandon?! cp_0 #t) (close-port p_0)) (void)))))))) -(define struct:rktio-evt - (make-record-type-descriptor* - 'rktio-evt - #f - (|#%nongenerative-uid| rktio-evt) - #f - #f - 2 - 0)) -(define effect_2460 - (struct-type-install-properties! - struct:rktio-evt +(define finish1351 + (make-struct-type-install-properties '(rktio-evt) 2 0 @@ -35301,6 +35291,16 @@ '(0 1) #f 'rktio-evt)) +(define struct:rktio-evt + (make-record-type-descriptor* + 'rktio-evt + #f + (|#%nongenerative-uid| rktio-evt) + #f + #f + 2 + 0)) +(define effect_1868 (finish1351 struct:rktio-evt)) (define rktio-evt1.1 (|#%name| rktio-evt @@ -35456,18 +35456,8 @@ (void)))) (define address-init! (lambda () (unsafe-place-local-set! cell.1$3 (make-will-executor)))) -(define struct:connect-progress - (make-record-type-descriptor* - 'connect-progress - #f - (|#%nongenerative-uid| connect-progress) - #f - #f - 2 - 3)) -(define effect_2123 - (struct-type-install-properties! - struct:connect-progress +(define finish1357 + (make-struct-type-install-properties '(connect-progress) 2 0 @@ -35478,6 +35468,16 @@ '() #f 'connect-progress)) +(define struct:connect-progress + (make-record-type-descriptor* + 'connect-progress + #f + (|#%nongenerative-uid| connect-progress) + #f + #f + 2 + 3)) +(define effect_2319 (finish1357 struct:connect-progress)) (define connect-progress1.1 (|#%name| connect-progress @@ -35829,18 +35829,8 @@ (fd-semaphore-update! fd_0 'remove) (set-connect-progress-trying-fd! conn-prog_0 #f)) (void))))) -(define struct:tcp-listener - (make-record-type-descriptor* - 'tcp-listener - #f - (|#%nongenerative-uid| tcp-listener) - #f - #f - 3 - 0)) -(define effect_2228 - (struct-type-install-properties! - struct:tcp-listener +(define finish1362 + (make-struct-type-install-properties '(tcp-listener) 3 0 @@ -35854,6 +35844,16 @@ '(0 1 2) #f 'tcp-listener)) +(define struct:tcp-listener + (make-record-type-descriptor* + 'tcp-listener + #f + (|#%nongenerative-uid| tcp-listener) + #f + #f + 3 + 0)) +(define effect_2347 (finish1362 struct:tcp-listener)) (define tcp-listener1.1 (|#%name| tcp-listener @@ -36209,18 +36209,8 @@ (void) (raise-argument-error 'tcp-accept-evt "tcp-listener?" listener_0)) (accept-evt6.1 listener_0)))))) -(define struct:accept-evt - (make-record-type-descriptor* - 'tcp-accept-evt - #f - (|#%nongenerative-uid| tcp-accept-evt) - #f - #f - 1 - 0)) -(define effect_2314 - (struct-type-install-properties! - struct:accept-evt +(define finish1372 + (make-struct-type-install-properties '(tcp-accept-evt) 1 0 @@ -36298,6 +36288,16 @@ '(0) #f 'accept-evt)) +(define struct:accept-evt + (make-record-type-descriptor* + 'tcp-accept-evt + #f + (|#%nongenerative-uid| tcp-accept-evt) + #f + #f + 1 + 0)) +(define effect_2608 (finish1372 struct:accept-evt)) (define accept-evt6.1 (|#%name| accept-evt @@ -36380,11 +36380,8 @@ v_0)))))) (for-loop_0 0 0)))) (args (raise-binding-result-arity-error 2 args)))))) -(define struct:udp - (make-record-type-descriptor* 'udp #f (|#%nongenerative-uid| udp) #f #f 3 7)) -(define effect_2285 - (struct-type-install-properties! - struct:udp +(define finish1377 + (make-struct-type-install-properties '(udp) 3 0 @@ -36395,6 +36392,9 @@ '() #f 'udp)) +(define struct:udp + (make-record-type-descriptor* 'udp #f (|#%nongenerative-uid| udp) #f #f 3 7)) +(define effect_2743 (finish1377 struct:udp)) (define udp1.1 (|#%name| udp @@ -37538,18 +37538,8 @@ who59_0 u60_0))))))) (loop_0))))))) -(define struct:udp-sending-evt - (make-record-type-descriptor* - 'udp-send-evt - #f - (|#%nongenerative-uid| udp-send-evt) - #f - #f - 2 - 0)) -(define effect_2811 - (struct-type-install-properties! - struct:udp-sending-evt +(define finish1393 + (make-struct-type-install-properties '(udp-send-evt) 2 0 @@ -37584,6 +37574,16 @@ '(0 1) #f 'udp-sending-evt)) +(define struct:udp-sending-evt + (make-record-type-descriptor* + 'udp-send-evt + #f + (|#%nongenerative-uid| udp-send-evt) + #f + #f + 2 + 0)) +(define effect_2114 (finish1393 struct:udp-sending-evt)) (define udp-sending-evt66.1 (|#%name| udp-sending-evt @@ -37595,18 +37595,8 @@ (|#%name| udp-send-evt-u (record-accessor struct:udp-sending-evt 0))) (define udp-sending-evt-try (|#%name| udp-send-evt-try (record-accessor struct:udp-sending-evt 1))) -(define struct:udp-sending-ready-evt - (make-record-type-descriptor* - 'udp-send-ready-evt - struct:rktio-evt - (|#%nongenerative-uid| udp-send-ready-evt) - #f - #f - 0 - 0)) -(define effect_2766 - (struct-type-install-properties! - struct:udp-sending-ready-evt +(define finish1396 + (make-struct-type-install-properties '(udp-send-ready-evt) 0 0 @@ -37617,6 +37607,16 @@ '() #f 'udp-sending-ready-evt)) +(define struct:udp-sending-ready-evt + (make-record-type-descriptor* + 'udp-send-ready-evt + struct:rktio-evt + (|#%nongenerative-uid| udp-send-ready-evt) + #f + #f + 0 + 0)) +(define effect_2524 (finish1396 struct:udp-sending-ready-evt)) (define udp-sending-ready-evt67.1 (|#%name| udp-sending-ready-evt @@ -37927,18 +37927,8 @@ (loop_0))))))) (define cell.1$2 (unsafe-make-place-local #vu8())) (define cell.2 (unsafe-make-place-local "")) -(define struct:udp-receiving-evt - (make-record-type-descriptor* - 'udp-receive-evt - #f - (|#%nongenerative-uid| udp-receive-evt) - #f - #f - 2 - 0)) -(define effect_3133 - (struct-type-install-properties! - struct:udp-receiving-evt +(define finish1400 + (make-struct-type-install-properties '(udp-receive-evt) 2 0 @@ -37978,6 +37968,16 @@ '(0 1) #f 'udp-receiving-evt)) +(define struct:udp-receiving-evt + (make-record-type-descriptor* + 'udp-receive-evt + #f + (|#%nongenerative-uid| udp-receive-evt) + #f + #f + 2 + 0)) +(define effect_2638 (finish1400 struct:udp-receiving-evt)) (define udp-receiving-evt39.1 (|#%name| udp-receiving-evt @@ -37989,18 +37989,8 @@ (|#%name| udp-receive-evt-u (record-accessor struct:udp-receiving-evt 0))) (define udp-receiving-evt-try (|#%name| udp-receive-evt-try (record-accessor struct:udp-receiving-evt 1))) -(define struct:udp-receiving-ready-evt - (make-record-type-descriptor* - 'udp-receive-ready-evt - struct:rktio-evt - (|#%nongenerative-uid| udp-receive-ready-evt) - #f - #f - 0 - 0)) -(define effect_2191 - (struct-type-install-properties! - struct:udp-receiving-ready-evt +(define finish1403 + (make-struct-type-install-properties '(udp-receive-ready-evt) 0 0 @@ -38011,6 +38001,16 @@ '() #f 'udp-receiving-ready-evt)) +(define struct:udp-receiving-ready-evt + (make-record-type-descriptor* + 'udp-receive-ready-evt + struct:rktio-evt + (|#%nongenerative-uid| udp-receive-ready-evt) + #f + #f + 0 + 0)) +(define effect_2865 (finish1403 struct:udp-receiving-ready-evt)) (define udp-receiving-ready-evt40.1 (|#%name| udp-receiving-ready-evt diff --git a/racket/src/cs/schemified/known.scm b/racket/src/cs/schemified/known.scm index 48642b6850..5cfa93a0ac 100644 --- a/racket/src/cs/schemified/known.scm +++ b/racket/src/cs/schemified/known.scm @@ -134,18 +134,8 @@ (lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 1))) (lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 2)))))))) (define empty-stream (make-do-stream (lambda () #t) void void)) -(define struct:known-constant - (make-record-type-descriptor* - 'known-constant - #f - (structure-type-lookup-prefab-uid 'known-constant #f 0 0 #f '()) - #f - #f - 0 - 0)) -(define effect_2175 - (struct-type-install-properties! - struct:known-constant +(define finish7 + (make-struct-type-install-properties '(known-constant) 0 0 @@ -156,6 +146,16 @@ '() #f 'known-constant)) +(define struct:known-constant + (make-record-type-descriptor* + 'known-constant + #f + (structure-type-lookup-prefab-uid 'known-constant #f 0 0 #f '()) + #f + #f + 0 + 0)) +(define effect_2537 (finish7 struct:known-constant)) (define known-constant (|#%name| known-constant @@ -173,6 +173,20 @@ (if (impersonator? v) (known-constant?_2598 (impersonator-val v)) #f)))))) +(define finish10 + (make-struct-type-install-properties + '(known-consistent) + 0 + 0 + (if (struct-type? struct:known-constant) + struct:known-constant + (check-struct-type 'struct struct:known-constant)) + null + 'prefab + #f + '() + #f + 'known-consistent)) (define struct:known-consistent (make-record-type-descriptor* 'known-consistent @@ -192,21 +206,7 @@ #f 0 0)) -(define effect_2225 - (struct-type-install-properties! - struct:known-consistent - '(known-consistent) - 0 - 0 - (if (struct-type? struct:known-constant) - struct:known-constant - (check-struct-type 'struct struct:known-constant)) - null - 'prefab - #f - '() - #f - 'known-consistent)) +(define effect_2382 (finish10 struct:known-consistent)) (define known-consistent (|#%name| known-consistent @@ -224,6 +224,20 @@ (if (impersonator? v) (known-consistent?_3048 (impersonator-val v)) #f)))))) +(define finish13 + (make-struct-type-install-properties + '(known-authentic) + 0 + 0 + (if (struct-type? struct:known-constant) + struct:known-constant + (check-struct-type 'struct struct:known-constant)) + null + 'prefab + #f + '() + #f + 'known-authentic)) (define struct:known-authentic (make-record-type-descriptor* 'known-authentic @@ -243,21 +257,7 @@ #f 0 0)) -(define effect_3179 - (struct-type-install-properties! - struct:known-authentic - '(known-authentic) - 0 - 0 - (if (struct-type? struct:known-constant) - struct:known-constant - (check-struct-type 'struct struct:known-constant)) - null - 'prefab - #f - '() - #f - 'known-authentic)) +(define effect_2570 (finish13 struct:known-authentic)) (define known-authentic (|#%name| known-authentic @@ -275,6 +275,20 @@ (if (impersonator? v) (known-authentic?_3119 (impersonator-val v)) #f)))))) +(define finish16 + (make-struct-type-install-properties + '(known-copy) + 1 + 0 + (if (struct-type? struct:known-constant) + struct:known-constant + (check-struct-type 'struct struct:known-constant)) + null + 'prefab + #f + '(0) + #f + 'known-copy)) (define struct:known-copy (make-record-type-descriptor* 'known-copy @@ -294,21 +308,7 @@ #f 1 1)) -(define effect_1974 - (struct-type-install-properties! - struct:known-copy - '(known-copy) - 1 - 0 - (if (struct-type? struct:known-constant) - struct:known-constant - (check-struct-type 'struct struct:known-constant)) - null - 'prefab - #f - '(0) - #f - 'known-copy)) +(define effect_2542 (finish16 struct:known-copy)) (define known-copy (|#%name| known-copy @@ -340,6 +340,20 @@ s 'known-copy 'id)))))) +(define finish20 + (make-struct-type-install-properties + '(known-literal) + 1 + 0 + (if (struct-type? struct:known-consistent) + struct:known-consistent + (check-struct-type 'struct struct:known-consistent)) + null + 'prefab + #f + '(0) + #f + 'known-literal)) (define struct:known-literal (make-record-type-descriptor* 'known-literal @@ -359,21 +373,7 @@ #f 1 1)) -(define effect_2741 - (struct-type-install-properties! - struct:known-literal - '(known-literal) - 1 - 0 - (if (struct-type? struct:known-consistent) - struct:known-consistent - (check-struct-type 'struct struct:known-consistent)) - null - 'prefab - #f - '(0) - #f - 'known-literal)) +(define effect_2788 (finish20 struct:known-literal)) (define known-literal (|#%name| known-literal @@ -407,6 +407,20 @@ s 'known-literal 'value)))))) +(define finish24 + (make-struct-type-install-properties + '(known-procedure) + 1 + 0 + (if (struct-type? struct:known-consistent) + struct:known-consistent + (check-struct-type 'struct struct:known-consistent)) + null + 'prefab + #f + '(0) + #f + 'known-procedure)) (define struct:known-procedure (make-record-type-descriptor* 'known-procedure @@ -426,21 +440,7 @@ #f 1 1)) -(define effect_1867 - (struct-type-install-properties! - struct:known-procedure - '(known-procedure) - 1 - 0 - (if (struct-type? struct:known-consistent) - struct:known-consistent - (check-struct-type 'struct struct:known-consistent)) - null - 'prefab - #f - '(0) - #f - 'known-procedure)) +(define effect_2677 (finish24 struct:known-procedure)) (define known-procedure (|#%name| known-procedure @@ -476,6 +476,20 @@ s 'known-procedure 'arity-mask)))))) +(define finish28 + (make-struct-type-install-properties + '(known-procedure/single-valued) + 0 + 0 + (if (struct-type? struct:known-procedure) + struct:known-procedure + (check-struct-type 'struct struct:known-procedure)) + null + 'prefab + #f + '() + #f + 'known-procedure/single-valued)) (define struct:known-procedure/single-valued (make-record-type-descriptor* 'known-procedure/single-valued @@ -495,21 +509,7 @@ #f 0 0)) -(define effect_2708 - (struct-type-install-properties! - struct:known-procedure/single-valued - '(known-procedure/single-valued) - 0 - 0 - (if (struct-type? struct:known-procedure) - struct:known-procedure - (check-struct-type 'struct struct:known-procedure)) - null - 'prefab - #f - '() - #f - 'known-procedure/single-valued)) +(define effect_2532 (finish28 struct:known-procedure/single-valued)) (define known-procedure/single-valued (|#%name| known-procedure/single-valued @@ -532,6 +532,20 @@ (if (impersonator? v) (known-procedure/single-valued?_3105 (impersonator-val v)) #f)))))) +(define finish31 + (make-struct-type-install-properties + '(known-procedure/no-prompt) + 0 + 0 + (if (struct-type? struct:known-procedure/single-valued) + struct:known-procedure/single-valued + (check-struct-type 'struct struct:known-procedure/single-valued)) + null + 'prefab + #f + '() + #f + 'known-procedure/no-prompt)) (define struct:known-procedure/no-prompt (make-record-type-descriptor* 'known-procedure/no-prompt @@ -551,21 +565,7 @@ #f 0 0)) -(define effect_2348 - (struct-type-install-properties! - struct:known-procedure/no-prompt - '(known-procedure/no-prompt) - 0 - 0 - (if (struct-type? struct:known-procedure/single-valued) - struct:known-procedure/single-valued - (check-struct-type 'struct struct:known-procedure/single-valued)) - null - 'prefab - #f - '() - #f - 'known-procedure/no-prompt)) +(define effect_1771 (finish31 struct:known-procedure/no-prompt)) (define known-procedure/no-prompt (|#%name| known-procedure/no-prompt @@ -588,6 +588,20 @@ (if (impersonator? v) (known-procedure/no-prompt?_2036 (impersonator-val v)) #f)))))) +(define finish34 + (make-struct-type-install-properties + '(known-procedure/no-prompt/multi) + 0 + 0 + (if (struct-type? struct:known-procedure) + struct:known-procedure + (check-struct-type 'struct struct:known-procedure)) + null + 'prefab + #f + '() + #f + 'known-procedure/no-prompt/multi)) (define struct:known-procedure/no-prompt/multi (make-record-type-descriptor* 'known-procedure/no-prompt/multi @@ -607,21 +621,7 @@ #f 0 0)) -(define effect_2331 - (struct-type-install-properties! - struct:known-procedure/no-prompt/multi - '(known-procedure/no-prompt/multi) - 0 - 0 - (if (struct-type? struct:known-procedure) - struct:known-procedure - (check-struct-type 'struct struct:known-procedure)) - null - 'prefab - #f - '() - #f - 'known-procedure/no-prompt/multi)) +(define effect_2793 (finish34 struct:known-procedure/no-prompt/multi)) (define known-procedure/no-prompt/multi (|#%name| known-procedure/no-prompt/multi @@ -644,6 +644,20 @@ (if (impersonator? v) (known-procedure/no-prompt/multi?_2394 (impersonator-val v)) #f)))))) +(define finish37 + (make-struct-type-install-properties + '(known-procedure/no-return) + 0 + 0 + (if (struct-type? struct:known-procedure/single-valued) + struct:known-procedure/single-valued + (check-struct-type 'struct struct:known-procedure/single-valued)) + null + 'prefab + #f + '() + #f + 'known-procedure/no-return)) (define struct:known-procedure/no-return (make-record-type-descriptor* 'known-procedure/no-return @@ -663,21 +677,7 @@ #f 0 0)) -(define effect_2377 - (struct-type-install-properties! - struct:known-procedure/no-return - '(known-procedure/no-return) - 0 - 0 - (if (struct-type? struct:known-procedure/single-valued) - struct:known-procedure/single-valued - (check-struct-type 'struct struct:known-procedure/single-valued)) - null - 'prefab - #f - '() - #f - 'known-procedure/no-return)) +(define effect_2517 (finish37 struct:known-procedure/no-return)) (define known-procedure/no-return (|#%name| known-procedure/no-return @@ -700,6 +700,20 @@ (if (impersonator? v) (known-procedure/no-return?_1763 (impersonator-val v)) #f)))))) +(define finish40 + (make-struct-type-install-properties + '(known-procedure/can-inline) + 1 + 0 + (if (struct-type? struct:known-procedure) + struct:known-procedure + (check-struct-type 'struct struct:known-procedure)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/can-inline)) (define struct:known-procedure/can-inline (make-record-type-descriptor* 'known-procedure/can-inline @@ -719,21 +733,7 @@ #f 1 1)) -(define effect_2149 - (struct-type-install-properties! - struct:known-procedure/can-inline - '(known-procedure/can-inline) - 1 - 0 - (if (struct-type? struct:known-procedure) - struct:known-procedure - (check-struct-type 'struct struct:known-procedure)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/can-inline)) +(define effect_2308 (finish40 struct:known-procedure/can-inline)) (define known-procedure/can-inline (|#%name| known-procedure/can-inline @@ -774,6 +774,20 @@ s 'known-procedure/can-inline 'expr)))))) +(define finish44 + (make-struct-type-install-properties + '(known-procedure/can-inline/need-imports) + 1 + 0 + (if (struct-type? struct:known-procedure/can-inline) + struct:known-procedure/can-inline + (check-struct-type 'struct struct:known-procedure/can-inline)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/can-inline/need-imports)) (define struct:known-procedure/can-inline/need-imports (make-record-type-descriptor* 'known-procedure/can-inline/need-imports @@ -793,21 +807,7 @@ #f 1 1)) -(define effect_2717 - (struct-type-install-properties! - struct:known-procedure/can-inline/need-imports - '(known-procedure/can-inline/need-imports) - 1 - 0 - (if (struct-type? struct:known-procedure/can-inline) - struct:known-procedure/can-inline - (check-struct-type 'struct struct:known-procedure/can-inline)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/can-inline/need-imports)) +(define effect_2618 (finish44 struct:known-procedure/can-inline/need-imports)) (define known-procedure/can-inline/need-imports (|#%name| known-procedure/can-inline/need-imports @@ -848,6 +848,20 @@ s 'known-procedure/can-inline/need-imports 'needed)))))) +(define finish48 + (make-struct-type-install-properties + '(known-procedure/folding) + 0 + 0 + (if (struct-type? struct:known-procedure/no-prompt) + struct:known-procedure/no-prompt + (check-struct-type 'struct struct:known-procedure/no-prompt)) + null + 'prefab + #f + '() + #f + 'known-procedure/folding)) (define struct:known-procedure/folding (make-record-type-descriptor* 'known-procedure/folding @@ -867,21 +881,7 @@ #f 0 0)) -(define effect_2516 - (struct-type-install-properties! - struct:known-procedure/folding - '(known-procedure/folding) - 0 - 0 - (if (struct-type? struct:known-procedure/no-prompt) - struct:known-procedure/no-prompt - (check-struct-type 'struct struct:known-procedure/no-prompt)) - null - 'prefab - #f - '() - #f - 'known-procedure/folding)) +(define effect_2478 (finish48 struct:known-procedure/folding)) (define known-procedure/folding (|#%name| known-procedure/folding @@ -904,6 +904,20 @@ (if (impersonator? v) (known-procedure/folding?_2882 (impersonator-val v)) #f)))))) +(define finish51 + (make-struct-type-install-properties + '(known-procedure/folding/limited) + 1 + 0 + (if (struct-type? struct:known-procedure/folding) + struct:known-procedure/folding + (check-struct-type 'struct struct:known-procedure/folding)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/folding/limited)) (define struct:known-procedure/folding/limited (make-record-type-descriptor* 'known-procedure/folding/limited @@ -923,21 +937,7 @@ #f 1 1)) -(define effect_2551 - (struct-type-install-properties! - struct:known-procedure/folding/limited - '(known-procedure/folding/limited) - 1 - 0 - (if (struct-type? struct:known-procedure/folding) - struct:known-procedure/folding - (check-struct-type 'struct struct:known-procedure/folding)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/folding/limited)) +(define effect_2518 (finish51 struct:known-procedure/folding/limited)) (define known-procedure/folding/limited (|#%name| known-procedure/folding/limited @@ -978,6 +978,20 @@ s 'known-procedure/folding/limited 'kind)))))) +(define finish55 + (make-struct-type-install-properties + '(known-procedure/succeeds) + 0 + 0 + (if (struct-type? struct:known-procedure/no-prompt) + struct:known-procedure/no-prompt + (check-struct-type 'struct struct:known-procedure/no-prompt)) + null + 'prefab + #f + '() + #f + 'known-procedure/succeeds)) (define struct:known-procedure/succeeds (make-record-type-descriptor* 'known-procedure/succeeds @@ -997,21 +1011,7 @@ #f 0 0)) -(define effect_2332 - (struct-type-install-properties! - struct:known-procedure/succeeds - '(known-procedure/succeeds) - 0 - 0 - (if (struct-type? struct:known-procedure/no-prompt) - struct:known-procedure/no-prompt - (check-struct-type 'struct struct:known-procedure/no-prompt)) - null - 'prefab - #f - '() - #f - 'known-procedure/succeeds)) +(define effect_2467 (finish55 struct:known-procedure/succeeds)) (define known-procedure/succeeds (|#%name| known-procedure/succeeds @@ -1034,6 +1034,20 @@ (if (impersonator? v) (known-procedure/succeeds?_3041 (impersonator-val v)) #f)))))) +(define finish58 + (make-struct-type-install-properties + '(known-procedure/allocates) + 0 + 0 + (if (struct-type? struct:known-procedure/succeeds) + struct:known-procedure/succeeds + (check-struct-type 'struct struct:known-procedure/succeeds)) + null + 'prefab + #f + '() + #f + 'known-procedure/allocates)) (define struct:known-procedure/allocates (make-record-type-descriptor* 'known-procedure/allocates @@ -1053,21 +1067,7 @@ #f 0 0)) -(define effect_2307 - (struct-type-install-properties! - struct:known-procedure/allocates - '(known-procedure/allocates) - 0 - 0 - (if (struct-type? struct:known-procedure/succeeds) - struct:known-procedure/succeeds - (check-struct-type 'struct struct:known-procedure/succeeds)) - null - 'prefab - #f - '() - #f - 'known-procedure/allocates)) +(define effect_2336 (finish58 struct:known-procedure/allocates)) (define known-procedure/allocates (|#%name| known-procedure/allocates @@ -1090,6 +1090,20 @@ (if (impersonator? v) (known-procedure/allocates?_2244 (impersonator-val v)) #f)))))) +(define finish61 + (make-struct-type-install-properties + '(known-procedure/pure) + 0 + 0 + (if (struct-type? struct:known-procedure/allocates) + struct:known-procedure/allocates + (check-struct-type 'struct struct:known-procedure/allocates)) + null + 'prefab + #f + '() + #f + 'known-procedure/pure)) (define struct:known-procedure/pure (make-record-type-descriptor* 'known-procedure/pure @@ -1109,21 +1123,7 @@ #f 0 0)) -(define effect_2394 - (struct-type-install-properties! - struct:known-procedure/pure - '(known-procedure/pure) - 0 - 0 - (if (struct-type? struct:known-procedure/allocates) - struct:known-procedure/allocates - (check-struct-type 'struct struct:known-procedure/allocates)) - null - 'prefab - #f - '() - #f - 'known-procedure/pure)) +(define effect_3058 (finish61 struct:known-procedure/pure)) (define known-procedure/pure (|#%name| known-procedure/pure @@ -1143,6 +1143,20 @@ (if (impersonator? v) (known-procedure/pure?_2240 (impersonator-val v)) #f)))))) +(define finish64 + (make-struct-type-install-properties + '(known-procedure/pure/folding) + 0 + 0 + (if (struct-type? struct:known-procedure/pure) + struct:known-procedure/pure + (check-struct-type 'struct struct:known-procedure/pure)) + null + 'prefab + #f + '() + #f + 'known-procedure/pure/folding)) (define struct:known-procedure/pure/folding (make-record-type-descriptor* 'known-procedure/pure/folding @@ -1162,21 +1176,7 @@ #f 0 0)) -(define effect_2781 - (struct-type-install-properties! - struct:known-procedure/pure/folding - '(known-procedure/pure/folding) - 0 - 0 - (if (struct-type? struct:known-procedure/pure) - struct:known-procedure/pure - (check-struct-type 'struct struct:known-procedure/pure)) - null - 'prefab - #f - '() - #f - 'known-procedure/pure/folding)) +(define effect_2264 (finish64 struct:known-procedure/pure/folding)) (define known-procedure/pure/folding (|#%name| known-procedure/pure/folding @@ -1199,6 +1199,20 @@ (if (impersonator? v) (known-procedure/pure/folding?_2719 (impersonator-val v)) #f)))))) +(define finish67 + (make-struct-type-install-properties + '(known-procedure/pure/folding-unsafe) + 1 + 0 + (if (struct-type? struct:known-procedure/pure/folding) + struct:known-procedure/pure/folding + (check-struct-type 'struct struct:known-procedure/pure/folding)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/pure/folding-unsafe)) (define struct:known-procedure/pure/folding-unsafe (make-record-type-descriptor* 'known-procedure/pure/folding-unsafe @@ -1218,21 +1232,7 @@ #f 1 1)) -(define effect_2709 - (struct-type-install-properties! - struct:known-procedure/pure/folding-unsafe - '(known-procedure/pure/folding-unsafe) - 1 - 0 - (if (struct-type? struct:known-procedure/pure/folding) - struct:known-procedure/pure/folding - (check-struct-type 'struct struct:known-procedure/pure/folding)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/pure/folding-unsafe)) +(define effect_2657 (finish67 struct:known-procedure/pure/folding-unsafe)) (define known-procedure/pure/folding-unsafe (|#%name| known-procedure/pure/folding-unsafe @@ -1273,6 +1273,20 @@ s 'known-procedure/pure/folding-unsafe 'safe)))))) +(define finish71 + (make-struct-type-install-properties + '(known-procedure/has-unsafe) + 1 + 0 + (if (struct-type? struct:known-procedure/no-prompt) + struct:known-procedure/no-prompt + (check-struct-type 'struct struct:known-procedure/no-prompt)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/has-unsafe)) (define struct:known-procedure/has-unsafe (make-record-type-descriptor* 'known-procedure/has-unsafe @@ -1292,21 +1306,7 @@ #f 1 1)) -(define effect_2998 - (struct-type-install-properties! - struct:known-procedure/has-unsafe - '(known-procedure/has-unsafe) - 1 - 0 - (if (struct-type? struct:known-procedure/no-prompt) - struct:known-procedure/no-prompt - (check-struct-type 'struct struct:known-procedure/no-prompt)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/has-unsafe)) +(define effect_1752 (finish71 struct:known-procedure/has-unsafe)) (define known-procedure/has-unsafe (|#%name| known-procedure/has-unsafe @@ -1347,6 +1347,20 @@ s 'known-procedure/has-unsafe 'alternate)))))) +(define finish75 + (make-struct-type-install-properties + '(known-procedure/has-unsafe/folding) + 0 + 0 + (if (struct-type? struct:known-procedure/has-unsafe) + struct:known-procedure/has-unsafe + (check-struct-type 'struct struct:known-procedure/has-unsafe)) + null + 'prefab + #f + '() + #f + 'known-procedure/has-unsafe/folding)) (define struct:known-procedure/has-unsafe/folding (make-record-type-descriptor* 'known-procedure/has-unsafe/folding @@ -1366,21 +1380,7 @@ #f 0 0)) -(define effect_2584 - (struct-type-install-properties! - struct:known-procedure/has-unsafe/folding - '(known-procedure/has-unsafe/folding) - 0 - 0 - (if (struct-type? struct:known-procedure/has-unsafe) - struct:known-procedure/has-unsafe - (check-struct-type 'struct struct:known-procedure/has-unsafe)) - null - 'prefab - #f - '() - #f - 'known-procedure/has-unsafe/folding)) +(define effect_2489 (finish75 struct:known-procedure/has-unsafe/folding)) (define known-procedure/has-unsafe/folding (|#%name| known-procedure/has-unsafe/folding @@ -1403,6 +1403,20 @@ (if (impersonator? v) (known-procedure/has-unsafe/folding?_2169 (impersonator-val v)) #f)))))) +(define finish78 + (make-struct-type-install-properties + '(known-procedure/has-unsafe/folding/limited) + 1 + 0 + (if (struct-type? struct:known-procedure/has-unsafe/folding) + struct:known-procedure/has-unsafe/folding + (check-struct-type 'struct struct:known-procedure/has-unsafe/folding)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/has-unsafe/folding/limited)) (define struct:known-procedure/has-unsafe/folding/limited (make-record-type-descriptor* 'known-procedure/has-unsafe/folding/limited @@ -1422,21 +1436,8 @@ #f 1 1)) -(define effect_2633 - (struct-type-install-properties! - struct:known-procedure/has-unsafe/folding/limited - '(known-procedure/has-unsafe/folding/limited) - 1 - 0 - (if (struct-type? struct:known-procedure/has-unsafe/folding) - struct:known-procedure/has-unsafe/folding - (check-struct-type 'struct struct:known-procedure/has-unsafe/folding)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/has-unsafe/folding/limited)) +(define effect_2512 + (finish78 struct:known-procedure/has-unsafe/folding/limited)) (define known-procedure/has-unsafe/folding/limited (|#%name| known-procedure/has-unsafe/folding/limited @@ -1478,6 +1479,20 @@ s 'known-procedure/has-unsafe/folding/limited 'kind)))))) +(define finish82 + (make-struct-type-install-properties + '(known-struct-type) + 4 + 0 + (if (struct-type? struct:known-consistent) + struct:known-consistent + (check-struct-type 'struct struct:known-consistent)) + null + 'prefab + #f + '(0 1 2 3) + #f + 'known-struct-type)) (define struct:known-struct-type (make-record-type-descriptor* 'known-struct-type @@ -1489,29 +1504,15 @@ (if (struct-type? struct:known-consistent) struct:known-consistent (check-struct-type 'struct struct:known-consistent)) - 3 + 4 0 #f - '(0 1 2)) + '(0 1 2 3)) #f #f - 3 - 7)) -(define effect_2547 - (struct-type-install-properties! - struct:known-struct-type - '(known-struct-type) - 3 - 0 - (if (struct-type? struct:known-consistent) - struct:known-consistent - (check-struct-type 'struct struct:known-consistent)) - null - 'prefab - #f - '(0 1 2) - #f - 'known-struct-type)) + 4 + 15)) +(define effect_2667 (finish82 struct:known-struct-type)) (define known-struct-type (|#%name| known-struct-type @@ -1583,6 +1584,38 @@ s 'known-struct-type 'pure-constructor?)))))) +(define known-struct-type-sealed?_2229 + (|#%name| + known-struct-type-sealed? + (record-accessor struct:known-struct-type 3))) +(define known-struct-type-sealed? + (|#%name| + known-struct-type-sealed? + (lambda (s) + (if (known-struct-type?_2572 s) + (known-struct-type-sealed?_2229 s) + ($value + (impersonate-ref + known-struct-type-sealed?_2229 + struct:known-struct-type + 3 + s + 'known-struct-type + 'sealed?)))))) +(define finish89 + (make-struct-type-install-properties + '(known-constructor) + 1 + 0 + (if (struct-type? struct:known-procedure/allocates) + struct:known-procedure/allocates + (check-struct-type 'struct struct:known-procedure/allocates)) + null + 'prefab + #f + '(0) + #f + 'known-constructor)) (define struct:known-constructor (make-record-type-descriptor* 'known-constructor @@ -1602,21 +1635,7 @@ #f 1 1)) -(define effect_2090 - (struct-type-install-properties! - struct:known-constructor - '(known-constructor) - 1 - 0 - (if (struct-type? struct:known-procedure/allocates) - struct:known-procedure/allocates - (check-struct-type 'struct struct:known-procedure/allocates)) - null - 'prefab - #f - '(0) - #f - 'known-constructor)) +(define effect_1913 (finish89 struct:known-constructor)) (define known-constructor (|#%name| known-constructor @@ -1652,6 +1671,20 @@ s 'known-constructor 'type)))))) +(define finish93 + (make-struct-type-install-properties + '(known-predicate) + 1 + 0 + (if (struct-type? struct:known-procedure/pure) + struct:known-procedure/pure + (check-struct-type 'struct struct:known-procedure/pure)) + null + 'prefab + #f + '(0) + #f + 'known-predicate)) (define struct:known-predicate (make-record-type-descriptor* 'known-predicate @@ -1671,21 +1704,7 @@ #f 1 1)) -(define effect_2975 - (struct-type-install-properties! - struct:known-predicate - '(known-predicate) - 1 - 0 - (if (struct-type? struct:known-procedure/pure) - struct:known-procedure/pure - (check-struct-type 'struct struct:known-procedure/pure)) - null - 'prefab - #f - '(0) - #f - 'known-predicate)) +(define effect_2144 (finish93 struct:known-predicate)) (define known-predicate (|#%name| known-predicate @@ -1719,6 +1738,20 @@ s 'known-predicate 'type)))))) +(define finish97 + (make-struct-type-install-properties + '(known-accessor) + 1 + 0 + (if (struct-type? struct:known-procedure/single-valued) + struct:known-procedure/single-valued + (check-struct-type 'struct struct:known-procedure/single-valued)) + null + 'prefab + #f + '(0) + #f + 'known-accessor)) (define struct:known-accessor (make-record-type-descriptor* 'known-accessor @@ -1738,21 +1771,7 @@ #f 1 1)) -(define effect_2542 - (struct-type-install-properties! - struct:known-accessor - '(known-accessor) - 1 - 0 - (if (struct-type? struct:known-procedure/single-valued) - struct:known-procedure/single-valued - (check-struct-type 'struct struct:known-procedure/single-valued)) - null - 'prefab - #f - '(0) - #f - 'known-accessor)) +(define effect_2905 (finish97 struct:known-accessor)) (define known-accessor (|#%name| known-accessor @@ -1786,6 +1805,20 @@ s 'known-accessor 'type)))))) +(define finish101 + (make-struct-type-install-properties + '(known-mutator) + 1 + 0 + (if (struct-type? struct:known-procedure/single-valued) + struct:known-procedure/single-valued + (check-struct-type 'struct struct:known-procedure/single-valued)) + null + 'prefab + #f + '(0) + #f + 'known-mutator)) (define struct:known-mutator (make-record-type-descriptor* 'known-mutator @@ -1805,21 +1838,7 @@ #f 1 1)) -(define effect_2533 - (struct-type-install-properties! - struct:known-mutator - '(known-mutator) - 1 - 0 - (if (struct-type? struct:known-procedure/single-valued) - struct:known-procedure/single-valued - (check-struct-type 'struct struct:known-procedure/single-valued)) - null - 'prefab - #f - '(0) - #f - 'known-mutator)) +(define effect_2521 (finish101 struct:known-mutator)) (define known-mutator (|#%name| known-mutator @@ -1853,6 +1872,20 @@ s 'known-mutator 'type)))))) +(define finish105 + (make-struct-type-install-properties + '(known-struct-constructor) + 1 + 0 + (if (struct-type? struct:known-constructor) + struct:known-constructor + (check-struct-type 'struct struct:known-constructor)) + null + 'prefab + #f + '(0) + #f + 'known-struct-constructor)) (define struct:known-struct-constructor (make-record-type-descriptor* 'known-struct-constructor @@ -1872,21 +1905,7 @@ #f 1 1)) -(define effect_2411 - (struct-type-install-properties! - struct:known-struct-constructor - '(known-struct-constructor) - 1 - 0 - (if (struct-type? struct:known-constructor) - struct:known-constructor - (check-struct-type 'struct struct:known-constructor)) - null - 'prefab - #f - '(0) - #f - 'known-struct-constructor)) +(define effect_3238 (finish105 struct:known-struct-constructor)) (define known-struct-constructor (|#%name| known-struct-constructor @@ -1927,6 +1946,20 @@ s 'known-struct-constructor 'type-id)))))) +(define finish109 + (make-struct-type-install-properties + '(known-struct-predicate) + 3 + 0 + (if (struct-type? struct:known-predicate) + struct:known-predicate + (check-struct-type 'struct struct:known-predicate)) + null + 'prefab + #f + '(0 1 2) + #f + 'known-struct-predicate)) (define struct:known-struct-predicate (make-record-type-descriptor* 'known-struct-predicate @@ -1938,29 +1971,15 @@ (if (struct-type? struct:known-predicate) struct:known-predicate (check-struct-type 'struct struct:known-predicate)) - 2 + 3 0 #f - '(0 1)) + '(0 1 2)) #f #f - 2 - 3)) -(define effect_2929 - (struct-type-install-properties! - struct:known-struct-predicate - '(known-struct-predicate) - 2 - 0 - (if (struct-type? struct:known-predicate) - struct:known-predicate - (check-struct-type 'struct struct:known-predicate)) - null - 'prefab - #f - '(0 1) - #f - 'known-struct-predicate)) + 3 + 7)) +(define effect_2384 (finish109 struct:known-struct-predicate)) (define known-struct-predicate (|#%name| known-struct-predicate @@ -2016,6 +2035,38 @@ s 'known-struct-predicate 'authentic?)))))) +(define known-struct-predicate-sealed?_2251 + (|#%name| + known-struct-predicate-sealed? + (record-accessor struct:known-struct-predicate 2))) +(define known-struct-predicate-sealed? + (|#%name| + known-struct-predicate-sealed? + (lambda (s) + (if (known-struct-predicate?_2418 s) + (known-struct-predicate-sealed?_2251 s) + ($value + (impersonate-ref + known-struct-predicate-sealed?_2251 + struct:known-struct-predicate + 2 + s + 'known-struct-predicate + 'sealed?)))))) +(define finish115 + (make-struct-type-install-properties + '(known-field-accessor) + 4 + 0 + (if (struct-type? struct:known-accessor) + struct:known-accessor + (check-struct-type 'struct struct:known-accessor)) + null + 'prefab + #f + '(0 1 2 3) + #f + 'known-field-accessor)) (define struct:known-field-accessor (make-record-type-descriptor* 'known-field-accessor @@ -2035,21 +2086,7 @@ #f 4 15)) -(define effect_2971 - (struct-type-install-properties! - struct:known-field-accessor - '(known-field-accessor) - 4 - 0 - (if (struct-type? struct:known-accessor) - struct:known-accessor - (check-struct-type 'struct struct:known-accessor)) - null - 'prefab - #f - '(0 1 2 3) - #f - 'known-field-accessor)) +(define effect_2259 (finish115 struct:known-field-accessor)) (define known-field-accessor (|#%name| known-field-accessor @@ -2141,6 +2178,20 @@ s 'known-field-accessor 'known-immutable?)))))) +(define finish122 + (make-struct-type-install-properties + '(known-field-mutator) + 3 + 0 + (if (struct-type? struct:known-mutator) + struct:known-mutator + (check-struct-type 'struct struct:known-mutator)) + null + 'prefab + #f + '(0 1 2) + #f + 'known-field-mutator)) (define struct:known-field-mutator (make-record-type-descriptor* 'known-field-mutator @@ -2160,21 +2211,7 @@ #f 3 7)) -(define effect_2493 - (struct-type-install-properties! - struct:known-field-mutator - '(known-field-mutator) - 3 - 0 - (if (struct-type? struct:known-mutator) - struct:known-mutator - (check-struct-type 'struct struct:known-mutator)) - null - 'prefab - #f - '(0 1 2) - #f - 'known-field-mutator)) +(define effect_2603 (finish122 struct:known-field-mutator)) (define known-field-mutator (|#%name| known-field-mutator @@ -2248,6 +2285,20 @@ s 'known-field-mutator 'pos)))))) +(define finish128 + (make-struct-type-install-properties + '(known-struct-constructor/need-imports) + 1 + 0 + (if (struct-type? struct:known-struct-constructor) + struct:known-struct-constructor + (check-struct-type 'struct struct:known-struct-constructor)) + null + 'prefab + #f + '(0) + #f + 'known-struct-constructor/need-imports)) (define struct:known-struct-constructor/need-imports (make-record-type-descriptor* 'known-struct-constructor/need-imports @@ -2267,21 +2318,7 @@ #f 1 1)) -(define effect_3135 - (struct-type-install-properties! - struct:known-struct-constructor/need-imports - '(known-struct-constructor/need-imports) - 1 - 0 - (if (struct-type? struct:known-struct-constructor) - struct:known-struct-constructor - (check-struct-type 'struct struct:known-struct-constructor)) - null - 'prefab - #f - '(0) - #f - 'known-struct-constructor/need-imports)) +(define effect_2146 (finish128 struct:known-struct-constructor/need-imports)) (define known-struct-constructor/need-imports (|#%name| known-struct-constructor/need-imports @@ -2322,6 +2359,20 @@ s 'known-struct-constructor/need-imports 'needed)))))) +(define finish132 + (make-struct-type-install-properties + '(known-struct-predicate/need-imports) + 1 + 0 + (if (struct-type? struct:known-struct-predicate) + struct:known-struct-predicate + (check-struct-type 'struct struct:known-struct-predicate)) + null + 'prefab + #f + '(0) + #f + 'known-struct-predicate/need-imports)) (define struct:known-struct-predicate/need-imports (make-record-type-descriptor* 'known-struct-predicate/need-imports @@ -2341,21 +2392,7 @@ #f 1 1)) -(define effect_2453 - (struct-type-install-properties! - struct:known-struct-predicate/need-imports - '(known-struct-predicate/need-imports) - 1 - 0 - (if (struct-type? struct:known-struct-predicate) - struct:known-struct-predicate - (check-struct-type 'struct struct:known-struct-predicate)) - null - 'prefab - #f - '(0) - #f - 'known-struct-predicate/need-imports)) +(define effect_3156 (finish132 struct:known-struct-predicate/need-imports)) (define known-struct-predicate/need-imports (|#%name| known-struct-predicate/need-imports @@ -2396,6 +2433,20 @@ s 'known-struct-predicate/need-imports 'needed)))))) +(define finish136 + (make-struct-type-install-properties + '(known-field-accessor/need-imports) + 1 + 0 + (if (struct-type? struct:known-field-accessor) + struct:known-field-accessor + (check-struct-type 'struct struct:known-field-accessor)) + null + 'prefab + #f + '(0) + #f + 'known-field-accessor/need-imports)) (define struct:known-field-accessor/need-imports (make-record-type-descriptor* 'known-field-accessor/need-imports @@ -2415,21 +2466,7 @@ #f 1 1)) -(define effect_2353 - (struct-type-install-properties! - struct:known-field-accessor/need-imports - '(known-field-accessor/need-imports) - 1 - 0 - (if (struct-type? struct:known-field-accessor) - struct:known-field-accessor - (check-struct-type 'struct struct:known-field-accessor)) - null - 'prefab - #f - '(0) - #f - 'known-field-accessor/need-imports)) +(define effect_2513 (finish136 struct:known-field-accessor/need-imports)) (define known-field-accessor/need-imports (|#%name| known-field-accessor/need-imports @@ -2470,6 +2507,20 @@ s 'known-field-accessor/need-imports 'needed)))))) +(define finish140 + (make-struct-type-install-properties + '(known-field-mutator/need-imports) + 1 + 0 + (if (struct-type? struct:known-field-mutator) + struct:known-field-mutator + (check-struct-type 'struct struct:known-field-mutator)) + null + 'prefab + #f + '(0) + #f + 'known-field-mutator/need-imports)) (define struct:known-field-mutator/need-imports (make-record-type-descriptor* 'known-field-mutator/need-imports @@ -2489,21 +2540,7 @@ #f 1 1)) -(define effect_2148 - (struct-type-install-properties! - struct:known-field-mutator/need-imports - '(known-field-mutator/need-imports) - 1 - 0 - (if (struct-type? struct:known-field-mutator) - struct:known-field-mutator - (check-struct-type 'struct struct:known-field-mutator)) - null - 'prefab - #f - '(0) - #f - 'known-field-mutator/need-imports)) +(define effect_2273 (finish140 struct:known-field-mutator/need-imports)) (define known-field-mutator/need-imports (|#%name| known-field-mutator/need-imports @@ -2544,6 +2581,18 @@ s 'known-field-mutator/need-imports 'needed)))))) +(define finish144 + (make-struct-type-install-properties + '(known-struct-type-property/immediate-guard) + 0 + 0 + #f + null + 'prefab + #f + '() + #f + 'known-struct-type-property/immediate-guard)) (define struct:known-struct-type-property/immediate-guard (make-record-type-descriptor* 'known-struct-type-property/immediate-guard @@ -2559,19 +2608,8 @@ #f 0 0)) -(define effect_2693 - (struct-type-install-properties! - struct:known-struct-type-property/immediate-guard - '(known-struct-type-property/immediate-guard) - 0 - 0 - #f - null - 'prefab - #f - '() - #f - 'known-struct-type-property/immediate-guard)) +(define effect_2294 + (finish144 struct:known-struct-type-property/immediate-guard)) (define known-struct-type-property/immediate-guard (|#%name| known-struct-type-property/immediate-guard diff --git a/racket/src/cs/schemified/regexp.scm b/racket/src/cs/schemified/regexp.scm index 385541a477..52aa249e38 100644 --- a/racket/src/cs/schemified/regexp.scm +++ b/racket/src/cs/schemified/regexp.scm @@ -865,18 +865,8 @@ (define rx:line-end 'line-end) (define rx:word-boundary 'word-boundary) (define rx:not-word-boundary 'not-word-boundary) -(define struct:rx:alts - (make-record-type-descriptor* - 'rx:alts - #f - (|#%nongenerative-uid| rx:alts) - #f - #f - 2 - 0)) -(define effect_1936 - (struct-type-install-properties! - struct:rx:alts +(define finish39 + (make-struct-type-install-properties '(rx:alts) 2 0 @@ -887,6 +877,16 @@ '(0 1) #f 'rx:alts)) +(define struct:rx:alts + (make-record-type-descriptor* + 'rx:alts + #f + (|#%nongenerative-uid| rx:alts) + #f + #f + 2 + 0)) +(define effect_2414 (finish39 struct:rx:alts)) (define rx:alts1.1 (|#%name| rx:alts @@ -921,18 +921,8 @@ (rx:alts-rx_2917 s) ($value (impersonate-ref rx:alts-rx_2917 struct:rx:alts 1 s 'rx:alts 'rx2)))))) -(define struct:rx:sequence - (make-record-type-descriptor* - 'rx:sequence - #f - (|#%nongenerative-uid| rx:sequence) - #f - #f - 2 - 0)) -(define effect_2662 - (struct-type-install-properties! - struct:rx:sequence +(define finish44 + (make-struct-type-install-properties '(rx:sequence) 2 0 @@ -943,6 +933,16 @@ '(0 1) #f 'rx:sequence)) +(define struct:rx:sequence + (make-record-type-descriptor* + 'rx:sequence + #f + (|#%nongenerative-uid| rx:sequence) + #f + #f + 2 + 0)) +(define effect_2459 (finish44 struct:rx:sequence)) (define rx:sequence2.1 (|#%name| rx:sequence @@ -992,18 +992,8 @@ s 'rx:sequence 'needs-backtrack?)))))) -(define struct:rx:group - (make-record-type-descriptor* - 'rx:group - #f - (|#%nongenerative-uid| rx:group) - #f - #f - 2 - 0)) -(define effect_3021 - (struct-type-install-properties! - struct:rx:group +(define finish49 + (make-struct-type-install-properties '(rx:group) 2 0 @@ -1014,6 +1004,16 @@ '(0 1) #f 'rx:group)) +(define struct:rx:group + (make-record-type-descriptor* + 'rx:group + #f + (|#%nongenerative-uid| rx:group) + #f + #f + 2 + 0)) +(define effect_1819 (finish49 struct:rx:group)) (define rx:group3.1 (|#%name| rx:group @@ -1060,18 +1060,8 @@ s 'rx:group 'number)))))) -(define struct:rx:repeat - (make-record-type-descriptor* - 'rx:repeat - #f - (|#%nongenerative-uid| rx:repeat) - #f - #f - 4 - 0)) -(define effect_2413 - (struct-type-install-properties! - struct:rx:repeat +(define finish54 + (make-struct-type-install-properties '(rx:repeat) 4 0 @@ -1082,6 +1072,16 @@ '(0 1 2 3) #f 'rx:repeat)) +(define struct:rx:repeat + (make-record-type-descriptor* + 'rx:repeat + #f + (|#%nongenerative-uid| rx:repeat) + #f + #f + 4 + 0)) +(define effect_2312 (finish54 struct:rx:repeat)) (define rx:repeat4.1 (|#%name| rx:repeat @@ -1161,18 +1161,8 @@ s 'rx:repeat 'non-greedy?)))))) -(define struct:rx:maybe - (make-record-type-descriptor* - 'rx:maybe - #f - (|#%nongenerative-uid| rx:maybe) - #f - #f - 2 - 0)) -(define effect_1615 - (struct-type-install-properties! - struct:rx:maybe +(define finish61 + (make-struct-type-install-properties '(rx:maybe) 2 0 @@ -1183,6 +1173,16 @@ '(0 1) #f 'rx:maybe)) +(define struct:rx:maybe + (make-record-type-descriptor* + 'rx:maybe + #f + (|#%nongenerative-uid| rx:maybe) + #f + #f + 2 + 0)) +(define effect_2202 (finish61 struct:rx:maybe)) (define rx:maybe5.1 (|#%name| rx:maybe @@ -1229,18 +1229,8 @@ s 'rx:maybe 'non-greedy?)))))) -(define struct:rx:conditional - (make-record-type-descriptor* - 'rx:conditional - #f - (|#%nongenerative-uid| rx:conditional) - #f - #f - 6 - 0)) -(define effect_2714 - (struct-type-install-properties! - struct:rx:conditional +(define finish66 + (make-struct-type-install-properties '(rx:conditional) 6 0 @@ -1251,6 +1241,16 @@ '(0 1 2 3 4 5) #f 'rx:conditional)) +(define struct:rx:conditional + (make-record-type-descriptor* + 'rx:conditional + #f + (|#%nongenerative-uid| rx:conditional) + #f + #f + 6 + 0)) +(define effect_2905 (finish66 struct:rx:conditional)) (define rx:conditional6.1 (|#%name| rx:conditional @@ -1366,18 +1366,8 @@ s 'rx:conditional 'needs-backtrack?)))))) -(define struct:rx:lookahead - (make-record-type-descriptor* - 'rx:lookahead - #f - (|#%nongenerative-uid| rx:lookahead) - #f - #f - 4 - 0)) -(define effect_2193 - (struct-type-install-properties! - struct:rx:lookahead +(define finish75 + (make-struct-type-install-properties '(rx:lookahead) 4 0 @@ -1388,6 +1378,16 @@ '(0 1 2 3) #f 'rx:lookahead)) +(define struct:rx:lookahead + (make-record-type-descriptor* + 'rx:lookahead + #f + (|#%nongenerative-uid| rx:lookahead) + #f + #f + 4 + 0)) +(define effect_2486 (finish75 struct:rx:lookahead)) (define rx:lookahead7.1 (|#%name| rx:lookahead @@ -1469,18 +1469,8 @@ s 'rx:lookahead 'num-n)))))) -(define struct:rx:lookbehind - (make-record-type-descriptor* - 'rx:lookbehind - #f - (|#%nongenerative-uid| rx:lookbehind) - #f - #f - 6 - 12)) -(define effect_2578 - (struct-type-install-properties! - struct:rx:lookbehind +(define finish82 + (make-struct-type-install-properties '(rx:lookbehind) 6 0 @@ -1491,6 +1481,16 @@ '(0 1 4 5) #f 'rx:lookbehind)) +(define struct:rx:lookbehind + (make-record-type-descriptor* + 'rx:lookbehind + #f + (|#%nongenerative-uid| rx:lookbehind) + #f + #f + 6 + 12)) +(define effect_2468 (finish82 struct:rx:lookbehind)) (define rx:lookbehind8.1 (|#%name| rx:lookbehind @@ -1640,18 +1640,8 @@ v 'rx:lookbehind 'lb-max)))))) -(define struct:rx:cut - (make-record-type-descriptor* - 'rx:cut - #f - (|#%nongenerative-uid| rx:cut) - #f - #f - 4 - 0)) -(define effect_2428 - (struct-type-install-properties! - struct:rx:cut +(define finish93 + (make-struct-type-install-properties '(rx:cut) 4 0 @@ -1662,6 +1652,16 @@ '(0 1 2 3) #f 'rx:cut)) +(define struct:rx:cut + (make-record-type-descriptor* + 'rx:cut + #f + (|#%nongenerative-uid| rx:cut) + #f + #f + 4 + 0)) +(define effect_2158 (finish93 struct:rx:cut)) (define rx:cut9.1 (|#%name| rx:cut @@ -1733,18 +1733,8 @@ s 'rx:cut 'needs-backtrack?)))))) -(define struct:rx:reference - (make-record-type-descriptor* - 'rx:reference - #f - (|#%nongenerative-uid| rx:reference) - #f - #f - 2 - 0)) -(define effect_2572 - (struct-type-install-properties! - struct:rx:reference +(define finish100 + (make-struct-type-install-properties '(rx:reference) 2 0 @@ -1755,6 +1745,16 @@ '(0 1) #f 'rx:reference)) +(define struct:rx:reference + (make-record-type-descriptor* + 'rx:reference + #f + (|#%nongenerative-uid| rx:reference) + #f + #f + 2 + 0)) +(define effect_2306 (finish100 struct:rx:reference)) (define rx:reference10.1 (|#%name| rx:reference @@ -1806,18 +1806,8 @@ s 'rx:reference 'case-sensitive?)))))) -(define struct:rx:range - (make-record-type-descriptor* - 'rx:range - #f - (|#%nongenerative-uid| rx:range) - #f - #f - 1 - 0)) -(define effect_2430 - (struct-type-install-properties! - struct:rx:range +(define finish105 + (make-struct-type-install-properties '(rx:range) 1 0 @@ -1828,6 +1818,16 @@ '(0) #f 'rx:range)) +(define struct:rx:range + (make-record-type-descriptor* + 'rx:range + #f + (|#%nongenerative-uid| rx:range) + #f + #f + 1 + 0)) +(define effect_2071 (finish105 struct:rx:range)) (define rx:range11.1 (|#%name| rx:range @@ -1858,18 +1858,8 @@ s 'rx:range 'range)))))) -(define struct:rx:unicode-categories - (make-record-type-descriptor* - 'rx:unicode-categories - #f - (|#%nongenerative-uid| rx:unicode-categories) - #f - #f - 2 - 0)) -(define effect_2489 - (struct-type-install-properties! - struct:rx:unicode-categories +(define finish109 + (make-struct-type-install-properties '(rx:unicode-categories) 2 0 @@ -1880,6 +1870,16 @@ '(0 1) #f 'rx:unicode-categories)) +(define struct:rx:unicode-categories + (make-record-type-descriptor* + 'rx:unicode-categories + #f + (|#%nongenerative-uid| rx:unicode-categories) + #f + #f + 2 + 0)) +(define effect_2341 (finish109 struct:rx:unicode-categories)) (define rx:unicode-categories12.1 (|#%name| rx:unicode-categories @@ -2129,18 +2129,8 @@ num-n_0 (let ((or-part_0 (needs-backtrack? pces1_0))) (if or-part_0 or-part_0 (needs-backtrack? pces2_0)))))) -(define struct:parse-config - (make-record-type-descriptor* - 'parse-config - #f - (|#%nongenerative-uid| parse-config) - #f - #f - 7 - 0)) -(define effect_2522 - (struct-type-install-properties! - struct:parse-config +(define finish123 + (make-struct-type-install-properties '(parse-config) 7 0 @@ -2151,6 +2141,16 @@ '(0 1 2 3 4 5 6) #f 'parse-config)) +(define struct:parse-config + (make-record-type-descriptor* + 'parse-config + #f + (|#%nongenerative-uid| parse-config) + #f + #f + 7 + 0)) +(define effect_2622 (finish123 struct:parse-config)) (define parse-config1.1 (|#%name| parse-config @@ -4697,18 +4697,8 @@ (zero-sized? (rx:cut-rx rx_0)) #f))))))))))))))))))) (define union (lambda (a_0 b_0) (if a_0 (if b_0 (range-union a_0 b_0) #f) #f))) -(define struct:lazy-bytes - (make-record-type-descriptor* - 'lazy-bytes - #f - (|#%nongenerative-uid| lazy-bytes) - #f - #f - 13 - 3075)) -(define effect_2409 - (struct-type-install-properties! - struct:lazy-bytes +(define finish535 + (make-struct-type-install-properties '(lazy-bytes) 13 0 @@ -4719,6 +4709,16 @@ '(2 3 4 5 6 7 8 9 12) #f 'lazy-bytes)) +(define struct:lazy-bytes + (make-record-type-descriptor* + 'lazy-bytes + #f + (|#%nongenerative-uid| lazy-bytes) + #f + #f + 13 + 3075)) +(define effect_2741 (finish535 struct:lazy-bytes)) (define lazy-bytes1.1 (|#%name| lazy-bytes @@ -7242,18 +7242,8 @@ (if (rx:range? rx_0) (range-matcher* (compile-range (rx:range-range rx_0)) max_0) #f)))))) -(define struct:rx:regexp - (make-record-type-descriptor* - 'regexp - #f - (|#%nongenerative-uid| regexp) - #f - #f - 10 - 0)) -(define effect_2528 - (struct-type-install-properties! - struct:rx:regexp +(define finish621 + (make-struct-type-install-properties '(regexp) 10 0 @@ -7281,6 +7271,16 @@ '(0 1 2 3 4 5 6 7 8 9) #f 'rx:regexp)) +(define struct:rx:regexp + (make-record-type-descriptor* + 'regexp + #f + (|#%nongenerative-uid| regexp) + #f + #f + 10 + 0)) +(define effect_2726 (finish621 struct:rx:regexp)) (define rx:regexp1.1 (|#%name| rx:regexp diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm index 6133cd5f5f..c54dd17fe8 100644 --- a/racket/src/cs/schemified/schemify.scm +++ b/racket/src/cs/schemified/schemify.scm @@ -1957,18 +1957,8 @@ (define reannotate/new-srcloc (lambda (old-term_0 new-term_0 new-srcloc_0) (datum->syntax #f new-term_0 new-srcloc_0 old-term_0))) -(define struct:known-constant - (make-record-type-descriptor* - 'known-constant - #f - (structure-type-lookup-prefab-uid 'known-constant #f 0 0 #f '()) - #f - #f - 0 - 0)) -(define effect_2175 - (struct-type-install-properties! - struct:known-constant +(define finish56 + (make-struct-type-install-properties '(known-constant) 0 0 @@ -1979,6 +1969,16 @@ '() #f 'known-constant)) +(define struct:known-constant + (make-record-type-descriptor* + 'known-constant + #f + (structure-type-lookup-prefab-uid 'known-constant #f 0 0 #f '()) + #f + #f + 0 + 0)) +(define effect_2537 (finish56 struct:known-constant)) (define known-constant (|#%name| known-constant @@ -1996,6 +1996,20 @@ (if (impersonator? v) (known-constant?_2598 (impersonator-val v)) #f)))))) +(define finish59 + (make-struct-type-install-properties + '(known-consistent) + 0 + 0 + (if (struct-type? struct:known-constant) + struct:known-constant + (check-struct-type 'struct struct:known-constant)) + null + 'prefab + #f + '() + #f + 'known-consistent)) (define struct:known-consistent (make-record-type-descriptor* 'known-consistent @@ -2015,21 +2029,7 @@ #f 0 0)) -(define effect_2225 - (struct-type-install-properties! - struct:known-consistent - '(known-consistent) - 0 - 0 - (if (struct-type? struct:known-constant) - struct:known-constant - (check-struct-type 'struct struct:known-constant)) - null - 'prefab - #f - '() - #f - 'known-consistent)) +(define effect_2382 (finish59 struct:known-consistent)) (define known-consistent (|#%name| known-consistent @@ -2047,6 +2047,20 @@ (if (impersonator? v) (known-consistent?_3048 (impersonator-val v)) #f)))))) +(define finish62 + (make-struct-type-install-properties + '(known-authentic) + 0 + 0 + (if (struct-type? struct:known-constant) + struct:known-constant + (check-struct-type 'struct struct:known-constant)) + null + 'prefab + #f + '() + #f + 'known-authentic)) (define struct:known-authentic (make-record-type-descriptor* 'known-authentic @@ -2066,21 +2080,7 @@ #f 0 0)) -(define effect_3179 - (struct-type-install-properties! - struct:known-authentic - '(known-authentic) - 0 - 0 - (if (struct-type? struct:known-constant) - struct:known-constant - (check-struct-type 'struct struct:known-constant)) - null - 'prefab - #f - '() - #f - 'known-authentic)) +(define effect_2570 (finish62 struct:known-authentic)) (define known-authentic (|#%name| known-authentic @@ -2098,6 +2098,20 @@ (if (impersonator? v) (known-authentic?_3119 (impersonator-val v)) #f)))))) +(define finish65 + (make-struct-type-install-properties + '(known-copy) + 1 + 0 + (if (struct-type? struct:known-constant) + struct:known-constant + (check-struct-type 'struct struct:known-constant)) + null + 'prefab + #f + '(0) + #f + 'known-copy)) (define struct:known-copy (make-record-type-descriptor* 'known-copy @@ -2117,21 +2131,7 @@ #f 1 1)) -(define effect_1974 - (struct-type-install-properties! - struct:known-copy - '(known-copy) - 1 - 0 - (if (struct-type? struct:known-constant) - struct:known-constant - (check-struct-type 'struct struct:known-constant)) - null - 'prefab - #f - '(0) - #f - 'known-copy)) +(define effect_2542 (finish65 struct:known-copy)) (define known-copy (|#%name| known-copy @@ -2163,6 +2163,20 @@ s 'known-copy 'id)))))) +(define finish69 + (make-struct-type-install-properties + '(known-literal) + 1 + 0 + (if (struct-type? struct:known-consistent) + struct:known-consistent + (check-struct-type 'struct struct:known-consistent)) + null + 'prefab + #f + '(0) + #f + 'known-literal)) (define struct:known-literal (make-record-type-descriptor* 'known-literal @@ -2182,21 +2196,7 @@ #f 1 1)) -(define effect_2741 - (struct-type-install-properties! - struct:known-literal - '(known-literal) - 1 - 0 - (if (struct-type? struct:known-consistent) - struct:known-consistent - (check-struct-type 'struct struct:known-consistent)) - null - 'prefab - #f - '(0) - #f - 'known-literal)) +(define effect_2788 (finish69 struct:known-literal)) (define known-literal (|#%name| known-literal @@ -2230,6 +2230,20 @@ s 'known-literal 'value)))))) +(define finish73 + (make-struct-type-install-properties + '(known-procedure) + 1 + 0 + (if (struct-type? struct:known-consistent) + struct:known-consistent + (check-struct-type 'struct struct:known-consistent)) + null + 'prefab + #f + '(0) + #f + 'known-procedure)) (define struct:known-procedure (make-record-type-descriptor* 'known-procedure @@ -2249,21 +2263,7 @@ #f 1 1)) -(define effect_1867 - (struct-type-install-properties! - struct:known-procedure - '(known-procedure) - 1 - 0 - (if (struct-type? struct:known-consistent) - struct:known-consistent - (check-struct-type 'struct struct:known-consistent)) - null - 'prefab - #f - '(0) - #f - 'known-procedure)) +(define effect_2677 (finish73 struct:known-procedure)) (define known-procedure (|#%name| known-procedure @@ -2299,6 +2299,20 @@ s 'known-procedure 'arity-mask)))))) +(define finish77 + (make-struct-type-install-properties + '(known-procedure/single-valued) + 0 + 0 + (if (struct-type? struct:known-procedure) + struct:known-procedure + (check-struct-type 'struct struct:known-procedure)) + null + 'prefab + #f + '() + #f + 'known-procedure/single-valued)) (define struct:known-procedure/single-valued (make-record-type-descriptor* 'known-procedure/single-valued @@ -2318,21 +2332,7 @@ #f 0 0)) -(define effect_2708 - (struct-type-install-properties! - struct:known-procedure/single-valued - '(known-procedure/single-valued) - 0 - 0 - (if (struct-type? struct:known-procedure) - struct:known-procedure - (check-struct-type 'struct struct:known-procedure)) - null - 'prefab - #f - '() - #f - 'known-procedure/single-valued)) +(define effect_2532 (finish77 struct:known-procedure/single-valued)) (define known-procedure/single-valued (|#%name| known-procedure/single-valued @@ -2355,6 +2355,20 @@ (if (impersonator? v) (known-procedure/single-valued?_3105 (impersonator-val v)) #f)))))) +(define finish80 + (make-struct-type-install-properties + '(known-procedure/no-prompt) + 0 + 0 + (if (struct-type? struct:known-procedure/single-valued) + struct:known-procedure/single-valued + (check-struct-type 'struct struct:known-procedure/single-valued)) + null + 'prefab + #f + '() + #f + 'known-procedure/no-prompt)) (define struct:known-procedure/no-prompt (make-record-type-descriptor* 'known-procedure/no-prompt @@ -2374,21 +2388,7 @@ #f 0 0)) -(define effect_2348 - (struct-type-install-properties! - struct:known-procedure/no-prompt - '(known-procedure/no-prompt) - 0 - 0 - (if (struct-type? struct:known-procedure/single-valued) - struct:known-procedure/single-valued - (check-struct-type 'struct struct:known-procedure/single-valued)) - null - 'prefab - #f - '() - #f - 'known-procedure/no-prompt)) +(define effect_1771 (finish80 struct:known-procedure/no-prompt)) (define known-procedure/no-prompt (|#%name| known-procedure/no-prompt @@ -2411,6 +2411,20 @@ (if (impersonator? v) (known-procedure/no-prompt?_2036 (impersonator-val v)) #f)))))) +(define finish83 + (make-struct-type-install-properties + '(known-procedure/no-prompt/multi) + 0 + 0 + (if (struct-type? struct:known-procedure) + struct:known-procedure + (check-struct-type 'struct struct:known-procedure)) + null + 'prefab + #f + '() + #f + 'known-procedure/no-prompt/multi)) (define struct:known-procedure/no-prompt/multi (make-record-type-descriptor* 'known-procedure/no-prompt/multi @@ -2430,21 +2444,7 @@ #f 0 0)) -(define effect_2331 - (struct-type-install-properties! - struct:known-procedure/no-prompt/multi - '(known-procedure/no-prompt/multi) - 0 - 0 - (if (struct-type? struct:known-procedure) - struct:known-procedure - (check-struct-type 'struct struct:known-procedure)) - null - 'prefab - #f - '() - #f - 'known-procedure/no-prompt/multi)) +(define effect_2793 (finish83 struct:known-procedure/no-prompt/multi)) (define known-procedure/no-prompt/multi (|#%name| known-procedure/no-prompt/multi @@ -2467,6 +2467,20 @@ (if (impersonator? v) (known-procedure/no-prompt/multi?_2394 (impersonator-val v)) #f)))))) +(define finish86 + (make-struct-type-install-properties + '(known-procedure/no-return) + 0 + 0 + (if (struct-type? struct:known-procedure/single-valued) + struct:known-procedure/single-valued + (check-struct-type 'struct struct:known-procedure/single-valued)) + null + 'prefab + #f + '() + #f + 'known-procedure/no-return)) (define struct:known-procedure/no-return (make-record-type-descriptor* 'known-procedure/no-return @@ -2486,21 +2500,7 @@ #f 0 0)) -(define effect_2377 - (struct-type-install-properties! - struct:known-procedure/no-return - '(known-procedure/no-return) - 0 - 0 - (if (struct-type? struct:known-procedure/single-valued) - struct:known-procedure/single-valued - (check-struct-type 'struct struct:known-procedure/single-valued)) - null - 'prefab - #f - '() - #f - 'known-procedure/no-return)) +(define effect_2517 (finish86 struct:known-procedure/no-return)) (define known-procedure/no-return (|#%name| known-procedure/no-return @@ -2523,6 +2523,20 @@ (if (impersonator? v) (known-procedure/no-return?_1763 (impersonator-val v)) #f)))))) +(define finish89 + (make-struct-type-install-properties + '(known-procedure/can-inline) + 1 + 0 + (if (struct-type? struct:known-procedure) + struct:known-procedure + (check-struct-type 'struct struct:known-procedure)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/can-inline)) (define struct:known-procedure/can-inline (make-record-type-descriptor* 'known-procedure/can-inline @@ -2542,21 +2556,7 @@ #f 1 1)) -(define effect_2149 - (struct-type-install-properties! - struct:known-procedure/can-inline - '(known-procedure/can-inline) - 1 - 0 - (if (struct-type? struct:known-procedure) - struct:known-procedure - (check-struct-type 'struct struct:known-procedure)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/can-inline)) +(define effect_2308 (finish89 struct:known-procedure/can-inline)) (define known-procedure/can-inline (|#%name| known-procedure/can-inline @@ -2597,6 +2597,20 @@ s 'known-procedure/can-inline 'expr)))))) +(define finish93 + (make-struct-type-install-properties + '(known-procedure/can-inline/need-imports) + 1 + 0 + (if (struct-type? struct:known-procedure/can-inline) + struct:known-procedure/can-inline + (check-struct-type 'struct struct:known-procedure/can-inline)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/can-inline/need-imports)) (define struct:known-procedure/can-inline/need-imports (make-record-type-descriptor* 'known-procedure/can-inline/need-imports @@ -2616,21 +2630,7 @@ #f 1 1)) -(define effect_2717 - (struct-type-install-properties! - struct:known-procedure/can-inline/need-imports - '(known-procedure/can-inline/need-imports) - 1 - 0 - (if (struct-type? struct:known-procedure/can-inline) - struct:known-procedure/can-inline - (check-struct-type 'struct struct:known-procedure/can-inline)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/can-inline/need-imports)) +(define effect_2618 (finish93 struct:known-procedure/can-inline/need-imports)) (define known-procedure/can-inline/need-imports (|#%name| known-procedure/can-inline/need-imports @@ -2671,6 +2671,20 @@ s 'known-procedure/can-inline/need-imports 'needed)))))) +(define finish97 + (make-struct-type-install-properties + '(known-procedure/folding) + 0 + 0 + (if (struct-type? struct:known-procedure/no-prompt) + struct:known-procedure/no-prompt + (check-struct-type 'struct struct:known-procedure/no-prompt)) + null + 'prefab + #f + '() + #f + 'known-procedure/folding)) (define struct:known-procedure/folding (make-record-type-descriptor* 'known-procedure/folding @@ -2690,21 +2704,7 @@ #f 0 0)) -(define effect_2516 - (struct-type-install-properties! - struct:known-procedure/folding - '(known-procedure/folding) - 0 - 0 - (if (struct-type? struct:known-procedure/no-prompt) - struct:known-procedure/no-prompt - (check-struct-type 'struct struct:known-procedure/no-prompt)) - null - 'prefab - #f - '() - #f - 'known-procedure/folding)) +(define effect_2478 (finish97 struct:known-procedure/folding)) (define known-procedure/folding (|#%name| known-procedure/folding @@ -2727,6 +2727,20 @@ (if (impersonator? v) (known-procedure/folding?_2882 (impersonator-val v)) #f)))))) +(define finish100 + (make-struct-type-install-properties + '(known-procedure/folding/limited) + 1 + 0 + (if (struct-type? struct:known-procedure/folding) + struct:known-procedure/folding + (check-struct-type 'struct struct:known-procedure/folding)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/folding/limited)) (define struct:known-procedure/folding/limited (make-record-type-descriptor* 'known-procedure/folding/limited @@ -2746,21 +2760,7 @@ #f 1 1)) -(define effect_2551 - (struct-type-install-properties! - struct:known-procedure/folding/limited - '(known-procedure/folding/limited) - 1 - 0 - (if (struct-type? struct:known-procedure/folding) - struct:known-procedure/folding - (check-struct-type 'struct struct:known-procedure/folding)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/folding/limited)) +(define effect_2518 (finish100 struct:known-procedure/folding/limited)) (define known-procedure/folding/limited (|#%name| known-procedure/folding/limited @@ -2801,6 +2801,20 @@ s 'known-procedure/folding/limited 'kind)))))) +(define finish104 + (make-struct-type-install-properties + '(known-procedure/succeeds) + 0 + 0 + (if (struct-type? struct:known-procedure/no-prompt) + struct:known-procedure/no-prompt + (check-struct-type 'struct struct:known-procedure/no-prompt)) + null + 'prefab + #f + '() + #f + 'known-procedure/succeeds)) (define struct:known-procedure/succeeds (make-record-type-descriptor* 'known-procedure/succeeds @@ -2820,21 +2834,7 @@ #f 0 0)) -(define effect_2332 - (struct-type-install-properties! - struct:known-procedure/succeeds - '(known-procedure/succeeds) - 0 - 0 - (if (struct-type? struct:known-procedure/no-prompt) - struct:known-procedure/no-prompt - (check-struct-type 'struct struct:known-procedure/no-prompt)) - null - 'prefab - #f - '() - #f - 'known-procedure/succeeds)) +(define effect_2467 (finish104 struct:known-procedure/succeeds)) (define known-procedure/succeeds (|#%name| known-procedure/succeeds @@ -2857,6 +2857,20 @@ (if (impersonator? v) (known-procedure/succeeds?_3041 (impersonator-val v)) #f)))))) +(define finish107 + (make-struct-type-install-properties + '(known-procedure/allocates) + 0 + 0 + (if (struct-type? struct:known-procedure/succeeds) + struct:known-procedure/succeeds + (check-struct-type 'struct struct:known-procedure/succeeds)) + null + 'prefab + #f + '() + #f + 'known-procedure/allocates)) (define struct:known-procedure/allocates (make-record-type-descriptor* 'known-procedure/allocates @@ -2876,21 +2890,7 @@ #f 0 0)) -(define effect_2307 - (struct-type-install-properties! - struct:known-procedure/allocates - '(known-procedure/allocates) - 0 - 0 - (if (struct-type? struct:known-procedure/succeeds) - struct:known-procedure/succeeds - (check-struct-type 'struct struct:known-procedure/succeeds)) - null - 'prefab - #f - '() - #f - 'known-procedure/allocates)) +(define effect_2336 (finish107 struct:known-procedure/allocates)) (define known-procedure/allocates (|#%name| known-procedure/allocates @@ -2913,6 +2913,20 @@ (if (impersonator? v) (known-procedure/allocates?_2244 (impersonator-val v)) #f)))))) +(define finish110 + (make-struct-type-install-properties + '(known-procedure/pure) + 0 + 0 + (if (struct-type? struct:known-procedure/allocates) + struct:known-procedure/allocates + (check-struct-type 'struct struct:known-procedure/allocates)) + null + 'prefab + #f + '() + #f + 'known-procedure/pure)) (define struct:known-procedure/pure (make-record-type-descriptor* 'known-procedure/pure @@ -2932,21 +2946,7 @@ #f 0 0)) -(define effect_2394 - (struct-type-install-properties! - struct:known-procedure/pure - '(known-procedure/pure) - 0 - 0 - (if (struct-type? struct:known-procedure/allocates) - struct:known-procedure/allocates - (check-struct-type 'struct struct:known-procedure/allocates)) - null - 'prefab - #f - '() - #f - 'known-procedure/pure)) +(define effect_3058 (finish110 struct:known-procedure/pure)) (define known-procedure/pure (|#%name| known-procedure/pure @@ -2966,6 +2966,20 @@ (if (impersonator? v) (known-procedure/pure?_2240 (impersonator-val v)) #f)))))) +(define finish113 + (make-struct-type-install-properties + '(known-procedure/pure/folding) + 0 + 0 + (if (struct-type? struct:known-procedure/pure) + struct:known-procedure/pure + (check-struct-type 'struct struct:known-procedure/pure)) + null + 'prefab + #f + '() + #f + 'known-procedure/pure/folding)) (define struct:known-procedure/pure/folding (make-record-type-descriptor* 'known-procedure/pure/folding @@ -2985,21 +2999,7 @@ #f 0 0)) -(define effect_2781 - (struct-type-install-properties! - struct:known-procedure/pure/folding - '(known-procedure/pure/folding) - 0 - 0 - (if (struct-type? struct:known-procedure/pure) - struct:known-procedure/pure - (check-struct-type 'struct struct:known-procedure/pure)) - null - 'prefab - #f - '() - #f - 'known-procedure/pure/folding)) +(define effect_2264 (finish113 struct:known-procedure/pure/folding)) (define known-procedure/pure/folding (|#%name| known-procedure/pure/folding @@ -3022,6 +3022,20 @@ (if (impersonator? v) (known-procedure/pure/folding?_2719 (impersonator-val v)) #f)))))) +(define finish116 + (make-struct-type-install-properties + '(known-procedure/pure/folding-unsafe) + 1 + 0 + (if (struct-type? struct:known-procedure/pure/folding) + struct:known-procedure/pure/folding + (check-struct-type 'struct struct:known-procedure/pure/folding)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/pure/folding-unsafe)) (define struct:known-procedure/pure/folding-unsafe (make-record-type-descriptor* 'known-procedure/pure/folding-unsafe @@ -3041,21 +3055,7 @@ #f 1 1)) -(define effect_2709 - (struct-type-install-properties! - struct:known-procedure/pure/folding-unsafe - '(known-procedure/pure/folding-unsafe) - 1 - 0 - (if (struct-type? struct:known-procedure/pure/folding) - struct:known-procedure/pure/folding - (check-struct-type 'struct struct:known-procedure/pure/folding)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/pure/folding-unsafe)) +(define effect_2657 (finish116 struct:known-procedure/pure/folding-unsafe)) (define known-procedure/pure/folding-unsafe (|#%name| known-procedure/pure/folding-unsafe @@ -3096,6 +3096,20 @@ s 'known-procedure/pure/folding-unsafe 'safe)))))) +(define finish120 + (make-struct-type-install-properties + '(known-procedure/has-unsafe) + 1 + 0 + (if (struct-type? struct:known-procedure/no-prompt) + struct:known-procedure/no-prompt + (check-struct-type 'struct struct:known-procedure/no-prompt)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/has-unsafe)) (define struct:known-procedure/has-unsafe (make-record-type-descriptor* 'known-procedure/has-unsafe @@ -3115,21 +3129,7 @@ #f 1 1)) -(define effect_2998 - (struct-type-install-properties! - struct:known-procedure/has-unsafe - '(known-procedure/has-unsafe) - 1 - 0 - (if (struct-type? struct:known-procedure/no-prompt) - struct:known-procedure/no-prompt - (check-struct-type 'struct struct:known-procedure/no-prompt)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/has-unsafe)) +(define effect_1752 (finish120 struct:known-procedure/has-unsafe)) (define known-procedure/has-unsafe (|#%name| known-procedure/has-unsafe @@ -3170,6 +3170,20 @@ s 'known-procedure/has-unsafe 'alternate)))))) +(define finish124 + (make-struct-type-install-properties + '(known-procedure/has-unsafe/folding) + 0 + 0 + (if (struct-type? struct:known-procedure/has-unsafe) + struct:known-procedure/has-unsafe + (check-struct-type 'struct struct:known-procedure/has-unsafe)) + null + 'prefab + #f + '() + #f + 'known-procedure/has-unsafe/folding)) (define struct:known-procedure/has-unsafe/folding (make-record-type-descriptor* 'known-procedure/has-unsafe/folding @@ -3189,21 +3203,7 @@ #f 0 0)) -(define effect_2584 - (struct-type-install-properties! - struct:known-procedure/has-unsafe/folding - '(known-procedure/has-unsafe/folding) - 0 - 0 - (if (struct-type? struct:known-procedure/has-unsafe) - struct:known-procedure/has-unsafe - (check-struct-type 'struct struct:known-procedure/has-unsafe)) - null - 'prefab - #f - '() - #f - 'known-procedure/has-unsafe/folding)) +(define effect_2489 (finish124 struct:known-procedure/has-unsafe/folding)) (define known-procedure/has-unsafe/folding (|#%name| known-procedure/has-unsafe/folding @@ -3226,6 +3226,20 @@ (if (impersonator? v) (known-procedure/has-unsafe/folding?_2169 (impersonator-val v)) #f)))))) +(define finish127 + (make-struct-type-install-properties + '(known-procedure/has-unsafe/folding/limited) + 1 + 0 + (if (struct-type? struct:known-procedure/has-unsafe/folding) + struct:known-procedure/has-unsafe/folding + (check-struct-type 'struct struct:known-procedure/has-unsafe/folding)) + null + 'prefab + #f + '(0) + #f + 'known-procedure/has-unsafe/folding/limited)) (define struct:known-procedure/has-unsafe/folding/limited (make-record-type-descriptor* 'known-procedure/has-unsafe/folding/limited @@ -3245,21 +3259,8 @@ #f 1 1)) -(define effect_2633 - (struct-type-install-properties! - struct:known-procedure/has-unsafe/folding/limited - '(known-procedure/has-unsafe/folding/limited) - 1 - 0 - (if (struct-type? struct:known-procedure/has-unsafe/folding) - struct:known-procedure/has-unsafe/folding - (check-struct-type 'struct struct:known-procedure/has-unsafe/folding)) - null - 'prefab - #f - '(0) - #f - 'known-procedure/has-unsafe/folding/limited)) +(define effect_2512 + (finish127 struct:known-procedure/has-unsafe/folding/limited)) (define known-procedure/has-unsafe/folding/limited (|#%name| known-procedure/has-unsafe/folding/limited @@ -3301,6 +3302,20 @@ s 'known-procedure/has-unsafe/folding/limited 'kind)))))) +(define finish131 + (make-struct-type-install-properties + '(known-struct-type) + 4 + 0 + (if (struct-type? struct:known-consistent) + struct:known-consistent + (check-struct-type 'struct struct:known-consistent)) + null + 'prefab + #f + '(0 1 2 3) + #f + 'known-struct-type)) (define struct:known-struct-type (make-record-type-descriptor* 'known-struct-type @@ -3312,29 +3327,15 @@ (if (struct-type? struct:known-consistent) struct:known-consistent (check-struct-type 'struct struct:known-consistent)) - 3 + 4 0 #f - '(0 1 2)) + '(0 1 2 3)) #f #f - 3 - 7)) -(define effect_2547 - (struct-type-install-properties! - struct:known-struct-type - '(known-struct-type) - 3 - 0 - (if (struct-type? struct:known-consistent) - struct:known-consistent - (check-struct-type 'struct struct:known-consistent)) - null - 'prefab - #f - '(0 1 2) - #f - 'known-struct-type)) + 4 + 15)) +(define effect_2667 (finish131 struct:known-struct-type)) (define known-struct-type (|#%name| known-struct-type @@ -3406,6 +3407,38 @@ s 'known-struct-type 'pure-constructor?)))))) +(define known-struct-type-sealed?_2229 + (|#%name| + known-struct-type-sealed? + (record-accessor struct:known-struct-type 3))) +(define known-struct-type-sealed? + (|#%name| + known-struct-type-sealed? + (lambda (s) + (if (known-struct-type?_2572 s) + (known-struct-type-sealed?_2229 s) + ($value + (impersonate-ref + known-struct-type-sealed?_2229 + struct:known-struct-type + 3 + s + 'known-struct-type + 'sealed?)))))) +(define finish138 + (make-struct-type-install-properties + '(known-constructor) + 1 + 0 + (if (struct-type? struct:known-procedure/allocates) + struct:known-procedure/allocates + (check-struct-type 'struct struct:known-procedure/allocates)) + null + 'prefab + #f + '(0) + #f + 'known-constructor)) (define struct:known-constructor (make-record-type-descriptor* 'known-constructor @@ -3425,21 +3458,7 @@ #f 1 1)) -(define effect_2090 - (struct-type-install-properties! - struct:known-constructor - '(known-constructor) - 1 - 0 - (if (struct-type? struct:known-procedure/allocates) - struct:known-procedure/allocates - (check-struct-type 'struct struct:known-procedure/allocates)) - null - 'prefab - #f - '(0) - #f - 'known-constructor)) +(define effect_1913 (finish138 struct:known-constructor)) (define known-constructor (|#%name| known-constructor @@ -3475,6 +3494,20 @@ s 'known-constructor 'type)))))) +(define finish142 + (make-struct-type-install-properties + '(known-predicate) + 1 + 0 + (if (struct-type? struct:known-procedure/pure) + struct:known-procedure/pure + (check-struct-type 'struct struct:known-procedure/pure)) + null + 'prefab + #f + '(0) + #f + 'known-predicate)) (define struct:known-predicate (make-record-type-descriptor* 'known-predicate @@ -3494,21 +3527,7 @@ #f 1 1)) -(define effect_2975 - (struct-type-install-properties! - struct:known-predicate - '(known-predicate) - 1 - 0 - (if (struct-type? struct:known-procedure/pure) - struct:known-procedure/pure - (check-struct-type 'struct struct:known-procedure/pure)) - null - 'prefab - #f - '(0) - #f - 'known-predicate)) +(define effect_2144 (finish142 struct:known-predicate)) (define known-predicate (|#%name| known-predicate @@ -3542,6 +3561,20 @@ s 'known-predicate 'type)))))) +(define finish146 + (make-struct-type-install-properties + '(known-accessor) + 1 + 0 + (if (struct-type? struct:known-procedure/single-valued) + struct:known-procedure/single-valued + (check-struct-type 'struct struct:known-procedure/single-valued)) + null + 'prefab + #f + '(0) + #f + 'known-accessor)) (define struct:known-accessor (make-record-type-descriptor* 'known-accessor @@ -3561,21 +3594,7 @@ #f 1 1)) -(define effect_2542 - (struct-type-install-properties! - struct:known-accessor - '(known-accessor) - 1 - 0 - (if (struct-type? struct:known-procedure/single-valued) - struct:known-procedure/single-valued - (check-struct-type 'struct struct:known-procedure/single-valued)) - null - 'prefab - #f - '(0) - #f - 'known-accessor)) +(define effect_2905 (finish146 struct:known-accessor)) (define known-accessor (|#%name| known-accessor @@ -3609,6 +3628,20 @@ s 'known-accessor 'type)))))) +(define finish150 + (make-struct-type-install-properties + '(known-mutator) + 1 + 0 + (if (struct-type? struct:known-procedure/single-valued) + struct:known-procedure/single-valued + (check-struct-type 'struct struct:known-procedure/single-valued)) + null + 'prefab + #f + '(0) + #f + 'known-mutator)) (define struct:known-mutator (make-record-type-descriptor* 'known-mutator @@ -3628,21 +3661,7 @@ #f 1 1)) -(define effect_2533 - (struct-type-install-properties! - struct:known-mutator - '(known-mutator) - 1 - 0 - (if (struct-type? struct:known-procedure/single-valued) - struct:known-procedure/single-valued - (check-struct-type 'struct struct:known-procedure/single-valued)) - null - 'prefab - #f - '(0) - #f - 'known-mutator)) +(define effect_2521 (finish150 struct:known-mutator)) (define known-mutator (|#%name| known-mutator @@ -3676,6 +3695,20 @@ s 'known-mutator 'type)))))) +(define finish154 + (make-struct-type-install-properties + '(known-struct-constructor) + 1 + 0 + (if (struct-type? struct:known-constructor) + struct:known-constructor + (check-struct-type 'struct struct:known-constructor)) + null + 'prefab + #f + '(0) + #f + 'known-struct-constructor)) (define struct:known-struct-constructor (make-record-type-descriptor* 'known-struct-constructor @@ -3695,21 +3728,7 @@ #f 1 1)) -(define effect_2411 - (struct-type-install-properties! - struct:known-struct-constructor - '(known-struct-constructor) - 1 - 0 - (if (struct-type? struct:known-constructor) - struct:known-constructor - (check-struct-type 'struct struct:known-constructor)) - null - 'prefab - #f - '(0) - #f - 'known-struct-constructor)) +(define effect_3238 (finish154 struct:known-struct-constructor)) (define known-struct-constructor (|#%name| known-struct-constructor @@ -3750,6 +3769,20 @@ s 'known-struct-constructor 'type-id)))))) +(define finish158 + (make-struct-type-install-properties + '(known-struct-predicate) + 3 + 0 + (if (struct-type? struct:known-predicate) + struct:known-predicate + (check-struct-type 'struct struct:known-predicate)) + null + 'prefab + #f + '(0 1 2) + #f + 'known-struct-predicate)) (define struct:known-struct-predicate (make-record-type-descriptor* 'known-struct-predicate @@ -3761,29 +3794,15 @@ (if (struct-type? struct:known-predicate) struct:known-predicate (check-struct-type 'struct struct:known-predicate)) - 2 + 3 0 #f - '(0 1)) + '(0 1 2)) #f #f - 2 - 3)) -(define effect_2929 - (struct-type-install-properties! - struct:known-struct-predicate - '(known-struct-predicate) - 2 - 0 - (if (struct-type? struct:known-predicate) - struct:known-predicate - (check-struct-type 'struct struct:known-predicate)) - null - 'prefab - #f - '(0 1) - #f - 'known-struct-predicate)) + 3 + 7)) +(define effect_2384 (finish158 struct:known-struct-predicate)) (define known-struct-predicate (|#%name| known-struct-predicate @@ -3839,6 +3858,38 @@ s 'known-struct-predicate 'authentic?)))))) +(define known-struct-predicate-sealed?_2251 + (|#%name| + known-struct-predicate-sealed? + (record-accessor struct:known-struct-predicate 2))) +(define known-struct-predicate-sealed? + (|#%name| + known-struct-predicate-sealed? + (lambda (s) + (if (known-struct-predicate?_2418 s) + (known-struct-predicate-sealed?_2251 s) + ($value + (impersonate-ref + known-struct-predicate-sealed?_2251 + struct:known-struct-predicate + 2 + s + 'known-struct-predicate + 'sealed?)))))) +(define finish164 + (make-struct-type-install-properties + '(known-field-accessor) + 4 + 0 + (if (struct-type? struct:known-accessor) + struct:known-accessor + (check-struct-type 'struct struct:known-accessor)) + null + 'prefab + #f + '(0 1 2 3) + #f + 'known-field-accessor)) (define struct:known-field-accessor (make-record-type-descriptor* 'known-field-accessor @@ -3858,21 +3909,7 @@ #f 4 15)) -(define effect_2971 - (struct-type-install-properties! - struct:known-field-accessor - '(known-field-accessor) - 4 - 0 - (if (struct-type? struct:known-accessor) - struct:known-accessor - (check-struct-type 'struct struct:known-accessor)) - null - 'prefab - #f - '(0 1 2 3) - #f - 'known-field-accessor)) +(define effect_2259 (finish164 struct:known-field-accessor)) (define known-field-accessor (|#%name| known-field-accessor @@ -3964,6 +4001,20 @@ s 'known-field-accessor 'known-immutable?)))))) +(define finish171 + (make-struct-type-install-properties + '(known-field-mutator) + 3 + 0 + (if (struct-type? struct:known-mutator) + struct:known-mutator + (check-struct-type 'struct struct:known-mutator)) + null + 'prefab + #f + '(0 1 2) + #f + 'known-field-mutator)) (define struct:known-field-mutator (make-record-type-descriptor* 'known-field-mutator @@ -3983,21 +4034,7 @@ #f 3 7)) -(define effect_2493 - (struct-type-install-properties! - struct:known-field-mutator - '(known-field-mutator) - 3 - 0 - (if (struct-type? struct:known-mutator) - struct:known-mutator - (check-struct-type 'struct struct:known-mutator)) - null - 'prefab - #f - '(0 1 2) - #f - 'known-field-mutator)) +(define effect_2603 (finish171 struct:known-field-mutator)) (define known-field-mutator (|#%name| known-field-mutator @@ -4071,6 +4108,20 @@ s 'known-field-mutator 'pos)))))) +(define finish177 + (make-struct-type-install-properties + '(known-struct-constructor/need-imports) + 1 + 0 + (if (struct-type? struct:known-struct-constructor) + struct:known-struct-constructor + (check-struct-type 'struct struct:known-struct-constructor)) + null + 'prefab + #f + '(0) + #f + 'known-struct-constructor/need-imports)) (define struct:known-struct-constructor/need-imports (make-record-type-descriptor* 'known-struct-constructor/need-imports @@ -4090,21 +4141,7 @@ #f 1 1)) -(define effect_3135 - (struct-type-install-properties! - struct:known-struct-constructor/need-imports - '(known-struct-constructor/need-imports) - 1 - 0 - (if (struct-type? struct:known-struct-constructor) - struct:known-struct-constructor - (check-struct-type 'struct struct:known-struct-constructor)) - null - 'prefab - #f - '(0) - #f - 'known-struct-constructor/need-imports)) +(define effect_2146 (finish177 struct:known-struct-constructor/need-imports)) (define known-struct-constructor/need-imports (|#%name| known-struct-constructor/need-imports @@ -4145,6 +4182,20 @@ s 'known-struct-constructor/need-imports 'needed)))))) +(define finish181 + (make-struct-type-install-properties + '(known-struct-predicate/need-imports) + 1 + 0 + (if (struct-type? struct:known-struct-predicate) + struct:known-struct-predicate + (check-struct-type 'struct struct:known-struct-predicate)) + null + 'prefab + #f + '(0) + #f + 'known-struct-predicate/need-imports)) (define struct:known-struct-predicate/need-imports (make-record-type-descriptor* 'known-struct-predicate/need-imports @@ -4164,21 +4215,7 @@ #f 1 1)) -(define effect_2453 - (struct-type-install-properties! - struct:known-struct-predicate/need-imports - '(known-struct-predicate/need-imports) - 1 - 0 - (if (struct-type? struct:known-struct-predicate) - struct:known-struct-predicate - (check-struct-type 'struct struct:known-struct-predicate)) - null - 'prefab - #f - '(0) - #f - 'known-struct-predicate/need-imports)) +(define effect_3156 (finish181 struct:known-struct-predicate/need-imports)) (define known-struct-predicate/need-imports (|#%name| known-struct-predicate/need-imports @@ -4219,6 +4256,20 @@ s 'known-struct-predicate/need-imports 'needed)))))) +(define finish185 + (make-struct-type-install-properties + '(known-field-accessor/need-imports) + 1 + 0 + (if (struct-type? struct:known-field-accessor) + struct:known-field-accessor + (check-struct-type 'struct struct:known-field-accessor)) + null + 'prefab + #f + '(0) + #f + 'known-field-accessor/need-imports)) (define struct:known-field-accessor/need-imports (make-record-type-descriptor* 'known-field-accessor/need-imports @@ -4238,21 +4289,7 @@ #f 1 1)) -(define effect_2353 - (struct-type-install-properties! - struct:known-field-accessor/need-imports - '(known-field-accessor/need-imports) - 1 - 0 - (if (struct-type? struct:known-field-accessor) - struct:known-field-accessor - (check-struct-type 'struct struct:known-field-accessor)) - null - 'prefab - #f - '(0) - #f - 'known-field-accessor/need-imports)) +(define effect_2513 (finish185 struct:known-field-accessor/need-imports)) (define known-field-accessor/need-imports (|#%name| known-field-accessor/need-imports @@ -4293,6 +4330,20 @@ s 'known-field-accessor/need-imports 'needed)))))) +(define finish189 + (make-struct-type-install-properties + '(known-field-mutator/need-imports) + 1 + 0 + (if (struct-type? struct:known-field-mutator) + struct:known-field-mutator + (check-struct-type 'struct struct:known-field-mutator)) + null + 'prefab + #f + '(0) + #f + 'known-field-mutator/need-imports)) (define struct:known-field-mutator/need-imports (make-record-type-descriptor* 'known-field-mutator/need-imports @@ -4312,21 +4363,7 @@ #f 1 1)) -(define effect_2148 - (struct-type-install-properties! - struct:known-field-mutator/need-imports - '(known-field-mutator/need-imports) - 1 - 0 - (if (struct-type? struct:known-field-mutator) - struct:known-field-mutator - (check-struct-type 'struct struct:known-field-mutator)) - null - 'prefab - #f - '(0) - #f - 'known-field-mutator/need-imports)) +(define effect_2273 (finish189 struct:known-field-mutator/need-imports)) (define known-field-mutator/need-imports (|#%name| known-field-mutator/need-imports @@ -4367,6 +4404,18 @@ s 'known-field-mutator/need-imports 'needed)))))) +(define finish193 + (make-struct-type-install-properties + '(known-struct-type-property/immediate-guard) + 0 + 0 + #f + null + 'prefab + #f + '() + #f + 'known-struct-type-property/immediate-guard)) (define struct:known-struct-type-property/immediate-guard (make-record-type-descriptor* 'known-struct-type-property/immediate-guard @@ -4382,19 +4431,8 @@ #f 0 0)) -(define effect_2693 - (struct-type-install-properties! - struct:known-struct-type-property/immediate-guard - '(known-struct-type-property/immediate-guard) - 0 - 0 - #f - null - 'prefab - #f - '() - #f - 'known-struct-type-property/immediate-guard)) +(define effect_2294 + (finish193 struct:known-struct-type-property/immediate-guard)) (define known-struct-type-property/immediate-guard (|#%name| known-struct-type-property/immediate-guard @@ -4435,18 +4473,8 @@ (let ((app_0 (if (string? prefix_0) prefix_0 (symbol->string prefix_0)))) (string-append app_0 (number->string (unbox b_0))))))))) -(define struct:import - (make-record-type-descriptor* - 'import - #f - (|#%nongenerative-uid| import) - #f - #f - 4 - 0)) -(define effect_3124 - (struct-type-install-properties! - struct:import +(define finish197 + (make-struct-type-install-properties '(import) 4 0 @@ -4457,6 +4485,16 @@ '(0 1 2 3) #f 'import)) +(define struct:import + (make-record-type-descriptor* + 'import + #f + (|#%nongenerative-uid| import) + #f + #f + 4 + 0)) +(define effect_2192 (finish197 struct:import)) (define import1.1 (|#%name| import @@ -4522,18 +4560,8 @@ s 'import 'ext-id)))))) -(define struct:import-group - (make-record-type-descriptor* - 'import-group - #f - (|#%nongenerative-uid| import-group) - #f - #f - 6 - 60)) -(define effect_2534 - (struct-type-install-properties! - struct:import-group +(define finish204 + (make-struct-type-install-properties '(import-group) 6 0 @@ -4544,6 +4572,16 @@ '(0 1) #f 'import-group)) +(define struct:import-group + (make-record-type-descriptor* + 'import-group + #f + (|#%nongenerative-uid| import-group) + #f + #f + 6 + 60)) +(define effect_2739 (finish204 struct:import-group)) (define import-group2.1 (|#%name| import-group @@ -4892,18 +4930,8 @@ (|#%app| inc-index!_0) (|#%app| add-group!_0 grp_0) grp_0)))))) -(define struct:export - (make-record-type-descriptor* - 'export - #f - (|#%nongenerative-uid| export) - #f - #f - 2 - 0)) -(define effect_2393 - (struct-type-install-properties! - struct:export +(define finish218 + (make-struct-type-install-properties '(export) 2 0 @@ -4914,6 +4942,16 @@ '(0 1) #f 'export)) +(define struct:export + (make-record-type-descriptor* + 'export + #f + (|#%nongenerative-uid| export) + #f + #f + 2 + 0)) +(define effect_2782 (finish218 struct:export)) (define export1.1 (|#%name| export @@ -4953,18 +4991,8 @@ s 'export 'ext-id)))))) -(define struct:too-early - (make-record-type-descriptor* - 'too-early - #f - (|#%nongenerative-uid| too-early) - #f - #f - 2 - 0)) -(define effect_2424 - (struct-type-install-properties! - struct:too-early +(define finish223 + (make-struct-type-install-properties '(too-early) 2 0 @@ -4975,6 +5003,16 @@ '(0 1) #f 'too-early)) +(define struct:too-early + (make-record-type-descriptor* + 'too-early + #f + (|#%nongenerative-uid| too-early) + #f + #f + 2 + 0)) +(define effect_2833 (finish223 struct:too-early)) (define too-early1.1 (|#%name| too-early @@ -7262,6 +7300,18 @@ (case-lambda ((k_0 im_0) k_0) (args (raise-binding-result-arity-error 2 args)))))) +(define finish311 + (make-struct-type-install-properties + '(struct-type-info) + 11 + 0 + #f + null + (current-inspector) + #f + '(0 1 2 3 4 5 6 7 8 9 10) + #f + 'struct-type-info)) (define struct:struct-type-info (make-record-type-descriptor* 'struct-type-info @@ -7269,21 +7319,9 @@ (|#%nongenerative-uid| struct-type-info) #f #f - 10 + 11 0)) -(define effect_2476 - (struct-type-install-properties! - struct:struct-type-info - '(struct-type-info) - 10 - 0 - #f - null - (current-inspector) - #f - '(0 1 2 3 4 5 6 7 8 9) - #f - 'struct-type-info)) +(define effect_2037 (finish311 struct:struct-type-info)) (define struct-type-info1.1 (|#%name| struct-type-info @@ -7407,73 +7445,93 @@ s 'struct-type-info 'authentic?)))))) -(define struct-type-info-prefab-immutables_2632 +(define struct-type-info-sealed?_2632 + (|#%name| + struct-type-info-sealed? + (record-accessor struct:struct-type-info 6))) +(define struct-type-info-sealed? + (|#%name| + struct-type-info-sealed? + (lambda (s) + (if (struct-type-info?_2591 s) + (struct-type-info-sealed?_2632 s) + ($value + (impersonate-ref + struct-type-info-sealed?_2632 + struct:struct-type-info + 6 + s + 'struct-type-info + 'sealed?)))))) +(define struct-type-info-prefab-immutables_2507 (|#%name| struct-type-info-prefab-immutables - (record-accessor struct:struct-type-info 6))) + (record-accessor struct:struct-type-info 7))) (define struct-type-info-prefab-immutables (|#%name| struct-type-info-prefab-immutables (lambda (s) (if (struct-type-info?_2591 s) - (struct-type-info-prefab-immutables_2632 s) + (struct-type-info-prefab-immutables_2507 s) ($value (impersonate-ref - struct-type-info-prefab-immutables_2632 + struct-type-info-prefab-immutables_2507 struct:struct-type-info - 6 + 7 s 'struct-type-info 'prefab-immutables)))))) -(define struct-type-info-non-prefab-immutables_2507 +(define struct-type-info-non-prefab-immutables_2796 (|#%name| struct-type-info-non-prefab-immutables - (record-accessor struct:struct-type-info 7))) + (record-accessor struct:struct-type-info 8))) (define struct-type-info-non-prefab-immutables (|#%name| struct-type-info-non-prefab-immutables (lambda (s) (if (struct-type-info?_2591 s) - (struct-type-info-non-prefab-immutables_2507 s) + (struct-type-info-non-prefab-immutables_2796 s) ($value (impersonate-ref - struct-type-info-non-prefab-immutables_2507 + struct-type-info-non-prefab-immutables_2796 struct:struct-type-info - 7 + 8 s 'struct-type-info 'non-prefab-immutables)))))) -(define struct-type-info-constructor-name-expr_2796 +(define struct-type-info-constructor-name-expr_2430 (|#%name| struct-type-info-constructor-name-expr - (record-accessor struct:struct-type-info 8))) + (record-accessor struct:struct-type-info 9))) (define struct-type-info-constructor-name-expr (|#%name| struct-type-info-constructor-name-expr (lambda (s) (if (struct-type-info?_2591 s) - (struct-type-info-constructor-name-expr_2796 s) + (struct-type-info-constructor-name-expr_2430 s) ($value (impersonate-ref - struct-type-info-constructor-name-expr_2796 + struct-type-info-constructor-name-expr_2430 struct:struct-type-info - 8 + 9 s 'struct-type-info 'constructor-name-expr)))))) -(define struct-type-info-rest_2430 - (|#%name| struct-type-info-rest (record-accessor struct:struct-type-info 9))) +(define struct-type-info-rest_2501 + (|#%name| + struct-type-info-rest + (record-accessor struct:struct-type-info 10))) (define struct-type-info-rest (|#%name| struct-type-info-rest (lambda (s) (if (struct-type-info?_2591 s) - (struct-type-info-rest_2430 s) + (struct-type-info-rest_2501 s) ($value (impersonate-ref - struct-type-info-rest_2430 + struct-type-info-rest_2501 struct:struct-type-info - 9 + 10 s 'struct-type-info 'rest)))))) @@ -8571,21 +8629,25 @@ (let ((app_2 (includes-property?_0 'prop:authentic))) - (struct-type-info1.1 - name_0 - parent_0 - fields_0 - app_0 - app_1 - app_2 - (if (eq? - prefab-imms_1 - 'non-prefab) - #f - prefab-imms_1) - non-prefab-imms_0 - constructor-name-expr_0 - rest_0)))) + (let ((app_3 + (includes-property?_0 + 'prop:sealed))) + (struct-type-info1.1 + name_0 + parent_0 + fields_0 + app_0 + app_1 + app_2 + app_3 + (if (eq? + prefab-imms_1 + 'non-prefab) + #f + prefab-imms_1) + non-prefab-imms_0 + constructor-name-expr_0 + rest_0))))) #f)))))))) #f) #f) @@ -12865,12 +12927,14 @@ (let ((app_1 (known-predicate-type k_0))) (let ((app_2 (known-struct-predicate-type-id k_0))) (let ((app_3 (known-struct-predicate-authentic? k_0))) - (known-struct-predicate/need-imports - app_0 - app_1 - app_2 - app_3 - (begin-unsafe (hash-map needed_0 cons #t))))))) + (let ((app_4 (known-struct-predicate-sealed? k_0))) + (known-struct-predicate/need-imports + app_0 + app_1 + app_2 + app_3 + app_4 + (begin-unsafe (hash-map needed_0 cons #t)))))))) (let ((app_0 (known-procedure-arity-mask k_0))) (known-predicate app_0 (known-predicate-type k_0))))) (if (known-field-accessor? k_0) @@ -15184,279 +15248,236 @@ a-known-constant))))) (let ((authentic?_0 (struct-type-info-authentic? info_0))) - (let ((knowns_1 - (let ((app_0 (unwrap s?_0))) - (hash-set - knowns_0 - app_0 - (known-struct-predicate - 2 - type_0 - struct:s_0 - authentic?_0))))) - (let ((knowns_2 - (let ((immediate-count_0 - (struct-type-info-immediate-field-count - info_0))) - (let ((parent-count_0 - (- - (struct-type-info-field-count - info_0) - immediate-count_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (knowns_2 lst_0 lst_1) - (begin - (if (if (pair? lst_0) - (pair? lst_1) - #f) - (let ((id_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr + (let ((sealed?_0 (struct-type-info-sealed? info_0))) + (let ((knowns_1 + (let ((app_0 (unwrap s?_0))) + (hash-set + knowns_0 + app_0 + (known-struct-predicate + 2 + type_0 + struct:s_0 + authentic?_0 + sealed?_0))))) + (let ((knowns_2 + (let ((immediate-count_0 + (struct-type-info-immediate-field-count + info_0))) + (let ((parent-count_0 + (- + (struct-type-info-field-count + info_0) + immediate-count_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (knowns_2 lst_0 lst_1) + (begin + (if (if (pair? lst_0) + (pair? lst_1) + #f) + (let ((id_0 + (unsafe-car lst_0))) - (let ((maker_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((maker_0 + (unsafe-car lst_1))) - (let ((knowns_3 - (let ((knowns_3 - (if (let ((p_0 - (unwrap - maker_0))) - (if (pair? - p_0) - (let ((a_0 - (cdr - p_0))) - (let ((p_1 - (unwrap - a_0))) - (if (pair? - p_1) - (let ((a_1 - (cdr - p_1))) - (let ((p_2 - (unwrap - a_1))) - (if (pair? - p_2) - (let ((a_2 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (if (let ((a_3 - (car - p_3))) - (let ((p_4 - (unwrap - a_3))) - (if (pair? - p_4) - (if (let ((a_4 - (car - p_4))) - (begin-unsafe - (let ((app_0 - (unwrap - 'quote))) - (eq? - app_0 - (unwrap - a_4))))) - (let ((a_4 - (cdr - p_4))) - (let ((p_5 - (unwrap - a_4))) - (if (pair? - p_5) - (let ((a_5 - (cdr - p_5))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f))) - #f) - #f))) - (let ((a_3 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f) - #f))) - #f))) - #f))) - #f)) - (call-with-values - (lambda () - (let ((p_0 - (unwrap - maker_0))) - (let ((make_1 - (let ((a_0 - (car - p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_0 - (cdr - p_0))) - (let ((p_1 - (unwrap - d_0))) - (let ((ref-or-set_0 - (let ((a_0 - (car - p_1))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 - (cdr - p_1))) - (let ((p_2 - (unwrap - d_1))) - (let ((pos_0 - (let ((a_0 + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((knowns_3 + (let ((knowns_3 + (if (let ((p_0 + (unwrap + maker_0))) + (if (pair? + p_0) + (let ((a_0 + (cdr + p_0))) + (let ((p_1 + (unwrap + a_0))) + (if (pair? + p_1) + (let ((a_1 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_1))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (if (let ((a_3 (car - p_2))) - a_0))) - (let ((name_0 - (let ((d_2 - (cdr - p_2))) - (let ((a_0 - (car - (unwrap - d_2)))) - (let ((d_3 - (cdr - (unwrap - a_0)))) - (let ((a_1 - (car + p_3))) + (let ((p_4 + (unwrap + a_3))) + (if (pair? + p_4) + (if (let ((a_4 + (car + p_4))) + (begin-unsafe + (let ((app_0 + (unwrap + 'quote))) + (eq? + app_0 (unwrap - d_3)))) - a_1)))))) - (let ((pos_1 - pos_0)) - (values - pos_1 - name_0))))))) - (case-lambda - ((pos_0 - name_0) - (let ((ref-or-set_1 - ref-or-set_0)) - (values - ref-or-set_1 - pos_0 - name_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((ref-or-set_0 - pos_0 - name_0) - (let ((make_2 - make_1)) - (values - make_2 - ref-or-set_0 - pos_0 - name_0))) - (args - (raise-binding-result-arity-error - 3 - args))))))) - (case-lambda - ((make_1 - ref-or-set_0 - pos_0 - name_0) - (let ((or-part_0 - (if (exact-nonnegative-integer? - pos_0) - (if (< - pos_0 - immediate-count_0) - (if (symbol? - name_0) - (if (if (begin-unsafe - (let ((app_0 - (unwrap - make_1))) - (eq? - app_0 - (unwrap - 'make-struct-field-accessor)))) - (begin-unsafe - (let ((app_0 + a_4))))) + (let ((a_4 + (cdr + p_4))) + (let ((p_5 + (unwrap + a_4))) + (if (pair? + p_5) + (let ((a_5 + (cdr + p_5))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_5))))) + #f))) + #f) + #f))) + (let ((a_3 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f) + #f))) + #f))) + #f))) + #f)) + (call-with-values + (lambda () + (let ((p_0 + (unwrap + maker_0))) + (let ((make_1 + (let ((a_0 + (car + p_0))) + a_0))) + (call-with-values + (lambda () + (let ((d_0 + (cdr + p_0))) + (let ((p_1 + (unwrap + d_0))) + (let ((ref-or-set_0 + (let ((a_0 + (car + p_1))) + a_0))) + (call-with-values + (lambda () + (let ((d_1 + (cdr + p_1))) + (let ((p_2 (unwrap - ref-or-set_0))) - (eq? - app_0 - (unwrap - -ref_0)))) - #f) - (let ((immutable?_0 - (memv - pos_0 - (let ((or-part_0 - (struct-type-info-prefab-immutables - info_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (struct-type-info-non-prefab-immutables - info_0))) - (if or-part_1 - or-part_1 - '()))))))) - (let ((app_0 - (unwrap - id_0))) - (hash-set - knowns_2 - app_0 - (known-field-accessor - 2 - type_0 - struct:s_0 - authentic?_0 - (+ - parent-count_0 - pos_0) - immutable?_0)))) + d_1))) + (let ((pos_0 + (let ((a_0 + (car + p_2))) + a_0))) + (let ((name_0 + (let ((d_2 + (cdr + p_2))) + (let ((a_0 + (car + (unwrap + d_2)))) + (let ((d_3 + (cdr + (unwrap + a_0)))) + (let ((a_1 + (car + (unwrap + d_3)))) + a_1)))))) + (let ((pos_1 + pos_0)) + (values + pos_1 + name_0))))))) + (case-lambda + ((pos_0 + name_0) + (let ((ref-or-set_1 + ref-or-set_0)) + (values + ref-or-set_1 + pos_0 + name_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((ref-or-set_0 + pos_0 + name_0) + (let ((make_2 + make_1)) + (values + make_2 + ref-or-set_0 + pos_0 + name_0))) + (args + (raise-binding-result-arity-error + 3 + args))))))) + (case-lambda + ((make_1 + ref-or-set_0 + pos_0 + name_0) + (let ((or-part_0 + (if (exact-nonnegative-integer? + pos_0) + (if (< + pos_0 + immediate-count_0) + (if (symbol? + name_0) (if (if (begin-unsafe (let ((app_0 (unwrap @@ -15464,7 +15485,7 @@ (eq? app_0 (unwrap - 'make-struct-field-mutator)))) + 'make-struct-field-accessor)))) (begin-unsafe (let ((app_0 (unwrap @@ -15472,59 +15493,108 @@ (eq? app_0 (unwrap - -set!_0)))) + -ref_0)))) #f) - (let ((app_0 - (unwrap - id_0))) - (hash-set - knowns_2 - app_0 - (known-field-mutator - 4 - type_0 - struct:s_0 - authentic?_0 - (+ - parent-count_0 - pos_0)))) - knowns_2)) + (let ((immutable?_0 + (memv + pos_0 + (let ((or-part_0 + (struct-type-info-prefab-immutables + info_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (struct-type-info-non-prefab-immutables + info_0))) + (if or-part_1 + or-part_1 + '()))))))) + (let ((app_0 + (unwrap + id_0))) + (hash-set + knowns_2 + app_0 + (known-field-accessor + 2 + type_0 + struct:s_0 + authentic?_0 + (+ + parent-count_0 + pos_0) + immutable?_0)))) + (if (if (begin-unsafe + (let ((app_0 + (unwrap + make_1))) + (eq? + app_0 + (unwrap + 'make-struct-field-mutator)))) + (begin-unsafe + (let ((app_0 + (unwrap + ref-or-set_0))) + (eq? + app_0 + (unwrap + -set!_0)))) + #f) + (let ((app_0 + (unwrap + id_0))) + (hash-set + knowns_2 + app_0 + (known-field-mutator + 4 + type_0 + struct:s_0 + authentic?_0 + (+ + parent-count_0 + pos_0)))) + knowns_2)) + #f) #f) - #f) - #f))) - (if or-part_0 - or-part_0 - knowns_2))) - (args - (raise-binding-result-arity-error - 4 - args)))) - knowns_2))) - (values - knowns_3)))) - (for-loop_0 - knowns_3 - rest_0 - rest_1)))))) - knowns_2)))))) - (for-loop_0 - knowns_1 - acc/muts_0 - make-acc/muts_0))))))) - (values - (let ((app_0 (unwrap struct:s_0))) - (hash-set - knowns_2 - app_0 - (let ((app_1 - (struct-type-info-field-count - info_0))) - (known-struct-type - type_0 - app_1 - (struct-type-info-pure-constructor? - info_0))))) - info_0)))))) + #f))) + (if or-part_0 + or-part_0 + knowns_2))) + (args + (raise-binding-result-arity-error + 4 + args)))) + knowns_2))) + (values + knowns_3)))) + (for-loop_0 + knowns_3 + rest_0 + rest_1)))))) + knowns_2)))))) + (for-loop_0 + knowns_1 + acc/muts_0 + make-acc/muts_0))))))) + (values + (let ((app_0 (unwrap struct:s_0))) + (hash-set + knowns_2 + app_0 + (let ((app_1 + (struct-type-info-field-count + info_0))) + (let ((app_2 + (struct-type-info-pure-constructor? + info_0))) + (known-struct-type + type_0 + app_1 + app_2 + (struct-type-info-sealed? info_0)))))) + info_0))))))) (values knowns7_0 #f)))) (args (raise-binding-result-arity-error 14 args)))) (if (if (eq? 'define-values hd_0) @@ -15704,22 +15774,29 @@ (hash-set knowns_0 app_0 - (known-struct-predicate - 2 - type_0 - struct:s_0 - (struct-type-info-authentic? info_0)))))) + (let ((app_1 + (struct-type-info-authentic? + info_0))) + (known-struct-predicate + 2 + type_0 + struct:s_0 + app_1 + (struct-type-info-sealed? info_0))))))) (let ((app_0 (unwrap struct:s_0))) (hash-set knowns_1 app_0 (let ((app_1 (struct-type-info-field-count info_0))) - (known-struct-type - type_0 - app_1 - (struct-type-info-pure-constructor? - info_0))))))) + (let ((app_2 + (struct-type-info-pure-constructor? + info_0))) + (known-struct-type + type_0 + app_1 + app_2 + (struct-type-info-sealed? info_0)))))))) info_0)) (values knowns7_0 #f)))) (args (raise-binding-result-arity-error 6 args)))) @@ -17043,296 +17120,282 @@ (unwrap struct:s_0) 'no)))) #f))) - (let ((app_0 - (list - 'define - struct:s_0 - (let ((app_0 - (list - 'quote - (struct-type-info-name sti_0)))) - (let ((app_1 - (|#%app| - schemify_0 - (struct-type-info-parent sti_0) - knowns_0))) - (let ((app_2 - (if (not - (struct-type-info-prefab-immutables - sti_0)) - (if (if top?_0 - (eq? target_0 'system) - #f) - (list - '|#%nongenerative-uid| - (struct-type-info-name sti_0)) - #f) - (let ((app_2 - (list - 'quote - (struct-type-info-name - sti_0)))) - (let ((app_3 - (|#%app| - schemify_0 - (struct-type-info-parent - sti_0) - knowns_0))) - (let ((app_4 - (struct-type-info-immediate-field-count - sti_0))) - (list - 'structure-type-lookup-prefab-uid - app_2 - app_3 - app_4 - 0 - #f - (list - 'quote - (struct-type-info-prefab-immutables - sti_0))))))))) - (let ((app_3 - (struct-type-info-immediate-field-count - sti_0))) - (list - 'make-record-type-descriptor* - app_0 - app_1 - app_2 - #f - #f - app_3 - (let ((n_0 - (struct-type-info-immediate-field-count - sti_0))) - (let ((mask_0 - (sub1 - (arithmetic-shift 1 n_0)))) - (let ((c1_0 - (struct-type-info-non-prefab-immutables - sti_0))) - (if c1_0 - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (imms_0 mask_1) - (begin - (if (null? imms_0) - mask_1 - (let ((m_0 - (bitwise-not - (arithmetic-shift - 1 - (car - imms_0))))) - (let ((app_4 - (cdr imms_0))) - (loop_0 - app_4 - (bitwise-and - mask_1 - m_0)))))))))) - (loop_0 c1_0 mask_0)) - mask_0)))))))))))) + (let ((finish!-id_0 + (if (let ((or-part_0 + (pair? (struct-type-info-rest sti_0)))) + (if or-part_0 + or-part_0 + (if (struct-type-info-prefab-immutables + sti_0) + (unwrap (struct-type-info-parent sti_0)) + #f))) + (deterministic-gensym "finish") + #f))) (list* 'begin - app_0 - (let ((app_1 - (if (null? (struct-type-info-rest sti_0)) - null + (let ((app_0 + (if finish!-id_0 (list - (let ((app_1 - (deterministic-gensym "effect"))) - (list - 'define - app_1 - (let ((app_2 - (list - 'quote - (if system-opaque?_0 - (list - (struct-type-info-name sti_0)) - (struct-type-info-name - sti_0))))) - (let ((app_3 - (struct-type-info-immediate-field-count - sti_0))) - (let ((app_4 - (|#%app| - schemify_0 - (struct-type-info-parent - sti_0) - knowns_0))) - (list* - 'struct-type-install-properties! - struct:s_0 - app_2 - app_3 - 0 - app_4 - (schemify-body$1 - schemify_0 - knowns_0 - (struct-type-info-rest - sti_0)))))))))))) - (qq-append - app_1 - (let ((app_2 (list 'define - make-s_0 - (let ((ctr_0 + finish!-id_0 + (let ((app_0 (list - 'record-constructor - (list* - 'make-record-constructor-descriptor - struct:s_0 - '(#f #f))))) - (let ((ctr-expr_0 - (if (struct-type-info-pure-constructor? - sti_0) - ctr_0 - (list - 'struct-type-constructor-add-guards - ctr_0 - struct:s_0 - (list - 'quote - (struct-type-info-name - sti_0)))))) - (let ((name-expr_0 - (struct-type-info-constructor-name-expr - sti_0))) - (let ((c_0 - (if (begin-unsafe - (let ((app_2 (unwrap #f))) - (eq? - app_2 - (unwrap name-expr_0)))) - (wrap-property-set - ctr-expr_0 - 'inferred-name + 'quote + (if system-opaque?_0 + (list + (struct-type-info-name sti_0)) + (struct-type-info-name sti_0))))) + (let ((app_1 + (struct-type-info-immediate-field-count + sti_0))) + (let ((app_2 + (|#%app| + schemify_0 + (struct-type-info-parent sti_0) + knowns_0))) + (list* + 'make-struct-type-install-properties + app_0 + app_1 + 0 + app_2 + (schemify-body$1 + schemify_0 + knowns_0 + (struct-type-info-rest sti_0)))))))) + null))) + (qq-append + app_0 + (let ((app_1 + (list + 'define + struct:s_0 + (let ((app_1 + (list + 'quote + (struct-type-info-name sti_0)))) + (let ((app_2 + (|#%app| + schemify_0 + (struct-type-info-parent sti_0) + knowns_0))) + (let ((app_3 + (if (not + (struct-type-info-prefab-immutables + sti_0)) + (if (if top?_0 + (eq? target_0 'system) + #f) + (list + '|#%nongenerative-uid| (struct-type-info-name sti_0)) - (if (let ((p_0 - (unwrap - name-expr_0))) - (if (pair? p_0) - (if (let ((a_0 - (car - p_0))) - (begin-unsafe - (let ((app_2 - (unwrap - 'quote))) - (eq? - app_2 - (unwrap - a_0))))) - (let ((a_0 - (cdr p_0))) - (let ((p_1 - (unwrap - a_0))) - (if (pair? p_1) - (let ((a_1 + #f) + (let ((app_3 + (list + 'quote + (struct-type-info-name + sti_0)))) + (let ((app_4 + (|#%app| + schemify_0 + (struct-type-info-parent + sti_0) + knowns_0))) + (let ((app_5 + (struct-type-info-immediate-field-count + sti_0))) + (list + 'structure-type-lookup-prefab-uid + app_3 + app_4 + app_5 + 0 + #f + (list + 'quote + (struct-type-info-prefab-immutables + sti_0))))))))) + (let ((app_4 + (struct-type-info-sealed? + sti_0))) + (let ((app_5 + (struct-type-info-immediate-field-count + sti_0))) + (list + 'make-record-type-descriptor* + app_1 + app_2 + app_3 + app_4 + #f + app_5 + (let ((n_0 + (struct-type-info-immediate-field-count + sti_0))) + (let ((mask_0 + (sub1 + (arithmetic-shift + 1 + n_0)))) + (let ((c1_0 + (struct-type-info-non-prefab-immutables + sti_0))) + (if c1_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (imms_0 + mask_1) + (begin + (if (null? + imms_0) + mask_1 + (let ((m_0 + (bitwise-not + (arithmetic-shift + 1 + (car + imms_0))))) + (let ((app_6 (cdr - p_1))) - (begin-unsafe - (let ((app_2 - (unwrap - '()))) - (eq? - app_2 - (unwrap - a_1))))) - #f))) - #f) - #f)) - (let ((sym_0 - (let ((d_0 - (cdr - (unwrap - name-expr_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_0)))) - (if (symbol? sym_0) + imms_0))) + (loop_0 + app_6 + (bitwise-and + mask_1 + m_0)))))))))) + (loop_0 c1_0 mask_0)) + mask_0))))))))))))) + (list* + app_1 + (let ((app_2 + (if finish!-id_0 + (list + (let ((app_2 + (deterministic-gensym + "effect"))) + (list + 'define + app_2 + (list finish!-id_0 struct:s_0)))) + null))) + (qq-append + app_2 + (let ((app_3 + (list + 'define + make-s_0 + (let ((ctr_0 + (list + 'record-constructor + (list* + 'make-record-constructor-descriptor + struct:s_0 + '(#f #f))))) + (let ((ctr-expr_0 + (if (struct-type-info-pure-constructor? + sti_0) + ctr_0 + (list + 'struct-type-constructor-add-guards + ctr_0 + struct:s_0 + (list + 'quote + (struct-type-info-name + sti_0)))))) + (let ((name-expr_0 + (struct-type-info-constructor-name-expr + sti_0))) + (let ((c_0 + (if (begin-unsafe + (let ((app_3 + (unwrap #f))) + (eq? + app_3 + (unwrap + name-expr_0)))) (wrap-property-set ctr-expr_0 'inferred-name - sym_0) - (list - 'procedure-rename - ctr-expr_0 - name-expr_0))) - (list - 'procedure-rename - ctr-expr_0 - name-expr_0))))) - (if system-opaque?_0 - c_0 - (list - '|#%struct-constructor| - c_0 - (arithmetic-shift - 1 - (struct-type-info-field-count - sti_0))))))))))) - (let ((app_3 - (list - 'define - raw-s?_0 - (let ((pre_0 "")) - (let ((p_0 - (let ((st_0 - (struct-type-info-name - sti_0))) - (let ((sep_0 "")) - (let ((post_0 "?")) - (let ((proc-expr_0 - (list - 'record-predicate - struct:s_0))) - (let ((post_1 post_0) - (sep_1 sep_0) - (st_1 st_0) - (pre_1 pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_3 - (symbol->string - st_1))) - (string-append - pre_1 - app_3 - sep_1 - (symbol->string - '||) - post_1)))))))))))) - (if (if can-impersonate?_0 - can-impersonate?_0 - system-opaque?_0) - p_0 - (list - '|#%struct-predicate| - p_0))))))) - (list* - app_2 - app_3 - (let ((app_4 - (if can-impersonate?_0 - (list + (struct-type-info-name + sti_0)) + (if (let ((p_0 + (unwrap + name-expr_0))) + (if (pair? p_0) + (if (let ((a_0 + (car + p_0))) + (begin-unsafe + (let ((app_3 + (unwrap + 'quote))) + (eq? + app_3 + (unwrap + a_0))))) + (let ((a_0 + (cdr + p_0))) + (let ((p_1 + (unwrap + a_0))) + (if (pair? + p_1) + (let ((a_1 + (cdr + p_1))) + (begin-unsafe + (let ((app_3 + (unwrap + '()))) + (eq? + app_3 + (unwrap + a_1))))) + #f))) + #f) + #f)) + (let ((sym_0 + (let ((d_0 + (cdr + (unwrap + name-expr_0)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (if (symbol? sym_0) + (wrap-property-set + ctr-expr_0 + 'inferred-name + sym_0) + (list + 'procedure-rename + ctr-expr_0 + name-expr_0))) + (list + 'procedure-rename + ctr-expr_0 + name-expr_0))))) + (if system-opaque?_0 + c_0 + (list + '|#%struct-constructor| + c_0 + (arithmetic-shift + 1 + (struct-type-info-field-count + sti_0))))))))))) + (let ((app_4 (list 'define - s?_0 + raw-s?_0 (let ((pre_0 "")) (let ((p_0 (let ((st_0 @@ -17342,25 +17405,8 @@ (let ((post_0 "?")) (let ((proc-expr_0 (list - 'lambda - '(v) - (list - 'if - (list* - raw-s?_0 - '(v)) - #t - (list - '$value - (list* - 'if - '(impersonator? - v) - (list* - raw-s?_0 - '((impersonator-val - v))) - '(#f))))))) + 'record-predicate + struct:s_0))) (let ((post_1 post_0) (sep_1 sep_0) @@ -17382,609 +17428,682 @@ (symbol->string '||) post_1)))))))))))) - (if system-opaque?_0 + (if (if can-impersonate?_0 + can-impersonate?_0 + system-opaque?_0) p_0 (list '|#%struct-predicate| - p_0)))))) - null))) - (qq-append - app_4 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0 lst_1) - (begin - (if (if (pair? lst_0) - (pair? lst_1) - #f) - (let ((acc/mut_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((make-acc/mut_0 - (unsafe-car lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((raw-acc/mut_0 - (if can-impersonate?_0 - (deterministic-gensym - (unwrap - acc/mut_0)) - acc/mut_0))) - (let ((hd_1 - (let ((p_0 + p_0))))))) + (list* + app_3 + app_4 + (let ((app_5 + (if can-impersonate?_0 + (list + (list + 'define + s?_0 + (let ((pre_0 "")) + (let ((p_0 + (let ((st_0 + (struct-type-info-name + sti_0))) + (let ((sep_0 "")) + (let ((post_0 + "?")) + (let ((proc-expr_0 + (list + 'lambda + '(v) + (list + 'if + (list* + raw-s?_0 + '(v)) + #t + (list + '$value + (list* + 'if + '(impersonator? + v) + (list* + raw-s?_0 + '((impersonator-val + v))) + '(#f))))))) + (let ((post_1 + post_0) + (sep_1 + sep_0) + (st_1 + st_0) + (pre_1 + pre_0)) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_5 + (symbol->string + st_1))) + (string-append + pre_1 + app_5 + sep_1 + (symbol->string + '||) + post_1)))))))))))) + (if system-opaque?_0 + p_0 + (list + '|#%struct-predicate| + p_0)))))) + null))) + (qq-append + app_5 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0 + lst_1) + (begin + (if (if (pair? lst_0) + (pair? lst_1) + #f) + (let ((acc/mut_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((make-acc/mut_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((raw-acc/mut_0 + (if can-impersonate?_0 + (deterministic-gensym (unwrap - make-acc/mut_0))) - (if (pair? - p_0) - (unwrap - (car - p_0)) - #f)))) - (if (if (eq? - 'make-struct-field-accessor - hd_1) - (let ((a_0 - (cdr - (unwrap - make-acc/mut_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (let ((a_2 - (cdr - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (if (let ((a_3 - (car - p_2))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (if (let ((a_4 - (car - p_3))) - (begin-unsafe - (let ((app_5 - (unwrap - 'quote))) - (eq? - app_5 - (unwrap - a_4))))) - (let ((a_4 - (cdr - p_3))) - (let ((p_4 - (unwrap - a_4))) - (if (pair? - p_4) - (let ((a_5 - (cdr - p_4))) - (begin-unsafe - (let ((app_5 - (unwrap - '()))) - (eq? - app_5 - (unwrap - a_5))))) - #f))) - #f) - #f))) - (let ((a_3 - (cdr - p_2))) - (begin-unsafe - (let ((app_5 - (unwrap - '()))) - (eq? - app_5 - (unwrap - a_3))))) - #f) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - make-acc/mut_0)))) - (let ((d_1 - (cdr - (unwrap - d_0)))) - (let ((p_0 - (unwrap - d_1))) - (let ((pos_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((field-name_0 - (let ((d_2 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_2)))) - (let ((d_3 - (cdr - (unwrap - a_0)))) - (let ((a_1 - (car - (unwrap - d_3)))) - a_1)))))) - (let ((pos_1 - pos_0)) - (values - pos_1 - field-name_0)))))))) - (case-lambda - ((pos_0 - field-name_0) - (let ((raw-def_0 - (list - 'define - raw-acc/mut_0 - (let ((pre_0 - "")) - (let ((p_0 - (let ((st_0 - (struct-type-info-name - sti_0))) - (let ((sep_0 - "-")) - (let ((post_0 - "")) - (let ((proc-expr_0 - (list - 'record-accessor - struct:s_0 - pos_0))) - (let ((post_1 - post_0) - (sep_1 - sep_0) - (st_1 - st_0) - (pre_1 - pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_5 - (symbol->string - st_1))) - (string-append - pre_1 - app_5 - sep_1 - (symbol->string - field-name_0) - post_1)))))))))))) - (if (if can-impersonate?_0 - can-impersonate?_0 - system-opaque?_0) - p_0 - (list - '|#%struct-field-accessor| - p_0 - struct:s_0 - pos_0))))))) - (if can-impersonate?_0 - (list - 'begin - raw-def_0 - (list - 'define - acc/mut_0 - (let ((pre_0 - "")) - (let ((p_0 - (let ((st_0 - (struct-type-info-name - sti_0))) - (let ((sep_0 - "-")) - (let ((post_0 - "")) - (let ((proc-expr_0 - (list - 'lambda - '(s) - (let ((app_5 - (list* - raw-s?_0 - '(s)))) - (let ((app_6 - (list* - raw-acc/mut_0 - '(s)))) - (list - 'if - app_5 - app_6 - (list - '$value - (let ((app_7 - (list - 'quote - (struct-type-info-name - sti_0)))) - (list - 'impersonate-ref - raw-acc/mut_0 - struct:s_0 - pos_0 - 's - app_7 - (list - 'quote - field-name_0)))))))))) - (let ((post_1 - post_0) - (sep_1 - sep_0) - (st_1 - st_0) - (pre_1 - pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_5 - (symbol->string - st_1))) - (string-append - pre_1 - app_5 - sep_1 - (symbol->string - field-name_0) - post_1)))))))))))) - (if system-opaque?_0 - p_0 - (list - '|#%struct-field-accessor| - p_0 - struct:s_0 - pos_0)))))) - raw-def_0))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'make-struct-field-mutator - hd_1) - (let ((a_0 - (cdr - (unwrap - make-acc/mut_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (let ((a_2 - (cdr - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (if (let ((a_3 - (car - p_2))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (if (let ((a_4 - (car - p_3))) - (begin-unsafe - (let ((app_5 - (unwrap - 'quote))) - (eq? - app_5 - (unwrap - a_4))))) - (let ((a_4 - (cdr - p_3))) - (let ((p_4 - (unwrap - a_4))) - (if (pair? - p_4) - (let ((a_5 - (cdr - p_4))) - (begin-unsafe - (let ((app_5 - (unwrap - '()))) - (eq? - app_5 - (unwrap - a_5))))) - #f))) - #f) - #f))) - (let ((a_3 - (cdr - p_2))) - (begin-unsafe - (let ((app_5 - (unwrap - '()))) - (eq? - app_5 - (unwrap - a_3))))) - #f) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - make-acc/mut_0)))) - (let ((d_1 - (cdr - (unwrap - d_0)))) + acc/mut_0)) + acc/mut_0))) + (let ((hd_1 (let ((p_0 (unwrap - d_1))) - (let ((pos_0 - (let ((a_0 - (car - p_0))) + make-acc/mut_0))) + (if (pair? + p_0) + (unwrap + (car + p_0)) + #f)))) + (if (if (eq? + 'make-struct-field-accessor + hd_1) + (let ((a_0 + (cdr + (unwrap + make-acc/mut_0)))) + (let ((p_0 + (unwrap a_0))) - (let ((field-name_0 - (let ((d_2 - (cdr - p_0))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (let ((p_1 + (unwrap + a_1))) + (if (pair? + p_1) + (let ((a_2 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? + p_3) + (if (let ((a_4 + (car + p_3))) + (begin-unsafe + (let ((app_6 + (unwrap + 'quote))) + (eq? + app_6 + (unwrap + a_4))))) + (let ((a_4 + (cdr + p_3))) + (let ((p_4 + (unwrap + a_4))) + (if (pair? + p_4) + (let ((a_5 + (cdr + p_4))) + (begin-unsafe + (let ((app_6 + (unwrap + '()))) + (eq? + app_6 + (unwrap + a_5))))) + #f))) + #f) + #f))) + (let ((a_3 + (cdr + p_2))) + (begin-unsafe + (let ((app_6 + (unwrap + '()))) + (eq? + app_6 + (unwrap + a_3))))) + #f) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + make-acc/mut_0)))) + (let ((d_1 + (cdr + (unwrap + d_0)))) + (let ((p_0 + (unwrap + d_1))) + (let ((pos_0 (let ((a_0 (car - (unwrap - d_2)))) - (let ((d_3 + p_0))) + a_0))) + (let ((field-name_0 + (let ((d_2 (cdr - (unwrap - a_0)))) - (let ((a_1 + p_0))) + (let ((a_0 (car (unwrap - d_3)))) - a_1)))))) - (let ((pos_1 - pos_0)) - (values - pos_1 - field-name_0)))))))) - (case-lambda - ((pos_0 - field-name_0) - (let ((raw-def_0 - (list - 'define - raw-acc/mut_0 - (let ((pre_0 - "set-")) - (let ((p_0 - (let ((st_0 - (struct-type-info-name - sti_0))) - (let ((sep_0 - "-")) - (let ((post_0 - "!")) - (let ((proc-expr_0 - (list - 'record-mutator - struct:s_0 - pos_0))) - (let ((post_1 - post_0) - (sep_1 - sep_0) - (st_1 - st_0) - (pre_1 - pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_5 + d_2)))) + (let ((d_3 + (cdr + (unwrap + a_0)))) + (let ((a_1 + (car + (unwrap + d_3)))) + a_1)))))) + (let ((pos_1 + pos_0)) + (values + pos_1 + field-name_0)))))))) + (case-lambda + ((pos_0 + field-name_0) + (let ((raw-def_0 + (list + 'define + raw-acc/mut_0 + (let ((pre_0 + "")) + (let ((p_0 + (let ((st_0 + (struct-type-info-name + sti_0))) + (let ((sep_0 + "-")) + (let ((post_0 + "")) + (let ((proc-expr_0 + (list + 'record-accessor + struct:s_0 + pos_0))) + (let ((post_1 + post_0) + (sep_1 + sep_0) + (st_1 + st_0) + (pre_1 + pre_0)) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_6 + (symbol->string + st_1))) + (string-append + pre_1 + app_6 + sep_1 (symbol->string - st_1))) - (string-append - pre_1 - app_5 - sep_1 - (symbol->string - field-name_0) - post_1)))))))))))) - (if (if can-impersonate?_0 - can-impersonate?_0 - system-opaque?_0) - p_0 - (list - '|#%struct-field-mutator| - p_0 - struct:s_0 - pos_0))))))) - (let ((abs-pos_0 - (+ - pos_0 - (let ((app_5 - (struct-type-info-field-count - sti_0))) - (- - app_5 - (struct-type-info-immediate-field-count - sti_0)))))) - (if can-impersonate?_0 - (list - 'begin - raw-def_0 - (list - 'define - acc/mut_0 - (let ((pre_0 - "set-")) - (let ((p_0 - (let ((st_0 - (struct-type-info-name - sti_0))) - (let ((sep_0 - "-")) - (let ((post_0 - "!")) - (let ((proc-expr_0 - (list - 'lambda - '(s - v) - (let ((app_5 - (list* - raw-s?_0 - '(s)))) + field-name_0) + post_1)))))))))))) + (if (if can-impersonate?_0 + can-impersonate?_0 + system-opaque?_0) + p_0 + (list + '|#%struct-field-accessor| + p_0 + struct:s_0 + pos_0))))))) + (if can-impersonate?_0 + (list + 'begin + raw-def_0 + (list + 'define + acc/mut_0 + (let ((pre_0 + "")) + (let ((p_0 + (let ((st_0 + (struct-type-info-name + sti_0))) + (let ((sep_0 + "-")) + (let ((post_0 + "")) + (let ((proc-expr_0 + (list + 'lambda + '(s) (let ((app_6 (list* - raw-acc/mut_0 - '(s - v)))) - (list - 'if - app_5 - app_6 + raw-s?_0 + '(s)))) + (let ((app_7 + (list* + raw-acc/mut_0 + '(s)))) + (list + 'if + app_6 + app_7 + (list + '$value + (let ((app_8 + (list + 'quote + (struct-type-info-name + sti_0)))) + (list + 'impersonate-ref + raw-acc/mut_0 + struct:s_0 + pos_0 + 's + app_8 + (list + 'quote + field-name_0)))))))))) + (let ((post_1 + post_0) + (sep_1 + sep_0) + (st_1 + st_0) + (pre_1 + pre_0)) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_6 + (symbol->string + st_1))) + (string-append + pre_1 + app_6 + sep_1 + (symbol->string + field-name_0) + post_1)))))))))))) + (if system-opaque?_0 + p_0 + (list + '|#%struct-field-accessor| + p_0 + struct:s_0 + pos_0)))))) + raw-def_0))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'make-struct-field-mutator + hd_1) + (let ((a_0 + (cdr + (unwrap + make-acc/mut_0)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (let ((p_1 + (unwrap + a_1))) + (if (pair? + p_1) + (let ((a_2 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? + p_3) + (if (let ((a_4 + (car + p_3))) + (begin-unsafe + (let ((app_6 + (unwrap + 'quote))) + (eq? + app_6 + (unwrap + a_4))))) + (let ((a_4 + (cdr + p_3))) + (let ((p_4 + (unwrap + a_4))) + (if (pair? + p_4) + (let ((a_5 + (cdr + p_4))) + (begin-unsafe + (let ((app_6 + (unwrap + '()))) + (eq? + app_6 + (unwrap + a_5))))) + #f))) + #f) + #f))) + (let ((a_3 + (cdr + p_2))) + (begin-unsafe + (let ((app_6 + (unwrap + '()))) + (eq? + app_6 + (unwrap + a_3))))) + #f) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + make-acc/mut_0)))) + (let ((d_1 + (cdr + (unwrap + d_0)))) + (let ((p_0 + (unwrap + d_1))) + (let ((pos_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((field-name_0 + (let ((d_2 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_2)))) + (let ((d_3 + (cdr + (unwrap + a_0)))) + (let ((a_1 + (car + (unwrap + d_3)))) + a_1)))))) + (let ((pos_1 + pos_0)) + (values + pos_1 + field-name_0)))))))) + (case-lambda + ((pos_0 + field-name_0) + (let ((raw-def_0 + (list + 'define + raw-acc/mut_0 + (let ((pre_0 + "set-")) + (let ((p_0 + (let ((st_0 + (struct-type-info-name + sti_0))) + (let ((sep_0 + "-")) + (let ((post_0 + "!")) + (let ((proc-expr_0 (list - '$value - (let ((app_7 - (list - 'quote - (struct-type-info-name - sti_0)))) - (list - 'impersonate-set! - raw-acc/mut_0 - struct:s_0 - pos_0 - abs-pos_0 - 's - 'v - app_7 - (list - 'quote - field-name_0)))))))))) - (let ((post_1 - post_0) - (sep_1 - sep_0) - (st_1 - st_0) - (pre_1 - pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_5 - (symbol->string - st_1))) - (string-append - pre_1 - app_5 - sep_1 - (symbol->string - field-name_0) - post_1)))))))))))) - (if system-opaque?_0 - p_0 - (list - '|#%struct-field-mutator| - p_0 - struct:s_0 - pos_0)))))) - raw-def_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (error - "oops"))))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 - null - acc/muts_0 - make-acc/muts_0)))))))))))))))) + 'record-mutator + struct:s_0 + pos_0))) + (let ((post_1 + post_0) + (sep_1 + sep_0) + (st_1 + st_0) + (pre_1 + pre_0)) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_6 + (symbol->string + st_1))) + (string-append + pre_1 + app_6 + sep_1 + (symbol->string + field-name_0) + post_1)))))))))))) + (if (if can-impersonate?_0 + can-impersonate?_0 + system-opaque?_0) + p_0 + (list + '|#%struct-field-mutator| + p_0 + struct:s_0 + pos_0))))))) + (let ((abs-pos_0 + (+ + pos_0 + (let ((app_6 + (struct-type-info-field-count + sti_0))) + (- + app_6 + (struct-type-info-immediate-field-count + sti_0)))))) + (if can-impersonate?_0 + (list + 'begin + raw-def_0 + (list + 'define + acc/mut_0 + (let ((pre_0 + "set-")) + (let ((p_0 + (let ((st_0 + (struct-type-info-name + sti_0))) + (let ((sep_0 + "-")) + (let ((post_0 + "!")) + (let ((proc-expr_0 + (list + 'lambda + '(s + v) + (let ((app_6 + (list* + raw-s?_0 + '(s)))) + (let ((app_7 + (list* + raw-acc/mut_0 + '(s + v)))) + (list + 'if + app_6 + app_7 + (list + '$value + (let ((app_8 + (list + 'quote + (struct-type-info-name + sti_0)))) + (list + 'impersonate-set! + raw-acc/mut_0 + struct:s_0 + pos_0 + abs-pos_0 + 's + 'v + app_8 + (list + 'quote + field-name_0)))))))))) + (let ((post_1 + post_0) + (sep_1 + sep_0) + (st_1 + st_0) + (pre_1 + pre_0)) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_6 + (symbol->string + st_1))) + (string-append + pre_1 + app_6 + sep_1 + (symbol->string + field-name_0) + post_1)))))))))))) + (if system-opaque?_0 + p_0 + (list + '|#%struct-field-mutator| + p_0 + struct:s_0 + pos_0)))))) + raw-def_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (error + "oops"))))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 + null + acc/muts_0 + make-acc/muts_0)))))))))))))))))))) #f))) (args (raise-binding-result-arity-error 14 args)))) #f)))) @@ -30049,71 +30168,76 @@ imports_0) #f) #f))) - (if (not - type-id_0) - #f - (if (known-struct-predicate-authentic? - k_0) - (let ((tmp_0 - (maybe-tmp_0 - (car - args_0) - 'v))) - (let ((ques_0 - (list - 'unsafe-struct? - tmp_0 - (schemify_0 - type-id_0 - 'fresh)))) - (wrap-tmp_0 - tmp_0 - (car - args_0) - ques_0))) - (let ((tmp_0 - (maybe-tmp_0 - (car - args_0) - 'v))) - (let ((schemified-type-id_0 - (schemify_0 - type-id_0 - 'fresh))) - (let ((tmp-type-id_0 - (maybe-tmp_0 - schemified-type-id_0 - 'v))) - (let ((ques_0 - (list - 'if - (list - 'unsafe-struct? - tmp_0 - tmp-type-id_0) - #t - (list* - 'if + (let ((unsafe-struct?_0 + (if (known-struct-predicate-sealed? + k_0) + 'unsafe-sealed-struct? + 'unsafe-struct?))) + (if (not + type-id_0) + #f + (if (known-struct-predicate-authentic? + k_0) + (let ((tmp_0 + (maybe-tmp_0 + (car + args_0) + 'v))) + (let ((ques_0 + (list + unsafe-struct?_0 + tmp_0 + (schemify_0 + type-id_0 + 'fresh)))) + (wrap-tmp_0 + tmp_0 + (car + args_0) + ques_0))) + (let ((tmp_0 + (maybe-tmp_0 + (car + args_0) + 'v))) + (let ((schemified-type-id_0 + (schemify_0 + type-id_0 + 'fresh))) + (let ((tmp-type-id_0 + (maybe-tmp_0 + schemified-type-id_0 + 'v))) + (let ((ques_0 (list - 'impersonator? - tmp_0) - (list - 'unsafe-struct? + 'if (list - 'impersonator-val - tmp_0) - tmp-type-id_0) - '(#f))))) - (let ((app_0 - (car - args_0))) - (wrap-tmp_0 - tmp_0 - app_0 - (wrap-tmp_0 - tmp-type-id_0 - schemified-type-id_0 - ques_0))))))))))))))) + unsafe-struct?_0 + tmp_0 + tmp-type-id_0) + #t + (list* + 'if + (list + 'impersonator? + tmp_0) + (list + unsafe-struct?_0 + (list + 'impersonator-val + tmp_0) + tmp-type-id_0) + '(#f))))) + (let ((app_0 + (car + args_0))) + (wrap-tmp_0 + tmp_0 + app_0 + (wrap-tmp_0 + tmp-type-id_0 + schemified-type-id_0 + ques_0)))))))))))))))) (let ((inline-field-access_0 (|#%name| inline-field-access @@ -30600,18 +30724,8 @@ (schemify-body_0 (cdr l_0) wcm-state_2)))))))))) (schemify_0 v_1 wcm-state_1))))))) (schemify/knowns_0 knowns_0 8 wcm-state_0 v_0)))) -(define struct:convert-mode - (make-record-type-descriptor* - 'convert-mode - #f - (|#%nongenerative-uid| convert-mode) - #f - #f - 4 - 0)) -(define effect_2536 - (struct-type-install-properties! - struct:convert-mode +(define finish1676 + (make-struct-type-install-properties '(convert-mode) 4 0 @@ -30622,6 +30736,16 @@ '(0 1 2 3) #f 'convert-mode)) +(define struct:convert-mode + (make-record-type-descriptor* + 'convert-mode + #f + (|#%nongenerative-uid| convert-mode) + #f + #f + 4 + 0)) +(define effect_2443 (finish1676 struct:convert-mode)) (define convert-mode1.1 (|#%name| convert-mode @@ -39744,18 +39868,8 @@ (if (|#%app| need-exposed?_0 q_0) #t (if (extflonum? q_0) #t #f)))))))))))))) -(define struct:to-unfasl - (make-record-type-descriptor* - 'to-unfasl - #f - (|#%nongenerative-uid| to-unfasl) - #f - #f - 3 - 0)) -(define effect_2468 - (struct-type-install-properties! - struct:to-unfasl +(define finish2146 + (make-struct-type-install-properties '(to-unfasl) 3 0 @@ -39766,6 +39880,16 @@ '(0 1 2) #f 'to-unfasl)) +(define struct:to-unfasl + (make-record-type-descriptor* + 'to-unfasl + #f + (|#%nongenerative-uid| to-unfasl) + #f + #f + 3 + 0)) +(define effect_2898 (finish2146 struct:to-unfasl)) (define to-unfasl1.1 (|#%name| to-unfasl @@ -39895,18 +40019,8 @@ 'write "cannot marshal value that is embedded in compiled code\n value: ~v" v_0))) -(define struct:node - (make-record-type-descriptor* - 'node - #f - (|#%nongenerative-uid| node) - #f - #f - 5 - 0)) -(define effect_2447 - (struct-type-install-properties! - struct:node +(define finish2154 + (make-struct-type-install-properties '(node) 5 0 @@ -39917,6 +40031,16 @@ '(0 1 2 3 4) #f 'node)) +(define struct:node + (make-record-type-descriptor* + 'node + #f + (|#%nongenerative-uid| node) + #f + #f + 5 + 0)) +(define effect_2547 (finish2154 struct:node)) (define node1.1 (|#%name| node @@ -40217,18 +40341,8 @@ app_2 (stack-set stack_1 pos_1 (car vals_1)))))))))))) (loop_0 pos_0 vals_0 count_0 stack_0)))))) -(define struct:stack-info - (make-record-type-descriptor* - 'stack-info - #f - (|#%nongenerative-uid| stack-info) - #f - #f - 5 - 28)) -(define effect_2734 - (struct-type-install-properties! - struct:stack-info +(define finish2200 + (make-struct-type-install-properties '(stack-info) 5 0 @@ -40239,6 +40353,16 @@ '(0 1) #f 'stack-info)) +(define struct:stack-info + (make-record-type-descriptor* + 'stack-info + #f + (|#%nongenerative-uid| stack-info) + #f + #f + 5 + 28)) +(define effect_2334 (finish2200 struct:stack-info)) (define stack-info4.1 (|#%name| stack-info @@ -40575,18 +40699,8 @@ (define stack-info-non-tail! (lambda (stk-i_0 stack-depth_0) (set-stack-info-non-tail-call-later?! stk-i_0 #t))) -(define struct:indirect - (make-record-type-descriptor* - 'indirect - #f - (|#%nongenerative-uid| indirect) - #f - #f - 2 - 0)) -(define effect_2736 - (struct-type-install-properties! - struct:indirect +(define finish2214 + (make-struct-type-install-properties '(indirect) 2 0 @@ -40597,6 +40711,16 @@ '(0 1) #f 'indirect)) +(define struct:indirect + (make-record-type-descriptor* + 'indirect + #f + (|#%nongenerative-uid| indirect) + #f + #f + 2 + 0)) +(define effect_2125 (finish2214 struct:indirect)) (define indirect1.1 (|#%name| indirect @@ -40643,18 +40767,8 @@ s 'indirect 'element)))))) -(define struct:boxed - (make-record-type-descriptor* - 'boxed - #f - (|#%nongenerative-uid| boxed) - #f - #f - 1 - 0)) -(define effect_2333 - (struct-type-install-properties! - struct:boxed +(define finish2219 + (make-struct-type-install-properties '(boxed) 1 0 @@ -40665,6 +40779,16 @@ '(0) #f 'boxed)) +(define struct:boxed + (make-record-type-descriptor* + 'boxed + #f + (|#%nongenerative-uid| boxed) + #f + #f + 1 + 0)) +(define effect_2970 (finish2219 struct:boxed)) (define boxed2.1 (|#%name| boxed @@ -40688,18 +40812,8 @@ (boxed-pos_2515 s) ($value (impersonate-ref boxed-pos_2515 struct:boxed 0 s 'boxed 'pos)))))) -(define struct:boxed/check - (make-record-type-descriptor* - 'boxed/check - struct:boxed - (|#%nongenerative-uid| boxed/check) - #f - #f - 0 - 0)) -(define effect_2358 - (struct-type-install-properties! - struct:boxed/check +(define finish2223 + (make-struct-type-install-properties '(boxed/check) 0 0 @@ -40710,6 +40824,16 @@ '() #f 'boxed/check)) +(define struct:boxed/check + (make-record-type-descriptor* + 'boxed/check + struct:boxed + (|#%nongenerative-uid| boxed/check) + #f + #f + 0 + 0)) +(define effect_2937 (finish2223 struct:boxed/check)) (define boxed/check3.1 (|#%name| boxed/check diff --git a/racket/src/cs/schemified/thread.scm b/racket/src/cs/schemified/thread.scm index d61dfd9e8d..9552c3f24d 100644 --- a/racket/src/cs/schemified/thread.scm +++ b/racket/src/cs/schemified/thread.scm @@ -972,18 +972,8 @@ (void) (raise-argument-error 'hash-empty? "hash?" table_0)) (zero? (hash-count table_0))))) -(define struct:queue - (make-record-type-descriptor* - 'queue - #f - (|#%nongenerative-uid| queue) - #f - #f - 2 - 3)) -(define effect_2212 - (struct-type-install-properties! - struct:queue +(define finish35 + (make-struct-type-install-properties '(queue) 2 0 @@ -994,6 +984,16 @@ '() #f 'queue)) +(define struct:queue + (make-record-type-descriptor* + 'queue + #f + (|#%nongenerative-uid| queue) + #f + #f + 2 + 3)) +(define effect_2998 (finish35 struct:queue)) (define queue1.1 (|#%name| queue @@ -1006,18 +1006,8 @@ (|#%name| set-queue-start! (record-mutator struct:queue 0))) (define set-queue-end! (|#%name| set-queue-end! (record-mutator struct:queue 1))) -(define struct:node$2 - (make-record-type-descriptor* - 'node - #f - (|#%nongenerative-uid| node) - #f - #f - 3 - 6)) -(define effect_2496 - (struct-type-install-properties! - struct:node$2 +(define finish37 + (make-struct-type-install-properties '(node) 3 0 @@ -1028,6 +1018,16 @@ '(0) #f 'node)) +(define struct:node$2 + (make-record-type-descriptor* + 'node + #f + (|#%nongenerative-uid| node) + #f + #f + 3 + 6)) +(define effect_1943 (finish37 struct:node$2)) (define node2.1 (|#%name| node @@ -1240,18 +1240,8 @@ (hash-ref (primitive-table '|#%engine|) 'continuation-current-primitive #f)) (define host:prop:unsafe-authentic-override (hash-ref (primitive-table '|#%engine|) 'prop:unsafe-authentic-override #f)) -(define struct:node$1 - (make-record-type-descriptor* - 'node - #f - (|#%nongenerative-uid| node) - #f - #f - 5 - 0)) -(define effect_1764 - (struct-type-install-properties! - struct:node$1 +(define finish45 + (make-struct-type-install-properties '(node) 5 0 @@ -1262,6 +1252,16 @@ '(0 1 2 3 4) #f 'node)) +(define struct:node$1 + (make-record-type-descriptor* + 'node + #f + (|#%nongenerative-uid| node) + #f + #f + 5 + 0)) +(define effect_1944 (finish45 struct:node$1)) (define node1.1$1 (|#%name| node @@ -1513,6 +1513,18 @@ (if (not (node-right t_0)) (let ((app_0 (node-key t_0))) (values app_0 (node-val t_0))) (max-key+value (node-right t_0))))) +(define finish75 + (make-struct-type-install-properties + '(sandman) + 11 + 0 + #f + null + 'prefab + #f + '(0 1 2 3 4 5 6 7 8 9 10) + #f + 'sandman)) (define struct:sandman (make-record-type-descriptor* 'sandman @@ -1528,19 +1540,7 @@ #f 11 2047)) -(define effect_2467 - (struct-type-install-properties! - struct:sandman - '(sandman) - 11 - 0 - #f - null - 'prefab - #f - '(0 1 2 3 4 5 6 7 8 9 10) - #f - 'sandman)) +(define effect_2951 (finish75 struct:sandman)) (define sandman1.1 (|#%name| sandman @@ -1978,18 +1978,8 @@ 'guard-for-prop:evt "(or/c evt? (procedure-arity-includes/c 1) exact-nonnegative-integer?)" v_0)))))))) -(define struct:selector-prop-evt-value - (make-record-type-descriptor* - 'selector-prop-evt-value - #f - (|#%nongenerative-uid| selector-prop-evt-value) - #f - #f - 1 - 0)) -(define effect_3012 - (struct-type-install-properties! - struct:selector-prop-evt-value +(define finish93 + (make-struct-type-install-properties '(selector-prop-evt-value) 1 0 @@ -2000,6 +1990,16 @@ '(0) #f 'selector-prop-evt-value)) +(define struct:selector-prop-evt-value + (make-record-type-descriptor* + 'selector-prop-evt-value + #f + (|#%nongenerative-uid| selector-prop-evt-value) + #f + #f + 1 + 0)) +(define effect_2735 (finish93 struct:selector-prop-evt-value)) (define selector-prop-evt-value1.1 (|#%name| selector-prop-evt-value @@ -2026,18 +2026,8 @@ (begin (let ((or-part_0 (primary-evt? v_0))) (if or-part_0 or-part_0 (secondary-evt? v_0))))))) -(define struct:poller - (make-record-type-descriptor* - 'poller - #f - (|#%nongenerative-uid| poller) - #f - #f - 1 - 0)) -(define effect_2322 - (struct-type-install-properties! - struct:poller +(define finish95 + (make-struct-type-install-properties '(poller) 1 0 @@ -2048,6 +2038,16 @@ '(0) #f 'poller)) +(define struct:poller + (make-record-type-descriptor* + 'poller + #f + (|#%nongenerative-uid| poller) + #f + #f + 1 + 0)) +(define effect_2545 (finish95 struct:poller)) (define poller2.1 (|#%name| poller @@ -2055,18 +2055,8 @@ (make-record-constructor-descriptor struct:poller #f #f)))) (define poller? (|#%name| poller? (record-predicate struct:poller))) (define poller-proc (|#%name| poller-proc (record-accessor struct:poller 0))) -(define struct:poll-ctx - (make-record-type-descriptor* - 'poll-ctx - #f - (|#%nongenerative-uid| poll-ctx) - #f - #f - 4 - 8)) -(define effect_2873 - (struct-type-install-properties! - struct:poll-ctx +(define finish97 + (make-struct-type-install-properties '(poll-ctx) 4 0 @@ -2077,6 +2067,16 @@ '(0 1 2) #f 'poll-ctx)) +(define struct:poll-ctx + (make-record-type-descriptor* + 'poll-ctx + #f + (|#%nongenerative-uid| poll-ctx) + #f + #f + 4 + 8)) +(define effect_2667 (finish97 struct:poll-ctx)) (define poll-ctx3.1 (|#%name| poll-ctx @@ -2093,18 +2093,8 @@ (|#%name| poll-ctx-incomplete? (record-accessor struct:poll-ctx 3))) (define set-poll-ctx-incomplete?! (|#%name| set-poll-ctx-incomplete?! (record-mutator struct:poll-ctx 3))) -(define struct:never-evt - (make-record-type-descriptor* - 'never-evt - #f - (|#%nongenerative-uid| never-evt) - #f - #f - 0 - 0)) -(define effect_2678 - (struct-type-install-properties! - struct:never-evt +(define finish100 + (make-struct-type-install-properties '(never-evt) 0 0 @@ -2118,6 +2108,16 @@ '() #f 'never-evt)) +(define struct:never-evt + (make-record-type-descriptor* + 'never-evt + #f + (|#%nongenerative-uid| never-evt) + #f + #f + 0 + 0)) +(define effect_2474 (finish100 struct:never-evt)) (define never-evt4.1 (|#%name| never-evt @@ -2134,18 +2134,8 @@ ($value (if (impersonator? v) (never-evt?_1958 (impersonator-val v)) #f)))))) (define the-never-evt (never-evt4.1)) -(define struct:always-evt - (make-record-type-descriptor* - 'always-evt - #f - (|#%nongenerative-uid| always-evt) - #f - #f - 0 - 0)) -(define effect_2666 - (struct-type-install-properties! - struct:always-evt +(define finish103 + (make-struct-type-install-properties '(always-evt) 0 0 @@ -2159,6 +2149,16 @@ '() #f 'always-evt)) +(define struct:always-evt + (make-record-type-descriptor* + 'always-evt + #f + (|#%nongenerative-uid| always-evt) + #f + #f + 0 + 0)) +(define effect_2333 (finish103 struct:always-evt)) (define always-evt5.1 (|#%name| always-evt @@ -2175,18 +2175,8 @@ ($value (if (impersonator? v) (always-evt?_2466 (impersonator-val v)) #f)))))) (define the-always-evt (always-evt5.1)) -(define struct:async-evt - (make-record-type-descriptor* - 'async-evt - #f - (|#%nongenerative-uid| async-evt) - #f - #f - 0 - 0)) -(define effect_2516 - (struct-type-install-properties! - struct:async-evt +(define finish106 + (make-struct-type-install-properties '(async-evt) 0 0 @@ -2200,6 +2190,16 @@ '() #f 'async-evt)) +(define struct:async-evt + (make-record-type-descriptor* + 'async-evt + #f + (|#%nongenerative-uid| async-evt) + #f + #f + 0 + 0)) +(define effect_2210 (finish106 struct:async-evt)) (define async-evt6.1 (|#%name| async-evt @@ -2216,11 +2216,8 @@ ($value (if (impersonator? v) (async-evt?_2619 (impersonator-val v)) #f)))))) (define the-async-evt (async-evt6.1)) -(define struct:wrap-evt - (make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 2 0)) -(define effect_2243 - (struct-type-install-properties! - struct:wrap-evt +(define finish109 + (make-struct-type-install-properties '(evt) 2 0 @@ -2234,6 +2231,9 @@ '(0 1) #f 'wrap-evt)) +(define struct:wrap-evt + (make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 2 0)) +(define effect_2815 (finish109 struct:wrap-evt)) (define wrap-evt7.1 (|#%name| wrap-evt @@ -2274,18 +2274,8 @@ s 'evt 'wrap)))))) -(define struct:handle-evt - (make-record-type-descriptor* - 'handle-evt - struct:wrap-evt - (|#%nongenerative-uid| handle-evt) - #f - #f - 0 - 0)) -(define effect_2575 - (struct-type-install-properties! - struct:handle-evt +(define finish114 + (make-struct-type-install-properties '(handle-evt) 0 0 @@ -2296,6 +2286,16 @@ '() #f 'handle-evt)) +(define struct:handle-evt + (make-record-type-descriptor* + 'handle-evt + struct:wrap-evt + (|#%nongenerative-uid| handle-evt) + #f + #f + 0 + 0)) +(define effect_3118 (finish114 struct:handle-evt)) (define handle-evt8.1 (|#%name| handle-evt @@ -2313,18 +2313,8 @@ (if (impersonator? v) (handle-evt?$1_2894 (impersonator-val v)) #f)))))) -(define struct:control-state-evt - (make-record-type-descriptor* - 'control-state-evt - #f - (|#%nongenerative-uid| control-state-evt) - #f - #f - 5 - 0)) -(define effect_2497 - (struct-type-install-properties! - struct:control-state-evt +(define finish117 + (make-struct-type-install-properties '(control-state-evt) 5 0 @@ -2338,6 +2328,16 @@ '(0 1 2 3 4) #f 'control-state-evt)) +(define struct:control-state-evt + (make-record-type-descriptor* + 'control-state-evt + #f + (|#%nongenerative-uid| control-state-evt) + #f + #f + 5 + 0)) +(define effect_3002 (finish117 struct:control-state-evt)) (define control-state-evt9.1 (|#%name| control-state-evt @@ -2445,11 +2445,8 @@ s 'control-state-evt 'retry-proc)))))) -(define struct:poll-guard-evt - (make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 1 0)) -(define effect_2340 - (struct-type-install-properties! - struct:poll-guard-evt +(define finish125 + (make-struct-type-install-properties '(evt) 1 0 @@ -2463,6 +2460,9 @@ '(0) #f 'poll-guard-evt)) +(define struct:poll-guard-evt + (make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 1 0)) +(define effect_2169 (finish125 struct:poll-guard-evt)) (define poll-guard-evt10.1 (|#%name| poll-guard-evt @@ -2496,11 +2496,8 @@ s 'evt 'proc)))))) -(define struct:choice-evt - (make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 1 0)) -(define effect_2203 - (struct-type-install-properties! - struct:choice-evt +(define finish129 + (make-struct-type-install-properties '(evt) 1 0 @@ -2514,6 +2511,9 @@ '(0) #f 'choice-evt)) +(define struct:choice-evt + (make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 1 0)) +(define effect_2613 (finish129 struct:choice-evt)) (define choice-evt11.1 (|#%name| choice-evt @@ -2575,18 +2575,8 @@ (if (poller? v_1) (|#%app| (poller-proc v_1) evt_0 poll-ctx_0) (if (1/evt? v_1) (values #f v_1) (values #f the-never-evt)))))))) -(define struct:delayed-poll - (make-record-type-descriptor* - 'delayed-poll - #f - (|#%nongenerative-uid| delayed-poll) - #f - #f - 1 - 0)) -(define effect_2389 - (struct-type-install-properties! - struct:delayed-poll +(define finish132 + (make-struct-type-install-properties '(delayed-poll) 1 0 @@ -2597,6 +2587,16 @@ '(0) #f 'delayed-poll)) +(define struct:delayed-poll + (make-record-type-descriptor* + 'delayed-poll + #f + (|#%nongenerative-uid| delayed-poll) + #f + #f + 1 + 0)) +(define effect_2263 (finish132 struct:delayed-poll)) (define delayed-poll12.1 (|#%name| delayed-poll @@ -2606,18 +2606,8 @@ (|#%name| delayed-poll? (record-predicate struct:delayed-poll))) (define delayed-poll-resume (|#%name| delayed-poll-resume (record-accessor struct:delayed-poll 0))) -(define struct:poller-evt - (make-record-type-descriptor* - 'poller-evt - #f - (|#%nongenerative-uid| poller-evt) - #f - #f - 1 - 0)) -(define effect_2296 - (struct-type-install-properties! - struct:poller-evt +(define finish135 + (make-struct-type-install-properties '(poller-evt) 1 0 @@ -2628,6 +2618,16 @@ '(0) #f 'poller-evt)) +(define struct:poller-evt + (make-record-type-descriptor* + 'poller-evt + #f + (|#%nongenerative-uid| poller-evt) + #f + #f + 1 + 0)) +(define effect_2260 (finish135 struct:poller-evt)) (define poller-evt13.1 (|#%name| poller-evt @@ -2662,18 +2662,8 @@ (define-values (prop:waiter waiter? waiter-ref) (make-struct-type-property 'waiter)) -(define struct:waiter-methods - (make-record-type-descriptor* - 'waiter-methods - #f - (|#%nongenerative-uid| waiter-methods) - #f - #f - 2 - 0)) -(define effect_3276 - (struct-type-install-properties! - struct:waiter-methods +(define finish138 + (make-struct-type-install-properties '(waiter-methods) 2 0 @@ -2684,6 +2674,16 @@ '(0 1) #f 'waiter-methods)) +(define struct:waiter-methods + (make-record-type-descriptor* + 'waiter-methods + #f + (|#%nongenerative-uid| waiter-methods) + #f + #f + 2 + 0)) +(define effect_2191 (finish138 struct:waiter-methods)) (define waiter-methods1.1 (|#%name| waiter-methods @@ -2706,18 +2706,8 @@ (define waiter-suspend! (lambda (w_0 interrupt-cb_0) (|#%app| (waiter-methods-suspend (waiter-ref w_0)) w_0 interrupt-cb_0))) -(define struct:select-waiter - (make-record-type-descriptor* - 'select-waiter - #f - (|#%nongenerative-uid| select-waiter) - #f - #f - 1 - 0)) -(define effect_2810 - (struct-type-install-properties! - struct:select-waiter +(define finish141 + (make-struct-type-install-properties '(select-waiter) 1 0 @@ -2736,6 +2726,16 @@ '(0) #f 'select-waiter)) +(define struct:select-waiter + (make-record-type-descriptor* + 'select-waiter + #f + (|#%nongenerative-uid| select-waiter) + #f + #f + 1 + 0)) +(define effect_2826 (finish141 struct:select-waiter)) (define select-waiter7.1 (|#%name| select-waiter @@ -2769,18 +2769,8 @@ s 'select-waiter 'proc)))))) -(define struct:custodian - (make-record-type-descriptor* - 'custodian - #f - (|#%nongenerative-uid| custodian) - #f - #f - 13 - 8188)) -(define effect_2862 - (struct-type-install-properties! - struct:custodian +(define finish144 + (make-struct-type-install-properties '(custodian) 13 0 @@ -2791,6 +2781,16 @@ '(0 1) #f 'custodian)) +(define struct:custodian + (make-record-type-descriptor* + 'custodian + #f + (|#%nongenerative-uid| custodian) + #f + #f + 13 + 8188)) +(define effect_2161 (finish144 struct:custodian)) (define custodian1.1 (|#%name| custodian @@ -2902,18 +2902,8 @@ (define-values (prop:place-message place-message? place-message-ref) (make-struct-type-property 'place-message)) -(define struct:message-ized - (make-record-type-descriptor* - 'message-ized - #f - (|#%nongenerative-uid| message-ized) - #f - #f - 1 - 0)) -(define effect_2533 - (struct-type-install-properties! - struct:message-ized +(define finish147 + (make-struct-type-install-properties '(message-ized) 1 0 @@ -2924,6 +2914,16 @@ '(0) #f 'message-ized)) +(define struct:message-ized + (make-record-type-descriptor* + 'message-ized + #f + (|#%nongenerative-uid| message-ized) + #f + #f + 1 + 0)) +(define effect_2995 (finish147 struct:message-ized)) (define message-ized1.1 (|#%name| message-ized @@ -3997,18 +3997,8 @@ (|#%app| (message-ized-unmessage v_1)) v_1))))))))))))) (loop_0 v_0))))) -(define struct:place - (make-record-type-descriptor* - 'place - #f - (|#%nongenerative-uid| place) - #f - #f - 19 - 491440)) -(define effect_2252 - (struct-type-install-properties! - struct:place +(define finish157 + (make-struct-type-install-properties '(place) 19 0 @@ -4025,6 +4015,16 @@ '(0 1 2 3 6 15) #f 'place)) +(define struct:place + (make-record-type-descriptor* + 'place + #f + (|#%nongenerative-uid| place) + #f + #f + 19 + 491440)) +(define effect_2619 (finish157 struct:place)) (define place1.1 (|#%name| place @@ -4160,18 +4160,8 @@ (for-loop_0 lst_0)))) (void))))) (void)))) -(define struct:semaphore - (make-record-type-descriptor* - 'semaphore - struct:queue - (|#%nongenerative-uid| semaphore) - #f - #f - 1 - 1)) -(define effect_2858 - (struct-type-install-properties! - struct:semaphore +(define finish162 + (make-struct-type-install-properties '(semaphore) 1 0 @@ -4189,6 +4179,16 @@ '() #f 'semaphore)) +(define struct:semaphore + (make-record-type-descriptor* + 'semaphore + struct:queue + (|#%nongenerative-uid| semaphore) + #f + #f + 1 + 1)) +(define effect_2927 (finish162 struct:semaphore)) (define semaphore1.1 (|#%name| semaphore @@ -4200,18 +4200,8 @@ (define set-semaphore-count! (|#%name| set-semaphore-count! (record-mutator struct:semaphore 0))) (define count-field-pos 2) -(define struct:semaphore-peek-evt - (make-record-type-descriptor* - 'semaphore-peek-evt - #f - (|#%nongenerative-uid| semaphore-peek-evt) - #f - #f - 1 - 0)) -(define effect_2145 - (struct-type-install-properties! - struct:semaphore-peek-evt +(define finish165 + (make-struct-type-install-properties '(semaphore-peek-evt) 1 0 @@ -4228,6 +4218,16 @@ '(0) #f 'semaphore-peek-evt)) +(define struct:semaphore-peek-evt + (make-record-type-descriptor* + 'semaphore-peek-evt + #f + (|#%nongenerative-uid| semaphore-peek-evt) + #f + #f + 1 + 0)) +(define effect_2414 (finish165 struct:semaphore-peek-evt)) (define semaphore-peek-evt2.1 (|#%name| semaphore-peek-evt @@ -4263,18 +4263,8 @@ s 'semaphore-peek-evt 'sema)))))) -(define struct:semaphore-peek-select-waiter - (make-record-type-descriptor* - 'semaphore-peek-select-waiter - struct:select-waiter - (|#%nongenerative-uid| semaphore-peek-select-waiter) - #f - #f - 0 - 0)) -(define effect_2532 - (struct-type-install-properties! - struct:semaphore-peek-select-waiter +(define finish169 + (make-struct-type-install-properties '(semaphore-peek-select-waiter) 0 0 @@ -4285,6 +4275,16 @@ '() #f 'semaphore-peek-select-waiter)) +(define struct:semaphore-peek-select-waiter + (make-record-type-descriptor* + 'semaphore-peek-select-waiter + struct:select-waiter + (|#%nongenerative-uid| semaphore-peek-select-waiter) + #f + #f + 0 + 0)) +(define effect_2387 (finish169 struct:semaphore-peek-select-waiter)) (define semaphore-peek-select-waiter3.1 (|#%name| semaphore-peek-select-waiter @@ -4505,18 +4505,8 @@ (set-semaphore-count! s_0 (sub1 c_0)) (internal-error "semaphore-wait/atomic: cannot decrement semaphore"))))) -(define struct:node - (make-record-type-descriptor* - 'node - #f - (|#%nongenerative-uid| node) - #f - #f - 2 - 3)) -(define effect_2309 - (struct-type-install-properties! - struct:node +(define finish182 + (make-struct-type-install-properties '(node) 2 0 @@ -4527,6 +4517,16 @@ '() #f 'node)) +(define struct:node + (make-record-type-descriptor* + 'node + #f + (|#%nongenerative-uid| node) + #f + #f + 2 + 3)) +(define effect_2547 (finish182 struct:node)) (define node1.1 (|#%name| node @@ -4541,18 +4541,8 @@ (|#%name| set-node-next! (record-mutator struct:node 1))) (define child-node (lambda (child_0) child_0)) (define node-child (lambda (n_0) n_0)) -(define struct:thread-group - (make-record-type-descriptor* - 'thread-group - struct:node - (|#%nongenerative-uid| thread-group) - #f - #f - 4 - 14)) -(define effect_2274 - (struct-type-install-properties! - struct:thread-group +(define finish184 + (make-struct-type-install-properties '(thread-group) 4 0 @@ -4563,6 +4553,16 @@ '(0) #f 'thread-group)) +(define struct:thread-group + (make-record-type-descriptor* + 'thread-group + struct:node + (|#%nongenerative-uid| thread-group) + #f + #f + 4 + 14)) +(define effect_2514 (finish184 struct:thread-group)) (define thread-group2.1 (|#%name| thread-group @@ -4713,18 +4713,8 @@ (begin-unsafe n_0) accum_1))))))))) (loop_0 (thread-group-chain-start parent_0) accum_0))))) -(define struct:schedule-info - (make-record-type-descriptor* - 'schedule-info - #f - (|#%nongenerative-uid| schedule-info) - #f - #f - 2 - 3)) -(define effect_2483 - (struct-type-install-properties! - struct:schedule-info +(define finish196 + (make-struct-type-install-properties '(schedule-info) 2 0 @@ -4735,6 +4725,16 @@ '() #f 'schedule-info)) +(define struct:schedule-info + (make-record-type-descriptor* + 'schedule-info + #f + (|#%nongenerative-uid| schedule-info) + #f + #f + 2 + 3)) +(define effect_2462 (finish196 struct:schedule-info)) (define schedule-info1.1 (|#%name| schedule-info @@ -4844,18 +4844,8 @@ (lambda (sched-info_0) (set-schedule-info-did-work?! sched-info_0 #t))) (define reference-sink (lambda (v_0) (ephemeron-value (make-ephemeron #f (void)) (void) v_0))) -(define struct:plumber - (make-record-type-descriptor* - 'plumber - #f - (|#%nongenerative-uid| plumber) - #f - #f - 2 - 0)) -(define effect_2626 - (struct-type-install-properties! - struct:plumber +(define finish204 + (make-struct-type-install-properties '(plumber) 2 0 @@ -4866,6 +4856,16 @@ '(0 1) #f 'plumber)) +(define struct:plumber + (make-record-type-descriptor* + 'plumber + #f + (|#%nongenerative-uid| plumber) + #f + #f + 2 + 0)) +(define effect_2412 (finish204 struct:plumber)) (define plumber1.1 (|#%name| plumber @@ -4892,18 +4892,8 @@ (raise-argument-error 'current-plumber "plumber?" v_0)) v_0)) 'current-plumber)) -(define struct:plumber-flush-handle - (make-record-type-descriptor* - 'plumber-flush-handle - #f - (|#%nongenerative-uid| plumber-flush-handle) - #f - #f - 2 - 0)) -(define effect_2487 - (struct-type-install-properties! - struct:plumber-flush-handle +(define finish208 + (make-struct-type-install-properties '(plumber-flush-handle) 2 0 @@ -4914,6 +4904,16 @@ '(0 1) #f 'plumber-flush-handle)) +(define struct:plumber-flush-handle + (make-record-type-descriptor* + 'plumber-flush-handle + #f + (|#%nongenerative-uid| plumber-flush-handle) + #f + #f + 2 + 0)) +(define effect_2328 (finish208 struct:plumber-flush-handle)) (define plumber-flush-handle2.1 (|#%name| plumber-flush-handle @@ -5124,18 +5124,8 @@ (|#%name| exit (case-lambda (() (begin (exit_0 #t))) ((v1_0) (exit_0 v1_0)))))) -(define struct:custodian-box - (make-record-type-descriptor* - 'custodian-box - #f - (|#%nongenerative-uid| custodian-box) - #f - #f - 2 - 1)) -(define effect_2348 - (struct-type-install-properties! - struct:custodian-box +(define finish212 + (make-struct-type-install-properties '(custodian-box) 2 0 @@ -5151,6 +5141,16 @@ '(1) #f 'custodian-box)) +(define struct:custodian-box + (make-record-type-descriptor* + 'custodian-box + #f + (|#%nongenerative-uid| custodian-box) + #f + #f + 2 + 1)) +(define effect_2694 (finish212 struct:custodian-box)) (define custodian-box1.1 (|#%name| custodian-box @@ -5164,18 +5164,8 @@ (|#%name| custodian-box-sema (record-accessor struct:custodian-box 1))) (define set-custodian-box-v! (|#%name| set-custodian-box-v! (record-mutator struct:custodian-box 0))) -(define struct:willed-callback - (make-record-type-descriptor* - 'willed-callback - #f - (|#%nongenerative-uid| willed-callback) - #f - #f - 2 - 0)) -(define effect_2870 - (struct-type-install-properties! - struct:willed-callback +(define finish214 + (make-struct-type-install-properties '(willed-callback) 2 0 @@ -5186,6 +5176,16 @@ '(0 1) #f 'willed-callback)) +(define struct:willed-callback + (make-record-type-descriptor* + 'willed-callback + #f + (|#%nongenerative-uid| willed-callback) + #f + #f + 2 + 0)) +(define effect_2527 (finish214 struct:willed-callback)) (define willed-callback2.1 (|#%name| willed-callback @@ -5197,18 +5197,8 @@ (|#%name| willed-callback-proc (record-accessor struct:willed-callback 0))) (define willed-callback-will (|#%name| willed-callback-will (record-accessor struct:willed-callback 1))) -(define struct:at-exit-callback - (make-record-type-descriptor* - 'at-exit-callback - struct:willed-callback - (|#%nongenerative-uid| at-exit-callback) - #f - #f - 0 - 0)) -(define effect_2332 - (struct-type-install-properties! - struct:at-exit-callback +(define finish216 + (make-struct-type-install-properties '(at-exit-callback) 0 0 @@ -5219,6 +5209,16 @@ '() #f 'at-exit-callback)) +(define struct:at-exit-callback + (make-record-type-descriptor* + 'at-exit-callback + struct:willed-callback + (|#%nongenerative-uid| at-exit-callback) + #f + #f + 0 + 0)) +(define effect_2512 (finish216 struct:at-exit-callback)) (define at-exit-callback3.1 (|#%name| at-exit-callback @@ -5226,18 +5226,8 @@ (make-record-constructor-descriptor struct:at-exit-callback #f #f)))) (define at-exit-callback? (|#%name| at-exit-callback? (record-predicate struct:at-exit-callback))) -(define struct:custodian-reference - (make-record-type-descriptor* - 'custodian-reference - #f - (|#%nongenerative-uid| custodian-reference) - #f - #f - 1 - 1)) -(define effect_2409 - (struct-type-install-properties! - struct:custodian-reference +(define finish218 + (make-struct-type-install-properties '(custodian-reference) 1 0 @@ -5248,6 +5238,16 @@ '() #f 'custodian-reference)) +(define struct:custodian-reference + (make-record-type-descriptor* + 'custodian-reference + #f + (|#%nongenerative-uid| custodian-reference) + #f + #f + 1 + 1)) +(define effect_2141 (finish218 struct:custodian-reference)) (define custodian-reference4.1 (|#%name| custodian-reference @@ -6111,7 +6111,7 @@ (define memory-limit-lock (|#%app| host:make-mutex)) (define compute-memory-sizes 0) (define computed-memory-sizes? #f) -(define effect_2498 +(define effect_2497 (begin (void (|#%app| @@ -6565,52 +6565,54 @@ (void))) (void))))))) (loop_0 mref_0)))) -(define struct:thread - (make-record-type-descriptor* - 'thread - struct:node - (|#%nongenerative-uid| thread) - #f - #f - 24 - 16777082)) -(define effect_2967 - (struct-type-install-properties! - struct:thread +(define finish235 + (make-struct-type-install-properties '(thread) 24 0 struct:node - (let ((app_0 (cons prop:authentic #t))) - (let ((app_1 (cons prop:object-name 0))) - (let ((app_2 - (cons - 1/prop:evt - (lambda (t_0) - (wrap-evt7.1 - (|#%app| get-thread-dead-evt t_0) - (lambda (v_0) t_0)))))) + (let ((app_0 (cons prop:sealed #t))) + (let ((app_1 (cons prop:authentic #t))) + (let ((app_2 (cons prop:object-name 0))) (let ((app_3 (cons - prop:waiter - (let ((temp28_0 - (lambda (t_0 i-cb_0) - (|#%app| thread-deschedule! t_0 #f i-cb_0)))) - (let ((temp29_0 - (lambda (t_0 v_0) - (begin (|#%app| thread-reschedule! t_0) v_0)))) - (make-waiter-methods.1 temp29_0 temp28_0)))))) - (list - app_0 - app_1 - app_2 - app_3 - (cons host:prop:unsafe-authentic-override #t)))))) + 1/prop:evt + (lambda (t_0) + (wrap-evt7.1 + (|#%app| get-thread-dead-evt t_0) + (lambda (v_0) t_0)))))) + (let ((app_4 + (cons + prop:waiter + (let ((temp28_0 + (lambda (t_0 i-cb_0) + (|#%app| thread-deschedule! t_0 #f i-cb_0)))) + (let ((temp29_0 + (lambda (t_0 v_0) + (begin (|#%app| thread-reschedule! t_0) v_0)))) + (make-waiter-methods.1 temp29_0 temp28_0)))))) + (list + app_0 + app_1 + app_2 + app_3 + app_4 + (cons host:prop:unsafe-authentic-override #t))))))) (current-inspector) #f '(0 2 7) #f 'thread)) +(define struct:thread + (make-record-type-descriptor* + 'thread + struct:node + (|#%nongenerative-uid| thread) + #t + #f + 24 + 16777082)) +(define effect_2668 (finish235 struct:thread)) (define thread1.1 (|#%name| thread @@ -7079,18 +7081,8 @@ (void) (raise-argument-error 'thread-wait "thread?" t_0)) (1/semaphore-wait (|#%app| get-thread-dead-sema t_0))))))) -(define struct:dead-evt - (make-record-type-descriptor* - 'thread-dead-evt - #f - (|#%nongenerative-uid| thread-dead-evt) - #f - #f - 1 - 0)) -(define effect_2406 - (struct-type-install-properties! - struct:dead-evt +(define finish248 + (make-struct-type-install-properties '(thread-dead-evt) 1 0 @@ -7105,6 +7097,16 @@ '(0) #f 'dead-evt)) +(define struct:dead-evt + (make-record-type-descriptor* + 'thread-dead-evt + #f + (|#%nongenerative-uid| thread-dead-evt) + #f + #f + 1 + 0)) +(define effect_2691 (finish248 struct:dead-evt)) (define dead-evt13.1 (|#%name| dead-evt @@ -7416,18 +7418,8 @@ (let ((app_0 (cdr crs_0))) (loop_0 app_0 (cons (car crs_0) accum_0)))))))))))) (loop_0 (thread-custodian-references t_0) null)))) -(define struct:transitive-resume - (make-record-type-descriptor* - 'transitive-resume - #f - (|#%nongenerative-uid| transitive-resume) - #f - #f - 2 - 0)) -(define effect_2379 - (struct-type-install-properties! - struct:transitive-resume +(define finish260 + (make-struct-type-install-properties '(transitive-resume) 2 0 @@ -7438,6 +7430,16 @@ '(0 1) #f 'transitive-resume)) +(define struct:transitive-resume + (make-record-type-descriptor* + 'transitive-resume + #f + (|#%nongenerative-uid| transitive-resume) + #f + #f + 2 + 0)) +(define effect_3100 (finish260 struct:transitive-resume)) (define transitive-resume16.1 (|#%name| transitive-resume @@ -7547,18 +7549,8 @@ (set-thread-interrupt-callback! t_0 #f) (|#%app| interrupt-callback_0)) (void))))) -(define struct:suspend-resume-evt - (make-record-type-descriptor* - 'suspend-resume-evt - #f - (|#%nongenerative-uid| suspend-resume-evt) - #f - #f - 2 - 2)) -(define effect_2856 - (struct-type-install-properties! - struct:suspend-resume-evt +(define finish266 + (make-struct-type-install-properties '(suspend-resume-evt) 2 0 @@ -7575,6 +7567,16 @@ '(0) #f 'suspend-resume-evt)) +(define struct:suspend-resume-evt + (make-record-type-descriptor* + 'suspend-resume-evt + #f + (|#%nongenerative-uid| suspend-resume-evt) + #f + #f + 2 + 2)) +(define effect_2478 (finish266 struct:suspend-resume-evt)) (define suspend-resume-evt17.1 (|#%name| suspend-resume-evt @@ -7648,18 +7650,8 @@ v 'suspend-resume-evt 'thread)))))) -(define struct:suspend-evt - (make-record-type-descriptor* - 'thread-suspend-evt - struct:suspend-resume-evt - (|#%nongenerative-uid| thread-suspend-evt) - #f - #f - 0 - 0)) -(define effect_2484 - (struct-type-install-properties! - struct:suspend-evt +(define finish272 + (make-struct-type-install-properties '(thread-suspend-evt) 0 0 @@ -7670,6 +7662,16 @@ '() #f 'suspend-evt)) +(define struct:suspend-evt + (make-record-type-descriptor* + 'thread-suspend-evt + struct:suspend-resume-evt + (|#%nongenerative-uid| thread-suspend-evt) + #f + #f + 0 + 0)) +(define effect_2442 (finish272 struct:suspend-evt)) (define suspend-evt18.1 (|#%name| suspend-evt @@ -7685,18 +7687,8 @@ #t ($value (if (impersonator? v) (suspend-evt?_3224 (impersonator-val v)) #f)))))) -(define struct:resume-evt - (make-record-type-descriptor* - 'thread-resume-evt - struct:suspend-resume-evt - (|#%nongenerative-uid| thread-resume-evt) - #f - #f - 0 - 0)) -(define effect_2390 - (struct-type-install-properties! - struct:resume-evt +(define finish275 + (make-struct-type-install-properties '(thread-resume-evt) 0 0 @@ -7707,6 +7699,16 @@ '() #f 'resume-evt)) +(define struct:resume-evt + (make-record-type-descriptor* + 'thread-resume-evt + struct:suspend-resume-evt + (|#%nongenerative-uid| thread-resume-evt) + #f + #f + 0 + 0)) +(define effect_2874 (finish275 struct:resume-evt)) (define resume-evt19.1 (|#%name| resume-evt @@ -8124,18 +8126,8 @@ (begin-unsafe (queue-add-front! (thread-mailbox t_0) msg_0))) lst_0)) (end-atomic))))))) -(define struct:thread-receiver-evt - (make-record-type-descriptor* - 'thread-receive-evt - #f - (|#%nongenerative-uid| thread-receive-evt) - #f - #f - 0 - 0)) -(define effect_2597 - (struct-type-install-properties! - struct:thread-receiver-evt +(define finish290 + (make-struct-type-install-properties '(thread-receive-evt) 0 0 @@ -8186,6 +8178,16 @@ '() #f 'thread-receiver-evt)) +(define struct:thread-receiver-evt + (make-record-type-descriptor* + 'thread-receive-evt + #f + (|#%nongenerative-uid| thread-receive-evt) + #f + #f + 0 + 0)) +(define effect_2506 (finish290 struct:thread-receiver-evt)) (define thread-receiver-evt26.1 (|#%name| thread-receiver-evt @@ -8205,7 +8207,7 @@ #f)))))) (define 1/thread-receive-evt (|#%name| thread-receive-evt (lambda () (begin (thread-receiver-evt26.1))))) -(define effect_2328 +(define effect_2329 (begin (void (|#%app| @@ -8232,18 +8234,8 @@ #f)))) (begin-unsafe (set! thread-engine-for-roots thread-engine_0)))) (void))) -(define struct:channel - (make-record-type-descriptor* - 'channel - #f - (|#%nongenerative-uid| channel) - #f - #f - 2 - 0)) -(define effect_2021 - (struct-type-install-properties! - struct:channel +(define finish294 + (make-struct-type-install-properties '(channel) 2 0 @@ -8258,6 +8250,16 @@ '(0 1) #f 'channel)) +(define struct:channel + (make-record-type-descriptor* + 'channel + #f + (|#%nongenerative-uid| channel) + #f + #f + 2 + 0)) +(define effect_2481 (finish294 struct:channel)) (define channel1.1 (|#%name| channel @@ -8304,18 +8306,8 @@ s 'channel 'put-queue)))))) -(define struct:channel-put-evt* - (make-record-type-descriptor* - 'channel-put-evt - #f - (|#%nongenerative-uid| channel-put-evt) - #f - #f - 2 - 0)) -(define effect_2566 - (struct-type-install-properties! - struct:channel-put-evt* +(define finish301 + (make-struct-type-install-properties '(channel-put-evt) 2 0 @@ -8336,6 +8328,16 @@ '(0 1) #f 'channel-put-evt*)) +(define struct:channel-put-evt* + (make-record-type-descriptor* + 'channel-put-evt + #f + (|#%nongenerative-uid| channel-put-evt) + #f + #f + 2 + 0)) +(define effect_2715 (finish301 struct:channel-put-evt*)) (define channel-put-evt*2.1 (|#%name| channel-put-evt* @@ -8385,18 +8387,8 @@ s 'channel-put-evt 'v)))))) -(define struct:channel-select-waiter - (make-record-type-descriptor* - 'channel-select-waiter - struct:select-waiter - (|#%nongenerative-uid| channel-select-waiter) - #f - #f - 1 - 0)) -(define effect_2402 - (struct-type-install-properties! - struct:channel-select-waiter +(define finish307 + (make-struct-type-install-properties '(channel-select-waiter) 1 0 @@ -8407,6 +8399,16 @@ '(0) #f 'channel-select-waiter)) +(define struct:channel-select-waiter + (make-record-type-descriptor* + 'channel-select-waiter + struct:select-waiter + (|#%nongenerative-uid| channel-select-waiter) + #f + #f + 1 + 0)) +(define effect_2956 (finish307 struct:channel-select-waiter)) (define channel-select-waiter3.1 (|#%name| channel-select-waiter @@ -8899,18 +8901,8 @@ (car args_1)) (loop_0 (cddr args_1)))))))))) (loop_0 args_0)))) -(define struct:syncing - (make-record-type-descriptor* - 'syncing - #f - (|#%nongenerative-uid| syncing) - #f - #f - 5 - 31)) -(define effect_2287 - (struct-type-install-properties! - struct:syncing +(define finish337 + (make-struct-type-install-properties '(syncing) 5 0 @@ -8921,6 +8913,16 @@ '() #f 'syncing)) +(define struct:syncing + (make-record-type-descriptor* + 'syncing + #f + (|#%nongenerative-uid| syncing) + #f + #f + 5 + 31)) +(define effect_2363 (finish337 struct:syncing)) (define syncing1.1 (|#%name| syncing @@ -9105,18 +9107,8 @@ v 'syncing 'need-retry?)))))) -(define struct:syncer - (make-record-type-descriptor* - 'syncer - #f - (|#%nongenerative-uid| syncer) - #f - #f - 9 - 511)) -(define effect_2172 - (struct-type-install-properties! - struct:syncer +(define finish350 + (make-struct-type-install-properties '(syncer) 9 0 @@ -9127,6 +9119,16 @@ '() #f 'syncer)) +(define struct:syncer + (make-record-type-descriptor* + 'syncer + #f + (|#%nongenerative-uid| syncer) + #f + #f + 9 + 511)) +(define effect_2176 (finish350 struct:syncer)) (define syncer2.1 (|#%name| syncer @@ -10635,11 +10637,8 @@ (end-atomic))))))))))))))))) (retry_0)) (end-atomic)))))) -(define struct:replacing-evt - (make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 1 0)) -(define effect_2315 - (struct-type-install-properties! - struct:replacing-evt +(define finish400 + (make-struct-type-install-properties '(evt) 1 0 @@ -10654,6 +10653,9 @@ '(0) #f 'replacing-evt)) +(define struct:replacing-evt + (make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 1 0)) +(define effect_2704 (finish400 struct:replacing-evt)) (define replacing-evt34.1 (|#%name| replacing-evt @@ -10687,11 +10689,8 @@ s 'evt 'guard)))))) -(define struct:nested-sync-evt - (make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 3 0)) -(define effect_2607 - (struct-type-install-properties! - struct:nested-sync-evt +(define finish404 + (make-struct-type-install-properties '(evt) 3 0 @@ -10705,6 +10704,9 @@ '(0 1 2) #f 'nested-sync-evt)) +(define struct:nested-sync-evt + (make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 3 0)) +(define effect_2461 (finish404 struct:nested-sync-evt)) (define nested-sync-evt35.1 (|#%name| nested-sync-evt @@ -10904,18 +10906,8 @@ (define cell.2$3 (unsafe-make-place-local (wrap-evt7.1 (unsafe-place-local-ref cell.1$5) void))) -(define struct:system-idle-evt - (make-record-type-descriptor* - 'system-idle-evt - #f - (|#%nongenerative-uid| system-idle-evt) - #f - #f - 0 - 0)) -(define effect_2854 - (struct-type-install-properties! - struct:system-idle-evt +(define finish413 + (make-struct-type-install-properties '(system-idle-evt) 0 0 @@ -10926,6 +10918,16 @@ '() #f 'system-idle-evt)) +(define struct:system-idle-evt + (make-record-type-descriptor* + 'system-idle-evt + #f + (|#%nongenerative-uid| system-idle-evt) + #f + #f + 0 + 0)) +(define effect_2195 (finish413 struct:system-idle-evt)) (define system-idle-evt1.1 (|#%name| system-idle-evt @@ -10965,18 +10967,8 @@ (wrap-evt7.1 (unsafe-place-local-ref cell.1$5) void))))) (define TICKS 100000) (define set-schedule-quantum! (lambda (n_0) (set! TICKS n_0))) -(define struct:future* - (make-record-type-descriptor* - 'future - #f - (|#%nongenerative-uid| future) - #f - #f - 10 - 1016)) -(define effect_3020 - (struct-type-install-properties! - struct:future* +(define finish419 + (make-struct-type-install-properties '(future) 10 0 @@ -10987,6 +10979,16 @@ '(0 1 2) #f 'future*)) +(define struct:future* + (make-record-type-descriptor* + 'future + #f + (|#%nongenerative-uid| future) + #f + #f + 10 + 1016)) +(define effect_2258 (finish419 struct:future*)) (define future*1.1 (|#%name| future* @@ -11068,18 +11070,8 @@ (if (eq? (unbox lock_0) 0) (internal-error "lock release failed!") (lock-release lock_0))))) -(define struct:future-event - (make-record-type-descriptor* - 'future-event - #f - (structure-type-lookup-prefab-uid 'future-event #f 6 0 #f '(0 1 2 3 4 5)) - #f - #f - 6 - 63)) -(define effect_2966 - (struct-type-install-properties! - struct:future-event +(define finish422 + (make-struct-type-install-properties '(future-event) 6 0 @@ -11090,6 +11082,16 @@ '(0 1 2 3 4 5) #f 'future-event)) +(define struct:future-event + (make-record-type-descriptor* + 'future-event + #f + (structure-type-lookup-prefab-uid 'future-event #f 6 0 #f '(0 1 2 3 4 5)) + #f + #f + 6 + 63)) +(define effect_2115 (finish422 struct:future-event)) (define future-event1.1 (|#%name| future-event @@ -11360,18 +11362,8 @@ (define init-future-place! (lambda () (init-future-logging-place!))) (define 1/futures-enabled? (|#%name| futures-enabled? (lambda () (begin (|#%app| threaded?))))) -(define struct:future-evt - (make-record-type-descriptor* - 'future-evt - #f - (|#%nongenerative-uid| future-evt) - #f - #f - 1 - 0)) -(define effect_2519 - (struct-type-install-properties! - struct:future-evt +(define finish437 + (make-struct-type-install-properties '(future-evt) 1 0 @@ -11396,6 +11388,16 @@ '(0) #f 'future-evt)) +(define struct:future-evt + (make-record-type-descriptor* + 'future-evt + #f + (|#%nongenerative-uid| future-evt) + #f + #f + 1 + 0)) +(define effect_2000 (finish437 struct:future-evt)) (define future-evt1.1 (|#%name| future-evt @@ -11803,18 +11805,8 @@ v_0)))))))))) (define pthread-count 1) (define set-processor-count! (lambda (n_0) (set! pthread-count n_0))) -(define struct:scheduler - (make-record-type-descriptor* - 'scheduler - #f - (|#%nongenerative-uid| scheduler) - #f - #f - 6 - 7)) -(define effect_2452 - (struct-type-install-properties! - struct:scheduler +(define finish441 + (make-struct-type-install-properties '(scheduler) 6 0 @@ -11825,6 +11817,16 @@ '(3 4 5) #f 'scheduler)) +(define struct:scheduler + (make-record-type-descriptor* + 'scheduler + #f + (|#%nongenerative-uid| scheduler) + #f + #f + 6 + 7)) +(define effect_2657 (finish441 struct:scheduler)) (define scheduler7.1 (|#%name| scheduler @@ -11849,18 +11851,8 @@ (|#%name| set-scheduler-futures-head! (record-mutator struct:scheduler 1))) (define set-scheduler-futures-tail! (|#%name| set-scheduler-futures-tail! (record-mutator struct:scheduler 2))) -(define struct:worker - (make-record-type-descriptor* - 'worker - #f - (|#%nongenerative-uid| worker) - #f - #f - 5 - 26)) -(define effect_2639 - (struct-type-install-properties! - struct:worker +(define finish443 + (make-struct-type-install-properties '(worker) 5 0 @@ -11871,6 +11863,16 @@ '(0 2) #f 'worker)) +(define struct:worker + (make-record-type-descriptor* + 'worker + #f + (|#%nongenerative-uid| worker) + #f + #f + 5 + 26)) +(define effect_2821 (finish443 struct:worker)) (define worker8.1 (|#%name| worker @@ -12697,18 +12699,8 @@ (define check-place-activity void) (define set-check-place-activity! (lambda (proc_0) (set! check-place-activity proc_0))) -(define struct:alarm-evt - (make-record-type-descriptor* - 'alarm-evt - #f - (|#%nongenerative-uid| alarm-evt) - #f - #f - 1 - 0)) -(define effect_2783 - (struct-type-install-properties! - struct:alarm-evt +(define finish462 + (make-struct-type-install-properties '(alarm-evt) 1 0 @@ -12731,6 +12723,16 @@ '(0) #f 'alarm-evt)) +(define struct:alarm-evt + (make-record-type-descriptor* + 'alarm-evt + #f + (|#%nongenerative-uid| alarm-evt) + #f + #f + 1 + 0)) +(define effect_2822 (finish462 struct:alarm-evt)) (define alarm-evt1.1 (|#%name| alarm-evt @@ -13256,18 +13258,8 @@ (begin (call-with-semaphore/enable-break_0 s_0 proc_0 #f null))) ((s_0 proc_0 try-fail12_0 . args_0) (call-with-semaphore/enable-break_0 s_0 proc_0 try-fail12_0 args_0)))))) -(define struct:will-executor - (make-record-type-descriptor* - 'will-executor - #f - (|#%nongenerative-uid| will-executor) - #f - #f - 2 - 0)) -(define effect_2531 - (struct-type-install-properties! - struct:will-executor +(define finish467 + (make-struct-type-install-properties '(will-executor) 2 0 @@ -13286,6 +13278,16 @@ '(0 1) #f 'will-executor)) +(define struct:will-executor + (make-record-type-descriptor* + 'will-executor + #f + (|#%nongenerative-uid| will-executor) + #f + #f + 2 + 0)) +(define effect_2170 (finish467 struct:will-executor)) (define will-executor1.1 (|#%name| will-executor @@ -13602,18 +13604,8 @@ v_0)) v_0)) 'current-thread-initial-stack-size)) -(define struct:place-event - (make-record-type-descriptor* - 'place-event - #f - (structure-type-lookup-prefab-uid 'place-event #f 4 0 #f '(0 1 2 3)) - #f - #f - 4 - 15)) -(define effect_2427 - (struct-type-install-properties! - struct:place-event +(define finish471 + (make-struct-type-install-properties '(place-event) 4 0 @@ -13624,6 +13616,16 @@ '(0 1 2 3) #f 'place-event)) +(define struct:place-event + (make-record-type-descriptor* + 'place-event + #f + (structure-type-lookup-prefab-uid 'place-event #f 4 0 #f '(0 1 2 3)) + #f + #f + 4 + 15)) +(define effect_2598 (finish471 struct:place-event)) (define place-event1.1 (|#%name| place-event @@ -14286,18 +14288,8 @@ (|#%app| (sandman-do-sleep the-sandman) #f)) (loop_0))))))))))) (loop_0))))) -(define struct:place-done-evt - (make-record-type-descriptor* - 'place-dead-evt - #f - (|#%nongenerative-uid| place-dead-evt) - #f - #f - 2 - 0)) -(define effect_2098 - (struct-type-install-properties! - struct:place-done-evt +(define finish487 + (make-struct-type-install-properties '(place-dead-evt) 2 0 @@ -14331,6 +14323,16 @@ '(0 1) #f 'place-done-evt)) +(define struct:place-done-evt + (make-record-type-descriptor* + 'place-dead-evt + #f + (|#%nongenerative-uid| place-dead-evt) + #f + #f + 2 + 0)) +(define effect_2480 (finish487 struct:place-done-evt)) (define place-done-evt3.1 (|#%name| place-done-evt @@ -14392,18 +14394,8 @@ (void) (raise-argument-error 'place-dead-evt "place?" p_0)) (place-done-evt3.1 p_0 #f)))))) -(define struct:message-queue - (make-record-type-descriptor* - 'message-queue - #f - (|#%nongenerative-uid| message-queue) - #f - #f - 6 - 22)) -(define effect_2499 - (struct-type-install-properties! - struct:message-queue +(define finish491 + (make-struct-type-install-properties '(message-queue) 6 0 @@ -14414,6 +14406,16 @@ '(0 3 5) #f 'message-queue)) +(define struct:message-queue + (make-record-type-descriptor* + 'message-queue + #f + (|#%nongenerative-uid| message-queue) + #f + #f + 6 + 22)) +(define effect_2109 (finish491 struct:message-queue)) (define message-queue4.1 (|#%name| message-queue @@ -14547,18 +14549,8 @@ (void)) (|#%app| host:mutex-release lock_0) (|#%app| success-k_0 (car q_0)))))))))))) -(define struct:pchannel - (make-record-type-descriptor* - 'place-channel - #f - (|#%nongenerative-uid| place-channel) - #f - #f - 6 - 0)) -(define effect_2960 - (struct-type-install-properties! - struct:pchannel +(define finish495 + (make-struct-type-install-properties '(place-channel) 6 0 @@ -14588,6 +14580,16 @@ '(0 1 2 3 4 5) #f 'pchannel)) +(define struct:pchannel + (make-record-type-descriptor* + 'place-channel + #f + (|#%nongenerative-uid| place-channel) + #f + #f + 6 + 0)) +(define effect_2172 (finish495 struct:pchannel)) (define pchannel5.1 (|#%name| pchannel @@ -14836,18 +14838,8 @@ (lambda () (place-has-activity! (unsafe-place-local-ref cell.1$2))) (lambda () (ensure-wakeup-handle!)))) (void))) -(define struct:fsemaphore - (make-record-type-descriptor* - 'fsemaphore - #f - (|#%nongenerative-uid| fsemaphore) - #f - #f - 4 - 13)) -(define effect_2715 - (struct-type-install-properties! - struct:fsemaphore +(define finish505 + (make-struct-type-install-properties '(fsemaphore) 4 0 @@ -14858,6 +14850,16 @@ '(1) #f 'fsemaphore)) +(define struct:fsemaphore + (make-record-type-descriptor* + 'fsemaphore + #f + (|#%nongenerative-uid| fsemaphore) + #f + #f + 4 + 13)) +(define effect_2528 (finish505 struct:fsemaphore)) (define fsemaphore1.1 (|#%name| fsemaphore @@ -14879,18 +14881,8 @@ (|#%name| set-fsemaphore-dependents! (record-mutator struct:fsemaphore 2))) (define set-fsemaphore-dep-box! (|#%name| set-fsemaphore-dep-box! (record-mutator struct:fsemaphore 3))) -(define struct:fsemaphore-box-evt - (make-record-type-descriptor* - 'fsemaphore-box-evt - #f - (|#%nongenerative-uid| fsemaphore-box-evt) - #f - #f - 1 - 0)) -(define effect_2250 - (struct-type-install-properties! - struct:fsemaphore-box-evt +(define finish510 + (make-struct-type-install-properties '(fsemaphore-box-evt) 1 0 @@ -14907,6 +14899,16 @@ '(0) #f 'fsemaphore-box-evt)) +(define struct:fsemaphore-box-evt + (make-record-type-descriptor* + 'fsemaphore-box-evt + #f + (|#%nongenerative-uid| fsemaphore-box-evt) + #f + #f + 1 + 0)) +(define effect_2415 (finish510 struct:fsemaphore-box-evt)) (define fsemaphore-box-evt2.1 (|#%name| fsemaphore-box-evt @@ -15081,18 +15083,8 @@ fork-pthread (lambda () (begin (start-atomic) (|#%app| proc_0)))) (void)))))) -(define struct:os-semaphore - (make-record-type-descriptor* - 'os-semaphore - #f - (|#%nongenerative-uid| os-semaphore) - #f - #f - 3 - 1)) -(define effect_2314 - (struct-type-install-properties! - struct:os-semaphore +(define finish513 + (make-struct-type-install-properties '(os-semaphore) 3 0 @@ -15103,6 +15095,16 @@ '(1 2) #f 'os-semaphore)) +(define struct:os-semaphore + (make-record-type-descriptor* + 'os-semaphore + #f + (|#%nongenerative-uid| os-semaphore) + #f + #f + 3 + 1)) +(define effect_2703 (finish513 struct:os-semaphore)) (define os-semaphore1.1 (|#%name| os-semaphore diff --git a/racket/src/expander/compile/built-in-symbol.rkt b/racket/src/expander/compile/built-in-symbol.rkt index 13d3466e41..96e1d04015 100644 --- a/racket/src/expander/compile/built-in-symbol.rkt +++ b/racket/src/expander/compile/built-in-symbol.rkt @@ -85,13 +85,14 @@ record-accessor record-mutator record-predicate - struct-type-install-properties! + make-struct-type-install-properties #%struct-constructor #%struct-predicate #%struct-field-accessor #%struct-field-mutator #%nongenerative-uid unsafe-struct? + unsafe-sealed-struct? unsafe-struct raise-binding-result-arity-error raise-definition-result-arity-error diff --git a/racket/src/expander/syntax/scope.rkt b/racket/src/expander/syntax/scope.rkt index 5257f541c7..703a27e10e 100644 --- a/racket/src/expander/syntax/scope.rkt +++ b/racket/src/expander/syntax/scope.rkt @@ -167,6 +167,7 @@ shifted ; box of table: interned shifted-multi-scopes for non-label phases label-shifted) ; box of table: interned shifted-multi-scopes for label phases #:authentic + #:sealed #:property prop:serialize (lambda (ms ser-push! state) (ser-push! 'tag '#:multi-scope) @@ -247,6 +248,7 @@ (struct shifted-multi-scope (phase ; non-label phase shift or shifted-to-label-phase multi-scope) ; a multi-scope #:authentic + #:sealed #:property prop:custom-write (lambda (sms port mode) (write-string "#list needed))] [else (known-predicate (known-procedure-arity-mask k) diff --git a/racket/src/schemify/known.rkt b/racket/src/schemify/known.rkt index 37f855be05..7da70419e6 100644 --- a/racket/src/schemify/known.rkt +++ b/racket/src/schemify/known.rkt @@ -29,13 +29,14 @@ known-procedure/has-unsafe/folding/limited known-procedure/has-unsafe/folding/limited? known-procedure/has-unsafe/folding/limited-kind known-struct-type known-struct-type? known-struct-type-type - known-struct-type-field-count known-struct-type-pure-constructor? + known-struct-type-field-count known-struct-type-pure-constructor? known-struct-type-sealed? known-constructor known-constructor? known-constructor-type known-predicate known-predicate? known-predicate-type known-accessor known-accessor? known-accessor-type known-mutator known-mutator? known-mutator-type known-struct-constructor known-struct-constructor? known-struct-constructor-type-id - known-struct-predicate known-struct-predicate? known-struct-predicate-type-id known-struct-predicate-authentic? + known-struct-predicate known-struct-predicate? known-struct-predicate-type-id + known-struct-predicate-authentic? known-struct-predicate-sealed? known-field-accessor known-field-accessor? known-field-accessor-type-id known-field-accessor-authentic? known-field-accessor-pos known-field-accessor-known-immutable? known-field-mutator known-field-mutator? known-field-mutator-type-id known-field-mutator-authentic? @@ -115,7 +116,7 @@ (struct known-procedure/has-unsafe/folding () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/has-unsafe) (struct known-procedure/has-unsafe/folding/limited (kind) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/has-unsafe/folding) -(struct known-struct-type (type field-count pure-constructor?) #:prefab #:omit-define-syntaxes #:super struct:known-consistent) +(struct known-struct-type (type field-count pure-constructor? sealed?) #:prefab #:omit-define-syntaxes #:super struct:known-consistent) ;; procedures with a known connection to a structure type: (struct known-constructor (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/allocates) @@ -123,7 +124,7 @@ (struct known-accessor (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/single-valued) (struct known-mutator (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/single-valued) (struct known-struct-constructor (type-id) #:prefab #:omit-define-syntaxes #:super struct:known-constructor) -(struct known-struct-predicate (type-id authentic?) #:prefab #:omit-define-syntaxes #:super struct:known-predicate) +(struct known-struct-predicate (type-id authentic? sealed?) #:prefab #:omit-define-syntaxes #:super struct:known-predicate) (struct known-field-accessor (type-id authentic? pos known-immutable?) #:prefab #:omit-define-syntaxes #:super struct:known-accessor) (struct known-field-mutator (type-id authentic? pos) #:prefab #:omit-define-syntaxes #:super struct:known-mutator) (struct known-struct-constructor/need-imports (needed) #:prefab #:omit-define-syntaxes #:super struct:known-struct-constructor) diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index 639cb8c182..5ad29f4c14 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -872,21 +872,24 @@ (define type-id (and (pair? args) (null? (cdr args)) (inline-type-id k im add-import! mutated imports))) + (define unsafe-struct? (if (known-struct-predicate-sealed? k) + 'unsafe-sealed-struct? + 'unsafe-struct?)) (cond [(not type-id) #f] [(known-struct-predicate-authentic? k) (define tmp (maybe-tmp (car args) 'v)) - (define ques `(unsafe-struct? ,tmp ,(schemify type-id 'fresh))) + (define ques `(,unsafe-struct? ,tmp ,(schemify type-id 'fresh))) (wrap-tmp tmp (car args) ques)] [else (define tmp (maybe-tmp (car args) 'v)) (define schemified-type-id (schemify type-id 'fresh)) (define tmp-type-id (maybe-tmp schemified-type-id 'v)) - (define ques `(if (unsafe-struct? ,tmp ,tmp-type-id) + (define ques `(if (,unsafe-struct? ,tmp ,tmp-type-id) #t (if (impersonator? ,tmp) - (unsafe-struct? (impersonator-val ,tmp) ,tmp-type-id) + (,unsafe-struct? (impersonator-val ,tmp) ,tmp-type-id) #f))) (wrap-tmp tmp (car args) (wrap-tmp tmp-type-id schemified-type-id diff --git a/racket/src/schemify/struct-convert.rkt b/racket/src/schemify/struct-convert.rkt index 92104304c9..2093ada347 100644 --- a/racket/src/schemify/struct-convert.rkt +++ b/racket/src/schemify/struct-convert.rkt @@ -60,7 +60,24 @@ (define system-opaque? (and (aim? target 'system) (or (not exports) (eq? 'no (hash-ref exports (unwrap struct:s) 'no))))) + (define finish!-id (and (or (pair? (struct-type-info-rest sti)) + (and (struct-type-info-prefab-immutables sti) + ;; to ensure that the super is also a prefab: + (unwrap (struct-type-info-parent sti)))) + (deterministic-gensym "finish"))) `(begin + ,@(if finish!-id + `((define ,finish!-id + (make-struct-type-install-properties ',(if system-opaque? + ;; list is recognized by `struct-type-install-properties!` + ;; to indicate a system structure type: + (list (struct-type-info-name sti)) + (struct-type-info-name sti)) + ,(struct-type-info-immediate-field-count sti) + 0 + ,(schemify (struct-type-info-parent sti) knowns) + ,@(schemify-body schemify knowns (struct-type-info-rest sti))))) + null) (define ,struct:s (make-record-type-descriptor* ',(struct-type-info-name sti) ,(schemify (struct-type-info-parent sti) knowns) ,(if (not (struct-type-info-prefab-immutables sti)) @@ -74,7 +91,7 @@ ,(struct-type-info-immediate-field-count sti) 0 #f ',(struct-type-info-prefab-immutables sti))) - #f + ,(struct-type-info-sealed? sti) #f ,(struct-type-info-immediate-field-count sti) ,(let* ([n (struct-type-info-immediate-field-count sti)] @@ -91,19 +108,9 @@ (loop (cdr imms) (bitwise-and mask m)))])))] [else mask])))) - ,@(if (null? (struct-type-info-rest sti)) - null - `((define ,(deterministic-gensym "effect") - (struct-type-install-properties! ,struct:s - ',(if system-opaque? - ;; list is recognized by `struct-type-install-properties!` - ;; to indincate a system structure type: - (list (struct-type-info-name sti)) - (struct-type-info-name sti)) - ,(struct-type-info-immediate-field-count sti) - 0 - ,(schemify (struct-type-info-parent sti) knowns) - ,@(schemify-body schemify knowns (struct-type-info-rest sti)))))) + ,@(if finish!-id + `((define ,(deterministic-gensym "effect") (,finish!-id ,struct:s))) + null) (define ,make-s ,(let ([ctr `(record-constructor (make-record-constructor-descriptor ,struct:s #f #f))]) (define ctr-expr diff --git a/racket/src/schemify/struct-type-info.rkt b/racket/src/schemify/struct-type-info.rkt index 191e7d86c0..284db5d37a 100644 --- a/racket/src/schemify/struct-type-info.rkt +++ b/racket/src/schemify/struct-type-info.rkt @@ -17,6 +17,7 @@ field-count pure-constructor? authentic? + sealed? prefab-immutables ; #f or immutable expression to be quoted non-prefab-immutables ; #f or immutable expression to be quoted constructor-name-expr ; an expression @@ -107,6 +108,7 @@ (not (unwrap (list-ref rest 4)))) (not (includes-property? 'prop:chaperone-unsafe-undefined))) (includes-property? 'prop:authentic) + (includes-property? 'prop:sealed) (if (eq? prefab-imms 'non-prefab) #f prefab-imms) diff --git a/racket/src/thread/thread.rkt b/racket/src/thread/thread.rkt index 6791ff01a8..7a1c7c5115 100644 --- a/racket/src/thread/thread.rkt +++ b/racket/src/thread/thread.rkt @@ -131,6 +131,7 @@ [future #:mutable]) ; current would-be future #:authentic + #:sealed #:property host:prop:unsafe-authentic-override #t ; allow evt chaperone #:property prop:waiter (make-waiter-methods diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index 9d1a611051..fa9873102c 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 6 +#define MZSCHEME_VERSION_W 7 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x