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