diff --git a/.makefile b/.makefile index 2c849b171a..63eb121733 100644 --- a/.makefile +++ b/.makefile @@ -338,7 +338,7 @@ RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) # This branch name changes each time the pb boot files are updated: -PB_BRANCH == circa-7.9.0.10-1 +PB_BRANCH == circa-7.9.0.11-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 dbd18958fa..c84688de5f 100644 --- a/Makefile +++ b/Makefile @@ -47,7 +47,7 @@ RACKETCS_SUFFIX = RACKET = RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) -PB_BRANCH = circa-7.9.0.10-1 +PB_BRANCH = circa-7.9.0.11-1 PB_REPO = https://github.com/racket/pb EXTRA_REPOS_BASE = CS_CROSS_SUFFIX = @@ -307,18 +307,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-7.9.0.10-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.10-1:remotes/origin/circa-7.9.0.10-1 ; fi - cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.10-1 + if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-7.9.0.11-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.11-1:remotes/origin/circa-7.9.0.11-1 ; fi + cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.11-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-7.9.0.10-1 - cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.10-1 + cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.11-1 + cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.11-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-7.9.0.10-1 + cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.11-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 0ddc04ab29..b0512fcca4 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 "7.9.0.10") +(define version "7.9.0.11") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-test-core/tests/racket/macro.rktl b/pkgs/racket-test-core/tests/racket/macro.rktl index 45deed785c..25ddf9c41e 100644 --- a/pkgs/racket-test-core/tests/racket/macro.rktl +++ b/pkgs/racket-test-core/tests/racket/macro.rktl @@ -3,6 +3,10 @@ (Section 'macro) +(test #f struct-predicate-procedure? syntax?) + +(test #t struct-predicate-procedure? exn:fail:syntax?) + (error-test #'(define-syntaxes () (values 1)) exn:application:arity?) (error-test #'(define-syntaxes () (values 1 2)) exn:application:arity?) (error-test #'(define-syntaxes (x) (values 1 2)) exn:application:arity?) diff --git a/pkgs/racket-test-core/tests/racket/struct.rktl b/pkgs/racket-test-core/tests/racket/struct.rktl index 751d4f2c9c..8bbfd2eefe 100644 --- a/pkgs/racket-test-core/tests/racket/struct.rktl +++ b/pkgs/racket-test-core/tests/racket/struct.rktl @@ -671,6 +671,19 @@ (test #f inspector-superior? (make-sibling-inspector) (current-inspector)) (test #t inspector-superior? (current-inspector) (make-sibling-inspector (make-inspector))) +;; ------------------------------------------------------------ +;; Some built-in structure procedures + +(test #t struct-predicate-procedure? exn?) +(test #t struct-predicate-procedure? exn:fail?) +(test #t struct-predicate-procedure? exn:fail:contract?) +(test #t struct-predicate-procedure? srcloc?) +(test #t struct-predicate-procedure? date?) + +(test #t struct-accessor-procedure? exn-message) +(test #t struct-accessor-procedure? srcloc-line) +(test #t struct-accessor-procedure? date-month) + ;; ------------------------------------------------------------ ;; Property accessor errors diff --git a/pkgs/racket-test-core/tests/racket/thread.rktl b/pkgs/racket-test-core/tests/racket/thread.rktl index 452cffa994..c42d5c88d7 100644 --- a/pkgs/racket-test-core/tests/racket/thread.rktl +++ b/pkgs/racket-test-core/tests/racket/thread.rktl @@ -16,6 +16,10 @@ (err/rt-test (thread (lambda (x) 8)) type?) (arity-test thread? 1 1) +(test #f struct-predicate-procedure? thread?) +(test #f struct-predicate-procedure? evt?) +(test #f struct-type-property-predicate-procedure? evt?) + ;; ---------------------------------------- ;; Thread sets diff --git a/racket/src/ChezScheme/csug/objects.stex b/racket/src/ChezScheme/csug/objects.stex index eacdcae0bf..ba3f97bd6b 100644 --- a/racket/src/ChezScheme/csug/objects.stex +++ b/racket/src/ChezScheme/csug/objects.stex @@ -4491,10 +4491,27 @@ Determines whether \var{obj} is a wrapper procedure produced by either \endschemedisplay +%---------------------------------------------------------------------------- +\entryheader +\formdef{wrapper-procedure-procedure}{\categoryprocedure}{(wrapper-procedure-data \var{w-proc})} +\returns the procedure wrapped by the wrapper procedure \var{proc} +\listlibraries +\endentryheader + +\noindent +\var{w-proc} must be a wrapper procedure produced by either +\scheme{make-wrapper-procedure} or \scheme{make-arity-wrapper-procedure}. + + +\schemedisplay +(define vector3 (make-wrapper-procedure vector 8 'my-data)) +(arity-wrapper-procedure-data vector3) ; => # +\endschemedisplay + %---------------------------------------------------------------------------- \entryheader \formdef{wrapper-procedure-data}{\categoryprocedure}{(wrapper-procedure-data \var{w-proc})} -\returns the data store with the arity wrapper procedure \var{proc} +\returns the data stored with the wrapper procedure \var{proc} \listlibraries \endentryheader diff --git a/racket/src/ChezScheme/makefiles/Mf-install.in b/racket/src/ChezScheme/makefiles/Mf-install.in index 6e5959ca03..6dbb14ce5b 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.3.53 +Version=csv9.5.3.54 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 d8eb39ce8a..783de6fbf2 100644 --- a/racket/src/ChezScheme/s/cmacros.ss +++ b/racket/src/ChezScheme/s/cmacros.ss @@ -1,4 +1,4 @@ -;;; Copyright 1984-2017 Cisco Systems, Inc. +<;;; Copyright 1984-2017 Cisco Systems, Inc. ;;; ;;; Licensed under the Apache License, Version 2.0 (the "License"); ;;; you may not use this file except in compliance with the License. @@ -357,7 +357,7 @@ ;; --------------------------------------------------------------------- ;; Version and machine types: -(define-constant scheme-version #x09050335) +(define-constant scheme-version #x09050336) (define-syntax define-machine-types (lambda (x) diff --git a/racket/src/ChezScheme/s/primdata.ss b/racket/src/ChezScheme/s/primdata.ss index ea8965d805..5e4d1c6894 100644 --- a/racket/src/ChezScheme/s/primdata.ss +++ b/racket/src/ChezScheme/s/primdata.ss @@ -1826,7 +1826,8 @@ (with-profile-tracker [sig [(procedure) (ptr procedure) -> (ptr ptr ...)]] [flags]) (with-source-path [sig [(maybe-who pathname procedure) -> (ptr ...)]] [flags]) (wrapper-procedure? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) - (wrapper-procedure-data [sig [(ptr) -> (ptr)]] [flags discard]) + (wrapper-procedure-data [sig [(ptr) -> (ptr)]] [flags]) + (wrapper-procedure-procedure [sig [(ptr) -> (procedure)]] [flags true]) ) diff --git a/racket/src/ChezScheme/s/prims.ss b/racket/src/ChezScheme/s/prims.ss index aa60ad127c..9a1a860798 100644 --- a/racket/src/ChezScheme/s/prims.ss +++ b/racket/src/ChezScheme/s/prims.ss @@ -2758,6 +2758,11 @@ ;; Indirect way of distinguishing from `$make-wrapper-procedure` result: ($code-mutable-closure? c)))))) +(define-who wrapper-procedure-procedure + (lambda (x) + (unless (wrapper-procedure? x) ($oops who "~s is not a wrapper procedure" x)) + ($closure-ref x 0))) + (define-who set-wrapper-procedure! (lambda (x proc) (unless (wrapper-procedure? x) ($oops who "~s is not a wrapper procedure" x)) diff --git a/racket/src/bc/include/scheme.h b/racket/src/bc/include/scheme.h index d1088b037b..bed459db68 100644 --- a/racket/src/bc/include/scheme.h +++ b/racket/src/bc/include/scheme.h @@ -2102,6 +2102,7 @@ extern Scheme_Extension_Table *scheme_extension_table; #define SCHEME_STRUCT_EXPTIME 0x80 #define SCHEME_STRUCT_NO_MAKE_PREFIX 0x100 #define SCHEME_STRUCT_NAMES_ARE_STRINGS 0x200 +#define SCHEME_STRUCT_BUILTIN 0x400 /*========================================================================*/ /* file descriptors */ diff --git a/racket/src/bc/src/cify-startup.rkt b/racket/src/bc/src/cify-startup.rkt index 012e840bf3..33da7371fa 100644 --- a/racket/src/bc/src/cify-startup.rkt +++ b/racket/src/bc/src/cify-startup.rkt @@ -78,8 +78,7 @@ (define body (time (schemify-body (recognize-inferred-names bodys/re-uniqued) prim-knowns #hasheq() #hasheq() #hasheq() - ;; for cify: - #t + 'cify ;; unsafe mode: #t ;; no prompts: diff --git a/racket/src/bc/src/error.c b/racket/src/bc/src/error.c index a41fb7ad47..cb1147d84f 100644 --- a/racket/src/bc/src/error.c +++ b/racket/src/bc/src/error.c @@ -4751,7 +4751,7 @@ void scheme_init_exn(Scheme_Startup_Env *env) #define EXN_PARENT(id) exn_table[id].type -#define EXN_FLAGS (SCHEME_STRUCT_EXPTIME | SCHEME_STRUCT_NO_SET | SCHEME_STRUCT_NO_MAKE_PREFIX) +#define EXN_FLAGS (SCHEME_STRUCT_EXPTIME | SCHEME_STRUCT_NO_SET | SCHEME_STRUCT_NO_MAKE_PREFIX | SCHEME_STRUCT_BUILTIN) #define SETUP_STRUCT(id, parent, name, argc, args, props, guard) \ { tmpo = scheme_make_struct_type_from_string(name, parent, argc, props, guard, 1); \ diff --git a/racket/src/bc/src/fun.c b/racket/src/bc/src/fun.c index 4b78e38a3a..f1ccddf29f 100644 --- a/racket/src/bc/src/fun.c +++ b/racket/src/bc/src/fun.c @@ -1002,7 +1002,8 @@ int scheme_intern_prim_opt_flags(int flags) } } - scheme_signal_error("too many flag combinations"); + scheme_log_abort("too many flag combinations"); + abort(); return 0; } diff --git a/racket/src/bc/src/startup.inc b/racket/src/bc/src/startup.inc index 8bdd4959a9..73858e4048 100644 --- a/racket/src/bc/src/startup.inc +++ b/racket/src/bc/src/startup.inc @@ -73,9 +73,6 @@ static const char *startup_source = "(qq-append)" " (lambda (a_0 b_0) (begin (if (list? a_0) (append a_0 b_0) (raise-argument-error 'unquote-splicing \"list?\" a_0)))))" "(define-values" -"(fixnum-for-every-system?)" -"(lambda(v_0)(begin(if(fixnum? v_0)(if(fx>= v_0 -536870912)(fx<= v_0 536870911) #f) #f))))" -"(define-values" "(bad-list$1)" " (lambda (who_0 orig-l_0) (begin 'bad-list (raise-mismatch-error who_0 \"not a proper list: \" orig-l_0))))" "(define-values" @@ -19912,7 +19909,7 @@ static const char *startup_source = "(let-values(((type_0)(read-byte/no-eof i_0)))" "(let-values(((tmp_0) type_0))" "(let-values(((index_0)" -"(if(fixnum-for-every-system? tmp_0)" +"(if(fixnum? tmp_0)" "(if(if(unsafe-fx>= tmp_0 1)" "(unsafe-fx< tmp_0 42)" " #f)" @@ -20596,7 +20593,7 @@ static const char *startup_source = "(begin" "(let-values(((pos_0)(mcdr i_0)))" "(begin" -" (if (< pos_0 (bytes-length (mcar i_0))) (void) (let-values () (read-error \"truncated stream\")))" +" (if (fx< pos_0 (bytes-length (mcar i_0))) (void) (let-values () (read-error \"truncated stream\")))" "(set-mcdr! i_0(fx+ pos_0 1))" "(bytes-ref(mcar i_0) pos_0))))))" "(define-values" @@ -20883,11 +20880,12 @@ static const char *startup_source = " record-mutator" " record-predicate" " struct-type-install-properties!" -" register-struct-constructor!" -" register-struct-predicate!" -" register-struct-field-accessor!" -" register-struct-field-mutator!" +" #%struct-constructor" +" #%struct-predicate" +" #%struct-field-accessor" +" #%struct-field-mutator" " unsafe-struct?" +" unsafe-struct" " raise-binding-result-arity-error" " structure-type-lookup-prefab-uid" " struct-type-constructor-add-guards" diff --git a/racket/src/bc/src/struct.c b/racket/src/bc/src/struct.c index 35b4fcfe89..0489cdfb83 100644 --- a/racket/src/bc/src/struct.c +++ b/racket/src/bc/src/struct.c @@ -134,6 +134,7 @@ static Scheme_Object *make_struct_proc(Scheme_Struct_Type *struct_type, char *fu static Scheme_Object *make_name(const char *pre, const char *tn, int tnl, const char *post1, const char *fn, int fnl, const char *post2, int sym); +XFORM_NONGCING static void adjust_primitive(Scheme_Object *vi, Scheme_Struct_Type *stype, int flags); static void get_struct_type_info(int argc, Scheme_Object *argv[], Scheme_Object **a, int always); @@ -190,7 +191,7 @@ static Scheme_Object *make_prefab_key(Scheme_Struct_Type *type); #define icons scheme_make_pair #define _intern scheme_intern_symbol -#define BUILTIN_STRUCT_FLAGS (SCHEME_STRUCT_NO_SET | SCHEME_STRUCT_EXPTIME | SCHEME_STRUCT_NO_MAKE_PREFIX) +#define BUILTIN_STRUCT_FLAGS (SCHEME_STRUCT_NO_SET | SCHEME_STRUCT_EXPTIME | SCHEME_STRUCT_NO_MAKE_PREFIX | SCHEME_STRUCT_BUILTIN) #define TYPE_NAME(base, blen, sym) make_name("struct:", base, blen, "", NULL, 0, "", sym) #define CSTR_NAME(base, blen, sym) make_name("", base, blen, "", NULL, 0, "", sym) @@ -3296,15 +3297,17 @@ int scheme_struct_is_transparent(Scheme_Object *s) #define STRUCT_mPROCP(o, v) \ (SCHEME_PRIMP(o) && ((((Scheme_Primitive_Proc *)o)->pp.flags & SCHEME_PRIM_OTHER_TYPE_MASK) == (v))) +#define STRUCT_PRIM_PROCP(o) ((((Scheme_Primitive_Proc *)o)->pp.flags & SCHEME_PRIM_IS_PRIMITIVE)) static Scheme_Object * struct_setter_p(int argc, Scheme_Object *argv[]) { Scheme_Object *v = argv[0]; if (SCHEME_CHAPERONEP(v)) v = SCHEME_CHAPERONE_VAL(v); - return ((STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER) - || STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXLESS_SETTER) - || STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_BROKEN_INDEXED_SETTER)) + return (((STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER) + || STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXLESS_SETTER) + || STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_BROKEN_INDEXED_SETTER)) + && !STRUCT_PRIM_PROCP(v)) ? scheme_true : scheme_false); } @@ -3313,8 +3316,9 @@ struct_getter_p(int argc, Scheme_Object *argv[]) { Scheme_Object *v = argv[0]; if (SCHEME_CHAPERONEP(v)) v = SCHEME_CHAPERONE_VAL(v); - return ((STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXED_GETTER) - || STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXLESS_GETTER)) + return (((STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXED_GETTER) + || STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXLESS_GETTER)) + && !STRUCT_PRIM_PROCP(v)) ? scheme_true : scheme_false); } @@ -3323,7 +3327,8 @@ struct_pred_p(int argc, Scheme_Object *argv[]) { Scheme_Object *v = argv[0]; if (SCHEME_CHAPERONEP(v)) v = SCHEME_CHAPERONE_VAL(v); - return (STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_PRED) + return ((STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_PRED) + && !STRUCT_PRIM_PROCP(v)) ? scheme_true : scheme_false); } @@ -3332,8 +3337,9 @@ struct_constr_p(int argc, Scheme_Object *argv[]) { Scheme_Object *v = argv[0]; if (SCHEME_CHAPERONEP(v)) v = SCHEME_CHAPERONE_VAL(v); - return ((STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_CONSTR) - || STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_SIMPLE_CONSTR)) + return (((STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_CONSTR) + || STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_SIMPLE_CONSTR)) + && !STRUCT_PRIM_PROCP(v)) ? scheme_true : scheme_false); } @@ -4203,6 +4209,7 @@ Scheme_Object **scheme_make_struct_values(Scheme_Object *type, nm, SCHEME_CONSTR, struct_type->num_slots); + adjust_primitive(vi, struct_type, flags); values[pos] = vi; pos++; } @@ -4214,6 +4221,7 @@ Scheme_Object **scheme_make_struct_values(Scheme_Object *type, nm, SCHEME_PRED, 0); + adjust_primitive(vi, struct_type, flags); values[pos] = vi; pos++; } @@ -4235,6 +4243,7 @@ Scheme_Object **scheme_make_struct_values(Scheme_Object *type, nm, SCHEME_GETTER, slot_num); + adjust_primitive(vi, struct_type, flags); values[pos] = vi; pos++; } @@ -4247,6 +4256,7 @@ Scheme_Object **scheme_make_struct_values(Scheme_Object *type, nm, SCHEME_SETTER, slot_num); + adjust_primitive(vi, struct_type, flags); values[pos] = vi; pos++; } @@ -4280,6 +4290,20 @@ Scheme_Object **scheme_make_struct_values(Scheme_Object *type, return values; } +static void adjust_primitive(Scheme_Object *vi, Scheme_Struct_Type *stype, int flags) { + if (flags & SCHEME_STRUCT_BUILTIN) { + /* Make sure the primitive flag is *not* set, because we mean + for these to be exposed as struct procedures */ + ((Scheme_Closed_Primitive_Proc *)vi)->pp.flags &= ~SCHEME_PRIM_IS_PRIMITIVE; + } else if (scheme_starting_up) { + /* Set primitive flag on non-transparent so structs in startup + code (the expander and reader) are *not* exposed as a structure + procedure */ + if (SCHEME_TRUEP(stype->inspector)) + ((Scheme_Closed_Primitive_Proc *)vi)->pp.flags |= SCHEME_PRIM_IS_PRIMITIVE; + } +} + static Scheme_Object **_make_struct_names(const char *base, int blen, int fcount, Scheme_Object *field_symbols, diff --git a/racket/src/cs/README.txt b/racket/src/cs/README.txt index 27c3b3aff0..723370bc16 100644 --- a/racket/src/cs/README.txt +++ b/racket/src/cs/README.txt @@ -462,6 +462,18 @@ configuration: increases load time and memory use of Racket programs by as much as 50%. +Structure Types +--------------- + +See the note in "../expander/README.txt" about structure types. That +applies for all of layers. So, for example, + + (struct-predicate-procedure? thread?) ; => #f + +Beware, however, that if schemify is not able to optimize a +structure-type creation, then the current implementation will end up +exposing structure procedures as such. + Inlining Expectations --------------------- diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss index 3315e34f09..ea037dbb48 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 3 53)) + (values 9 5 3 54)) (unless (guard (x [else #f]) (eval 'scheme-fork-version-number)) (error 'compile-file diff --git a/racket/src/cs/convert.rkt b/racket/src/cs/convert.rkt index 30259ed446..0143a239f7 100644 --- a/racket/src/cs/convert.rkt +++ b/racket/src/cs/convert.rkt @@ -120,7 +120,16 @@ (printf "Schemify...\n") (define body (time - (schemify-body bodys prim-knowns primitives #hasheq() #hasheq() #f unsafe-mode? + (schemify-body bodys prim-knowns primitives + #hasheq() + ;; map exports to #f to indicate which are exported + ;; without triggering most export machinery: + (for/hasheq ([ex exports]) + (if (pair? ex) + (values (car ex) #f) + (values ex #f))) + 'system ; target + unsafe-mode? #t ; no-prompt? #f))) ; explicit-unnamed? (printf "Lift...\n") diff --git a/racket/src/cs/demo/struct.ss b/racket/src/cs/demo/struct.ss index bd96b1f3de..1d80cb3bd2 100644 --- a/racket/src/cs/demo/struct.ss +++ b/racket/src/cs/demo/struct.ss @@ -97,6 +97,9 @@ (check ((struct-type-make-constructor struct:q) 9 10) a-q) (check ((struct-type-make-predicate struct:q) a-q) #t) +(check (struct-accessor-procedure? q-ref) #t) +(check (struct-mutator-procedure? q-set!) #t) + (check (andmap (lambda (a b) (or (equal? a b) (and (struct-accessor-procedure? a) diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 80acc6f925..015af218bb 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -530,7 +530,7 @@ (schemify-linklet (show "linklet" c) serializable?-box (not (#%memq 'uninterned-literal options)) - (eq? format 'interpret) + (if (eq? format 'interpret) 'interp 'compile) ; target (|#%app| compile-allow-set!-undefined) unsafe? enforce-constant? diff --git a/racket/src/cs/primitive/internal.ss b/racket/src/cs/primitive/internal.ss index 81d85395d3..211ee52cbf 100644 --- a/racket/src/cs/primitive/internal.ss +++ b/racket/src/cs/primitive/internal.ss @@ -11,14 +11,14 @@ [struct-type-install-properties! (known-constant)] [structure-type-lookup-prefab-uid (known-constant)] [struct-type-constructor-add-guards (known-constant)] - [register-struct-constructor! (known-constant)] - [register-struct-predicate! (known-constant)] - [register-struct-field-accessor! (known-constant)] - [register-struct-field-mutator! (known-constant)] [|#%call-with-values| (known-constant)] [unbox/check-undefined (known-constant)] [set-box!/check-undefined (known-constant)] + [|#%struct-constructor| (known-constant)] + [|#%struct-predicate| (known-constant)] + [|#%struct-field-accessor| (known-constant)] + [|#%struct-field-mutator| (known-constant)] [make-record-type-descriptor (known-constant)] [make-record-type-descriptor* (known-constant)] [make-record-constructor-descriptor (known-constant)] @@ -27,6 +27,7 @@ [record-accessor (known-constant)] [record-mutator (known-constant)] [unsafe-struct? (known-constant)] + [unsafe-struct (known-constant)] [call-with-module-prompt (known-procedure 2)] [raise-binding-result-arity-error (known-procedure 4)] diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index d1687952e6..c7c05d165b 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -221,10 +221,10 @@ make-struct-field-accessor make-struct-field-mutator struct-type-constructor-add-guards ; not exported to Racket - register-struct-constructor! ; not exported to Racket - register-struct-predicate! ; not exported to Racket - register-struct-field-accessor! ; not exported to Racket - register-struct-field-mutator! ; not exported to Racket + |#%struct-constructor| ; not exported to Racket + |#%struct-predicate| ; not exported to Racket + |#%struct-field-accessor| ; not exported to Racket + |#%struct-field-mutator| ; not exported to Racket struct-property-set! ; not exported to Racket struct-constructor-procedure? struct-predicate-procedure? @@ -693,6 +693,7 @@ unsafe-struct*-set! unsafe-struct*-cas! unsafe-struct? ; not exported to racket + unsafe-struct ; not exported to racket unsafe-s16vector-ref unsafe-s16vector-set! diff --git a/racket/src/cs/rumble/impersonator.ss b/racket/src/cs/rumble/impersonator.ss index a595b5ec6f..cc23f41e08 100644 --- a/racket/src/cs/rumble/impersonator.ss +++ b/racket/src/cs/rumble/impersonator.ss @@ -505,10 +505,10 @@ [(struct-mutator-procedure? (car args)) (let* ([orig-proc (car args)] [key-proc (strip-impersonator orig-proc)] - [rtd+pos (struct-mutator-procedure-rtd+pos key-proc)]) + [pos+rtd (struct-mutator-procedure-pos+rtd key-proc)]) (get-proc "mutator" args 2 - orig-proc (car rtd+pos) (struct-mutator-pos->key2 (cdr rtd+pos)) - (record? val (car rtd+pos)) + orig-proc (cdr pos+rtd) (struct-mutator-pos->key2 (car pos+rtd)) + (record? val (cdr pos+rtd)) #t))] [(struct-type-property-accessor-procedure? (car args)) (let* ([orig-proc (car args)] @@ -548,7 +548,8 @@ [(null? args) empty-hash] [(struct-mutator-procedure? (car args)) (hash-set (loop (cddr args)) - (struct-mutator-procedure-rtd+pos (strip-impersonator (car args))) + (let ([pos+rtd (struct-mutator-procedure-pos+rtd (strip-impersonator (car args)))]) + (cons (cdr pos+rtd) (car pos+rtd))) #t)] [else (loop (cddr args))]))]) diff --git a/racket/src/cs/rumble/procedure.ss b/racket/src/cs/rumble/procedure.ss index e49895ad9b..1ed9f3fb41 100644 --- a/racket/src/cs/rumble/procedure.ss +++ b/racket/src/cs/rumble/procedure.ss @@ -338,6 +338,10 @@ ;; - (vector 'method) => is a method ;; - (box ) => JIT function generated, name is , not a method ;; - => parameter +;; - 'constructor => struct constructor +;; - 'predicate => struct predicate +;; - (cons rtd pos) => struct accessor +;; - (cons pos rtd) => struct mutator ;; ---------------------------------------- @@ -580,7 +584,7 @@ [(#%vector? name) (or (#%vector-ref name 0) (object-name (#%vector-ref name 1)))] [(parameter-data? name) (parameter-data-name name)] - [else name]))) + [else (object-name (wrapper-procedure-procedure p))]))) ;; ---------------------------------------- diff --git a/racket/src/cs/rumble/struct.ss b/racket/src/cs/rumble/struct.ss index b5b9256eb3..3eff3d5927 100644 --- a/racket/src/cs/rumble/struct.ss +++ b/racket/src/cs/rumble/struct.ss @@ -47,7 +47,7 @@ (struct-type-property? (car p)) (procedure? (cdr p)) (procedure-arity-includes? (cdr p) 1))) - supers)) + supers))< (raise-argument-error who "(listof (cons/c struct-type-property? (procedure-arity-includes/c 1)))" supers)) (let* ([can-impersonate? (and (or can-impersonate? (eq? guard 'can-impersonate)) #t)] [st (make-struct-type-prop name (and (not (eq? guard 'can-impersonate)) guard) supers)] @@ -378,6 +378,8 @@ ;; a lock (define rtd-mutables (make-ephemeron-eq-hashtable)) +(define struct-proc-tables-need-resize? #f) + ;; Accessors and mutators that need a position are wrapped in these records: (define-record position-based-accessor (rtd offset field-count)) (define-record position-based-mutator (rtd offset field-count)) @@ -389,15 +391,6 @@ (let ([rtd (position-based-mutator-rtd f)]) (string->symbol (string-append (symbol->string (record-type-name rtd)) "-set!")))) -;; Register other procedures in hash tables; avoid wrapping to -;; avoid making the procedures slower. These tables are accessed -;; without a lock, so son't use `hashtable-set!` on them. -(define struct-constructors (make-ephemeron-eq-hashtable)) -(define struct-predicates (make-ephemeron-eq-hashtable)) -(define struct-field-accessors (make-ephemeron-eq-hashtable)) -(define struct-field-mutators (make-ephemeron-eq-hashtable)) -(define struct-proc-tables-need-resize? #f) - (define (add-to-table! table key val) (if (eq-hashtable-try-atomic-cell table key val) (set! struct-proc-tables-need-resize? #t) @@ -413,60 +406,60 @@ (let ([p (cons #f #f)]) (eq-hashtable-set! ht p #t) (eq-hashtable-delete! ht p)))]) - (resize! struct-constructors) - (resize! struct-predicates) - (resize! struct-field-accessors) - (resize! struct-field-mutators) (resize! property-accessors) (resize! property-predicates) (resize! rtd-mutables) (resize! rtd-props)))) -(define (register-struct-constructor! p) - (#%$app/no-inline add-to-table! struct-constructors p #t)) +(define (|#%struct-constructor| p arity-mask) + (make-wrapper-procedure p arity-mask 'constructor)) -(define (register-struct-predicate! p) - (#%$app/no-inline add-to-table! struct-predicates p #t)) +(define (|#%struct-predicate| p) + (make-wrapper-procedure p 2 'predicate)) -(define (register-struct-field-accessor! p rtd pos) - (#%$app/no-inline add-to-table! struct-field-accessors p (cons rtd pos))) +(define (|#%struct-field-accessor| p rtd pos) + (make-wrapper-procedure p 2 (cons rtd pos))) -(define (register-struct-field-mutator! p rtd pos) - (#%$app/no-inline add-to-table! struct-field-mutators p (cons rtd pos))) +(define (|#%struct-field-mutator| p rtd pos) + (make-wrapper-procedure p 4 (cons pos rtd))) (define (struct-constructor-procedure? v) - (and (procedure? v) - (let ([v (strip-impersonator v)]) - (eq-hashtable-contains? struct-constructors v)))) + (let ([v (strip-impersonator v)]) + (and (wrapper-procedure? v) + (eq? 'constructor (wrapper-procedure-data v))))) (define (struct-predicate-procedure? v) - (and (procedure? v) - (let ([v (strip-impersonator v)]) - (eq-hashtable-contains? struct-predicates v)))) + (let ([v (strip-impersonator v)]) + (and (wrapper-procedure? v) + (eq? 'predicate (wrapper-procedure-data v))))) (define (struct-accessor-procedure? v) - (and (procedure? v) - (let ([v (strip-impersonator v)]) - (or (position-based-accessor? v) - (eq-hashtable-contains? struct-field-accessors v))))) + (let ([v (strip-impersonator v)]) + (or (position-based-accessor? v) + (and (wrapper-procedure? v) + (let ([d (wrapper-procedure-data v)]) + (and (pair? d) + (record-type-descriptor? (car d)))))))) (define (struct-mutator-procedure? v) - (and (procedure? v) - (let ([v (strip-impersonator v)]) - (or (position-based-mutator? v) - (eq-hashtable-contains? struct-field-mutators v))))) + (let ([v (strip-impersonator v)]) + (or (position-based-mutator? v) + (and (wrapper-procedure? v) + (let ([d (wrapper-procedure-data v)]) + < (and (pair? d) + (record-type-descriptor? (cdr d)))))))) (define (struct-accessor-procedure-rtd+pos v) (if (position-based-accessor? v) (cons (position-based-accessor-rtd v) (position-based-accessor-offset v)) - (eq-hashtable-ref struct-field-accessors v #f))) + (wrapper-procedure-data v))) -(define (struct-mutator-procedure-rtd+pos v) +(define (struct-mutator-procedure-pos+rtd v) (if (position-based-mutator? v) - (cons (position-based-mutator-rtd v) - (position-based-mutator-offset v)) - (eq-hashtable-ref struct-field-mutators v #f))) + (cons (position-based-mutator-offset v) + (position-based-mutator-rtd v)) + (wrapper-procedure-data v))) ;; ---------------------------------------- @@ -549,11 +542,9 @@ (and (impersonator? v) (record? (impersonator-val v) rtd)))) (string->symbol (string-append (symbol->string name) "?")))]) - (register-struct-constructor! ctr) - (register-struct-predicate! pred) (values rtd - ctr - pred + (|#%struct-constructor| ctr (procedure-arity-mask ctr)) + (|#%struct-predicate| pred) (make-position-based-accessor rtd parent-total*-count (+ init-count auto-count)) (make-position-based-mutator rtd parent-total*-count (+ init-count auto-count)))))])) @@ -740,8 +731,7 @@ (if name (symbol->string name) (string-append "field" (number->string pos))))))]) - (register-struct-field-accessor! wrap-p rtd pos) - wrap-p))] + (|#%struct-field-accessor| wrap-p rtd pos)))] [(pba pos) (make-struct-field-accessor pba pos #f)])) @@ -776,8 +766,7 @@ (lambda (v a) (cannot-modify-by-pos-error mut-name v pos))) mut-name)]) - (register-struct-field-mutator! wrap-p rtd pos) - wrap-p))] + (|#%struct-field-mutator| wrap-p rtd pos)))] [(pbm pos) (make-struct-field-mutator pbm pos #f)])) @@ -889,24 +878,27 @@ (check who symbol? :or-false name) (let ([rtd* (strip-impersonator rtd)]) (check-inspector-access who rtd*) - (let ([ctr (struct-type-constructor-add-guards - (let* ([c (record-constructor rtd*)] - [fi (struct-type-field-info rtd*)] - [auto-field-adder (get-field-info-auto-adder fi)] - [name (or name - (string->symbol (format "make-~a" (record-type-name rtd*))))]) - (cond - [auto-field-adder - (procedure-rename - (procedure-reduce-arity - (lambda args - (apply c (reverse (auto-field-adder (reverse args))))) - (get-field-info-init*-count fi)) - name)] - [else (procedure-rename c name)])) - rtd* - #f)]) - (register-struct-constructor! ctr) + (let ([ctr (let* ([c (record-constructor rtd*)] + [fi (struct-type-field-info rtd*)] + [init*-count (get-field-info-init*-count fi)] + [init*-count-mask (bitwise-arithmetic-shift-left 1 init*-count)] + [auto-field-adder (get-field-info-auto-adder fi)] + [name (or name + (string->symbol (format "make-~a" (record-type-name rtd*))))]) + (|#%struct-constructor| + (struct-type-constructor-add-guards + (cond + [auto-field-adder + (procedure-rename + (procedure-reduce-arity-mask + (lambda args + (apply c (reverse (auto-field-adder (reverse args))))) + init*-count-mask) + name)] + [else (procedure-rename c name)]) + rtd* + #f) + init*-count-mask))]) (cond [(struct-type-chaperone? rtd) (chaperone-constructor rtd ctr)] @@ -958,13 +950,12 @@ (check who struct-type? rtd) (let ([rtd* (strip-impersonator rtd)]) (check-inspector-access who rtd*) - (let ([pred (escapes-ok - (lambda (v) - (or (record? v rtd*) - (and (impersonator? v) - (record? (impersonator-val v) rtd*)))))]) - (register-struct-predicate! pred) - pred))) + (|#%struct-predicate| + (escapes-ok + (lambda (v) + (or (record? v rtd*) + (and (impersonator? v) + (record? (impersonator-val v) rtd*)))))))) ;; ---------------------------------------- @@ -1088,6 +1079,9 @@ (define (unsafe-struct? v r) (#3%record? v r)) +(define (unsafe-struct r . args) + (#%apply #%$record r args)) + (define (unsafe-struct-ref s i) (if (impersonator? s) (let loop ([rtd* (record-rtd (impersonator-val s))]) @@ -1289,21 +1283,23 @@ (define unsafe-make-name (record-constructor (make-record-constructor-descriptor struct:name #f #f))) (define name ctr-expr) (define authentic-name? (record-predicate struct:name)) - (define name? (lambda (v) (or (authentic-name? v) - (and (impersonator? v) - (authentic-name? (impersonator-val v)))))) + (define name? (|#%struct-predicate| + (lambda (v) (or (authentic-name? v) + (and (impersonator? v) + (authentic-name? (impersonator-val v))))))) (define name-field (let ([name-field (record-accessor struct:name field-index)]) - (lambda (v) - (if (authentic-name? v) - (name-field v) - (pariah (impersonate-ref name-field struct:name field-index v 'name 'field)))))) + (|#%struct-field-accessor| + (lambda (v) + (if (authentic-name? v) + (name-field v) + (pariah (impersonate-ref name-field struct:name field-index v 'name 'field)))) + struct:name + field-index))) ... (define dummy (begin (register-struct-named! struct:name) - (register-struct-constructor! name) - (register-struct-field-accessor! name-field struct:name field-index) ... (record-type-equal-procedure struct:name default-struct-equal?) (record-type-hash-procedure struct:name default-struct-hash) (inspector-set! struct:name #f)))))))]))) diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index 9ff1c3940a..0535725b36 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -4103,23 +4103,6 @@ v 'region 'as-nested-memory)))))) -(define effect_2737 - (begin - (register-struct-constructor! region1.1) - (register-struct-predicate! region?) - (register-struct-field-accessor! region-path struct:region 0) - (register-struct-field-accessor! region-start struct:region 1) - (register-struct-field-accessor! region-start-memory struct:region 2) - (register-struct-field-accessor! region-as-nested struct:region 3) - (register-struct-field-accessor! region-as-nested-memory struct:region 4) - (register-struct-field-mutator! set-region-start! struct:region 1) - (register-struct-field-mutator! set-region-start-memory! struct:region 2) - (register-struct-field-mutator! set-region-as-nested! struct:region 3) - (register-struct-field-mutator! - set-region-as-nested-memory! - struct:region - 4) - (void))) (define struct:stat (make-record-type-descriptor* 'stat #f #f #f #f 3 7)) (define effect_2634 (struct-type-install-properties! @@ -4229,17 +4212,6 @@ v 'stat 'count)))))) -(define effect_3065 - (begin - (register-struct-constructor! stat2.1) - (register-struct-predicate! stat?) - (register-struct-field-accessor! stat-msecs struct:stat 0) - (register-struct-field-accessor! stat-memory struct:stat 1) - (register-struct-field-accessor! stat-count struct:stat 2) - (register-struct-field-mutator! set-stat-msecs! struct:stat 0) - (register-struct-field-mutator! set-stat-memory! struct:stat 1) - (register-struct-field-mutator! set-stat-count! struct:stat 2) - (void))) (define stat-key (gensym)) (define start-performance-region (letrec ((loop_0 @@ -5424,15 +5396,6 @@ (|#%name| weak-intern-table-box (record-accessor struct:weak-intern-table 0))) -(define effect_2313 - (begin - (register-struct-constructor! weak-intern-table1.1) - (register-struct-predicate! weak-intern-table?) - (register-struct-field-accessor! - weak-intern-table-box - struct:weak-intern-table - 0) - (void))) (define struct:table (make-record-type-descriptor* 'table #f #f #f #f 3 0)) (define effect_2793 (struct-type-install-properties! @@ -5457,14 +5420,6 @@ (define table-count (|#%name| table-count (record-accessor struct:table 1))) (define table-prune-at (|#%name| table-prune-at (record-accessor struct:table 2))) -(define effect_3140 - (begin - (register-struct-constructor! table2.1) - (register-struct-predicate! table?) - (register-struct-field-accessor! table-ht struct:table 0) - (register-struct-field-accessor! table-count struct:table 1) - (register-struct-field-accessor! table-prune-at struct:table 2) - (void))) (define make-weak-intern-table (lambda () (weak-intern-table1.1 (box (table2.1 (hasheqv) 0 128))))) (define weak-intern! @@ -5690,15 +5645,6 @@ (|#%name| resolved-module-path-name (record-accessor struct:resolved-module-path 0))) -(define effect_2955 - (begin - (register-struct-constructor! resolved-module-path1.1) - (register-struct-predicate! 1/resolved-module-path?) - (register-struct-field-accessor! - 1/resolved-module-path-name - struct:resolved-module-path - 0) - (void))) (define format-resolved-module-path-name (lambda (p_0) (if (path? p_0) @@ -5949,35 +5895,6 @@ (|#%name| set-module-path-index-shift-cache! (record-mutator struct:module-path-index 3))) -(define effect_3326 - (begin - (register-struct-constructor! module-path-index2.1) - (register-struct-predicate! 1/module-path-index?) - (register-struct-field-accessor! - module-path-index-path - struct:module-path-index - 0) - (register-struct-field-accessor! - module-path-index-base - struct:module-path-index - 1) - (register-struct-field-accessor! - module-path-index-resolved - struct:module-path-index - 2) - (register-struct-field-accessor! - module-path-index-shift-cache - struct:module-path-index - 3) - (register-struct-field-mutator! - set-module-path-index-resolved! - struct:module-path-index - 2) - (register-struct-field-mutator! - set-module-path-index-shift-cache! - struct:module-path-index - 3) - (void))) (define empty-shift-cache '()) (define deserialize-module-path-index (case-lambda @@ -6535,15 +6452,6 @@ (|#%name| set-promise-val! (record-mutator struct:promise 0))) (define set-promise-status! (|#%name| set-promise-status! (record-mutator struct:promise 1))) -(define effect_3056 - (begin - (register-struct-constructor! promise1.1) - (register-struct-predicate! promise?) - (register-struct-field-accessor! promise-val struct:promise 0) - (register-struct-field-accessor! promise-status struct:promise 1) - (register-struct-field-mutator! set-promise-val! struct:promise 0) - (register-struct-field-mutator! set-promise-status! struct:promise 1) - (void))) (define force (lambda (v_0) (if (promise? v_0) @@ -6642,59 +6550,6 @@ (|#%name| serialize-state-sharing-syntaxes (record-accessor struct:serialize-state 11))) -(define effect_1715 - (begin - (register-struct-constructor! serialize-state1.1) - (register-struct-predicate! serialize-state?) - (register-struct-field-accessor! - serialize-state-reachable-scopes - struct:serialize-state - 0) - (register-struct-field-accessor! - serialize-state-bindings-intern - struct:serialize-state - 1) - (register-struct-field-accessor! - serialize-state-bulk-bindings-intern - struct:serialize-state - 2) - (register-struct-field-accessor! - serialize-state-scopes - struct:serialize-state - 3) - (register-struct-field-accessor! - serialize-state-shifted-multi-scopes - struct:serialize-state - 4) - (register-struct-field-accessor! - serialize-state-multi-scope-tables - struct:serialize-state - 5) - (register-struct-field-accessor! - serialize-state-mpi-shifts - struct:serialize-state - 6) - (register-struct-field-accessor! - serialize-state-context-triples - struct:serialize-state - 7) - (register-struct-field-accessor! - serialize-state-props - struct:serialize-state - 8) - (register-struct-field-accessor! - serialize-state-interned-props - struct:serialize-state - 9) - (register-struct-field-accessor! - serialize-state-syntax-context - struct:serialize-state - 10) - (register-struct-field-accessor! - serialize-state-sharing-syntaxes - struct:serialize-state - 11) - (void))) (define make-serialize-state (lambda (reachable-scopes_0) (let ((state_0 @@ -7333,15 +7188,6 @@ s 'preserved-property-value 'content)))))) -(define effect_2248 - (begin - (register-struct-constructor! preserved-property-value1.1) - (register-struct-predicate! preserved-property-value?) - (register-struct-field-accessor! - preserved-property-value-content - struct:preserved-property-value - 0) - (void))) (define plain-property-value (lambda (v_0) (if (preserved-property-value? v_0) @@ -7529,19 +7375,6 @@ (|#%name| modified-content-scope-propagations+tamper (record-accessor struct:modified-content 1))) -(define effect_2588 - (begin - (register-struct-constructor! modified-content1.1) - (register-struct-predicate! modified-content?) - (register-struct-field-accessor! - modified-content-content - struct:modified-content - 0) - (register-struct-field-accessor! - modified-content-scope-propagations+tamper - struct:modified-content - 1) - (void))) (define struct:syntax (make-record-type-descriptor* 'syntax #f #f #f #f 7 1)) (define effect_2384 (struct-type-install-properties! @@ -7801,22 +7634,6 @@ (|#%name| syntax-inspector (record-accessor struct:syntax 6))) (define set-syntax-content*! (|#%name| set-syntax-content*! (record-mutator struct:syntax 0))) -(define effect_2032 - (begin - (register-struct-constructor! syntax2.1) - (register-struct-predicate! syntax?$1) - (register-struct-field-accessor! syntax-content* struct:syntax 0) - (register-struct-field-accessor! syntax-scopes struct:syntax 1) - (register-struct-field-accessor! - syntax-shifted-multi-scopes - struct:syntax - 2) - (register-struct-field-accessor! syntax-mpi-shifts struct:syntax 3) - (register-struct-field-accessor! syntax-srcloc struct:syntax 4) - (register-struct-field-accessor! syntax-props struct:syntax 5) - (register-struct-field-accessor! syntax-inspector struct:syntax 6) - (register-struct-field-mutator! set-syntax-content*! struct:syntax 0) - (void))) (define-values (prop:propagation propagation?$1 propagation-ref) (make-struct-type-property 'propagation)) @@ -8192,24 +8009,6 @@ (|#%name| set-syntax-state-all-sharing?! (record-mutator struct:syntax-state 0))) -(define effect_2403 - (begin - (register-struct-constructor! syntax-state17.1) - (register-struct-predicate! syntax-state?) - (register-struct-field-accessor! - syntax-state-all-sharing? - struct:syntax-state - 0) - (register-struct-field-accessor! - syntax-state-context-triple - struct:syntax-state - 1) - (register-struct-field-accessor! syntax-state-srcloc struct:syntax-state 2) - (register-struct-field-mutator! - set-syntax-state-all-sharing?! - struct:syntax-state - 0) - (void))) (define no-pair-syntax-in-cdr? (lambda (content_0) (if (pair? content_0) @@ -8323,19 +8122,6 @@ (|#%name| full-binding-frame-id (record-accessor struct:full-binding 0))) (define full-binding-free=id (|#%name| full-binding-free=id (record-accessor struct:full-binding 1))) -(define effect_2880 - (begin - (register-struct-constructor! full-binding1.1) - (register-struct-predicate! full-binding?) - (register-struct-field-accessor! - full-binding-frame-id - struct:full-binding - 0) - (register-struct-field-accessor! - full-binding-free=id - struct:full-binding - 1) - (void))) (define binding-frame-id (lambda (b_0) (if (full-binding? b_0) (full-binding-frame-id b_0) #f))) (define binding-free=id @@ -8584,47 +8370,6 @@ (|#%name| full-module-binding-extra-nominal-bindings (record-accessor struct:full-module-binding 8))) -(define effect_3016 - (begin - (register-struct-constructor! full-module-binding45.1) - (register-struct-predicate! full-module-binding?) - (register-struct-field-accessor! - full-module-binding-module - struct:full-module-binding - 0) - (register-struct-field-accessor! - full-module-binding-phase - struct:full-module-binding - 1) - (register-struct-field-accessor! - full-module-binding-sym - struct:full-module-binding - 2) - (register-struct-field-accessor! - full-module-binding-nominal-module - struct:full-module-binding - 3) - (register-struct-field-accessor! - full-module-binding-nominal-phase - struct:full-module-binding - 4) - (register-struct-field-accessor! - full-module-binding-nominal-sym - struct:full-module-binding - 5) - (register-struct-field-accessor! - full-module-binding-nominal-require-phase - struct:full-module-binding - 6) - (register-struct-field-accessor! - full-module-binding-extra-inspector - struct:full-module-binding - 7) - (register-struct-field-accessor! - full-module-binding-extra-nominal-bindings - struct:full-module-binding - 8) - (void))) (define struct:simple-module-binding (make-record-type-descriptor* 'simple-module-binding #f #f #f #f 4 0)) (define effect_2189 @@ -8675,27 +8420,6 @@ (|#%name| simple-module-binding-nominal-module (record-accessor struct:simple-module-binding 3))) -(define effect_2719 - (begin - (register-struct-constructor! simple-module-binding46.1) - (register-struct-predicate! simple-module-binding?) - (register-struct-field-accessor! - simple-module-binding-module - struct:simple-module-binding - 0) - (register-struct-field-accessor! - simple-module-binding-phase - struct:simple-module-binding - 1) - (register-struct-field-accessor! - simple-module-binding-sym - struct:simple-module-binding - 2) - (register-struct-field-accessor! - simple-module-binding-nominal-module - struct:simple-module-binding - 3) - (void))) (define deserialize-full-module-binding (lambda (module_0 sym_0 @@ -8817,23 +8541,6 @@ (|#%name| table-with-bulk-bindings-bulk-bindings (record-accessor struct:table-with-bulk-bindings 2))) -(define effect_2853 - (begin - (register-struct-constructor! table-with-bulk-bindings1.1) - (register-struct-predicate! table-with-bulk-bindings?) - (register-struct-field-accessor! - table-with-bulk-bindings-syms - struct:table-with-bulk-bindings - 0) - (register-struct-field-accessor! - table-with-bulk-bindings-syms/serialize - struct:table-with-bulk-bindings - 1) - (register-struct-field-accessor! - table-with-bulk-bindings-bulk-bindings - struct:table-with-bulk-bindings - 2) - (void))) (define deserialize-table-with-bulk-bindings (lambda (syms_0 bulk-bindings_0) (table-with-bulk-bindings1.1 syms_0 syms_0 bulk-bindings_0))) @@ -8874,19 +8581,6 @@ (|#%name| bulk-binding-at-scopes (record-accessor struct:bulk-binding-at 0))) (define bulk-binding-at-bulk (|#%name| bulk-binding-at-bulk (record-accessor struct:bulk-binding-at 1))) -(define effect_2678 - (begin - (register-struct-constructor! bulk-binding-at2.1) - (register-struct-predicate! bulk-binding-at?) - (register-struct-field-accessor! - bulk-binding-at-scopes - struct:bulk-binding-at - 0) - (register-struct-field-accessor! - bulk-binding-at-bulk - struct:bulk-binding-at - 1) - (void))) (define deserialize-bulk-binding-at (lambda (scopes_0 bulk_0) (bulk-binding-at2.1 scopes_0 bulk_0))) (define-values @@ -8960,19 +8654,6 @@ s 'bulk-binding-class 'create)))))) -(define effect_2358 - (begin - (register-struct-constructor! bulk-binding-class3.1) - (register-struct-predicate! bulk-binding-class?) - (register-struct-field-accessor! - bulk-binding-class-get-symbols - struct:bulk-binding-class - 0) - (register-struct-field-accessor! - bulk-binding-class-create - struct:bulk-binding-class - 1) - (void))) (define bulk-binding-symbols (lambda (b_0 s_0 extra-shifts_0) (let ((app_0 (bulk-binding-class-get-symbols (bulk-binding-ref b_0)))) @@ -10510,12 +10191,6 @@ s 'fallback 'search-list)))))) -(define effect_2526 - (begin - (register-struct-constructor! fallback1.1) - (register-struct-predicate! fallback?) - (register-struct-field-accessor! fallback-search-list struct:fallback 0) - (void))) (define fallback-first (lambda (smss_0) (if (fallback? smss_0) (car (fallback-search-list smss_0)) smss_0))) @@ -10611,15 +10286,6 @@ (define entry-phase (|#%name| entry-phase (record-accessor struct:entry 2))) (define entry-binding (|#%name| entry-binding (record-accessor struct:entry 3))) -(define effect_2477 - (begin - (register-struct-constructor! entry1.1) - (register-struct-predicate! entry?) - (register-struct-field-accessor! entry-scs struct:entry 0) - (register-struct-field-accessor! entry-smss struct:entry 1) - (register-struct-field-accessor! entry-phase struct:entry 2) - (register-struct-field-accessor! entry-binding struct:entry 3) - (void))) (define resolve-cache-get (lambda (sym_0 phase_0 scs_0 smss_0) (let ((c_0 @@ -10677,20 +10343,6 @@ (|#%name| shifted-entry-phase (record-accessor struct:shifted-entry 1))) (define shifted-entry-binding (|#%name| shifted-entry-binding (record-accessor struct:shifted-entry 2))) -(define effect_2436 - (begin - (register-struct-constructor! shifted-entry2.1) - (register-struct-predicate! shifted-entry?) - (register-struct-field-accessor! shifted-entry-s struct:shifted-entry 0) - (register-struct-field-accessor! - shifted-entry-phase - struct:shifted-entry - 1) - (register-struct-field-accessor! - shifted-entry-binding - struct:shifted-entry - 2) - (void))) (define shifted-cache-vector (lambda () (let ((wb_0 (unsafe-unbox* (unsafe-place-local-ref cell.2$3)))) @@ -10936,15 +10588,6 @@ (|#%name| scope-binding-table (record-accessor struct:scope 2))) (define set-scope-binding-table! (|#%name| set-scope-binding-table! (record-mutator struct:scope 2))) -(define effect_2640 - (begin - (register-struct-constructor! scope1.1) - (register-struct-predicate! scope?) - (register-struct-field-accessor! scope-id struct:scope 0) - (register-struct-field-accessor! scope-kind struct:scope 1) - (register-struct-field-accessor! scope-binding-table struct:scope 2) - (register-struct-field-mutator! set-scope-binding-table! struct:scope 2) - (void))) (define deserialize-scope (case-lambda (() top-level-common-scope) @@ -10998,15 +10641,6 @@ (|#%name| interned-scope? (record-predicate struct:interned-scope))) (define interned-scope-key (|#%name| interned-scope-key (record-accessor struct:interned-scope 0))) -(define effect_2338 - (begin - (register-struct-constructor! interned-scope2.1) - (register-struct-predicate! interned-scope?) - (register-struct-field-accessor! - interned-scope-key - struct:interned-scope - 0) - (void))) (define struct:multi-scope (make-record-type-descriptor* 'multi-scope #f #f #f #f 5 0)) (define effect_2089 @@ -11141,19 +10775,6 @@ (|#%name| multi-scope-shifted (record-accessor struct:multi-scope 3))) (define multi-scope-label-shifted (|#%name| multi-scope-label-shifted (record-accessor struct:multi-scope 4))) -(define effect_2725 - (begin - (register-struct-constructor! multi-scope3.1) - (register-struct-predicate! multi-scope?) - (register-struct-field-accessor! multi-scope-id struct:multi-scope 0) - (register-struct-field-accessor! multi-scope-name struct:multi-scope 1) - (register-struct-field-accessor! multi-scope-scopes struct:multi-scope 2) - (register-struct-field-accessor! multi-scope-shifted struct:multi-scope 3) - (register-struct-field-accessor! - multi-scope-label-shifted - struct:multi-scope - 4) - (void))) (define deserialize-multi-scope (lambda (name_0 scopes_0) (let ((app_0 (new-deserialize-scope-id!))) @@ -11243,27 +10864,6 @@ (|#%name| set-representative-scope-phase! (record-mutator struct:representative-scope 1))) -(define effect_2103 - (begin - (register-struct-constructor! representative-scope4.1) - (register-struct-predicate! representative-scope?) - (register-struct-field-accessor! - representative-scope-owner - struct:representative-scope - 0) - (register-struct-field-accessor! - representative-scope-phase - struct:representative-scope - 1) - (register-struct-field-mutator! - set-representative-scope-owner! - struct:representative-scope - 0) - (register-struct-field-mutator! - set-representative-scope-phase! - struct:representative-scope - 1) - (void))) (define deserialize-representative-scope (lambda (kind_0 phase_0) (let ((v_0 @@ -11334,19 +10934,6 @@ (|#%name| shifted-multi-scope-multi-scope (record-accessor struct:shifted-multi-scope 1))) -(define effect_2631 - (begin - (register-struct-constructor! shifted-multi-scope5.1) - (register-struct-predicate! shifted-multi-scope?) - (register-struct-field-accessor! - shifted-multi-scope-phase - struct:shifted-multi-scope - 0) - (register-struct-field-accessor! - shifted-multi-scope-multi-scope - struct:shifted-multi-scope - 1) - (void))) (define deserialize-shifted-multi-scope (lambda (phase_0 multi-scope_0) (intern-shifted-multi-scope phase_0 multi-scope_0))) @@ -11457,15 +11044,6 @@ s 'shifted-to-label-phase 'from)))))) -(define effect_2375 - (begin - (register-struct-constructor! shifted-to-label-phase6.1) - (register-struct-predicate! shifted-to-label-phase?) - (register-struct-field-accessor! - shifted-to-label-phase-from - struct:shifted-to-label-phase - 0) - (void))) (define cell.1$5 (unsafe-make-place-local 0)) (define new-scope-id! (lambda () @@ -12403,30 +11981,6 @@ (|#%name| propagation-inspector (record-accessor struct:propagation 5))) (define propagation-tamper (|#%name| propagation-tamper (record-accessor struct:propagation 6))) -(define effect_2702 - (begin - (register-struct-constructor! propagation12.1) - (register-struct-predicate! propagation?) - (register-struct-field-accessor! propagation-prev-scs struct:propagation 0) - (register-struct-field-accessor! - propagation-prev-smss - struct:propagation - 1) - (register-struct-field-accessor! - propagation-scope-ops - struct:propagation - 2) - (register-struct-field-accessor! propagation-prev-mss struct:propagation 3) - (register-struct-field-accessor! - propagation-add-mpi-shifts - struct:propagation - 4) - (register-struct-field-accessor! - propagation-inspector - struct:propagation - 5) - (register-struct-field-accessor! propagation-tamper struct:propagation 6) - (void))) (define propagation-add (lambda (prop_0 sc_0 prev-scs_0 prev-smss_0 prev-mss_0) (if (propagation? prop_0) @@ -13963,15 +13517,6 @@ (|#%name| full-local-binding-key (record-accessor struct:full-local-binding 0))) -(define effect_2332 - (begin - (register-struct-constructor! full-local-binding1.1) - (register-struct-predicate! full-local-binding?) - (register-struct-field-accessor! - full-local-binding-key - struct:full-local-binding - 0) - (void))) (define deserialize-full-local-binding (lambda (key_0 free=id_0) (full-local-binding1.1 #f free=id_0 key_0))) (define make-local-binding.1 @@ -14118,15 +13663,6 @@ s 'rename-transformer 'id)))))) -(define effect_2501 - (begin - (register-struct-constructor! id-rename-transformer1.1) - (register-struct-predicate! id-rename-transformer?) - (register-struct-field-accessor! - id-rename-transformer-id - struct:id-rename-transformer - 0) - (void))) (define 1/make-rename-transformer (|#%name| make-rename-transformer @@ -14383,19 +13919,6 @@ s 'non-source-shift 'to)))))) -(define effect_2817 - (begin - (register-struct-constructor! non-source-shift4.1) - (register-struct-predicate! non-source-shift?) - (register-struct-field-accessor! - non-source-shift-from - struct:non-source-shift - 0) - (register-struct-field-accessor! - non-source-shift-to - struct:non-source-shift - 1) - (void))) (define shift-from (lambda (s_0) (if (pair? s_0) (car s_0) (non-source-shift-from s_0)))) (define shift-to @@ -14931,14 +14454,6 @@ (|#%name| provided-protected? (record-accessor struct:provided 1))) (define provided-syntax? (|#%name| provided-syntax? (record-accessor struct:provided 2))) -(define effect_2639 - (begin - (register-struct-constructor! provided1.1) - (register-struct-predicate! provided?) - (register-struct-field-accessor! provided-binding struct:provided 0) - (register-struct-field-accessor! provided-protected? struct:provided 1) - (register-struct-field-accessor! provided-syntax? struct:provided 2) - (void))) (define provided-as-binding (lambda (v_0) (if (provided? v_0) (provided-binding v_0) v_0))) (define provided-as-protected? @@ -15117,42 +14632,6 @@ (|#%name| set-bulk-binding-provides! (record-mutator struct:bulk-binding 0))) (define set-bulk-binding-self! (|#%name| set-bulk-binding-self! (record-mutator struct:bulk-binding 3))) -(define effect_3030 - (begin - (register-struct-constructor! bulk-binding12.1) - (register-struct-predicate! bulk-binding?) - (register-struct-field-accessor! - bulk-binding-provides - struct:bulk-binding - 0) - (register-struct-field-accessor! bulk-binding-prefix struct:bulk-binding 1) - (register-struct-field-accessor! - bulk-binding-excepts - struct:bulk-binding - 2) - (register-struct-field-accessor! bulk-binding-self struct:bulk-binding 3) - (register-struct-field-accessor! bulk-binding-mpi struct:bulk-binding 4) - (register-struct-field-accessor! - bulk-binding-provide-phase-level - struct:bulk-binding - 5) - (register-struct-field-accessor! - bulk-binding-phase-shift - struct:bulk-binding - 6) - (register-struct-field-accessor! - bulk-binding-bulk-binding-registry - struct:bulk-binding - 7) - (register-struct-field-mutator! - set-bulk-binding-provides! - struct:bulk-binding - 0) - (register-struct-field-mutator! - set-bulk-binding-self! - struct:bulk-binding - 3) - (void))) (define deserialize-bulk-binding (lambda (prefix_0 excepts_0 @@ -15273,16 +14752,6 @@ s 'bulk-provide 'provides)))))) -(define effect_3105 - (begin - (register-struct-constructor! bulk-provide13.1) - (register-struct-predicate! bulk-provide?) - (register-struct-field-accessor! bulk-provide-self struct:bulk-provide 0) - (register-struct-field-accessor! - bulk-provide-provides - struct:bulk-provide - 1) - (void))) (define struct:bulk-binding-registry (make-record-type-descriptor* 'bulk-binding-registry #f #f #f #f 1 0)) (define effect_2382 @@ -15335,15 +14804,6 @@ s 'bulk-binding-registry 'table)))))) -(define effect_2706 - (begin - (register-struct-constructor! bulk-binding-registry14.1) - (register-struct-predicate! bulk-binding-registry?) - (register-struct-field-accessor! - bulk-binding-registry-table - struct:bulk-binding-registry - 0) - (void))) (define make-bulk-binding-registry (lambda () (bulk-binding-registry14.1 (make-hasheq)))) (define register-bulk-provide! @@ -15404,27 +14864,6 @@ (|#%name| root-expand-context-frame-id (record-accessor struct:root-expand-context/outer 3))) -(define effect_3468 - (begin - (register-struct-constructor! root-expand-context/outer1.1) - (register-struct-predicate! root-expand-context/outer?) - (register-struct-field-accessor! - root-expand-context/outer-inner - struct:root-expand-context/outer - 0) - (register-struct-field-accessor! - root-expand-context/outer-post-expansion - struct:root-expand-context/outer - 1) - (register-struct-field-accessor! - root-expand-context/outer-use-site-scopes - struct:root-expand-context/outer - 2) - (register-struct-field-accessor! - root-expand-context/outer-frame-id - struct:root-expand-context/outer - 3) - (void))) (define struct:root-expand-context/inner (make-record-type-descriptor* 'root-expand-context/inner #f #f #f #f 7 0)) (define effect_2774 @@ -15480,39 +14919,6 @@ (|#%name| root-expand-context/inner-lift-key (record-accessor struct:root-expand-context/inner 6))) -(define effect_1966 - (begin - (register-struct-constructor! root-expand-context/inner2.1) - (register-struct-predicate! root-expand-context/inner?) - (register-struct-field-accessor! - root-expand-context/inner-self-mpi - struct:root-expand-context/inner - 0) - (register-struct-field-accessor! - root-expand-context/inner-module-scopes - struct:root-expand-context/inner - 1) - (register-struct-field-accessor! - root-expand-context/inner-top-level-bind-scope - struct:root-expand-context/inner - 2) - (register-struct-field-accessor! - root-expand-context/inner-all-scopes-stx - struct:root-expand-context/inner - 3) - (register-struct-field-accessor! - root-expand-context/inner-defined-syms - struct:root-expand-context/inner - 4) - (register-struct-field-accessor! - root-expand-context/inner-counter - struct:root-expand-context/inner - 5) - (register-struct-field-accessor! - root-expand-context/inner-lift-key - struct:root-expand-context/inner - 6) - (void))) (define root-expand-context/make (lambda (self-mpi_0 module-scopes_0 @@ -16081,19 +15487,6 @@ s 'module-registry 'lock-box)))))) -(define effect_2929 - (begin - (register-struct-constructor! module-registry1.1) - (register-struct-predicate! module-registry?) - (register-struct-field-accessor! - module-registry-declarations - struct:module-registry - 0) - (register-struct-field-accessor! - module-registry-lock-box - struct:module-registry - 1) - (void))) (define make-module-registry (lambda () (module-registry1.1 (make-hasheq) (box #f)))) (define registry-call-with-lock @@ -16227,60 +15620,6 @@ (|#%name| namespace-module-instances (record-accessor struct:namespace 14))) (define set-namespace-inspector! (|#%name| set-namespace-inspector! (record-mutator struct:namespace 12))) -(define effect_2859 - (begin - (register-struct-constructor! namespace1.1) - (register-struct-predicate! 1/namespace?) - (register-struct-field-accessor! namespace-mpi struct:namespace 0) - (register-struct-field-accessor! namespace-source-name struct:namespace 1) - (register-struct-field-accessor! - namespace-root-expand-ctx - struct:namespace - 2) - (register-struct-field-accessor! namespace-phase struct:namespace 3) - (register-struct-field-accessor! namespace-0-phase struct:namespace 4) - (register-struct-field-accessor! - namespace-phase-to-namespace - struct:namespace - 5) - (register-struct-field-accessor! - namespace-phase-level-to-definitions - struct:namespace - 6) - (register-struct-field-accessor! - namespace-module-registry$1 - struct:namespace - 7) - (register-struct-field-accessor! - namespace-bulk-binding-registry - struct:namespace - 8) - (register-struct-field-accessor! - namespace-submodule-declarations - struct:namespace - 9) - (register-struct-field-accessor! - namespace-root-namespace - struct:namespace - 10) - (register-struct-field-accessor! - namespace-declaration-inspector - struct:namespace - 11) - (register-struct-field-accessor! namespace-inspector struct:namespace 12) - (register-struct-field-accessor! - namespace-available-module-instances - struct:namespace - 13) - (register-struct-field-accessor! - namespace-module-instances - struct:namespace - 14) - (register-struct-field-mutator! - set-namespace-inspector! - struct:namespace - 12) - (void))) (define struct:definitions (make-record-type-descriptor* 'definitions #f #f #f #f 2 0)) (define effect_2279 @@ -16307,19 +15646,6 @@ (|#%name| definitions-variables (record-accessor struct:definitions 0))) (define definitions-transformers (|#%name| definitions-transformers (record-accessor struct:definitions 1))) -(define effect_2876 - (begin - (register-struct-constructor! definitions2.1) - (register-struct-predicate! definitions?) - (register-struct-field-accessor! - definitions-variables - struct:definitions - 0) - (register-struct-field-accessor! - definitions-transformers - struct:definitions - 1) - (void))) (define make-namespace (lambda () (new-namespace.1 #t unsafe-undefined #f))) (define new-namespace.1 (|#%name| @@ -16912,15 +16238,6 @@ s 'syntax-binding-set 'binds)))))) -(define effect_2729 - (begin - (register-struct-constructor! syntax-binding-set1.1) - (register-struct-predicate! 1/syntax-binding-set?) - (register-struct-field-accessor! - syntax-binding-set-binds - struct:syntax-binding-set - 0) - (void))) (define struct:bind (make-record-type-descriptor* 'bind #f #f #f #f 3 0)) (define effect_3043 (struct-type-install-properties! @@ -16975,14 +16292,6 @@ (bind-binding_2667 s) ($value (impersonate-ref bind-binding_2667 struct:bind 2 s 'bind 'binding)))))) -(define effect_1839 - (begin - (register-struct-constructor! bind2.1) - (register-struct-predicate! bind?) - (register-struct-field-accessor! bind-sym struct:bind 0) - (register-struct-field-accessor! bind-phase struct:bind 1) - (register-struct-field-accessor! bind-binding struct:bind 2) - (void))) (define syntax-binding-set-extend$1 (|#%name| syntax-binding-set-extend @@ -17495,13 +16804,6 @@ s 'module-use 'phase)))))) -(define effect_2439 - (begin - (register-struct-constructor! module-use1.1) - (register-struct-predicate! module-use?) - (register-struct-field-accessor! module-use-module struct:module-use 0) - (register-struct-field-accessor! module-use-phase struct:module-use 1) - (void))) (define struct:module (make-record-type-descriptor* 'module #f #f #f #f 20 16)) (define effect_2359 (struct-type-install-properties! @@ -17565,38 +16867,6 @@ (|#%name| module-get-all-variables (record-accessor struct:module 19))) (define set-module-access! (|#%name| set-module-access! (record-mutator struct:module 4))) -(define effect_2409 - (begin - (register-struct-constructor! module1.1) - (register-struct-predicate! module?) - (register-struct-field-accessor! module-source-name struct:module 0) - (register-struct-field-accessor! module-self struct:module 1) - (register-struct-field-accessor! module-requires struct:module 2) - (register-struct-field-accessor! module-provides struct:module 3) - (register-struct-field-accessor! module-access struct:module 4) - (register-struct-field-accessor! module-language-info struct:module 5) - (register-struct-field-accessor! module-min-phase-level struct:module 6) - (register-struct-field-accessor! module-max-phase-level struct:module 7) - (register-struct-field-accessor! - module-phase-level-linklet-info-callback - struct:module - 8) - (register-struct-field-accessor! module-force-bulk-binding struct:module 9) - (register-struct-field-accessor! module-prepare-instance struct:module 10) - (register-struct-field-accessor! module-instantiate-phase struct:module 11) - (register-struct-field-accessor! module-primitive? struct:module 12) - (register-struct-field-accessor! module-is-predefined? struct:module 13) - (register-struct-field-accessor! - module-cross-phase-persistent? - struct:module - 14) - (register-struct-field-accessor! module-no-protected? struct:module 15) - (register-struct-field-accessor! module-inspector struct:module 16) - (register-struct-field-accessor! module-submodule-names struct:module 17) - (register-struct-field-accessor! module-supermodule-name struct:module 18) - (register-struct-field-accessor! module-get-all-variables struct:module 19) - (register-struct-field-mutator! set-module-access! struct:module 4) - (void))) (define struct:module-linklet-info (make-record-type-descriptor* 'module-linklet-info #f #f #f #f 6 0)) (define effect_2516 @@ -17645,35 +16915,6 @@ (|#%name| module-linklet-info-extra-inspectorsss (record-accessor struct:module-linklet-info 5))) -(define effect_2446 - (begin - (register-struct-constructor! module-linklet-info2.1) - (register-struct-predicate! module-linklet-info?) - (register-struct-field-accessor! - module-linklet-info-linklet-or-instance - struct:module-linklet-info - 0) - (register-struct-field-accessor! - module-linklet-info-module-uses - struct:module-linklet-info - 1) - (register-struct-field-accessor! - module-linklet-info-self - struct:module-linklet-info - 2) - (register-struct-field-accessor! - module-linklet-info-inspector - struct:module-linklet-info - 3) - (register-struct-field-accessor! - module-linklet-info-extra-inspector - struct:module-linklet-info - 4) - (register-struct-field-accessor! - module-linklet-info-extra-inspectorsss - struct:module-linklet-info - 5) - (void))) (define make-module.1 (letrec ((procz2 (|#%name| get-all-variables (lambda () (begin null)))) (procz1 @@ -17797,51 +17038,6 @@ (|#%name| set-module-instance-attached?! (record-mutator struct:module-instance 5))) -(define effect_3231 - (begin - (register-struct-constructor! module-instance40.1) - (register-struct-predicate! module-instance?) - (register-struct-field-accessor! - module-instance-namespace - struct:module-instance - 0) - (register-struct-field-accessor! - module-instance-module - struct:module-instance - 1) - (register-struct-field-accessor! - module-instance-shifted-requires - struct:module-instance - 2) - (register-struct-field-accessor! - module-instance-phase-level-to-state - struct:module-instance - 3) - (register-struct-field-accessor! - module-instance-made-available? - struct:module-instance - 4) - (register-struct-field-accessor! - module-instance-attached? - struct:module-instance - 5) - (register-struct-field-accessor! - module-instance-data-box - struct:module-instance - 6) - (register-struct-field-mutator! - set-module-instance-shifted-requires! - struct:module-instance - 2) - (register-struct-field-mutator! - set-module-instance-made-available?! - struct:module-instance - 4) - (register-struct-field-mutator! - set-module-instance-attached?! - struct:module-instance - 5) - (void))) (define make-module-instance (lambda (m-ns_0 m_0) (module-instance40.1 m-ns_0 m_0 #f (make-small-hasheqv) #f #f (box #f)))) @@ -19417,7 +18613,7 @@ (define 1/make-set!-transformer (let ((struct:set!-transformer_0 (make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 0))) - (let ((effect2437 + (let ((effect2391 (struct-type-install-properties! struct:set!-transformer_0 'set!-transformer @@ -19470,29 +18666,20 @@ s 'set!-transformer 'proc))))))) - (let ((effect2439 - (begin - (register-struct-constructor! set!-transformer1_0) - (register-struct-predicate! set!-transformer?_1) - (register-struct-field-accessor! - set!-transformer-proc_1 - struct:set!-transformer_0 - 0) - (void)))) - (|#%name| - make-set!-transformer - (lambda (proc_0) + (|#%name| + make-set!-transformer + (lambda (proc_0) + (begin (begin - (begin - (if (if (procedure? proc_0) - (procedure-arity-includes? proc_0 1) - #f) - (void) - (raise-argument-error - 'make-set!-transformer - "(procedure-arity-includes/c 1)" - proc_0)) - (set!-transformer1_0 proc_0)))))))))))))) + (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 @@ -19535,12 +18722,6 @@ (|#%name| local-variable? (record-predicate struct:local-variable))) (define local-variable-id (|#%name| local-variable-id (record-accessor struct:local-variable 0))) -(define effect_2523 - (begin - (register-struct-constructor! local-variable1.1) - (register-struct-predicate! local-variable?) - (register-struct-field-accessor! local-variable-id struct:local-variable 0) - (void))) (define substitute-variable.1 (|#%name| substitute-variable @@ -19602,13 +18783,6 @@ (|#%name| core-form-expander (record-accessor struct:core-form 0))) (define core-form-name (|#%name| core-form-name (record-accessor struct:core-form 1))) -(define effect_1976 - (begin - (register-struct-constructor! core-form7.1) - (register-struct-predicate! core-form?) - (register-struct-field-accessor! core-form-expander struct:core-form 0) - (register-struct-field-accessor! core-form-name struct:core-form 1) - (void))) (define add-binding!.1 (|#%name| add-binding! @@ -19946,55 +19120,6 @@ (|#%name| expand-context-name (record-accessor struct:expand-context/outer 10))) -(define effect_2084 - (begin - (register-struct-constructor! expand-context/outer1.1) - (register-struct-predicate! expand-context/outer?) - (register-struct-field-accessor! - expand-context/outer-context - struct:expand-context/outer - 0) - (register-struct-field-accessor! - expand-context/outer-env - struct:expand-context/outer - 1) - (register-struct-field-accessor! - expand-context/outer-scopes - struct:expand-context/outer - 2) - (register-struct-field-accessor! - expand-context/outer-def-ctx-scopes - struct:expand-context/outer - 3) - (register-struct-field-accessor! - expand-context/outer-binding-layer - struct:expand-context/outer - 4) - (register-struct-field-accessor! - expand-context/outer-reference-records - struct:expand-context/outer - 5) - (register-struct-field-accessor! - expand-context/outer-only-immediate? - struct:expand-context/outer - 6) - (register-struct-field-accessor! - expand-context/outer-need-eventually-defined - struct:expand-context/outer - 7) - (register-struct-field-accessor! - expand-context/outer-current-introduction-scopes - struct:expand-context/outer - 8) - (register-struct-field-accessor! - expand-context/outer-current-use-scopes - struct:expand-context/outer - 9) - (register-struct-field-accessor! - expand-context/outer-name - struct:expand-context/outer - 10) - (void))) (define struct:expand-context/inner (make-record-type-descriptor* 'expand-context/inner @@ -20114,99 +19239,6 @@ (|#%name| expand-context/inner-skip-visit-available? (record-accessor struct:expand-context/inner 21))) -(define effect_2582 - (begin - (register-struct-constructor! expand-context/inner2.1) - (register-struct-predicate! expand-context/inner?) - (register-struct-field-accessor! - expand-context/inner-to-parsed? - struct:expand-context/inner - 0) - (register-struct-field-accessor! - expand-context/inner-phase - struct:expand-context/inner - 1) - (register-struct-field-accessor! - expand-context/inner-namespace - struct:expand-context/inner - 2) - (register-struct-field-accessor! - expand-context/inner-just-once? - struct:expand-context/inner - 3) - (register-struct-field-accessor! - expand-context/inner-module-begin-k - struct:expand-context/inner - 4) - (register-struct-field-accessor! - expand-context/inner-allow-unbound? - struct:expand-context/inner - 5) - (register-struct-field-accessor! - expand-context/inner-in-local-expand? - struct:expand-context/inner - 6) - (register-struct-field-accessor! - |expand-context/inner-keep-#%expression?| - struct:expand-context/inner - 7) - (register-struct-field-accessor! - expand-context/inner-stops - struct:expand-context/inner - 8) - (register-struct-field-accessor! - expand-context/inner-declared-submodule-names - struct:expand-context/inner - 9) - (register-struct-field-accessor! - expand-context/inner-lifts - struct:expand-context/inner - 10) - (register-struct-field-accessor! - expand-context/inner-lift-envs - struct:expand-context/inner - 11) - (register-struct-field-accessor! - expand-context/inner-module-lifts - struct:expand-context/inner - 12) - (register-struct-field-accessor! - expand-context/inner-require-lifts - struct:expand-context/inner - 13) - (register-struct-field-accessor! - expand-context/inner-to-module-lifts - struct:expand-context/inner - 14) - (register-struct-field-accessor! - expand-context/inner-requires+provides - struct:expand-context/inner - 15) - (register-struct-field-accessor! - expand-context/inner-observer - struct:expand-context/inner - 16) - (register-struct-field-accessor! - expand-context/inner-for-serializable? - struct:expand-context/inner - 17) - (register-struct-field-accessor! - expand-context/inner-to-correlated-linklet? - struct:expand-context/inner - 18) - (register-struct-field-accessor! - expand-context/inner-normalize-locals? - struct:expand-context/inner - 19) - (register-struct-field-accessor! - expand-context/inner-parsing-expanded? - struct:expand-context/inner - 20) - (register-struct-field-accessor! - expand-context/inner-skip-visit-available? - struct:expand-context/inner - 21) - (void))) (define expand-context/make (lambda (self-mpi_0 module-scopes_0 @@ -22812,39 +21844,6 @@ (record-accessor struct:compile-context 5))) (define compile-context-header (|#%name| compile-context-header (record-accessor struct:compile-context 6))) -(define effect_2429 - (begin - (register-struct-constructor! compile-context1.1) - (register-struct-predicate! compile-context?) - (register-struct-field-accessor! - compile-context-namespace - struct:compile-context - 0) - (register-struct-field-accessor! - compile-context-phase - struct:compile-context - 1) - (register-struct-field-accessor! - compile-context-self - struct:compile-context - 2) - (register-struct-field-accessor! - compile-context-module-self - struct:compile-context - 3) - (register-struct-field-accessor! - compile-context-full-module-name - struct:compile-context - 4) - (register-struct-field-accessor! - compile-context-lazy-syntax-literals? - struct:compile-context - 5) - (register-struct-field-accessor! - compile-context-header - struct:compile-context - 6) - (void))) (define make-compile-context.1 (|#%name| make-compile-context @@ -25445,19 +24444,6 @@ s 'mpi-intern-table 'fast)))))) -(define effect_2596 - (begin - (register-struct-constructor! mpi-intern-table1.1) - (register-struct-predicate! mpi-intern-table?) - (register-struct-field-accessor! - mpi-intern-table-normal - struct:mpi-intern-table - 0) - (register-struct-field-accessor! - mpi-intern-table-fast - struct:mpi-intern-table - 1) - (void))) (define make-module-path-index-intern-table (lambda () (let ((app_0 (make-hash))) (mpi-intern-table1.1 app_0 (make-hasheq))))) @@ -25530,7 +24516,7 @@ (begin (begin-unsafe (hash-set! built-in-symbols built-in-s_0 #t)) built-in-s_0)))) -(define effect_3040 +(define effect_2850 (begin (void (begin @@ -25589,11 +24575,12 @@ record-mutator record-predicate struct-type-install-properties! - register-struct-constructor! - register-struct-predicate! - register-struct-field-accessor! - register-struct-field-mutator! + |#%struct-constructor| + |#%struct-predicate| + |#%struct-field-accessor| + |#%struct-field-mutator| unsafe-struct? + unsafe-struct raise-binding-result-arity-error structure-type-lookup-prefab-uid struct-type-constructor-add-guards @@ -25710,19 +24697,6 @@ s 'module-path-index-table 'intern)))))) -(define effect_2320 - (begin - (register-struct-constructor! module-path-index-table1.1) - (register-struct-predicate! module-path-index-table?) - (register-struct-field-accessor! - module-path-index-table-positions - struct:module-path-index-table - 0) - (register-struct-field-accessor! - module-path-index-table-intern - struct:module-path-index-table - 1) - (void))) (define make-module-path-index-table (lambda () (let ((app_0 (make-hasheq))) @@ -29422,12 +28396,6 @@ (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 effect_2211 - (begin - (register-struct-constructor! parsed1.1) - (register-struct-predicate! parsed?) - (register-struct-field-accessor! parsed-s struct:parsed 0) - (void))) (define struct:parsed-id (make-record-type-descriptor* 'parsed-id struct:parsed #f #f #f 2 0)) (define effect_2786 @@ -29453,13 +28421,6 @@ (|#%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 effect_2621 - (begin - (register-struct-constructor! parsed-id2.1) - (register-struct-predicate! parsed-id?) - (register-struct-field-accessor! parsed-id-binding struct:parsed-id 0) - (register-struct-field-accessor! parsed-id-inspector struct:parsed-id 1) - (void))) (define struct:parsed-primitive-id (make-record-type-descriptor* 'parsed-primitive-id @@ -29491,11 +28452,6 @@ (|#%name| parsed-primitive-id? (record-predicate struct:parsed-primitive-id))) -(define effect_2123 - (begin - (register-struct-constructor! parsed-primitive-id3.1) - (register-struct-predicate! parsed-primitive-id?) - (void))) (define struct:parsed-top-id (make-record-type-descriptor* 'parsed-top-id struct:parsed-id #f #f #f 0 0)) (define effect_3596 @@ -29518,14 +28474,9 @@ (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 effect_2475 - (begin - (register-struct-constructor! parsed-top-id4.1) - (register-struct-predicate! parsed-top-id?) - (void))) (define struct:parsed-lambda (make-record-type-descriptor* 'parsed-lambda struct:parsed #f #f #f 2 0)) -(define effect_2930 +(define effect_2929 (struct-type-install-properties! struct:parsed-lambda 'parsed-lambda @@ -29549,13 +28500,6 @@ (|#%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 effect_2778 - (begin - (register-struct-constructor! parsed-lambda5.1) - (register-struct-predicate! parsed-lambda?) - (register-struct-field-accessor! parsed-lambda-keys struct:parsed-lambda 0) - (register-struct-field-accessor! parsed-lambda-body struct:parsed-lambda 1) - (void))) (define struct:parsed-case-lambda (make-record-type-descriptor* 'parsed-case-lambda @@ -29589,15 +28533,6 @@ (|#%name| parsed-case-lambda-clauses (record-accessor struct:parsed-case-lambda 0))) -(define effect_2377 - (begin - (register-struct-constructor! parsed-case-lambda6.1) - (register-struct-predicate! parsed-case-lambda?) - (register-struct-field-accessor! - parsed-case-lambda-clauses - struct:parsed-case-lambda - 0) - (void))) (define struct:parsed-app (make-record-type-descriptor* 'parsed-app struct:parsed #f #f #f 2 0)) (define effect_3155 @@ -29624,13 +28559,6 @@ (|#%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 effect_2480 - (begin - (register-struct-constructor! parsed-app7.1) - (register-struct-predicate! parsed-app?) - (register-struct-field-accessor! parsed-app-rator struct:parsed-app 0) - (register-struct-field-accessor! parsed-app-rands struct:parsed-app 1) - (void))) (define struct:parsed-if (make-record-type-descriptor* 'parsed-if struct:parsed #f #f #f 3 0)) (define effect_2697 @@ -29658,14 +28586,6 @@ (|#%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 effect_2672 - (begin - (register-struct-constructor! parsed-if8.1) - (register-struct-predicate! parsed-if?) - (register-struct-field-accessor! parsed-if-tst struct:parsed-if 0) - (register-struct-field-accessor! parsed-if-thn struct:parsed-if 1) - (register-struct-field-accessor! parsed-if-els struct:parsed-if 2) - (void))) (define struct:parsed-set! (make-record-type-descriptor* 'parsed-set! struct:parsed #f #f #f 2 0)) (define effect_2794 @@ -29692,13 +28612,6 @@ (|#%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 effect_2811 - (begin - (register-struct-constructor! parsed-set!9.1) - (register-struct-predicate! parsed-set!?) - (register-struct-field-accessor! parsed-set!-id struct:parsed-set! 0) - (register-struct-field-accessor! parsed-set!-rhs struct:parsed-set! 1) - (void))) (define struct:parsed-with-continuation-mark (make-record-type-descriptor* 'parsed-with-continuation-mark @@ -29745,23 +28658,6 @@ (|#%name| parsed-with-continuation-mark-body (record-accessor struct:parsed-with-continuation-mark 2))) -(define effect_2803 - (begin - (register-struct-constructor! parsed-with-continuation-mark10.1) - (register-struct-predicate! parsed-with-continuation-mark?) - (register-struct-field-accessor! - parsed-with-continuation-mark-key - struct:parsed-with-continuation-mark - 0) - (register-struct-field-accessor! - parsed-with-continuation-mark-val - struct:parsed-with-continuation-mark - 1) - (register-struct-field-accessor! - parsed-with-continuation-mark-body - struct:parsed-with-continuation-mark - 2) - (void))) (define |struct:parsed-#%variable-reference| (make-record-type-descriptor* '|parsed-#%variable-reference| @@ -29800,15 +28696,6 @@ (|#%name| |parsed-#%variable-reference-id| (record-accessor |struct:parsed-#%variable-reference| 0))) -(define effect_2466 - (begin - (register-struct-constructor! |parsed-#%variable-reference11.1|) - (register-struct-predicate! |parsed-#%variable-reference?|) - (register-struct-field-accessor! - |parsed-#%variable-reference-id| - |struct:parsed-#%variable-reference| - 0) - (void))) (define struct:parsed-begin (make-record-type-descriptor* 'parsed-begin struct:parsed #f #f #f 1 0)) (define effect_2775 @@ -29833,12 +28720,6 @@ (|#%name| parsed-begin? (record-predicate struct:parsed-begin))) (define parsed-begin-body (|#%name| parsed-begin-body (record-accessor struct:parsed-begin 0))) -(define effect_2646 - (begin - (register-struct-constructor! parsed-begin12.1) - (register-struct-predicate! parsed-begin?) - (register-struct-field-accessor! parsed-begin-body struct:parsed-begin 0) - (void))) (define struct:parsed-begin0 (make-record-type-descriptor* 'parsed-begin0 struct:parsed #f #f #f 1 0)) (define effect_2776 @@ -29863,12 +28744,6 @@ (|#%name| parsed-begin0? (record-predicate struct:parsed-begin0))) (define parsed-begin0-body (|#%name| parsed-begin0-body (record-accessor struct:parsed-begin0 0))) -(define effect_2159 - (begin - (register-struct-constructor! parsed-begin013.1) - (register-struct-predicate! parsed-begin0?) - (register-struct-field-accessor! parsed-begin0-body struct:parsed-begin0 0) - (void))) (define struct:parsed-quote (make-record-type-descriptor* 'parsed-quote struct:parsed #f #f #f 1 0)) (define effect_2325 @@ -29893,12 +28768,6 @@ (|#%name| parsed-quote? (record-predicate struct:parsed-quote))) (define parsed-quote-datum (|#%name| parsed-quote-datum (record-accessor struct:parsed-quote 0))) -(define effect_1772 - (begin - (register-struct-constructor! parsed-quote14.1) - (register-struct-predicate! parsed-quote?) - (register-struct-field-accessor! parsed-quote-datum struct:parsed-quote 0) - (void))) (define struct:parsed-quote-syntax (make-record-type-descriptor* 'parsed-quote-syntax @@ -29934,15 +28803,6 @@ (|#%name| parsed-quote-syntax-datum (record-accessor struct:parsed-quote-syntax 0))) -(define effect_2564 - (begin - (register-struct-constructor! parsed-quote-syntax15.1) - (register-struct-predicate! parsed-quote-syntax?) - (register-struct-field-accessor! - parsed-quote-syntax-datum - struct:parsed-quote-syntax - 0) - (void))) (define struct:parsed-let_-values (make-record-type-descriptor* 'parsed-let_-values @@ -29984,23 +28844,6 @@ (|#%name| parsed-let_-values-body (record-accessor struct:parsed-let_-values 2))) -(define effect_2591 - (begin - (register-struct-constructor! parsed-let_-values16.1) - (register-struct-predicate! parsed-let_-values?) - (register-struct-field-accessor! - parsed-let_-values-idss - struct:parsed-let_-values - 0) - (register-struct-field-accessor! - parsed-let_-values-clauses - struct:parsed-let_-values - 1) - (register-struct-field-accessor! - parsed-let_-values-body - struct:parsed-let_-values - 2) - (void))) (define struct:parsed-let-values (make-record-type-descriptor* 'parsed-let-values @@ -30010,7 +28853,7 @@ #f 0 0)) -(define effect_2085 +(define effect_2084 (struct-type-install-properties! struct:parsed-let-values 'parsed-let-values @@ -30030,11 +28873,6 @@ (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 effect_2321 - (begin - (register-struct-constructor! parsed-let-values17.1) - (register-struct-predicate! parsed-let-values?) - (void))) (define struct:parsed-letrec-values (make-record-type-descriptor* 'parsed-letrec-values @@ -30066,11 +28904,6 @@ (|#%name| parsed-letrec-values? (record-predicate struct:parsed-letrec-values))) -(define effect_2520 - (begin - (register-struct-constructor! parsed-letrec-values18.1) - (register-struct-predicate! parsed-letrec-values?) - (void))) (define struct:parsed-define-values (make-record-type-descriptor* 'parsed-define-values @@ -30114,23 +28947,6 @@ (|#%name| parsed-define-values-rhs (record-accessor struct:parsed-define-values 2))) -(define effect_1949 - (begin - (register-struct-constructor! parsed-define-values19.1) - (register-struct-predicate! parsed-define-values?) - (register-struct-field-accessor! - parsed-define-values-ids - struct:parsed-define-values - 0) - (register-struct-field-accessor! - parsed-define-values-syms - struct:parsed-define-values - 1) - (register-struct-field-accessor! - parsed-define-values-rhs - struct:parsed-define-values - 2) - (void))) (define struct:parsed-define-syntaxes (make-record-type-descriptor* 'parsed-define-syntaxes @@ -30174,23 +28990,6 @@ (|#%name| parsed-define-syntaxes-rhs (record-accessor struct:parsed-define-syntaxes 2))) -(define effect_3321 - (begin - (register-struct-constructor! parsed-define-syntaxes20.1) - (register-struct-predicate! parsed-define-syntaxes?) - (register-struct-field-accessor! - parsed-define-syntaxes-ids - struct:parsed-define-syntaxes - 0) - (register-struct-field-accessor! - parsed-define-syntaxes-syms - struct:parsed-define-syntaxes - 1) - (register-struct-field-accessor! - parsed-define-syntaxes-rhs - struct:parsed-define-syntaxes - 2) - (void))) (define struct:parsed-begin-for-syntax (make-record-type-descriptor* 'parsed-begin-for-syntax @@ -30229,15 +29028,6 @@ (|#%name| parsed-begin-for-syntax-body (record-accessor struct:parsed-begin-for-syntax 0))) -(define effect_2380 - (begin - (register-struct-constructor! parsed-begin-for-syntax21.1) - (register-struct-predicate! parsed-begin-for-syntax?) - (register-struct-field-accessor! - parsed-begin-for-syntax-body - struct:parsed-begin-for-syntax - 0) - (void))) (define |struct:parsed-#%declare| (make-record-type-descriptor* '|parsed-#%declare| @@ -30247,7 +29037,7 @@ #f 0 0)) -(define effect_2738 +(define effect_2737 (struct-type-install-properties! |struct:parsed-#%declare| '|parsed-#%declare| @@ -30267,11 +29057,6 @@ (make-record-constructor-descriptor |struct:parsed-#%declare| #f #f)))) (define |parsed-#%declare?| (|#%name| |parsed-#%declare?| (record-predicate |struct:parsed-#%declare|))) -(define effect_2832 - (begin - (register-struct-constructor! |parsed-#%declare22.1|) - (register-struct-predicate! |parsed-#%declare?|) - (void))) (define struct:parsed-require (make-record-type-descriptor* 'parsed-require struct:parsed #f #f #f 0 0)) (define effect_2525 @@ -30294,11 +29079,6 @@ (make-record-constructor-descriptor struct:parsed-require #f #f)))) (define parsed-require? (|#%name| parsed-require? (record-predicate struct:parsed-require))) -(define effect_2223 - (begin - (register-struct-constructor! parsed-require23.1) - (register-struct-predicate! parsed-require?) - (void))) (define |struct:parsed-#%module-begin| (make-record-type-descriptor* '|parsed-#%module-begin| @@ -30337,18 +29117,9 @@ (|#%name| |parsed-#%module-begin-body| (record-accessor |struct:parsed-#%module-begin| 0))) -(define effect_2903 - (begin - (register-struct-constructor! |parsed-#%module-begin24.1|) - (register-struct-predicate! |parsed-#%module-begin?|) - (register-struct-field-accessor! - |parsed-#%module-begin-body| - |struct:parsed-#%module-begin| - 0) - (void))) (define struct:parsed-module (make-record-type-descriptor* 'parsed-module struct:parsed #f #f #f 10 0)) -(define effect_2381 +(define effect_2380 (struct-type-install-properties! struct:parsed-module 'parsed-module @@ -30396,45 +29167,6 @@ (|#%name| parsed-module-compiled-submodules (record-accessor struct:parsed-module 9))) -(define effect_3034 - (begin - (register-struct-constructor! parsed-module25.1) - (register-struct-predicate! parsed-module?) - (register-struct-field-accessor! - parsed-module-star? - struct:parsed-module - 0) - (register-struct-field-accessor! - parsed-module-name-id - struct:parsed-module - 1) - (register-struct-field-accessor! parsed-module-self struct:parsed-module 2) - (register-struct-field-accessor! - parsed-module-requires - struct:parsed-module - 3) - (register-struct-field-accessor! - parsed-module-provides - struct:parsed-module - 4) - (register-struct-field-accessor! - parsed-module-root-ctx-simple? - struct:parsed-module - 5) - (register-struct-field-accessor! - parsed-module-encoded-root-ctx - struct:parsed-module - 6) - (register-struct-field-accessor! parsed-module-body struct:parsed-module 7) - (register-struct-field-accessor! - parsed-module-compiled-module - struct:parsed-module - 8) - (register-struct-field-accessor! - parsed-module-compiled-submodules - struct:parsed-module - 9) - (void))) (define module-path->mpi.1 (|#%name| module-path->mpi @@ -30582,55 +29314,6 @@ (|#%name| set-requires+provides-all-bindings-simple?! (record-mutator struct:requires+provides 8))) -(define effect_2676 - (begin - (register-struct-constructor! requires+provides1.1) - (register-struct-predicate! requires+provides?) - (register-struct-field-accessor! - requires+provides-self - struct:requires+provides - 0) - (register-struct-field-accessor! - requires+provides-require-mpis - struct:requires+provides - 1) - (register-struct-field-accessor! - requires+provides-require-mpis-in-order - struct:requires+provides - 2) - (register-struct-field-accessor! - requires+provides-requires - struct:requires+provides - 3) - (register-struct-field-accessor! - requires+provides-provides - struct:requires+provides - 4) - (register-struct-field-accessor! - requires+provides-phase-to-defined-syms - struct:requires+provides - 5) - (register-struct-field-accessor! - requires+provides-also-required - struct:requires+provides - 6) - (register-struct-field-accessor! - requires+provides-can-cross-phase-persistent? - struct:requires+provides - 7) - (register-struct-field-accessor! - requires+provides-all-bindings-simple? - struct:requires+provides - 8) - (register-struct-field-mutator! - set-requires+provides-can-cross-phase-persistent?! - struct:requires+provides - 7) - (register-struct-field-mutator! - set-requires+provides-all-bindings-simple?! - struct:requires+provides - 8) - (void))) (define struct:required (make-record-type-descriptor* 'required #f #f #f #f 4 0)) (define effect_2154 @@ -30659,21 +29342,6 @@ (|#%name| required-can-be-shadowed? (record-accessor struct:required 2))) (define required-as-transformer? (|#%name| required-as-transformer? (record-accessor struct:required 3))) -(define effect_2268 - (begin - (register-struct-constructor! required2.1) - (register-struct-predicate! required?) - (register-struct-field-accessor! required-id struct:required 0) - (register-struct-field-accessor! required-phase struct:required 1) - (register-struct-field-accessor! - required-can-be-shadowed? - struct:required - 2) - (register-struct-field-accessor! - required-as-transformer? - struct:required - 3) - (void))) (define struct:nominal (make-record-type-descriptor* 'nominal #f #f #f #f 4 0)) (define effect_3046 (struct-type-install-properties! @@ -30701,15 +29369,6 @@ (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 effect_3116 - (begin - (register-struct-constructor! nominal3.1) - (register-struct-predicate! nominal?) - (register-struct-field-accessor! nominal-module struct:nominal 0) - (register-struct-field-accessor! nominal-provide-phase struct:nominal 1) - (register-struct-field-accessor! nominal-require-phase struct:nominal 2) - (register-struct-field-accessor! nominal-sym struct:nominal 3) - (void))) (define struct:bulk-required (make-record-type-descriptor* 'bulk-required #f #f #f #f 5 0)) (define effect_2563 @@ -30746,28 +29405,6 @@ (|#%name| bulk-required-can-be-shadowed? (record-accessor struct:bulk-required 4))) -(define effect_2931 - (begin - (register-struct-constructor! bulk-required4.1) - (register-struct-predicate! bulk-required?) - (register-struct-field-accessor! - bulk-required-provides - struct:bulk-required - 0) - (register-struct-field-accessor! - bulk-required-prefix-len - struct:bulk-required - 1) - (register-struct-field-accessor! bulk-required-s struct:bulk-required 2) - (register-struct-field-accessor! - bulk-required-provide-phase-level - struct:bulk-required - 3) - (register-struct-field-accessor! - bulk-required-can-be-shadowed? - struct:bulk-required - 4) - (void))) (define make-requires+provides.1 (|#%name| make-requires+provides @@ -32230,12 +30867,6 @@ s 'adjust-only 'syms)))))) -(define effect_2655 - (begin - (register-struct-constructor! adjust-only1.1) - (register-struct-predicate! adjust-only?) - (register-struct-field-accessor! adjust-only-syms struct:adjust-only 0) - (void))) (define struct:adjust-prefix (make-record-type-descriptor* 'adjust-prefix #f #f #f #f 1 0)) (define effect_2782 @@ -32284,12 +30915,6 @@ s 'adjust-prefix 'sym)))))) -(define effect_2715 - (begin - (register-struct-constructor! adjust-prefix2.1) - (register-struct-predicate! adjust-prefix?) - (register-struct-field-accessor! adjust-prefix-sym struct:adjust-prefix 0) - (void))) (define struct:adjust-all-except (make-record-type-descriptor* 'adjust-all-except #f #f #f #f 2 0)) (define effect_3032 @@ -32358,19 +30983,6 @@ s 'adjust-all-except 'syms)))))) -(define effect_2389 - (begin - (register-struct-constructor! adjust-all-except3.1) - (register-struct-predicate! adjust-all-except?) - (register-struct-field-accessor! - adjust-all-except-prefix-sym - struct:adjust-all-except - 0) - (register-struct-field-accessor! - adjust-all-except-syms - struct:adjust-all-except - 1) - (void))) (define struct:adjust-rename (make-record-type-descriptor* 'adjust-rename #f #f #f #f 2 0)) (define effect_2135 @@ -32435,19 +31047,6 @@ s 'adjust-rename 'from-sym)))))) -(define effect_2841 - (begin - (register-struct-constructor! adjust-rename4.1) - (register-struct-predicate! adjust-rename?) - (register-struct-field-accessor! - adjust-rename-to-id - struct:adjust-rename - 0) - (register-struct-field-accessor! - adjust-rename-from-sym - struct:adjust-rename - 1) - (void))) (define layers$1 '(raw phaseless path)) (define parse-and-perform-requires!.1 (letrec ((check-nested_0 @@ -35762,63 +34361,6 @@ s 'compiled-in-memory 'purely-functional?)))))) -(define effect_3156 - (begin - (register-struct-constructor! compiled-in-memory1.1) - (register-struct-predicate! compiled-in-memory?) - (register-struct-field-accessor! - compiled-in-memory-linklet-directory - struct:compiled-in-memory - 0) - (register-struct-field-accessor! - compiled-in-memory-original-self - struct:compiled-in-memory - 1) - (register-struct-field-accessor! - compiled-in-memory-requires - struct:compiled-in-memory - 2) - (register-struct-field-accessor! - compiled-in-memory-provides - struct:compiled-in-memory - 3) - (register-struct-field-accessor! - compiled-in-memory-phase-to-link-module-uses - struct:compiled-in-memory - 4) - (register-struct-field-accessor! - compiled-in-memory-compile-time-inspector - struct:compiled-in-memory - 5) - (register-struct-field-accessor! - compiled-in-memory-phase-to-link-extra-inspectorsss - struct:compiled-in-memory - 6) - (register-struct-field-accessor! - compiled-in-memory-mpis - struct:compiled-in-memory - 7) - (register-struct-field-accessor! - compiled-in-memory-syntax-literals - struct:compiled-in-memory - 8) - (register-struct-field-accessor! - compiled-in-memory-pre-compiled-in-memorys - struct:compiled-in-memory - 9) - (register-struct-field-accessor! - compiled-in-memory-post-compiled-in-memorys - struct:compiled-in-memory - 10) - (register-struct-field-accessor! - compiled-in-memory-namespace-scopes - struct:compiled-in-memory - 11) - (register-struct-field-accessor! - compiled-in-memory-purely-functional? - struct:compiled-in-memory - 12) - (void))) (define version-bytes$1 (string->bytes/utf-8 (version))) (define vm-bytes$1 (linklet-virtual-machine-bytes)) (define datum->syntax$3 datum->syntax) @@ -35884,7 +34426,7 @@ (define correlated-span (lambda (s_0) (syntax-span s_0))) (define struct:correlated-linklet (make-record-type-descriptor* 'correlated-linklet #f #f #f #f 3 4)) -(define effect_2481 +(define effect_2480 (struct-type-install-properties! struct:correlated-linklet 'correlated-linklet @@ -35920,27 +34462,6 @@ (|#%name| set-correlated-linklet-compiled! (record-mutator struct:correlated-linklet 2))) -(define effect_2315 - (begin - (register-struct-constructor! correlated-linklet1.1) - (register-struct-predicate! correlated-linklet?) - (register-struct-field-accessor! - correlated-linklet-expr - struct:correlated-linklet - 0) - (register-struct-field-accessor! - correlated-linklet-name - struct:correlated-linklet - 1) - (register-struct-field-accessor! - correlated-linklet-compiled - struct:correlated-linklet - 2) - (register-struct-field-mutator! - set-correlated-linklet-compiled! - struct:correlated-linklet - 2) - (void))) (define make-correlated-linklet (lambda (expr_0 name_0) (correlated-linklet1.1 expr_0 name_0 #f))) (define force-compile-linklet @@ -36138,39 +34659,6 @@ s 'faslable-correlated 'props)))))) -(define effect_2924 - (begin - (register-struct-constructor! faslable-correlated2.1) - (register-struct-predicate! faslable-correlated?) - (register-struct-field-accessor! - faslable-correlated-e - struct:faslable-correlated - 0) - (register-struct-field-accessor! - faslable-correlated-source - struct:faslable-correlated - 1) - (register-struct-field-accessor! - faslable-correlated-position - struct:faslable-correlated - 2) - (register-struct-field-accessor! - faslable-correlated-line - struct:faslable-correlated - 3) - (register-struct-field-accessor! - faslable-correlated-column - struct:faslable-correlated - 4) - (register-struct-field-accessor! - faslable-correlated-span - struct:faslable-correlated - 5) - (register-struct-field-accessor! - faslable-correlated-props - struct:faslable-correlated - 6) - (void))) (define struct:faslable-correlated-linklet (make-record-type-descriptor* 'faslable-correlated-linklet @@ -36257,19 +34745,6 @@ s 'faslable-correlated-linklet 'name)))))) -(define effect_2360 - (begin - (register-struct-constructor! faslable-correlated-linklet3.1) - (register-struct-predicate! faslable-correlated-linklet?) - (register-struct-field-accessor! - faslable-correlated-linklet-expr - struct:faslable-correlated-linklet - 0) - (register-struct-field-accessor! - faslable-correlated-linklet-name - struct:faslable-correlated-linklet - 1) - (void))) (define write-correlated-linklet-bundle-hash (lambda (ht_0 o_0) (let ((temp7_0 (->faslable ht_0))) @@ -37025,15 +35500,6 @@ s 'linklet-directory 'ht)))))) -(define effect_2120 - (begin - (register-struct-constructor! linklet-directory1.1) - (register-struct-predicate! linklet-directory?$1) - (register-struct-field-accessor! - linklet-directory-ht - struct:linklet-directory - 0) - (void))) (define struct:linklet-bundle (make-record-type-descriptor* 'linklet-bundle #f #f #f #f 1 0)) (define effect_2330 @@ -37090,12 +35556,6 @@ s 'linklet-bundle 'ht)))))) -(define effect_1594 - (begin - (register-struct-constructor! linklet-bundle2.1) - (register-struct-predicate! linklet-bundle?) - (register-struct-field-accessor! linklet-bundle-ht struct:linklet-bundle 0) - (void))) (define hash->linklet-directory (lambda (ht_0) (begin @@ -37333,19 +35793,6 @@ s 'namespace-scopes 'other)))))) -(define effect_2331 - (begin - (register-struct-constructor! namespace-scopes1.1) - (register-struct-predicate! namespace-scopes?) - (register-struct-field-accessor! - namespace-scopes-post - struct:namespace-scopes - 0) - (register-struct-field-accessor! - namespace-scopes-other - struct:namespace-scopes - 1) - (void))) (define swap-top-level-scopes (lambda (s_0 original-scopes-s_0 new-ns_0) (call-with-values @@ -37519,27 +35966,6 @@ v 'syntax-literals 'count)))))) -(define effect_3459 - (begin - (register-struct-constructor! syntax-literals1.1) - (register-struct-predicate! syntax-literals?) - (register-struct-field-accessor! - syntax-literals-stxes - struct:syntax-literals - 0) - (register-struct-field-accessor! - syntax-literals-count - struct:syntax-literals - 1) - (register-struct-field-mutator! - set-syntax-literals-stxes! - struct:syntax-literals - 0) - (register-struct-field-mutator! - set-syntax-literals-count! - struct:syntax-literals - 1) - (void))) (define struct:header (make-record-type-descriptor* 'header #f #f #f #f 8 36)) (define effect_2959 (struct-type-install-properties! @@ -37742,48 +36168,6 @@ v 'header 'require-vars-in-order)))))) -(define effect_2478 - (begin - (register-struct-constructor! header2.1) - (register-struct-predicate! header?) - (register-struct-field-accessor! - header-module-path-indexes - struct:header - 0) - (register-struct-field-accessor! - header-binding-sym-to-define-sym - struct:header - 1) - (register-struct-field-accessor! - header-binding-syms-in-order - struct:header - 2) - (register-struct-field-accessor! - header-require-var-to-import-sym - struct:header - 3) - (register-struct-field-accessor! - header-import-sym-to-extra-inspectors - struct:header - 4) - (register-struct-field-accessor! - header-require-vars-in-order - struct:header - 5) - (register-struct-field-accessor! - header-define-and-import-syms - struct:header - 6) - (register-struct-field-accessor! header-syntax-literals struct:header 7) - (register-struct-field-mutator! - set-header-binding-syms-in-order! - struct:header - 2) - (register-struct-field-mutator! - set-header-require-vars-in-order! - struct:header - 5) - (void))) (define struct:variable-use (make-record-type-descriptor* 'variable-use #f #f #f #f 2 0)) (define effect_2316 @@ -37848,16 +36232,6 @@ s 'variable-use 'sym)))))) -(define effect_2294 - (begin - (register-struct-constructor! variable-use3.1) - (register-struct-predicate! variable-use?) - (register-struct-field-accessor! - variable-use-module-use - struct:variable-use - 0) - (register-struct-field-accessor! variable-use-sym struct:variable-use 1) - (void))) (define make-syntax-literals (lambda () (syntax-literals1.1 null 0))) (define make-header (lambda (mpis_0 syntax-literals_0) @@ -39468,27 +37842,6 @@ v 'module-use* 'self-inspector)))))) -(define effect_3063 - (begin - (register-struct-constructor! module-use*1.1) - (register-struct-predicate! module-use*?) - (register-struct-field-accessor! - module-use*-extra-inspectorss - struct:module-use* - 0) - (register-struct-field-accessor! - module-use*-self-inspector - struct:module-use* - 1) - (register-struct-field-mutator! - set-module-use*-extra-inspectorss! - struct:module-use* - 0) - (register-struct-field-mutator! - set-module-use*-self-inspector! - struct:module-use* - 1) - (void))) (define module-uses-add-extra-inspectorsss (lambda (mus_0 extra-inspectorsss_0) (if extra-inspectorsss_0 @@ -39907,21 +38260,6 @@ s 'link-info 'def-decls)))))) -(define effect_2746 - (begin - (register-struct-constructor! link-info1.1) - (register-struct-predicate! link-info?) - (register-struct-field-accessor! - link-info-link-module-uses - struct:link-info - 0) - (register-struct-field-accessor! link-info-imports struct:link-info 1) - (register-struct-field-accessor! - link-info-extra-inspectorsss - struct:link-info - 2) - (register-struct-field-accessor! link-info-def-decls struct:link-info 3) - (void))) (define compile-forms.1 (letrec ((procz1 (|#%name| @@ -42070,15 +40408,6 @@ s 'known-defined/delay 'thunk)))))) -(define effect_2637 - (begin - (register-struct-constructor! known-defined/delay2.1) - (register-struct-predicate! known-defined/delay?) - (register-struct-field-accessor! - known-defined/delay-thunk - struct:known-defined/delay - 0) - (void))) (define struct:known-property (make-record-type-descriptor* 'known-property @@ -42118,11 +40447,6 @@ (if (impersonator? v) (known-property?_2907 (impersonator-val v)) #f)))))) -(define effect_2665 - (begin - (register-struct-constructor! known-property3.1) - (register-struct-predicate! known-property?) - (void))) (define struct:known-property-of-function (make-record-type-descriptor* 'known-property-of-function @@ -42191,15 +40515,6 @@ s 'known-property-of-function 'arity)))))) -(define effect_2322 - (begin - (register-struct-constructor! known-property-of-function4.1) - (register-struct-predicate! known-property-of-function?) - (register-struct-field-accessor! - known-property-of-function-arity - struct:known-property-of-function - 0) - (void))) (define struct:known-function (make-record-type-descriptor* 'known-function @@ -42271,19 +40586,6 @@ s 'known-function 'pure?)))))) -(define effect_2283 - (begin - (register-struct-constructor! known-function5.1) - (register-struct-predicate! known-function?) - (register-struct-field-accessor! - known-function-arity - struct:known-function - 0) - (register-struct-field-accessor! - known-function-pure? - struct:known-function - 1) - (void))) (define struct:known-function-of-satisfying (make-record-type-descriptor* 'known-function-of-satisfying @@ -42352,15 +40654,6 @@ s 'known-function-of-satisfying 'arg-predicate-keys)))))) -(define effect_3122 - (begin - (register-struct-constructor! known-function-of-satisfying6.1) - (register-struct-predicate! known-function-of-satisfying?) - (register-struct-field-accessor! - known-function-of-satisfying-arg-predicate-keys - struct:known-function-of-satisfying - 0) - (void))) (define struct:known-predicate (make-record-type-descriptor* 'known-predicate @@ -42416,15 +40709,6 @@ s 'known-predicate 'key)))))) -(define effect_2589 - (begin - (register-struct-constructor! known-predicate7.1) - (register-struct-predicate! known-predicate?) - (register-struct-field-accessor! - known-predicate-key - struct:known-predicate - 0) - (void))) (define struct:known-satisfies (make-record-type-descriptor* 'known-satisfies @@ -42482,15 +40766,6 @@ s 'known-satisfies 'predicate-key)))))) -(define effect_2675 - (begin - (register-struct-constructor! known-satisfies8.1) - (register-struct-predicate! known-satisfies?) - (register-struct-field-accessor! - known-satisfies-predicate-key - struct:known-satisfies - 0) - (void))) (define struct:known-struct-op (make-record-type-descriptor* 'known-struct-op @@ -42564,19 +40839,6 @@ s 'known-struct-op 'field-count)))))) -(define effect_2194 - (begin - (register-struct-constructor! known-struct-op9.1) - (register-struct-predicate! known-struct-op?) - (register-struct-field-accessor! - known-struct-op-type - struct:known-struct-op - 0) - (register-struct-field-accessor! - known-struct-op-field-count - struct:known-struct-op - 1) - (void))) (define lookup-defn (lambda (defns_0 sym_0) (let ((d_0 (hash-ref defns_0 sym_0 #f))) @@ -47216,19 +45478,6 @@ s 'instance-data 'cache-key)))))) -(define effect_2114 - (begin - (register-struct-constructor! instance-data9.1) - (register-struct-predicate! instance-data?) - (register-struct-field-accessor! - instance-data-syntax-literals-instance - struct:instance-data - 0) - (register-struct-field-accessor! - instance-data-cache-key - struct:instance-data - 1) - (void))) (define init-instance-data! (letrec ((procz1 (lambda (name_0 val_0) @@ -49627,7 +47876,7 @@ c_0)))) (define struct:recompiled (make-record-type-descriptor* 'recompiled #f #f #f #f 3 0)) -(define effect_2476 +(define effect_2475 (struct-type-install-properties! struct:recompiled 'recompiled @@ -49655,17 +47904,6 @@ (record-accessor struct:recompiled 1))) (define recompiled-self (|#%name| recompiled-self (record-accessor struct:recompiled 2))) -(define effect_2635 - (begin - (register-struct-constructor! recompiled1.1) - (register-struct-predicate! recompiled?) - (register-struct-field-accessor! recompiled-bundle struct:recompiled 0) - (register-struct-field-accessor! - recompiled-phase-to-link-module-uses - struct:recompiled - 1) - (register-struct-field-accessor! recompiled-self struct:recompiled 2) - (void))) (define recompile-bundle (letrec ((decl_0 (|#%name| @@ -51205,20 +49443,6 @@ (|#%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 effect_2195 - (begin - (register-struct-constructor! lift-context1.1) - (register-struct-predicate! lift-context?) - (register-struct-field-accessor! - lift-context-convert - struct:lift-context - 0) - (register-struct-field-accessor! lift-context-lifts struct:lift-context 1) - (register-struct-field-accessor! - lift-context-module*-ok? - struct:lift-context - 2) - (void))) (define struct:lifted-bind (make-record-type-descriptor* 'lifted-bind #f #f #f #f 3 0)) (define effect_3182 @@ -51247,14 +49471,6 @@ (|#%name| lifted-bind-keys (record-accessor struct:lifted-bind 1))) (define lifted-bind-rhs (|#%name| lifted-bind-rhs (record-accessor struct:lifted-bind 2))) -(define effect_1742 - (begin - (register-struct-constructor! lifted-bind2.1) - (register-struct-predicate! lifted-bind?) - (register-struct-field-accessor! lifted-bind-ids struct:lifted-bind 0) - (register-struct-field-accessor! lifted-bind-keys struct:lifted-bind 1) - (register-struct-field-accessor! lifted-bind-rhs struct:lifted-bind 2) - (void))) (define make-lift-context.1 (|#%name| make-lift-context @@ -51517,23 +49733,6 @@ (|#%name| module-lift-context-module*-ok? (record-accessor struct:module-lift-context 2))) -(define effect_2960 - (begin - (register-struct-constructor! module-lift-context15.1) - (register-struct-predicate! module-lift-context?) - (register-struct-field-accessor! - module-lift-context-wrt-phase - struct:module-lift-context - 0) - (register-struct-field-accessor! - module-lift-context-lifts - struct:module-lift-context - 1) - (register-struct-field-accessor! - module-lift-context-module*-ok? - struct:module-lift-context - 2) - (void))) (define make-module-lift-context (lambda (phase_0 module*-ok?_0) (module-lift-context15.1 phase_0 (box null) module*-ok?_0))) @@ -51609,23 +49808,6 @@ (|#%name| require-lift-context-requires (record-accessor struct:require-lift-context 2))) -(define effect_2845 - (begin - (register-struct-constructor! require-lift-context16.1) - (register-struct-predicate! require-lift-context?) - (register-struct-field-accessor! - require-lift-context-do-require - struct:require-lift-context - 0) - (register-struct-field-accessor! - require-lift-context-wrt-phase - struct:require-lift-context - 1) - (register-struct-field-accessor! - require-lift-context-requires - struct:require-lift-context - 2) - (void))) (define make-require-lift-context (lambda (wrt-phase_0 do-require_0) (require-lift-context16.1 do-require_0 wrt-phase_0 (box null)))) @@ -51677,27 +49859,6 @@ (|#%name| to-module-lift-context-ends (record-accessor struct:to-module-lift-context 3))) -(define effect_2254 - (begin - (register-struct-constructor! to-module-lift-context17.1) - (register-struct-predicate! to-module-lift-context?) - (register-struct-field-accessor! - to-module-lift-context-wrt-phase - struct:to-module-lift-context - 0) - (register-struct-field-accessor! - to-module-lift-context-provides - struct:to-module-lift-context - 1) - (register-struct-field-accessor! - to-module-lift-context-end-as-expressions? - struct:to-module-lift-context - 2) - (register-struct-field-accessor! - to-module-lift-context-ends - struct:to-module-lift-context - 3) - (void))) (define make-to-module-lift-context.1 (|#%name| make-to-module-lift-context @@ -51787,19 +49948,6 @@ s 'expanded-syntax 'binding-layer)))))) -(define effect_2744 - (begin - (register-struct-constructor! already-expanded1.1) - (register-struct-predicate! already-expanded?) - (register-struct-field-accessor! - already-expanded-s - struct:already-expanded - 0) - (register-struct-field-accessor! - already-expanded-binding-layer - struct:already-expanded - 1) - (void))) (define-values (1/prop:liberal-define-context has-liberal-define-context-property? @@ -51839,11 +49987,6 @@ (if (impersonator? v) (1/liberal-define-context?_2641 (impersonator-val v)) #f)))))) -(define effect_2977 - (begin - (register-struct-constructor! make-liberal-define-context) - (register-struct-predicate! 1/liberal-define-context?) - (void))) (define-values (1/prop:expansion-contexts expansion-contexts? expansion-contexts-ref) (make-struct-type-property @@ -51984,35 +50127,6 @@ (|#%name| set-reference-record-all-referenced?! (record-mutator struct:reference-record 2))) -(define effect_2638 - (begin - (register-struct-constructor! reference-record1.1) - (register-struct-predicate! reference-record?) - (register-struct-field-accessor! - reference-record-already-bound - struct:reference-record - 0) - (register-struct-field-accessor! - reference-record-reference-before-bound - struct:reference-record - 1) - (register-struct-field-accessor! - reference-record-all-referenced? - struct:reference-record - 2) - (register-struct-field-mutator! - set-reference-record-already-bound! - struct:reference-record - 0) - (register-struct-field-mutator! - set-reference-record-reference-before-bound! - struct:reference-record - 1) - (register-struct-field-mutator! - set-reference-record-all-referenced?! - struct:reference-record - 2) - (void))) (define make-reference-record (lambda () (let ((app_0 (seteq))) (reference-record1.1 app_0 (seteq) #f)))) (define reference-record-used! @@ -52147,19 +50261,6 @@ (|#%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 effect_2344 - (begin - (register-struct-constructor! expanded+parsed1.1) - (register-struct-predicate! expanded+parsed?) - (register-struct-field-accessor! - expanded+parsed-s - struct:expanded+parsed - 0) - (register-struct-field-accessor! - expanded+parsed-parsed - struct:expanded+parsed - 1) - (void))) (define struct:semi-parsed-define-values (make-record-type-descriptor* 'semi-parsed-define-values #f #f #f #f 4 0)) (define effect_2257 @@ -52203,27 +50304,6 @@ (|#%name| semi-parsed-define-values-rhs (record-accessor struct:semi-parsed-define-values 3))) -(define effect_2243 - (begin - (register-struct-constructor! semi-parsed-define-values2.1) - (register-struct-predicate! semi-parsed-define-values?) - (register-struct-field-accessor! - semi-parsed-define-values-s - struct:semi-parsed-define-values - 0) - (register-struct-field-accessor! - semi-parsed-define-values-syms - struct:semi-parsed-define-values - 1) - (register-struct-field-accessor! - semi-parsed-define-values-ids - struct:semi-parsed-define-values - 2) - (register-struct-field-accessor! - semi-parsed-define-values-rhs - struct:semi-parsed-define-values - 3) - (void))) (define struct:semi-parsed-begin-for-syntax (make-record-type-descriptor* 'semi-parsed-begin-for-syntax #f #f #f #f 2 0)) (define effect_2603 @@ -52259,19 +50339,6 @@ (|#%name| semi-parsed-begin-for-syntax-body (record-accessor struct:semi-parsed-begin-for-syntax 1))) -(define effect_2473 - (begin - (register-struct-constructor! semi-parsed-begin-for-syntax3.1) - (register-struct-predicate! semi-parsed-begin-for-syntax?) - (register-struct-field-accessor! - semi-parsed-begin-for-syntax-s - struct:semi-parsed-begin-for-syntax - 0) - (register-struct-field-accessor! - semi-parsed-begin-for-syntax-body - struct:semi-parsed-begin-for-syntax - 1) - (void))) (define extract-syntax (lambda (s_0) (if (expanded+parsed? s_0) (expanded+parsed-s s_0) s_0))) (define parsed-only @@ -54683,31 +52750,6 @@ s 'internal-definition-context 'parent-ctx)))))) -(define effect_2175 - (begin - (register-struct-constructor! internal-definition-context1.1) - (register-struct-predicate! 1/internal-definition-context?) - (register-struct-field-accessor! - internal-definition-context-frame-id - struct:internal-definition-context - 0) - (register-struct-field-accessor! - internal-definition-context-scope - struct:internal-definition-context - 1) - (register-struct-field-accessor! - internal-definition-context-add-scope? - struct:internal-definition-context - 2) - (register-struct-field-accessor! - internal-definition-context-env-mixins - struct:internal-definition-context - 3) - (register-struct-field-accessor! - internal-definition-context-parent-ctx - struct:internal-definition-context - 4) - (void))) (define struct:env-mixin (make-record-type-descriptor* 'env-mixin #f #f #f #f 4 0)) (define effect_2814 @@ -54802,15 +52844,6 @@ s 'env-mixin 'cache)))))) -(define effect_2656 - (begin - (register-struct-constructor! env-mixin2.1) - (register-struct-predicate! env-mixin?) - (register-struct-field-accessor! env-mixin-id struct:env-mixin 0) - (register-struct-field-accessor! env-mixin-sym struct:env-mixin 1) - (register-struct-field-accessor! env-mixin-value struct:env-mixin 2) - (register-struct-field-accessor! env-mixin-cache struct:env-mixin 3) - (void))) (define 1/syntax-local-make-definition-context (let ((syntax-local-make-definition-context_0 (|#%name| @@ -59642,7 +57675,7 @@ ((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 #f #f #f 2 0)) -(define effect_2904 +(define effect_2903 (struct-type-install-properties! struct:lifted-parsed-begin 'lifted-parsed-begin @@ -59710,19 +57743,6 @@ s 'lifted-parsed-begin 'last)))))) -(define effect_2663 - (begin - (register-struct-constructor! lifted-parsed-begin11.1) - (register-struct-predicate! lifted-parsed-begin?) - (register-struct-field-accessor! - lifted-parsed-begin-seq - struct:lifted-parsed-begin - 0) - (register-struct-field-accessor! - lifted-parsed-begin-last - struct:lifted-parsed-begin - 1) - (void))) (define compile-single.1 (letrec ((loop_0 (|#%name| @@ -62380,19 +60400,6 @@ (|#%name| shadow-directory-table (record-accessor struct:shadow-directory 1))) -(define effect_2544 - (begin - (register-struct-constructor! shadow-directory1.1) - (register-struct-predicate! shadow-directory?) - (register-struct-field-accessor! - shadow-directory-evt - struct:shadow-directory - 0) - (register-struct-field-accessor! - shadow-directory-table - struct:shadow-directory - 1) - (void))) (define use-shadow-directory? (let ((v_0 (system-type 'fs-change))) (if (eq? 'scalable (vector-ref v_0 1)) @@ -63272,42 +61279,9 @@ (|#%name| read-config-keep-comment? (record-accessor struct:read-config/outer 6))) -(define effect_2996 - (begin - (register-struct-constructor! read-config/outer1.1) - (register-struct-predicate! read-config/outer?) - (register-struct-field-accessor! - read-config/outer-inner - struct:read-config/outer - 0) - (register-struct-field-accessor! - read-config/outer-wrap - struct:read-config/outer - 1) - (register-struct-field-accessor! - read-config/outer-line - struct:read-config/outer - 2) - (register-struct-field-accessor! - read-config/outer-col - struct:read-config/outer - 3) - (register-struct-field-accessor! - read-config/outer-pos - struct:read-config/outer - 4) - (register-struct-field-accessor! - read-config/outer-indentations - struct:read-config/outer - 5) - (register-struct-field-accessor! - read-config/outer-keep-comment? - struct:read-config/outer - 6) - (void))) (define struct:read-config/inner (make-record-type-descriptor* 'read-config/inner #f #f #f #f 13 0)) -(define effect_2333 +(define effect_2332 (struct-type-install-properties! struct:read-config/inner 'read-config/inner @@ -63379,63 +61353,6 @@ (|#%name| read-config/inner-st (record-accessor struct:read-config/inner 12))) -(define effect_2485 - (begin - (register-struct-constructor! read-config/inner2.1) - (register-struct-predicate! read-config/inner?) - (register-struct-field-accessor! - read-config/inner-readtable - struct:read-config/inner - 0) - (register-struct-field-accessor! - read-config/inner-next-readtable - struct:read-config/inner - 1) - (register-struct-field-accessor! - read-config/inner-for-syntax? - struct:read-config/inner - 2) - (register-struct-field-accessor! - read-config/inner-source - struct:read-config/inner - 3) - (register-struct-field-accessor! - read-config/inner-read-compiled - struct:read-config/inner - 4) - (register-struct-field-accessor! - read-config/inner-call-with-root-namespace - struct:read-config/inner - 5) - (register-struct-field-accessor! - read-config/inner-dynamic-require - struct:read-config/inner - 6) - (register-struct-field-accessor! - read-config/inner-module-declared? - struct:read-config/inner - 7) - (register-struct-field-accessor! - read-config/inner-coerce - struct:read-config/inner - 8) - (register-struct-field-accessor! - read-config/inner-coerce-key - struct:read-config/inner - 9) - (register-struct-field-accessor! - read-config/inner-parameter-override - struct:read-config/inner - 10) - (register-struct-field-accessor! - read-config/inner-parameter-cache - struct:read-config/inner - 11) - (register-struct-field-accessor! - read-config/inner-st - struct:read-config/inner - 12) - (void))) (define read-config/make (lambda (readtable_0 next-readtable_0 @@ -63627,27 +61544,6 @@ v 'read-config-state 'graph)))))) -(define effect_2533 - (begin - (register-struct-constructor! read-config-state3.1) - (register-struct-predicate! read-config-state?) - (register-struct-field-accessor! - read-config-state-accum-str - struct:read-config-state - 0) - (register-struct-field-accessor! - read-config-state-graph - struct:read-config-state - 1) - (register-struct-field-mutator! - set-read-config-state-accum-str! - struct:read-config-state - 0) - (register-struct-field-mutator! - set-read-config-state-graph! - struct:read-config-state - 1) - (void))) (define default-val.1 #f) (define current-read-config (lambda () (continuation-mark-set-first #f current-read-config #f root-tag))) @@ -64194,7 +62090,7 @@ (check-parameter 1/read-accept-lang config_0)))))) (define struct:special-comment (make-record-type-descriptor* 'special-comment #f #f #f #f 1 0)) -(define effect_2850 +(define effect_2851 (struct-type-install-properties! struct:special-comment 'special-comment @@ -64216,15 +62112,6 @@ (|#%name| special-comment? (record-predicate struct:special-comment))) (define 1/special-comment-value (|#%name| special-comment-value (record-accessor struct:special-comment 0))) -(define effect_2756 - (begin - (register-struct-constructor! 1/make-special-comment) - (register-struct-predicate! 1/special-comment?) - (register-struct-field-accessor! - 1/special-comment-value - struct:special-comment - 0) - (void))) (define struct:readtable (make-record-type-descriptor* 'readtable #f #f #f #f 4 0)) (define effect_2799 @@ -64254,18 +62141,6 @@ (|#%name| readtable-dispatch-ht (record-accessor struct:readtable 2))) (define readtable-delimiter-ht (|#%name| readtable-delimiter-ht (record-accessor struct:readtable 3))) -(define effect_2657 - (begin - (register-struct-constructor! readtable1.1) - (register-struct-predicate! 1/readtable?) - (register-struct-field-accessor! - readtable-symbol-parser - struct:readtable - 0) - (register-struct-field-accessor! readtable-char-ht struct:readtable 1) - (register-struct-field-accessor! readtable-dispatch-ht struct:readtable 2) - (register-struct-field-accessor! readtable-delimiter-ht struct:readtable 3) - (void))) (define 1/make-readtable (letrec ((loop_0 (|#%name| @@ -64660,12 +62535,6 @@ s 'special 'value)))))) -(define effect_2889 - (begin - (register-struct-constructor! special1.1) - (register-struct-predicate! special?) - (register-struct-field-accessor! special-value struct:special 0) - (void))) (define wrap (lambda (s-exp_0 in_0 config_0 rep_0) (let ((wrap_0 (begin-unsafe (read-config/outer-wrap config_0)))) @@ -65163,7 +63032,7 @@ p_0))))))) (define struct:accum-string (make-record-type-descriptor* 'accum-string #f #f #f #f 2 3)) -(define effect_2104 +(define effect_2103 (struct-type-install-properties! struct:accum-string 'accum-string @@ -65191,21 +63060,6 @@ (|#%name| set-accum-string-pos! (record-mutator struct:accum-string 0))) (define set-accum-string-str! (|#%name| set-accum-string-str! (record-mutator struct:accum-string 1))) -(define effect_2281 - (begin - (register-struct-constructor! accum-string1.1) - (register-struct-predicate! accum-string?) - (register-struct-field-accessor! accum-string-pos struct:accum-string 0) - (register-struct-field-accessor! accum-string-str struct:accum-string 1) - (register-struct-field-mutator! - set-accum-string-pos! - struct:accum-string - 0) - (register-struct-field-mutator! - set-accum-string-str! - struct:accum-string - 1) - (void))) (define accum-string-init! (lambda (config_0) (let ((st_0 @@ -65571,64 +63425,6 @@ v 'indentation 'suspicious-quote)))))) -(define effect_2383 - (begin - (register-struct-constructor! indentation1.1) - (register-struct-predicate! indentation?) - (register-struct-field-accessor! indentation-closer struct:indentation 0) - (register-struct-field-accessor! - indentation-suspicious-closer - struct:indentation - 1) - (register-struct-field-accessor! - indentation-multiline? - struct:indentation - 2) - (register-struct-field-accessor! - indentation-start-line - struct:indentation - 3) - (register-struct-field-accessor! - indentation-last-line - struct:indentation - 4) - (register-struct-field-accessor! - indentation-suspicious-line - struct:indentation - 5) - (register-struct-field-accessor! - indentation-max-indent - struct:indentation - 6) - (register-struct-field-accessor! - indentation-suspicious-quote - struct:indentation - 7) - (register-struct-field-mutator! - set-indentation-suspicious-closer! - struct:indentation - 1) - (register-struct-field-mutator! - set-indentation-multiline?! - struct:indentation - 2) - (register-struct-field-mutator! - set-indentation-last-line! - struct:indentation - 4) - (register-struct-field-mutator! - set-indentation-suspicious-line! - struct:indentation - 5) - (register-struct-field-mutator! - set-indentation-max-indent! - struct:indentation - 6) - (register-struct-field-mutator! - set-indentation-suspicious-quote! - struct:indentation - 7) - (void))) (define make-indentation (lambda (closer_0 in_0 config_0) (call-with-values @@ -66483,28 +64279,6 @@ (|#%name| parse-state-other-exactness (record-accessor struct:parse-state 4))) -(define effect_2590 - (begin - (register-struct-constructor! parse-state6.1) - (register-struct-predicate! parse-state?) - (register-struct-field-accessor! - parse-state-exactness - struct:parse-state - 0) - (register-struct-field-accessor! - parse-state-convert-mode - struct:parse-state - 1) - (register-struct-field-accessor! - parse-state-can-single? - struct:parse-state - 2) - (register-struct-field-accessor! parse-state-fst struct:parse-state 3) - (register-struct-field-accessor! - parse-state-other-exactness - struct:parse-state - 4) - (void))) (define struct:rect-prefix (make-record-type-descriptor* 'rect-prefix #f #f #f #f 3 0)) (define effect_2587 @@ -66533,14 +64307,6 @@ (|#%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 effect_2641 - (begin - (register-struct-constructor! rect-prefix7.1) - (register-struct-predicate! rect-prefix?) - (register-struct-field-accessor! rect-prefix-sgn/z struct:rect-prefix 0) - (register-struct-field-accessor! rect-prefix-n struct:rect-prefix 1) - (register-struct-field-accessor! rect-prefix-start struct:rect-prefix 2) - (void))) (define struct:polar-prefix (make-record-type-descriptor* 'polar-prefix #f #f #f #f 3 0)) (define effect_2784 @@ -66569,14 +64335,6 @@ (|#%name| polar-prefix-n (record-accessor struct:polar-prefix 1))) (define polar-prefix-start (|#%name| polar-prefix-start (record-accessor struct:polar-prefix 2))) -(define effect_2846 - (begin - (register-struct-constructor! polar-prefix8.1) - (register-struct-predicate! polar-prefix?) - (register-struct-field-accessor! polar-prefix-sgn/z struct:polar-prefix 0) - (register-struct-field-accessor! polar-prefix-n struct:polar-prefix 1) - (register-struct-field-accessor! polar-prefix-start struct:polar-prefix 2) - (void))) (define init-state (lambda (exactness_0 convert-mode_0 single-mode_0 fst_0) (parse-state6.1 @@ -66694,14 +64452,6 @@ (|#%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 effect_2482 - (begin - (register-struct-constructor! lazy-expt9.1) - (register-struct-predicate! lazy-expt?) - (register-struct-field-accessor! lazy-expt-n struct:lazy-expt 0) - (register-struct-field-accessor! lazy-expt-radix struct:lazy-expt 1) - (register-struct-field-accessor! lazy-expt-exp struct:lazy-expt 2) - (void))) (define struct:lazy-rational (make-record-type-descriptor* 'lazy-rational #f #f #f #f 2 0)) (define effect_2285 @@ -66728,13 +64478,6 @@ (|#%name| lazy-rational-n (record-accessor struct:lazy-rational 0))) (define lazy-rational-d (|#%name| lazy-rational-d (record-accessor struct:lazy-rational 1))) -(define effect_2797 - (begin - (register-struct-constructor! lazy-rational10.1) - (register-struct-predicate! lazy-rational?) - (register-struct-field-accessor! lazy-rational-n struct:lazy-rational 0) - (register-struct-field-accessor! lazy-rational-d struct:lazy-rational 1) - (void))) (define lazy-number (lambda (n_0 radix_0 exp_0) (if (eq? n_0 'dbz) @@ -84706,7 +82449,7 @@ 'letrec-syntaxes+values (make-let-values-form.1 'prim-letrec-syntaxes+values #t #t #t))) (void))) -(define effect_2467 +(define effect_2466 (begin (void (add-core-form!* @@ -85391,7 +83134,7 @@ (args (raise-binding-result-arity-error 3 args))))) (args (raise-binding-result-arity-error 3 args))))))))) (void))) -(define effect_2334 +(define effect_2333 (begin (void (add-core-form!* @@ -85659,7 +83402,7 @@ (args (raise-binding-result-arity-error 5 args)))))) (args (raise-binding-result-arity-error 4 args))))))))) (void))) -(define effect_2592 +(define effect_2588 (begin (void (add-core-form!* @@ -85991,7 +83734,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!* @@ -97545,7 +95288,7 @@ (values tl-ids_0 (select-defined-syms-and-bind!/ctx tmp-bind-ids_0 ctx_0)))))))) -(define effect_2376 +(define effect_2375 (begin (void (add-core-form!* diff --git a/racket/src/cs/schemified/io.scm b/racket/src/cs/schemified/io.scm index 6a7caf2e0e..ac8478fe1d 100644 --- a/racket/src/cs/schemified/io.scm +++ b/racket/src/cs/schemified/io.scm @@ -2829,34 +2829,6 @@ s 'sandman 'do-extract-timeout)))))) -(define effect_1848 - (begin - (register-struct-constructor! sandman1.1) - (register-struct-predicate! sandman?) - (register-struct-field-accessor! sandman-do-sleep struct:sandman 0) - (register-struct-field-accessor! sandman-do-poll struct:sandman 1) - (register-struct-field-accessor! sandman-do-get-wakeup struct:sandman 2) - (register-struct-field-accessor! sandman-do-wakeup struct:sandman 3) - (register-struct-field-accessor! sandman-do-any-sleepers? struct:sandman 4) - (register-struct-field-accessor! - sandman-do-sleepers-external-events - struct:sandman - 5) - (register-struct-field-accessor! sandman-do-add-thread! struct:sandman 6) - (register-struct-field-accessor! - sandman-do-remove-thread! - struct:sandman - 7) - (register-struct-field-accessor! - sandman-do-merge-external-event-sets - struct:sandman - 8) - (register-struct-field-accessor! sandman-do-merge-timeout struct:sandman 9) - (register-struct-field-accessor! - sandman-do-extract-timeout - struct:sandman - 10) - (void))) (define table (let ((or-part_0 (primitive-table '|#%thread|))) (if or-part_0 @@ -3666,13 +3638,6 @@ s 'exts 'fd-adders)))))) -(define effect_2449 - (begin - (register-struct-constructor! exts1.1) - (register-struct-predicate! exts?) - (register-struct-field-accessor! exts-timeout-at struct:exts 0) - (register-struct-field-accessor! exts-fd-adders struct:exts 1) - (void))) (define sandman-add-poll-set-adder (lambda (old-exts_0 adder_0) (let ((app_0 (if old-exts_0 (exts-timeout-at old-exts_0) #f))) @@ -3947,26 +3912,6 @@ (|#%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 effect_2516 - (begin - (register-struct-constructor! create-core-port) - (register-struct-predicate! core-port?) - (register-struct-field-accessor! core-port-vtable struct:core-port 0) - (register-struct-field-accessor! core-port-name struct:core-port 1) - (register-struct-field-accessor! core-port-buffer struct:core-port 2) - (register-struct-field-accessor! core-port-closed? struct:core-port 3) - (register-struct-field-accessor! core-port-closed-sema struct:core-port 4) - (register-struct-field-accessor! core-port-offset struct:core-port 5) - (register-struct-field-accessor! core-port-count struct:core-port 6) - (register-struct-field-mutator! set-core-port-buffer! struct:core-port 2) - (register-struct-field-mutator! set-core-port-closed?! struct:core-port 3) - (register-struct-field-mutator! - set-core-port-closed-sema! - struct:core-port - 4) - (register-struct-field-mutator! set-core-port-offset! struct:core-port 5) - (register-struct-field-mutator! set-core-port-count! struct:core-port 6) - (void))) (define struct:core-port-methods.1 (make-record-type-descriptor* 'core-port-methods #f #f #f #f 5 0)) (define effect_2750 @@ -4089,31 +4034,6 @@ s 'core-port-methods 'buffer-mode)))))) -(define effect_2378 - (begin - (register-struct-constructor! core-port-methods1.1) - (register-struct-predicate! core-port-methods?.1) - (register-struct-field-accessor! - core-port-methods-close.1 - struct:core-port-methods.1 - 0) - (register-struct-field-accessor! - core-port-methods-count-lines!.1 - struct:core-port-methods.1 - 1) - (register-struct-field-accessor! - core-port-methods-get-location.1 - struct:core-port-methods.1 - 2) - (register-struct-field-accessor! - core-port-methods-file-position.1 - struct:core-port-methods.1 - 3) - (register-struct-field-accessor! - core-port-methods-buffer-mode.1 - struct:core-port-methods.1 - 4) - (void))) (define core-port-vtable.1 (core-port-methods1.1 (|#%name| close (lambda (this-id_0) (begin (void)))) @@ -4150,17 +4070,6 @@ (|#%name| set-direct-pos! (record-mutator struct:direct 1))) (define set-direct-end! (|#%name| set-direct-end! (record-mutator struct:direct 2))) -(define effect_3038 - (begin - (register-struct-constructor! direct2.1) - (register-struct-predicate! direct?) - (register-struct-field-accessor! direct-bstr struct:direct 0) - (register-struct-field-accessor! direct-pos struct:direct 1) - (register-struct-field-accessor! direct-end struct:direct 2) - (register-struct-field-mutator! set-direct-bstr! struct:direct 0) - (register-struct-field-mutator! set-direct-pos! struct:direct 1) - (register-struct-field-mutator! set-direct-end! struct:direct 2) - (void))) (define struct:location (make-record-type-descriptor* 'location #f #f #f #f 5 31)) (define effect_2872 @@ -4202,21 +4111,6 @@ (|#%name| set-location-column! (record-mutator struct:location 3))) (define set-location-position! (|#%name| set-location-position! (record-mutator struct:location 4))) -(define effect_2656 - (begin - (register-struct-constructor! location3.1) - (register-struct-predicate! location?) - (register-struct-field-accessor! location-state struct:location 0) - (register-struct-field-accessor! location-cr-state struct:location 1) - (register-struct-field-accessor! location-line struct:location 2) - (register-struct-field-accessor! location-column struct:location 3) - (register-struct-field-accessor! location-position struct:location 4) - (register-struct-field-mutator! set-location-state! struct:location 0) - (register-struct-field-mutator! set-location-cr-state! struct:location 1) - (register-struct-field-mutator! set-location-line! struct:location 2) - (register-struct-field-mutator! set-location-column! struct:location 3) - (register-struct-field-mutator! set-location-position! struct:location 4) - (void))) (define get-core-port-offset (lambda (p_0) (let ((offset_0 (core-port-offset p_0))) @@ -4351,27 +4245,6 @@ (|#%name| set-core-input-port-read-handler! (record-mutator struct:core-input-port 1))) -(define effect_2369 - (begin - (register-struct-constructor! create-core-input-port) - (register-struct-predicate! core-input-port?) - (register-struct-field-accessor! - core-input-port-pending-eof? - struct:core-input-port - 0) - (register-struct-field-accessor! - core-input-port-read-handler - struct:core-input-port - 1) - (register-struct-field-mutator! - set-core-input-port-pending-eof?! - struct:core-input-port - 0) - (register-struct-field-mutator! - set-core-input-port-read-handler! - struct:core-input-port - 1) - (void))) (define struct:core-input-port-methods.1 (make-record-type-descriptor* 'core-input-port-methods @@ -4524,35 +4397,6 @@ s 'core-input-port-methods 'commit)))))) -(define effect_3072 - (begin - (register-struct-constructor! core-input-port-methods6.1) - (register-struct-predicate! core-input-port-methods?.1) - (register-struct-field-accessor! - core-input-port-methods-prepare-change.1 - struct:core-input-port-methods.1 - 0) - (register-struct-field-accessor! - core-input-port-methods-read-in.1 - struct:core-input-port-methods.1 - 1) - (register-struct-field-accessor! - core-input-port-methods-peek-in.1 - struct:core-input-port-methods.1 - 2) - (register-struct-field-accessor! - core-input-port-methods-byte-ready.1 - struct:core-input-port-methods.1 - 3) - (register-struct-field-accessor! - core-input-port-methods-get-progress-evt.1 - struct:core-input-port-methods.1 - 4) - (register-struct-field-accessor! - core-input-port-methods-commit.1 - struct:core-input-port-methods.1 - 5) - (void))) (define core-input-port-vtable.1 (let ((app_0 (core-port-methods-close.1 core-port-vtable.1))) (let ((app_1 (core-port-methods-count-lines!.1 core-port-vtable.1))) @@ -4721,43 +4565,6 @@ (|#%name| set-core-output-port-display-handler! (record-mutator struct:core-output-port 3))) -(define effect_2276 - (begin - (register-struct-constructor! create-core-output-port) - (register-struct-predicate! core-output-port?) - (register-struct-field-accessor! - core-output-port-evt - struct:core-output-port - 0) - (register-struct-field-accessor! - core-output-port-write-handler - struct:core-output-port - 1) - (register-struct-field-accessor! - core-output-port-print-handler - struct:core-output-port - 2) - (register-struct-field-accessor! - core-output-port-display-handler - struct:core-output-port - 3) - (register-struct-field-mutator! - set-core-output-port-evt! - struct:core-output-port - 0) - (register-struct-field-mutator! - set-core-output-port-write-handler! - struct:core-output-port - 1) - (register-struct-field-mutator! - set-core-output-port-print-handler! - struct:core-output-port - 2) - (register-struct-field-mutator! - set-core-output-port-display-handler! - struct:core-output-port - 3) - (void))) (define struct:core-output-port-methods.1 (make-record-type-descriptor* 'core-output-port-methods @@ -4874,27 +4681,6 @@ s 'core-output-port-methods 'get-write-special-evt)))))) -(define effect_2071 - (begin - (register-struct-constructor! core-output-port-methods6.1) - (register-struct-predicate! core-output-port-methods?.1) - (register-struct-field-accessor! - core-output-port-methods-write-out.1 - struct:core-output-port-methods.1 - 0) - (register-struct-field-accessor! - core-output-port-methods-write-out-special.1 - struct:core-output-port-methods.1 - 1) - (register-struct-field-accessor! - core-output-port-methods-get-write-evt.1 - struct:core-output-port-methods.1 - 2) - (register-struct-field-accessor! - core-output-port-methods-get-write-special-evt.1 - struct:core-output-port-methods.1 - 3) - (void))) (define core-output-port-vtable.1 (let ((app_0 (core-port-methods-close.1 core-port-vtable.1))) (let ((app_1 (core-port-methods-count-lines!.1 core-port-vtable.1))) @@ -5002,12 +4788,6 @@ s 'write-evt 'proc)))))) -(define effect_2615 - (begin - (register-struct-constructor! write-evt7.1) - (register-struct-predicate! write-evt?) - (register-struct-field-accessor! write-evt-proc struct:write-evt 0) - (void))) (define empty-output-port (create-core-output-port core-output-port-vtable.1 @@ -5099,20 +4879,6 @@ s 'utf-8-state 'pending-amt)))))) -(define effect_2313 - (begin - (register-struct-constructor! utf-8-state1.1) - (register-struct-predicate! utf-8-state?) - (register-struct-field-accessor! utf-8-state-accum struct:utf-8-state 0) - (register-struct-field-accessor! - utf-8-state-remaining - struct:utf-8-state - 1) - (register-struct-field-accessor! - utf-8-state-pending-amt - struct:utf-8-state - 2) - (void))) (define utf-8-decode!.1 (letrec ((complete_0 (|#%name| @@ -7258,23 +7024,6 @@ s 'commit-manager 'thread)))))) -(define effect_2282 - (begin - (register-struct-constructor! commit-manager1.1) - (register-struct-predicate! commit-manager?) - (register-struct-field-accessor! - commit-manager-pause-channel - struct:commit-manager - 0) - (register-struct-field-accessor! - commit-manager-commit-channel - struct:commit-manager - 1) - (register-struct-field-accessor! - commit-manager-thread - struct:commit-manager - 2) - (void))) (define struct:commit-request (make-record-type-descriptor* 'commit-request #f #f #f #f 5 0)) (define effect_2327 @@ -7393,31 +7142,6 @@ s 'commit-request 'result-ch)))))) -(define effect_2642 - (begin - (register-struct-constructor! commit-request2.1) - (register-struct-predicate! commit-request?) - (register-struct-field-accessor! - commit-request-ext-evt - struct:commit-request - 0) - (register-struct-field-accessor! - commit-request-progress-evt - struct:commit-request - 1) - (register-struct-field-accessor! - commit-request-abandon-evt - struct:commit-request - 2) - (register-struct-field-accessor! - commit-request-finish - struct:commit-request - 3) - (register-struct-field-accessor! - commit-request-result-ch - struct:commit-request - 4) - (void))) (define struct:commit-response (make-record-type-descriptor* 'commit-response #f #f #f #f 2 0)) (define effect_2424 @@ -7486,19 +7210,6 @@ s 'commit-response 'result-put-evt)))))) -(define effect_2386 - (begin - (register-struct-constructor! commit-response3.1) - (register-struct-predicate! commit-response?) - (register-struct-field-accessor! - commit-response-abandon-evt - struct:commit-response - 0) - (register-struct-field-accessor! - commit-response-result-put-evt - struct:commit-response - 1) - (void))) (define make-commit-manager (letrec ((loop_0 (|#%name| @@ -7791,27 +7502,6 @@ (|#%name| set-commit-input-port-commit-manager! (record-mutator struct:commit-input-port 1))) -(define effect_2710 - (begin - (register-struct-constructor! create-commit-input-port) - (register-struct-predicate! commit-input-port?) - (register-struct-field-accessor! - commit-input-port-progress-sema - struct:commit-input-port - 0) - (register-struct-field-accessor! - commit-input-port-commit-manager - struct:commit-input-port - 1) - (register-struct-field-mutator! - set-commit-input-port-progress-sema! - struct:commit-input-port - 0) - (register-struct-field-mutator! - set-commit-input-port-commit-manager! - struct:commit-input-port - 1) - (void))) (define struct:commit-input-port-methods.1 (make-record-type-descriptor* 'commit-input-port-methods @@ -7856,11 +7546,6 @@ (if (impersonator? v) (commit-input-port-methods?.1_1864 (impersonator-val v)) #f)))))) -(define effect_3263 - (begin - (register-struct-constructor! commit-input-port-methods5.1) - (register-struct-predicate! commit-input-port-methods?.1) - (void))) (define commit-input-port-vtable.1 (let ((app_0 (core-port-methods-close.1 core-input-port-vtable.1))) (let ((app_1 (core-port-methods-count-lines!.1 core-input-port-vtable.1))) @@ -8087,90 +7772,6 @@ (|#%name| set-pipe-data-write-ready-evt! (record-mutator struct:pipe-data 15))) -(define effect_2347 - (begin - (register-struct-constructor! create-pipe-data) - (register-struct-predicate! pipe-data?) - (register-struct-field-accessor! pipe-data-vtable struct:pipe-data 0) - (register-struct-field-accessor! pipe-data-bstr struct:pipe-data 1) - (register-struct-field-accessor! pipe-data-len struct:pipe-data 2) - (register-struct-field-accessor! pipe-data-limit struct:pipe-data 3) - (register-struct-field-accessor! pipe-data-peeked-amt struct:pipe-data 4) - (register-struct-field-accessor! pipe-data-start struct:pipe-data 5) - (register-struct-field-accessor! pipe-data-end struct:pipe-data 6) - (register-struct-field-accessor! pipe-data-input-ref struct:pipe-data 7) - (register-struct-field-accessor! pipe-data-output-ref struct:pipe-data 8) - (register-struct-field-accessor! pipe-data-input-buffer struct:pipe-data 9) - (register-struct-field-accessor! - pipe-data-output-buffer - struct:pipe-data - 10) - (register-struct-field-accessor! - pipe-data-read-ready-sema - struct:pipe-data - 11) - (register-struct-field-accessor! - pipe-data-write-ready-sema - struct:pipe-data - 12) - (register-struct-field-accessor! - pipe-data-more-read-ready-sema - struct:pipe-data - 13) - (register-struct-field-accessor! - pipe-data-read-ready-evt - struct:pipe-data - 14) - (register-struct-field-accessor! - pipe-data-write-ready-evt - struct:pipe-data - 15) - (register-struct-field-mutator! set-pipe-data-bstr! struct:pipe-data 1) - (register-struct-field-mutator! set-pipe-data-len! struct:pipe-data 2) - (register-struct-field-mutator! set-pipe-data-limit! struct:pipe-data 3) - (register-struct-field-mutator! - set-pipe-data-peeked-amt! - struct:pipe-data - 4) - (register-struct-field-mutator! set-pipe-data-start! struct:pipe-data 5) - (register-struct-field-mutator! set-pipe-data-end! struct:pipe-data 6) - (register-struct-field-mutator! - set-pipe-data-input-ref! - struct:pipe-data - 7) - (register-struct-field-mutator! - set-pipe-data-output-ref! - struct:pipe-data - 8) - (register-struct-field-mutator! - set-pipe-data-input-buffer! - struct:pipe-data - 9) - (register-struct-field-mutator! - set-pipe-data-output-buffer! - struct:pipe-data - 10) - (register-struct-field-mutator! - set-pipe-data-read-ready-sema! - struct:pipe-data - 11) - (register-struct-field-mutator! - set-pipe-data-write-ready-sema! - struct:pipe-data - 12) - (register-struct-field-mutator! - set-pipe-data-more-read-ready-sema! - struct:pipe-data - 13) - (register-struct-field-mutator! - set-pipe-data-read-ready-evt! - struct:pipe-data - 14) - (register-struct-field-mutator! - set-pipe-data-write-ready-evt! - struct:pipe-data - 15) - (void))) (define struct:pipe-data-methods.1 (make-record-type-descriptor* 'pipe-data-methods #f #f #f #f 0 0)) (define effect_2891 @@ -8203,11 +7804,6 @@ (if (impersonator? v) (pipe-data-methods?.1_2563 (impersonator-val v)) #f)))))) -(define effect_2053 - (begin - (register-struct-constructor! pipe-data-methods10.1) - (register-struct-predicate! pipe-data-methods?.1) - (void))) (define pipe-data-vtable.1 (pipe-data-methods10.1)) (define temp1.1$2 (|#%name| @@ -8336,19 +7932,6 @@ (|#%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 effect_3388 - (begin - (register-struct-constructor! create-pipe-input-port) - (register-struct-predicate! pipe-input-port?) - (register-struct-field-accessor! - pipe-input-port-d - struct:pipe-input-port - 0) - (register-struct-field-mutator! - set-pipe-input-port-d! - struct:pipe-input-port - 0) - (void))) (define struct:pipe-input-port-methods.1 (make-record-type-descriptor* 'pipe-input-port-methods @@ -8393,11 +7976,6 @@ (if (impersonator? v) (pipe-input-port-methods?.1_2609 (impersonator-val v)) #f)))))) -(define effect_2755 - (begin - (register-struct-constructor! pipe-input-port-methods15.1) - (register-struct-predicate! pipe-input-port-methods?.1) - (void))) (define pipe-input-port-vtable.1 (let ((app_0 (core-port-methods-get-location.1 commit-input-port-vtable.1))) (let ((app_1 @@ -8759,19 +8337,6 @@ (|#%name| set-pipe-output-port-d! (record-mutator struct:pipe-output-port 0))) -(define effect_2380 - (begin - (register-struct-constructor! create-pipe-output-port) - (register-struct-predicate! pipe-output-port?) - (register-struct-field-accessor! - pipe-output-port-d - struct:pipe-output-port - 0) - (register-struct-field-mutator! - set-pipe-output-port-d! - struct:pipe-output-port - 0) - (void))) (define struct:pipe-output-port-methods.1 (make-record-type-descriptor* 'pipe-output-port-methods @@ -8816,11 +8381,6 @@ (if (impersonator? v) (pipe-output-port-methods?.1_2695 (impersonator-val v)) #f)))))) -(define effect_2479 - (begin - (register-struct-constructor! pipe-output-port-methods20.1) - (register-struct-predicate! pipe-output-port-methods?.1) - (void))) (define pipe-output-port-vtable.1 (let ((app_0 (core-port-methods-count-lines!.1 core-output-port-vtable.1))) (let ((app_1 (core-port-methods-get-location.1 core-output-port-vtable.1))) @@ -9401,15 +8961,6 @@ s 'pipe-write-poller 'd)))))) -(define effect_2069 - (begin - (register-struct-constructor! pipe-write-poller27.1) - (register-struct-predicate! pipe-write-poller?) - (register-struct-field-accessor! - pipe-write-poller-d - struct:pipe-write-poller - 0) - (void))) (define struct:pipe-read-poller (make-record-type-descriptor* 'pipe-read-poller #f #f #f #f 1 0)) (define effect_2394 @@ -9489,15 +9040,6 @@ s 'pipe-read-poller 'd)))))) -(define effect_2353 - (begin - (register-struct-constructor! pipe-read-poller28.1) - (register-struct-predicate! pipe-read-poller?) - (register-struct-field-accessor! - pipe-read-poller-d - struct:pipe-read-poller - 0) - (void))) (define struct:peek-via-read-input-port (make-record-type-descriptor* 'peek-via-read-input-port @@ -9572,51 +9114,6 @@ (|#%name| set-peek-via-read-input-port-buffer-mode! (record-mutator struct:peek-via-read-input-port 4))) -(define effect_2761 - (begin - (register-struct-constructor! create-peek-via-read-input-port) - (register-struct-predicate! peek-via-read-input-port?) - (register-struct-field-accessor! - peek-via-read-input-port-bstr - struct:peek-via-read-input-port - 0) - (register-struct-field-accessor! - peek-via-read-input-port-pos - struct:peek-via-read-input-port - 1) - (register-struct-field-accessor! - peek-via-read-input-port-end-pos - struct:peek-via-read-input-port - 2) - (register-struct-field-accessor! - peek-via-read-input-port-peeked-eof? - struct:peek-via-read-input-port - 3) - (register-struct-field-accessor! - peek-via-read-input-port-buffer-mode - struct:peek-via-read-input-port - 4) - (register-struct-field-mutator! - set-peek-via-read-input-port-bstr! - struct:peek-via-read-input-port - 0) - (register-struct-field-mutator! - set-peek-via-read-input-port-pos! - struct:peek-via-read-input-port - 1) - (register-struct-field-mutator! - set-peek-via-read-input-port-end-pos! - struct:peek-via-read-input-port - 2) - (register-struct-field-mutator! - set-peek-via-read-input-port-peeked-eof?! - struct:peek-via-read-input-port - 3) - (register-struct-field-mutator! - set-peek-via-read-input-port-buffer-mode! - struct:peek-via-read-input-port - 4) - (void))) (define struct:peek-via-read-input-port-methods.1 (make-record-type-descriptor* 'peek-via-read-input-port-methods @@ -9679,15 +9176,6 @@ s 'peek-via-read-input-port-methods 'read-in/inner)))))) -(define effect_3235 - (begin - (register-struct-constructor! peek-via-read-input-port-methods10.1) - (register-struct-predicate! peek-via-read-input-port-methods?.1) - (register-struct-field-accessor! - peek-via-read-input-port-methods-read-in/inner.1 - struct:peek-via-read-input-port-methods.1 - 0) - (void))) (define peek-via-read-input-port-vtable.1 (let ((app_0 (core-port-methods-count-lines!.1 commit-input-port-vtable.1))) (let ((app_1 @@ -10388,32 +9876,6 @@ (|#%name| set-fd-input-port-custodian-reference! (record-mutator struct:fd-input-port 2))) -(define effect_2812 - (begin - (register-struct-constructor! create-fd-input-port) - (register-struct-predicate! fd-input-port?) - (register-struct-field-accessor! fd-input-port-fd struct:fd-input-port 0) - (register-struct-field-accessor! - fd-input-port-fd-refcount - struct:fd-input-port - 1) - (register-struct-field-accessor! - fd-input-port-custodian-reference - struct:fd-input-port - 2) - (register-struct-field-mutator! - set-fd-input-port-fd! - struct:fd-input-port - 0) - (register-struct-field-mutator! - set-fd-input-port-fd-refcount! - struct:fd-input-port - 1) - (register-struct-field-mutator! - set-fd-input-port-custodian-reference! - struct:fd-input-port - 2) - (void))) (define struct:fd-input-port-methods.1 (make-record-type-descriptor* 'fd-input-port-methods @@ -10494,19 +9956,6 @@ s 'fd-input-port-methods 'raise-read-error)))))) -(define effect_2230 - (begin - (register-struct-constructor! fd-input-port-methods6.1) - (register-struct-predicate! fd-input-port-methods?.1) - (register-struct-field-accessor! - fd-input-port-methods-on-close.1 - struct:fd-input-port-methods.1 - 0) - (register-struct-field-accessor! - fd-input-port-methods-raise-read-error.1 - struct:fd-input-port-methods.1 - 1) - (void))) (define fd-input-port-vtable.1 (let ((app_0 (core-port-methods-count-lines!.1 peek-via-read-input-port-vtable.1))) @@ -10792,72 +10241,6 @@ (|#%name| set-fd-output-port-custodian-reference! (record-mutator struct:fd-output-port 7))) -(define effect_2829 - (begin - (register-struct-constructor! create-fd-output-port) - (register-struct-predicate! fd-output-port?) - (register-struct-field-accessor! fd-output-port-fd struct:fd-output-port 0) - (register-struct-field-accessor! - fd-output-port-fd-refcount - struct:fd-output-port - 1) - (register-struct-field-accessor! - fd-output-port-bstr - struct:fd-output-port - 2) - (register-struct-field-accessor! - fd-output-port-start-pos - struct:fd-output-port - 3) - (register-struct-field-accessor! - fd-output-port-end-pos - struct:fd-output-port - 4) - (register-struct-field-accessor! - fd-output-port-flush-handle - struct:fd-output-port - 5) - (register-struct-field-accessor! - fd-output-port-buffer-mode - struct:fd-output-port - 6) - (register-struct-field-accessor! - fd-output-port-custodian-reference - struct:fd-output-port - 7) - (register-struct-field-mutator! - set-fd-output-port-fd! - struct:fd-output-port - 0) - (register-struct-field-mutator! - set-fd-output-port-fd-refcount! - struct:fd-output-port - 1) - (register-struct-field-mutator! - set-fd-output-port-bstr! - struct:fd-output-port - 2) - (register-struct-field-mutator! - set-fd-output-port-start-pos! - struct:fd-output-port - 3) - (register-struct-field-mutator! - set-fd-output-port-end-pos! - struct:fd-output-port - 4) - (register-struct-field-mutator! - set-fd-output-port-flush-handle! - struct:fd-output-port - 5) - (register-struct-field-mutator! - set-fd-output-port-buffer-mode! - struct:fd-output-port - 6) - (register-struct-field-mutator! - set-fd-output-port-custodian-reference! - struct:fd-output-port - 7) - (void))) (define struct:fd-output-port-methods.1 (make-record-type-descriptor* 'fd-output-port-methods @@ -10938,19 +10321,6 @@ s 'fd-output-port-methods 'raise-write-error)))))) -(define effect_2528 - (begin - (register-struct-constructor! fd-output-port-methods26.1) - (register-struct-predicate! fd-output-port-methods?.1) - (register-struct-field-accessor! - fd-output-port-methods-on-close.1 - struct:fd-output-port-methods.1 - 0) - (register-struct-field-accessor! - fd-output-port-methods-raise-write-error.1 - struct:fd-output-port-methods.1 - 1) - (void))) (define fd-output-port-vtable.1 (let ((app_0 (core-port-methods-count-lines!.1 core-output-port-vtable.1))) (let ((app_1 (core-port-methods-get-location.1 core-output-port-vtable.1))) @@ -11621,15 +10991,6 @@ v 'fd-evt 'closed)))))) -(define effect_1987 - (begin - (register-struct-constructor! fd-evt44.1) - (register-struct-predicate! fd-evt?) - (register-struct-field-accessor! fd-evt-fd struct:fd-evt 0) - (register-struct-field-accessor! fd-evt-mode struct:fd-evt 1) - (register-struct-field-accessor! fd-evt-closed struct:fd-evt 2) - (register-struct-field-mutator! set-fd-evt-closed! struct:fd-evt 2) - (void))) (define struct:rktio-fd-flushed-evt (make-record-type-descriptor* 'rktio-fd-flushed-evt #f #f #f #f 1 0)) (define effect_2495 @@ -11706,15 +11067,6 @@ s 'rktio-fd-flushed-evt 'p)))))) -(define effect_2106 - (begin - (register-struct-constructor! rktio-fd-flushed-evt45.1) - (register-struct-predicate! rktio-fd-flushed-evt?) - (register-struct-field-accessor! - rktio-fd-flushed-evt-p - struct:rktio-fd-flushed-evt - 0) - (void))) (define register-fd-close (lambda (custodian_0 fd_0 fd-refcount_0 flush-handle_0 port_0) (|#%app| @@ -12512,13 +11864,6 @@ s 'progress-evt 'evt)))))) -(define effect_2780 - (begin - (register-struct-constructor! progress-evt1.1) - (register-struct-predicate! 1/progress-evt?) - (register-struct-field-accessor! progress-evt-port struct:progress-evt 0) - (register-struct-field-accessor! progress-evt-evt struct:progress-evt 1) - (void))) (define progress-evt?* (|#%name| progress-evt? @@ -15826,19 +15171,6 @@ s 'utf-8-converter 'to)))))) -(define effect_2373 - (begin - (register-struct-constructor! utf-8-converter1.1) - (register-struct-predicate! utf-8-converter?) - (register-struct-field-accessor! - utf-8-converter-from - struct:utf-8-converter - 0) - (register-struct-field-accessor! - utf-8-converter-to - struct:utf-8-converter - 1) - (void))) (define big-endian?$1 (system-big-endian?)) (define utf-8-convert-in (lambda (c_0 src_0 src-start_0 src-end_0 dest_0 dest-start_0 dest-end_0) @@ -16895,27 +16227,6 @@ v 'bytes-converter 'custodian-reference)))))) -(define effect_1798 - (begin - (register-struct-constructor! bytes-converter1.1) - (register-struct-predicate! 1/bytes-converter?) - (register-struct-field-accessor! - bytes-converter-c - struct:bytes-converter - 0) - (register-struct-field-accessor! - bytes-converter-custodian-reference - struct:bytes-converter - 1) - (register-struct-field-mutator! - set-bytes-converter-c! - struct:bytes-converter - 0) - (register-struct-field-mutator! - set-bytes-converter-custodian-reference! - struct:bytes-converter - 1) - (void))) (define windows? (eq? 'windows (system-type))) (define platform-utf-8 (if windows? 'utf-8-ish 'utf-8)) (define platform-utf-8-permissive @@ -17727,19 +17038,6 @@ (|#%name| set-cache-to2! (record-mutator struct:cache 2))) (define set-cache-from! (|#%name| set-cache-from! (record-mutator struct:cache 3))) -(define effect_2818 - (begin - (register-struct-constructor! cache1.1) - (register-struct-predicate! cache?) - (register-struct-field-accessor! cache-enc struct:cache 0) - (register-struct-field-accessor! cache-to struct:cache 1) - (register-struct-field-accessor! cache-to_3068 struct:cache 2) - (register-struct-field-accessor! cache-from struct:cache 3) - (register-struct-field-mutator! set-cache-enc! struct:cache 0) - (register-struct-field-mutator! set-cache-to! struct:cache 1) - (register-struct-field-mutator! set-cache-to2! struct:cache 2) - (register-struct-field-mutator! set-cache-from! struct:cache 3) - (void))) (define new-cache (lambda () (cache1.1 #f #f #f #f))) (define cell.1$7 (unsafe-make-place-local (new-cache))) (define cell.2$1 @@ -18148,13 +17446,6 @@ s 'path 'convention)))))) -(define effect_2122 - (begin - (register-struct-constructor! path1.1) - (register-struct-predicate! 1/path?) - (register-struct-field-accessor! path-bytes struct:path 0) - (register-struct-field-accessor! path-convention struct:path 1) - (void))) (define is-path? (|#%name| path? @@ -19441,35 +18732,6 @@ (|#%name| set-bytes-input-port-alt-pos! (record-mutator struct:bytes-input-port 2))) -(define effect_2418 - (begin - (register-struct-constructor! create-bytes-input-port) - (register-struct-predicate! bytes-input-port?) - (register-struct-field-accessor! - bytes-input-port-bstr - struct:bytes-input-port - 0) - (register-struct-field-accessor! - bytes-input-port-pos - struct:bytes-input-port - 1) - (register-struct-field-accessor! - bytes-input-port-alt-pos - struct:bytes-input-port - 2) - (register-struct-field-mutator! - set-bytes-input-port-bstr! - struct:bytes-input-port - 0) - (register-struct-field-mutator! - set-bytes-input-port-pos! - struct:bytes-input-port - 1) - (register-struct-field-mutator! - set-bytes-input-port-alt-pos! - struct:bytes-input-port - 2) - (void))) (define struct:bytes-input-port-methods.1 (make-record-type-descriptor* 'bytes-input-port-methods @@ -19514,11 +18776,6 @@ (if (impersonator? v) (bytes-input-port-methods?.1_2316 (impersonator-val v)) #f)))))) -(define effect_2597 - (begin - (register-struct-constructor! bytes-input-port-methods4.1) - (register-struct-predicate! bytes-input-port-methods?.1) - (void))) (define bytes-input-port-vtable.1 (let ((app_0 (core-port-methods-count-lines!.1 commit-input-port-vtable.1))) (let ((app_1 @@ -19759,35 +19016,6 @@ (|#%name| set-bytes-output-port-max-pos! (record-mutator struct:bytes-output-port 2))) -(define effect_2129 - (begin - (register-struct-constructor! create-bytes-output-port) - (register-struct-predicate! bytes-output-port?) - (register-struct-field-accessor! - bytes-output-port-bstr - struct:bytes-output-port - 0) - (register-struct-field-accessor! - bytes-output-port-pos - struct:bytes-output-port - 1) - (register-struct-field-accessor! - bytes-output-port-max-pos - struct:bytes-output-port - 2) - (register-struct-field-mutator! - set-bytes-output-port-bstr! - struct:bytes-output-port - 0) - (register-struct-field-mutator! - set-bytes-output-port-pos! - struct:bytes-output-port - 1) - (register-struct-field-mutator! - set-bytes-output-port-max-pos! - struct:bytes-output-port - 2) - (void))) (define struct:bytes-output-port-methods.1 (make-record-type-descriptor* 'bytes-output-port-methods @@ -19868,19 +19096,6 @@ s 'bytes-output-port-methods 'get-bytes)))))) -(define effect_2733 - (begin - (register-struct-constructor! bytes-output-port-methods8.1) - (register-struct-predicate! bytes-output-port-methods?.1) - (register-struct-field-accessor! - bytes-output-port-methods-get-length.1 - struct:bytes-output-port-methods.1 - 0) - (register-struct-field-accessor! - bytes-output-port-methods-get-bytes.1 - struct:bytes-output-port-methods.1 - 1) - (void))) (define bytes-output-port-vtable.1 (let ((app_0 (core-port-methods-close.1 core-output-port-vtable.1))) (let ((app_1 (core-port-methods-count-lines!.1 core-output-port-vtable.1))) @@ -20294,27 +19509,6 @@ (|#%name| set-max-output-port-max-length! (record-mutator struct:max-output-port 1))) -(define effect_3372 - (begin - (register-struct-constructor! create-max-output-port) - (register-struct-predicate! max-output-port?) - (register-struct-field-accessor! - max-output-port-o - struct:max-output-port - 0) - (register-struct-field-accessor! - max-output-port-max-length - struct:max-output-port - 1) - (register-struct-field-mutator! - set-max-output-port-o! - struct:max-output-port - 0) - (register-struct-field-mutator! - set-max-output-port-max-length! - struct:max-output-port - 1) - (void))) (define struct:max-output-port-methods.1 (make-record-type-descriptor* 'max-output-port-methods @@ -20359,11 +19553,6 @@ (if (impersonator? v) (max-output-port-methods?.1_2811 (impersonator-val v)) #f)))))) -(define effect_3192 - (begin - (register-struct-constructor! max-output-port-methods1.1) - (register-struct-predicate! max-output-port-methods?.1) - (void))) (define max-output-port-vtable.1 (let ((app_0 (core-port-methods-close.1 core-output-port-vtable.1))) (let ((app_1 (core-port-methods-count-lines!.1 core-output-port-vtable.1))) @@ -21300,11 +20489,6 @@ (|#%name| nowhere-output-port? (record-predicate struct:nowhere-output-port))) -(define effect_2815 - (begin - (register-struct-constructor! create-nowhere-output-port) - (register-struct-predicate! nowhere-output-port?) - (void))) (define struct:nowhere-output-port-methods.1 (make-record-type-descriptor* 'nowhere-output-port-methods @@ -21349,11 +20533,6 @@ (if (impersonator? v) (nowhere-output-port-methods?.1_2940 (impersonator-val v)) #f)))))) -(define effect_2533 - (begin - (register-struct-constructor! nowhere-output-port-methods1.1) - (register-struct-predicate! nowhere-output-port-methods?.1) - (void))) (define nowhere-output-port-vtable.1 (let ((app_0 (core-port-methods-close.1 core-output-port-vtable.1))) (let ((app_1 (core-port-methods-count-lines!.1 core-output-port-vtable.1))) @@ -21670,15 +20849,6 @@ s 'as-constructor 'tag)))))) -(define effect_2364 - (begin - (register-struct-constructor! as-constructor1.1) - (register-struct-predicate! as-constructor?) - (register-struct-field-accessor! - as-constructor-tag - struct:as-constructor - 0) - (void))) (define build-graph (letrec ((build-graph_0 (|#%name| @@ -25042,39 +24212,6 @@ s 'starting-point 'drive?)))))) -(define effect_2620 - (begin - (register-struct-constructor! starting-point7.1) - (register-struct-predicate! starting-point?) - (register-struct-field-accessor! - starting-point-kind - struct:starting-point - 0) - (register-struct-field-accessor! - starting-point-bstr - struct:starting-point - 1) - (register-struct-field-accessor! - starting-point-len - struct:starting-point - 2) - (register-struct-field-accessor! - starting-point-orig-len - struct:starting-point - 3) - (register-struct-field-accessor! - starting-point-extra-sep - struct:starting-point - 4) - (register-struct-field-accessor! - starting-point-add-ups? - struct:starting-point - 5) - (register-struct-field-accessor! - starting-point-drive? - struct:starting-point - 6) - (void))) (define make-starting-point.1 (|#%name| make-starting-point @@ -27091,27 +26228,6 @@ s 'security-guard 'link-guard)))))) -(define effect_2474 - (begin - (register-struct-constructor! security-guard1.1) - (register-struct-predicate! 1/security-guard?) - (register-struct-field-accessor! - security-guard-parent - struct:security-guard - 0) - (register-struct-field-accessor! - security-guard-file-guard - struct:security-guard - 1) - (register-struct-field-accessor! - security-guard-network-guard - struct:security-guard - 2) - (register-struct-field-accessor! - security-guard-link-guard - struct:security-guard - 3) - (void))) (define root-security-guard (security-guard1.1 #f void void void)) (define 1/current-security-guard (make-parameter @@ -31489,19 +30605,6 @@ (|#%name| set-environment-variables-ht! (record-mutator struct:environment-variables 0))) -(define effect_2661 - (begin - (register-struct-constructor! environment-variables1.1) - (register-struct-predicate! 1/environment-variables?) - (register-struct-field-accessor! - environment-variables-ht - struct:environment-variables - 0) - (register-struct-field-mutator! - set-environment-variables-ht! - struct:environment-variables - 0) - (void))) (define 1/current-environment-variables (make-parameter (environment-variables1.1 #f) @@ -33532,51 +32635,6 @@ v 'logger 'local-level-timestamp)))))) -(define effect_1856 - (begin - (register-struct-constructor! logger1.1) - (register-struct-predicate! 1/logger?) - (register-struct-field-accessor! logger-topic struct:logger 0) - (register-struct-field-accessor! logger-parent struct:logger 1) - (register-struct-field-accessor! logger-propagate-filters struct:logger 2) - (register-struct-field-accessor! - logger-receiver-box+backrefs - struct:logger - 3) - (register-struct-field-accessor! logger-prune-counter struct:logger 4) - (register-struct-field-accessor! - logger-permanent-receivers - struct:logger - 5) - (register-struct-field-accessor! logger-max-receiver-level struct:logger 6) - (register-struct-field-accessor! logger-topic-level-cache struct:logger 7) - (register-struct-field-accessor! - logger-local-level-timestamp - struct:logger - 8) - (register-struct-field-accessor! - logger-root-level-timestamp-box - struct:logger - 9) - (register-struct-field-accessor! logger-level-sema-box struct:logger 10) - (register-struct-field-mutator! - set-logger-receiver-box+backrefs! - struct:logger - 3) - (register-struct-field-mutator! set-logger-prune-counter! struct:logger 4) - (register-struct-field-mutator! - set-logger-permanent-receivers! - struct:logger - 5) - (register-struct-field-mutator! - set-logger-max-receiver-level! - struct:logger - 6) - (register-struct-field-mutator! - set-logger-local-level-timestamp! - struct:logger - 8) - (void))) (define 1/logger-name (|#%name| logger-name @@ -33767,15 +32825,6 @@ (|#%name| set-queue-start! (record-mutator struct:queue 0))) (define set-queue-end! (|#%name| set-queue-end! (record-mutator struct:queue 1))) -(define effect_2779 - (begin - (register-struct-constructor! queue1.1) - (register-struct-predicate! queue?) - (register-struct-field-accessor! queue-start struct:queue 0) - (register-struct-field-accessor! queue-end struct:queue 1) - (register-struct-field-mutator! set-queue-start! struct:queue 0) - (register-struct-field-mutator! set-queue-end! struct:queue 1) - (void))) (define struct:node (make-record-type-descriptor* 'node #f #f #f #f 3 6)) (define effect_2547 (struct-type-install-properties! @@ -33803,16 +32852,6 @@ (|#%name| set-node-prev! (record-mutator struct:node 1))) (define set-node-next! (|#%name| set-node-next! (record-mutator struct:node 2))) -(define effect_2935 - (begin - (register-struct-constructor! node2.1) - (register-struct-predicate! node?) - (register-struct-field-accessor! node-elem struct:node 0) - (register-struct-field-accessor! node-prev struct:node 1) - (register-struct-field-accessor! node-next struct:node 2) - (register-struct-field-mutator! set-node-prev! struct:node 1) - (register-struct-field-mutator! set-node-next! struct:node 2) - (void))) (define make-queue (lambda () (queue1.1 #f #f))) (define queue-empty? (lambda (q_0) (not (queue-start q_0)))) (define queue-remove! @@ -33890,15 +32929,6 @@ s 'log-receiver 'filters)))))) -(define effect_2843 - (begin - (register-struct-constructor! log-receiver1.1) - (register-struct-predicate! 1/log-receiver?) - (register-struct-field-accessor! - log-receiver-filters - struct:log-receiver - 0) - (void))) (define-values (prop:receiver-send receiver-send? receiver-send-ref) (make-struct-type-property 'receiver-send)) @@ -34043,23 +33073,6 @@ s 'log-receiver 'backref)))))) -(define effect_2530 - (begin - (register-struct-constructor! queue-log-receiver2.1) - (register-struct-predicate! queue-log-receiver?) - (register-struct-field-accessor! - queue-log-receiver-msgs - struct:queue-log-receiver - 0) - (register-struct-field-accessor! - queue-log-receiver-waiters - struct:queue-log-receiver - 1) - (register-struct-field-accessor! - queue-log-receiver-backref - struct:queue-log-receiver - 2) - (void))) (define 1/make-log-receiver (|#%name| make-log-receiver @@ -34206,19 +33219,6 @@ s 'stdio-log-receiver 'which)))))) -(define effect_2429 - (begin - (register-struct-constructor! stdio-log-receiver3.1) - (register-struct-predicate! stdio-log-receiver?) - (register-struct-field-accessor! - stdio-log-receiver-rktio - struct:stdio-log-receiver - 0) - (register-struct-field-accessor! - stdio-log-receiver-which - struct:stdio-log-receiver - 1) - (void))) (define add-stdio-log-receiver! (lambda (who_0 logger_0 args_0 parse-who_0 which_0) (begin @@ -34356,19 +33356,6 @@ s 'syslog-log-receiver 'cmd)))))) -(define effect_2303 - (begin - (register-struct-constructor! syslog-log-receiver4.1) - (register-struct-predicate! syslog-log-receiver?) - (register-struct-field-accessor! - syslog-log-receiver-rktio - struct:syslog-log-receiver - 0) - (register-struct-field-accessor! - syslog-log-receiver-cmd - struct:syslog-log-receiver - 1) - (void))) (define add-syslog-log-receiver! (lambda (logger_0 . args_0) (let ((lr_0 @@ -35394,24 +34381,6 @@ v 'filesystem-change-evt 'cust-ref)))))) -(define effect_2283 - (begin - (register-struct-constructor! fs-change-evt1.1) - (register-struct-predicate! fs-change-evt?) - (register-struct-field-accessor! fs-change-evt-rfc struct:fs-change-evt 0) - (register-struct-field-accessor! - fs-change-evt-cust-ref - struct:fs-change-evt - 1) - (register-struct-field-mutator! - set-fs-change-evt-rfc! - struct:fs-change-evt - 0) - (register-struct-field-mutator! - set-fs-change-evt-cust-ref! - struct:fs-change-evt - 1) - (void))) (define 1/filesystem-change-evt? (|#%name| filesystem-change-evt? @@ -35922,22 +34891,6 @@ v 'subprocess 'cust-ref)))))) -(define effect_2667 - (begin - (register-struct-constructor! make-subprocess) - (register-struct-predicate! 1/subprocess?) - (register-struct-field-accessor! subprocess-process struct:subprocess 0) - (register-struct-field-accessor! subprocess-cust-ref struct:subprocess 1) - (register-struct-field-accessor! subprocess-is-group? struct:subprocess 2) - (register-struct-field-mutator! - set-subprocess-process! - struct:subprocess - 0) - (register-struct-field-mutator! - set-subprocess-cust-ref! - struct:subprocess - 1) - (void))) (define do-subprocess (letrec ((maybe-wait_0 (|#%name| @@ -35995,11 +34948,11 @@ 'subprocess "(or/c (and/c output-port? file-stream-port?) #f 'stdout)" stderr_0)) - (let ((lr3626 unsafe-undefined) + (let ((lr3567 unsafe-undefined) (group_0 unsafe-undefined) (command_0 unsafe-undefined) (exact/args_0 unsafe-undefined)) - (set! lr3626 + (set! lr3567 (call-with-values (lambda () (if (path-string? group/command_0) @@ -36054,9 +35007,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 lr3626 0)) - (set! command_0 (unsafe-vector*-ref lr3626 1)) - (set! exact/args_0 (unsafe-vector*-ref lr3626 2)) + (set! group_0 (unsafe-vector*-ref lr3567 0)) + (set! command_0 (unsafe-vector*-ref lr3567 1)) + (set! exact/args_0 (unsafe-vector*-ref lr3567 2)) (call-with-values (lambda () (if (if (pair? exact/args_0) @@ -36719,19 +35672,6 @@ (|#%name| set-tcp-input-port-abandon?! (record-mutator struct:tcp-input-port 0))) -(define effect_2627 - (begin - (register-struct-constructor! create-tcp-input-port) - (register-struct-predicate! tcp-input-port?) - (register-struct-field-accessor! - tcp-input-port-abandon? - struct:tcp-input-port - 0) - (register-struct-field-mutator! - set-tcp-input-port-abandon?! - struct:tcp-input-port - 0) - (void))) (define struct:tcp-input-port-methods.1 (make-record-type-descriptor* 'tcp-input-port-methods @@ -36776,11 +35716,6 @@ (if (impersonator? v) (tcp-input-port-methods?.1_2414 (impersonator-val v)) #f)))))) -(define effect_2814 - (begin - (register-struct-constructor! tcp-input-port-methods1.1) - (register-struct-predicate! tcp-input-port-methods?.1) - (void))) (define tcp-input-port-vtable.1 (let ((app_0 (core-port-methods-close.1 fd-input-port-vtable.1))) (let ((app_1 (core-port-methods-count-lines!.1 fd-input-port-vtable.1))) @@ -36915,19 +35850,6 @@ (|#%name| set-tcp-output-port-abandon?! (record-mutator struct:tcp-output-port 0))) -(define effect_2804 - (begin - (register-struct-constructor! create-tcp-output-port) - (register-struct-predicate! tcp-output-port?) - (register-struct-field-accessor! - tcp-output-port-abandon? - struct:tcp-output-port - 0) - (register-struct-field-mutator! - set-tcp-output-port-abandon?! - struct:tcp-output-port - 0) - (void))) (define struct:tcp-output-port-methods.1 (make-record-type-descriptor* 'tcp-output-port-methods @@ -36972,11 +35894,6 @@ (if (impersonator? v) (tcp-output-port-methods?.1_2754 (impersonator-val v)) #f)))))) -(define effect_2801 - (begin - (register-struct-constructor! tcp-output-port-methods7.1) - (register-struct-predicate! tcp-output-port-methods?.1) - (void))) (define tcp-output-port-vtable.1 (let ((app_0 (core-port-methods-close.1 fd-output-port-vtable.1))) (let ((app_1 (core-port-methods-count-lines!.1 fd-output-port-vtable.1))) @@ -37127,16 +36044,6 @@ (|#%name| rktio-evt-poll (record-accessor struct:rktio-evt 0))) (define rktio-evt-add-to-poll-set (|#%name| rktio-evt-add-to-poll-set (record-accessor struct:rktio-evt 1))) -(define effect_2398 - (begin - (register-struct-constructor! rktio-evt1.1) - (register-struct-predicate! rktio-evt?) - (register-struct-field-accessor! rktio-evt-poll struct:rktio-evt 0) - (register-struct-field-accessor! - rktio-evt-add-to-poll-set - struct:rktio-evt - 1) - (void))) (define call-with-resolved-address.1 (letrec ((procz2 (lambda (addr_0) @@ -37320,27 +36227,6 @@ (|#%name| set-connect-progress-trying-fd! (record-mutator struct:connect-progress 1))) -(define effect_2059 - (begin - (register-struct-constructor! connect-progress1.1) - (register-struct-predicate! connect-progress?) - (register-struct-field-accessor! - connect-progress-conn - struct:connect-progress - 0) - (register-struct-field-accessor! - connect-progress-trying-fd - struct:connect-progress - 1) - (register-struct-field-mutator! - set-connect-progress-conn! - struct:connect-progress - 0) - (register-struct-field-mutator! - set-connect-progress-trying-fd! - struct:connect-progress - 1) - (void))) (define 1/tcp-connect (let ((tcp-connect_0 (|#%name| @@ -37792,17 +36678,6 @@ s 'tcp-listener 'custodian-reference)))))) -(define effect_2084 - (begin - (register-struct-constructor! tcp-listener1.1) - (register-struct-predicate! 1/tcp-listener?) - (register-struct-field-accessor! tcp-listener-lnr struct:tcp-listener 0) - (register-struct-field-accessor! tcp-listener-closed struct:tcp-listener 1) - (register-struct-field-accessor! - tcp-listener-custodian-reference - struct:tcp-listener - 2) - (void))) (define 1/tcp-listen (let ((tcp-listen_0 (letrec ((loop_0 @@ -38218,12 +37093,6 @@ s 'tcp-accept-evt 'listener)))))) -(define effect_2643 - (begin - (register-struct-constructor! accept-evt6.1) - (register-struct-predicate! accept-evt?) - (register-struct-field-accessor! accept-evt-listener struct:accept-evt 0) - (void))) (define error-result (lambda (thunk_0) (values #f (wrap-evt always-evt (lambda (v_0) (|#%app| thunk_0)))))) @@ -38303,17 +37172,6 @@ (|#%name| set-udp-is-bound?! (record-mutator struct:udp 1))) (define set-udp-is-connected?! (|#%name| set-udp-is-connected?! (record-mutator struct:udp 2))) -(define effect_2782 - (begin - (register-struct-constructor! udp1.1) - (register-struct-predicate! 1/udp?) - (register-struct-field-accessor! udp-s struct:udp 0) - (register-struct-field-accessor! udp-is-bound? struct:udp 1) - (register-struct-field-accessor! udp-is-connected? struct:udp 2) - (register-struct-field-mutator! set-udp-s! struct:udp 0) - (register-struct-field-mutator! set-udp-is-bound?! struct:udp 1) - (register-struct-field-mutator! set-udp-is-connected?! struct:udp 2) - (void))) (define 1/udp-open-socket (let ((udp-open-socket_0 (letrec ((procz1 @@ -39532,19 +38390,6 @@ (|#%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 effect_2387 - (begin - (register-struct-constructor! udp-sending-evt66.1) - (register-struct-predicate! udp-sending-evt?) - (register-struct-field-accessor! - udp-sending-evt-u - struct:udp-sending-evt - 0) - (register-struct-field-accessor! - udp-sending-evt-try - struct:udp-sending-evt - 1) - (void))) (define struct:udp-sending-ready-evt (make-record-type-descriptor* 'udp-send-ready-evt @@ -39554,7 +38399,7 @@ #f 0 0)) -(define effect_3039 +(define effect_3038 (struct-type-install-properties! struct:udp-sending-ready-evt 'udp-send-ready-evt @@ -39576,11 +38421,6 @@ (|#%name| udp-send-ready-evt? (record-predicate struct:udp-sending-ready-evt))) -(define effect_2593 - (begin - (register-struct-constructor! udp-sending-ready-evt67.1) - (register-struct-predicate! udp-sending-ready-evt?) - (void))) (define 1/udp-receive! (let ((udp-receive!_0 (|#%name| @@ -39959,19 +38799,6 @@ (|#%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 effect_2659 - (begin - (register-struct-constructor! udp-receiving-evt39.1) - (register-struct-predicate! udp-receiving-evt?) - (register-struct-field-accessor! - udp-receiving-evt-u - struct:udp-receiving-evt - 0) - (register-struct-field-accessor! - udp-receiving-evt-try - struct:udp-receiving-evt - 1) - (void))) (define struct:udp-receiving-ready-evt (make-record-type-descriptor* 'udp-receive-ready-evt @@ -40006,11 +38833,6 @@ (|#%name| udp-receive-ready-evt? (record-predicate struct:udp-receiving-ready-evt))) -(define effect_2999 - (begin - (register-struct-constructor! udp-receiving-ready-evt40.1) - (register-struct-predicate! udp-receiving-ready-evt?) - (void))) (define 1/udp-set-receive-buffer-size! (|#%name| udp-set-receive-buffer-size! diff --git a/racket/src/cs/schemified/known.scm b/racket/src/cs/schemified/known.scm index 2289164e13..3c9b6d11c6 100644 --- a/racket/src/cs/schemified/known.scm +++ b/racket/src/cs/schemified/known.scm @@ -173,11 +173,6 @@ (if (impersonator? v) (known-constant?_2598 (impersonator-val v)) #f)))))) -(define effect_2956 - (begin - (register-struct-constructor! known-constant) - (register-struct-predicate! known-constant?) - (void))) (define struct:known-consistent (make-record-type-descriptor* 'known-consistent @@ -229,11 +224,6 @@ (if (impersonator? v) (known-consistent?_3048 (impersonator-val v)) #f)))))) -(define effect_3117 - (begin - (register-struct-constructor! known-consistent) - (register-struct-predicate! known-consistent?) - (void))) (define struct:known-authentic (make-record-type-descriptor* 'known-authentic @@ -285,11 +275,6 @@ (if (impersonator? v) (known-authentic?_3119 (impersonator-val v)) #f)))))) -(define effect_2588 - (begin - (register-struct-constructor! known-authentic) - (register-struct-predicate! known-authentic?) - (void))) (define struct:known-copy (make-record-type-descriptor* 'known-copy @@ -355,12 +340,6 @@ s 'known-copy 'id)))))) -(define effect_2902 - (begin - (register-struct-constructor! known-copy) - (register-struct-predicate! known-copy?) - (register-struct-field-accessor! known-copy-id struct:known-copy 0) - (void))) (define struct:known-literal (make-record-type-descriptor* 'known-literal @@ -428,15 +407,6 @@ s 'known-literal 'value)))))) -(define effect_2398 - (begin - (register-struct-constructor! known-literal) - (register-struct-predicate! known-literal?) - (register-struct-field-accessor! - known-literal-value - struct:known-literal - 0) - (void))) (define struct:known-procedure (make-record-type-descriptor* 'known-procedure @@ -506,15 +476,6 @@ s 'known-procedure 'arity-mask)))))) -(define effect_1399 - (begin - (register-struct-constructor! known-procedure) - (register-struct-predicate! known-procedure?) - (register-struct-field-accessor! - known-procedure-arity-mask - struct:known-procedure - 0) - (void))) (define struct:known-procedure/no-prompt (make-record-type-descriptor* 'known-procedure/no-prompt @@ -571,11 +532,6 @@ (if (impersonator? v) (known-procedure/no-prompt?_2036 (impersonator-val v)) #f)))))) -(define effect_2150 - (begin - (register-struct-constructor! known-procedure/no-prompt) - (register-struct-predicate! known-procedure/no-prompt?) - (void))) (define struct:known-procedure/can-inline (make-record-type-descriptor* 'known-procedure/can-inline @@ -650,15 +606,6 @@ s 'known-procedure/can-inline 'expr)))))) -(define effect_2594 - (begin - (register-struct-constructor! known-procedure/can-inline) - (register-struct-predicate! known-procedure/can-inline?) - (register-struct-field-accessor! - known-procedure/can-inline-expr - struct:known-procedure/can-inline - 0) - (void))) (define struct:known-procedure/can-inline/need-imports (make-record-type-descriptor* 'known-procedure/can-inline/need-imports @@ -733,15 +680,6 @@ s 'known-procedure/can-inline/need-imports 'needed)))))) -(define effect_2494 - (begin - (register-struct-constructor! known-procedure/can-inline/need-imports) - (register-struct-predicate! known-procedure/can-inline/need-imports?) - (register-struct-field-accessor! - known-procedure/can-inline/need-imports-needed - struct:known-procedure/can-inline/need-imports - 0) - (void))) (define struct:known-procedure/folding (make-record-type-descriptor* 'known-procedure/folding @@ -798,11 +736,6 @@ (if (impersonator? v) (known-procedure/folding?_2882 (impersonator-val v)) #f)))))) -(define effect_2446 - (begin - (register-struct-constructor! known-procedure/folding) - (register-struct-predicate! known-procedure/folding?) - (void))) (define struct:known-procedure/folding/limited (make-record-type-descriptor* 'known-procedure/folding/limited @@ -877,15 +810,6 @@ s 'known-procedure/folding/limited 'kind)))))) -(define effect_2817 - (begin - (register-struct-constructor! known-procedure/folding/limited) - (register-struct-predicate! known-procedure/folding/limited?) - (register-struct-field-accessor! - known-procedure/folding/limited-kind - struct:known-procedure/folding/limited - 0) - (void))) (define struct:known-procedure/succeeds (make-record-type-descriptor* 'known-procedure/succeeds @@ -942,11 +866,6 @@ (if (impersonator? v) (known-procedure/succeeds?_3041 (impersonator-val v)) #f)))))) -(define effect_2473 - (begin - (register-struct-constructor! known-procedure/succeeds) - (register-struct-predicate! known-procedure/succeeds?) - (void))) (define struct:known-procedure/pure (make-record-type-descriptor* 'known-procedure/pure @@ -1000,11 +919,6 @@ (if (impersonator? v) (known-procedure/pure?_2240 (impersonator-val v)) #f)))))) -(define effect_2621 - (begin - (register-struct-constructor! known-procedure/pure) - (register-struct-predicate! known-procedure/pure?) - (void))) (define struct:known-procedure/pure/folding (make-record-type-descriptor* 'known-procedure/pure/folding @@ -1061,11 +975,6 @@ (if (impersonator? v) (known-procedure/pure/folding?_2719 (impersonator-val v)) #f)))))) -(define effect_2449 - (begin - (register-struct-constructor! known-procedure/pure/folding) - (register-struct-predicate! known-procedure/pure/folding?) - (void))) (define struct:known-procedure/pure/folding-unsafe (make-record-type-descriptor* 'known-procedure/pure/folding-unsafe @@ -1140,15 +1049,6 @@ s 'known-procedure/pure/folding-unsafe 'safe)))))) -(define effect_2336 - (begin - (register-struct-constructor! known-procedure/pure/folding-unsafe) - (register-struct-predicate! known-procedure/pure/folding-unsafe?) - (register-struct-field-accessor! - known-procedure/pure/folding-unsafe-safe - struct:known-procedure/pure/folding-unsafe - 0) - (void))) (define struct:known-procedure/has-unsafe (make-record-type-descriptor* 'known-procedure/has-unsafe @@ -1223,15 +1123,6 @@ s 'known-procedure/has-unsafe 'alternate)))))) -(define effect_1976 - (begin - (register-struct-constructor! known-procedure/has-unsafe) - (register-struct-predicate! known-procedure/has-unsafe?) - (register-struct-field-accessor! - known-procedure/has-unsafe-alternate - struct:known-procedure/has-unsafe - 0) - (void))) (define struct:known-procedure/has-unsafe/folding (make-record-type-descriptor* 'known-procedure/has-unsafe/folding @@ -1288,11 +1179,6 @@ (if (impersonator? v) (known-procedure/has-unsafe/folding?_2169 (impersonator-val v)) #f)))))) -(define effect_2832 - (begin - (register-struct-constructor! known-procedure/has-unsafe/folding) - (register-struct-predicate! known-procedure/has-unsafe/folding?) - (void))) (define struct:known-procedure/has-unsafe/folding/limited (make-record-type-descriptor* 'known-procedure/has-unsafe/folding/limited @@ -1368,15 +1254,6 @@ s 'known-procedure/has-unsafe/folding/limited 'kind)))))) -(define effect_2061 - (begin - (register-struct-constructor! known-procedure/has-unsafe/folding/limited) - (register-struct-predicate! known-procedure/has-unsafe/folding/limited?) - (register-struct-field-accessor! - known-procedure/has-unsafe/folding/limited-kind - struct:known-procedure/has-unsafe/folding/limited - 0) - (void))) (define struct:known-struct-type (make-record-type-descriptor* 'known-struct-type @@ -1482,23 +1359,6 @@ s 'known-struct-type 'pure-constructor?)))))) -(define effect_2460 - (begin - (register-struct-constructor! known-struct-type) - (register-struct-predicate! known-struct-type?) - (register-struct-field-accessor! - known-struct-type-type - struct:known-struct-type - 0) - (register-struct-field-accessor! - known-struct-type-field-count - struct:known-struct-type - 1) - (register-struct-field-accessor! - known-struct-type-pure-constructor? - struct:known-struct-type - 2) - (void))) (define struct:known-constructor (make-record-type-descriptor* 'known-constructor @@ -1568,15 +1428,6 @@ s 'known-constructor 'type)))))) -(define effect_2610 - (begin - (register-struct-constructor! known-constructor) - (register-struct-predicate! known-constructor?) - (register-struct-field-accessor! - known-constructor-type - struct:known-constructor - 0) - (void))) (define struct:known-predicate (make-record-type-descriptor* 'known-predicate @@ -1644,15 +1495,6 @@ s 'known-predicate 'type)))))) -(define effect_2622 - (begin - (register-struct-constructor! known-predicate) - (register-struct-predicate! known-predicate?) - (register-struct-field-accessor! - known-predicate-type - struct:known-predicate - 0) - (void))) (define struct:known-accessor (make-record-type-descriptor* 'known-accessor @@ -1672,7 +1514,7 @@ #f 1 1)) -(define effect_2151 +(define effect_2150 (struct-type-install-properties! struct:known-accessor 'known-accessor @@ -1720,15 +1562,6 @@ s 'known-accessor 'type)))))) -(define effect_3078 - (begin - (register-struct-constructor! known-accessor) - (register-struct-predicate! known-accessor?) - (register-struct-field-accessor! - known-accessor-type - struct:known-accessor - 0) - (void))) (define struct:known-mutator (make-record-type-descriptor* 'known-mutator @@ -1796,12 +1629,80 @@ s 'known-mutator 'type)))))) -(define effect_2451 - (begin - (register-struct-constructor! known-mutator) - (register-struct-predicate! known-mutator?) - (register-struct-field-accessor! known-mutator-type struct:known-mutator 0) - (void))) +(define struct:known-struct-constructor + (make-record-type-descriptor* + 'known-struct-constructor + (if (struct-type? struct:known-constructor) + struct:known-constructor + (check-struct-type 'struct struct:known-constructor)) + (structure-type-lookup-prefab-uid + 'known-struct-constructor + (if (struct-type? struct:known-constructor) + struct:known-constructor + (check-struct-type 'struct struct:known-constructor)) + 1 + 0 + #f + '(0)) + #f + #f + 1 + 1)) +(define effect_3019 + (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 known-struct-constructor + (|#%name| + known-struct-constructor + (record-constructor + (make-record-constructor-descriptor + struct:known-struct-constructor + #f + #f)))) +(define known-struct-constructor?_2705 + (|#%name| + known-struct-constructor? + (record-predicate struct:known-struct-constructor))) +(define known-struct-constructor? + (|#%name| + known-struct-constructor? + (lambda (v) + (if (known-struct-constructor?_2705 v) + #t + ($value + (if (impersonator? v) + (known-struct-constructor?_2705 (impersonator-val v)) + #f)))))) +(define known-struct-constructor-type-id_2882 + (|#%name| + known-struct-constructor-type-id + (record-accessor struct:known-struct-constructor 0))) +(define known-struct-constructor-type-id + (|#%name| + known-struct-constructor-type-id + (lambda (s) + (if (known-struct-constructor?_2705 s) + (known-struct-constructor-type-id_2882 s) + ($value + (impersonate-ref + known-struct-constructor-type-id_2882 + struct:known-struct-constructor + 0 + s + 'known-struct-constructor + 'type-id)))))) (define struct:known-struct-predicate (make-record-type-descriptor* 'known-struct-predicate @@ -1891,19 +1792,6 @@ s 'known-struct-predicate 'authentic?)))))) -(define effect_2415 - (begin - (register-struct-constructor! known-struct-predicate) - (register-struct-predicate! known-struct-predicate?) - (register-struct-field-accessor! - known-struct-predicate-type-id - struct:known-struct-predicate - 0) - (register-struct-field-accessor! - known-struct-predicate-authentic? - struct:known-struct-predicate - 1) - (void))) (define struct:known-field-accessor (make-record-type-descriptor* 'known-field-accessor @@ -1993,19 +1881,6 @@ s 'known-field-accessor 'pos)))))) -(define effect_2652 - (begin - (register-struct-constructor! known-field-accessor) - (register-struct-predicate! known-field-accessor?) - (register-struct-field-accessor! - known-field-accessor-type-id - struct:known-field-accessor - 0) - (register-struct-field-accessor! - known-field-accessor-pos - struct:known-field-accessor - 1) - (void))) (define struct:known-field-mutator (make-record-type-descriptor* 'known-field-mutator @@ -2095,19 +1970,80 @@ s 'known-field-mutator 'pos)))))) -(define effect_2676 - (begin - (register-struct-constructor! known-field-mutator) - (register-struct-predicate! known-field-mutator?) - (register-struct-field-accessor! - known-field-mutator-type-id - struct:known-field-mutator - 0) - (register-struct-field-accessor! - known-field-mutator-pos - struct:known-field-mutator - 1) - (void))) +(define struct:known-struct-constructor/need-imports + (make-record-type-descriptor* + 'known-struct-constructor/need-imports + (if (struct-type? struct:known-struct-constructor) + struct:known-struct-constructor + (check-struct-type 'struct struct:known-struct-constructor)) + (structure-type-lookup-prefab-uid + 'known-struct-constructor/need-imports + (if (struct-type? struct:known-struct-constructor) + struct:known-struct-constructor + (check-struct-type 'struct struct:known-struct-constructor)) + 1 + 0 + #f + '(0)) + #f + #f + 1 + 1)) +(define effect_2765 + (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 known-struct-constructor/need-imports + (|#%name| + known-struct-constructor/need-imports + (record-constructor + (make-record-constructor-descriptor + struct:known-struct-constructor/need-imports + #f + #f)))) +(define known-struct-constructor/need-imports?_2300 + (|#%name| + known-struct-constructor/need-imports? + (record-predicate struct:known-struct-constructor/need-imports))) +(define known-struct-constructor/need-imports? + (|#%name| + known-struct-constructor/need-imports? + (lambda (v) + (if (known-struct-constructor/need-imports?_2300 v) + #t + ($value + (if (impersonator? v) + (known-struct-constructor/need-imports?_2300 (impersonator-val v)) + #f)))))) +(define known-struct-constructor/need-imports-needed_2757 + (|#%name| + known-struct-constructor/need-imports-needed + (record-accessor struct:known-struct-constructor/need-imports 0))) +(define known-struct-constructor/need-imports-needed + (|#%name| + known-struct-constructor/need-imports-needed + (lambda (s) + (if (known-struct-constructor/need-imports?_2300 s) + (known-struct-constructor/need-imports-needed_2757 s) + ($value + (impersonate-ref + known-struct-constructor/need-imports-needed_2757 + struct:known-struct-constructor/need-imports + 0 + s + 'known-struct-constructor/need-imports + 'needed)))))) (define struct:known-struct-predicate/need-imports (make-record-type-descriptor* 'known-struct-predicate/need-imports @@ -2182,15 +2118,6 @@ s 'known-struct-predicate/need-imports 'needed)))))) -(define effect_1651 - (begin - (register-struct-constructor! known-struct-predicate/need-imports) - (register-struct-predicate! known-struct-predicate/need-imports?) - (register-struct-field-accessor! - known-struct-predicate/need-imports-needed - struct:known-struct-predicate/need-imports - 0) - (void))) (define struct:known-field-accessor/need-imports (make-record-type-descriptor* 'known-field-accessor/need-imports @@ -2265,15 +2192,6 @@ s 'known-field-accessor/need-imports 'needed)))))) -(define effect_2889 - (begin - (register-struct-constructor! known-field-accessor/need-imports) - (register-struct-predicate! known-field-accessor/need-imports?) - (register-struct-field-accessor! - known-field-accessor/need-imports-needed - struct:known-field-accessor/need-imports - 0) - (void))) (define struct:known-field-mutator/need-imports (make-record-type-descriptor* 'known-field-mutator/need-imports @@ -2348,15 +2266,6 @@ s 'known-field-mutator/need-imports 'needed)))))) -(define effect_2411 - (begin - (register-struct-constructor! known-field-mutator/need-imports) - (register-struct-predicate! known-field-mutator/need-imports?) - (register-struct-field-accessor! - known-field-mutator/need-imports-needed - struct:known-field-mutator/need-imports - 0) - (void))) (define struct:known-struct-type-property/immediate-guard (make-record-type-descriptor* 'known-struct-type-property/immediate-guard @@ -2408,10 +2317,5 @@ (known-struct-type-property/immediate-guard?_2536 (impersonator-val v)) #f)))))) -(define effect_1742 - (begin - (register-struct-constructor! known-struct-type-property/immediate-guard) - (register-struct-predicate! known-struct-type-property/immediate-guard?) - (void))) (define a-known-constant (known-constant)) (define a-known-consistent (known-consistent)) diff --git a/racket/src/cs/schemified/regexp.scm b/racket/src/cs/schemified/regexp.scm index c7ef5a2bad..db805f244f 100644 --- a/racket/src/cs/schemified/regexp.scm +++ b/racket/src/cs/schemified/regexp.scm @@ -886,13 +886,6 @@ (rx:alts-rx_2917 s) ($value (impersonate-ref rx:alts-rx_2917 struct:rx:alts 1 s 'rx:alts 'rx2)))))) -(define effect_2536 - (begin - (register-struct-constructor! rx:alts1.1) - (register-struct-predicate! rx:alts?) - (register-struct-field-accessor! rx:alts-rx_1874 struct:rx:alts 0) - (register-struct-field-accessor! rx:alts-rx_2761 struct:rx:alts 1) - (void))) (define struct:rx:sequence (make-record-type-descriptor* 'rx:sequence #f #f #f #f 2 0)) (define effect_2137 @@ -957,16 +950,6 @@ s 'rx:sequence 'needs-backtrack?)))))) -(define effect_2844 - (begin - (register-struct-constructor! rx:sequence2.1) - (register-struct-predicate! rx:sequence?) - (register-struct-field-accessor! rx:sequence-rxs struct:rx:sequence 0) - (register-struct-field-accessor! - rx:sequence-needs-backtrack? - struct:rx:sequence - 1) - (void))) (define struct:rx:group (make-record-type-descriptor* 'rx:group #f #f #f #f 2 0)) (define effect_2340 @@ -1028,13 +1011,6 @@ s 'rx:group 'number)))))) -(define effect_2814 - (begin - (register-struct-constructor! rx:group3.1) - (register-struct-predicate! rx:group?) - (register-struct-field-accessor! rx:group-rx struct:rx:group 0) - (register-struct-field-accessor! rx:group-number struct:rx:group 1) - (void))) (define struct:rx:repeat (make-record-type-descriptor* 'rx:repeat #f #f #f #f 4 0)) (define effect_2551 @@ -1129,15 +1105,6 @@ s 'rx:repeat 'non-greedy?)))))) -(define effect_2847 - (begin - (register-struct-constructor! rx:repeat4.1) - (register-struct-predicate! rx:repeat?) - (register-struct-field-accessor! rx:repeat-rx struct:rx:repeat 0) - (register-struct-field-accessor! rx:repeat-min struct:rx:repeat 1) - (register-struct-field-accessor! rx:repeat-max struct:rx:repeat 2) - (register-struct-field-accessor! rx:repeat-non-greedy? struct:rx:repeat 3) - (void))) (define struct:rx:maybe (make-record-type-descriptor* 'rx:maybe #f #f #f #f 2 0)) (define effect_2619 @@ -1199,13 +1166,6 @@ s 'rx:maybe 'non-greedy?)))))) -(define effect_2791 - (begin - (register-struct-constructor! rx:maybe5.1) - (register-struct-predicate! rx:maybe?) - (register-struct-field-accessor! rx:maybe-rx struct:rx:maybe 0) - (register-struct-field-accessor! rx:maybe-non-greedy? struct:rx:maybe 1) - (void))) (define struct:rx:conditional (make-record-type-descriptor* 'rx:conditional #f #f #f #f 6 0)) (define effect_2459 @@ -1336,35 +1296,6 @@ s 'rx:conditional 'needs-backtrack?)))))) -(define effect_2522 - (begin - (register-struct-constructor! rx:conditional6.1) - (register-struct-predicate! rx:conditional?) - (register-struct-field-accessor! - rx:conditional-tst - struct:rx:conditional - 0) - (register-struct-field-accessor! - rx:conditional-rx_2013 - struct:rx:conditional - 1) - (register-struct-field-accessor! - rx:conditional-rx_2094 - struct:rx:conditional - 2) - (register-struct-field-accessor! - rx:conditional-n-start - struct:rx:conditional - 3) - (register-struct-field-accessor! - rx:conditional-num-n - struct:rx:conditional - 4) - (register-struct-field-accessor! - rx:conditional-needs-backtrack? - struct:rx:conditional - 5) - (void))) (define struct:rx:lookahead (make-record-type-descriptor* 'rx:lookahead #f #f #f #f 4 0)) (define effect_2324 @@ -1461,18 +1392,6 @@ s 'rx:lookahead 'num-n)))))) -(define effect_2423 - (begin - (register-struct-constructor! rx:lookahead7.1) - (register-struct-predicate! rx:lookahead?) - (register-struct-field-accessor! rx:lookahead-rx struct:rx:lookahead 0) - (register-struct-field-accessor! rx:lookahead-match? struct:rx:lookahead 1) - (register-struct-field-accessor! - rx:lookahead-n-start - struct:rx:lookahead - 2) - (register-struct-field-accessor! rx:lookahead-num-n struct:rx:lookahead 3) - (void))) (define struct:rx:lookbehind (make-record-type-descriptor* 'rx:lookbehind #f #f #f #f 6 12)) (define effect_2263 @@ -1637,40 +1556,6 @@ v 'rx:lookbehind 'lb-max)))))) -(define effect_2163 - (begin - (register-struct-constructor! rx:lookbehind8.1) - (register-struct-predicate! rx:lookbehind?) - (register-struct-field-accessor! rx:lookbehind-rx struct:rx:lookbehind 0) - (register-struct-field-accessor! - rx:lookbehind-match? - struct:rx:lookbehind - 1) - (register-struct-field-accessor! - rx:lookbehind-lb-min - struct:rx:lookbehind - 2) - (register-struct-field-accessor! - rx:lookbehind-lb-max - struct:rx:lookbehind - 3) - (register-struct-field-accessor! - rx:lookbehind-n-start - struct:rx:lookbehind - 4) - (register-struct-field-accessor! - rx:lookbehind-num-n - struct:rx:lookbehind - 5) - (register-struct-field-mutator! - set-rx:lookbehind-lb-min! - struct:rx:lookbehind - 2) - (register-struct-field-mutator! - set-rx:lookbehind-lb-max! - struct:rx:lookbehind - 3) - (void))) (define struct:rx:cut (make-record-type-descriptor* 'rx:cut #f #f #f #f 4 0)) (define effect_2942 (struct-type-install-properties! @@ -1756,15 +1641,6 @@ s 'rx:cut 'needs-backtrack?)))))) -(define effect_2360 - (begin - (register-struct-constructor! rx:cut9.1) - (register-struct-predicate! rx:cut?) - (register-struct-field-accessor! rx:cut-rx struct:rx:cut 0) - (register-struct-field-accessor! rx:cut-n-start struct:rx:cut 1) - (register-struct-field-accessor! rx:cut-num-n struct:rx:cut 2) - (register-struct-field-accessor! rx:cut-needs-backtrack? struct:rx:cut 3) - (void))) (define struct:rx:reference (make-record-type-descriptor* 'rx:reference #f #f #f #f 2 0)) (define effect_2344 @@ -1831,16 +1707,6 @@ s 'rx:reference 'case-sensitive?)))))) -(define effect_2703 - (begin - (register-struct-constructor! rx:reference10.1) - (register-struct-predicate! rx:reference?) - (register-struct-field-accessor! rx:reference-n struct:rx:reference 0) - (register-struct-field-accessor! - rx:reference-case-sensitive? - struct:rx:reference - 1) - (void))) (define struct:rx:range (make-record-type-descriptor* 'rx:range #f #f #f #f 1 0)) (define effect_2702 @@ -1886,12 +1752,6 @@ s 'rx:range 'range)))))) -(define effect_2869 - (begin - (register-struct-constructor! rx:range11.1) - (register-struct-predicate! rx:range?) - (register-struct-field-accessor! rx:range-range struct:rx:range 0) - (void))) (define struct:rx:unicode-categories (make-record-type-descriptor* 'rx:unicode-categories #f #f #f #f 2 0)) (define effect_2129 @@ -1962,19 +1822,6 @@ s 'rx:unicode-categories 'match?)))))) -(define effect_2012 - (begin - (register-struct-constructor! rx:unicode-categories12.1) - (register-struct-predicate! rx:unicode-categories?) - (register-struct-field-accessor! - rx:unicode-categories-symlist - struct:rx:unicode-categories - 0) - (register-struct-field-accessor! - rx:unicode-categories-match? - struct:rx:unicode-categories - 1) - (void))) (define needs-backtrack? (lambda (rx_0) (if (rx:alts? rx_0) @@ -2328,33 +2175,6 @@ s 'parse-config 'error-handler?)))))) -(define effect_2865 - (begin - (register-struct-constructor! parse-config1.1) - (register-struct-predicate! parse-config?) - (register-struct-field-accessor! parse-config-who struct:parse-config 0) - (register-struct-field-accessor! parse-config-px? struct:parse-config 1) - (register-struct-field-accessor! - parse-config-case-sensitive? - struct:parse-config - 2) - (register-struct-field-accessor! - parse-config-multi-line? - struct:parse-config - 3) - (register-struct-field-accessor! - parse-config-group-number-box - struct:parse-config - 4) - (register-struct-field-accessor! - parse-config-references?-box - struct:parse-config - 5) - (register-struct-field-accessor! - parse-config-error-handler? - struct:parse-config - 6) - (void))) (define make-parse-config.1 (|#%name| make-parse-config @@ -5144,46 +4964,6 @@ v 'lazy-bytes 'discarded-count)))))) -(define effect_3099 - (begin - (register-struct-constructor! lazy-bytes1.1) - (register-struct-predicate! lazy-bytes?) - (register-struct-field-accessor! lazy-bytes-bstr struct:lazy-bytes 0) - (register-struct-field-accessor! lazy-bytes-end struct:lazy-bytes 1) - (register-struct-field-accessor! lazy-bytes-in struct:lazy-bytes 2) - (register-struct-field-accessor! lazy-bytes-skip-amt struct:lazy-bytes 3) - (register-struct-field-accessor! lazy-bytes-prefix-len struct:lazy-bytes 4) - (register-struct-field-accessor! lazy-bytes-peek? struct:lazy-bytes 5) - (register-struct-field-accessor! - lazy-bytes-immediate-only? - struct:lazy-bytes - 6) - (register-struct-field-accessor! - lazy-bytes-progress-evt - struct:lazy-bytes - 7) - (register-struct-field-accessor! lazy-bytes-out struct:lazy-bytes 8) - (register-struct-field-accessor! - lazy-bytes-max-lookbehind - struct:lazy-bytes - 9) - (register-struct-field-accessor! lazy-bytes-failed? struct:lazy-bytes 10) - (register-struct-field-accessor! - lazy-bytes-discarded-count - struct:lazy-bytes - 11) - (register-struct-field-accessor! lazy-bytes-max-peek struct:lazy-bytes 12) - (register-struct-field-mutator! set-lazy-bytes-bstr! struct:lazy-bytes 0) - (register-struct-field-mutator! set-lazy-bytes-end! struct:lazy-bytes 1) - (register-struct-field-mutator! - set-lazy-bytes-failed?! - struct:lazy-bytes - 10) - (register-struct-field-mutator! - set-lazy-bytes-discarded-count! - struct:lazy-bytes - 11) - (void))) (define make-lazy-bytes (lambda (in_0 skip-amt_0 @@ -7690,24 +7470,6 @@ s 'regexp 'start-range)))))) -(define effect_3291 - (begin - (register-struct-constructor! rx:regexp1.1) - (register-struct-predicate! rx:regexp?) - (register-struct-field-accessor! rx:regexp-bytes? struct:rx:regexp 0) - (register-struct-field-accessor! rx:regexp-px? struct:rx:regexp 1) - (register-struct-field-accessor! rx:regexp-source struct:rx:regexp 2) - (register-struct-field-accessor! rx:regexp-matcher struct:rx:regexp 3) - (register-struct-field-accessor! rx:regexp-num-groups struct:rx:regexp 4) - (register-struct-field-accessor! rx:regexp-references? struct:rx:regexp 5) - (register-struct-field-accessor! - rx:regexp-max-lookbehind - struct:rx:regexp - 6) - (register-struct-field-accessor! rx:regexp-anchored? struct:rx:regexp 7) - (register-struct-field-accessor! rx:regexp-must-string struct:rx:regexp 8) - (register-struct-field-accessor! rx:regexp-start-range struct:rx:regexp 9) - (void))) (define make-regexp (lambda (who_0 orig-p_0 px?_0 as-bytes?_0 handler_0) (call-with-continuation-prompt diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm index ad442ae10d..64f407580d 100644 --- a/racket/src/cs/schemified/schemify.scm +++ b/racket/src/cs/schemified/schemify.scm @@ -2028,11 +2028,6 @@ (if (impersonator? v) (known-constant?_2598 (impersonator-val v)) #f)))))) -(define effect_2956 - (begin - (register-struct-constructor! known-constant) - (register-struct-predicate! known-constant?) - (void))) (define struct:known-consistent (make-record-type-descriptor* 'known-consistent @@ -2084,11 +2079,6 @@ (if (impersonator? v) (known-consistent?_3048 (impersonator-val v)) #f)))))) -(define effect_3117 - (begin - (register-struct-constructor! known-consistent) - (register-struct-predicate! known-consistent?) - (void))) (define struct:known-authentic (make-record-type-descriptor* 'known-authentic @@ -2140,11 +2130,6 @@ (if (impersonator? v) (known-authentic?_3119 (impersonator-val v)) #f)))))) -(define effect_2588 - (begin - (register-struct-constructor! known-authentic) - (register-struct-predicate! known-authentic?) - (void))) (define struct:known-copy (make-record-type-descriptor* 'known-copy @@ -2210,12 +2195,6 @@ s 'known-copy 'id)))))) -(define effect_2902 - (begin - (register-struct-constructor! known-copy) - (register-struct-predicate! known-copy?) - (register-struct-field-accessor! known-copy-id struct:known-copy 0) - (void))) (define struct:known-literal (make-record-type-descriptor* 'known-literal @@ -2283,15 +2262,6 @@ s 'known-literal 'value)))))) -(define effect_2398 - (begin - (register-struct-constructor! known-literal) - (register-struct-predicate! known-literal?) - (register-struct-field-accessor! - known-literal-value - struct:known-literal - 0) - (void))) (define struct:known-procedure (make-record-type-descriptor* 'known-procedure @@ -2361,15 +2331,6 @@ s 'known-procedure 'arity-mask)))))) -(define effect_1399 - (begin - (register-struct-constructor! known-procedure) - (register-struct-predicate! known-procedure?) - (register-struct-field-accessor! - known-procedure-arity-mask - struct:known-procedure - 0) - (void))) (define struct:known-procedure/no-prompt (make-record-type-descriptor* 'known-procedure/no-prompt @@ -2426,11 +2387,6 @@ (if (impersonator? v) (known-procedure/no-prompt?_2036 (impersonator-val v)) #f)))))) -(define effect_2150 - (begin - (register-struct-constructor! known-procedure/no-prompt) - (register-struct-predicate! known-procedure/no-prompt?) - (void))) (define struct:known-procedure/can-inline (make-record-type-descriptor* 'known-procedure/can-inline @@ -2505,15 +2461,6 @@ s 'known-procedure/can-inline 'expr)))))) -(define effect_2594 - (begin - (register-struct-constructor! known-procedure/can-inline) - (register-struct-predicate! known-procedure/can-inline?) - (register-struct-field-accessor! - known-procedure/can-inline-expr - struct:known-procedure/can-inline - 0) - (void))) (define struct:known-procedure/can-inline/need-imports (make-record-type-descriptor* 'known-procedure/can-inline/need-imports @@ -2588,15 +2535,6 @@ s 'known-procedure/can-inline/need-imports 'needed)))))) -(define effect_2494 - (begin - (register-struct-constructor! known-procedure/can-inline/need-imports) - (register-struct-predicate! known-procedure/can-inline/need-imports?) - (register-struct-field-accessor! - known-procedure/can-inline/need-imports-needed - struct:known-procedure/can-inline/need-imports - 0) - (void))) (define struct:known-procedure/folding (make-record-type-descriptor* 'known-procedure/folding @@ -2653,11 +2591,6 @@ (if (impersonator? v) (known-procedure/folding?_2882 (impersonator-val v)) #f)))))) -(define effect_2446 - (begin - (register-struct-constructor! known-procedure/folding) - (register-struct-predicate! known-procedure/folding?) - (void))) (define struct:known-procedure/folding/limited (make-record-type-descriptor* 'known-procedure/folding/limited @@ -2732,15 +2665,6 @@ s 'known-procedure/folding/limited 'kind)))))) -(define effect_2817 - (begin - (register-struct-constructor! known-procedure/folding/limited) - (register-struct-predicate! known-procedure/folding/limited?) - (register-struct-field-accessor! - known-procedure/folding/limited-kind - struct:known-procedure/folding/limited - 0) - (void))) (define struct:known-procedure/succeeds (make-record-type-descriptor* 'known-procedure/succeeds @@ -2797,11 +2721,6 @@ (if (impersonator? v) (known-procedure/succeeds?_3041 (impersonator-val v)) #f)))))) -(define effect_2473 - (begin - (register-struct-constructor! known-procedure/succeeds) - (register-struct-predicate! known-procedure/succeeds?) - (void))) (define struct:known-procedure/pure (make-record-type-descriptor* 'known-procedure/pure @@ -2855,11 +2774,6 @@ (if (impersonator? v) (known-procedure/pure?_2240 (impersonator-val v)) #f)))))) -(define effect_2621 - (begin - (register-struct-constructor! known-procedure/pure) - (register-struct-predicate! known-procedure/pure?) - (void))) (define struct:known-procedure/pure/folding (make-record-type-descriptor* 'known-procedure/pure/folding @@ -2916,11 +2830,6 @@ (if (impersonator? v) (known-procedure/pure/folding?_2719 (impersonator-val v)) #f)))))) -(define effect_2449 - (begin - (register-struct-constructor! known-procedure/pure/folding) - (register-struct-predicate! known-procedure/pure/folding?) - (void))) (define struct:known-procedure/pure/folding-unsafe (make-record-type-descriptor* 'known-procedure/pure/folding-unsafe @@ -2995,15 +2904,6 @@ s 'known-procedure/pure/folding-unsafe 'safe)))))) -(define effect_2336 - (begin - (register-struct-constructor! known-procedure/pure/folding-unsafe) - (register-struct-predicate! known-procedure/pure/folding-unsafe?) - (register-struct-field-accessor! - known-procedure/pure/folding-unsafe-safe - struct:known-procedure/pure/folding-unsafe - 0) - (void))) (define struct:known-procedure/has-unsafe (make-record-type-descriptor* 'known-procedure/has-unsafe @@ -3078,15 +2978,6 @@ s 'known-procedure/has-unsafe 'alternate)))))) -(define effect_1976 - (begin - (register-struct-constructor! known-procedure/has-unsafe) - (register-struct-predicate! known-procedure/has-unsafe?) - (register-struct-field-accessor! - known-procedure/has-unsafe-alternate - struct:known-procedure/has-unsafe - 0) - (void))) (define struct:known-procedure/has-unsafe/folding (make-record-type-descriptor* 'known-procedure/has-unsafe/folding @@ -3143,11 +3034,6 @@ (if (impersonator? v) (known-procedure/has-unsafe/folding?_2169 (impersonator-val v)) #f)))))) -(define effect_2832 - (begin - (register-struct-constructor! known-procedure/has-unsafe/folding) - (register-struct-predicate! known-procedure/has-unsafe/folding?) - (void))) (define struct:known-procedure/has-unsafe/folding/limited (make-record-type-descriptor* 'known-procedure/has-unsafe/folding/limited @@ -3223,15 +3109,6 @@ s 'known-procedure/has-unsafe/folding/limited 'kind)))))) -(define effect_2061 - (begin - (register-struct-constructor! known-procedure/has-unsafe/folding/limited) - (register-struct-predicate! known-procedure/has-unsafe/folding/limited?) - (register-struct-field-accessor! - known-procedure/has-unsafe/folding/limited-kind - struct:known-procedure/has-unsafe/folding/limited - 0) - (void))) (define struct:known-struct-type (make-record-type-descriptor* 'known-struct-type @@ -3337,23 +3214,6 @@ s 'known-struct-type 'pure-constructor?)))))) -(define effect_2460 - (begin - (register-struct-constructor! known-struct-type) - (register-struct-predicate! known-struct-type?) - (register-struct-field-accessor! - known-struct-type-type - struct:known-struct-type - 0) - (register-struct-field-accessor! - known-struct-type-field-count - struct:known-struct-type - 1) - (register-struct-field-accessor! - known-struct-type-pure-constructor? - struct:known-struct-type - 2) - (void))) (define struct:known-constructor (make-record-type-descriptor* 'known-constructor @@ -3423,15 +3283,6 @@ s 'known-constructor 'type)))))) -(define effect_2610 - (begin - (register-struct-constructor! known-constructor) - (register-struct-predicate! known-constructor?) - (register-struct-field-accessor! - known-constructor-type - struct:known-constructor - 0) - (void))) (define struct:known-predicate (make-record-type-descriptor* 'known-predicate @@ -3499,15 +3350,6 @@ s 'known-predicate 'type)))))) -(define effect_2622 - (begin - (register-struct-constructor! known-predicate) - (register-struct-predicate! known-predicate?) - (register-struct-field-accessor! - known-predicate-type - struct:known-predicate - 0) - (void))) (define struct:known-accessor (make-record-type-descriptor* 'known-accessor @@ -3527,7 +3369,7 @@ #f 1 1)) -(define effect_2151 +(define effect_2150 (struct-type-install-properties! struct:known-accessor 'known-accessor @@ -3575,15 +3417,6 @@ s 'known-accessor 'type)))))) -(define effect_3078 - (begin - (register-struct-constructor! known-accessor) - (register-struct-predicate! known-accessor?) - (register-struct-field-accessor! - known-accessor-type - struct:known-accessor - 0) - (void))) (define struct:known-mutator (make-record-type-descriptor* 'known-mutator @@ -3651,12 +3484,80 @@ s 'known-mutator 'type)))))) -(define effect_2451 - (begin - (register-struct-constructor! known-mutator) - (register-struct-predicate! known-mutator?) - (register-struct-field-accessor! known-mutator-type struct:known-mutator 0) - (void))) +(define struct:known-struct-constructor + (make-record-type-descriptor* + 'known-struct-constructor + (if (struct-type? struct:known-constructor) + struct:known-constructor + (check-struct-type 'struct struct:known-constructor)) + (structure-type-lookup-prefab-uid + 'known-struct-constructor + (if (struct-type? struct:known-constructor) + struct:known-constructor + (check-struct-type 'struct struct:known-constructor)) + 1 + 0 + #f + '(0)) + #f + #f + 1 + 1)) +(define effect_3019 + (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 known-struct-constructor + (|#%name| + known-struct-constructor + (record-constructor + (make-record-constructor-descriptor + struct:known-struct-constructor + #f + #f)))) +(define known-struct-constructor?_2705 + (|#%name| + known-struct-constructor? + (record-predicate struct:known-struct-constructor))) +(define known-struct-constructor? + (|#%name| + known-struct-constructor? + (lambda (v) + (if (known-struct-constructor?_2705 v) + #t + ($value + (if (impersonator? v) + (known-struct-constructor?_2705 (impersonator-val v)) + #f)))))) +(define known-struct-constructor-type-id_2882 + (|#%name| + known-struct-constructor-type-id + (record-accessor struct:known-struct-constructor 0))) +(define known-struct-constructor-type-id + (|#%name| + known-struct-constructor-type-id + (lambda (s) + (if (known-struct-constructor?_2705 s) + (known-struct-constructor-type-id_2882 s) + ($value + (impersonate-ref + known-struct-constructor-type-id_2882 + struct:known-struct-constructor + 0 + s + 'known-struct-constructor + 'type-id)))))) (define struct:known-struct-predicate (make-record-type-descriptor* 'known-struct-predicate @@ -3746,19 +3647,6 @@ s 'known-struct-predicate 'authentic?)))))) -(define effect_2415 - (begin - (register-struct-constructor! known-struct-predicate) - (register-struct-predicate! known-struct-predicate?) - (register-struct-field-accessor! - known-struct-predicate-type-id - struct:known-struct-predicate - 0) - (register-struct-field-accessor! - known-struct-predicate-authentic? - struct:known-struct-predicate - 1) - (void))) (define struct:known-field-accessor (make-record-type-descriptor* 'known-field-accessor @@ -3848,19 +3736,6 @@ s 'known-field-accessor 'pos)))))) -(define effect_2652 - (begin - (register-struct-constructor! known-field-accessor) - (register-struct-predicate! known-field-accessor?) - (register-struct-field-accessor! - known-field-accessor-type-id - struct:known-field-accessor - 0) - (register-struct-field-accessor! - known-field-accessor-pos - struct:known-field-accessor - 1) - (void))) (define struct:known-field-mutator (make-record-type-descriptor* 'known-field-mutator @@ -3950,19 +3825,80 @@ s 'known-field-mutator 'pos)))))) -(define effect_2676 - (begin - (register-struct-constructor! known-field-mutator) - (register-struct-predicate! known-field-mutator?) - (register-struct-field-accessor! - known-field-mutator-type-id - struct:known-field-mutator - 0) - (register-struct-field-accessor! - known-field-mutator-pos - struct:known-field-mutator - 1) - (void))) +(define struct:known-struct-constructor/need-imports + (make-record-type-descriptor* + 'known-struct-constructor/need-imports + (if (struct-type? struct:known-struct-constructor) + struct:known-struct-constructor + (check-struct-type 'struct struct:known-struct-constructor)) + (structure-type-lookup-prefab-uid + 'known-struct-constructor/need-imports + (if (struct-type? struct:known-struct-constructor) + struct:known-struct-constructor + (check-struct-type 'struct struct:known-struct-constructor)) + 1 + 0 + #f + '(0)) + #f + #f + 1 + 1)) +(define effect_2765 + (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 known-struct-constructor/need-imports + (|#%name| + known-struct-constructor/need-imports + (record-constructor + (make-record-constructor-descriptor + struct:known-struct-constructor/need-imports + #f + #f)))) +(define known-struct-constructor/need-imports?_2300 + (|#%name| + known-struct-constructor/need-imports? + (record-predicate struct:known-struct-constructor/need-imports))) +(define known-struct-constructor/need-imports? + (|#%name| + known-struct-constructor/need-imports? + (lambda (v) + (if (known-struct-constructor/need-imports?_2300 v) + #t + ($value + (if (impersonator? v) + (known-struct-constructor/need-imports?_2300 (impersonator-val v)) + #f)))))) +(define known-struct-constructor/need-imports-needed_2757 + (|#%name| + known-struct-constructor/need-imports-needed + (record-accessor struct:known-struct-constructor/need-imports 0))) +(define known-struct-constructor/need-imports-needed + (|#%name| + known-struct-constructor/need-imports-needed + (lambda (s) + (if (known-struct-constructor/need-imports?_2300 s) + (known-struct-constructor/need-imports-needed_2757 s) + ($value + (impersonate-ref + known-struct-constructor/need-imports-needed_2757 + struct:known-struct-constructor/need-imports + 0 + s + 'known-struct-constructor/need-imports + 'needed)))))) (define struct:known-struct-predicate/need-imports (make-record-type-descriptor* 'known-struct-predicate/need-imports @@ -4037,15 +3973,6 @@ s 'known-struct-predicate/need-imports 'needed)))))) -(define effect_1651 - (begin - (register-struct-constructor! known-struct-predicate/need-imports) - (register-struct-predicate! known-struct-predicate/need-imports?) - (register-struct-field-accessor! - known-struct-predicate/need-imports-needed - struct:known-struct-predicate/need-imports - 0) - (void))) (define struct:known-field-accessor/need-imports (make-record-type-descriptor* 'known-field-accessor/need-imports @@ -4120,15 +4047,6 @@ s 'known-field-accessor/need-imports 'needed)))))) -(define effect_2889 - (begin - (register-struct-constructor! known-field-accessor/need-imports) - (register-struct-predicate! known-field-accessor/need-imports?) - (register-struct-field-accessor! - known-field-accessor/need-imports-needed - struct:known-field-accessor/need-imports - 0) - (void))) (define struct:known-field-mutator/need-imports (make-record-type-descriptor* 'known-field-mutator/need-imports @@ -4203,15 +4121,6 @@ s 'known-field-mutator/need-imports 'needed)))))) -(define effect_2411 - (begin - (register-struct-constructor! known-field-mutator/need-imports) - (register-struct-predicate! known-field-mutator/need-imports?) - (register-struct-field-accessor! - known-field-mutator/need-imports-needed - struct:known-field-mutator/need-imports - 0) - (void))) (define struct:known-struct-type-property/immediate-guard (make-record-type-descriptor* 'known-struct-type-property/immediate-guard @@ -4263,11 +4172,6 @@ (known-struct-type-property/immediate-guard?_2536 (impersonator-val v)) #f)))))) -(define effect_1742 - (begin - (register-struct-constructor! known-struct-type-property/immediate-guard) - (register-struct-predicate! known-struct-type-property/immediate-guard?) - (void))) (define a-known-constant (known-constant)) (define a-known-consistent (known-consistent)) (define gensym-counter (make-parameter #f)) @@ -4364,15 +4268,6 @@ s 'import 'ext-id)))))) -(define effect_2322 - (begin - (register-struct-constructor! import1.1) - (register-struct-predicate! import?) - (register-struct-field-accessor! import-grp struct:import 0) - (register-struct-field-accessor! import-id struct:import 1) - (register-struct-field-accessor! import-int-id struct:import 2) - (register-struct-field-accessor! import-ext-id struct:import 3) - (void))) (define struct:import-group (make-record-type-descriptor* 'import-group #f #f #f #f 6 60)) (define effect_2514 @@ -4579,45 +4474,6 @@ v 'import-group 'imports)))))) -(define effect_2905 - (begin - (register-struct-constructor! import-group2.1) - (register-struct-predicate! import-group?) - (register-struct-field-accessor! import-group-index struct:import-group 0) - (register-struct-field-accessor! import-group-key struct:import-group 1) - (register-struct-field-accessor! - import-group-knowns/proc - struct:import-group - 2) - (register-struct-field-accessor! - import-group-converter - struct:import-group - 3) - (register-struct-field-accessor! - import-group-import-keys - struct:import-group - 4) - (register-struct-field-accessor! - import-group-imports - struct:import-group - 5) - (register-struct-field-mutator! - set-import-group-knowns/proc! - struct:import-group - 2) - (register-struct-field-mutator! - set-import-group-converter! - struct:import-group - 3) - (register-struct-field-mutator! - set-import-group-import-keys! - struct:import-group - 4) - (register-struct-field-mutator! - set-import-group-imports! - struct:import-group - 5) - (void))) (define import-group-knowns (lambda (grp_0) (let ((knowns/proc_0 (import-group-knowns/proc grp_0))) @@ -4828,13 +4684,6 @@ s 'export 'ext-id)))))) -(define effect_2433 - (begin - (register-struct-constructor! export1.1) - (register-struct-predicate! export?) - (register-struct-field-accessor! export-id struct:export 0) - (register-struct-field-accessor! export-ext-id struct:export 1) - (void))) (define struct:too-early (make-record-type-descriptor* 'too-early #f #f #f #f 2 0)) (define effect_2681 @@ -4897,13 +4746,6 @@ s 'too-early 'set!ed?)))))) -(define effect_2623 - (begin - (register-struct-constructor! too-early1.1) - (register-struct-predicate! too-early?) - (register-struct-field-accessor! too-early-name struct:too-early 0) - (register-struct-field-accessor! too-early-set!ed? struct:too-early 1) - (void))) (define delayed-mutated-state? (lambda (v_0) (procedure? v_0))) (define simple-mutated-state? (lambda (v_0) @@ -7148,51 +6990,6 @@ s 'struct-type-info 'rest)))))) -(define effect_1914 - (begin - (register-struct-constructor! struct-type-info1.1) - (register-struct-predicate! struct-type-info?) - (register-struct-field-accessor! - struct-type-info-name - struct:struct-type-info - 0) - (register-struct-field-accessor! - struct-type-info-parent - struct:struct-type-info - 1) - (register-struct-field-accessor! - struct-type-info-immediate-field-count - struct:struct-type-info - 2) - (register-struct-field-accessor! - struct-type-info-field-count - struct:struct-type-info - 3) - (register-struct-field-accessor! - struct-type-info-pure-constructor? - struct:struct-type-info - 4) - (register-struct-field-accessor! - struct-type-info-authentic? - struct:struct-type-info - 5) - (register-struct-field-accessor! - struct-type-info-prefab-immutables - struct:struct-type-info - 6) - (register-struct-field-accessor! - struct-type-info-non-prefab-immutables - struct:struct-type-info - 7) - (register-struct-field-accessor! - struct-type-info-constructor-name-expr - struct:struct-type-info - 8) - (register-struct-field-accessor! - struct-type-info-rest - struct:struct-type-info - 9) - (void))) (define struct-type-info-rest-properties-list-pos 0) (define make-struct-type-info (letrec ((handle-proc-spec_0 @@ -10973,34 +10770,41 @@ (define inline-type-id (lambda (k_0 im_0 add-import!_0 mutated_0 imports_0) (let ((type-id_0 - (if (known-struct-predicate? k_0) - (known-struct-predicate-type-id k_0) - (if (known-field-accessor? k_0) - (known-field-accessor-type-id k_0) - (if (known-field-mutator? k_0) - (known-field-mutator-type-id k_0) - #f))))) + (if (known-struct-constructor? k_0) + (known-struct-constructor-type-id k_0) + (if (known-struct-predicate? k_0) + (known-struct-predicate-type-id k_0) + (if (known-field-accessor? k_0) + (known-field-accessor-type-id k_0) + (if (known-field-mutator? k_0) + (known-field-mutator-type-id k_0) + #f)))))) (let ((env_0 (if (not type-id_0) #f (if (not im_0) '() - (if (known-struct-predicate/need-imports? k_0) + (if (known-struct-constructor/need-imports? k_0) (needed->env - (known-struct-predicate/need-imports-needed k_0) + (known-struct-constructor/need-imports-needed k_0) add-import!_0 im_0) - (if (known-field-accessor/need-imports? k_0) + (if (known-struct-predicate/need-imports? k_0) (needed->env - (known-field-accessor/need-imports-needed k_0) + (known-struct-predicate/need-imports-needed k_0) add-import!_0 im_0) - (if (known-field-mutator/need-imports? k_0) + (if (known-field-accessor/need-imports? k_0) (needed->env - (known-field-mutator/need-imports-needed k_0) + (known-field-accessor/need-imports-needed k_0) add-import!_0 im_0) - '()))))))) + (if (known-field-mutator/need-imports? k_0) + (needed->env + (known-field-mutator/need-imports-needed k_0) + add-import!_0 + im_0) + '())))))))) (if env_0 (if (null? env_0) type-id_0 (clone-expr type-id_0 env_0 mutated_0)) #f))))) @@ -11769,10 +11573,10 @@ app_0 app_1 (begin-unsafe (hash-map needed_0 cons #t))))))))) - (if (known-struct-predicate? k_0) + (if (known-struct-constructor? k_0) (let ((needed_0 (needed-imports - (known-struct-predicate-type-id k_0) + (known-struct-constructor-type-id k_0) prim-knowns_0 imports_0 exports_0 @@ -11780,21 +11584,19 @@ hash2610))) (if needed_0 (let ((app_0 (known-procedure-arity-mask k_0))) - (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_1 (known-constructor-type k_0))) + (let ((app_2 (known-struct-constructor-type-id k_0))) + (known-struct-constructor/need-imports + app_0 + app_1 + app_2 + (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) + (known-constructor app_0 (known-constructor-type k_0))))) + (if (known-struct-predicate? k_0) (let ((needed_0 (needed-imports - (known-field-accessor-type-id k_0) + (known-struct-predicate-type-id k_0) prim-knowns_0 imports_0 exports_0 @@ -11802,21 +11604,21 @@ hash2610))) (if needed_0 (let ((app_0 (known-procedure-arity-mask k_0))) - (let ((app_1 (known-accessor-type k_0))) - (let ((app_2 (known-field-accessor-type-id k_0))) - (let ((app_3 (known-field-accessor-pos k_0))) - (known-field-accessor/need-imports + (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_0 (known-procedure-arity-mask k_0))) - (known-accessor app_0 (known-accessor-type k_0))))) - (if (known-field-mutator? k_0) + (known-predicate app_0 (known-predicate-type k_0))))) + (if (known-field-accessor? k_0) (let ((needed_0 (needed-imports - (known-field-mutator-type-id k_0) + (known-field-accessor-type-id k_0) prim-knowns_0 imports_0 exports_0 @@ -11824,18 +11626,40 @@ hash2610))) (if needed_0 (let ((app_0 (known-procedure-arity-mask k_0))) - (let ((app_1 (known-mutator-type k_0))) - (let ((app_2 (known-field-mutator-type-id k_0))) - (let ((app_3 (known-field-mutator-pos k_0))) - (known-field-mutator/need-imports + (let ((app_1 (known-accessor-type k_0))) + (let ((app_2 (known-field-accessor-type-id k_0))) + (let ((app_3 (known-field-accessor-pos k_0))) + (known-field-accessor/need-imports app_0 app_1 app_2 app_3 (begin-unsafe (hash-map needed_0 cons #t))))))) (let ((app_0 (known-procedure-arity-mask k_0))) - (known-mutator app_0 (known-mutator-type k_0))))) - k_0)))))) + (known-accessor app_0 (known-accessor-type k_0))))) + (if (known-field-mutator? k_0) + (let ((needed_0 + (needed-imports + (known-field-mutator-type-id k_0) + prim-knowns_0 + imports_0 + exports_0 + '() + hash2610))) + (if needed_0 + (let ((app_0 (known-procedure-arity-mask k_0))) + (let ((app_1 (known-mutator-type k_0))) + (let ((app_2 (known-field-mutator-type-id k_0))) + (let ((app_3 (known-field-mutator-pos k_0))) + (known-field-mutator/need-imports + app_0 + app_1 + app_2 + app_3 + (begin-unsafe (hash-map needed_0 cons #t))))))) + (let ((app_0 (known-procedure-arity-mask k_0))) + (known-mutator app_0 (known-mutator-type k_0))))) + k_0))))))) (define needed-imports (lambda (v_0 prim-knowns_0 imports_0 exports_0 env_0 needed_0) (if needed_0 @@ -12606,7 +12430,7 @@ mutated13_0 simples14_0 unsafe-mode?15_0 - for-cify?16_0) + target16_0) (begin (letrec* ((loop_0 @@ -12643,7 +12467,9 @@ lam_0))) (known-procedure/can-inline arity-mask_0 - (if (if unsafe-mode?15_0 (not for-cify?16_0) #f) + (if (if unsafe-mode?15_0 + (not (eq? target16_0 'cify)) + #f) (add-begin-unsafe lam_1) lam_1))) (known-procedure arity-mask_0)))) @@ -12684,7 +12510,27 @@ (if (let ((or-part_0 (not defn8_0))) (if or-part_0 or-part_0 - (known-copy? c2_0))) + (let ((or-part_1 + (known-copy? c2_0))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (known-struct-constructor/need-imports? + c2_0))) + (if or-part_2 + or-part_2 + (let ((or-part_3 + (known-struct-predicate/need-imports? + c2_0))) + (if or-part_3 + or-part_3 + (let ((or-part_4 + (known-field-accessor/need-imports? + c2_0))) + (if or-part_4 + or-part_4 + (known-field-mutator/need-imports? + c2_0))))))))))) (known-copy rhs_0) c2_0))) (if defn8_0 @@ -13861,7 +13707,7 @@ mutated9_0 simples10_0 unsafe-mode?11_0 - for-cify?12_0) + target12_0) (begin (let ((hd_0 (let ((p_0 (unwrap v5_0))) @@ -13927,7 +13773,7 @@ mutated9_0 simples10_0 unsafe-mode?11_0 - for-cify?12_0))) + target12_0))) (if k_0 (hash-set knowns7_0 (unwrap id_0) k_0) knowns7_0)) #f))) (args (raise-binding-result-arity-error 2 args)))) @@ -14521,11 +14367,12 @@ knowns7_0 app_0 (if (struct-type-info-pure-constructor? info_0) - (known-constructor + (known-struct-constructor (arithmetic-shift 1 (struct-type-info-field-count info_0)) - type_0) + type_0 + struct:s_0) a-known-constant))))) (let ((knowns_1 (let ((app_0 (unwrap s?_0))) @@ -15287,7 +15134,7 @@ mutated9_0 simples10_0 unsafe-mode?11_0 - for-cify?12_0))) + target12_0))) (case-lambda ((new-knowns_0 info_0) @@ -15318,8 +15165,10 @@ prim-knowns_0 knowns_0 imports_0 + exports_0 mutated_0 schemify_0 + target_0 no-prompt?_0) (let ((hd_0 (let ((p_0 (unwrap form_0))) @@ -16349,718 +16198,539 @@ (if can-impersonate?_0 (deterministic-gensym (unwrap s?_0)) s?_0))) - (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)) - #f - (let ((app_2 + (let ((system-opaque?_0 + (if (eq? target_0 'system) + (let ((or-part_0 (not exports_0))) + (if or-part_0 + or-part_0 + (eq? + 'no + (hash-ref + exports_0 + (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)) + #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)))))))))))) + (list* + 'begin + app_0 + (let ((app_1 + (if (null? (struct-type-info-rest sti_0)) + null + (list + (let ((app_1 + (deterministic-gensym "effect"))) + (list + 'define + app_1 + (let ((app_2 + (list + 'quote + (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 + (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 ((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)))))))))))) - (list* - 'begin - app_0 - (let ((app_1 - (if (null? (struct-type-info-rest sti_0)) - null - (list - (let ((app_1 (deterministic-gensym "effect"))) - (list - 'define - app_1 - (let ((app_2 - (list - 'quote - (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 - (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))) - (if (begin-unsafe - (let ((app_2 (unwrap #f))) - (eq? - app_2 - (unwrap name-expr_0)))) - (wrap-property-set - ctr-expr_0 - 'inferred-name - (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 (cdr p_1))) - (begin-unsafe - (let ((app_2 + 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 + (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 + (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 - '()))) - (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) - (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))))))))) - (let ((app_3 - (list - 'define - raw-s?_0 - (let ((pre_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)))))))))))))) - (list* - app_2 - app_3 - (let ((app_4 - (if can-impersonate?_0 - (list - (list - 'define - s?_0 - (let ((pre_0 "")) - (let ((st_0 - (struct-type-info-name - sti_0))) - (let ((sep_0 "")) - (let ((post_0 "?")) - (let ((proc-expr_0 + 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 - '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_4 - (symbol->string - st_1))) - (string-append - pre_1 - app_4 - sep_1 - (symbol->string '||) - post_1))))))))))))) - null))) - (qq-append - app_4 - (let ((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 - acc/mut_0)) - acc/mut_0))) - (let ((hd_1 - (let ((p_0 - (unwrap - make-acc/mut_0))) - (if (pair? - p_0) + '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 + (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_4 + (symbol->string + st_1))) + (string-append + pre_1 + app_4 + sep_1 + (symbol->string + '||) + post_1)))))))))))) + (if 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 + (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 - (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 + make-acc/mut_0)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (let ((a_1 (cdr - (unwrap - d_0)))) - (let ((p_0 + p_0))) + (let ((p_1 (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 + 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_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 ((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 can-impersonate?_0 - (list - 'begin - raw-def_0 - (list - 'define - acc/mut_0 - (let ((pre_0 - "")) - (let ((st_0 - (struct-type-info-name - sti_0))) - (let ((sep_0 - "-")) - (let ((post_0 - "")) - (let ((proc-expr_0 - (list - 'lambda - '(s) - (list - 'if - (list* - raw-s?_0 - '(s)) - (list* - raw-acc/mut_0 - '(s)) - (list - '$value - (list - 'impersonate-ref - raw-acc/mut_0 - struct:s_0 - pos_0 - 's - (list - 'quote - (struct-type-info-name - sti_0)) - (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))))))))))))) - 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 + 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_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 + 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 - 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 - "set-")) + '()))) + (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-mutator + 'record-accessor struct:s_0 pos_0))) (let ((post_1 @@ -17085,300 +16755,381 @@ sep_1 (symbol->string field-name_0) - post_1)))))))))))))) - (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 + post_1)))))))))))) + (if (if can-impersonate?_0 + can-impersonate?_0 + system-opaque?_0) + p_0 (list - 'define - acc/mut_0 - (let ((pre_0 - "set-")) - (let ((st_0 - (struct-type-info-name - sti_0))) - (let ((sep_0 - "-")) - (let ((post_0 - "!")) - (let ((proc-expr_0 + '|#%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) + (list + 'if + (list* + raw-s?_0 + '(s)) + (list* + raw-acc/mut_0 + '(s)) (list - 'lambda - '(s - v) + '$value (list - 'if - (list* - raw-s?_0 - '(s)) - (list* - raw-acc/mut_0 - '(s - v)) + 'impersonate-ref + raw-acc/mut_0 + struct:s_0 + pos_0 + 's (list - '$value - (list - 'impersonate-set! - raw-acc/mut_0 - struct:s_0 - pos_0 - abs-pos_0 - 's - 'v - (list - 'quote - (struct-type-info-name - sti_0)) - (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))))))))))))) - 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)))))) - (qq-append - app_5 - (list - (let ((app_6 - (deterministic-gensym "effect"))) - (list - 'define - app_6 - (list* - 'begin - (list - 'register-struct-constructor! - make-s_0) - (list - 'register-struct-predicate! - s?_0) - (qq-append - (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 ((hd_1 + 'quote + (struct-type-info-name + sti_0)) + (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 - make-acc/mut_0))) + a_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) - (let ((a_3 - (cdr - p_2))) - (begin-unsafe - (let ((app_7 - (unwrap - '()))) - (eq? - app_7 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (let ((pos_0 - (let ((d_0 + (let ((a_1 (cdr - (unwrap - make-acc/mut_0)))) - (let ((d_1 - (cdr - (unwrap - d_0)))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0))))) - (list - 'register-struct-field-accessor! - acc/mut_0 - struct:s_0 - pos_0)) - (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 + 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_2))) - (if (pair? - p_2) - (let ((a_3 - (cdr - p_2))) - (begin-unsafe - (let ((app_7 - (unwrap - '()))) - (eq? - app_7 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (let ((pos_0 - (let ((d_0 - (cdr - (unwrap - make-acc/mut_0)))) - (let ((d_1 - (cdr - (unwrap - d_0)))) + 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_1)))) - a_0))))) - (list - 'register-struct-field-mutator! - acc/mut_0 - struct:s_0 - pos_0)) - (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)))) - '((void)))))))))))))))))))) + 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 + '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 + (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) + (list + 'if + (list* + raw-s?_0 + '(s)) + (list* + raw-acc/mut_0 + '(s + v)) + (list + '$value + (list + 'impersonate-set! + raw-acc/mut_0 + struct:s_0 + pos_0 + abs-pos_0 + 's + 'v + (list + 'quote + (struct-type-info-name + sti_0)) + (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)))))))))))))))) #f))) (args (raise-binding-result-arity-error 14 args)))) #f)))) @@ -17583,8 +17334,8 @@ (error 'match "failed ~e" new-seq_0))))))))) (|#%name| struct-convert-local - (lambda (for-cify?3_0 - letrec?1_0 + (lambda (letrec?1_0 + target3_0 unsafe-mode?2_0 form7_0 prim-knowns8_0 @@ -17655,8 +17406,10 @@ prim-knowns8_0 knowns9_0 imports10_0 + #f mutated11_0 schemify13_0 + target3_0 #t))) (if new-seq_0 (let ((hd_0 @@ -17677,7 +17430,7 @@ mutated11_0 simples12_0 unsafe-mode?2_0 - for-cify?3_0)) + target3_0)) (case-lambda ((new-knowns_0 info_0) (if letrec?1_0 @@ -17918,9 +17671,9 @@ or-part_0 (loop_0 mutated_0 (cdr ids_0)))) #f)))))))) - (lambda (ids_0 mutated_0 for-cify?_0 e_0) + (lambda (ids_0 mutated_0 target_0 e_0) (let ((need-convert?_0 - (if (not for-cify?_0) (loop_0 mutated_0 ids_0) #f))) + (if (not (eq? target_0 'cify)) (loop_0 mutated_0 ids_0) #f))) (if need-convert?_0 (if (let ((p_0 (unwrap e_0))) (if (pair? p_0) @@ -18157,7 +17910,7 @@ imports_0 simples_0 unsafe-mode?_0 - for-cify?_0 + target_0 enforce-constant?_0) (let ((mutated_0 (make-hasheq))) (begin @@ -18280,7 +18033,7 @@ mutated_0 simples_0 unsafe-mode?_0 - for-cify?_0)) + target_0)) (case-lambda ((knowns_1 info_0) (begin @@ -20364,7 +20117,7 @@ (letrec ((loop_0 (|#%name| loop - (lambda (bodys_0 for-cify?_0 idss_0 rhss_0 binds_0) + (lambda (bodys_0 target_0 idss_0 rhss_0 binds_0) (begin (if (null? (cdr rhss_0)) (let ((app_0 (car idss_0))) @@ -20372,7 +20125,7 @@ app_0 (car rhss_0) (list* 'let binds_0 bodys_0) - for-cify?_0)) + target_0)) (let ((ids_0 (car idss_0))) (let ((app_0 (car rhss_0))) (make-let-values @@ -20382,7 +20135,7 @@ (let ((app_2 (cdr rhss_0))) (loop_0 bodys_0 - for-cify?_0 + target_0 app_1 app_2 (append @@ -20421,16 +20174,16 @@ fold-var_0)))))) (for-loop_0 null ids_0)))) binds_0)))) - for-cify?_0))))))))) - (lambda (idss_0 rhss_0 bodys_0 mutated_0 for-cify?_0) + target_0))))))))) + (lambda (idss_0 rhss_0 bodys_0 mutated_0 target_0) (if (null? (cdr idss_0)) (let ((e_0 (if (null? (cdr bodys_0)) (car bodys_0) (list* 'begin bodys_0)))) (let ((app_0 (car idss_0))) - (make-let-values app_0 (car rhss_0) e_0 for-cify?_0))) - (loop_0 bodys_0 for-cify?_0 idss_0 rhss_0 null))))) + (make-let-values app_0 (car rhss_0) e_0 target_0))) + (loop_0 bodys_0 target_0 idss_0 rhss_0 null))))) (define left-to-right/app (letrec ((loop_0 (|#%name| @@ -20525,13 +20278,13 @@ (lambda (rator_0 rands_0 plain-app?_0 - for-cify?_0 + target_0 prim-knowns_0 knowns_0 imports_0 mutated_0 simples_0) - (if for-cify?_0 + (if (eq? target_0 'cify) (cons rator_0 rands_0) (loop_0 imports_0 @@ -20545,7 +20298,7 @@ #f #f))))) (define make-let-values - (lambda (ids_0 rhs_0 body_0 for-cify?_0) + (lambda (ids_0 rhs_0 body_0 target_0) (if (if (pair? ids_0) (null? (cdr ids_0)) #f) (list 'let (list (list (car ids_0) rhs_0)) body_0) (let ((v_0 (if (null? ids_0) rhs_0 #f))) @@ -20584,7 +20337,7 @@ (let ((d_0 (cdr (unwrap v_0)))) (let ((a_0 (car (unwrap d_0)))) a_0)))) (list 'begin rhs_1 body_0)) - (if for-cify?_0 + (if (eq? target_0 'cify) (list 'call-with-values (list 'lambda '() rhs_0) @@ -21840,7 +21593,7 @@ (lambda (lk_0 serializable?-box_0 datum-intern?_0 - for-interp?_0 + target_0 allow-set!-undefined?_0 unsafe-mode?_0 enforce-constant?_0 @@ -22051,10 +21804,9 @@ exports_0 serializable?-box_0 datum-intern?_0 - for-interp?_0 allow-set!-undefined?_0 add-import!_0 - #f + target_0 unsafe-mode?_0 enforce-constant?_0 allow-inline?_0 @@ -22488,7 +22240,7 @@ primitives_0 imports_0 exports_0 - for-cify?_0 + target_0 unsafe-mode?_0 no-prompt?_0 explicit-unnamed?_0) @@ -22510,9 +22262,8 @@ #f #f #f - #f procz1 - for-cify?_0 + target_0 unsafe-mode?_0 #t #t @@ -22579,8 +22330,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -22592,6 +22341,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 knowns16_0 next-k18_0 @@ -22700,7 +22450,7 @@ mutated_0 simples_0 unsafe-mode?_0 - for-cify?_0)) + target_0)) (args (raise-binding-result-arity-error 2 @@ -22714,10 +22464,7 @@ knowns_1))) knowns_1))) (let ((app_0 - (make-expr-defns_0 - for-cify?_0 - for-interp?_0 - accum-exprs_1))) + (make-expr-defns_0 target_0 accum-exprs_1))) (append app_0 (cons @@ -22744,8 +22491,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -22753,6 +22498,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (cdr l_0) mut-l_0 @@ -22760,16 +22506,18 @@ accum-ids_2 next-knowns_0)) (if (let ((or-part_0 - (if for-interp?_0 - for-interp?_0 - for-cify?_0))) - (if or-part_0 - or-part_0 - (via-variable-mutated-state? - (hash-ref - mutated_0 - (unwrap (car ids_0)) - #f)))) + (eq? target_0 'interp))) + (let ((or-part_1 + (if or-part_0 + or-part_0 + (eq? target_0 'cify)))) + (if or-part_1 + or-part_1 + (via-variable-mutated-state? + (hash-ref + mutated_0 + (unwrap (car ids_0)) + #f))))) (let ((id_0 (unwrap (car ids_0)))) (if (hash-ref exports_0 id_0 #f) (let ((app_1 (cdr ids_0))) @@ -22811,8 +22559,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -22824,26 +22570,21 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 ids_0 rhs_0) (begin - (let ((app_0 - (make-expr-defns_0 - for-cify?_0 - for-interp?_0 - accum-exprs_0))) + (let ((app_0 (make-expr-defns_0 target_0 accum-exprs_0))) (let ((app_1 (make-expr-defns_0 - for-cify?_0 - for-interp?_0 + target_0 (make-set-variables_0 accum-ids_0 exports_0 - for-cify?_0 - for-interp?_0 knowns_0 - mutated_0)))) + mutated_0 + target_0)))) (append app_0 app_1 @@ -22860,8 +22601,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -22869,6 +22608,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 app_2 mut-l_0 @@ -22975,7 +22715,7 @@ fold-var_0)))))) (for-loop_0 null ids_0)))))) (let ((app_2 - (if for-interp?_0 + (if (eq? target_0 'interp) expr_0 (make-expr-defn expr_0)))) (cons @@ -22991,8 +22731,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -23000,6 +22738,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (cdr l_0) mut-l_0 @@ -23017,8 +22756,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -23026,6 +22763,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 l_0 in-mut-l_0 @@ -23042,10 +22780,9 @@ (make-set-variables_0 accum-ids_0 exports_0 - for-cify?_0 - for-interp?_0 knowns_0 - mutated_0))) + mutated_0 + target_0))) (if (null? set-vars_0) (if (null? accum-exprs_0) '((void)) @@ -23066,8 +22803,7 @@ add-import!_0 serializable?-box_0 datum-intern?_0 - for-cify?_0 - for-interp?_0 + target_0 unsafe-mode?_0 allow-inline?_0 no-prompt?_0 @@ -23126,8 +22862,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -23139,6 +22873,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 unsafe-undefined #f @@ -23157,8 +22892,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -23170,6 +22903,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (list id_0) rhs_0))) @@ -23283,8 +23017,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -23296,6 +23028,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 ids_0 rhss_0 @@ -23313,8 +23046,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -23326,6 +23057,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 unsafe-undefined #f @@ -23344,8 +23076,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -23357,6 +23087,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 unsafe-undefined #f @@ -23375,8 +23106,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -23388,6 +23117,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 ids_0 rhs_0))) @@ -23418,8 +23148,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -23427,6 +23155,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (cdr l_0) mut-l_0 @@ -23463,10 +23192,9 @@ (make-set-variables_0 accum-ids_0 exports_0 - for-cify?_0 - for-interp?_0 knowns_0 - mutated_0))) + mutated_0 + target_0))) (let ((temp68_0 (append set-vars_0 @@ -23482,8 +23210,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -23495,6 +23221,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 unsafe-undefined #f @@ -23520,8 +23247,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -23529,6 +23254,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (cdr l_0) mut-l_0 @@ -23539,10 +23265,9 @@ (make-set-variables_0 accum-ids_0 exports_0 - for-cify?_0 - for-interp?_0 knowns_0 - mutated_0))) + mutated_0 + target_0))) (let ((expr_0 (if no-prompt?_0 schemified_0 @@ -23562,8 +23287,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -23571,6 +23294,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 app_0 mut-l_0 @@ -23639,9 +23363,10 @@ (make-expr-defns_0 (|#%name| make-expr-defns - (lambda (for-cify?_0 for-interp?_0 es_0) + (lambda (target_0 es_0) (begin - (if (if for-interp?_0 for-interp?_0 for-cify?_0) + (if (let ((or-part_0 (eq? target_0 'cify))) + (if or-part_0 or-part_0 (eq? target_0 'interp))) (reverse$1 es_0) (reverse$1 (let ((lst_0 (reverse$1 es_0))) @@ -23667,14 +23392,10 @@ (make-set-variables_0 (|#%name| make-set-variables - (lambda (accum-ids_0 - exports_0 - for-cify?_0 - for-interp?_0 - knowns_0 - mutated_0) + (lambda (accum-ids_0 exports_0 knowns_0 mutated_0 target_0) (begin - (if (if for-cify?_0 for-cify?_0 for-interp?_0) + (if (let ((or-part_0 (eq? target_0 'cify))) + (if or-part_0 or-part_0 (eq? target_0 'interp))) (reverse$1 (begin (letrec* @@ -23718,8 +23439,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -23731,6 +23450,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 ids_0 rhss_0 @@ -23748,8 +23468,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -23757,6 +23475,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (cdr l_0) mut-l_0 @@ -23781,8 +23500,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -23794,6 +23511,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 app_0 (cdr rhss_0) @@ -23811,8 +23529,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 l_0 @@ -23824,6 +23540,7 @@ schemified_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 knowns_1 temp64_0 @@ -23838,10 +23555,9 @@ exports_0 serializable?-box_0 datum-intern?_0 - for-interp?_0 allow-set!-undefined?_0 add-import!_0 - for-cify?_0 + target_0 unsafe-mode?_0 enforce-constant?_0 allow-inline?_0 @@ -23857,7 +23573,7 @@ imports_0 simples_0 unsafe-mode?_0 - for-cify?_0 + target_0 enforce-constant?_0))) (let ((knowns_0 (begin @@ -23884,7 +23600,7 @@ mutated_0 simples_0 unsafe-mode?_0 - for-cify?_0)) + target_0)) (case-lambda ((new-knowns_0 info_0) new-knowns_0) @@ -23908,8 +23624,6 @@ exports_0 extra-variables_0 final-knowns_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -23917,6 +23631,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 l_0 l_0 @@ -24045,8 +23760,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24056,6 +23769,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 k_0 s-rator_0 @@ -24063,16 +23777,14 @@ args_0) (begin (let ((type-id_0 - (if (if im_0 im_0 for-interp?_0) - (if (pair? args_0) - (if (null? (cdr args_0)) - (inline-type-id - k_0 - im_0 - add-import!_0 - mutated_0 - imports_0) - #f) + (if (pair? args_0) + (if (null? (cdr args_0)) + (inline-type-id + k_0 + im_0 + add-import!_0 + mutated_0 + imports_0) #f) #f))) (if type-id_0 @@ -24085,39 +23797,43 @@ (car args_0) 'v))) (let ((sel_0 - (let ((app_0 - (list - 'unsafe-struct? - tmp_0 - (schemify_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - for-cify?_0 - for-interp?_0 - imports_0 - inline-fuel_0 - knowns_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - unsafe-mode?_0 - type-id_0 - 'fresh)))) + (if unsafe-mode?_0 (list - 'if - app_0 - (list - 'unsafe-struct*-ref - tmp_0 - (known-field-accessor-pos k_0)) - (list s-rator_0 tmp_0))))) + 'unsafe-struct*-ref + tmp_0 + (known-field-accessor-pos k_0)) + (let ((app_0 + (list + 'unsafe-struct? + tmp_0 + (schemify_0 + add-import!_0 + allow-inline?_0 + allow-set!-undefined?_0 + datum-intern?_0 + explicit-unnamed?_0 + exports_0 + imports_0 + inline-fuel_0 + knowns_0 + mutated_0 + no-prompt?_0 + prim-knowns_0 + primitives_0 + serializable?-box_0 + simples_0 + target_0 + unsafe-mode?_0 + type-id_0 + 'fresh)))) + (list + 'if + app_0 + (list + 'unsafe-struct*-ref + tmp_0 + (known-field-accessor-pos k_0)) + (list s-rator_0 tmp_0)))))) (wrap-tmp_0 tmp_0 (car args_0) sel_0))) #f)))))) (inline-field-mutate_0 @@ -24129,8 +23845,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24140,6 +23854,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 k_0 s-rator_0 @@ -24147,17 +23862,15 @@ args_0) (begin (let ((type-id_0 - (if (if im_0 im_0 for-interp?_0) - (if (pair? args_0) - (if (pair? (cdr args_0)) - (if (null? (cddr args_0)) - (inline-type-id - k_0 - im_0 - add-import!_0 - mutated_0 - imports_0) - #f) + (if (pair? args_0) + (if (pair? (cdr args_0)) + (if (null? (cddr args_0)) + (inline-type-id + k_0 + im_0 + add-import!_0 + mutated_0 + imports_0) #f) #f) #f))) @@ -24179,40 +23892,45 @@ (cadr args_0) 'rhs))) (let ((mut_0 - (let ((app_0 - (list - 'unsafe-struct? - tmp_0 - (schemify_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - for-cify?_0 - for-interp?_0 - imports_0 - inline-fuel_0 - knowns_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - unsafe-mode?_0 - type-id_0 - 'fresh)))) + (if unsafe-mode?_0 (list - 'if - app_0 - (list - 'unsafe-struct*-set! - tmp_0 - (known-field-mutator-pos k_0) - tmp-rhs_0) - (list s-rator_0 tmp_0 tmp-rhs_0))))) + 'unsafe-struct*-set! + tmp_0 + (known-field-mutator-pos k_0) + tmp-rhs_0) + (let ((app_0 + (list + 'unsafe-struct? + tmp_0 + (schemify_0 + add-import!_0 + allow-inline?_0 + allow-set!-undefined?_0 + datum-intern?_0 + explicit-unnamed?_0 + exports_0 + imports_0 + inline-fuel_0 + knowns_0 + mutated_0 + no-prompt?_0 + prim-knowns_0 + primitives_0 + serializable?-box_0 + simples_0 + target_0 + unsafe-mode?_0 + type-id_0 + 'fresh)))) + (list + 'if + app_0 + (list + 'unsafe-struct*-set! + tmp_0 + (known-field-mutator-pos k_0) + tmp-rhs_0) + (list s-rator_0 tmp_0 tmp-rhs_0)))))) (let ((app_0 (car args_0))) (wrap-tmp_0 tmp_0 @@ -24229,8 +23947,6 @@ explicit-unnamed?_0 exports_0 exps_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24241,6 +23957,7 @@ rator_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 wcm-state_0) (begin @@ -24273,8 +23990,6 @@ explicit-unnamed?_0 exports_0 exps_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 mutated_0 @@ -24283,6 +23998,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 wcm-state_0 app_0 @@ -24291,6 +24007,74 @@ (args (raise-binding-result-arity-error 2 args)))) #f) #f)))))) + (inline-struct-constructor_0 + (|#%name| + inline-struct-constructor + (lambda (add-import!_0 + allow-inline?_0 + allow-set!-undefined?_0 + datum-intern?_0 + explicit-unnamed?_0 + exports_0 + imports_0 + inline-fuel_0 + knowns_0 + mutated_0 + no-prompt?_0 + prim-knowns_0 + primitives_0 + serializable?-box_0 + simples_0 + target_0 + unsafe-mode?_0 + k_0 + s-rator_0 + im_0 + args_0) + (begin + (let ((type-id_0 + (if (let ((app_0 (known-procedure-arity-mask k_0))) + (bitwise-bit-set? app_0 (length args_0))) + (inline-type-id + k_0 + im_0 + add-import!_0 + mutated_0 + imports_0) + #f))) + (if type-id_0 + (left-to-right/app + 'unsafe-struct + (cons + (schemify_0 + add-import!_0 + allow-inline?_0 + allow-set!-undefined?_0 + datum-intern?_0 + explicit-unnamed?_0 + exports_0 + imports_0 + inline-fuel_0 + knowns_0 + mutated_0 + no-prompt?_0 + prim-knowns_0 + primitives_0 + serializable?-box_0 + simples_0 + target_0 + unsafe-mode?_0 + type-id_0 + 'fresh) + args_0) + #t + target_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0) + #f)))))) (inline-struct-predicate_0 (|#%name| inline-struct-predicate @@ -24300,8 +24084,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24311,6 +24093,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 k_0 s-rator_0 @@ -24318,17 +24101,15 @@ args_0) (begin (let ((type-id_0 - (if im_0 - (if (known-struct-predicate-authentic? k_0) - (if (pair? args_0) - (if (null? (cdr args_0)) - (inline-type-id - k_0 - im_0 - add-import!_0 - mutated_0 - imports_0) - #f) + (if (known-struct-predicate-authentic? k_0) + (if (pair? args_0) + (if (null? (cdr args_0)) + (inline-type-id + k_0 + im_0 + add-import!_0 + mutated_0 + imports_0) #f) #f) #f))) @@ -24352,8 +24133,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24363,6 +24142,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 type-id_0 'fresh)))) @@ -24378,8 +24158,6 @@ explicit-unnamed?_0 exports_0 exps_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 mutated_0 @@ -24388,6 +24166,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 wcm-state_0 rator_0 @@ -24430,8 +24209,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -24439,6 +24216,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 knowns_0 inline-fuel_0 @@ -24523,8 +24301,6 @@ explicit-unnamed?_0 exports_0 exps_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 mutated_0 @@ -24533,6 +24309,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 wcm-state_0 (list* 'lambda formal-args_0 bodys_0) @@ -24547,8 +24324,6 @@ explicit-unnamed?_0 exports_0 exps_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 mutated_0 @@ -24557,6 +24332,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 wcm-state_0 (list* 'case-lambda rest_0) @@ -24596,8 +24372,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24607,6 +24381,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 l_0 wcm-state_0) @@ -24622,8 +24397,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24633,6 +24406,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (car l_0) wcm-state_0)) @@ -24644,8 +24418,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24655,6 +24427,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (car l_0) 'fresh))) @@ -24667,8 +24440,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24678,6 +24449,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (cdr l_0) wcm-state_0))))))))) @@ -24690,8 +24462,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -24699,6 +24469,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 knowns_0 inline-fuel_0 @@ -24712,8 +24483,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24723,6 +24492,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 v_0 wcm-state_0))))) @@ -24735,8 +24505,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24746,6 +24514,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 v_0 wcm-state_0) @@ -24788,8 +24557,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -24799,6 +24566,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 body_0 'tail)) @@ -25005,8 +24773,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -25016,6 +24782,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 body_0 'tail)) @@ -25289,9 +25056,10 @@ #f))) #f) (not - (if for-interp?_0 - for-interp?_0 - for-cify?_0)) + (let ((or-part_0 (eq? target_0 'interp))) + (if or-part_0 + or-part_0 + (eq? target_0 'cify)))) #f) (call-with-values (lambda () @@ -25715,6 +25483,7 @@ prim-knowns_0 knowns_0 imports_0 + exports_0 mutated_0 (lambda (v_1 knowns_1) (schemify/knowns_0 @@ -25724,8 +25493,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -25733,11 +25500,13 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 knowns_1 inline-fuel_0 'fresh v_1)) + target_0 no-prompt?_0))) (if new-seq_0 new-seq_0 @@ -25794,8 +25563,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -25805,6 +25572,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 rhs_0 'fresh))) @@ -25875,8 +25643,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -25886,6 +25652,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 rhs_0 'fresh))) @@ -25937,8 +25704,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -25948,6 +25713,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 rhs_0 'fresh))) @@ -26022,8 +25788,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -26033,6 +25797,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 body_0 wcm-state_0)) @@ -26066,8 +25831,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -26077,6 +25840,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (list* 'begin bodys_0) wcm-state_0)) @@ -26373,8 +26137,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -26384,6 +26146,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (car rhss_0) wcm-state_0) @@ -26430,7 +26193,7 @@ mutated_0 simples_0 unsafe-mode?_0 - for-cify?_0))) + target_0))) (if k_0 (hash-set knowns_1 @@ -26530,8 +26293,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -26541,6 +26302,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 rhs_0 'fresh) @@ -26586,8 +26348,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -26595,6 +26355,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 new-knowns_0 inline-fuel_0 @@ -26853,8 +26614,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -26864,6 +26623,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 rhss_0 'fresh))) @@ -26876,8 +26636,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -26887,6 +26645,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 bodys_0 wcm-state_0))))) @@ -27141,9 +26900,15 @@ ((idss_0 rhss_0 bodys_0) (let ((or-part_0 (if (not - (if for-interp?_0 - for-interp?_0 - for-cify?_0)) + (let ((or-part_0 + (eq? + target_0 + 'interp))) + (if or-part_0 + or-part_0 + (eq? + target_0 + 'cify)))) (let ((temp101_0 (|#%name| temp101 @@ -27157,8 +26922,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -27166,14 +26929,15 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 knowns_1 inline-fuel_0 'fresh v_1)))))) (struct-convert-local.1 - for-cify?_0 #f + target_0 unsafe-mode?_0 v_0 prim-knowns_0 @@ -27214,8 +26978,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -27225,6 +26987,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 rhs_0 'fresh) @@ -27248,8 +27011,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -27259,11 +27020,12 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 bodys_0 wcm-state_0) mutated_0 - for-cify?_0)) + target_0)) prim-knowns_0 knowns_0 imports_0 @@ -27319,8 +27081,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -27330,6 +27090,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (list* 'begin bodys_0) wcm-state_0)) @@ -27465,8 +27226,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -27476,6 +27235,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (list* 'begin bodys_0) wcm-state_0)) @@ -27692,8 +27452,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -27703,6 +27461,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (list* 'letrec-values @@ -28048,7 +27807,7 @@ mutated_0 simples_0 unsafe-mode?_0 - for-cify?_0))) + target_0))) (let ((u-id_0 (unwrap id_0))) @@ -28117,7 +27876,7 @@ (letrec-conversion ids_0 mutated_0 - for-cify?_0 + target_0 (let ((app_0 (reverse$1 (begin @@ -28158,8 +27917,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -28167,6 +27924,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 rhs-knowns_0 inline-fuel_0 @@ -28214,8 +27972,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -28223,6 +27979,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 body-knowns_0 inline-fuel_0 @@ -28524,8 +28281,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -28533,6 +28288,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 knowns_1 inline-fuel_0 @@ -28540,8 +28296,8 @@ v_1)))))) (let ((c1_0 (struct-convert-local.1 - for-cify?_0 #t + target_0 unsafe-mode?_0 v_0 prim-knowns_0 @@ -28562,8 +28318,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -28573,6 +28327,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (letrec-split-values-binding idss_0 @@ -28582,7 +28337,7 @@ (letrec-conversion idss_0 mutated_0 - for-cify?_0 + target_0 (let ((app_0 (apply append @@ -28624,8 +28379,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -28635,6 +28388,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 rhs_0 'fresh))) @@ -28650,7 +28404,7 @@ null rhs_1 '(void) - for-cify?_0)))) + target_0)))) (if (if (pair? ids_0) (null? @@ -28674,7 +28428,7 @@ (list* 'vector ids_0) - for-cify?_0)))) + target_0)))) (list* app_0 (reverse$1 @@ -28742,8 +28496,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -28753,6 +28505,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 bodys_0 wcm-state_0))))))))) @@ -28869,8 +28622,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -28880,6 +28631,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 tst_0 'fresh))) @@ -28891,8 +28643,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -28902,6 +28652,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 thn_0 wcm-state_0))) @@ -28916,8 +28667,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -28927,6 +28676,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 els_0 wcm-state_0))))) @@ -29043,8 +28793,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29054,6 +28802,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 key_0 'fresh))) @@ -29065,8 +28814,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29076,6 +28823,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 val_0 'fresh))) @@ -29087,8 +28835,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29098,6 +28844,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 body_0 'marked))) @@ -29136,7 +28883,9 @@ imports_0 mutated_0) s-body_0)) - (if for-cify?_0 + (if (eq? + target_0 + 'cify) (list 'with-continuation-mark s-key_0 @@ -29204,8 +28953,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29215,6 +28962,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 exp_0 wcm-state_0)) @@ -29244,8 +28992,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29255,6 +29001,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 exps_0 wcm-state_0))) @@ -29284,8 +29031,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29295,6 +29040,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 exps_0 wcm-state_0))) @@ -29340,8 +29086,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29351,6 +29095,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 exp_0 wcm-state_0)) @@ -29409,8 +29154,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29420,6 +29163,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 exp_0 'fresh))) @@ -29433,8 +29177,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29444,6 +29186,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 exps_0 'fresh)))) @@ -29532,8 +29275,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29543,6 +29284,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 rhs_0 'fresh))) @@ -29568,7 +29310,9 @@ (if (if (too-early-mutated-state? state_0) (not - for-cify?_0) + (eq? + target_0 + 'cify)) #f) (let ((tmp_0 (deterministic-gensym @@ -29718,8 +29462,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29729,6 +29471,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (list '|#%variable-reference| @@ -29964,8 +29707,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29975,6 +29716,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 exp1_0 'fresh))) @@ -29986,8 +29728,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -29997,6 +29737,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 exp2_0 'fresh))) @@ -30030,7 +29771,7 @@ exp1_2 exp2_1) #t - for-cify?_0 + target_0 prim-knowns_0 knowns_0 imports_0 @@ -30127,8 +29868,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30138,6 +29877,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 generator_0 'fresh))) @@ -30151,8 +29891,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30162,11 +29900,14 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 receiver_0 'fresh))) (let ((app_0 - (if for-cify?_0 + (if (eq? + target_0 + 'cify) 'call-with-values '|#%call-with-values|))) (left-to-right/app @@ -30179,8 +29920,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30190,6 +29929,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 generator_0 'fresh))) @@ -30202,8 +29942,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30213,11 +29951,12 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 receiver_0 'fresh))) #t - for-cify?_0 + target_0 prim-knowns_0 knowns_0 imports_0 @@ -30243,7 +29982,9 @@ (unwrap a_0))))) #f) - for-cify?_0 + (eq? + target_0 + 'cify) (if (let ((p_0 (unwrap v_0))) @@ -30374,8 +30115,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30385,6 +30124,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (list 'letrec-values @@ -30441,8 +30181,6 @@ explicit-unnamed?_0 exports_0 exps_0 - for-cify?_0 - for-interp?_0 imports_0 knowns_0 mutated_0 @@ -30451,6 +30189,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 wcm-state_0 rator_0 @@ -30468,8 +30207,6 @@ explicit-unnamed?_0 exports_0 exps_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30480,6 +30217,7 @@ rator_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 wcm-state_0) #f))) @@ -30493,8 +30231,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30504,6 +30240,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 rator_0 'fresh))) @@ -30515,8 +30252,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30526,6 +30261,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 exps_0 'fresh))) @@ -30547,7 +30283,7 @@ (case-lambda ((k_0 im_0) - (let ((c5_0 + (let ((c6_0 (let ((or-part_2 (if (eq? rator_0 @@ -30563,35 +30299,41 @@ (inline-ptr-set args_1) #f))))) - (if c5_0 + (if c6_0 (let ((app_0 (car - c5_0))) + c6_0))) (left-to-right/app app_0 (cdr - c5_0) + c6_0) #t - for-cify?_0 + target_0 prim-knowns_0 knowns_0 imports_0 mutated_0 simples_0)) - (let ((c4_0 + (let ((c5_0 (if (not - for-cify?_0) - (if (known-struct-predicate? + (let ((or-part_2 + (eq? + target_0 + 'cify))) + (if or-part_2 + or-part_2 + (eq? + target_0 + 'system)))) + (if (known-struct-constructor? k_0) - (inline-struct-predicate_0 + (inline-struct-constructor_0 add-import!_0 allow-inline?_0 allow-set!-undefined?_0 datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30601,6 +30343,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 k_0 s-rator_1 @@ -30608,22 +30351,28 @@ args_1) #f) #f))) - (if c4_0 - c4_0 - (let ((c3_0 + (if c5_0 + c5_0 + (let ((c4_0 (if (not - for-cify?_0) - (if (known-field-accessor? + (let ((or-part_2 + (eq? + target_0 + 'cify))) + (if or-part_2 + or-part_2 + (eq? + target_0 + 'system)))) + (if (known-struct-predicate? k_0) - (inline-field-access_0 + (inline-struct-predicate_0 add-import!_0 allow-inline?_0 allow-set!-undefined?_0 datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30633,6 +30382,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 k_0 s-rator_1 @@ -30640,22 +30390,28 @@ args_1) #f) #f))) - (if c3_0 - c3_0 - (let ((c2_0 + (if c4_0 + c4_0 + (let ((c3_0 (if (not - for-cify?_0) - (if (known-field-mutator? + (let ((or-part_2 + (eq? + target_0 + 'cify))) + (if or-part_2 + or-part_2 + (eq? + target_0 + 'system)))) + (if (known-field-accessor? k_0) - (inline-field-mutate_0 + (inline-field-access_0 add-import!_0 allow-inline?_0 allow-set!-undefined?_0 datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30665,6 +30421,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 k_0 s-rator_1 @@ -30672,42 +30429,81 @@ args_1) #f) #f))) - (if c2_0 - c2_0 - (if (if unsafe-mode?_0 - (known-procedure/has-unsafe? - k_0) - #f) - (left-to-right/app - (known-procedure/has-unsafe-alternate - k_0) - args_1 - #t - for-cify?_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - (let ((or-part_2 - (known-procedure? - k_0))) - (let ((plain-app?_0 - (if or-part_2 - or-part_2 - (lambda?.1 - #f - rator_0)))) + (if c3_0 + c3_0 + (let ((c2_0 + (if (not + (let ((or-part_2 + (eq? + target_0 + 'cify))) + (if or-part_2 + or-part_2 + (eq? + target_0 + 'system)))) + (if (known-field-mutator? + k_0) + (inline-field-mutate_0 + add-import!_0 + allow-inline?_0 + allow-set!-undefined?_0 + datum-intern?_0 + explicit-unnamed?_0 + exports_0 + imports_0 + inline-fuel_0 + knowns_0 + mutated_0 + no-prompt?_0 + prim-knowns_0 + primitives_0 + serializable?-box_0 + simples_0 + target_0 + unsafe-mode?_0 + k_0 + s-rator_1 + im_0 + args_1) + #f) + #f))) + (if c2_0 + c2_0 + (if (if unsafe-mode?_0 + (known-procedure/has-unsafe? + k_0) + #f) (left-to-right/app - s-rator_1 + (known-procedure/has-unsafe-alternate + k_0) args_1 - plain-app?_0 - for-cify?_0 + #t + target_0 prim-knowns_0 knowns_0 imports_0 mutated_0 - simples_0))))))))))))) + simples_0) + (let ((or-part_2 + (known-procedure? + k_0))) + (let ((plain-app?_0 + (if or-part_2 + or-part_2 + (lambda?.1 + #f + rator_0)))) + (left-to-right/app + s-rator_1 + args_1 + plain-app?_0 + target_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0))))))))))))))) (args (raise-binding-result-arity-error 2 @@ -30732,7 +30528,7 @@ mutated_0 u-v_0 #f))) - (let ((c8_0 + (let ((c9_0 (if (via-variable-mutated-state? state_0) (hash-ref @@ -30740,26 +30536,26 @@ u-v_0 #f) #f))) - (if c8_0 + (if c9_0 (if (too-early-mutated-state? state_0) (list 'variable-ref (export-id - c8_0)) + c9_0)) (list 'variable-ref/no-check (export-id - c8_0))) - (let ((c7_0 + c9_0))) + (let ((c8_0 (hash-ref imports_0 u-v_0 #f))) - (if c7_0 + (if c8_0 (let ((k_0 (import-lookup - c7_0))) + c8_0))) (if (known-constant? k_0) (if (known-literal? @@ -30778,19 +30574,19 @@ (known-copy-id k_0) (import-id - c7_0))) + c8_0))) (list 'variable-ref/no-check (import-id - c7_0)))) - (let ((c6_0 + c8_0)))) + (let ((c7_0 (hash-ref knowns_0 u-v_0 #f))) - (if c6_0 + (if c7_0 (if (if (known-copy? - c6_0) + c7_0) (simple-mutated-state? (hash-ref mutated_0 @@ -30804,8 +30600,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 inline-fuel_0 knowns_0 @@ -30815,15 +30609,18 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 (known-copy-id - c6_0) + c7_0) wcm-state_0) v_0) (if (if (too-early-mutated-state? state_0) (not - for-cify?_0) + (eq? + target_0 + 'cify)) #f) (list 'check-not-unsafe-undefined @@ -30861,8 +30658,7 @@ add-import!_0 serializable?-box_0 datum-intern?_0 - for-cify?_0 - for-interp?_0 + target_0 unsafe-mode?_0 allow-inline?_0 no-prompt?_0 @@ -30875,8 +30671,6 @@ datum-intern?_0 explicit-unnamed?_0 exports_0 - for-cify?_0 - for-interp?_0 imports_0 mutated_0 no-prompt?_0 @@ -30884,6 +30678,7 @@ primitives_0 serializable?-box_0 simples_0 + target_0 unsafe-mode?_0 knowns_0 8 @@ -31002,16 +30797,6 @@ v 'liftable 'binds)))))) -(define effect_2141 - (begin - (register-struct-constructor! liftable1.1) - (register-struct-predicate! liftable?) - (register-struct-field-accessor! liftable-expr struct:liftable 0) - (register-struct-field-accessor! liftable-frees struct:liftable 1) - (register-struct-field-accessor! liftable-binds struct:liftable 2) - (register-struct-field-mutator! set-liftable-frees! struct:liftable 1) - (register-struct-field-mutator! set-liftable-binds! struct:liftable 2) - (void))) (define struct:indirected (make-record-type-descriptor* 'indirected #f #f #f #f 1 1)) (define effect_2558 @@ -31076,13 +30861,6 @@ v 'indirected 'check?)))))) -(define effect_2189 - (begin - (register-struct-constructor! indirected2.1) - (register-struct-predicate! indirected?) - (register-struct-field-accessor! indirected-check? struct:indirected 0) - (register-struct-field-mutator! set-indirected-check?! struct:indirected 0) - (void))) (define empty-frees+binds (cons hash2610 hash2610)) (define lift-in-schemified-linklet (let ((lift-in-schemified-linklet_0 @@ -40059,21 +39837,6 @@ s 'convert-mode 'no-more-conversions?)))))) -(define effect_2406 - (begin - (register-struct-constructor! convert-mode1.1) - (register-struct-predicate! convert-mode?) - (register-struct-field-accessor! convert-mode-sizes struct:convert-mode 0) - (register-struct-field-accessor! - convert-mode-called? - struct:convert-mode - 1) - (register-struct-field-accessor! convert-mode-lift? struct:convert-mode 2) - (register-struct-field-accessor! - convert-mode-no-more-conversions? - struct:convert-mode - 3) - (void))) (define lifts-id (string->uninterned-symbol "_jits")) (define jitify-schemified-linklet (letrec ((procz14 @@ -49267,14 +49030,6 @@ s 'to-unfasl 'wrt)))))) -(define effect_1729 - (begin - (register-struct-constructor! to-unfasl1.1) - (register-struct-predicate! to-unfasl?) - (register-struct-field-accessor! to-unfasl-bstr struct:to-unfasl 0) - (register-struct-field-accessor! to-unfasl-externals struct:to-unfasl 1) - (register-struct-field-accessor! to-unfasl-wrt struct:to-unfasl 2) - (void))) (define empty-literals? (lambda (v_0) (if (vector? v_0) (eqv? 0 (vector-length v_0)) #f))) (define fasl-literals @@ -49366,16 +49121,6 @@ (define node-height (|#%name| node-height (record-accessor struct:node 2))) (define node-left (|#%name| node-left (record-accessor struct:node 3))) (define node-right (|#%name| node-right (record-accessor struct:node 4))) -(define effect_2611 - (begin - (register-struct-constructor! node1.1) - (register-struct-predicate! node?) - (register-struct-field-accessor! node-key struct:node 0) - (register-struct-field-accessor! node-val struct:node 1) - (register-struct-field-accessor! node-height struct:node 2) - (register-struct-field-accessor! node-left struct:node 3) - (register-struct-field-accessor! node-right struct:node 4) - (void))) (define tree-height (lambda (t_0) (if (not t_0) 0 (node-height t_0)))) (define combine (lambda (key_0 val_0 left_0 right_0) @@ -49840,40 +49585,6 @@ v 'stack-info 'non-tail-call-later?)))))) -(define effect_2497 - (begin - (register-struct-constructor! stack-info4.1) - (register-struct-predicate! stack-info?) - (register-struct-field-accessor! - stack-info-capture-depth - struct:stack-info - 0) - (register-struct-field-accessor! - stack-info-closure-map - struct:stack-info - 1) - (register-struct-field-accessor! stack-info-use-map struct:stack-info 2) - (register-struct-field-accessor! - stack-info-local-use-map - struct:stack-info - 3) - (register-struct-field-accessor! - stack-info-non-tail-call-later? - struct:stack-info - 4) - (register-struct-field-mutator! - set-stack-info-use-map! - struct:stack-info - 2) - (register-struct-field-mutator! - set-stack-info-local-use-map! - struct:stack-info - 3) - (register-struct-field-mutator! - set-stack-info-non-tail-call-later?! - struct:stack-info - 4) - (void))) (define make-stack-info.1 (|#%name| make-stack-info @@ -50116,13 +49827,6 @@ s 'indirect 'element)))))) -(define effect_2955 - (begin - (register-struct-constructor! indirect1.1) - (register-struct-predicate! indirect?) - (register-struct-field-accessor! indirect-pos struct:indirect 0) - (register-struct-field-accessor! indirect-element struct:indirect 1) - (void))) (define struct:boxed (make-record-type-descriptor* 'boxed #f #f #f #f 1 0)) (define effect_2559 (struct-type-install-properties! @@ -50160,12 +49864,6 @@ (boxed-pos_2515 s) ($value (impersonate-ref boxed-pos_2515 struct:boxed 0 s 'boxed 'pos)))))) -(define effect_2251 - (begin - (register-struct-constructor! boxed2.1) - (register-struct-predicate! boxed?) - (register-struct-field-accessor! boxed-pos struct:boxed 0) - (void))) (define struct:boxed/check (make-record-type-descriptor* 'boxed/check struct:boxed #f #f #f 0 0)) (define effect_2563 @@ -50196,11 +49894,6 @@ #t ($value (if (impersonator? v) (boxed/check?_2060 (impersonator-val v)) #f)))))) -(define effect_2076 - (begin - (register-struct-constructor! boxed/check3.1) - (register-struct-predicate! boxed/check?) - (void))) (define primitives hash2610) (define strip-annotations (lambda (e_0) e_0)) (define 1/variable-ref diff --git a/racket/src/cs/schemified/thread.scm b/racket/src/cs/schemified/thread.scm index e723678d3b..1802f0af0c 100644 --- a/racket/src/cs/schemified/thread.scm +++ b/racket/src/cs/schemified/thread.scm @@ -973,15 +973,6 @@ (|#%name| set-queue-start! (record-mutator struct:queue 0))) (define set-queue-end! (|#%name| set-queue-end! (record-mutator struct:queue 1))) -(define effect_2779 - (begin - (register-struct-constructor! queue1.1) - (register-struct-predicate! queue?) - (register-struct-field-accessor! queue-start struct:queue 0) - (register-struct-field-accessor! queue-end struct:queue 1) - (register-struct-field-mutator! set-queue-start! struct:queue 0) - (register-struct-field-mutator! set-queue-end! struct:queue 1) - (void))) (define struct:node$2 (make-record-type-descriptor* 'node #f #f #f #f 3 6)) (define effect_2809 (struct-type-install-properties! @@ -1009,16 +1000,6 @@ (|#%name| set-node-prev! (record-mutator struct:node$2 1))) (define set-node-next!$1 (|#%name| set-node-next! (record-mutator struct:node$2 2))) -(define effect_2726 - (begin - (register-struct-constructor! node2.1) - (register-struct-predicate! node?$2) - (register-struct-field-accessor! node-elem struct:node$2 0) - (register-struct-field-accessor! node-prev$1 struct:node$2 1) - (register-struct-field-accessor! node-next$1 struct:node$2 2) - (register-struct-field-mutator! set-node-prev!$1 struct:node$2 1) - (register-struct-field-mutator! set-node-next!$1 struct:node$2 2) - (void))) (define make-queue (lambda () (queue1.1 #f #f))) (define queue-empty? (lambda (q_0) (not (queue-start q_0)))) (define queue-remove! @@ -1293,16 +1274,6 @@ (node-right_2584 s) ($value (impersonate-ref node-right_2584 struct:node$1 4 s 'node 'right)))))) -(define effect_2174 - (begin - (register-struct-constructor! node1.1$1) - (register-struct-predicate! node?$1) - (register-struct-field-accessor! node-key struct:node$1 0) - (register-struct-field-accessor! node-val struct:node$1 1) - (register-struct-field-accessor! node-height struct:node$1 2) - (register-struct-field-accessor! node-left struct:node$1 3) - (register-struct-field-accessor! node-right struct:node$1 4) - (void))) (define empty-tree #f) (define is-empty? (lambda (t_0) (not t_0))) (define tree-height (lambda (t_0) (if (not t_0) 0 (node-height t_0)))) @@ -1715,34 +1686,6 @@ s 'sandman 'do-extract-timeout)))))) -(define effect_1848 - (begin - (register-struct-constructor! sandman1.1) - (register-struct-predicate! sandman?) - (register-struct-field-accessor! sandman-do-sleep struct:sandman 0) - (register-struct-field-accessor! sandman-do-poll struct:sandman 1) - (register-struct-field-accessor! sandman-do-get-wakeup struct:sandman 2) - (register-struct-field-accessor! sandman-do-wakeup struct:sandman 3) - (register-struct-field-accessor! sandman-do-any-sleepers? struct:sandman 4) - (register-struct-field-accessor! - sandman-do-sleepers-external-events - struct:sandman - 5) - (register-struct-field-accessor! sandman-do-add-thread! struct:sandman 6) - (register-struct-field-accessor! - sandman-do-remove-thread! - struct:sandman - 7) - (register-struct-field-accessor! - sandman-do-merge-external-event-sets - struct:sandman - 8) - (register-struct-field-accessor! sandman-do-merge-timeout struct:sandman 9) - (register-struct-field-accessor! - sandman-do-extract-timeout - struct:sandman - 10) - (void))) (define the-sandman #f) (define current-sandman (case-lambda @@ -2016,15 +1959,6 @@ (|#%name| selector-prop-evt-value-selector (record-accessor struct:selector-prop-evt-value 0))) -(define effect_3138 - (begin - (register-struct-constructor! selector-prop-evt-value1.1) - (register-struct-predicate! selector-prop-evt-value?) - (register-struct-field-accessor! - selector-prop-evt-value-selector - struct:selector-prop-evt-value - 0) - (void))) (define-values (prop:secondary-evt secondary-evt? secondary-evt-ref) (make-struct-type-property 'secondary-evt)) @@ -2056,12 +1990,6 @@ (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 effect_2566 - (begin - (register-struct-constructor! poller2.1) - (register-struct-predicate! poller?) - (register-struct-field-accessor! poller-proc struct:poller 0) - (void))) (define struct:poll-ctx (make-record-type-descriptor* 'poll-ctx #f #f #f #f 4 8)) (define effect_3060 @@ -2093,19 +2021,6 @@ (|#%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 effect_2494 - (begin - (register-struct-constructor! poll-ctx3.1) - (register-struct-predicate! poll-ctx?) - (register-struct-field-accessor! poll-ctx-poll? struct:poll-ctx 0) - (register-struct-field-accessor! poll-ctx-select-proc struct:poll-ctx 1) - (register-struct-field-accessor! poll-ctx-sched-info struct:poll-ctx 2) - (register-struct-field-accessor! poll-ctx-incomplete? struct:poll-ctx 3) - (register-struct-field-mutator! - set-poll-ctx-incomplete?! - struct:poll-ctx - 3) - (void))) (define struct:never-evt (make-record-type-descriptor* 'never-evt #f #f #f #f 0 0)) (define effect_2812 @@ -2139,11 +2054,6 @@ #t ($value (if (impersonator? v) (never-evt?_1958 (impersonator-val v)) #f)))))) -(define effect_2441 - (begin - (register-struct-constructor! never-evt4.1) - (register-struct-predicate! never-evt?) - (void))) (define the-never-evt (never-evt4.1)) (define struct:always-evt (make-record-type-descriptor* 'always-evt #f #f #f #f 0 0)) @@ -2178,11 +2088,6 @@ #t ($value (if (impersonator? v) (always-evt?_2466 (impersonator-val v)) #f)))))) -(define effect_2609 - (begin - (register-struct-constructor! always-evt5.1) - (register-struct-predicate! always-evt?) - (void))) (define the-always-evt (always-evt5.1)) (define struct:async-evt (make-record-type-descriptor* 'async-evt #f #f #f #f 0 0)) @@ -2217,11 +2122,6 @@ #t ($value (if (impersonator? v) (async-evt?_2619 (impersonator-val v)) #f)))))) -(define effect_1849 - (begin - (register-struct-constructor! async-evt6.1) - (register-struct-predicate! async-evt?) - (void))) (define the-async-evt (async-evt6.1)) (define struct:wrap-evt (make-record-type-descriptor* 'evt #f #f #f #f 2 0)) (define effect_2319 @@ -2280,13 +2180,6 @@ s 'evt 'wrap)))))) -(define effect_2610 - (begin - (register-struct-constructor! wrap-evt7.1) - (register-struct-predicate! wrap-evt?) - (register-struct-field-accessor! wrap-evt-evt struct:wrap-evt 0) - (register-struct-field-accessor! wrap-evt-wrap struct:wrap-evt 1) - (void))) (define struct:handle-evt (make-record-type-descriptor* 'handle-evt struct:wrap-evt #f #f #f 0 0)) (define effect_2329 @@ -2319,11 +2212,6 @@ (if (impersonator? v) (handle-evt?$1_2894 (impersonator-val v)) #f)))))) -(define effect_3044 - (begin - (register-struct-constructor! handle-evt8.1) - (register-struct-predicate! handle-evt?$1) - (void))) (define struct:control-state-evt (make-record-type-descriptor* 'control-state-evt #f #f #f #f 5 0)) (define effect_2665 @@ -2449,31 +2337,6 @@ s 'control-state-evt 'retry-proc)))))) -(define effect_2957 - (begin - (register-struct-constructor! control-state-evt9.1) - (register-struct-predicate! control-state-evt?) - (register-struct-field-accessor! - control-state-evt-evt - struct:control-state-evt - 0) - (register-struct-field-accessor! - control-state-evt-wrap-proc - struct:control-state-evt - 1) - (register-struct-field-accessor! - control-state-evt-interrupt-proc - struct:control-state-evt - 2) - (register-struct-field-accessor! - control-state-evt-abandon-proc - struct:control-state-evt - 3) - (register-struct-field-accessor! - control-state-evt-retry-proc - struct:control-state-evt - 4) - (void))) (define struct:poll-guard-evt (make-record-type-descriptor* 'evt #f #f #f #f 1 0)) (define effect_2393 @@ -2525,15 +2388,6 @@ s 'evt 'proc)))))) -(define effect_2289 - (begin - (register-struct-constructor! poll-guard-evt10.1) - (register-struct-predicate! poll-guard-evt?) - (register-struct-field-accessor! - poll-guard-evt-proc - struct:poll-guard-evt - 0) - (void))) (define struct:choice-evt (make-record-type-descriptor* 'evt #f #f #f #f 1 0)) (define effect_2512 (struct-type-install-properties! @@ -2581,12 +2435,6 @@ s 'evt 'evts)))))) -(define effect_2513 - (begin - (register-struct-constructor! choice-evt11.1) - (register-struct-predicate! choice-evt?) - (register-struct-field-accessor! choice-evt-evts struct:choice-evt 0) - (void))) (define-values (impersonator-prop:evt evt-impersonator? evt-impersonator-ref) (make-impersonator-property 'evt-impersonator)) @@ -2642,12 +2490,6 @@ (|#%name| delayed-poll? (record-predicate struct:delayed-poll))) (define delayed-poll-resume (|#%name| delayed-poll-resume (record-accessor struct:delayed-poll 0))) -(define effect_2511 - (begin - (register-struct-constructor! delayed-poll12.1) - (register-struct-predicate! delayed-poll?) - (register-struct-field-accessor! delayed-poll-resume struct:delayed-poll 0) - (void))) (define struct:poller-evt (make-record-type-descriptor* 'poller-evt #f #f #f #f 1 0)) (define effect_2558 @@ -2694,12 +2536,6 @@ s 'poller-evt 'poller)))))) -(define effect_2383 - (begin - (register-struct-constructor! poller-evt13.1) - (register-struct-predicate! poller-evt?) - (register-struct-field-accessor! poller-evt-poller struct:poller-evt 0) - (void))) (define-values (prop:waiter waiter? waiter-ref) (make-struct-type-property 'waiter)) @@ -2729,19 +2565,6 @@ (|#%name| waiter-methods-suspend (record-accessor struct:waiter-methods 0))) (define waiter-methods-resume (|#%name| waiter-methods-resume (record-accessor struct:waiter-methods 1))) -(define effect_2559 - (begin - (register-struct-constructor! waiter-methods1.1) - (register-struct-predicate! waiter-methods?) - (register-struct-field-accessor! - waiter-methods-suspend - struct:waiter-methods - 0) - (register-struct-field-accessor! - waiter-methods-resume - struct:waiter-methods - 1) - (void))) (define make-waiter-methods.1 (|#%name| make-waiter-methods @@ -2809,12 +2632,6 @@ s 'select-waiter 'proc)))))) -(define effect_2971 - (begin - (register-struct-constructor! select-waiter7.1) - (register-struct-predicate! select-waiter?) - (register-struct-field-accessor! select-waiter-proc struct:select-waiter 0) - (void))) (define struct:custodian (make-record-type-descriptor* 'custodian #f #f #f #f 13 8188)) (define effect_2364 @@ -2888,89 +2705,6 @@ (|#%name| set-custodian-sync-futures?! (record-mutator struct:custodian 11))) (define set-custodian-post-shutdown! (|#%name| set-custodian-post-shutdown! (record-mutator struct:custodian 12))) -(define effect_2160 - (begin - (register-struct-constructor! custodian1.1) - (register-struct-predicate! 1/custodian?) - (register-struct-field-accessor! custodian-children struct:custodian 0) - (register-struct-field-accessor! - custodian-shut-down?-box - struct:custodian - 1) - (register-struct-field-accessor! - custodian-shutdown-sema - struct:custodian - 2) - (register-struct-field-accessor! - custodian-need-shutdown - struct:custodian - 3) - (register-struct-field-accessor! - custodian-parent-reference - struct:custodian - 4) - (register-struct-field-accessor! - custodian-self-reference - struct:custodian - 5) - (register-struct-field-accessor! custodian-place struct:custodian 6) - (register-struct-field-accessor! custodian-memory-use struct:custodian 7) - (register-struct-field-accessor! custodian-gc-roots struct:custodian 8) - (register-struct-field-accessor! - custodian-memory-limits - struct:custodian - 9) - (register-struct-field-accessor! - custodian-immediate-limit - struct:custodian - 10) - (register-struct-field-accessor! - custodian-sync-futures? - struct:custodian - 11) - (register-struct-field-accessor! - custodian-post-shutdown - struct:custodian - 12) - (register-struct-field-mutator! - set-custodian-shutdown-sema! - struct:custodian - 2) - (register-struct-field-mutator! - set-custodian-need-shutdown! - struct:custodian - 3) - (register-struct-field-mutator! - set-custodian-parent-reference! - struct:custodian - 4) - (register-struct-field-mutator! - set-custodian-self-reference! - struct:custodian - 5) - (register-struct-field-mutator! set-custodian-place! struct:custodian 6) - (register-struct-field-mutator! - set-custodian-memory-use! - struct:custodian - 7) - (register-struct-field-mutator! set-custodian-gc-roots! struct:custodian 8) - (register-struct-field-mutator! - set-custodian-memory-limits! - struct:custodian - 9) - (register-struct-field-mutator! - set-custodian-immediate-limit! - struct:custodian - 10) - (register-struct-field-mutator! - set-custodian-sync-futures?! - struct:custodian - 11) - (register-struct-field-mutator! - set-custodian-post-shutdown! - struct:custodian - 12) - (void))) (define create-custodian (lambda (parent_0) (custodian1.1 @@ -3060,15 +2794,6 @@ (|#%name| message-ized? (record-predicate struct:message-ized))) (define message-ized-unmessage (|#%name| message-ized-unmessage (record-accessor struct:message-ized 0))) -(define effect_2445 - (begin - (register-struct-constructor! message-ized1.1) - (register-struct-predicate! message-ized?) - (register-struct-field-accessor! - message-ized-unmessage - struct:message-ized - 0) - (void))) (define allowed?.1 (letrec ((loop_0 (|#%name| @@ -4269,46 +3994,6 @@ (|#%name| set-place-dequeue-semas! (record-mutator struct:place 17))) (define set-place-future-scheduler! (|#%name| set-place-future-scheduler! (record-mutator struct:place 18))) -(define effect_1859 - (begin - (register-struct-constructor! place1.1) - (register-struct-predicate! 1/place?) - (register-struct-field-accessor! place-parent struct:place 0) - (register-struct-field-accessor! place-lock struct:place 1) - (register-struct-field-accessor! place-activity-canary struct:place 2) - (register-struct-field-accessor! place-pch struct:place 3) - (register-struct-field-accessor! place-result struct:place 4) - (register-struct-field-accessor! place-queued-result struct:place 5) - (register-struct-field-accessor! place-custodian struct:place 6) - (register-struct-field-accessor! place-custodian-ref struct:place 7) - (register-struct-field-accessor! place-host-thread struct:place 8) - (register-struct-field-accessor! place-id struct:place 9) - (register-struct-field-accessor! place-host-roots struct:place 10) - (register-struct-field-accessor! place-current-thread struct:place 11) - (register-struct-field-accessor! place-post-shutdown struct:place 12) - (register-struct-field-accessor! place-pumpers struct:place 13) - (register-struct-field-accessor! place-pending-break struct:place 14) - (register-struct-field-accessor! place-done-waiting struct:place 15) - (register-struct-field-accessor! place-wakeup-handle struct:place 16) - (register-struct-field-accessor! place-dequeue-semas struct:place 17) - (register-struct-field-accessor! place-future-scheduler struct:place 18) - (register-struct-field-mutator! set-place-result! struct:place 4) - (register-struct-field-mutator! set-place-queued-result! struct:place 5) - (register-struct-field-mutator! set-place-custodian-ref! struct:place 7) - (register-struct-field-mutator! set-place-host-thread! struct:place 8) - (register-struct-field-mutator! set-place-id! struct:place 9) - (register-struct-field-mutator! set-place-host-roots! struct:place 10) - (register-struct-field-mutator! set-place-current-thread! struct:place 11) - (register-struct-field-mutator! set-place-post-shutdown! struct:place 12) - (register-struct-field-mutator! set-place-pumpers! struct:place 13) - (register-struct-field-mutator! set-place-pending-break! struct:place 14) - (register-struct-field-mutator! set-place-wakeup-handle! struct:place 16) - (register-struct-field-mutator! set-place-dequeue-semas! struct:place 17) - (register-struct-field-mutator! - set-place-future-scheduler! - struct:place - 18) - (void))) (define make-place.1 (|#%name| make-place @@ -4411,13 +4096,6 @@ (|#%name| semaphore-count (record-accessor struct:semaphore 0))) (define set-semaphore-count! (|#%name| set-semaphore-count! (record-mutator struct:semaphore 0))) -(define effect_2880 - (begin - (register-struct-constructor! semaphore1.1) - (register-struct-predicate! 1/semaphore?) - (register-struct-field-accessor! semaphore-count struct:semaphore 0) - (register-struct-field-mutator! set-semaphore-count! struct:semaphore 0) - (void))) (define count-field-pos 2) (define struct:semaphore-peek-evt (make-record-type-descriptor* 'semaphore-peek-evt #f #f #f #f 1 0)) @@ -4475,15 +4153,6 @@ s 'semaphore-peek-evt 'sema)))))) -(define effect_2072 - (begin - (register-struct-constructor! semaphore-peek-evt2.1) - (register-struct-predicate! 1/semaphore-peek-evt?) - (register-struct-field-accessor! - semaphore-peek-evt-sema - struct:semaphore-peek-evt - 0) - (void))) (define struct:semaphore-peek-select-waiter (make-record-type-descriptor* 'semaphore-peek-select-waiter @@ -4528,11 +4197,6 @@ (if (impersonator? v) (semaphore-peek-select-waiter?_2529 (impersonator-val v)) #f)))))) -(define effect_2627 - (begin - (register-struct-constructor! semaphore-peek-select-waiter3.1) - (register-struct-predicate! semaphore-peek-select-waiter?) - (void))) (define 1/make-semaphore (let ((make-semaphore_0 (|#%name| @@ -4749,15 +4413,6 @@ (|#%name| set-node-prev! (record-mutator struct:node 0))) (define set-node-next! (|#%name| set-node-next! (record-mutator struct:node 1))) -(define effect_3032 - (begin - (register-struct-constructor! node1.1) - (register-struct-predicate! node?) - (register-struct-field-accessor! node-prev struct:node 0) - (register-struct-field-accessor! node-next struct:node 1) - (register-struct-field-mutator! set-node-prev! struct:node 0) - (register-struct-field-mutator! set-node-next! struct:node 1) - (void))) (define child-node (lambda (child_0) child_0)) (define node-child (lambda (n_0) n_0)) (define struct:thread-group @@ -4800,33 +4455,6 @@ (|#%name| set-thread-group-chain-end! (record-mutator struct:thread-group 3))) -(define effect_3011 - (begin - (register-struct-constructor! thread-group2.1) - (register-struct-predicate! 1/thread-group?) - (register-struct-field-accessor! thread-group-parent struct:thread-group 0) - (register-struct-field-accessor! - thread-group-chain-start - struct:thread-group - 1) - (register-struct-field-accessor! thread-group-chain struct:thread-group 2) - (register-struct-field-accessor! - thread-group-chain-end - struct:thread-group - 3) - (register-struct-field-mutator! - set-thread-group-chain-start! - struct:thread-group - 1) - (register-struct-field-mutator! - set-thread-group-chain! - struct:thread-group - 2) - (register-struct-field-mutator! - set-thread-group-chain-end! - struct:thread-group - 3) - (void))) (define not-added-key #f) (define assert-not-added (lambda (n_0) (void))) (define assert-added (lambda (n_0) (void))) @@ -5054,24 +4682,6 @@ v 'schedule-info 'exts)))))) -(define effect_2287 - (begin - (register-struct-constructor! schedule-info1.1) - (register-struct-predicate! schedule-info?) - (register-struct-field-accessor! - schedule-info-did-work? - struct:schedule-info - 0) - (register-struct-field-accessor! schedule-info-exts struct:schedule-info 1) - (register-struct-field-mutator! - set-schedule-info-did-work?! - struct:schedule-info - 0) - (register-struct-field-mutator! - set-schedule-info-exts! - struct:schedule-info - 1) - (void))) (define make-schedule-info.1 (|#%name| make-schedule-info @@ -5118,13 +4728,6 @@ (|#%name| plumber-callbacks (record-accessor struct:plumber 0))) (define plumber-weak-callbacks (|#%name| plumber-weak-callbacks (record-accessor struct:plumber 1))) -(define effect_2372 - (begin - (register-struct-constructor! plumber1.1) - (register-struct-predicate! 1/plumber?) - (register-struct-field-accessor! plumber-callbacks struct:plumber 0) - (register-struct-field-accessor! plumber-weak-callbacks struct:plumber 1) - (void))) (define 1/make-plumber (|#%name| make-plumber @@ -5211,19 +4814,6 @@ s 'plumber-flush-handle 'proc)))))) -(define effect_2567 - (begin - (register-struct-constructor! plumber-flush-handle2.1) - (register-struct-predicate! 1/plumber-flush-handle?) - (register-struct-field-accessor! - plumber-flush-handle-plumber - struct:plumber-flush-handle - 0) - (register-struct-field-accessor! - plumber-flush-handle-proc - struct:plumber-flush-handle - 1) - (void))) (define 1/plumber-add-flush! (let ((plumber-add-flush!_0 (|#%name| @@ -5410,17 +5000,6 @@ (|#%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 effect_2560 - (begin - (register-struct-constructor! custodian-box1.1) - (register-struct-predicate! 1/custodian-box?) - (register-struct-field-accessor! custodian-box-v struct:custodian-box 0) - (register-struct-field-accessor! custodian-box-sema struct:custodian-box 1) - (register-struct-field-mutator! - set-custodian-box-v! - struct:custodian-box - 0) - (void))) (define struct:willed-callback (make-record-type-descriptor* 'willed-callback #f #f #f #f 2 0)) (define effect_2810 @@ -5447,19 +5026,6 @@ (|#%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 effect_2644 - (begin - (register-struct-constructor! willed-callback2.1) - (register-struct-predicate! willed-callback?) - (register-struct-field-accessor! - willed-callback-proc - struct:willed-callback - 0) - (register-struct-field-accessor! - willed-callback-will - struct:willed-callback - 1) - (void))) (define struct:at-exit-callback (make-record-type-descriptor* 'at-exit-callback @@ -5489,11 +5055,6 @@ (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 effect_2470 - (begin - (register-struct-constructor! at-exit-callback3.1) - (register-struct-predicate! at-exit-callback?) - (void))) (define struct:custodian-reference (make-record-type-descriptor* 'custodian-reference #f #f #f #f 1 1)) (define effect_2616 @@ -5526,19 +5087,6 @@ (|#%name| set-custodian-reference-weak-c! (record-mutator struct:custodian-reference 0))) -(define effect_2569 - (begin - (register-struct-constructor! custodian-reference4.1) - (register-struct-predicate! custodian-reference?) - (register-struct-field-accessor! - custodian-reference-weak-c - struct:custodian-reference - 0) - (register-struct-field-mutator! - set-custodian-reference-weak-c! - struct:custodian-reference - 0) - (void))) (define cell.1$7 (unsafe-make-place-local (|#%app| host:make-late-will-executor void #f))) (define 1/current-custodian @@ -6940,89 +6488,6 @@ (|#%name| set-thread-cpu-time! (record-mutator struct:thread 22))) (define set-thread-future! (|#%name| set-thread-future! (record-mutator struct:thread 23))) -(define effect_2975 - (begin - (register-struct-constructor! thread1.1) - (register-struct-predicate! 1/thread?) - (register-struct-field-accessor! thread-name struct:thread 0) - (register-struct-field-accessor! thread-engine struct:thread 1) - (register-struct-field-accessor! thread-parent struct:thread 2) - (register-struct-field-accessor! thread-sleeping struct:thread 3) - (register-struct-field-accessor! thread-sched-info struct:thread 4) - (register-struct-field-accessor! - thread-custodian-references - struct:thread - 5) - (register-struct-field-accessor! thread-transitive-resumes struct:thread 6) - (register-struct-field-accessor! thread-suspend-to-kill? struct:thread 7) - (register-struct-field-accessor! thread-kill-callbacks struct:thread 8) - (register-struct-field-accessor! - thread-suspend+resume-callbacks - struct:thread - 9) - (register-struct-field-accessor! thread-descheduled? struct:thread 10) - (register-struct-field-accessor! - thread-interrupt-callback - struct:thread - 11) - (register-struct-field-accessor! thread-dead-sema struct:thread 12) - (register-struct-field-accessor! 1/thread-dead-evt struct:thread 13) - (register-struct-field-accessor! thread-suspended-box struct:thread 14) - (register-struct-field-accessor! thread-suspended-evt struct:thread 15) - (register-struct-field-accessor! thread-resumed-evt struct:thread 16) - (register-struct-field-accessor! thread-pending-break struct:thread 17) - (register-struct-field-accessor! - thread-ignore-break-cells - struct:thread - 18) - (register-struct-field-accessor! thread-forward-break-to struct:thread 19) - (register-struct-field-accessor! thread-mailbox struct:thread 20) - (register-struct-field-accessor! thread-mailbox-wakeup struct:thread 21) - (register-struct-field-accessor! thread-cpu-time struct:thread 22) - (register-struct-field-accessor! thread-future struct:thread 23) - (register-struct-field-mutator! set-thread-engine! struct:thread 1) - (register-struct-field-mutator! set-thread-sleeping! struct:thread 3) - (register-struct-field-mutator! set-thread-sched-info! struct:thread 4) - (register-struct-field-mutator! - set-thread-custodian-references! - struct:thread - 5) - (register-struct-field-mutator! - set-thread-transitive-resumes! - struct:thread - 6) - (register-struct-field-mutator! set-thread-kill-callbacks! struct:thread 8) - (register-struct-field-mutator! - set-thread-suspend+resume-callbacks! - struct:thread - 9) - (register-struct-field-mutator! set-thread-descheduled?! struct:thread 10) - (register-struct-field-mutator! - set-thread-interrupt-callback! - struct:thread - 11) - (register-struct-field-mutator! set-thread-dead-sema! struct:thread 12) - (register-struct-field-mutator! set-thread-dead-evt! struct:thread 13) - (register-struct-field-mutator! set-thread-suspended-box! struct:thread 14) - (register-struct-field-mutator! set-thread-suspended-evt! struct:thread 15) - (register-struct-field-mutator! set-thread-resumed-evt! struct:thread 16) - (register-struct-field-mutator! set-thread-pending-break! struct:thread 17) - (register-struct-field-mutator! - set-thread-ignore-break-cells! - struct:thread - 18) - (register-struct-field-mutator! - set-thread-forward-break-to! - struct:thread - 19) - (register-struct-field-mutator! set-thread-mailbox! struct:thread 20) - (register-struct-field-mutator! - set-thread-mailbox-wakeup! - struct:thread - 21) - (register-struct-field-mutator! set-thread-cpu-time! struct:thread 22) - (register-struct-field-mutator! set-thread-future! struct:thread 23) - (void))) (define cell.1$1 (unsafe-make-place-local #f)) (define 1/current-thread (|#%name| @@ -7440,12 +6905,6 @@ s 'thread-dead-evt 'sema)))))) -(define effect_2531 - (begin - (register-struct-constructor! dead-evt13.1) - (register-struct-predicate! dead-evt?) - (register-struct-field-accessor! dead-evt-sema struct:dead-evt 0) - (void))) (define thread-dead-evt? (lambda (v_0) (dead-evt? v_0))) (define get-thread-dead-evt (|#%name| @@ -7750,19 +7209,6 @@ (|#%name| transitive-resume-box (record-accessor struct:transitive-resume 1))) -(define effect_2460 - (begin - (register-struct-constructor! transitive-resume16.1) - (register-struct-predicate! transitive-resume?) - (register-struct-field-accessor! - transitive-resume-weak-box - struct:transitive-resume - 0) - (register-struct-field-accessor! - transitive-resume-box - struct:transitive-resume - 1) - (void))) (define add-transitive-resume-to-thread! (letrec ((loop_0 (|#%name| @@ -7947,23 +7393,6 @@ v 'suspend-resume-evt 'thread)))))) -(define effect_2999 - (begin - (register-struct-constructor! suspend-resume-evt17.1) - (register-struct-predicate! suspend-resume-evt?) - (register-struct-field-accessor! - suspend-resume-evt-sema - struct:suspend-resume-evt - 0) - (register-struct-field-accessor! - suspend-resume-evt-thread - struct:suspend-resume-evt - 1) - (register-struct-field-mutator! - set-suspend-resume-evt-thread! - struct:suspend-resume-evt - 1) - (void))) (define struct:suspend-evt (make-record-type-descriptor* 'thread-suspend-evt @@ -8001,11 +7430,6 @@ #t ($value (if (impersonator? v) (suspend-evt?_3224 (impersonator-val v)) #f)))))) -(define effect_2668 - (begin - (register-struct-constructor! suspend-evt18.1) - (register-struct-predicate! suspend-evt?) - (void))) (define struct:resume-evt (make-record-type-descriptor* 'thread-resume-evt @@ -8043,11 +7467,6 @@ #t ($value (if (impersonator? v) (resume-evt?_2037 (impersonator-val v)) #f)))))) -(define effect_1814 - (begin - (register-struct-constructor! resume-evt19.1) - (register-struct-predicate! resume-evt?) - (void))) (define 1/thread-resume-evt (|#%name| thread-resume-evt @@ -8522,11 +7941,6 @@ (if (impersonator? v) (thread-receiver-evt?_2591 (impersonator-val v)) #f)))))) -(define effect_2732 - (begin - (register-struct-constructor! thread-receiver-evt26.1) - (register-struct-predicate! thread-receiver-evt?) - (void))) (define 1/thread-receive-evt (|#%name| thread-receive-evt (lambda () (begin (thread-receiver-evt26.1))))) (define effect_2328 @@ -8620,13 +8034,6 @@ s 'channel 'put-queue)))))) -(define effect_2912 - (begin - (register-struct-constructor! channel1.1) - (register-struct-predicate! 1/channel?) - (register-struct-field-accessor! channel-get-queue struct:channel 0) - (register-struct-field-accessor! channel-put-queue struct:channel 1) - (void))) (define struct:channel-put-evt* (make-record-type-descriptor* 'channel-put-evt #f #f #f #f 2 0)) (define effect_2694 @@ -8701,19 +8108,6 @@ s 'channel-put-evt 'v)))))) -(define effect_2493 - (begin - (register-struct-constructor! channel-put-evt*2.1) - (register-struct-predicate! channel-put-evt*?) - (register-struct-field-accessor! - channel-put-evt*-ch - struct:channel-put-evt* - 0) - (register-struct-field-accessor! - channel-put-evt*-v - struct:channel-put-evt* - 1) - (void))) (define struct:channel-select-waiter (make-record-type-descriptor* 'channel-select-waiter @@ -8773,15 +8167,6 @@ s 'channel-select-waiter 'thread)))))) -(define effect_2663 - (begin - (register-struct-constructor! channel-select-waiter3.1) - (register-struct-predicate! channel-select-waiter?) - (register-struct-field-accessor! - channel-select-waiter-thread - struct:channel-select-waiter - 0) - (void))) (define 1/make-channel (|#%name| make-channel @@ -9440,24 +8825,6 @@ v 'syncing 'need-retry?)))))) -(define effect_2486 - (begin - (register-struct-constructor! syncing1.1) - (register-struct-predicate! syncing?) - (register-struct-field-accessor! syncing-selected struct:syncing 0) - (register-struct-field-accessor! syncing-syncers struct:syncing 1) - (register-struct-field-accessor! syncing-wakeup struct:syncing 2) - (register-struct-field-accessor! syncing-disable-break struct:syncing 3) - (register-struct-field-accessor! syncing-need-retry? struct:syncing 4) - (register-struct-field-mutator! set-syncing-selected! struct:syncing 0) - (register-struct-field-mutator! set-syncing-syncers! struct:syncing 1) - (register-struct-field-mutator! set-syncing-wakeup! struct:syncing 2) - (register-struct-field-mutator! - set-syncing-disable-break! - struct:syncing - 3) - (register-struct-field-mutator! set-syncing-need-retry?! struct:syncing 4) - (void))) (define struct:syncer (make-record-type-descriptor* 'syncer #f #f #f #f 9 511)) (define effect_2549 (struct-type-install-properties! @@ -9774,29 +9141,6 @@ v 'syncer 'next)))))) -(define effect_2487 - (begin - (register-struct-constructor! syncer2.1) - (register-struct-predicate! syncer?) - (register-struct-field-accessor! syncer-evt struct:syncer 0) - (register-struct-field-accessor! syncer-wraps struct:syncer 1) - (register-struct-field-accessor! syncer-commits struct:syncer 2) - (register-struct-field-accessor! syncer-interrupted? struct:syncer 3) - (register-struct-field-accessor! syncer-interrupt struct:syncer 4) - (register-struct-field-accessor! syncer-abandons struct:syncer 5) - (register-struct-field-accessor! syncer-retry struct:syncer 6) - (register-struct-field-accessor! syncer-prev struct:syncer 7) - (register-struct-field-accessor! syncer-next struct:syncer 8) - (register-struct-field-mutator! set-syncer-evt! struct:syncer 0) - (register-struct-field-mutator! set-syncer-wraps! struct:syncer 1) - (register-struct-field-mutator! set-syncer-commits! struct:syncer 2) - (register-struct-field-mutator! set-syncer-interrupted?! struct:syncer 3) - (register-struct-field-mutator! set-syncer-interrupt! struct:syncer 4) - (register-struct-field-mutator! set-syncer-abandons! struct:syncer 5) - (register-struct-field-mutator! set-syncer-retry! struct:syncer 6) - (register-struct-field-mutator! set-syncer-prev! struct:syncer 7) - (register-struct-field-mutator! set-syncer-next! struct:syncer 8) - (void))) (define make-syncer (lambda (evt_0 wraps_0 prev_0) (syncer2.1 evt_0 wraps_0 null #f #f null #f prev_0 #f))) @@ -11063,15 +10407,6 @@ s 'evt 'guard)))))) -(define effect_3103 - (begin - (register-struct-constructor! replacing-evt34.1) - (register-struct-predicate! replacing-evt?) - (register-struct-field-accessor! - replacing-evt-guard - struct:replacing-evt - 0) - (void))) (define struct:nested-sync-evt (make-record-type-descriptor* 'evt #f #f #f #f 3 0)) (define effect_2232 @@ -11155,23 +10490,6 @@ s 'evt 'orig-evt)))))) -(define effect_2506 - (begin - (register-struct-constructor! nested-sync-evt35.1) - (register-struct-predicate! nested-sync-evt?) - (register-struct-field-accessor! - nested-sync-evt-s - struct:nested-sync-evt - 0) - (register-struct-field-accessor! - nested-sync-evt-next - struct:nested-sync-evt - 1) - (register-struct-field-accessor! - nested-sync-evt-orig-evt - struct:nested-sync-evt - 2) - (void))) (define 1/replace-evt (|#%name| replace-evt @@ -11340,11 +10658,6 @@ (if (impersonator? v) (system-idle-evt?_2250 (impersonator-val v)) #f)))))) -(define effect_2692 - (begin - (register-struct-constructor! system-idle-evt1.1) - (register-struct-predicate! system-idle-evt?) - (void))) (define the-idle-evt (system-idle-evt1.1)) (define get-system-idle-evt (|#%name| system-idle-evt (lambda () (begin the-idle-evt)))) @@ -11418,28 +10731,6 @@ (|#%name| set-future-state! (record-mutator struct:future* 8))) (define set-future*-dependents! (|#%name| set-future-dependents! (record-mutator struct:future* 9))) -(define effect_3156 - (begin - (register-struct-constructor! future*1.1) - (register-struct-predicate! future*?) - (register-struct-field-accessor! future*-id struct:future* 0) - (register-struct-field-accessor! future*-lock struct:future* 1) - (register-struct-field-accessor! future*-custodian struct:future* 2) - (register-struct-field-accessor! future*-would-be? struct:future* 3) - (register-struct-field-accessor! future*-thunk struct:future* 4) - (register-struct-field-accessor! future*-prev struct:future* 5) - (register-struct-field-accessor! future*-next struct:future* 6) - (register-struct-field-accessor! future*-results struct:future* 7) - (register-struct-field-accessor! future*-state struct:future* 8) - (register-struct-field-accessor! future*-dependents struct:future* 9) - (register-struct-field-mutator! set-future*-would-be?! struct:future* 3) - (register-struct-field-mutator! set-future*-thunk! struct:future* 4) - (register-struct-field-mutator! set-future*-prev! struct:future* 5) - (register-struct-field-mutator! set-future*-next! struct:future* 6) - (register-struct-field-mutator! set-future*-results! struct:future* 7) - (register-struct-field-mutator! set-future*-state! struct:future* 8) - (register-struct-field-mutator! set-future*-dependents! struct:future* 9) - (void))) (define currently-running-future-key (gensym 'future)) (define currently-running-future (lambda () @@ -11620,29 +10911,6 @@ s 'future-event 'user-data)))))) -(define effect_2671 - (begin - (register-struct-constructor! future-event1.1) - (register-struct-predicate! future-event?) - (register-struct-field-accessor! - future-event-future-id - struct:future-event - 0) - (register-struct-field-accessor! - future-event-proc-id - struct:future-event - 1) - (register-struct-field-accessor! future-event-action struct:future-event 2) - (register-struct-field-accessor! future-event-time struct:future-event 3) - (register-struct-field-accessor! - future-event-prim-name - struct:future-event - 4) - (register-struct-field-accessor! - future-event-user-data - struct:future-event - 5) - (void))) (define cell.1$4 (unsafe-make-place-local (box null))) (define init-future-logging-place! (lambda () (unsafe-place-local-set! cell.1$4 (box null)))) @@ -11802,7 +11070,7 @@ (|#%name| futures-enabled? (lambda () (begin (|#%app| threaded?))))) (define struct:future-evt (make-record-type-descriptor* 'future-evt #f #f #f #f 1 0)) -(define effect_2446 +(define effect_2445 (struct-type-install-properties! struct:future-evt 'future-evt @@ -11860,12 +11128,6 @@ s 'future-evt 'future)))))) -(define effect_2956 - (begin - (register-struct-constructor! future-evt1.1) - (register-struct-predicate! future-evt?) - (register-struct-field-accessor! future-evt-future struct:future-evt 0) - (void))) (define create-future (lambda (thunk_0 cust_0 would-be?_0) (let ((id_0 (get-next-id))) @@ -12245,7 +11507,7 @@ (define set-processor-count! (lambda (n_0) (set! pthread-count n_0))) (define struct:scheduler (make-record-type-descriptor* 'scheduler #f #f #f #f 6 7)) -(define effect_2611 +(define effect_2609 (struct-type-install-properties! struct:scheduler 'scheduler @@ -12282,26 +11544,6 @@ (|#%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 effect_2249 - (begin - (register-struct-constructor! scheduler7.1) - (register-struct-predicate! scheduler?) - (register-struct-field-accessor! scheduler-workers struct:scheduler 0) - (register-struct-field-accessor! scheduler-futures-head struct:scheduler 1) - (register-struct-field-accessor! scheduler-futures-tail struct:scheduler 2) - (register-struct-field-accessor! scheduler-mutex struct:scheduler 3) - (register-struct-field-accessor! scheduler-cond struct:scheduler 4) - (register-struct-field-accessor! scheduler-ping-cond struct:scheduler 5) - (register-struct-field-mutator! set-scheduler-workers! struct:scheduler 0) - (register-struct-field-mutator! - set-scheduler-futures-head! - struct:scheduler - 1) - (register-struct-field-mutator! - set-scheduler-futures-tail! - struct:scheduler - 2) - (void))) (define struct:worker (make-record-type-descriptor* 'worker #f #f #f #f 5 26)) (define effect_2322 (struct-type-install-properties! @@ -12335,19 +11577,6 @@ (|#%name| set-worker-die?! (record-mutator struct:worker 3))) (define set-worker-ping! (|#%name| set-worker-ping! (record-mutator struct:worker 4))) -(define effect_2526 - (begin - (register-struct-constructor! worker8.1) - (register-struct-predicate! worker?) - (register-struct-field-accessor! worker-id struct:worker 0) - (register-struct-field-accessor! worker-pthread struct:worker 1) - (register-struct-field-accessor! worker-current-future-box struct:worker 2) - (register-struct-field-accessor! worker-die? struct:worker 3) - (register-struct-field-accessor! worker-ping struct:worker 4) - (register-struct-field-mutator! set-worker-pthread! struct:worker 1) - (register-struct-field-mutator! set-worker-die?! struct:worker 3) - (register-struct-field-mutator! set-worker-ping! struct:worker 4) - (void))) (define current-scheduler (case-lambda (() (place-future-scheduler (unsafe-place-local-ref cell.1$2))) @@ -13227,12 +12456,6 @@ s 'alarm-evt 'msecs)))))) -(define effect_2706 - (begin - (register-struct-constructor! alarm-evt1.1) - (register-struct-predicate! alarm-evt?) - (register-struct-field-accessor! alarm-evt-msecs struct:alarm-evt 0) - (void))) (define create-alarm-evt (lambda (msecs_0) (begin @@ -13770,16 +12993,6 @@ (|#%name| will-executor-host-we (record-accessor struct:will-executor 0))) (define will-executor-sema (|#%name| will-executor-sema (record-accessor struct:will-executor 1))) -(define effect_2727 - (begin - (register-struct-constructor! will-executor1.1) - (register-struct-predicate! 1/will-executor?) - (register-struct-field-accessor! - will-executor-host-we - struct:will-executor - 0) - (register-struct-field-accessor! will-executor-sema struct:will-executor 1) - (void))) (define do-make-will-executor (lambda (host:make-will-executor_0) (let ((sema_0 (1/make-semaphore))) @@ -14189,15 +13402,6 @@ s 'place-event 'time)))))) -(define effect_2648 - (begin - (register-struct-constructor! place-event1.1) - (register-struct-predicate! place-event?) - (register-struct-field-accessor! place-event-id struct:place-event 0) - (register-struct-field-accessor! place-event-action struct:place-event 1) - (register-struct-field-accessor! place-event-data struct:place-event 2) - (register-struct-field-accessor! place-event-time struct:place-event 3) - (void))) (define log-place.1 (|#%name| log-place @@ -14867,16 +14071,6 @@ s 'place-dead-evt 'get-result?)))))) -(define effect_2476 - (begin - (register-struct-constructor! place-done-evt3.1) - (register-struct-predicate! place-done-evt?) - (register-struct-field-accessor! place-done-evt-p struct:place-done-evt 0) - (register-struct-field-accessor! - place-done-evt-get-result? - struct:place-done-evt - 1) - (void))) (define 1/place-dead-evt (|#%name| place-dead-evt @@ -14931,41 +14125,6 @@ (|#%name| set-message-queue-waiters! (record-mutator struct:message-queue 4))) -(define effect_2130 - (begin - (register-struct-constructor! message-queue4.1) - (register-struct-predicate! message-queue?) - (register-struct-field-accessor! message-queue-lock struct:message-queue 0) - (register-struct-field-accessor! message-queue-q struct:message-queue 1) - (register-struct-field-accessor! - message-queue-rev-q - struct:message-queue - 2) - (register-struct-field-accessor! - message-queue-out-key-box - struct:message-queue - 3) - (register-struct-field-accessor! - message-queue-waiters - struct:message-queue - 4) - (register-struct-field-accessor! - message-queue-in-key-box - struct:message-queue - 5) - (register-struct-field-mutator! - set-message-queue-q! - struct:message-queue - 1) - (register-struct-field-mutator! - set-message-queue-rev-q! - struct:message-queue - 2) - (register-struct-field-mutator! - set-message-queue-waiters! - struct:message-queue - 4) - (void))) (define make-message-queue (lambda () (message-queue4.1 @@ -15222,17 +14381,6 @@ s 'place-channel 'out-key-box)))))) -(define effect_2649 - (begin - (register-struct-constructor! pchannel5.1) - (register-struct-predicate! pchannel?) - (register-struct-field-accessor! pchannel-in-mq-e struct:pchannel 0) - (register-struct-field-accessor! pchannel-out-mq-e struct:pchannel 1) - (register-struct-field-accessor! pchannel-reader-key struct:pchannel 2) - (register-struct-field-accessor! pchannel-writer-key struct:pchannel 3) - (register-struct-field-accessor! pchannel-in-key-box struct:pchannel 4) - (register-struct-field-accessor! pchannel-out-key-box struct:pchannel 5) - (void))) (define 1/place-channel? (|#%name| place-channel? @@ -15414,24 +14562,6 @@ (|#%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 effect_2759 - (begin - (register-struct-constructor! fsemaphore1.1) - (register-struct-predicate! 1/fsemaphore?) - (register-struct-field-accessor! fsemaphore-c struct:fsemaphore 0) - (register-struct-field-accessor! fsemaphore-lock struct:fsemaphore 1) - (register-struct-field-accessor! fsemaphore-dependents struct:fsemaphore 2) - (register-struct-field-accessor! fsemaphore-dep-box struct:fsemaphore 3) - (register-struct-field-mutator! set-fsemaphore-c! struct:fsemaphore 0) - (register-struct-field-mutator! - set-fsemaphore-dependents! - struct:fsemaphore - 2) - (register-struct-field-mutator! - set-fsemaphore-dep-box! - struct:fsemaphore - 3) - (void))) (define struct:fsemaphore-box-evt (make-record-type-descriptor* 'fsemaphore-box-evt #f #f #f #f 1 0)) (define effect_2902 @@ -15488,15 +14618,6 @@ s 'fsemaphore-box-evt 'b)))))) -(define effect_2342 - (begin - (register-struct-constructor! fsemaphore-box-evt2.1) - (register-struct-predicate! fsemaphore-box-evt?) - (register-struct-field-accessor! - fsemaphore-box-evt-b - struct:fsemaphore-box-evt - 0) - (void))) (define 1/make-fsemaphore (|#%name| make-fsemaphore @@ -15734,21 +14855,6 @@ v 'os-semaphore 'count)))))) -(define effect_2303 - (begin - (register-struct-constructor! os-semaphore1.1) - (register-struct-predicate! os-semaphore?) - (register-struct-field-accessor! os-semaphore-count struct:os-semaphore 0) - (register-struct-field-accessor! os-semaphore-mutex struct:os-semaphore 1) - (register-struct-field-accessor! - os-semaphore-condition - struct:os-semaphore - 2) - (register-struct-field-mutator! - set-os-semaphore-count! - struct:os-semaphore - 0) - (void))) (define 1/unsafe-make-os-semaphore (|#%name| unsafe-make-os-semaphore diff --git a/racket/src/expander/README.txt b/racket/src/expander/README.txt index e43dab5c76..409df58f28 100644 --- a/racket/src/expander/README.txt +++ b/racket/src/expander/README.txt @@ -226,6 +226,25 @@ reported by the expander. ---------------------------------------- +About structures: + +Constructors, predicates, accessors, etc., for a non-transparent +structure type are defined in the implementation of the expander are +compiled/loaded in a way that makes them claim not to be structure +procedures when built into Racket. For example, + + (struct-predicate-procedure? syntax?) ; => #f + +If a structure type's representation is exported, such as +`exn:fail:syntax`, then operations do claim to be strcuture operations + + (struct-predicate-procedure? exn:fail:syntax?) ; => #t + +As a consequence, it's ok to directly expose predicates, accessors, +etc., without exposing an implementation detail. + +---------------------------------------- + Implementation guidelines: * Do not rely on more than `racket/base` for code that will be diff --git a/racket/src/expander/compile/built-in-symbol.rkt b/racket/src/expander/compile/built-in-symbol.rkt index 480aed9297..e29dbffa4b 100644 --- a/racket/src/expander/compile/built-in-symbol.rkt +++ b/racket/src/expander/compile/built-in-symbol.rkt @@ -84,11 +84,12 @@ record-mutator record-predicate struct-type-install-properties! - register-struct-constructor! - register-struct-predicate! - register-struct-field-accessor! - register-struct-field-mutator! + #%struct-constructor + #%struct-predicate + #%struct-field-accessor + #%struct-field-mutator unsafe-struct? + unsafe-struct raise-binding-result-arity-error structure-type-lookup-prefab-uid struct-type-constructor-add-guards diff --git a/racket/src/schemify/aim.rkt b/racket/src/schemify/aim.rkt new file mode 100644 index 0000000000..69a7307f18 --- /dev/null +++ b/racket/src/schemify/aim.rkt @@ -0,0 +1,9 @@ +#lang racket/base +(provide aim?) + +;; macro statically ensures that the second argument is a valid target +(define-syntax aim? + (syntax-rules (cify interp) + [(_ e 'cify) (eq? e 'cify)] + [(_ e 'interp) (eq? e 'interp)] + [(_ e 'system) (eq? e 'system)])) diff --git a/racket/src/schemify/find-definition.rkt b/racket/src/schemify/find-definition.rkt index dc3fdcde4e..773342022d 100644 --- a/racket/src/schemify/find-definition.rkt +++ b/racket/src/schemify/find-definition.rkt @@ -11,7 +11,7 @@ ;; Record top-level functions and structure types, and returns ;; (values knowns struct-type-info-or-#f) -(define (find-definitions v prim-knowns knowns imports mutated simples unsafe-mode? for-cify? +(define (find-definitions v prim-knowns knowns imports mutated simples unsafe-mode? target #:primitives [primitives #hasheq()] ; for `optimize?` mode #:optimize? optimize?) (match v @@ -20,7 +20,7 @@ (optimize orig-rhs prim-knowns primitives knowns imports mutated) orig-rhs)) (values - (let ([k (infer-known rhs v id knowns prim-knowns imports mutated simples unsafe-mode? for-cify? + (let ([k (infer-known rhs v id knowns prim-knowns imports mutated simples unsafe-mode? target #:primitives primitives #:optimize-inline? optimize?)]) (if k @@ -43,7 +43,7 @@ (let* ([knowns (hash-set knowns (unwrap make-s) (if (struct-type-info-pure-constructor? info) - (known-constructor (arithmetic-shift 1 (struct-type-info-field-count info)) type) + (known-struct-constructor (arithmetic-shift 1 (struct-type-info-field-count info)) type struct:s) a-known-constant))] [knowns (hash-set knowns (unwrap s?) @@ -120,7 +120,7 @@ [rhs (in-list rhss)]) (define-values (new-knowns info) (find-definitions `(define-values (,id) ,rhs) - prim-knowns knowns imports mutated simples unsafe-mode? for-cify? + prim-knowns knowns imports mutated simples unsafe-mode? target #:optimize? optimize?)) new-knowns) #f)] diff --git a/racket/src/schemify/infer-known.rkt b/racket/src/schemify/infer-known.rkt index 686cebd27a..fe780f4e05 100644 --- a/racket/src/schemify/infer-known.rkt +++ b/racket/src/schemify/infer-known.rkt @@ -9,7 +9,8 @@ "literal.rkt" "inline.rkt" "mutated-state.rkt" - "optimize.rkt") + "optimize.rkt" + "aim.rkt") (provide infer-known can-improve-infer-known? @@ -18,7 +19,7 @@ ;; For definitions, it's useful to infer `a-known-constant` to reflect ;; that the variable will get a value without referencing anything ;; too early. If `post-schemify?`, then `rhs` has been schemified. -(define (infer-known rhs defn id knowns prim-knowns imports mutated simples unsafe-mode? for-cify? +(define (infer-known rhs defn id knowns prim-knowns imports mutated simples unsafe-mode? target #:primitives [primitives #hasheq()] ; for `optimize-inline?` mode #:optimize-inline? [optimize-inline? #f] #:post-schemify? [post-schemify? #f]) @@ -34,7 +35,7 @@ (let ([lam (if optimize-inline? (optimize* lam prim-knowns primitives knowns imports mutated unsafe-mode?) lam)]) - (known-procedure/can-inline arity-mask (if (and unsafe-mode? (not for-cify?)) + (known-procedure/can-inline arity-mask (if (and unsafe-mode? (not (aim? target 'cify))) (add-begin-unsafe lam) lam))) (known-procedure arity-mask))] @@ -65,7 +66,11 @@ [(or (not defn) ;; can't just return `known`; like `known-procedure/can-inline/need-imports`, ;; we'd lose track of the need to potentially propagate imports - (known-copy? known)) + (known-copy? known) + (known-struct-constructor/need-imports? known) + (known-struct-predicate/need-imports? known) + (known-field-accessor/need-imports? known) + (known-field-mutator/need-imports? known)) (known-copy rhs)] [else known]))] [defn a-known-constant] diff --git a/racket/src/schemify/inline.rkt b/racket/src/schemify/inline.rkt index 7277bc6457..f4c7bee9c7 100644 --- a/racket/src/schemify/inline.rkt +++ b/racket/src/schemify/inline.rkt @@ -88,6 +88,8 @@ (define (inline-type-id k im add-import! mutated imports) (define type-id (cond + [(known-struct-constructor? k) + (known-struct-constructor-type-id k)] [(known-struct-predicate? k) (known-struct-predicate-type-id k)] [(known-field-accessor? k) @@ -101,6 +103,10 @@ (cond [(not type-id) #f] [(not im) '()] + [(known-struct-constructor/need-imports? k) + (needed->env (known-struct-constructor/need-imports-needed k) + add-import! + im)] [(known-struct-predicate/need-imports? k) (needed->env (known-struct-predicate/need-imports-needed k) add-import! @@ -241,6 +247,17 @@ (known-procedure-arity-mask k) (if serializable? (wrap-truncate-paths expr) expr) (needed->list needed))])] + [(known-struct-constructor? k) + (define needed (needed-imports (known-struct-constructor-type-id k) prim-knowns imports exports '() '#hasheq())) + (cond + [needed + (known-struct-constructor/need-imports (known-procedure-arity-mask k) + (known-constructor-type k) + (known-struct-constructor-type-id k) + (needed->list needed))] + [else + (known-constructor (known-procedure-arity-mask k) + (known-constructor-type k))])] [(known-struct-predicate? k) (define needed (needed-imports (known-struct-predicate-type-id k) prim-knowns imports exports '() '#hasheq())) (cond diff --git a/racket/src/schemify/known.rkt b/racket/src/schemify/known.rkt index 669b53dc86..b8099d1cf6 100644 --- a/racket/src/schemify/known.rkt +++ b/racket/src/schemify/known.rkt @@ -30,9 +30,11 @@ 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-field-accessor known-field-accessor? known-field-accessor-type-id known-field-accessor-pos known-field-mutator known-field-mutator? known-field-mutator-type-id known-field-mutator-pos + known-struct-constructor/need-imports known-struct-constructor/need-imports? known-struct-constructor/need-imports-needed known-struct-predicate/need-imports known-struct-predicate/need-imports? known-struct-predicate/need-imports-needed known-field-accessor/need-imports known-field-accessor/need-imports? known-field-accessor/need-imports-needed known-field-mutator/need-imports known-field-mutator/need-imports? known-field-mutator/need-imports-needed @@ -102,9 +104,11 @@ (struct known-predicate (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/pure) (struct known-accessor (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure) (struct known-mutator (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure) +(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-field-accessor (type-id pos) #:prefab #:omit-define-syntaxes #:super struct:known-accessor) (struct known-field-mutator (type-id 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) (struct known-struct-predicate/need-imports (needed) #:prefab #:omit-define-syntaxes #:super struct:known-struct-predicate) (struct known-field-accessor/need-imports (needed) #:prefab #:omit-define-syntaxes #:super struct:known-field-accessor) (struct known-field-mutator/need-imports (needed) #:prefab #:omit-define-syntaxes #:super struct:known-field-mutator) diff --git a/racket/src/schemify/left-to-right.rkt b/racket/src/schemify/left-to-right.rkt index ec244c670c..a22637b557 100644 --- a/racket/src/schemify/left-to-right.rkt +++ b/racket/src/schemify/left-to-right.rkt @@ -2,7 +2,8 @@ (require "wrap.rkt" "match.rkt" "simple.rkt" - "gensym.rkt") + "gensym.rkt" + "aim.rkt") (provide left-to-right/let left-to-right/let-values @@ -47,13 +48,13 @@ ;; Convert a `let-values` to nested `let-values`es to ;; enforce order -(define (left-to-right/let-values idss rhss bodys mutated for-cify?) +(define (left-to-right/let-values idss rhss bodys mutated target) (cond [(null? (cdr idss)) (define e (if (null? (cdr bodys)) (car bodys) `(begin . ,bodys))) - (make-let-values (car idss) (car rhss) e for-cify?)] + (make-let-values (car idss) (car rhss) e target)] [else (let loop ([idss idss] [rhss rhss] [binds null]) (cond @@ -62,7 +63,7 @@ (car idss) (car rhss) `(let ,binds . ,bodys) - for-cify?)] + target)] [else (define ids (car idss)) (make-let-values @@ -71,14 +72,14 @@ (loop (cdr idss) (cdr rhss) (append (for/list ([id (in-wrap-list ids)]) `[,id ,id]) binds)) - for-cify?)]))])) + target)]))])) ;; Convert an application to enforce left-to-right ;; evaluation order -(define (left-to-right/app rator rands plain-app? for-cify? +(define (left-to-right/app rator rands plain-app? target prim-knowns knowns imports mutated simples) (cond - [for-cify? (cons rator rands)] + [(aim? target 'cify) (cons rator rands)] [else (let loop ([l (cons rator rands)] [accum null] [pending-non-simple #f] [pending-id #f]) (cond @@ -110,7 +111,7 @@ ;; ---------------------------------------- -(define (make-let-values ids rhs body for-cify?) +(define (make-let-values ids rhs body target) (cond [(and (pair? ids) (null? (cdr ids))) `(let ([,(car ids) ,rhs]) ,body)] @@ -120,7 +121,7 @@ `(begin ,rhs ,body)] [`,_ (cond - [for-cify? + [(aim? target 'cify) ;; No checking `(call-with-values (lambda () ,rhs) (lambda ,ids ,body))] diff --git a/racket/src/schemify/letrec.rkt b/racket/src/schemify/letrec.rkt index b490ecfd7c..bdba93f160 100644 --- a/racket/src/schemify/letrec.rkt +++ b/racket/src/schemify/letrec.rkt @@ -2,7 +2,8 @@ (require "wrap.rkt" "match.rkt" "infer-known.rkt" - "mutated-state.rkt") + "mutated-state.rkt" + "aim.rkt") (provide letrec-splitable-values-binding? letrec-split-values-binding @@ -27,9 +28,9 @@ `[(,id) ,rhs]) . ,bodys)) -(define (letrec-conversion ids mutated for-cify? e) +(define (letrec-conversion ids mutated target e) (define need-convert? - (and (not for-cify?) + (and (not (aim? target 'cify)) (let loop ([ids ids]) (cond [(symbol? ids) diff --git a/racket/src/schemify/mutated.rkt b/racket/src/schemify/mutated.rkt index 1db1f685b5..906ac1c926 100644 --- a/racket/src/schemify/mutated.rkt +++ b/racket/src/schemify/mutated.rkt @@ -24,7 +24,7 @@ ;; This pass is also responsible for recording when a letrec binding ;; must be mutated implicitly via `call/cc`. -(define (mutated-in-body l exports prim-knowns knowns imports simples unsafe-mode? for-cify? enforce-constant?) +(define (mutated-in-body l exports prim-knowns knowns imports simples unsafe-mode? target enforce-constant?) ;; Find all `set!`ed variables, and also record all bindings ;; that might be used too early (define mutated (make-hasheq)) @@ -53,7 +53,7 @@ ;; that information is correct, because it dynamically precedes ;; the `set!` (define-values (knowns info) - (find-definitions form prim-knowns prev-knowns imports mutated simples unsafe-mode? for-cify? + (find-definitions form prim-knowns prev-knowns imports mutated simples unsafe-mode? target #:optimize? #f)) (match form [`(define-values (,ids ...) ,rhs) diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index 1ba4376c6f..7e404068db 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -24,7 +24,8 @@ "literal.rkt" "authentic.rkt" "single-valued.rkt" - "gensym.rkt") + "gensym.rkt" + "aim.rkt") (provide schemify-linklet schemify-body) @@ -78,7 +79,7 @@ ;; means that a variable (which boxes a value) is expected. ;; If `serializable?-box` is not #f, it is filled with a ;; hash table of objects that need to be handled by `racket/fasl`. -(define (schemify-linklet lk serializable?-box datum-intern? for-interp? allow-set!-undefined? +(define (schemify-linklet lk serializable?-box datum-intern? target allow-set!-undefined? unsafe-mode? enforce-constant? allow-inline? no-prompt? prim-knowns primitives get-import-knowns import-keys) (with-deterministic-gensym @@ -134,7 +135,7 @@ ;; Schemify the body, collecting information about defined names: (define-values (new-body defn-info mutated) (schemify-body* bodys prim-knowns primitives imports exports - serializable?-box datum-intern? for-interp? allow-set!-undefined? add-import! #f + serializable?-box datum-intern? allow-set!-undefined? add-import! target unsafe-mode? enforce-constant? allow-inline? no-prompt? #t)) (define all-grps (append grps (reverse new-grps))) (values @@ -188,28 +189,28 @@ ;; ---------------------------------------- (define (schemify-body l prim-knowns primitives imports exports - for-cify? unsafe-mode? no-prompt? explicit-unnamed?) + target unsafe-mode? no-prompt? explicit-unnamed?) (with-deterministic-gensym (define-values (new-body defn-info mutated) (schemify-body* l prim-knowns primitives imports exports - #f #f #f #f (lambda (im ext-id index) #f) - for-cify? unsafe-mode? #t #t no-prompt? explicit-unnamed?)) + #f #f #f (lambda (im ext-id index) #f) + target unsafe-mode? #t #t no-prompt? explicit-unnamed?)) new-body)) (define (schemify-body* l prim-knowns primitives imports exports - serializable?-box datum-intern? for-interp? allow-set!-undefined? add-import! - for-cify? unsafe-mode? enforce-constant? allow-inline? no-prompt? explicit-unnamed?) + serializable?-box datum-intern? allow-set!-undefined? add-import! + target unsafe-mode? enforce-constant? allow-inline? no-prompt? explicit-unnamed?) ;; Keep simple checking efficient by caching results (define simples (make-hasheq)) ;; Various conversion steps need information about mutated variables, ;; where "mutated" here includes visible implicit mutation, such as ;; a variable that might be used before it is defined: - (define mutated (mutated-in-body l exports prim-knowns (hasheq) imports simples unsafe-mode? for-cify? enforce-constant?)) + (define mutated (mutated-in-body l exports prim-knowns (hasheq) imports simples unsafe-mode? target enforce-constant?)) ;; Make another pass to gather known-binding information: (define knowns (for/fold ([knowns (hasheq)]) ([form (in-list l)]) (define-values (new-knowns info) - (find-definitions form prim-knowns knowns imports mutated simples unsafe-mode? for-cify? + (find-definitions form prim-knowns knowns imports mutated simples unsafe-mode? target #:primitives primitives #:optimize? #t)) new-knowns)) @@ -231,7 +232,7 @@ (define (make-set-variables) ;; Resulting list of assinments will be reversed (cond - [(or for-cify? for-interp?) + [(or (aim? target 'cify) (aim? target 'interp)) (for/list ([id (in-list accum-ids)] #:when (hash-ref exports (unwrap id) #f)) (make-set-variable id exports knowns mutated))] @@ -256,7 +257,7 @@ [else (loop (cdr accum-ids) consistent-ids)])]))])) (define (make-expr-defns es) - (if (or for-interp? for-cify?) + (if (or (aim? target 'cify) (aim? target 'interp)) (reverse es) (for/list ([e (in-list (reverse es))]) (make-expr-defn e)))) @@ -278,7 +279,7 @@ prim-knowns primitives knowns mutated imports exports simples allow-set!-undefined? add-import! - serializable?-box datum-intern? for-cify? for-interp? + serializable?-box datum-intern? target unsafe-mode? allow-inline? no-prompt? explicit-unnamed? (if (and no-prompt? (null? (cdr l))) 'tail @@ -299,7 +300,7 @@ (define id (car ids)) (define k (match schemified [`(define ,id ,rhs) - (infer-known rhs #f id knowns prim-knowns imports mutated simples unsafe-mode? for-cify? + (infer-known rhs #f id knowns prim-knowns imports mutated simples unsafe-mode? target #:post-schemify? #t)])) (if k (hash-set knowns (unwrap id) k) @@ -314,7 +315,7 @@ [(null? ids) (if next-k (next-k accum-exprs accum-ids next-knowns) (loop (cdr l) mut-l accum-exprs accum-ids next-knowns))] - [(or (or for-interp? for-cify?) + [(or (or (aim? target 'interp) (aim? target 'cify)) (via-variable-mutated-state? (hash-ref mutated (unwrap (car ids)) #f))) (define id (unwrap (car ids))) (cond @@ -356,7 +357,7 @@ (for/list ([id (in-list ids)]) (make-define-variable id exports knowns mutated extra-variables))) (cons - (if for-interp? + (if (aim? target 'interp) expr (make-expr-defn expr)) (append defns (loop (cdr l) mut-l null null knowns)))]))) @@ -474,7 +475,7 @@ ;; a 'too-early state in `mutated` for a `letrec`-bound variable can be ;; effectively canceled with a mapping in `knowns`. (define (schemify v prim-knowns primitives knowns mutated imports exports simples allow-set!-undefined? add-import! - serializable?-box datum-intern? for-cify? for-interp? unsafe-mode? allow-inline? no-prompt? explicit-unnamed? + serializable?-box datum-intern? target unsafe-mode? allow-inline? no-prompt? explicit-unnamed? wcm-state) ;; `wcm-state` is one of: 'tail (= unknown), 'fresh (= no marks), or 'marked (= some marks) (let schemify/knowns ([knowns knowns] [inline-fuel init-inline-fuel] [wcm-state wcm-state] [v v]) @@ -501,10 +502,11 @@ ,make2 ,?2 ,make-acc/muts ...))) - #:guard (not (or for-interp? for-cify?)) + #:guard (not (or (aim? target 'interp) (aim? target 'cify))) (define new-seq - (struct-convert v prim-knowns knowns imports mutated - (lambda (v knowns) (schemify/knowns knowns inline-fuel 'fresh v)) no-prompt?)) + (struct-convert v prim-knowns knowns imports exports mutated + (lambda (v knowns) (schemify/knowns knowns inline-fuel 'fresh v)) + target no-prompt?)) (or new-seq (match v [`(,_ ,ids ,rhs) @@ -534,7 +536,7 @@ (define new-knowns (for/fold ([knowns knowns]) ([id (in-list ids)] [rhs (in-list rhss)]) - (define k (infer-known rhs #f id knowns prim-knowns imports mutated simples unsafe-mode? for-cify?)) + (define k (infer-known rhs #f id knowns prim-knowns imports mutated simples unsafe-mode? target)) (if k (hash-set knowns (unwrap id) k) knowns))) @@ -559,18 +561,18 @@ [`(let-values ([() (begin ,rhss ... (values))]) ,bodys ...) `(begin ,@(schemify-body rhss 'fresh) ,@(schemify-body bodys wcm-state))] [`(let-values ([,idss ,rhss] ...) ,bodys ...) - (or (and (not (or for-interp? for-cify?)) + (or (and (not (or (aim? target 'interp) (aim? target 'cify))) (struct-convert-local v prim-knowns knowns imports mutated simples (lambda (v knowns) (schemify/knowns knowns inline-fuel 'fresh v)) #:unsafe-mode? unsafe-mode? - #:for-cify? for-cify?)) + #:target target)) (unnest-let (left-to-right/let-values idss (for/list ([rhs (in-list rhss)]) (schemify rhs 'fresh)) (schemify-body bodys wcm-state) mutated - for-cify?) + target) prim-knowns knowns imports mutated simples))] [`(letrec-values () ,bodys ...) (schemify `(begin . ,bodys) wcm-state)] @@ -583,7 +585,7 @@ (define-values (rhs-knowns body-knowns) (for/fold ([rhs-knowns knowns] [body-knowns knowns]) ([id (in-list ids)] [rhs (in-list rhss)]) - (define k (infer-known rhs #f id knowns prim-knowns imports mutated simples unsafe-mode? for-cify?)) + (define k (infer-known rhs #f id knowns prim-knowns imports mutated simples unsafe-mode? target)) (define u-id (unwrap id)) (cond [(too-early-mutated-state? (hash-ref mutated u-id #f)) @@ -592,7 +594,7 @@ [else (values rhs-knowns body-knowns)]))) (unnest-let (letrec-conversion - ids mutated for-cify? + ids mutated target `(letrec* ,(for/list ([id (in-list ids)] [rhs (in-list rhss)]) `[,id ,(schemify/knowns rhs-knowns inline-fuel 'fresh rhs)]) @@ -604,7 +606,7 @@ [(struct-convert-local v #:letrec? #t prim-knowns knowns imports mutated simples (lambda (v knowns) (schemify/knowns knowns inline-fuel 'fresh v)) #:unsafe-mode? unsafe-mode? - #:for-cify? for-cify?) + #:target target) => (lambda (form) form)] [(letrec-splitable-values-binding? idss rhss) (schemify @@ -619,7 +621,7 @@ ;; ... ...) ;; ....) (letrec-conversion - idss mutated for-cify? + idss mutated target `(letrec* ,(apply append (for/list ([ids (in-list idss)] @@ -628,12 +630,12 @@ (cond [(null? ids) `([,(deterministic-gensym "lr") - ,(make-let-values null rhs '(void) for-cify?)])] + ,(make-let-values null rhs '(void) target)])] [(and (pair? ids) (null? (cdr ids))) `([,(car ids) ,rhs])] [else (define lr (deterministic-gensym "lr")) - `([,lr ,(make-let-values ids rhs `(vector . ,ids) for-cify?)] + `([,lr ,(make-let-values ids rhs `(vector . ,ids) target)] ,@(for/list ([id (in-list ids)] [pos (in-naturals)]) `[,id (unsafe-vector*-ref ,lr ,pos)]))])))) @@ -652,7 +654,7 @@ `(begin ,(ensure-single-valued s-key knowns prim-knowns imports mutated) ,(ensure-single-valued s-val knowns prim-knowns imports mutated) ,s-body)] - [for-cify? + [(aim? target 'cify) `(with-continuation-mark ,s-key ,s-val ,s-body)] [else (define mode @@ -686,7 +688,7 @@ [else (cond [(and (too-early-mutated-state? state) - (not for-cify?)) + (not (aim? target 'cify))) (define tmp (deterministic-gensym "set")) `(let ([,tmp ,new-rhs]) (check-not-unsafe-undefined/assign ,id ',(too-early-mutated-state-name state int-id)) @@ -745,7 +747,7 @@ [else (left-to-right/app 'equal? (list exp1 exp2) - #t for-cify? + #t target prim-knowns knowns imports mutated simples)]))] [`(call-with-values ,generator ,receiver) (cond @@ -754,13 +756,13 @@ (eq? (unwrap receiver) 'list))) `(call-with-values ,(schemify generator 'fresh) ,(schemify receiver 'fresh))] [else - (left-to-right/app (if for-cify? 'call-with-values '#%call-with-values) + (left-to-right/app (if (aim? target 'cify) 'call-with-values '#%call-with-values) (list (schemify generator 'fresh) (schemify receiver 'fresh)) - #t for-cify? + #t target prim-knowns knowns imports mutated simples)])] [`(single-flonum-available?) ;; Fold to a boolean to allow earlier simplification - for-cify?] + (aim? target 'cify)] [`((letrec-values ,binds ,rator) ,rands ...) (schemify `(letrec-values ,binds (,rator . ,rands)) wcm-state)] [`(,rator ,exps ...) @@ -812,11 +814,18 @@ body `(let ([,tmp ,e]) ,body))) + (define (inline-struct-constructor k s-rator im args) + (define type-id (and (bitwise-bit-set? (known-procedure-arity-mask k) (length args)) + (inline-type-id k im add-import! mutated imports))) + (cond + [type-id + (left-to-right/app 'unsafe-struct + (cons (schemify type-id 'fresh) args) + #t target + prim-knowns knowns imports mutated simples)] + [else #f])) (define (inline-struct-predicate k s-rator im args) - ;; For imported predicates on authentic structure types, it's worth - ;; inlining the predicate to enable cptypes optimizations. - (define type-id (and im - (known-struct-predicate-authentic? k) + (define type-id (and (known-struct-predicate-authentic? k) (pair? args) (null? (cdr args)) (inline-type-id k im add-import! mutated imports))) @@ -828,24 +837,23 @@ ques)] [else #f])) (define (inline-field-access k s-rator im args) - ;; For imported accessors or for JIT mode, inline the - ;; selector with an `unsafe-struct?` test plus `unsafe-struct*-ref`. - (define type-id (and (or im for-interp?) - (pair? args) + ;; Inline the selector with an `unsafe-struct?` test plus `unsafe-struct*-ref`. + (define type-id (and (pair? args) (null? (cdr args)) (inline-type-id k im add-import! mutated imports))) (cond [type-id (define tmp (maybe-tmp (car args) 'v)) - (define sel `(if (unsafe-struct? ,tmp ,(schemify type-id 'fresh)) - (unsafe-struct*-ref ,tmp ,(known-field-accessor-pos k)) - (,s-rator ,tmp))) + (define sel (if unsafe-mode? + `(unsafe-struct*-ref ,tmp ,(known-field-accessor-pos k)) + `(if (unsafe-struct? ,tmp ,(schemify type-id 'fresh)) + (unsafe-struct*-ref ,tmp ,(known-field-accessor-pos k)) + (,s-rator ,tmp)))) (wrap-tmp tmp (car args) sel)] [else #f])) (define (inline-field-mutate k s-rator im args) - (define type-id (and (or im for-interp?) - (pair? args) + (define type-id (and (pair? args) (pair? (cdr args)) (null? (cddr args)) (inline-type-id k im add-import! mutated imports))) @@ -853,9 +861,11 @@ [type-id (define tmp (maybe-tmp (car args) 'v)) (define tmp-rhs (maybe-tmp (cadr args) 'rhs)) - (define mut `(if (unsafe-struct? ,tmp ,(schemify type-id 'fresh)) - (unsafe-struct*-set! ,tmp ,(known-field-mutator-pos k) ,tmp-rhs) - (,s-rator ,tmp ,tmp-rhs))) + (define mut (if unsafe-mode? + `(unsafe-struct*-set! ,tmp ,(known-field-mutator-pos k) ,tmp-rhs) + `(if (unsafe-struct? ,tmp ,(schemify type-id 'fresh)) + (unsafe-struct*-set! ,tmp ,(known-field-mutator-pos k) ,tmp-rhs) + (,s-rator ,tmp ,tmp-rhs)))) (wrap-tmp tmp (car args) (wrap-tmp tmp-rhs (cadr args) mut))] @@ -873,17 +883,30 @@ => (lambda (e) (left-to-right/app (car e) (cdr e) - #t for-cify? + #t target prim-knowns knowns imports mutated simples))] - [(and (not for-cify?) + [(and (not (or + ;; Don't inline in cify mode, because cify takes care of it + (aim? target 'cify) + ;; Don't inline in 'system mode, because there will + ;; be no `|#%struct-constructor| in the way, and + ;; it's more readable to use the normal constructor name + (aim? target 'system))) + (known-struct-constructor? k) + (inline-struct-constructor k s-rator im args)) + => (lambda (e) e)] + [(and (not (or (aim? target 'cify) + (aim? target 'system))) (known-struct-predicate? k) (inline-struct-predicate k s-rator im args)) => (lambda (e) e)] - [(and (not for-cify?) + [(and (not (or (aim? target 'cify) + (aim? target 'system))) (known-field-accessor? k) (inline-field-access k s-rator im args)) => (lambda (e) e)] - [(and (not for-cify?) + [(and (not (or (aim? target 'cify) + (aim? target 'system))) (known-field-mutator? k) (inline-field-mutate k s-rator im args)) => (lambda (e) e)] @@ -891,14 +914,14 @@ (known-procedure/has-unsafe? k)) (left-to-right/app (known-procedure/has-unsafe-alternate k) args - #t for-cify? + #t target prim-knowns knowns imports mutated simples)] [else (define plain-app? (or (known-procedure? k) (lambda? rator))) (left-to-right/app s-rator args - plain-app? for-cify? + plain-app? target prim-knowns knowns imports mutated simples)])))] [`,_ (let ([u-v (unwrap v)]) @@ -944,7 +967,7 @@ (schemify (known-copy-id k) wcm-state)] [else v]))] [(and (too-early-mutated-state? state) - (not for-cify?)) + (not (aim? target 'cify))) ;; Note: we don't get to this case if `knowns` has ;; a mapping that says the variable is ready by now `(check-not-unsafe-undefined ,v ',(too-early-mutated-state-name state u-v))] diff --git a/racket/src/schemify/struct-convert.rkt b/racket/src/schemify/struct-convert.rkt index a2d1f0fad2..81cc785c8d 100644 --- a/racket/src/schemify/struct-convert.rkt +++ b/racket/src/schemify/struct-convert.rkt @@ -4,13 +4,15 @@ "struct-type-info.rkt" "mutated-state.rkt" "find-definition.rkt" - "gensym.rkt") + "gensym.rkt" + "known.rkt" + "aim.rkt") (provide struct-convert struct-convert-local) -(define (struct-convert form prim-knowns knowns imports mutated - schemify no-prompt?) +(define (struct-convert form prim-knowns knowns imports exports mutated + schemify target no-prompt?) (match form [`(define-values (,struct:s ,make-s ,s? ,acc/muts ...) (let-values (((,struct: ,make ,?1 ,-ref ,-set!) ,mk)) @@ -55,6 +57,9 @@ (not (set!ed-mutated-state? (hash-ref mutated (unwrap struct:s) #f))))) (define can-impersonate? (not (struct-type-info-authentic? sti))) (define raw-s? (if can-impersonate? (deterministic-gensym (unwrap s?)) s?)) + (define system-opaque? (and (aim? target 'system) + (or (not exports) + (eq? 'no (hash-ref exports (unwrap struct:s) 'no))))) `(begin (define ,struct:s (make-record-type-descriptor* ',(struct-type-info-name sti) ,(schemify (struct-type-info-parent sti) knowns) @@ -99,22 +104,33 @@ ctr `(struct-type-constructor-add-guards ,ctr ,struct:s ',(struct-type-info-name sti)))) (define name-expr (struct-type-info-constructor-name-expr sti)) - (match name-expr - [`#f - (wrap-property-set ctr-expr 'inferred-name (struct-type-info-name sti))] - [`',sym - (if (symbol? sym) - (wrap-property-set ctr-expr 'inferred-name sym) - `(procedure-rename ,ctr-expr ,name-expr))] - [`,_ - `(procedure-rename ,ctr-expr ,name-expr)]))) - (define ,raw-s? ,(name-procedure - "" (struct-type-info-name sti) "" '|| "?" - `(record-predicate ,struct:s))) + (define c + (match name-expr + [`#f + (wrap-property-set ctr-expr 'inferred-name (struct-type-info-name sti))] + [`',sym + (if (symbol? sym) + (wrap-property-set ctr-expr 'inferred-name sym) + `(procedure-rename ,ctr-expr ,name-expr))] + [`,_ + `(procedure-rename ,ctr-expr ,name-expr)])) + (if system-opaque? + c + `(#%struct-constructor ,c ,(arithmetic-shift 1 (struct-type-info-field-count sti)))))) + (define ,raw-s? ,(let ([p (name-procedure + "" (struct-type-info-name sti) "" '|| "?" + `(record-predicate ,struct:s))]) + (if (or can-impersonate? + system-opaque?) + p + `(#%struct-predicate ,p)))) ,@(if can-impersonate? - `((define ,s? ,(name-procedure - "" (struct-type-info-name sti) "" '|| "?" - `(lambda (v) (if (,raw-s? v) #t ($value (if (impersonator? v) (,raw-s? (impersonator-val v)) #f))))))) + `((define ,s? ,(let ([p (name-procedure + "" (struct-type-info-name sti) "" '|| "?" + `(lambda (v) (if (,raw-s? v) #t ($value (if (impersonator? v) (,raw-s? (impersonator-val v)) #f)))))]) + (if system-opaque? + p + `(#%struct-predicate ,p))))) null) ,@(for/list ([acc/mut (in-list acc/muts)] [make-acc/mut (in-list make-acc/muts)]) @@ -122,52 +138,53 @@ (match make-acc/mut [`(make-struct-field-accessor ,(? (lambda (v) (wrap-eq? v -ref))) ,pos ',field-name) (define raw-def `(define ,raw-acc/mut - ,(name-procedure - "" (struct-type-info-name sti) "-" field-name "" - `(record-accessor ,struct:s ,pos)))) + ,(let ([p (name-procedure + "" (struct-type-info-name sti) "-" field-name "" + `(record-accessor ,struct:s ,pos))]) + (if (or can-impersonate? + system-opaque?) + p + `(#%struct-field-accessor ,p ,struct:s ,pos))))) (if can-impersonate? `(begin ,raw-def (define ,acc/mut - ,(name-procedure - "" (struct-type-info-name sti) "-" field-name "" - `(lambda (s) (if (,raw-s? s) - (,raw-acc/mut s) - ($value (impersonate-ref ,raw-acc/mut ,struct:s ,pos s - ',(struct-type-info-name sti) ',field-name))))))) + ,(let ([p (name-procedure + "" (struct-type-info-name sti) "-" field-name "" + `(lambda (s) (if (,raw-s? s) + (,raw-acc/mut s) + ($value (impersonate-ref ,raw-acc/mut ,struct:s ,pos s + ',(struct-type-info-name sti) ',field-name)))))]) + (if system-opaque? + p + `(#%struct-field-accessor ,p ,struct:s ,pos))))) raw-def)] [`(make-struct-field-mutator ,(? (lambda (v) (wrap-eq? v -set!))) ,pos ',field-name) (define raw-def `(define ,raw-acc/mut - ,(name-procedure - "set-" (struct-type-info-name sti) "-" field-name "!" - `(record-mutator ,struct:s ,pos)))) + ,(let ([p (name-procedure + "set-" (struct-type-info-name sti) "-" field-name "!" + `(record-mutator ,struct:s ,pos))]) + (if (or can-impersonate? + system-opaque?) + p + `(#%struct-field-mutator ,p ,struct:s ,pos))))) (define abs-pos (+ pos (- (struct-type-info-field-count sti) (struct-type-info-immediate-field-count sti)))) (if can-impersonate? `(begin ,raw-def (define ,acc/mut - ,(name-procedure - "set-" (struct-type-info-name sti) "-" field-name "!" - `(lambda (s v) (if (,raw-s? s) - (,raw-acc/mut s v) - ($value (impersonate-set! ,raw-acc/mut ,struct:s ,pos ,abs-pos s v - ',(struct-type-info-name sti) ',field-name))))))) + ,(let ([p (name-procedure + "set-" (struct-type-info-name sti) "-" field-name "!" + `(lambda (s v) (if (,raw-s? s) + (,raw-acc/mut s v) + ($value (impersonate-set! ,raw-acc/mut ,struct:s ,pos ,abs-pos s v + ',(struct-type-info-name sti) ',field-name)))))]) + (if system-opaque? + p + `(#%struct-field-mutator ,p ,struct:s ,pos))))) raw-def)] - [`,_ (error "oops")])) - (define ,(deterministic-gensym "effect") - (begin - (register-struct-constructor! ,make-s) - (register-struct-predicate! ,s?) - ,@(for/list ([acc/mut (in-list acc/muts)] - [make-acc/mut (in-list make-acc/muts)]) - (match make-acc/mut - [`(make-struct-field-accessor ,_ ,pos ,_) - `(register-struct-field-accessor! ,acc/mut ,struct:s ,pos)] - [`(make-struct-field-mutator ,_ ,pos ,_) - `(register-struct-field-mutator! ,acc/mut ,struct:s ,pos)] - [`,_ (error "oops")])) - (void))))] + [`,_ (error "oops")])))] [else #f])] [`,_ #f])) @@ -175,19 +192,19 @@ prim-knowns knowns imports mutated simples schemify #:unsafe-mode? unsafe-mode? - #:for-cify? for-cify?) + #:target target) (match form [`(,_ ([,ids ,rhs]) ,bodys ...) (define defn `(define-values ,ids ,rhs)) (define new-seq (struct-convert defn - prim-knowns knowns imports mutated - schemify #t)) + prim-knowns knowns imports #f mutated + schemify target #t)) (and new-seq (match new-seq [`(begin . ,new-seq) (define-values (new-knowns info) - (find-definitions defn prim-knowns knowns imports mutated simples unsafe-mode? for-cify? + (find-definitions defn prim-knowns knowns imports mutated simples unsafe-mode? target #:optimize? #f)) (cond [letrec? diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index decac23b5e..891c36f4b2 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 9 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 10 +#define MZSCHEME_VERSION_W 11 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x