From 72d278cb84d1d9a0c7e6a876af4441bbe2843914 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 18 Dec 2020 14:02:15 -0700 Subject: [PATCH] cs: take advantage of new lifting in Chez Scheme Since Chez Scheme now performs the kind of closure conversion that Racket does --- ensuring that a closure is not allocated if it is bound to an identifier that is used only in application positions --- the variant in schemify is not longer run. The hacky macro-based lifter in the "rumble" layer can also go. The lifting pass is still preserved in schemify, because it is still useful to cify. It's not clear whether interpreter mode (which is used during macro expansion for compile-time code that doesn't cross a module boundary) is better off with or without schemify's lift, but it's gone for now. --- .makefile | 2 +- Makefile | 12 +- pkgs/base/info.rkt | 2 +- .../scribblings/reference/compiler.scrbl | 3 - racket/src/ChezScheme/makefiles/Mf-install.in | 2 +- racket/src/ChezScheme/mats/cp0.ms | 9 + racket/src/ChezScheme/s/cmacros.ss | 2 +- racket/src/ChezScheme/s/cp0.ss | 16 +- racket/src/cs/Makefile | 3 +- racket/src/cs/README.txt | 10 +- racket/src/cs/compile-file.ss | 2 +- racket/src/cs/convert.rkt | 5 +- racket/src/cs/linklet.sls | 26 +- racket/src/cs/rumble.sls | 8 +- racket/src/cs/rumble/check.ss | 30 +- racket/src/cs/rumble/define.ss | 571 - racket/src/cs/rumble/error.ss | 11 +- racket/src/cs/rumble/foreign.ss | 41 +- racket/src/cs/rumble/impersonator.ss | 9 +- racket/src/cs/rumble/list.ss | 2 +- racket/src/cs/rumble/struct.ss | 34 +- racket/src/cs/schemified/expander.scm | 60014 +++++++------ racket/src/cs/schemified/io.scm | 21081 +++-- racket/src/cs/schemified/regexp.scm | 5157 +- racket/src/cs/schemified/schemify.scm | 70288 +++++++--------- racket/src/cs/schemified/thread.scm | 5581 +- racket/src/cs/schemify.sls | 1 - racket/src/schemify/lift.rkt | 2 +- racket/src/schemify/main.rkt | 4 - racket/src/schemify/schemify.rkt | 20 +- racket/src/version/racket_version.h | 2 +- 31 files changed, 74152 insertions(+), 88798 deletions(-) delete mode 100644 racket/src/cs/rumble/define.ss diff --git a/.makefile b/.makefile index 47f4f7b13b..85c10b3d16 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.14-2 +PB_BRANCH == circa-7.9.0.15-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 00e6066821..12989afd16 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.14-2 +PB_BRANCH = circa-7.9.0.15-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.14-2 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.14-2:remotes/origin/circa-7.9.0.14-2 ; fi - cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.14-2 + if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-7.9.0.15-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.15-1:remotes/origin/circa-7.9.0.15-1 ; fi + cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.15-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.14-2 - cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.14-2 + cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.15-1 + cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.15-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.14-2 + cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.15-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 db6dae94a3..46a6c72413 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.14") +(define version "7.9.0.15") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/compiler.scrbl b/pkgs/racket-doc/scribblings/reference/compiler.scrbl index d4b0a04a97..1e050e9019 100644 --- a/pkgs/racket-doc/scribblings/reference/compiler.scrbl +++ b/pkgs/racket-doc/scribblings/reference/compiler.scrbl @@ -91,9 +91,6 @@ forms or adjust the way forms are displayed: generated names, instead of abbreviations that may conflate different symbols} - @item{@envvar-indexed{PLT_LINKLET_SHOW_PRE_LIFT} --- shows a - schemified forms before closure transformations are applied} - @item{@envvar-indexed{PLT_LINKLET_SHOW_PRE_JIT} --- shows a schemified forms before a transformation to JIT mode, which applies only when @envvar{PLT_CS_JIT} is set} diff --git a/racket/src/ChezScheme/makefiles/Mf-install.in b/racket/src/ChezScheme/makefiles/Mf-install.in index c6c3d08075..95ea1cc64d 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.56 +Version=csv9.5.3.57 Include=boot/$m PetiteBoot=boot/$m/petite.boot SchemeBoot=boot/$m/scheme.boot diff --git a/racket/src/ChezScheme/mats/cp0.ms b/racket/src/ChezScheme/mats/cp0.ms index b00253a2de..25ca4005cb 100644 --- a/racket/src/ChezScheme/mats/cp0.ms +++ b/racket/src/ChezScheme/mats/cp0.ms @@ -3214,6 +3214,15 @@ '(begin (g) 5) '(begin (#3%$value (g)) 5))) + (equivalent-expansion? + (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f]) + (expand/optimize '(let ([f (#2%make-wrapper-procedure (lambda (x) x) 2 'data)]) (#2%list f (f 5))))) + '(#2%list (#2%make-wrapper-procedure (lambda (x) x) 2 'data) 5)) + (equivalent-expansion? + (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f]) + (expand/optimize '(let ([f (#2%make-arity-wrapper-procedure (lambda (x) x) 2 'data)]) (#2%list f (f 5))))) + '(#2%list (#2%make-arity-wrapper-procedure (lambda (x) x) 2 'data) 5)) + (not (equivalent-expansion? (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f]) diff --git a/racket/src/ChezScheme/s/cmacros.ss b/racket/src/ChezScheme/s/cmacros.ss index 5f6945d726..d0aeee7d76 100644 --- a/racket/src/ChezScheme/s/cmacros.ss +++ b/racket/src/ChezScheme/s/cmacros.ss @@ -357,7 +357,7 @@ ;; --------------------------------------------------------------------- ;; Version and machine types: -(define-constant scheme-version #x09050338) +(define-constant scheme-version #x09050339) (define-syntax define-machine-types (lambda (x) diff --git a/racket/src/ChezScheme/s/cp0.ss b/racket/src/ChezScheme/s/cp0.ss index 4f1c8b1546..854a1104a4 100644 --- a/racket/src/ChezScheme/s/cp0.ss +++ b/racket/src/ChezScheme/s/cp0.ss @@ -1923,7 +1923,7 @@ (define copy2 ; ctxt is value, test, or app (lambda (maybe-src id opnd ctxt sc wd name moi) - (let ([rhs (result-exp (operand-value opnd))]) + (let loop ([rhs (result-exp (operand-value opnd))]) (nanopass-case (Lsrc Expr) rhs [(case-lambda ,preinfo1 ,cl* ...) (context-case ctxt @@ -1989,6 +1989,20 @@ true-rec (residualize-ref maybe-src id sc))] [else (fold-primref rhs ctxt sc wd name moi)])] + [(call ,preinfo ,pr ,e1 ,e2 ,e3) + ;; inline wrapped procedure, if it's easy: + (guard (app? ctxt) + (or (eq? (primref-name pr) 'make-wrapper-procedure) + (eq? (primref-name pr) 'make-arity-wrapper-procedure)) + (nanopass-case (Lsrc Expr) e2 + [(quote ,d) + (and (exact? d) (integer? d) + (bitwise-bit-set? d (length (app-opnds ctxt))))] + [else #f]) + (nanopass-case (Lsrc Expr) e2 + [(quote ,d) #t] + [else #f])) + (loop e1)] [else (residualize-ref maybe-src id sc)])))) (define fold-primref diff --git a/racket/src/cs/Makefile b/racket/src/cs/Makefile index 462413e931..d17a8a1c7c 100644 --- a/racket/src/cs/Makefile +++ b/racket/src/cs/Makefile @@ -258,8 +258,7 @@ future-demo: $(BUILDDIR)rumble.$(CSO) future2-demo: $(BUILDDIR)rumble.$(CSO) $(SCHEME) $(BUILDDIR)chezpart.$(CSO) $(BUILDDIR)rumble.$(CSO) demo/future2.ss -RUMBLE_SRCS = rumble/define.ss \ - rumble/virtual-register.ss \ +RUMBLE_SRCS = rumble/virtual-register.ss \ rumble/layout.ss \ rumble/check.ss \ rumble/syntax-rule.ss \ diff --git a/racket/src/cs/README.txt b/racket/src/cs/README.txt index 723370bc16..5b1175aa29 100644 --- a/racket/src/cs/README.txt +++ b/racket/src/cs/README.txt @@ -132,7 +132,10 @@ Racket CS currently supports three compilation modes: interpreter around the compiled parts). Select this mode by setting the `PLT_CS_MACH` environment variable, - but it's currently the default. + but it's currently the default. When this mode is selected, + interpreter mode is still used for compile-time code that does not + span a module (or, more generally, for the 'quick option to + `compile-linklet` and similar functions). When the "cs" suffix is used for build mode, compiled ".zo" files in this mode are written to a subdirectory of "compiled" using the @@ -164,7 +167,12 @@ Racket CS currently supports three compilation modes: * JIT mode --- The compiled form of a module is an S-expression where individual `lambda`s are compiled on demand. + JIT mode does not perform well and probably should be discontinued. + Select this mode by setting the `PLT_CS_JIT` environment variable. + When this mode is selected, interpreter mode is still used for + compile-time code that does not span a module (or, more generally, + for the 'quick option to `compile-linklet` and similar functions). When the "cs" suffix is used for build mode, compiled ".zo" files in this mode are written to a "cs" subdirectory of "compiled". diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss index 653740f8e9..b4df086e1f 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 55)) + (values 9 5 3 57)) (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 0143a239f7..80b622d537 100644 --- a/racket/src/cs/convert.rkt +++ b/racket/src/cs/convert.rkt @@ -132,10 +132,7 @@ unsafe-mode? #t ; no-prompt? #f))) ; explicit-unnamed? - (printf "Lift...\n") - ;; Lift functions to avoid closure creation: - (time - (lift-in-schemified-body body #t)))) + body)) ;; ---------------------------------------- diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 5dcd84e1f9..45777c99a7 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -175,7 +175,6 @@ [else #f])])) (define gensym-on? (getenv "PLT_LINKLET_SHOW_GENSYM")) - (define pre-lift-on? (getenv "PLT_LINKLET_SHOW_PRE_LIFT")) (define pre-jit-on? (getenv "PLT_LINKLET_SHOW_PRE_JIT")) (define lambda-on? (getenv "PLT_LINKLET_SHOW_LAMBDA")) (define post-lambda-on? (getenv "PLT_LINKLET_SHOW_POST_LAMBDA")) @@ -187,7 +186,6 @@ (define assembly-on? (getenv "PLT_LINKLET_SHOW_ASSEMBLY")) (define show-on? (or gensym-on? pre-jit-on? - pre-lift-on? post-lambda-on? post-interp-on? jit-demand-on? @@ -304,10 +302,17 @@ (define (run-interpret s) (interpret-linklet s)) + (define (lambda->linklet-lambda s) + ;; Replace `lambda` with `$lambda/lift-barrier`, which prevents + ;; the compiler from converting functions in the immediate linklet + ;; body to take closure elements are arguments; at the level of a + ;; linklet, it's better to create all of the closures on instantiation + (cons '$lambda/lift-barrier (cdr s))) + (define (compile-to-proc s format unsafe?) (if (eq? format 'interpret) (run-interpret s) - (compile* s unsafe?))) + (compile* (lambda->linklet-lambda s) unsafe?))) ;; returns code bytevector and literals vector (define (compile*-to-bytevector s quoteds unsafe?) @@ -322,13 +327,13 @@ (let-values ([(o get) (open-bytevector-output-port)]) (let ([literals (fasl-write-code* s quoteds o)]) (values (get) literals)))] - [else (compile*-to-bytevector s quoteds unsafe?)])) + [else (compile*-to-bytevector (lambda->linklet-lambda s) quoteds unsafe?)])) ;; returns code bytevector and literals vector (define (cross-compile-to-bytevector machine s quoteds format unsafe?) (cond [(eq? format 'interpret) (cross-fasl-to-string machine s quoteds)] - [else (cross-compile machine s quoteds unsafe?)])) + [else (cross-compile machine (lambda->linklet-lambda s) quoteds unsafe?)])) (define (eval-from-bytevector bv literals format) (add-performance-memory! 'faslin-code (bytevector-length bv)) @@ -528,6 +533,7 @@ 'schemify (define jitify-mode? (and (not just-expand?) + (not quick-mode?) (or (eq? linklet-compilation-mode 'jit) (and (eq? linklet-compilation-mode 'mach) (linklet-bigger-than? c linklet-compilation-limit serializable?) @@ -558,19 +564,15 @@ (lambda (key) (lookup-linklet-or-instance get-import key)) (lambda (key) (values #f #f #f))) import-keys)) - (define impl-lam/lifts - (lift-in-schemified-linklet (show pre-lift-on? "pre-lift" impl-lam) - ;; preserve loop forms? - (not (eq? linklet-compilation-mode 'interp)))) (define impl-lam/jitified (cond - [(not jitify-mode?) impl-lam/lifts] + [(not jitify-mode?) impl-lam] [else (performance-region 'jitify (jitify-schemified-linklet (case linklet-compilation-mode - [(jit) (show pre-jit-on? "pre-jitified" impl-lam/lifts)] - [else (show "schemified" impl-lam/lifts)]) + [(jit) (show pre-jit-on? "pre-jitified" impl-lam)] + [else (show "schemified" impl-lam)]) ;; don't need extract for non-serializable 'lambda mode (or serializable? (eq? linklet-compilation-mode 'jit)) ;; need lift only for serializable JIT mode diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index 036dea66cb..b15441d134 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -734,8 +734,7 @@ current-atomic-virtual-register end-atomic-virtual-register current-future-virtual-register) - (import (rename (chezpart) - [define define/no-lift]) + (import (chezpart) (rename (only (chezscheme) sleep) [sleep chez:sleep]) (only (chezscheme) @@ -752,10 +751,9 @@ record-field-mutator)) ;; Internal tokens that are different from all possible user-level values: - (define/no-lift none '#{none kwcju864gpycc2h151s9atbmo-1}) - (define/no-lift none2 '#{none kwcju864gpycc2h151s9atbmo-2}) ; never put this in an emphemeron + (define none '#{none kwcju864gpycc2h151s9atbmo-1}) + (define none2 '#{none kwcju864gpycc2h151s9atbmo-2}) ; never put this in an emphemeron - (include "rumble/define.ss") (include "rumble/virtual-register.ss") (include "rumble/layout.ss") (include "rumble/begin0.ss") diff --git a/racket/src/cs/rumble/check.ss b/racket/src/cs/rumble/check.ss index 38cbef2cfc..4310739ec5 100644 --- a/racket/src/cs/rumble/check.ss +++ b/racket/src/cs/rumble/check.ss @@ -2,24 +2,18 @@ (define-syntax (who stx) (syntax-error stx "not bound")) -(define-syntax-rule (define-define/who define/who define) - (... - (define-syntax (define/who stx) - (syntax-case stx () - [(_ (id . args) body ...) - #'(define id - (fluid-let-syntax ([who (lambda (stx) - #''id)]) - (lambda args body ...)))] - [(_ id rhs) - #'(define id - (fluid-let-syntax ([who (lambda (stx) - #''id)]) - rhs))])))) - -(define-define/who define/who define) -(define-define/who define/lift/who define/lift) -(define-define/who define/no-lift/who define/no-lift) +(define-syntax (define/who stx) + (syntax-case stx () + [(_ (id . args) body ...) + #'(define id + (fluid-let-syntax ([who (lambda (stx) + #''id)]) + (lambda args body ...)))] + [(_ id rhs) + #'(define id + (fluid-let-syntax ([who (lambda (stx) + #''id)]) + rhs))])) (define-syntax (check stx) (syntax-case stx (:test :contract :or-false) diff --git a/racket/src/cs/rumble/define.ss b/racket/src/cs/rumble/define.ss deleted file mode 100644 index b35820299f..0000000000 --- a/racket/src/cs/rumble/define.ss +++ /dev/null @@ -1,571 +0,0 @@ -;; Replace `define` to perform simple function lifting, which avoids -;; having to allocate closures for local loops (i.e., a more -;; Racket-like allocation model). Since it only has to work for -;; Rumble's implementation, the lifter doesn't have to be general or -;; scalable. The lifter transforms unexpanded source expressions, so -;; it needs to recognize all of the forms that are used inside -;; `define` forms. - -;; Only functions bound with named `let`, normal `let` with `lambda`, -;; and `let*` with `lamdba` are lifted, and the lifter assumes that a -;; named `let`'s identifier is used only in application position. -;; Local `define` is not allowed. - -;; To bind a `let`-bound function that is not used only in an -;; application position, wrap it with `escapes-ok`. - -;; If a function F includes a call to a function G, function G has a -;; free variable X, and function F has an argument X, then the lifter -;; doesn't work (and it reports an error). Help the lifter in that -;; case by picking a different name for one of the Xs. - -;; If a "loop" is a non-tail loop or if has many free variables, then -;; lifting may be counterproductive (by making a bad trade for less -;; allocation but slower GCs). Use `define/no-lift` in that case. - -;; Select `define/lift` as the default mode: -(define-syntax (define stx) - (syntax-case stx () - [(_ . r) #'(define/lift . r)])) - -(define-syntax (define/lift stx) - (letrec ([lift-local-functions - ;; Convert `e` to return - ;; (list new-list (list lifted-defn ...)) - ;; The `env` argument is a list of symbols (not identifiers), - ;; and the `binds` argument is a list of syntax bindings - ;; #`(bind-form ([id rhs] ...)) - ;; to be copied over to any lifted form. Also, the `rhs` - ;; of a `bind-form` can contain free-variable and - ;; called-variable information for a previously lifted - ;; function, so that its free variables can be added - ;; as needed to a newly lifted function that calls the - ;; lifted one. - ;; Earlier entries in `binds` shadow later ones, and - ;; entires in `env` shadow `binds` entries. - (lambda (e env binds mutated) - (syntax-case e (quote begin lambda case-lambda - let letrec let* let-values - fluid-let-syntax let-syntax - cond define set!) - [(define . _) - (syntax-error e "don't use nested `define`:")] - [(quote _) - (list e '())] - [(begin e) - (lift-local-functions #'e env binds mutated)] - [(seq e ...) - (and (symbol? (syntax->datum #'seq)) - (or (free-identifier=? #'seq #'begin) - (free-identifier=? #'seq #'begin0) - (free-identifier=? #'seq #'if))) - (with-syntax ([((new-e lifts) ...) - (map (lambda (e) - (lift-local-functions e env binds mutated)) - #'(e ...))]) - (list #'(seq new-e ...) - (append-all #'(lifts ...))))] - [(lambda args e ...) - (with-syntax ([(body lifts) - (lift-local-functions #'(begin e ...) - (add-args env #'args) - binds - mutated)]) - #`((lambda args body) - lifts))] - [(case-lambda [args e ...] ...) - (with-syntax ([((body lifts) ...) - (map (lambda (args body) - (lift-local-functions body - (add-args env args) - binds - mutated)) - #'(args ...) - #'((begin e ...) ...))]) - (list #'(case-lambda [args body] ...) - (append-all #'(lifts ...))))] - [(let loop ([arg val] ...) body-e ...) - (symbol? (syntax->datum #'loop)) - (cond - [(true-loop? (syntax->datum #'loop) #t #'(begin body-e ...)) - (lift-local-functions-in-named-let e env binds mutated)] - [else - (generate-lifted env binds mutated - #'loop ; name - #'(arg ...) ; argument names - #'(begin body-e ...) ; body - #t ; recursive - (lambda (defn-to-lift new-loop-name free-vars wrap-bind-of-lifted) - (with-syntax ([(free-var ...) free-vars] - [new-loop-name new-loop-name] - [defn-to-lift defn-to-lift]) - #`((new-loop-name val ... free-var ...) - (defn-to-lift)))))])] - [(let* () e ...) - (lift-local-functions #`(begin e ...) env binds mutated)] - [(let* ([id rhs] . more-binds) e ...) - (lift-local-functions #`(let ([id rhs]) (let* more-binds e ...)) env binds mutated)] - [(let . _) - (lift-local-functions-in-let/lift-immediate e env binds mutated)] - [(letrec . _) - (lift-local-functions-in-let e env binds mutated #t)] - [(let-values ([(id ...) rhs] ...) e ...) - (with-syntax ([((new-rhs lifts) ...) - (map (lambda (rhs) - (lift-local-functions rhs env binds mutated)) - #'(rhs ...))]) - (with-syntax ([(new-body body-lifts) - (lift-local-functions #'(begin e ...) - (add-args env (#%apply append #'((id ...) ...))) - binds - mutated)]) - (list #'(let-values ([(id ...) new-rhs] ...) new-body) - (append #'body-lifts (append-all #'(lifts ...))))))] - [(fluid-let-syntax ([id rhs] ...) e ...) - (with-syntax ([(new-body body-lifts) - (lift-local-functions #'(begin e ...) - (remove-args env #'(id ...)) - (cons #'(fluid-let-syntax ([id rhs] ...)) - binds) - mutated)]) - #`((fluid-let-syntax ([id rhs] ...) new-body) - body-lifts))] - [(let-syntax ([id rhs] ...) e ...) - (with-syntax ([(new-body body-lifts) - (lift-local-functions #'(begin e ...) - (remove-args env #'(id ...)) - (cons #'(let-syntax ([id rhs] ...)) - binds) - mutated)]) - #`((let-syntax ([id rhs] ...) new-body) - body-lifts))] - [(cond [e ...] ...) - (with-syntax ([(((new-e lifts) ...) ...) - (map (lambda (es) - (map (lambda (e) - (lift-local-functions e env binds mutated)) - es)) - #'((e ...) ...))]) - (list #'(cond [new-e ...] ...) - (append-all (append-all #'((lifts ...) ...)))))] - [(set! id rhs) - (track-mutated! mutated #'id 'mutated) - (with-syntax ([(new-rhs lifts) (lift-local-functions #'rhs env binds mutated)]) - #'((set! id new-rhs) - lifts))] - [(rator rand ...) - (with-syntax ([((new-e lifts) ...) - (map (lambda (e) - (lift-local-functions e env binds mutated)) - #'(rator rand ...))]) - (list #'(new-e ...) - (append-all #'(lifts ...))))] - [_ (list e '())]))] - - [lift-local-functions-in-let - (lambda (e env binds mutated rec?) - (syntax-case e () - [(form ([id rhs] ...) e ...) - (let ([body-env (add-args env #'(id ...))]) - (with-syntax ([((new-rhs lifts) ...) - (map (lambda (rhs) - (lift-local-functions rhs (if rec? body-env env) binds mutated)) - #'(rhs ...))]) - (with-syntax ([(new-body body-lifts) - (lift-local-functions #'(begin e ...) body-env binds mutated)]) - (list #'(form ([id new-rhs] ...) new-body) - (append #'body-lifts (append-all #'(lifts ...)))))))]))] - - [lift-local-functions-in-let/lift-immediate - ;; Split `lambda` bindings for other bindings, then lift the `lambda`s - (lambda (e env binds mutated) - (syntax-case e () - [(form ([id rhs] ...) . body) - (let ([body-env (add-args env #'(id ...))]) - (let-values ([(proc-binds other-binds) - (split-proc-binds #'([id rhs] ...))]) - (cond - [(null? proc-binds) - (lift-local-functions-in-let e env binds mutated #f)] - [else - (let loop ([proc-binds proc-binds] - [e (with-syntax ([other-binds other-binds]) - #'(form other-binds . body))] - [lifts '()]) - (cond - [(null? proc-binds) - (with-syntax ([(new-e e-lifts) (lift-local-functions e env binds mutated)]) - (list #'new-e - (append lifts #'e-lifts)))] - [else - (with-syntax ([[id (_ rhs-args rhs-e ...)] (car proc-binds)]) - (generate-lifted - env binds mutated - #'id ; name - #'rhs-args ; argument names - #'(begin rhs-e ...) ; body - #f ; not recursive - (lambda (defn-to-lift new-id free-vars wrap-bind-of-lifted) - (loop (cdr proc-binds) - (wrap-bind-of-lifted e) - (cons defn-to-lift lifts)))))]))])))]))] - - [lift-local-functions-in-named-let - (lambda (e env binds mutated) - (syntax-case e () - [(form loop ([id rhs] ...) e ...) - (let ([body-env (add-args env #'(id ...))]) - (with-syntax ([((new-rhs lifts) ...) - (map (lambda (rhs) - (lift-local-functions rhs env binds mutated)) - #'(rhs ...))]) - (with-syntax ([(new-body body-lifts) - (lift-local-functions #'(begin e ...) body-env binds mutated)]) - (list #'(form loop ([id new-rhs] ...) new-body) - (append #'body-lifts (append-all #'(lifts ...)))))))]))] - - [split-proc-binds - ;; Helper to split `lambda` from non-`lambda` - (lambda (form-binds) - (let loop ([binds form-binds] [proc-binds '()] [other-binds '()]) - (cond - [(null? binds) - (values (reverse proc-binds) - (reverse other-binds))] - [else - (syntax-case (car binds) (lambda) - [[_ (lambda (arg ...) . _)] - (loop (cdr binds) - (cons (car binds) proc-binds) - other-binds)] - [_ - (loop (cdr binds) - proc-binds - (cons (car binds) other-binds))])])))] - - [generate-lifted - ;; Takes pieces for a function to lift an generates the lifted version - (lambda (env binds mutated name args body rec? k) - (let* ([ids (if rec? (cons name args) args)] - [binds (filter-shadowed-binds binds (add-args env ids))] - [body-env (remove-args env ids)] - [direct-free-vars (extract-free-vars body body-env)] - [direct-called-vars (extract-free-vars body (binds-to-env binds))]) - (for-each (lambda (free-var) (track-mutated! mutated free-var 'must-not)) direct-free-vars) - (let-values ([(free-vars called-vars) (extract-bind-vars binds body-env direct-free-vars direct-called-vars)]) - (let ([free-vars (unique-ids free-vars)] - [called-vars (unique-ids called-vars)]) - (with-syntax ([(free-var ...) free-vars] - [(called-var ...) called-vars] - [new-name (datum->syntax - name - (#%gensym (#%symbol->string (syntax->datum name))))] - [body (let loop ([body body] - [binds binds]) - (cond - [(null? binds) body] - [else (with-syntax ([(form form-binds) (car binds)] - [body body]) - (loop #'(form form-binds body) - (cdr binds)))]))] - [name name] - [(arg ...) args]) - (let ([wrap-bind-of-lifted - (lambda (body) - (with-syntax ([body body]) - #'(let-syntax ([name (begin ; this pattern is recognized by `extract-bind-free-vars` - '(FREE-VARS free-var ...) - '(CALLED-VARS called-var ...) - (lambda (stx) - (syntax-case stx () - [(_ call-arg (... ...)) - #'(new-name call-arg (... ...) free-var ...)] - [_ (syntax-error stx "lifted procedure escapes:")])))]) - body)))]) - (with-syntax ([wrapped-body (if rec? - (wrap-bind-of-lifted #'body) - #'body)]) - (k #`(define/lift new-name - (lambda (arg ... free-var ...) - wrapped-body)) - #'new-name - free-vars - wrap-bind-of-lifted))))))))] - - [extract-free-vars - ;; For an expression that is going to be lifted, find all the free - ;; variables so they can be added to call sites of the enclosing - ;; lifted function. Only variables in `env` are candidate free - ;; variables. - (lambda (e env) - (syntax-case e (quote begin lambda case-lambda - let* let letrec let-values - fluid-let-syntax let-syntax - set!) - [id - (symbol? (syntax->datum #'id)) - (if (chez:memq (syntax->datum #'id) env) - (list #'id) - '())] - [(set! id rhs) - (if (chez:memq (syntax->datum #'id) env) - (syntax-error #'id "cannot mutate variable added to lifted procedure:") - (extract-free-vars #'rhs env))] - [(quote _) '()] - [(seq e ...) - (and (symbol? (syntax->datum #'seq)) - (or (free-identifier=? #'seq #'begin) - (free-identifier=? #'seq #'begin0) - (free-identifier=? #'seq #'if) - (free-identifier=? #'seq #'cond))) - (#%apply append (map (lambda (e) - (extract-free-vars e env)) - #'(e ...)))] - [(lambda args e ...) - (extract-free-vars #'(begin e ...) - (remove-args env #'args))] - [(case-lambda [args e ...] ...) - (#%apply - append - (map (lambda (args body) - (extract-free-vars body (remove-args env args))) - #'(args ...) - #'((begin e ...) ...)))] - [(let loop ([arg val] ...) e ...) - (symbol? (syntax->datum #'loop)) - (append - (extract-free-vars #'(begin val ...) env) - (extract-free-vars #'(begin e ...) - (remove-args env #'(loop arg ...))))] - [(let* () e ...) - (extract-free-vars #`(begin e ...) env)] - [(let* ([id rhs] . binds) e ...) - (extract-free-vars #`(let ([id rhs]) (let* binds e ...)) env)] - [(let ([id rhs] ...) e ...) - (append - (extract-free-vars #'(begin rhs ...) env) - (extract-free-vars #'(begin e ...) (remove-args env #'(id ...))))] - [(let-values ([(id ...) rhs] ...) e ...) - (append - (extract-free-vars #'(begin rhs ...) env) - (extract-free-vars #'(begin e ...) (remove-args env (#%apply append #'((id ...) ...)))))] - [(letrec ([id rhs] ...) e ...) - (extract-free-vars #'(begin rhs ... e ...) (remove-args env #'(id ...)))] - [(fluid-let-syntax ([id rhs] ...) e ...) - (extract-free-vars #'(begin e ...) (remove-args env #'(id ...)))] - [(let-syntax ([id rhs] ...) e ...) - (extract-free-vars #'(begin e ...) (remove-args env #'(id ...)))] - [(rator rand ...) - (extract-free-vars #'(begin rator rand ...) env)] - [_ '()]))] - - [true-loop? - (lambda (name tail? e) - (syntax-case e (quote begin begin0 if cond lambda case-lambda - let* let letrec let-values - fluid-let-syntax let-syntax - set!) - [id - (symbol? (syntax->datum #'id)) - (not (eq? (syntax->datum #'id) name))] - [(set! id rhs) - (and (not (eq? (syntax->datum #'id) name)) - (true-loop? name #f e))] - [(quote _) '()] - [(begin e ... e0) - (and (#%andmap (lambda (e) (true-loop? name #f e)) - #'(e ...)) - (true-loop? name tail? #'e0))] - [(begin0 e ...) - (#%andmap (lambda (e) (true-loop? name #f e)) - #'(e ...))] - [(if e0 e1 e2) - (and (true-loop? name #f #'e0) - (true-loop? name tail? #'e1) - (true-loop? name tail? #'e2))] - [(cond [test expr ...] ...) - (#%andmap (lambda (b) (true-loop? name #f b)) - #'((begin test expr ...) ...))] - [(lambda args e ...) #f] - [(case-lambda [args e ...] ...) #f] - [(let loop ([arg val] ...) e ...) - (or (eq? name (syntax->datum #'loop)) - (and - (#%andmap (lambda (val) (true-loop? name #f val)) - #'(val ...)) - (true-loop? name tail? #'(begin e ...))))] - [(let* () e ...) - (true-loop? name tail? #'(begin e ...))] - [(let* ([id rhs] . binds) e ...) - (true-loop? name tail? #`(let ([id rhs]) (let* binds e ...)))] - [(let ([id rhs] ...) e ...) - (and (#%andmap (lambda (rhs) (true-loop? name #f #'rhs)) - #'(rhs ...)) - (or (#%ormap (lambda (id) (eq? (syntax->datum id) name)) - #'(id ...)) - (true-loop? name tail? #'(begin e ...))))] - [(let-values ([(id ...) rhs] ...) e ...) - (and (#%andmap (lambda (rhs) (true-loop? name #f #'rhs)) - #'(rhs ...)) - (or (#%ormap (lambda (id) (eq? (syntax->datum id) name)) - #'(id ... ...)) - (true-loop? name tail? #'(begin e ...))))] - [(letrec ([id rhs] ...) e ...) - (or (#%ormap (lambda (id) (eq? (syntax->datum id) name)) - #'(id ...)) - (and (#%andmap (lambda (rhs) (true-loop? name #f #'rhs)) - #'(rhs ...)) - (true-loop? name tail? #'(begin e ...))))] - [(fluid-let-syntax ([id rhs] ...) e ...) - (or (#%ormap (lambda (id) (eq? (syntax->datum id) name)) - #'(id ...)) - (true-loop? name tail? #'(begin e ...)))] - [(let-syntax ([id rhs] ...) e ...) - (or (#%ormap (lambda (id) (eq? (syntax->datum id) name)) - #'(id ...)) - (true-loop? name tail? #'(begin e ...)))] - [(rator rand ...) - (and (or (and tail? - (eq? name (syntax->datum #'rator))) - (true-loop? name #f #'rator)) - (#%andmap (lambda (rand) (true-loop? name #f rand)) - #'(rand ...)))] - [_ #t]))] - - [filter-shadowed-binds - ;; Simplify `binds` to drop bindings that are shadowned by - ;; `env` or by earlier bindings - (lambda (binds env) - (let loop ([binds binds] - [env env]) - (cond - [(null? binds) '()] - [else (with-syntax ([(form ([id rhs] ...)) (car binds)]) - (with-syntax ([([id rhs] ...) - ;; Filter any `ids` that are shadowed - (let loop ([ids #'(id ...)] [rhss #'(rhs ...)]) - (cond - [(null? ids) '()] - [(chez:memq (syntax->datum (car ids)) env) - (loop (cdr ids) (cdr rhss))] - [else (cons (list (car ids) (car rhss)) - (loop (cdr ids) (cdr rhss)))]))]) - (cons #'(form ([id rhs] ...)) - (loop (cdr binds) - (add-args env #'(id ...))))))])))] - - [binds-to-env - ;; Extract the identifiers of `binds` into an environment - (lambda (binds) - (let loop ([binds binds] [env '()]) - (cond - [(null? binds) env] - [else - (loop (cdr binds) - (syntax-case (car binds) () - [(form ([id rhs] ...)) - (add-args env #'(id ...))]))])))] - - [extract-bind-vars - ;; Add new variables to `free-vars` and `called-vars` based on - ;; entries in `all-binds` that will be called (because they're - ;; referenced in `called-vars`). A fixpoint calculation is needed, - ;; since calling a lifted function may add new free variables and - ;; new called variables. - (lambda (all-binds env free-vars called-vars) - (let loop ([binds all-binds] [added? #f] [free-vars free-vars] [called-vars called-vars] [did-ids '()]) - (cond - [(null? binds) (if added? - ;; Loop to fixpoint - (loop all-binds #f free-vars called-vars did-ids) - ;; Found fixpoint - (values free-vars called-vars))] - [else (syntax-case (car binds) (FREE-VARS CALLED-VARS begin quote) - [(form ([id (begin - '(FREE-VARS free-var ...) - '(CALLED-VARS called-var ...) - _)])) - (and (id-member? #'id called-vars) - (not (chez:memq (syntax->datum #'id) did-ids))) - (loop (cdr binds) - #t - (append (#%map (lambda (free-var) - (if (chez:memq (syntax->datum free-var) env) - free-var - (syntax-error free-var "wrong variable at call site; lifter needs your help by renaming:"))) - #'(free-var ...)) - free-vars) - (append #'(called-var ...) - called-vars) - (cons (syntax->datum #'id) did-ids))] - [_ - ;; Not a lifted-function binding - (loop (cdr binds) added? free-vars called-vars did-ids)])])))] - - [add-args - ;; Add identifiers (accomdating rest args) to an environment - (lambda (env args) - (let add-args ([env env] [args (syntax->datum args)]) - (cond - [(null? args) env] - [(pair? args) (add-args (cons (car args) env) - (cdr args))] - [else (cons args env)])))] - - [remove-args - ;; Remove identifiers (accomdating rest args) from an environment - (lambda (env args) - (let remove-args ([env env] [args (syntax->datum args)]) - (cond - [(null? args) env] - [(pair? args) (remove-args (#%remq (car args) env) - (cdr args))] - [else (#%remq args env)])))] - - [track-mutated! - (lambda (mutated id state) - (let ([old-state (hashtable-ref mutated (syntax->datum id) #f)]) - (when (and old-state - (not (eq? old-state state))) - (syntax-error id "lift seems to need to close over mutated variable:")) - (hashtable-set! mutated (syntax->datum id) state)))] - - [unique-ids - (lambda (l) - (let loop ([l l]) - (cond - [(null? l) '()] - [(id-member? (car l) (cdr l)) - (loop (cdr l))] - [else (cons (car l) (loop (cdr l)))])))] - - [id-member? - (lambda (id l) - (let loop ([l l]) - (cond - [(null? l) #f] - [else (or (free-identifier=? id (car l)) - (loop (cdr l)))])))] - - [append-all - (lambda (l) - (#%apply append l))]) - - ;; Traverse the right-hand side of a definition to extract lifts - (syntax-case stx () - [(_ (id . args) e ...) - #'(define/lift id (lambda args e ...))] - [(_ id rhs) - (with-syntax ([(new-rhs (lift ...)) (lift-local-functions - #'rhs - '() - '() - (make-eq-hashtable))]) - #'(define/no-lift id - (let () - lift ... - new-rhs)))]))) - -(define-syntax (escapes-ok stx) - (syntax-case stx () - [(_ e) #'e])) diff --git a/racket/src/cs/rumble/error.ss b/racket/src/cs/rumble/error.ss index c0de47d92d..2bf488ac4c 100644 --- a/racket/src/cs/rumble/error.ss +++ b/racket/src/cs/rumble/error.ss @@ -464,12 +464,11 @@ (fields value)) (define make-unquoted-printing-string - (let ([unquoted-printing-string - (escapes-ok - (lambda (s) - (check 'unquoted-printing-string string? s) - (new-unquoted-printing-string s)))]) - unquoted-printing-string)) + (|#%name| + unquoted-printing-string + (lambda (s) + (check 'unquoted-printing-string string? s) + (new-unquoted-printing-string s)))) ;; ---------------------------------------- diff --git a/racket/src/cs/rumble/foreign.ss b/racket/src/cs/rumble/foreign.ss index c30cf9cd82..2ea698869a 100644 --- a/racket/src/cs/rumble/foreign.ss +++ b/racket/src/cs/rumble/foreign.ss @@ -525,14 +525,13 @@ [(types abi alignment) (make-cstruct-type types abi alignment 'atomic)] [(types abi alignment malloc-mode) (let ([make-decls - (escapes-ok - (lambda (id next!-id) - (let-values ([(reps decls) (types->reps types next!-id)]) - (append decls - `((define-ftype ,id - (struct ,@(map (lambda (rep) - `[,(next!-id) ,rep]) - reps))))))))]) + (lambda (id next!-id) + (let-values ([(reps decls) (types->reps types next!-id)]) + (append decls + `((define-ftype ,id + (struct ,@(map (lambda (rep) + `[,(next!-id) ,rep]) + reps)))))))]) (let-values ([(size alignment) (ctypes-sizeof+alignof types alignment)]) (create-compound-ctype 'struct 'struct @@ -548,14 +547,13 @@ (for-each (lambda (type) (check who ctype? type)) types) (let ([make-decls - (escapes-ok - (lambda (id next!-id) - (let-values ([(reps decls) (types->reps types next!-id)]) - (append decls - `((define-ftype ,id - (union ,@(map (lambda (rep) - `[,(next!-id) ,rep]) - reps))))))))] + (lambda (id next!-id) + (let-values ([(reps decls) (types->reps types next!-id)]) + (append decls + `((define-ftype ,id + (union ,@(map (lambda (rep) + `[,(next!-id) ,rep]) + reps)))))))] [size (apply max (map ctype-sizeof types))] [alignment (apply max (map ctype-alignof types))]) (create-compound-ctype 'union @@ -572,12 +570,11 @@ (check who ctype? type) (check who exact-nonnegative-integer? count) (let ([make-decls - (escapes-ok - (lambda (id next!-id) - (let-values ([(reps decls) (types->reps (list type) next!-id)]) - (append decls - `((define-ftype ,id - (array ,count ,(car reps))))))))] + (lambda (id next!-id) + (let-values ([(reps decls) (types->reps (list type) next!-id)]) + (append decls + `((define-ftype ,id + (array ,count ,(car reps)))))))] [size (* count (ctype-sizeof type))] [alignment (ctype-alignof type)]) (unless (fixnum? size) diff --git a/racket/src/cs/rumble/impersonator.ss b/racket/src/cs/rumble/impersonator.ss index cc23f41e08..06d5af9084 100644 --- a/racket/src/cs/rumble/impersonator.ss +++ b/racket/src/cs/rumble/impersonator.ss @@ -677,11 +677,10 @@ (define (set-impersonator-hash!) (let ([struct-impersonator-hash-code - (escapes-ok - (lambda (c hash-code) - ((record-hash-procedure (impersonator-val c)) - c - hash-code)))]) + (lambda (c hash-code) + ((record-hash-procedure (impersonator-val c)) + c + hash-code))]) (let ([add (lambda (rtd) (record-type-hash-procedure rtd struct-impersonator-hash-code))]) (add (record-type-descriptor struct-impersonator)) diff --git a/racket/src/cs/rumble/list.ss b/racket/src/cs/rumble/list.ss index c133b94cd1..be7e68e54f 100644 --- a/racket/src/cs/rumble/list.ss +++ b/racket/src/cs/rumble/list.ss @@ -34,7 +34,7 @@ ;; compatilation approach (define-syntax-rule (define-list-proc |#%name| name base combine) - (define/no-lift |#%name| + (define |#%name| (case-lambda [(f l) (if (list? l) diff --git a/racket/src/cs/rumble/struct.ss b/racket/src/cs/rumble/struct.ss index 44c2b102e8..1068d5dcf2 100644 --- a/racket/src/cs/rumble/struct.ss +++ b/racket/src/cs/rumble/struct.ss @@ -218,19 +218,18 @@ (let ([props-ht ;; Check for duplicates and record property values (let ([get-struct-info - (escapes-ok - (lambda () - (let ([parent-total*-count (if parent-rtd* - (struct-type-total*-field-count parent-rtd*) - 0)]) - (list name - init-count - auto-count - (make-position-based-accessor rtd parent-total*-count (+ init-count auto-count)) - (make-position-based-mutator rtd parent-total*-count (+ init-count auto-count)) - all-immutables - parent-rtd - #f))))]) + (lambda () + (let ([parent-total*-count (if parent-rtd* + (struct-type-total*-field-count parent-rtd*) + 0)]) + (list name + init-count + auto-count + (make-position-based-accessor rtd parent-total*-count (+ init-count auto-count)) + (make-position-based-mutator rtd parent-total*-count (+ init-count auto-count)) + all-immutables + parent-rtd + #f)))]) (let loop ([props props] [ht empty-hasheq]) (cond [(null? props) @@ -951,11 +950,10 @@ (let ([rtd* (strip-impersonator rtd)]) (check-inspector-access who rtd*) (|#%struct-predicate| - (escapes-ok - (lambda (v) - (or (record? v rtd*) - (and (impersonator? v) - (record? (impersonator-val v) rtd*)))))))) + (lambda (v) + (or (record? v rtd*) + (and (impersonator? v) + (record? (impersonator-val v) rtd*))))))) ;; ---------------------------------------- diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index dfba868463..6e7ef3d74d 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -661,31 +661,26 @@ (define false-thread-cell (make-thread-cell #f)) (define handler-prompt-key (make-continuation-prompt-tag 'handler-prompt-tag)) (define call-handled-body - (letrec ((procz2 - (lambda (bpz_0 body-thunk_0) - (with-continuation-mark* - authentic - break-enabled-key - bpz_0 - (with-continuation-mark* - authentic - exception-handler-key - procz1 - (|#%app| body-thunk_0))))) - (procz1 - (lambda (e_0) - (abort-current-continuation handler-prompt-key e_0)))) - (lambda (bpz_0 handle-proc_0 body-thunk_0) - (with-continuation-mark* - authentic - break-enabled-key - false-thread-cell - (call-with-continuation-prompt - procz2 - handler-prompt-key - handle-proc_0 - bpz_0 - body-thunk_0))))) + (lambda (bpz_0 handle-proc_0 body-thunk_0) + (with-continuation-mark* + authentic + break-enabled-key + false-thread-cell + (call-with-continuation-prompt + (lambda (bpz_1 body-thunk_1) + (with-continuation-mark* + authentic + break-enabled-key + bpz_1 + (with-continuation-mark* + authentic + exception-handler-key + (lambda (e_0) (abort-current-continuation handler-prompt-key e_0)) + (|#%app| body-thunk_1)))) + handler-prompt-key + handle-proc_0 + bpz_0 + body-thunk_0)))) (define call-with-exception-handler (lambda (exnh_0 thunk_0) (begin0 @@ -752,92 +747,111 @@ #f))))) (define bsbs (string '#\x5c '#\x5c)) (define normal-case-path - (letrec ((finish_0 - (|#%name| - finish - (lambda (bstr_0) (begin (bytes->path bstr_0 'windows))))) - (loop_0 - (|#%name| - loop - (lambda (bstr_0 c_0 offset_0) - (begin - (call-with-values - (lambda () - (bytes-convert - c_0 - bstr_0 - offset_0 - (unsafe-bytes-length bstr_0))) - (case-lambda - ((new-bstr_0 used_0 status_0) - (let ((s_0 (bytes->string/locale new-bstr_0))) - (let ((tail-s_0 - (if (eq? status_0 'complete) - (norm-tail_0 s_0) - s_0))) - (let ((done_0 - (string->bytes/locale (norm_0 tail-s_0)))) - (if (eq? status_0 'complete) - done_0 - (if (eq? status_0 'aborts) - (bytes-append - done_0 - (subbytes bstr_0 (+ offset_0 used_0))) - (let ((app_0 - (let ((app_0 (+ offset_0 used_0))) - (subbytes - bstr_0 - app_0 - (+ offset_0 used_0 1))))) - (bytes-append - done_0 - app_0 - (loop_0 - bstr_0 - c_0 - (+ offset_0 used_0 1)))))))))) - (args (raise-binding-result-arity-error 3 args)))))))) - (norm-tail_0 - (|#%name| - norm-tail - (lambda (s_0) - (begin - (if (regexp-match? rx2283 s_0) - s_0 - (regexp-replace* rx2458 s_0 "\\1")))))) - (norm_0 - (|#%name| - norm - (lambda (s_0) - (begin - (string-locale-downcase - (regexp-replace* rx2515 s_0 bsbs))))))) - (lambda (s_0) - (begin - (if (let ((or-part_0 (path-for-some-system? s_0))) - (if or-part_0 or-part_0 (path-string? s_0))) - (void) - (raise-argument-error - 'normal-path-case - "(or/c path-for-some-system? path-string?)" - s_0)) - (if (if (path-for-some-system? s_0) - (eq? (path-convention-type s_0) 'windows) - (eq? (system-type) 'windows)) - (let ((bstr_0 (if (string? s_0) #f (path->bytes s_0)))) - (if (if (string? s_0) (regexp-match? rx2276 s_0) #f) - (string->path s_0) - (if (if bstr_0 (regexp-match? rx2490 bstr_0) #f) - s_0 - (if (string? s_0) - (let ((bstr_1 - (string->bytes/locale (norm_0 (norm-tail_0 s_0))))) - (begin-unsafe (begin (bytes->path bstr_1 'windows)))) - (let ((c_0 (bytes-open-converter "" "UTF-8"))) - (let ((bstr_1 (loop_0 bstr_0 c_0 0))) - (begin-unsafe - (begin (bytes->path bstr_1 'windows))))))))) - (if (string? s_0) (string->path s_0) s_0)))))) + (lambda (s_0) + (begin + (if (let ((or-part_0 (path-for-some-system? s_0))) + (if or-part_0 or-part_0 (path-string? s_0))) + (void) + (raise-argument-error + 'normal-path-case + "(or/c path-for-some-system? path-string?)" + s_0)) + (if (if (path-for-some-system? s_0) + (eq? (path-convention-type s_0) 'windows) + (eq? (system-type) 'windows)) + (let ((bstr_0 (if (string? s_0) #f (path->bytes s_0)))) + (if (if (string? s_0) (regexp-match? rx2276 s_0) #f) + (string->path s_0) + (if (if bstr_0 (regexp-match? rx2490 bstr_0) #f) + s_0 + (let ((norm_0 + (|#%name| + norm + (lambda (s_1) + (begin + (string-locale-downcase + (regexp-replace* rx2515 s_1 bsbs))))))) + (let ((norm-tail_0 + (|#%name| + norm-tail + (lambda (s_1) + (begin + (if (regexp-match? rx2283 s_1) + s_1 + (regexp-replace* rx2458 s_1 "\\1"))))))) + (let ((finish_0 + (|#%name| + finish + (lambda (bstr_1) + (begin (bytes->path bstr_1 'windows)))))) + (if (string? s_0) + (let ((bstr_1 + (string->bytes/locale + (norm_0 (norm-tail_0 s_0))))) + (begin-unsafe (begin (bytes->path bstr_1 'windows)))) + (let ((c_0 (bytes-open-converter "" "UTF-8"))) + (let ((bstr_1 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (offset_0) + (begin + (call-with-values + (lambda () + (bytes-convert + c_0 + bstr_0 + offset_0 + (unsafe-bytes-length bstr_0))) + (case-lambda + ((new-bstr_0 used_0 status_0) + (let ((s_1 + (bytes->string/locale + new-bstr_0))) + (let ((tail-s_0 + (if (eq? status_0 'complete) + (norm-tail_0 s_1) + s_1))) + (let ((done_0 + (string->bytes/locale + (norm_0 tail-s_0)))) + (if (eq? status_0 'complete) + done_0 + (if (eq? status_0 'aborts) + (bytes-append + done_0 + (subbytes + bstr_0 + (+ offset_0 used_0))) + (let ((app_0 + (let ((app_0 + (+ + offset_0 + used_0))) + (subbytes + bstr_0 + app_0 + (+ + offset_0 + used_0 + 1))))) + (bytes-append + done_0 + app_0 + (loop_0 + (+ + offset_0 + used_0 + 1)))))))))) + (args + (raise-binding-result-arity-error + 3 + args))))))))) + (loop_0 0)))) + (begin-unsafe + (begin (bytes->path bstr_1 'windows)))))))))))) + (if (string? s_0) (string->path s_0) s_0))))) (define check-extension-call (lambda (s_0 sfx_0 who_0 sep_0 trust-sep?_0) (begin @@ -886,36 +900,36 @@ (values base_0 name_0))) (args (raise-binding-result-arity-error 3 args))))))) (define path-adjust-extension - (letrec ((finish_0 - (|#%name| - finish - (lambda (bs_0 rest-bytes_0 s_0 sfx_0 i_0 sep_0 i2_0) - (begin - (let ((app_0 - (let ((app_0 (subbytes bs_0 0 i_0))) - (let ((app_1 - (if (string? sep_0) - (string->bytes/locale sep_0 63) - sep_0))) - (let ((app_2 (|#%app| rest-bytes_0 bs_0 i2_0))) - (bytes-append - app_0 - app_1 - app_2 - (if (string? sfx_0) - (string->bytes/locale sfx_0 63) - sfx_0))))))) - (bytes->path-element - app_0 - (if (path-for-some-system? s_0) - (path-convention-type s_0) - (system-path-convention-type))))))))) - (lambda (name_0 sep_0 rest-bytes_0 s_0 sfx_0 trust-sep?_0) - (call-with-values - (lambda () (check-extension-call s_0 sfx_0 name_0 sep_0 trust-sep?_0)) - (case-lambda - ((base_0 name_1) - (let ((bs_0 (path-element->bytes name_1))) + (lambda (name_0 sep_0 rest-bytes_0 s_0 sfx_0 trust-sep?_0) + (call-with-values + (lambda () (check-extension-call s_0 sfx_0 name_0 sep_0 trust-sep?_0)) + (case-lambda + ((base_0 name_1) + (let ((bs_0 (path-element->bytes name_1))) + (let ((finish_0 + (|#%name| + finish + (lambda (i_0 sep_1 i2_0) + (begin + (let ((app_0 + (let ((app_0 (subbytes bs_0 0 i_0))) + (let ((app_1 + (if (string? sep_1) + (string->bytes/locale sep_1 63) + sep_1))) + (let ((app_2 (|#%app| rest-bytes_0 bs_0 i2_0))) + (bytes-append + app_0 + app_1 + app_2 + (if (string? sfx_0) + (string->bytes/locale sfx_0 63) + sfx_0))))))) + (bytes->path-element + app_0 + (if (path-for-some-system? s_0) + (path-convention-type s_0) + (system-path-convention-type))))))))) (let ((new-name_0 (letrec* ((loop_0 @@ -925,10 +939,6 @@ (begin (if (zero? i_0) (finish_0 - bs_0 - rest-bytes_0 - s_0 - sfx_0 (unsafe-bytes-length bs_0) #vu8() (unsafe-bytes-length bs_0)) @@ -936,24 +946,22 @@ (if (if (not (zero? i_1)) (eq? 46 (unsafe-bytes-ref bs_0 i_1)) #f) - (finish_0 - bs_0 - rest-bytes_0 - s_0 - sfx_0 - i_1 - sep_0 - (add1 i_1)) + (finish_0 i_1 sep_0 (add1 i_1)) (loop_0 i_1))))))))) (loop_0 (unsafe-bytes-length bs_0))))) (if (path-for-some-system? base_0) (build-path base_0 new-name_0) - new-name_0)))) - (args (raise-binding-result-arity-error 2 args))))))) + new-name_0))))) + (args (raise-binding-result-arity-error 2 args)))))) (define path-replace-extension - (letrec ((procz1 (lambda (bs_0 i_0) #vu8()))) - (lambda (s_0 sfx_0) - (path-adjust-extension 'path-replace-extension #vu8() procz1 s_0 sfx_0 #t)))) + (lambda (s_0 sfx_0) + (path-adjust-extension + 'path-replace-extension + #vu8() + (lambda (bs_0 i_0) #vu8()) + s_0 + sfx_0 + #t))) (define path-add-extension (case-lambda ((s_0 sfx_0) @@ -1075,153 +1083,136 @@ (append default_0 l_0) (cons (bytes->path s_1) l_0))))) (define path-list-string->path-list - (letrec ((loop_0 - (|#%name| - loop - (lambda (default_0 s_0) - (begin - (let ((m_0 (regexp-match rx:path-list s_0))) - (if m_0 - (let ((app_0 (cadr m_0))) - (cons-path - default_0 - app_0 - (loop_0 default_0 (caddr m_0)))) - (cons-path default_0 s_0 null)))))))) - (lambda (s_0 default_0) - (begin - (if (let ((or-part_0 (bytes? s_0))) - (if or-part_0 or-part_0 (string? s_0))) - (void) - (raise-argument-error - 'path-list-string->path-list - "(or/c bytes? string?)" - s_0)) - (if (if (list? default_0) (andmap path? default_0) #f) - (void) - (raise-argument-error - 'path-list-string->path-list - "(listof path?)" - default_0)) - (init-rx:path-list!) - (loop_0 default_0 (if (string? s_0) (string->bytes/utf-8 s_0) s_0)))))) + (lambda (s_0 default_0) + (begin + (if (let ((or-part_0 (bytes? s_0))) + (if or-part_0 or-part_0 (string? s_0))) + (void) + (raise-argument-error + 'path-list-string->path-list + "(or/c bytes? string?)" + s_0)) + (if (if (list? default_0) (andmap path? default_0) #f) + (void) + (raise-argument-error + 'path-list-string->path-list + "(listof path?)" + default_0)) + (init-rx:path-list!) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (s_1) + (begin + (let ((m_0 (regexp-match rx:path-list s_1))) + (if m_0 + (let ((app_0 (cadr m_0))) + (cons-path default_0 app_0 (loop_0 (caddr m_0)))) + (cons-path default_0 s_1 null)))))))) + (loop_0 (if (string? s_0) (string->bytes/utf-8 s_0) s_0)))))) (define find-executable-path - (letrec ((found-exec_0 - (|#%name| - found-exec - (lambda (libpath_0 reverse?_0 exec-name_0) - (begin - (if libpath_0 - (call-with-values - (lambda () (split-path exec-name_0)) - (case-lambda - ((base_0 name_0 isdir?_0) - (let ((or-part_0 - (if reverse?_0 - (next_0 base_0 exec-name_0 libpath_0 reverse?_0) - #f))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (if (path? base_0) - (let ((lib_0 (build-path base_0 libpath_0))) - (if (let ((or-part_1 - (directory-exists? lib_0))) - (if or-part_1 - or-part_1 - (file-exists? lib_0))) - lib_0 - #f)) - #f))) - (if or-part_1 - or-part_1 - (if (not reverse?_0) - (next_0 - base_0 - exec-name_0 - libpath_0 - reverse?_0) - #f)))))) - (args (raise-binding-result-arity-error 3 args)))) - exec-name_0))))) - (next_0 - (|#%name| - next - (lambda (base_0 exec-name_0 libpath_0 reverse?_0) - (begin - (let ((resolved_0 (resolve-path exec-name_0))) - (if (equal? resolved_0 exec-name_0) - #f - (if (relative-path? resolved_0) - (found-exec_0 - libpath_0 - reverse?_0 - (build-path base_0 resolved_0)) - (found-exec_0 libpath_0 reverse?_0 resolved_0)))))))) - (win-add_0 - (|#%name| - win-add - (lambda (s_0) - (begin - (if (eq? (system-type) 'windows) - (cons (bytes->path #vu8(46)) s_0) - s_0)))))) - (case-lambda - ((program_0 libpath_0 reverse?_0) - (begin - (if (path-string? program_0) - (void) - (raise-argument-error - 'find-executable-path - "path-string?" - program_0)) - (if (let ((or-part_0 (not libpath_0))) - (if or-part_0 - or-part_0 - (if (path-string? libpath_0) (relative-path? libpath_0) #f))) - (void) - (raise-argument-error - 'find-executable-path - "(or/c #f (and/c path-string? relative-path?))" - libpath_0)) - (if (if (relative-path? program_0) - (call-with-values - (lambda () (split-path program_0)) - (case-lambda - ((base_0 name_0 dir?_0) (eq? base_0 'relative)) - (args (raise-binding-result-arity-error 3 args)))) - #f) - (let ((paths-str_0 - (environment-variables-ref - (current-environment-variables) - #vu8(80 65 84 72)))) - (let ((paths-str_1 paths-str_0)) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (paths_0) - (begin - (if (null? paths_0) - #f - (let ((base_0 (path->complete-path (car paths_0)))) - (let ((name_0 (build-path base_0 program_0))) - (if (file-exists? name_0) - (found-exec_0 libpath_0 reverse?_0 name_0) - (loop_0 (cdr paths_0))))))))))) - (loop_0 - (win-add_0 - (if paths-str_1 - (path-list-string->path-list - (bytes->string/locale paths-str_1 '#\x3f) - null) - null)))))) - (let ((p_0 (path->complete-path program_0))) - (if (file-exists? p_0) - (found-exec_0 libpath_0 reverse?_0 p_0) - #f))))) - ((program_0 libpath_0) (find-executable-path program_0 libpath_0 #f)) - ((program_0) (find-executable-path program_0 #f #f))))) + (case-lambda + ((program_0 libpath_0 reverse?_0) + (begin + (if (path-string? program_0) + (void) + (raise-argument-error 'find-executable-path "path-string?" program_0)) + (if (let ((or-part_0 (not libpath_0))) + (if or-part_0 + or-part_0 + (if (path-string? libpath_0) (relative-path? libpath_0) #f))) + (void) + (raise-argument-error + 'find-executable-path + "(or/c #f (and/c path-string? relative-path?))" + libpath_0)) + (letrec* + ((found-exec_0 + (|#%name| + found-exec + (lambda (exec-name_0) + (begin + (if libpath_0 + (call-with-values + (lambda () (split-path exec-name_0)) + (case-lambda + ((base_0 name_0 isdir?_0) + (let ((next_0 + (|#%name| + next + (lambda () + (begin + (let ((resolved_0 (resolve-path exec-name_0))) + (if (equal? resolved_0 exec-name_0) + #f + (if (relative-path? resolved_0) + (found-exec_0 + (build-path base_0 resolved_0)) + (found-exec_0 resolved_0))))))))) + (let ((or-part_0 (if reverse?_0 (next_0) #f))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (if (path? base_0) + (let ((lib_0 (build-path base_0 libpath_0))) + (if (let ((or-part_1 + (directory-exists? lib_0))) + (if or-part_1 + or-part_1 + (file-exists? lib_0))) + lib_0 + #f)) + #f))) + (if or-part_1 + or-part_1 + (if (not reverse?_0) (next_0) #f))))))) + (args (raise-binding-result-arity-error 3 args)))) + exec-name_0)))))) + (if (if (relative-path? program_0) + (call-with-values + (lambda () (split-path program_0)) + (case-lambda + ((base_0 name_0 dir?_0) (eq? base_0 'relative)) + (args (raise-binding-result-arity-error 3 args)))) + #f) + (let ((paths-str_0 + (environment-variables-ref + (current-environment-variables) + #vu8(80 65 84 72)))) + (let ((win-add_0 + (|#%name| + win-add + (lambda (s_0) + (begin + (if (eq? (system-type) 'windows) + (cons (bytes->path #vu8(46)) s_0) + s_0)))))) + (let ((paths-str_1 paths-str_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (paths_0) + (begin + (if (null? paths_0) + #f + (let ((base_0 (path->complete-path (car paths_0)))) + (let ((name_0 (build-path base_0 program_0))) + (if (file-exists? name_0) + (found-exec_0 name_0) + (loop_0 (cdr paths_0))))))))))) + (loop_0 + (win-add_0 + (if paths-str_1 + (path-list-string->path-list + (bytes->string/locale paths-str_1 '#\x3f) + null) + null))))))) + (let ((p_0 (path->complete-path program_0))) + (if (file-exists? p_0) (found-exec_0 p_0) #f)))))) + ((program_0 libpath_0) (find-executable-path program_0 libpath_0 #f)) + ((program_0) (find-executable-path program_0 #f #f)))) (define call-with-default-reading-parameterization (lambda (thunk_0) (if (if (procedure? thunk_0) (procedure-arity-includes? thunk_0 0) #f) @@ -1354,286 +1345,31 @@ (define-values (sort vector-sort vector-sort!) (let ((generic-sort_0 - (letrec ((copying-mergesort_0 - (|#%name| - copying-mergesort - (lambda (A_0 less-than?_0 Alo_0 Blo_0 n_0) - (begin - (if (unsafe-fx= n_0 1) - (unsafe-vector-set! - A_0 - Blo_0 - (unsafe-vector-ref A_0 Alo_0)) - (if (unsafe-fx= n_0 2) - (let ((x_0 (unsafe-vector-ref A_0 Alo_0))) - (let ((y_0 - (unsafe-vector-ref - A_0 - (unsafe-fx+ Alo_0 1)))) - (let ((x_1 x_0)) - (if (|#%app| less-than?_0 y_0 x_1) - (begin - (unsafe-vector-set! A_0 Blo_0 y_0) - (unsafe-vector-set! - A_0 - (unsafe-fx+ Blo_0 1) - x_1)) - (begin - (unsafe-vector-set! A_0 Blo_0 x_1) - (unsafe-vector-set! - A_0 - (unsafe-fx+ Blo_0 1) - y_0)))))) - (if (unsafe-fx< n_0 16) - (begin - (unsafe-vector-set! - A_0 - Blo_0 - (unsafe-vector-ref A_0 Alo_0)) - (letrec* - ((iloop_0 - (|#%name| - iloop - (lambda (i_0) - (begin - (if (unsafe-fx< i_0 n_0) - (let ((ref-i_0 - (unsafe-vector-ref - A_0 - (unsafe-fx+ Alo_0 i_0)))) - (letrec* - ((jloop_0 - (|#%name| - jloop - (lambda (j_0) - (begin - (let ((ref-j-1_0 - (unsafe-vector-ref - A_0 - (unsafe-fx- - j_0 - 1)))) - (if (if (unsafe-fx< - Blo_0 - j_0) - (|#%app| - less-than?_0 - ref-i_0 - ref-j-1_0) - #f) - (begin - (unsafe-vector-set! - A_0 - j_0 - ref-j-1_0) - (jloop_0 - (unsafe-fx- j_0 1))) - (begin - (unsafe-vector-set! - A_0 - j_0 - ref-i_0) - (iloop_0 - (unsafe-fx+ - i_0 - 1)))))))))) - (jloop_0 (unsafe-fx+ Blo_0 i_0)))) - (void))))))) - (iloop_0 1))) - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_0))) - (let ((Amid2_0 (unsafe-fx+ Alo_0 n/2+_0))) - (let ((Bmid1_0 (unsafe-fx+ Blo_0 n/2-_0))) - (begin - (copying-mergesort_0 - A_0 - less-than?_0 - Amid1_0 - Bmid1_0 - n/2+_0) - (copying-mergesort_0 - A_0 - less-than?_0 - Alo_0 - Amid2_0 - n/2-_0) - (let ((b2_0 (unsafe-fx+ Blo_0 n_0))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (a1_0 b1_0 c1_0) - (begin - (let ((x_0 - (unsafe-vector-ref - A_0 - a1_0))) - (let ((y_0 - (unsafe-vector-ref - A_0 - b1_0))) - (let ((x_1 x_0)) - (if (not - (|#%app| - less-than?_0 - y_0 - x_1)) - (begin - (unsafe-vector-set! - A_0 - c1_0 - x_1) - (let ((a1_1 - (unsafe-fx+ - a1_0 - 1))) - (let ((c1_1 - (unsafe-fx+ - c1_0 - 1))) - (if (unsafe-fx< - c1_1 - b1_0) - (loop_0 - a1_1 - b1_0 - c1_1) - (void))))) - (begin - (unsafe-vector-set! - A_0 - c1_0 - y_0) - (let ((b1_1 - (unsafe-fx+ - b1_0 - 1))) - (let ((c1_1 - (unsafe-fx+ - c1_0 - 1))) - (if (unsafe-fx<= - b2_0 - b1_1) - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (a1_1 - c1_2) - (begin - (if (unsafe-fx< - c1_2 - b1_1) - (begin - (unsafe-vector-set! - A_0 - c1_2 - (unsafe-vector-ref - A_0 - a1_1)) - (loop_1 - (unsafe-fx+ - a1_1 - 1) - (unsafe-fx+ - c1_2 - 1))) - (void))))))) - (loop_1 - a1_0 - c1_1)) - (loop_0 - a1_0 - b1_1 - c1_1)))))))))))))) - (loop_0 - Amid2_0 - Bmid1_0 - Blo_0))))))))))))))))) - (|#%name| - generic-sort - (lambda (A_0 less-than?_0 n_0) - (begin - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (begin - (copying-mergesort_0 A_0 less-than?_0 n/2-_0 n_0 n/2+_0) - (if (zero? n/2-_0) - (void) - (copying-mergesort_0 A_0 less-than?_0 0 n/2+_0 n/2-_0)) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (a1_0 b1_0 c1_0) - (begin - (let ((x_0 (unsafe-vector-ref A_0 a1_0))) - (let ((y_0 (unsafe-vector-ref A_0 b1_0))) - (let ((x_1 x_0)) - (if (|#%app| less-than?_0 x_1 y_0) - (begin - (unsafe-vector-set! A_0 c1_0 x_1) - (let ((a1_1 (unsafe-fx+ a1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx< c1_1 b1_0) - (loop_0 a1_1 b1_0 c1_1) - (void))))) - (begin - (unsafe-vector-set! A_0 c1_0 y_0) - (let ((b1_1 (unsafe-fx+ b1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx<= n_0 b1_1) - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (a1_1 c1_2) - (begin - (if (unsafe-fx< c1_2 b1_1) - (begin - (unsafe-vector-set! - A_0 - c1_2 - (unsafe-vector-ref - A_0 - a1_1)) - (loop_1 - (unsafe-fx+ a1_1 1) - (unsafe-fx+ c1_2 1))) - (void))))))) - (loop_1 a1_0 c1_1)) - (loop_0 - a1_0 - b1_1 - c1_1)))))))))))))) - (loop_0 n_0 n/2+_0 0))))))))))) - (let ((generic-sort/key_0 - (letrec ((copying-mergesort_0 + (|#%name| + generic-sort + (lambda (A_0 less-than?_0 n_0) + (begin + (let ((n/2-_0 (unsafe-fxrshift n_0 1))) + (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) + (letrec* + ((copying-mergesort_0 (|#%name| copying-mergesort - (lambda (A_0 key_0 less-than?_0 Alo_0 Blo_0 n_0) + (lambda (Alo_0 Blo_0 n_1) (begin - (if (unsafe-fx= n_0 1) + (if (unsafe-fx= n_1 1) (unsafe-vector-set! A_0 Blo_0 (unsafe-vector-ref A_0 Alo_0)) - (if (unsafe-fx= n_0 2) + (if (unsafe-fx= n_1 2) (let ((x_0 (unsafe-vector-ref A_0 Alo_0))) (let ((y_0 (unsafe-vector-ref A_0 (unsafe-fx+ Alo_0 1)))) (let ((x_1 x_0)) - (if (if key_0 - (let ((app_0 (|#%app| key_0 y_0))) - (|#%app| - less-than?_0 - app_0 - (|#%app| key_0 x_1))) - (|#%app| less-than?_0 y_0 x_1)) + (if (|#%app| less-than?_0 y_0 x_1) (begin (unsafe-vector-set! A_0 Blo_0 y_0) (unsafe-vector-set! @@ -1646,7 +1382,7 @@ A_0 (unsafe-fx+ Blo_0 1) y_0)))))) - (if (unsafe-fx< n_0 16) + (if (unsafe-fx< n_1 16) (begin (unsafe-vector-set! A_0 @@ -1658,7 +1394,7 @@ iloop (lambda (i_0) (begin - (if (unsafe-fx< i_0 n_0) + (if (unsafe-fx< i_0 n_1) (let ((ref-i_0 (unsafe-vector-ref A_0 @@ -1678,21 +1414,10 @@ (if (if (unsafe-fx< Blo_0 j_0) - (if key_0 - (let ((app_0 - (|#%app| - key_0 - ref-i_0))) - (|#%app| - less-than?_0 - app_0 - (|#%app| - key_0 - ref-j-1_0))) - (|#%app| - less-than?_0 - ref-i_0 - ref-j-1_0)) + (|#%app| + less-than?_0 + ref-i_0 + ref-j-1_0) #f) (begin (unsafe-vector-set! @@ -1716,28 +1441,22 @@ (unsafe-fx+ Blo_0 i_0)))) (void))))))) (iloop_0 1))) - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_0))) - (let ((Amid2_0 (unsafe-fx+ Alo_0 n/2+_0))) + (let ((n/2-_1 (unsafe-fxrshift n_1 1))) + (let ((n/2+_1 (unsafe-fx- n_1 n/2-_1))) + (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_1))) + (let ((Amid2_0 (unsafe-fx+ Alo_0 n/2+_1))) (let ((Bmid1_0 - (unsafe-fx+ Blo_0 n/2-_0))) + (unsafe-fx+ Blo_0 n/2-_1))) (begin (copying-mergesort_0 - A_0 - key_0 - less-than?_0 Amid1_0 Bmid1_0 - n/2+_0) + n/2+_1) (copying-mergesort_0 - A_0 - key_0 - less-than?_0 Alo_0 Amid2_0 - n/2-_0) - (let ((b2_0 (unsafe-fx+ Blo_0 n_0))) + n/2-_1) + (let ((b2_0 (unsafe-fx+ Blo_0 n_1))) (letrec* ((loop_0 (|#%name| @@ -1754,21 +1473,10 @@ b1_0))) (let ((x_1 x_0)) (if (not - (if key_0 - (let ((app_0 - (|#%app| - key_0 - y_0))) - (|#%app| - less-than?_0 - app_0 - (|#%app| - key_0 - x_1))) - (|#%app| - less-than?_0 - y_0 - x_1))) + (|#%app| + less-than?_0 + y_0 + x_1)) (begin (unsafe-vector-set! A_0 @@ -1842,274 +1550,530 @@ Amid2_0 Bmid1_0 Blo_0))))))))))))))))) - (|#%name| - generic-sort/key - (lambda (A_0 less-than?_0 n_0 key_0) - (begin - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (begin - (copying-mergesort_0 - A_0 - key_0 - less-than?_0 - n/2-_0 - n_0 - n/2+_0) - (if (zero? n/2-_0) - (void) - (copying-mergesort_0 - A_0 - key_0 - less-than?_0 - 0 - n/2+_0 - n/2-_0)) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (a1_0 b1_0 c1_0) - (begin - (let ((x_0 (unsafe-vector-ref A_0 a1_0))) - (let ((y_0 (unsafe-vector-ref A_0 b1_0))) + (begin + (copying-mergesort_0 n/2-_0 n_0 n/2+_0) + (if (zero? n/2-_0) + (void) + (copying-mergesort_0 0 n/2+_0 n/2-_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (a1_0 b1_0 c1_0) + (begin + (let ((x_0 (unsafe-vector-ref A_0 a1_0))) + (let ((y_0 (unsafe-vector-ref A_0 b1_0))) + (let ((x_1 x_0)) + (if (|#%app| less-than?_0 x_1 y_0) + (begin + (unsafe-vector-set! A_0 c1_0 x_1) + (let ((a1_1 (unsafe-fx+ a1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx< c1_1 b1_0) + (loop_0 a1_1 b1_0 c1_1) + (void))))) + (begin + (unsafe-vector-set! A_0 c1_0 y_0) + (let ((b1_1 (unsafe-fx+ b1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx<= n_0 b1_1) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (a1_1 c1_2) + (begin + (if (unsafe-fx< c1_2 b1_1) + (begin + (unsafe-vector-set! + A_0 + c1_2 + (unsafe-vector-ref + A_0 + a1_1)) + (loop_1 + (unsafe-fx+ a1_1 1) + (unsafe-fx+ c1_2 1))) + (void))))))) + (loop_1 a1_0 c1_1)) + (loop_0 + a1_0 + b1_1 + c1_1)))))))))))))) + (loop_0 n_0 n/2+_0 0))))))))))) + (let ((generic-sort/key_0 + (|#%name| + generic-sort/key + (lambda (A_0 less-than?_0 n_0 key_0) + (begin + (let ((n/2-_0 (unsafe-fxrshift n_0 1))) + (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) + (letrec* + ((copying-mergesort_0 + (|#%name| + copying-mergesort + (lambda (Alo_0 Blo_0 n_1) + (begin + (if (unsafe-fx= n_1 1) + (unsafe-vector-set! + A_0 + Blo_0 + (unsafe-vector-ref A_0 Alo_0)) + (if (unsafe-fx= n_1 2) + (let ((x_0 (unsafe-vector-ref A_0 Alo_0))) + (let ((y_0 + (unsafe-vector-ref + A_0 + (unsafe-fx+ Alo_0 1)))) (let ((x_1 x_0)) (if (if key_0 - (let ((app_0 (|#%app| key_0 x_1))) + (let ((app_0 (|#%app| key_0 y_0))) (|#%app| less-than?_0 app_0 - (|#%app| key_0 y_0))) - (|#%app| less-than?_0 x_1 y_0)) + (|#%app| key_0 x_1))) + (|#%app| less-than?_0 y_0 x_1)) (begin - (unsafe-vector-set! A_0 c1_0 x_1) - (let ((a1_1 (unsafe-fx+ a1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx< c1_1 b1_0) - (loop_0 a1_1 b1_0 c1_1) - (void))))) + (unsafe-vector-set! A_0 Blo_0 y_0) + (unsafe-vector-set! + A_0 + (unsafe-fx+ Blo_0 1) + x_1)) (begin - (unsafe-vector-set! A_0 c1_0 y_0) - (let ((b1_1 (unsafe-fx+ b1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx<= n_0 b1_1) + (unsafe-vector-set! A_0 Blo_0 x_1) + (unsafe-vector-set! + A_0 + (unsafe-fx+ Blo_0 1) + y_0)))))) + (if (unsafe-fx< n_1 16) + (begin + (unsafe-vector-set! + A_0 + Blo_0 + (unsafe-vector-ref A_0 Alo_0)) + (letrec* + ((iloop_0 + (|#%name| + iloop + (lambda (i_0) + (begin + (if (unsafe-fx< i_0 n_1) + (let ((ref-i_0 + (unsafe-vector-ref + A_0 + (unsafe-fx+ Alo_0 i_0)))) (letrec* - ((loop_1 + ((jloop_0 + (|#%name| + jloop + (lambda (j_0) + (begin + (let ((ref-j-1_0 + (unsafe-vector-ref + A_0 + (unsafe-fx- + j_0 + 1)))) + (if (if (unsafe-fx< + Blo_0 + j_0) + (if key_0 + (let ((app_0 + (|#%app| + key_0 + ref-i_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| + key_0 + ref-j-1_0))) + (|#%app| + less-than?_0 + ref-i_0 + ref-j-1_0)) + #f) + (begin + (unsafe-vector-set! + A_0 + j_0 + ref-j-1_0) + (jloop_0 + (unsafe-fx- + j_0 + 1))) + (begin + (unsafe-vector-set! + A_0 + j_0 + ref-i_0) + (iloop_0 + (unsafe-fx+ + i_0 + 1)))))))))) + (jloop_0 + (unsafe-fx+ Blo_0 i_0)))) + (void))))))) + (iloop_0 1))) + (let ((n/2-_1 (unsafe-fxrshift n_1 1))) + (let ((n/2+_1 (unsafe-fx- n_1 n/2-_1))) + (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_1))) + (let ((Amid2_0 + (unsafe-fx+ Alo_0 n/2+_1))) + (let ((Bmid1_0 + (unsafe-fx+ Blo_0 n/2-_1))) + (begin + (copying-mergesort_0 + Amid1_0 + Bmid1_0 + n/2+_1) + (copying-mergesort_0 + Alo_0 + Amid2_0 + n/2-_1) + (let ((b2_0 + (unsafe-fx+ Blo_0 n_1))) + (letrec* + ((loop_0 (|#%name| loop - (lambda (a1_1 c1_2) + (lambda (a1_0 b1_0 c1_0) (begin - (if (unsafe-fx< - c1_2 - b1_1) - (begin - (unsafe-vector-set! - A_0 - c1_2 - (unsafe-vector-ref - A_0 - a1_1)) - (loop_1 - (unsafe-fx+ a1_1 1) - (unsafe-fx+ - c1_2 - 1))) - (void))))))) - (loop_1 a1_0 c1_1)) - (loop_0 - a1_0 - b1_1 - c1_1)))))))))))))) - (loop_0 n_0 n/2+_0 0))))))))))) - (values - (letrec ((loop_0 - (|#%name| - loop - (lambda (getkey_0 less-than?_0 last_0 next_0) - (begin - (let ((or-part_0 (null? next_0))) - (if or-part_0 - or-part_0 - (if (not - (if getkey_0 - (let ((app_0 - (|#%app| getkey_0 (unsafe-car next_0)))) - (|#%app| - less-than?_0 - app_0 - (|#%app| getkey_0 last_0))) - (|#%app| - less-than?_0 - (unsafe-car next_0) - last_0))) - (loop_0 - getkey_0 - less-than?_0 - (unsafe-car next_0) - (unsafe-cdr next_0)) - #f))))))) - (loop_1 - (|#%name| - loop - (lambda (less-than?_0 last_0 next_0) - (begin - (let ((or-part_0 (null? next_0))) - (if or-part_0 - or-part_0 - (if (not - (|#%app| - less-than?_0 - (unsafe-car next_0) - last_0)) - (loop_1 - less-than?_0 - (unsafe-car next_0) - (unsafe-cdr next_0)) - #f)))))))) - (case-lambda - ((lst_0 less-than?_0) - (let ((n_0 (length lst_0))) - (if (unsafe-fx= n_0 0) - lst_0 - (if (let ((app_0 (car lst_0))) - (loop_1 less-than?_0 app_0 (cdr lst_0))) - lst_0 - (if (unsafe-fx<= n_0 3) - (if (unsafe-fx= n_0 1) - lst_0 - (if (unsafe-fx= n_0 2) - (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) - (let ((a_0 (car lst_0))) - (let ((b_0 (cadr lst_0))) - (let ((c_0 (caddr lst_0))) - (let ((b_1 b_0) (a_1 a_0)) - (if (|#%app| less-than?_0 b_1 a_1) - (if (|#%app| less-than?_0 c_0 b_1) - (list c_0 b_1 a_1) - (if (|#%app| less-than?_0 c_0 a_1) - (list b_1 c_0 a_1) - (list b_1 a_1 c_0))) - (if (|#%app| less-than?_0 c_0 a_1) - (list c_0 a_1 b_1) - (list a_1 c_0 b_1))))))))) - (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (let ((x_0 + (unsafe-vector-ref + A_0 + a1_0))) + (let ((y_0 + (unsafe-vector-ref + A_0 + b1_0))) + (let ((x_1 x_0)) + (if (not + (if key_0 + (let ((app_0 + (|#%app| + key_0 + y_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| + key_0 + x_1))) + (|#%app| + less-than?_0 + y_0 + x_1))) + (begin + (unsafe-vector-set! + A_0 + c1_0 + x_1) + (let ((a1_1 + (unsafe-fx+ + a1_0 + 1))) + (let ((c1_1 + (unsafe-fx+ + c1_0 + 1))) + (if (unsafe-fx< + c1_1 + b1_0) + (loop_0 + a1_1 + b1_0 + c1_1) + (void))))) + (begin + (unsafe-vector-set! + A_0 + c1_0 + y_0) + (let ((b1_1 + (unsafe-fx+ + b1_0 + 1))) + (let ((c1_1 + (unsafe-fx+ + c1_0 + 1))) + (if (unsafe-fx<= + b2_0 + b1_1) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (a1_1 + c1_2) + (begin + (if (unsafe-fx< + c1_2 + b1_1) + (begin + (unsafe-vector-set! + A_0 + c1_2 + (unsafe-vector-ref + A_0 + a1_1)) + (loop_1 + (unsafe-fx+ + a1_1 + 1) + (unsafe-fx+ + c1_2 + 1))) + (void))))))) + (loop_1 + a1_0 + c1_1)) + (loop_0 + a1_0 + b1_1 + c1_1)))))))))))))) + (loop_0 + Amid2_0 + Bmid1_0 + Blo_0))))))))))))))))) (begin + (copying-mergesort_0 n/2-_0 n_0 n/2+_0) + (if (zero? n/2-_0) + (void) + (copying-mergesort_0 0 n/2+_0 n/2-_0)) (letrec* - ((loop_2 + ((loop_0 (|#%name| loop - (lambda (i_0 lst_1) + (lambda (a1_0 b1_0 c1_0) (begin - (if (pair? lst_1) - (begin - (vector-set! vec_0 i_0 (car lst_1)) - (let ((app_0 (add1 i_0))) - (loop_2 app_0 (cdr lst_1)))) - (void))))))) - (loop_2 0 lst_0)) - (generic-sort_0 vec_0 less-than?_0 n_0) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 r_0) - (begin - (let ((i_1 (sub1 i_0))) - (if (< i_1 0) - r_0 - (loop_2 - i_1 - (cons (vector-ref vec_0 i_1) r_0))))))))) - (loop_2 n_0 '()))))))))) - ((lst_0 less-than?_0 getkey_0) - (if (if getkey_0 (not (eq? values getkey_0)) #f) - (|#%app| - (check-not-unsafe-undefined sort 'sort) - lst_0 - less-than?_0 - getkey_0 - #f) - (|#%app| - (check-not-unsafe-undefined sort 'sort) - lst_0 - less-than?_0))) - ((lst_0 less-than?_0 getkey_0 cache-keys?_0) - (if (if getkey_0 (not (eq? values getkey_0)) #f) - (let ((n_0 (length lst_0))) - (if (unsafe-fx= n_0 0) - lst_0 - (if cache-keys?_0 - (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) - (begin - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 lst_1) - (begin - (if (pair? lst_1) - (let ((x_0 (car lst_1))) - (begin - (unsafe-vector-set! - vec_0 - i_0 - (cons (|#%app| getkey_0 x_0) x_0)) - (loop_2 (unsafe-fx+ i_0 1) (cdr lst_1)))) - (void))))))) - (loop_2 0 lst_0)) - (generic-sort/key_0 vec_0 less-than?_0 n_0 unsafe-car) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 r_0) - (begin - (let ((i_1 (unsafe-fx- i_0 1))) - (if (unsafe-fx< i_1 0) - r_0 - (loop_2 - i_1 - (cons - (unsafe-cdr (unsafe-vector-ref vec_0 i_1)) - r_0))))))))) - (loop_2 n_0 '())))) - (if (let ((app_0 (car lst_0))) - (loop_0 getkey_0 less-than?_0 app_0 (cdr lst_0))) - lst_0 - (if (unsafe-fx<= n_0 3) - (if (unsafe-fx= n_0 1) - lst_0 - (if (unsafe-fx= n_0 2) - (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) - (let ((a_0 (car lst_0))) - (let ((b_0 (cadr lst_0))) - (let ((c_0 (caddr lst_0))) - (let ((b_1 b_0) (a_1 a_0)) - (if (if getkey_0 - (let ((app_0 (|#%app| getkey_0 b_1))) - (|#%app| - less-than?_0 - app_0 - (|#%app| getkey_0 a_1))) - (|#%app| less-than?_0 b_1 a_1)) - (if (if getkey_0 - (let ((app_0 (|#%app| getkey_0 c_0))) + (let ((x_0 (unsafe-vector-ref A_0 a1_0))) + (let ((y_0 (unsafe-vector-ref A_0 b1_0))) + (let ((x_1 x_0)) + (if (if key_0 + (let ((app_0 (|#%app| key_0 x_1))) (|#%app| less-than?_0 app_0 - (|#%app| getkey_0 b_1))) - (|#%app| less-than?_0 c_0 b_1)) - (list c_0 b_1 a_1) - (if (if getkey_0 - (let ((app_0 - (|#%app| getkey_0 c_0))) + (|#%app| key_0 y_0))) + (|#%app| less-than?_0 x_1 y_0)) + (begin + (unsafe-vector-set! A_0 c1_0 x_1) + (let ((a1_1 (unsafe-fx+ a1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx< c1_1 b1_0) + (loop_0 a1_1 b1_0 c1_1) + (void))))) + (begin + (unsafe-vector-set! A_0 c1_0 y_0) + (let ((b1_1 (unsafe-fx+ b1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx<= n_0 b1_1) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (a1_1 c1_2) + (begin + (if (unsafe-fx< + c1_2 + b1_1) + (begin + (unsafe-vector-set! + A_0 + c1_2 + (unsafe-vector-ref + A_0 + a1_1)) + (loop_1 + (unsafe-fx+ a1_1 1) + (unsafe-fx+ + c1_2 + 1))) + (void))))))) + (loop_1 a1_0 c1_1)) + (loop_0 + a1_0 + b1_1 + c1_1)))))))))))))) + (loop_0 n_0 n/2+_0 0))))))))))) + (values + (case-lambda + ((lst_0 less-than?_0) + (let ((n_0 (length lst_0))) + (if (unsafe-fx= n_0 0) + lst_0 + (if (letrec* + ((loop_0 + (|#%name| + loop + (lambda (last_0 next_0) + (begin + (let ((or-part_0 (null? next_0))) + (if or-part_0 + or-part_0 + (if (not + (|#%app| + less-than?_0 + (unsafe-car next_0) + last_0)) + (loop_0 (unsafe-car next_0) (unsafe-cdr next_0)) + #f)))))))) + (let ((app_0 (car lst_0))) (loop_0 app_0 (cdr lst_0)))) + lst_0 + (if (unsafe-fx<= n_0 3) + (if (unsafe-fx= n_0 1) + lst_0 + (if (unsafe-fx= n_0 2) + (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) + (let ((a_0 (car lst_0))) + (let ((b_0 (cadr lst_0))) + (let ((c_0 (caddr lst_0))) + (let ((b_1 b_0) (a_1 a_0)) + (if (|#%app| less-than?_0 b_1 a_1) + (if (|#%app| less-than?_0 c_0 b_1) + (list c_0 b_1 a_1) + (if (|#%app| less-than?_0 c_0 a_1) + (list b_1 c_0 a_1) + (list b_1 a_1 c_0))) + (if (|#%app| less-than?_0 c_0 a_1) + (list c_0 a_1 b_1) + (list a_1 c_0 b_1))))))))) + (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 lst_1) + (begin + (if (pair? lst_1) + (begin + (vector-set! vec_0 i_0 (car lst_1)) + (let ((app_0 (add1 i_0))) + (loop_0 app_0 (cdr lst_1)))) + (void))))))) + (loop_0 0 lst_0)) + (generic-sort_0 vec_0 less-than?_0 n_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 r_0) + (begin + (let ((i_1 (sub1 i_0))) + (if (< i_1 0) + r_0 + (loop_0 + i_1 + (cons (vector-ref vec_0 i_1) r_0))))))))) + (loop_0 n_0 '()))))))))) + ((lst_0 less-than?_0 getkey_0) + (if (if getkey_0 (not (eq? values getkey_0)) #f) + (|#%app| + (check-not-unsafe-undefined sort 'sort) + lst_0 + less-than?_0 + getkey_0 + #f) + (|#%app| + (check-not-unsafe-undefined sort 'sort) + lst_0 + less-than?_0))) + ((lst_0 less-than?_0 getkey_0 cache-keys?_0) + (if (if getkey_0 (not (eq? values getkey_0)) #f) + (let ((n_0 (length lst_0))) + (if (unsafe-fx= n_0 0) + lst_0 + (if cache-keys?_0 + (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 lst_1) + (begin + (if (pair? lst_1) + (let ((x_0 (car lst_1))) + (begin + (unsafe-vector-set! + vec_0 + i_0 + (cons (|#%app| getkey_0 x_0) x_0)) + (loop_0 (unsafe-fx+ i_0 1) (cdr lst_1)))) + (void))))))) + (loop_0 0 lst_0)) + (generic-sort/key_0 vec_0 less-than?_0 n_0 unsafe-car) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 r_0) + (begin + (let ((i_1 (unsafe-fx- i_0 1))) + (if (unsafe-fx< i_1 0) + r_0 + (loop_0 + i_1 + (cons + (unsafe-cdr (unsafe-vector-ref vec_0 i_1)) + r_0))))))))) + (loop_0 n_0 '())))) + (if (letrec* + ((loop_0 + (|#%name| + loop + (lambda (last_0 next_0) + (begin + (let ((or-part_0 (null? next_0))) + (if or-part_0 + or-part_0 + (if (not + (if getkey_0 + (let ((app_0 (|#%app| - less-than?_0 - app_0 - (|#%app| getkey_0 a_1))) - (|#%app| less-than?_0 c_0 a_1)) - (list b_1 c_0 a_1) - (list b_1 a_1 c_0))) + getkey_0 + (unsafe-car next_0)))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 last_0))) + (|#%app| + less-than?_0 + (unsafe-car next_0) + last_0))) + (loop_0 + (unsafe-car next_0) + (unsafe-cdr next_0)) + #f)))))))) + (let ((app_0 (car lst_0))) (loop_0 app_0 (cdr lst_0)))) + lst_0 + (if (unsafe-fx<= n_0 3) + (if (unsafe-fx= n_0 1) + lst_0 + (if (unsafe-fx= n_0 2) + (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) + (let ((a_0 (car lst_0))) + (let ((b_0 (cadr lst_0))) + (let ((c_0 (caddr lst_0))) + (let ((b_1 b_0) (a_1 a_0)) + (if (if getkey_0 + (let ((app_0 (|#%app| getkey_0 b_1))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 a_1))) + (|#%app| less-than?_0 b_1 a_1)) + (if (if getkey_0 + (let ((app_0 (|#%app| getkey_0 c_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 b_1))) + (|#%app| less-than?_0 c_0 b_1)) + (list c_0 b_1 a_1) (if (if getkey_0 (let ((app_0 (|#%app| getkey_0 c_0))) (|#%app| @@ -2117,43 +2081,50 @@ app_0 (|#%app| getkey_0 a_1))) (|#%app| less-than?_0 c_0 a_1)) - (list c_0 a_1 b_1) - (list a_1 c_0 b_1))))))))) - (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) - (begin - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 lst_1) - (begin - (if (pair? lst_1) - (begin - (vector-set! vec_0 i_0 (car lst_1)) - (let ((app_0 (add1 i_0))) - (loop_2 app_0 (cdr lst_1)))) - (void))))))) - (loop_2 0 lst_0)) - (generic-sort/key_0 vec_0 less-than?_0 n_0 getkey_0) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 r_0) - (begin - (let ((i_1 (sub1 i_0))) - (if (< i_1 0) - r_0 - (loop_2 - i_1 - (cons - (vector-ref vec_0 i_1) - r_0))))))))) - (loop_2 n_0 '()))))))))) - (|#%app| - (check-not-unsafe-undefined sort 'sort) - lst_0 - less-than?_0))))) + (list b_1 c_0 a_1) + (list b_1 a_1 c_0))) + (if (if getkey_0 + (let ((app_0 (|#%app| getkey_0 c_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 a_1))) + (|#%app| less-than?_0 c_0 a_1)) + (list c_0 a_1 b_1) + (list a_1 c_0 b_1))))))))) + (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 lst_1) + (begin + (if (pair? lst_1) + (begin + (vector-set! vec_0 i_0 (car lst_1)) + (let ((app_0 (add1 i_0))) + (loop_0 app_0 (cdr lst_1)))) + (void))))))) + (loop_0 0 lst_0)) + (generic-sort/key_0 vec_0 less-than?_0 n_0 getkey_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 r_0) + (begin + (let ((i_1 (sub1 i_0))) + (if (< i_1 0) + r_0 + (loop_0 + i_1 + (cons (vector-ref vec_0 i_1) r_0))))))))) + (loop_0 n_0 '()))))))))) + (|#%app| + (check-not-unsafe-undefined sort 'sort) + lst_0 + less-than?_0)))) (case-lambda ((vec_0 less-than?_0 start_0 end_0) (let ((n_0 (- end_0 start_0))) @@ -3043,37 +3014,42 @@ (lambda (vec_0 i_0) (let ((new-vec_0 (make-vector i_0))) (begin (vector-copy! new-vec_0 0 vec_0 0 i_0) new-vec_0)))) -(define map_2960 +(define map_1346 (|#%name| map - (letrec ((loop_0 - (|#%name| - loop - (lambda (f_0 l1_0 l2_0) - (begin - (if (null? l1_0) - null - (let ((r1_0 (cdr l1_0))) - (let ((r2_0 (cdr l2_0))) - (let ((r1_1 r1_0)) - (let ((app_0 - (let ((app_0 (car l1_0))) - (|#%app| f_0 app_0 (car l2_0))))) - (cons app_0 (loop_0 f_0 r1_1 r2_0))))))))))) - (loop_1 - (|#%name| - loop - (lambda (f_0 l_0) - (begin - (if (null? l_0) - null - (let ((r_0 (cdr l_0))) - (let ((app_0 (|#%app| f_0 (car l_0)))) - (cons app_0 (loop_1 f_0 r_0)))))))))) - (case-lambda - ((f_0 l_0) (begin (loop_1 f_0 l_0))) - ((f_0 l1_0 l2_0) (loop_0 f_0 l1_0 l2_0)) - ((f_0 l_0 . args_0) (gen-map f_0 (cons l_0 args_0))))))) + (case-lambda + ((f_0 l_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1) + (begin + (if (null? l_1) + null + (let ((r_0 (cdr l_1))) + (let ((app_0 (|#%app| f_0 (car l_1)))) + (cons app_0 (loop_0 r_0)))))))))) + (loop_0 l_0)))) + ((f_0 l1_0 l2_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l1_1 l2_1) + (begin + (if (null? l1_1) + null + (let ((r1_0 (cdr l1_1))) + (let ((r2_0 (cdr l2_1))) + (let ((r1_1 r1_0)) + (let ((app_0 + (let ((app_0 (car l1_1))) + (|#%app| f_0 app_0 (car l2_1))))) + (cons app_0 (loop_0 r1_1 r2_0)))))))))))) + (loop_0 l1_0 l2_0))) + ((f_0 l_0 . args_0) (gen-map f_0 (cons l_0 args_0)))))) (define for-each_2380 (|#%name| for-each @@ -3189,144 +3165,165 @@ (loop_0 l1_0 l2_0)))) ((f_0 l_0 . args_0) (gen-ormap f_0 (cons l_0 args_0)))))) (define check-args - (letrec ((loop_0 - (|#%name| - loop - (lambda (kws_0) - (begin - (if (null? kws_0) - null - (let ((app_0 - (string-append "#:" (keyword->string (car kws_0))))) - (list* " " app_0 (loop_0 (cdr kws_0))))))))) - (loop_1 - (|#%name| - loop - (lambda (w_0 ls_0) - (begin - (if (null? ls_0) - null - (let ((app_0 - (string-append - "\n " - (let ((app_0 (error-value->string-handler))) - (|#%app| app_0 (car ls_0) w_0))))) - (cons app_0 (loop_1 w_0 (cdr ls_0)))))))))) - (lambda (who_0 f_0 ls_0) - (begin - (if (procedure? f_0) - (void) - (raise-argument-error who_0 "procedure?" f_0)) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (prev-len_0 ls_1 i_0) - (begin - (if (null? ls_1) - (void) - (let ((l_0 (car ls_1))) - (begin - (if (list? l_0) - (void) - (raise-argument-error who_0 "list?" l_0)) - (let ((len_0 (length l_0))) - (begin - (if (if prev-len_0 (not (= len_0 prev-len_0)) #f) - (raise-arguments-error - who_0 - "all lists must have same size" - "first list length" - prev-len_0 - "other list length" - len_0 - "procedure" - f_0) - (void)) - (let ((app_0 (cdr ls_1))) - (loop_2 len_0 app_0 (add1 i_0))))))))))))) - (loop_2 #f ls_0 1)) - (if (procedure-arity-includes? f_0 (length ls_0)) - (void) - (call-with-values - (lambda () (procedure-keywords f_0)) - (case-lambda - ((required-keywords_0 optional-keywords_0) - (let ((app_0 - (if (pair? required-keywords_0) - (string-append - "argument mismatch;\n" - " the given procedure expects keyword arguments") - (string-append - "argument mismatch;\n" - " the given procedure's expected number of arguments does not match" - " the given number of lists")))) - (let ((app_1 - (unquoted-printing-string - (let ((or-part_0 - (let ((n_0 (object-name f_0))) - (if (symbol? n_0) (symbol->string n_0) #f)))) - (if or-part_0 or-part_0 "#"))))) - (apply - raise-arguments-error - who_0 - app_0 - "given procedure" - app_1 - (let ((app_2 - (let ((a_0 (procedure-arity f_0))) - (if (pair? required-keywords_0) - null - (if (integer? a_0) - (list "expected" a_0) - (if (arity-at-least? a_0) - (list - "expected" - (unquoted-printing-string - (string-append - "at least " - (number->string - (arity-at-least-value a_0))))) - null)))))) - (let ((app_3 - (if (pair? required-keywords_0) - null - (list "given" (length ls_0))))) - (let ((app_4 - (if (pair? required-keywords_0) + (lambda (who_0 f_0 ls_0) + (begin + (if (procedure? f_0) + (void) + (raise-argument-error who_0 "procedure?" f_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (prev-len_0 ls_1 i_0) + (begin + (if (null? ls_1) + (void) + (let ((l_0 (car ls_1))) + (begin + (if (list? l_0) + (void) + (raise-argument-error who_0 "list?" l_0)) + (let ((len_0 (length l_0))) + (begin + (if (if prev-len_0 (not (= len_0 prev-len_0)) #f) + (raise-arguments-error + who_0 + "all lists must have same size" + "first list length" + prev-len_0 + "other list length" + len_0 + "procedure" + f_0) + (void)) + (let ((app_0 (cdr ls_1))) + (loop_0 len_0 app_0 (add1 i_0))))))))))))) + (loop_0 #f ls_0 1)) + (if (procedure-arity-includes? f_0 (length ls_0)) + (void) + (call-with-values + (lambda () (procedure-keywords f_0)) + (case-lambda + ((required-keywords_0 optional-keywords_0) + (let ((app_0 + (if (pair? required-keywords_0) + (string-append + "argument mismatch;\n" + " the given procedure expects keyword arguments") + (string-append + "argument mismatch;\n" + " the given procedure's expected number of arguments does not match" + " the given number of lists")))) + (let ((app_1 + (unquoted-printing-string + (let ((or-part_0 + (let ((n_0 (object-name f_0))) + (if (symbol? n_0) (symbol->string n_0) #f)))) + (if or-part_0 or-part_0 "#"))))) + (apply + raise-arguments-error + who_0 + app_0 + "given procedure" + app_1 + (let ((app_2 + (let ((a_0 (procedure-arity f_0))) + (if (pair? required-keywords_0) + null + (if (integer? a_0) + (list "expected" a_0) + (if (arity-at-least? a_0) (list - "required keywords" + "expected" (unquoted-printing-string - (apply - string-append - (cdr (loop_0 required-keywords_0))))) - null))) - (append - app_2 - app_3 - app_4 - (let ((w_0 - (let ((app_5 (error-print-width))) - (quotient app_5 (length ls_0))))) - (if (> w_0 10) + (string-append + "at least " + (number->string + (arity-at-least-value a_0))))) + null)))))) + (let ((app_3 + (if (pair? required-keywords_0) + null + (list "given" (length ls_0))))) + (let ((app_4 + (if (pair? required-keywords_0) (list - "argument lists..." + "required keywords" (unquoted-printing-string - (apply string-append (loop_1 w_0 ls_0)))) - null)))))))))) - (args (raise-binding-result-arity-error 2 args))))))))) + (apply + string-append + (cdr + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (kws_0) + (begin + (if (null? kws_0) + null + (let ((app_4 + (string-append + "#:" + (keyword->string + (car kws_0))))) + (list* + " " + app_4 + (loop_0 (cdr kws_0)))))))))) + (loop_0 required-keywords_0)))))) + null))) + (append + app_2 + app_3 + app_4 + (let ((w_0 + (let ((app_5 (error-print-width))) + (quotient app_5 (length ls_0))))) + (if (> w_0 10) + (list + "argument lists..." + (unquoted-printing-string + (apply + string-append + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ls_1) + (begin + (if (null? ls_1) + null + (let ((app_5 + (string-append + "\n " + (let ((app_5 + (error-value->string-handler))) + (|#%app| + app_5 + (car ls_1) + w_0))))) + (cons + app_5 + (loop_0 (cdr ls_1)))))))))) + (loop_0 ls_0))))) + null)))))))))) + (args (raise-binding-result-arity-error 2 args)))))))) (define gen-map - (letrec ((loop_0 - (|#%name| - loop - (lambda (f_0 ls_0) - (begin - (if (null? (car ls_0)) - null - (let ((next-ls_0 (map_2960 cdr ls_0))) - (let ((app_0 (apply f_0 (map_2960 car ls_0)))) - (cons app_0 (loop_0 f_0 next-ls_0)))))))))) - (lambda (f_0 ls_0) (begin #t (loop_0 f_0 ls_0))))) + (lambda (f_0 ls_0) + (begin + #t + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ls_1) + (begin + (if (null? (car ls_1)) + null + (let ((next-ls_0 (map_1346 cdr ls_1))) + (let ((app_0 (apply f_0 (map_1346 car ls_1)))) + (cons app_0 (loop_0 next-ls_0)))))))))) + (loop_0 ls_0))))) (define gen-for-each (lambda (f_0 ls_0) (begin @@ -3339,9 +3336,9 @@ (begin (if (null? (car ls_1)) (void) - (let ((next-ls_0 (map_2960 cdr ls_1))) + (let ((next-ls_0 (map_1346 cdr ls_1))) (begin - (apply f_0 (map_2960 car ls_1)) + (apply f_0 (map_1346 car ls_1)) (loop_0 next-ls_0))))))))) (loop_0 ls_0))))) (define gen-andmap @@ -3357,9 +3354,9 @@ (if (null? (car ls_1)) #t (if (null? (cdar ls_1)) - (apply f_0 (map_2960 car ls_1)) - (let ((next-ls_0 (map_2960 cdr ls_1))) - (if (apply f_0 (map_2960 car ls_1)) + (apply f_0 (map_1346 car ls_1)) + (let ((next-ls_0 (map_1346 cdr ls_1))) + (if (apply f_0 (map_1346 car ls_1)) (loop_0 next-ls_0) #f))))))))) (loop_0 ls_0))))) @@ -3376,22 +3373,24 @@ (if (null? (car ls_1)) #f (if (null? (cdar ls_1)) - (apply f_0 (map_2960 car ls_1)) - (let ((next-ls_0 (map_2960 cdr ls_1))) - (let ((or-part_0 (apply f_0 (map_2960 car ls_1)))) + (apply f_0 (map_1346 car ls_1)) + (let ((next-ls_0 (map_1346 cdr ls_1))) + (let ((or-part_0 (apply f_0 (map_1346 car ls_1)))) (if or-part_0 or-part_0 (loop_0 next-ls_0))))))))))) (loop_0 ls_0))))) (define hash-keys - (letrec ((loop_0 - (|#%name| - loop - (lambda (h_0 pos_0) - (begin - (if pos_0 - (let ((app_0 (hash-iterate-key h_0 pos_0))) - (cons app_0 (loop_0 h_0 (hash-iterate-next h_0 pos_0)))) - null)))))) - (lambda (h_0) (loop_0 h_0 (hash-iterate-first h_0))))) + (lambda (h_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_0) + (begin + (if pos_0 + (let ((app_0 (hash-iterate-key h_0 pos_0))) + (cons app_0 (loop_0 (hash-iterate-next h_0 pos_0)))) + null)))))) + (loop_0 (hash-iterate-first h_0))))) (define sort.1 (|#%name| sort @@ -3762,80 +3761,72 @@ (define exited-key (gensym 'as-exit)) (define lock-tag (make-continuation-prompt-tag 'lock)) (define call-as-atomic - (letrec ((procz6 (lambda (t_0) (|#%app| t_0))) - (procz5 - (lambda () - (begin - (unsafe-place-local-set! cell.1$10 #f) - (unsafe-place-local-set! cell.2$5 #f) - (unsafe-place-local-set! cell.3$2 #f) - (begin-unsafe (unsafe-end-breakable-atomic))))) - (procz4 - (lambda (exn_0) - (if (continuation-mark-set-first #f exited-key) - exn_0 - (abort-current-continuation - lock-tag - (lambda () (raise exn_0)))))) - (procz3 - (lambda () - (begin - (begin-unsafe (unsafe-start-breakable-atomic)) - (unsafe-place-local-set! cell.1$10 (current-thread))))) - (procz2 - (lambda () - (begin - (unsafe-place-local-set! - cell.4$2 - (sub1 (unsafe-place-local-ref cell.4$2))) - (begin-unsafe (unsafe-end-breakable-atomic))))) - (procz1 - (lambda () - (begin - (begin-unsafe (unsafe-start-breakable-atomic)) - (unsafe-place-local-set! - cell.4$2 - (add1 (unsafe-place-local-ref cell.4$2))))))) - (lambda (f_0) - (begin - (if (if (procedure? f_0) (procedure-arity-includes? f_0 0) #f) - (void) - (raise-type-error 'call-as-atomic "procedure (arity 0)" f_0)) - (if (eq? (unsafe-place-local-ref cell.1$10) (current-thread)) - (dynamic-wind procz1 f_0 procz2) - (with-continuation-mark* - general - exited-key - #f - (call-with-continuation-prompt - (lambda () - (dynamic-wind - procz3 - (lambda () - (begin - (unsafe-place-local-set! - cell.2$5 - (current-parameterization)) - (unsafe-place-local-set! - cell.3$2 - (current-break-parameterization)) - (with-continuation-mark* - authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - error-value->string-handler - entered-err-string-handler) - (with-continuation-mark* - authentic - break-enabled-key - (make-thread-cell #f) - (begin - (check-for-break) - (call-with-exception-handler procz4 f_0)))))) - procz5)) - lock-tag - procz6))))))) + (lambda (f_0) + (begin + (if (if (procedure? f_0) (procedure-arity-includes? f_0 0) #f) + (void) + (raise-type-error 'call-as-atomic "procedure (arity 0)" f_0)) + (if (eq? (unsafe-place-local-ref cell.1$10) (current-thread)) + (dynamic-wind + (lambda () + (begin + (begin-unsafe (unsafe-start-breakable-atomic)) + (unsafe-place-local-set! + cell.4$2 + (add1 (unsafe-place-local-ref cell.4$2))))) + f_0 + (lambda () + (begin + (unsafe-place-local-set! + cell.4$2 + (sub1 (unsafe-place-local-ref cell.4$2))) + (begin-unsafe (unsafe-end-breakable-atomic))))) + (with-continuation-mark* + general + exited-key + #f + (call-with-continuation-prompt + (lambda () + (dynamic-wind + (lambda () + (begin + (begin-unsafe (unsafe-start-breakable-atomic)) + (unsafe-place-local-set! cell.1$10 (current-thread)))) + (lambda () + (begin + (unsafe-place-local-set! cell.2$5 (current-parameterization)) + (unsafe-place-local-set! + cell.3$2 + (current-break-parameterization)) + (with-continuation-mark* + authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first #f parameterization-key) + error-value->string-handler + entered-err-string-handler) + (with-continuation-mark* + authentic + break-enabled-key + (make-thread-cell #f) + (begin + (check-for-break) + (call-with-exception-handler + (lambda (exn_0) + (if (continuation-mark-set-first #f exited-key) + exn_0 + (abort-current-continuation + lock-tag + (lambda () (raise exn_0))))) + f_0)))))) + (lambda () + (begin + (unsafe-place-local-set! cell.1$10 #f) + (unsafe-place-local-set! cell.2$5 #f) + (unsafe-place-local-set! cell.3$2 #f) + (begin-unsafe (unsafe-end-breakable-atomic)))))) + lock-tag + (lambda (t_0) (|#%app| t_0)))))))) (define call-as-nonatomic (lambda (f_0) (begin @@ -4214,40 +4205,41 @@ 'count)))))) (define stat-key (gensym)) (define start-performance-region - (letrec ((loop_0 - (|#%name| - loop - (lambda (path_0 enclosing-path_0) - (begin - (if (null? path_0) - null - (let ((app_0 - (if (if (eq? '_ (car path_0)) - (pair? enclosing-path_0) - #f) - (car enclosing-path_0) - (car path_0)))) - (cons - app_0 - (let ((app_1 (cdr path_0))) - (loop_0 - app_1 - (if (pair? enclosing-path_0) - (cdr enclosing-path_0) - null))))))))))) - (lambda path_0 - (unsafe-place-local-set! - cell.1$9 - (cons - (let ((app_0 - (if (unsafe-place-local-ref cell.1$9) - (loop_0 - path_0 - (region-path (car (unsafe-place-local-ref cell.1$9)))) - path_0))) - (let ((app_1 (current-inexact-milliseconds))) - (region1.1 app_0 app_1 (current-memory-use 'cumulative) 0.0 0))) - (unsafe-place-local-ref cell.1$9)))))) + (lambda path_0 + (unsafe-place-local-set! + cell.1$9 + (cons + (let ((app_0 + (if (unsafe-place-local-ref cell.1$9) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (path_1 enclosing-path_0) + (begin + (if (null? path_1) + null + (let ((app_0 + (if (if (eq? '_ (car path_1)) + (pair? enclosing-path_0) + #f) + (car enclosing-path_0) + (car path_1)))) + (cons + app_0 + (let ((app_1 (cdr path_1))) + (loop_0 + app_1 + (if (pair? enclosing-path_0) + (cdr enclosing-path_0) + null))))))))))) + (loop_0 + path_0 + (region-path (car (unsafe-place-local-ref cell.1$9))))) + path_0))) + (let ((app_1 (current-inexact-milliseconds))) + (region1.1 app_0 app_1 (current-memory-use 'cumulative) 0.0 0))) + (unsafe-place-local-ref cell.1$9))))) (define end-performance-region (lambda () (let ((now_0 (current-inexact-milliseconds))) @@ -4337,385 +4329,410 @@ (car (unsafe-place-local-ref cell.1$9))) full-delta-memory_0)))) (void))))))))))))) -(define effect_2816 +(define effect_2814 (begin (|#%call-with-values| - (letrec ((kb_0 - (|#%name| - kb - (lambda (b_0) - (begin - (let ((s_0 (number->string (quotient b_0 1024)))) - (list->string - (let ((lst_0 (reverse$1 (string->list s_0)))) + (lambda () + (if log-performance? + (void + (plumber-add-flush! + (current-plumber) + (lambda (h_0) + (let ((whole-len_0 + (|#%name| + whole-len + (lambda (s_0) + (begin + (caar + (let ((or-part_0 + (regexp-match-positions rx2668 s_0))) + (if or-part_0 or-part_0 '(0))))))))) + (let ((kb_0 + (|#%name| + kb + (lambda (b_0) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (l_0 lst_1 pos_0) - (begin - (if (if (pair? lst_1) #t #f) - (let ((c_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (let ((l_1 + (let ((s_0 (number->string (quotient b_0 1024)))) + (list->string + (let ((lst_0 (reverse$1 (string->list s_0)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (l_0 lst_1 pos_0) + (begin + (if (if (pair? lst_1) #t #f) + (let ((c_0 (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) (let ((l_1 - (if (if (positive? - pos_0) - (zero? - (modulo pos_0 3)) - #f) - (list* c_0 '#\x2c l_0) - (cons c_0 l_0)))) - (values l_1)))) - (for-loop_0 - l_1 - rest_0 - (+ pos_0 1))))) - l_0)))))) - (for-loop_0 null lst_0 0)))))))))) - (loop_0 - (|#%name| - loop - (lambda (accums_0 - label-len_0 - value-len_0 - memory-len_0 - count-len_0 - indent_0) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (label-len_1 - value-len_1 - memory-len_1 - count-len_1 - i_0) + (let ((l_1 + (if (if (positive? + pos_0) + (zero? + (modulo + pos_0 + 3)) + #f) + (list* + c_0 + '#\x2c + l_0) + (cons + c_0 + l_0)))) + (values l_1)))) + (for-loop_0 + l_1 + rest_0 + (+ pos_0 1))))) + l_0)))))) + (for-loop_0 null lst_0 0))))))))))) + (call-with-values + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (accums_0 + label-len_0 + value-len_0 + memory-len_0 + count-len_0 + indent_0) + (begin (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value accums_0 i_0)) - (case-lambda - ((k_0 v_0) - (call-with-values - (lambda () - (call-with-values - (lambda () - (if (eq? k_0 stat-key) - (let ((app_0 - (max - value-len_1 - (whole-len_0 - (format - "~a" - (stat-msecs v_0)))))) - (let ((app_1 - (max - memory-len_1 - (string-length - (format - "~a" - (kb_0 - (stat-memory v_0))))))) - (values - label-len_1 - app_0 - app_1 - (max - count-len_1 - (string-length - (format - "~a" - (stat-count v_0))))))) - (let ((app_0 - (max - label-len_1 - (+ - indent_0 - (string-length - (format "~a" k_0)))))) - (loop_0 - v_0 - app_0 - value-len_1 - memory-len_1 - count-len_1 - (+ 2 indent_0))))) - (case-lambda - ((label-len_2 - value-len_2 - memory-len_2 - count-len_2) - (values - label-len_2 - value-len_2 - memory-len_2 - count-len_2)) - (args - (raise-binding-result-arity-error - 4 - args))))) - (case-lambda - ((label-len_2 - value-len_2 - memory-len_2 - count-len_2) - (for-loop_0 - label-len_2 - value-len_2 - memory-len_2 - count-len_2 - (hash-iterate-next accums_0 i_0))) - (args - (raise-binding-result-arity-error - 4 - args))))) - (args - (raise-binding-result-arity-error 2 args)))) - (values - label-len_1 - value-len_1 - memory-len_1 - count-len_1))))))) - (for-loop_0 - label-len_0 - value-len_0 - memory-len_0 - count-len_0 - (hash-iterate-first accums_0)))))))) - (loop_1 - (|#%name| - loop - (lambda (count-max-len_0 - label-max-len_0 - memory-max-len_0 - value-max-len_0 - name_0 - accums_0 - indent_0 - newline?_0) - (begin - (begin - (if name_0 - (let ((v_0 (hash-ref accums_0 stat-key))) - (let ((l_0 (current-logger))) - (if (log-level? l_0 'error (logger-name l_0)) - (let ((app_0 - (let ((app_0 - (make-string - (let ((app_0 - (let ((app_0 - (string-length + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (label-len_1 + value-len_1 + memory-len_1 + count-len_1 + i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + accums_0 + i_0)) + (case-lambda + ((k_0 v_0) + (call-with-values + (lambda () + (call-with-values + (lambda () + (if (eq? k_0 stat-key) + (let ((app_0 + (max + value-len_1 + (whole-len_0 (format "~a" - name_0)))) - (- - label-max-len_0 - app_0 - (string-length - indent_0))))) - (+ - app_0 - (- - value-max-len_0 - (whole-len_0 - (format - "~a" - (stat-msecs v_0)))))) - '#\x20))) - (let ((app_1 - (regexp-replace - rx2640 - (format "~a00" (stat-msecs v_0)) - ".\\1"))) - (let ((app_2 - (make-string - (- - memory-max-len_0 - (string-length - (format - "~a" - (kb_0 (stat-memory v_0))))) - '#\x20))) - (let ((app_3 - (kb_0 (stat-memory v_0)))) - (let ((app_4 - (make-string - (- - count-max-len_0 - (string-length - (format - "~a" - (stat-count v_0)))) - '#\x20))) - (format - "~a~a ~a~a ~a~a ~a~a" - indent_0 - name_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (stat-count v_0))))))))) - (log-message - l_0 - 'error - app_0 - (current-continuation-marks))) - (void)))) - (void)) - (let ((keys_0 - (let ((temp5_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 i_0) - (begin - (if i_0 - (let ((k_0 - (hash-iterate-key - accums_0 - i_0))) - (let ((fold-var_1 - (if (not - (eq? - k_0 - stat-key)) - (let ((fold-var_1 - (cons - k_0 - fold-var_0))) - (values - fold-var_1)) - fold-var_0))) - (for-loop_0 - fold-var_1 - (hash-iterate-next - accums_0 - i_0)))) - fold-var_0)))))) - (for-loop_0 - null - (hash-iterate-first accums_0))))))) - (let ((temp7_0 - (lambda (key_0) - (stat-msecs - (hash-ref - (hash-ref accums_0 key_0) - stat-key))))) - (let ((temp5_1 temp5_0)) - (sort.1 #f temp7_0 temp5_1 >)))))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0 pos_0) - (begin - (if (if (pair? lst_0) #t #f) - (let ((k_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (begin - (if (if newline?_0 - (positive? pos_0) - #f) - (let ((l_0 (current-logger))) - (if (log-level? - l_0 - 'error - (logger-name l_0)) - (log-message - l_0 - 'error - "" - (current-continuation-marks)) - (void))) - (void)) - (let ((app_0 - (hash-ref accums_0 k_0))) - (loop_1 - count-max-len_0 - label-max-len_0 - memory-max-len_0 - value-max-len_0 - k_0 - app_0 - (string-append indent_0 " ") - #f))) - (for-loop_0 rest_0 (+ pos_0 1))))) - (values))))))) - (for-loop_0 keys_0 0))) - (void)))))))) - (whole-len_0 - (|#%name| - whole-len - (lambda (s_0) - (begin - (caar - (let ((or-part_0 (regexp-match-positions rx2668 s_0))) - (if or-part_0 or-part_0 '(0))))))))) - (lambda () - (if log-performance? - (void - (plumber-add-flush! - (current-plumber) - (lambda (h_0) - (call-with-values - (lambda () - (loop_0 (unsafe-place-local-ref cell.2$4) 6 5 4 5 2)) - (case-lambda - ((label-max-len_0 - value-max-len_0 - memory-max-len_0 - count-max-len_0) - (begin - (let ((l_0 (current-logger))) - (if (log-level? l_0 'error (logger-name l_0)) - (let ((app_0 - (let ((app_0 - (make-string - (- - (+ label-max-len_0 value-max-len_0) - 11) - '#\x20))) - (let ((app_1 - (make-string - (- memory-max-len_0 4) - '#\x20))) - (format - "REGION ~aMSECS ~aMEMK ~aCOUNT" - app_0 - app_1 - (make-string - (- count-max-len_0 5) - '#\x20)))))) - (log-message - l_0 - 'error - app_0 - (current-continuation-marks))) - (void))) - (loop_1 - count-max-len_0 - label-max-len_0 - memory-max-len_0 + (stat-msecs + v_0)))))) + (let ((app_1 + (max + memory-len_1 + (string-length + (format + "~a" + (kb_0 + (stat-memory + v_0))))))) + (values + label-len_1 + app_0 + app_1 + (max + count-len_1 + (string-length + (format + "~a" + (stat-count + v_0))))))) + (let ((app_0 + (max + label-len_1 + (+ + indent_0 + (string-length + (format + "~a" + k_0)))))) + (loop_0 + v_0 + app_0 + value-len_1 + memory-len_1 + count-len_1 + (+ 2 indent_0))))) + (case-lambda + ((label-len_2 + value-len_2 + memory-len_2 + count-len_2) + (values + label-len_2 + value-len_2 + memory-len_2 + count-len_2)) + (args + (raise-binding-result-arity-error + 4 + args))))) + (case-lambda + ((label-len_2 + value-len_2 + memory-len_2 + count-len_2) + (for-loop_0 + label-len_2 + value-len_2 + memory-len_2 + count-len_2 + (hash-iterate-next + accums_0 + i_0))) + (args + (raise-binding-result-arity-error + 4 + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values + label-len_1 + value-len_1 + memory-len_1 + count-len_1))))))) + (for-loop_0 + label-len_0 + value-len_0 + memory-len_0 + count-len_0 + (hash-iterate-first accums_0))))))))) + (loop_0 (unsafe-place-local-ref cell.2$4) 6 5 4 5 2))) + (case-lambda + ((label-max-len_0 value-max-len_0 - #f - (unsafe-place-local-ref cell.2$4) - "" - #t))) - (args (raise-binding-result-arity-error 4 args))))))) - (void)))) + memory-max-len_0 + count-max-len_0) + (begin + (let ((l_0 (current-logger))) + (if (log-level? l_0 'error (logger-name l_0)) + (let ((app_0 + (let ((app_0 + (make-string + (- + (+ label-max-len_0 value-max-len_0) + 11) + '#\x20))) + (let ((app_1 + (make-string + (- memory-max-len_0 4) + '#\x20))) + (format + "REGION ~aMSECS ~aMEMK ~aCOUNT" + app_0 + app_1 + (make-string + (- count-max-len_0 5) + '#\x20)))))) + (log-message + l_0 + 'error + app_0 + (current-continuation-marks))) + (void))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (name_0 accums_0 indent_0 newline?_0) + (begin + (begin + (if name_0 + (let ((v_0 (hash-ref accums_0 stat-key))) + (let ((l_0 (current-logger))) + (if (log-level? + l_0 + 'error + (logger-name l_0)) + (let ((app_0 + (let ((app_0 + (make-string + (let ((app_0 + (let ((app_0 + (string-length + (format + "~a" + name_0)))) + (- + label-max-len_0 + app_0 + (string-length + indent_0))))) + (+ + app_0 + (- + value-max-len_0 + (whole-len_0 + (format + "~a" + (stat-msecs + v_0)))))) + '#\x20))) + (let ((app_1 + (regexp-replace + rx2640 + (format + "~a00" + (stat-msecs v_0)) + ".\\1"))) + (let ((app_2 + (make-string + (- + memory-max-len_0 + (string-length + (format + "~a" + (kb_0 + (stat-memory + v_0))))) + '#\x20))) + (let ((app_3 + (kb_0 + (stat-memory + v_0)))) + (let ((app_4 + (make-string + (- + count-max-len_0 + (string-length + (format + "~a" + (stat-count + v_0)))) + '#\x20))) + (format + "~a~a ~a~a ~a~a ~a~a" + indent_0 + name_0 + app_0 + app_1 + app_2 + app_3 + app_4 + (stat-count + v_0))))))))) + (log-message + l_0 + 'error + app_0 + (current-continuation-marks))) + (void)))) + (void)) + (let ((keys_0 + (let ((temp5_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 i_0) + (begin + (if i_0 + (let ((k_0 + (hash-iterate-key + accums_0 + i_0))) + (let ((fold-var_1 + (if (not + (eq? + k_0 + stat-key)) + (let ((fold-var_1 + (cons + k_0 + fold-var_0))) + (values + fold-var_1)) + fold-var_0))) + (for-loop_0 + fold-var_1 + (hash-iterate-next + accums_0 + i_0)))) + fold-var_0)))))) + (for-loop_0 + null + (hash-iterate-first + accums_0))))))) + (let ((temp7_0 + (lambda (key_0) + (stat-msecs + (hash-ref + (hash-ref accums_0 key_0) + stat-key))))) + (let ((temp5_1 temp5_0)) + (sort.1 #f temp7_0 temp5_1 >)))))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0 pos_0) + (begin + (if (if (pair? lst_0) #t #f) + (let ((k_0 (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) + (begin + (begin + (if (if newline?_0 + (positive? pos_0) + #f) + (let ((l_0 + (current-logger))) + (if (log-level? + l_0 + 'error + (logger-name + l_0)) + (log-message + l_0 + 'error + "" + (current-continuation-marks)) + (void))) + (void)) + (let ((app_0 + (hash-ref + accums_0 + k_0))) + (loop_0 + k_0 + app_0 + (string-append + indent_0 + " ") + #f))) + (for-loop_0 + rest_0 + (+ pos_0 1))))) + (values))))))) + (for-loop_0 keys_0 0))) + (void))))))))) + (loop_0 #f (unsafe-place-local-ref cell.2$4) "" #t)))) + (args (raise-binding-result-arity-error 4 args))))))))) + (void))) print-values) (void))) (define 1/module-path? @@ -5764,7 +5781,7 @@ root-mod-path_0)))))) (define struct:module-path-index (make-record-type-descriptor* 'module-path-index #f #f #f #f 4 12)) -(define effect_2579 +(define effect_2455 (struct-type-install-properties! struct:module-path-index 'module-path-index @@ -5775,75 +5792,96 @@ (cons prop:authentic #t) (cons prop:custom-write - (letrec ((loop_0 - (|#%name| - loop - (lambda (r_0) - (begin - (if (not r_0) - null - (if (1/resolved-module-path? r_0) - (list "+" (format "~a" r_0)) - (if (module-path-index-path r_0) - (let ((app_0 (loop_1 (module-path-index-path r_0)))) - (cons app_0 (loop_0 (module-path-index-base r_0)))) - (if (module-path-index-resolved r_0) - (list - "+" - (format "~a" (module-path-index-resolved r_0))) - null)))))))) - (loop_1 - (|#%name| - loop - (lambda (v_0) - (begin - (if (if (pair? v_0) - (if (eq? 'quote (car v_0)) (null? (cddr v_0)) #f) - #f) - (format-symbol (cadr v_0)) - (if (if (pair? v_0) (eq? 'submod (car v_0)) #f) - (let ((app_0 (loop_1 (cadr v_0)))) - (format-submod app_0 (cddr v_0))) - (format "~.s" v_0)))))))) - (lambda (r_0 port_0 mode_0) - (begin - (write-string "#" port_0))))) + (lambda (r_0 port_0 mode_0) + (begin + (write-string "#" port_0)))) (cons prop:equal+hash (list @@ -6199,29 +6237,30 @@ result_0)))))) (for-loop_0 #f cache_0))))) (define shift-cache-set! - (letrec ((loop_0 - (|#%name| - loop - (lambda (n_0 l_0) - (begin - (if (null? l_0) - null - (if (eqv? n_0 0) - null - (if (not (weak-box-value (car l_0))) - (loop_0 n_0 (cdr l_0)) - (let ((r_0 - (let ((app_0 (fx- n_0 1))) - (loop_0 app_0 (cdr l_0))))) - (if (eq? r_0 (cdr l_0)) - l_0 - (cons (car l_0) r_0))))))))))) - (lambda (base_0 v_0) - (let ((new-cache_0 - (cons - (make-weak-box v_0) - (loop_0 32 (module-path-index-shift-cache base_0))))) - (set-module-path-index-shift-cache! base_0 new-cache_0))))) + (lambda (base_0 v_0) + (let ((new-cache_0 + (cons + (make-weak-box v_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (n_0 l_0) + (begin + (if (null? l_0) + null + (if (eqv? n_0 0) + null + (if (not (weak-box-value (car l_0))) + (loop_0 n_0 (cdr l_0)) + (let ((r_0 + (let ((app_0 (fx- n_0 1))) + (loop_0 app_0 (cdr l_0))))) + (if (eq? r_0 (cdr l_0)) + l_0 + (cons (car l_0) r_0))))))))))) + (loop_0 32 (module-path-index-shift-cache base_0)))))) + (set-module-path-index-shift-cache! base_0 new-cache_0)))) (define top-level-module-path-index (make-self-module-path-index (1/make-resolved-module-path 'top-level))) (define top-level-module-path-index? @@ -6755,367 +6794,331 @@ (define all-fields-immutable? (lambda (k_0) (prefab-key-all-fields-immutable? k_0))) (define datum-map-slow - (letrec ((loop_0 - (|#%name| - loop - (lambda (f_0 known-pairs_0 tail?_0 s_0 prev-seen_0) - (begin - (let ((seen_0 - (if (if prev-seen_0 (datum-has-elements? s_0) #f) - (if (hash-ref prev-seen_0 s_0 #f) - (|#%app| (hash-ref prev-seen_0 'cycle-fail) s_0) - (hash-set prev-seen_0 s_0 #t)) - prev-seen_0))) - (if (null? s_0) - (|#%app| f_0 tail?_0 s_0) - (if (pair? s_0) - (if (if known-pairs_0 - (if tail?_0 (hash-ref known-pairs_0 s_0 #f) #f) - #f) - s_0 - (|#%app| - f_0 - tail?_0 - (let ((app_0 - (loop_0 - f_0 - known-pairs_0 - #f - (car s_0) - seen_0))) - (cons - app_0 - (let ((app_1 (if tail?_0 (fx+ 1 tail?_0) 1))) - (loop_0 - f_0 - known-pairs_0 - app_1 - (cdr s_0) - seen_0)))))) - (if (let ((or-part_0 (symbol? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (boolean? s_0))) - (if or-part_1 or-part_1 (number? s_0))))) - (|#%app| f_0 #f s_0) - (if (vector? s_0) - (|#%app| - f_0 - #f - (vector->immutable-vector - (let ((len_0 (vector-length s_0))) - (begin - (if (exact-nonnegative-integer? len_0) - (void) - (raise-argument-error - 'for/vector - "exact-nonnegative-integer?" - len_0)) - (let ((v_0 (make-vector len_0 0))) - (begin - (if (zero? len_0) - (void) - (call-with-values - (lambda () - (begin - (check-vector s_0) - (values - s_0 - (unsafe-vector-length s_0)))) - (case-lambda - ((vec_0 len_1) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0 pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_1) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (let ((i_1 - (let ((i_1 - (begin - (unsafe-vector*-set! - v_0 - i_0 - (loop_0 - f_0 - known-pairs_0 - #f - e_0 - seen_0)) - (unsafe-fx+ - 1 - i_0)))) - (values - i_1)))) - (if (if (not - (let ((x_0 - (list - e_0))) - (unsafe-fx= - i_1 - len_0))) - #t - #f) - (for-loop_0 - i_1 - (unsafe-fx+ - 1 - pos_0)) - i_1))) - i_0)))))) - (for-loop_0 0 0)))) - (args - (raise-binding-result-arity-error - 2 - args))))) - v_0)))))) - (if (box? s_0) - (|#%app| - f_0 - #f - (box-immutable - (loop_0 - f_0 - known-pairs_0 - #f - (unbox s_0) - seen_0))) - (let ((c1_0 (immutable-prefab-struct-key s_0))) - (if c1_0 - (|#%app| - f_0 - #f - (apply - make-prefab-struct - c1_0 - (reverse$1 - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - (struct->vector s_0) - 1 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 idx_0) - (begin - (if (unsafe-fx< idx_0 stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons + (lambda (tail?_0 s_0 f_0 seen_0 known-pairs_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (tail?_1 s_1 prev-seen_0) + (begin + (let ((seen_1 + (if (if prev-seen_0 (datum-has-elements? s_1) #f) + (if (hash-ref prev-seen_0 s_1 #f) + (|#%app| (hash-ref prev-seen_0 'cycle-fail) s_1) + (hash-set prev-seen_0 s_1 #t)) + prev-seen_0))) + (if (null? s_1) + (|#%app| f_0 tail?_1 s_1) + (if (pair? s_1) + (if (if known-pairs_0 + (if tail?_1 (hash-ref known-pairs_0 s_1 #f) #f) + #f) + s_1 + (|#%app| + f_0 + tail?_1 + (let ((app_0 (loop_0 #f (car s_1) seen_1))) + (cons + app_0 + (let ((app_1 (if tail?_1 (fx+ 1 tail?_1) 1))) + (loop_0 app_1 (cdr s_1) seen_1)))))) + (if (let ((or-part_0 (symbol? s_1))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (boolean? s_1))) + (if or-part_1 or-part_1 (number? s_1))))) + (|#%app| f_0 #f s_1) + (if (vector? s_1) + (|#%app| + f_0 + #f + (vector->immutable-vector + (let ((len_0 (vector-length s_1))) + (begin + (if (exact-nonnegative-integer? len_0) + (void) + (raise-argument-error + 'for/vector + "exact-nonnegative-integer?" + len_0)) + (let ((v_0 (make-vector len_0 0))) + (begin + (if (zero? len_0) + (void) + (call-with-values + (lambda () + (begin + (check-vector s_1) + (values + s_1 + (unsafe-vector-length s_1)))) + (case-lambda + ((vec_0 len_1) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0 pos_0) + (begin + (if (unsafe-fx< pos_0 len_1) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (let ((i_1 + (let ((i_1 + (begin + (unsafe-vector*-set! + v_0 + i_0 (loop_0 - f_0 - known-pairs_0 #f e_0 - seen_0) - fold-var_0))) - (values - fold-var_1)))) + seen_1)) + (unsafe-fx+ + 1 + i_0)))) + (values i_1)))) + (if (if (not + (let ((x_0 + (list + e_0))) + (unsafe-fx= + i_1 + len_0))) + #t + #f) (for-loop_0 - fold-var_1 - (unsafe-fx+ idx_0 1)))) - fold-var_0)))))) - (for-loop_0 null start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args))))))) - (if (if (hash? s_0) (immutable? s_0) #f) - (if (hash-eq? s_0) - (|#%app| - f_0 - #f - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - s_0 - i_0)) - (case-lambda - ((k_0 v_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - k_0 - (loop_0 - f_0 - known-pairs_0 - #f - v_0 - seen_0))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - s_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2610 - (hash-iterate-first s_0))))) - (if (hash-eqv? s_0) - (|#%app| - f_0 - #f - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - s_0 - i_0)) - (case-lambda - ((k_0 v_0) + i_1 + (unsafe-fx+ 1 pos_0)) + i_1))) + i_0)))))) + (for-loop_0 0 0)))) + (args + (raise-binding-result-arity-error + 2 + args))))) + v_0)))))) + (if (box? s_1) + (|#%app| + f_0 + #f + (box-immutable (loop_0 #f (unbox s_1) seen_1))) + (let ((c1_0 (immutable-prefab-struct-key s_1))) + (if c1_0 + (|#%app| + f_0 + #f + (apply + make-prefab-struct + c1_0 + (reverse$1 + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + (struct->vector s_1) + 1 + #f + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 idx_0) + (begin + (if (unsafe-fx< idx_0 stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (loop_0 + #f + e_0 + seen_1) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 + fold-var_1 + (unsafe-fx+ idx_0 1)))) + fold-var_0)))))) + (for-loop_0 null start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args))))))) + (if (if (hash? s_1) (immutable? s_1) #f) + (if (hash-eq? s_1) + (|#%app| + f_0 + #f + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + s_1 + i_0)) + (case-lambda + ((k_0 v_0) + (let ((table_1 (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - k_0 - (loop_0 - f_0 - known-pairs_0 - #f - v_0 - seen_0))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - s_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2589 - (hash-iterate-first s_0))))) - (|#%app| - f_0 - #f - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - s_0 - i_0)) - (case-lambda - ((k_0 v_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - k_0 - (loop_0 - f_0 - known-pairs_0 - #f - v_0 - seen_0))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - s_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2725 - (hash-iterate-first s_0))))))) - (|#%app| f_0 #f s_0))))))))))))))) - (lambda (tail?_0 s_0 f_0 seen_0 known-pairs_0) - (loop_0 f_0 known-pairs_0 tail?_0 s_0 seen_0)))) + (call-with-values + (lambda () + (values + k_0 + (loop_0 + #f + v_0 + seen_1))) + (case-lambda + ((key_0 val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + s_1 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2610 + (hash-iterate-first s_1))))) + (if (hash-eqv? s_1) + (|#%app| + f_0 + #f + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + s_1 + i_0)) + (case-lambda + ((k_0 v_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + k_0 + (loop_0 + #f + v_0 + seen_1))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + s_1 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2589 + (hash-iterate-first s_1))))) + (|#%app| + f_0 + #f + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + s_1 + i_0)) + (case-lambda + ((k_0 v_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + k_0 + (loop_0 + #f + v_0 + seen_1))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + s_1 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2725 + (hash-iterate-first s_1))))))) + (|#%app| f_0 #f s_1))))))))))))))) + (loop_0 tail?_0 s_0 seen_0)))) (define datum-has-elements? (lambda (d_0) (let ((or-part_0 (pair? d_0))) @@ -7194,125 +7197,119 @@ (preserved-property-value-content v_0) v_0))) (define check-value-to-preserve - (letrec ((check-preserve_0 - (|#%name| - check-preserve - (lambda (syntax?_0 tail?_0 v_0) - (begin - (begin - (if (let ((or-part_0 (null? v_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (boolean? v_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 (symbol? v_0))) - (if or-part_2 - or-part_2 - (let ((or-part_3 (number? v_0))) - (if or-part_3 - or-part_3 - (let ((or-part_4 (char? v_0))) - (if or-part_4 - or-part_4 - (let ((or-part_5 (string? v_0))) - (if or-part_5 - or-part_5 - (let ((or-part_6 (bytes? v_0))) - (if or-part_6 - or-part_6 - (let ((or-part_7 - (regexp? v_0))) - (if or-part_7 - or-part_7 - (let ((or-part_8 - (|#%app| - syntax?_0 - v_0))) - (if or-part_8 - or-part_8 - (let ((or-part_9 - (pair? v_0))) - (if or-part_9 - or-part_9 - (let ((or-part_10 - (vector? - v_0))) - (if or-part_10 - or-part_10 - (let ((or-part_11 - (box? - v_0))) - (if or-part_11 - or-part_11 - (let ((or-part_12 - (hash? - v_0))) - (if or-part_12 - or-part_12 - (immutable-prefab-struct-key - v_0))))))))))))))))))))))))))) - (void) - (raise-arguments-error - 'write - "disallowed value in preserved syntax property" - "value" - v_0)) - v_0))))) - (loop_0 - (|#%name| - loop - (lambda (syntax?_0 tail?_0 s_0 prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (if disallow-cycles$1 (fx> depth_0 32) #f) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) - (check-preserve_0 syntax?_0 tail?_1 s_1)) - disallow-cycles$1 - #f) - (if (null? s_0) - (check-preserve_0 syntax?_0 tail?_0 s_0) - (if (pair? s_0) - (check-preserve_0 - syntax?_0 - tail?_0 - (let ((app_0 - (loop_0 syntax?_0 #f (car s_0) depth_0))) - (cons - app_0 - (loop_0 syntax?_0 1 (cdr s_0) depth_0)))) - (if (symbol? s_0) - (check-preserve_0 syntax?_0 #f s_0) - (if (boolean? s_0) - (check-preserve_0 syntax?_0 #f s_0) - (if (number? s_0) - (check-preserve_0 syntax?_0 #f s_0) - (if (let ((or-part_0 (vector? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key s_0))) - (if or-part_2 - or-part_2 - (hash? s_0))))))) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) - (check-preserve_0 syntax?_0 tail?_1 s_1)) - disallow-cycles$1 - #f) - (check-preserve_0 - syntax?_0 - #f - s_0)))))))))))))) - (lambda (v_0 syntax?_0) (loop_0 syntax?_0 #f v_0 0)))) + (lambda (v_0 syntax?_0) + (let ((check-preserve_0 + (|#%name| + check-preserve + (lambda (tail?_0 v_1) + (begin + (begin + (if (let ((or-part_0 (null? v_1))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (boolean? v_1))) + (if or-part_1 + or-part_1 + (let ((or-part_2 (symbol? v_1))) + (if or-part_2 + or-part_2 + (let ((or-part_3 (number? v_1))) + (if or-part_3 + or-part_3 + (let ((or-part_4 (char? v_1))) + (if or-part_4 + or-part_4 + (let ((or-part_5 (string? v_1))) + (if or-part_5 + or-part_5 + (let ((or-part_6 (bytes? v_1))) + (if or-part_6 + or-part_6 + (let ((or-part_7 + (regexp? v_1))) + (if or-part_7 + or-part_7 + (let ((or-part_8 + (|#%app| + syntax?_0 + v_1))) + (if or-part_8 + or-part_8 + (let ((or-part_9 + (pair? v_1))) + (if or-part_9 + or-part_9 + (let ((or-part_10 + (vector? + v_1))) + (if or-part_10 + or-part_10 + (let ((or-part_11 + (box? + v_1))) + (if or-part_11 + or-part_11 + (let ((or-part_12 + (hash? + v_1))) + (if or-part_12 + or-part_12 + (immutable-prefab-struct-key + v_1))))))))))))))))))))))))))) + (void) + (raise-arguments-error + 'write + "disallowed value in preserved syntax property" + "value" + v_1)) + v_1)))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (tail?_0 s_0 prev-depth_0) + (begin + (let ((depth_0 (fx+ 1 prev-depth_0))) + (if (if disallow-cycles$1 (fx> depth_0 32) #f) + (datum-map-slow + tail?_0 + s_0 + (lambda (tail?_1 s_1) (check-preserve_0 tail?_1 s_1)) + disallow-cycles$1 + #f) + (if (null? s_0) + (check-preserve_0 tail?_0 s_0) + (if (pair? s_0) + (check-preserve_0 + tail?_0 + (let ((app_0 (loop_0 #f (car s_0) depth_0))) + (cons app_0 (loop_0 1 (cdr s_0) depth_0)))) + (if (symbol? s_0) + (check-preserve_0 #f s_0) + (if (boolean? s_0) + (check-preserve_0 #f s_0) + (if (number? s_0) + (check-preserve_0 #f s_0) + (if (let ((or-part_0 (vector? s_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (box? s_0))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key s_0))) + (if or-part_2 + or-part_2 + (hash? s_0))))))) + (datum-map-slow + tail?_0 + s_0 + (lambda (tail?_1 s_1) + (check-preserve_0 tail?_1 s_1)) + disallow-cycles$1 + #f) + (check-preserve_0 #f s_0)))))))))))))) + (loop_0 #f v_0 0))))) (define disallow-cycles$1 (hash 'cycle-fail @@ -7685,64 +7682,77 @@ (lambda (s_0) (if (syntax?$1 s_0) (symbol? (syntax-content s_0)) #f))) (define syntax-identifier? (lambda (s_0) (symbol? (syntax-content s_0)))) (define syntax->datum$1 - (letrec ((procz1 (|#%name| f (lambda (tail?_0 x_0) (begin x_0)))) - (d->s_0 (|#%name| d->s (lambda (s_0 d_0) (begin d_0)))) - (gf_0 - (|#%name| - gf - (lambda (f_0 tail?_0 v_0) - (begin - (if (syntax?$1 v_0) - (let ((d_0 (loop_0 f_0 (syntax-content v_0)))) - (begin-unsafe (begin d_0))) - (begin-unsafe (begin v_0))))))) - (loop_0 - (|#%name| - loop - (lambda (f_0 s_0) - (begin (let ((f_1 f_0)) (loop_1 f_0 #f s_0 0)))))) - (loop_1 - (|#%name| - loop - (lambda (f_0 tail?_0 s_0 prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (null? s_0) - (begin-unsafe (begin s_0)) - (if (pair? s_0) - (let ((x_0 - (let ((app_0 (loop_1 f_0 #f (car s_0) depth_0))) - (cons - app_0 - (loop_1 f_0 1 (cdr s_0) depth_0))))) - (begin-unsafe (begin x_0))) - (if (symbol? s_0) - (begin-unsafe (begin s_0)) - (if (boolean? s_0) - (begin-unsafe (begin s_0)) - (if (number? s_0) - (begin-unsafe (begin s_0)) - (if (let ((or-part_0 (vector? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key s_0))) - (if or-part_2 - or-part_2 - (hash? s_0))))))) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) (gf_0 f_0 tail?_1 s_1)) - #f - #f) - (gf_0 f_0 #f s_0))))))))))))) - (|#%name| - syntax->datum - (lambda (s_0) (begin (let ((f_0 procz1)) (loop_0 f_0 s_0))))))) + (|#%name| + syntax->datum + (lambda (s_0) + (begin + (let ((f_0 (|#%name| f (lambda (tail?_0 x_0) (begin x_0))))) + (let ((d->s_0 (|#%name| d->s (lambda (s_1 d_0) (begin d_0))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (s_1) + (begin + (let ((f_1 f_0)) + (let ((gf_0 + (|#%name| + gf + (lambda (tail?_0 v_0) + (begin + (if (syntax?$1 v_0) + (let ((d_0 (loop_0 (syntax-content v_0)))) + (begin-unsafe (begin d_0))) + (begin-unsafe (begin v_0)))))))) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (tail?_0 s_2 prev-depth_0) + (begin + (let ((depth_0 (fx+ 1 prev-depth_0))) + (if (null? s_2) + (begin-unsafe (begin s_2)) + (if (pair? s_2) + (let ((x_0 + (let ((app_0 + (loop_1 + #f + (car s_2) + depth_0))) + (cons + app_0 + (loop_1 1 (cdr s_2) depth_0))))) + (begin-unsafe (begin x_0))) + (if (symbol? s_2) + (begin-unsafe (begin s_2)) + (if (boolean? s_2) + (begin-unsafe (begin s_2)) + (if (number? s_2) + (begin-unsafe (begin s_2)) + (if (let ((or-part_0 (vector? s_2))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (box? s_2))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key + s_2))) + (if or-part_2 + or-part_2 + (hash? s_2))))))) + (datum-map-slow + tail?_0 + s_2 + (lambda (tail?_1 s_3) + (gf_0 tail?_1 s_3)) + #f + #f) + (gf_0 #f s_2))))))))))))) + (loop_1 #f s_1 0))))))))) + (loop_0 s_0)))))))) (define cell.1$7 (unsafe-make-place-local (make-weak-hasheq))) (define immediate-datum->syntax (lambda (stx-c_0 content_0 stx-l_0 props_0 insp_0) @@ -7784,173 +7794,158 @@ #f))))))))) (define datum->syntax$1 (let ((datum->syntax_0 - (letrec ((f_0 - (|#%name| - f - (lambda (insp_0 stx-c5_0 stx-l3_0 tail?_0 x_0) - (begin - (if tail?_0 - (begin - (if (if (fx> tail?_0 32) - (fx= 0 (fxand tail?_0 (fx- tail?_0 1))) - #f) - (hash-set! - (unsafe-place-local-ref cell.1$7) - x_0 - #t) - (void)) - x_0) - (wrap_0 insp_0 stx-c5_0 stx-l3_0 x_0)))))) - (gf_0 - (|#%name| - gf - (lambda (insp_0 stx-c5_0 stx-l3_0 tail?_0 v_0) - (begin - (if (syntax?$1 v_0) - (begin-unsafe (begin v_0)) - (f_0 insp_0 stx-c5_0 stx-l3_0 tail?_0 v_0)))))) - (loop_0 - (|#%name| - loop - (lambda (insp_0 - known-pairs_0 - stx-c5_0 - stx-l3_0 - tail?_0 - s_0 - prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (if disallow-cycles (fx> depth_0 32) #f) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) - (gf_0 insp_0 stx-c5_0 stx-l3_0 tail?_1 s_1)) - disallow-cycles - known-pairs_0) - (if (null? s_0) - (f_0 insp_0 stx-c5_0 stx-l3_0 tail?_0 s_0) - (if (pair? s_0) - (f_0 - insp_0 + (|#%name| + datum->syntax + (lambda (stx-c5_0 s6_0 stx-l3_0 stx-p4_0) + (begin + (if (syntax?$1 s6_0) + s6_0 + (let ((insp_0 + (if (syntax?$1 s6_0) + 'not-needed + (current-module-code-inspector)))) + (let ((wrap_0 + (|#%name| + wrap + (lambda (content_0) + (begin + (let ((content_1 + (datum-intern-literal content_0))) + (immediate-datum->syntax stx-c5_0 + content_1 stx-l3_0 - tail?_0 - (let ((app_0 - (loop_0 - insp_0 - known-pairs_0 - stx-c5_0 - stx-l3_0 - #f - (car s_0) - depth_0))) - (cons - app_0 - (loop_0 - insp_0 - known-pairs_0 - stx-c5_0 - stx-l3_0 - 1 - (cdr s_0) - depth_0)))) - (if (symbol? s_0) - (f_0 insp_0 stx-c5_0 stx-l3_0 #f s_0) - (if (boolean? s_0) - (f_0 insp_0 stx-c5_0 stx-l3_0 #f s_0) - (if (number? s_0) - (f_0 insp_0 stx-c5_0 stx-l3_0 #f s_0) - (if (let ((or-part_0 (vector? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key - s_0))) - (if or-part_2 - or-part_2 - (hash? s_0))))))) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) - (gf_0 - insp_0 - stx-c5_0 - stx-l3_0 - tail?_1 - s_1)) - disallow-cycles - known-pairs_0) - (gf_0 - insp_0 - stx-c5_0 - stx-l3_0 - #f - s_0))))))))))))) - (s->_0 (|#%name| s-> (lambda (s_0) (begin s_0)))) - (wrap_0 - (|#%name| - wrap - (lambda (insp_0 stx-c5_0 stx-l3_0 content_0) - (begin - (let ((content_1 (datum-intern-literal content_0))) - (immediate-datum->syntax - stx-c5_0 - content_1 - stx-l3_0 - empty-props - insp_0))))))) - (|#%name| - datum->syntax - (lambda (stx-c5_0 s6_0 stx-l3_0 stx-p4_0) - (begin - (if (syntax?$1 s6_0) - s6_0 - (let ((insp_0 - (if (syntax?$1 s6_0) - 'not-needed - (current-module-code-inspector)))) - (let ((result-s_0 - (let ((known-pairs_0 - (unsafe-place-local-ref cell.1$7))) - (loop_0 - insp_0 - known-pairs_0 - stx-c5_0 - stx-l3_0 - #f - s6_0 - 0)))) - (if (if stx-p4_0 - (not (eq? (syntax-props stx-p4_0) empty-props)) - #f) - (if (syntax?$1 result-s_0) - (let ((props20_0 (syntax-props stx-p4_0))) - (let ((app_0 (syntax-content* result-s_0))) - (let ((app_1 (syntax-scopes result-s_0))) - (let ((app_2 - (syntax-shifted-multi-scopes - result-s_0))) - (let ((app_3 (syntax-mpi-shifts result-s_0))) - (let ((app_4 (syntax-srcloc result-s_0))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - props20_0 - (syntax-inspector result-s_0)))))))) - (raise-argument-error - 'struct-copy - "syntax?" - result-s_0)) - result-s_0)))))))))) + empty-props + insp_0))))))) + (let ((f_0 + (|#%name| + f + (lambda (tail?_0 x_0) + (begin + (if tail?_0 + (begin + (if (if (fx> tail?_0 32) + (fx= + 0 + (fxand tail?_0 (fx- tail?_0 1))) + #f) + (hash-set! + (unsafe-place-local-ref cell.1$7) + x_0 + #t) + (void)) + x_0) + (wrap_0 x_0))))))) + (let ((result-s_0 + (let ((s->_0 + (|#%name| s-> (lambda (s_0) (begin s_0))))) + (let ((known-pairs_0 + (unsafe-place-local-ref cell.1$7))) + (let ((gf_0 + (|#%name| + gf + (lambda (tail?_0 v_0) + (begin + (if (syntax?$1 v_0) + (begin-unsafe (begin v_0)) + (f_0 tail?_0 v_0))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (tail?_0 s_0 prev-depth_0) + (begin + (let ((depth_0 + (fx+ 1 prev-depth_0))) + (if (if disallow-cycles + (fx> depth_0 32) + #f) + (datum-map-slow + tail?_0 + s_0 + (lambda (tail?_1 s_1) + (gf_0 tail?_1 s_1)) + disallow-cycles + known-pairs_0) + (if (null? s_0) + (f_0 tail?_0 s_0) + (if (pair? s_0) + (f_0 + tail?_0 + (let ((app_0 + (loop_0 + #f + (car s_0) + depth_0))) + (cons + app_0 + (loop_0 + 1 + (cdr s_0) + depth_0)))) + (if (symbol? s_0) + (f_0 #f s_0) + (if (boolean? s_0) + (f_0 #f s_0) + (if (number? s_0) + (f_0 #f s_0) + (if (let ((or-part_0 + (vector? + s_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (box? + s_0))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key + s_0))) + (if or-part_2 + or-part_2 + (hash? + s_0))))))) + (datum-map-slow + tail?_0 + s_0 + (lambda (tail?_1 + s_1) + (gf_0 + tail?_1 + s_1)) + disallow-cycles + known-pairs_0) + (gf_0 + #f + s_0)))))))))))))) + (loop_0 #f s6_0 0))))))) + (if (if stx-p4_0 + (not (eq? (syntax-props stx-p4_0) empty-props)) + #f) + (if (syntax?$1 result-s_0) + (let ((props20_0 (syntax-props stx-p4_0))) + (let ((app_0 (syntax-content* result-s_0))) + (let ((app_1 (syntax-scopes result-s_0))) + (let ((app_2 + (syntax-shifted-multi-scopes + result-s_0))) + (let ((app_3 + (syntax-mpi-shifts result-s_0))) + (let ((app_4 (syntax-srcloc result-s_0))) + (syntax2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + props20_0 + (syntax-inspector result-s_0)))))))) + (raise-argument-error + 'struct-copy + "syntax?" + result-s_0)) + result-s_0))))))))))) (|#%name| datum->syntax (case-lambda @@ -9276,93 +9271,89 @@ (void)) (void))))) (define scopes-register-reachable - (letrec ((check-trigger_0 - (|#%name| - check-trigger - (lambda (pending-scopes_0 scopes_0 v_0 reach_0) + (lambda (scopes_0 v_0 get-reachable-scopes_0 reach_0 register-trigger_0) + (let ((reachable-scopes_0 (|#%app| get-reachable-scopes_0))) + (if (begin-unsafe (hash-keys-subset? scopes_0 reachable-scopes_0)) + (|#%app| reach_0 v_0) + (let ((pending-scopes_0 (begin - (if (zero? (hash-count (unsafe-unbox* pending-scopes_0))) - (begin - (|#%app| reach_0 v_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (let ((sc_0 - (unsafe-immutable-hash-iterate-key - scopes_0 - i_0))) - (begin - (if (implicitly-reachable? sc_0) - (|#%app| reach_0 sc_0) - (void)) - (for-loop_0 - (unsafe-immutable-hash-iterate-next - scopes_0 - i_0)))) - (values))))))) - (for-loop_0 - (unsafe-immutable-hash-iterate-first scopes_0)))) - (void)) - (void))))))) - (lambda (scopes_0 v_0 get-reachable-scopes_0 reach_0 register-trigger_0) - (let ((reachable-scopes_0 (|#%app| get-reachable-scopes_0))) - (if (begin-unsafe (hash-keys-subset? scopes_0 reachable-scopes_0)) - (|#%app| reach_0 v_0) - (let ((pending-scopes_0 - (box - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (let ((sc_0 + (unsafe-immutable-hash-iterate-key + scopes_0 + i_0))) + (let ((table_1 + (if (let ((or-part_0 + (begin-unsafe + (hash-ref + reachable-scopes_0 + sc_0 + #f)))) + (if or-part_0 + or-part_0 + (implicitly-reachable? sc_0))) + table_0 + (let ((table_1 + (call-with-values + (lambda () (values sc_0 #t)) + (case-lambda + ((key_0 val_0) + (hash-set table_0 key_0 val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1))))) + (for-loop_0 + table_1 + (unsafe-immutable-hash-iterate-next + scopes_0 + i_0)))) + table_0)))))) + (for-loop_0 + hash2610 + (unsafe-immutable-hash-iterate-first scopes_0)))))) + (let ((check-trigger_0 + (|#%name| + check-trigger + (lambda (reach_1) + (begin + (if (zero? (hash-count pending-scopes_0)) + (begin + (|#%app| reach_1 v_0) (begin - (if i_0 - (let ((sc_0 - (unsafe-immutable-hash-iterate-key - scopes_0 - i_0))) - (let ((table_1 - (if (let ((or-part_0 - (begin-unsafe - (hash-ref - reachable-scopes_0 - sc_0 - #f)))) - (if or-part_0 - or-part_0 - (implicitly-reachable? sc_0))) - table_0 - (let ((table_1 - (call-with-values - (lambda () (values sc_0 #t)) - (case-lambda - ((key_0 val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1))))) - (for-loop_0 - table_1 - (unsafe-immutable-hash-iterate-next - scopes_0 - i_0)))) - table_0)))))) - (for-loop_0 - hash2610 - (unsafe-immutable-hash-iterate-first scopes_0))))))) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0) + (begin + (if i_0 + (let ((sc_0 + (unsafe-immutable-hash-iterate-key + scopes_0 + i_0))) + (begin + (if (implicitly-reachable? sc_0) + (|#%app| reach_1 sc_0) + (void)) + (for-loop_0 + (unsafe-immutable-hash-iterate-next + scopes_0 + i_0)))) + (values))))))) + (for-loop_0 + (unsafe-immutable-hash-iterate-first scopes_0)))) + (void)) + (void))))))) (begin - (let ((ht_0 (unsafe-unbox* pending-scopes_0))) + (let ((ht_0 pending-scopes_0)) (begin (letrec* ((for-loop_0 @@ -9381,16 +9372,9 @@ sc_0 (lambda (reach_1) (begin - (unsafe-set-box*! - pending-scopes_0 - (hash-remove - (unsafe-unbox* pending-scopes_0) - sc_0)) - (check-trigger_0 - pending-scopes_0 - scopes_0 - v_0 - reach_1)))) + (set! pending-scopes_0 + (hash-remove pending-scopes_0 sc_0)) + (check-trigger_0 reach_1)))) (for-loop_0 (unsafe-immutable-hash-iterate-next ht_0 @@ -9398,7 +9382,7 @@ (values))))))) (for-loop_0 (unsafe-immutable-hash-iterate-first ht_0))))) (void) - (check-trigger_0 pending-scopes_0 scopes_0 v_0 reach_0)))))))) + (check-trigger_0 reach_0)))))))) (define syntax-property$1 (|#%name| syntax-property @@ -9557,104 +9541,110 @@ (define syntax-has-property? (lambda (from-s_0 key_0) (hash-ref (syntax-props from-s_0) key_0 #f))) (define taint-content - (letrec ((procz1 (|#%name| f (lambda (tail?_0 x_0) (begin x_0)))) - (gf_0 - (|#%name| - gf - (lambda (tail?_0 v_0) - (begin - (if (syntax?$1 v_0) - (s->_0 v_0) - (begin-unsafe (begin v_0))))))) - (loop_0 - (|#%name| - loop - (lambda (tail?_0 s_0 prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (null? s_0) - (begin-unsafe (begin s_0)) - (if (pair? s_0) - (let ((x_0 - (let ((app_0 (loop_0 #f (car s_0) depth_0))) - (cons app_0 (loop_0 1 (cdr s_0) depth_0))))) - (begin-unsafe (begin x_0))) - (if (symbol? s_0) - (begin-unsafe (begin s_0)) - (if (boolean? s_0) - (begin-unsafe (begin s_0)) - (if (number? s_0) - (begin-unsafe (begin s_0)) - (if (let ((or-part_0 (vector? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key s_0))) - (if or-part_2 - or-part_2 - (hash? s_0))))))) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) (gf_0 tail?_1 s_1)) - #f - #f) - (gf_0 #f s_0)))))))))))) - (s->_0 - (|#%name| - s-> - (lambda (sub-s_0) - (begin - (if (let ((v_0 (syntax-tamper sub-s_0))) - (begin-unsafe (symbol? v_0))) - sub-s_0 - (let ((t_0 - (tamper-tainted-for-content - (syntax-content sub-s_0)))) - (let ((content*_0 (syntax-content* sub-s_0))) - (let ((content_0 - (if (modified-content? content*_0) - (modified-content-content content*_0) - content*_0))) - (let ((p_0 - (if (modified-content? content*_0) - (modified-content-scope-propagations+tamper - content*_0) - #f))) - (if (syntax?$1 sub-s_0) - (let ((content*3_0 - (let ((new-p_0 - (if (tamper? p_0) - t_0 - (|#%app| - (propagation-set-tamper-ref p_0) - p_0 - t_0)))) - (if new-p_0 - (modified-content1.1 content_0 new-p_0) - content_0)))) - (let ((app_0 (syntax-scopes sub-s_0))) - (let ((app_1 - (syntax-shifted-multi-scopes sub-s_0))) - (let ((app_2 (syntax-mpi-shifts sub-s_0))) - (let ((app_3 (syntax-srcloc sub-s_0))) - (let ((app_4 (syntax-props sub-s_0))) - (syntax2.1 - content*3_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (syntax-inspector sub-s_0)))))))) - (raise-argument-error - 'struct-copy - "syntax?" - sub-s_0)))))))))))) - (lambda (d_0) (let ((f_0 procz1)) (let ((f_1 f_0)) (loop_0 #f d_0 0)))))) + (lambda (d_0) + (let ((f_0 (|#%name| f (lambda (tail?_0 x_0) (begin x_0))))) + (let ((s->_0 + (|#%name| + s-> + (lambda (sub-s_0) + (begin + (if (let ((v_0 (syntax-tamper sub-s_0))) + (begin-unsafe (symbol? v_0))) + sub-s_0 + (let ((t_0 + (tamper-tainted-for-content + (syntax-content sub-s_0)))) + (let ((content*_0 (syntax-content* sub-s_0))) + (let ((content_0 + (if (modified-content? content*_0) + (modified-content-content content*_0) + content*_0))) + (let ((p_0 + (if (modified-content? content*_0) + (modified-content-scope-propagations+tamper + content*_0) + #f))) + (if (syntax?$1 sub-s_0) + (let ((content*3_0 + (let ((new-p_0 + (if (tamper? p_0) + t_0 + (|#%app| + (propagation-set-tamper-ref p_0) + p_0 + t_0)))) + (if new-p_0 + (modified-content1.1 + content_0 + new-p_0) + content_0)))) + (let ((app_0 (syntax-scopes sub-s_0))) + (let ((app_1 + (syntax-shifted-multi-scopes + sub-s_0))) + (let ((app_2 (syntax-mpi-shifts sub-s_0))) + (let ((app_3 (syntax-srcloc sub-s_0))) + (let ((app_4 (syntax-props sub-s_0))) + (syntax2.1 + content*3_0 + app_0 + app_1 + app_2 + app_3 + app_4 + (syntax-inspector sub-s_0)))))))) + (raise-argument-error + 'struct-copy + "syntax?" + sub-s_0)))))))))))) + (let ((f_1 f_0)) + (let ((gf_0 + (|#%name| + gf + (lambda (tail?_0 v_0) + (begin + (if (syntax?$1 v_0) + (s->_0 v_0) + (begin-unsafe (begin v_0)))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (tail?_0 s_0 prev-depth_0) + (begin + (let ((depth_0 (fx+ 1 prev-depth_0))) + (if (null? s_0) + (begin-unsafe (begin s_0)) + (if (pair? s_0) + (let ((x_0 + (let ((app_0 (loop_0 #f (car s_0) depth_0))) + (cons app_0 (loop_0 1 (cdr s_0) depth_0))))) + (begin-unsafe (begin x_0))) + (if (symbol? s_0) + (begin-unsafe (begin s_0)) + (if (boolean? s_0) + (begin-unsafe (begin s_0)) + (if (number? s_0) + (begin-unsafe (begin s_0)) + (if (let ((or-part_0 (vector? s_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (box? s_0))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key s_0))) + (if or-part_2 + or-part_2 + (hash? s_0))))))) + (datum-map-slow + tail?_0 + s_0 + (lambda (tail?_1 s_1) (gf_0 tail?_1 s_1)) + #f + #f) + (gf_0 #f s_0))))))))))))) + (loop_0 #f d_0 0)))))))) (define syntax-tainted?$1 (|#%name| syntax-tainted? @@ -10934,53 +10924,48 @@ (lambda (phase_0 multi-scope_0) (intern-shifted-multi-scope phase_0 multi-scope_0))) (define intern-shifted-multi-scope - (letrec ((transaction-loop_0 - (|#%name| - transaction-loop - (lambda (phase_0 boxed-table_0 key_0 make_0) - (begin - (let ((or-part_0 (hash-ref (unbox boxed-table_0) phase_0 #f))) - (if or-part_0 - or-part_0 - (let ((val_0 (|#%app| make_0))) - (let ((current_0 (unbox boxed-table_0))) - (let ((next_0 (hash-set current_0 key_0 val_0))) - (if (unsafe-box*-cas! - boxed-table_0 - current_0 - next_0) - val_0 - (transaction-loop_0 - phase_0 - boxed-table_0 - key_0 - make_0)))))))))))) - (lambda (phase_0 multi-scope_0) - (if (phase? phase_0) - (let ((or-part_0 - (hash-ref - (unbox (multi-scope-shifted multi-scope_0)) - phase_0 - #f))) - (if or-part_0 - or-part_0 - (transaction-loop_0 - phase_0 - (multi-scope-shifted multi-scope_0) - phase_0 - (lambda () (shifted-multi-scope5.1 phase_0 multi-scope_0))))) - (let ((or-part_0 - (hash-ref - (unbox (multi-scope-label-shifted multi-scope_0)) - phase_0 - #f))) - (if or-part_0 - or-part_0 - (transaction-loop_0 - phase_0 - (multi-scope-label-shifted multi-scope_0) - phase_0 - (lambda () (shifted-multi-scope5.1 phase_0 multi-scope_0))))))))) + (lambda (phase_0 multi-scope_0) + (letrec* + ((transaction-loop_0 + (|#%name| + transaction-loop + (lambda (boxed-table_0 key_0 make_0) + (begin + (let ((or-part_0 (hash-ref (unbox boxed-table_0) phase_0 #f))) + (if or-part_0 + or-part_0 + (let ((val_0 (|#%app| make_0))) + (let ((current_0 (unbox boxed-table_0))) + (let ((next_0 (hash-set current_0 key_0 val_0))) + (if (unsafe-box*-cas! boxed-table_0 current_0 next_0) + val_0 + (transaction-loop_0 + boxed-table_0 + key_0 + make_0)))))))))))) + (if (phase? phase_0) + (let ((or-part_0 + (hash-ref + (unbox (multi-scope-shifted multi-scope_0)) + phase_0 + #f))) + (if or-part_0 + or-part_0 + (transaction-loop_0 + (multi-scope-shifted multi-scope_0) + phase_0 + (lambda () (shifted-multi-scope5.1 phase_0 multi-scope_0))))) + (let ((or-part_0 + (hash-ref + (unbox (multi-scope-label-shifted multi-scope_0)) + phase_0 + #f))) + (if or-part_0 + or-part_0 + (transaction-loop_0 + (multi-scope-label-shifted multi-scope_0) + phase_0 + (lambda () (shifted-multi-scope5.1 phase_0 multi-scope_0))))))))) (define struct:shifted-to-label-phase (make-record-type-descriptor* 'shifted-to-label-phase @@ -11149,255 +11134,312 @@ (let ((app_0 (multi-scope-id ms1_0))) (< app_0 (multi-scope-id ms2_0)))))))) (define syntax-propagated-content* - (letrec ((procz2 (|#%name| f (lambda (tail?_0 x_0) (begin x_0)))) - (procz1 (|#%name| f (lambda (tail?_0 x_0) (begin x_0)))) - (gf_0 - (|#%name| - gf - (lambda (prop_0 s_0 tail?_0 v_0) - (begin - (if (syntax?$1 v_0) - (s->_0 prop_0 s_0 v_0) - (begin-unsafe (begin v_0))))))) - (gf_1 - (|#%name| - gf - (lambda (tail?_0 v_0) - (begin - (if (syntax?$1 v_0) - (s->_1 v_0) - (begin-unsafe (begin v_0))))))) - (loop_0 - (|#%name| - loop - (lambda (prop_0 s_0 tail?_0 s_1 prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (null? s_1) - (begin-unsafe (begin s_1)) - (if (pair? s_1) - (let ((x_0 - (let ((app_0 - (loop_0 prop_0 s_0 #f (car s_1) depth_0))) - (cons - app_0 - (loop_0 prop_0 s_0 1 (cdr s_1) depth_0))))) - (begin-unsafe (begin x_0))) - (if (symbol? s_1) - (begin-unsafe (begin s_1)) - (if (boolean? s_1) - (begin-unsafe (begin s_1)) - (if (number? s_1) - (begin-unsafe (begin s_1)) - (if (let ((or-part_0 (vector? s_1))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_1))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key s_1))) - (if or-part_2 - or-part_2 - (hash? s_1))))))) - (datum-map-slow - tail?_0 - s_1 - (lambda (tail?_1 s_2) - (gf_0 prop_0 s_0 tail?_1 s_2)) - #f - #f) - (gf_0 prop_0 s_0 #f s_1)))))))))))) - (loop_1 - (|#%name| - loop - (lambda (tail?_0 s_0 prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (null? s_0) - (begin-unsafe (begin s_0)) - (if (pair? s_0) - (let ((x_0 - (let ((app_0 (loop_1 #f (car s_0) depth_0))) - (cons app_0 (loop_1 1 (cdr s_0) depth_0))))) - (begin-unsafe (begin x_0))) - (if (symbol? s_0) - (begin-unsafe (begin s_0)) - (if (boolean? s_0) - (begin-unsafe (begin s_0)) - (if (number? s_0) - (begin-unsafe (begin s_0)) - (if (let ((or-part_0 (vector? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key s_0))) - (if or-part_2 - or-part_2 - (hash? s_0))))))) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) (gf_1 tail?_1 s_1)) - #f - #f) - (gf_1 #f s_0)))))))))))) - (s->_0 - (|#%name| - s-> - (lambda (prop_0 s_0 sub-s_0) - (begin - (let ((sub-content*_0 (syntax-content* sub-s_0))) - (let ((sub-content_0 - (if (modified-content? sub-content*_0) - (modified-content-content sub-content*_0) - sub-content*_0))) - (let ((scope-propagations+tamper_0 - (let ((app_0 - (if (modified-content? sub-content*_0) - (modified-content-scope-propagations+tamper - sub-content*_0) - #f))) - (let ((app_1 (syntax-scopes sub-s_0))) - (let ((app_2 - (syntax-shifted-multi-scopes sub-s_0))) - (propagation-merge - sub-content_0 - prop_0 - app_0 - app_1 - app_2 - (syntax-mpi-shifts sub-s_0))))))) - (if (syntax?$1 sub-s_0) - (let ((scopes41_0 - (propagation-apply - prop_0 - (syntax-scopes sub-s_0) - s_0))) - (let ((shifted-multi-scopes42_0 - (propagation-apply-shifted - prop_0 - (syntax-shifted-multi-scopes sub-s_0) - s_0))) - (let ((mpi-shifts43_0 - (propagation-apply-mpi-shifts - prop_0 - (syntax-mpi-shifts sub-s_0) - s_0))) - (let ((inspector44_0 - (propagation-apply-inspector - prop_0 - (syntax-inspector sub-s_0)))) - (let ((content*45_0 - (if scope-propagations+tamper_0 - (modified-content1.1 - sub-content_0 - scope-propagations+tamper_0) - sub-content_0))) - (let ((inspector44_1 inspector44_0) - (mpi-shifts43_1 mpi-shifts43_0) - (shifted-multi-scopes42_1 - shifted-multi-scopes42_0) - (scopes41_1 scopes41_0)) - (let ((app_0 (syntax-srcloc sub-s_0))) - (syntax2.1 - content*45_0 - scopes41_1 - shifted-multi-scopes42_1 - mpi-shifts43_1 - app_0 - (syntax-props sub-s_0) - inspector44_1)))))))) - (raise-argument-error - 'struct-copy - "syntax?" - sub-s_0))))))))) - (s->_1 - (|#%name| - s-> - (lambda (sub-s_0) - (begin - (let ((t_0 - (tamper-tainted-for-content (syntax-content sub-s_0)))) - (let ((content*_0 (syntax-content* sub-s_0))) - (let ((content_0 - (if (modified-content? content*_0) - (modified-content-content content*_0) - content*_0))) - (let ((p_0 - (if (modified-content? content*_0) - (modified-content-scope-propagations+tamper - content*_0) - #f))) - (if (syntax?$1 sub-s_0) - (let ((content*46_0 - (let ((new-p_0 - (if (tamper? p_0) - t_0 - (|#%app| - (propagation-set-tamper-ref p_0) - p_0 - t_0)))) - (if new-p_0 - (modified-content1.1 content_0 new-p_0) - content_0)))) - (let ((app_0 (syntax-scopes sub-s_0))) - (let ((app_1 - (syntax-shifted-multi-scopes sub-s_0))) - (let ((app_2 (syntax-mpi-shifts sub-s_0))) - (let ((app_3 (syntax-srcloc sub-s_0))) - (let ((app_4 (syntax-props sub-s_0))) - (syntax2.1 - content*46_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (syntax-inspector sub-s_0)))))))) - (raise-argument-error - 'struct-copy - "syntax?" - sub-s_0))))))))))) - (lambda (s_0) - (let ((content*_0 (syntax-content* s_0))) - (if (not (modified-content? content*_0)) - content*_0 - (let ((prop_0 - (modified-content-scope-propagations+tamper content*_0))) - (if (let ((or-part_0 (propagation? prop_0))) - (if or-part_0 - or-part_0 - (begin-unsafe (eq? prop_0 'tainted/need-propagate)))) - (let ((content_0 (modified-content-content content*_0))) - (let ((new-content_0 - (if (propagation? prop_0) - (let ((f_0 procz1)) + (lambda (s_0) + (let ((content*_0 (syntax-content* s_0))) + (if (not (modified-content? content*_0)) + content*_0 + (let ((prop_0 (modified-content-scope-propagations+tamper content*_0))) + (if (let ((or-part_0 (propagation? prop_0))) + (if or-part_0 + or-part_0 + (begin-unsafe (eq? prop_0 'tainted/need-propagate)))) + (let ((content_0 (modified-content-content content*_0))) + (let ((new-content_0 + (if (propagation? prop_0) + (let ((f_0 + (|#%name| f (lambda (tail?_0 x_0) (begin x_0))))) + (let ((s->_0 + (|#%name| + s-> + (lambda (sub-s_0) + (begin + (let ((sub-content*_0 + (syntax-content* sub-s_0))) + (let ((sub-content_0 + (if (modified-content? + sub-content*_0) + (modified-content-content + sub-content*_0) + sub-content*_0))) + (let ((scope-propagations+tamper_0 + (let ((app_0 + (if (modified-content? + sub-content*_0) + (modified-content-scope-propagations+tamper + sub-content*_0) + #f))) + (let ((app_1 + (syntax-scopes + sub-s_0))) + (let ((app_2 + (syntax-shifted-multi-scopes + sub-s_0))) + (propagation-merge + sub-content_0 + prop_0 + app_0 + app_1 + app_2 + (syntax-mpi-shifts + sub-s_0))))))) + (if (syntax?$1 sub-s_0) + (let ((scopes41_0 + (propagation-apply + prop_0 + (syntax-scopes sub-s_0) + s_0))) + (let ((shifted-multi-scopes42_0 + (propagation-apply-shifted + prop_0 + (syntax-shifted-multi-scopes + sub-s_0) + s_0))) + (let ((mpi-shifts43_0 + (propagation-apply-mpi-shifts + prop_0 + (syntax-mpi-shifts + sub-s_0) + s_0))) + (let ((inspector44_0 + (propagation-apply-inspector + prop_0 + (syntax-inspector + sub-s_0)))) + (let ((content*45_0 + (if scope-propagations+tamper_0 + (modified-content1.1 + sub-content_0 + scope-propagations+tamper_0) + sub-content_0))) + (let ((inspector44_1 + inspector44_0) + (mpi-shifts43_1 + mpi-shifts43_0) + (shifted-multi-scopes42_1 + shifted-multi-scopes42_0) + (scopes41_1 + scopes41_0)) + (let ((app_0 + (syntax-srcloc + sub-s_0))) + (syntax2.1 + content*45_0 + scopes41_1 + shifted-multi-scopes42_1 + mpi-shifts43_1 + app_0 + (syntax-props + sub-s_0) + inspector44_1)))))))) + (raise-argument-error + 'struct-copy + "syntax?" + sub-s_0)))))))))) (let ((f_1 f_0)) - (loop_0 prop_0 s_0 #f content_0 0))) - (let ((f_0 procz2)) - (let ((f_1 f_0)) (loop_1 #f content_0 0)))))) - (let ((new-tamper_0 - (tamper-propagated - (if (propagation? prop_0) - (propagation-tamper prop_0) - prop_0)))) - (let ((new-content*_0 - (if new-tamper_0 - (modified-content1.1 new-content_0 new-tamper_0) - new-content_0))) - (if (begin-unsafe - (unsafe-struct*-cas! - s_0 - 0 - content*_0 - new-content*_0)) - new-content*_0 - (syntax-propagated-content* s_0)))))) - content*_0))))))) + (let ((gf_0 + (|#%name| + gf + (lambda (tail?_0 v_0) + (begin + (if (syntax?$1 v_0) + (s->_0 v_0) + (begin-unsafe (begin v_0)))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (tail?_0 s_1 prev-depth_0) + (begin + (let ((depth_0 (fx+ 1 prev-depth_0))) + (if (null? s_1) + (begin-unsafe (begin s_1)) + (if (pair? s_1) + (let ((x_0 + (let ((app_0 + (loop_0 + #f + (car s_1) + depth_0))) + (cons + app_0 + (loop_0 + 1 + (cdr s_1) + depth_0))))) + (begin-unsafe (begin x_0))) + (if (symbol? s_1) + (begin-unsafe (begin s_1)) + (if (boolean? s_1) + (begin-unsafe (begin s_1)) + (if (number? s_1) + (begin-unsafe (begin s_1)) + (if (let ((or-part_0 + (vector? s_1))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (box? s_1))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key + s_1))) + (if or-part_2 + or-part_2 + (hash? + s_1))))))) + (datum-map-slow + tail?_0 + s_1 + (lambda (tail?_1 s_2) + (gf_0 tail?_1 s_2)) + #f + #f) + (gf_0 #f s_1))))))))))))) + (loop_0 #f content_0 0)))))) + (let ((f_0 + (|#%name| f (lambda (tail?_0 x_0) (begin x_0))))) + (let ((s->_0 + (|#%name| + s-> + (lambda (sub-s_0) + (begin + (let ((t_0 + (tamper-tainted-for-content + (syntax-content sub-s_0)))) + (let ((content*_1 + (syntax-content* sub-s_0))) + (let ((content_1 + (if (modified-content? + content*_1) + (modified-content-content + content*_1) + content*_1))) + (let ((p_0 + (if (modified-content? + content*_1) + (modified-content-scope-propagations+tamper + content*_1) + #f))) + (if (syntax?$1 sub-s_0) + (let ((content*46_0 + (let ((new-p_0 + (if (tamper? p_0) + t_0 + (|#%app| + (propagation-set-tamper-ref + p_0) + p_0 + t_0)))) + (if new-p_0 + (modified-content1.1 + content_1 + new-p_0) + content_1)))) + (let ((app_0 + (syntax-scopes + sub-s_0))) + (let ((app_1 + (syntax-shifted-multi-scopes + sub-s_0))) + (let ((app_2 + (syntax-mpi-shifts + sub-s_0))) + (let ((app_3 + (syntax-srcloc + sub-s_0))) + (let ((app_4 + (syntax-props + sub-s_0))) + (syntax2.1 + content*46_0 + app_0 + app_1 + app_2 + app_3 + app_4 + (syntax-inspector + sub-s_0)))))))) + (raise-argument-error + 'struct-copy + "syntax?" + sub-s_0))))))))))) + (let ((f_1 f_0)) + (let ((gf_0 + (|#%name| + gf + (lambda (tail?_0 v_0) + (begin + (if (syntax?$1 v_0) + (s->_0 v_0) + (begin-unsafe (begin v_0)))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (tail?_0 s_1 prev-depth_0) + (begin + (let ((depth_0 (fx+ 1 prev-depth_0))) + (if (null? s_1) + (begin-unsafe (begin s_1)) + (if (pair? s_1) + (let ((x_0 + (let ((app_0 + (loop_0 + #f + (car s_1) + depth_0))) + (cons + app_0 + (loop_0 + 1 + (cdr s_1) + depth_0))))) + (begin-unsafe (begin x_0))) + (if (symbol? s_1) + (begin-unsafe (begin s_1)) + (if (boolean? s_1) + (begin-unsafe (begin s_1)) + (if (number? s_1) + (begin-unsafe (begin s_1)) + (if (let ((or-part_0 + (vector? s_1))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (box? s_1))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key + s_1))) + (if or-part_2 + or-part_2 + (hash? + s_1))))))) + (datum-map-slow + tail?_0 + s_1 + (lambda (tail?_1 s_2) + (gf_0 tail?_1 s_2)) + #f + #f) + (gf_0 #f s_1))))))))))))) + (loop_0 #f content_0 0))))))))) + (let ((new-tamper_0 + (tamper-propagated + (if (propagation? prop_0) + (propagation-tamper prop_0) + prop_0)))) + (let ((new-content*_0 + (if new-tamper_0 + (modified-content1.1 new-content_0 new-tamper_0) + new-content_0))) + (if (begin-unsafe + (unsafe-struct*-cas! s_0 0 content*_0 new-content*_0)) + new-content*_0 + (syntax-propagated-content* s_0)))))) + content*_0)))))) (define syntax-e/no-taint (lambda (s_0) (let ((content*_0 (syntax-propagated-content* s_0))) @@ -11764,177 +11806,128 @@ s_1)))))) (for-loop_0 s_0 scs_0))))) (define push-scope - (letrec ((procz1 (|#%name| f (lambda (tail?_0 x_0) (begin x_0)))) - (d->s_0 - (|#%name| - d->s - (lambda (prev-result_0 sms_0 smss/maybe-fallbacks59_0 s_0 d_0) - (begin - (if (syntax?$1 s_0) - (let ((content*60_0 (re-modify-content s_0 d_0))) - (let ((shifted-multi-scopes61_0 - (push_0 - prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - (syntax-shifted-multi-scopes s_0)))) - (let ((content*60_1 content*60_0)) - (let ((app_0 (syntax-scopes s_0))) - (let ((app_1 (syntax-mpi-shifts s_0))) - (let ((app_2 (syntax-srcloc s_0))) - (let ((app_3 (syntax-props s_0))) - (syntax2.1 - content*60_1 - app_0 - shifted-multi-scopes61_0 - app_1 - app_2 - app_3 - (syntax-inspector s_0))))))))) - (raise-argument-error 'struct-copy "syntax?" s_0)))))) - (gf_0 - (|#%name| - gf - (lambda (f_0 + (lambda (s_0 sms_0) + (let ((smss/maybe-fallbacks59_0 #f)) + (let ((prev-result_0 #f)) + (let ((push_0 + (|#%name| + push + (lambda (smss/maybe-fallbacks_0) + (begin + (if (eq? smss/maybe-fallbacks59_0 smss/maybe-fallbacks_0) prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - tail?_0 - v_0) - (begin - (if (syntax?$1 v_0) - (d->s_0 - prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - v_0 - (loop_0 - f_0 - prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - (syntax-e/no-taint v_0))) - (begin-unsafe (begin v_0))))))) - (loop_0 - (|#%name| - loop - (lambda (f_0 prev-result_0 sms_0 smss/maybe-fallbacks59_0 s_0) - (begin - (let ((f_1 f_0)) - (loop_1 - f_0 - prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - #f - s_0 - 0)))))) - (loop_1 - (|#%name| - loop - (lambda (f_0 - prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - tail?_0 - s_0 - prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (null? s_0) - (begin-unsafe (begin s_0)) - (if (pair? s_0) - (let ((x_0 - (let ((app_0 - (loop_1 - f_0 - prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - #f - (car s_0) - depth_0))) - (cons - app_0 - (loop_1 - f_0 - prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - 1 - (cdr s_0) - depth_0))))) - (begin-unsafe (begin x_0))) - (if (symbol? s_0) - (begin-unsafe (begin s_0)) - (if (boolean? s_0) - (begin-unsafe (begin s_0)) - (if (number? s_0) - (begin-unsafe (begin s_0)) - (if (let ((or-part_0 (vector? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key s_0))) - (if or-part_2 - or-part_2 - (hash? s_0))))))) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) - (gf_0 - f_0 - prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - tail?_1 - s_1)) - #f - #f) - (gf_0 - f_0 - prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - #f - s_0)))))))))))) - (push_0 - (|#%name| - push - (lambda (prev-result_0 - sms_0 - smss/maybe-fallbacks59_0 - smss/maybe-fallbacks_0) - (begin - (if (eq? - (unsafe-unbox* smss/maybe-fallbacks59_0) - smss/maybe-fallbacks_0) - (unsafe-unbox* prev-result_0) - (let ((r_0 - (let ((smss_0 - (fallback-first smss/maybe-fallbacks_0))) - (if (begin-unsafe (zero? (hash-count smss_0))) - (begin-unsafe (hash-set smss_0 sms_0 #t)) - (if (begin-unsafe (hash-ref smss_0 sms_0 #f)) - smss/maybe-fallbacks_0 - (fallback-push + (let ((r_0 + (let ((smss_0 + (fallback-first smss/maybe-fallbacks_0))) + (if (begin-unsafe (zero? (hash-count smss_0))) (begin-unsafe (hash-set smss_0 sms_0 #t)) - smss/maybe-fallbacks_0)))))) - (begin - (unsafe-set-box*! - smss/maybe-fallbacks59_0 - smss/maybe-fallbacks_0) - (unsafe-set-box*! prev-result_0 r_0) - r_0)))))))) - (lambda (s_0 sms_0) - (let ((smss/maybe-fallbacks59_0 (box #f))) - (let ((prev-result_0 (box #f))) - (let ((f_0 procz1)) - (loop_0 f_0 prev-result_0 sms_0 smss/maybe-fallbacks59_0 s_0))))))) + (if (begin-unsafe (hash-ref smss_0 sms_0 #f)) + smss/maybe-fallbacks_0 + (fallback-push + (begin-unsafe (hash-set smss_0 sms_0 #t)) + smss/maybe-fallbacks_0)))))) + (begin + (set! smss/maybe-fallbacks59_0 + smss/maybe-fallbacks_0) + (set! prev-result_0 r_0) + r_0)))))))) + (let ((f_0 (|#%name| f (lambda (tail?_0 x_0) (begin x_0))))) + (let ((d->s_0 + (|#%name| + d->s + (lambda (s_1 d_0) + (begin + (if (syntax?$1 s_1) + (let ((content*60_0 (re-modify-content s_1 d_0))) + (let ((shifted-multi-scopes61_0 + (push_0 (syntax-shifted-multi-scopes s_1)))) + (let ((content*60_1 content*60_0)) + (let ((app_0 (syntax-scopes s_1))) + (let ((app_1 (syntax-mpi-shifts s_1))) + (let ((app_2 (syntax-srcloc s_1))) + (let ((app_3 (syntax-props s_1))) + (syntax2.1 + content*60_1 + app_0 + shifted-multi-scopes61_0 + app_1 + app_2 + app_3 + (syntax-inspector s_1))))))))) + (raise-argument-error + 'struct-copy + "syntax?" + s_1))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (s_1) + (begin + (let ((f_1 f_0)) + (let ((gf_0 + (|#%name| + gf + (lambda (tail?_0 v_0) + (begin + (if (syntax?$1 v_0) + (d->s_0 + v_0 + (loop_0 (syntax-e/no-taint v_0))) + (begin-unsafe (begin v_0)))))))) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (tail?_0 s_2 prev-depth_0) + (begin + (let ((depth_0 (fx+ 1 prev-depth_0))) + (if (null? s_2) + (begin-unsafe (begin s_2)) + (if (pair? s_2) + (let ((x_0 + (let ((app_0 + (loop_1 + #f + (car s_2) + depth_0))) + (cons + app_0 + (loop_1 + 1 + (cdr s_2) + depth_0))))) + (begin-unsafe (begin x_0))) + (if (symbol? s_2) + (begin-unsafe (begin s_2)) + (if (boolean? s_2) + (begin-unsafe (begin s_2)) + (if (number? s_2) + (begin-unsafe (begin s_2)) + (if (let ((or-part_0 + (vector? s_2))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (box? s_2))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key + s_2))) + (if or-part_2 + or-part_2 + (hash? s_2))))))) + (datum-map-slow + tail?_0 + s_2 + (lambda (tail?_1 s_3) + (gf_0 tail?_1 s_3)) + #f + #f) + (gf_0 #f s_2))))))))))))) + (loop_1 #f s_1 0))))))))) + (loop_0 s_0))))))))) (define struct:propagation (make-record-type-descriptor* 'propagation #f #f #f #f 7 0)) (define effect_2826 @@ -12410,581 +12403,468 @@ app_0 (shifted-multi-scope-multi-scope sms_0)))))))) (define syntax-shift-phase-level$1 - (letrec ((procz1 (|#%name| f (lambda (tail?_0 d_0) (begin d_0)))) - (d->s_0 - (|#%name| - d->s - (lambda (phase_0 prev-result_0 smss73_0 s_0 d_0) - (begin - (if (syntax?$1 s_0) - (let ((content*74_0 (re-modify-content s_0 d_0))) - (let ((shifted-multi-scopes75_0 - (shift-all_0 - phase_0 - prev-result_0 - smss73_0 - (syntax-shifted-multi-scopes s_0)))) - (let ((content*74_1 content*74_0)) - (let ((app_0 (syntax-scopes s_0))) - (let ((app_1 (syntax-mpi-shifts s_0))) - (let ((app_2 (syntax-srcloc s_0))) - (let ((app_3 (syntax-props s_0))) - (syntax2.1 - content*74_1 - app_0 - shifted-multi-scopes75_0 - app_1 - app_2 - app_3 - (syntax-inspector s_0))))))))) - (raise-argument-error 'struct-copy "syntax?" s_0)))))) - (gf_0 - (|#%name| - gf - (lambda (f_0 phase_0 prev-result_0 smss73_0 tail?_0 v_0) - (begin - (if (syntax?$1 v_0) - (d->s_0 - phase_0 - prev-result_0 - smss73_0 - v_0 - (loop_0 - f_0 - phase_0 - prev-result_0 - smss73_0 - (syntax-e/no-taint v_0))) - (begin-unsafe (begin v_0))))))) - (loop_0 - (|#%name| - loop - (lambda (f_0 phase_0 prev-result_0 smss73_0 s_0) - (begin - (let ((f_1 f_0)) - (loop_1 f_0 phase_0 prev-result_0 smss73_0 #f s_0 0)))))) - (loop_1 - (|#%name| - loop - (lambda (f_0 - phase_0 - prev-result_0 - smss73_0 - tail?_0 - s_0 - prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (null? s_0) - (begin-unsafe (begin s_0)) - (if (pair? s_0) - (let ((d_0 - (let ((app_0 - (loop_1 - f_0 - phase_0 - prev-result_0 - smss73_0 - #f - (car s_0) - depth_0))) - (cons - app_0 - (loop_1 - f_0 - phase_0 - prev-result_0 - smss73_0 - 1 - (cdr s_0) - depth_0))))) - (begin-unsafe (begin d_0))) - (if (symbol? s_0) - (begin-unsafe (begin s_0)) - (if (boolean? s_0) - (begin-unsafe (begin s_0)) - (if (number? s_0) - (begin-unsafe (begin s_0)) - (if (let ((or-part_0 (vector? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key s_0))) - (if or-part_2 - or-part_2 - (hash? s_0))))))) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) - (gf_0 - f_0 - phase_0 - prev-result_0 - smss73_0 - tail?_1 - s_1)) - #f - #f) - (gf_0 - f_0 - phase_0 - prev-result_0 - smss73_0 - #f - s_0)))))))))))) - (shift-all_0 - (|#%name| - shift-all - (lambda (phase_0 prev-result_0 smss73_0 smss_0) - (begin - (if (eq? (unsafe-unbox* smss73_0) smss_0) - (unsafe-unbox* prev-result_0) - (let ((r_0 - (fallback-map - smss_0 - (lambda (smss_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (let ((sms_0 - (unsafe-immutable-hash-iterate-key - smss_1 - i_0))) - (let ((table_1 - (let ((new-sms_0 - (shift-multi-scope - sms_0 - phase_0))) - (begin - #t - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (table_1) - (begin - (let ((table_2 - (if new-sms_0 - (let ((table_2 - (call-with-values - (lambda () - (values - new-sms_0 - #t)) - (case-lambda - ((key_0 - val_0) - (hash-set - table_1 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_2)) - table_1))) - table_2)))))) - (for-loop_1 - table_0)))))) - (for-loop_0 - table_1 - (unsafe-immutable-hash-iterate-next - smss_1 - i_0)))) - table_0)))))) - (for-loop_0 - hash2610 - (unsafe-immutable-hash-iterate-first - smss_1)))))))) - (begin - (unsafe-set-box*! smss73_0 smss_0) - (unsafe-set-box*! prev-result_0 r_0) - r_0)))))))) - (|#%name| - syntax-shift-phase-level - (lambda (s_0 phase_0) - (begin - (if (eqv? phase_0 0) - s_0 - (let ((smss73_0 (box #f))) - (let ((prev-result_0 (box #f))) - (let ((f_0 procz1)) - (loop_0 f_0 phase_0 prev-result_0 smss73_0 s_0)))))))))) -(define syntax-swap-scopes - (letrec ((procz1 (|#%name| f (lambda (tail?_0 d_0) (begin d_0)))) - (d->s_0 - (|#%name| - d->s - (lambda (dest-scs_0 - dest-smss_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - s_0 - d_0) - (begin - (if (syntax?$1 s_0) - (let ((content*78_0 (re-modify-content s_0 d_0))) - (let ((scopes79_0 - (swap-scs_0 - dest-scs_0 - prev-result_0 - scs76_0 - src-scs_0 - (syntax-scopes s_0)))) - (let ((shifted-multi-scopes80_0 - (swap-smss_0 - dest-smss_0 - prev-result_1 - smss77_0 - src-smss_0 - (syntax-shifted-multi-scopes s_0)))) - (let ((scopes79_1 scopes79_0) - (content*78_1 content*78_0)) - (let ((app_0 (syntax-mpi-shifts s_0))) - (let ((app_1 (syntax-srcloc s_0))) - (let ((app_2 (syntax-props s_0))) - (syntax2.1 - content*78_1 - scopes79_1 - shifted-multi-scopes80_0 - app_0 - app_1 - app_2 - (syntax-inspector s_0))))))))) - (raise-argument-error 'struct-copy "syntax?" s_0)))))) - (gf_0 - (|#%name| - gf - (lambda (dest-scs_0 - dest-smss_0 - f_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - tail?_0 - v_0) - (begin - (if (syntax?$1 v_0) - (d->s_0 - dest-scs_0 - dest-smss_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - v_0 - (loop_0 - dest-scs_0 - dest-smss_0 - f_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - (syntax-e/no-taint v_0))) - (begin-unsafe (begin v_0))))))) - (loop_0 - (|#%name| - loop - (lambda (dest-scs_0 - dest-smss_0 - f_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - s_0) - (begin - (let ((f_1 f_0)) - (loop_1 - dest-scs_0 - dest-smss_0 - f_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - #f - s_0 - 0)))))) - (loop_1 - (|#%name| - loop - (lambda (dest-scs_0 - dest-smss_0 - f_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - tail?_0 - s_0 - prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (null? s_0) - (begin-unsafe (begin s_0)) - (if (pair? s_0) - (let ((d_0 - (let ((app_0 - (loop_1 - dest-scs_0 - dest-smss_0 - f_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - #f - (car s_0) - depth_0))) - (cons - app_0 - (loop_1 - dest-scs_0 - dest-smss_0 - f_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - 1 - (cdr s_0) - depth_0))))) - (begin-unsafe (begin d_0))) - (if (symbol? s_0) - (begin-unsafe (begin s_0)) - (if (boolean? s_0) - (begin-unsafe (begin s_0)) - (if (number? s_0) - (begin-unsafe (begin s_0)) - (if (let ((or-part_0 (vector? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key s_0))) - (if or-part_2 - or-part_2 - (hash? s_0))))))) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) - (gf_0 - dest-scs_0 - dest-smss_0 - f_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - tail?_1 - s_1)) - #f - #f) - (gf_0 - dest-scs_0 - dest-smss_0 - f_0 - prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_0 - src-smss_0 - #f - s_0)))))))))))) - (swap-scs_0 - (|#%name| - swap-scs - (lambda (dest-scs_0 prev-result_0 scs76_0 src-scs_0 scs_0) - (begin - (if (eq? (unsafe-unbox* scs76_0) scs_0) - (unsafe-unbox* prev-result_0) - (let ((r_0 - (if (begin-unsafe - (hash-keys-subset? src-scs_0 scs_0)) - (set-union - (set-subtract scs_0 src-scs_0) - dest-scs_0) - scs_0))) - (begin - (unsafe-set-box*! scs76_0 scs_0) - (unsafe-set-box*! prev-result_0 r_0) - r_0))))))) - (swap-smss_0 - (|#%name| - swap-smss - (lambda (dest-smss_0 prev-result_0 smss77_0 src-smss_0 smss_0) - (begin - (if (eq? (unsafe-unbox* smss77_0) smss_0) - (unsafe-unbox* prev-result_0) - (let ((r_0 - (fallback-update-first - smss_0 - (lambda (smss_1) - (if (begin-unsafe - (hash-keys-subset? src-smss_0 smss_1)) - (set-union - (set-subtract smss_1 src-smss_0) - dest-smss_0) - smss_1))))) - (begin - (unsafe-set-box*! smss77_0 smss_0) - (unsafe-set-box*! prev-result_0 r_0) - r_0)))))))) - (lambda (s_0 src-scopes_0 dest-scopes_0) - (if (equal? src-scopes_0 dest-scopes_0) - s_0 - (call-with-values - (lambda () - (let ((app_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (let ((sc_0 - (unsafe-immutable-hash-iterate-key - src-scopes_0 - i_0))) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - (generalize-scope sc_0) - #t)) - (case-lambda - ((key_0 val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)))) - (for-loop_0 - table_1 - (unsafe-immutable-hash-iterate-next - src-scopes_0 - i_0)))) - table_0)))))) - (for-loop_0 - hash2610 - (unsafe-immutable-hash-iterate-first src-scopes_0)))))) - (let ((app_1 (seteq))) - (set-partition app_0 shifted-multi-scope? app_1 (seteq))))) - (case-lambda - ((src-smss_0 src-scs_0) - (call-with-values - (lambda () - (let ((app_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (let ((sc_0 - (unsafe-immutable-hash-iterate-key - dest-scopes_0 - i_0))) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - (generalize-scope sc_0) - #t)) - (case-lambda - ((key_0 val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)))) - (for-loop_0 - table_1 - (unsafe-immutable-hash-iterate-next - dest-scopes_0 - i_0)))) - table_0)))))) - (for-loop_0 - hash2610 - (unsafe-immutable-hash-iterate-first - dest-scopes_0)))))) - (let ((app_1 (seteq))) - (set-partition app_0 shifted-multi-scope? app_1 (seteq))))) - (case-lambda - ((dest-smss_0 dest-scs_0) - (let ((src-smss_1 src-smss_0) (src-scs_1 src-scs_0)) - (let ((scs76_0 (box #f))) - (let ((prev-result_0 (box #f))) - (let ((smss77_0 (box #f))) - (let ((prev-result_1 (box #f))) - (let ((f_0 procz1)) - (loop_0 - dest-scs_0 - dest-smss_0 - f_0 + (|#%name| + syntax-shift-phase-level + (lambda (s_0 phase_0) + (begin + (if (eqv? phase_0 0) + s_0 + (let ((smss73_0 #f)) + (let ((prev-result_0 #f)) + (let ((shift-all_0 + (|#%name| + shift-all + (lambda (smss_0) + (begin + (if (eq? smss73_0 smss_0) prev-result_0 - prev-result_1 - scs76_0 - smss77_0 - src-scs_1 - src-smss_1 - s_0)))))))) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))))))) + (let ((r_0 + (fallback-map + smss_0 + (lambda (smss_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (let ((sms_0 + (unsafe-immutable-hash-iterate-key + smss_1 + i_0))) + (let ((table_1 + (let ((new-sms_0 + (shift-multi-scope + sms_0 + phase_0))) + (begin + #t + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (table_1) + (begin + (let ((table_2 + (if new-sms_0 + (let ((table_2 + (call-with-values + (lambda () + (values + new-sms_0 + #t)) + (case-lambda + ((key_0 + val_0) + (hash-set + table_1 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_2)) + table_1))) + table_2)))))) + (for-loop_1 + table_0)))))) + (for-loop_0 + table_1 + (unsafe-immutable-hash-iterate-next + smss_1 + i_0)))) + table_0)))))) + (for-loop_0 + hash2610 + (unsafe-immutable-hash-iterate-first + smss_1)))))))) + (begin + (set! smss73_0 smss_0) + (set! prev-result_0 r_0) + r_0)))))))) + (let ((f_0 (|#%name| f (lambda (tail?_0 d_0) (begin d_0))))) + (let ((d->s_0 + (|#%name| + d->s + (lambda (s_1 d_0) + (begin + (if (syntax?$1 s_1) + (let ((content*74_0 + (re-modify-content s_1 d_0))) + (let ((shifted-multi-scopes75_0 + (shift-all_0 + (syntax-shifted-multi-scopes s_1)))) + (let ((content*74_1 content*74_0)) + (let ((app_0 (syntax-scopes s_1))) + (let ((app_1 (syntax-mpi-shifts s_1))) + (let ((app_2 (syntax-srcloc s_1))) + (let ((app_3 (syntax-props s_1))) + (syntax2.1 + content*74_1 + app_0 + shifted-multi-scopes75_0 + app_1 + app_2 + app_3 + (syntax-inspector s_1))))))))) + (raise-argument-error + 'struct-copy + "syntax?" + s_1))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (s_1) + (begin + (let ((f_1 f_0)) + (let ((gf_0 + (|#%name| + gf + (lambda (tail?_0 v_0) + (begin + (if (syntax?$1 v_0) + (d->s_0 + v_0 + (loop_0 (syntax-e/no-taint v_0))) + (begin-unsafe (begin v_0)))))))) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (tail?_0 s_2 prev-depth_0) + (begin + (let ((depth_0 (fx+ 1 prev-depth_0))) + (if (null? s_2) + (begin-unsafe (begin s_2)) + (if (pair? s_2) + (let ((d_0 + (let ((app_0 + (loop_1 + #f + (car s_2) + depth_0))) + (cons + app_0 + (loop_1 + 1 + (cdr s_2) + depth_0))))) + (begin-unsafe (begin d_0))) + (if (symbol? s_2) + (begin-unsafe (begin s_2)) + (if (boolean? s_2) + (begin-unsafe (begin s_2)) + (if (number? s_2) + (begin-unsafe (begin s_2)) + (if (let ((or-part_0 + (vector? s_2))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (box? s_2))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key + s_2))) + (if or-part_2 + or-part_2 + (hash? + s_2))))))) + (datum-map-slow + tail?_0 + s_2 + (lambda (tail?_1 s_3) + (gf_0 tail?_1 s_3)) + #f + #f) + (gf_0 #f s_2))))))))))))) + (loop_1 #f s_1 0))))))))) + (loop_0 s_0)))))))))))) +(define syntax-swap-scopes + (lambda (s_0 src-scopes_0 dest-scopes_0) + (if (equal? src-scopes_0 dest-scopes_0) + s_0 + (call-with-values + (lambda () + (let ((app_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (let ((sc_0 + (unsafe-immutable-hash-iterate-key + src-scopes_0 + i_0))) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + (generalize-scope sc_0) + #t)) + (case-lambda + ((key_0 val_0) + (hash-set table_0 key_0 val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (unsafe-immutable-hash-iterate-next + src-scopes_0 + i_0)))) + table_0)))))) + (for-loop_0 + hash2610 + (unsafe-immutable-hash-iterate-first src-scopes_0)))))) + (let ((app_1 (seteq))) + (set-partition app_0 shifted-multi-scope? app_1 (seteq))))) + (case-lambda + ((src-smss_0 src-scs_0) + (call-with-values + (lambda () + (let ((app_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (let ((sc_0 + (unsafe-immutable-hash-iterate-key + dest-scopes_0 + i_0))) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + (generalize-scope sc_0) + #t)) + (case-lambda + ((key_0 val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (unsafe-immutable-hash-iterate-next + dest-scopes_0 + i_0)))) + table_0)))))) + (for-loop_0 + hash2610 + (unsafe-immutable-hash-iterate-first dest-scopes_0)))))) + (let ((app_1 (seteq))) + (set-partition app_0 shifted-multi-scope? app_1 (seteq))))) + (case-lambda + ((dest-smss_0 dest-scs_0) + (let ((src-smss_1 src-smss_0) (src-scs_1 src-scs_0)) + (let ((scs76_0 #f)) + (let ((prev-result_0 #f)) + (let ((swap-scs_0 + (|#%name| + swap-scs + (lambda (scs_0) + (begin + (if (eq? scs76_0 scs_0) + prev-result_0 + (let ((r_0 + (if (begin-unsafe + (hash-keys-subset? + src-scs_1 + scs_0)) + (set-union + (set-subtract scs_0 src-scs_1) + dest-scs_0) + scs_0))) + (begin + (set! scs76_0 scs_0) + (set! prev-result_0 r_0) + r_0)))))))) + (let ((smss77_0 #f)) + (let ((prev-result_1 #f)) + (let ((swap-smss_0 + (|#%name| + swap-smss + (lambda (smss_0) + (begin + (if (eq? smss77_0 smss_0) + prev-result_1 + (let ((r_0 + (fallback-update-first + smss_0 + (lambda (smss_1) + (if (begin-unsafe + (hash-keys-subset? + src-smss_1 + smss_1)) + (set-union + (set-subtract + smss_1 + src-smss_1) + dest-smss_0) + smss_1))))) + (begin + (set! smss77_0 smss_0) + (set! prev-result_1 r_0) + r_0)))))))) + (let ((f_0 + (|#%name| + f + (lambda (tail?_0 d_0) (begin d_0))))) + (let ((d->s_0 + (|#%name| + d->s + (lambda (s_1 d_0) + (begin + (if (syntax?$1 s_1) + (let ((content*78_0 + (re-modify-content s_1 d_0))) + (let ((scopes79_0 + (swap-scs_0 + (syntax-scopes s_1)))) + (let ((shifted-multi-scopes80_0 + (swap-smss_0 + (syntax-shifted-multi-scopes + s_1)))) + (let ((scopes79_1 scopes79_0) + (content*78_1 + content*78_0)) + (let ((app_0 + (syntax-mpi-shifts + s_1))) + (let ((app_1 + (syntax-srcloc + s_1))) + (let ((app_2 + (syntax-props + s_1))) + (syntax2.1 + content*78_1 + scopes79_1 + shifted-multi-scopes80_0 + app_0 + app_1 + app_2 + (syntax-inspector + s_1))))))))) + (raise-argument-error + 'struct-copy + "syntax?" + s_1))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (s_1) + (begin + (let ((f_1 f_0)) + (let ((gf_0 + (|#%name| + gf + (lambda (tail?_0 v_0) + (begin + (if (syntax?$1 v_0) + (d->s_0 + v_0 + (loop_0 + (syntax-e/no-taint + v_0))) + (begin-unsafe + (begin v_0)))))))) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (tail?_0 + s_2 + prev-depth_0) + (begin + (let ((depth_0 + (fx+ 1 prev-depth_0))) + (if (null? s_2) + (begin-unsafe + (begin s_2)) + (if (pair? s_2) + (let ((d_0 + (let ((app_0 + (loop_1 + #f + (car + s_2) + depth_0))) + (cons + app_0 + (loop_1 + 1 + (cdr s_2) + depth_0))))) + (begin-unsafe + (begin d_0))) + (if (symbol? s_2) + (begin-unsafe + (begin s_2)) + (if (boolean? s_2) + (begin-unsafe + (begin s_2)) + (if (number? s_2) + (begin-unsafe + (begin s_2)) + (if (let ((or-part_0 + (vector? + s_2))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (box? + s_2))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key + s_2))) + (if or-part_2 + or-part_2 + (hash? + s_2))))))) + (datum-map-slow + tail?_0 + s_2 + (lambda (tail?_1 + s_3) + (gf_0 + tail?_1 + s_3)) + #f + #f) + (gf_0 + #f + s_2))))))))))))) + (loop_1 #f s_1 0))))))))) + (loop_0 s_0)))))))))))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args))))))) (define syntax-scope-set (lambda (s_0 phase_0) (scope-set-at-fallback @@ -15281,7 +15161,7 @@ (for-loop_0 #t (hash-iterate-first v_0)))))) (define extract-scope-list (lambda (stx_0) - (map_2960 generalize-scope (set->list (syntax-scope-set stx_0 0))))) + (map_1346 generalize-scope (set->list (syntax-scope-set stx_0 0))))) (define syntax-with-one-scope? (lambda (stx_0) (if (syntax?$1 stx_0) @@ -15486,48 +15366,47 @@ (define make-module-registry (lambda () (module-registry1.1 (make-hasheq) (box #f)))) (define registry-call-with-lock - (letrec ((loop_0 - (|#%name| - loop - (lambda (lock-box_0 proc_0) - (begin - (let ((v_0 (unbox lock-box_0))) - (if (let ((or-part_0 (not v_0))) - (if or-part_0 - or-part_0 - (let ((app_0 (car v_0))) - (sync/timeout - 0 - app_0 - (let ((or-part_1 (weak-box-value (cdr v_0)))) - (if or-part_1 or-part_1 never-evt)))))) - (let ((sema_0 (make-semaphore))) - (let ((lock_0 - (let ((app_0 (semaphore-peek-evt sema_0))) - (cons - app_0 - (make-weak-box (current-thread)))))) - (|#%app| - (dynamic-wind - void - (lambda () - (if (unsafe-box*-cas! lock-box_0 v_0 lock_0) - (begin (|#%app| proc_0) void) - (lambda () (loop_0 lock-box_0 proc_0)))) - (lambda () (semaphore-post sema_0)))))) - (if (let ((app_0 (current-thread))) - (eq? app_0 (weak-box-value (cdr v_0)))) - (|#%app| proc_0) - (begin - (let ((app_0 (car v_0))) - (sync - app_0 - (let ((or-part_0 (weak-box-value (cdr v_0)))) - (if or-part_0 or-part_0 never-evt)))) - (loop_0 lock-box_0 proc_0)))))))))) - (lambda (r_0 proc_0) - (let ((lock-box_0 (module-registry-lock-box r_0))) - (loop_0 lock-box_0 proc_0))))) + (lambda (r_0 proc_0) + (let ((lock-box_0 (module-registry-lock-box r_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda () + (begin + (let ((v_0 (unbox lock-box_0))) + (if (let ((or-part_0 (not v_0))) + (if or-part_0 + or-part_0 + (let ((app_0 (car v_0))) + (sync/timeout + 0 + app_0 + (let ((or-part_1 (weak-box-value (cdr v_0)))) + (if or-part_1 or-part_1 never-evt)))))) + (let ((sema_0 (make-semaphore))) + (let ((lock_0 + (let ((app_0 (semaphore-peek-evt sema_0))) + (cons app_0 (make-weak-box (current-thread)))))) + (|#%app| + (dynamic-wind + void + (lambda () + (if (unsafe-box*-cas! lock-box_0 v_0 lock_0) + (begin (|#%app| proc_0) void) + (lambda () (loop_0)))) + (lambda () (semaphore-post sema_0)))))) + (if (let ((app_0 (current-thread))) + (eq? app_0 (weak-box-value (cdr v_0)))) + (|#%app| proc_0) + (begin + (let ((app_0 (car v_0))) + (sync + app_0 + (let ((or-part_0 (weak-box-value (cdr v_0)))) + (if or-part_0 or-part_0 never-evt)))) + (loop_0)))))))))) + (loop_0))))) (define struct:namespace (make-record-type-descriptor* 'namespace #f #f #f #f 15 4096)) (define effect_2781 @@ -15925,18 +15804,25 @@ (begin-unsafe (hash-ref (unbox small-ht_0) 0 'no-b))))))) (define original-property-sym (gensym 'original)) (define syntax->list$1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (s_0) - (begin - (if (pair? s_0) - (let ((app_0 (car s_0))) (cons app_0 (loop_0 (cdr s_0)))) - (if (syntax?$1 s_0) (loop_0 (syntax-e$1 s_0)) s_0))))))) - (|#%name| - syntax->list - (lambda (s_0) - (begin (let ((l_0 (loop_0 s_0))) (if (list? l_0) l_0 #f))))))) + (|#%name| + syntax->list + (lambda (s_0) + (begin + (let ((l_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (s_1) + (begin + (if (pair? s_1) + (let ((app_0 (car s_1))) + (cons app_0 (loop_0 (cdr s_1)))) + (if (syntax?$1 s_1) + (loop_0 (syntax-e$1 s_1)) + s_1))))))) + (loop_0 s_0)))) + (if (list? l_0) l_0 #f)))))) (define missing$1 (gensym)) (define syntax-track-origin$1 (let ((syntax-track-origin_0 @@ -16369,40 +16255,36 @@ 1/exn:fail:syntax? 1/exn:fail:syntax-exprs) (call-with-values - (letrec ((procz2 - (lambda (str_0 cm_0 exprs_0 info_0) - (begin - (if (if (list? exprs_0) (andmap_2344 syntax?$1 exprs_0) #f) - (void) - (raise-argument-error - 'exn:fail:syntax - "(listof syntax?)" - exprs_0)) - (values str_0 cm_0 exprs_0)))) - (procz1 - (lambda (e_0) - (filter - values - (map_2960 - syntax-srcloc - (|#%app| - (check-not-unsafe-undefined - 1/exn:fail:syntax-exprs - '1/exn:fail:syntax-exprs) - e_0)))))) - (lambda () - (make-struct-type - 'exn:fail:syntax - struct:exn:fail - 1 - 0 - #f - (list (cons prop:exn:srclocs procz1)) - #f - #f - '(0) - procz2 - 'exn:fail:syntax))) + (lambda () + (make-struct-type + 'exn:fail:syntax + struct:exn:fail + 1 + 0 + #f + (list + (cons + prop:exn:srclocs + (lambda (e_0) + (filter + values + (map_1346 + syntax-srcloc + (|#%app| + (check-not-unsafe-undefined + 1/exn:fail:syntax-exprs + '1/exn:fail:syntax-exprs) + e_0)))))) + #f + #f + '(0) + (lambda (str_0 cm_0 exprs_0 info_0) + (begin + (if (if (list? exprs_0) (andmap_2344 syntax?$1 exprs_0) #f) + (void) + (raise-argument-error 'exn:fail:syntax "(listof syntax?)" exprs_0)) + (values str_0 cm_0 exprs_0))) + 'exn:fail:syntax)) (case-lambda ((struct:_0 make-_0 ?_0 -ref_0 -set!_0) (values @@ -16672,7 +16554,7 @@ exn:fail:syntax_0 app_0 app_1 - (map_2960 + (map_1346 syntax-taint$1 (if (if sub-expr_0 sub-expr_0 expr_0) (cons @@ -16912,68 +16794,63 @@ module-linklet-info-extra-inspectorsss (record-accessor struct:module-linklet-info 5))) (define make-module.1 - (letrec ((procz2 (|#%name| get-all-variables (lambda () (begin null)))) - (procz1 - (|#%name| - phase-level-linklet-info-callback - (lambda (phase-level_0 ns_0 insp_0) (begin #f))))) - (|#%name| - make-module - (lambda (cross-phase-persistent?16_0 - force-bulk-binding-callback10_0 - get-all-variables20_0 - instantiate-phase-callback9_0 - language-info13_0 - max-phase-level8_0 - min-phase-level7_0 - no-protected?17_0 - phase-level-linklet-info-callback12_0 - predefined?15_0 - prepare-instance-callback11_0 - primitive?14_0 - provides6_0 - requires5_0 - self4_0 - source-name3_0 - submodule-names18_0 - supermodule-name19_0) - (begin - (let ((phase-level-linklet-info-callback_0 - (if (eq? - phase-level-linklet-info-callback12_0 - unsafe-undefined) - procz1 - phase-level-linklet-info-callback12_0))) - (let ((cross-phase-persistent?_0 - (if (eq? cross-phase-persistent?16_0 unsafe-undefined) - primitive?14_0 - cross-phase-persistent?16_0))) - (let ((get-all-variables_0 - (if (eq? get-all-variables20_0 unsafe-undefined) - procz2 - get-all-variables20_0))) - (let ((app_0 (unresolve-requires requires5_0))) - (module1.1 - source-name3_0 - self4_0 - app_0 - provides6_0 - #f - language-info13_0 - min-phase-level7_0 - max-phase-level8_0 - phase-level-linklet-info-callback_0 - force-bulk-binding-callback10_0 - prepare-instance-callback11_0 - instantiate-phase-callback9_0 + (|#%name| + make-module + (lambda (cross-phase-persistent?16_0 + force-bulk-binding-callback10_0 + get-all-variables20_0 + instantiate-phase-callback9_0 + language-info13_0 + max-phase-level8_0 + min-phase-level7_0 + no-protected?17_0 + phase-level-linklet-info-callback12_0 + predefined?15_0 + prepare-instance-callback11_0 + primitive?14_0 + provides6_0 + requires5_0 + self4_0 + source-name3_0 + submodule-names18_0 + supermodule-name19_0) + (begin + (let ((phase-level-linklet-info-callback_0 + (if (eq? phase-level-linklet-info-callback12_0 unsafe-undefined) + (|#%name| + phase-level-linklet-info-callback + (lambda (phase-level_0 ns_0 insp_0) (begin #f))) + phase-level-linklet-info-callback12_0))) + (let ((cross-phase-persistent?_0 + (if (eq? cross-phase-persistent?16_0 unsafe-undefined) primitive?14_0 - predefined?15_0 - cross-phase-persistent?_0 - no-protected?17_0 - (current-code-inspector) - submodule-names18_0 - supermodule-name19_0 - get-all-variables_0)))))))))) + cross-phase-persistent?16_0))) + (let ((get-all-variables_0 + (if (eq? get-all-variables20_0 unsafe-undefined) + (|#%name| get-all-variables (lambda () (begin null))) + get-all-variables20_0))) + (let ((app_0 (unresolve-requires requires5_0))) + (module1.1 + source-name3_0 + self4_0 + app_0 + provides6_0 + #f + language-info13_0 + min-phase-level7_0 + max-phase-level8_0 + phase-level-linklet-info-callback_0 + force-bulk-binding-callback10_0 + prepare-instance-callback11_0 + instantiate-phase-callback9_0 + primitive?14_0 + predefined?15_0 + cross-phase-persistent?_0 + no-protected?17_0 + (current-code-inspector) + submodule-names18_0 + supermodule-name19_0 + get-all-variables_0))))))))) (define struct:module-instance (make-record-type-descriptor* 'module-instance #f #f #f #f 7 52)) (define effect_2597 @@ -17574,96 +17451,73 @@ (let ((app_0 (module-force-bulk-binding m_0))) (|#%app| app_0 (namespace-bulk-binding-registry ns_0))))) (define namespace-module-instantiate!.1 - (letrec ((instantiate!_0 - (|#%name| - instantiate! - (lambda (m_0 - mpi86_0 - name_0 - otherwise-available?77_0 - seen-list79_0 - seen78_0 - skip-run?76_0 - instance-phase_0 - run-phase_0 - ns_0) + (|#%name| + namespace-module-instantiate! + (lambda (otherwise-available?77_0 + run-phase75_0 + seen78_0 + seen-list79_0 + skip-run?76_0 + ns85_0 + mpi86_0 + instance-phase87_0) + (begin + (let ((run-phase_0 + (if (eq? run-phase75_0 unsafe-undefined) + (namespace-phase ns85_0) + run-phase75_0))) + (begin + (if (1/module-path-index? mpi86_0) + (void) + (error "not a module path index:" mpi86_0)) + (let ((name_0 (1/module-path-index-resolve mpi86_0 #t))) + (let ((m_0 (namespace->module ns85_0 name_0))) (begin - (let ((mi_0 - (let ((or-part_0 - (namespace->module-instance.1 - #f - #f - void - ns_0 - name_0 - instance-phase_0))) - (if or-part_0 - or-part_0 - (namespace-create-module-instance! - ns_0 - name_0 - instance-phase_0 - m_0 - mpi86_0))))) - (run-module-instance!.1 - otherwise-available?77_0 - run-phase_0 - seen78_0 - seen-list79_0 - skip-run?76_0 - mi_0 - ns_0))))))) - (|#%name| - namespace-module-instantiate! - (lambda (otherwise-available?77_0 - run-phase75_0 - seen78_0 - seen-list79_0 - skip-run?76_0 - ns85_0 - mpi86_0 - instance-phase87_0) - (begin - (let ((run-phase_0 - (if (eq? run-phase75_0 unsafe-undefined) - (namespace-phase ns85_0) - run-phase75_0))) - (begin - (if (1/module-path-index? mpi86_0) - (void) - (error "not a module path index:" mpi86_0)) - (let ((name_0 (1/module-path-index-resolve mpi86_0 #t))) - (let ((m_0 (namespace->module ns85_0 name_0))) - (begin - (if m_0 - (void) - (begin-unsafe - (raise-arguments-error - 'instantiate - "unknown module" - "module name" - (module-name->error-string name_0)))) + (if m_0 + (void) + (begin-unsafe + (raise-arguments-error + 'instantiate + "unknown module" + "module name" + (module-name->error-string name_0)))) + (let ((instantiate!_0 + (|#%name| + instantiate! + (lambda (instance-phase_0 run-phase_1 ns_0) + (begin + (let ((mi_0 + (let ((or-part_0 + (namespace->module-instance.1 + #f + #f + void + ns_0 + name_0 + instance-phase_0))) + (if or-part_0 + or-part_0 + (namespace-create-module-instance! + ns_0 + name_0 + instance-phase_0 + m_0 + mpi86_0))))) + (run-module-instance!.1 + otherwise-available?77_0 + run-phase_1 + seen78_0 + seen-list79_0 + skip-run?76_0 + mi_0 + ns_0))))))) (if (module-cross-phase-persistent? m_0) (instantiate!_0 - m_0 - mpi86_0 - name_0 - otherwise-available?77_0 - seen-list79_0 - seen78_0 - skip-run?76_0 0 0 (let ((or-part_0 (namespace-root-namespace ns85_0))) (if or-part_0 or-part_0 ns85_0))) (instantiate!_0 - m_0 - mpi86_0 - name_0 - otherwise-available?77_0 - seen-list79_0 - seen78_0 - skip-run?76_0 instance-phase87_0 run-phase_0 ns85_0)))))))))))) @@ -18351,85 +18205,86 @@ (for-loop_0 hash2589 (hash-iterate-first ht_0))))))) (begin (set-module-access! m_0 access_0) access_0)))) (define module-instances->indented-module-names - (letrec ((loop_0 + (lambda (mi_0 seen-list_0) + (let ((mi->name_0 + (|#%name| + mi->name + (lambda (mi_1) + (begin + (format + "\n ~a" + (1/module-path-index-resolve + (namespace-mpi (module-instance-namespace mi_1))))))))) + (let ((app_0 (mi->name_0 mi_0))) + (cons + app_0 + (letrec* + ((loop_0 (|#%name| loop - (lambda (mi_0 seen-list_0) + (lambda (seen-list_1) (begin - (if (null? seen-list_0) + (if (null? seen-list_1) '() - (if (eq? mi_0 (car seen-list_0)) + (if (eq? mi_0 (car seen-list_1)) (list (mi->name_0 mi_0)) - (let ((app_0 (mi->name_0 (car seen-list_0)))) - (cons app_0 (loop_0 mi_0 (cdr seen-list_0)))))))))) - (mi->name_0 - (|#%name| - mi->name - (lambda (mi_0) - (begin - (format - "\n ~a" - (1/module-path-index-resolve - (namespace-mpi (module-instance-namespace mi_0))))))))) - (lambda (mi_0 seen-list_0) - (let ((app_0 (mi->name_0 mi_0))) - (cons app_0 (loop_0 mi_0 seen-list_0)))))) + (let ((app_1 (mi->name_0 (car seen-list_1)))) + (cons app_1 (loop_0 (cdr seen-list_1))))))))))) + (loop_0 seen-list_0))))))) (define binding->module-instance - (letrec ((procz1 (lambda (mi_0) 'unavailable))) - (lambda (b_0 ns_0 phase_0 id_0) - (let ((at-phase_0 (phase- phase_0 (module-binding-phase b_0)))) - (let ((mi_0 - (let ((temp2_0 - (1/module-path-index-resolve - (module-binding-module b_0)))) - (let ((temp4_0 (module-binding-phase b_0))) - (let ((temp5_0 procz1)) - (let ((temp4_1 temp4_0) (temp2_1 temp2_0)) - (namespace->module-instance.1 - temp4_1 - #f - temp5_0 - ns_0 - temp2_1 - at-phase_0))))))) - (begin - (if (eq? mi_0 'unavailable) - (raise-syntax-error$1 - #f - (let ((app_0 - (string-append - "module mismatch;\n" - " attempted to use a module that is not available\n" - " possible cause:\n" - " using (dynamic-require .... #f)\n" - " but need (dynamic-require .... 0)\n" - " module: ~s\n" - " phase: ~s"))) - (let ((app_1 (module-binding-module b_0))) - (format - app_0 - app_1 - (phase+ at-phase_0 (module-binding-phase b_0))))) - id_0) - (void)) - (if mi_0 - (void) - (let ((app_0 - (string-append - "namespace mismatch; cannot locate module instance\n" - " module: ~s\n" - " use phase: ~a\n" - " definition phase: ~a\n" - " for identifier: ~s"))) - (let ((app_1 (module-binding-module b_0))) - (error - 'expand - app_0 - app_1 - phase_0 - (module-binding-phase b_0) - id_0)))) - mi_0)))))) + (lambda (b_0 ns_0 phase_0 id_0) + (let ((at-phase_0 (phase- phase_0 (module-binding-phase b_0)))) + (let ((mi_0 + (let ((temp2_0 + (1/module-path-index-resolve (module-binding-module b_0)))) + (let ((temp4_0 (module-binding-phase b_0))) + (let ((temp5_0 (lambda (mi_0) 'unavailable))) + (let ((temp4_1 temp4_0) (temp2_1 temp2_0)) + (namespace->module-instance.1 + temp4_1 + #f + temp5_0 + ns_0 + temp2_1 + at-phase_0))))))) + (begin + (if (eq? mi_0 'unavailable) + (raise-syntax-error$1 + #f + (let ((app_0 + (string-append + "module mismatch;\n" + " attempted to use a module that is not available\n" + " possible cause:\n" + " using (dynamic-require .... #f)\n" + " but need (dynamic-require .... 0)\n" + " module: ~s\n" + " phase: ~s"))) + (let ((app_1 (module-binding-module b_0))) + (format + app_0 + app_1 + (phase+ at-phase_0 (module-binding-phase b_0))))) + id_0) + (void)) + (if mi_0 + (void) + (let ((app_0 + (string-append + "namespace mismatch; cannot locate module instance\n" + " module: ~s\n" + " use phase: ~a\n" + " definition phase: ~a\n" + " for identifier: ~s"))) + (let ((app_1 (module-binding-module b_0))) + (error + 'expand + app_0 + app_1 + phase_0 + (module-binding-phase b_0) + id_0)))) + mi_0))))) (define check-access (lambda (b_0 mi_0 id_0 in-s_0 what_0) (let ((m_0 (module-instance-module mi_0))) @@ -18493,119 +18348,103 @@ #f))) #f)))) (define resolve+shift/extra-inspector - (letrec ((loop_0 - (|#%name| - loop - (lambda (ns_0 phase_0 id_0 in-s_0) - (begin - (let ((b_0 (resolve+shift.1 #f #f null #t #f id_0 phase_0))) - (let ((c1_0 (binding-free=id b_0))) - (if c1_0 - (begin - (if (if (module-binding? b_0) - (not - (let ((mpi_0 (module-binding-module b_0))) - (begin-unsafe - (eq? top-level-module-path-index mpi_0)))) - #f) - (let ((mi_0 - (binding->module-instance - b_0 - ns_0 - phase_0 - id_0))) - (check-access - b_0 - mi_0 - id_0 - in-s_0 - "provided binding")) - (void)) - (let ((next-b_0 - (loop_0 - ns_0 - phase_0 - c1_0 - (if in-s_0 in-s_0 id_0)))) - (if (not next-b_0) - b_0 - (if (if (module-binding? next-b_0) - (if (not - (module-binding-extra-inspector - next-b_0)) - (syntax-inspector id_0) - #f) - #f) - (let ((temp5_0 (syntax-inspector id_0))) - (module-binding-update.1 - temp5_0 - unsafe-undefined - unsafe-undefined - unsafe-undefined - unsafe-undefined - unsafe-undefined - unsafe-undefined - unsafe-undefined - unsafe-undefined - unsafe-undefined - unsafe-undefined - next-b_0)) - next-b_0)))) - b_0)))))))) - (lambda (id_0 phase_0 ns_0) (loop_0 ns_0 phase_0 id_0 #f)))) + (lambda (id_0 phase_0 ns_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (id_1 in-s_0) + (begin + (let ((b_0 (resolve+shift.1 #f #f null #t #f id_1 phase_0))) + (let ((c1_0 (binding-free=id b_0))) + (if c1_0 + (begin + (if (if (module-binding? b_0) + (not + (let ((mpi_0 (module-binding-module b_0))) + (begin-unsafe + (eq? top-level-module-path-index mpi_0)))) + #f) + (let ((mi_0 + (binding->module-instance b_0 ns_0 phase_0 id_1))) + (check-access b_0 mi_0 id_1 in-s_0 "provided binding")) + (void)) + (let ((next-b_0 (loop_0 c1_0 (if in-s_0 in-s_0 id_1)))) + (if (not next-b_0) + b_0 + (if (if (module-binding? next-b_0) + (if (not + (module-binding-extra-inspector next-b_0)) + (syntax-inspector id_1) + #f) + #f) + (let ((temp5_0 (syntax-inspector id_1))) + (module-binding-update.1 + temp5_0 + unsafe-undefined + unsafe-undefined + unsafe-undefined + unsafe-undefined + unsafe-undefined + unsafe-undefined + unsafe-undefined + unsafe-undefined + unsafe-undefined + unsafe-undefined + next-b_0)) + next-b_0)))) + b_0)))))))) + (loop_0 id_0 #f)))) (define-values (1/prop:set!-transformer 1/set!-transformer? set!-transformer-value) (make-struct-type-property 'set!-transformer - (letrec ((procz1 (lambda (s_0) (error "bad syntax:" s_0)))) - (lambda (v_0 info_0) + (lambda (v_0 info_0) + (begin + (if (let ((or-part_0 + (if (procedure? v_0) + (let ((or-part_0 (procedure-arity-includes? v_0 1))) + (if or-part_0 + or-part_0 + (procedure-arity-includes? v_0 2))) + #f))) + (if or-part_0 or-part_0 (exact-nonnegative-integer? v_0))) + (void) + (raise-argument-error + 'guard-for-prop:set!-transformer + (string-append + "(or/c (procedure-arity-includes? proc 1)\n" + " (procedure-arity-includes? proc 2)\n" + " exact-nonnegative-integer?)") + v_0)) (begin - (if (let ((or-part_0 - (if (procedure? v_0) - (let ((or-part_0 (procedure-arity-includes? v_0 1))) - (if or-part_0 - or-part_0 - (procedure-arity-includes? v_0 2))) - #f))) - (if or-part_0 or-part_0 (exact-nonnegative-integer? v_0))) - (void) - (raise-argument-error - 'guard-for-prop:set!-transformer - (string-append - "(or/c (procedure-arity-includes? proc 1)\n" - " (procedure-arity-includes? proc 2)\n" - " exact-nonnegative-integer?)") - v_0)) - (begin - (if (exact-nonnegative-integer? v_0) - (begin - (if (<= v_0 (list-ref info_0 1)) - (void) - (raise-arguments-error - 'guard-for-prop:set!-transformer - "field index >= initialized-field count for structure type" - "field index" - v_0 - "initialized-field count" - (list-ref info_0 1))) - (if (member v_0 (list-ref info_0 5)) - (void) - (raise-arguments-error - 'guard-for-prop:set!-transformer - "field index not declared immutable" - "field index" - v_0))) - (void)) - (let ((ref_0 (list-ref info_0 3))) - (if (integer? v_0) - (lambda (t_0) - (let ((p_0 (|#%app| ref_0 t_0 v_0))) - (if (if (procedure? p_0) - (procedure-arity-includes? p_0 1) - #f) - p_0 - procz1))) - (lambda (t_0) v_0))))))))) + (if (exact-nonnegative-integer? v_0) + (begin + (if (<= v_0 (list-ref info_0 1)) + (void) + (raise-arguments-error + 'guard-for-prop:set!-transformer + "field index >= initialized-field count for structure type" + "field index" + v_0 + "initialized-field count" + (list-ref info_0 1))) + (if (member v_0 (list-ref info_0 5)) + (void) + (raise-arguments-error + 'guard-for-prop:set!-transformer + "field index not declared immutable" + "field index" + v_0))) + (void)) + (let ((ref_0 (list-ref info_0 3))) + (if (integer? v_0) + (lambda (t_0) + (let ((p_0 (|#%app| ref_0 t_0 v_0))) + (if (if (procedure? p_0) (procedure-arity-includes? p_0 1) #f) + p_0 + (lambda (s_0) (error "bad syntax:" s_0))))) + (lambda (t_0) v_0)))))))) (define 1/make-set!-transformer (let ((struct:set!-transformer_0 (make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 0))) @@ -18749,11 +18588,10 @@ (let ((or-part_1 (1/set!-transformer? t_0))) (if or-part_1 or-part_1 (1/rename-transformer? t_0))))))) (define transformer->procedure - (letrec ((procz1 (lambda (s_0) s_0))) - (lambda (t_0) - (if (1/set!-transformer? t_0) - (1/set!-transformer-procedure t_0) - (if (1/rename-transformer? t_0) procz1 t_0))))) + (lambda (t_0) + (if (1/set!-transformer? t_0) + (1/set!-transformer-procedure t_0) + (if (1/rename-transformer? t_0) (lambda (s_0) s_0) t_0)))) (define struct:core-form (make-record-type-descriptor* 'core-form #f #f #f #f 2 0)) (define effect_2019 @@ -20122,29 +19960,28 @@ (expand-context/outer-name ctx_0)))))))))))))))) (raise-argument-error 'struct-copy "expand-context/outer?" ctx_0)))) -(define effect_2716 +(define effect_2553 (begin (|#%call-with-values| - (letrec ((procz1 - (lambda () - (let ((ctx_0 (force (current-expand-context)))) - (let ((phase-to-ids_0 - (if ctx_0 - (begin-unsafe - (expand-context/outer-need-eventually-defined - ctx_0)) - #f))) - (if phase-to-ids_0 - (hash-ref - phase-to-ids_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx_0))) - null) - #f)))))) - (lambda () - (let ((proc_0 procz1)) - (begin-unsafe (set! current-previously-unbound proc_0))))) + (lambda () + (let ((proc_0 + (lambda () + (let ((ctx_0 (force (current-expand-context)))) + (let ((phase-to-ids_0 + (if ctx_0 + (begin-unsafe + (expand-context/outer-need-eventually-defined + ctx_0)) + #f))) + (if phase-to-ids_0 + (hash-ref + phase-to-ids_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))) + null) + #f)))))) + (begin-unsafe (set! current-previously-unbound proc_0)))) print-values) (void))) (define to-syntax-list.1 @@ -20224,222 +20061,212 @@ sym_0))) (let ((temp1_1 temp1_0)) (add-binding!.1 #f #f temp1_1 temp2_0 0)))))) (define declare-core-module! - (letrec ((procz1 - (lambda (phase-level_0 ns_0 insp_0) - (if (zero? phase-level_0) - (let ((ns_1 - (namespace->module-namespace.1 - #f - #f - void - ns_0 - core-module-name - 0))) - (if ns_1 - (module-linklet-info2.1 - (begin-unsafe - (definitions-variables (namespace->definitions ns_1 0))) - #f - core-mpi - #f - #f - #f) - #f)) - #f)))) - (lambda (ns_0) - (let ((temp8_0 - (let ((temp14_0 - (hasheqv - 0 - (let ((lst_0 - (let ((app_0 core-primitives)) - (list app_0 core-forms)))) - (let ((lst_1 '(#f #t))) - (let ((lst_2 lst_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 lst_3 lst_4) - (begin - (if (if (pair? lst_3) (pair? lst_4) #f) - (let ((syms_0 (unsafe-car lst_3))) - (let ((rest_0 (unsafe-cdr lst_3))) - (let ((syntax?_0 - (unsafe-car lst_4))) - (let ((rest_1 (unsafe-cdr lst_4))) - (let ((table_1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (table_1 - i_0) - (begin - (if i_0 - (let ((sym_0 - (hash-iterate-key - syms_0 - i_0))) - (let ((table_2 - (let ((table_2 - (call-with-values - (lambda () - (let ((b_0 - (make-module-binding.1 - #f - null - #f - #f - unsafe-undefined - unsafe-undefined - 0 - unsafe-undefined - core-mpi - 0 - sym_0))) - (values - sym_0 - (if syntax?_0 - (provided1.1 - b_0 - #f - #t) - b_0)))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_1 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_2)))) - (for-loop_1 - table_2 - (hash-iterate-next + (lambda (ns_0) + (let ((temp8_0 + (let ((temp14_0 + (hasheqv + 0 + (let ((lst_0 + (let ((app_0 core-primitives)) + (list app_0 core-forms)))) + (let ((lst_1 '(#f #t))) + (let ((lst_2 lst_0)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 lst_3 lst_4) + (begin + (if (if (pair? lst_3) (pair? lst_4) #f) + (let ((syms_0 (unsafe-car lst_3))) + (let ((rest_0 (unsafe-cdr lst_3))) + (let ((syntax?_0 (unsafe-car lst_4))) + (let ((rest_1 (unsafe-cdr lst_4))) + (let ((table_1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (table_1 i_0) + (begin + (if i_0 + (let ((sym_0 + (hash-iterate-key syms_0 - i_0)))) - table_1)))))) - (for-loop_1 - table_0 - (hash-iterate-first - syms_0)))))) - (for-loop_0 - table_1 - rest_0 - rest_1)))))) - table_0)))))) - (for-loop_0 hash2610 lst_2 lst_1))))))))) - (let ((temp15_0 procz1)) - (let ((temp16_0 - (lambda (data-box_0 - ns_1 - phase_0 - phase-level_0 - self_0 - bulk-binding-registry_0 - insp_0) - (if (eq? phase-level_0 0) - (begin - (let ((ht_0 core-primitives)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - ht_0 - i_0)) - (case-lambda - ((sym_0 val_0) - (begin - (namespace-set-consistent! - ns_1 - 0 - sym_0 - val_0) - (for-loop_0 - (hash-iterate-next - ht_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values))))))) - (for-loop_0 (hash-iterate-first ht_0))))) - (void) - (let ((ht_0 core-forms)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - ht_0 - i_0)) - (case-lambda - ((sym_0 proc_0) - (begin - (namespace-set-transformer! - ns_1 - 0 - sym_0 - (if (procedure-arity-includes? - proc_0 - 2) - (core-form7.1 proc_0 sym_0) - proc_0)) - (for-loop_0 - (hash-iterate-next - ht_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values))))))) - (for-loop_0 (hash-iterate-first ht_0))))) - (void)) - (void))))) - (let ((temp15_1 temp15_0) (temp14_1 temp14_0)) - (make-module.1 - #t - void - unsafe-undefined - temp16_0 - #f - 0 - 0 - #t - temp15_1 - #t - void - #f - temp14_1 - null - core-mpi - #f - null - #f))))))) - (declare-module!.1 #t ns_0 temp8_0 core-module-name))))) + i_0))) + (let ((table_2 + (let ((table_2 + (call-with-values + (lambda () + (let ((b_0 + (make-module-binding.1 + #f + null + #f + #f + unsafe-undefined + unsafe-undefined + 0 + unsafe-undefined + core-mpi + 0 + sym_0))) + (values + sym_0 + (if syntax?_0 + (provided1.1 + b_0 + #f + #t) + b_0)))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_1 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_2)))) + (for-loop_1 + table_2 + (hash-iterate-next + syms_0 + i_0)))) + table_1)))))) + (for-loop_1 + table_0 + (hash-iterate-first + syms_0)))))) + (for-loop_0 + table_1 + rest_0 + rest_1)))))) + table_0)))))) + (for-loop_0 hash2610 lst_2 lst_1))))))))) + (let ((temp15_0 + (lambda (phase-level_0 ns_1 insp_0) + (if (zero? phase-level_0) + (let ((ns_2 + (namespace->module-namespace.1 + #f + #f + void + ns_1 + core-module-name + 0))) + (if ns_2 + (module-linklet-info2.1 + (begin-unsafe + (definitions-variables + (namespace->definitions ns_2 0))) + #f + core-mpi + #f + #f + #f) + #f)) + #f)))) + (let ((temp16_0 + (lambda (data-box_0 + ns_1 + phase_0 + phase-level_0 + self_0 + bulk-binding-registry_0 + insp_0) + (if (eq? phase-level_0 0) + (begin + (let ((ht_0 core-primitives)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value ht_0 i_0)) + (case-lambda + ((sym_0 val_0) + (begin + (namespace-set-consistent! + ns_1 + 0 + sym_0 + val_0) + (for-loop_0 + (hash-iterate-next ht_0 i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values))))))) + (for-loop_0 (hash-iterate-first ht_0))))) + (void) + (let ((ht_0 core-forms)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value ht_0 i_0)) + (case-lambda + ((sym_0 proc_0) + (begin + (namespace-set-transformer! + ns_1 + 0 + sym_0 + (if (procedure-arity-includes? + proc_0 + 2) + (core-form7.1 proc_0 sym_0) + proc_0)) + (for-loop_0 + (hash-iterate-next ht_0 i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values))))))) + (for-loop_0 (hash-iterate-first ht_0))))) + (void)) + (void))))) + (let ((temp15_1 temp15_0) (temp14_1 temp14_0)) + (make-module.1 + #t + void + unsafe-undefined + temp16_0 + #f + 0 + 0 + #t + temp15_1 + #t + void + #f + temp14_1 + null + core-mpi + #f + null + #f))))))) + (declare-module!.1 #t ns_0 temp8_0 core-module-name)))) (define core-form-sym (lambda (s_0 phase_0) (call-with-values @@ -20487,258 +20314,291 @@ #f)) (args (raise-binding-result-arity-error 3 args)))))) (define taint-dispatch - (letrec ((procz2 (|#%name| f (lambda (tail?_0 d_0) (begin d_0)))) - (procz1 (|#%name| f (lambda (tail?_0 d_0) (begin d_0)))) - (gf_0 - (|#%name| - gf - (lambda (phase_0 proc_0 tail?_0 v_0) - (begin - (if (syntax?$1 v_0) - (s->_0 phase_0 proc_0 v_0) - (begin-unsafe (begin v_0))))))) - (gf_1 - (|#%name| - gf - (lambda (phase_0 proc_0 tail?_0 v_0) - (begin - (if (syntax?$1 v_0) - (s->_1 phase_0 proc_0 v_0) - (begin-unsafe (begin v_0))))))) - (loop_0 - (|#%name| - loop - (lambda (phase_0 proc_0 tail?_0 s_0 prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (null? s_0) - (begin-unsafe (begin s_0)) - (if (pair? s_0) - (let ((d_0 + (lambda (s_0 proc_0 phase_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (s_1 mode_0) + (begin + (if (eq? mode_0 'none) + s_1 + (if (eq? mode_0 'opaque) + (|#%app| proc_0 s_1) + (if (eq? mode_0 'transparent) + (let ((c_0 + (let ((s_2 + (let ((or-part_0 (syntax->list$1 s_1))) + (if or-part_0 or-part_0 (syntax-e$1 s_1))))) + (let ((f_0 + (|#%name| + f + (lambda (tail?_0 d_0) (begin d_0))))) + (let ((s->_0 + (|#%name| + s-> + (lambda (s_3) + (begin + (loop_0 + s_3 + (syntax-taint-mode-property + s_3))))))) + (let ((f_1 f_0) (s_3 s_2)) + (let ((f_2 f_1)) + (let ((gf_0 + (|#%name| + gf + (lambda (tail?_0 v_0) + (begin + (if (syntax?$1 v_0) + (s->_0 v_0) + (begin-unsafe + (begin v_0)))))))) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (tail?_0 s_4 prev-depth_0) + (begin + (let ((depth_0 + (fx+ 1 prev-depth_0))) + (if (null? s_4) + (begin-unsafe (begin s_4)) + (if (pair? s_4) + (let ((d_0 + (let ((app_0 + (loop_1 + #f + (car s_4) + depth_0))) + (cons + app_0 + (loop_1 + 1 + (cdr s_4) + depth_0))))) + (begin-unsafe + (begin d_0))) + (if (symbol? s_4) + (begin-unsafe (begin s_4)) + (if (boolean? s_4) + (begin-unsafe + (begin s_4)) + (if (number? s_4) + (begin-unsafe + (begin s_4)) + (if (let ((or-part_0 + (vector? + s_4))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (box? + s_4))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key + s_4))) + (if or-part_2 + or-part_2 + (hash? + s_4))))))) + (datum-map-slow + tail?_0 + s_4 + (lambda (tail?_1 + s_5) + (gf_0 + tail?_1 + s_5)) + #f + #f) + (gf_0 + #f + s_4))))))))))))) + (loop_1 #f s_3 0)))))))))) + (datum->syntax$1 + #f + c_0 + s_1 + (if (syntax-any-macro-scopes? s_1) + (1/syntax-property-remove s_1 original-property-sym) + s_1))) + (if (eq? mode_0 'transparent-binding) + (let ((c_0 (syntax-e$1 s_1))) + (if (pair? c_0) + (let ((cd_0 (cdr c_0))) + (if (let ((or-part_0 (pair? cd_0))) + (if or-part_0 + or-part_0 + (if (syntax?$1 cd_0) + (pair? (syntax-e$1 cd_0)) + #f))) + (let ((d_0 + (if (syntax?$1 cd_0) + (syntax-e$1 cd_0) + cd_0))) (let ((app_0 - (loop_0 - phase_0 - proc_0 - #f - (car s_0) - depth_0))) - (cons - app_0 - (loop_0 - phase_0 - proc_0 - 1 - (cdr s_0) - depth_0))))) - (begin-unsafe (begin d_0))) - (if (symbol? s_0) - (begin-unsafe (begin s_0)) - (if (boolean? s_0) - (begin-unsafe (begin s_0)) - (if (number? s_0) - (begin-unsafe (begin s_0)) - (if (let ((or-part_0 (vector? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key s_0))) - (if or-part_2 - or-part_2 - (hash? s_0))))))) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) - (gf_1 phase_0 proc_0 tail?_1 s_1)) - #f - #f) - (gf_1 phase_0 proc_0 #f s_0)))))))))))) - (loop_1 - (|#%name| - loop - (lambda (phase_0 proc_0 s_0 mode_0) - (begin - (if (eq? mode_0 'none) - s_0 - (if (eq? mode_0 'opaque) - (|#%app| proc_0 s_0) - (if (eq? mode_0 'transparent) - (let ((c_0 - (let ((s_1 - (let ((or-part_0 (syntax->list$1 s_0))) - (if or-part_0 - or-part_0 - (syntax-e$1 s_0))))) - (let ((f_0 procz1)) - (let ((f_1 f_0) (s_2 s_1)) - (let ((f_2 f_1)) - (loop_2 phase_0 proc_0 #f s_2 0))))))) - (datum->syntax$1 - #f - c_0 - s_0 - (if (syntax-any-macro-scopes? s_0) - (1/syntax-property-remove - s_0 - original-property-sym) - s_0))) - (if (eq? mode_0 'transparent-binding) - (let ((c_0 (syntax-e$1 s_0))) - (if (pair? c_0) - (let ((cd_0 (cdr c_0))) - (if (let ((or-part_0 (pair? cd_0))) - (if or-part_0 - or-part_0 - (if (syntax?$1 cd_0) - (pair? (syntax-e$1 cd_0)) - #f))) - (let ((d_0 - (if (syntax?$1 cd_0) - (syntax-e$1 cd_0) - cd_0))) - (let ((app_0 - (let ((app_0 - (let ((app_0 (car c_0))) - (loop_1 - phase_0 - proc_0 - app_0 - (syntax-taint-mode-property - (car c_0)))))) - (cons - app_0 - (let ((app_1 - (loop_1 - phase_0 - proc_0 - (car d_0) - 'transparent))) - (cons - app_1 - (let ((s_1 - (let ((or-part_0 - (syntax->list$1 - (cdr d_0)))) - (if or-part_0 - or-part_0 - (cdr d_0))))) - (let ((f_0 procz2)) - (let ((f_1 f_0) (s_2 s_1)) - (let ((f_2 f_1)) - (loop_0 - phase_0 - proc_0 + (let ((app_0 + (let ((app_0 (car c_0))) + (loop_0 + app_0 + (syntax-taint-mode-property + (car c_0)))))) + (cons + app_0 + (let ((app_1 + (loop_0 + (car d_0) + 'transparent))) + (cons + app_1 + (let ((s_2 + (let ((or-part_0 + (syntax->list$1 + (cdr d_0)))) + (if or-part_0 + or-part_0 + (cdr d_0))))) + (let ((f_0 + (|#%name| + f + (lambda (tail?_0 d_1) + (begin d_1))))) + (let ((s->_0 + (|#%name| + s-> + (lambda (s_3) + (begin + (loop_0 + s_3 + (syntax-taint-mode-property + s_3))))))) + (let ((f_1 f_0) (s_3 s_2)) + (let ((f_2 f_1)) + (let ((gf_0 + (|#%name| + gf + (lambda (tail?_0 + v_0) + (begin + (if (syntax?$1 + v_0) + (s->_0 v_0) + (begin-unsafe + (begin + v_0)))))))) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (tail?_0 + s_4 + prev-depth_0) + (begin + (let ((depth_0 + (fx+ + 1 + prev-depth_0))) + (if (null? + s_4) + (begin-unsafe + (begin + s_4)) + (if (pair? + s_4) + (let ((d_1 + (let ((app_2 + (loop_1 + #f + (car + s_4) + depth_0))) + (cons + app_2 + (loop_1 + 1 + (cdr + s_4) + depth_0))))) + (begin-unsafe + (begin + d_1))) + (if (symbol? + s_4) + (begin-unsafe + (begin + s_4)) + (if (boolean? + s_4) + (begin-unsafe + (begin + s_4)) + (if (number? + s_4) + (begin-unsafe + (begin + s_4)) + (if (let ((or-part_0 + (vector? + s_4))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (box? + s_4))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (prefab-struct-key + s_4))) + (if or-part_2 + or-part_2 + (hash? + s_4))))))) + (datum-map-slow + tail?_0 + s_4 + (lambda (tail?_1 + s_5) + (gf_0 + tail?_1 + s_5)) + #f + #f) + (gf_0 + #f + s_4))))))))))))) + (loop_1 #f - s_2 - 0))))))))))) - (datum->syntax$1 - #f - app_0 - s_0 - (if (syntax-any-macro-scopes? s_0) - (1/syntax-property-remove - s_0 - original-property-sym) - s_0)))) - (loop_1 phase_0 proc_0 s_0 'transparent))) - (loop_1 phase_0 proc_0 s_0 'transparent))) - (let ((c_0 (syntax-e$1 s_0))) - (let ((tmp_0 (core-form-sym c_0 phase_0))) - (if (if (eq? tmp_0 'begin) - #t - (if (eq? tmp_0 'begin-for-syntax) - #t - (eq? tmp_0 '|#%module-begin|))) - (loop_1 phase_0 proc_0 s_0 'transparent) - (if (if (eq? tmp_0 'define-values) - #t - (eq? tmp_0 'define-syntaxes)) - (loop_1 - phase_0 - proc_0 - s_0 - 'transparent-binding) - (loop_1 - phase_0 - proc_0 - s_0 - 'opaque))))))))))))) - (loop_2 - (|#%name| - loop - (lambda (phase_0 proc_0 tail?_0 s_0 prev-depth_0) - (begin - (let ((depth_0 (fx+ 1 prev-depth_0))) - (if (null? s_0) - (begin-unsafe (begin s_0)) - (if (pair? s_0) - (let ((d_0 - (let ((app_0 - (loop_2 - phase_0 - proc_0 - #f - (car s_0) - depth_0))) - (cons + s_3 + 0)))))))))))))) + (datum->syntax$1 + #f app_0 - (loop_2 - phase_0 - proc_0 - 1 - (cdr s_0) - depth_0))))) - (begin-unsafe (begin d_0))) - (if (symbol? s_0) - (begin-unsafe (begin s_0)) - (if (boolean? s_0) - (begin-unsafe (begin s_0)) - (if (number? s_0) - (begin-unsafe (begin s_0)) - (if (let ((or-part_0 (vector? s_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (box? s_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (prefab-struct-key s_0))) - (if or-part_2 - or-part_2 - (hash? s_0))))))) - (datum-map-slow - tail?_0 - s_0 - (lambda (tail?_1 s_1) - (gf_0 phase_0 proc_0 tail?_1 s_1)) - #f - #f) - (gf_0 phase_0 proc_0 #f s_0)))))))))))) - (s->_0 - (|#%name| - s-> - (lambda (phase_0 proc_0 s_0) - (begin - (loop_1 - phase_0 - proc_0 - s_0 - (syntax-taint-mode-property s_0)))))) - (s->_1 - (|#%name| - s-> - (lambda (phase_0 proc_0 s_0) - (begin - (loop_1 - phase_0 - proc_0 - s_0 - (syntax-taint-mode-property s_0))))))) - (lambda (s_0 proc_0 phase_0) - (loop_1 phase_0 proc_0 s_0 (syntax-taint-mode-property s_0))))) + s_1 + (if (syntax-any-macro-scopes? s_1) + (1/syntax-property-remove + s_1 + original-property-sym) + s_1)))) + (loop_0 s_1 'transparent))) + (loop_0 s_1 'transparent))) + (let ((c_0 (syntax-e$1 s_1))) + (let ((tmp_0 (core-form-sym c_0 phase_0))) + (if (if (eq? tmp_0 'begin) + #t + (if (eq? tmp_0 'begin-for-syntax) + #t + (eq? tmp_0 '|#%module-begin|))) + (loop_0 s_1 'transparent) + (if (if (eq? tmp_0 'define-values) + #t + (eq? tmp_0 'define-syntaxes)) + (loop_0 s_1 'transparent-binding) + (loop_0 s_1 'opaque)))))))))))))) + (loop_0 s_0 (syntax-taint-mode-property s_0))))) (define syntax-taint-mode-property (lambda (s_0) (let ((or-part_0 (syntax-property$1 s_0 'taint-mode))) @@ -20749,522 +20609,531 @@ (1/syntax-property-remove s_0 'taint-mode) 'certify-mode))) (define syntax-debug-info$1 - (letrec ((classify-binding_0 - (|#%name| - classify-binding - (lambda (b_0) (begin (if (local-binding? b_0) 'local 'module))))) - (extract-binding_0 - (|#%name| - extract-binding - (lambda (b_0) - (begin - (if (local-binding? b_0) - (local-binding-key b_0) - (let ((app_0 (module-binding-sym b_0))) - (let ((app_1 (module-binding-module b_0))) - (vector app_0 app_1 (module-binding-phase b_0)))))))))) - (|#%name| - syntax-debug-info - (lambda (s_0 phase_0 all-bindings?_0) - (begin - (let ((hts_0 - (reverse$1 - (let ((lst_0 - (fallback->list (syntax-shifted-multi-scopes s_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_1) - (begin - (if (pair? lst_1) - (let ((smss_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((init-ht_0 - (if (identifier? s_0) - (hasheq - 'name - (syntax-e$1 s_0)) - hash2610))) - (let ((s-scs_0 - (scope-set-at-fallback - s_0 - smss_0 - phase_0))) - (let ((context_0 - (scope-set->context - s-scs_0))) - (let ((context-ht_0 - (hash-set - init-ht_0 - 'context - context_0))) - (let ((sym_0 - (syntax-e$1 - s_0))) - (let ((bindings_0 - (let ((app_0 - (if (identifier? - s_0) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (bindings_0 - covered-scope-sets_0 - i_0) - (begin - (if i_0 - (let ((sc_0 - (unsafe-immutable-hash-iterate-key - s-scs_0 - i_0))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((table_0 - (scope-binding-table - sc_0))) - (if (hash? - table_0) - (values - (hash-ref - table_0 - sym_0 - hash2725) - null) - (let ((app_0 - (hash-ref - (table-with-bulk-bindings-syms - table_0) - sym_0 - hash2725))) - (values - app_0 - (table-with-bulk-bindings-bulk-bindings - table_0)))))) - (case-lambda - ((ht_0 - bulk-bindings_0) - (let ((s_1 - s_0)) - (let ((extra-shifts_0 - null)) - (let ((s_2 - s_1) - (ht_1 - ht_0) - (bulk-bindings_1 - bulk-bindings_0)) - (begin - #t - (letrec* - ((for-loop_2 - (|#%name| - for-loop - (lambda (bindings_1 - covered-scope-sets_1 - i_1) - (begin - (if (not - (null? - i_1)) - (let ((scs_0 - (if (pair? - i_1) - (bulk-binding-at-scopes - (car - i_1)) - (hash-iterate-key - ht_1 - i_1)))) - (let ((b_0 - (if (pair? - i_1) - (let ((bulk_0 - (bulk-binding-at-bulk - (car - i_1)))) - (let ((b-info_0 - (if (symbol-interned? - sym_0) - (hash-ref - (bulk-binding-symbols - bulk_0 - s_2 - extra-shifts_0) - sym_0 - #f) - #f))) - (if b-info_0 - (|#%app| - (begin-unsafe - (bulk-binding-class-create - (bulk-binding-ref - bulk_0))) - bulk_0 - b-info_0 - sym_0) - #f))) - (hash-iterate-value - ht_1 - i_1)))) - (let ((scs_1 - scs_0)) - (call-with-values - (lambda () - (if (if scs_1 - (if b_0 - (not - (begin-unsafe - (hash-ref - covered-scope-sets_1 - scs_1 - #f))) - #f) - #f) - (call-with-values - (lambda () - (let ((app_0 - (cons - (let ((app_0 - (syntax-e$1 - s_0))) - (let ((app_1 - (scope-set->context - scs_1))) - (let ((app_2 - (begin-unsafe - (hash-keys-subset? - scs_1 - s-scs_0)))) - (let ((app_3 - (classify-binding_0 - b_0))) - (hasheq - 'name - app_0 - 'context - app_1 - 'match? - app_2 - app_3 - (extract-binding_0 - b_0)))))) - bindings_1))) - (values - app_0 - (begin-unsafe - (hash-set - covered-scope-sets_1 - scs_1 - #t))))) - (case-lambda - ((bindings_2 - covered-scope-sets_2) - (values - bindings_2 - covered-scope-sets_2)) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values - bindings_1 - covered-scope-sets_1))) - (case-lambda - ((bindings_2 - covered-scope-sets_2) - (for-loop_2 - bindings_2 - covered-scope-sets_2 - (if (pair? - i_1) - (cdr - i_1) - (let ((or-part_0 - (hash-iterate-next - ht_1 - i_1))) - (if or-part_0 - or-part_0 - bulk-bindings_1))))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - bindings_1 - covered-scope-sets_1))))))) - (for-loop_2 - bindings_0 - covered-scope-sets_0 - (let ((or-part_0 - (hash-iterate-first - ht_1))) - (if or-part_0 - or-part_0 - bulk-bindings_1))))))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((bindings_1 - covered-scope-sets_1) - (for-loop_1 - bindings_1 - covered-scope-sets_1 - (unsafe-immutable-hash-iterate-next - s-scs_0 - i_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (values - bindings_0 - covered-scope-sets_0))))))) - (for-loop_1 - null - (set) - (unsafe-immutable-hash-iterate-first - s-scs_0))))) - (case-lambda - ((bindings_0 - covered-scopess_0) - bindings_0) - (args - (raise-binding-result-arity-error - 2 - args)))) - null))) - (append - app_0 - (if all-bindings?_0 - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_1 - i_0) + (|#%name| + syntax-debug-info + (lambda (s_0 phase_0 all-bindings?_0) + (begin + (let ((hts_0 + (reverse$1 + (let ((lst_0 + (fallback->list (syntax-shifted-multi-scopes s_0)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_1) + (begin + (if (pair? lst_1) + (let ((smss_0 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((init-ht_0 + (if (identifier? s_0) + (hasheq + 'name + (syntax-e$1 s_0)) + hash2610))) + (let ((s-scs_0 + (scope-set-at-fallback + s_0 + smss_0 + phase_0))) + (let ((context_0 + (scope-set->context + s-scs_0))) + (let ((context-ht_0 + (hash-set + init-ht_0 + 'context + context_0))) + (let ((sym_0 + (syntax-e$1 + s_0))) + (let ((classify-binding_0 + (|#%name| + classify-binding + (lambda (b_0) + (begin + (if (local-binding? + b_0) + 'local + 'module)))))) + (let ((extract-binding_0 + (|#%name| + extract-binding + (lambda (b_0) + (begin + (if (local-binding? + b_0) + (local-binding-key + b_0) + (let ((app_0 + (module-binding-sym + b_0))) + (let ((app_1 + (module-binding-module + b_0))) + (vector + app_0 + app_1 + (module-binding-phase + b_0)))))))))) + (let ((bindings_0 + (let ((app_0 + (if (identifier? + s_0) + (call-with-values + (lambda () (begin - (if i_0 - (let ((sc_0 - (unsafe-immutable-hash-iterate-key - s-scs_0 - i_0))) - (let ((fold-var_2 - (let ((sym-ht_0 + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (bindings_0 + covered-scope-sets_0 + i_0) + (begin + (if i_0 + (let ((sc_0 + (unsafe-immutable-hash-iterate-key + s-scs_0 + i_0))) + (call-with-values + (lambda () + (call-with-values + (lambda () (let ((table_0 (scope-binding-table sc_0))) (if (hash? table_0) - table_0 - (table-with-bulk-bindings-syms - table_0))))) - (begin - #t - (letrec* - ((for-loop_2 - (|#%name| - for-loop - (lambda (fold-var_2 - state_0) - (begin - (if (car - state_0) - (let ((o-sym_0 - (vector-ref - (car - state_0) - 1))) - (let ((scs_0 - (let ((app_1 - (vector-ref - (car - state_0) - 2))) - (hash-iterate-key - app_1 - (cdr - state_0))))) - (let ((b_0 + (values + (hash-ref + table_0 + sym_0 + hash2725) + null) + (let ((app_0 + (hash-ref + (table-with-bulk-bindings-syms + table_0) + sym_0 + hash2725))) + (values + app_0 + (table-with-bulk-bindings-bulk-bindings + table_0)))))) + (case-lambda + ((ht_0 + bulk-bindings_0) + (let ((s_1 + s_0)) + (let ((extra-shifts_0 + null)) + (let ((s_2 + s_1) + (ht_1 + ht_0) + (bulk-bindings_1 + bulk-bindings_0)) + (begin + #t + (letrec* + ((for-loop_2 + (|#%name| + for-loop + (lambda (bindings_1 + covered-scope-sets_1 + i_1) + (begin + (if (not + (null? + i_1)) + (let ((scs_0 + (if (pair? + i_1) + (bulk-binding-at-scopes + (car + i_1)) + (hash-iterate-key + ht_1 + i_1)))) + (let ((b_0 + (if (pair? + i_1) + (let ((bulk_0 + (bulk-binding-at-bulk + (car + i_1)))) + (let ((b-info_0 + (if (symbol-interned? + sym_0) + (hash-ref + (bulk-binding-symbols + bulk_0 + s_2 + extra-shifts_0) + sym_0 + #f) + #f))) + (if b-info_0 + (|#%app| + (begin-unsafe + (bulk-binding-class-create + (bulk-binding-ref + bulk_0))) + bulk_0 + b-info_0 + sym_0) + #f))) + (hash-iterate-value + ht_1 + i_1)))) + (let ((scs_1 + scs_0)) + (call-with-values + (lambda () + (if (if scs_1 + (if b_0 + (not + (begin-unsafe + (hash-ref + covered-scope-sets_1 + scs_1 + #f))) + #f) + #f) + (call-with-values + (lambda () + (let ((app_0 + (cons + (let ((app_0 + (syntax-e$1 + s_0))) + (let ((app_1 + (scope-set->context + scs_1))) + (let ((app_2 + (begin-unsafe + (hash-keys-subset? + scs_1 + s-scs_0)))) + (let ((app_3 + (classify-binding_0 + b_0))) + (hasheq + 'name + app_0 + 'context + app_1 + 'match? + app_2 + app_3 + (extract-binding_0 + b_0)))))) + bindings_1))) + (values + app_0 + (begin-unsafe + (hash-set + covered-scope-sets_1 + scs_1 + #t))))) + (case-lambda + ((bindings_2 + covered-scope-sets_2) + (values + bindings_2 + covered-scope-sets_2)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values + bindings_1 + covered-scope-sets_1))) + (case-lambda + ((bindings_2 + covered-scope-sets_2) + (for-loop_2 + bindings_2 + covered-scope-sets_2 + (if (pair? + i_1) + (cdr + i_1) + (let ((or-part_0 + (hash-iterate-next + ht_1 + i_1))) + (if or-part_0 + or-part_0 + bulk-bindings_1))))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values + bindings_1 + covered-scope-sets_1))))))) + (for-loop_2 + bindings_0 + covered-scope-sets_0 + (let ((or-part_0 + (hash-iterate-first + ht_1))) + (if or-part_0 + or-part_0 + bulk-bindings_1))))))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((bindings_1 + covered-scope-sets_1) + (for-loop_1 + bindings_1 + covered-scope-sets_1 + (unsafe-immutable-hash-iterate-next + s-scs_0 + i_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (values + bindings_0 + covered-scope-sets_0))))))) + (for-loop_1 + null + (set) + (unsafe-immutable-hash-iterate-first + s-scs_0))))) + (case-lambda + ((bindings_0 + covered-scopess_0) + bindings_0) + (args + (raise-binding-result-arity-error + 2 + args)))) + null))) + (append + app_0 + (if all-bindings?_0 + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_1 + i_0) + (begin + (if i_0 + (let ((sc_0 + (unsafe-immutable-hash-iterate-key + s-scs_0 + i_0))) + (let ((fold-var_2 + (let ((sym-ht_0 + (let ((table_0 + (scope-binding-table + sc_0))) + (if (hash? + table_0) + table_0 + (table-with-bulk-bindings-syms + table_0))))) + (begin + #t + (letrec* + ((for-loop_2 + (|#%name| + for-loop + (lambda (fold-var_2 + state_0) + (begin + (if (car + state_0) + (let ((o-sym_0 + (vector-ref + (car + state_0) + 1))) + (let ((scs_0 (let ((app_1 (vector-ref (car state_0) 2))) - (hash-iterate-value + (hash-iterate-key app_1 (cdr state_0))))) - (let ((scs_1 - scs_0) - (o-sym_1 - o-sym_0)) - (let ((fold-var_3 - (if (eq? - o-sym_1 - sym_0) - fold-var_2 - (let ((fold-var_3 - (cons - (let ((app_1 - (scope-set->context - scs_1))) - (let ((app_2 - (classify-binding_0 - b_0))) - (hasheq - 'name - o-sym_1 - 'context - app_1 - 'match? - #f - app_2 - (extract-binding_0 - b_0)))) - fold-var_2))) - (values - fold-var_3))))) - (for-loop_2 - fold-var_3 - (let ((ht_0 - (vector-ref - (car - state_0) - 2))) - (let ((i_1 - (hash-iterate-next - ht_0 - (cdr - state_0)))) - (if i_1 - (cons - (car - state_0) - i_1) - (next-state-in-full-binding-table - sym-ht_0 - (hash-iterate-next - sym-ht_0 - (vector-ref + (let ((b_0 + (let ((app_1 + (vector-ref + (car + state_0) + 2))) + (hash-iterate-value + app_1 + (cdr + state_0))))) + (let ((scs_1 + scs_0) + (o-sym_1 + o-sym_0)) + (let ((fold-var_3 + (if (eq? + o-sym_1 + sym_0) + fold-var_2 + (let ((fold-var_3 + (cons + (let ((app_1 + (scope-set->context + scs_1))) + (let ((app_2 + (classify-binding_0 + b_0))) + (hasheq + 'name + o-sym_1 + 'context + app_1 + 'match? + #f + app_2 + (extract-binding_0 + b_0)))) + fold-var_2))) + (values + fold-var_3))))) + (for-loop_2 + fold-var_3 + (let ((ht_0 + (vector-ref + (car + state_0) + 2))) + (let ((i_1 + (hash-iterate-next + ht_0 + (cdr + state_0)))) + (if i_1 + (cons (car state_0) - 0)))))))))))) - fold-var_2)))))) - (for-loop_2 - fold-var_1 - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (sym-i_0) - (begin - (if sym-i_0 - (next-state-in-full-binding-table - sym-ht_0 - sym-i_0) - '(#f - . - #f))))))) - (loop_0 - (hash-iterate-first - sym-ht_0))))))))) - (for-loop_1 - fold-var_2 - (unsafe-immutable-hash-iterate-next - s-scs_0 - i_0)))) - fold-var_1)))))) - (for-loop_1 - null - (unsafe-immutable-hash-iterate-first - s-scs_0))))) - null))))) - (if (null? - bindings_0) - context-ht_0 - (hash-set - context-ht_0 - 'bindings - bindings_0)))))))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null lst_0))))))) - (let ((ht_0 (car hts_0))) - (if (null? (cdr hts_0)) - ht_0 - (hash-set ht_0 'fallbacks (cdr hts_0)))))))))) + i_1) + (next-state-in-full-binding-table + sym-ht_0 + (hash-iterate-next + sym-ht_0 + (vector-ref + (car + state_0) + 0)))))))))))) + fold-var_2)))))) + (for-loop_2 + fold-var_1 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (sym-i_0) + (begin + (if sym-i_0 + (next-state-in-full-binding-table + sym-ht_0 + sym-i_0) + '(#f + . + #f))))))) + (loop_0 + (hash-iterate-first + sym-ht_0))))))))) + (for-loop_1 + fold-var_2 + (unsafe-immutable-hash-iterate-next + s-scs_0 + i_0)))) + fold-var_1)))))) + (for-loop_1 + null + (unsafe-immutable-hash-iterate-first + s-scs_0))))) + null))))) + (if (null? + bindings_0) + context-ht_0 + (hash-set + context-ht_0 + 'bindings + bindings_0)))))))))) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 fold-var_1 rest_0)))) + fold-var_0)))))) + (for-loop_0 null lst_0))))))) + (let ((ht_0 (car hts_0))) + (if (null? (cdr hts_0)) + ht_0 + (hash-set ht_0 'fallbacks (cdr hts_0))))))))) (define scope-set->context - (letrec ((procz1 (lambda (v_0) (vector-ref v_0 0)))) - (lambda (scs_0) - (let ((temp1_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 i_0) - (begin - (if i_0 - (let ((sc_0 - (unsafe-immutable-hash-iterate-key - scs_0 - i_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if (interned-scope? sc_0) + (lambda (scs_0) + (let ((temp1_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 i_0) + (begin + (if i_0 + (let ((sc_0 + (unsafe-immutable-hash-iterate-key scs_0 i_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if (interned-scope? sc_0) + (let ((app_0 (scope-id sc_0))) + (let ((app_1 (scope-kind sc_0))) + (vector + app_0 + app_1 + (interned-scope-key sc_0)))) + (if (representative-scope? sc_0) (let ((app_0 (scope-id sc_0))) (let ((app_1 (scope-kind sc_0))) (vector app_0 app_1 - (interned-scope-key sc_0)))) - (if (representative-scope? sc_0) - (let ((app_0 (scope-id sc_0))) - (let ((app_1 - (scope-kind sc_0))) - (vector - app_0 - app_1 - (multi-scope-name - (representative-scope-owner - sc_0))))) - (let ((app_0 (scope-id sc_0))) - (vector - app_0 - (scope-kind sc_0))))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - (unsafe-immutable-hash-iterate-next - scs_0 - i_0)))) - fold-var_0)))))) - (for-loop_0 - null - (unsafe-immutable-hash-iterate-first scs_0))))))) - (let ((temp3_0 procz1)) - (let ((temp1_1 temp1_0)) (sort.1 #f temp3_0 temp1_1 <))))))) + (multi-scope-name + (representative-scope-owner + sc_0))))) + (let ((app_0 (scope-id sc_0))) + (vector + app_0 + (scope-kind sc_0))))) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 + fold-var_1 + (unsafe-immutable-hash-iterate-next scs_0 i_0)))) + fold-var_0)))))) + (for-loop_0 + null + (unsafe-immutable-hash-iterate-first scs_0))))))) + (let ((temp3_0 (lambda (v_0) (vector-ref v_0 0)))) + (let ((temp1_1 temp1_0)) (sort.1 #f temp3_0 temp1_1 <)))))) (define raise-ambiguous-error (lambda (id_0 ctx_0) (raise-syntax-error$1 @@ -21275,298 +21144,328 @@ null (syntax-debug-info-string id_0 ctx_0)))) (define syntax-debug-info-string - (letrec ((procz1 - (|#%name| - temp2 - (lambda (a_0 b_0) - (begin - (if (hash-ref a_0 'match? #f) - (not (hash-ref b_0 'match? #f)) - #f))))) - (loop_0 - (|#%name| - loop - (lambda (info_0 layer_0) - (begin - (let ((app_0 - (let ((app_0 (hash-ref info_0 'context))) - (cons - app_0 - (reverse$1 - (let ((lst_0 (hash-ref info_0 'bindings null))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_1) - (begin - (if (pair? lst_1) - (let ((b_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (hash-ref - b_0 - 'context) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null lst_0))))))))) - (apply - append - app_0 - (let ((fallbacks_0 (hash-ref info_0 'fallbacks null))) - (reverse$1 - (let ((start_0 (add1 layer_0))) + (lambda (s_0 ctx_0) + (let ((info_0 + (syntax-debug-info$1 + s_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))) + #f))) + (if (not + (let ((or-part_0 (pair? (hash-ref info_0 'bindings null)))) + (if or-part_0 + or-part_0 + (let ((lst_0 (hash-ref info_0 'fallbacks null))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_1) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0 pos_0) - (begin - (if (if (pair? lst_0) #t #f) - (let ((fallback_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (loop_0 - fallback_0 - pos_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - (+ pos_0 1))))) - fold-var_0)))))) - (for-loop_0 null fallbacks_0 start_0)))))))))))) - (loop_1 - (|#%name| - loop - (lambda (common-scopes_0 info_0 layer_0) - (begin - (let ((app_0 (layer->string layer_0))) - (let ((app_1 - (describe-context - (hash-ref info_0 'context) - common-scopes_0))) - (let ((app_2 - (apply - string-append - (reverse$1 - (let ((lst_0 - (let ((temp1_0 - (hash-ref info_0 'bindings null))) - (let ((temp2_0 procz1)) - (let ((temp1_1 temp1_0)) - (sort.1 #f #f temp1_1 temp2_0)))))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_1) - (begin - (if (pair? lst_1) - (let ((b_0 (unsafe-car lst_1))) - (let ((rest_0 - (unsafe-cdr lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((app_2 - (if (hash-ref - b_0 - 'match? - #f) - "matching" - "other"))) - (let ((app_3 - (layer->string - layer_0))) - (let ((app_4 - (if (hash-ref - b_0 - 'local - #f) - "local" - (format - "~a" - (hash-ref - b_0 - 'module - #f))))) - (string-append - "\n " - app_2 - " binding" - app_3 - "...:" - "\n " - app_4 - (describe-context - (hash-ref - b_0 - 'context) - common-scopes_0))))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null lst_0)))))))) - (string-append - "\n context" - app_0 - "...:" - app_1 - app_2 - (let ((fallbacks_0 (hash-ref info_0 'fallbacks null))) - (apply - string-append - (reverse$1 - (let ((start_0 (add1 layer_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0 pos_0) - (begin - (if (if (pair? lst_0) #t #f) - (let ((fallback_0 - (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (loop_1 - common-scopes_0 - fallback_0 - pos_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - (+ pos_0 1))))) - fold-var_0)))))) - (for-loop_0 - null - fallbacks_0 - start_0)))))))))))))))) - (lambda (s_0 ctx_0) - (let ((info_0 - (syntax-debug-info$1 - s_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx_0))) - #f))) - (if (not - (let ((or-part_0 (pair? (hash-ref info_0 'bindings null)))) - (if or-part_0 - or-part_0 - (let ((lst_0 (hash-ref info_0 'fallbacks null))) + (if (pair? lst_1) + (let ((fb-info_0 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (let ((result_1 + (let ((result_1 + (pair? + (hash-ref + fb-info_0 + 'bindings + null)))) + (values result_1)))) + (if (if (not + (let ((x_0 (list fb-info_0))) + result_1)) + #t + #f) + (for-loop_0 result_1 rest_0) + result_1)))) + result_0)))))) + (for-loop_0 #f lst_0))))))) + "" + (let ((relevant-scope-sets_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (info_1 layer_0) + (begin + (let ((app_0 + (let ((app_0 (hash-ref info_1 'context))) + (cons + app_0 + (reverse$1 + (let ((lst_0 + (hash-ref info_1 'bindings null))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_1) + (begin + (if (pair? lst_1) + (let ((b_0 (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (hash-ref + b_0 + 'context) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 null lst_0))))))))) + (apply + append + app_0 + (let ((fallbacks_0 + (hash-ref info_1 'fallbacks null))) + (reverse$1 + (let ((start_0 (add1 layer_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0 pos_0) + (begin + (if (if (pair? lst_0) #t #f) + (let ((fallback_0 + (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (loop_0 + fallback_0 + pos_0) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + (+ pos_0 1))))) + fold-var_0)))))) + (for-loop_0 + null + fallbacks_0 + start_0))))))))))))) + (loop_0 info_0 0)))) + (let ((common-scopes_0 + (if (null? relevant-scope-sets_0) + (set) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (result_0 lst_1) + (lambda (s_1 lst_0) (begin - (if (pair? lst_1) - (let ((fb-info_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (let ((result_1 - (let ((result_1 - (pair? - (hash-ref - fb-info_0 - 'bindings - null)))) - (values result_1)))) - (if (if (not - (let ((x_0 (list fb-info_0))) - result_1)) - #t - #f) - (for-loop_0 result_1 rest_0) - result_1)))) - result_0)))))) - (for-loop_0 #f lst_0))))))) - "" - (let ((relevant-scope-sets_0 (loop_0 info_0 0))) - (let ((common-scopes_0 - (if (null? relevant-scope-sets_0) - (set) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (s_1 lst_0) - (begin - (if (pair? lst_0) - (let ((l_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((s_2 - (let ((s_2 - (set-intersect - s_1 - (list->set l_0)))) - (values s_2)))) - (for-loop_0 s_2 rest_0)))) - s_1)))))) - (for-loop_0 - (list->set (car relevant-scope-sets_0)) - relevant-scope-sets_0)))))) - (let ((app_0 (loop_1 common-scopes_0 info_0 0))) - (string-append - app_0 - (if (begin-unsafe (zero? (hash-count common-scopes_0))) - "" - (string-append - "\n common scopes...:" - (let ((app_1 - (reverse$1 - (let ((lst_0 (hash-ref info_0 'context))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_1) - (begin - (if (pair? lst_1) - (let ((s_1 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (let ((fold-var_1 - (if (begin-unsafe - (hash-ref - common-scopes_0 - s_1 - #f)) - (let ((fold-var_1 - (cons - s_1 - fold-var_0))) - (values fold-var_1)) - fold-var_0))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null lst_0))))))) - (describe-context app_1 (set)))))))))))))) + (if (pair? lst_0) + (let ((l_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((s_2 + (let ((s_2 + (set-intersect + s_1 + (list->set l_0)))) + (values s_2)))) + (for-loop_0 s_2 rest_0)))) + s_1)))))) + (for-loop_0 + (list->set (car relevant-scope-sets_0)) + relevant-scope-sets_0)))))) + (let ((app_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (info_1 layer_0) + (begin + (let ((app_0 (layer->string layer_0))) + (let ((app_1 + (describe-context + (hash-ref info_1 'context) + common-scopes_0))) + (let ((app_2 + (apply + string-append + (reverse$1 + (let ((lst_0 + (let ((temp1_0 + (hash-ref + info_1 + 'bindings + null))) + (let ((temp2_0 + (|#%name| + temp2 + (lambda (a_0 b_0) + (begin + (if (hash-ref + a_0 + 'match? + #f) + (not + (hash-ref + b_0 + 'match? + #f)) + #f)))))) + (let ((temp1_1 temp1_0)) + (sort.1 + #f + #f + temp1_1 + temp2_0)))))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_1) + (begin + (if (pair? lst_1) + (let ((b_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((app_2 + (if (hash-ref + b_0 + 'match? + #f) + "matching" + "other"))) + (let ((app_3 + (layer->string + layer_0))) + (let ((app_4 + (if (hash-ref + b_0 + 'local + #f) + "local" + (format + "~a" + (hash-ref + b_0 + 'module + #f))))) + (string-append + "\n " + app_2 + " binding" + app_3 + "...:" + "\n " + app_4 + (describe-context + (hash-ref + b_0 + 'context) + common-scopes_0))))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 null lst_0)))))))) + (string-append + "\n context" + app_0 + "...:" + app_1 + app_2 + (let ((fallbacks_0 + (hash-ref info_1 'fallbacks null))) + (apply + string-append + (reverse$1 + (let ((start_0 (add1 layer_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0 pos_0) + (begin + (if (if (pair? lst_0) #t #f) + (let ((fallback_0 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (loop_0 + fallback_0 + pos_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + (+ pos_0 1))))) + fold-var_0)))))) + (for-loop_0 + null + fallbacks_0 + start_0)))))))))))))))) + (loop_0 info_0 0)))) + (string-append + app_0 + (if (begin-unsafe (zero? (hash-count common-scopes_0))) + "" + (string-append + "\n common scopes...:" + (let ((app_1 + (reverse$1 + (let ((lst_0 (hash-ref info_0 'context))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_1) + (begin + (if (pair? lst_1) + (let ((s_1 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (let ((fold-var_1 + (if (begin-unsafe + (hash-ref + common-scopes_0 + s_1 + #f)) + (let ((fold-var_1 + (cons + s_1 + fold-var_0))) + (values fold-var_1)) + fold-var_0))) + (for-loop_0 fold-var_1 rest_0)))) + fold-var_0)))))) + (for-loop_0 null lst_0))))))) + (describe-context app_1 (set))))))))))))) (define describe-context (lambda (scopes_0 common-scopes_0) (let ((strs_0 @@ -21712,60 +21611,58 @@ ""))))))))))) (define make-check-no-duplicate-table (lambda () hash2610)) (define check-no-duplicate-ids.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (phase5_0 s6_0 what_0 v_0 ht_0) - (begin - (if (identifier? v_0) - (let ((l_0 (hash-ref ht_0 (syntax-e$1 v_0) null))) - (begin + (|#%name| + check-no-duplicate-ids + (lambda (what1_0 ids4_0 phase5_0 s6_0 ht3_0) + (begin + (let ((ht_0 + (if (eq? ht3_0 unsafe-undefined) + (make-check-no-duplicate-table) + ht3_0))) + (let ((what_0 + (if (eq? what1_0 unsafe-undefined) "binding name" what1_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_0 ht_1) + (begin + (if (identifier? v_0) + (let ((l_0 (hash-ref ht_1 (syntax-e$1 v_0) null))) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (if (bound-identifier=?$1 - id_0 - v_0 - phase5_0) - (raise-syntax-error$1 - #f - (string-append "duplicate " what_0) - s6_0 - v_0) - (void)) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 l_0))) - (void) - (hash-set ht_0 (syntax-e$1 v_0) (cons v_0 l_0)))) - (if (pair? v_0) - (let ((app_0 (cdr v_0))) - (loop_0 - phase5_0 - s6_0 - what_0 - app_0 - (loop_0 phase5_0 s6_0 what_0 (car v_0) ht_0))) - ht_0))))))) - (|#%name| - check-no-duplicate-ids - (lambda (what1_0 ids4_0 phase5_0 s6_0 ht3_0) - (begin - (let ((ht_0 - (if (eq? ht3_0 unsafe-undefined) - (make-check-no-duplicate-table) - ht3_0))) - (let ((what_0 - (if (eq? what1_0 unsafe-undefined) "binding name" what1_0))) - (loop_0 phase5_0 s6_0 what_0 ids4_0 ht_0)))))))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (if (bound-identifier=?$1 + id_0 + v_0 + phase5_0) + (raise-syntax-error$1 + #f + (string-append + "duplicate " + what_0) + s6_0 + v_0) + (void)) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 l_0))) + (void) + (hash-set ht_1 (syntax-e$1 v_0) (cons v_0 l_0)))) + (if (pair? v_0) + (let ((app_0 (cdr v_0))) + (loop_0 app_0 (loop_0 (car v_0) ht_1))) + ht_1))))))) + (loop_0 ids4_0 ht_0)))))))) (define remove-use-site-scopes (lambda (s_0 ctx_0) (let ((use-sites_0 @@ -21979,301 +21876,331 @@ (path->string p_0) (bytes->string/utf-8 (path->bytes p_0) '#\xfffd)))) (define make-path->relative-path-elements.1 - (letrec ((procz1 (lambda (v_0) #f)) - (loop_0 - (|#%name| - loop - (lambda (exploded-wrt-rel-dir_0 rel_0) - (begin - (if (null? exploded-wrt-rel-dir_0) - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((p_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if (path? p_0) - (path-element->bytes p_0) - p_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null rel_0)))) - (if (if (pair? rel_0) - (let ((app_0 (car rel_0))) - (equal? app_0 (car exploded-wrt-rel-dir_0))) - #f) - (let ((app_0 (cdr exploded-wrt-rel-dir_0))) - (loop_0 app_0 (cdr rel_0))) - (let ((app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((p_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (cons 'up fold-var_0))) - (let ((fold-var_2 - (values fold-var_1))) - (for-loop_0 - fold-var_2 - rest_0))))) - fold-var_0)))))) - (for-loop_0 null exploded-wrt-rel-dir_0)))))) - (append - app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((p_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if (path? p_0) - (path-element->bytes - p_0) - p_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null rel_0))))))))))))) - (|#%name| - make-path->relative-path-elements - (lambda (who1_0 wr-dir3_0) - (begin - (let ((wr-dir_0 - (if (eq? wr-dir3_0 unsafe-undefined) - (current-write-relative-directory) - wr-dir3_0))) - (begin - (if who1_0 - (if (let ((or-part_0 (not wr-dir_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (if (path-string? wr-dir_0) - (complete-path? wr-dir_0) - #f))) - (if or-part_1 - or-part_1 - (if (pair? wr-dir_0) - (if (path-string? (car wr-dir_0)) - (if (complete-path? (car wr-dir_0)) - (if (path-string? (cdr wr-dir_0)) - (complete-path? (cdr wr-dir_0)) - #f) + (|#%name| + make-path->relative-path-elements + (lambda (who1_0 wr-dir3_0) + (begin + (let ((wr-dir_0 + (if (eq? wr-dir3_0 unsafe-undefined) + (current-write-relative-directory) + wr-dir3_0))) + (begin + (if who1_0 + (if (let ((or-part_0 (not wr-dir_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (if (path-string? wr-dir_0) + (complete-path? wr-dir_0) + #f))) + (if or-part_1 + or-part_1 + (if (pair? wr-dir_0) + (if (path-string? (car wr-dir_0)) + (if (complete-path? (car wr-dir_0)) + (if (path-string? (cdr wr-dir_0)) + (complete-path? (cdr wr-dir_0)) #f) #f) - #f))))) - (void) - (raise-argument-error - who1_0 - (string-append - "(or/c (and/c path-string? complete-path?)\n" - " (cons/c (and/c path-string? complete-path?)\n" - " (and/c path-string? complete-path?))\n" - " #f)") - wr-dir_0)) - (void)) - (if (not wr-dir_0) - procz1 - (let ((exploded-base-dir_0 'not-ready)) - (let ((exploded-wrt-rel-dir_0 'not-ready)) - (lambda (v_0) - (begin - (if (if (eq? exploded-base-dir_0 'not-ready) - (path? v_0) #f) - (let ((wrt-dir_0 - (if wr-dir_0 - (if (pair? wr-dir_0) (car wr-dir_0) wr-dir_0) - #f))) - (let ((exploded-wrt-dir_0 (explode-path wrt-dir_0))) - (let ((base-dir_0 - (if wr-dir_0 - (if (pair? wr-dir_0) - (cdr wr-dir_0) - wr-dir_0) - #f))) - (begin - (set! exploded-base-dir_0 - (if base-dir_0 - (explode-path base-dir_0) - #f)) - (set! exploded-wrt-rel-dir_0 - (if (eq? base-dir_0 wrt-dir_0) - '() - (let ((exploded-wrt-dir_1 - (explode-path wrt-dir_0))) - (let ((base-len_0 - (length exploded-base-dir_0))) - (begin - (if who1_0 - (if (if (>= - (length - exploded-wrt-dir_1) - base-len_0) - (let ((lst_0 - exploded-base-dir_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - lst_1 + #f))))) + (void) + (raise-argument-error + who1_0 + (string-append + "(or/c (and/c path-string? complete-path?)\n" + " (cons/c (and/c path-string? complete-path?)\n" + " (and/c path-string? complete-path?))\n" + " #f)") + wr-dir_0)) + (void)) + (if (not wr-dir_0) + (lambda (v_0) #f) + (let ((exploded-base-dir_0 'not-ready)) + (let ((exploded-wrt-rel-dir_0 'not-ready)) + (lambda (v_0) + (begin + (if (if (eq? exploded-base-dir_0 'not-ready) + (path? v_0) + #f) + (let ((wrt-dir_0 + (if wr-dir_0 + (if (pair? wr-dir_0) (car wr-dir_0) wr-dir_0) + #f))) + (let ((exploded-wrt-dir_0 (explode-path wrt-dir_0))) + (let ((base-dir_0 + (if wr-dir_0 + (if (pair? wr-dir_0) + (cdr wr-dir_0) + wr-dir_0) + #f))) + (begin + (set! exploded-base-dir_0 + (if base-dir_0 (explode-path base-dir_0) #f)) + (set! exploded-wrt-rel-dir_0 + (if (eq? base-dir_0 wrt-dir_0) + '() + (let ((exploded-wrt-dir_1 + (explode-path wrt-dir_0))) + (let ((base-len_0 + (length exploded-base-dir_0))) + (begin + (if who1_0 + (if (if (>= + (length exploded-wrt-dir_1) + base-len_0) + (let ((lst_0 + exploded-base-dir_0)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_1 + lst_2) + (begin + (if (if (pair? + lst_1) + (pair? lst_2) - (begin - (if (if (pair? - lst_1) - (pair? - lst_2) - #f) - (let ((a_0 - (unsafe-car + #f) + (let ((a_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((b_0 - (unsafe-car + (let ((b_0 + (unsafe-car + lst_2))) + (let ((rest_1 + (unsafe-cdr lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((result_1 - (let ((result_1 - (equal? - a_0 - b_0))) - (values - result_1)))) - (if (if (not + (let ((result_1 + (let ((result_1 + (equal? + a_0 + b_0))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + a_0))) + (not + result_1))) + (if (not (let ((x_0 (list - a_0))) + b_0))) (not result_1))) - (if (not - (let ((x_0 - (list - b_0))) - (not - result_1))) - #t - #f) + #t #f) - (for-loop_0 - result_1 - rest_0 - rest_1) - result_1)))))) - result_0)))))) - (for-loop_0 - #t - exploded-wrt-dir_1 - lst_0)))) - #f) - (void) - (raise-arguments-error - who1_0 - "relative-directory pair's first path does not extend second path" - "first path" - wrt-dir_0 - "second path" - base-dir_0)) - (void)) - (list-tail - exploded-wrt-dir_1 - base-len_0)))))))))) - (void)) - (if exploded-base-dir_0 - (if (path? v_0) - (let ((exploded_0 (explode-path v_0))) - (if (let ((lst_0 exploded-base-dir_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_1 lst_2) - (begin - (if (if (pair? lst_1) - (pair? lst_2) - #f) - (let ((base-p_0 - (unsafe-car lst_1))) - (let ((rest_0 - (unsafe-cdr lst_1))) - (let ((p_0 - (unsafe-car lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((result_1 - (let ((result_1 - (equal? - base-p_0 - p_0))) - (values - result_1)))) - (if (if (not + #f) + (for-loop_0 + result_1 + rest_0 + rest_1) + result_1)))))) + result_0)))))) + (for-loop_0 + #t + exploded-wrt-dir_1 + lst_0)))) + #f) + (void) + (raise-arguments-error + who1_0 + "relative-directory pair's first path does not extend second path" + "first path" + wrt-dir_0 + "second path" + base-dir_0)) + (void)) + (list-tail + exploded-wrt-dir_1 + base-len_0)))))))))) + (void)) + (if exploded-base-dir_0 + (if (path? v_0) + (let ((exploded_0 (explode-path v_0))) + (if (let ((lst_0 exploded-base-dir_0)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_1 lst_2) + (begin + (if (if (pair? lst_1) + (pair? lst_2) + #f) + (let ((base-p_0 + (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) + (let ((p_0 + (unsafe-car lst_2))) + (let ((rest_1 + (unsafe-cdr lst_2))) + (let ((result_1 + (let ((result_1 + (equal? + base-p_0 + p_0))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + base-p_0))) + (not + result_1))) + (if (not (let ((x_0 (list - base-p_0))) + p_0))) (not result_1))) - (if (not - (let ((x_0 - (list - p_0))) - (not - result_1))) - #t - #f) + #t #f) - (for-loop_0 - result_1 - rest_0 - rest_1) - result_1)))))) - result_0)))))) - (for-loop_0 #t lst_0 exploded_0)))) - (if (let ((app_0 (length exploded_0))) - (>= app_0 (length exploded-base-dir_0))) - (let ((app_0 exploded-wrt-rel-dir_0)) - (loop_0 - app_0 - (list-tail - exploded_0 - (length exploded-base-dir_0)))) - #f) - #f)) - #f) - #f))))))))))))) + #f) + (for-loop_0 + result_1 + rest_0 + rest_1) + result_1)))))) + result_0)))))) + (for-loop_0 #t lst_0 exploded_0)))) + (if (let ((app_0 (length exploded_0))) + (>= app_0 (length exploded-base-dir_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (exploded-wrt-rel-dir_1 rel_0) + (begin + (if (null? exploded-wrt-rel-dir_1) + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((p_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if (path? + p_0) + (path-element->bytes + p_0) + p_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 null rel_0)))) + (if (if (pair? rel_0) + (let ((app_0 (car rel_0))) + (equal? + app_0 + (car + exploded-wrt-rel-dir_1))) + #f) + (let ((app_0 + (cdr + exploded-wrt-rel-dir_1))) + (loop_0 app_0 (cdr rel_0))) + (let ((app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? lst_0) + (let ((p_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (cons + 'up + fold-var_0))) + (let ((fold-var_2 + (values + fold-var_1))) + (for-loop_0 + fold-var_2 + rest_0))))) + fold-var_0)))))) + (for-loop_0 + null + exploded-wrt-rel-dir_1)))))) + (append + app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((p_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if (path? + p_0) + (path-element->bytes + p_0) + p_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + rel_0))))))))))))) + (let ((app_0 exploded-wrt-rel-dir_0)) + (loop_0 + app_0 + (list-tail + exploded_0 + (length exploded-base-dir_0))))) + #f) + #f)) + #f) + #f)))))))))))) (define 1/write-byte (|#%name| write-byte @@ -22347,1084 +22274,261 @@ (define fasl-hash-equal-variant 1) (define fasl-hash-eqv-variant 2) (define s-exp->fasl.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - v_0) - (begin - (if (not (eq? (hash-ref shared_0 v_0 1) 1)) - (let ((c_0 (hash-ref shared_0 v_0))) - (if (negative? c_0) - (begin - (begin-unsafe (write-byte 2 o_0)) - (write-fasl-integer (sub1 (- c_0)) o_0)) - (let ((pos_0 (unsafe-unbox* shared-counter_0))) - (begin - (unsafe-set-box*! - shared-counter_0 - (add1 (unsafe-unbox* shared-counter_0))) - (begin-unsafe (write-byte 1 o_0)) - (write-fasl-integer pos_0 o_0) - (hash-remove! shared_0 v_0) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - v_0) - (hash-set! shared_0 v_0 (- (add1 pos_0))))))) - (if (not v_0) - (begin-unsafe (write-byte 3 o_0)) - (if (eq? v_0 #t) - (begin-unsafe (write-byte 4 o_0)) - (if (null? v_0) - (begin-unsafe (write-byte 5 o_0)) - (if (void? v_0) - (begin-unsafe (write-byte 6 o_0)) - (if (eof-object? v_0) - (begin-unsafe (write-byte 7 o_0)) - (if (exact-integer? v_0) - (if (<= -10 v_0 144) - (let ((byte_0 (+ 100 (- v_0 -10)))) - (begin-unsafe (write-byte byte_0 o_0))) - (begin - (begin-unsafe (write-byte 8 o_0)) - (write-fasl-integer v_0 o_0))) - (if (flonum? v_0) - (begin - (begin-unsafe (write-byte 9 o_0)) - (1/write-bytes - (if (eqv? v_0 +nan.0) - #vu8(0 0 0 0 0 0 248 127) - (real->floating-point-bytes v_0 8 #f)) - o_0)) - (if (single-flonum? v_0) - (begin - (begin-unsafe (write-byte 10 o_0)) - (1/write-bytes - (if (eqv? - v_0 - (real->single-flonum +nan.0)) - #vu8(0 0 192 127) - (real->floating-point-bytes v_0 4 #f)) - o_0)) - (if (extflonum? v_0) - (begin - (begin-unsafe (write-byte 39 o_0)) - (let ((bstr_0 - (string->bytes/utf-8 - (format "~a" v_0)))) - (begin - (write-fasl-integer - (unsafe-bytes-length bstr_0) - o_0) - (1/write-bytes bstr_0 o_0)))) - (if (rational? v_0) - (begin - (begin-unsafe (write-byte 11 o_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (numerator v_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (denominator v_0))) - (if (complex? v_0) - (begin - (begin-unsafe (write-byte 12 o_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (real-part v_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (imag-part v_0))) - (if (char? v_0) - (begin - (begin-unsafe (write-byte 13 o_0)) - (write-fasl-integer - (char->integer v_0) - o_0)) - (if (symbol? v_0) - (begin - (if (symbol-interned? v_0) - (begin-unsafe - (write-byte 14 o_0)) - (if (symbol-unreadable? v_0) - (begin-unsafe - (write-byte 15 o_0)) - (begin-unsafe - (write-byte 16 o_0)))) - (let ((bstr_0 - (string->bytes/utf-8 - (symbol->string v_0)))) - (begin - (write-fasl-integer - (unsafe-bytes-length - bstr_0) - o_0) - (1/write-bytes - bstr_0 - o_0)))) - (if (keyword? v_0) - (begin - (begin-unsafe - (write-byte 17 o_0)) - (let ((bstr_0 - (string->bytes/utf-8 - (keyword->string - v_0)))) - (begin - (write-fasl-integer - (unsafe-bytes-length - bstr_0) - o_0) - (1/write-bytes - bstr_0 - o_0)))) - (if (string? v_0) - (begin - (write-fasl-integer - (if (treat-immutable?_0 - keep-mutable?5_0 - v_0) - 19 - 18) - o_0) - (write-fasl-string v_0 o_0)) - (if (bytes? v_0) - (begin - (write-fasl-integer - (if (treat-immutable?_0 - keep-mutable?5_0 - v_0) - 21 - 20) - o_0) - (write-fasl-bytes - v_0 - o_0)) - (if (path-for-some-system? - v_0) - (let ((rel-elems_0 - (|#%app| - path->relative-path-elements_0 - v_0))) - (if rel-elems_0 - (begin - (begin-unsafe - (write-byte - 23 - o_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - rel-elems_0)) - (begin - (begin-unsafe - (write-byte - 22 - o_0)) - (write-fasl-bytes - (path->bytes v_0) - o_0) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (path-convention-type - v_0))))) - (if (if (srcloc? v_0) - (let ((src_0 - (srcloc-source - v_0))) - (let ((or-part_0 - (not - src_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (path-for-some-system? - src_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (string? - src_0))) - (if or-part_2 - or-part_2 - (let ((or-part_3 - (bytes? - src_0))) - (if or-part_3 - or-part_3 - (symbol? - src_0)))))))))) - #f) - (let ((src_0 - (srcloc-source - v_0))) - (let ((new-src_0 - (if (if (path? - src_0) - (not - (|#%app| - path->relative-path-elements_0 - src_0)) - #f) - (truncate-path - src_0) - src_0))) - (begin - (write-fasl-integer - 38 - o_0) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - new-src_0) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (srcloc-line - v_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (srcloc-column - v_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (srcloc-position - v_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (srcloc-span - v_0))))) - (if (pair? v_0) - (if (pair? (cdr v_0)) - (call-with-values - (lambda () - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (v_1 - len_0) - (begin - (if (null? - v_1) - (values - len_0 - #t) - (if (pair? - v_1) - (let ((app_0 - (cdr - v_1))) - (loop_2 - app_0 - (add1 - len_0))) - (values - len_0 - #f)))))))) - (loop_2 v_0 0))) - (case-lambda - ((n_0 - normal-list?_0) - (begin - (let ((byte_0 - (if normal-list?_0 - 28 - 29))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (write-fasl-integer - n_0 - o_0) - (letrec* - ((ploop_0 - (|#%name| - ploop - (lambda (v_1) - (begin - (if (pair? - v_1) - (begin - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (car - v_1)) - (ploop_0 - (cdr - v_1))) - (if normal-list?_0 - (void) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - v_1)))))))) - (ploop_0 - v_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (begin - (begin-unsafe - (write-byte - 30 - o_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (car v_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (cdr v_0)))) - (if (vector? v_0) - (begin - (let ((byte_0 - (if (treat-immutable?_0 - keep-mutable?5_0 - v_0) - 32 - 31))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (write-fasl-integer - (vector-length - v_0) - o_0) - (call-with-values - (lambda () - (begin - (check-vector - v_0) - (values - v_0 - (unsafe-vector-length - v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - e_0) - (for-loop_0 - (unsafe-fx+ - 1 - pos_0)))) - (values))))))) - (for-loop_0 - 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (void)) - (if (box? v_0) - (begin - (let ((byte_0 - (if (treat-immutable?_0 - keep-mutable?5_0 - v_0) - 34 - 33))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (unbox v_0))) - (let ((c2_0 - (prefab-struct-key - v_0))) - (if c2_0 - (begin - (begin-unsafe - (write-byte - 35 - o_0)) - (begin - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - c2_0) - (let ((vec_0 - (struct->vector - v_0))) - (begin - (write-fasl-integer - (sub1 - (vector-length - vec_0)) - o_0) - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - vec_0 - 1 - #f - 1)) - (case-lambda - ((v*_0 - start*_0 - stop*_0 - step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (begin - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - e_0) - (for-loop_0 - (unsafe-fx+ - idx_0 - 1)))) - (values))))))) - (for-loop_0 - start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (void))))) - (if (hash? - v_0) - (begin - (let ((byte_0 - (if (treat-immutable?_0 - keep-mutable?5_0 - v_0) - 37 - 36))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (let ((byte_0 - (if (hash-eq? - v_0) - 0 - (if (hash-eqv? - v_0) - 2 - 1)))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (write-fasl-integer - (hash-count - v_0) - o_0) - (hash-for-each - v_0 - (lambda (k_0 - v_1) - (begin - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - k_0) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - v_1))) - #t)) - (if (regexp? - v_0) - (begin - (let ((byte_0 - (if (pregexp? - v_0) - 24 - 25))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (write-fasl-string - (object-name - v_0) - o_0)) - (if (byte-regexp? - v_0) - (begin - (let ((byte_0 - (if (byte-pregexp? - v_0) - 26 - 27))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (write-fasl-bytes - (object-name - v_0) - o_0)) - (if (begin-unsafe - (|#%app| - syntax?$3 - v_0)) - (begin - (begin-unsafe - (write-byte - 40 - o_0)) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (begin-unsafe - (|#%app| - syntax-e$4 - v_0))) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (let ((app_0 - (begin-unsafe - (|#%app| - syntax-source$3 - v_0)))) - (let ((app_1 - (begin-unsafe - (|#%app| - syntax-line$3 - v_0)))) - (let ((app_2 - (begin-unsafe - (|#%app| - syntax-column$3 - v_0)))) - (let ((app_3 - (begin-unsafe - (|#%app| - syntax-position$3 - v_0)))) - (unsafe-make-srcloc - app_0 - app_1 - app_2 - app_3 - (begin-unsafe - (|#%app| - syntax-span$3 - v_0)))))))) - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (reverse$1 - (let ((lst_0 - (begin-unsafe - (|#%app| - syntax-property-symbol-keys$3 - v_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((k_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (cons - k_0 - (begin-unsafe - (|#%app| - syntax-property$3 - v_0 - k_0))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - lst_0))))))) - (if (eq? - v_0 - unsafe-undefined) - (begin-unsafe - (write-byte - 41 - o_0)) - (if handle-fail6_0 - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (|#%app| - handle-fail6_0 - v_0)) - (raise-arguments-error - 's-exp->fasl - "cannot write value" - "value" - v_0))))))))))))))))))))))))))))))))))) - (loop_1 - (|#%name| - loop - (lambda (external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - v_0) - (begin - (if (if external-lift_0 (hash-ref external-lift_0 v_0 #f) #f) - (void) - (if (if external-lift?7_0 - (|#%app| external-lift?7_0 v_0) - #f) - (begin - (hash-set! external-lift_0 v_0 #t) - (unsafe-set-box*! - shared-counter_0 - (add1 (unsafe-unbox* shared-counter_0))) - (hash-set! - shared_0 - v_0 - (- (unsafe-unbox* shared-counter_0)))) - (if (let ((or-part_0 (symbol? v_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (keyword? v_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 (string? v_0))) - (if or-part_2 - or-part_2 - (let ((or-part_3 (bytes? v_0))) - (if or-part_3 - or-part_3 - (path? v_0))))))))) - (begin-unsafe - (do-hash-update - 'hash-update! - #t - hash-set! - shared_0 - v_0 - add1 - 0)) - (if (pair? v_0) - (begin - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (car v_0)) - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (cdr v_0))) - (if (vector? v_0) - (begin - (call-with-values - (lambda () - (begin - (check-vector v_0) - (values v_0 (unsafe-vector-length v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (unsafe-fx< pos_0 len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - e_0) - (for-loop_0 - (unsafe-fx+ 1 pos_0)))) - (values))))))) - (for-loop_0 0)))) - (args - (raise-binding-result-arity-error 2 args)))) - (void)) - (if (hash? v_0) - (hash-for-each - v_0 - (lambda (k_0 v_1) - (begin - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - k_0) - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - v_1))) - #t) - (if (box? v_0) - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (unbox v_0)) - (let ((c1_0 (prefab-struct-key v_0))) - (if c1_0 - (begin - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - c1_0) - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - (struct->vector v_0) - 1 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (begin - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - e_0) - (for-loop_0 - (unsafe-fx+ - idx_0 - 1)))) - (values))))))) - (for-loop_0 start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (void)) - (if (srcloc? v_0) - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (srcloc-source v_0)) - (if (begin-unsafe (|#%app| syntax?$3 v_0)) - (begin - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (begin-unsafe - (|#%app| syntax-e$4 v_0))) - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (begin-unsafe - (|#%app| syntax-source$3 v_0))) - (let ((lst_0 - (begin-unsafe - (|#%app| - syntax-property-symbol-keys$3 - v_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((k_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (begin - (begin - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - k_0) - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (begin-unsafe - (|#%app| - syntax-property$3 - v_0 - k_0)))) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void)) - (void)))))))))))))))) - (treat-immutable?_0 - (|#%name| - treat-immutable? - (lambda (keep-mutable?5_0 v_0) - (begin - (let ((or-part_0 (not keep-mutable?5_0))) - (if or-part_0 or-part_0 (immutable? v_0)))))))) - (|#%name| - s-exp->fasl - (lambda (external-lift?7_0 - handle-fail6_0 - keep-mutable?5_0 - skip-prefix?8_0 - v14_0 - orig-o13_0) + (|#%name| + s-exp->fasl + (lambda (external-lift?7_0 + handle-fail6_0 + keep-mutable?5_0 + skip-prefix?8_0 + v14_0 + orig-o13_0) + (begin (begin + (if orig-o13_0 + (if (output-port? orig-o13_0) + (void) + (raise-argument-error + 's-exp->fasl + "(or/c output-port? #f)" + orig-o13_0)) + (void)) (begin - (if orig-o13_0 - (if (output-port? orig-o13_0) + (if handle-fail6_0 + (if (if (procedure? handle-fail6_0) + (procedure-arity-includes? handle-fail6_0 1) + #f) (void) (raise-argument-error 's-exp->fasl - "(or/c output-port? #f)" - orig-o13_0)) + "(or/c (procedure-arity-includes/c 1) #f)" + handle-fail6_0)) (void)) (begin - (if handle-fail6_0 - (if (if (procedure? handle-fail6_0) - (procedure-arity-includes? handle-fail6_0 1) + (if external-lift?7_0 + (if (if (procedure? external-lift?7_0) + (procedure-arity-includes? external-lift?7_0 1) #f) (void) (raise-argument-error 's-exp->fasl "(or/c (procedure-arity-includes/c 1) #f)" - handle-fail6_0)) + external-lift?7_0)) (void)) - (begin - (if external-lift?7_0 - (if (if (procedure? external-lift?7_0) - (procedure-arity-includes? external-lift?7_0 1) - #f) - (void) - (raise-argument-error - 's-exp->fasl - "(or/c (procedure-arity-includes/c 1) #f)" - external-lift?7_0)) - (void)) - (let ((o_0 (if orig-o13_0 orig-o13_0 (open-output-bytes)))) - (let ((shared_0 (make-hasheq))) - (let ((external-lift_0 - (if external-lift?7_0 (make-hasheq) #f))) - (let ((shared-counter_0 (box 0))) - (begin - (loop_1 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - v14_0) + (let ((o_0 (if orig-o13_0 orig-o13_0 (open-output-bytes)))) + (let ((shared_0 (make-hasheq))) + (let ((external-lift_0 + (if external-lift?7_0 (make-hasheq) #f))) + (let ((shared-counter_0 0)) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_0) + (begin + (if (if external-lift_0 + (hash-ref external-lift_0 v_0 #f) + #f) + (void) + (if (if external-lift?7_0 + (|#%app| external-lift?7_0 v_0) + #f) + (begin + (hash-set! external-lift_0 v_0 #t) + (set! shared-counter_0 + (add1 shared-counter_0)) + (hash-set! + shared_0 + v_0 + (- shared-counter_0))) + (if (let ((or-part_0 (symbol? v_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (keyword? v_0))) + (if or-part_1 + or-part_1 + (let ((or-part_2 (string? v_0))) + (if or-part_2 + or-part_2 + (let ((or-part_3 + (bytes? v_0))) + (if or-part_3 + or-part_3 + (path? v_0))))))))) + (begin-unsafe + (do-hash-update + 'hash-update! + #t + hash-set! + shared_0 + v_0 + add1 + 0)) + (if (pair? v_0) + (begin + (loop_0 (car v_0)) + (loop_0 (cdr v_0))) + (if (vector? v_0) + (begin + (call-with-values + (lambda () + (begin + (check-vector v_0) + (values + v_0 + (unsafe-vector-length v_0)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (loop_0 e_0) + (for-loop_0 + (unsafe-fx+ + 1 + pos_0)))) + (values))))))) + (for-loop_0 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (void)) + (if (hash? v_0) + (hash-for-each + v_0 + (lambda (k_0 v_1) + (begin + (loop_0 k_0) + (loop_0 v_1))) + #t) + (if (box? v_0) + (loop_0 (unbox v_0)) + (let ((c1_0 + (prefab-struct-key v_0))) + (if c1_0 + (begin + (loop_0 c1_0) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + (struct->vector v_0) + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + idx_0 + 1)))) + (values))))))) + (for-loop_0 + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (void)) + (if (srcloc? v_0) + (loop_0 (srcloc-source v_0)) + (if (begin-unsafe + (|#%app| + syntax?$3 + v_0)) + (begin + (loop_0 + (begin-unsafe + (|#%app| + syntax-e$4 + v_0))) + (loop_0 + (begin-unsafe + (|#%app| + syntax-source$3 + v_0))) + (let ((lst_0 + (begin-unsafe + (|#%app| + syntax-property-symbol-keys$3 + v_0)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? + lst_1) + (let ((k_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (begin + (begin + (loop_0 + k_0) + (loop_0 + (begin-unsafe + (|#%app| + syntax-property$3 + v_0 + k_0)))) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + lst_0)))) + (void)) + (void))))))))))))))))) + (loop_0 v14_0)) + (let ((treat-immutable?_0 + (|#%name| + treat-immutable? + (lambda (v_0) + (begin + (let ((or-part_0 (not keep-mutable?5_0))) + (if or-part_0 + or-part_0 + (immutable? v_0)))))))) (let ((path->relative-path-elements_0 (make-path->relative-path-elements.1 #f @@ -23436,19 +22540,739 @@ (let ((bstr_0 (let ((o_1 (open-output-bytes))) (begin - (loop_0 - handle-fail6_0 - keep-mutable?5_0 - o_1 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - v14_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_0) + (begin + (if (not + (eq? + (hash-ref shared_0 v_0 1) + 1)) + (let ((c_0 + (hash-ref + shared_0 + v_0))) + (if (negative? c_0) + (begin + (begin-unsafe + (write-byte 2 o_1)) + (write-fasl-integer + (sub1 (- c_0)) + o_1)) + (let ((pos_0 + shared-counter_0)) + (begin + (set! shared-counter_0 + (add1 + shared-counter_0)) + (begin-unsafe + (write-byte 1 o_1)) + (write-fasl-integer + pos_0 + o_1) + (hash-remove! + shared_0 + v_0) + (loop_0 v_0) + (hash-set! + shared_0 + v_0 + (- + (add1 pos_0))))))) + (if (not v_0) + (begin-unsafe + (write-byte 3 o_1)) + (if (eq? v_0 #t) + (begin-unsafe + (write-byte 4 o_1)) + (if (null? v_0) + (begin-unsafe + (write-byte 5 o_1)) + (if (void? v_0) + (begin-unsafe + (write-byte 6 o_1)) + (if (eof-object? v_0) + (begin-unsafe + (write-byte + 7 + o_1)) + (if (exact-integer? + v_0) + (if (<= + -10 + v_0 + 144) + (let ((byte_0 + (+ + 100 + (- + v_0 + -10)))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (begin + (begin-unsafe + (write-byte + 8 + o_1)) + (write-fasl-integer + v_0 + o_1))) + (if (flonum? v_0) + (begin + (begin-unsafe + (write-byte + 9 + o_1)) + (1/write-bytes + (if (eqv? + v_0 + +nan.0) + #vu8(0 0 0 0 0 0 248 127) + (real->floating-point-bytes + v_0 + 8 + #f)) + o_1)) + (if (single-flonum? + v_0) + (begin + (begin-unsafe + (write-byte + 10 + o_1)) + (1/write-bytes + (if (eqv? + v_0 + (real->single-flonum + +nan.0)) + #vu8(0 0 192 127) + (real->floating-point-bytes + v_0 + 4 + #f)) + o_1)) + (if (extflonum? + v_0) + (begin + (begin-unsafe + (write-byte + 39 + o_1)) + (let ((bstr_0 + (string->bytes/utf-8 + (format + "~a" + v_0)))) + (begin + (write-fasl-integer + (unsafe-bytes-length + bstr_0) + o_1) + (1/write-bytes + bstr_0 + o_1)))) + (if (rational? + v_0) + (begin + (begin-unsafe + (write-byte + 11 + o_1)) + (loop_0 + (numerator + v_0)) + (loop_0 + (denominator + v_0))) + (if (complex? + v_0) + (begin + (begin-unsafe + (write-byte + 12 + o_1)) + (loop_0 + (real-part + v_0)) + (loop_0 + (imag-part + v_0))) + (if (char? + v_0) + (begin + (begin-unsafe + (write-byte + 13 + o_1)) + (write-fasl-integer + (char->integer + v_0) + o_1)) + (if (symbol? + v_0) + (begin + (if (symbol-interned? + v_0) + (begin-unsafe + (write-byte + 14 + o_1)) + (if (symbol-unreadable? + v_0) + (begin-unsafe + (write-byte + 15 + o_1)) + (begin-unsafe + (write-byte + 16 + o_1)))) + (let ((bstr_0 + (string->bytes/utf-8 + (symbol->string + v_0)))) + (begin + (write-fasl-integer + (unsafe-bytes-length + bstr_0) + o_1) + (1/write-bytes + bstr_0 + o_1)))) + (if (keyword? + v_0) + (begin + (begin-unsafe + (write-byte + 17 + o_1)) + (let ((bstr_0 + (string->bytes/utf-8 + (keyword->string + v_0)))) + (begin + (write-fasl-integer + (unsafe-bytes-length + bstr_0) + o_1) + (1/write-bytes + bstr_0 + o_1)))) + (if (string? + v_0) + (begin + (write-fasl-integer + (if (treat-immutable?_0 + v_0) + 19 + 18) + o_1) + (write-fasl-string + v_0 + o_1)) + (if (bytes? + v_0) + (begin + (write-fasl-integer + (if (treat-immutable?_0 + v_0) + 21 + 20) + o_1) + (write-fasl-bytes + v_0 + o_1)) + (if (path-for-some-system? + v_0) + (let ((rel-elems_0 + (|#%app| + path->relative-path-elements_0 + v_0))) + (if rel-elems_0 + (begin + (begin-unsafe + (write-byte + 23 + o_1)) + (loop_0 + rel-elems_0)) + (begin + (begin-unsafe + (write-byte + 22 + o_1)) + (write-fasl-bytes + (path->bytes + v_0) + o_1) + (loop_0 + (path-convention-type + v_0))))) + (if (if (srcloc? + v_0) + (let ((src_0 + (srcloc-source + v_0))) + (let ((or-part_0 + (not + src_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (path-for-some-system? + src_0))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (string? + src_0))) + (if or-part_2 + or-part_2 + (let ((or-part_3 + (bytes? + src_0))) + (if or-part_3 + or-part_3 + (symbol? + src_0)))))))))) + #f) + (let ((src_0 + (srcloc-source + v_0))) + (let ((new-src_0 + (if (if (path? + src_0) + (not + (|#%app| + path->relative-path-elements_0 + src_0)) + #f) + (truncate-path + src_0) + src_0))) + (begin + (write-fasl-integer + 38 + o_1) + (loop_0 + new-src_0) + (loop_0 + (srcloc-line + v_0)) + (loop_0 + (srcloc-column + v_0)) + (loop_0 + (srcloc-position + v_0)) + (loop_0 + (srcloc-span + v_0))))) + (if (pair? + v_0) + (if (pair? + (cdr + v_0)) + (call-with-values + (lambda () + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (v_1 + len_0) + (begin + (if (null? + v_1) + (values + len_0 + #t) + (if (pair? + v_1) + (let ((app_0 + (cdr + v_1))) + (loop_1 + app_0 + (add1 + len_0))) + (values + len_0 + #f)))))))) + (loop_1 + v_0 + 0))) + (case-lambda + ((n_0 + normal-list?_0) + (begin + (let ((byte_0 + (if normal-list?_0 + 28 + 29))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (write-fasl-integer + n_0 + o_1) + (letrec* + ((ploop_0 + (|#%name| + ploop + (lambda (v_1) + (begin + (if (pair? + v_1) + (begin + (loop_0 + (car + v_1)) + (ploop_0 + (cdr + v_1))) + (if normal-list?_0 + (void) + (loop_0 + v_1)))))))) + (ploop_0 + v_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (begin + (begin-unsafe + (write-byte + 30 + o_1)) + (loop_0 + (car + v_0)) + (loop_0 + (cdr + v_0)))) + (if (vector? + v_0) + (begin + (let ((byte_0 + (if (treat-immutable?_0 + v_0) + 32 + 31))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (write-fasl-integer + (vector-length + v_0) + o_1) + (call-with-values + (lambda () + (begin + (check-vector + v_0) + (values + v_0 + (unsafe-vector-length + v_0)))) + (case-lambda + ((vec_0 + len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + 1 + pos_0)))) + (values))))))) + (for-loop_0 + 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (void)) + (if (box? + v_0) + (begin + (let ((byte_0 + (if (treat-immutable?_0 + v_0) + 34 + 33))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (loop_0 + (unbox + v_0))) + (let ((c2_0 + (prefab-struct-key + v_0))) + (if c2_0 + (begin + (begin-unsafe + (write-byte + 35 + o_1)) + (begin + (loop_0 + c2_0) + (let ((vec_0 + (struct->vector + v_0))) + (begin + (write-fasl-integer + (sub1 + (vector-length + vec_0)) + o_1) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + vec_0 + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + idx_0 + 1)))) + (values))))))) + (for-loop_0 + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (void))))) + (if (hash? + v_0) + (begin + (let ((byte_0 + (if (treat-immutable?_0 + v_0) + 37 + 36))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (let ((byte_0 + (if (hash-eq? + v_0) + 0 + (if (hash-eqv? + v_0) + 2 + 1)))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (write-fasl-integer + (hash-count + v_0) + o_1) + (hash-for-each + v_0 + (lambda (k_0 + v_1) + (begin + (loop_0 + k_0) + (loop_0 + v_1))) + #t)) + (if (regexp? + v_0) + (begin + (let ((byte_0 + (if (pregexp? + v_0) + 24 + 25))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (write-fasl-string + (object-name + v_0) + o_1)) + (if (byte-regexp? + v_0) + (begin + (let ((byte_0 + (if (byte-pregexp? + v_0) + 26 + 27))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (write-fasl-bytes + (object-name + v_0) + o_1)) + (if (begin-unsafe + (|#%app| + syntax?$3 + v_0)) + (begin + (begin-unsafe + (write-byte + 40 + o_1)) + (loop_0 + (begin-unsafe + (|#%app| + syntax-e$4 + v_0))) + (loop_0 + (let ((app_0 + (begin-unsafe + (|#%app| + syntax-source$3 + v_0)))) + (let ((app_1 + (begin-unsafe + (|#%app| + syntax-line$3 + v_0)))) + (let ((app_2 + (begin-unsafe + (|#%app| + syntax-column$3 + v_0)))) + (let ((app_3 + (begin-unsafe + (|#%app| + syntax-position$3 + v_0)))) + (unsafe-make-srcloc + app_0 + app_1 + app_2 + app_3 + (begin-unsafe + (|#%app| + syntax-span$3 + v_0)))))))) + (loop_0 + (reverse$1 + (let ((lst_0 + (begin-unsafe + (|#%app| + syntax-property-symbol-keys$3 + v_0)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((k_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (cons + k_0 + (begin-unsafe + (|#%app| + syntax-property$3 + v_0 + k_0))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + lst_0))))))) + (if (eq? + v_0 + unsafe-undefined) + (begin-unsafe + (write-byte + 41 + o_1)) + (if handle-fail6_0 + (loop_0 + (|#%app| + handle-fail6_0 + v_0)) + (raise-arguments-error + 's-exp->fasl + "cannot write value" + "value" + v_0)))))))))))))))))))))))))))))))))))) + (loop_0 v14_0)) (get-output-bytes o_1 #t))))) (begin - (write-fasl-integer - (unsafe-unbox* shared-counter_0) - o_0) + (write-fasl-integer shared-counter_0 o_0) (write-fasl-integer (unsafe-bytes-length bstr_0) o_0) @@ -23457,713 +23281,693 @@ (void) (get-output-bytes o_0))))))))))))))))))) (define fasl->s-exp.1 - (letrec ((intern_0 - (|#%name| - intern - (lambda (datum-intern?16_0 v_0) - (begin (if datum-intern?16_0 (datum-intern-literal v_0) v_0))))) - (loop_0 - (|#%name| - loop - (lambda (datum-intern?16_0 i_0 shared-count_0 shared_0) - (begin - (let ((type_0 (read-byte/no-eof i_0))) - (let ((index_0 - (if (fixnum? type_0) - (if (if (unsafe-fx>= type_0 1) - (unsafe-fx< type_0 42) - #f) - (let ((tbl_0 - '#(1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 12 - 13 - 14 - 15 - 16 - 17 - 18 - 19 - 20 - 21 - 22 - 23 - 24 - 25 - 26 - 27 - 28 - 29 - 31 - 30 - 32 - 32 - 33 - 34 - 35 - 36 - 37 - 38 - 11 - 39 - 40))) - (unsafe-vector*-ref - tbl_0 - (unsafe-fx- type_0 1))) - 0) - 0))) - (if (unsafe-fx< index_0 20) - (if (unsafe-fx< index_0 9) - (if (unsafe-fx< index_0 4) - (if (unsafe-fx< index_0 1) - (if (>= type_0 100) - (+ (- type_0 100) -10) - (read-error - "unrecognized fasl tag" - "tag" - type_0)) - (if (unsafe-fx< index_0 2) - (let ((pos_0 (|#%app| read-fasl-integer i_0))) - (let ((v_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (begin - (if (< pos_0 shared-count_0) - (void) - (read-error "bad graph index")) - (vector-set! shared_0 pos_0 v_0) - v_0))) - (if (unsafe-fx< index_0 3) - (let ((pos_0 (|#%app| read-fasl-integer i_0))) - (begin - (if (< pos_0 shared-count_0) - (void) - (read-error "bad graph index")) - (vector-ref shared_0 pos_0))) - #f))) - (if (unsafe-fx< index_0 6) - (if (unsafe-fx< index_0 5) #t null) - (if (unsafe-fx< index_0 7) - (void) - (if (unsafe-fx< index_0 8) - eof - (intern_0 - datum-intern?16_0 - (|#%app| read-fasl-integer i_0)))))) - (if (unsafe-fx< index_0 14) - (if (unsafe-fx< index_0 11) - (if (unsafe-fx< index_0 10) - (floating-point-bytes->real - (read-bytes/exactly 8 i_0) - #f) - (real->single-flonum - (floating-point-bytes->real - (read-bytes/exactly 4 i_0) - #f))) - (if (unsafe-fx< index_0 12) - (let ((bstr_0 - (read-bytes/exactly - (|#%app| read-fasl-integer i_0) - i_0))) - (let ((app_0 1/string->number)) - (|#%app| - app_0 - (bytes->string/utf-8 bstr_0) - 10 - 'read))) - (if (unsafe-fx< index_0 13) - (intern_0 - datum-intern?16_0 - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (/ - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0)))) - (intern_0 - datum-intern?16_0 - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (make-rectangular - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))))))) - (if (unsafe-fx< index_0 16) - (if (unsafe-fx< index_0 15) - (intern_0 - datum-intern?16_0 - (integer->char - (|#%app| read-fasl-integer i_0))) - (string->symbol (|#%app| read-fasl-string i_0))) - (if (unsafe-fx< index_0 17) - (string->unreadable-symbol - (|#%app| read-fasl-string i_0)) - (if (unsafe-fx< index_0 18) - (string->uninterned-symbol - (|#%app| read-fasl-string i_0)) - (if (unsafe-fx< index_0 19) - (string->keyword - (|#%app| read-fasl-string i_0)) - (|#%app| read-fasl-string i_0))))))) - (if (unsafe-fx< index_0 30) - (if (unsafe-fx< index_0 24) - (if (unsafe-fx< index_0 21) - (intern_0 - datum-intern?16_0 - (string->immutable-string - (|#%app| read-fasl-string i_0))) - (if (unsafe-fx< index_0 22) - (read-fasl-bytes i_0) - (if (unsafe-fx< index_0 23) - (intern_0 - datum-intern?16_0 - (bytes->immutable-bytes - (read-fasl-bytes i_0))) - (let ((app_0 (read-fasl-bytes i_0))) - (bytes->path - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0)))))) - (if (unsafe-fx< index_0 26) - (if (unsafe-fx< index_0 25) - (let ((wrt-dir_0 - (current-load-relative-directory))) - (let ((rel-elems_0 - (reverse$1 - (let ((lst_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_1) - (begin - (if (pair? lst_1) - (let ((p_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if (bytes? - p_0) - (bytes->path-element - p_0) - p_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null lst_0))))))) - (if wrt-dir_0 - (apply build-path wrt-dir_0 rel-elems_0) - (if (null? rel-elems_0) - (build-path 'same) - (apply build-path rel-elems_0))))) - (intern_0 - datum-intern?16_0 - (pregexp (|#%app| read-fasl-string i_0)))) - (if (unsafe-fx< index_0 27) - (intern_0 - datum-intern?16_0 - (regexp (|#%app| read-fasl-string i_0))) - (if (unsafe-fx< index_0 28) - (intern_0 - datum-intern?16_0 - (byte-pregexp (read-fasl-bytes i_0))) - (if (unsafe-fx< index_0 29) - (intern_0 - datum-intern?16_0 - (byte-regexp (read-fasl-bytes i_0))) - (let ((len_0 - (|#%app| read-fasl-integer i_0))) - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 pos_0) - (begin - (if (< pos_0 len_0) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - (+ pos_0 1))) - fold-var_0)))))) - (for-loop_0 null 0)))))))))) - (if (unsafe-fx< index_0 35) - (if (unsafe-fx< index_0 32) - (if (unsafe-fx< index_0 31) - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (cons - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((len_0 (|#%app| read-fasl-integer i_0))) - (ploop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0 - len_0))) - (if (unsafe-fx< index_0 33) - (let ((len_0 (|#%app| read-fasl-integer i_0))) - (let ((vec_0 - (begin - (if (exact-nonnegative-integer? - len_0) - (void) - (raise-argument-error - 'for/vector - "exact-nonnegative-integer?" - len_0)) - (let ((v_0 (make-vector len_0 0))) - (begin - (if (zero? len_0) - (void) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_1 pos_0) - (begin - (if (< pos_0 len_0) - (let ((i_2 - (let ((i_2 - (begin - (unsafe-vector*-set! - v_0 - i_1 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0)) - (unsafe-fx+ - 1 - i_1)))) - (values - i_2)))) - (if (if (not - (let ((x_0 - (list - pos_0))) - (unsafe-fx= - i_2 - len_0))) - #t - #f) - (for-loop_0 - i_2 - (+ pos_0 1)) - i_2)) - i_1)))))) - (for-loop_0 0 0)))) - v_0))))) - (if (eqv? type_0 32) - (vector->immutable-vector vec_0) - vec_0))) - (if (unsafe-fx< index_0 34) - (box - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0)) - (box-immutable - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))))) - (if (unsafe-fx< index_0 37) - (if (unsafe-fx< index_0 36) - (let ((key_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((len_0 (|#%app| read-fasl-integer i_0))) - (apply - make-prefab-struct - key_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 pos_0) - (begin - (if (< pos_0 len_0) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - (+ pos_0 1))) - fold-var_0)))))) - (for-loop_0 null 0))))))) - (let ((ht_0 - (let ((tmp_0 (read-byte/no-eof i_0))) - (if (eq? tmp_0 0) - (make-hasheq) - (if (eq? tmp_0 2) - (make-hasheqv) - (make-hash)))))) - (let ((len_0 (|#%app| read-fasl-integer i_0))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (< pos_0 len_0) - (begin - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (hash-set! - ht_0 - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (for-loop_0 (+ pos_0 1))) - (values))))))) - (for-loop_0 0))) - (void) - ht_0)))) - (if (unsafe-fx< index_0 38) - (let ((ht_0 - (let ((tmp_0 (read-byte/no-eof i_0))) - (if (eq? tmp_0 0) - hash2610 - (if (eq? tmp_0 2) - hash2589 - hash2725))))) - (let ((len_0 (|#%app| read-fasl-integer i_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ht_1 pos_0) - (begin - (if (< pos_0 len_0) - (let ((ht_2 - (let ((ht_2 - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (hash-set - ht_1 - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))))) - (values ht_2)))) - (for-loop_0 ht_2 (+ pos_0 1))) - ht_1)))))) - (for-loop_0 ht_0 0))))) - (if (unsafe-fx< index_0 39) - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((app_1 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((app_2 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((app_3 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (unsafe-make-srcloc - app_0 - app_1 - app_2 - app_3 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0)))))) - (if (unsafe-fx< index_0 40) - (let ((e_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((s_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((c_0 - (datum->correlated$1 - e_0 - (let ((app_0 - (srcloc-source s_0))) - (let ((app_1 - (srcloc-line s_0))) - (let ((app_2 - (srcloc-column s_0))) - (let ((app_3 - (srcloc-position - s_0))) - (vector - app_0 - app_1 - app_2 - app_3 - (srcloc-span - s_0))))))))) - (let ((lst_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (c_1 lst_1) - (begin - (if (pair? lst_1) - (let ((p_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((c_2 - (let ((c_2 - (let ((k_0 - (car - p_0))) - (let ((v_0 - (cdr - p_0))) - (let ((k_1 - k_0)) - (begin-unsafe - (|#%app| - syntax-property$3 - c_1 - k_1 - v_0))))))) - (values - c_2)))) - (for-loop_0 - c_2 - rest_0)))) - c_1)))))) - (for-loop_0 c_0 lst_0))))))) - unsafe-undefined))))))))))))) - (ploop_0 - (|#%name| - ploop - (lambda (datum-intern?16_0 i_0 shared-count_0 shared_0 len_0) - (begin - (if (zero? len_0) - (loop_0 datum-intern?16_0 i_0 shared-count_0 shared_0) - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (cons - app_0 - (ploop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0 - (sub1 len_0)))))))))) - (|#%name| - fasl->s-exp - (lambda (datum-intern?16_0 external-lifts17_0 skip-prefix?18_0 orig-i22_0) - (begin - (let ((external-lifts_0 - (if (eq? external-lifts17_0 unsafe-undefined) - '#() - external-lifts17_0))) - (let ((init-i_0 - (if (bytes? orig-i22_0) - (mcons orig-i22_0 0) - (if (input-port? orig-i22_0) - orig-i22_0 - (raise-argument-error - 'fasl->s-exp - "(or/c bytes? input-port?)" - orig-i22_0))))) - (begin - (if skip-prefix?18_0 + (|#%name| + fasl->s-exp + (lambda (datum-intern?16_0 external-lifts17_0 skip-prefix?18_0 orig-i22_0) + (begin + (let ((external-lifts_0 + (if (eq? external-lifts17_0 unsafe-undefined) + '#() + external-lifts17_0))) + (let ((init-i_0 + (if (bytes? orig-i22_0) + (mcons orig-i22_0 0) + (if (input-port? orig-i22_0) + orig-i22_0 + (raise-argument-error + 'fasl->s-exp + "(or/c bytes? input-port?)" + orig-i22_0))))) + (begin + (if skip-prefix?18_0 + (void) + (if (bytes=? + (read-bytes/exactly* fasl-prefix-length init-i_0) + fasl-prefix) (void) - (if (bytes=? - (read-bytes/exactly* fasl-prefix-length init-i_0) - fasl-prefix) - (void) - (read-error "unrecognized prefix"))) - (let ((shared-count_0 (read-fasl-integer* init-i_0))) - (let ((shared_0 (make-vector shared-count_0))) + (read-error "unrecognized prefix"))) + (let ((shared-count_0 (read-fasl-integer* init-i_0))) + (let ((shared_0 (make-vector shared-count_0))) + (begin + (if (if (vector? external-lifts_0) + (<= (vector-length external-lifts_0) shared-count_0) + #f) + (void) + (error + 'fasl->s-exp + "external-lift vector does not match expected size")) (begin - (if (if (vector? external-lifts_0) - (<= (vector-length external-lifts_0) shared-count_0) - #f) - (void) - (error - 'fasl->s-exp - "external-lift vector does not match expected size")) - (begin - (call-with-values - (lambda () - (begin - (check-vector external-lifts_0) - (values - external-lifts_0 - (unsafe-vector-length external-lifts_0)))) - (case-lambda - ((vec_0 len_0) - (let ((start_0 0)) - (let ((vec_1 vec_0) (len_1 len_0)) - (begin - #f - (void) - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0 pos_1) - (begin - (if (if (unsafe-fx< pos_0 len_1) #t #f) - (let ((v_0 - (unsafe-vector-ref - vec_1 - pos_0))) - (begin - (vector-set! - shared_0 - pos_1 - (vector-ref - external-lifts_0 - pos_1)) - (for-loop_0 - (unsafe-fx+ 1 pos_0) - (+ pos_1 1)))) - (values))))))) - (for-loop_0 0 start_0)))))) - (args (raise-binding-result-arity-error 2 args)))) - (let ((len_0 (read-fasl-integer* init-i_0))) - (let ((i_0 - (if (mpair? init-i_0) - init-i_0 - (let ((bstr_0 - (read-bytes/exactly* len_0 init-i_0))) - (mcons bstr_0 0))))) - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))))))))))))))) + (call-with-values + (lambda () + (begin + (check-vector external-lifts_0) + (values + external-lifts_0 + (unsafe-vector-length external-lifts_0)))) + (case-lambda + ((vec_0 len_0) + (let ((start_0 0)) + (let ((vec_1 vec_0) (len_1 len_0)) + (begin + #f + (void) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0 pos_1) + (begin + (if (if (unsafe-fx< pos_0 len_1) #t #f) + (let ((v_0 + (unsafe-vector-ref + vec_1 + pos_0))) + (begin + (vector-set! + shared_0 + pos_1 + (vector-ref + external-lifts_0 + pos_1)) + (for-loop_0 + (unsafe-fx+ 1 pos_0) + (+ pos_1 1)))) + (values))))))) + (for-loop_0 0 start_0)))))) + (args (raise-binding-result-arity-error 2 args)))) + (let ((len_0 (read-fasl-integer* init-i_0))) + (let ((i_0 + (if (mpair? init-i_0) + init-i_0 + (let ((bstr_0 + (read-bytes/exactly* len_0 init-i_0))) + (mcons bstr_0 0))))) + (let ((intern_0 + (|#%name| + intern + (lambda (v_0) + (begin + (if datum-intern?16_0 + (datum-intern-literal v_0) + v_0)))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda () + (begin + (let ((type_0 (read-byte/no-eof i_0))) + (let ((index_0 + (if (fixnum? type_0) + (if (if (unsafe-fx>= type_0 1) + (unsafe-fx< type_0 42) + #f) + (let ((tbl_0 + '#(1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 12 + 13 + 14 + 15 + 16 + 17 + 18 + 19 + 20 + 21 + 22 + 23 + 24 + 25 + 26 + 27 + 28 + 29 + 31 + 30 + 32 + 32 + 33 + 34 + 35 + 36 + 37 + 38 + 11 + 39 + 40))) + (unsafe-vector*-ref + tbl_0 + (unsafe-fx- type_0 1))) + 0) + 0))) + (if (unsafe-fx< index_0 20) + (if (unsafe-fx< index_0 9) + (if (unsafe-fx< index_0 4) + (if (unsafe-fx< index_0 1) + (if (>= type_0 100) + (+ (- type_0 100) -10) + (read-error + "unrecognized fasl tag" + "tag" + type_0)) + (if (unsafe-fx< index_0 2) + (let ((pos_0 + (|#%app| + read-fasl-integer + i_0))) + (let ((v_0 (loop_0))) + (begin + (if (< + pos_0 + shared-count_0) + (void) + (read-error + "bad graph index")) + (vector-set! + shared_0 + pos_0 + v_0) + v_0))) + (if (unsafe-fx< index_0 3) + (let ((pos_0 + (|#%app| + read-fasl-integer + i_0))) + (begin + (if (< + pos_0 + shared-count_0) + (void) + (read-error + "bad graph index")) + (vector-ref + shared_0 + pos_0))) + #f))) + (if (unsafe-fx< index_0 6) + (if (unsafe-fx< index_0 5) + #t + null) + (if (unsafe-fx< index_0 7) + (void) + (if (unsafe-fx< index_0 8) + eof + (intern_0 + (|#%app| + read-fasl-integer + i_0)))))) + (if (unsafe-fx< index_0 14) + (if (unsafe-fx< index_0 11) + (if (unsafe-fx< index_0 10) + (floating-point-bytes->real + (read-bytes/exactly 8 i_0) + #f) + (real->single-flonum + (floating-point-bytes->real + (read-bytes/exactly 4 i_0) + #f))) + (if (unsafe-fx< index_0 12) + (let ((bstr_0 + (read-bytes/exactly + (|#%app| + read-fasl-integer + i_0) + i_0))) + (let ((app_0 + 1/string->number)) + (|#%app| + app_0 + (bytes->string/utf-8 + bstr_0) + 10 + 'read))) + (if (unsafe-fx< index_0 13) + (intern_0 + (let ((app_0 (loop_0))) + (/ app_0 (loop_0)))) + (intern_0 + (let ((app_0 (loop_0))) + (make-rectangular + app_0 + (loop_0))))))) + (if (unsafe-fx< index_0 16) + (if (unsafe-fx< index_0 15) + (intern_0 + (integer->char + (|#%app| + read-fasl-integer + i_0))) + (string->symbol + (|#%app| + read-fasl-string + i_0))) + (if (unsafe-fx< index_0 17) + (string->unreadable-symbol + (|#%app| + read-fasl-string + i_0)) + (if (unsafe-fx< index_0 18) + (string->uninterned-symbol + (|#%app| + read-fasl-string + i_0)) + (if (unsafe-fx< index_0 19) + (string->keyword + (|#%app| + read-fasl-string + i_0)) + (|#%app| + read-fasl-string + i_0))))))) + (if (unsafe-fx< index_0 30) + (if (unsafe-fx< index_0 24) + (if (unsafe-fx< index_0 21) + (intern_0 + (string->immutable-string + (|#%app| + read-fasl-string + i_0))) + (if (unsafe-fx< index_0 22) + (read-fasl-bytes i_0) + (if (unsafe-fx< index_0 23) + (intern_0 + (bytes->immutable-bytes + (read-fasl-bytes i_0))) + (let ((app_0 + (read-fasl-bytes + i_0))) + (bytes->path + app_0 + (loop_0)))))) + (if (unsafe-fx< index_0 26) + (if (unsafe-fx< index_0 25) + (let ((wrt-dir_0 + (current-load-relative-directory))) + (let ((rel-elems_0 + (reverse$1 + (let ((lst_0 + (loop_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((p_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if (bytes? + p_0) + (bytes->path-element + p_0) + p_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + lst_0))))))) + (if wrt-dir_0 + (apply + build-path + wrt-dir_0 + rel-elems_0) + (if (null? rel-elems_0) + (build-path 'same) + (apply + build-path + rel-elems_0))))) + (intern_0 + (pregexp + (|#%app| + read-fasl-string + i_0)))) + (if (unsafe-fx< index_0 27) + (intern_0 + (regexp + (|#%app| + read-fasl-string + i_0))) + (if (unsafe-fx< index_0 28) + (intern_0 + (byte-pregexp + (read-fasl-bytes i_0))) + (if (unsafe-fx< index_0 29) + (intern_0 + (byte-regexp + (read-fasl-bytes i_0))) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + pos_0) + (begin + (if (< + pos_0 + len_1) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (loop_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + (+ + pos_0 + 1))) + fold-var_0)))))) + (for-loop_0 + null + 0)))))))))) + (if (unsafe-fx< index_0 35) + (if (unsafe-fx< index_0 32) + (if (unsafe-fx< index_0 31) + (let ((app_0 (loop_0))) + (cons app_0 (loop_0))) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (letrec* + ((ploop_0 + (|#%name| + ploop + (lambda (len_2) + (begin + (if (zero? len_2) + (loop_0) + (let ((app_0 + (loop_0))) + (cons + app_0 + (ploop_0 + (sub1 + len_2)))))))))) + (ploop_0 len_1)))) + (if (unsafe-fx< index_0 33) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (let ((vec_0 + (begin + (if (exact-nonnegative-integer? + len_1) + (void) + (raise-argument-error + 'for/vector + "exact-nonnegative-integer?" + len_1)) + (let ((v_0 + (make-vector + len_1 + 0))) + (begin + (if (zero? + len_1) + (void) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_1 + pos_0) + (begin + (if (< + pos_0 + len_1) + (let ((i_2 + (let ((i_2 + (begin + (unsafe-vector*-set! + v_0 + i_1 + (loop_0)) + (unsafe-fx+ + 1 + i_1)))) + (values + i_2)))) + (if (if (not + (let ((x_0 + (list + pos_0))) + (unsafe-fx= + i_2 + len_1))) + #t + #f) + (for-loop_0 + i_2 + (+ + pos_0 + 1)) + i_2)) + i_1)))))) + (for-loop_0 + 0 + 0)))) + v_0))))) + (if (eqv? type_0 32) + (vector->immutable-vector + vec_0) + vec_0))) + (if (unsafe-fx< index_0 34) + (box (loop_0)) + (box-immutable (loop_0))))) + (if (unsafe-fx< index_0 37) + (if (unsafe-fx< index_0 36) + (let ((key_0 (loop_0))) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (apply + make-prefab-struct + key_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + pos_0) + (begin + (if (< + pos_0 + len_1) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (loop_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + (+ + pos_0 + 1))) + fold-var_0)))))) + (for-loop_0 + null + 0))))))) + (let ((ht_0 + (let ((tmp_0 + (read-byte/no-eof + i_0))) + (if (eq? tmp_0 0) + (make-hasheq) + (if (eq? tmp_0 2) + (make-hasheqv) + (make-hash)))))) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (< + pos_0 + len_1) + (begin + (let ((app_0 + (loop_0))) + (hash-set! + ht_0 + app_0 + (loop_0))) + (for-loop_0 + (+ + pos_0 + 1))) + (values))))))) + (for-loop_0 0))) + (void) + ht_0)))) + (if (unsafe-fx< index_0 38) + (let ((ht_0 + (let ((tmp_0 + (read-byte/no-eof + i_0))) + (if (eq? tmp_0 0) + hash2610 + (if (eq? tmp_0 2) + hash2589 + hash2725))))) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ht_1 pos_0) + (begin + (if (< + pos_0 + len_1) + (let ((ht_2 + (let ((ht_2 + (let ((app_0 + (loop_0))) + (hash-set + ht_1 + app_0 + (loop_0))))) + (values + ht_2)))) + (for-loop_0 + ht_2 + (+ + pos_0 + 1))) + ht_1)))))) + (for-loop_0 ht_0 0))))) + (if (unsafe-fx< index_0 39) + (let ((app_0 (loop_0))) + (let ((app_1 (loop_0))) + (let ((app_2 (loop_0))) + (let ((app_3 + (loop_0))) + (unsafe-make-srcloc + app_0 + app_1 + app_2 + app_3 + (loop_0)))))) + (if (unsafe-fx< index_0 40) + (let ((e_0 (loop_0))) + (let ((s_0 (loop_0))) + (let ((c_0 + (datum->correlated$1 + e_0 + (let ((app_0 + (srcloc-source + s_0))) + (let ((app_1 + (srcloc-line + s_0))) + (let ((app_2 + (srcloc-column + s_0))) + (let ((app_3 + (srcloc-position + s_0))) + (vector + app_0 + app_1 + app_2 + app_3 + (srcloc-span + s_0))))))))) + (let ((lst_0 + (loop_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (c_1 + lst_1) + (begin + (if (pair? + lst_1) + (let ((p_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((c_2 + (let ((c_2 + (let ((k_0 + (car + p_0))) + (let ((v_0 + (cdr + p_0))) + (let ((k_1 + k_0)) + (begin-unsafe + (|#%app| + syntax-property$3 + c_1 + k_1 + v_0))))))) + (values + c_2)))) + (for-loop_0 + c_2 + rest_0)))) + c_1)))))) + (for-loop_0 + c_0 + lst_0))))))) + unsafe-undefined)))))))))))))) + (loop_0)))))))))))))))) (define write-fasl-integer (lambda (i_0 o_0) (if (<= -124 i_0 127) @@ -24724,48 +24528,30 @@ (begin (hash-set! positions_0 mpi_2 pos_0) pos_0))))))) (void))))) (define generate-module-path-index-deserialize - (letrec ((loop_0 - (|#%name| - loop - (lambda (gen-order_0 mpi_0) - (begin - (if (hash-ref gen-order_0 mpi_0 #f) - (void) - (call-with-values - (lambda () (1/module-path-index-split mpi_0)) - (case-lambda - ((name_0 base_0) - (begin - (if base_0 (loop_0 gen-order_0 base_0) (void)) - (hash-set! - gen-order_0 - mpi_0 - (hash-count gen-order_0)))) - (args (raise-binding-result-arity-error 2 args))))))))) - (unique-list_0 - (|#%name| - unique-list - (lambda (v_0) - (begin - (if (pair? v_0) - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((i_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 (cons i_0 fold-var_0))) - (let ((fold-var_2 (values fold-var_1))) - (for-loop_0 fold-var_2 rest_0))))) - fold-var_0)))))) - (for-loop_0 null v_0)))) - v_0)))))) - (lambda (mpis_0) + (lambda (mpis_0) + (let ((unique-list_0 + (|#%name| + unique-list + (lambda (v_0) + (begin + (if (pair? v_0) + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((i_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 (cons i_0 fold-var_0))) + (let ((fold-var_2 (values fold-var_1))) + (for-loop_0 fold-var_2 rest_0))))) + fold-var_0)))))) + (for-loop_0 null v_0)))) + v_0)))))) (let ((positions_0 (module-path-index-table-positions mpis_0))) (let ((gen-order_0 (make-hasheqv))) (let ((rev-positions_0 @@ -24818,7 +24604,32 @@ (if (< pos_0 end_0) (begin (let ((mpi_0 (hash-ref rev-positions_0 pos_0))) - (loop_0 gen-order_0 mpi_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (mpi_1) + (begin + (if (hash-ref gen-order_0 mpi_1 #f) + (void) + (call-with-values + (lambda () + (1/module-path-index-split mpi_1)) + (case-lambda + ((name_0 base_0) + (begin + (if base_0 + (loop_0 base_0) + (void)) + (hash-set! + gen-order_0 + mpi_1 + (hash-count gen-order_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))))))) + (loop_0 mpi_0))) (for-loop_0 (+ pos_0 1))) (values))))))) (for-loop_0 0)))) @@ -25272,1398 +25083,1505 @@ fold-var_0)))))) (for-loop_0 null phases-in-order_0))))))))) (define generate-deserialize.1 - (letrec ((finish_0 - (|#%name| - finish - (lambda (mutables_0 - shares_0 - syntax-support?2_0 - mutable-shell-bindings-expr_0 - shared-bindings-expr_0 - mutable-fills-expr_0 - result-expr_0) - (begin - (let ((app_0 (if syntax-support?2_0 inspector-id #f))) - (let ((app_1 - (if syntax-support?2_0 bulk-binding-registry-id #f))) - (let ((app_2 (list 'quote (hash-count mutables_0)))) - (list - 'deserialize - mpi-vector-id - app_0 - app_1 - app_2 - mutable-shell-bindings-expr_0 - (list 'quote (hash-count shares_0)) - shared-bindings-expr_0 - mutable-fills-expr_0 - result-expr_0)))))))) - (frontier-loop_0 - (|#%name| - frontier-loop - (lambda (add-frontier!_0 - frontier_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - v_0) - (begin - (begin - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - v_0) - (if (null? (unsafe-unbox* frontier_0)) - (void) - (let ((l_0 (unsafe-unbox* frontier_0))) - (begin - (unsafe-set-box*! frontier_0 null) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((v_1 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (frontier-loop_0 - add-frontier!_0 - frontier_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - v_1) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 l_0))) - (void))))))))) - (loop_0 - (|#%name| - loop - (lambda (add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - v_0) - (begin - (if (let ((or-part_0 (interned-literal? v_0))) - (if or-part_0 or-part_0 (1/module-path-index? v_0))) - (void) - (if (hash-ref objs_0 v_0 #f) - (if (hash-ref mutables_0 v_0 #f) - (void) - (hash-set! shares_0 v_0 #t)) - (begin - (if (serialize-fill!? v_0) - (begin - (hash-set! mutables_0 v_0 (hash-count mutables_0)) - (|#%app| - (serialize-fill!-ref v_0) - v_0 - add-frontier!_0 - state_0)) - (if (serialize? v_0) - (|#%app| - (serialize-ref v_0) - v_0 - (case-lambda - ((sub-v_0) - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - sub-v_0)) - ((kind_0 sub-v_0) - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - sub-v_0))) - state_0) - (if (pair? v_0) - (begin - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - (car v_0)) - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - (cdr v_0))) - (if (vector? v_0) - (if (let ((or-part_0 (immutable? v_0))) - (if or-part_0 - or-part_0 - (zero? (vector-length v_0)))) - (begin - (call-with-values - (lambda () - (begin - (check-vector v_0) - (values - v_0 - (unsafe-vector-length v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) + (|#%name| + generate-deserialize + (lambda (syntax-support?2_0 v4_0 mpis5_0) + (begin + (let ((reachable-scopes_0 (find-reachable-scopes v4_0))) + (let ((state_0 (make-serialize-state reachable-scopes_0))) + (let ((mutables_0 (make-hasheq))) + (let ((objs_0 (make-hasheq))) + (let ((shares_0 (make-hasheq))) + (let ((obj-step_0 0)) + (let ((frontier_0 null)) + (letrec* + ((add-frontier!_0 + (|#%name| + add-frontier! + (case-lambda + ((v_0) + (begin (set! frontier_0 (cons v_0 frontier_0)))) + ((kind_0 v_0) (add-frontier!_0 v_0)))))) + (begin + (letrec* + ((frontier-loop_0 + (|#%name| + frontier-loop + (lambda (v_0) + (begin + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_1) + (begin + (if (let ((or-part_0 + (interned-literal? v_1))) + (if or-part_0 + or-part_0 + (1/module-path-index? v_1))) + (void) + (if (hash-ref objs_0 v_1 #f) + (if (hash-ref mutables_0 v_1 #f) + (void) + (hash-set! shares_0 v_1 #t)) (begin - (if (unsafe-fx< pos_0 len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - e_0) - (for-loop_0 - (unsafe-fx+ 1 pos_0)))) - (values))))))) - (for-loop_0 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (void)) - (begin - (hash-set! - mutables_0 - v_0 - (hash-count mutables_0)) - (begin - (call-with-values - (lambda () + (if (serialize-fill!? v_1) + (begin + (hash-set! + mutables_0 + v_1 + (hash-count mutables_0)) + (|#%app| + (serialize-fill!-ref v_1) + v_1 + add-frontier!_0 + state_0)) + (if (serialize? v_1) + (|#%app| + (serialize-ref v_1) + v_1 + (case-lambda + ((sub-v_0) + (loop_0 sub-v_0)) + ((kind_0 sub-v_0) + (loop_0 sub-v_0))) + state_0) + (if (pair? v_1) + (begin + (loop_0 (car v_1)) + (loop_0 (cdr v_1))) + (if (vector? v_1) + (if (let ((or-part_0 + (immutable? + v_1))) + (if or-part_0 + or-part_0 + (zero? + (vector-length + v_1)))) + (begin + (call-with-values + (lambda () + (begin + (check-vector + v_1) + (values + v_1 + (unsafe-vector-length + v_1)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + 1 + pos_0)))) + (values))))))) + (for-loop_0 + 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (void)) + (begin + (hash-set! + mutables_0 + v_1 + (hash-count + mutables_0)) + (begin + (call-with-values + (lambda () + (begin + (check-vector + v_1) + (values + v_1 + (unsafe-vector-length + v_1)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (add-frontier!_0 + e_0) + (for-loop_0 + (unsafe-fx+ + 1 + pos_0)))) + (values))))))) + (for-loop_0 + 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (void)))) + (if (box? v_1) + (if (immutable? v_1) + (loop_0 + (unbox v_1)) + (begin + (hash-set! + mutables_0 + v_1 + (hash-count + mutables_0)) + (add-frontier!_0 + (unbox v_1)))) + (if (hash? v_1) + (if (immutable? + v_1) + (begin + (let ((lst_0 + (sorted-hash-keys + v_1))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? + lst_1) + (let ((k_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (begin + (begin + (loop_0 + k_0) + (loop_0 + (hash-ref + v_1 + k_0))) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + lst_0)))) + (void)) + (begin + (hash-set! + mutables_0 + v_1 + (hash-count + mutables_0)) + (begin + (let ((lst_0 + (sorted-hash-keys + v_1))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? + lst_1) + (let ((k_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (begin + (begin + (add-frontier!_0 + k_0) + (add-frontier!_0 + (hash-ref + v_1 + k_0))) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + lst_0)))) + (void)))) + (if (prefab-struct-key + v_1) + (begin + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + (struct->vector + v_1) + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + idx_0 + 1)))) + (values))))))) + (for-loop_0 + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (void)) + (if (srcloc? v_1) + (if (path? + (srcloc-source + v_1)) + (void) + (begin + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + (struct->vector + v_1) + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + idx_0 + 1)))) + (values))))))) + (for-loop_0 + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (void))) + (void))))))))) + (hash-set! + objs_0 + v_1 + obj-step_0) + (set! obj-step_0 + (add1 obj-step_0)))))))))) + (loop_0 v_0)) + (if (null? frontier_0) + (void) + (let ((l_0 frontier_0)) + (begin + (set! frontier_0 null) (begin - (check-vector v_0) - (values - v_0 - (unsafe-vector-length v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (pos_0) + (lambda (lst_0) (begin - (if (unsafe-fx< pos_0 len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (add-frontier!_0 e_0) - (for-loop_0 - (unsafe-fx+ - 1 - pos_0)))) + (if (pair? lst_0) + (let ((v_1 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (begin + (frontier-loop_0 v_1) + (for-loop_0 + rest_0)))) (values))))))) - (for-loop_0 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (void)))) - (if (box? v_0) - (if (immutable? v_0) - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - (unbox v_0)) - (begin - (hash-set! - mutables_0 - v_0 - (hash-count mutables_0)) - (add-frontier!_0 (unbox v_0)))) - (if (hash? v_0) - (if (immutable? v_0) - (begin - (let ((lst_0 (sorted-hash-keys v_0))) + (for-loop_0 l_0))) + (void)))))))))) + (frontier-loop_0 v4_0)) + (let ((num-mutables_0 (hash-count mutables_0))) + (let ((share-step-positions_0 + (let ((share-steps_0 + (reverse$1 (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (lst_1) + (lambda (fold-var_0 i_0) (begin - (if (pair? lst_1) - (let ((k_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (begin - (begin - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - k_0) - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - (hash-ref - v_0 - k_0))) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void)) - (begin - (hash-set! - mutables_0 - v_0 - (hash-count mutables_0)) - (begin - (let ((lst_0 (sorted-hash-keys v_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((k_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (begin - (begin - (add-frontier!_0 - k_0) - (add-frontier!_0 - (hash-ref - v_0 - k_0))) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void)))) - (if (prefab-struct-key v_0) - (begin - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - (struct->vector v_0) - 1 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (begin - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 + (if i_0 + (let ((obj_0 + (hash-iterate-key + shares_0 + i_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (hash-ref + objs_0 + obj_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + (hash-iterate-next shares_0 - state_0 - e_0) - (for-loop_0 - (unsafe-fx+ - idx_0 - 1)))) - (values))))))) - (for-loop_0 start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (void)) - (if (srcloc? v_0) - (if (path? (srcloc-source v_0)) - (void) - (begin - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - (struct->vector v_0) - 1 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (begin - (loop_0 - add-frontier!_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - e_0) - (for-loop_0 - (unsafe-fx+ - idx_0 - 1)))) - (values))))))) - (for-loop_0 start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (void))) - (void))))))))) - (hash-set! objs_0 v_0 (unsafe-unbox* obj-step_0)) - (unsafe-set-box*! - obj-step_0 - (add1 (unsafe-unbox* obj-step_0)))))))))) - (next-push-position_0 - (|#%name| - next-push-position - (lambda (stream-size_0) (begin (unsafe-unbox* stream-size_0))))) - (quoted?_0 - (|#%name| - quoted? - (lambda (stream-size_0 stream_0 pos_0) - (begin - (let ((v_0 - (let ((app_0 (unsafe-unbox* stream_0))) - (list-ref - app_0 - (let ((app_1 (unsafe-unbox* stream-size_0))) - (- app_1 (add1 pos_0))))))) - (let ((or-part_0 (not (keyword? v_0)))) - (if or-part_0 or-part_0 (eq? kw2626 v_0)))))))) - (reap-stream!_0 - (|#%name| - reap-stream! - (lambda (stream-size_0 stream_0) - (begin - (begin0 - (list->vector (reverse$1 (unsafe-unbox* stream_0))) - (unsafe-set-box*! stream_0 null) - (unsafe-set-box*! stream-size_0 0)))))) - (ser-push-encoded!_0 - (|#%name| - ser-push-encoded! - (lambda (mpis5_0 ser-push!_0 state_0 stream-size_0 stream_0 v_0) - (begin - (if (keyword? v_0) - (begin - (ser-push!_0 'tag kw2626) - (ser-push!_0 'exact v_0)) - (if (1/module-path-index? v_0) - (begin - (ser-push!_0 'tag kw3163) - (ser-push!_0 - 'exact - (add-module-path-index!/pos mpis5_0 v_0))) - (if (serialize? v_0) - (|#%app| (serialize-ref v_0) v_0 ser-push!_0 state_0) - (if (if (list? v_0) - (if (pair? v_0) (pair? (cdr v_0)) #f) - #f) - (let ((start-pos_0 - (begin-unsafe - (begin (unsafe-unbox* stream-size_0))))) - (begin - (ser-push!_0 'tag kw2802) - (begin - (ser-push!_0 'exact (length v_0)) - (let ((all-quoted?_0 - (begin - (letrec* - ((for-loop_0 + i_0)))) + fold-var_0)))))) + (for-loop_0 + null + (hash-iterate-first + shares_0))))))) + (let ((lst_0 + (sort.1 #f #f share-steps_0 <))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 lst_1 pos_0) + (begin + (if (if (pair? lst_1) #t #f) + (let ((step_0 + (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + step_0 + pos_0)) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + rest_0 + (+ pos_0 1))))) + table_0)))))) + (for-loop_0 + hash2589 + lst_0 + num-mutables_0))))))) + (let ((stream_0 null)) + (let ((stream-size_0 0)) + (let ((next-push-position_0 + (|#%name| + next-push-position + (lambda () (begin stream-size_0))))) + (let ((quoted?_0 + (|#%name| + quoted? + (lambda (pos_0) + (begin + (let ((v_0 + (let ((app_0 stream_0)) + (list-ref + app_0 + (let ((app_1 + stream-size_0)) + (- + app_1 + (add1 pos_0))))))) + (let ((or-part_0 + (not (keyword? v_0)))) + (if or-part_0 + or-part_0 + (eq? + kw2626 + v_0))))))))) + (let ((ser-reset!_0 (|#%name| - for-loop - (lambda (all-quoted?_0 lst_0) + ser-reset! + (lambda (pos_0) (begin - (if (pair? lst_0) - (let ((i_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((all-quoted?_1 - (let ((all-quoted?_1 - (let ((i-pos_0 - (begin-unsafe - (begin - (unsafe-unbox* - stream-size_0))))) + (begin + (set! stream_0 + (let ((app_0 stream_0)) + (list-tail + app_0 + (- + stream-size_0 + pos_0)))) + (set! stream-size_0 + pos_0))))))) + (let ((reap-stream!_0 + (|#%name| + reap-stream! + (lambda () + (begin + (begin0 + (list->vector + (reverse$1 stream_0)) + (set! stream_0 null) + (set! stream-size_0 + 0))))))) + (letrec* + ((ser-push!_0 + (|#%name| + ser-push! + (case-lambda + ((v_0) + (begin + (if (hash-ref shares_0 v_0 #f) + (let ((n_0 + (hash-ref + share-step-positions_0 + (hash-ref + objs_0 + v_0)))) + (begin + (ser-push!_0 + 'tag + kw2603) + (ser-push!_0 + 'exact + n_0))) + (let ((c1_0 + (hash-ref + mutables_0 + v_0 + #f))) + (if c1_0 + (begin + (ser-push!_0 + 'tag + kw2603) + (ser-push!_0 + 'exact + c1_0)) + (ser-push-encoded!_0 + v_0)))))) + ((kind_0 v_0) + (if (eq? kind_0 'exact) + (begin + (set! stream_0 + (cons v_0 stream_0)) + (set! stream-size_0 + (add1 stream-size_0))) + (if (eq? kind_0 'tag) + (ser-push!_0 'exact v_0) + (if (eq? kind_0 'reference) + (if (hash-ref + shares_0 + v_0 + #f) + (let ((n_0 + (hash-ref + share-step-positions_0 + (hash-ref + objs_0 + v_0)))) + (ser-push!_0 + 'exact + n_0)) + (let ((c2_0 + (hash-ref + mutables_0 + v_0 + #f))) + (if c2_0 + (ser-push!_0 + 'exact + c2_0) + (ser-push!_0 v_0)))) + (ser-push!_0 v_0)))))))) + (ser-push-encoded!_0 + (|#%name| + ser-push-encoded! + (lambda (v_0) + (begin + (if (keyword? v_0) + (begin + (ser-push!_0 + 'tag + kw2626) + (ser-push!_0 'exact v_0)) + (if (1/module-path-index? + v_0) + (begin + (ser-push!_0 + 'tag + kw3163) + (ser-push!_0 + 'exact + (add-module-path-index!/pos + mpis5_0 + v_0))) + (if (serialize? v_0) + (|#%app| + (serialize-ref v_0) + v_0 + ser-push!_0 + state_0) + (if (if (list? v_0) + (if (pair? v_0) + (pair? (cdr v_0)) + #f) + #f) + (let ((start-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + 'tag + kw2802) + (begin + (ser-push!_0 + 'exact + (length v_0)) + (let ((all-quoted?_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (all-quoted?_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((i_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((all-quoted?_1 + (let ((all-quoted?_1 + (let ((i-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + i_0) + (if all-quoted?_0 + (quoted?_0 + i-pos_0) + #f))))) + (values + all-quoted?_1)))) + (for-loop_0 + all-quoted?_1 + rest_0)))) + all-quoted?_0)))))) + (for-loop_0 + #t + v_0))))) + (if all-quoted?_0 + (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0)) + (void)))))) + (if (pair? v_0) + (let ((start-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + 'tag + kw2821) + (let ((a-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + (car v_0)) + (let ((d-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + (cdr + v_0)) + (if (if (quoted?_0 + a-pos_0) + (quoted?_0 + d-pos_0) + #f) + (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0)) + (void)))))))) + (if (box? v_0) + (let ((start-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + 'tag + kw2525) + (let ((v-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + (unbox + v_0)) + (if (quoted?_0 + v-pos_0) + (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0)) + (void)))))) + (if (vector? v_0) + (let ((start-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + 'tag + kw2967) + (begin + (ser-push!_0 + 'exact + (vector-length + v_0)) + (let ((all-quoted?_0 + (call-with-values + (lambda () + (begin + (check-vector + v_0) + (values + v_0 + (unsafe-vector-length + v_0)))) + (case-lambda + ((vec_0 + len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (all-quoted?_0 + pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((i_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (let ((all-quoted?_1 + (let ((all-quoted?_1 + (let ((i-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + i_0) + (if all-quoted?_0 + (quoted?_0 + i-pos_0) + #f))))) + (values + all-quoted?_1)))) + (for-loop_0 + all-quoted?_1 + (unsafe-fx+ + 1 + pos_0)))) + all-quoted?_0)))))) + (for-loop_0 + #t + 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (if all-quoted?_0 + (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0)) + (void)))))) + (if (hash? v_0) + (let ((start-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (let ((as-set?_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + i_0) + (begin + (if i_0 + (let ((val_0 + (hash-iterate-value + v_0 + i_0))) + (let ((result_1 + (eq? + val_0 + #t))) + (let ((result_2 + (values + result_1))) + (if (if (not + (let ((x_0 + (list + val_0))) + (not + result_2))) + #t + #f) + (for-loop_0 + result_2 + (hash-iterate-next + v_0 + i_0)) + result_2)))) + result_0)))))) + (for-loop_0 + #t + (hash-iterate-first + v_0)))))) + (begin + (ser-push!_0 + 'tag + (if as-set?_0 + (if (hash-eq? + v_0) + kw3357 + (if (hash-eqv? + v_0) + kw2333 + kw2473)) + (if (hash-eq? + v_0) + kw2796 + (if (hash-eqv? + v_0) + kw3245 + kw2582)))) (begin (ser-push!_0 - i_0) - (if all-quoted?_0 - (quoted?_0 - stream-size_0 - stream_0 - i-pos_0) - #f))))) - (values - all-quoted?_1)))) - (for-loop_0 - all-quoted?_1 - rest_0)))) - all-quoted?_0)))))) - (for-loop_0 #t v_0))))) - (if all-quoted?_0 - (begin - (ser-reset!_0 - stream-size_0 - stream_0 - start-pos_0) - (ser-push-optional-quote!_0) - (ser-push!_0 'exact v_0)) - (void)))))) - (if (pair? v_0) - (let ((start-pos_0 - (begin-unsafe - (begin (unsafe-unbox* stream-size_0))))) - (begin - (ser-push!_0 'tag kw2821) - (let ((a-pos_0 - (begin-unsafe - (begin (unsafe-unbox* stream-size_0))))) - (begin - (ser-push!_0 (car v_0)) - (let ((d-pos_0 - (begin-unsafe - (begin - (unsafe-unbox* stream-size_0))))) - (begin - (ser-push!_0 (cdr v_0)) - (if (if (quoted?_0 - stream-size_0 - stream_0 - a-pos_0) - (quoted?_0 - stream-size_0 - stream_0 - d-pos_0) - #f) - (begin - (ser-reset!_0 - stream-size_0 - stream_0 - start-pos_0) - (ser-push-optional-quote!_0) - (ser-push!_0 'exact v_0)) - (void)))))))) - (if (box? v_0) - (let ((start-pos_0 - (begin-unsafe - (begin (unsafe-unbox* stream-size_0))))) - (begin - (ser-push!_0 'tag kw2525) - (let ((v-pos_0 - (begin-unsafe - (begin - (unsafe-unbox* stream-size_0))))) - (begin - (ser-push!_0 (unbox v_0)) - (if (quoted?_0 - stream-size_0 - stream_0 - v-pos_0) - (begin - (ser-reset!_0 - stream-size_0 - stream_0 - start-pos_0) - (ser-push-optional-quote!_0) - (ser-push!_0 'exact v_0)) - (void)))))) - (if (vector? v_0) - (let ((start-pos_0 - (begin-unsafe - (begin (unsafe-unbox* stream-size_0))))) - (begin - (ser-push!_0 'tag kw2967) - (begin - (ser-push!_0 'exact (vector-length v_0)) - (let ((all-quoted?_0 - (call-with-values - (lambda () - (begin - (check-vector v_0) - (values - v_0 - (unsafe-vector-length v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (all-quoted?_0 - pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_0) - (let ((i_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (let ((all-quoted?_1 - (let ((all-quoted?_1 - (let ((i-pos_0 - (begin-unsafe - (begin - (unsafe-unbox* - stream-size_0))))) - (begin - (ser-push!_0 - i_0) - (if all-quoted?_0 - (quoted?_0 - stream-size_0 - stream_0 - i-pos_0) - #f))))) - (values - all-quoted?_1)))) - (for-loop_0 - all-quoted?_1 - (unsafe-fx+ - 1 - pos_0)))) - all-quoted?_0)))))) - (for-loop_0 #t 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (if all-quoted?_0 - (begin - (ser-reset!_0 - stream-size_0 - stream_0 - start-pos_0) - (ser-push-optional-quote!_0) - (ser-push!_0 'exact v_0)) - (void)))))) - (if (hash? v_0) - (let ((start-pos_0 - (begin-unsafe - (begin - (unsafe-unbox* stream-size_0))))) - (let ((as-set?_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 i_0) - (begin - (if i_0 - (let ((val_0 - (hash-iterate-value - v_0 - i_0))) - (let ((result_1 - (eq? val_0 #t))) - (let ((result_2 - (values - result_1))) - (if (if (not - (let ((x_0 - (list - val_0))) - (not - result_2))) - #t - #f) - (for-loop_0 - result_2 - (hash-iterate-next - v_0 - i_0)) - result_2)))) - result_0)))))) - (for-loop_0 - #t - (hash-iterate-first v_0)))))) - (begin - (ser-push!_0 - 'tag - (if as-set?_0 - (if (hash-eq? v_0) - kw3357 - (if (hash-eqv? v_0) - kw2333 - kw2473)) - (if (hash-eq? v_0) - kw2796 - (if (hash-eqv? v_0) - kw3245 - kw2582)))) - (begin - (ser-push!_0 'exact (hash-count v_0)) - (let ((ks_0 (sorted-hash-keys v_0))) - (let ((all-quoted?_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (all-quoted?_0 - lst_0) - (begin - (if (pair? lst_0) - (let ((k_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((all-quoted?_1 - (let ((all-quoted?_1 - (let ((k-pos_0 - (begin-unsafe + 'exact + (hash-count + v_0)) + (let ((ks_0 + (sorted-hash-keys + v_0))) + (let ((all-quoted?_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (all-quoted?_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((k_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((all-quoted?_1 + (let ((all-quoted?_1 + (let ((k-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + k_0) + (let ((v-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (if as-set?_0 + (void) + (ser-push!_0 + (hash-ref + v_0 + k_0))) + (if all-quoted?_0 + (if (quoted?_0 + k-pos_0) + (if as-set?_0 + as-set?_0 + (quoted?_0 + v-pos_0)) + #f) + #f))))))) + (values + all-quoted?_1)))) + (for-loop_0 + all-quoted?_1 + rest_0)))) + all-quoted?_0)))))) + (for-loop_0 + #t + ks_0))))) + (if all-quoted?_0 + (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0)) + (void)))))))) + (let ((c3_0 + (prefab-struct-key + v_0))) + (if c3_0 + (let ((vec_0 + (struct->vector + v_0))) + (let ((start-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + 'tag + kw2931) + (begin + (ser-push!_0 + 'exact + c3_0) + (begin + (ser-push!_0 + 'exact + (sub1 + (vector-length + vec_0))) + (let ((all-quoted?_0 + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + vec_0 + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) (begin - (unsafe-unbox* - stream-size_0))))) + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (all-quoted?_0 + idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((i_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (let ((all-quoted?_1 + (let ((all-quoted?_1 + (let ((i-pos_0 + (begin-unsafe + (begin + stream-size_0)))) + (begin + (ser-push!_0 + i_0) + (if all-quoted?_0 + (quoted?_0 + i-pos_0) + #f))))) + (values + all-quoted?_1)))) + (for-loop_0 + all-quoted?_1 + (unsafe-fx+ + idx_0 + 1)))) + all-quoted?_0)))))) + (for-loop_0 + #t + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))))) + (if all-quoted?_0 (begin + (ser-reset!_0 + start-pos_0) + (ser-push-optional-quote!_0) (ser-push!_0 - k_0) - (let ((v-pos_0 - (begin-unsafe - (begin - (unsafe-unbox* - stream-size_0))))) - (begin - (if as-set?_0 - (void) - (ser-push!_0 - (hash-ref - v_0 - k_0))) - (if all-quoted?_0 - (if (quoted?_0 - stream-size_0 - stream_0 - k-pos_0) - (if as-set?_0 - as-set?_0 - (quoted?_0 - stream-size_0 - stream_0 - v-pos_0)) - #f) - #f))))))) - (values - all-quoted?_1)))) - (for-loop_0 - all-quoted?_1 - rest_0)))) - all-quoted?_0)))))) - (for-loop_0 #t ks_0))))) - (if all-quoted?_0 - (begin - (ser-reset!_0 - stream-size_0 - stream_0 - start-pos_0) - (ser-push-optional-quote!_0) - (ser-push!_0 'exact v_0)) - (void)))))))) - (let ((c3_0 (prefab-struct-key v_0))) - (if c3_0 - (let ((vec_0 (struct->vector v_0))) - (let ((start-pos_0 - (begin-unsafe - (begin - (unsafe-unbox* - stream-size_0))))) - (begin - (ser-push!_0 'tag kw2931) - (begin - (ser-push!_0 'exact c3_0) - (begin - (ser-push!_0 - 'exact - (sub1 (vector-length vec_0))) - (let ((all-quoted?_0 - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - vec_0 - 1 - #f - 1)) - (case-lambda - ((v*_0 - start*_0 - stop*_0 - step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (all-quoted?_0 - idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((i_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (let ((all-quoted?_1 - (let ((all-quoted?_1 - (let ((i-pos_0 - (begin-unsafe - (begin - (unsafe-unbox* - stream-size_0))))) - (begin - (ser-push!_0 - i_0) - (if all-quoted?_0 - (quoted?_0 - stream-size_0 - stream_0 - i-pos_0) - #f))))) - (values - all-quoted?_1)))) - (for-loop_0 - all-quoted?_1 - (unsafe-fx+ - idx_0 - 1)))) - all-quoted?_0)))))) - (for-loop_0 - #t - start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))))) - (if all-quoted?_0 - (begin - (ser-reset!_0 - stream-size_0 - stream_0 - start-pos_0) - (ser-push-optional-quote!_0) - (ser-push!_0 'exact v_0)) - (void)))))))) - (if (srcloc? v_0) - (if (path? (srcloc-source v_0)) - (begin - (ser-push-optional-quote!_0) - (ser-push!_0 'exact v_0)) - (begin - (ser-push!_0 'tag kw2496) - (ser-push!_0 (srcloc-source v_0)) - (ser-push!_0 (srcloc-line v_0)) - (ser-push!_0 (srcloc-column v_0)) - (ser-push!_0 (srcloc-position v_0)) - (ser-push!_0 (srcloc-span v_0)))) - (begin - (ser-push-optional-quote!_0) - (ser-push!_0 - 'exact - v_0))))))))))))))))) - (ser-push-optional-quote!_0 - (|#%name| ser-push-optional-quote! (lambda () (begin (void))))) - (ser-reset!_0 - (|#%name| - ser-reset! - (lambda (stream-size_0 stream_0 pos_0) - (begin - (begin - (unsafe-set-box*! - stream_0 - (let ((app_0 (unsafe-unbox* stream_0))) - (list-tail - app_0 - (- (unsafe-unbox* stream-size_0) pos_0)))) - (unsafe-set-box*! stream-size_0 pos_0)))))) - (ser-shell!_0 - (|#%name| - ser-shell! - (lambda (ser-push!_0 state_0 v_0) - (begin - (if (serialize-fill!? v_0) - (|#%app| (serialize-ref v_0) v_0 ser-push!_0 state_0) - (if (box? v_0) - (ser-push!_0 'tag kw2525) - (if (vector? v_0) - (begin - (ser-push!_0 'tag kw2967) - (ser-push!_0 'exact (vector-length v_0))) - (if (hash? v_0) - (ser-push!_0 - 'tag - (if (hash-eq? v_0) - kw2796 - (if (hash-eqv? v_0) kw3245 kw2582))) - (error 'ser-shell "unknown mutable: ~e" v_0))))))))) - (ser-shell-fill!_0 - (|#%name| - ser-shell-fill! - (lambda (ser-push!_0 state_0 v_0) - (begin - (if (serialize-fill!? v_0) - (|#%app| (serialize-fill!-ref v_0) v_0 ser-push!_0 state_0) - (if (box? v_0) - (begin - (ser-push!_0 'tag kw2531) - (ser-push!_0 (unbox v_0))) - (if (vector? v_0) - (begin - (ser-push!_0 'tag kw3046) - (ser-push!_0 'exact (vector-length v_0)) - (call-with-values - (lambda () - (begin - (check-vector v_0) - (values v_0 (unsafe-vector-length v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (unsafe-fx< pos_0 len_0) - (let ((v_1 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (ser-push!_0 v_1) - (for-loop_0 (unsafe-fx+ 1 pos_0)))) - (values))))))) - (for-loop_0 0)))) - (args (raise-binding-result-arity-error 2 args)))) - (void)) - (if (hash? v_0) - (begin - (ser-push!_0 'tag kw2194) - (begin - (ser-push!_0 'exact (hash-count v_0)) - (let ((ks_0 (sorted-hash-keys v_0))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((k_0 (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (begin - (begin - (ser-push!_0 k_0) - (ser-push!_0 - (hash-ref v_0 k_0))) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 ks_0))) - (void))))) - (error - 'ser-shell-fill - "unknown mutable: ~e" - v_0)))))))))) - (|#%name| - generate-deserialize - (lambda (syntax-support?2_0 v4_0 mpis5_0) - (begin - (let ((reachable-scopes_0 (find-reachable-scopes v4_0))) - (let ((state_0 (make-serialize-state reachable-scopes_0))) - (let ((mutables_0 (make-hasheq))) - (let ((objs_0 (make-hasheq))) - (let ((shares_0 (make-hasheq))) - (let ((obj-step_0 (box 0))) - (let ((frontier_0 (box null))) - (letrec* - ((add-frontier!_0 - (|#%name| - add-frontier! - (case-lambda - ((v_0) - (begin - (unsafe-set-box*! - frontier_0 - (cons v_0 (unsafe-unbox* frontier_0))))) - ((kind_0 v_0) (add-frontier!_0 v_0)))))) - (begin - (frontier-loop_0 - add-frontier!_0 - frontier_0 - mutables_0 - obj-step_0 - objs_0 - shares_0 - state_0 - v4_0) - (let ((num-mutables_0 (hash-count mutables_0))) - (let ((share-step-positions_0 - (let ((share-steps_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 + 'exact + v_0)) + (void)))))))) + (if (srcloc? + v_0) + (if (path? + (srcloc-source + v_0)) + (begin + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0)) + (begin + (ser-push!_0 + 'tag + kw2496) + (ser-push!_0 + (srcloc-source + v_0)) + (ser-push!_0 + (srcloc-line + v_0)) + (ser-push!_0 + (srcloc-column + v_0)) + (ser-push!_0 + (srcloc-position + v_0)) + (ser-push!_0 + (srcloc-span + v_0)))) + (begin + (ser-push-optional-quote!_0) + (ser-push!_0 + 'exact + v_0))))))))))))))))) + (ser-push-optional-quote!_0 + (|#%name| + ser-push-optional-quote! + (lambda () (begin (void)))))) + (let ((ser-shell!_0 (|#%name| - for-loop - (lambda (fold-var_0 i_0) + ser-shell! + (lambda (v_0) (begin - (if i_0 - (let ((obj_0 - (hash-iterate-key - shares_0 - i_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (hash-ref - objs_0 - obj_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - (hash-iterate-next - shares_0 - i_0)))) - fold-var_0)))))) - (for-loop_0 - null - (hash-iterate-first - shares_0))))))) - (let ((lst_0 - (sort.1 #f #f share-steps_0 <))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 lst_1 pos_0) - (begin - (if (if (pair? lst_1) #t #f) - (let ((step_0 - (unsafe-car lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - step_0 - pos_0)) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - rest_0 - (+ pos_0 1))))) - table_0)))))) - (for-loop_0 - hash2589 - lst_0 - num-mutables_0))))))) - (let ((stream_0 (box null))) - (let ((stream-size_0 (box 0))) - (letrec* - ((ser-push!_0 - (|#%name| - ser-push! - (case-lambda - ((v_0) - (begin - (if (hash-ref shares_0 v_0 #f) - (let ((n_0 - (hash-ref - share-step-positions_0 - (hash-ref objs_0 v_0)))) - (begin - (ser-push!_0 'tag kw2603) - (ser-push!_0 'exact n_0))) - (let ((c1_0 - (hash-ref - mutables_0 - v_0 - #f))) - (if c1_0 - (begin - (ser-push!_0 'tag kw2603) - (ser-push!_0 'exact c1_0)) - (ser-push-encoded!_0 - mpis5_0 - ser-push!_0 - state_0 - stream-size_0 - stream_0 - v_0)))))) - ((kind_0 v_0) - (if (eq? kind_0 'exact) - (begin - (unsafe-set-box*! - stream_0 - (cons - v_0 - (unsafe-unbox* stream_0))) - (unsafe-set-box*! - stream-size_0 - (add1 - (unsafe-unbox* stream-size_0)))) - (if (eq? kind_0 'tag) - (ser-push!_0 'exact v_0) - (if (eq? kind_0 'reference) - (if (hash-ref shares_0 v_0 #f) - (let ((n_0 - (hash-ref - share-step-positions_0 - (hash-ref - objs_0 - v_0)))) - (ser-push!_0 'exact n_0)) - (let ((c2_0 - (hash-ref - mutables_0 + (if (serialize-fill!? v_0) + (|#%app| + (serialize-ref v_0) v_0 - #f))) - (if c2_0 - (ser-push!_0 'exact c2_0) - (ser-push!_0 v_0)))) - (ser-push!_0 v_0))))))))) - (let ((rev-mutables_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - mutables_0 - i_0)) - (case-lambda - ((k_0 v_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - v_0 - k_0)) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - mutables_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2589 - (hash-iterate-first - mutables_0)))))) - (let ((mutable-shell-bindings_0 - (begin - (begin - (let ((end_0 - (hash-count - mutables_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (< pos_0 end_0) - (begin - (ser-shell!_0 - ser-push!_0 - state_0 - (hash-ref - rev-mutables_0 - pos_0)) - (for-loop_0 - (+ pos_0 1))) - (values))))))) - (for-loop_0 0)))) - (void)) - (reap-stream!_0 - stream-size_0 - stream_0)))) - (let ((rev-shares_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (let ((obj_0 - (hash-iterate-key - shares_0 - i_0))) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - (hash-ref - share-step-positions_0 - (hash-ref - objs_0 - obj_0)) - obj_0)) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - shares_0 - i_0)))) - table_0)))))) - (for-loop_0 - hash2589 - (hash-iterate-first - shares_0)))))) - (let ((shared-bindings_0 - (begin - (begin - (let ((end_0 - (+ - num-mutables_0 - (hash-count - shares_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (< - pos_0 - end_0) + ser-push!_0 + state_0) + (if (box? v_0) + (ser-push!_0 + 'tag + kw2525) + (if (vector? v_0) + (begin + (ser-push!_0 + 'tag + kw2967) + (ser-push!_0 + 'exact + (vector-length + v_0))) + (if (hash? v_0) + (ser-push!_0 + 'tag + (if (hash-eq? + v_0) + kw2796 + (if (hash-eqv? + v_0) + kw3245 + kw2582))) + (error + 'ser-shell + "unknown mutable: ~e" + v_0)))))))))) + (let ((ser-shell-fill!_0 + (|#%name| + ser-shell-fill! + (lambda (v_0) + (begin + (if (serialize-fill!? + v_0) + (|#%app| + (serialize-fill!-ref + v_0) + v_0 + ser-push!_0 + state_0) + (if (box? v_0) + (begin + (ser-push!_0 + 'tag + kw2531) + (ser-push!_0 + (unbox v_0))) + (if (vector? v_0) + (begin + (ser-push!_0 + 'tag + kw3046) + (ser-push!_0 + 'exact + (vector-length + v_0)) + (call-with-values + (lambda () (begin - (ser-push-encoded!_0 - mpis5_0 - ser-push!_0 - state_0 - stream-size_0 - stream_0 - (hash-ref - rev-shares_0 - pos_0)) - (for-loop_0 - (+ - pos_0 - 1))) - (values))))))) - (for-loop_0 - num-mutables_0)))) - (void)) - (reap-stream!_0 - stream-size_0 - stream_0)))) - (let ((mutable-fills_0 - (begin + (check-vector + v_0) + (values + v_0 + (unsafe-vector-length + v_0)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((v_1 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (ser-push!_0 + v_1) + (for-loop_0 + (unsafe-fx+ + 1 + pos_0)))) + (values))))))) + (for-loop_0 + 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (void)) + (if (hash? v_0) + (begin + (ser-push!_0 + 'tag + kw2194) + (begin + (ser-push!_0 + 'exact + (hash-count + v_0)) + (let ((ks_0 + (sorted-hash-keys + v_0))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? + lst_0) + (let ((k_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (begin + (begin + (ser-push!_0 + k_0) + (ser-push!_0 + (hash-ref + v_0 + k_0))) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + ks_0))) + (void))))) + (error + 'ser-shell-fill + "unknown mutable: ~e" + v_0)))))))))) + (let ((rev-mutables_0 (begin - (let ((end_0 - (hash-count - mutables_0))) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + mutables_0 + i_0)) + (case-lambda + ((k_0 v_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + v_0 + k_0)) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + mutables_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2589 + (hash-iterate-first + mutables_0)))))) + (let ((mutable-shell-bindings_0 + (begin + (begin + (let ((end_0 + (hash-count + mutables_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (< + pos_0 + end_0) + (begin + (ser-shell!_0 + (hash-ref + rev-mutables_0 + pos_0)) + (for-loop_0 + (+ + pos_0 + 1))) + (values))))))) + (for-loop_0 + 0)))) + (void)) + (reap-stream!_0)))) + (let ((rev-shares_0 (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (pos_0) + (lambda (table_0 + i_0) (begin - (if (< - pos_0 - end_0) - (begin - (ser-shell-fill!_0 - ser-push!_0 - state_0 - (hash-ref - rev-mutables_0 - pos_0)) - (for-loop_0 - (+ - pos_0 - 1))) - (values))))))) - (for-loop_0 0)))) - (void)) - (reap-stream!_0 - stream-size_0 - stream_0)))) - (let ((result_0 - (begin - (ser-push!_0 v4_0) - (reap-stream!_0 - stream-size_0 - stream_0)))) - (list - 'let-values - (list - (list - '(data) - (list - 'quote - (vector - mutable-shell-bindings_0 - shared-bindings_0 - mutable-fills_0 - result_0)))) - (finish_0 - mutables_0 - shares_0 - syntax-support?2_0 - '(unsafe-vector*-ref data 0) - '(unsafe-vector*-ref data 1) - '(unsafe-vector*-ref data 2) - '(unsafe-vector*-ref - data - 3)))))))))))))))))))))))))))) + (if i_0 + (let ((obj_0 + (hash-iterate-key + shares_0 + i_0))) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + (hash-ref + share-step-positions_0 + (hash-ref + objs_0 + obj_0)) + obj_0)) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + shares_0 + i_0)))) + table_0)))))) + (for-loop_0 + hash2589 + (hash-iterate-first + shares_0)))))) + (let ((shared-bindings_0 + (begin + (begin + (let ((end_0 + (+ + num-mutables_0 + (hash-count + shares_0)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (< + pos_0 + end_0) + (begin + (ser-push-encoded!_0 + (hash-ref + rev-shares_0 + pos_0)) + (for-loop_0 + (+ + pos_0 + 1))) + (values))))))) + (for-loop_0 + num-mutables_0)))) + (void)) + (reap-stream!_0)))) + (let ((mutable-fills_0 + (begin + (begin + (let ((end_0 + (hash-count + mutables_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (< + pos_0 + end_0) + (begin + (ser-shell-fill!_0 + (hash-ref + rev-mutables_0 + pos_0)) + (for-loop_0 + (+ + pos_0 + 1))) + (values))))))) + (for-loop_0 + 0)))) + (void)) + (reap-stream!_0)))) + (let ((result_0 + (begin + (ser-push!_0 + v4_0) + (reap-stream!_0)))) + (let ((finish_0 + (|#%name| + finish + (lambda (mutable-shell-bindings-expr_0 + shared-bindings-expr_0 + mutable-fills-expr_0 + result-expr_0) + (begin + (let ((app_0 + (if syntax-support?2_0 + inspector-id + #f))) + (let ((app_1 + (if syntax-support?2_0 + bulk-binding-registry-id + #f))) + (let ((app_2 + (list + 'quote + (hash-count + mutables_0)))) + (list + 'deserialize + mpi-vector-id + app_0 + app_1 + app_2 + mutable-shell-bindings-expr_0 + (list + 'quote + (hash-count + shares_0)) + shared-bindings-expr_0 + mutable-fills-expr_0 + result-expr_0))))))))) + (list + 'let-values + (list + (list + '(data) + (list + 'quote + (vector + mutable-shell-bindings_0 + shared-bindings_0 + mutable-fills_0 + result_0)))) + (finish_0 + '(unsafe-vector*-ref + data + 0) + '(unsafe-vector*-ref + data + 1) + '(unsafe-vector*-ref + data + 2) + '(unsafe-vector*-ref + data + 3)))))))))))))))))))))))))))))))))) (define sorted-hash-keys (lambda (ht_0) (let ((ks_0 (hash-keys ht_0))) @@ -26834,141 +26752,215 @@ bulk-binding-registry_0 shared_0))))))))) (define decode - (letrec ((procz1 (lambda () 0))) - (lambda (vec_0 pos_0 mpis_0 inspector_0 bulk-binding-registry_0 shared_0) - (let ((tmp_0 (unsafe-vector*-ref vec_0 pos_0))) - (let ((index_0 - (if (keyword? tmp_0) (hash-ref hash2936 tmp_0 procz1) 0))) - (if (unsafe-fx< index_0 14) - (if (unsafe-fx< index_0 6) - (if (unsafe-fx< index_0 2) - (if (unsafe-fx< index_0 1) - (let ((app_0 (unsafe-vector*-ref vec_0 pos_0))) - (values app_0 (add1 pos_0))) - (let ((app_0 - (unsafe-vector*-ref - shared_0 - (unsafe-vector*-ref vec_0 (add1 pos_0))))) - (values app_0 (+ pos_0 2)))) - (if (unsafe-fx< index_0 3) - (values inspector_0 (add1 pos_0)) - (if (unsafe-fx< index_0 4) - (values bulk-binding-registry_0 (add1 pos_0)) - (if (unsafe-fx< index_0 5) + (lambda (vec_0 pos_0 mpis_0 inspector_0 bulk-binding-registry_0 shared_0) + (let ((tmp_0 (unsafe-vector*-ref vec_0 pos_0))) + (let ((index_0 + (if (keyword? tmp_0) + (hash-ref hash2936 tmp_0 (lambda () 0)) + 0))) + (if (unsafe-fx< index_0 14) + (if (unsafe-fx< index_0 6) + (if (unsafe-fx< index_0 2) + (if (unsafe-fx< index_0 1) + (let ((app_0 (unsafe-vector*-ref vec_0 pos_0))) + (values app_0 (add1 pos_0))) + (let ((app_0 + (unsafe-vector*-ref + shared_0 + (unsafe-vector*-ref vec_0 (add1 pos_0))))) + (values app_0 (+ pos_0 2)))) + (if (unsafe-fx< index_0 3) + (values inspector_0 (add1 pos_0)) + (if (unsafe-fx< index_0 4) + (values bulk-binding-registry_0 (add1 pos_0)) + (if (unsafe-fx< index_0 5) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((content_0 next-pos_0) + (call-with-values + (lambda () + (let ((i_0 (unsafe-vector*-ref vec_0 next-pos_0))) + (if (exact-integer? i_0) + (let ((app_0 (unsafe-vector*-ref shared_0 i_0))) + (values app_0 (add1 next-pos_0))) + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)))) + (case-lambda + ((context_0 next-pos_1) + (call-with-values + (lambda () + (let ((i_0 (unsafe-vector*-ref vec_0 next-pos_1))) + (if (exact-integer? i_0) + (let ((app_0 + (unsafe-vector*-ref shared_0 i_0))) + (values app_0 (add1 next-pos_1))) + (decode + vec_0 + next-pos_1 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)))) + (case-lambda + ((srcloc_0 next-pos_2) + (values + (deserialize-syntax + content_0 + context_0 + srcloc_0 + #f + #f + inspector_0) + next-pos_2)) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((content_0 next-pos_0) + (call-with-values + (lambda () + (let ((i_0 (unsafe-vector*-ref vec_0 next-pos_0))) + (if (exact-integer? i_0) + (let ((app_0 (unsafe-vector*-ref shared_0 i_0))) + (values app_0 (add1 next-pos_0))) + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)))) + (case-lambda + ((context_0 next-pos_1) + (call-with-values + (lambda () + (let ((i_0 (unsafe-vector*-ref vec_0 next-pos_1))) + (if (exact-integer? i_0) + (let ((app_0 + (unsafe-vector*-ref shared_0 i_0))) + (values app_0 (add1 next-pos_1))) + (decode + vec_0 + next-pos_1 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)))) + (case-lambda + ((srcloc_0 next-pos_2) + (values + (deserialize-datum->syntax + content_0 + context_0 + srcloc_0 + inspector_0) + next-pos_2)) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))))))) + (if (unsafe-fx< index_0 9) + (if (unsafe-fx< index_0 7) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((content_0 next-pos_0) + (call-with-values + (lambda () + (let ((i_0 (unsafe-vector*-ref vec_0 next-pos_0))) + (if (exact-integer? i_0) + (let ((app_0 (unsafe-vector*-ref shared_0 i_0))) + (values app_0 (add1 next-pos_0))) + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)))) + (case-lambda + ((context_0 next-pos_1) (call-with-values (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) + (let ((i_0 (unsafe-vector*-ref vec_0 next-pos_1))) + (if (exact-integer? i_0) + (let ((app_0 (unsafe-vector*-ref shared_0 i_0))) + (values app_0 (add1 next-pos_1))) + (decode + vec_0 + next-pos_1 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)))) (case-lambda - ((content_0 next-pos_0) + ((srcloc_0 next-pos_2) (call-with-values (lambda () - (let ((i_0 (unsafe-vector*-ref vec_0 next-pos_0))) - (if (exact-integer? i_0) - (let ((app_0 - (unsafe-vector*-ref shared_0 i_0))) - (values app_0 (add1 next-pos_0))) - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)))) + (decode + vec_0 + next-pos_2 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) (case-lambda - ((context_0 next-pos_1) + ((props_0 next-pos_3) (call-with-values (lambda () - (let ((i_0 - (unsafe-vector*-ref vec_0 next-pos_1))) - (if (exact-integer? i_0) - (let ((app_0 - (unsafe-vector*-ref shared_0 i_0))) - (values app_0 (add1 next-pos_1))) - (decode - vec_0 - next-pos_1 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)))) + (decode + vec_0 + next-pos_3 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) (case-lambda - ((srcloc_0 next-pos_2) + ((tamper_0 next-pos_4) (values (deserialize-syntax content_0 context_0 srcloc_0 - #f - #f + props_0 + tamper_0 inspector_0) - next-pos_2)) + next-pos_4)) (args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((content_0 next-pos_0) - (call-with-values - (lambda () - (let ((i_0 (unsafe-vector*-ref vec_0 next-pos_0))) - (if (exact-integer? i_0) - (let ((app_0 - (unsafe-vector*-ref shared_0 i_0))) - (values app_0 (add1 next-pos_0))) - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)))) - (case-lambda - ((context_0 next-pos_1) - (call-with-values - (lambda () - (let ((i_0 - (unsafe-vector*-ref vec_0 next-pos_1))) - (if (exact-integer? i_0) - (let ((app_0 - (unsafe-vector*-ref shared_0 i_0))) - (values app_0 (add1 next-pos_1))) - (decode - vec_0 - next-pos_1 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)))) - (case-lambda - ((srcloc_0 next-pos_2) - (values - (deserialize-datum->syntax - content_0 - context_0 - srcloc_0 - inspector_0) - next-pos_2)) - (args - (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))))))) - (if (unsafe-fx< index_0 9) - (if (unsafe-fx< index_0 7) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))) + (if (unsafe-fx< index_0 8) (call-with-values (lambda () (decode @@ -26979,37 +26971,29 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((content_0 next-pos_0) + ((source_0 next-pos_0) (call-with-values (lambda () - (let ((i_0 (unsafe-vector*-ref vec_0 next-pos_0))) - (if (exact-integer? i_0) - (let ((app_0 (unsafe-vector*-ref shared_0 i_0))) - (values app_0 (add1 next-pos_0))) - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)))) + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) (case-lambda - ((context_0 next-pos_1) + ((line_0 next-pos_1) (call-with-values (lambda () - (let ((i_0 (unsafe-vector*-ref vec_0 next-pos_1))) - (if (exact-integer? i_0) - (let ((app_0 (unsafe-vector*-ref shared_0 i_0))) - (values app_0 (add1 next-pos_1))) - (decode - vec_0 - next-pos_1 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)))) + (decode + vec_0 + next-pos_1 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) (case-lambda - ((srcloc_0 next-pos_2) + ((column_0 next-pos_2) (call-with-values (lambda () (decode @@ -27020,7 +27004,7 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((props_0 next-pos_3) + ((position_0 next-pos_3) (call-with-values (lambda () (decode @@ -27031,15 +27015,14 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((tamper_0 next-pos_4) + ((span_0 next-pos_4) (values - (deserialize-syntax - content_0 - context_0 - srcloc_0 - props_0 - tamper_0 - inspector_0) + (unsafe-make-srcloc + source_0 + line_0 + column_0 + position_0 + span_0) next-pos_4)) (args (raise-binding-result-arity-error 2 args))))) @@ -27048,200 +27031,261 @@ (args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 2 args)))) - (if (unsafe-fx< index_0 8) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((source_0 next-pos_0) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((line_0 next-pos_1) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_1 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((column_0 next-pos_2) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_2 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((position_0 next-pos_3) + (let ((app_0 (unsafe-vector*-ref vec_0 (add1 pos_0)))) + (values app_0 (+ pos_0 2))))) + (if (unsafe-fx< index_0 11) + (if (unsafe-fx< index_0 10) + (let ((app_0 + (unsafe-vector*-ref + mpis_0 + (unsafe-vector*-ref vec_0 (add1 pos_0))))) + (values app_0 (+ pos_0 2))) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((v_0 next-pos_0) (values (box-immutable v_0) next-pos_0)) + (args (raise-binding-result-arity-error 2 args))))) + (if (unsafe-fx< index_0 12) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((a_0 next-pos_0) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((d_0 next-pos_1) (values (cons a_0 d_0) next-pos_1)) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))) + (if (unsafe-fx< index_0 13) + (let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0)))) + (let ((r_0 (make-vector len_0))) + (let ((next-pos_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_1 pos_2) + (begin + (if (< pos_2 len_0) + (let ((pos_3 + (let ((pos_3 + (call-with-values + (lambda () + (call-with-values + (lambda () + (decode + vec_0 + pos_1 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((v_0 next-pos_0) + (values + v_0 + next-pos_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((v_0 next-pos_0) + (begin + (vector-set! + r_0 + pos_2 + v_0) + next-pos_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values pos_3)))) + (for-loop_0 pos_3 (+ pos_2 1))) + pos_1)))))) + (for-loop_0 (+ pos_0 2) 0))))) + (values + (if (eq? + (unsafe-vector*-ref vec_0 pos_0) + kw2802) + (vector->list r_0) + (vector->immutable-vector r_0)) + next-pos_0)))) + (let ((ht_0 + (let ((tmp_1 (unsafe-vector*-ref vec_0 pos_0))) + (if (eq? tmp_1 kw2582) + (hash) + (if (eq? tmp_1 kw2796) + (hasheq) + (if (eq? tmp_1 kw3245) + (hasheqv) + (void))))))) + (let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ht_1 pos_1 pos_2) + (begin + (if (< pos_2 len_0) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (decode + vec_0 + pos_1 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((k_0 next-pos_0) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((v_0 next-pos_1) + (values + (hash-set ht_1 k_0 v_0) + next-pos_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ht_2 pos_3) (values ht_2 pos_3)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ht_2 pos_3) + (for-loop_0 ht_2 pos_3 (+ pos_2 1))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values ht_1 pos_1))))))) + (for-loop_0 ht_0 (+ pos_0 2) 0)))))))))) + (if (unsafe-fx< index_0 21) + (if (unsafe-fx< index_0 17) + (if (unsafe-fx< index_0 15) + (let ((s_0 + (let ((tmp_1 (unsafe-vector*-ref vec_0 pos_0))) + (if (eq? tmp_1 kw2473) + (set) + (if (eq? tmp_1 kw3357) + (seteq) + (if (eq? tmp_1 kw2333) + (begin-unsafe the-empty-hasheqv) + (void))))))) + (let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (s_1 pos_1 pos_2) + (begin + (if (< pos_2 len_0) (call-with-values (lambda () - (decode - vec_0 - next-pos_3 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (decode + vec_0 + pos_1 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((k_0 next-pos_0) + (values + (begin-unsafe (hash-set s_1 k_0 #t)) + next-pos_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((s_2 pos_3) (values s_2 pos_3)) + (args + (raise-binding-result-arity-error + 2 + args))))) (case-lambda - ((span_0 next-pos_4) - (values - (unsafe-make-srcloc - source_0 - line_0 - column_0 - position_0 - span_0) - next-pos_4)) + ((s_2 pos_3) + (for-loop_0 s_2 pos_3 (+ pos_2 1))) (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (let ((app_0 (unsafe-vector*-ref vec_0 (add1 pos_0)))) - (values app_0 (+ pos_0 2))))) - (if (unsafe-fx< index_0 11) - (if (unsafe-fx< index_0 10) - (let ((app_0 - (unsafe-vector*-ref - mpis_0 - (unsafe-vector*-ref vec_0 (add1 pos_0))))) - (values app_0 (+ pos_0 2))) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((v_0 next-pos_0) - (values (box-immutable v_0) next-pos_0)) - (args (raise-binding-result-arity-error 2 args))))) - (if (unsafe-fx< index_0 12) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((a_0 next-pos_0) + (raise-binding-result-arity-error 2 args)))) + (values s_1 pos_1))))))) + (for-loop_0 s_0 (+ pos_0 2) 0))))) + (if (unsafe-fx< index_0 16) + (call-with-values + (lambda () + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((k_0 next-pos_0) (values k_0 next-pos_0)) + (args (raise-binding-result-arity-error 2 args))))) + (case-lambda + ((key_0 next-pos_0) + (let ((len_0 (unsafe-vector*-ref vec_0 next-pos_0))) (call-with-values (lambda () - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((d_0 next-pos_1) (values (cons a_0 d_0) next-pos_1)) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (if (unsafe-fx< index_0 13) - (let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0)))) - (let ((r_0 (make-vector len_0))) - (let ((next-pos_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_1 pos_2) - (begin - (if (< pos_2 len_0) - (let ((pos_3 - (let ((pos_3 - (call-with-values - (lambda () - (call-with-values - (lambda () - (decode - vec_0 - pos_1 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((v_0 - next-pos_0) - (values - v_0 - next-pos_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((v_0 next-pos_0) - (begin - (vector-set! - r_0 - pos_2 - v_0) - next-pos_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values pos_3)))) - (for-loop_0 pos_3 (+ pos_2 1))) - pos_1)))))) - (for-loop_0 (+ pos_0 2) 0))))) - (values - (if (eq? - (unsafe-vector*-ref vec_0 pos_0) - kw2802) - (vector->list r_0) - (vector->immutable-vector r_0)) - next-pos_0)))) - (let ((ht_0 - (let ((tmp_1 (unsafe-vector*-ref vec_0 pos_0))) - (if (eq? tmp_1 kw2582) - (hash) - (if (eq? tmp_1 kw2796) - (hasheq) - (if (eq? tmp_1 kw3245) - (hasheqv) - (void))))))) - (let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0)))) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (ht_1 pos_1 pos_2) + (lambda (r_0 pos_1 pos_2) (begin (if (< pos_2 len_0) (call-with-values @@ -27258,179 +27302,188 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((k_0 next-pos_0) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((v_0 next-pos_1) - (values - (hash-set ht_1 k_0 v_0) - next-pos_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) + ((v_0 next-pos_1) + (values + (cons v_0 r_0) + next-pos_1)) (args (raise-binding-result-arity-error 2 args))))) (case-lambda - ((ht_2 pos_3) (values ht_2 pos_3)) + ((r_1 pos_3) (values r_1 pos_3)) (args (raise-binding-result-arity-error 2 args))))) (case-lambda - ((ht_2 pos_3) - (for-loop_0 ht_2 pos_3 (+ pos_2 1))) + ((r_1 pos_3) + (for-loop_0 r_1 pos_3 (+ pos_2 1))) (args (raise-binding-result-arity-error 2 args)))) - (values ht_1 pos_1))))))) - (for-loop_0 ht_0 (+ pos_0 2) 0)))))))))) - (if (unsafe-fx< index_0 21) - (if (unsafe-fx< index_0 17) - (if (unsafe-fx< index_0 15) - (let ((s_0 - (let ((tmp_1 (unsafe-vector*-ref vec_0 pos_0))) - (if (eq? tmp_1 kw2473) - (set) - (if (eq? tmp_1 kw3357) - (seteq) - (if (eq? tmp_1 kw2333) - (begin-unsafe the-empty-hasheqv) - (void))))))) - (let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (s_1 pos_1 pos_2) - (begin - (if (< pos_2 len_0) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (decode - vec_0 - pos_1 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((k_0 next-pos_0) - (values - (begin-unsafe - (hash-set s_1 k_0 #t)) - next-pos_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((s_2 pos_3) (values s_2 pos_3)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((s_2 pos_3) - (for-loop_0 s_2 pos_3 (+ pos_2 1))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values s_1 pos_1))))))) - (for-loop_0 s_0 (+ pos_0 2) 0))))) - (if (unsafe-fx< index_0 16) + (values r_0 pos_1))))))) + (for-loop_0 null (add1 next-pos_0) 0)))) + (case-lambda + ((r_0 done-pos_0) + (values + (apply make-prefab-struct key_0 (reverse$1 r_0)) + done-pos_0)) + (args (raise-binding-result-arity-error 2 args)))))) + (args (raise-binding-result-arity-error 2 args)))) + (values (begin-unsafe top-level-common-scope) (add1 pos_0)))) + (if (unsafe-fx< index_0 18) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((kind_0 next-pos_0) + (values + (begin-unsafe + (scope1.1 + (new-deserialize-scope-id!) + kind_0 + empty-binding-table)) + next-pos_0)) + (args (raise-binding-result-arity-error 2 args)))) + (if (unsafe-fx< index_0 19) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((id_0 next-pos_0) + (values (make-interned-scope id_0) next-pos_0)) + (args (raise-binding-result-arity-error 2 args)))) + (if (unsafe-fx< index_0 20) (call-with-values (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((name_0 next-pos_0) (call-with-values (lambda () (decode vec_0 - (add1 pos_0) + next-pos_0 mpis_0 inspector_0 bulk-binding-registry_0 shared_0)) (case-lambda - ((k_0 next-pos_0) (values k_0 next-pos_0)) + ((scopes_0 next-pos_1) + (values + (deserialize-multi-scope name_0 scopes_0) + next-pos_1)) (args (raise-binding-result-arity-error 2 args))))) - (case-lambda - ((key_0 next-pos_0) - (let ((len_0 (unsafe-vector*-ref vec_0 next-pos_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (r_0 pos_1 pos_2) - (begin - (if (< pos_2 len_0) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (decode - vec_0 - pos_1 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((v_0 next-pos_1) - (values - (cons v_0 r_0) - next-pos_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((r_1 pos_3) (values r_1 pos_3)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((r_1 pos_3) - (for-loop_0 r_1 pos_3 (+ pos_2 1))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values r_0 pos_1))))))) - (for-loop_0 null (add1 next-pos_0) 0)))) - (case-lambda - ((r_0 done-pos_0) - (values - (apply make-prefab-struct key_0 (reverse$1 r_0)) - done-pos_0)) - (args (raise-binding-result-arity-error 2 args)))))) (args (raise-binding-result-arity-error 2 args)))) - (values - (begin-unsafe top-level-common-scope) - (add1 pos_0)))) - (if (unsafe-fx< index_0 18) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((phase_0 next-pos_0) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((multi-scope_0 next-pos_1) + (values + (begin-unsafe + (intern-shifted-multi-scope phase_0 multi-scope_0)) + next-pos_1)) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))))))) + (if (unsafe-fx< index_0 24) + (if (unsafe-fx< index_0 22) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((syms_0 next-pos_0) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((bulk-bindings_0 next-pos_1) + (values + (begin-unsafe + (table-with-bulk-bindings1.1 + syms_0 + syms_0 + bulk-bindings_0)) + next-pos_1)) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))) + (if (unsafe-fx< index_0 23) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((scopes_0 next-pos_0) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((bulk_0 next-pos_1) + (values + (begin-unsafe (bulk-binding-at2.1 scopes_0 bulk_0)) + next-pos_1)) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))) (call-with-values (lambda () (decode @@ -27442,99 +27495,6 @@ shared_0)) (case-lambda ((kind_0 next-pos_0) - (values - (begin-unsafe - (scope1.1 - (new-deserialize-scope-id!) - kind_0 - empty-binding-table)) - next-pos_0)) - (args (raise-binding-result-arity-error 2 args)))) - (if (unsafe-fx< index_0 19) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((id_0 next-pos_0) - (values (make-interned-scope id_0) next-pos_0)) - (args (raise-binding-result-arity-error 2 args)))) - (if (unsafe-fx< index_0 20) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((name_0 next-pos_0) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((scopes_0 next-pos_1) - (values - (deserialize-multi-scope name_0 scopes_0) - next-pos_1)) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((phase_0 next-pos_0) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((multi-scope_0 next-pos_1) - (values - (begin-unsafe - (intern-shifted-multi-scope - phase_0 - multi-scope_0)) - next-pos_1)) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))))))) - (if (unsafe-fx< index_0 24) - (if (unsafe-fx< index_0 22) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((syms_0 next-pos_0) (call-with-values (lambda () (decode @@ -27545,17 +27505,252 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((bulk-bindings_0 next-pos_1) + ((phase_0 next-pos_1) + (values + (deserialize-representative-scope kind_0 phase_0) + next-pos_1)) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))))) + (if (unsafe-fx< index_0 26) + (if (unsafe-fx< index_0 25) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((module_0 next-pos_0) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((sym_0 next-pos_1) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_1 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((phase_0 next-pos_2) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_2 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((nominal-module_0 next-pos_3) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_3 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((nominal-phase_0 next-pos_4) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_4 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((nominal-sym_0 next-pos_5) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_5 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((nominal-require-phase_0 next-pos_6) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_6 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((free=id_0 next-pos_7) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_7 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((extra-inspector_0 next-pos_8) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_8 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((extra-nominal-bindings_0 + next-pos_9) + (values + (deserialize-full-module-binding + module_0 + sym_0 + phase_0 + nominal-module_0 + nominal-phase_0 + nominal-sym_0 + nominal-require-phase_0 + free=id_0 + extra-inspector_0 + extra-nominal-bindings_0) + next-pos_9)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error 2 args))))) + (args + (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((module_0 next-pos_0) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((sym_0 next-pos_1) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_1 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((phase_0 next-pos_2) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_2 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((nominal-module_0 next-pos_3) + (values + (begin-unsafe + (simple-module-binding46.1 + module_0 + phase_0 + sym_0 + nominal-module_0)) + next-pos_3)) + (args + (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args))))) + (if (unsafe-fx< index_0 27) + (call-with-values + (lambda () + (decode + vec_0 + (add1 pos_0) + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((key_0 next-pos_0) + (call-with-values + (lambda () + (decode + vec_0 + next-pos_0 + mpis_0 + inspector_0 + bulk-binding-registry_0 + shared_0)) + (case-lambda + ((free=id_0 next-pos_1) (values (begin-unsafe - (table-with-bulk-bindings1.1 - syms_0 - syms_0 - bulk-bindings_0)) + (full-local-binding1.1 #f free=id_0 key_0)) next-pos_1)) (args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 2 args)))) - (if (unsafe-fx< index_0 23) + (if (unsafe-fx< index_0 28) (call-with-values (lambda () (decode @@ -27566,7 +27761,7 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((scopes_0 next-pos_0) + ((prefix_0 next-pos_0) (call-with-values (lambda () (decode @@ -27577,63 +27772,7 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((bulk_0 next-pos_1) - (values - (begin-unsafe (bulk-binding-at2.1 scopes_0 bulk_0)) - next-pos_1)) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((kind_0 next-pos_0) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((phase_0 next-pos_1) - (values - (deserialize-representative-scope kind_0 phase_0) - next-pos_1)) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))))) - (if (unsafe-fx< index_0 26) - (if (unsafe-fx< index_0 25) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((module_0 next-pos_0) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((sym_0 next-pos_1) + ((excepts_0 next-pos_1) (call-with-values (lambda () (decode @@ -27644,7 +27783,7 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((phase_0 next-pos_2) + ((mpi_0 next-pos_2) (call-with-values (lambda () (decode @@ -27655,7 +27794,7 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((nominal-module_0 next-pos_3) + ((provide-phase-level_0 next-pos_3) (call-with-values (lambda () (decode @@ -27666,7 +27805,7 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((nominal-phase_0 next-pos_4) + ((phase-shift_0 next-pos_4) (call-with-values (lambda () (decode @@ -27677,81 +27816,19 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((nominal-sym_0 next-pos_5) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_5 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((nominal-require-phase_0 next-pos_6) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_6 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((free=id_0 next-pos_7) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_7 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((extra-inspector_0 next-pos_8) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_8 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((extra-nominal-bindings_0 - next-pos_9) - (values - (deserialize-full-module-binding - module_0 - sym_0 - phase_0 - nominal-module_0 - nominal-phase_0 - nominal-sym_0 - nominal-require-phase_0 - free=id_0 - extra-inspector_0 - extra-nominal-bindings_0) - next-pos_9)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args))))) + ((bulk-binding-registry_1 next-pos_5) + (values + (begin-unsafe + (bulk-binding12.1 + #f + prefix_0 + excepts_0 + #f + mpi_0 + provide-phase-level_0 + phase-shift_0 + bulk-binding-registry_1)) + next-pos_5)) (args (raise-binding-result-arity-error 2 @@ -27775,7 +27852,7 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((module_0 next-pos_0) + ((binding_0 next-pos_0) (call-with-values (lambda () (decode @@ -27786,7 +27863,7 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((sym_0 next-pos_1) + ((protected?_0 next-pos_1) (call-with-values (lambda () (decode @@ -27797,200 +27874,15 @@ bulk-binding-registry_0 shared_0)) (case-lambda - ((phase_0 next-pos_2) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_2 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((nominal-module_0 next-pos_3) - (values - (begin-unsafe - (simple-module-binding46.1 - module_0 - phase_0 - sym_0 - nominal-module_0)) - next-pos_3)) - (args - (raise-binding-result-arity-error 2 args))))) + ((syntax?_0 next-pos_2) + (values + (begin-unsafe + (provided1.1 binding_0 protected?_0 syntax?_0)) + next-pos_2)) (args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args))))) - (if (unsafe-fx< index_0 27) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((key_0 next-pos_0) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((free=id_0 next-pos_1) - (values - (begin-unsafe - (full-local-binding1.1 #f free=id_0 key_0)) - next-pos_1)) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (if (unsafe-fx< index_0 28) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((prefix_0 next-pos_0) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((excepts_0 next-pos_1) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_1 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((mpi_0 next-pos_2) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_2 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((provide-phase-level_0 next-pos_3) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_3 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((phase-shift_0 next-pos_4) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_4 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((bulk-binding-registry_1 next-pos_5) - (values - (begin-unsafe - (bulk-binding12.1 - #f - prefix_0 - excepts_0 - #f - mpi_0 - provide-phase-level_0 - phase-shift_0 - bulk-binding-registry_1)) - next-pos_5)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error 2 args))))) - (args - (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (call-with-values - (lambda () - (decode - vec_0 - (add1 pos_0) - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((binding_0 next-pos_0) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_0 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((protected?_0 next-pos_1) - (call-with-values - (lambda () - (decode - vec_0 - next-pos_1 - mpis_0 - inspector_0 - bulk-binding-registry_0 - shared_0)) - (case-lambda - ((syntax?_0 next-pos_2) - (values - (begin-unsafe - (provided1.1 - binding_0 - protected?_0 - syntax?_0)) - next-pos_2)) - (args - (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args))))) - (args - (raise-binding-result-arity-error - 2 - args))))))))))))))) + (args + (raise-binding-result-arity-error 2 args)))))))))))))) (define decode-fill! (lambda (v_0 vec_0 pos_0 mpis_0 inspector_0 bulk-binding-registry_0 shared_0) (let ((tmp_0 (unsafe-vector*-ref vec_0 pos_0))) @@ -30002,97 +29894,104 @@ fold-var_0)))))) (for-loop_0 null reqds_0)))))) (define check-not-defined.1 - (letrec ((raise-already-bound_0 - (|#%name| - raise-already-bound - (lambda (id81_0 in68_0 phase82_0 who72_0 defined?_0 where_0) - (begin - (let ((app_0 - (let ((app_0 (if defined?_0 "defined" "required"))) - (string-append - "identifier already " - app_0 - (if (begin-unsafe (eq? phase82_0 0)) - "" - (if (begin-unsafe (not phase82_0)) - " for label" - (if (= 1 phase82_0) - " for syntax" - (format " for phase ~a" phase82_0)))))))) - (raise-syntax-error$1 - who72_0 - app_0 - in68_0 - id81_0 - null - (if (bulk-required? where_0) - (format - "\n also provided by: ~.s" - (syntax->datum$1 (bulk-required-s where_0))) - "")))))))) - (|#%name| - check-not-defined - (lambda (accum-update-nominals71_0 - allow-defined?67_0 - check-not-required?66_0 - in68_0 - remove-shadowed!?70_0 - unless-matches69_0 - who72_0 - r+p80_0 - id81_0 - phase82_0) - (begin - (let ((b_0 - (resolve+shift.1 + (|#%name| + check-not-defined + (lambda (accum-update-nominals71_0 + allow-defined?67_0 + check-not-required?66_0 + in68_0 + remove-shadowed!?70_0 + unless-matches69_0 + who72_0 + r+p80_0 + id81_0 + phase82_0) + (begin + (let ((b_0 + (resolve+shift.1 + #f + #t + null + unsafe-undefined + #f + id81_0 + phase82_0))) + (if (not b_0) + #f + (if (not (module-binding? b_0)) + (raise-syntax-error$1 #f "identifier out of context" id81_0) + (let ((defined?_0 + (if b_0 + (let ((app_0 (requires+provides-self r+p80_0))) + (eq? app_0 (module-binding-module b_0))) + #f))) + (if (if defined?_0 + (not + (let ((app_0 + (hash-ref + (requires+provides-phase-to-defined-syms r+p80_0) + phase82_0 + hash2610))) + (hash-ref app_0 (module-binding-sym b_0) #f))) + #f) #f - #t - null - unsafe-undefined - #f - id81_0 - phase82_0))) - (if (not b_0) - #f - (if (not (module-binding? b_0)) - (raise-syntax-error$1 #f "identifier out of context" id81_0) - (let ((defined?_0 - (if b_0 - (let ((app_0 (requires+provides-self r+p80_0))) - (eq? app_0 (module-binding-module b_0))) - #f))) - (if (if defined?_0 - (not - (let ((app_0 - (hash-ref - (requires+provides-phase-to-defined-syms - r+p80_0) - phase82_0 - hash2610))) - (hash-ref app_0 (module-binding-sym b_0) #f))) - #f) - #f - (let ((define-shadowing-require?_0 - (if (not defined?_0) - (not check-not-required?66_0) - #f))) - (let ((mpi_0 - (let ((mpi_0 (module-binding-nominal-module b_0))) - (begin-unsafe - (intern-module-path-index! - (requires+provides-require-mpis r+p80_0) - mpi_0))))) - (let ((at-mod_0 - (hash-ref - (requires+provides-requires r+p80_0) - mpi_0 - #f))) - (let ((ok-binding_0 - (if (not define-shadowing-require?_0) - (if (procedure? unless-matches69_0) - (|#%app| unless-matches69_0) - unless-matches69_0) - #f))) + (let ((define-shadowing-require?_0 + (if (not defined?_0) + (not check-not-required?66_0) + #f))) + (let ((mpi_0 + (let ((mpi_0 (module-binding-nominal-module b_0))) + (begin-unsafe + (intern-module-path-index! + (requires+provides-require-mpis r+p80_0) + mpi_0))))) + (let ((at-mod_0 + (hash-ref + (requires+provides-requires r+p80_0) + mpi_0 + #f))) + (let ((ok-binding_0 + (if (not define-shadowing-require?_0) + (if (procedure? unless-matches69_0) + (|#%app| unless-matches69_0) + unless-matches69_0) + #f))) + (let ((raise-already-bound_0 + (|#%name| + raise-already-bound + (lambda (defined?_1 where_0) + (begin + (let ((app_0 + (let ((app_0 + (if defined?_1 + "defined" + "required"))) + (string-append + "identifier already " + app_0 + (if (begin-unsafe + (eq? phase82_0 0)) + "" + (if (begin-unsafe + (not phase82_0)) + " for label" + (if (= 1 phase82_0) + " for syntax" + (format + " for phase ~a" + phase82_0)))))))) + (raise-syntax-error$1 + who72_0 + app_0 + in68_0 + id81_0 + null + (if (bulk-required? where_0) + (format + "\n also provided by: ~.s" + (syntax->datum$1 + (bulk-required-s where_0))) + "")))))))) (if (if (not at-mod_0) (not define-shadowing-require?_0) #f) @@ -30157,13 +30056,7 @@ ok-binding_0 prev-b_0)) #f) - (raise-already-bound_0 - id81_0 - in68_0 - phase82_0 - who72_0 - #f - #f) + (raise-already-bound_0 #f #f) (void)) (hash-set! also-required_0 @@ -30224,10 +30117,6 @@ (if define-shadowing-require?_0 #f (raise-already-bound_0 - id81_0 - in68_0 - phase82_0 - who72_0 defined?_0 r_1))))) (values @@ -30627,199 +30516,202 @@ xform_1 default_0))))))))))) (define extract-requires-and-provides - (letrec ((extract-provides_0 - (|#%name| - extract-provides - (lambda (new-self_0 old-self_0 r+p_0) - (begin - (shift-provides-module-path-index - (requires+provides-provides r+p_0) - old-self_0 - new-self_0))))) - (extract-requires_0 - (|#%name| - extract-requires - (lambda (new-self_0 old-self_0 r+p_0) - (begin - (let ((phase-to-mpis-in-order_0 - (requires+provides-require-mpis-in-order r+p_0))) - (let ((phases-in-order_0 - (let ((temp153_0 - (hash-keys phase-to-mpis-in-order_0))) - (sort.1 #f #f temp153_0 phasesym-set - id138_0)) + adjust_0 #f - #f - 'path))) + just-meta-ok?_0 + 'raw))) (args (raise-binding-result-arity-error - 4 + 3 args))))) (if (eq? fm_0 - 'prefix) + 'for-label) (begin - (check-nested_0 - layer_0 - orig-s26_0 - req_0 - 'phaseless) + (check-nested_1 + 'raw + for-meta-ok?_0) (call-with-values (lambda () (call-with-values @@ -31940,180 +31362,81 @@ req_0))) (if (pair? s_0) - (let ((prefix148_0 + (let ((for-label126_0 (let ((s_1 (car s_0))) s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((id:prefix151_0 - (let ((s_3 - (car - s_2))) - (if (let ((or-part_0 - (if (syntax?$1 - s_3) - (symbol? - (syntax-e$1 - s_3)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_3))) - s_3 - (raise-syntax-error$1 - #f - "not an identifier" - req_0 - s_3))))) - (let ((spec152_0 - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? - s_4) - (let ((spec153_0 - (let ((s_5 - (car - s_4))) - s_5))) - (call-with-values - (lambda () - (let ((s_5 - (cdr - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 - s_5) - s_5))) - (if (null? - s_6) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - req_0))))) - (case-lambda - (() - (let ((spec153_1 - spec153_0)) - (values - spec153_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0)))))) - (let ((id:prefix151_1 - id:prefix151_0)) - (values - id:prefix151_1 - spec152_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0))))) - (case-lambda - ((id:prefix149_0 - spec150_0) - (let ((prefix148_1 - prefix148_0)) - (values - prefix148_1 - id:prefix149_0 - spec150_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) + (let ((spec127_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + req_0) + flat-s_0)))))) + (let ((for-label126_1 + for-label126_0)) + (values + for-label126_1 + spec127_0)))) (raise-syntax-error$1 #f "bad syntax" req_0)))) (case-lambda - ((prefix145_0 - id:prefix146_0 - spec147_0) + ((for-label124_0 + spec125_0) (values #t - prefix145_0 - id:prefix146_0 - spec147_0)) + for-label124_0 + spec125_0)) (args (raise-binding-result-arity-error - 3 + 2 args))))) (case-lambda ((ok?_0 - prefix145_0 - id:prefix146_0 - spec147_0) + for-label124_0 + spec125_0) (let ((app_0 (if top-req_0 top-req_0 req_0))) (loop_0 - copy-variable-as-constant?11_0 - copy-variable-phase-level10_0 - declared-submodule-names9_0 - initial-require?_0 - m-ns27_0 - orig-s26_0 - requires+provides29_0 - run-phase_0 - run?7_0 - self5_0 - skip-variable-phase-level12_0 - visit?8_0 - who14_0 - (list - spec147_0) + spec125_0 app_0 - phase-shift_0 + (phase+ + phase-shift_0 + #f) just-meta_0 - (adjust-prefix2.1 - (syntax-e$1 - id:prefix146_0)) + adjust_0 #f - #f - 'path))) + just-meta-ok?_0 + 'raw))) (args (raise-binding-result-arity-error - 4 + 3 args))))) (if (eq? fm_0 - 'all-except) + 'just-meta) (begin - (check-nested_0 - layer_0 - orig-s26_0 - req_0 - 'phaseless) + (check-nested_1 + 'raw + just-meta-ok?_0) (call-with-values (lambda () (call-with-values @@ -32126,7 +31449,7 @@ req_0))) (if (pair? s_0) - (let ((all-except157_0 + (let ((just-meta131_0 (let ((s_1 (car s_0))) @@ -32144,12 +31467,12 @@ s_1))) (if (pair? s_2) - (let ((spec160_0 + (let ((phase-level134_0 (let ((s_3 (car s_2))) s_3))) - (let ((id161_0 + (let ((spec135_0 (let ((s_3 (cdr s_2))) @@ -32168,75 +31491,25 @@ #f "bad syntax" req_0) - (let ((id_0 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (id_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((s_5 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((id_1 - (let ((id_1 - (let ((id162_0 - (if (let ((or-part_0 - (if (syntax?$1 - s_5) - (symbol? - (syntax-e$1 - s_5)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_5))) - s_5 - (raise-syntax-error$1 - #f - "not an identifier" - req_0 - s_5)))) - (cons - id162_0 - id_0)))) - (values - id_1)))) - (for-loop_1 - id_1 - rest_1)))) - id_0)))))) - (for-loop_1 - null - flat-s_0))))) - (reverse$1 - id_0)))))))) - (let ((spec160_1 - spec160_0)) + flat-s_0)))))) + (let ((phase-level134_1 + phase-level134_0)) (values - spec160_1 - id161_0)))) + phase-level134_1 + spec135_0)))) (raise-syntax-error$1 #f "bad syntax" req_0))))) (case-lambda - ((spec158_0 - id159_0) - (let ((all-except157_1 - all-except157_0)) + ((phase-level132_0 + spec133_0) + (let ((just-meta131_1 + just-meta131_0)) (values - all-except157_1 - spec158_0 - id159_0))) + just-meta131_1 + phase-level132_0 + spec133_0))) (args (raise-binding-result-arity-error 2 @@ -32246,65 +31519,55 @@ "bad syntax" req_0)))) (case-lambda - ((all-except154_0 - spec155_0 - id156_0) + ((just-meta128_0 + phase-level129_0 + spec130_0) (values #t - all-except154_0 - spec155_0 - id156_0)) + just-meta128_0 + phase-level129_0 + spec130_0)) (args (raise-binding-result-arity-error 3 args))))) (case-lambda ((ok?_0 - all-except154_0 - spec155_0 - id156_0) - (let ((app_0 - (if top-req_0 - top-req_0 - req_0))) - (loop_0 - copy-variable-as-constant?11_0 - copy-variable-phase-level10_0 - declared-submodule-names9_0 - initial-require?_0 - m-ns27_0 - orig-s26_0 - requires+provides29_0 - run-phase_0 - run?7_0 - self5_0 - skip-variable-phase-level12_0 - visit?8_0 - who14_0 - (list - spec155_0) - app_0 - phase-shift_0 - just-meta_0 - (adjust-all-except3.1 - '|| - (ids->sym-set - id156_0)) - #f - #f - 'path))) + just-meta128_0 + phase-level129_0 + spec130_0) + (let ((p_0 + (syntax-e$1 + phase-level129_0))) + (begin + (if (phase? + p_0) + (void) + (raise-syntax-error$1 + #f + "bad phase" + orig-s26_0 + req_0)) + (loop_0 + spec130_0 + (if top-req_0 + top-req_0 + req_0) + phase-shift_0 + p_0 + adjust_0 + for-meta-ok?_0 + #f + 'raw)))) (args (raise-binding-result-arity-error 4 args))))) (if (eq? fm_0 - 'prefix-all-except) + 'only) (begin - (check-nested_0 - layer_0 - orig-s26_0 - req_0 + (check-nested_1 'phaseless) (call-with-values (lambda () @@ -32318,7 +31581,7 @@ req_0))) (if (pair? s_0) - (let ((prefix-all-except167_0 + (let ((only139_0 (let ((s_1 (car s_0))) @@ -32336,226 +31599,150 @@ s_1))) (if (pair? s_2) - (let ((id:prefix171_0 + (let ((spec142_0 (let ((s_3 (car s_2))) - (if (let ((or-part_0 - (if (syntax?$1 - s_3) - (symbol? - (syntax-e$1 - s_3)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_3))) - s_3 - (raise-syntax-error$1 - #f - "not an identifier" - req_0 - s_3))))) - (call-with-values - (lambda () - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? - s_4) - (let ((spec174_0 - (let ((s_5 - (car - s_4))) - s_5))) - (let ((id175_0 - (let ((s_5 - (cdr - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 - s_5) - s_5))) - (let ((flat-s_0 - (to-syntax-list.1 - s_6))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - req_0) - (let ((id_0 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (id_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((s_7 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((id_1 - (let ((id_1 - (let ((id176_0 - (if (let ((or-part_0 - (if (syntax?$1 - s_7) - (symbol? - (syntax-e$1 - s_7)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_7))) - s_7 - (raise-syntax-error$1 - #f - "not an identifier" - req_0 - s_7)))) - (cons - id176_0 - id_0)))) - (values - id_1)))) - (for-loop_1 - id_1 - rest_1)))) - id_0)))))) - (for-loop_1 - null - flat-s_0))))) - (reverse$1 - id_0)))))))) - (let ((spec174_1 - spec174_0)) - (values - spec174_1 - id175_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0))))) - (case-lambda - ((spec172_0 - id173_0) - (let ((id:prefix171_1 - id:prefix171_0)) - (values - id:prefix171_1 - spec172_0 - id173_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) + s_3))) + (let ((id143_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + req_0) + (let ((id_0 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (id_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((s_5 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((id_1 + (let ((id_1 + (let ((id144_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + req_0 + s_5)))) + (cons + id144_0 + id_0)))) + (values + id_1)))) + (for-loop_1 + id_1 + rest_1)))) + id_0)))))) + (for-loop_1 + null + flat-s_0))))) + (reverse$1 + id_0)))))))) + (let ((spec142_1 + spec142_0)) + (values + spec142_1 + id143_0)))) (raise-syntax-error$1 #f "bad syntax" req_0))))) (case-lambda - ((id:prefix168_0 - spec169_0 - id170_0) - (let ((prefix-all-except167_1 - prefix-all-except167_0)) + ((spec140_0 + id141_0) + (let ((only139_1 + only139_0)) (values - prefix-all-except167_1 - id:prefix168_0 - spec169_0 - id170_0))) + only139_1 + spec140_0 + id141_0))) (args (raise-binding-result-arity-error - 3 + 2 args))))) (raise-syntax-error$1 #f "bad syntax" req_0)))) (case-lambda - ((prefix-all-except163_0 - id:prefix164_0 - spec165_0 - id166_0) + ((only136_0 + spec137_0 + id138_0) (values #t - prefix-all-except163_0 - id:prefix164_0 - spec165_0 - id166_0)) + only136_0 + spec137_0 + id138_0)) (args (raise-binding-result-arity-error - 4 + 3 args))))) (case-lambda ((ok?_0 - prefix-all-except163_0 - id:prefix164_0 - spec165_0 - id166_0) + only136_0 + spec137_0 + id138_0) (let ((app_0 (if top-req_0 top-req_0 req_0))) (loop_0 - copy-variable-as-constant?11_0 - copy-variable-phase-level10_0 - declared-submodule-names9_0 - initial-require?_0 - m-ns27_0 - orig-s26_0 - requires+provides29_0 - run-phase_0 - run?7_0 - self5_0 - skip-variable-phase-level12_0 - visit?8_0 - who14_0 (list - spec165_0) + spec137_0) app_0 phase-shift_0 just-meta_0 - (let ((app_1 - (syntax-e$1 - id:prefix164_0))) - (adjust-all-except3.1 - app_1 - (ids->sym-set - id166_0))) + (adjust-only1.1 + (ids->sym-set + id138_0)) #f #f 'path))) (args (raise-binding-result-arity-error - 5 + 4 args))))) (if (eq? fm_0 - 'rename) + 'prefix) (begin - (check-nested_0 - layer_0 - orig-s26_0 - req_0 + (check-nested_1 'phaseless) (call-with-values (lambda () @@ -32569,7 +31756,7 @@ req_0))) (if (pair? s_0) - (let ((rename181_0 + (let ((prefix148_0 (let ((s_1 (car s_0))) @@ -32587,46 +31774,46 @@ s_1))) (if (pair? s_2) - (let ((spec185_0 + (let ((id:prefix151_0 (let ((s_3 (car s_2))) - s_3))) - (call-with-values - (lambda () - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? - s_4) - (let ((id:to188_0 - (let ((s_5 - (car - s_4))) - (if (let ((or-part_0 - (if (syntax?$1 - s_5) - (symbol? - (syntax-e$1 - s_5)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_5))) - s_5 - (raise-syntax-error$1 - #f - "not an identifier" - req_0 - s_5))))) - (let ((id:from189_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_3) + (symbol? + (syntax-e$1 + s_3)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_3))) + s_3 + (raise-syntax-error$1 + #f + "not an identifier" + req_0 + s_3))))) + (let ((spec152_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((spec153_0 + (let ((s_5 + (car + s_4))) + s_5))) + (call-with-values + (lambda () (let ((s_5 (cdr s_4))) @@ -32636,288 +31823,810 @@ (syntax-e$1 s_5) s_5))) - (if (pair? + (if (null? s_6) - (let ((id:from190_0 - (let ((s_7 - (car - s_6))) - (if (let ((or-part_0 - (if (syntax?$1 - s_7) - (symbol? - (syntax-e$1 - s_7)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_7))) - s_7 - (raise-syntax-error$1 - #f - "not an identifier" - req_0 - s_7))))) - (call-with-values - (lambda () - (let ((s_7 - (cdr - s_6))) - (let ((s_8 - (if (syntax?$1 - s_7) - (syntax-e$1 - s_7) - s_7))) - (if (null? - s_8) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - req_0))))) - (case-lambda - (() - (let ((id:from190_1 - id:from190_0)) - (values - id:from190_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) + (values) (raise-syntax-error$1 #f "bad syntax" - req_0)))))) - (let ((id:to188_1 - id:to188_0)) - (values - id:to188_1 - id:from189_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0))))) - (case-lambda - ((id:to186_0 - id:from187_0) - (let ((spec185_1 - spec185_0)) - (values - spec185_1 - id:to186_0 - id:from187_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) + req_0))))) + (case-lambda + (() + (let ((spec153_1 + spec153_0)) + (values + spec153_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + req_0)))))) + (let ((id:prefix151_1 + id:prefix151_0)) + (values + id:prefix151_1 + spec152_0)))) (raise-syntax-error$1 #f "bad syntax" req_0))))) (case-lambda - ((spec182_0 - id:to183_0 - id:from184_0) - (let ((rename181_1 - rename181_0)) + ((id:prefix149_0 + spec150_0) + (let ((prefix148_1 + prefix148_0)) (values - rename181_1 - spec182_0 - id:to183_0 - id:from184_0))) + prefix148_1 + id:prefix149_0 + spec150_0))) (args (raise-binding-result-arity-error - 3 + 2 args))))) (raise-syntax-error$1 #f "bad syntax" req_0)))) (case-lambda - ((rename177_0 - spec178_0 - id:to179_0 - id:from180_0) + ((prefix145_0 + id:prefix146_0 + spec147_0) (values #t - rename177_0 - spec178_0 - id:to179_0 - id:from180_0)) + prefix145_0 + id:prefix146_0 + spec147_0)) (args (raise-binding-result-arity-error - 4 + 3 args))))) (case-lambda ((ok?_0 - rename177_0 - spec178_0 - id:to179_0 - id:from180_0) + prefix145_0 + id:prefix146_0 + spec147_0) (let ((app_0 (if top-req_0 top-req_0 req_0))) (loop_0 - copy-variable-as-constant?11_0 - copy-variable-phase-level10_0 - declared-submodule-names9_0 - initial-require?_0 - m-ns27_0 - orig-s26_0 - requires+provides29_0 - run-phase_0 - run?7_0 - self5_0 - skip-variable-phase-level12_0 - visit?8_0 - who14_0 (list - spec178_0) + spec147_0) app_0 phase-shift_0 just-meta_0 - (adjust-rename4.1 - id:to179_0 + (adjust-prefix2.1 (syntax-e$1 - id:from180_0)) + id:prefix146_0)) #f #f 'path))) (args (raise-binding-result-arity-error - 5 + 4 args))))) - (let ((maybe-mp_0 - (syntax->datum$1 - req_0))) + (if (eq? + fm_0 + 'all-except) (begin - (if (let ((or-part_0 - (1/module-path? - maybe-mp_0))) - (if or-part_0 - or-part_0 - (1/resolved-module-path? - maybe-mp_0))) - (void) - (raise-syntax-error$1 - #f - "bad require spec" - orig-s26_0 - req_0)) + (check-nested_1 + 'phaseless) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + req_0) + (syntax-e$1 + req_0) + req_0))) + (if (pair? + s_0) + (let ((all-except157_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((spec160_0 + (let ((s_3 + (car + s_2))) + s_3))) + (let ((id161_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + req_0) + (let ((id_0 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (id_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((s_5 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((id_1 + (let ((id_1 + (let ((id162_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + req_0 + s_5)))) + (cons + id162_0 + id_0)))) + (values + id_1)))) + (for-loop_1 + id_1 + rest_1)))) + id_0)))))) + (for-loop_1 + null + flat-s_0))))) + (reverse$1 + id_0)))))))) + (let ((spec160_1 + spec160_0)) + (values + spec160_1 + id161_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + req_0))))) + (case-lambda + ((spec158_0 + id159_0) + (let ((all-except157_1 + all-except157_0)) + (values + all-except157_1 + spec158_0 + id159_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + req_0)))) + (case-lambda + ((all-except154_0 + spec155_0 + id156_0) + (values + #t + all-except154_0 + spec155_0 + id156_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + all-except154_0 + spec155_0 + id156_0) + (let ((app_0 + (if top-req_0 + top-req_0 + req_0))) + (loop_0 + (list + spec155_0) + app_0 + phase-shift_0 + just-meta_0 + (adjust-all-except3.1 + '|| + (ids->sym-set + id156_0)) + #f + #f + 'path))) + (args + (raise-binding-result-arity-error + 4 + args))))) + (if (eq? + fm_0 + 'prefix-all-except) (begin - (if (if adjust_0 - adjust_0 - (not - (eq? - just-meta_0 - 'all))) - (set-requires+provides-all-bindings-simple?! - requires+provides29_0 - #f) - (void)) - (let ((mp_0 - (if (1/resolved-module-path? - maybe-mp_0) - (resolved-module-path->module-path - maybe-mp_0) - maybe-mp_0))) - (let ((mpi_0 - (module-path->mpi.1 - declared-submodule-names9_0 - mp_0 - self5_0))) - (begin - (let ((temp194_0 - (if req_0 - req_0 - top-req_0))) - (let ((initial-require?206_0 - (unsafe-unbox* - initial-require?_0))) - (let ((temp194_1 - temp194_0)) - (perform-require!.1 - adjust_0 - #t + (check-nested_1 + 'phaseless) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + req_0) + (syntax-e$1 + req_0) + req_0))) + (if (pair? + s_0) + (let ((prefix-all-except167_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((id:prefix171_0 + (let ((s_3 + (car + s_2))) + (if (let ((or-part_0 + (if (syntax?$1 + s_3) + (symbol? + (syntax-e$1 + s_3)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_3))) + s_3 + (raise-syntax-error$1 + #f + "not an identifier" + req_0 + s_3))))) + (call-with-values + (lambda () + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((spec174_0 + (let ((s_5 + (car + s_4))) + s_5))) + (let ((id175_0 + (let ((s_5 + (cdr + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 + s_5) + s_5))) + (let ((flat-s_0 + (to-syntax-list.1 + s_6))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + req_0) + (let ((id_0 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (id_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((s_7 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((id_1 + (let ((id_1 + (let ((id176_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_7) + (symbol? + (syntax-e$1 + s_7)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_7))) + s_7 + (raise-syntax-error$1 + #f + "not an identifier" + req_0 + s_7)))) + (cons + id176_0 + id_0)))) + (values + id_1)))) + (for-loop_1 + id_1 + rest_1)))) + id_0)))))) + (for-loop_1 + null + flat-s_0))))) + (reverse$1 + id_0)))))))) + (let ((spec174_1 + spec174_0)) + (values + spec174_1 + id175_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + req_0))))) + (case-lambda + ((spec172_0 + id173_0) + (let ((id:prefix171_1 + id:prefix171_0)) + (values + id:prefix171_1 + spec172_0 + id173_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + req_0))))) + (case-lambda + ((id:prefix168_0 + spec169_0 + id170_0) + (let ((prefix-all-except167_1 + prefix-all-except167_0)) + (values + prefix-all-except167_1 + id:prefix168_0 + spec169_0 + id170_0))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + req_0)))) + (case-lambda + ((prefix-all-except163_0 + id:prefix164_0 + spec165_0 + id166_0) + (values + #t + prefix-all-except163_0 + id:prefix164_0 + spec165_0 + id166_0)) + (args + (raise-binding-result-arity-error + 4 + args))))) + (case-lambda + ((ok?_0 + prefix-all-except163_0 + id:prefix164_0 + spec165_0 + id166_0) + (let ((app_0 + (if top-req_0 + top-req_0 + req_0))) + (loop_0 + (list + spec165_0) + app_0 + phase-shift_0 + just-meta_0 + (let ((app_1 + (syntax-e$1 + id:prefix164_0))) + (adjust-all-except3.1 + app_1 + (ids->sym-set + id166_0))) + #f + #f + 'path))) + (args + (raise-binding-result-arity-error + 5 + args))))) + (if (eq? + fm_0 + 'rename) + (begin + (check-nested_1 + 'phaseless) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + req_0) + (syntax-e$1 + req_0) + req_0))) + (if (pair? + s_0) + (let ((rename181_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((spec185_0 + (let ((s_3 + (car + s_2))) + s_3))) + (call-with-values + (lambda () + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((id:to188_0 + (let ((s_5 + (car + s_4))) + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + req_0 + s_5))))) + (let ((id:from189_0 + (let ((s_5 + (cdr + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 + s_5) + s_5))) + (if (pair? + s_6) + (let ((id:from190_0 + (let ((s_7 + (car + s_6))) + (if (let ((or-part_0 + (if (syntax?$1 + s_7) + (symbol? + (syntax-e$1 + s_7)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_7))) + s_7 + (raise-syntax-error$1 + #f + "not an identifier" + req_0 + s_7))))) + (call-with-values + (lambda () + (let ((s_7 + (cdr + s_6))) + (let ((s_8 + (if (syntax?$1 + s_7) + (syntax-e$1 + s_7) + s_7))) + (if (null? + s_8) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + req_0))))) + (case-lambda + (() + (let ((id:from190_1 + id:from190_0)) + (values + id:from190_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + req_0)))))) + (let ((id:to188_1 + id:to188_0)) + (values + id:to188_1 + id:from189_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + req_0))))) + (case-lambda + ((id:to186_0 + id:from187_0) + (let ((spec185_1 + spec185_0)) + (values + spec185_1 + id:to186_0 + id:from187_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + req_0))))) + (case-lambda + ((spec182_0 + id:to183_0 + id:from184_0) + (let ((rename181_1 + rename181_0)) + (values + rename181_1 + spec182_0 + id:to183_0 + id:from184_0))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (raise-syntax-error$1 #f - copy-variable-as-constant?11_0 - copy-variable-phase-level10_0 - initial-require?206_0 - just-meta_0 - phase-shift_0 - requires+provides29_0 - run-phase_0 - run?7_0 - skip-variable-phase-level12_0 - visit?8_0 - who14_0 - mpi_0 - req_0 - self5_0 - temp194_1 - m-ns27_0)))) - (unsafe-set-box*! - initial-require?_0 - #f)))))))))))))))))))) - (values result_1)))) - (if (if (not - (let ((x_0 (list req_0))) - (not result_1))) - #t - #f) - (for-loop_0 result_1 rest_0) - result_1)))) - result_0)))))) - (for-loop_0 #t reqs_0)))))))) - (|#%name| - parse-and-perform-requires! - (lambda (copy-variable-as-constant?11_0 - copy-variable-phase-level10_0 - declared-submodule-names9_0 - initial-require?13_0 - run-phase6_0 - run?7_0 - self5_0 - skip-variable-phase-level12_0 - visit?8_0 - who14_0 - reqs25_0 - orig-s26_0 - m-ns27_0 - phase-shift28_0 - requires+provides29_0) - (begin - (let ((run-phase_0 - (if (eq? run-phase6_0 unsafe-undefined) - (namespace-phase m-ns27_0) - run-phase6_0))) - (let ((initial-require?_0 (box initial-require?13_0))) - (loop_0 - copy-variable-as-constant?11_0 - copy-variable-phase-level10_0 - declared-submodule-names9_0 - initial-require?_0 - m-ns27_0 - orig-s26_0 - requires+provides29_0 - run-phase_0 - run?7_0 - self5_0 - skip-variable-phase-level12_0 - visit?8_0 - who14_0 - reqs25_0 - #f - phase-shift28_0 - 'all - #f - #t - #t - 'raw)))))))) + "bad syntax" + req_0)))) + (case-lambda + ((rename177_0 + spec178_0 + id:to179_0 + id:from180_0) + (values + #t + rename177_0 + spec178_0 + id:to179_0 + id:from180_0)) + (args + (raise-binding-result-arity-error + 4 + args))))) + (case-lambda + ((ok?_0 + rename177_0 + spec178_0 + id:to179_0 + id:from180_0) + (let ((app_0 + (if top-req_0 + top-req_0 + req_0))) + (loop_0 + (list + spec178_0) + app_0 + phase-shift_0 + just-meta_0 + (adjust-rename4.1 + id:to179_0 + (syntax-e$1 + id:from180_0)) + #f + #f + 'path))) + (args + (raise-binding-result-arity-error + 5 + args))))) + (let ((maybe-mp_0 + (syntax->datum$1 + req_0))) + (begin + (if (let ((or-part_0 + (1/module-path? + maybe-mp_0))) + (if or-part_0 + or-part_0 + (1/resolved-module-path? + maybe-mp_0))) + (void) + (raise-syntax-error$1 + #f + "bad require spec" + orig-s26_0 + req_0)) + (begin + (if (if adjust_0 + adjust_0 + (not + (eq? + just-meta_0 + 'all))) + (set-requires+provides-all-bindings-simple?! + requires+provides29_0 + #f) + (void)) + (let ((mp_0 + (if (1/resolved-module-path? + maybe-mp_0) + (resolved-module-path->module-path + maybe-mp_0) + maybe-mp_0))) + (let ((mpi_0 + (module-path->mpi.1 + declared-submodule-names9_0 + mp_0 + self5_0))) + (begin + (let ((temp194_0 + (if req_0 + req_0 + top-req_0))) + (let ((initial-require?206_0 + initial-require?_0)) + (let ((temp194_1 + temp194_0)) + (perform-require!.1 + adjust_0 + #t + #f + copy-variable-as-constant?11_0 + copy-variable-phase-level10_0 + initial-require?206_0 + just-meta_0 + phase-shift_0 + requires+provides29_0 + run-phase_0 + run?7_0 + skip-variable-phase-level12_0 + visit?8_0 + who14_0 + mpi_0 + req_0 + self5_0 + temp194_1 + m-ns27_0)))) + (set! initial-require?_0 + #f))))))))))))))))))))) + (values result_1)))) + (if (if (not + (let ((x_0 (list req_0))) + (not result_1))) + #t + #f) + (for-loop_0 result_1 rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t reqs_0)))))))) + (loop_0 reqs25_0 #f phase-shift28_0 'all #f #t #t 'raw)))))))) (define ids->sym-set (lambda (ids_0) (begin @@ -33592,388 +33301,358 @@ (for-loop_0 (hash-iterate-first ht_0))))) (void))))))) (define require-spec-shift-for-syntax - (letrec ((loop_0 - (|#%name| - loop - (lambda (shifted?_0) - (begin - (lambda (req_0) - (let ((fm_0 - (if (pair? (syntax-e$1 req_0)) - (if (identifier? (car (syntax-e$1 req_0))) - (syntax-e$1 (car (syntax-e$1 req_0))) - #f) - #f))) - (if (eq? fm_0 'for-meta) + (lambda (req_0) + (let ((rebuild-req_0 + (|#%name| + rebuild-req + (lambda (req_1 new-req_0) + (begin (datum->syntax$1 req_1 new-req_0 req_1 req_1)))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (shifted?_0) + (begin + (lambda (req_1) + (let ((fm_0 + (if (pair? (syntax-e$1 req_1)) + (if (identifier? (car (syntax-e$1 req_1))) + (syntax-e$1 (car (syntax-e$1 req_1))) + #f) + #f))) + (if (eq? fm_0 'for-meta) + (call-with-values + (lambda () (call-with-values (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 req_0) - (syntax-e$1 req_0) - req_0))) - (if (pair? s_0) - (let ((for-meta300_0 - (let ((s_1 (car s_0))) s_1))) - (call-with-values - (lambda () - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (if (pair? s_2) - (let ((phase-level303_0 - (let ((s_3 (car s_2))) - s_3))) - (let ((spec304_0 - (let ((s_3 (cdr s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (let ((flat-s_0 - (to-syntax-list.1 - s_4))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - req_0) - flat-s_0)))))) - (let ((phase-level303_1 - phase-level303_0)) - (values - phase-level303_1 - spec304_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0))))) - (case-lambda - ((phase-level301_0 spec302_0) - (let ((for-meta300_1 for-meta300_0)) - (values - for-meta300_1 - phase-level301_0 - spec302_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0)))) - (case-lambda - ((for-meta297_0 phase-level298_0 spec299_0) - (values - #t - for-meta297_0 - phase-level298_0 - spec299_0)) - (args (raise-binding-result-arity-error 3 args))))) - (case-lambda - ((ok?_0 for-meta297_0 phase-level298_0 spec299_0) - (let ((p_0 (syntax-e$1 phase-level298_0))) - (begin - (if (phase? p_0) - (void) - (raise-syntax-error$1 #f "bad phase" req_0)) - (let ((new-req_0 - (let ((app_0 (phase+ p_0 1))) - (list* - for-meta297_0 - app_0 - (map_2960 (loop_0 #t) spec299_0))))) - (begin-unsafe - (begin - (datum->syntax$1 - req_0 - new-req_0 - req_0 - req_0))))))) - (args (raise-binding-result-arity-error 4 args)))) - (if (eq? fm_0 'for-syntax) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 req_0) - (syntax-e$1 req_0) - req_0))) - (if (pair? s_0) - (let ((for-syntax307_0 - (let ((s_1 (car s_0))) s_1))) - (let ((spec308_0 - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 s_2))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - req_0) - flat-s_0)))))) - (let ((for-syntax307_1 for-syntax307_0)) - (values for-syntax307_1 spec308_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0)))) - (case-lambda - ((for-syntax305_0 spec306_0) - (values #t for-syntax305_0 spec306_0)) - (args - (raise-binding-result-arity-error 2 args))))) - (case-lambda - ((ok?_0 for-syntax305_0 spec306_0) - (let ((new-req_0 - (list* - 'for-meta - 2 - (map_2960 (loop_0 #t) spec306_0)))) - (begin-unsafe - (begin - (datum->syntax$1 - req_0 - new-req_0 - req_0 - req_0))))) - (args (raise-binding-result-arity-error 3 args)))) - (if (eq? fm_0 'for-template) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 req_0) - (syntax-e$1 req_0) - req_0))) - (if (pair? s_0) - (let ((for-template311_0 - (let ((s_1 (car s_0))) s_1))) - (let ((spec312_0 - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - req_0) - flat-s_0)))))) - (let ((for-template311_1 - for-template311_0)) - (values - for-template311_1 - spec312_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0)))) - (case-lambda - ((for-template309_0 spec310_0) - (values #t for-template309_0 spec310_0)) - (args - (raise-binding-result-arity-error 2 args))))) - (case-lambda - ((ok?_0 for-template309_0 spec310_0) - (let ((new-req_0 - (list* - 'for-meta - 0 - (map_2960 (loop_0 #t) spec310_0)))) - (begin-unsafe - (begin - (datum->syntax$1 - req_0 - new-req_0 - req_0 - req_0))))) - (args (raise-binding-result-arity-error 3 args)))) - (if (eq? fm_0 'for-label) - (call-with-values - (lambda () + (let ((s_0 + (if (syntax?$1 req_1) + (syntax-e$1 req_1) + req_1))) + (if (pair? s_0) + (let ((for-meta300_0 + (let ((s_1 (car s_0))) s_1))) (call-with-values (lambda () - (let ((s_0 - (if (syntax?$1 req_0) - (syntax-e$1 req_0) - req_0))) - (if (pair? s_0) - (let ((for-label315_0 - (let ((s_1 (car s_0))) s_1))) - (let ((spec316_0 - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - req_0) - flat-s_0)))))) - (let ((for-label315_1 - for-label315_0)) - (values - for-label315_1 - spec316_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0)))) + (let ((s_1 (cdr s_0))) + (let ((s_2 + (if (syntax?$1 s_1) + (syntax-e$1 s_1) + s_1))) + (if (pair? s_2) + (let ((phase-level303_0 + (let ((s_3 (car s_2))) s_3))) + (let ((spec304_0 + (let ((s_3 (cdr s_2))) + (let ((s_4 + (if (syntax?$1 s_3) + (syntax-e$1 s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + req_1) + flat-s_0)))))) + (let ((phase-level303_1 + phase-level303_0)) + (values + phase-level303_1 + spec304_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + req_1))))) (case-lambda - ((for-label313_0 spec314_0) - (values #t for-label313_0 spec314_0)) + ((phase-level301_0 spec302_0) + (let ((for-meta300_1 for-meta300_0)) + (values + for-meta300_1 + phase-level301_0 + spec302_0))) (args (raise-binding-result-arity-error 2 args))))) + (raise-syntax-error$1 #f "bad syntax" req_1)))) + (case-lambda + ((for-meta297_0 phase-level298_0 spec299_0) + (values #t for-meta297_0 phase-level298_0 spec299_0)) + (args (raise-binding-result-arity-error 3 args))))) + (case-lambda + ((ok?_0 for-meta297_0 phase-level298_0 spec299_0) + (let ((p_0 (syntax-e$1 phase-level298_0))) + (begin + (if (phase? p_0) + (void) + (raise-syntax-error$1 #f "bad phase" req_1)) + (let ((new-req_0 + (let ((app_0 (phase+ p_0 1))) + (list* + for-meta297_0 + app_0 + (map_1346 (loop_0 #t) spec299_0))))) + (begin-unsafe + (begin + (datum->syntax$1 + req_1 + new-req_0 + req_1 + req_1))))))) + (args (raise-binding-result-arity-error 4 args)))) + (if (eq? fm_0 'for-syntax) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 req_1) + (syntax-e$1 req_1) + req_1))) + (if (pair? s_0) + (let ((for-syntax307_0 + (let ((s_1 (car s_0))) s_1))) + (let ((spec308_0 + (let ((s_1 (cdr s_0))) + (let ((s_2 + (if (syntax?$1 s_1) + (syntax-e$1 s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 s_2))) + (if (not flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + req_1) + flat-s_0)))))) + (let ((for-syntax307_1 for-syntax307_0)) + (values for-syntax307_1 spec308_0)))) + (raise-syntax-error$1 #f "bad syntax" req_1)))) + (case-lambda + ((for-syntax305_0 spec306_0) + (values #t for-syntax305_0 spec306_0)) + (args (raise-binding-result-arity-error 2 args))))) + (case-lambda + ((ok?_0 for-syntax305_0 spec306_0) + (let ((new-req_0 + (list* + 'for-meta + 2 + (map_1346 (loop_0 #t) spec306_0)))) + (begin-unsafe + (begin + (datum->syntax$1 req_1 new-req_0 req_1 req_1))))) + (args (raise-binding-result-arity-error 3 args)))) + (if (eq? fm_0 'for-template) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 req_1) + (syntax-e$1 req_1) + req_1))) + (if (pair? s_0) + (let ((for-template311_0 + (let ((s_1 (car s_0))) s_1))) + (let ((spec312_0 + (let ((s_1 (cdr s_0))) + (let ((s_2 + (if (syntax?$1 s_1) + (syntax-e$1 s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 s_2))) + (if (not flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + req_1) + flat-s_0)))))) + (let ((for-template311_1 + for-template311_0)) + (values for-template311_1 spec312_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + req_1)))) + (case-lambda + ((for-template309_0 spec310_0) + (values #t for-template309_0 spec310_0)) + (args + (raise-binding-result-arity-error 2 args))))) + (case-lambda + ((ok?_0 for-template309_0 spec310_0) + (let ((new-req_0 + (list* + 'for-meta + 0 + (map_1346 (loop_0 #t) spec310_0)))) + (begin-unsafe + (begin + (datum->syntax$1 + req_1 + new-req_0 + req_1 + req_1))))) + (args (raise-binding-result-arity-error 3 args)))) + (if (eq? fm_0 'for-label) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 req_1) + (syntax-e$1 req_1) + req_1))) + (if (pair? s_0) + (let ((for-label315_0 + (let ((s_1 (car s_0))) s_1))) + (let ((spec316_0 + (let ((s_1 (cdr s_0))) + (let ((s_2 + (if (syntax?$1 s_1) + (syntax-e$1 s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + req_1) + flat-s_0)))))) + (let ((for-label315_1 for-label315_0)) + (values for-label315_1 spec316_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + req_1)))) (case-lambda - ((ok?_0 for-label313_0 spec314_0) - (let ((new-req_0 - (list* - for-label313_0 - (map_2960 (loop_0 #t) spec314_0)))) - (begin-unsafe - (begin - (datum->syntax$1 - req_0 - new-req_0 - req_0 - req_0))))) + ((for-label313_0 spec314_0) + (values #t for-label313_0 spec314_0)) (args - (raise-binding-result-arity-error 3 args)))) - (if (eq? fm_0 'just-meta) + (raise-binding-result-arity-error 2 args))))) + (case-lambda + ((ok?_0 for-label313_0 spec314_0) + (let ((new-req_0 + (list* + for-label313_0 + (map_1346 (loop_0 #t) spec314_0)))) + (begin-unsafe + (begin + (datum->syntax$1 + req_1 + new-req_0 + req_1 + req_1))))) + (args (raise-binding-result-arity-error 3 args)))) + (if (eq? fm_0 'just-meta) + (call-with-values + (lambda () (call-with-values (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 req_0) - (syntax-e$1 req_0) - req_0))) - (if (pair? s_0) - (let ((just-meta320_0 - (let ((s_1 (car s_0))) s_1))) - (call-with-values - (lambda () - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (if (pair? s_2) - (let ((phase-level323_0 - (let ((s_3 - (car s_2))) - s_3))) - (let ((spec324_0 - (let ((s_3 - (cdr s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (let ((flat-s_0 - (to-syntax-list.1 - s_4))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - req_0) - flat-s_0)))))) - (let ((phase-level323_1 - phase-level323_0)) - (values - phase-level323_1 - spec324_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0))))) - (case-lambda - ((phase-level321_0 spec322_0) - (let ((just-meta320_1 - just-meta320_0)) - (values - just-meta320_1 - phase-level321_0 - spec322_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - req_0)))) - (case-lambda - ((just-meta317_0 - phase-level318_0 - spec319_0) - (values - #t - just-meta317_0 - phase-level318_0 - spec319_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) + (let ((s_0 + (if (syntax?$1 req_1) + (syntax-e$1 req_1) + req_1))) + (if (pair? s_0) + (let ((just-meta320_0 + (let ((s_1 (car s_0))) s_1))) + (call-with-values + (lambda () + (let ((s_1 (cdr s_0))) + (let ((s_2 + (if (syntax?$1 s_1) + (syntax-e$1 s_1) + s_1))) + (if (pair? s_2) + (let ((phase-level323_0 + (let ((s_3 (car s_2))) + s_3))) + (let ((spec324_0 + (let ((s_3 + (cdr s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + req_1) + flat-s_0)))))) + (let ((phase-level323_1 + phase-level323_0)) + (values + phase-level323_1 + spec324_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + req_1))))) + (case-lambda + ((phase-level321_0 spec322_0) + (let ((just-meta320_1 + just-meta320_0)) + (values + just-meta320_1 + phase-level321_0 + spec322_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + req_1)))) (case-lambda - ((ok?_0 + ((just-meta317_0 phase-level318_0 spec319_0) + (values + #t just-meta317_0 phase-level318_0 - spec319_0) - (let ((new-req_0 - (list* - just-meta317_0 - phase-level318_0 - (map_2960 (loop_0 #f) spec319_0)))) - (begin-unsafe - (begin - (datum->syntax$1 - req_0 - new-req_0 - req_0 - req_0))))) + spec319_0)) (args - (raise-binding-result-arity-error 4 args)))) - (if shifted?_0 - req_0 - (datum->syntax$1 - #f - (list 'for-syntax req_0)))))))))))))) - (rebuild-req_0 - (|#%name| - rebuild-req - (lambda (req_0 new-req_0) - (begin (datum->syntax$1 req_0 new-req_0 req_0 req_0)))))) - (lambda (req_0) (|#%app| (loop_0 #f) req_0)))) + (raise-binding-result-arity-error 3 args))))) + (case-lambda + ((ok?_0 + just-meta317_0 + phase-level318_0 + spec319_0) + (let ((new-req_0 + (list* + just-meta317_0 + phase-level318_0 + (map_1346 (loop_0 #f) spec319_0)))) + (begin-unsafe + (begin + (datum->syntax$1 + req_1 + new-req_0 + req_1 + req_1))))) + (args + (raise-binding-result-arity-error 4 args)))) + (if shifted?_0 + req_1 + (datum->syntax$1 + #f + (list 'for-syntax req_1))))))))))))))) + (|#%app| (loop_0 #f) req_0))))) (define copy-namespace-value (lambda (m-ns_0 adjusted-sym_0 @@ -34388,21 +34067,23 @@ (lambda (e_0) (let ((l_0 (correlated-e e_0))) (if (list? l_0) (length l_0) #f)))) (define correlated->list - (letrec ((loop_0 - (|#%name| - loop - (lambda (e_0) - (begin - (if (list? e_0) - e_0 - (if (pair? e_0) - (let ((app_0 (car e_0))) (cons app_0 (loop_0 (cdr e_0)))) - (if (null? e_0) - null - (if (syntax? e_0) - (loop_0 (syntax-e e_0)) - (error 'correlated->list "not a list")))))))))) - (lambda (e_0) (loop_0 e_0)))) + (lambda (e_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (e_1) + (begin + (if (list? e_1) + e_1 + (if (pair? e_1) + (let ((app_0 (car e_1))) (cons app_0 (loop_0 (cdr e_1)))) + (if (null? e_1) + null + (if (syntax? e_1) + (loop_0 (syntax-e e_1)) + (error 'correlated->list "not a list")))))))))) + (loop_0 e_0)))) (define correlated-property (case-lambda ((e_0 k_0) (syntax-property e_0 k_0)) @@ -35107,195 +34788,196 @@ o_0) (get-output-bytes o_0))))) (define write-linklet-directory - (letrec ((procz1 - (|#%name| - temp2 - (lambda (a_0 b_0) - (begin (let ((app_0 (car a_0))) (byteshash_0 - linklet-directory->hash_0 - ld_0 - rev-name-prefix_0 - accum_0) - (begin - (call-with-values - (lambda () - (let ((ht_0 (|#%app| linklet-directory->hash_0 ld_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (accum_1 saw-bundle?_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value ht_0 i_0)) - (case-lambda - ((key_0 value_0) - (call-with-values - (lambda () - (call-with-values - (lambda () - (if (eq? key_0 #f) - (values - (cons - (let ((app_0 - (encode-name - rev-name-prefix_0))) - (cons - app_0 - (linklet-bundle->bytes - value_0 - as-correlated-linklet?_0 - linklet-bundle->hash_0))) - accum_1) - #t) - (values - (flatten-linklet-directory_0 - as-correlated-linklet?_0 - linklet-bundle->hash_0 - linklet-directory->hash_0 - value_0 - (cons key_0 rev-name-prefix_0) - accum_1) - saw-bundle?_0))) - (case-lambda - ((accum_2 saw-bundle?_1) - (values accum_2 saw-bundle?_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((accum_2 saw-bundle?_1) - (for-loop_0 - accum_2 - saw-bundle?_1 - (hash-iterate-next ht_0 i_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values accum_1 saw-bundle?_0))))))) - (for-loop_0 accum_0 #f (hash-iterate-first ht_0)))))) - (case-lambda - ((new-accum_0 saw-bundle?_0) - (if saw-bundle?_0 - new-accum_0 - (cons - (cons (encode-name rev-name-prefix_0) #vu8(35 102)) - new-accum_0))) - (args (raise-binding-result-arity-error 2 args))))))))) - (lambda (ld_0 - as-correlated-linklet?_0 - linklet-directory->hash_0 - linklet-bundle->hash_0 - port_0) - (let ((vm-bytes_0 - (if as-correlated-linklet?_0 - correlated-linklet-vm-bytes - vm-bytes$1))) + (lambda (ld_0 + as-correlated-linklet?_0 + linklet-directory->hash_0 + linklet-bundle->hash_0 + port_0) + (let ((vm-bytes_0 + (if as-correlated-linklet?_0 + correlated-linklet-vm-bytes + vm-bytes$1))) + (begin + (write-bytes #vu8(35 126) port_0) (begin - (write-bytes #vu8(35 126) port_0) + (write-byte (unsafe-bytes-length version-bytes$1) port_0) (begin - (write-byte (unsafe-bytes-length version-bytes$1) port_0) + (write-bytes version-bytes$1 port_0) (begin - (write-bytes version-bytes$1 port_0) + (write-byte (unsafe-bytes-length vm-bytes_0) port_0) (begin - (write-byte (unsafe-bytes-length vm-bytes_0) port_0) + (write-bytes vm-bytes_0 port_0) (begin - (write-bytes vm-bytes_0 port_0) - (begin - (write-bytes #vu8(68) port_0) - (let ((bundles_0 - (list->vector - (let ((temp1_0 - (flatten-linklet-directory_0 - as-correlated-linklet?_0 - linklet-bundle->hash_0 - linklet-directory->hash_0 - ld_0 - '() - '()))) - (let ((temp2_0 procz1)) - (let ((temp1_1 temp1_0)) - (sort.1 #f #f temp1_1 temp2_0))))))) - (let ((len_0 (vector-length bundles_0))) - (let ((initial-offset_0 - (+ - 2 - 1 - (unsafe-bytes-length version-bytes$1) - 1 - (unsafe-bytes-length vm-bytes_0) - 1 - 4))) - (begin - (write-int len_0 port_0) - (let ((btree-size_0 - (compute-btree-size bundles_0 len_0))) - (let ((node-offsets_0 - (compute-btree-node-offsets - bundles_0 - len_0 - initial-offset_0))) - (let ((bundle-offsets_0 - (compute-bundle-offsets - bundles_0 - len_0 - (+ initial-offset_0 btree-size_0)))) - (begin - (write-directory-btree + (write-bytes #vu8(68) port_0) + (letrec* + ((flatten-linklet-directory_0 + (|#%name| + flatten-linklet-directory + (lambda (ld_1 rev-name-prefix_0 accum_0) + (begin + (call-with-values + (lambda () + (let ((ht_0 + (|#%app| linklet-directory->hash_0 ld_1))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (accum_1 saw-bundle?_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + ht_0 + i_0)) + (case-lambda + ((key_0 value_0) + (call-with-values + (lambda () + (call-with-values + (lambda () + (if (eq? key_0 #f) + (values + (cons + (let ((app_0 + (encode-name + rev-name-prefix_0))) + (cons + app_0 + (linklet-bundle->bytes + value_0 + as-correlated-linklet?_0 + linklet-bundle->hash_0))) + accum_1) + #t) + (values + (flatten-linklet-directory_0 + value_0 + (cons + key_0 + rev-name-prefix_0) + accum_1) + saw-bundle?_0))) + (case-lambda + ((accum_2 saw-bundle?_1) + (values + accum_2 + saw-bundle?_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((accum_2 saw-bundle?_1) + (for-loop_0 + accum_2 + saw-bundle?_1 + (hash-iterate-next + ht_0 + i_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values accum_1 saw-bundle?_0))))))) + (for-loop_0 + accum_0 + #f + (hash-iterate-first ht_0)))))) + (case-lambda + ((new-accum_0 saw-bundle?_0) + (if saw-bundle?_0 + new-accum_0 + (cons + (cons (encode-name rev-name-prefix_0) #vu8(35 102)) + new-accum_0))) + (args + (raise-binding-result-arity-error 2 args))))))))) + (let ((bundles_0 + (list->vector + (let ((temp1_0 + (flatten-linklet-directory_0 ld_0 '() '()))) + (let ((temp2_0 + (|#%name| + temp2 + (lambda (a_0 b_0) + (begin + (let ((app_0 (car a_0))) + (bytesbytes/utf-8 (symbol->string s_0)))) - (let ((len_0 (unsafe-bytes-length bstr_0))) - (if (< len_0 255) - (list (bytes len_0) bstr_0) - (let ((app_0 (bytes 255))) - (list - app_0 - (integer->integer-bytes len_0 4 #f #f) - bstr_0)))))))))) - (lambda (rev-name_0) + (lambda (rev-name_0) + (let ((encode-symbol_0 + (|#%name| + encode-symbol + (lambda (s_0) + (begin + (let ((bstr_0 (string->bytes/utf-8 (symbol->string s_0)))) + (let ((len_0 (unsafe-bytes-length bstr_0))) + (if (< len_0 255) + (list (bytes len_0) bstr_0) + (let ((app_0 (bytes 255))) + (list + app_0 + (integer->integer-bytes len_0 4 #f #f) + bstr_0)))))))))) (letrec* ((loop_0 (|#%name| @@ -35332,38 +35014,28 @@ result_0)))))) (for-loop_0 0 0))))) (define compute-btree-node-offsets - (letrec ((loop_0 - (|#%name| - loop - (lambda (bundles_0 node-offsets_0 lo_0 hi_0 offset_0) - (begin - (if (= lo_0 hi_0) - offset_0 - (let ((mid_0 (quotient (+ lo_0 hi_0) 2))) - (begin - (vector-set! node-offsets_0 mid_0 offset_0) - (let ((nlen_0 - (unsafe-bytes-length - (car (vector-ref bundles_0 mid_0))))) - (let ((offset_1 (+ offset_0 4 nlen_0 4 4 4 4))) - (let ((offset_2 - (loop_0 - bundles_0 - node-offsets_0 - lo_0 - mid_0 - offset_1))) - (loop_0 - bundles_0 - node-offsets_0 - (add1 mid_0) - hi_0 - offset_2)))))))))))) - (lambda (bundles_0 len_0 initial-offset_0) - (let ((node-offsets_0 (make-vector len_0))) - (begin - (loop_0 bundles_0 node-offsets_0 0 len_0 initial-offset_0) - node-offsets_0))))) + (lambda (bundles_0 len_0 initial-offset_0) + (let ((node-offsets_0 (make-vector len_0))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (lo_0 hi_0 offset_0) + (begin + (if (= lo_0 hi_0) + offset_0 + (let ((mid_0 (quotient (+ lo_0 hi_0) 2))) + (begin + (vector-set! node-offsets_0 mid_0 offset_0) + (let ((nlen_0 + (unsafe-bytes-length + (car (vector-ref bundles_0 mid_0))))) + (let ((offset_1 (+ offset_0 4 nlen_0 4 4 4 4))) + (let ((offset_2 (loop_0 lo_0 mid_0 offset_1))) + (loop_0 (add1 mid_0) hi_0 offset_2)))))))))))) + (loop_0 0 len_0 initial-offset_0)) + node-offsets_0)))) (define compute-bundle-offsets (lambda (bundles_0 len_0 offset_0) (let ((bundle-offsets_0 (make-vector len_0))) @@ -35388,57 +35060,38 @@ (loop_0 0 offset_0)) bundle-offsets_0)))) (define write-directory-btree - (letrec ((loop_0 - (|#%name| - loop - (lambda (bundle-offsets_0 - bundles_0 - node-offsets_0 - port_0 - lo_0 - hi_0) - (begin - (if (= lo_0 hi_0) - (void) - (let ((mid_0 (quotient (+ lo_0 hi_0) 2))) - (let ((p_0 (vector-ref bundles_0 mid_0))) - (let ((nlen_0 (unsafe-bytes-length (car p_0)))) - (begin - (write-int nlen_0 port_0) - (write-bytes (car p_0) port_0) - (write-int - (vector-ref bundle-offsets_0 mid_0) - port_0) - (write-int (unsafe-bytes-length (cdr p_0)) port_0) - (if (> mid_0 lo_0) - (let ((left_0 (quotient (+ lo_0 mid_0) 2))) - (write-int - (vector-ref node-offsets_0 left_0) - port_0)) - (write-int 0 port_0)) - (if (< (add1 mid_0) hi_0) - (let ((right_0 - (quotient (+ (add1 mid_0) hi_0) 2))) - (write-int - (vector-ref node-offsets_0 right_0) - port_0)) - (write-int 0 port_0)) - (loop_0 - bundle-offsets_0 - bundles_0 - node-offsets_0 - port_0 - lo_0 - mid_0) - (loop_0 - bundle-offsets_0 - bundles_0 - node-offsets_0 - port_0 - (add1 mid_0) - hi_0))))))))))) - (lambda (bundles_0 node-offsets_0 bundle-offsets_0 len_0 port_0) - (loop_0 bundle-offsets_0 bundles_0 node-offsets_0 port_0 0 len_0)))) + (lambda (bundles_0 node-offsets_0 bundle-offsets_0 len_0 port_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (lo_0 hi_0) + (begin + (if (= lo_0 hi_0) + (void) + (let ((mid_0 (quotient (+ lo_0 hi_0) 2))) + (let ((p_0 (vector-ref bundles_0 mid_0))) + (let ((nlen_0 (unsafe-bytes-length (car p_0)))) + (begin + (write-int nlen_0 port_0) + (write-bytes (car p_0) port_0) + (write-int (vector-ref bundle-offsets_0 mid_0) port_0) + (write-int (unsafe-bytes-length (cdr p_0)) port_0) + (if (> mid_0 lo_0) + (let ((left_0 (quotient (+ lo_0 mid_0) 2))) + (write-int + (vector-ref node-offsets_0 left_0) + port_0)) + (write-int 0 port_0)) + (if (< (add1 mid_0) hi_0) + (let ((right_0 (quotient (+ (add1 mid_0) hi_0) 2))) + (write-int + (vector-ref node-offsets_0 right_0) + port_0)) + (write-int 0 port_0)) + (loop_0 lo_0 mid_0) + (loop_0 (add1 mid_0) hi_0))))))))))) + (loop_0 0 len_0)))) (define write-int (lambda (n_0 port_0) (write-bytes (integer->integer-bytes n_0 4 #f #f) port_0))) @@ -37001,15 +36654,16 @@ (lambda (on?_0) (set! keep-source-locations? on?_0))) (define compile$2 (let ((compile_0 - (letrec ((compile_0 - (|#%name| - compile - (lambda (cctx4_0 p_0 name_0 result-used?_0) - (begin (compile$2 p_0 cctx4_0 name_0 result-used?_0)))))) - (|#%name| - compile - (lambda (p3_0 cctx4_0 name1_0 result-used?2_0) - (begin + (|#%name| + compile + (lambda (p3_0 cctx4_0 name1_0 result-used?2_0) + (begin + (let ((compile_0 + (|#%name| + compile + (lambda (p_0 name_0 result-used?_0) + (begin + (compile$2 p_0 cctx4_0 name_0 result-used?_0)))))) (let ((s_0 (parsed-s p3_0))) (if (parsed-id? p3_0) (compile-identifier.1 #f #f p3_0 cctx4_0) @@ -37398,48 +37052,49 @@ fold-var_0)))))) (for-loop_0 null es_0 0)))))))) (define add-lambda-properties - (letrec ((simplify-name_0 - (|#%name| - simplify-name - (lambda (v_0) - (begin - (if (pair? v_0) - (let ((n1_0 (simplify-name_0 (car v_0)))) - (let ((n2_0 (simplify-name_0 (cdr v_0)))) - (if (eq? n1_0 n2_0) n1_0 v_0))) - v_0)))))) - (lambda (s_0 inferred-name_0 orig-s_0) - (let ((name_0 - (let ((or-part_0 - (let ((v_0 - (simplify-name_0 - (syntax-property$1 orig-s_0 'inferred-name)))) - (if (let ((or-part_0 (symbol? v_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (if (syntax?$1 v_0) - (symbol? (syntax-e$1 v_0)) - #f))) - (if or-part_1 or-part_1 (void? v_0))))) - v_0 - #f)))) - (if or-part_0 or-part_0 inferred-name_0)))) - (let ((named-s_0 - (if name_0 - (let ((e_0 (begin-unsafe (datum->correlated s_0 #f)))) + (lambda (s_0 inferred-name_0 orig-s_0) + (letrec* + ((simplify-name_0 + (|#%name| + simplify-name + (lambda (v_0) + (begin + (if (pair? v_0) + (let ((n1_0 (simplify-name_0 (car v_0)))) + (let ((n2_0 (simplify-name_0 (cdr v_0)))) + (if (eq? n1_0 n2_0) n1_0 v_0))) + v_0)))))) + (let ((name_0 + (let ((or-part_0 (let ((v_0 - (if (syntax?$1 name_0) (syntax-e$1 name_0) name_0))) - (let ((e_1 e_0)) - (begin-unsafe - (syntax-property e_1 'inferred-name v_0))))) - s_0))) - (let ((as-method_0 (syntax-property$1 orig-s_0 'method-arity-error))) - (if as-method_0 - (let ((e_0 (begin-unsafe (datum->correlated named-s_0 #f)))) - (begin-unsafe - (syntax-property e_0 'method-arity-error as-method_0))) - named-s_0))))))) + (simplify-name_0 + (syntax-property$1 orig-s_0 'inferred-name)))) + (if (let ((or-part_0 (symbol? v_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (if (syntax?$1 v_0) + (symbol? (syntax-e$1 v_0)) + #f))) + (if or-part_1 or-part_1 (void? v_0))))) + v_0 + #f)))) + (if or-part_0 or-part_0 inferred-name_0)))) + (let ((named-s_0 + (if name_0 + (let ((e_0 (begin-unsafe (datum->correlated s_0 #f)))) + (let ((v_0 + (if (syntax?$1 name_0) (syntax-e$1 name_0) name_0))) + (let ((e_1 e_0)) + (begin-unsafe + (syntax-property e_1 'inferred-name v_0))))) + s_0))) + (let ((as-method_0 (syntax-property$1 orig-s_0 'method-arity-error))) + (if as-method_0 + (let ((e_0 (begin-unsafe (datum->correlated named-s_0 #f)))) + (begin-unsafe + (syntax-property e_0 'method-arity-error as-method_0))) + named-s_0))))))) (define compile-let.1 (|#%name| compile-let @@ -38260,1235 +37915,1157 @@ 'link-info 'def-decls)))))) (define compile-forms.1 - (letrec ((procz1 - (|#%name| - get-module-linklet-info - (lambda (mod-name_0 p_0) (begin #f)))) - (add-body!_0 - (|#%name| - add-body! - (lambda (phase-to-body_0 phase_0 body_0) - (begin - (let ((xform_0 (lambda (l_0) (cons body_0 l_0)))) - (begin-unsafe - (do-hash-update - 'hash-update! - #t - hash-set! - phase-to-body_0 - phase_0 - xform_0 - null))))))) - (as-required?_0 - (|#%name| - as-required? - (lambda (header_0) - (begin - (lambda (sym_0) (registered-as-required? header_0 sym_0)))))) - (find-or-create-header!_0 - (|#%name| - find-or-create-header! - (lambda (mpis34_0 phase-to-header_0 syntax-literals_0 phase_0) - (begin - (let ((or-part_0 (hash-ref phase-to-header_0 phase_0 #f))) - (if or-part_0 - or-part_0 - (let ((header_0 (make-header mpis34_0 syntax-literals_0))) - (begin - (hash-set! phase-to-header_0 phase_0 header_0) - header_0)))))))) - (loop!_0 - (|#%name| - loop! - (lambda (mpis34_0 - phase-to-header_0 - syntax-literals_0 - bodys_0 - phase_0 - header_0) - (begin - (begin - (begin - (letrec* - ((for-loop_0 + (|#%name| + compile-forms + (lambda (body-import-instances3_0 + body-imports2_0 + body-suffix-forms4_0 + compiled-expression-callback8_0 + definition-callback9_0 + encoded-root-expand-ctx-box6_0 + force-phases5_0 + get-module-linklet-info11_0 + module-prompt?13_0 + optimize-linklet?15_0 + other-form-callback10_0 + root-ctx-only-if-syntax?7_0 + serializable?12_0 + to-correlated-linklet?14_0 + unsafe?-box16_0 + bodys32_0 + cctx33_0 + mpis34_0) + (begin + (let ((get-module-linklet-info_0 + (if (eq? get-module-linklet-info11_0 unsafe-undefined) + (|#%name| + get-module-linklet-info + (lambda (mod-name_0 p_0) (begin #f))) + get-module-linklet-info11_0))) + (let ((phase_0 (compile-context-phase cctx33_0))) + (let ((self_0 (compile-context-self cctx33_0))) + (let ((syntax-literals_0 (make-syntax-literals))) + (let ((phase-to-body_0 (make-hasheqv))) + (let ((add-body!_0 (|#%name| - for-loop - (lambda (lst_0) + add-body! + (lambda (phase_1 body_0) (begin - (if (pair? lst_0) - (let ((body_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (if (parsed-define-values? body_0) - (begin - (let ((lst_1 - (parsed-define-values-syms - body_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (lst_2) - (begin - (if (pair? lst_2) - (let ((sym_0 - (unsafe-car - lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (begin - (let ((def-sym_0 - (select-fresh - sym_0 - header_0))) - (begin - (hash-set! - (header-binding-sym-to-define-sym - header_0) - sym_0 - def-sym_0) - (set-header-binding-syms-in-order! - header_0 - (cons - sym_0 - (header-binding-syms-in-order - header_0))) - (begin-unsafe - (hash-set! - (header-define-and-import-syms - header_0) - def-sym_0 - 'defined)))) - (for-loop_1 - rest_1)))) - (values))))))) - (for-loop_1 lst_1)))) - (void)) - (if (parsed-begin-for-syntax? body_0) - (let ((app_0 - (parsed-begin-for-syntax-body - body_0))) - (let ((app_1 (add1 phase_0))) - (loop!_0 - mpis34_0 - phase-to-header_0 - syntax-literals_0 - app_0 - app_1 - (find-or-create-header!_0 - mpis34_0 - phase-to-header_0 - syntax-literals_0 - (add1 phase_0))))) - (void))) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 bodys_0))) - (void)))))) - (loop!_1 - (|#%name| - loop! - (lambda (cctx33_0 - compiled-expression-callback8_0 - definition-callback9_0 - last-i_0 - mpis34_0 - other-form-callback10_0 - phase-to-body_0 - phase-to-header_0 - saw-define-syntaxes?_0 - syntax-literals_0 - bodys_0 - phase_0 - header_0) - (begin - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0 pos_0) - (begin - (if (if (pair? lst_0) #t #f) - (let ((body_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (if (parsed-define-values? body_0) - (let ((ids_0 - (parsed-define-values-ids - body_0))) - (let ((binding-syms_0 - (parsed-define-values-syms - body_0))) - (let ((def-syms_0 - (if (compile-context-module-self - cctx33_0) - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1 - lst_2) - (begin - (if (if (pair? - lst_1) - (pair? - lst_2) - #f) - (let ((binding-sym_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((id_0 - (unsafe-car - lst_2))) - (let ((rest_2 - (unsafe-cdr - lst_2))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((app_0 - (hash-ref - (header-binding-sym-to-define-sym - header_0) - binding-sym_0))) - (correlate-source-name - app_0 - (syntax-e$1 - id_0))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_1 - fold-var_1 - rest_1 - rest_2)))))) - fold-var_0)))))) - (for-loop_1 - null - binding-syms_0 - ids_0)))) - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((binding-sym_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((temp62_0 - (compile-context-self - cctx33_0))) - (register-required-variable-use!.1 - #t - header_0 - temp62_0 - phase_0 - binding-sym_0 - #f)) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_1 - fold-var_1 - rest_1)))) - fold-var_0)))))) - (for-loop_1 - null - binding-syms_0))))))) - (let ((rhs_0 - (let ((app_0 - (parsed-define-values-rhs - body_0))) - (let ((app_1 - (if (compile-context? - cctx33_0) - (let ((app_1 - (compile-context-namespace - cctx33_0))) - (let ((app_2 - (compile-context-self - cctx33_0))) - (let ((app_3 - (compile-context-module-self - cctx33_0))) - (let ((app_4 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_1 - phase_0 - app_2 - app_3 - app_4 - (compile-context-lazy-syntax-literals? - cctx33_0) - header_0))))) - (raise-argument-error - 'struct-copy - "compile-context?" - cctx33_0)))) - (compile$2 - app_0 - app_1 - (if (= - (length ids_0) - 1) - (car ids_0) - #f)))))) - (begin - (|#%app| - definition-callback9_0) - (let ((app_0 - (length def-syms_0))) - (|#%app| - compiled-expression-callback8_0 - rhs_0 - app_0 - phase_0 - (as-required?_0 header_0))) - (add-body!_0 - phase-to-body_0 - phase_0 - (let ((app_0 - (correlate* - (parsed-s body_0) - (list - 'define-values - def-syms_0 - rhs_0)))) - (propagate-inline-property - app_0 - (parsed-s body_0)))) - (if (let ((or-part_0 - (compile-context-module-self - cctx33_0))) - (if or-part_0 - or-part_0 - (null? ids_0))) - (void) - (begin - (add-body!_0 - phase-to-body_0 - phase_0 - (list* - 'if - #f - (list* - 'begin - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((def-sym_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (cons - (list* - 'set! - def-sym_0 - '(#f)) - fold-var_0))) - (let ((fold-var_2 - (values - fold-var_1))) - (for-loop_1 - fold-var_2 - rest_1))))) - fold-var_0)))))) - (for-loop_1 - null - def-syms_0))))) - '((void)))) - (add-body!_0 - phase-to-body_0 - phase_0 - (compile-top-level-bind - ids_0 - binding-syms_0 - (if (compile-context? - cctx33_0) - (let ((app_0 - (compile-context-namespace - cctx33_0))) - (let ((app_1 - (compile-context-self - cctx33_0))) - (let ((app_2 - (compile-context-module-self - cctx33_0))) - (let ((app_3 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_0 - phase_0 - app_1 - app_2 - app_3 - (compile-context-lazy-syntax-literals? - cctx33_0) - header_0))))) - (raise-argument-error - 'struct-copy - "compile-context?" - cctx33_0)) - #f))))))))) - (if (parsed-define-syntaxes? body_0) - (let ((ids_0 - (parsed-define-syntaxes-ids - body_0))) - (let ((binding-syms_0 - (parsed-define-syntaxes-syms - body_0))) - (let ((next-header_0 - (find-or-create-header!_0 - mpis34_0 - phase-to-header_0 - syntax-literals_0 - (add1 phase_0)))) - (let ((gen-syms_0 - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((binding-sym_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((gen-sym_0 - (select-fresh - binding-sym_0 - next-header_0))) - (begin - (begin-unsafe - (hash-set! - (header-define-and-import-syms - next-header_0) - gen-sym_0 - 'defined)) - gen-sym_0)) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_1 - fold-var_1 - rest_1)))) - fold-var_0)))))) - (for-loop_1 - null - binding-syms_0)))))) - (let ((rhs_0 - (let ((app_0 - (parsed-define-syntaxes-rhs - body_0))) - (compile$2 - app_0 - (if (compile-context? - cctx33_0) - (let ((phase71_0 - (add1 - phase_0))) - (let ((app_1 - (compile-context-namespace - cctx33_0))) - (let ((app_2 - (compile-context-self - cctx33_0))) - (let ((app_3 - (compile-context-module-self - cctx33_0))) - (let ((app_4 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_1 - phase71_0 - app_2 - app_3 - app_4 - (compile-context-lazy-syntax-literals? - cctx33_0) - next-header_0)))))) - (raise-argument-error - 'struct-copy - "compile-context?" - cctx33_0)))))) - (begin - (|#%app| - definition-callback9_0) - (begin - (let ((app_0 - (length - gen-syms_0))) - (let ((app_1 - (add1 - phase_0))) - (|#%app| - compiled-expression-callback8_0 - rhs_0 - app_0 - app_1 - (as-required?_0 - header_0)))) - (let ((transformer-set!s_0 - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1 - lst_2) - (begin - (if (if (pair? - lst_1) - (pair? - lst_2) - #f) - (let ((binding-sym_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((gen-sym_0 - (unsafe-car - lst_2))) - (let ((rest_2 - (unsafe-cdr - lst_2))) - (let ((fold-var_1 - (cons - (list - set-transformer!-id - (list - 'quote - binding-sym_0) - gen-sym_0) - fold-var_0))) - (let ((fold-var_2 - (values - fold-var_1))) - (for-loop_1 - fold-var_2 - rest_1 - rest_2))))))) - fold-var_0)))))) - (for-loop_1 - null - binding-syms_0 - gen-syms_0)))))) - (begin - (if (compile-context-module-self - cctx33_0) - (let ((app_0 - (add1 - phase_0))) - (add-body!_0 - phase-to-body_0 - app_0 - (list - 'let-values - (list - (list - gen-syms_0 - rhs_0)) - (list* - 'begin - (qq-append - transformer-set!s_0 - '((void))))))) - (let ((app_0 - (add1 - phase_0))) - (add-body!_0 - phase-to-body_0 - app_0 - (generate-top-level-define-syntaxes - gen-syms_0 - rhs_0 - transformer-set!s_0 - (compile-top-level-bind - ids_0 - binding-syms_0 - (if (compile-context? - cctx33_0) - (let ((app_1 - (compile-context-namespace - cctx33_0))) - (let ((app_2 - (compile-context-self - cctx33_0))) - (let ((app_3 - (compile-context-module-self - cctx33_0))) - (let ((app_4 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_1 - phase_0 - app_2 - app_3 - app_4 - (compile-context-lazy-syntax-literals? - cctx33_0) - header_0))))) - (raise-argument-error - 'struct-copy - "compile-context?" - cctx33_0)) - gen-syms_0))))) - (unsafe-set-box*! - saw-define-syntaxes?_0 - #t)))))))))) - (if (parsed-begin-for-syntax? body_0) - (let ((app_0 - (parsed-begin-for-syntax-body - body_0))) - (let ((app_1 (add1 phase_0))) - (loop!_1 - cctx33_0 - compiled-expression-callback8_0 - definition-callback9_0 - last-i_0 - mpis34_0 - other-form-callback10_0 - phase-to-body_0 - phase-to-header_0 - saw-define-syntaxes?_0 - syntax-literals_0 - app_0 - app_1 - (find-or-create-header!_0 - mpis34_0 - phase-to-header_0 - syntax-literals_0 - (add1 phase_0))))) - (if (let ((or-part_0 - (|parsed-#%declare?| - body_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (parsed-module? - body_0))) - (if or-part_1 - or-part_1 - (parsed-require? - body_0))))) - (let ((e_0 - (|#%app| - other-form-callback10_0 - body_0 - (if (compile-context? - cctx33_0) - (let ((app_0 - (compile-context-namespace - cctx33_0))) - (let ((app_1 - (compile-context-self - cctx33_0))) - (let ((app_2 - (compile-context-module-self - cctx33_0))) - (let ((app_3 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_0 - phase_0 - app_1 - app_2 - app_3 - (compile-context-lazy-syntax-literals? - cctx33_0) - header_0))))) - (raise-argument-error - 'struct-copy - "compile-context?" - cctx33_0))))) - (if e_0 - (begin - (|#%app| - compiled-expression-callback8_0 - e_0 - #f - phase_0 - (as-required?_0 header_0)) - (add-body!_0 - phase-to-body_0 - phase_0 - e_0)) - (void))) - (let ((e_0 - (let ((app_0 - (if (compile-context? - cctx33_0) - (let ((app_0 - (compile-context-namespace - cctx33_0))) - (let ((app_1 - (compile-context-self - cctx33_0))) - (let ((app_2 - (compile-context-module-self - cctx33_0))) - (let ((app_3 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_0 - phase_0 - app_1 - app_2 - app_3 - (compile-context-lazy-syntax-literals? - cctx33_0) - header_0))))) - (raise-argument-error - 'struct-copy - "compile-context?" - cctx33_0)))) - (compile$2 - body_0 - app_0 - #f - (= pos_0 last-i_0))))) - (begin - (|#%app| - compiled-expression-callback8_0 - e_0 - #f - phase_0 - (as-required?_0 header_0)) - (add-body!_0 - phase-to-body_0 - phase_0 - e_0))))))) - (for-loop_0 rest_0 (+ pos_0 1))))) - (values))))))) - (for-loop_0 bodys_0 0))) - (void))))))) - (|#%name| - compile-forms - (lambda (body-import-instances3_0 - body-imports2_0 - body-suffix-forms4_0 - compiled-expression-callback8_0 - definition-callback9_0 - encoded-root-expand-ctx-box6_0 - force-phases5_0 - get-module-linklet-info11_0 - module-prompt?13_0 - optimize-linklet?15_0 - other-form-callback10_0 - root-ctx-only-if-syntax?7_0 - serializable?12_0 - to-correlated-linklet?14_0 - unsafe?-box16_0 - bodys32_0 - cctx33_0 - mpis34_0) - (begin - (let ((get-module-linklet-info_0 - (if (eq? get-module-linklet-info11_0 unsafe-undefined) - procz1 - get-module-linklet-info11_0))) - (let ((phase_0 (compile-context-phase cctx33_0))) - (let ((self_0 (compile-context-self cctx33_0))) - (let ((syntax-literals_0 (make-syntax-literals))) - (let ((phase-to-body_0 (make-hasheqv))) + (let ((xform_0 (lambda (l_0) (cons body_0 l_0)))) + (begin-unsafe + (do-hash-update + 'hash-update! + #t + hash-set! + phase-to-body_0 + phase_1 + xform_0 + null)))))))) (let ((phase-to-header_0 (make-hasheqv))) - (begin - (begin - (letrec* - ((for-loop_0 + (let ((find-or-create-header!_0 (|#%name| - for-loop - (lambda (lst_0) + find-or-create-header! + (lambda (phase_1) (begin - (if (pair? lst_0) - (let ((phase_1 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) + (let ((or-part_0 + (hash-ref + phase-to-header_0 + phase_1 + #f))) + (if or-part_0 + or-part_0 + (let ((header_0 + (make-header + mpis34_0 + syntax-literals_0))) + (begin + (hash-set! + phase-to-header_0 + phase_1 + header_0) + header_0))))))))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((phase_1 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (begin + (find-or-create-header!_0 phase_1) + (add-body!_0 phase_1 '(void))) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 force-phases5_0))) + (let ((saw-define-syntaxes?_0 #f)) + (begin + (if (compile-context-module-self cctx33_0) + (letrec* + ((loop!_0 + (|#%name| + loop! + (lambda (bodys_0 phase_1 header_0) + (begin (begin (begin - (find-or-create-header!_0 - mpis34_0 - phase-to-header_0 - syntax-literals_0 - phase_1) - (add-body!_0 - phase-to-body_0 - phase_1 - '(void))) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 force-phases5_0))) - (let ((saw-define-syntaxes?_0 (box #f))) - (begin - (if (compile-context-module-self cctx33_0) - (loop!_0 - mpis34_0 - phase-to-header_0 - syntax-literals_0 - bodys32_0 - phase_0 - (find-or-create-header!_0 - mpis34_0 - phase-to-header_0 - syntax-literals_0 - phase_0)) - (void)) - (let ((last-i_0 (sub1 (length bodys32_0)))) - (begin - (loop!_1 - cctx33_0 - compiled-expression-callback8_0 - definition-callback9_0 - last-i_0 - mpis34_0 - other-form-callback10_0 - phase-to-body_0 - phase-to-header_0 - saw-define-syntaxes?_0 - syntax-literals_0 - bodys32_0 - phase_0 - (find-or-create-header!_0 - mpis34_0 - phase-to-header_0 - syntax-literals_0 - phase_0)) - (let ((encoded-root-expand-pos_0 - (if encoded-root-expand-ctx-box6_0 - (if (unbox - encoded-root-expand-ctx-box6_0) - (if (not - (if root-ctx-only-if-syntax?7_0 - (if (not - (unsafe-unbox* - saw-define-syntaxes?_0)) - (begin-unsafe - (null? - (syntax-literals-stxes - syntax-literals_0))) - #f) - #f)) - (add-syntax-literal! - syntax-literals_0 - (unbox - encoded-root-expand-ctx-box6_0)) - #f) - #f) - #f))) - (let ((phases-in-order_0 - (let ((temp79_0 - (hash-keys phase-to-body_0))) - (sort.1 #f #f temp79_0 <)))) - (let ((min-phase_0 - (if (pair? phases-in-order_0) - (car phases-in-order_0) - phase_0))) - (let ((max-phase_0 - (if (pair? phases-in-order_0) - (car - (reverse$1 phases-in-order_0)) - phase_0))) - (let ((phase-to-link-info_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 lst_0) - (begin - (if (pair? lst_0) - (let ((phase_1 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (let ((header_0 - (hash-ref - phase-to-header_0 - phase_1 - #f))) - (call-with-values - (lambda () - (generate-links+imports - header_0 - phase_1 - cctx33_0 - optimize-linklet?15_0)) - (case-lambda - ((link-module-uses_0 - imports_0 - extra-inspectorsss_0 - def-decls_0) - (values - phase_1 - (link-info1.1 - link-module-uses_0 - imports_0 - extra-inspectorsss_0 - def-decls_0))) - (args - (raise-binding-result-arity-error - 4 - args)))))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - rest_0)))) - table_0)))))) - (for-loop_0 - hash2725 - phases-in-order_0))))) - (let ((body-linklets+module-use*s_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 lst_0) - (begin - (if (pair? lst_0) - (let ((phase_1 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (let ((bodys_0 - (hash-ref - phase-to-body_0 - phase_1))) - (let ((li_0 - (hash-ref - phase-to-link-info_0 + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((body_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (begin + (if (parsed-define-values? + body_0) + (begin + (let ((lst_1 + (parsed-define-values-syms + body_0))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (lst_2) + (begin + (if (pair? + lst_2) + (let ((sym_0 + (unsafe-car + lst_2))) + (let ((rest_1 + (unsafe-cdr + lst_2))) + (begin + (let ((def-sym_0 + (select-fresh + sym_0 + header_0))) + (begin + (hash-set! + (header-binding-sym-to-define-sym + header_0) + sym_0 + def-sym_0) + (set-header-binding-syms-in-order! + header_0 + (cons + sym_0 + (header-binding-syms-in-order + header_0))) + (begin-unsafe + (hash-set! + (header-define-and-import-syms + header_0) + def-sym_0 + 'defined)))) + (for-loop_1 + rest_1)))) + (values))))))) + (for-loop_1 + lst_1)))) + (void)) + (if (parsed-begin-for-syntax? + body_0) + (let ((app_0 + (parsed-begin-for-syntax-body + body_0))) + (let ((app_1 + (add1 + phase_1))) + (loop!_0 + app_0 + app_1 + (find-or-create-header!_0 + (add1 + phase_1))))) + (void))) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 bodys_0))) + (void))))))) + (loop!_0 + bodys32_0 + phase_0 + (find-or-create-header!_0 phase_0))) + (void)) + (let ((as-required?_0 + (|#%name| + as-required? + (lambda (header_0) + (begin + (lambda (sym_0) + (registered-as-required? + header_0 + sym_0))))))) + (let ((last-i_0 (sub1 (length bodys32_0)))) + (begin + (letrec* + ((loop!_0 + (|#%name| + loop! + (lambda (bodys_0 phase_1 header_0) + (begin + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0 pos_0) + (begin + (if (if (pair? lst_0) + #t + #f) + (let ((body_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (begin + (if (parsed-define-values? + body_0) + (let ((ids_0 + (parsed-define-values-ids + body_0))) + (let ((binding-syms_0 + (parsed-define-values-syms + body_0))) + (let ((def-syms_0 + (if (compile-context-module-self + cctx33_0) + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1 + lst_2) + (begin + (if (if (pair? + lst_1) + (pair? + lst_2) + #f) + (let ((binding-sym_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((id_0 + (unsafe-car + lst_2))) + (let ((rest_2 + (unsafe-cdr + lst_2))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((app_0 + (hash-ref + (header-binding-sym-to-define-sym + header_0) + binding-sym_0))) + (correlate-source-name + app_0 + (syntax-e$1 + id_0))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_1 + fold-var_1 + rest_1 + rest_2)))))) + fold-var_0)))))) + (for-loop_1 + null + binding-syms_0 + ids_0)))) + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((binding-sym_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((temp62_0 + (compile-context-self + cctx33_0))) + (register-required-variable-use!.1 + #t + header_0 + temp62_0 + phase_1 + binding-sym_0 + #f)) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_1 + fold-var_1 + rest_1)))) + fold-var_0)))))) + (for-loop_1 + null + binding-syms_0))))))) + (let ((rhs_0 + (let ((app_0 + (parsed-define-values-rhs + body_0))) + (let ((app_1 + (if (compile-context? + cctx33_0) + (let ((app_1 + (compile-context-namespace + cctx33_0))) + (let ((app_2 + (compile-context-self + cctx33_0))) + (let ((app_3 + (compile-context-module-self + cctx33_0))) + (let ((app_4 + (compile-context-full-module-name + cctx33_0))) + (compile-context1.1 + app_1 + phase_1 + app_2 + app_3 + app_4 + (compile-context-lazy-syntax-literals? + cctx33_0) + header_0))))) + (raise-argument-error + 'struct-copy + "compile-context?" + cctx33_0)))) + (compile$2 + app_0 + app_1 + (if (= + (length + ids_0) + 1) + (car + ids_0) + #f)))))) + (begin + (|#%app| + definition-callback9_0) + (let ((app_0 + (length + def-syms_0))) + (|#%app| + compiled-expression-callback8_0 + rhs_0 + app_0 + phase_1 + (as-required?_0 + header_0))) + (add-body!_0 + phase_1 + (let ((app_0 + (correlate* + (parsed-s + body_0) + (list + 'define-values + def-syms_0 + rhs_0)))) + (propagate-inline-property + app_0 + (parsed-s + body_0)))) + (if (let ((or-part_0 + (compile-context-module-self + cctx33_0))) + (if or-part_0 + or-part_0 + (null? + ids_0))) + (void) + (begin + (add-body!_0 + phase_1 + (list* + 'if + #f + (list* + 'begin + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((def-sym_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (cons + (list* + 'set! + def-sym_0 + '(#f)) + fold-var_0))) + (let ((fold-var_2 + (values + fold-var_1))) + (for-loop_1 + fold-var_2 + rest_1))))) + fold-var_0)))))) + (for-loop_1 + null + def-syms_0))))) + '((void)))) + (add-body!_0 + phase_1 + (compile-top-level-bind + ids_0 + binding-syms_0 + (if (compile-context? + cctx33_0) + (let ((app_0 + (compile-context-namespace + cctx33_0))) + (let ((app_1 + (compile-context-self + cctx33_0))) + (let ((app_2 + (compile-context-module-self + cctx33_0))) + (let ((app_3 + (compile-context-full-module-name + cctx33_0))) + (compile-context1.1 + app_0 + phase_1 + app_1 + app_2 + app_3 + (compile-context-lazy-syntax-literals? + cctx33_0) + header_0))))) + (raise-argument-error + 'struct-copy + "compile-context?" + cctx33_0)) + #f))))))))) + (if (parsed-define-syntaxes? + body_0) + (let ((ids_0 + (parsed-define-syntaxes-ids + body_0))) + (let ((binding-syms_0 + (parsed-define-syntaxes-syms + body_0))) + (let ((next-header_0 + (find-or-create-header!_0 + (add1 + phase_1)))) + (let ((gen-syms_0 + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((binding-sym_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((gen-sym_0 + (select-fresh + binding-sym_0 + next-header_0))) + (begin + (begin-unsafe + (hash-set! + (header-define-and-import-syms + next-header_0) + gen-sym_0 + 'defined)) + gen-sym_0)) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_1 + fold-var_1 + rest_1)))) + fold-var_0)))))) + (for-loop_1 + null + binding-syms_0)))))) + (let ((rhs_0 + (let ((app_0 + (parsed-define-syntaxes-rhs + body_0))) + (compile$2 + app_0 + (if (compile-context? + cctx33_0) + (let ((phase71_0 + (add1 + phase_1))) + (let ((app_1 + (compile-context-namespace + cctx33_0))) + (let ((app_2 + (compile-context-self + cctx33_0))) + (let ((app_3 + (compile-context-module-self + cctx33_0))) + (let ((app_4 + (compile-context-full-module-name + cctx33_0))) + (compile-context1.1 + app_1 + phase71_0 + app_2 + app_3 + app_4 + (compile-context-lazy-syntax-literals? + cctx33_0) + next-header_0)))))) + (raise-argument-error + 'struct-copy + "compile-context?" + cctx33_0)))))) + (begin + (|#%app| + definition-callback9_0) + (begin + (let ((app_0 + (length + gen-syms_0))) + (let ((app_1 + (add1 phase_1))) - (let ((binding-sym-to-define-sym_0 - (header-binding-sym-to-define-sym - (hash-ref - phase-to-header_0 - phase_1)))) - (let ((module-use*s_0 - (let ((app_0 - (link-info-link-module-uses - li_0))) - (module-uses-add-extra-inspectorsss - app_0 - (link-info-extra-inspectorsss - li_0))))) - (let ((body-linklet_0 - (let ((app_0 - (qq-append - body-imports2_0 - (link-info-imports - li_0)))) - (let ((app_1 - (let ((app_1 - (link-info-def-decls - li_0))) - (qq-append - app_1 - (reverse$1 - (let ((lst_1 - (header-binding-syms-in-order - (hash-ref - phase-to-header_0 - phase_1)))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_2) - (begin - (if (pair? - lst_2) - (let ((binding-sym_0 - (unsafe-car - lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((def-sym_0 - (hash-ref - binding-sym-to-define-sym_0 - binding-sym_0))) - (if (eq? - def-sym_0 - binding-sym_0) - def-sym_0 - (list - def-sym_0 - binding-sym_0))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_1 - fold-var_1 - rest_1)))) - fold-var_0)))))) - (for-loop_1 - null - lst_1))))))))) - (list* - 'linklet - app_0 - app_1 - (qq-append - (reverse$1 - bodys_0) - body-suffix-forms4_0)))))) - (call-with-values - (lambda () - (if to-correlated-linklet?14_0 - (values - (begin-unsafe - (correlated-linklet1.1 - body-linklet_0 - 'module - #f)) - module-use*s_0) - (let ((temp89_0 - (if unsafe?-box16_0 - (unbox - unsafe?-box16_0) - #f))) - (let ((temp91_0 - (compile-context-namespace + (|#%app| + compiled-expression-callback8_0 + rhs_0 + app_0 + app_1 + (as-required?_0 + header_0)))) + (let ((transformer-set!s_0 + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1 + lst_2) + (begin + (if (if (pair? + lst_1) + (pair? + lst_2) + #f) + (let ((binding-sym_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((gen-sym_0 + (unsafe-car + lst_2))) + (let ((rest_2 + (unsafe-cdr + lst_2))) + (let ((fold-var_1 + (cons + (list + set-transformer!-id + (list + 'quote + binding-sym_0) + gen-sym_0) + fold-var_0))) + (let ((fold-var_2 + (values + fold-var_1))) + (for-loop_1 + fold-var_2 + rest_1 + rest_2))))))) + fold-var_0)))))) + (for-loop_1 + null + binding-syms_0 + gen-syms_0)))))) + (begin + (if (compile-context-module-self + cctx33_0) + (let ((app_0 + (add1 + phase_1))) + (add-body!_0 + app_0 + (list + 'let-values + (list + (list + gen-syms_0 + rhs_0)) + (list* + 'begin + (qq-append + transformer-set!s_0 + '((void))))))) + (let ((app_0 + (add1 + phase_1))) + (add-body!_0 + app_0 + (generate-top-level-define-syntaxes + gen-syms_0 + rhs_0 + transformer-set!s_0 + (compile-top-level-bind + ids_0 + binding-syms_0 + (if (compile-context? + cctx33_0) + (let ((app_1 + (compile-context-namespace + cctx33_0))) + (let ((app_2 + (compile-context-self + cctx33_0))) + (let ((app_3 + (compile-context-module-self cctx33_0))) - (let ((temp89_1 - temp89_0)) - (compile-module-linklet.1 - body-import-instances3_0 - body-imports2_0 - unsafe-undefined - get-module-linklet-info_0 - #f - module-prompt?13_0 - module-use*s_0 - temp91_0 - optimize-linklet?15_0 - serializable?12_0 - temp89_1 - body-linklet_0)))))) - (case-lambda - ((linklet_0 - new-module-use*s_0) - (values - phase_1 - (cons - linklet_0 - new-module-use*s_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - rest_0)))) - table_0)))))) - (for-loop_0 - hash2610 - phases-in-order_0))))) - (let ((body-linklets_0 + (let ((app_4 + (compile-context-full-module-name + cctx33_0))) + (compile-context1.1 + app_1 + phase_1 + app_2 + app_3 + app_4 + (compile-context-lazy-syntax-literals? + cctx33_0) + header_0))))) + (raise-argument-error + 'struct-copy + "compile-context?" + cctx33_0)) + gen-syms_0))))) + (set! saw-define-syntaxes?_0 + #t)))))))))) + (if (parsed-begin-for-syntax? + body_0) + (let ((app_0 + (parsed-begin-for-syntax-body + body_0))) + (let ((app_1 + (add1 + phase_1))) + (loop!_0 + app_0 + app_1 + (find-or-create-header!_0 + (add1 + phase_1))))) + (if (let ((or-part_0 + (|parsed-#%declare?| + body_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (parsed-module? + body_0))) + (if or-part_1 + or-part_1 + (parsed-require? + body_0))))) + (let ((e_0 + (|#%app| + other-form-callback10_0 + body_0 + (if (compile-context? + cctx33_0) + (let ((app_0 + (compile-context-namespace + cctx33_0))) + (let ((app_1 + (compile-context-self + cctx33_0))) + (let ((app_2 + (compile-context-module-self + cctx33_0))) + (let ((app_3 + (compile-context-full-module-name + cctx33_0))) + (compile-context1.1 + app_0 + phase_1 + app_1 + app_2 + app_3 + (compile-context-lazy-syntax-literals? + cctx33_0) + header_0))))) + (raise-argument-error + 'struct-copy + "compile-context?" + cctx33_0))))) + (if e_0 + (begin + (|#%app| + compiled-expression-callback8_0 + e_0 + #f + phase_1 + (as-required?_0 + header_0)) + (add-body!_0 + phase_1 + e_0)) + (void))) + (let ((e_0 + (let ((app_0 + (if (compile-context? + cctx33_0) + (let ((app_0 + (compile-context-namespace + cctx33_0))) + (let ((app_1 + (compile-context-self + cctx33_0))) + (let ((app_2 + (compile-context-module-self + cctx33_0))) + (let ((app_3 + (compile-context-full-module-name + cctx33_0))) + (compile-context1.1 + app_0 + phase_1 + app_1 + app_2 + app_3 + (compile-context-lazy-syntax-literals? + cctx33_0) + header_0))))) + (raise-argument-error + 'struct-copy + "compile-context?" + cctx33_0)))) + (compile$2 + body_0 + app_0 + #f + (= + pos_0 + last-i_0))))) + (begin + (|#%app| + compiled-expression-callback8_0 + e_0 + #f + phase_1 + (as-required?_0 + header_0)) + (add-body!_0 + phase_1 + e_0))))))) + (for-loop_0 + rest_0 + (+ pos_0 1))))) + (values))))))) + (for-loop_0 bodys_0 0))) + (void))))))) + (loop!_0 + bodys32_0 + phase_0 + (find-or-create-header!_0 phase_0))) + (let ((encoded-root-expand-pos_0 + (if encoded-root-expand-ctx-box6_0 + (if (unbox + encoded-root-expand-ctx-box6_0) + (if (not + (if root-ctx-only-if-syntax?7_0 + (if (not + saw-define-syntaxes?_0) + (begin-unsafe + (null? + (syntax-literals-stxes + syntax-literals_0))) + #f) + #f)) + (add-syntax-literal! + syntax-literals_0 + (unbox + encoded-root-expand-ctx-box6_0)) + #f) + #f) + #f))) + (let ((phases-in-order_0 + (let ((temp79_0 + (hash-keys + phase-to-body_0))) + (sort.1 #f #f temp79_0 <)))) + (let ((min-phase_0 + (if (pair? phases-in-order_0) + (car phases-in-order_0) + phase_0))) + (let ((max-phase_0 + (if (pair? phases-in-order_0) + (car + (reverse$1 + phases-in-order_0)) + phase_0))) + (let ((phase-to-link-info_0 (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (table_0 i_0) + (lambda (table_0 lst_0) (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - body-linklets+module-use*s_0 - i_0)) - (case-lambda - ((phase_1 - l+mu*s_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - phase_1 - (car - l+mu*s_0))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - body-linklets+module-use*s_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) + (if (pair? lst_0) + (let ((phase_1 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (let ((header_0 + (hash-ref + phase-to-header_0 + phase_1 + #f))) + (call-with-values + (lambda () + (generate-links+imports + header_0 + phase_1 + cctx33_0 + optimize-linklet?15_0)) + (case-lambda + ((link-module-uses_0 + imports_0 + extra-inspectorsss_0 + def-decls_0) + (values + phase_1 + (link-info1.1 + link-module-uses_0 + imports_0 + extra-inspectorsss_0 + def-decls_0))) + (args + (raise-binding-result-arity-error + 4 + args)))))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + rest_0)))) table_0)))))) (for-loop_0 - hash2610 - (hash-iterate-first - body-linklets+module-use*s_0)))))) - (let ((phase-to-link-module-uses_0 + hash2725 + phases-in-order_0))))) + (let ((body-linklets+module-use*s_0 (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (table_0 i_0) + (lambda (table_0 + lst_0) (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - body-linklets+module-use*s_0 - i_0)) - (case-lambda - ((phase_1 - l+mu*s_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - phase_1 - (module-uses-strip-extra-inspectorsss - (cdr - l+mu*s_0)))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - body-linklets+module-use*s_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) + (if (pair? lst_0) + (let ((phase_1 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (let ((bodys_0 + (hash-ref + phase-to-body_0 + phase_1))) + (let ((li_0 + (hash-ref + phase-to-link-info_0 + phase_1))) + (let ((binding-sym-to-define-sym_0 + (header-binding-sym-to-define-sym + (hash-ref + phase-to-header_0 + phase_1)))) + (let ((module-use*s_0 + (let ((app_0 + (link-info-link-module-uses + li_0))) + (module-uses-add-extra-inspectorsss + app_0 + (link-info-extra-inspectorsss + li_0))))) + (let ((body-linklet_0 + (let ((app_0 + (qq-append + body-imports2_0 + (link-info-imports + li_0)))) + (let ((app_1 + (let ((app_1 + (link-info-def-decls + li_0))) + (qq-append + app_1 + (reverse$1 + (let ((lst_1 + (header-binding-syms-in-order + (hash-ref + phase-to-header_0 + phase_1)))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_2) + (begin + (if (pair? + lst_2) + (let ((binding-sym_0 + (unsafe-car + lst_2))) + (let ((rest_1 + (unsafe-cdr + lst_2))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((def-sym_0 + (hash-ref + binding-sym-to-define-sym_0 + binding-sym_0))) + (if (eq? + def-sym_0 + binding-sym_0) + def-sym_0 + (list + def-sym_0 + binding-sym_0))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_1 + fold-var_1 + rest_1)))) + fold-var_0)))))) + (for-loop_1 + null + lst_1))))))))) + (list* + 'linklet + app_0 + app_1 + (qq-append + (reverse$1 + bodys_0) + body-suffix-forms4_0)))))) + (call-with-values + (lambda () + (if to-correlated-linklet?14_0 + (values + (begin-unsafe + (correlated-linklet1.1 + body-linklet_0 + 'module + #f)) + module-use*s_0) + (let ((temp89_0 + (if unsafe?-box16_0 + (unbox + unsafe?-box16_0) + #f))) + (let ((temp91_0 + (compile-context-namespace + cctx33_0))) + (let ((temp89_1 + temp89_0)) + (compile-module-linklet.1 + body-import-instances3_0 + body-imports2_0 + unsafe-undefined + get-module-linklet-info_0 + #f + module-prompt?13_0 + module-use*s_0 + temp91_0 + optimize-linklet?15_0 + serializable?12_0 + temp89_1 + body-linklet_0)))))) + (case-lambda + ((linklet_0 + new-module-use*s_0) + (values + phase_1 + (cons + linklet_0 + new-module-use*s_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + rest_0)))) table_0)))))) (for-loop_0 hash2610 - (hash-iterate-first - body-linklets+module-use*s_0)))))) - (let ((phase-to-link-module-uses-expr_0 - (serialize-phase-to-link-module-uses - phase-to-link-module-uses_0 - mpis34_0))) - (let ((phase-to-link-extra-inspectorsss_0 + phases-in-order_0))))) + (let ((body-linklets_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 + i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + body-linklets+module-use*s_0 + i_0)) + (case-lambda + ((phase_1 + l+mu*s_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + phase_1 + (car + l+mu*s_0))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + body-linklets+module-use*s_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2610 + (hash-iterate-first + body-linklets+module-use*s_0)))))) + (let ((phase-to-link-module-uses_0 (begin (letrec* ((for-loop_0 @@ -39507,57 +39084,27 @@ ((phase_1 l+mu*s_0) (let ((table_1 - (let ((extra-inspectorsss_0 - (let ((app_0 - (cdr - l+mu*s_0))) - (let ((app_1 - (car - l+mu*s_0))) - (let ((app_2 - (if optimize-linklet?15_0 - (not - to-correlated-linklet?14_0) - #f))) - (module-uses-extract-extra-inspectorsss - app_0 - app_1 - app_2 - (length - body-imports2_0))))))) - (begin - #t - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (table_1) - (begin - (let ((table_2 - (if extra-inspectorsss_0 - (let ((table_2 - (call-with-values - (lambda () - (values - phase_1 - extra-inspectorsss_0)) - (case-lambda - ((key_0 - val_0) - (hash-set - table_1 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_2)) - table_1))) - table_2)))))) - (for-loop_1 - table_0)))))) + (let ((table_1 + (call-with-values + (lambda () + (values + phase_1 + (module-uses-strip-extra-inspectorsss + (cdr + l+mu*s_0)))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) (for-loop_0 table_1 (hash-iterate-next @@ -39569,18 +39116,106 @@ args)))) table_0)))))) (for-loop_0 - hash2725 + hash2610 (hash-iterate-first body-linklets+module-use*s_0)))))) - (values - body-linklets_0 - min-phase_0 - max-phase_0 - phase-to-link-module-uses_0 - phase-to-link-module-uses-expr_0 - phase-to-link-extra-inspectorsss_0 - syntax-literals_0 - encoded-root-expand-pos_0))))))))))))))))))))))))))) + (let ((phase-to-link-module-uses-expr_0 + (serialize-phase-to-link-module-uses + phase-to-link-module-uses_0 + mpis34_0))) + (let ((phase-to-link-extra-inspectorsss_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 + i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + body-linklets+module-use*s_0 + i_0)) + (case-lambda + ((phase_1 + l+mu*s_0) + (let ((table_1 + (let ((extra-inspectorsss_0 + (let ((app_0 + (cdr + l+mu*s_0))) + (let ((app_1 + (car + l+mu*s_0))) + (let ((app_2 + (if optimize-linklet?15_0 + (not + to-correlated-linklet?14_0) + #f))) + (module-uses-extract-extra-inspectorsss + app_0 + app_1 + app_2 + (length + body-imports2_0))))))) + (begin + #t + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (table_1) + (begin + (let ((table_2 + (if extra-inspectorsss_0 + (let ((table_2 + (call-with-values + (lambda () + (values + phase_1 + extra-inspectorsss_0)) + (case-lambda + ((key_0 + val_0) + (hash-set + table_1 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_2)) + table_1))) + table_2)))))) + (for-loop_1 + table_0)))))) + (for-loop_0 + table_1 + (hash-iterate-next + body-linklets+module-use*s_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2725 + (hash-iterate-first + body-linklets+module-use*s_0)))))) + (values + body-linklets_0 + min-phase_0 + max-phase_0 + phase-to-link-module-uses_0 + phase-to-link-module-uses-expr_0 + phase-to-link-extra-inspectorsss_0 + syntax-literals_0 + encoded-root-expand-pos_0))))))))))))))))))))))))))))) (define compile-top-level-bind (lambda (ids_0 binding-syms_0 cctx_0 trans-exprs_0) (let ((phase_0 (compile-context-phase cctx_0))) @@ -39800,37 +39435,37 @@ (list-tail app_0 (length body-imports37_0))))) (args (raise-binding-result-arity-error 2 args))))))))) (define make-module-use-to-linklet - (letrec ((intern-module-use*_0 - (|#%name| - intern-module-use* - (lambda (mu*-intern-table_0 mu*_0) - (begin - (let ((mod-name_0 - (1/module-path-index-resolve - (module-use-module mu*_0)))) - (let ((existing-mu*_0 - (hash-ref + (lambda (optimize-linklet?_0 + load-modules?_0 + ns_0 + get-module-linklet-info_0 + init-mu*s_0) + (let ((mu*-intern-table_0 (make-hash))) + (let ((intern-module-use*_0 + (|#%name| + intern-module-use* + (lambda (mu*_0) + (begin + (let ((mod-name_0 + (1/module-path-index-resolve + (module-use-module mu*_0)))) + (let ((existing-mu*_0 + (hash-ref + mu*-intern-table_0 + (cons mod-name_0 (module-use-phase mu*_0)) + #f))) + (if existing-mu*_0 + (begin + (module-use-merge-extra-inspectorss! + existing-mu*_0 + mu*_0) + existing-mu*_0) + (begin + (hash-set! mu*-intern-table_0 (cons mod-name_0 (module-use-phase mu*_0)) - #f))) - (if existing-mu*_0 - (begin - (module-use-merge-extra-inspectorss! - existing-mu*_0 - mu*_0) - existing-mu*_0) - (begin - (hash-set! - mu*-intern-table_0 - (cons mod-name_0 (module-use-phase mu*_0)) - mu*_0) - mu*_0))))))))) - (lambda (optimize-linklet?_0 - load-modules?_0 - ns_0 - get-module-linklet-info_0 - init-mu*s_0) - (let ((mu*-intern-table_0 (make-hash))) + mu*_0) + mu*_0))))))))) (begin (begin (letrec* @@ -39843,7 +39478,7 @@ (let ((mu*_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) (begin - (intern-module-use*_0 mu*-intern-table_0 mu*_0) + (intern-module-use*_0 mu*_0) (for-loop_0 rest_0)))) (values))))))) (for-loop_0 init-mu*s_0))) @@ -39942,7 +39577,6 @@ (let ((fold-var_1 (cons (intern-module-use*_0 - mu*-intern-table_0 (let ((app_1 (let ((app_1 (module-use-module @@ -40170,47 +39804,45 @@ (correlated-linklet1.1 linklet-s_0 #f #f)) (compile-linklet linklet-s_0)))))))))))))))) (define map-cim-tree - (letrec ((loop_0 - (|#%name| - loop - (lambda (proc_0 cims_0) - (begin - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((cim_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((app_0 - (|#%app| - proc_0 - cim_0))) - (let ((app_1 - (loop_0 - proc_0 - (compiled-in-memory-pre-compiled-in-memorys - cim_0)))) - (vector - app_0 - app_1 - (loop_0 - proc_0 - (compiled-in-memory-post-compiled-in-memorys - cim_0))))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null cims_0))))))))) - (lambda (cims_0 proc_0) (loop_0 proc_0 cims_0)))) + (lambda (cims_0 proc_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (cims_1) + (begin + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((cim_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((app_0 + (|#%app| proc_0 cim_0))) + (let ((app_1 + (loop_0 + (compiled-in-memory-pre-compiled-in-memorys + cim_0)))) + (vector + app_0 + app_1 + (loop_0 + (compiled-in-memory-post-compiled-in-memorys + cim_0))))) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 fold-var_1 rest_0)))) + fold-var_0)))))) + (for-loop_0 null cims_1))))))))) + (loop_0 cims_0)))) (define compiled-tops->compiled-top.1 (|#%name| compiled-tops->compiled-top @@ -40847,35 +40479,29 @@ (lookup-defn defns_0 sym_0)) d_0)))) (define any-side-effects?.1 - (letrec ((procz2 (lambda () 0)) - (procz1 (|#%name| ready-variable? (lambda (id_0) (begin #f)))) - (effects?_0 - (|#%name| - effects? - (lambda (known-defns2_0 + (|#%name| + any-side-effects? + (lambda (known-defns2_0 + known-locals1_0 + ready-variable?3_0 + e7_0 + expected-results8_0) + (begin + (let ((ready-variable?_0 + (if (eq? ready-variable?3_0 unsafe-undefined) + (|#%name| ready-variable? (lambda (id_0) (begin #f))) + ready-variable?3_0))) + (let ((effects?_0 + (|#%name| + effects? + (lambda (e_0 expected-results_0 locals_0) + (begin + (any-side-effects?.1 + known-defns2_0 + locals_0 ready-variable?_0 e_0 - expected-results_0 - locals_0) - (begin - (any-side-effects?.1 - known-defns2_0 - locals_0 - ready-variable?_0 - e_0 - expected-results_0)))))) - (|#%name| - any-side-effects? - (lambda (known-defns2_0 - known-locals1_0 - ready-variable?3_0 - e7_0 - expected-results8_0) - (begin - (let ((ready-variable?_0 - (if (eq? ready-variable?3_0 unsafe-undefined) - procz1 - ready-variable?3_0))) + expected-results_0)))))) (let ((actual-results_0 (letrec* ((loop_0 @@ -40889,7 +40515,7 @@ #f))) (let ((index_0 (if (symbol? tmp_0) - (hash-ref hash2430 tmp_0 procz2) + (hash-ref hash2430 tmp_0 (lambda () 0)) 0))) (if (unsafe-fx< index_0 6) (if (unsafe-fx< index_0 2) @@ -41020,8 +40646,6 @@ (let ((result_1 (not (effects?_0 - known-defns2_0 - ready-variable?_0 e_1 1 locals_0)))) @@ -41086,8 +40710,6 @@ (let ((result_1 (if (not (effects?_0 - known-defns2_0 - ready-variable?_0 e_1 1 locals_0)) @@ -41480,8 +41102,6 @@ (let ((result_1 (let ((result_1 (effects?_0 - known-defns2_0 - ready-variable?_0 rhs_0 (correlated-length ids_0) @@ -41583,8 +41203,6 @@ (let ((result_1 (not (effects?_0 - known-defns2_0 - ready-variable?_0 e_1 1 locals_0)))) @@ -41672,8 +41290,6 @@ (let ((result_1 (not (effects?_0 - known-defns2_0 - ready-variable?_0 e_1 1 locals_0)))) @@ -41756,8 +41372,6 @@ locals_0) (if (not (effects?_0 - known-defns2_0 - ready-variable?_0 (car es_0) #f locals_0)) @@ -41860,8 +41474,6 @@ (let ((result_1 (not (effects?_0 - known-defns2_0 - ready-variable?_0 e_1 #f locals_0)))) @@ -42820,8 +42432,6 @@ (if (known-predicate? c2_0) (if (not (effects?_0 - known-defns2_0 - ready-variable?_0 thn94_0 expected-results8_0 (hash-set @@ -43042,15 +42652,11 @@ (if ok?_1 (if (not (effects?_0 - known-defns2_0 - ready-variable?_0 tst112_0 1 locals_0)) (if (not (effects?_0 - known-defns2_0 - ready-variable?_0 thn113_0 expected-results8_0 locals_0)) @@ -43249,56 +42855,55 @@ (known-satisfies8.1 'procedure) #t)))) (define ok-make-struct-type-property? - (letrec ((procz1 (lambda (v_0) (quoted? symbol? v_0)))) - (lambda (e_0 defns_0) - (let ((l_0 (correlated->list e_0))) - (if (<= 2 (length l_0) 5) - (let ((lst_0 (cdr l_0))) - (let ((lst_1 - (list - procz1 - (lambda (v_0) (is-lambda? v_0 2 defns_0)) - (lambda (v_0) - (ok-make-struct-type-property-super? v_0 defns_0)) - (lambda (v_0) - (not - (any-side-effects?.1 - defns_0 - hash2610 - unsafe-undefined - v_0 - 1)))))) - (let ((lst_2 lst_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_3 lst_4) - (begin - (if (if (pair? lst_3) (pair? lst_4) #f) - (let ((arg_0 (unsafe-car lst_3))) - (let ((rest_0 (unsafe-cdr lst_3))) - (let ((pred_0 (unsafe-car lst_4))) - (let ((rest_1 (unsafe-cdr lst_4))) - (let ((result_1 - (let ((result_1 - (|#%app| pred_0 arg_0))) - (values result_1)))) - (if (if (not - (let ((x_0 (list arg_0))) + (lambda (e_0 defns_0) + (let ((l_0 (correlated->list e_0))) + (if (<= 2 (length l_0) 5) + (let ((lst_0 (cdr l_0))) + (let ((lst_1 + (list + (lambda (v_0) (quoted? symbol? v_0)) + (lambda (v_0) (is-lambda? v_0 2 defns_0)) + (lambda (v_0) + (ok-make-struct-type-property-super? v_0 defns_0)) + (lambda (v_0) + (not + (any-side-effects?.1 + defns_0 + hash2610 + unsafe-undefined + v_0 + 1)))))) + (let ((lst_2 lst_0)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_3 lst_4) + (begin + (if (if (pair? lst_3) (pair? lst_4) #f) + (let ((arg_0 (unsafe-car lst_3))) + (let ((rest_0 (unsafe-cdr lst_3))) + (let ((pred_0 (unsafe-car lst_4))) + (let ((rest_1 (unsafe-cdr lst_4))) + (let ((result_1 + (let ((result_1 + (|#%app| pred_0 arg_0))) + (values result_1)))) + (if (if (not + (let ((x_0 (list arg_0))) + (not result_1))) + (if (not + (let ((x_0 (list pred_0))) (not result_1))) - (if (not - (let ((x_0 (list pred_0))) - (not result_1))) - #t - #f) + #t #f) - (for-loop_0 result_1 rest_0 rest_1) - result_1)))))) - result_0)))))) - (for-loop_0 #t lst_2 lst_1)))))) - #f))))) + #f) + (for-loop_0 result_1 rest_0 rest_1) + result_1)))))) + result_0)))))) + (for-loop_0 #t lst_2 lst_1)))))) + #f)))) (define ok-make-struct-type-property-super? (lambda (v_0 defns_0) (let ((or-part_0 (quoted? null? v_0))) @@ -43428,102 +43033,96 @@ #f) #f))))))) (define ok-make-struct-type? - (letrec ((procz4 (lambda (v_0) (inspector-or-false? v_0))) - (procz3 (lambda (v_0) (field-count-expr-to-field-count v_0))) - (procz2 (lambda (v_0) (field-count-expr-to-field-count v_0))) - (procz1 (lambda (v_0) (quoted? symbol? v_0)))) - (lambda (e_0 ready-variable?_0 defns_0) - (let ((l_0 (correlated->list e_0))) - (let ((init-field-count-expr_0 - (if (> (length l_0) 3) (list-ref l_0 3) #f))) - (let ((auto-field-count-expr_0 - (if (> (length l_0) 4) (list-ref l_0 4) #f))) - (let ((num-fields_0 - (let ((app_0 - (field-count-expr-to-field-count - init-field-count-expr_0))) - (maybe+ - app_0 - (field-count-expr-to-field-count - auto-field-count-expr_0))))) - (let ((immutables-expr_0 - (let ((or-part_0 - (if (> (length l_0) 9) (list-ref l_0 9) #f))) - (if or-part_0 or-part_0 'null)))) - (let ((super-expr_0 - (if (> (length l_0) 2) (list-ref l_0 2) #f))) - (if (>= (length l_0) 5) - (if (<= (length l_0) 12) - (let ((lst_0 (cdr l_0))) - (let ((lst_1 - (list - procz1 - (lambda (v_0) (super-ok? v_0 defns_0)) - procz2 - procz3 - (lambda (v_0) - (not - (any-side-effects?.1 - defns_0 - hash2610 - ready-variable?_0 - v_0 - 1))) - (lambda (v_0) - (known-good-struct-properties? - v_0 - immutables-expr_0 - super-expr_0 - defns_0)) - procz4 - (lambda (v_0) - (procedure-spec? v_0 num-fields_0)) - (lambda (v_0) - (immutables-ok? - v_0 - init-field-count-expr_0))))) - (let ((lst_2 lst_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_3 lst_4) - (begin - (if (if (pair? lst_3) (pair? lst_4) #f) - (let ((arg_0 (unsafe-car lst_3))) - (let ((rest_0 (unsafe-cdr lst_3))) - (let ((pred_0 (unsafe-car lst_4))) - (let ((rest_1 - (unsafe-cdr lst_4))) - (let ((result_1 - (let ((result_1 - (|#%app| - pred_0 - arg_0))) - (values result_1)))) - (if (if (not + (lambda (e_0 ready-variable?_0 defns_0) + (let ((l_0 (correlated->list e_0))) + (let ((init-field-count-expr_0 + (if (> (length l_0) 3) (list-ref l_0 3) #f))) + (let ((auto-field-count-expr_0 + (if (> (length l_0) 4) (list-ref l_0 4) #f))) + (let ((num-fields_0 + (let ((app_0 + (field-count-expr-to-field-count + init-field-count-expr_0))) + (maybe+ + app_0 + (field-count-expr-to-field-count + auto-field-count-expr_0))))) + (let ((immutables-expr_0 + (let ((or-part_0 + (if (> (length l_0) 9) (list-ref l_0 9) #f))) + (if or-part_0 or-part_0 'null)))) + (let ((super-expr_0 (if (> (length l_0) 2) (list-ref l_0 2) #f))) + (if (>= (length l_0) 5) + (if (<= (length l_0) 12) + (let ((lst_0 (cdr l_0))) + (let ((lst_1 + (list + (lambda (v_0) (quoted? symbol? v_0)) + (lambda (v_0) (super-ok? v_0 defns_0)) + (lambda (v_0) + (field-count-expr-to-field-count v_0)) + (lambda (v_0) + (field-count-expr-to-field-count v_0)) + (lambda (v_0) + (not + (any-side-effects?.1 + defns_0 + hash2610 + ready-variable?_0 + v_0 + 1))) + (lambda (v_0) + (known-good-struct-properties? + v_0 + immutables-expr_0 + super-expr_0 + defns_0)) + (lambda (v_0) (inspector-or-false? v_0)) + (lambda (v_0) (procedure-spec? v_0 num-fields_0)) + (lambda (v_0) + (immutables-ok? + v_0 + init-field-count-expr_0))))) + (let ((lst_2 lst_0)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_3 lst_4) + (begin + (if (if (pair? lst_3) (pair? lst_4) #f) + (let ((arg_0 (unsafe-car lst_3))) + (let ((rest_0 (unsafe-cdr lst_3))) + (let ((pred_0 (unsafe-car lst_4))) + (let ((rest_1 (unsafe-cdr lst_4))) + (let ((result_1 + (let ((result_1 + (|#%app| + pred_0 + arg_0))) + (values result_1)))) + (if (if (not + (let ((x_0 + (list arg_0))) + (not result_1))) + (if (not (let ((x_0 (list - arg_0))) + pred_0))) (not result_1))) - (if (not - (let ((x_0 - (list - pred_0))) - (not result_1))) - #t - #f) + #t #f) - (for-loop_0 - result_1 - rest_0 - rest_1) - result_1)))))) - result_0)))))) - (for-loop_0 #t lst_2 lst_1)))))) - #f) - #f)))))))))) + #f) + (for-loop_0 + result_1 + rest_0 + rest_1) + result_1)))))) + result_0)))))) + (for-loop_0 #t lst_2 lst_1)))))) + #f) + #f))))))))) (define super-ok? (lambda (e_0 defns_0) (let ((or-part_0 (quoted? false? e_0))) @@ -43804,7 +43403,7 @@ (let ((v_0 (correlated-cadr e_0))) (let ((or-part_0 (if (correlated-length v_0) - (let ((l_0 (map_2960 correlated-e (correlated->list v_0)))) + (let ((l_0 (map_1346 correlated-e (correlated->list v_0)))) (if (andmap_2344 exact-nonnegative-integer? l_0) (if (let ((app_0 (length l_0))) (= @@ -43879,114 +43478,117 @@ (define compile-single (lambda (p_0 cctx_0) (compile-top.1 #f #t #f p_0 cctx_0))) (define compile-top.1 - (letrec ((procz1 (lambda (inst_0) (values inst_0 #f))) - (add-metadata_0 - (|#%name| - add-metadata - (lambda (max-phase_0 phase_0 ht_0) - (begin - (let ((ht_1 (hash-set ht_0 'original-phase phase_0))) - (let ((ht_2 (hash-set ht_1 'max-phase max-phase_0))) - ht_2))))))) - (|#%name| - compile-top - (lambda (serializable?1_0 - single-expression?2_0 - to-correlated-linklet?3_0 - p7_0 - cctx8_0) + (|#%name| + compile-top + (lambda (serializable?1_0 + single-expression?2_0 + to-correlated-linklet?3_0 + p7_0 + cctx8_0) + (begin (begin - (begin - (if log-performance? - (start-performance-region - 'compile - (if single-expression?2_0 'transformer 'top)) - (void)) - (begin0 - (let ((phase_0 (compile-context-phase cctx8_0))) - (let ((mpis_0 (make-module-path-index-table))) - (let ((purely-functional?_0 #t)) - (call-with-values - (lambda () - (let ((temp14_0 (list p7_0))) - (let ((temp17_0 - (if single-expression?2_0 - (list* '() (list syntax-literals-id) '(())) - (list - (list - top-level-bind!-id - top-level-require!-id) - (list mpi-vector-id syntax-literals-id) - instance-imports)))) - (let ((temp18_0 - (list - top-level-instance - empty-top-syntax-literal-instance - empty-instance-instance))) - (let ((temp21_0 - (lambda () (set! purely-functional?_0 #f)))) - (let ((temp22_0 - (lambda (e_0 - expected-results_0 - phase_1 - required-reference?_0) - (if (if purely-functional?_0 - (any-side-effects?.1 - hash2610 - hash2610 - required-reference?_0 - e_0 - expected-results_0) - #f) + (if log-performance? + (start-performance-region + 'compile + (if single-expression?2_0 'transformer 'top)) + (void)) + (begin0 + (let ((phase_0 (compile-context-phase cctx8_0))) + (let ((mpis_0 (make-module-path-index-table))) + (let ((purely-functional?_0 #t)) + (call-with-values + (lambda () + (let ((temp14_0 (list p7_0))) + (let ((temp17_0 + (if single-expression?2_0 + (list* '() (list syntax-literals-id) '(())) + (list + (list top-level-bind!-id top-level-require!-id) + (list mpi-vector-id syntax-literals-id) + instance-imports)))) + (let ((temp18_0 + (list + top-level-instance + empty-top-syntax-literal-instance + empty-instance-instance))) + (let ((temp21_0 + (lambda () (set! purely-functional?_0 #f)))) + (let ((temp22_0 + (lambda (e_0 + expected-results_0 + phase_1 + required-reference?_0) + (if (if purely-functional?_0 + (any-side-effects?.1 + hash2610 + hash2610 + required-reference?_0 + e_0 + expected-results_0) + #f) + (set! purely-functional?_0 #f) + (void))))) + (let ((temp23_0 + (lambda (s_0 cctx_0) + (begin (set! purely-functional?_0 #f) - (void))))) - (let ((temp23_0 - (lambda (s_0 cctx_0) - (begin - (set! purely-functional?_0 #f) - (compile-top-level-require - s_0 - cctx_0))))) - (let ((temp24_0 (not single-expression?2_0))) - (let ((temp23_1 temp23_0) - (temp22_1 temp22_0) - (temp21_1 temp21_0) - (temp18_1 temp18_0) - (temp17_1 temp17_0) - (temp14_1 temp14_0)) - (compile-forms.1 - temp18_1 - temp17_1 - null - temp22_1 - temp21_1 - #f - null - unsafe-undefined - #f - temp24_0 - temp23_1 - #f - serializable?1_0 - to-correlated-linklet?3_0 - #f - temp14_1 - cctx8_0 - mpis_0)))))))))) - (case-lambda - ((body-linklets_0 - min-phase_0 - max-phase_0 - phase-to-link-module-uses_0 - phase-to-link-module-uses-expr_0 - phase-to-link-extra-inspectorss_0 - syntax-literals_0 - no-root-context-pos_0) + (compile-top-level-require + s_0 + cctx_0))))) + (let ((temp24_0 (not single-expression?2_0))) + (let ((temp23_1 temp23_0) + (temp22_1 temp22_0) + (temp21_1 temp21_0) + (temp18_1 temp18_0) + (temp17_1 temp17_0) + (temp14_1 temp14_0)) + (compile-forms.1 + temp18_1 + temp17_1 + null + temp22_1 + temp21_1 + #f + null + unsafe-undefined + #f + temp24_0 + temp23_1 + #f + serializable?1_0 + to-correlated-linklet?3_0 + #f + temp14_1 + cctx8_0 + mpis_0)))))))))) + (case-lambda + ((body-linklets_0 + min-phase_0 + max-phase_0 + phase-to-link-module-uses_0 + phase-to-link-module-uses-expr_0 + phase-to-link-extra-inspectorss_0 + syntax-literals_0 + no-root-context-pos_0) + (let ((add-metadata_0 + (|#%name| + add-metadata + (lambda (ht_0) + (begin + (let ((ht_1 + (hash-set + ht_0 + 'original-phase + phase_0))) + (let ((ht_2 + (hash-set + ht_1 + 'max-phase + max-phase_0))) + ht_2))))))) (let ((bundle_0 (hash->linklet-bundle (add-metadata_0 - max-phase_0 - phase_0 (if serializable?1_0 (let ((syntax-literals-expr_0 (begin @@ -44067,7 +43669,8 @@ (vector deserialize-instance empty-eager-instance-instance) - procz1)) + (lambda (inst_0) + (values inst_0 #f)))) (case-lambda ((linklet_0 new-keys_0) linklet_0) @@ -44106,9 +43709,9 @@ null null app_4 - purely-functional?_0)))))))) - (args (raise-binding-result-arity-error 8 args))))))) - (if log-performance? (end-performance-region) (void))))))))) + purely-functional?_0))))))))) + (args (raise-binding-result-arity-error 8 args))))))) + (if log-performance? (end-performance-region) (void)))))))) (define compile-top-level-require (lambda (p_0 cctx_0) (let ((phase_0 (compile-context-phase cctx_0))) @@ -44757,73 +44360,48 @@ (define current-module-declare-as-predefined (make-parameter #f #f 'current-module-declare-as-predefined)) (define eval-module.1 - (letrec ((procz1 - (|#%name| - temp50 - (lambda (name_0 val_0) - (begin - (error - 'define-syntax - "should not happen at phase level 0"))))) - (decl_0 - (|#%name| - decl - (lambda (declaration-instance_0 key_0) - (begin - (instance-variable-value declaration-instance_0 key_0))))) - (instantiate-body_0 - (|#%name| - instantiate-body - (lambda (import-instances_0 - module-body-instance-instance_0 - ns_0 - phase-level_0 - phase-linklet_0 - syntax-literals-instance_0) - (begin - (instantiate-linklet - phase-linklet_0 - (list* - syntax-literals-instance_0 - module-body-instance-instance_0 - import-instances_0) - (begin-unsafe - (definitions-variables - (namespace->definitions ns_0 phase-level_0))))))))) - (|#%name| - eval-module - (lambda (namespace1_0 supermodule-name3_0 with-submodules?2_0 c7_0) - (begin - (let ((ns_0 - (if (eq? namespace1_0 unsafe-undefined) - (1/current-namespace) - namespace1_0))) - (begin - (if log-performance? - (start-performance-region 'eval 'module) - (void)) - (begin0 - (call-with-values - (lambda () - (compiled-module->dh+h+data-instance+declaration-instance - c7_0)) - (case-lambda - ((dh_0 h_0 data-instance_0 declaration-instance_0) - (let ((syntax-literals-data-instance_0 - (if (compiled-in-memory? c7_0) - (make-syntax-literal-data-instance-from-compiled-in-memory - c7_0) - (let ((l_0 (hash-ref h_0 'stx-data #f))) - (if l_0 - (instantiate-linklet - (begin-unsafe - (eval-linklet (force-compile-linklet l_0))) - (list deserialize-instance data-instance_0)) - (if (eq? - (hash-ref h_0 'module->namespace #f) - 'empty) - empty-syntax-literals-instance/empty-namespace - empty-syntax-literals-data-instance)))))) + (|#%name| + eval-module + (lambda (namespace1_0 supermodule-name3_0 with-submodules?2_0 c7_0) + (begin + (let ((ns_0 + (if (eq? namespace1_0 unsafe-undefined) + (1/current-namespace) + namespace1_0))) + (begin + (if log-performance? + (start-performance-region 'eval 'module) + (void)) + (begin0 + (call-with-values + (lambda () + (compiled-module->dh+h+data-instance+declaration-instance + c7_0)) + (case-lambda + ((dh_0 h_0 data-instance_0 declaration-instance_0) + (let ((syntax-literals-data-instance_0 + (if (compiled-in-memory? c7_0) + (make-syntax-literal-data-instance-from-compiled-in-memory + c7_0) + (let ((l_0 (hash-ref h_0 'stx-data #f))) + (if l_0 + (instantiate-linklet + (begin-unsafe + (eval-linklet (force-compile-linklet l_0))) + (list deserialize-instance data-instance_0)) + (if (eq? + (hash-ref h_0 'module->namespace #f) + 'empty) + empty-syntax-literals-instance/empty-namespace + empty-syntax-literals-data-instance)))))) + (let ((decl_0 + (|#%name| + decl + (lambda (key_0) + (begin + (instance-variable-value + declaration-instance_0 + key_0)))))) (let ((pre-submodule-names_0 (hash-ref h_0 'pre null))) (let ((post-submodule-names_0 (hash-ref h_0 'post null))) (let ((default-name_0 (hash-ref h_0 'name 'module))) @@ -45250,7 +44828,14 @@ (eq? phase-level_0 0)) - procz1 + (|#%name| + temp50 + (lambda (name_0 + val_0) + (begin + (error + 'define-syntax + "should not happen at phase level 0")))) (|#%name| temp50 (lambda (name_0 @@ -45264,77 +44849,75 @@ val_0))))))) (make-module-body-instance-instance.1 temp50_0)))) - (if (begin-unsafe - (eq? - phase-level_0 - 0)) + (let ((instantiate-body_0 + (|#%name| + instantiate-body + (lambda () + (begin + (instantiate-linklet + phase-linklet_0 + (list* + syntax-literals-instance_0 + module-body-instance-instance_0 + import-instances_0) + (begin-unsafe + (definitions-variables + (namespace->definitions + ns_2 + phase-level_0))))))))) (if (begin-unsafe (eq? - phase-shift_0 - 0)) - (instantiate-body_0 - import-instances_0 - module-body-instance-instance_0 - ns_2 - phase-level_0 - phase-linklet_0 - syntax-literals-instance_0) - (with-continuation-mark* - push-authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first - #f - parameterization-key) - 1/current-namespace - ns_2) - (instantiate-body_0 - import-instances_0 - module-body-instance-instance_0 - ns_2 - phase-level_0 - phase-linklet_0 - syntax-literals-instance_0))) - (let ((ns-1_0 - (namespace->namespace-at-phase - ns_2 - (phase+ - phase-shift_0 - (sub1 - phase-level_0))))) - (with-continuation-mark* - push-authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first - #f - parameterization-key) - 1/current-namespace - ns_2) - (with-continuation-mark* - authentic - current-expand-context - (promise1.1 - (lambda () - (make-expand-context.1 - #f - #f - #t - #f - #f - ns-1_0)) - #f) - (with-continuation-mark* - authentic - current-module-code-inspector - insp_0 - (instantiate-body_0 - import-instances_0 - module-body-instance-instance_0 - ns_2 phase-level_0 - phase-linklet_0 - syntax-literals-instance_0))))))))) + 0)) + (if (begin-unsafe + (eq? + phase-shift_0 + 0)) + (instantiate-body_0) + (with-continuation-mark* + push-authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first + #f + parameterization-key) + 1/current-namespace + ns_2) + (instantiate-body_0))) + (let ((ns-1_0 + (namespace->namespace-at-phase + ns_2 + (phase+ + phase-shift_0 + (sub1 + phase-level_0))))) + (with-continuation-mark* + push-authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first + #f + parameterization-key) + 1/current-namespace + ns_2) + (with-continuation-mark* + authentic + current-expand-context + (promise1.1 + (lambda () + (make-expand-context.1 + #f + #f + #t + #f + #f + ns-1_0)) + #f) + (with-continuation-mark* + authentic + current-module-code-inspector + insp_0 + (instantiate-body_0)))))))))) (args (raise-binding-result-arity-error 2 @@ -45408,9 +44991,9 @@ declare-this-module_0) (void)) (declare-this-module_0 - ns_0))))))))))))))))))))))) - (args (raise-binding-result-arity-error 4 args)))) - (if log-performance? (end-performance-region) (void)))))))))) + ns_0)))))))))))))))))))))))) + (args (raise-binding-result-arity-error 4 args)))) + (if log-performance? (end-performance-region) (void))))))))) (define struct:instance-data (make-record-type-descriptor* 'instance-data #f #f #f #f 2 0)) (define effect_2509 @@ -45478,96 +45061,93 @@ 'instance-data 'cache-key)))))) (define init-instance-data! - (letrec ((procz1 - (lambda (name_0 val_0) - (error "shouldn't get here for the root-ctx linklet")))) - (lambda (data-box_0 - cache-key_0 - ns_0 - syntax-literals-linklet_0 - data-instance_0 - syntax-literals-data-instance_0 - phase-shift_0 - original-self_0 - self_0 - bulk-binding-registry_0 - insp_0 - create-root-expand-context-from-module_0) - (begin - (if (not (load-on-demand-enabled)) - (force-syntax-deserialize + (lambda (data-box_0 + cache-key_0 + ns_0 + syntax-literals-linklet_0 + data-instance_0 syntax-literals-data-instance_0 - bulk-binding-registry_0) - (void)) - (let ((temp59_0 procz1)) - (let ((inst_0 - (make-instance-instance.1 - bulk-binding-registry_0 - insp_0 - ns_0 - phase-shift_0 - self_0 - temp59_0))) - (let ((syntax-literals-instance_0 - (if syntax-literals-linklet_0 - (instantiate-linklet - syntax-literals-linklet_0 - (list - deserialize-instance - data-instance_0 - syntax-literals-data-instance_0 - inst_0)) - empty-syntax-literals-instance))) - (begin - (set-box! - data-box_0 - (instance-data9.1 syntax-literals-instance_0 cache-key_0)) - (let ((get-encoded-root-expand-ctx_0 - (instance-variable-value - syntax-literals-instance_0 - 'get-encoded-root-expand-ctx))) - (if (eq? get-encoded-root-expand-ctx_0 'empty) + phase-shift_0 + original-self_0 + self_0 + bulk-binding-registry_0 + insp_0 + create-root-expand-context-from-module_0) + (begin + (if (not (load-on-demand-enabled)) + (force-syntax-deserialize + syntax-literals-data-instance_0 + bulk-binding-registry_0) + (void)) + (let ((temp59_0 + (lambda (name_0 val_0) + (error "shouldn't get here for the root-ctx linklet")))) + (let ((inst_0 + (make-instance-instance.1 + bulk-binding-registry_0 + insp_0 + ns_0 + phase-shift_0 + self_0 + temp59_0))) + (let ((syntax-literals-instance_0 + (if syntax-literals-linklet_0 + (instantiate-linklet + syntax-literals-linklet_0 + (list + deserialize-instance + data-instance_0 + syntax-literals-data-instance_0 + inst_0)) + empty-syntax-literals-instance))) + (begin + (set-box! + data-box_0 + (instance-data9.1 syntax-literals-instance_0 cache-key_0)) + (let ((get-encoded-root-expand-ctx_0 + (instance-variable-value + syntax-literals-instance_0 + 'get-encoded-root-expand-ctx))) + (if (eq? get-encoded-root-expand-ctx_0 'empty) + (let ((root-ctx_0 + (promise1.1 + (lambda () + (shift-to-inside-root-context + (make-root-expand-context.1 + #f + null + unsafe-undefined + unsafe-undefined + self_0))) + #f))) + (begin-unsafe + (set-box! (namespace-root-expand-ctx ns_0) root-ctx_0))) + (if (procedure? get-encoded-root-expand-ctx_0) (let ((root-ctx_0 (promise1.1 (lambda () (shift-to-inside-root-context - (make-root-expand-context.1 - #f - null - unsafe-undefined - unsafe-undefined + (root-expand-context-decode-for-module + (|#%app| get-encoded-root-expand-ctx_0) self_0))) #f))) (begin-unsafe (set-box! (namespace-root-expand-ctx ns_0) root-ctx_0))) - (if (procedure? get-encoded-root-expand-ctx_0) - (let ((root-ctx_0 - (promise1.1 - (lambda () - (shift-to-inside-root-context - (root-expand-context-decode-for-module - (|#%app| get-encoded-root-expand-ctx_0) - self_0))) - #f))) - (begin-unsafe - (set-box! - (namespace-root-expand-ctx ns_0) - root-ctx_0))) - (let ((root-ctx_0 - (promise1.1 - (lambda () - (shift-to-inside-root-context - (|#%app| - create-root-expand-context-from-module_0 - ns_0 - phase-shift_0 - original-self_0 - self_0))) - #f))) - (begin-unsafe - (set-box! - (namespace-root-expand-ctx ns_0) - root-ctx_0)))))))))))))) + (let ((root-ctx_0 + (promise1.1 + (lambda () + (shift-to-inside-root-context + (|#%app| + create-root-expand-context-from-module_0 + ns_0 + phase-shift_0 + original-self_0 + self_0))) + #f))) + (begin-unsafe + (set-box! + (namespace-root-expand-ctx ns_0) + root-ctx_0))))))))))))) (define force-syntax-deserialize (lambda (syntax-literals-data-instance_0 bulk-binding-registry_0) (if (let ((or-part_0 @@ -45732,202 +45312,197 @@ (void) (raise-argument-error who_0 "(or/c #f 'defined-names)" verbosity_0)))) (define provides->api-provides - (letrec ((procz1 (lambda (b/p_0) (not (provided-as-transformer? b/p_0)))) - (extract_0 - (|#%name| - extract - (lambda (defined-names?_0 provides_0 self_0 ok?_0) - (begin - (let ((result-l_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - provides_0 - i_0)) - (case-lambda - ((phase_0 at-phase_0) - (let ((fold-var_1 - (let ((l_0 - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_1 - i_1) - (begin - (if i_1 - (call-with-values - (lambda () - (hash-iterate-key+value - at-phase_0 - i_1)) - (case-lambda - ((sym_0 - b/p_0) - (let ((fold-var_2 - (if (|#%app| - ok?_0 - b/p_0) - (let ((fold-var_2 - (cons - (let ((b_0 - (provided-as-binding - b/p_0))) - (let ((app_0 - (if (eq? - self_0 - (module-binding-module - b_0)) - null - (reverse$1 - (let ((lst_0 - (cons - b_0 - (module-binding-extra-nominal-bindings - b_0)))) - (begin - (letrec* - ((for-loop_2 - (|#%name| - for-loop - (lambda (fold-var_2 - lst_1) - (begin - (if (pair? - lst_1) - (let ((b_1 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((fold-var_3 - (let ((fold-var_3 - (cons - (if (if (eqv? - (module-binding-nominal-phase - b_1) - phase_0) - (eq? - (module-binding-nominal-sym - b_1) - sym_0) - #f) - (module-binding-nominal-module - b_1) - (let ((app_0 - (module-binding-nominal-module - b_1))) - (let ((app_1 - (module-binding-phase - b_1))) - (let ((app_2 - (module-binding-nominal-sym - b_1))) - (list - app_0 - app_1 - app_2 - (module-binding-nominal-phase - b_1)))))) - fold-var_2))) - (values - fold-var_3)))) - (for-loop_2 - fold-var_3 - rest_0)))) - fold-var_2)))))) - (for-loop_2 - null - lst_0)))))))) - (list* - sym_0 - app_0 - (if defined-names?_0 - (list - (module-binding-sym - b_0)) - null)))) - fold-var_1))) - (values - fold-var_2)) - fold-var_1))) - (for-loop_1 - fold-var_2 - (hash-iterate-next - at-phase_0 - i_1)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - fold-var_1)))))) - (for-loop_1 - null - (hash-iterate-first - at-phase_0))))))) - (begin - #t - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_1) - (begin - (let ((fold-var_2 - (if (null? - l_0) - fold-var_1 - (let ((fold-var_2 - (cons + (lambda (provides_0 self_0 verbosity_0) + (let ((defined-names?_0 (eq? verbosity_0 'defined-names))) + (let ((extract_0 + (|#%name| + extract + (lambda (ok?_0) + (begin + (let ((result-l_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + provides_0 + i_0)) + (case-lambda + ((phase_0 at-phase_0) + (let ((fold-var_1 + (let ((l_0 + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_1 + i_1) + (begin + (if i_1 + (call-with-values + (lambda () + (hash-iterate-key+value + at-phase_0 + i_1)) + (case-lambda + ((sym_0 + b/p_0) + (let ((fold-var_2 + (if (|#%app| + ok?_0 + b/p_0) + (let ((fold-var_2 + (cons + (let ((b_0 + (provided-as-binding + b/p_0))) + (let ((app_0 + (if (eq? + self_0 + (module-binding-module + b_0)) + null + (reverse$1 + (let ((lst_0 + (cons + b_0 + (module-binding-extra-nominal-bindings + b_0)))) + (begin + (letrec* + ((for-loop_2 + (|#%name| + for-loop + (lambda (fold-var_2 + lst_1) + (begin + (if (pair? + lst_1) + (let ((b_1 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((fold-var_3 + (let ((fold-var_3 + (cons + (if (if (eqv? + (module-binding-nominal-phase + b_1) + phase_0) + (eq? + (module-binding-nominal-sym + b_1) + sym_0) + #f) + (module-binding-nominal-module + b_1) + (let ((app_0 + (module-binding-nominal-module + b_1))) + (let ((app_1 + (module-binding-phase + b_1))) + (let ((app_2 + (module-binding-nominal-sym + b_1))) + (list + app_0 + app_1 + app_2 + (module-binding-nominal-phase + b_1)))))) + fold-var_2))) + (values + fold-var_3)))) + (for-loop_2 + fold-var_3 + rest_0)))) + fold-var_2)))))) + (for-loop_2 + null + lst_0)))))))) + (list* + sym_0 + app_0 + (if defined-names?_0 + (list + (module-binding-sym + b_0)) + null)))) + fold-var_1))) + (values + fold-var_2)) + fold-var_1))) + (for-loop_1 + fold-var_2 + (hash-iterate-next + at-phase_0 + i_1)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + fold-var_1)))))) + (for-loop_1 + null + (hash-iterate-first + at-phase_0))))))) + (begin + #t + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_1) + (begin + (let ((fold-var_2 + (if (null? + l_0) + fold-var_1 + (let ((fold-var_2 (cons - phase_0 - (sort.1 - #f - car - l_0 - symbolapi-nonprovides (lambda (provides_0 all-vars_0) (let ((result-l_0 @@ -46159,19 +45734,19 @@ (let ((n_0 (module-compiled-current-name c_0))) (if (pair? n_0) (car (reverse$1 n_0)) n_0)))) (define change-module-name - (letrec ((recur_0 - (|#%name| - recur - (lambda (next-prefix_0 sub-c_0 name_0) - (begin - (if (let ((app_0 (module-compiled-current-name sub-c_0))) - (equal? app_0 (append next-prefix_0 (list name_0)))) - sub-c_0 - (change-module-name sub-c_0 name_0 next-prefix_0))))))) - (lambda (c_0 name_0 prefix_0) - (let ((full-name_0 - (if (null? prefix_0) name_0 (append prefix_0 (list name_0))))) - (let ((next-prefix_0 (if (null? prefix_0) (list name_0) full-name_0))) + (lambda (c_0 name_0 prefix_0) + (let ((full-name_0 + (if (null? prefix_0) name_0 (append prefix_0 (list name_0))))) + (let ((next-prefix_0 (if (null? prefix_0) (list name_0) full-name_0))) + (let ((recur_0 + (|#%name| + recur + (lambda (sub-c_0 name_1) + (begin + (if (let ((app_0 (module-compiled-current-name sub-c_0))) + (equal? app_0 (append next-prefix_0 (list name_1)))) + sub-c_0 + (change-module-name sub-c_0 name_1 next-prefix_0))))))) (if (compiled-in-memory? c_0) (let ((change-submodule-name_0 (|#%name| @@ -46179,15 +45754,14 @@ (lambda (sub-c_0) (begin (recur_0 - next-prefix_0 sub-c_0 (module-compiled-immediate-name sub-c_0))))))) (let ((pre-compiled-in-memorys_0 - (map_2960 + (map_1346 change-submodule-name_0 (compiled-in-memory-pre-compiled-in-memorys c_0)))) (let ((post-compiled-in-memorys_0 - (map_2960 + (map_1346 change-submodule-name_0 (compiled-in-memory-post-compiled-in-memorys c_0)))) (if (compiled-in-memory? c_0) @@ -46276,10 +45850,7 @@ (update-one-name val_0 full-name_0) - (recur_0 - next-prefix_0 - val_0 - key_0)))) + (recur_0 val_0 key_0)))) (case-lambda ((key_1 val_1) (hash-set @@ -46503,7 +46074,7 @@ non-star?_0 submods_0))) (let ((temp9_0 - (map_2960 + (map_1346 compiled->linklet-directory-or-bundle (let ((app_0 (if non-star?_0 @@ -46529,7 +46100,7 @@ (hash-set app_0 app_1 - (let ((temp10_0 (map_2960 module-compiled-immediate-name submods_0))) + (let ((temp10_0 (map_1346 module-compiled-immediate-name submods_0))) (sort.1 #f #f temp10_0 symbolh c_0))) (hash-ref h_0 'cross-phase-persistent? #f))))))) (define compile-module.1 - (letrec ((get-submodules_0 - (|#%name| - get-submodules - (lambda (compiled-submodules_0 - full-module-name_0 - need-compiled-submodule-rename?5_0 - p11_0 - star?_0) - (begin - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 i_0) + (|#%name| + compile-module + (lambda (force-linklet-directory?1_0 + modules-being-compiled4_0 + need-compiled-submodule-rename?5_0 + serializable?2_0 + to-correlated-linklet?3_0 + p11_0 + cctx12_0) + (begin + (let ((modules-being-compiled_0 + (if (eq? modules-being-compiled4_0 unsafe-undefined) + (make-hasheq) + modules-being-compiled4_0))) + (let ((full-module-name_0 + (let ((parent-full-name_0 + (compile-context-full-module-name cctx12_0))) + (let ((name_0 (syntax-e$1 (parsed-module-name-id p11_0)))) + (let ((parent-full-name_1 parent-full-name_0)) + (if parent-full-name_1 + (append + (if (list? parent-full-name_1) + parent-full-name_1 + (list parent-full-name_1)) + (list name_0)) + name_0)))))) + (let ((compiled-submodules_0 + (parsed-module-compiled-submodules p11_0))) + (let ((get-submodules_0 + (|#%name| + get-submodules + (lambda (star?_0) + (begin + (reverse$1 (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - compiled-submodules_0 - i_0)) - (case-lambda - ((name_0 star?+compiled_0) - (let ((fold-var_1 - (if (eq? - star?_0 - (car star?+compiled_0)) - (let ((fold-var_1 - (cons - (cons - name_0 - (if (if need-compiled-submodule-rename?5_0 - (not - (parsed-module-compiled-module - p11_0)) - #f) - (update-submodule-names - (cdr star?+compiled_0) - name_0 - full-module-name_0) - (cdr star?+compiled_0))) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + compiled-submodules_0 + i_0)) + (case-lambda + ((name_0 star?+compiled_0) + (let ((fold-var_1 + (if (eq? + star?_0 + (car star?+compiled_0)) + (let ((fold-var_1 + (cons + (cons + name_0 + (if (if need-compiled-submodule-rename?5_0 + (not + (parsed-module-compiled-module + p11_0)) + #f) + (update-submodule-names + (cdr + star?+compiled_0) + name_0 + full-module-name_0) + (cdr + star?+compiled_0))) + fold-var_0))) + (values fold-var_1)) fold-var_0))) - (values fold-var_1)) - fold-var_0))) - (for-loop_0 - fold-var_1 - (hash-iterate-next - compiled-submodules_0 - i_0)))) - (args - (raise-binding-result-arity-error 2 args)))) - fold-var_0)))))) - (for-loop_0 - null - (hash-iterate-first compiled-submodules_0)))))))))) - (|#%name| - compile-module - (lambda (force-linklet-directory?1_0 - modules-being-compiled4_0 - need-compiled-submodule-rename?5_0 - serializable?2_0 - to-correlated-linklet?3_0 - p11_0 - cctx12_0) - (begin - (let ((modules-being-compiled_0 - (if (eq? modules-being-compiled4_0 unsafe-undefined) - (make-hasheq) - modules-being-compiled4_0))) - (let ((full-module-name_0 - (let ((parent-full-name_0 - (compile-context-full-module-name cctx12_0))) - (let ((name_0 (syntax-e$1 (parsed-module-name-id p11_0)))) - (let ((parent-full-name_1 parent-full-name_0)) - (if parent-full-name_1 - (append - (if (list? parent-full-name_1) - parent-full-name_1 - (list parent-full-name_1)) - (list name_0)) - name_0)))))) - (let ((compiled-submodules_0 - (parsed-module-compiled-submodules p11_0))) + (for-loop_0 + fold-var_1 + (hash-iterate-next + compiled-submodules_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + fold-var_0)))))) + (for-loop_0 + null + (hash-iterate-first + compiled-submodules_0)))))))))) (let ((pre-submodules_0 - (let ((temp33_0 - (get-submodules_0 - compiled-submodules_0 - full-module-name_0 - need-compiled-submodule-rename?5_0 - p11_0 - #f))) + (let ((temp33_0 (get-submodules_0 #f))) (sort.1 #f car temp33_0 symbolnamespace?_0 - (box #f))) - (let ((mpis_0 (make-module-path-index-table))) - (let ((body-cctx_0 - (if (compile-context? cctx31_0) - (let ((app_0 - (compile-context-namespace - cctx31_0))) - (compile-context1.1 - app_0 - 0 - self_0 - self_0 - full-module-name14_0 - #t - (compile-context-header - cctx31_0))) - (raise-argument-error - 'struct-copy - "compile-context?" - cctx31_0)))) - (let ((cross-phase-persistent?_0 (box #f))) - (let ((unsafe?-box_0 (box #f))) - (let ((side-effects_0 (make-hasheqv))) - (let ((check-side-effects!_0 - (|#%name| - check-side-effects! - (lambda (e_0 - expected-results_0 - phase_0 - required-reference?_0) - (begin - (if (hash-ref - side-effects_0 - phase_0 - #f) - (void) - (if (any-side-effects?.1 - hash2610 - hash2610 - required-reference?_0 - e_0 - expected-results_0) - (hash-set! - side-effects_0 - phase_0 - #t) - (void)))))))) - (begin - (if (if need-compiled-submodule-rename?21_0 - modules-being-compiled18_0 - #f) - (begin - (if (null? - post-submodules20_0) - (void) - (error - "internal error: have post submodules, but not already compiled")) - (register-compiled-submodules - modules-being-compiled18_0 - pre-submodules19_0 - self_0)) - (void)) - (call-with-values - (lambda () - (let ((temp60_0 + (if log-performance? + (start-performance-region 'compile 'module) + (void)) + (begin0 + (let ((enclosing-self_0 (compile-context-module-self cctx31_0))) + (let ((self_0 (parsed-module-self p30_0))) + (let ((requires_0 (parsed-module-requires p30_0))) + (let ((provides_0 (parsed-module-provides p30_0))) + (let ((encoded-root-expand-ctx-box_0 + (box (parsed-module-encoded-root-ctx p30_0)))) + (let ((body-context-simple?_0 + (parsed-module-root-ctx-simple? p30_0))) + (let ((language-info_0 + (filter-language-info + (syntax-property$1 + (parsed-s p30_0) + 'module-language)))) + (let ((bodys_0 (parsed-module-body p30_0))) + (let ((empty-result-for-module->namespace?_0 #f)) + (let ((mpis_0 (make-module-path-index-table))) + (let ((body-cctx_0 + (if (compile-context? cctx31_0) + (let ((app_0 + (compile-context-namespace + cctx31_0))) + (compile-context1.1 + app_0 + 0 + self_0 + self_0 + full-module-name14_0 + #t + (compile-context-header cctx31_0))) + (raise-argument-error + 'struct-copy + "compile-context?" + cctx31_0)))) + (let ((cross-phase-persistent?_0 #f)) + (let ((unsafe?-box_0 (box #f))) + (let ((side-effects_0 (make-hasheqv))) + (let ((check-side-effects!_0 + (|#%name| + check-side-effects! + (lambda (e_0 + expected-results_0 + phase_0 + required-reference?_0) + (begin + (if (hash-ref + side-effects_0 + phase_0 + #f) + (void) + (if (any-side-effects?.1 + hash2610 + hash2610 + required-reference?_0 + e_0 + expected-results_0) + (hash-set! + side-effects_0 + phase_0 + #t) + (void)))))))) + (begin + (if (if need-compiled-submodule-rename?21_0 + modules-being-compiled18_0 + #f) + (begin + (if (null? post-submodules20_0) + (void) + (error + "internal error: have post submodules, but not already compiled")) + (register-compiled-submodules + modules-being-compiled18_0 + pre-submodules19_0 + self_0)) + (void)) + (call-with-values + (lambda () + (let ((temp60_0 + (list + (list + get-syntax-literal!-id) + (list + set-transformer!-id)))) + (let ((temp61_0 (list - (list - get-syntax-literal!-id) - (list - set-transformer!-id)))) - (let ((temp61_0 - (list - empty-syntax-literals-instance - empty-module-body-instance))) - (let ((temp62_0 '((void)))) - (let ((temp63_0 '(0))) - (let ((temp67_0 - (lambda (body_0 - cctx_0) - (if (|parsed-#%declare?| - body_0) - (call-with-values - (lambda () - (let ((s_0 - (parsed-s - body_0))) - (call-with-values - (lambda () - (let ((s_1 - (if (syntax?$1 - s_0) - (syntax-e$1 + empty-syntax-literals-instance + empty-module-body-instance))) + (let ((temp62_0 '((void)))) + (let ((temp63_0 '(0))) + (let ((temp67_0 + (lambda (body_0 + cctx_0) + (if (|parsed-#%declare?| + body_0) + (call-with-values + (lambda () + (let ((s_0 + (parsed-s + body_0))) + (call-with-values + (lambda () + (let ((s_1 + (if (syntax?$1 s_0) - s_0))) - (if (pair? - s_1) - (let ((_0 + (syntax-e$1 + s_0) + s_0))) + (if (pair? + s_1) + (let ((_0 + (let ((s_2 + (car + s_1))) + s_2))) + (let ((kw76_0 (let ((s_2 - (car + (cdr s_1))) - s_2))) - (let ((kw76_0 - (let ((s_2 - (cdr - s_1))) - (let ((s_3 - (if (syntax?$1 - s_2) - (syntax-e$1 + (let ((s_3 + (if (syntax?$1 s_2) - s_2))) - (let ((flat-s_0 - (to-syntax-list.1 - s_3))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - s_0) - flat-s_0)))))) - (let ((_1 - _0)) - (values - _1 - kw76_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - s_0)))) - (case-lambda - ((_0 - kw74_0) - (values - #t - _0 - kw74_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((ok?_0 - _0 - kw74_0) + (syntax-e$1 + s_2) + s_2))) + (let ((flat-s_0 + (to-syntax-list.1 + s_3))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + s_0) + flat-s_0)))))) + (let ((_1 + _0)) + (values + _1 + kw76_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + s_0)))) + (case-lambda + ((_0 + kw74_0) + (values + #t + _0 + kw74_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((ok?_0 + _0 + kw74_0) + (begin (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? - lst_0) - (let ((kw_0 - (unsafe-car + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? + lst_0) + (let ((kw_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) + (begin (begin - (begin - (if (eq? - (syntax-e$1 - kw_0) - kw2208) - (unsafe-set-box*! - cross-phase-persistent?_0 - #t) - (void)) - (if (eq? - (syntax-e$1 - kw_0) - kw2910) - (begin - (unsafe-set-box*! - empty-result-for-module->namespace?_0 - #t) - (set-box! - encoded-root-expand-ctx-box_0 - #f)) - (void)) - (if (eq? - (syntax-e$1 - kw_0) - kw2838) + (if (eq? + (syntax-e$1 + kw_0) + kw2208) + (set! cross-phase-persistent?_0 + #t) + (void)) + (if (eq? + (syntax-e$1 + kw_0) + kw2910) + (begin + (set! empty-result-for-module->namespace?_0 + #t) (set-box! - unsafe?-box_0 - #t) - (void))) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 - kw74_0))) - (void) - #f)) - (args - (raise-binding-result-arity-error - 3 - args)))) - #f)))) - (let ((temp68_0 - (lambda (mod-name_0 - phase_0) - (let ((ht_0 - (if modules-being-compiled18_0 - (hash-ref - modules-being-compiled18_0 - mod-name_0 - #f) - #f))) - (if ht_0 - (hash-ref - ht_0 - phase_0 - #f) - #f))))) - (compile-forms.1 - temp61_0 - temp60_0 - temp62_0 - check-side-effects!_0 - void - encoded-root-expand-ctx-box_0 - temp63_0 - temp68_0 - #t - #t - temp67_0 - body-context-simple?_0 - serializable?16_0 - to-correlated-linklet?17_0 - unsafe?-box_0 - bodys_0 - body-cctx_0 - mpis_0)))))))) - (case-lambda - ((body-linklets_0 - min-phase_0 - max-phase_0 - phase-to-link-module-uses_0 - phase-to-link-module-uses-expr_0 - phase-to-link-extra-inspectorsss_0 - syntax-literals_0 - root-ctx-pos_0) - (begin - (if modules-being-compiled18_0 - (let ((app_0 - (1/module-path-index-resolve - self_0))) - (hash-set! - modules-being-compiled18_0 - app_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 - i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - body-linklets_0 - i_0)) - (case-lambda - ((phase_0 - linklet_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - phase_0 - (let ((app_1 - (hash-ref - phase-to-link-module-uses_0 - phase_0 - #f))) - (module-linklet-info2.1 - linklet_0 - app_1 - self_0 - #f - #f - (if phase-to-link-extra-inspectorsss_0 + encoded-root-expand-ctx-box_0 + #f)) + (void)) + (if (eq? + (syntax-e$1 + kw_0) + kw2838) + (set-box! + unsafe?-box_0 + #t) + (void))) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + kw74_0))) + (void) + #f)) + (args + (raise-binding-result-arity-error + 3 + args)))) + #f)))) + (let ((temp68_0 + (lambda (mod-name_0 + phase_0) + (let ((ht_0 + (if modules-being-compiled18_0 + (hash-ref + modules-being-compiled18_0 + mod-name_0 + #f) + #f))) + (if ht_0 + (hash-ref + ht_0 + phase_0 + #f) + #f))))) + (compile-forms.1 + temp61_0 + temp60_0 + temp62_0 + check-side-effects!_0 + void + encoded-root-expand-ctx-box_0 + temp63_0 + temp68_0 + #t + #t + temp67_0 + body-context-simple?_0 + serializable?16_0 + to-correlated-linklet?17_0 + unsafe?-box_0 + bodys_0 + body-cctx_0 + mpis_0)))))))) + (case-lambda + ((body-linklets_0 + min-phase_0 + max-phase_0 + phase-to-link-module-uses_0 + phase-to-link-module-uses-expr_0 + phase-to-link-extra-inspectorsss_0 + syntax-literals_0 + root-ctx-pos_0) + (begin + (if modules-being-compiled18_0 + (let ((app_0 + (1/module-path-index-resolve + self_0))) + (hash-set! + modules-being-compiled18_0 + app_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 + i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + body-linklets_0 + i_0)) + (case-lambda + ((phase_0 + linklet_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + phase_0 + (let ((app_1 (hash-ref - phase-to-link-extra-inspectorsss_0 + phase-to-link-module-uses_0 phase_0 - #f) - #f))))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - body-linklets_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2610 - (hash-iterate-first - body-linklets_0)))))) - (void)) - (let ((declaration-linklet_0 - (if serializable?16_0 + #f))) + (module-linklet-info2.1 + linklet_0 + app_1 + self_0 + #f + #f + (if phase-to-link-extra-inspectorsss_0 + (hash-ref + phase-to-link-extra-inspectorsss_0 + phase_0 + #f) + #f))))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + body-linklets_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2610 + (hash-iterate-first + body-linklets_0)))))) + (void)) + (let ((declaration-linklet_0 + (if serializable?16_0 + (let ((s_0 + (generate-module-declaration-linklet + mpis_0 + self_0 + requires_0 + provides_0 + phase-to-link-module-uses-expr_0))) + (if to-correlated-linklet?17_0 + (begin-unsafe + (correlated-linklet1.1 + s_0 + 'decl + #f)) + (begin + (if log-performance? + (start-performance-region + 'compile + 'module + 'linklet) + (void)) + (begin0 + (compile-linklet + s_0 + 'decl) + (if log-performance? + (end-performance-region) + (void)))))) + #f))) + (let ((syntax-literals-linklet_0 + (if (not + (begin-unsafe + (null? + (syntax-literals-stxes + syntax-literals_0)))) (let ((s_0 - (generate-module-declaration-linklet - mpis_0 - self_0 - requires_0 - provides_0 - phase-to-link-module-uses-expr_0))) + (let ((app_0 + (list + deserialize-imports + (list + mpi-vector-id) + (list* + deserialized-syntax-vector-id + (if serializable?16_0 + (list + deserialize-syntax-id) + '())) + instance-imports))) + (list* + 'linklet + app_0 + (list* + get-syntax-literal!-id + '(get-encoded-root-expand-ctx)) + (let ((app_1 + (let ((temp80_0 + (not + serializable?16_0))) + (generate-lazy-syntax-literals!.1 + temp80_0 + syntax-literals_0 + mpis_0 + self_0)))) + (qq-append + app_1 + (list + (list + 'define-values + '(get-encoded-root-expand-ctx) + (if root-ctx-pos_0 + (list + 'lambda + '() + (begin-unsafe + (list + get-syntax-literal!-id + root-ctx-pos_0))) + (if empty-result-for-module->namespace?_0 + ''empty + ''#f)))))))))) (if to-correlated-linklet?17_0 (begin-unsafe (correlated-linklet1.1 s_0 - 'decl + 'syntax-literals #f)) (begin (if log-performance? @@ -47180,404 +46806,332 @@ 'linklet) (void)) (begin0 - (compile-linklet - s_0 - 'decl) + (call-with-values + (lambda () + (compile-linklet + s_0 + 'syntax-literals + (vector + deserialize-instance + empty-top-syntax-literal-instance + empty-syntax-literals-data-instance + empty-instance-instance) + (lambda (inst_0) + (values + inst_0 + #f)) + (if serializable?16_0 + '(serializable) + '()))) + (case-lambda + ((linklet_0 + new-keys_0) + linklet_0) + (args + (raise-binding-result-arity-error + 2 + args)))) (if log-performance? (end-performance-region) (void)))))) #f))) - (let ((syntax-literals-linklet_0 - (if (not - (begin-unsafe - (null? - (syntax-literals-stxes - syntax-literals_0)))) - (let ((s_0 - (let ((app_0 - (list - deserialize-imports - (list - mpi-vector-id) - (list* - deserialized-syntax-vector-id - (if serializable?16_0 - (list - deserialize-syntax-id) - '())) - instance-imports))) - (list* - 'linklet - app_0 - (list* - get-syntax-literal!-id - '(get-encoded-root-expand-ctx)) - (let ((app_1 - (let ((temp80_0 - (not - serializable?16_0))) - (generate-lazy-syntax-literals!.1 - temp80_0 - syntax-literals_0 - mpis_0 - self_0)))) - (qq-append - app_1 - (list - (list - 'define-values - '(get-encoded-root-expand-ctx) - (if root-ctx-pos_0 + (let ((syntax-literals-data-linklet_0 + (if serializable?16_0 + (if (not + (begin-unsafe + (null? + (syntax-literals-stxes + syntax-literals_0)))) + (let ((s_0 + (let ((app_0 + (list + 'define-values (list - 'lambda - '() - (begin-unsafe - (list - get-syntax-literal!-id - root-ctx-pos_0))) - (if (unsafe-unbox* - empty-result-for-module->namespace?_0) - ''empty - ''#f)))))))))) - (if to-correlated-linklet?17_0 - (begin-unsafe - (correlated-linklet1.1 - s_0 - 'syntax-literals - #f)) - (begin - (if log-performance? - (start-performance-region - 'compile - 'module - 'linklet) - (void)) - (begin0 - (call-with-values - (lambda () - (compile-linklet - s_0 - 'syntax-literals - (vector - deserialize-instance - empty-top-syntax-literal-instance - empty-syntax-literals-data-instance - empty-instance-instance) - procz1 - (if serializable?16_0 - '(serializable) - '()))) - (case-lambda - ((linklet_0 - new-keys_0) - linklet_0) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if log-performance? - (end-performance-region) - (void)))))) - #f))) - (let ((syntax-literals-data-linklet_0 - (if serializable?16_0 - (if (not - (begin-unsafe - (null? - (syntax-literals-stxes - syntax-literals_0)))) - (let ((s_0 - (let ((app_0 - (list - 'define-values - (list - deserialized-syntax-vector-id) - (list* - 'make-vector - (syntax-literals-count - syntax-literals_0) - '(#f))))) - (list* - 'linklet - (list - deserialize-imports - (list - mpi-vector-id)) - (list - deserialized-syntax-vector-id - deserialize-syntax-id) - app_0 - (begin + deserialized-syntax-vector-id) + (list* + 'make-vector + (syntax-literals-count + syntax-literals_0) + '(#f))))) + (list* + 'linklet + (list + deserialize-imports + (list + mpi-vector-id)) + (list + deserialized-syntax-vector-id + deserialize-syntax-id) + app_0 + (begin + (if log-performance? + (start-performance-region + 'compile + 'module + 'serialize) + (void)) + (begin0 + (generate-lazy-syntax-literals-data! + syntax-literals_0 + mpis_0) (if log-performance? - (start-performance-region - 'compile - 'module - 'serialize) - (void)) - (begin0 - (generate-lazy-syntax-literals-data! - syntax-literals_0 - mpis_0) - (if log-performance? - (end-performance-region) - (void)))))))) - (if to-correlated-linklet?17_0 - (begin-unsafe - (correlated-linklet1.1 - s_0 - 'syntax-literals-data - #f)) - (begin + (end-performance-region) + (void)))))))) + (if to-correlated-linklet?17_0 + (begin-unsafe + (correlated-linklet1.1 + s_0 + 'syntax-literals-data + #f)) + (begin + (if log-performance? + (start-performance-region + 'compile + 'module + 'linklet) + (void)) + (begin0 + (compile-linklet + s_0 + 'syntax-literals-data + #f + #f + '(serializable)) (if log-performance? - (start-performance-region - 'compile - 'module - 'linklet) - (void)) - (begin0 - (compile-linklet - s_0 - 'syntax-literals-data - #f - #f - '(serializable)) - (if log-performance? - (end-performance-region) - (void)))))) - #f) + (end-performance-region) + (void)))))) + #f) + #f))) + (let ((data-linklet_0 + (if serializable?16_0 + (let ((s_0 + (generate-module-data-linklet + mpis_0))) + (if to-correlated-linklet?17_0 + (begin-unsafe + (correlated-linklet1.1 + s_0 + 'data + #f)) + (begin + (if log-performance? + (start-performance-region + 'compile + 'module + 'linklet) + (void)) + (begin0 + (compile-linklet + s_0 + 'data) + (if log-performance? + (end-performance-region) + (void)))))) #f))) - (let ((data-linklet_0 - (if serializable?16_0 - (let ((s_0 - (generate-module-data-linklet - mpis_0))) - (if to-correlated-linklet?17_0 - (begin-unsafe - (correlated-linklet1.1 - s_0 - 'data - #f)) - (begin - (if log-performance? - (start-performance-region - 'compile - 'module - 'linklet) - (void)) - (begin0 - (compile-linklet - s_0 - 'data) - (if log-performance? - (end-performance-region) - (void)))))) - #f))) - (let ((bundle_0 - (let ((bundle_0 + (let ((bundle_0 + (let ((bundle_0 + (hash-set + body-linklets_0 + 'name + full-module-name14_0))) + (let ((bundle_1 (hash-set - body-linklets_0 - 'name - full-module-name14_0))) - (let ((bundle_1 - (hash-set - bundle_0 - 'decl - (if declaration-linklet_0 - declaration-linklet_0 - 'in-memory)))) - (let ((bundle_2 - (if data-linklet_0 + bundle_0 + 'decl + (if declaration-linklet_0 + declaration-linklet_0 + 'in-memory)))) + (let ((bundle_2 + (if data-linklet_0 + (hash-set + bundle_1 + 'data + data-linklet_0) + bundle_1))) + (let ((bundle_3 + (if syntax-literals-linklet_0 (hash-set - bundle_1 - 'data - data-linklet_0) - bundle_1))) - (let ((bundle_3 - (if syntax-literals-linklet_0 + bundle_2 + 'stx + syntax-literals-linklet_0) + bundle_2))) + (let ((bundle_4 + (if syntax-literals-data-linklet_0 (hash-set - bundle_2 - 'stx - syntax-literals-linklet_0) - bundle_2))) - (let ((bundle_4 - (if syntax-literals-data-linklet_0 + bundle_3 + 'stx-data + syntax-literals-data-linklet_0) + bundle_3))) + (let ((bundle_5 + (if (null? + pre-submodules19_0) + bundle_4 (hash-set - bundle_3 - 'stx-data - syntax-literals-data-linklet_0) - bundle_3))) - (let ((bundle_5 + bundle_4 + 'pre + (map_1346 + car + pre-submodules19_0))))) + (let ((bundle_6 (if (null? - pre-submodules19_0) - bundle_4 + post-submodules20_0) + bundle_5 (hash-set - bundle_4 - 'pre - (map_2960 + bundle_5 + 'post + (map_1346 car - pre-submodules19_0))))) - (let ((bundle_6 - (if (null? - post-submodules20_0) - bundle_5 + post-submodules20_0))))) + (let ((bundle_7 + (if cross-phase-persistent?_0 (hash-set - bundle_5 - 'post - (map_2960 - car - post-submodules20_0))))) - (let ((bundle_7 - (if (unsafe-unbox* - cross-phase-persistent?_0) + bundle_6 + 'cross-phase-persistent? + #t) + bundle_6))) + (let ((bundle_8 + (if language-info_0 (hash-set - bundle_6 - 'cross-phase-persistent? - #t) - bundle_6))) - (let ((bundle_8 - (if language-info_0 + bundle_7 + 'language-info + language-info_0) + bundle_7))) + (let ((bundle_9 + (if (zero? + min-phase_0) + bundle_8 (hash-set - bundle_7 - 'language-info - language-info_0) - bundle_7))) - (let ((bundle_9 + bundle_8 + 'min-phase + min-phase_0)))) + (let ((bundle_10 (if (zero? - min-phase_0) - bundle_8 + max-phase_0) + bundle_9 (hash-set - bundle_8 - 'min-phase - min-phase_0)))) - (let ((bundle_10 - (if (zero? - max-phase_0) - bundle_9 + bundle_9 + 'max-phase + max-phase_0)))) + (let ((bundle_11 + (if (hash-count + side-effects_0) (hash-set - bundle_9 - 'max-phase - max-phase_0)))) - (let ((bundle_11 - (if (hash-count - side-effects_0) + bundle_10 + 'side-effects + (let ((temp81_0 + (hash-keys + side-effects_0))) + (sort.1 + #f + #f + temp81_0 + <))) + bundle_10))) + (let ((bundle_12 + (if empty-result-for-module->namespace?_0 (hash-set - bundle_10 - 'side-effects - (let ((temp81_0 - (hash-keys - side-effects_0))) - (sort.1 - #f - #f - temp81_0 - <))) - bundle_10))) - (let ((bundle_12 - (if (unsafe-unbox* - empty-result-for-module->namespace?_0) + bundle_11 + 'module->namespace + 'empty) + bundle_11))) + (let ((bundle_13 + (if (unbox + unsafe?-box_0) (hash-set - bundle_11 - 'module->namespace - 'empty) - bundle_11))) - (let ((bundle_13 - (if (unbox - unsafe?-box_0) - (hash-set - bundle_12 - 'unsafe? - #t) - bundle_12))) - (hash->linklet-bundle - bundle_13))))))))))))))))) - (let ((ld_0 - (if (if (null? - pre-submodules19_0) - (if (null? - post-submodules20_0) - (not - force-linklet-directory?15_0) - #f) + bundle_12 + 'unsafe? + #t) + bundle_12))) + (hash->linklet-bundle + bundle_13))))))))))))))))) + (let ((ld_0 + (if (if (null? + pre-submodules19_0) + (if (null? + post-submodules20_0) + (not + force-linklet-directory?15_0) #f) - bundle_0 - (let ((ht_0 - (let ((lst_0 - (append - pre-submodules19_0 - post-submodules20_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ht_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((sm_0 - (unsafe-car + #f) + bundle_0 + (let ((ht_0 + (let ((lst_0 + (append + pre-submodules19_0 + post-submodules20_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ht_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((sm_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((ht_1 - (let ((ht_1 - (let ((app_0 - (car - sm_0))) - (hash-set - ht_0 - app_0 - (compiled-in-memory-linklet-directory - (cdr - sm_0)))))) - (values - ht_1)))) - (for-loop_0 - ht_1 - rest_0)))) - ht_0)))))) - (for-loop_0 - (hasheq - #f - bundle_0) - lst_0)))))) - (hash->linklet-directory - ht_0))))) - (let ((app_0 - (current-code-inspector))) - (let ((app_1 - (mpis-as-vector - mpis_0))) - (let ((app_2 - (syntax-literals-as-vector - syntax-literals_0))) - (let ((app_3 - (map_2960 - cdr - pre-submodules19_0))) - (compiled-in-memory1.1 - ld_0 - self_0 - requires_0 - provides_0 - phase-to-link-module-uses_0 - app_0 - phase-to-link-extra-inspectorsss_0 - app_1 - app_2 - app_3 - (map_2960 - cdr - post-submodules20_0) - #f - #f))))))))))))) - (args - (raise-binding-result-arity-error - 8 - args)))))))))))))))))))) - (if log-performance? (end-performance-region) (void))))))))) + (let ((ht_1 + (let ((ht_1 + (let ((app_0 + (car + sm_0))) + (hash-set + ht_0 + app_0 + (compiled-in-memory-linklet-directory + (cdr + sm_0)))))) + (values + ht_1)))) + (for-loop_0 + ht_1 + rest_0)))) + ht_0)))))) + (for-loop_0 + (hasheq + #f + bundle_0) + lst_0)))))) + (hash->linklet-directory + ht_0))))) + (let ((app_0 + (current-code-inspector))) + (let ((app_1 + (mpis-as-vector + mpis_0))) + (let ((app_2 + (syntax-literals-as-vector + syntax-literals_0))) + (let ((app_3 + (map_1346 + cdr + pre-submodules19_0))) + (compiled-in-memory1.1 + ld_0 + self_0 + requires_0 + provides_0 + phase-to-link-module-uses_0 + app_0 + phase-to-link-extra-inspectorsss_0 + app_1 + app_2 + app_3 + (map_1346 + cdr + post-submodules20_0) + #f + #f))))))))))))) + (args + (raise-binding-result-arity-error + 8 + args)))))))))))))))))))) + (if log-performance? (end-performance-region) (void)))))))) (define update-submodule-names (lambda (cim_0 name_0 full-module-name_0) (change-module-name @@ -47904,362 +47458,271 @@ (define recompiled-self (|#%name| recompiled-self (record-accessor struct:recompiled 2))) (define recompile-bundle - (letrec ((decl_0 - (|#%name| - decl - (lambda (declaration-instance_0 key_0) - (begin - (instance-variable-value declaration-instance_0 key_0))))) - (eval-metadata-linklet_0 - (|#%name| - eval-metadata-linklet - (lambda (can-eval-compiled?_0 h_0 orig-h_0 key_0) - (begin - (if can-eval-compiled?_0 - (eval-linklet (hash-ref h_0 key_0)) - (eval-correlated-linklet (hash-ref orig-h_0 key_0))))))) - (root-of_0 - (|#%name| - root-of - (lambda (l_0) (begin (if (pair? l_0) (car l_0) l_0)))))) - (lambda (b_0 get-submodule-recompiled_0 ns_0 target-machine_0) - (let ((orig-h_0 (linklet-bundle->hash b_0))) - (let ((h_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () (hash-iterate-key+value orig-h_0 i_0)) - (case-lambda - ((k_0 v_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (if (if (not - (exact-integer? k_0)) - (correlated-linklet? v_0) - #f) - (values - k_0 - (force-compile-linklet v_0)) - (values k_0 v_0))) - (case-lambda - ((key_0 val_0) - (hash-set table_0 key_0 val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next orig-h_0 i_0)))) - (args (raise-binding-result-arity-error 2 args)))) - table_0)))))) - (for-loop_0 hash2610 (hash-iterate-first orig-h_0)))))) - (let ((can-eval-compiled?_0 - (eq? target-machine_0 (system-type 'target-machine)))) + (lambda (b_0 get-submodule-recompiled_0 ns_0 target-machine_0) + (let ((orig-h_0 (linklet-bundle->hash b_0))) + (let ((h_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () (hash-iterate-key+value orig-h_0 i_0)) + (case-lambda + ((k_0 v_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (if (if (not (exact-integer? k_0)) + (correlated-linklet? v_0) + #f) + (values + k_0 + (force-compile-linklet v_0)) + (values k_0 v_0))) + (case-lambda + ((key_0 val_0) + (hash-set table_0 key_0 val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next orig-h_0 i_0)))) + (args (raise-binding-result-arity-error 2 args)))) + table_0)))))) + (for-loop_0 hash2610 (hash-iterate-first orig-h_0)))))) + (let ((can-eval-compiled?_0 + (eq? target-machine_0 (system-type 'target-machine)))) + (let ((eval-metadata-linklet_0 + (|#%name| + eval-metadata-linklet + (lambda (key_0) + (begin + (if can-eval-compiled?_0 + (eval-linklet (hash-ref h_0 key_0)) + (eval-correlated-linklet + (hash-ref orig-h_0 key_0)))))))) (let ((data-instance_0 (instantiate-linklet - (eval-metadata-linklet_0 - can-eval-compiled?_0 - h_0 - orig-h_0 - 'data) + (eval-metadata-linklet_0 'data) (list deserialize-instance)))) (let ((declaration-instance_0 (instantiate-linklet - (eval-metadata-linklet_0 - can-eval-compiled?_0 - h_0 - orig-h_0 - 'decl) + (eval-metadata-linklet_0 'decl) (list deserialize-instance data-instance_0)))) - (let ((mpis_0 (make-module-path-index-table))) - (begin - (call-with-values - (lambda () - (let ((vec_0 - (instance-variable-value - data-instance_0 - mpi-vector-id))) + (let ((decl_0 + (|#%name| + decl + (lambda (key_0) + (begin + (instance-variable-value + declaration-instance_0 + key_0)))))) + (let ((mpis_0 (make-module-path-index-table))) + (begin + (call-with-values + (lambda () + (let ((vec_0 + (instance-variable-value + data-instance_0 + mpi-vector-id))) + (begin + (check-vector vec_0) + (values vec_0 (unsafe-vector-length vec_0))))) + (case-lambda + ((vec_0 len_0) (begin - (check-vector vec_0) - (values vec_0 (unsafe-vector-length vec_0))))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (unsafe-fx< pos_0 len_0) - (let ((mpi_0 - (unsafe-vector-ref vec_0 pos_0))) - (begin - (add-module-path-index! mpis_0 mpi_0) - (for-loop_0 (unsafe-fx+ 1 pos_0)))) - (values))))))) - (for-loop_0 0)))) - (args (raise-binding-result-arity-error 2 args)))) - (let ((self_0 - (begin-unsafe - (begin - (instance-variable-value - declaration-instance_0 - 'self-mpi))))) - (let ((phase-to-link-modules_0 + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< pos_0 len_0) + (let ((mpi_0 + (unsafe-vector-ref vec_0 pos_0))) + (begin + (add-module-path-index! mpis_0 mpi_0) + (for-loop_0 (unsafe-fx+ 1 pos_0)))) + (values))))))) + (for-loop_0 0)))) + (args (raise-binding-result-arity-error 2 args)))) + (let ((self_0 (begin-unsafe (begin (instance-variable-value declaration-instance_0 - 'phase-to-link-modules))))) - (let ((unsafe?_0 (hash-ref orig-h_0 'unsafe? #f))) - (let ((find-submodule_0 - (|#%name| - find-submodule - (lambda (mod-name_0 phase_0) - (begin - (let ((find-l_0 - (1/resolved-module-path-name - mod-name_0))) - (let ((self-l_0 + 'self-mpi))))) + (let ((phase-to-link-modules_0 + (begin-unsafe + (begin + (instance-variable-value + declaration-instance_0 + 'phase-to-link-modules))))) + (let ((unsafe?_0 (hash-ref orig-h_0 'unsafe? #f))) + (let ((find-submodule_0 + (|#%name| + find-submodule + (lambda (mod-name_0 phase_0) + (begin + (let ((find-l_0 (1/resolved-module-path-name - (1/module-path-index-resolve - self_0)))) - (if (let ((app_0 - (root-of_0 find-l_0))) - (equal? - app_0 - (root-of_0 self-l_0))) - (let ((r_0 - (|#%app| - get-submodule-recompiled_0 - (if (pair? find-l_0) - (cdr find-l_0) - '())))) - (begin - (if (eq? r_0 'in-process) - (raise-arguments-error - 'compiled-expression-recompile - "cycle in linklet imports") - (void)) - (let ((b_1 - (recompiled-bundle - r_0))) - (let ((linklet_0 - (let ((or-part_0 - (hash-ref - (linklet-bundle->hash - b_1) - phase_0 - #f))) - (if or-part_0 - or-part_0 - (raise-arguments-error - 'compiled-expression-recompile - "cannot find submodule at phase" - "submodule" - mod-name_0 - "phase" - phase_0))))) - (let ((app_0 - (hash-ref - (recompiled-phase-to-link-module-uses - r_0) - phase_0 - #f))) - (let ((app_1 - (recompiled-self - r_0))) - (module-linklet-info2.1 - linklet_0 - app_0 - app_1 - #f - (current-code-inspector) - #f))))))) - #f)))))))) - (let ((body-linklets+module-use*s_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - h_0 - i_0)) - (case-lambda - ((phase_0 body-linklet_0) - (let ((table_1 - (if (exact-integer? - phase_0) - (let ((table_1 - (call-with-values - (lambda () - (let ((module-use*s_0 - (module-uses-add-extra-inspectorsss - (hash-ref - phase-to-link-modules_0 - phase_0) - #f))) - (call-with-values - (lambda () - (let ((temp3_0 - (if (correlated-linklet? - body-linklet_0) - (correlated-linklet-expr - body-linklet_0) - body-linklet_0))) - (let ((temp4_0 - (if (correlated-linklet? - body-linklet_0) - compile-linklet - recompile-linklet))) - (let ((temp5_0 - (list - (list - get-syntax-literal!-id) - (list - set-transformer!-id)))) - (let ((temp6_0 - (list - empty-syntax-literals-instance - empty-module-body-instance))) - (let ((temp5_1 - temp5_0) - (temp4_1 - temp4_0) - (temp3_1 - temp3_0)) - (compile-module-linklet.1 - temp6_0 - temp5_1 - temp4_1 - find-submodule_0 - #t - #t - module-use*s_0 - ns_0 - #t - #t - unsafe?_0 - temp3_1))))))) - (case-lambda - ((linklet_0 - new-module-use*s_0) - (values - phase_0 - (cons - linklet_0 - new-module-use*s_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)) - table_0))) - (for-loop_0 - table_1 - (hash-iterate-next - h_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2725 - (hash-iterate-first h_0)))))) - (let ((h/new-body-linklets_0 + mod-name_0))) + (let ((self-l_0 + (1/resolved-module-path-name + (1/module-path-index-resolve + self_0)))) + (let ((root-of_0 + (|#%name| + root-of + (lambda (l_0) + (begin + (if (pair? l_0) + (car l_0) + l_0)))))) + (if (let ((app_0 + (root-of_0 find-l_0))) + (equal? + app_0 + (root-of_0 self-l_0))) + (let ((r_0 + (|#%app| + get-submodule-recompiled_0 + (if (pair? find-l_0) + (cdr find-l_0) + '())))) + (begin + (if (eq? r_0 'in-process) + (raise-arguments-error + 'compiled-expression-recompile + "cycle in linklet imports") + (void)) + (let ((b_1 + (recompiled-bundle + r_0))) + (let ((linklet_0 + (let ((or-part_0 + (hash-ref + (linklet-bundle->hash + b_1) + phase_0 + #f))) + (if or-part_0 + or-part_0 + (raise-arguments-error + 'compiled-expression-recompile + "cannot find submodule at phase" + "submodule" + mod-name_0 + "phase" + phase_0))))) + (let ((app_0 + (hash-ref + (recompiled-phase-to-link-module-uses + r_0) + phase_0 + #f))) + (let ((app_1 + (recompiled-self + r_0))) + (module-linklet-info2.1 + linklet_0 + app_0 + app_1 + #f + (current-code-inspector) + #f))))))) + #f))))))))) + (let ((body-linklets+module-use*s_0 (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (h_1 i_0) + (lambda (table_0 i_0) (begin (if i_0 (call-with-values (lambda () (hash-iterate-key+value - body-linklets+module-use*s_0 + h_0 i_0)) (case-lambda - ((phase_0 l+mu*s_0) - (let ((h_2 - (let ((h_2 - (hash-set - h_1 - phase_0 - (car - l+mu*s_0)))) - (values h_2)))) - (for-loop_0 - h_2 - (hash-iterate-next - body-linklets+module-use*s_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - h_1)))))) - (for-loop_0 - h_0 - (hash-iterate-first - body-linklets+module-use*s_0)))))) - (let ((phase-to-link-module-uses_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - body-linklets+module-use*s_0 - i_0)) - (case-lambda - ((phase_0 l+mu*s_0) - (let ((table_1 + ((phase_0 body-linklet_0) + (let ((table_1 + (if (exact-integer? + phase_0) (let ((table_1 (call-with-values (lambda () - (values - phase_0 - (module-uses-strip-extra-inspectorsss - (cdr - l+mu*s_0)))) + (let ((module-use*s_0 + (module-uses-add-extra-inspectorsss + (hash-ref + phase-to-link-modules_0 + phase_0) + #f))) + (call-with-values + (lambda () + (let ((temp3_0 + (if (correlated-linklet? + body-linklet_0) + (correlated-linklet-expr + body-linklet_0) + body-linklet_0))) + (let ((temp4_0 + (if (correlated-linklet? + body-linklet_0) + compile-linklet + recompile-linklet))) + (let ((temp5_0 + (list + (list + get-syntax-literal!-id) + (list + set-transformer!-id)))) + (let ((temp6_0 + (list + empty-syntax-literals-instance + empty-module-body-instance))) + (let ((temp5_1 + temp5_0) + (temp4_1 + temp4_0) + (temp3_1 + temp3_0)) + (compile-module-linklet.1 + temp6_0 + temp5_1 + temp4_1 + find-submodule_0 + #t + #t + module-use*s_0 + ns_0 + #t + #t + unsafe?_0 + temp3_1))))))) + (case-lambda + ((linklet_0 + new-module-use*s_0) + (values + phase_0 + (cons + linklet_0 + new-module-use*s_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))) (case-lambda ((key_0 val_0) @@ -48272,9 +47735,47 @@ 2 args)))))) (values - table_1)))) + table_1)) + table_0))) + (for-loop_0 + table_1 + (hash-iterate-next + h_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2725 + (hash-iterate-first h_0)))))) + (let ((h/new-body-linklets_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (h_1 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + body-linklets+module-use*s_0 + i_0)) + (case-lambda + ((phase_0 l+mu*s_0) + (let ((h_2 + (let ((h_2 + (hash-set + h_1 + phase_0 + (car + l+mu*s_0)))) + (values h_2)))) (for-loop_0 - table_1 + h_2 (hash-iterate-next body-linklets+module-use*s_0 i_0)))) @@ -48282,149 +47783,133 @@ (raise-binding-result-arity-error 2 args)))) - table_0)))))) + h_1)))))) (for-loop_0 - hash2610 + h_0 (hash-iterate-first body-linklets+module-use*s_0)))))) - (let ((phase-to-link-module-uses-expr_0 - (serialize-phase-to-link-module-uses - phase-to-link-module-uses_0 - mpis_0))) - (let ((data-linklet_0 - (compile-linklet - (generate-module-data-linklet - mpis_0) - 'data))) - (let ((declaration-linklet_0 + (let ((phase-to-link-module-uses_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + body-linklets+module-use*s_0 + i_0)) + (case-lambda + ((phase_0 l+mu*s_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + phase_0 + (module-uses-strip-extra-inspectorsss + (cdr + l+mu*s_0)))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + body-linklets+module-use*s_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2610 + (hash-iterate-first + body-linklets+module-use*s_0)))))) + (let ((phase-to-link-module-uses-expr_0 + (serialize-phase-to-link-module-uses + phase-to-link-module-uses_0 + mpis_0))) + (let ((data-linklet_0 (compile-linklet - (let ((app_0 - (begin-unsafe - (begin - (instance-variable-value - declaration-instance_0 - 'requires))))) - (generate-module-declaration-linklet - mpis_0 - self_0 - app_0 - (begin-unsafe - (begin - (instance-variable-value - declaration-instance_0 - 'provides))) - phase-to-link-module-uses-expr_0)) - 'decl))) - (let ((new-bundle_0 - (hash->linklet-bundle - (let ((h_1 - (hash-set - h/new-body-linklets_0 - 'data - data-linklet_0))) - (let ((h_2 + (generate-module-data-linklet + mpis_0) + 'data))) + (let ((declaration-linklet_0 + (compile-linklet + (let ((app_0 + (begin-unsafe + (begin + (instance-variable-value + declaration-instance_0 + 'requires))))) + (generate-module-declaration-linklet + mpis_0 + self_0 + app_0 + (begin-unsafe + (begin + (instance-variable-value + declaration-instance_0 + 'provides))) + phase-to-link-module-uses-expr_0)) + 'decl))) + (let ((new-bundle_0 + (hash->linklet-bundle + (let ((h_1 (hash-set - h_1 - 'decl - declaration-linklet_0))) - h_2))))) - (recompiled1.1 - new-bundle_0 - phase-to-link-module-uses_0 - self_0)))))))))))))))))))))) + h/new-body-linklets_0 + 'data + data-linklet_0))) + (let ((h_2 + (hash-set + h_1 + 'decl + declaration-linklet_0))) + h_2))))) + (recompiled1.1 + new-bundle_0 + phase-to-link-module-uses_0 + self_0))))))))))))))))))))))) (define create-compiled-in-memorys-using-shared-data - (letrec ((data_0 - (|#%name| - data - (lambda (data-instance_0 key_0) - (begin (instance-variable-value data-instance_0 key_0))))) - (map-construct-compiled-in-memory_0 - (|#%name| - map-construct-compiled-in-memory - (lambda (construct-compiled-in-memory_0 - mpi-vector-tree_0 - phase-to-link-modules-tree_0 - syntax-literals-tree_0 - l_0 - vec-pos_0) - (begin - (reverse$1 - (let ((lst_0 (vector-ref mpi-vector-tree_0 vec-pos_0))) - (let ((lst_1 - (vector-ref - phase-to-link-modules-tree_0 - vec-pos_0))) - (let ((lst_2 - (vector-ref syntax-literals-tree_0 vec-pos_0))) - (let ((lst_3 lst_1) (lst_4 lst_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_5 lst_6 lst_7 lst_8) - (begin - (if (if (pair? lst_5) - (if (pair? lst_6) - (if (pair? lst_7) (pair? lst_8) #f) - #f) - #f) - (let ((sub-ld_0 (unsafe-car lst_5))) - (let ((rest_0 (unsafe-cdr lst_5))) - (let ((mpi-vector-tree_1 - (unsafe-car lst_6))) - (let ((rest_1 (unsafe-cdr lst_6))) - (let ((phase-to-link-modules-tree_1 - (unsafe-car lst_7))) - (let ((rest_2 - (unsafe-cdr lst_7))) - (let ((syntax-literals-tree_1 - (unsafe-car lst_8))) - (let ((rest_3 - (unsafe-cdr lst_8))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (construct-compiled-in-memory_0 - sub-ld_0 - mpi-vector-tree_1 - phase-to-link-modules-tree_1 - syntax-literals-tree_1) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1 - rest_2 - rest_3)))))))))) - fold-var_0)))))) - (for-loop_0 - null - l_0 - lst_4 - lst_3 - lst_2))))))))))))) - (lambda (tops_0 data-linklet_0 ns_0) - (let ((data-instance_0 - (instantiate-linklet - data-linklet_0 - (list - deserialize-instance - (let ((temp2_0 (namespace-phase ns_0))) - (let ((temp3_0 (namespace-mpi ns_0))) - (let ((temp4_0 (namespace-bulk-binding-registry ns_0))) - (let ((temp5_0 (current-code-inspector))) - (let ((temp4_1 temp4_0) - (temp3_1 temp3_0) - (temp2_1 temp2_0)) - (make-eager-instance-instance.1 - temp4_1 - temp2_1 - temp5_0 - ns_0 - temp3_1)))))))))) + (lambda (tops_0 data-linklet_0 ns_0) + (let ((data-instance_0 + (instantiate-linklet + data-linklet_0 + (list + deserialize-instance + (let ((temp2_0 (namespace-phase ns_0))) + (let ((temp3_0 (namespace-mpi ns_0))) + (let ((temp4_0 (namespace-bulk-binding-registry ns_0))) + (let ((temp5_0 (current-code-inspector))) + (let ((temp4_1 temp4_0) + (temp3_1 temp3_0) + (temp2_1 temp2_0)) + (make-eager-instance-instance.1 + temp4_1 + temp2_1 + temp5_0 + ns_0 + temp3_1)))))))))) + (let ((data_0 + (|#%name| + data + (lambda (key_0) + (begin (instance-variable-value data-instance_0 key_0)))))) (let ((mpi-vector_0 (begin-unsafe (begin @@ -48502,100 +47987,108 @@ ld_0 'post) null))) - (let ((app_0 - (vector-ref - phase-to-link-modules-vector_0 - (vector-ref - phase-to-link-modules-tree_0 - 0)))) - (let ((app_1 - (let ((len_0 - (vector-length - mpi-pos-vec_0))) - (begin - (if (exact-nonnegative-integer? - len_0) - (void) - (raise-argument-error - 'for/vector - "exact-nonnegative-integer?" - len_0)) - (let ((v_0 - (make-vector - len_0 - 0))) - (begin - (if (zero? len_0) - (void) - (call-with-values - (lambda () - (begin - (check-vector - mpi-pos-vec_0) - (values - mpi-pos-vec_0 - (unsafe-vector-length - mpi-pos-vec_0)))) - (case-lambda - ((vec_0 len_1) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0 - pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_1) - (let ((pos_1 - (unsafe-vector-ref - vec_0 - pos_0))) - (let ((i_1 - (let ((i_1 - (begin - (unsafe-vector*-set! - v_0 - i_0 - (vector-ref - mpi-vector_0 - pos_1)) - (unsafe-fx+ - 1 - i_0)))) - (values - i_1)))) - (if (if (not - (let ((x_0 - (list - pos_1))) - (unsafe-fx= - i_1 - len_0))) - #t - #f) - (for-loop_0 - i_1 - (unsafe-fx+ - 1 - pos_0)) - i_1))) - i_0)))))) - (for-loop_0 - 0 - 0)))) - (args - (raise-binding-result-arity-error - 2 - args))))) - v_0)))))) - (let ((app_2 + (let ((map-construct-compiled-in-memory_0 + (|#%name| + map-construct-compiled-in-memory + (lambda (l_0 vec-pos_0) + (begin + (reverse$1 + (let ((lst_0 + (vector-ref + mpi-vector-tree_0 + vec-pos_0))) + (let ((lst_1 + (vector-ref + phase-to-link-modules-tree_0 + vec-pos_0))) + (let ((lst_2 + (vector-ref + syntax-literals-tree_0 + vec-pos_0))) + (let ((lst_3 + lst_1) + (lst_4 + lst_0)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_5 + lst_6 + lst_7 + lst_8) + (begin + (if (if (pair? + lst_5) + (if (pair? + lst_6) + (if (pair? + lst_7) + (pair? + lst_8) + #f) + #f) + #f) + (let ((sub-ld_0 + (unsafe-car + lst_5))) + (let ((rest_0 + (unsafe-cdr + lst_5))) + (let ((mpi-vector-tree_1 + (unsafe-car + lst_6))) + (let ((rest_1 + (unsafe-cdr + lst_6))) + (let ((phase-to-link-modules-tree_1 + (unsafe-car + lst_7))) + (let ((rest_2 + (unsafe-cdr + lst_7))) + (let ((syntax-literals-tree_1 + (unsafe-car + lst_8))) + (let ((rest_3 + (unsafe-cdr + lst_8))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (construct-compiled-in-memory_0 + sub-ld_0 + mpi-vector-tree_1 + phase-to-link-modules-tree_1 + syntax-literals-tree_1) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1 + rest_2 + rest_3)))))))))) + fold-var_0)))))) + (for-loop_0 + null + l_0 + lst_4 + lst_3 + lst_2))))))))))))) + (let ((app_0 + (vector-ref + phase-to-link-modules-vector_0 + (vector-ref + phase-to-link-modules-tree_0 + 0)))) + (let ((app_1 (let ((len_0 - (cdr - syntax-literals-spec_0))) + (vector-length + mpi-pos-vec_0))) (begin (if (exact-nonnegative-integer? len_0) @@ -48611,88 +48104,165 @@ (begin (if (zero? len_0) (void) - (let ((end_0 - (cdr - syntax-literals-spec_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0 - pos_0) - (begin - (if (< - pos_0 - end_0) - (let ((i_1 - (let ((i_1 - (begin - (unsafe-vector*-set! - v_0 - i_0 - (if syntax-literals_0 - (vector-ref - syntax-literals_0 - (+ - (car - syntax-literals-spec_0) - pos_0)) - #f)) - (unsafe-fx+ - 1 - i_0)))) - (values - i_1)))) - (if (if (not - (let ((x_0 - (list - pos_0))) - (unsafe-fx= - i_1 - len_0))) - #t - #f) - (for-loop_0 - i_1 - (+ - pos_0 - 1)) - i_1)) - i_0)))))) - (for-loop_0 - 0 - 0))))) + (call-with-values + (lambda () + (begin + (check-vector + mpi-pos-vec_0) + (values + mpi-pos-vec_0 + (unsafe-vector-length + mpi-pos-vec_0)))) + (case-lambda + ((vec_0 len_1) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0 + pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_1) + (let ((pos_1 + (unsafe-vector-ref + vec_0 + pos_0))) + (let ((i_1 + (let ((i_1 + (begin + (unsafe-vector*-set! + v_0 + i_0 + (vector-ref + mpi-vector_0 + pos_1)) + (unsafe-fx+ + 1 + i_0)))) + (values + i_1)))) + (if (if (not + (let ((x_0 + (list + pos_1))) + (unsafe-fx= + i_1 + len_0))) + #t + #f) + (for-loop_0 + i_1 + (unsafe-fx+ + 1 + pos_0)) + i_1))) + i_0)))))) + (for-loop_0 + 0 + 0)))) + (args + (raise-binding-result-arity-error + 2 + args))))) v_0)))))) - (let ((app_3 - (map-construct-compiled-in-memory_0 - construct-compiled-in-memory_0 - mpi-vector-tree_0 - phase-to-link-modules-tree_0 - syntax-literals-tree_0 - pres_0 - 1))) - (compiled-in-memory1.1 - ld_0 - #f - #f - #f - app_0 - #f - hash2589 - app_1 - app_2 - app_3 - (map-construct-compiled-in-memory_0 - construct-compiled-in-memory_0 - mpi-vector-tree_0 - phase-to-link-modules-tree_0 - syntax-literals-tree_0 - posts_0 - 2) - namespace-scopes_0 - #f)))))))))))))))) - (map_2960 + (let ((app_2 + (let ((len_0 + (cdr + syntax-literals-spec_0))) + (begin + (if (exact-nonnegative-integer? + len_0) + (void) + (raise-argument-error + 'for/vector + "exact-nonnegative-integer?" + len_0)) + (let ((v_0 + (make-vector + len_0 + 0))) + (begin + (if (zero? + len_0) + (void) + (let ((end_0 + (cdr + syntax-literals-spec_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0 + pos_0) + (begin + (if (< + pos_0 + end_0) + (let ((i_1 + (let ((i_1 + (begin + (unsafe-vector*-set! + v_0 + i_0 + (if syntax-literals_0 + (vector-ref + syntax-literals_0 + (+ + (car + syntax-literals-spec_0) + pos_0)) + #f)) + (unsafe-fx+ + 1 + i_0)))) + (values + i_1)))) + (if (if (not + (let ((x_0 + (list + pos_0))) + (unsafe-fx= + i_1 + len_0))) + #t + #f) + (for-loop_0 + i_1 + (+ + pos_0 + 1)) + i_1)) + i_0)))))) + (for-loop_0 + 0 + 0))))) + v_0)))))) + (let ((app_3 + (map-construct-compiled-in-memory_0 + pres_0 + 1))) + (compiled-in-memory1.1 + ld_0 + #f + #f + #f + app_0 + #f + hash2589 + app_1 + app_2 + app_3 + (map-construct-compiled-in-memory_0 + posts_0 + 2) + namespace-scopes_0 + #f))))))))))))))))) + (map_1346 construct-compiled-in-memory_0 tops_0 mpi-vector-trees_0 @@ -48763,42 +48333,32 @@ (eval-top_0 c_0 ns_0 eval-compiled_0 as-tail?2_0)) ((c_0 ns_0 eval-compiled1_0) (eval-top_0 c_0 ns_0 eval-compiled1_0 #t))))) (define eval-multiple-tops - (letrec ((eval-compiled-parts_0 - (|#%name| - eval-compiled-parts - (lambda (as-tail?_0 eval-compiled_0 ns_0 l_0) - (begin - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (l_1) - (begin - (if (null? l_1) - void - (if (null? (cdr l_1)) - (|#%app| - eval-compiled_0 - (car l_1) - ns_0 - as-tail?_0) - (begin - (|#%app| eval-compiled_0 (car l_1) ns_0 #f) - (loop_0 (cdr l_1)))))))))) - (loop_0 l_0))))))) - (lambda (c_0 ns_0 eval-compiled_0 as-tail?_0) + (lambda (c_0 ns_0 eval-compiled_0 as-tail?_0) + (let ((eval-compiled-parts_0 + (|#%name| + eval-compiled-parts + (lambda (l_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1) + (begin + (if (null? l_1) + void + (if (null? (cdr l_1)) + (|#%app| eval-compiled_0 (car l_1) ns_0 as-tail?_0) + (begin + (|#%app| eval-compiled_0 (car l_1) ns_0 #f) + (loop_0 (cdr l_1)))))))))) + (loop_0 l_0))))))) (if (compiled-in-memory? c_0) (eval-compiled-parts_0 - as-tail?_0 - eval-compiled_0 - ns_0 (compiled-in-memory-pre-compiled-in-memorys c_0)) (let ((c1_0 (hash-ref (linklet-directory->hash$1 c_0) 'data #f))) (if c1_0 (eval-compiled-parts_0 - as-tail?_0 - eval-compiled_0 - ns_0 (let ((app_0 (compiled-top->compiled-tops c_0))) (create-compiled-in-memorys-using-shared-data app_0 @@ -48807,11 +48367,7 @@ (hash-ref (linklet-directory->hash$1 c1_0) #f)) 0) ns_0))) - (eval-compiled-parts_0 - as-tail?_0 - eval-compiled_0 - ns_0 - (compiled-top->compiled-tops c_0)))))))) + (eval-compiled-parts_0 (compiled-top->compiled-tops c_0)))))))) (define eval-one-top.1 (|#%name| eval-one-top @@ -50040,46 +49596,48 @@ (define context->symbol (lambda (context_0) (if (symbol? context_0) context_0 'definition-context))) (define avoid-current-expand-context - (letrec ((fail_0 - (|#%name| - fail - (lambda (ctx_0 s_0) - (begin - (raise-syntax-error$1 - #f - (format - "not allowed in context\n expansion context: ~a" - (context->symbol - (begin-unsafe (expand-context/outer-context ctx_0)))) - s_0))))) - (wrap_0 - (|#%name| - wrap - (lambda (ctx_0 s_0 sym_0) - (begin - (datum->syntax$1 - #f - (list - (let ((app_0 (datum->syntax$1 core-stx sym_0))) - (syntax-shift-phase-level$1 - app_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx_0))))) - s_0))))))) - (lambda (s_0 t_0 ctx_0) - (let ((tmp_0 - (context->symbol - (begin-unsafe (expand-context/outer-context ctx_0))))) - (if (eq? tmp_0 'module-begin) - (wrap_0 ctx_0 s_0 'begin) - (if (if (eq? tmp_0 'module) - #t - (if (eq? tmp_0 'top-level) #t (eq? tmp_0 'definition-context))) - (if (memq 'expression (expansion-contexts-ref t_0)) - (wrap_0 ctx_0 s_0 '|#%expression|) - (fail_0 ctx_0 s_0)) - (fail_0 ctx_0 s_0))))))) + (lambda (s_0 t_0 ctx_0) + (let ((wrap_0 + (|#%name| + wrap + (lambda (sym_0) + (begin + (datum->syntax$1 + #f + (list + (let ((app_0 (datum->syntax$1 core-stx sym_0))) + (syntax-shift-phase-level$1 + app_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))))) + s_0))))))) + (let ((fail_0 + (|#%name| + fail + (lambda () + (begin + (raise-syntax-error$1 + #f + (format + "not allowed in context\n expansion context: ~a" + (context->symbol + (begin-unsafe (expand-context/outer-context ctx_0)))) + s_0)))))) + (let ((tmp_0 + (context->symbol + (begin-unsafe (expand-context/outer-context ctx_0))))) + (if (eq? tmp_0 'module-begin) + (wrap_0 'begin) + (if (if (eq? tmp_0 'module) + #t + (if (eq? tmp_0 'top-level) + #t + (eq? tmp_0 'definition-context))) + (if (memq 'expression (expansion-contexts-ref t_0)) + (wrap_0 '|#%expression|) + (fail_0)) + (fail_0)))))))) (define struct:reference-record (make-record-type-descriptor* 'reference-record #f #f #f #f 3 7)) (define effect_2434 @@ -50138,25 +49696,30 @@ (let ((s_0 (reference-record-reference-before-bound rr_0))) (begin-unsafe (hash-set s_0 key_0 #t))))))) (define reference-records-all-used! - (letrec ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((rr_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (if (reference-record-all-referenced? rr_0) - (values) - (begin - (set-reference-record-all-referenced?! rr_0 #t) - (next-k-proc_0 rest_0))))) - (values)))))) - (next-k-proc_0 - (|#%name| - next-k-proc - (lambda (rest_0) (begin (for-loop_0 rest_0)))))) - (lambda (rrs_0) (begin (begin (for-loop_0 rrs_0)) (void))))) + (lambda (rrs_0) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((rr_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((next-k-proc_0 + (|#%name| + next-k-proc + (lambda () (begin (for-loop_0 rest_0)))))) + (if (reference-record-all-referenced? rr_0) + (values) + (begin + (set-reference-record-all-referenced?! rr_0 #t) + (next-k-proc_0)))))) + (values))))))) + (for-loop_0 rrs_0))) + (void)))) (define reference-record-bound! (lambda (rr_0 keys_0) (begin @@ -51609,361 +51172,339 @@ (reference-record-used! app_0 (local-binding-key binding_0))) (void)))) (define expand/capture-lifts.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (begin-form?52_0 - context_0 - expand-lifts?51_0 - lift-key_0 - local?_0 - phase_0 - s_0 - always-wrap?_0 - ctx_0) - (begin - (let ((lift-env_0 (if local?_0 (box empty-env) #f))) - (let ((lift-ctx_0 - (let ((temp193_0 - (if local?_0 - (let ((app_0 - (begin-unsafe - (root-expand-context/inner-counter - (root-expand-context/outer-inner - ctx_0))))) - (make-local-lift - lift-env_0 - app_0 - (if (begin-unsafe - (expand-context/inner-normalize-locals? - (root-expand-context/outer-inner - ctx_0))) - 'lift - #f))) - (make-top-level-lift ctx_0)))) - (let ((temp194_0 - (if (not local?_0) - (eq? context_0 'module) - #f))) - (let ((temp193_1 temp193_0)) - (make-lift-context.1 temp194_0 temp193_1)))))) - (let ((capture-ctx_0 - (if (expand-context/outer? ctx_0) - (let ((inner195_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_0))) - (if (expand-context/inner? the-struct_0) - (let ((lift-envs198_0 - (if local?_0 - (cons - lift-env_0 - (begin-unsafe - (expand-context/inner-lift-envs - (root-expand-context/outer-inner - ctx_0)))) - (begin-unsafe - (expand-context/inner-lift-envs - (root-expand-context/outer-inner - ctx_0)))))) - (let ((module-lifts199_0 - (if (if local?_0 - local?_0 - (not - (memq - context_0 - '(top-level - module)))) - (begin-unsafe - (expand-context/inner-module-lifts - (root-expand-context/outer-inner - ctx_0))) - lift-ctx_0))) - (let ((lift-envs198_1 - lift-envs198_0)) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx + (|#%name| + expand/capture-lifts + (lambda (always-wrap?54_0 + begin-form?52_0 + expand-lifts?51_0 + lift-key53_0 + s59_0 + ctx60_0) + (begin + (let ((lift-key_0 + (if (eq? lift-key53_0 unsafe-undefined) + (generate-lift-key) + lift-key53_0))) + (let ((context_0 + (begin-unsafe (expand-context/outer-context ctx60_0)))) + (let ((phase_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx60_0))))) + (let ((local?_0 (not begin-form?52_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (s_0 always-wrap?_0 ctx_0) + (begin + (let ((lift-env_0 (if local?_0 (box empty-env) #f))) + (let ((lift-ctx_0 + (let ((temp193_0 + (if local?_0 + (let ((app_0 + (begin-unsafe + (root-expand-context/inner-counter + (root-expand-context/outer-inner + ctx_0))))) + (make-local-lift + lift-env_0 + app_0 + (if (begin-unsafe + (expand-context/inner-normalize-locals? + (root-expand-context/outer-inner + ctx_0))) + 'lift + #f))) + (make-top-level-lift ctx_0)))) + (let ((temp194_0 + (if (not local?_0) + (eq? context_0 'module) + #f))) + (let ((temp193_1 temp193_0)) + (make-lift-context.1 + temp194_0 + temp193_1)))))) + (let ((capture-ctx_0 + (if (expand-context/outer? ctx_0) + (let ((inner195_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx_0))) + (if (expand-context/inner? + the-struct_0) + (let ((lift-envs198_0 + (if local?_0 + (cons + lift-env_0 + (begin-unsafe + (expand-context/inner-lift-envs + (root-expand-context/outer-inner + ctx_0)))) + (begin-unsafe + (expand-context/inner-lift-envs + (root-expand-context/outer-inner + ctx_0)))))) + (let ((module-lifts199_0 + (if (if local?_0 + local?_0 + (not + (memq + context_0 + '(top-level + module)))) + (begin-unsafe + (expand-context/inner-module-lifts + (root-expand-context/outer-inner + ctx_0))) + lift-ctx_0))) + (let ((lift-envs198_1 + lift-envs198_0)) + (let ((app_0 + (root-expand-context/inner-self-mpi the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms + (let ((app_1 + (root-expand-context/inner-module-scopes the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter + (let ((app_2 + (root-expand-context/inner-top-level-bind-scope the-struct_0))) - (let ((app_6 - (expand-context/inner-to-parsed? + (let ((app_3 + (root-expand-context/inner-all-scopes-stx the-struct_0))) - (let ((app_7 - (expand-context/inner-phase + (let ((app_4 + (root-expand-context/inner-defined-syms the-struct_0))) - (let ((app_8 - (expand-context/inner-namespace + (let ((app_5 + (root-expand-context/inner-counter the-struct_0))) - (let ((app_9 - (expand-context/inner-just-once? + (let ((app_6 + (expand-context/inner-to-parsed? the-struct_0))) - (let ((app_10 - (expand-context/inner-module-begin-k + (let ((app_7 + (expand-context/inner-phase the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? + (let ((app_8 + (expand-context/inner-namespace the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? + (let ((app_9 + (expand-context/inner-just-once? the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| + (let ((app_10 + (expand-context/inner-module-begin-k the-struct_0))) - (let ((app_14 - (expand-context/inner-stops + (let ((app_11 + (expand-context/inner-allow-unbound? the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names + (let ((app_12 + (expand-context/inner-in-local-expand? the-struct_0))) - (let ((app_16 - (expand-context/inner-require-lifts + (let ((app_13 + (|expand-context/inner-keep-#%expression?| the-struct_0))) - (let ((app_17 - (expand-context/inner-to-module-lifts + (let ((app_14 + (expand-context/inner-stops the-struct_0))) - (let ((app_18 - (expand-context/inner-requires+provides + (let ((app_15 + (expand-context/inner-declared-submodule-names the-struct_0))) - (let ((app_19 - (expand-context/inner-observer + (let ((app_16 + (expand-context/inner-require-lifts the-struct_0))) - (let ((app_20 - (expand-context/inner-for-serializable? + (let ((app_17 + (expand-context/inner-to-module-lifts the-struct_0))) - (let ((app_21 - (expand-context/inner-to-correlated-linklet? + (let ((app_18 + (expand-context/inner-requires+provides the-struct_0))) - (let ((app_22 - (expand-context/inner-normalize-locals? + (let ((app_19 + (expand-context/inner-observer the-struct_0))) - (let ((app_23 - (expand-context/inner-parsing-expanded? + (let ((app_20 + (expand-context/inner-for-serializable? the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - lift-key_0 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - lift-ctx_0 - lift-envs198_1 - module-lifts199_0 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_0))) - (let ((app_3 - (expand-context/outer-context + (let ((app_21 + (expand-context/inner-to-correlated-linklet? + the-struct_0))) + (let ((app_22 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_23 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + lift-key_0 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + app_12 + app_13 + app_14 + app_15 + lift-ctx_0 + lift-envs198_1 + module-lifts199_0 + app_16 + app_17 + app_18 + app_19 + app_20 + app_21 + app_22 + app_23 + (expand-context/inner-skip-visit-available? + the-struct_0))))))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((app_0 + (root-expand-context/outer-post-expansion ctx_0))) - (let ((app_4 - (expand-context/outer-env + (let ((app_1 + (root-expand-context/outer-use-site-scopes ctx_0))) - (let ((app_5 - (expand-context/outer-scopes + (let ((app_2 + (root-expand-context/outer-frame-id ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes + (let ((app_3 + (expand-context/outer-context ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer + (let ((app_4 + (expand-context/outer-env ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records + (let ((app_5 + (expand-context/outer-scopes ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? + (let ((app_6 + (expand-context/outer-def-ctx-scopes ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined + (let ((app_7 + (expand-context/outer-binding-layer ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes + (let ((app_8 + (expand-context/outer-reference-records ctx_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes + (let ((app_9 + (expand-context/outer-only-immediate? ctx_0))) - (expand-context/outer1.1 - inner195_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - ctx_0)))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx_0)))) - (let ((rebuild-s_0 (keep-properties-only s_0))) - (let ((exp-s_0 (expand.1 #f #f s_0 capture-ctx_0))) - (let ((lifts_0 - (let ((lifts_0 - (begin-unsafe - (expand-context/inner-lifts - (root-expand-context/outer-inner - capture-ctx_0))))) - (begin-unsafe - (box-clear! - (lift-context-lifts lifts_0)))))) - (let ((with-lifts-s_0 - (if (let ((or-part_0 (pair? lifts_0))) - (if or-part_0 - or-part_0 - always-wrap?_0)) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx_0))) - (begin - (if expand-lifts?51_0 - (void) - (error - "internal error: to-parsed mode without expanding lifts")) - (wrap-lifts-as-parsed-let - lifts_0 - exp-s_0 - rebuild-s_0 - ctx_0 - (lambda (rhs_0 rhs-ctx_0) - (loop_0 - begin-form?52_0 - context_0 - expand-lifts?51_0 - lift-key_0 - local?_0 - phase_0 - rhs_0 - #f - rhs-ctx_0)))) - (if begin-form?52_0 - (wrap-lifts-as-begin.1 - unsafe-undefined - unsafe-undefined - lifts_0 - exp-s_0 - phase_0) - (wrap-lifts-as-let - lifts_0 - exp-s_0 - phase_0))) - exp-s_0))) - (if (let ((or-part_0 (not expand-lifts?51_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (null? lifts_0))) - (if or-part_1 - or-part_1 - (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx_0))))))) - with-lifts-s_0 - (begin - (let ((obs_0 + (let ((app_10 + (expand-context/outer-need-eventually-defined + ctx_0))) + (let ((app_11 + (expand-context/outer-current-introduction-scopes + ctx_0))) + (let ((app_12 + (expand-context/outer-current-use-scopes + ctx_0))) + (expand-context/outer1.1 + inner195_0 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + app_12 + (expand-context/outer-name + ctx_0)))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx_0)))) + (let ((rebuild-s_0 (keep-properties-only s_0))) + (let ((exp-s_0 + (expand.1 #f #f s_0 capture-ctx_0))) + (let ((lifts_0 + (let ((lifts_0 + (begin-unsafe + (expand-context/inner-lifts + (root-expand-context/outer-inner + capture-ctx_0))))) (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'letlift-loop - with-lifts-s_0) - (void))) - (loop_0 - begin-form?52_0 - context_0 - expand-lifts?51_0 - lift-key_0 - local?_0 - phase_0 - with-lifts-s_0 - #f - ctx_0))))))))))))))) - (|#%name| - expand/capture-lifts - (lambda (always-wrap?54_0 - begin-form?52_0 - expand-lifts?51_0 - lift-key53_0 - s59_0 - ctx60_0) - (begin - (let ((lift-key_0 - (if (eq? lift-key53_0 unsafe-undefined) - (generate-lift-key) - lift-key53_0))) - (let ((context_0 - (begin-unsafe (expand-context/outer-context ctx60_0)))) - (let ((phase_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx60_0))))) - (let ((local?_0 (not begin-form?52_0))) - (loop_0 - begin-form?52_0 - context_0 - expand-lifts?51_0 - lift-key_0 - local?_0 - phase_0 - s59_0 - always-wrap?54_0 - ctx60_0)))))))))) + (box-clear! + (lift-context-lifts lifts_0)))))) + (let ((with-lifts-s_0 + (if (let ((or-part_0 + (pair? lifts_0))) + (if or-part_0 + or-part_0 + always-wrap?_0)) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx_0))) + (begin + (if expand-lifts?51_0 + (void) + (error + "internal error: to-parsed mode without expanding lifts")) + (wrap-lifts-as-parsed-let + lifts_0 + exp-s_0 + rebuild-s_0 + ctx_0 + (lambda (rhs_0 rhs-ctx_0) + (loop_0 + rhs_0 + #f + rhs-ctx_0)))) + (if begin-form?52_0 + (wrap-lifts-as-begin.1 + unsafe-undefined + unsafe-undefined + lifts_0 + exp-s_0 + phase_0) + (wrap-lifts-as-let + lifts_0 + exp-s_0 + phase_0))) + exp-s_0))) + (if (let ((or-part_0 + (not expand-lifts?51_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (null? lifts_0))) + (if or-part_1 + or-part_1 + (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx_0))))))) + with-lifts-s_0 + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'letlift-loop + with-lifts-s_0) + (void))) + (loop_0 + with-lifts-s_0 + #f + ctx_0))))))))))))))) + (loop_0 s59_0 always-wrap?54_0 ctx60_0)))))))))) (define expand-transformer.1 (|#%name| expand-transformer @@ -52358,166 +51899,153 @@ (let ((or-part_0 (syntax-property$1 s_0 'disappeared-binding))) (if or-part_0 or-part_0 null)))))))) (define increment-binding-layer - (letrec ((loop_0 - (|#%name| - loop - (lambda (ids_0) - (begin - (let ((or-part_0 (identifier? ids_0))) - (if or-part_0 - or-part_0 - (if (pair? ids_0) - (let ((or-part_1 (loop_0 (car ids_0)))) - (if or-part_1 or-part_1 (loop_0 (cdr ids_0)))) - #f)))))))) - (lambda (ids_0 ctx_0 layer-val_0) - (if (loop_0 ids_0) - layer-val_0 - (begin-unsafe (expand-context/outer-binding-layer ctx_0)))))) + (lambda (ids_0 ctx_0 layer-val_0) + (if (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ids_1) + (begin + (let ((or-part_0 (identifier? ids_1))) + (if or-part_0 + or-part_0 + (if (pair? ids_1) + (let ((or-part_1 (loop_0 (car ids_1)))) + (if or-part_1 or-part_1 (loop_0 (cdr ids_1)))) + #f)))))))) + (loop_0 ids_0)) + layer-val_0 + (begin-unsafe (expand-context/outer-binding-layer ctx_0))))) (define wrap-lifts-as-parsed-let - (letrec ((lets-loop_0 - (|#%name| - lets-loop - (lambda (exp-s_0 - parse-rhs_0 - rebuild-s_0 - idss+keyss+rhss_0 - rhs-ctx_0) - (begin - (if (null? idss+keyss+rhss_0) - exp-s_0 - (let ((ids_0 (caar idss+keyss+rhss_0))) - (let ((keys_0 (cadar idss+keyss+rhss_0))) - (let ((rhs_0 (caddar idss+keyss+rhss_0))) - (let ((exp-rhs_0 - (|#%app| parse-rhs_0 rhs_0 rhs-ctx_0))) - (parsed-let-values17.1 - rebuild-s_0 - (list ids_0) - (list (list keys_0 exp-rhs_0)) - (list - (let ((app_0 (cdr idss+keyss+rhss_0))) - (lets-loop_0 - exp-s_0 - parse-rhs_0 - rebuild-s_0 - app_0 - (if (expand-context/outer? rhs-ctx_0) - (let ((env235_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (env_0 lst_0 lst_1) - (begin - (if (if (pair? lst_0) - (pair? lst_1) - #f) - (let ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((key_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((val_0 - (local-variable1.1 - id_0))) - (let ((env_1 - (let ((env_1 - (begin-unsafe - (hash-set - env_0 - key_0 - val_0)))) - (values - env_1)))) - (for-loop_0 - env_1 - rest_0 - rest_1))))))) - env_0)))))) - (for-loop_0 - (begin-unsafe - (expand-context/outer-env - rhs-ctx_0)) - ids_0 - keys_0))))) - (let ((inner236_0 - (root-expand-context/outer-inner - rhs-ctx_0))) - (let ((env235_1 env235_0)) - (let ((app_1 - (root-expand-context/outer-post-expansion - rhs-ctx_0))) - (let ((app_2 - (root-expand-context/outer-use-site-scopes - rhs-ctx_0))) - (let ((app_3 - (root-expand-context/outer-frame-id - rhs-ctx_0))) - (let ((app_4 - (expand-context/outer-context - rhs-ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - rhs-ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - rhs-ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer - rhs-ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - rhs-ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - rhs-ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - rhs-ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - rhs-ctx_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - rhs-ctx_0))) - (expand-context/outer1.1 - inner236_0 - app_1 - app_2 - app_3 - app_4 - env235_1 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - rhs-ctx_0))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - rhs-ctx_0)))))))))))))))) - (lambda (lifts_0 exp-s_0 rebuild-s_0 ctx_0 parse-rhs_0) - (let ((idss+keyss+rhss_0 (get-lifts-as-lists lifts_0))) - (lets-loop_0 - exp-s_0 - parse-rhs_0 - rebuild-s_0 - idss+keyss+rhss_0 - ctx_0))))) + (lambda (lifts_0 exp-s_0 rebuild-s_0 ctx_0 parse-rhs_0) + (let ((idss+keyss+rhss_0 (get-lifts-as-lists lifts_0))) + (letrec* + ((lets-loop_0 + (|#%name| + lets-loop + (lambda (idss+keyss+rhss_1 rhs-ctx_0) + (begin + (if (null? idss+keyss+rhss_1) + exp-s_0 + (let ((ids_0 (caar idss+keyss+rhss_1))) + (let ((keys_0 (cadar idss+keyss+rhss_1))) + (let ((rhs_0 (caddar idss+keyss+rhss_1))) + (let ((exp-rhs_0 (|#%app| parse-rhs_0 rhs_0 rhs-ctx_0))) + (parsed-let-values17.1 + rebuild-s_0 + (list ids_0) + (list (list keys_0 exp-rhs_0)) + (list + (let ((app_0 (cdr idss+keyss+rhss_1))) + (lets-loop_0 + app_0 + (if (expand-context/outer? rhs-ctx_0) + (let ((env235_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (env_0 lst_0 lst_1) + (begin + (if (if (pair? lst_0) + (pair? lst_1) + #f) + (let ((id_0 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) + (let ((key_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((val_0 + (local-variable1.1 + id_0))) + (let ((env_1 + (let ((env_1 + (begin-unsafe + (hash-set + env_0 + key_0 + val_0)))) + (values + env_1)))) + (for-loop_0 + env_1 + rest_0 + rest_1))))))) + env_0)))))) + (for-loop_0 + (begin-unsafe + (expand-context/outer-env + rhs-ctx_0)) + ids_0 + keys_0))))) + (let ((inner236_0 + (root-expand-context/outer-inner + rhs-ctx_0))) + (let ((env235_1 env235_0)) + (let ((app_1 + (root-expand-context/outer-post-expansion + rhs-ctx_0))) + (let ((app_2 + (root-expand-context/outer-use-site-scopes + rhs-ctx_0))) + (let ((app_3 + (root-expand-context/outer-frame-id + rhs-ctx_0))) + (let ((app_4 + (expand-context/outer-context + rhs-ctx_0))) + (let ((app_5 + (expand-context/outer-scopes + rhs-ctx_0))) + (let ((app_6 + (expand-context/outer-def-ctx-scopes + rhs-ctx_0))) + (let ((app_7 + (expand-context/outer-binding-layer + rhs-ctx_0))) + (let ((app_8 + (expand-context/outer-reference-records + rhs-ctx_0))) + (let ((app_9 + (expand-context/outer-only-immediate? + rhs-ctx_0))) + (let ((app_10 + (expand-context/outer-need-eventually-defined + rhs-ctx_0))) + (let ((app_11 + (expand-context/outer-current-introduction-scopes + rhs-ctx_0))) + (let ((app_12 + (expand-context/outer-current-use-scopes + rhs-ctx_0))) + (expand-context/outer1.1 + inner236_0 + app_1 + app_2 + app_3 + app_4 + env235_1 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + app_12 + (expand-context/outer-name + rhs-ctx_0))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + rhs-ctx_0)))))))))))))))) + (lets-loop_0 idss+keyss+rhss_0 ctx_0))))) (define rename-transformer-target-in-context (lambda (t_0 ctx_0) (with-continuation-mark* @@ -52770,7 +52298,7 @@ 'parent-ctx)))))) (define struct:env-mixin (make-record-type-descriptor* 'env-mixin #f #f #f #f 4 0)) -(define effect_2814 +(define effect_2815 (struct-type-install-properties! struct:env-mixin 'env-mixin @@ -53545,70 +53073,89 @@ (define intdefs-or-false?-string "(or/c internal-definition-context? (listof internal-definition-context?) #f)") (define add-intdef-bindings - (letrec ((loop_0 - (|#%name| - loop - (lambda (env_0 env-mixins_0) - (begin - (if (null? env-mixins_0) - env_0 - (let ((env-mixin_0 (car env-mixins_0))) - (let ((or-part_0 - (hash-ref (env-mixin-cache env-mixin_0) env_0 #f))) - (if or-part_0 - or-part_0 - (let ((new-env_0 - (let ((env_1 - (loop_0 env_0 (cdr env-mixins_0)))) - (let ((key_0 (env-mixin-sym env-mixin_0))) - (let ((val_0 - (env-mixin-value env-mixin_0))) - (let ((key_1 key_0) (env_2 env_1)) - (begin-unsafe - (hash-set env_2 key_1 val_0)))))))) - (begin - (hash-set! - (env-mixin-cache env-mixin_0) - env_0 - new-env_0) - new-env_0))))))))))) - (lambda (env_0 intdefs_0) - (let ((x_0 - (if (list? intdefs_0) - (reverse$1 intdefs_0) - (if (not intdefs_0) null (list intdefs_0))))) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (env_1 a_0) - (begin - (if (pair? a_0) - (let ((intdef_0 (car a_0))) - (let ((env_2 - (let ((env_2 - (let ((parent-ctx_0 - (internal-definition-context-parent-ctx - intdef_0))) - (let ((parent-env_0 - (if parent-ctx_0 - (add-intdef-bindings - env_1 - parent-ctx_0) - env_1))) - (let ((env-mixins_0 - (unbox - (internal-definition-context-env-mixins - intdef_0)))) - (loop_0 - parent-env_0 - env-mixins_0)))))) - (values env_2)))) - (for-loop_0 env_2 (cdr a_0)))) - env_1)))))) - (for-loop_0 env_0 x_0))))))) + (lambda (env_0 intdefs_0) + (let ((x_0 + (if (list? intdefs_0) + (reverse$1 intdefs_0) + (if (not intdefs_0) null (list intdefs_0))))) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (env_1 a_0) + (begin + (if (pair? a_0) + (let ((intdef_0 (car a_0))) + (let ((env_2 + (let ((env_2 + (let ((parent-ctx_0 + (internal-definition-context-parent-ctx + intdef_0))) + (let ((parent-env_0 + (if parent-ctx_0 + (add-intdef-bindings + env_1 + parent-ctx_0) + env_1))) + (let ((env-mixins_0 + (unbox + (internal-definition-context-env-mixins + intdef_0)))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (env_2 env-mixins_1) + (begin + (if (null? env-mixins_1) + env_2 + (let ((env-mixin_0 + (car env-mixins_1))) + (let ((or-part_0 + (hash-ref + (env-mixin-cache + env-mixin_0) + env_2 + #f))) + (if or-part_0 + or-part_0 + (let ((new-env_0 + (let ((env_3 + (loop_0 + env_2 + (cdr + env-mixins_1)))) + (let ((key_0 + (env-mixin-sym + env-mixin_0))) + (let ((val_0 + (env-mixin-value + env-mixin_0))) + (let ((key_1 + key_0) + (env_4 + env_3)) + (begin-unsafe + (hash-set + env_4 + key_1 + val_0)))))))) + (begin + (hash-set! + (env-mixin-cache + env-mixin_0) + env_2 + new-env_0) + new-env_0))))))))))) + (loop_0 + parent-env_0 + env-mixins_0))))))) + (values env_2)))) + (for-loop_0 env_2 (cdr a_0)))) + env_1)))))) + (for-loop_0 env_0 x_0)))))) (define add-intdef-scopes.1 (|#%name| add-intdef-scopes @@ -54133,185 +53680,183 @@ sym-key_0)) (do-make-syntax-introducer (make-interned-scope sym-key_0))))))) (define do-make-syntax-introducer - (letrec ((do-make-syntax-introducer_0 - (|#%name| - do-make-syntax-introducer - (lambda (sc_0 s57_0 mode56_0) - (begin - (begin - (if (syntax?$1 s57_0) - (void) - (raise-argument-error 'syntax-introducer "syntax?" s57_0)) - (let ((new-s_0 - (if (eq? mode56_0 'add) - (add-scope s57_0 sc_0) - (if (eq? mode56_0 'remove) - (remove-scope s57_0 sc_0) - (if (eq? mode56_0 'flip) - (flip-scope s57_0 sc_0) - (raise-argument-error - 'syntax-introducer - "(or/c 'add 'remove 'flip)" - mode56_0)))))) - (let ((ctx_0 - (get-current-expand-context.1 #t 'unexpected))) - (begin - (if ctx_0 - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'track-syntax - mode56_0 - new-s_0 - s57_0) - (void))) - (void)) - new-s_0))))))))) - (lambda (sc_0) + (lambda (sc_0) + (let ((do-make-syntax-introducer_0 + (|#%name| + do-make-syntax-introducer + (lambda (s57_0 mode56_0) + (begin + (begin + (if (syntax?$1 s57_0) + (void) + (raise-argument-error 'syntax-introducer "syntax?" s57_0)) + (let ((new-s_0 + (if (eq? mode56_0 'add) + (add-scope s57_0 sc_0) + (if (eq? mode56_0 'remove) + (remove-scope s57_0 sc_0) + (if (eq? mode56_0 'flip) + (flip-scope s57_0 sc_0) + (raise-argument-error + 'syntax-introducer + "(or/c 'add 'remove 'flip)" + mode56_0)))))) + (let ((ctx_0 + (get-current-expand-context.1 #t 'unexpected))) + (begin + (if ctx_0 + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'track-syntax + mode56_0 + new-s_0 + s57_0) + (void))) + (void)) + new-s_0))))))))) (|#%name| do-make-syntax-introducer (case-lambda - ((s_0) (begin (do-make-syntax-introducer_0 sc_0 s_0 'flip))) - ((s_0 mode56_0) (do-make-syntax-introducer_0 sc_0 s_0 mode56_0))))))) + ((s_0) (begin (do-make-syntax-introducer_0 s_0 'flip))) + ((s_0 mode56_0) (do-make-syntax-introducer_0 s_0 mode56_0))))))) (define 1/make-syntax-delta-introducer (let ((make-syntax-delta-introducer_0 - (letrec ((make-syntax-delta-introducer_0 - (|#%name| - make-syntax-delta-introducer - (lambda (delta-scs_0 maybe-taint_0 shifts_0 s64_0 mode63_0) - (begin - (let ((new-s_0 - (|#%app| - maybe-taint_0 - (if (eq? mode63_0 'add) - (let ((temp65_0 - (add-scopes s64_0 delta-scs_0))) - (syntax-add-shifts.1 - #t - temp65_0 - shifts_0 - #f)) - (if (eq? mode63_0 'remove) - (remove-scopes s64_0 delta-scs_0) - (if (eq? mode63_0 'flip) - (let ((temp68_0 - (flip-scopes s64_0 delta-scs_0))) - (syntax-add-shifts.1 - #t - temp68_0 - shifts_0 - #f)) - (raise-argument-error - 'syntax-introducer - "(or/c 'add 'remove 'flip)" - mode63_0))))))) - (let ((ctx_0 - (get-current-expand-context.1 - #t - 'unexpected))) - (begin - (if ctx_0 - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'track-syntax - mode63_0 - new-s_0 - s64_0) - (void))) - (void)) - new-s_0)))))))) - (|#%name| - make-syntax-delta-introducer - (lambda (ext-s3_0 base-s4_0 phase2_0) - (begin - (let ((phase_0 - (if (eq? phase2_0 unsafe-undefined) - (1/syntax-local-phase-level) - phase2_0))) + (|#%name| + make-syntax-delta-introducer + (lambda (ext-s3_0 base-s4_0 phase2_0) + (begin + (let ((phase_0 + (if (eq? phase2_0 unsafe-undefined) + (1/syntax-local-phase-level) + phase2_0))) + (begin + (if (syntax?$1 ext-s3_0) + (void) + (raise-argument-error + 'make-syntax-delta-introducer + "syntax?" + ext-s3_0)) (begin - (if (syntax?$1 ext-s3_0) + (if (let ((or-part_0 (not base-s4_0))) + (if or-part_0 or-part_0 (syntax?$1 base-s4_0))) (void) (raise-argument-error 'make-syntax-delta-introducer - "syntax?" - ext-s3_0)) + "(or/c syntax? #f)" + base-s4_0)) (begin - (if (let ((or-part_0 (not base-s4_0))) - (if or-part_0 or-part_0 (syntax?$1 base-s4_0))) + (if (phase? phase_0) (void) (raise-argument-error 'make-syntax-delta-introducer - "(or/c syntax? #f)" - base-s4_0)) - (begin - (if (phase? phase_0) - (void) - (raise-argument-error - 'make-syntax-delta-introducer - phase?-string - phase_0)) - (let ((ext-scs_0 (syntax-scope-set ext-s3_0 phase_0))) - (let ((base-scs_0 - (syntax-scope-set - (if base-s4_0 base-s4_0 empty-syntax) - phase_0))) - (let ((use-base-scs_0 - (if (begin-unsafe - (hash-keys-subset? - base-scs_0 - ext-scs_0)) - base-scs_0 - (let ((or-part_0 - (if (identifier? base-s4_0) - (resolve.1 - #f - #f - null - #t - base-s4_0 - phase_0) - #f))) - (if or-part_0 or-part_0 (seteq)))))) - (let ((delta-scs_0 - (set->list - (set-subtract - ext-scs_0 - use-base-scs_0)))) - (let ((maybe-taint_0 - (if (begin-unsafe - (let ((v_0 - (syntax-tamper ext-s3_0))) - (begin-unsafe (not v_0)))) - values - syntax-taint$1))) - (let ((shifts_0 - (syntax-mpi-shifts ext-s3_0))) + phase?-string + phase_0)) + (let ((ext-scs_0 (syntax-scope-set ext-s3_0 phase_0))) + (let ((base-scs_0 + (syntax-scope-set + (if base-s4_0 base-s4_0 empty-syntax) + phase_0))) + (let ((use-base-scs_0 + (if (begin-unsafe + (hash-keys-subset? base-scs_0 ext-scs_0)) + base-scs_0 + (let ((or-part_0 + (if (identifier? base-s4_0) + (resolve.1 + #f + #f + null + #t + base-s4_0 + phase_0) + #f))) + (if or-part_0 or-part_0 (seteq)))))) + (let ((delta-scs_0 + (set->list + (set-subtract ext-scs_0 use-base-scs_0)))) + (let ((maybe-taint_0 + (if (begin-unsafe + (let ((v_0 (syntax-tamper ext-s3_0))) + (begin-unsafe (not v_0)))) + values + syntax-taint$1))) + (let ((shifts_0 (syntax-mpi-shifts ext-s3_0))) + (let ((make-syntax-delta-introducer_0 + (|#%name| + make-syntax-delta-introducer + (lambda (s64_0 mode63_0) + (begin + (let ((new-s_0 + (|#%app| + maybe-taint_0 + (if (eq? mode63_0 'add) + (let ((temp65_0 + (add-scopes + s64_0 + delta-scs_0))) + (syntax-add-shifts.1 + #t + temp65_0 + shifts_0 + #f)) + (if (eq? + mode63_0 + 'remove) + (remove-scopes + s64_0 + delta-scs_0) + (if (eq? + mode63_0 + 'flip) + (let ((temp68_0 + (flip-scopes + s64_0 + delta-scs_0))) + (syntax-add-shifts.1 + #t + temp68_0 + shifts_0 + #f)) + (raise-argument-error + 'syntax-introducer + "(or/c 'add 'remove 'flip)" + mode63_0))))))) + (let ((ctx_0 + (get-current-expand-context.1 + #t + 'unexpected))) + (begin + (if ctx_0 + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'track-syntax + mode63_0 + new-s_0 + s64_0) + (void))) + (void)) + new-s_0)))))))) (|#%name| make-syntax-delta-introducer (case-lambda ((s_0) (begin (make-syntax-delta-introducer_0 - delta-scs_0 - maybe-taint_0 - shifts_0 s_0 'add))) ((s_0 mode63_0) (make-syntax-delta-introducer_0 - delta-scs_0 - maybe-taint_0 - shifts_0 s_0 mode63_0)))))))))))))))))))) (|#%name| @@ -54687,7 +54232,7 @@ s_0 added-s_0) (void))) - (map_2960 + (map_1346 (lambda (id_0) (begin-unsafe (flip-scopes @@ -54784,294 +54329,286 @@ "given form" s_0)))))))))) (define do-local-lift-to-module.1 - (letrec ((procz3 - (|#%name| post-wrap (lambda (s_0 phase_0 lift-ctx_0) (begin s_0)))) - (procz2 - (|#%name| - shift-wrap - (lambda (s_0 phase_0 lift-ctx_0) (begin s_0)))) - (procz1 - (|#%name| pre-wrap (lambda (s_0 phase_0 lift-ctx_0) (begin s_0))))) - (|#%name| - do-local-lift-to-module - (lambda (add-lifted!23_0 - get-lift-ctx22_0 - get-wrt-phase24_0 - intro?20_0 - log-tag18_0 - more-checks21_0 - no-target-msg19_0 - post-wrap27_0 - pre-wrap25_0 - shift-wrap26_0 - who38_0 - s39_0) - (begin - (let ((pre-wrap_0 - (if (eq? pre-wrap25_0 unsafe-undefined) procz1 pre-wrap25_0))) - (let ((shift-wrap_0 - (if (eq? shift-wrap26_0 unsafe-undefined) - procz2 - shift-wrap26_0))) - (let ((post-wrap_0 - (if (eq? post-wrap27_0 unsafe-undefined) - procz3 - post-wrap27_0))) + (|#%name| + do-local-lift-to-module + (lambda (add-lifted!23_0 + get-lift-ctx22_0 + get-wrt-phase24_0 + intro?20_0 + log-tag18_0 + more-checks21_0 + no-target-msg19_0 + post-wrap27_0 + pre-wrap25_0 + shift-wrap26_0 + who38_0 + s39_0) + (begin + (let ((pre-wrap_0 + (if (eq? pre-wrap25_0 unsafe-undefined) + (|#%name| + pre-wrap + (lambda (s_0 phase_0 lift-ctx_0) (begin s_0))) + pre-wrap25_0))) + (let ((shift-wrap_0 + (if (eq? shift-wrap26_0 unsafe-undefined) + (|#%name| + shift-wrap + (lambda (s_0 phase_0 lift-ctx_0) (begin s_0))) + shift-wrap26_0))) + (let ((post-wrap_0 + (if (eq? post-wrap27_0 unsafe-undefined) + (|#%name| + post-wrap + (lambda (s_0 phase_0 lift-ctx_0) (begin s_0))) + post-wrap27_0))) + (begin + (if (syntax?$1 s39_0) + (void) + (raise-argument-error who38_0 "syntax?" s39_0)) (begin - (if (syntax?$1 s39_0) - (void) - (raise-argument-error who38_0 "syntax?" s39_0)) - (begin - (|#%app| more-checks21_0) - (let ((ctx_0 (get-current-expand-context.1 #f who38_0))) - (let ((lift-ctx_0 (|#%app| get-lift-ctx22_0 ctx_0))) - (begin - (if lift-ctx_0 - (void) - (raise-arguments-error - who38_0 - no-target-msg19_0 - "form to lift" - s39_0)) - (let ((phase_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx_0))))) - (let ((wrt-phase_0 - (|#%app| get-wrt-phase24_0 lift-ctx_0))) - (let ((added-s_0 - (if intro?20_0 + (|#%app| more-checks21_0) + (let ((ctx_0 (get-current-expand-context.1 #f who38_0))) + (let ((lift-ctx_0 (|#%app| get-lift-ctx22_0 ctx_0))) + (begin + (if lift-ctx_0 + (void) + (raise-arguments-error + who38_0 + no-target-msg19_0 + "form to lift" + s39_0)) + (let ((phase_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))))) + (let ((wrt-phase_0 + (|#%app| get-wrt-phase24_0 lift-ctx_0))) + (let ((added-s_0 + (if intro?20_0 + (begin-unsafe + (flip-scopes + s39_0 (begin-unsafe - (flip-scopes - s39_0 - (begin-unsafe - (expand-context/outer-current-introduction-scopes - ctx_0)))) - s39_0))) - (let ((pre-s_0 - (|#%app| - pre-wrap_0 - added-s_0 - phase_0 - lift-ctx_0))) - (let ((shift-s_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (s_0 pos_0) - (begin - (if (> pos_0 wrt-phase_0) - (let ((s_1 - (let ((s_1 - (|#%app| - shift-wrap_0 - s_0 - (sub1 pos_0) - lift-ctx_0))) - (values s_1)))) - (for-loop_0 - s_1 - (+ pos_0 -1))) - s_0)))))) - (for-loop_0 pre-s_0 phase_0))))) - (let ((post-s_0 - (|#%app| - post-wrap_0 - shift-s_0 - wrt-phase_0 - lift-ctx_0))) - (begin - (if log-tag18_0 - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - log-tag18_0 - s39_0 - added-s_0 - post-s_0) - (void))) - (void)) - (|#%app| - add-lifted!23_0 - lift-ctx_0 - post-s_0 - wrt-phase_0) - (values - ctx_0 - post-s_0))))))))))))))))))))) + (expand-context/outer-current-introduction-scopes + ctx_0)))) + s39_0))) + (let ((pre-s_0 + (|#%app| + pre-wrap_0 + added-s_0 + phase_0 + lift-ctx_0))) + (let ((shift-s_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (s_0 pos_0) + (begin + (if (> pos_0 wrt-phase_0) + (let ((s_1 + (let ((s_1 + (|#%app| + shift-wrap_0 + s_0 + (sub1 pos_0) + lift-ctx_0))) + (values s_1)))) + (for-loop_0 + s_1 + (+ pos_0 -1))) + s_0)))))) + (for-loop_0 pre-s_0 phase_0))))) + (let ((post-s_0 + (|#%app| + post-wrap_0 + shift-s_0 + wrt-phase_0 + lift-ctx_0))) + (begin + (if log-tag18_0 + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + log-tag18_0 + s39_0 + added-s_0 + post-s_0) + (void))) + (void)) + (|#%app| + add-lifted!23_0 + lift-ctx_0 + post-s_0 + wrt-phase_0) + (values ctx_0 post-s_0)))))))))))))))))))) (define 1/syntax-local-lift-require - (letrec ((procz1 - (lambda (s_0 phase_0 require-lift-ctx_0) - (require-spec-shift-for-syntax s_0)))) - (|#%name| - syntax-local-lift-require - (lambda (s_0 use-s_0) - (begin - (let ((sc_0 (new-scope 'lifted-require))) - (call-with-values - (lambda () - (let ((temp103_0 (datum->syntax$1 #f s_0))) - (let ((temp104_0 "could not find target context")) - (let ((temp106_0 - (lambda () - (if (syntax?$1 use-s_0) - (void) - (raise-argument-error - 'syntax-local-lift-require - "syntax?" - use-s_0))))) - (let ((expand-context-require-lifts107_0 - expand-context-require-lifts)) - (let ((temp110_0 procz1)) - (let ((temp111_0 - (lambda (s_1 phase_0 require-lift-ctx_0) - (wrap-form - '|#%require| - (add-scope s_1 sc_0) - phase_0)))) - (let ((temp110_1 temp110_0) - (expand-context-require-lifts107_1 - expand-context-require-lifts107_0) - (temp106_1 temp106_0) - (temp104_1 temp104_0) - (temp103_1 temp103_0)) - (do-local-lift-to-module.1 - add-lifted-require! - expand-context-require-lifts107_1 - require-lift-context-wrt-phase - #f - #f - temp106_1 - temp104_1 - temp111_0 - unsafe-undefined - temp110_1 - 'syntax-local-lift-require - temp103_1))))))))) - (case-lambda - ((ctx_0 added-s_0) - (begin - (with-continuation-mark* - push-authentic - current-expand-context - #f - (let ((app_0 - (begin-unsafe - (expand-context/inner-namespace - (root-expand-context/outer-inner ctx_0))))) - (namespace-visit-available-modules! - app_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx_0)))))) - (let ((result-s_0 (add-scope use-s_0 sc_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'lift-require - added-s_0 - use-s_0 - result-s_0) - (void))) - result-s_0)))) - (args (raise-binding-result-arity-error 2 args)))))))))) + (|#%name| + syntax-local-lift-require + (lambda (s_0 use-s_0) + (begin + (let ((sc_0 (new-scope 'lifted-require))) + (call-with-values + (lambda () + (let ((temp103_0 (datum->syntax$1 #f s_0))) + (let ((temp104_0 "could not find target context")) + (let ((temp106_0 + (lambda () + (if (syntax?$1 use-s_0) + (void) + (raise-argument-error + 'syntax-local-lift-require + "syntax?" + use-s_0))))) + (let ((expand-context-require-lifts107_0 + expand-context-require-lifts)) + (let ((temp110_0 + (lambda (s_1 phase_0 require-lift-ctx_0) + (require-spec-shift-for-syntax s_1)))) + (let ((temp111_0 + (lambda (s_1 phase_0 require-lift-ctx_0) + (wrap-form + '|#%require| + (add-scope s_1 sc_0) + phase_0)))) + (let ((temp110_1 temp110_0) + (expand-context-require-lifts107_1 + expand-context-require-lifts107_0) + (temp106_1 temp106_0) + (temp104_1 temp104_0) + (temp103_1 temp103_0)) + (do-local-lift-to-module.1 + add-lifted-require! + expand-context-require-lifts107_1 + require-lift-context-wrt-phase + #f + #f + temp106_1 + temp104_1 + temp111_0 + unsafe-undefined + temp110_1 + 'syntax-local-lift-require + temp103_1))))))))) + (case-lambda + ((ctx_0 added-s_0) + (begin + (with-continuation-mark* + push-authentic + current-expand-context + #f + (let ((app_0 + (begin-unsafe + (expand-context/inner-namespace + (root-expand-context/outer-inner ctx_0))))) + (namespace-visit-available-modules! + app_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0)))))) + (let ((result-s_0 (add-scope use-s_0 sc_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'lift-require + added-s_0 + use-s_0 + result-s_0) + (void))) + result-s_0)))) + (args (raise-binding-result-arity-error 2 args))))))))) (define 1/syntax-local-lift-provide - (letrec ((procz2 - (lambda (s_0 phase_0 to-module-lift-ctx_0) - (wrap-form '|#%provide| s_0 phase_0))) - (procz1 - (lambda (s_0 phase_0 to-module-lift-ctx_0) - (wrap-form 'for-syntax s_0 #f)))) - (|#%name| - syntax-local-lift-provide - (lambda (s_0) - (begin - (call-with-values - (lambda () - (let ((temp115_0 "not expanding in a module run-time body")) - (let ((expand-context-to-module-lifts116_0 - expand-context-to-module-lifts)) - (let ((add-lifted-to-module-provide!118_0 - add-lifted-to-module-provide!)) - (let ((temp119_0 procz1)) - (let ((temp120_0 procz2)) - (do-local-lift-to-module.1 - add-lifted-to-module-provide!118_0 - expand-context-to-module-lifts116_0 - to-module-lift-context-wrt-phase - #t - #f - void - temp115_0 - temp120_0 - unsafe-undefined - temp119_0 - 'syntax-local-lift-provide - s_0))))))) - (case-lambda - ((ctx_0 result-s_0) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx_0))))) - (if obs_0 - (call-expand-observe obs_0 'lift-provide result-s_0) - (void)))) - (args (raise-binding-result-arity-error 2 args))))))))) + (|#%name| + syntax-local-lift-provide + (lambda (s_0) + (begin + (call-with-values + (lambda () + (let ((temp115_0 "not expanding in a module run-time body")) + (let ((expand-context-to-module-lifts116_0 + expand-context-to-module-lifts)) + (let ((add-lifted-to-module-provide!118_0 + add-lifted-to-module-provide!)) + (let ((temp119_0 + (lambda (s_1 phase_0 to-module-lift-ctx_0) + (wrap-form 'for-syntax s_1 #f)))) + (let ((temp120_0 + (lambda (s_1 phase_0 to-module-lift-ctx_0) + (wrap-form '|#%provide| s_1 phase_0)))) + (do-local-lift-to-module.1 + add-lifted-to-module-provide!118_0 + expand-context-to-module-lifts116_0 + to-module-lift-context-wrt-phase + #t + #f + void + temp115_0 + temp120_0 + unsafe-undefined + temp119_0 + 'syntax-local-lift-provide + s_0))))))) + (case-lambda + ((ctx_0 result-s_0) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx_0))))) + (if obs_0 + (call-expand-observe obs_0 'lift-provide result-s_0) + (void)))) + (args (raise-binding-result-arity-error 2 args)))))))) (define 1/syntax-local-lift-module-end-declaration - (letrec ((procz3 - (lambda (s_0 phase_0 to-module-lift-ctx_0) - (wrap-form 'begin-for-syntax s_0 phase_0))) - (procz2 - (lambda (orig-s_0 phase_0 to-module-lift-ctx_0) - (if (to-module-lift-context-end-as-expressions? - to-module-lift-ctx_0) - (wrap-form '|#%expression| orig-s_0 phase_0) - orig-s_0))) - (procz1 (lambda (lift-ctx_0) 0))) - (|#%name| - syntax-local-lift-module-end-declaration - (lambda (s_0) - (begin - (call-with-values - (lambda () - (let ((temp125_0 - "not currently transforming an expression within a module declaration")) - (let ((expand-context-to-module-lifts126_0 - expand-context-to-module-lifts)) - (let ((temp127_0 procz1)) - (let ((add-lifted-to-module-end!128_0 - add-lifted-to-module-end!)) - (let ((temp129_0 procz2)) - (let ((temp130_0 procz3)) - (do-local-lift-to-module.1 - add-lifted-to-module-end!128_0 - expand-context-to-module-lifts126_0 - temp127_0 - #t - 'lift-end-decl - void - temp125_0 - unsafe-undefined - temp129_0 - temp130_0 - 'syntax-local-lift-module-end-declaration - s_0)))))))) - (case-lambda - ((ctx_0 also-s_0) (void)) - (args (raise-binding-result-arity-error 2 args))))))))) + (|#%name| + syntax-local-lift-module-end-declaration + (lambda (s_0) + (begin + (call-with-values + (lambda () + (let ((temp125_0 + "not currently transforming an expression within a module declaration")) + (let ((expand-context-to-module-lifts126_0 + expand-context-to-module-lifts)) + (let ((temp127_0 (lambda (lift-ctx_0) 0))) + (let ((add-lifted-to-module-end!128_0 + add-lifted-to-module-end!)) + (let ((temp129_0 + (lambda (orig-s_0 phase_0 to-module-lift-ctx_0) + (if (to-module-lift-context-end-as-expressions? + to-module-lift-ctx_0) + (wrap-form '|#%expression| orig-s_0 phase_0) + orig-s_0)))) + (let ((temp130_0 + (lambda (s_1 phase_0 to-module-lift-ctx_0) + (wrap-form 'begin-for-syntax s_1 phase_0)))) + (do-local-lift-to-module.1 + add-lifted-to-module-end!128_0 + expand-context-to-module-lifts126_0 + temp127_0 + #t + 'lift-end-decl + void + temp125_0 + unsafe-undefined + temp129_0 + temp130_0 + 'syntax-local-lift-module-end-declaration + s_0)))))))) + (case-lambda + ((ctx_0 also-s_0) (void)) + (args (raise-binding-result-arity-error 2 args)))))))) (define wrap-form (lambda (sym_0 s_0 phase_0) (datum->syntax$1 @@ -56324,515 +55861,514 @@ mod-path_0 dest-namespace4_0)))))) (define do-attach-module.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (dest-namespace12_0 - missing_0 - src-namespace10_0 - todo_0 - who9_0 - mpi_0 - phase_0 - attach-instances?_0 - attach-phase_0) - (begin - (let ((mod-name_0 - (with-continuation-mark* - push-authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - 1/current-namespace - src-namespace10_0) - (1/module-path-index-resolve mpi_0)))) - (let ((attach-this-instance?_0 - (if attach-instances?_0 - (eqv? phase_0 attach-phase_0) - #f))) - (let ((m-ns_0 - (hash-ref - (hash-ref todo_0 mod-name_0 hash2589) - phase_0 - missing_0))) - (if (let ((or-part_0 (eq? missing_0 m-ns_0))) - (if or-part_0 - or-part_0 - (if attach-this-instance?_0 (not m-ns_0) #f))) - (let ((m_0 - (namespace->module - src-namespace10_0 - mod-name_0))) - (begin - (if m_0 - (void) - (raise-arguments-error - who9_0 - "module not declared (in the source namespace)" - "module name" - mod-name_0)) - (if (if (module-cross-phase-persistent? m_0) - (if (not (begin-unsafe (not phase_0))) - (not (begin-unsafe (eq? phase_0 0))) - #f) - #f) - (loop_0 - dest-namespace12_0 - missing_0 - src-namespace10_0 - todo_0 - who9_0 - mpi_0 - 0 - attach-instances?_0 - 0) - (let ((already-m_0 - (namespace->module - dest-namespace12_0 - mod-name_0))) - (begin - (if (if already-m_0 - (not (eq? already-m_0 m_0)) - #f) - (raise-arguments-error - who9_0 - "a different declaration is already in the destination namespace" - "module name" - mod-name_0) - (void)) - (call-with-values - (lambda () - (if (if attach-this-instance?_0 - attach-this-instance?_0 - (module-cross-phase-persistent? - m_0)) - (let ((m-ns_1 - (namespace->module-namespace.1 - #f - #f - void - src-namespace10_0 - mod-name_0 - phase_0))) - (begin - (if m-ns_1 - (void) - (raise-arguments-error - who9_0 - "module not instantiated (in the source namespace)" - "module name" - mod-name_0)) - (let ((already-m-ns_0 - (if already-m_0 - (namespace->module-namespace.1 - #f - #f - void - dest-namespace12_0 - mod-name_0 - phase_0) - #f))) - (begin - (if (if already-m-ns_0 - (if (not - (eq? - m-ns_1 - already-m-ns_0)) - (not - (namespace-same-instance? - m-ns_1 - already-m-ns_0)) - #f) - #f) - (raise-arguments-error - who9_0 - "a different instance is already in the destination namespace" - "module name" - mod-name_0) - (void)) - (values - m-ns_1 - (if already-m-ns_0 #t #f)))))) - (begin - (if (if (begin-unsafe (not phase_0)) - (not - (namespace->module-namespace.1 - #f - #f - void - src-namespace10_0 - mod-name_0 - phase_0)) - #f) - (with-continuation-mark* - push-authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first - #f - parameterization-key) - 1/current-namespace - src-namespace10_0) - (namespace-module-instantiate!.1 - #t - unsafe-undefined - hash2610 - null - #f - src-namespace10_0 - mpi_0 - phase_0)) - (void)) - (values #f (if already-m_0 #t #f))))) - (case-lambda - ((m-ns_1 already?_0) - (begin - (let ((xform_0 - (lambda (ht_0) - (hash-set - ht_0 - phase_0 - m-ns_1)))) - (let ((default_0 hash2589)) - (begin-unsafe - (do-hash-update - 'hash-update! - #t - hash-set! - todo_0 - mod-name_0 - xform_0 - default_0)))) - (if already?_0 - (void) - (begin - (let ((lst_0 - (module-requires m_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((phase+reqs_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (call-with-values - (lambda () - (let ((lst_2 - (cdr - phase+reqs_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (lst_3) - (begin - (if (pair? - lst_3) - (let ((req_0 - (unsafe-car - lst_3))) - (let ((rest_1 - (unsafe-cdr - lst_3))) - (begin - (let ((app_0 - (module-path-index-shift - req_0 - (module-self - m_0) - mpi_0))) - (loop_0 - dest-namespace12_0 - missing_0 - src-namespace10_0 - todo_0 - who9_0 - app_0 - (phase+ - phase_0 - (car - phase+reqs_0)) - attach-instances?_0 - attach-phase_0)) - (for-loop_1 - rest_1)))) - (values))))))) - (for-loop_1 - lst_2))))) - (case-lambda - (() - (for-loop_0 - rest_0)) - (args - (raise-binding-result-arity-error - 0 - args)))))) - (values))))))) - (for-loop_0 lst_0)))) - (void) - (let ((lst_0 - (module-submodule-names - m_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((submod-name_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (begin - (loop_0 - dest-namespace12_0 - missing_0 - src-namespace10_0 - todo_0 - who9_0 - (1/module-path-index-join - (list - 'submod - "." - submod-name_0) - mpi_0) - #f - #f - attach-phase_0) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void) - (if (module-supermodule-name m_0) - (loop_0 - dest-namespace12_0 - missing_0 - src-namespace10_0 - todo_0 - who9_0 - (1/module-path-index-join - '(submod "..") - mpi_0) - #f - #f - attach-phase_0) - (void)))))) - (args - (raise-binding-result-arity-error - 2 - args))))))))) - (void)))))))))) - (|#%name| - do-attach-module - (lambda (attach-instances?7_0 - who9_0 - src-namespace10_0 - mod-path11_0 - dest-namespace12_0) + (|#%name| + do-attach-module + (lambda (attach-instances?7_0 + who9_0 + src-namespace10_0 + mod-path11_0 + dest-namespace12_0) + (begin (begin + (if (1/namespace? src-namespace10_0) + (void) + (raise-argument-error who9_0 "namespace?" src-namespace10_0)) (begin - (if (1/namespace? src-namespace10_0) + (if (let ((or-part_0 (1/module-path? mod-path11_0))) + (if or-part_0 + or-part_0 + (1/resolved-module-path? mod-path11_0))) (void) - (raise-argument-error who9_0 "namespace?" src-namespace10_0)) + (raise-argument-error + who9_0 + "(or/c module-path? resolved-module-path?)" + mod-path11_0)) (begin - (if (let ((or-part_0 (1/module-path? mod-path11_0))) - (if or-part_0 - or-part_0 - (1/resolved-module-path? mod-path11_0))) + (if (1/namespace? dest-namespace12_0) (void) - (raise-argument-error - who9_0 - "(or/c module-path? resolved-module-path?)" - mod-path11_0)) - (begin - (if (1/namespace? dest-namespace12_0) - (void) - (raise-argument-error who9_0 "namespace?" dest-namespace12_0)) - (let ((phase_0 (namespace-phase src-namespace10_0))) - (begin - (if (eqv? phase_0 (namespace-phase dest-namespace12_0)) - (void) - (raise-arguments-error - who9_0 - "source and destination namespace phases do not match" - "source phase" - phase_0 - "destination phase" - (namespace-phase dest-namespace12_0))) - (let ((todo_0 (make-hasheq))) - (let ((missing_0 kw2836)) - (begin - (loop_0 - dest-namespace12_0 - missing_0 - src-namespace10_0 - todo_0 - who9_0 - (1/module-path-index-join - (if (1/resolved-module-path? mod-path11_0) - (resolved-module-path->module-path mod-path11_0) - mod-path11_0) - #f) - phase_0 - attach-instances?7_0 - phase_0) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value todo_0 i_0)) - (case-lambda - ((mod-name_0 phases_0) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (i_1) - (begin - (if i_1 - (call-with-values - (lambda () - (hash-iterate-key+value - phases_0 - i_1)) - (case-lambda - ((phase_1 m-ns_0) - (begin - (let ((m_0 - (namespace->module - src-namespace10_0 - mod-name_0))) - (begin - (begin-unsafe - (let ((app_0 - (module-force-bulk-binding - m_0))) - (|#%app| - app_0 - (namespace-bulk-binding-registry - src-namespace10_0)))) - (with-continuation-mark* - push-authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first - #f - parameterization-key) - 1/current-namespace - dest-namespace12_0) - (declare-module!.1 - #t - dest-namespace12_0 - m_0 - mod-name_0)) - (if m-ns_0 - (begin - (namespace-record-module-instance-attached! - src-namespace10_0 - mod-name_0 - phase_1) - (let ((or-part_0 - (namespace->module-namespace.1 - #f - #f - void - dest-namespace12_0 - mod-name_0 - phase_1))) - (if or-part_0 - or-part_0 - (namespace-install-module-namespace! - dest-namespace12_0 - mod-name_0 - phase_1 - m_0 - m-ns_0)))) - (void)))) - (for-loop_1 - (hash-iterate-next - phases_0 - i_1)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values))))))) - (for-loop_1 - (hash-iterate-first - phases_0))))) - (case-lambda - (() - (for-loop_0 - (hash-iterate-next todo_0 i_0))) - (args - (raise-binding-result-arity-error + (raise-argument-error who9_0 "namespace?" dest-namespace12_0)) + (let ((phase_0 (namespace-phase src-namespace10_0))) + (begin + (if (eqv? phase_0 (namespace-phase dest-namespace12_0)) + (void) + (raise-arguments-error + who9_0 + "source and destination namespace phases do not match" + "source phase" + phase_0 + "destination phase" + (namespace-phase dest-namespace12_0))) + (let ((todo_0 (make-hasheq))) + (let ((missing_0 kw2836)) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (mpi_0 + phase_1 + attach-instances?_0 + attach-phase_0) + (begin + (let ((mod-name_0 + (with-continuation-mark* + push-authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first + #f + parameterization-key) + 1/current-namespace + src-namespace10_0) + (1/module-path-index-resolve mpi_0)))) + (let ((attach-this-instance?_0 + (if attach-instances?_0 + (eqv? phase_1 attach-phase_0) + #f))) + (let ((m-ns_0 + (hash-ref + (hash-ref + todo_0 + mod-name_0 + hash2589) + phase_1 + missing_0))) + (if (let ((or-part_0 + (eq? missing_0 m-ns_0))) + (if or-part_0 + or-part_0 + (if attach-this-instance?_0 + (not m-ns_0) + #f))) + (let ((m_0 + (namespace->module + src-namespace10_0 + mod-name_0))) + (begin + (if m_0 + (void) + (raise-arguments-error + who9_0 + "module not declared (in the source namespace)" + "module name" + mod-name_0)) + (if (if (module-cross-phase-persistent? + m_0) + (if (not + (begin-unsafe + (not phase_1))) + (not + (begin-unsafe + (eq? phase_1 0))) + #f) + #f) + (loop_0 + mpi_0 0 - args))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values))))))) - (for-loop_0 (hash-iterate-first todo_0)))) - (let ((mnr_0 - (|#%app| 1/current-module-name-resolver))) - (with-continuation-mark* - authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first - #f - parameterization-key) - 1/current-namespace - dest-namespace12_0) + attach-instances?_0 + 0) + (let ((already-m_0 + (namespace->module + dest-namespace12_0 + mod-name_0))) + (begin + (if (if already-m_0 + (not + (eq? already-m_0 m_0)) + #f) + (raise-arguments-error + who9_0 + "a different declaration is already in the destination namespace" + "module name" + mod-name_0) + (void)) + (call-with-values + (lambda () + (if (if attach-this-instance?_0 + attach-this-instance?_0 + (module-cross-phase-persistent? + m_0)) + (let ((m-ns_1 + (namespace->module-namespace.1 + #f + #f + void + src-namespace10_0 + mod-name_0 + phase_1))) + (begin + (if m-ns_1 + (void) + (raise-arguments-error + who9_0 + "module not instantiated (in the source namespace)" + "module name" + mod-name_0)) + (let ((already-m-ns_0 + (if already-m_0 + (namespace->module-namespace.1 + #f + #f + void + dest-namespace12_0 + mod-name_0 + phase_1) + #f))) + (begin + (if (if already-m-ns_0 + (if (not + (eq? + m-ns_1 + already-m-ns_0)) + (not + (namespace-same-instance? + m-ns_1 + already-m-ns_0)) + #f) + #f) + (raise-arguments-error + who9_0 + "a different instance is already in the destination namespace" + "module name" + mod-name_0) + (void)) + (values + m-ns_1 + (if already-m-ns_0 + #t + #f)))))) + (begin + (if (if (begin-unsafe + (not phase_1)) + (not + (namespace->module-namespace.1 + #f + #f + void + src-namespace10_0 + mod-name_0 + phase_1)) + #f) + (with-continuation-mark* + push-authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first + #f + parameterization-key) + 1/current-namespace + src-namespace10_0) + (namespace-module-instantiate!.1 + #t + unsafe-undefined + hash2610 + null + #f + src-namespace10_0 + mpi_0 + phase_1)) + (void)) + (values + #f + (if already-m_0 + #t + #f))))) + (case-lambda + ((m-ns_1 already?_0) + (begin + (let ((xform_0 + (lambda (ht_0) + (hash-set + ht_0 + phase_1 + m-ns_1)))) + (let ((default_0 + hash2589)) + (begin-unsafe + (do-hash-update + 'hash-update! + #t + hash-set! + todo_0 + mod-name_0 + xform_0 + default_0)))) + (if already?_0 + (void) + (begin + (let ((lst_0 + (module-requires + m_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? + lst_1) + (let ((phase+reqs_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (call-with-values + (lambda () + (let ((lst_2 + (cdr + phase+reqs_0))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (lst_3) + (begin + (if (pair? + lst_3) + (let ((req_0 + (unsafe-car + lst_3))) + (let ((rest_1 + (unsafe-cdr + lst_3))) + (begin + (let ((app_0 + (module-path-index-shift + req_0 + (module-self + m_0) + mpi_0))) + (loop_0 + app_0 + (phase+ + phase_1 + (car + phase+reqs_0)) + attach-instances?_0 + attach-phase_0)) + (for-loop_1 + rest_1)))) + (values))))))) + (for-loop_1 + lst_2))))) + (case-lambda + (() + (for-loop_0 + rest_0)) + (args + (raise-binding-result-arity-error + 0 + args)))))) + (values))))))) + (for-loop_0 + lst_0)))) + (void) + (let ((lst_0 + (module-submodule-names + m_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? + lst_1) + (let ((submod-name_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (begin + (loop_0 + (1/module-path-index-join + (list + 'submod + "." + submod-name_0) + mpi_0) + #f + #f + attach-phase_0) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + lst_0)))) + (void) + (if (module-supermodule-name + m_0) + (loop_0 + (1/module-path-index-join + '(submod "..") + mpi_0) + #f + #f + attach-phase_0) + (void)))))) + (args + (raise-binding-result-arity-error + 2 + args))))))))) + (void)))))))))) + (loop_0 + (1/module-path-index-join + (if (1/resolved-module-path? mod-path11_0) + (resolved-module-path->module-path mod-path11_0) + mod-path11_0) + #f) + phase_0 + attach-instances?7_0 + phase_0)) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value todo_0 i_0)) + (case-lambda + ((mod-name_0 phases_0) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (i_1) + (begin + (if i_1 + (call-with-values + (lambda () + (hash-iterate-key+value + phases_0 + i_1)) + (case-lambda + ((phase_1 m-ns_0) + (begin + (let ((m_0 + (namespace->module + src-namespace10_0 + mod-name_0))) + (begin + (begin-unsafe + (let ((app_0 + (module-force-bulk-binding + m_0))) + (|#%app| + app_0 + (namespace-bulk-binding-registry + src-namespace10_0)))) + (with-continuation-mark* + push-authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first + #f + parameterization-key) + 1/current-namespace + dest-namespace12_0) + (declare-module!.1 + #t + dest-namespace12_0 + m_0 + mod-name_0)) + (if m-ns_0 + (begin + (namespace-record-module-instance-attached! + src-namespace10_0 + mod-name_0 + phase_1) + (let ((or-part_0 + (namespace->module-namespace.1 + #f + #f + void + dest-namespace12_0 + mod-name_0 + phase_1))) + (if or-part_0 + or-part_0 + (namespace-install-module-namespace! + dest-namespace12_0 + mod-name_0 + phase_1 + m_0 + m-ns_0)))) + (void)))) + (for-loop_1 + (hash-iterate-next + phases_0 + i_1)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values))))))) + (for-loop_1 + (hash-iterate-first + phases_0))))) + (case-lambda + (() + (for-loop_0 + (hash-iterate-next todo_0 i_0))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values))))))) + (for-loop_0 (hash-iterate-first todo_0)))) + (let ((mnr_0 + (|#%app| 1/current-module-name-resolver))) + (with-continuation-mark* + authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first + #f + parameterization-key) + 1/current-namespace + dest-namespace12_0) + (begin (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (let ((mod-name_0 - (hash-iterate-key - todo_0 - i_0))) - (begin - (|#%app| - mnr_0 - mod-name_0 - src-namespace10_0) - (for-loop_0 - (hash-iterate-next + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0) + (begin + (if i_0 + (let ((mod-name_0 + (hash-iterate-key todo_0 - i_0)))) - (values))))))) - (for-loop_0 (hash-iterate-first todo_0)))) - (void)))))))))))))))))) + i_0))) + (begin + (|#%app| + mnr_0 + mod-name_0 + src-namespace10_0) + (for-loop_0 + (hash-iterate-next + todo_0 + i_0)))) + (values))))))) + (for-loop_0 (hash-iterate-first todo_0)))) + (void))))))))))))))))) (define 1/make-empty-namespace (|#%name| make-empty-namespace @@ -56848,115 +56384,108 @@ ns_0)))))))) (define 1/namespace-syntax-introduce (let ((namespace-syntax-introduce_0 - (letrec ((add-ns-scopes_0 - (|#%name| - add-ns-scopes - (lambda (ns_0 - other-namespace-scopes_0 - post-scope_0 - root-ctx_0 - s_0) - (begin - (let ((temp40_0 - (add-scopes - (push-scope s_0 post-scope_0) - other-namespace-scopes_0))) - (let ((temp41_0 - (begin-unsafe - (root-expand-context/inner-all-scopes-stx - (root-expand-context/outer-inner - root-ctx_0))))) - (let ((temp42_0 - (let ((or-part_0 - (namespace-declaration-inspector - ns_0))) - (if or-part_0 - or-part_0 - (current-code-inspector))))) - (let ((temp41_1 temp41_0) (temp40_1 temp40_0)) - (syntax-transfer-shifts.1 - #t - temp40_1 - temp41_1 - temp42_0)))))))))) - (|#%name| - namespace-syntax-introduce - (lambda (s2_0 ns1_0) - (begin - (let ((ns_0 - (if (eq? ns1_0 unsafe-undefined) - (1/current-namespace) - ns1_0))) + (|#%name| + namespace-syntax-introduce + (lambda (s2_0 ns1_0) + (begin + (let ((ns_0 + (if (eq? ns1_0 unsafe-undefined) + (1/current-namespace) + ns1_0))) + (begin + (if (syntax?$1 s2_0) + (void) + (raise-argument-error + 'namespace-syntax-introduce + "syntax?" + s2_0)) (begin - (if (syntax?$1 s2_0) + (if (1/namespace? ns_0) (void) (raise-argument-error 'namespace-syntax-introduce - "syntax?" - s2_0)) - (begin - (if (1/namespace? ns_0) - (void) - (raise-argument-error - 'namespace-syntax-introduce - "namespace?" - ns_0)) - (let ((root-ctx_0 (namespace-get-root-expand-ctx ns_0))) - (let ((post-scope_0 - (post-expansion-scope - (begin-unsafe - (root-expand-context/outer-post-expansion - root-ctx_0))))) - (let ((other-namespace-scopes_0 - (reverse$1 - (let ((ht_0 - (syntax-scope-set - (begin-unsafe - (root-expand-context/inner-all-scopes-stx - (root-expand-context/outer-inner - root-ctx_0))) - 0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 i_0) - (begin - (if i_0 - (let ((sc_0 - (unsafe-immutable-hash-iterate-key - ht_0 - i_0))) - (let ((fold-var_1 - (if (equal? - sc_0 - post-scope_0) - fold-var_0 - (let ((fold-var_1 - (cons - sc_0 - fold-var_0))) - (values - fold-var_1))))) - (for-loop_0 - fold-var_1 - (unsafe-immutable-hash-iterate-next + "namespace?" + ns_0)) + (let ((root-ctx_0 (namespace-get-root-expand-ctx ns_0))) + (let ((post-scope_0 + (post-expansion-scope + (begin-unsafe + (root-expand-context/outer-post-expansion + root-ctx_0))))) + (let ((other-namespace-scopes_0 + (reverse$1 + (let ((ht_0 + (syntax-scope-set + (begin-unsafe + (root-expand-context/inner-all-scopes-stx + (root-expand-context/outer-inner + root-ctx_0))) + 0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 i_0) + (begin + (if i_0 + (let ((sc_0 + (unsafe-immutable-hash-iterate-key ht_0 - i_0)))) - fold-var_0)))))) - (for-loop_0 - null - (unsafe-immutable-hash-iterate-first - ht_0)))))))) + i_0))) + (let ((fold-var_1 + (if (equal? + sc_0 + post-scope_0) + fold-var_0 + (let ((fold-var_1 + (cons + sc_0 + fold-var_0))) + (values + fold-var_1))))) + (for-loop_0 + fold-var_1 + (unsafe-immutable-hash-iterate-next + ht_0 + i_0)))) + fold-var_0)))))) + (for-loop_0 + null + (unsafe-immutable-hash-iterate-first + ht_0)))))))) + (let ((add-ns-scopes_0 + (|#%name| + add-ns-scopes + (lambda (s_0) + (begin + (let ((temp40_0 + (add-scopes + (push-scope s_0 post-scope_0) + other-namespace-scopes_0))) + (let ((temp41_0 + (begin-unsafe + (root-expand-context/inner-all-scopes-stx + (root-expand-context/outer-inner + root-ctx_0))))) + (let ((temp42_0 + (let ((or-part_0 + (namespace-declaration-inspector + ns_0))) + (if or-part_0 + or-part_0 + (current-code-inspector))))) + (let ((temp41_1 temp41_0) + (temp40_1 temp40_0)) + (syntax-transfer-shifts.1 + #t + temp40_1 + temp41_1 + temp42_0)))))))))) (let ((maybe-module-id_0 (if (pair? (1/syntax-e s2_0)) (if (identifier? (car (1/syntax-e s2_0))) (add-ns-scopes_0 - ns_0 - other-namespace-scopes_0 - post-scope_0 - root-ctx_0 (car (1/syntax-e s2_0))) #f) #f))) @@ -56976,12 +56505,7 @@ (cdr (1/syntax-e s2_0))) s2_0 s2_0) - (add-ns-scopes_0 - ns_0 - other-namespace-scopes_0 - post-scope_0 - root-ctx_0 - s2_0))))))))))))))) + (add-ns-scopes_0 s2_0))))))))))))))) (|#%name| namespace-syntax-introduce (case-lambda @@ -57558,59 +57082,54 @@ ((ns38_0) (namespace-base-phase_0 ns38_0)))))) (define 1/eval (let ((eval_0 - (letrec ((procz1 - (|#%name| - compile - (lambda (s_0 ns_0) (begin (1/compile s_0 ns_0 #f)))))) - (|#%name| - eval - (lambda (s3_0 ns1_0 compile2_0) - (begin - (let ((ns_0 - (if (eq? ns1_0 unsafe-undefined) - (1/current-namespace) - ns1_0))) - (let ((compile_0 - (if (eq? compile2_0 unsafe-undefined) - procz1 - compile2_0))) - (if (let ((or-part_0 (compiled-in-memory? s3_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (linklet-directory?$1 s3_0))) - (if or-part_1 - or-part_1 - (linklet-bundle? s3_0))))) - (eval-compiled s3_0 ns_0) - (if (if (syntax?$1 s3_0) - (let ((or-part_0 - (compiled-in-memory? (1/syntax-e s3_0)))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (linklet-directory?$1 - (1/syntax-e s3_0)))) - (if or-part_1 - or-part_1 - (linklet-bundle? (1/syntax-e s3_0)))))) - #f) - (eval-compiled (1/syntax->datum s3_0) ns_0) - (let ((temp65_0 - (lambda (s_0 ns_1 tail?_0) - (eval-compiled - (|#%app| compile_0 s_0 ns_1) - ns_1 - tail?_0)))) - (per-top-level.1 - #f - #f - #f - #t - #f - temp65_0 - #f - s3_0 - ns_0)))))))))))) + (|#%name| + eval + (lambda (s3_0 ns1_0 compile2_0) + (begin + (let ((ns_0 + (if (eq? ns1_0 unsafe-undefined) + (1/current-namespace) + ns1_0))) + (let ((compile_0 + (if (eq? compile2_0 unsafe-undefined) + (|#%name| + compile + (lambda (s_0 ns_1) (begin (1/compile s_0 ns_1 #f)))) + compile2_0))) + (if (let ((or-part_0 (compiled-in-memory? s3_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (linklet-directory?$1 s3_0))) + (if or-part_1 or-part_1 (linklet-bundle? s3_0))))) + (eval-compiled s3_0 ns_0) + (if (if (syntax?$1 s3_0) + (let ((or-part_0 + (compiled-in-memory? (1/syntax-e s3_0)))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (linklet-directory?$1 (1/syntax-e s3_0)))) + (if or-part_1 + or-part_1 + (linklet-bundle? (1/syntax-e s3_0)))))) + #f) + (eval-compiled (1/syntax->datum s3_0) ns_0) + (let ((temp65_0 + (lambda (s_0 ns_1 tail?_0) + (eval-compiled + (|#%app| compile_0 s_0 ns_1) + ns_1 + tail?_0)))) + (per-top-level.1 + #f + #f + #f + #t + #f + temp65_0 + #f + s3_0 + ns_0))))))))))) (|#%name| eval (case-lambda @@ -57762,15 +57281,30 @@ 'lifted-parsed-begin 'last)))))) (define compile-single.1 - (letrec ((loop_0 + (|#%name| + compile-single + (lambda (serializable?12_0 + to-correlated-linklet?13_0 + s16_0 + ns17_0 + expand18_0) + (begin + (let ((exp-s_0 + (|#%app| + expand18_0 + s16_0 + ns17_0 + #f + #t + serializable?12_0 + to-correlated-linklet?13_0))) + (letrec* + ((loop_0 (|#%name| loop - (lambda (ns17_0 - serializable?12_0 - to-correlated-linklet?13_0 - exp-s_0) + (lambda (exp-s_1) (begin - (if (parsed-module? exp-s_0) + (if (parsed-module? exp-s_1) (let ((temp85_0 (make-compile-context.1 #f @@ -57785,18 +57319,18 @@ #t serializable?12_0 to-correlated-linklet?13_0 - exp-s_0 + exp-s_1 temp85_0)) - (if (lifted-parsed-begin? exp-s_0) + (if (lifted-parsed-begin? exp-s_1) (let ((temp90_0 (reverse$1 (let ((lst_0 (let ((app_0 - (lifted-parsed-begin-seq exp-s_0))) + (lifted-parsed-begin-seq exp-s_1))) (append app_0 (list - (lifted-parsed-begin-last exp-s_0)))))) + (lifted-parsed-begin-last exp-s_1)))))) (begin (letrec* ((for-loop_0 @@ -57810,11 +57344,7 @@ (let ((fold-var_1 (let ((fold-var_1 (cons - (loop_0 - ns17_0 - serializable?12_0 - to-correlated-linklet?13_0 - e_0) + (loop_0 e_0) fold-var_0))) (values fold-var_1)))) (for-loop_0 @@ -57839,30 +57369,9 @@ serializable?12_0 #f to-correlated-linklet?13_0 - exp-s_0 + exp-s_1 temp92_0))))))))) - (|#%name| - compile-single - (lambda (serializable?12_0 - to-correlated-linklet?13_0 - s16_0 - ns17_0 - expand18_0) - (begin - (let ((exp-s_0 - (|#%app| - expand18_0 - s16_0 - ns17_0 - #f - #t - serializable?12_0 - to-correlated-linklet?13_0))) - (loop_0 - ns17_0 - serializable?12_0 - to-correlated-linklet?13_0 - exp-s_0))))))) + (loop_0 exp-s_0))))))) (define expand$1 (let ((expand_0 (|#%name| @@ -58002,28 +57511,27 @@ (args (raise-binding-result-arity-error 3 args)))))))))) (define expand-once$1 (let ((expand-once_0 - (letrec ((procz1 - (lambda (s_0 ns_0 as-tail?_0) - (expand-single-once s_0 ns_0)))) - (|#%name| - expand-once - (lambda (s36_0 ns35_0) - (begin - (let ((ns_0 - (if (eq? ns35_0 unsafe-undefined) - (1/current-namespace) - ns35_0))) - (let ((temp133_0 procz1)) - (per-top-level.1 - cons - #t - #f - #t - #f - temp133_0 - re-pair - s36_0 - ns_0))))))))) + (|#%name| + expand-once + (lambda (s36_0 ns35_0) + (begin + (let ((ns_0 + (if (eq? ns35_0 unsafe-undefined) + (1/current-namespace) + ns35_0))) + (let ((temp133_0 + (lambda (s_0 ns_1 as-tail?_0) + (expand-single-once s_0 ns_1)))) + (per-top-level.1 + cons + #t + #f + #t + #f + temp133_0 + re-pair + s36_0 + ns_0)))))))) (|#%name| expand-once (case-lambda @@ -58251,863 +57759,785 @@ ((s_0) (begin (expand-to-top-form_0 s_0 unsafe-undefined))) ((s_0 ns37_0) (expand-to-top-form_0 s_0 ns37_0)))))) (define per-top-level.1 - (letrec ((begin-loop_0 - (|#%name| - begin-loop - (lambda (as-tail?_0 - combine40_0 - ctx_0 - just-once?42_0 - ns_0 - phase_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - tl-ctx_0 - wrap41_0 - es_0) - (begin - (if (null? es_0) - (if combine40_0 null (void)) - (if (if (not combine40_0) (null? (cdr es_0)) #f) - (loop_0 - combine40_0 - ctx_0 - just-once?42_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - wrap41_0 - (car es_0) - phase_0 - ns_0 - as-tail?_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner tl-ctx_0))))) - (if obs_0 (call-expand-observe obs_0 'next) (void))) - (let ((a_0 - (if combine40_0 - (loop_0 - combine40_0 - ctx_0 - just-once?42_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - wrap41_0 - (car es_0) - phase_0 - ns_0 - #f) - (begin - (loop_0 - combine40_0 - ctx_0 - just-once?42_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - wrap41_0 - (car es_0) - phase_0 - ns_0 - #f) - (void))))) - (if combine40_0 - (|#%app| - combine40_0 - a_0 - (begin-loop_0 - as-tail?_0 - combine40_0 - ctx_0 - just-once?42_0 - ns_0 - phase_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - tl-ctx_0 - wrap41_0 - (cdr es_0))) - (begin-loop_0 - as-tail?_0 - combine40_0 - ctx_0 - just-once?42_0 - ns_0 - phase_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - tl-ctx_0 - wrap41_0 - (cdr es_0))))))))))) - (loop_0 - (|#%name| - loop - (lambda (combine40_0 - ctx_0 - just-once?42_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - wrap41_0 - s_0 - phase_0 - ns_0 - as-tail?_0) - (begin - (let ((tl-ctx_0 - (if (expand-context/outer? ctx_0) - (let ((inner151_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_0))) - (if (expand-context/inner? the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope + (|#%name| + per-top-level + (lambda (combine40_0 + just-once?42_0 + observer45_0 + quick-immediate?43_0 + serializable?44_0 + single39_0 + wrap41_0 + given-s53_0 + ns54_0) + (begin + (let ((s_0 (maybe-intro given-s53_0 ns54_0))) + (let ((ctx_0 (make-expand-context.1 #f observer45_0 #f #f #f ns54_0))) + (let ((phase_0 (namespace-phase ns54_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (s_1 phase_1 ns_0 as-tail?_0) + (begin + (let ((tl-ctx_0 + (if (expand-context/outer? ctx_0) + (let ((inner151_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx_0))) + (if (expand-context/inner? the-struct_0) + (let ((app_0 + (root-expand-context/inner-self-mpi the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx + (let ((app_1 + (root-expand-context/inner-module-scopes the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms + (let ((app_2 + (root-expand-context/inner-top-level-bind-scope the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter + (let ((app_3 + (root-expand-context/inner-all-scopes-stx the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key + (let ((app_4 + (root-expand-context/inner-defined-syms the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? + (let ((app_5 + (root-expand-context/inner-counter the-struct_0))) - (let ((app_8 - (expand-context/inner-module-begin-k + (let ((app_6 + (root-expand-context/inner-lift-key the-struct_0))) - (let ((app_9 - (expand-context/inner-allow-unbound? + (let ((app_7 + (expand-context/inner-to-parsed? the-struct_0))) - (let ((app_10 - (expand-context/inner-in-local-expand? + (let ((app_8 + (expand-context/inner-module-begin-k the-struct_0))) - (let ((app_11 - (|expand-context/inner-keep-#%expression?| + (let ((app_9 + (expand-context/inner-allow-unbound? the-struct_0))) - (let ((app_12 - (expand-context/inner-stops + (let ((app_10 + (expand-context/inner-in-local-expand? the-struct_0))) - (let ((app_13 - (expand-context/inner-declared-submodule-names + (let ((app_11 + (|expand-context/inner-keep-#%expression?| the-struct_0))) - (let ((app_14 - (expand-context/inner-lifts + (let ((app_12 + (expand-context/inner-stops the-struct_0))) - (let ((app_15 - (expand-context/inner-lift-envs + (let ((app_13 + (expand-context/inner-declared-submodule-names the-struct_0))) - (let ((app_16 - (expand-context/inner-module-lifts + (let ((app_14 + (expand-context/inner-lifts the-struct_0))) - (let ((app_17 - (expand-context/inner-require-lifts + (let ((app_15 + (expand-context/inner-lift-envs the-struct_0))) - (let ((app_18 - (expand-context/inner-to-module-lifts + (let ((app_16 + (expand-context/inner-module-lifts the-struct_0))) - (let ((app_19 - (expand-context/inner-requires+provides + (let ((app_17 + (expand-context/inner-require-lifts the-struct_0))) - (let ((app_20 - (expand-context/inner-observer + (let ((app_18 + (expand-context/inner-to-module-lifts the-struct_0))) - (let ((app_21 - (expand-context/inner-to-correlated-linklet? + (let ((app_19 + (expand-context/inner-requires+provides the-struct_0))) - (let ((app_22 - (expand-context/inner-normalize-locals? + (let ((app_20 + (expand-context/inner-observer the-struct_0))) - (let ((app_23 - (expand-context/inner-parsing-expanded? + (let ((app_21 + (expand-context/inner-to-correlated-linklet? the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - phase_0 - ns_0 - just-once?42_0 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - serializable?44_0 - app_21 - app_22 - app_23 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id + (let ((app_22 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_23 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + phase_1 + ns_0 + just-once?42_0 + app_8 + app_9 + app_10 + app_11 + app_12 + app_13 + app_14 + app_15 + app_16 + app_17 + app_18 + app_19 + app_20 + serializable?44_0 + app_21 + app_22 + app_23 + (expand-context/inner-skip-visit-available? + the-struct_0)))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((app_0 + (root-expand-context/outer-post-expansion ctx_0))) - (let ((app_3 - (expand-context/outer-context ctx_0))) - (let ((app_4 - (expand-context/outer-env ctx_0))) - (let ((app_5 - (expand-context/outer-scopes + (let ((app_1 + (root-expand-context/outer-use-site-scopes + ctx_0))) + (let ((app_2 + (root-expand-context/outer-frame-id + ctx_0))) + (let ((app_3 + (expand-context/outer-context ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes + (let ((app_4 + (expand-context/outer-env ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer + (let ((app_5 + (expand-context/outer-scopes ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records + (let ((app_6 + (expand-context/outer-def-ctx-scopes ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? + (let ((app_7 + (expand-context/outer-binding-layer ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined + (let ((app_8 + (expand-context/outer-reference-records ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes + (let ((app_9 + (expand-context/outer-only-immediate? ctx_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes + (let ((app_10 + (expand-context/outer-need-eventually-defined ctx_0))) - (expand-context/outer1.1 - inner151_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - ctx_0)))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx_0)))) - (let ((wb-s_0 (if just-once?42_0 s_0 #f))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner tl-ctx_0))))) - (if obs_0 - (call-expand-observe obs_0 'visit s_0) - (void))) - (call-with-values - (lambda () - (expand-capturing-lifts - s_0 - (if (expand-context/outer? tl-ctx_0) - (let ((inner157_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - tl-ctx_0))) - (if (expand-context/inner? the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope + (let ((app_11 + (expand-context/outer-current-introduction-scopes + ctx_0))) + (let ((app_12 + (expand-context/outer-current-use-scopes + ctx_0))) + (expand-context/outer1.1 + inner151_0 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + app_12 + (expand-context/outer-name + ctx_0)))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx_0)))) + (let ((wb-s_0 (if just-once?42_0 s_1 #f))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + tl-ctx_0))))) + (if obs_0 + (call-expand-observe obs_0 'visit s_1) + (void))) + (call-with-values + (lambda () + (expand-capturing-lifts + s_1 + (if (expand-context/outer? tl-ctx_0) + (let ((inner157_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + tl-ctx_0))) + (if (expand-context/inner? + the-struct_0) + (let ((app_0 + (root-expand-context/inner-self-mpi the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx + (let ((app_1 + (root-expand-context/inner-module-scopes the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms + (let ((app_2 + (root-expand-context/inner-top-level-bind-scope the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter + (let ((app_3 + (root-expand-context/inner-all-scopes-stx the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key + (let ((app_4 + (root-expand-context/inner-defined-syms the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? + (let ((app_5 + (root-expand-context/inner-counter the-struct_0))) - (let ((app_8 - (expand-context/inner-just-once? + (let ((app_6 + (root-expand-context/inner-lift-key the-struct_0))) - (let ((app_9 - (expand-context/inner-module-begin-k + (let ((app_7 + (expand-context/inner-to-parsed? the-struct_0))) - (let ((app_10 - (expand-context/inner-allow-unbound? + (let ((app_8 + (expand-context/inner-just-once? the-struct_0))) - (let ((app_11 - (expand-context/inner-in-local-expand? + (let ((app_9 + (expand-context/inner-module-begin-k the-struct_0))) - (let ((app_12 - (|expand-context/inner-keep-#%expression?| + (let ((app_10 + (expand-context/inner-allow-unbound? the-struct_0))) - (let ((app_13 - (expand-context/inner-stops + (let ((app_11 + (expand-context/inner-in-local-expand? the-struct_0))) - (let ((app_14 - (expand-context/inner-declared-submodule-names + (let ((app_12 + (|expand-context/inner-keep-#%expression?| the-struct_0))) - (let ((app_15 - (expand-context/inner-lifts + (let ((app_13 + (expand-context/inner-stops the-struct_0))) - (let ((app_16 - (expand-context/inner-lift-envs + (let ((app_14 + (expand-context/inner-declared-submodule-names the-struct_0))) - (let ((app_17 - (expand-context/inner-module-lifts + (let ((app_15 + (expand-context/inner-lifts the-struct_0))) - (let ((app_18 - (expand-context/inner-require-lifts + (let ((app_16 + (expand-context/inner-lift-envs the-struct_0))) - (let ((app_19 - (expand-context/inner-to-module-lifts + (let ((app_17 + (expand-context/inner-module-lifts the-struct_0))) - (let ((app_20 - (expand-context/inner-requires+provides + (let ((app_18 + (expand-context/inner-require-lifts the-struct_0))) - (let ((app_21 - (expand-context/inner-observer + (let ((app_19 + (expand-context/inner-to-module-lifts the-struct_0))) - (let ((app_22 - (expand-context/inner-for-serializable? + (let ((app_20 + (expand-context/inner-requires+provides the-struct_0))) - (let ((app_23 - (expand-context/inner-to-correlated-linklet? + (let ((app_21 + (expand-context/inner-observer the-struct_0))) - (let ((app_24 - (expand-context/inner-normalize-locals? + (let ((app_22 + (expand-context/inner-for-serializable? the-struct_0))) - (let ((app_25 - (expand-context/inner-parsing-expanded? + (let ((app_23 + (expand-context/inner-to-correlated-linklet? the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - phase_0 - ns_0 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - tl-ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - tl-ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id + (let ((app_24 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_25 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + phase_1 + ns_0 + app_8 + app_9 + app_10 + app_11 + app_12 + app_13 + app_14 + app_15 + app_16 + app_17 + app_18 + app_19 + app_20 + app_21 + app_22 + app_23 + app_24 + app_25 + (expand-context/inner-skip-visit-available? + the-struct_0)))))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((app_0 + (root-expand-context/outer-post-expansion tl-ctx_0))) - (let ((app_3 - (expand-context/outer-context + (let ((app_1 + (root-expand-context/outer-use-site-scopes tl-ctx_0))) - (let ((app_4 - (expand-context/outer-env + (let ((app_2 + (root-expand-context/outer-frame-id tl-ctx_0))) - (let ((app_5 - (expand-context/outer-scopes + (let ((app_3 + (expand-context/outer-context tl-ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes + (let ((app_4 + (expand-context/outer-env tl-ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer + (let ((app_5 + (expand-context/outer-scopes tl-ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records + (let ((app_6 + (expand-context/outer-def-ctx-scopes tl-ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined + (let ((app_7 + (expand-context/outer-binding-layer tl-ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes + (let ((app_8 + (expand-context/outer-reference-records tl-ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes + (let ((app_9 + (expand-context/outer-need-eventually-defined tl-ctx_0))) - (expand-context/outer1.1 - inner157_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - #t - app_9 - app_10 - app_11 - (expand-context/outer-name - tl-ctx_0))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - tl-ctx_0)))) - (case-lambda - ((require-lifts_0 lifts_0 exp-s_0) - (let ((disarmed-exp-s_0 (syntax-disarm$1 exp-s_0))) - (if (let ((or-part_0 (pair? require-lifts_0))) - (if or-part_0 or-part_0 (pair? lifts_0))) - (let ((new-s_0 - (let ((temp160_0 - (append require-lifts_0 lifts_0))) - (wrap-lifts-as-begin.1 - unsafe-undefined - unsafe-undefined - temp160_0 - exp-s_0 - phase_0)))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - tl-ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'lift-loop - new-s_0) - (void))) - (if just-once?42_0 - new-s_0 - (loop_0 - combine40_0 - ctx_0 - just-once?42_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - wrap41_0 - new-s_0 - phase_0 - ns_0 - as-tail?_0)))) - (if (not single39_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - tl-ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'return - exp-s_0) - (void))) - exp-s_0) - (if (if just-once?42_0 - (not (eq? exp-s_0 wb-s_0)) - #f) - exp-s_0 - (let ((tmp_0 - (core-form-sym - disarmed-exp-s_0 - phase_0))) - (if (eq? tmp_0 'begin) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-begin - disarmed-exp-s_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_1 - (if (syntax?$1 - disarmed-exp-s_0) - (syntax-e$1 - disarmed-exp-s_0) - disarmed-exp-s_0))) - (if (pair? s_1) - (let ((begin165_0 - (let ((s_2 (car s_1))) - s_2))) - (let ((e166_0 - (let ((s_2 - (cdr s_1))) - (let ((s_3 - (if (syntax?$1 - s_2) - (syntax-e$1 - s_2) - s_2))) - (let ((flat-s_0 - (to-syntax-list.1 - s_3))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-s_0) - flat-s_0)))))) - (let ((begin165_1 - begin165_0)) - (values - begin165_1 - e166_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-s_0)))) - (case-lambda - ((begin163_0 e164_0) - (values #t begin163_0 e164_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 begin163_0 e164_0) - (if wrap41_0 - (let ((new-s_0 - (|#%app| - wrap41_0 - begin163_0 - exp-s_0 - (begin-loop_0 - as-tail?_0 - combine40_0 - ctx_0 - just-once?42_0 - ns_0 - phase_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - tl-ctx_0 - wrap41_0 - e164_0)))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - tl-ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'return - new-s_0) - (void))) - new-s_0)) - (begin-loop_0 - as-tail?_0 - combine40_0 - ctx_0 - just-once?42_0 - ns_0 - phase_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - tl-ctx_0 - wrap41_0 - e164_0))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (if (eq? tmp_0 'begin-for-syntax) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - tl-ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-begin-for-syntax - disarmed-exp-s_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_1 - (if (syntax?$1 - disarmed-exp-s_0) - (syntax-e$1 - disarmed-exp-s_0) - disarmed-exp-s_0))) - (if (pair? s_1) - (let ((begin-for-syntax169_0 - (let ((s_2 - (car s_1))) - s_2))) - (let ((e170_0 - (let ((s_2 - (cdr s_1))) - (let ((s_3 - (if (syntax?$1 - s_2) - (syntax-e$1 - s_2) - s_2))) - (let ((flat-s_0 - (to-syntax-list.1 - s_3))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-s_0) - flat-s_0)))))) - (let ((begin-for-syntax169_1 - begin-for-syntax169_0)) - (values - begin-for-syntax169_1 - e170_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-s_0)))) - (case-lambda - ((begin-for-syntax167_0 e168_0) - (values - #t - begin-for-syntax167_0 - e168_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 - begin-for-syntax167_0 - e168_0) - (let ((next-phase_0 - (add1 phase_0))) - (let ((next-ns_0 - (namespace->namespace-at-phase - ns_0 - next-phase_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - tl-ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prepare-env) - (void))) - (begin - (if quick-immediate?43_0 - (namespace-visit-available-modules! - ns_0) - (void)) - (begin - (namespace-visit-available-modules! - next-ns_0) - (let ((l_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((s_1 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - tl-ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next) - (void))) - (loop_0 - combine40_0 - ctx_0 - just-once?42_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - wrap41_0 - s_1 - next-phase_0 - next-ns_0 - #f)) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - e168_0)))))) - (if wrap41_0 - (let ((new-s_0 - (|#%app| - wrap41_0 - begin-for-syntax167_0 - exp-s_0 - l_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - tl-ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'return - new-s_0) - (void))) - new-s_0)) - (if combine40_0 - (apply append l_0) - (void)))))))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (|#%app| - single39_0 - exp-s_0 + (let ((app_10 + (expand-context/outer-current-introduction-scopes + tl-ctx_0))) + (let ((app_11 + (expand-context/outer-current-use-scopes + tl-ctx_0))) + (expand-context/outer1.1 + inner157_0 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + #t + app_9 + app_10 + app_11 + (expand-context/outer-name + tl-ctx_0))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + tl-ctx_0)))) + (case-lambda + ((require-lifts_0 lifts_0 exp-s_0) + (let ((disarmed-exp-s_0 + (syntax-disarm$1 exp-s_0))) + (if (let ((or-part_0 (pair? require-lifts_0))) + (if or-part_0 or-part_0 (pair? lifts_0))) + (let ((new-s_0 + (let ((temp160_0 + (append + require-lifts_0 + lifts_0))) + (wrap-lifts-as-begin.1 + unsafe-undefined + unsafe-undefined + temp160_0 + exp-s_0 + phase_1)))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + tl-ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'lift-loop + new-s_0) + (void))) + (if just-once?42_0 + new-s_0 + (loop_0 + new-s_0 + phase_1 ns_0 - as-tail?_0))))))))) - (args - (raise-binding-result-arity-error 3 args)))))))))))) - (|#%name| - per-top-level - (lambda (combine40_0 - just-once?42_0 - observer45_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - wrap41_0 - given-s53_0 - ns54_0) - (begin - (let ((s_0 (maybe-intro given-s53_0 ns54_0))) - (let ((ctx_0 - (make-expand-context.1 #f observer45_0 #f #f #f ns54_0))) - (let ((phase_0 (namespace-phase ns54_0))) - (loop_0 - combine40_0 - ctx_0 - just-once?42_0 - quick-immediate?43_0 - serializable?44_0 - single39_0 - wrap41_0 - s_0 - phase_0 - ns54_0 - #t))))))))) + as-tail?_0)))) + (if (not single39_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + tl-ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'return + exp-s_0) + (void))) + exp-s_0) + (if (if just-once?42_0 + (not (eq? exp-s_0 wb-s_0)) + #f) + exp-s_0 + (let ((tmp_0 + (core-form-sym + disarmed-exp-s_0 + phase_1))) + (if (eq? tmp_0 'begin) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-begin + disarmed-exp-s_0) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_2 + (if (syntax?$1 + disarmed-exp-s_0) + (syntax-e$1 + disarmed-exp-s_0) + disarmed-exp-s_0))) + (if (pair? s_2) + (let ((begin165_0 + (let ((s_3 + (car s_2))) + s_3))) + (let ((e166_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-s_0) + flat-s_0)))))) + (let ((begin165_1 + begin165_0)) + (values + begin165_1 + e166_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-s_0)))) + (case-lambda + ((begin163_0 e164_0) + (values + #t + begin163_0 + e164_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 begin163_0 e164_0) + (letrec* + ((begin-loop_0 + (|#%name| + begin-loop + (lambda (es_0) + (begin + (if (null? es_0) + (if combine40_0 + null + (void)) + (if (if (not + combine40_0) + (null? + (cdr es_0)) + #f) + (loop_0 + (car es_0) + phase_1 + ns_0 + as-tail?_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + tl-ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next) + (void))) + (let ((a_0 + (if combine40_0 + (loop_0 + (car + es_0) + phase_1 + ns_0 + #f) + (begin + (loop_0 + (car + es_0) + phase_1 + ns_0 + #f) + (void))))) + (if combine40_0 + (|#%app| + combine40_0 + a_0 + (begin-loop_0 + (cdr es_0))) + (begin-loop_0 + (cdr + es_0)))))))))))) + (if wrap41_0 + (let ((new-s_0 + (|#%app| + wrap41_0 + begin163_0 + exp-s_0 + (begin-loop_0 + e164_0)))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + tl-ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'return + new-s_0) + (void))) + new-s_0)) + (begin-loop_0 e164_0)))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (if (eq? tmp_0 'begin-for-syntax) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + tl-ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-begin-for-syntax + disarmed-exp-s_0) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_2 + (if (syntax?$1 + disarmed-exp-s_0) + (syntax-e$1 + disarmed-exp-s_0) + disarmed-exp-s_0))) + (if (pair? s_2) + (let ((begin-for-syntax169_0 + (let ((s_3 + (car + s_2))) + s_3))) + (let ((e170_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-s_0) + flat-s_0)))))) + (let ((begin-for-syntax169_1 + begin-for-syntax169_0)) + (values + begin-for-syntax169_1 + e170_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-s_0)))) + (case-lambda + ((begin-for-syntax167_0 + e168_0) + (values + #t + begin-for-syntax167_0 + e168_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + begin-for-syntax167_0 + e168_0) + (let ((next-phase_0 + (add1 phase_1))) + (let ((next-ns_0 + (namespace->namespace-at-phase + ns_0 + next-phase_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + tl-ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prepare-env) + (void))) + (begin + (if quick-immediate?43_0 + (namespace-visit-available-modules! + ns_0) + (void)) + (begin + (namespace-visit-available-modules! + next-ns_0) + (let ((l_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((s_2 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + tl-ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next) + (void))) + (loop_0 + s_2 + next-phase_0 + next-ns_0 + #f)) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + e168_0)))))) + (if wrap41_0 + (let ((new-s_0 + (|#%app| + wrap41_0 + begin-for-syntax167_0 + exp-s_0 + l_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + tl-ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'return + new-s_0) + (void))) + new-s_0)) + (if combine40_0 + (apply + append + l_0) + (void)))))))))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (|#%app| + single39_0 + exp-s_0 + ns_0 + as-tail?_0))))))))) + (args + (raise-binding-result-arity-error + 3 + args)))))))))))) + (loop_0 s_0 phase_0 ns54_0 #t))))))))) (define maybe-intro (lambda (s_0 ns_0) (if (syntax?$1 s_0) @@ -59555,7 +58985,7 @@ 'current-library-collection-paths "(listof (and/c path-string? complete-path?))" l_0)) - (map_2960 to-path l_0))) + (map_1346 to-path l_0))) 'current-library-collection-paths)) (define 1/current-library-collection-links (make-parameter @@ -59630,7 +59060,7 @@ " (hash/c (or/c (and/c symbol? module-path?) #f)\n" " (listof (and/c path-string? complete-path?)))))") l_0)) - (map_2960 + (map_1346 (lambda (p_0) (if (not p_0) #f @@ -59685,24 +59115,26 @@ 'use-compiled-file-paths "(listof (and/c path-string? relative-path?))" l_0)) - (map_2960 to-path l_0))) + (map_1346 to-path l_0))) 'use-compiled-file-paths)) (define 1/current-compiled-file-roots (make-parameter '(same) - (letrec ((procz1 - (lambda (p_0) - (let ((or-part_0 (path-string? p_0))) - (if or-part_0 or-part_0 (eq? p_0 'same)))))) - (lambda (l_0) - (begin - (if (if (list? l_0) (andmap_2344 procz1 l_0) #f) - (void) - (raise-argument-error - 'current-compiled-file-roots - "(listof (or/c path-string? 'same))" - l_0)) - (map_2960 to-path l_0)))) + (lambda (l_0) + (begin + (if (if (list? l_0) + (andmap_2344 + (lambda (p_0) + (let ((or-part_0 (path-string? p_0))) + (if or-part_0 or-part_0 (eq? p_0 'same)))) + l_0) + #f) + (void) + (raise-argument-error + 'current-compiled-file-roots + "(listof (or/c path-string? 'same))" + l_0)) + (map_1346 to-path l_0))) 'current-compiled-file-roots)) (define 1/use-compiled-file-check (make-parameter @@ -60343,42 +59775,44 @@ (embedded-load_0 start_0 end_0 bstr_0 as-predefined?_0 in-path1_0))))) (define ->path (lambda (s_0) (if (string? s_0) (string->path s_0) s_0))) (define find-main-collects - (letrec ((procz1 - (lambda () - (exe-relative-path->complete-path - (find-system-path 'collects-dir))))) - (lambda () (cache-configuration 0 procz1)))) + (lambda () + (cache-configuration + 0 + (lambda () + (exe-relative-path->complete-path (find-system-path 'collects-dir)))))) (define find-main-config - (letrec ((procz1 - (lambda () - (exe-relative-path->complete-path - (find-system-path 'config-dir))))) - (lambda () (cache-configuration 1 procz1)))) + (lambda () + (cache-configuration + 1 + (lambda () + (exe-relative-path->complete-path (find-system-path 'config-dir)))))) (define exe-relative-path->complete-path - (letrec ((procz1 - (lambda () - (let ((app_0 - (find-executable-path (find-system-path 'exec-file)))) - (path->complete-path app_0 (find-system-path 'orig-dir)))))) - (lambda (collects-path_0) - (if (complete-path? collects-path_0) - (simplify-path collects-path_0) - (if (absolute-path? collects-path_0) - (let ((exec_0 (call-in-original-directory procz1))) - (call-with-values - (lambda () (split-path exec_0)) - (case-lambda - ((base_0 name_0 dir?_0) - (simplify-path (path->complete-path collects-path_0 base_0))) - (args (raise-binding-result-arity-error 3 args))))) - (let ((p_0 - (call-in-original-directory - (lambda () - (find-executable-path - (find-system-path 'exec-file) - collects-path_0 - #t))))) - (if p_0 (simplify-path p_0) #f))))))) + (lambda (collects-path_0) + (if (complete-path? collects-path_0) + (simplify-path collects-path_0) + (if (absolute-path? collects-path_0) + (let ((exec_0 + (call-in-original-directory + (lambda () + (let ((app_0 + (find-executable-path (find-system-path 'exec-file)))) + (path->complete-path + app_0 + (find-system-path 'orig-dir))))))) + (call-with-values + (lambda () (split-path exec_0)) + (case-lambda + ((base_0 name_0 dir?_0) + (simplify-path (path->complete-path collects-path_0 base_0))) + (args (raise-binding-result-arity-error 3 args))))) + (let ((p_0 + (call-in-original-directory + (lambda () + (find-executable-path + (find-system-path 'exec-file) + collects-path_0 + #t))))) + (if p_0 (simplify-path p_0) #f)))))) (define call-in-original-directory (lambda (thunk_0) (with-continuation-mark* @@ -60428,69 +59862,67 @@ (define shadow-directory-place-init! (lambda () (unsafe-place-local-set! cell.1$2 (make-cache)))) (define lookup-shadow-directory - (letrec ((procz1 (lambda () #f))) - (lambda (orig_0) - (let ((sd_0 - (call-as-atomic - (lambda () - (hash-ref (unsafe-place-local-ref cell.1$2) orig_0 #f))))) - (if sd_0 - (if (sync/timeout 0 (shadow-directory-evt sd_0)) - (begin - (call-as-atomic - (lambda () - (hash-remove! (unsafe-place-local-ref cell.1$2) orig_0))) - (lookup-shadow-directory orig_0)) - sd_0) - (let ((evt_0 (filesystem-change-evt orig_0 procz1))) - (if evt_0 - (let ((table_0 - (let ((lst_0 (directory-list orig_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 lst_1) - (begin - (if (pair? lst_1) - (let ((p_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (let ((table_1 - (if (directory-exists? - (build-path orig_0 p_0)) - (let ((table_1 - (call-with-values - (lambda () - (values - (normal-case-path - p_0) - #t)) - (case-lambda - ((key_0 val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)) - table_0))) - (for-loop_0 table_1 rest_0)))) - table_0)))))) - (for-loop_0 hash2725 lst_0)))))) - (let ((sd_1 (shadow-directory1.1 evt_0 table_0))) - (begin - (call-as-atomic - (lambda () - (hash-set! - (unsafe-place-local-ref cell.1$2) - orig_0 - sd_1))) - sd_1))) - #f))))))) + (lambda (orig_0) + (let ((sd_0 + (call-as-atomic + (lambda () + (hash-ref (unsafe-place-local-ref cell.1$2) orig_0 #f))))) + (if sd_0 + (if (sync/timeout 0 (shadow-directory-evt sd_0)) + (begin + (call-as-atomic + (lambda () + (hash-remove! (unsafe-place-local-ref cell.1$2) orig_0))) + (lookup-shadow-directory orig_0)) + sd_0) + (let ((evt_0 (filesystem-change-evt orig_0 (lambda () #f)))) + (if evt_0 + (let ((table_0 + (let ((lst_0 (directory-list orig_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 lst_1) + (begin + (if (pair? lst_1) + (let ((p_0 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (let ((table_1 + (if (directory-exists? + (build-path orig_0 p_0)) + (let ((table_1 + (call-with-values + (lambda () + (values + (normal-case-path p_0) + #t)) + (case-lambda + ((key_0 val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)) + table_0))) + (for-loop_0 table_1 rest_0)))) + table_0)))))) + (for-loop_0 hash2725 lst_0)))))) + (let ((sd_1 (shadow-directory1.1 evt_0 table_0))) + (begin + (call-as-atomic + (lambda () + (hash-set! + (unsafe-place-local-ref cell.1$2) + orig_0 + sd_1))) + sd_1))) + #f)))))) (define directory-exists?/shadow-filesystem (lambda (p_0 orig_0 subpath_0) (if (not (unsafe-place-local-ref cell.1$2)) @@ -60558,24 +59990,24 @@ file-name_0 check-compiled?_0)))))) (define get-config-table - (letrec ((procz1 - (|#%name| - temp6 - (lambda () - (begin - (let ((v_0 - (call-with-default-reading-parameterization 1/read))) - (if (hash? v_0) v_0 #f))))))) - (lambda (d_0) - (let ((p_0 (if d_0 (build-path d_0 "config.rktd") #f))) - (let ((or-part_0 - (if p_0 - (if (file-exists? p_0) - (let ((temp6_0 procz1)) - (with-input-from-file.1 'binary p_0 temp6_0)) - #f) - #f))) - (if or-part_0 or-part_0 hash2725)))))) + (lambda (d_0) + (let ((p_0 (if d_0 (build-path d_0 "config.rktd") #f))) + (let ((or-part_0 + (if p_0 + (if (file-exists? p_0) + (let ((temp6_0 + (|#%name| + temp6 + (lambda () + (begin + (let ((v_0 + (call-with-default-reading-parameterization + 1/read))) + (if (hash? v_0) v_0 #f))))))) + (with-input-from-file.1 'binary p_0 temp6_0)) + #f) + #f))) + (if or-part_0 or-part_0 hash2725))))) (define get-installation-name (lambda (config-table_0) (hash-ref config-table_0 'installation-name (version)))) @@ -60595,20 +60027,23 @@ (let ((or-part_0 (find-main-collects))) (if or-part_0 or-part_0 (current-directory))))))) (define add-config-search - (letrec ((loop_0 - (|#%name| - loop - (lambda (orig-l_0 l_0) - (begin - (if (null? l_0) - null - (if (not (car l_0)) - (append orig-l_0 (loop_0 orig-l_0 (cdr l_0))) - (let ((app_0 (coerce-to-path (car l_0)))) - (cons app_0 (loop_0 orig-l_0 (cdr l_0))))))))))) - (lambda (ht_0 key_0 orig-l_0) - (let ((l_0 (hash-ref ht_0 key_0 #f))) - (if l_0 (loop_0 orig-l_0 l_0) orig-l_0))))) + (lambda (ht_0 key_0 orig-l_0) + (let ((l_0 (hash-ref ht_0 key_0 #f))) + (if l_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1) + (begin + (if (null? l_1) + null + (if (not (car l_1)) + (append orig-l_0 (loop_0 (cdr l_1))) + (let ((app_0 (coerce-to-path (car l_1)))) + (cons app_0 (loop_0 (cdr l_1))))))))))) + (loop_0 l_0)) + orig-l_0)))) (define 1/find-library-collection-links (|#%name| find-library-collection-links @@ -60646,155 +60081,128 @@ (lambda () (unsafe-place-local-set! cell.1$1 (make-weak-hash)))) (define stamp-prompt-tag (make-continuation-prompt-tag 'stamp)) (define file->stamp - (letrec ((procz4 (lambda () #f)) - (procz3 (lambda () #f)) - (procz2 - (lambda (exn_0) - (abort-current-continuation - stamp-prompt-tag - (if (exn:fail:filesystem? exn_0) - procz1 - (lambda () (raise exn_0)))))) - (procz1 (lambda () #f))) - (lambda (path_0 old-stamp_0) - (if (if old-stamp_0 - (if (cdr old-stamp_0) (not (sync/timeout 0 (cdr old-stamp_0))) #f) - #f) - old-stamp_0 - (call-with-continuation-prompt - (lambda () - (call-with-exception-handler - procz2 - (lambda () - (let ((dir-evt_0 - (if (vector-ref (system-type 'fs-change) 2) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (path_1) - (begin - (call-with-values - (lambda () (split-path path_1)) - (case-lambda - ((base_0 name_0 dir?_0) - (if (path? base_0) - (if (directory-exists? base_0) - (filesystem-change-evt base_0 procz3) - (loop_0 base_0)) - #f)) - (args - (raise-binding-result-arity-error - 3 - args))))))))) - (loop_0 path_0)) - #f))) - (if (not (file-exists? path_0)) - (cons #f dir-evt_0) - (let ((evt_0 - (if (vector-ref (system-type 'fs-change) 2) - (filesystem-change-evt path_0 procz4) - #f))) - (begin - (if dir-evt_0 - (filesystem-change-evt-cancel dir-evt_0) - (void)) - (cons (file->bytes path_0) evt_0)))))))) - stamp-prompt-tag))))) + (lambda (path_0 old-stamp_0) + (if (if old-stamp_0 + (if (cdr old-stamp_0) (not (sync/timeout 0 (cdr old-stamp_0))) #f) + #f) + old-stamp_0 + (call-with-continuation-prompt + (lambda () + (call-with-exception-handler + (lambda (exn_0) + (abort-current-continuation + stamp-prompt-tag + (if (exn:fail:filesystem? exn_0) + (lambda () #f) + (lambda () (raise exn_0))))) + (lambda () + (let ((dir-evt_0 + (if (vector-ref (system-type 'fs-change) 2) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (path_1) + (begin + (call-with-values + (lambda () (split-path path_1)) + (case-lambda + ((base_0 name_0 dir?_0) + (if (path? base_0) + (if (directory-exists? base_0) + (filesystem-change-evt + base_0 + (lambda () #f)) + (loop_0 base_0)) + #f)) + (args + (raise-binding-result-arity-error + 3 + args))))))))) + (loop_0 path_0)) + #f))) + (if (not (file-exists? path_0)) + (cons #f dir-evt_0) + (let ((evt_0 + (if (vector-ref (system-type 'fs-change) 2) + (filesystem-change-evt path_0 (lambda () #f)) + #f))) + (begin + (if dir-evt_0 + (filesystem-change-evt-cancel dir-evt_0) + (void)) + (cons (file->bytes path_0) evt_0)))))))) + stamp-prompt-tag)))) (define file->bytes - (letrec ((loop_0 - (|#%name| - loop - (lambda (p_0) - (begin - (let ((bstr_0 (read-bytes 8192 p_0))) - (if (eof-object? bstr_0) - null - (cons bstr_0 (loop_0 p_0))))))))) - (lambda (path_0) - (let ((temp8_0 - (|#%name| - temp8 - (lambda (p_0) - (begin - (let ((bstr_0 (read-bytes 8192 p_0))) - (if (if (bytes? bstr_0) - (>= (unsafe-bytes-length bstr_0) 8192) - #f) - (apply bytes-append (cons bstr_0 (loop_0 p_0))) - bstr_0))))))) - (call-with-input-file*.1 'binary path_0 temp8_0))))) + (lambda (path_0) + (let ((temp8_0 + (|#%name| + temp8 + (lambda (p_0) + (begin + (let ((bstr_0 (read-bytes 8192 p_0))) + (if (if (bytes? bstr_0) + (>= (unsafe-bytes-length bstr_0) 8192) + #f) + (apply + bytes-append + (cons + bstr_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda () + (begin + (let ((bstr_1 (read-bytes 8192 p_0))) + (if (eof-object? bstr_1) + null + (cons bstr_1 (loop_0))))))))) + (loop_0)))) + bstr_0))))))) + (call-with-input-file*.1 'binary path_0 temp8_0)))) (define no-file-stamp? (lambda (a_0) (let ((or-part_0 (not a_0))) (if or-part_0 or-part_0 (not (car a_0)))))) (define get-linked-collections - (letrec ((procz2 - (lambda (p_0) - (if (list? p_0) - (if (let ((or-part_0 (= 2 (length p_0)))) - (if or-part_0 or-part_0 (= 3 (length p_0)))) - (if (let ((or-part_0 (string? (car p_0)))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (eq? 'root (car p_0)))) - (if or-part_1 - or-part_1 - (eq? 'static-root (car p_0)))))) - (if (path-string? (cadr p_0)) - (let ((or-part_0 (null? (cddr p_0)))) - (if or-part_0 or-part_0 (regexp? (caddr p_0)))) - #f) - #f) - #f) - #f))) - (procz1 - (|#%name| - temp10 - (lambda (p_0) - (begin - (begin0 - (1/read p_0) - (if (eof-object? (1/read p_0)) - (void) - (error "expected a single S-expression"))))))) - (make-handler_0 - (|#%name| - make-handler - (lambda (esc_0 links-path_0 ts_0) - (begin - (lambda (exn_0) - (begin - (if (exn:fail? exn_0) - (let ((l_0 (current-logger))) - (if (log-level? l_0 'error) - (let ((app_0 - (format - "error reading collection links file ~s: ~a" - links-path_0 - (exn-message exn_0)))) - (log-message - l_0 - 'error - app_0 - (current-continuation-marks))) - (void))) - (void)) - (if ts_0 - (call-as-atomic - (lambda () - (hash-set! - (unsafe-place-local-ref cell.1$1) - links-path_0 - (cons ts_0 hash2610)))) - (void)) - (if (exn:fail? exn_0) - (|#%app| esc_0 (make-hasheq)) - exn_0)))))))) - (lambda (links-path_0) - (call-with-escape-continuation - (lambda (esc_0) + (lambda (links-path_0) + (call-with-escape-continuation + (lambda (esc_0) + (let ((make-handler_0 + (|#%name| + make-handler + (lambda (ts_0) + (begin + (lambda (exn_0) + (begin + (if (exn:fail? exn_0) + (let ((l_0 (current-logger))) + (if (log-level? l_0 'error) + (let ((app_0 + (format + "error reading collection links file ~s: ~a" + links-path_0 + (exn-message exn_0)))) + (log-message + l_0 + 'error + app_0 + (current-continuation-marks))) + (void))) + (void)) + (if ts_0 + (call-as-atomic + (lambda () + (hash-set! + (unsafe-place-local-ref cell.1$1) + links-path_0 + (cons ts_0 hash2610)))) + (void)) + (if (exn:fail? exn_0) + (|#%app| esc_0 (make-hasheq)) + exn_0)))))))) (call-with-exception-handler - (make-handler_0 esc_0 links-path_0 #f) + (make-handler_0 #f) (lambda () (let ((links-stamp+cache_0 (call-as-atomic @@ -60808,20 +60216,63 @@ (if (equal? ts_0 a-links-stamp_0) (cdr links-stamp+cache_0) (call-with-exception-handler - (make-handler_0 esc_0 links-path_0 ts_0) + (make-handler_0 ts_0) (lambda () (call-with-default-reading-parameterization (lambda () (let ((v_0 (if (no-file-stamp? ts_0) null - (let ((temp10_0 procz1)) + (let ((temp10_0 + (|#%name| + temp10 + (lambda (p_0) + (begin + (begin0 + (1/read p_0) + (if (eof-object? (1/read p_0)) + (void) + (error + "expected a single S-expression")))))))) (call-with-input-file*.1 'binary links-path_0 temp10_0))))) (begin - (if (if (list? v_0) (andmap_2344 procz2 v_0) #f) + (if (if (list? v_0) + (andmap_2344 + (lambda (p_0) + (if (list? p_0) + (if (let ((or-part_0 + (= 2 (length p_0)))) + (if or-part_0 + or-part_0 + (= 3 (length p_0)))) + (if (let ((or-part_0 + (string? (car p_0)))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (eq? + 'root + (car p_0)))) + (if or-part_1 + or-part_1 + (eq? + 'static-root + (car p_0)))))) + (if (path-string? (cadr p_0)) + (let ((or-part_0 + (null? (cddr p_0)))) + (if or-part_0 + or-part_0 + (regexp? (caddr p_0)))) + #f) + #f) + #f) + #f)) + v_0) + #f) (void) (error "ill-formed content")) (let ((ht_0 (make-hasheq))) @@ -60930,208 +60381,234 @@ (cons name_0 collection-path_0)))) (args (raise-binding-result-arity-error 3 args))))))) (define find-col-file - (letrec ((procz2 (lambda (p_0) (format "\n ~a" (unbox p_0)))) - (procz1 (lambda (p_0) (format "\n ~a ~a" " " p_0))) - (*build-path-rep_0 - (|#%name| - *build-path-rep - (lambda (p_0 c_0) - (begin (if (path? p_0) (build-path p_0 c_0) (unbox p_0)))))) - (*directory-exists?_0 - (|#%name| - *directory-exists? - (lambda (orig_0 collection_0 p_0) - (begin - (if (path? orig_0) - (directory-exists?/shadow-filesystem - p_0 - orig_0 - collection_0) - #t))))) - (done_0 - (|#%name| - done - (lambda (file-name_0 p_0) - (begin (if file-name_0 (build-path p_0 file-name_0) p_0))))) - (filter_0 - (|#%name| - filter - (lambda (f_0 l_0) - (begin - (if (null? l_0) - null - (if (|#%app| f_0 (car l_0)) - (let ((app_0 (car l_0))) - (cons app_0 (filter_0 f_0 (cdr l_0)))) - (filter_0 f_0 (cdr l_0)))))))) - (loop_0 - (|#%name| - loop - (lambda (sym_0 l_0) - (begin - (if (null? l_0) - null - (if (not (car l_0)) - (let ((app_0 (1/current-library-collection-paths))) - (append app_0 (loop_0 sym_0 (cdr l_0)))) - (if (hash? (car l_0)) - (let ((app_0 - (map_2960 box (hash-ref (car l_0) sym_0 null)))) - (let ((app_1 (hash-ref (car l_0) #f null))) - (append app_0 app_1 (loop_0 sym_0 (cdr l_0))))) - (let ((ht_0 (get-linked-collections (car l_0)))) - (let ((app_0 (hash-ref ht_0 sym_0 null))) - (let ((app_1 (hash-ref ht_0 #f null))) - (append - app_0 - app_1 - (loop_0 sym_0 (cdr l_0))))))))))))) - (loop_1 - (|#%name| - loop - (lambda (cp_0) - (begin - (if (null? (cdr cp_0)) - (list (to-string_0 (car cp_0))) - (let ((app_0 (to-string_0 (car cp_0)))) - (list* app_0 "/" (loop_1 (cdr cp_0))))))))) - (to-string_0 - (|#%name| - to-string - (lambda (p_0) (begin (if (path? p_0) (path->string p_0) p_0)))))) - (lambda (fail_0 - collection-in_0 - collection-path-in_0 - file-name_0 - check-compiled?_0) - (call-with-values - (lambda () - (normalize-collection-reference collection-in_0 collection-path-in_0)) - (case-lambda - ((collection_0 collection-path_0) - (let ((all-paths_0 - (let ((sym_0 - (string->symbol - (if (path? collection_0) - (path->string collection_0) - collection_0)))) - (loop_0 sym_0 (1/current-library-collection-links))))) - (letrec* - ((cloop_0 - (|#%name| - cloop - (lambda (paths_0 found-col_0) - (begin - (if (null? paths_0) - (if found-col_0 - (done_0 file-name_0 found-col_0) - (let ((rest-coll_0 - (if (null? collection-path_0) - "" - (apply - string-append - (loop_1 collection-path_0))))) - (|#%app| - fail_0 - (let ((app_0 - (if (null? collection-path_0) - (to-string_0 collection_0) - (string-append - (to-string_0 collection_0) - "/" - rest-coll_0)))) - (let ((app_1 - (apply - string-append - (map_2960 - procz1 - (let ((len_0 (length all-paths_0))) - (let ((clen_0 - (length - (1/current-library-collection-paths)))) - (let ((len_1 len_0)) - (if (< (- len_1 clen_0) 5) - all-paths_0 - (let ((app_1 - (1/current-library-collection-paths))) - (append - app_1 - (list - (format - "... [~a additional linked and package directories]" - (- len_1 clen_0))))))))))))) - (format - "collection not found\n collection: ~s\n in collection directories:~a~a" - app_0 - app_1 - (if (ormap_2765 box? all-paths_0) - (format - "\n sub-collection: ~s\n in parent directories:~a" - rest-coll_0 - (apply - string-append - (map_2960 - procz2 - (filter_0 box? all-paths_0)))) - ""))))))) - (let ((dir_0 - (*build-path-rep_0 (car paths_0) collection_0))) - (if (*directory-exists?_0 - (car paths_0) - collection_0 - dir_0) - (let ((cpath_0 - (apply build-path dir_0 collection-path_0))) - (if (if (null? collection-path_0) - #t - (directory-exists? cpath_0)) - (if file-name_0 - (if (let ((or-part_0 - (file-exists?/maybe-compiled - cpath_0 - file-name_0 - check-compiled?_0))) - (if or-part_0 - or-part_0 - (let ((alt-file-name_0 - (let ((file-name_1 - (if (path? file-name_0) - (path->string - file-name_0) - file-name_0))) - (let ((len_0 - (string-length - file-name_1))) - (if (>= len_0 4) - (if (string=? - ".rkt" - (substring - file-name_1 - (- len_0 4))) - (string-append - (substring - file-name_1 - 0 - (- len_0 4)) - ".ss") - #f) - #f))))) - (if alt-file-name_0 - (file-exists?/maybe-compiled - cpath_0 - alt-file-name_0 - check-compiled?_0) - #f)))) - (done_0 file-name_0 cpath_0) - (let ((app_0 (cdr paths_0))) - (cloop_0 - app_0 - (if found-col_0 found-col_0 cpath_0)))) - (done_0 file-name_0 cpath_0)) - (cloop_0 (cdr paths_0) found-col_0))) - (cloop_0 (cdr paths_0) found-col_0))))))))) - (cloop_0 all-paths_0 #f)))) - (args (raise-binding-result-arity-error 2 args))))))) + (lambda (fail_0 + collection-in_0 + collection-path-in_0 + file-name_0 + check-compiled?_0) + (call-with-values + (lambda () + (normalize-collection-reference collection-in_0 collection-path-in_0)) + (case-lambda + ((collection_0 collection-path_0) + (let ((all-paths_0 + (let ((sym_0 + (string->symbol + (if (path? collection_0) + (path->string collection_0) + collection_0)))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_0) + (begin + (if (null? l_0) + null + (if (not (car l_0)) + (let ((app_0 (1/current-library-collection-paths))) + (append app_0 (loop_0 (cdr l_0)))) + (if (hash? (car l_0)) + (let ((app_0 + (map_1346 + box + (hash-ref (car l_0) sym_0 null)))) + (let ((app_1 (hash-ref (car l_0) #f null))) + (append app_0 app_1 (loop_0 (cdr l_0))))) + (let ((ht_0 (get-linked-collections (car l_0)))) + (let ((app_0 (hash-ref ht_0 sym_0 null))) + (let ((app_1 (hash-ref ht_0 #f null))) + (append + app_0 + app_1 + (loop_0 (cdr l_0)))))))))))))) + (loop_0 (1/current-library-collection-links)))))) + (let ((done_0 + (|#%name| + done + (lambda (p_0) + (begin + (if file-name_0 (build-path p_0 file-name_0) p_0)))))) + (let ((*build-path-rep_0 + (|#%name| + *build-path-rep + (lambda (p_0 c_0) + (begin + (if (path? p_0) (build-path p_0 c_0) (unbox p_0))))))) + (let ((*directory-exists?_0 + (|#%name| + *directory-exists? + (lambda (orig_0 collection_1 p_0) + (begin + (if (path? orig_0) + (directory-exists?/shadow-filesystem + p_0 + orig_0 + collection_1) + #t)))))) + (let ((to-string_0 + (|#%name| + to-string + (lambda (p_0) + (begin (if (path? p_0) (path->string p_0) p_0)))))) + (letrec* + ((cloop_0 + (|#%name| + cloop + (lambda (paths_0 found-col_0) + (begin + (if (null? paths_0) + (if found-col_0 + (done_0 found-col_0) + (let ((rest-coll_0 + (if (null? collection-path_0) + "" + (apply + string-append + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (cp_0) + (begin + (if (null? (cdr cp_0)) + (list + (to-string_0 (car cp_0))) + (let ((app_0 + (to-string_0 + (car cp_0)))) + (list* + app_0 + "/" + (loop_0 (cdr cp_0)))))))))) + (loop_0 collection-path_0)))))) + (letrec* + ((filter_0 + (|#%name| + filter + (lambda (f_0 l_0) + (begin + (if (null? l_0) + null + (if (|#%app| f_0 (car l_0)) + (let ((app_0 (car l_0))) + (cons + app_0 + (filter_0 f_0 (cdr l_0)))) + (filter_0 f_0 (cdr l_0))))))))) + (|#%app| + fail_0 + (let ((app_0 + (if (null? collection-path_0) + (to-string_0 collection_0) + (string-append + (to-string_0 collection_0) + "/" + rest-coll_0)))) + (let ((app_1 + (apply + string-append + (map_1346 + (lambda (p_0) + (format "\n ~a ~a" " " p_0)) + (let ((len_0 (length all-paths_0))) + (let ((clen_0 + (length + (1/current-library-collection-paths)))) + (let ((len_1 len_0)) + (if (< (- len_1 clen_0) 5) + all-paths_0 + (let ((app_1 + (1/current-library-collection-paths))) + (append + app_1 + (list + (format + "... [~a additional linked and package directories]" + (- + len_1 + clen_0))))))))))))) + (format + "collection not found\n collection: ~s\n in collection directories:~a~a" + app_0 + app_1 + (if (ormap_2765 box? all-paths_0) + (format + "\n sub-collection: ~s\n in parent directories:~a" + rest-coll_0 + (apply + string-append + (map_1346 + (lambda (p_0) + (format "\n ~a" (unbox p_0))) + (filter_0 box? all-paths_0)))) + "")))))))) + (let ((dir_0 + (*build-path-rep_0 + (car paths_0) + collection_0))) + (if (*directory-exists?_0 + (car paths_0) + collection_0 + dir_0) + (let ((cpath_0 + (apply + build-path + dir_0 + collection-path_0))) + (if (if (null? collection-path_0) + #t + (directory-exists? cpath_0)) + (if file-name_0 + (if (let ((or-part_0 + (file-exists?/maybe-compiled + cpath_0 + file-name_0 + check-compiled?_0))) + (if or-part_0 + or-part_0 + (let ((alt-file-name_0 + (let ((file-name_1 + (if (path? + file-name_0) + (path->string + file-name_0) + file-name_0))) + (let ((len_0 + (string-length + file-name_1))) + (if (>= len_0 4) + (if (string=? + ".rkt" + (substring + file-name_1 + (- len_0 4))) + (string-append + (substring + file-name_1 + 0 + (- len_0 4)) + ".ss") + #f) + #f))))) + (if alt-file-name_0 + (file-exists?/maybe-compiled + cpath_0 + alt-file-name_0 + check-compiled?_0) + #f)))) + (done_0 cpath_0) + (let ((app_0 (cdr paths_0))) + (cloop_0 + app_0 + (if found-col_0 + found-col_0 + cpath_0)))) + (done_0 cpath_0)) + (cloop_0 (cdr paths_0) found-col_0))) + (cloop_0 (cdr paths_0) found-col_0))))))))) + (cloop_0 all-paths_0 #f)))))))) + (args (raise-binding-result-arity-error 2 args)))))) (define file-exists?/maybe-compiled (lambda (dir_0 path_0 check-compiled?_0) (let ((or-part_0 (file-exists? (build-path dir_0 path_0)))) @@ -61167,69 +60644,66 @@ #f))))) (define 1/find-library-collection-paths (let ((find-library-collection-paths_0 - (letrec ((procz1 - (|#%name| - cons-if - (lambda (f_0 r_0) (begin (if f_0 (cons f_0 r_0) r_0))))) - (loop_0 - (|#%name| - loop - (lambda (l_0) - (begin - (if (null? l_0) - null - (let ((collects-path_0 (car l_0))) - (let ((v_0 - (exe-relative-path->complete-path - collects-path_0))) - (if v_0 - (let ((app_0 - (simplify-path - (path->complete-path - v_0 - (current-directory))))) - (cons app_0 (loop_0 (cdr l_0)))) - (loop_0 (cdr l_0))))))))))) - (|#%name| - find-library-collection-paths - (lambda (extra-collects-dirs1_0 post-collects-dirs2_0) - (begin - (let ((user-too?_0 (1/use-user-specific-search-paths))) - (let ((cons-if_0 procz1)) - (let ((config-table_0 - (get-config-table (find-main-config)))) - (let ((cons-if_1 cons-if_0) (user-too?_1 user-too?_0)) - (let ((app_0 - (if user-too?_1 - (let ((c_0 - (environment-variables-ref - (current-environment-variables) - #vu8(80 76 84 67 79 76 76 69 67 84 83)))) - (if c_0 - (bytes->string/locale c_0 '#\x3f) - "")) - ""))) - (path-list-string->path-list - app_0 - (add-config-search - config-table_0 - 'collects-search-dirs - (let ((app_1 - (if user-too?_1 - (let ((app_1 - (find-system-path 'addon-dir))) - (build-path - app_1 - (get-installation-name config-table_0) - "collects")) - #f))) - (cons-if_1 - app_1 - (loop_0 - (append - extra-collects-dirs1_0 - (list (find-system-path 'collects-dir)) - post-collects-dirs2_0))))))))))))))))) + (|#%name| + find-library-collection-paths + (lambda (extra-collects-dirs1_0 post-collects-dirs2_0) + (begin + (let ((user-too?_0 (1/use-user-specific-search-paths))) + (let ((cons-if_0 + (|#%name| + cons-if + (lambda (f_0 r_0) + (begin (if f_0 (cons f_0 r_0) r_0)))))) + (let ((config-table_0 (get-config-table (find-main-config)))) + (let ((cons-if_1 cons-if_0) (user-too?_1 user-too?_0)) + (let ((app_0 + (if user-too?_1 + (let ((c_0 + (environment-variables-ref + (current-environment-variables) + #vu8(80 76 84 67 79 76 76 69 67 84 83)))) + (if c_0 (bytes->string/locale c_0 '#\x3f) "")) + ""))) + (path-list-string->path-list + app_0 + (add-config-search + config-table_0 + 'collects-search-dirs + (let ((app_1 + (if user-too?_1 + (let ((app_1 (find-system-path 'addon-dir))) + (build-path + app_1 + (get-installation-name config-table_0) + "collects")) + #f))) + (cons-if_1 + app_1 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_0) + (begin + (if (null? l_0) + null + (let ((collects-path_0 (car l_0))) + (let ((v_0 + (exe-relative-path->complete-path + collects-path_0))) + (if v_0 + (let ((app_2 + (simplify-path + (path->complete-path + v_0 + (current-directory))))) + (cons app_2 (loop_0 (cdr l_0)))) + (loop_0 (cdr l_0))))))))))) + (loop_0 + (append + extra-collects-dirs1_0 + (list (find-system-path 'collects-dir)) + post-collects-dirs2_0))))))))))))))))) (|#%name| find-library-collection-paths (case-lambda @@ -61566,92 +61040,93 @@ (define current-read-config (lambda () (continuation-mark-set-first #f current-read-config #f root-tag))) (define make-read-config.1 - (letrec ((procz6 (lambda (for-syntax?_0 v_0) v_0)) - (procz5 (lambda (for-syntax?_0 v_0 srcloc_0) v_0)) - (procz4 - (lambda (mod-path_0) - (error 'read "no `module-declare?` provided"))) - (procz3 - (lambda (mod-path_0 sym_0 failure-k_0) - (error 'read "no `dynamic-require` provided"))) - (procz2 - (lambda (thunk_0) - (error 'read "no `call-with-root-namespace` provided"))) - (procz1 - (lambda (in_0) (error 'read "no `read-compiled` provided")))) - (|#%name| - make-read-config - (lambda (call-with-root-namespace10_0 - coerce13_0 - coerce-key14_0 - dynamic-require11_0 - for-syntax?5_0 - keep-comment?15_0 - module-declared?12_0 - next-readtable7_0 - read-compiled9_0 - readtable6_0 - source4_0 - wrap8_0) - (begin - (let ((readtable_0 - (if (eq? readtable6_0 unsafe-undefined) - (1/current-readtable) - readtable6_0))) - (let ((next-readtable_0 - (if (eq? next-readtable7_0 unsafe-undefined) - readtable_0 - next-readtable7_0))) - (let ((read-compiled_0 - (if read-compiled9_0 read-compiled9_0 procz1))) - (let ((call-with-root-namespace_0 - (if call-with-root-namespace10_0 - call-with-root-namespace10_0 - procz2))) - (let ((dynamic-require_0 - (if dynamic-require11_0 dynamic-require11_0 procz3))) - (let ((module-declared?_0 - (if module-declared?12_0 - module-declared?12_0 - procz4))) - (let ((coerce_0 (if coerce13_0 coerce13_0 procz5))) - (let ((coerce-key_0 - (if coerce-key14_0 coerce-key14_0 procz6))) - (let ((parameter-override_0 hash2610)) - (let ((parameter-cache_0 (make-hasheq))) - (let ((st_0 (read-config-state3.1 #f #f))) - (let ((parameter-cache_1 parameter-cache_0) - (parameter-override_1 - parameter-override_0) - (coerce-key_1 coerce-key_0) - (coerce_1 coerce_0) - (module-declared?_1 module-declared?_0) - (dynamic-require_1 dynamic-require_0) - (call-with-root-namespace_1 - call-with-root-namespace_0) - (read-compiled_1 read-compiled_0)) - (begin-unsafe - (read-config/outer1.1 - (read-config/inner2.1 - readtable_0 - next-readtable_0 - for-syntax?5_0 - source4_0 - read-compiled_1 - call-with-root-namespace_1 - dynamic-require_1 - module-declared?_1 - coerce_1 - coerce-key_1 - parameter-override_1 - parameter-cache_1 - st_0) - wrap8_0 - #f - #f - #f - null - keep-comment?15_0))))))))))))))))))) + (|#%name| + make-read-config + (lambda (call-with-root-namespace10_0 + coerce13_0 + coerce-key14_0 + dynamic-require11_0 + for-syntax?5_0 + keep-comment?15_0 + module-declared?12_0 + next-readtable7_0 + read-compiled9_0 + readtable6_0 + source4_0 + wrap8_0) + (begin + (let ((readtable_0 + (if (eq? readtable6_0 unsafe-undefined) + (1/current-readtable) + readtable6_0))) + (let ((next-readtable_0 + (if (eq? next-readtable7_0 unsafe-undefined) + readtable_0 + next-readtable7_0))) + (let ((read-compiled_0 + (if read-compiled9_0 + read-compiled9_0 + (lambda (in_0) + (error 'read "no `read-compiled` provided"))))) + (let ((call-with-root-namespace_0 + (if call-with-root-namespace10_0 + call-with-root-namespace10_0 + (lambda (thunk_0) + (error + 'read + "no `call-with-root-namespace` provided"))))) + (let ((dynamic-require_0 + (if dynamic-require11_0 + dynamic-require11_0 + (lambda (mod-path_0 sym_0 failure-k_0) + (error 'read "no `dynamic-require` provided"))))) + (let ((module-declared?_0 + (if module-declared?12_0 + module-declared?12_0 + (lambda (mod-path_0) + (error 'read "no `module-declare?` provided"))))) + (let ((coerce_0 + (if coerce13_0 + coerce13_0 + (lambda (for-syntax?_0 v_0 srcloc_0) v_0)))) + (let ((coerce-key_0 + (if coerce-key14_0 + coerce-key14_0 + (lambda (for-syntax?_0 v_0) v_0)))) + (let ((parameter-override_0 hash2610)) + (let ((parameter-cache_0 (make-hasheq))) + (let ((st_0 (read-config-state3.1 #f #f))) + (let ((parameter-cache_1 parameter-cache_0) + (parameter-override_1 parameter-override_0) + (coerce-key_1 coerce-key_0) + (coerce_1 coerce_0) + (module-declared?_1 module-declared?_0) + (dynamic-require_1 dynamic-require_0) + (call-with-root-namespace_1 + call-with-root-namespace_0) + (read-compiled_1 read-compiled_0)) + (begin-unsafe + (read-config/outer1.1 + (read-config/inner2.1 + readtable_0 + next-readtable_0 + for-syntax?5_0 + source4_0 + read-compiled_1 + call-with-root-namespace_1 + dynamic-require_1 + module-declared?_1 + coerce_1 + coerce-key_1 + parameter-override_1 + parameter-cache_1 + st_0) + wrap8_0 + #f + #f + #f + null + keep-comment?15_0)))))))))))))))))) (define read-config-update.1 (|#%name| read-config-update @@ -62160,22 +61635,32 @@ (define readtable-delimiter-ht (|#%name| readtable-delimiter-ht (record-accessor struct:readtable 3))) (define 1/make-readtable - (letrec ((loop_0 + (|#%name| + make-readtable + (lambda (rt_0 . args_0) + (begin + (begin + (if (let ((or-part_0 (not rt_0))) + (if or-part_0 or-part_0 (1/readtable? rt_0))) + (void) + (raise-argument-error 'make-readtable "(or/c readtable? #f)" rt_0)) + (letrec* + ((loop_0 (|#%name| loop - (lambda (args_0 + (lambda (args_1 symbol-parser_0 char-ht_0 dispatch-ht_0 delimiter-ht_0) (begin - (if (null? args_0) + (if (null? args_1) (readtable1.1 symbol-parser_0 char-ht_0 dispatch-ht_0 delimiter-ht_0) - (let ((key_0 (car args_0))) + (let ((key_0 (car args_1))) (begin (if (let ((or-part_0 (not key_0))) (if or-part_0 or-part_0 (char? key_0))) @@ -62185,7 +61670,7 @@ "(or/c char? #f)" key_0)) (begin - (if (null? (cdr args_0)) + (if (null? (cdr args_1)) (if key_0 (raise-arguments-error 'make-readtable @@ -62198,7 +61683,7 @@ 'make-readtable "expected 'non-terminating-macro after #f")) (void)) - (let ((mode_0 (cadr args_0))) + (let ((mode_0 (cadr args_1))) (begin (if key_0 (if (let ((or-part_0 @@ -62229,7 +61714,7 @@ 'make-readtable "expected 'non-terminating-macro after #f"))) (begin - (if (null? (cddr args_0)) + (if (null? (cddr args_1)) (raise-arguments-error 'make-readtable (if key_0 @@ -62238,8 +61723,8 @@ "given" mode_0) (void)) - (let ((target_0 (caddr args_0))) - (let ((rest-args_0 (cdddr args_0))) + (let ((target_0 (caddr args_1))) + (let ((rest-args_0 (cdddr args_1))) (if (not key_0) (begin (if (if (procedure? target_0) @@ -62360,27 +61845,15 @@ new-char-ht_0 dispatch-ht_0 new-delimiter-ht_0))))))))))))))))))))) - (|#%name| - make-readtable - (lambda (rt_0 . args_0) - (begin - (begin - (if (let ((or-part_0 (not rt_0))) - (if or-part_0 or-part_0 (1/readtable? rt_0))) - (void) - (raise-argument-error - 'make-readtable - "(or/c readtable? #f)" - rt_0)) - (let ((app_0 (if rt_0 (readtable-symbol-parser rt_0) #f))) - (let ((app_1 (if rt_0 (readtable-char-ht rt_0) hash2589))) - (let ((app_2 (if rt_0 (readtable-dispatch-ht rt_0) hash2589))) - (loop_0 - args_0 - app_0 - app_1 - app_2 - (if rt_0 (readtable-delimiter-ht rt_0) hash2589))))))))))) + (let ((app_0 (if rt_0 (readtable-symbol-parser rt_0) #f))) + (let ((app_1 (if rt_0 (readtable-char-ht rt_0) hash2589))) + (let ((app_2 (if rt_0 (readtable-dispatch-ht rt_0) hash2589))) + (loop_0 + args_0 + app_0 + app_1 + app_2 + (if rt_0 (readtable-delimiter-ht rt_0) hash2589))))))))))) (define *readtable-effective-char (lambda (rt_0 c_0) (let ((target_0 (hash-ref (readtable-char-ht rt_0) c_0 #f))) @@ -63001,31 +62474,33 @@ (define opener-name (lambda (c_0 config_0) (effective-char-names c_0 config_0 "opener"))) (define effective-char-names - (letrec ((loop_0 - (|#%name| - loop - (lambda (cs_0) - (begin - (if (null? (cdr cs_0)) - (list (format "or `~a`" (car cs_0))) - (let ((app_0 (format "`~a`, " (car cs_0)))) - (cons app_0 (loop_0 (cdr cs_0)))))))))) - (lambda (c_0 config_0 fallback-str_0) - (let ((rt_0 - (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner config_0))))) - (if (not rt_0) - (format "`~a`" c_0) - (let ((cs_0 (readtable-equivalent-chars rt_0 c_0))) - (if (null? cs_0) - fallback-str_0 - (if (null? (cdr cs_0)) - (format "`~a`" (car cs_0)) - (if (null? (cddr cs_0)) - (let ((app_0 (car cs_0))) - (format "`~a` or `~a`" app_0 (cadr cs_0))) - (apply string-append (loop_0 cs_0))))))))))) + (lambda (c_0 config_0 fallback-str_0) + (let ((rt_0 + (begin-unsafe + (read-config/inner-readtable (read-config/outer-inner config_0))))) + (if (not rt_0) + (format "`~a`" c_0) + (let ((cs_0 (readtable-equivalent-chars rt_0 c_0))) + (if (null? cs_0) + fallback-str_0 + (if (null? (cdr cs_0)) + (format "`~a`" (car cs_0)) + (if (null? (cddr cs_0)) + (let ((app_0 (car cs_0))) + (format "`~a` or `~a`" app_0 (cadr cs_0))) + (apply + string-append + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (cs_1) + (begin + (if (null? (cdr cs_1)) + (list (format "or `~a`" (car cs_1))) + (let ((app_0 (format "`~a`, " (car cs_1)))) + (cons app_0 (loop_0 (cdr cs_1)))))))))) + (loop_0 cs_0))))))))))) (define closer->opener (lambda (c_0) (if (eqv? c_0 '#\x29) @@ -63570,442 +63045,395 @@ c_0))))))) (string-append app_0 (indentation-possible-cause config_0)))))))) (define read-unwrapped-sequence.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (closer14_0 - config/keep-comment_0 - config_0 - dot-mode2_0 - head_0 - in15_0 - open-end-pos_0 - opener-c12_0 - read-one11_0 - seq-config16_0 - whitespace-read-one_0 - depth_0 - accum_0 - init-c_0 - first?_0 - first-read-one_0) - (begin - (let ((c_0 - (read-char/skip-whitespace-and-comments - init-c_0 - whitespace-read-one_0 - in15_0 - seq-config16_0))) - (let ((ec_0 (effective-char c_0 seq-config16_0))) - (if (eqv? ec_0 closer14_0) - (if (null? accum_0) null (reverse$1 accum_0)) - (if (if (not first?_0) - (if (eqv? ec_0 '#\x2e) - (if (check-parameter 1/read-accept-dot config_0) - (let ((c_1 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) - (let ((c_1 - (peek-char-or-special - in15_0 - 0 - 'special - source_0))) - (if (eq? c_1 'special) - (special1.1 'special) - c_1))))) - (begin-unsafe - (readtable-char-delimiter? - (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner - seq-config16_0))) - c_1 - seq-config16_0))) - #f) - #f) - #f) - (call-with-values - (lambda () (port-next-location* in15_0 c_0)) - (case-lambda - ((dot-line_0 dot-col_0 dot-pos_0) - (begin - (track-indentation! - config_0 - dot-line_0 - dot-col_0) - (begin - (if (if dot-mode2_0 - (not (unsafe-unbox* head_0)) - #f) - (void) - (let ((temp29_0 - (reading-at - config_0 - dot-line_0 - dot-col_0 - dot-pos_0))) - (let ((temp30_0 "illegal use of `.`")) - (let ((temp29_1 temp29_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in15_0 - temp29_1 - temp30_0 - (list)))))) - (let ((v_0 - (read-one/not-eof_0 - closer14_0 - in15_0 - open-end-pos_0 - opener-c12_0 - seq-config16_0 - #f - first-read-one_0 - config_0))) - (let ((rest-c_0 - (read-char/skip-whitespace-and-comments - #f - whitespace-read-one_0 - in15_0 - seq-config16_0))) - (let ((rest-ec_0 - (effective-char - rest-c_0 - seq-config16_0))) - (if (eqv? rest-ec_0 closer14_0) - (if (null? accum_0) - v_0 - (append (reverse$1 accum_0) v_0)) - (if (if (eqv? rest-ec_0 '#\x2e) - (if (check-parameter - 1/read-accept-dot - config_0) - (if (check-parameter - 1/read-accept-infix-dot - config_0) - (let ((c_1 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) - (let ((c_1 - (peek-char-or-special - in15_0 - 0 - 'special - source_0))) - (if (eq? - c_1 - 'special) - (special1.1 - 'special) - c_1))))) - (begin-unsafe - (readtable-char-delimiter? - (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner - seq-config16_0))) - c_1 - seq-config16_0))) - #f) - #f) - #f) - (begin - (unsafe-set-box*! head_0 (box v_0)) - (call-with-values - (lambda () - (port-next-location in15_0)) - (case-lambda - ((dot2-line_0 - dot2-col_0 - dot2-pos_0) - (begin - (track-indentation! - config_0 - dot2-line_0 - dot2-col_0) - (let ((post-c_0 - (read-char/skip-whitespace-and-comments - #f - whitespace-read-one_0 - in15_0 - seq-config16_0))) - (let ((post-ec_0 - (effective-char - post-c_0 - seq-config16_0))) - (begin - (if (let ((or-part_0 - (eof-object? - post-ec_0))) - (if or-part_0 - or-part_0 - (eqv? - post-ec_0 - closer14_0))) - (let ((temp32_0 - (reading-at - config_0 - dot-line_0 - dot-col_0 - dot-pos_0))) - (let ((temp34_0 - "illegal use of `.`")) - (let ((temp32_1 - temp32_0)) - (reader-error.1 - unsafe-undefined - post-ec_0 - #f - unsafe-undefined - in15_0 - temp32_1 - temp34_0 - (list))))) - (void)) - (loop_0 - closer14_0 - config/keep-comment_0 - config_0 - dot-mode2_0 - head_0 - in15_0 - open-end-pos_0 - opener-c12_0 - read-one11_0 - seq-config16_0 - whitespace-read-one_0 - depth_0 - accum_0 - post-c_0 - #f - read-one11_0)))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (let ((temp36_0 - (reading-at - config_0 - dot-line_0 - dot-col_0 - dot-pos_0))) - (let ((temp38_0 - "illegal use of `.`")) - (let ((temp36_1 temp36_0)) - (reader-error.1 - unsafe-undefined - rest-c_0 - #f - unsafe-undefined - in15_0 - temp36_1 - temp38_0 - (list))))))))))))) - (args (raise-binding-result-arity-error 3 args)))) - (let ((v_0 - (read-one/not-eof_0 - closer14_0 - in15_0 - open-end-pos_0 - opener-c12_0 - seq-config16_0 - c_0 - first-read-one_0 - config/keep-comment_0))) - (if (1/special-comment? v_0) - (loop_0 - closer14_0 - config/keep-comment_0 - config_0 - dot-mode2_0 - head_0 - in15_0 - open-end-pos_0 - opener-c12_0 - read-one11_0 - seq-config16_0 - whitespace-read-one_0 - depth_0 - accum_0 - #f - #f - read-one11_0) - (if (> depth_0 1024) - (loop_0 - closer14_0 - config/keep-comment_0 - config_0 - dot-mode2_0 - head_0 - in15_0 - open-end-pos_0 - opener-c12_0 - read-one11_0 - seq-config16_0 - whitespace-read-one_0 - depth_0 - (cons v_0 accum_0) - #f - #f - read-one11_0) - (cons - v_0 - (loop_0 - closer14_0 - config/keep-comment_0 - config_0 - dot-mode2_0 - head_0 - in15_0 - open-end-pos_0 - opener-c12_0 - read-one11_0 - seq-config16_0 - whitespace-read-one_0 - (add1 depth_0) - null - #f - #f - read-one11_0))))))))))))) - (read-one/not-eof_0 - (|#%name| - read-one/not-eof - (lambda (closer14_0 - in15_0 - open-end-pos_0 - opener-c12_0 - seq-config16_0 - init-c_0 - read-one_0 - config_0) - (begin - (let ((e_0 (|#%app| read-one_0 init-c_0 in15_0 config_0))) - (begin - (if (eof-object? e_0) - (let ((temp24_0 "expected a ~a to close `~a`~a")) - (let ((temp25_0 - (begin-unsafe - (effective-char-names - closer14_0 - config_0 - "closer")))) - (let ((temp27_0 - (indentation-possible-cause config_0))) - (let ((temp25_1 temp25_0) (temp24_1 temp24_0)) - (reader-error.1 - unsafe-undefined - e_0 - open-end-pos_0 - unsafe-undefined - in15_0 - seq-config16_0 - temp24_1 - (list temp25_1 opener-c12_0 temp27_0)))))) - (void)) - e_0))))))) - (|#%name| - read-unwrapped-sequence - (lambda (dot-mode2_0 - elem-config1_0 - first-read-one5_0 - shape-tag?3_0 - whitespace-read-one4_0 - read-one11_0 - opener-c12_0 - opener13_0 - closer14_0 - in15_0 - seq-config16_0) - (begin - (let ((elem-config_0 - (if (eq? elem-config1_0 unsafe-undefined) - (next-readtable seq-config16_0) - elem-config1_0))) - (let ((whitespace-read-one_0 - (if (eq? whitespace-read-one4_0 unsafe-undefined) + (|#%name| + read-unwrapped-sequence + (lambda (dot-mode2_0 + elem-config1_0 + first-read-one5_0 + shape-tag?3_0 + whitespace-read-one4_0 + read-one11_0 + opener-c12_0 + opener13_0 + closer14_0 + in15_0 + seq-config16_0) + (begin + (let ((elem-config_0 + (if (eq? elem-config1_0 unsafe-undefined) + (next-readtable seq-config16_0) + elem-config1_0))) + (let ((whitespace-read-one_0 + (if (eq? whitespace-read-one4_0 unsafe-undefined) + read-one11_0 + whitespace-read-one4_0))) + (let ((first-read-one_0 + (if (eq? first-read-one5_0 unsafe-undefined) read-one11_0 - whitespace-read-one4_0))) - (let ((first-read-one_0 - (if (eq? first-read-one5_0 unsafe-undefined) - read-one11_0 - first-read-one5_0))) - (let ((head_0 (box #f))) - (let ((indentation_0 - (make-indentation closer14_0 in15_0 seq-config16_0))) - (let ((config_0 - (if (read-config/outer? elem-config_0) - (let ((indentations18_0 - (cons - indentation_0 - (begin-unsafe - (read-config/outer-indentations - seq-config16_0))))) - (let ((inner19_0 - (read-config/outer-inner elem-config_0))) - (let ((indentations18_1 indentations18_0)) - (let ((app_0 - (read-config/outer-wrap + first-read-one5_0))) + (let ((head_0 #f)) + (let ((indentation_0 + (make-indentation closer14_0 in15_0 seq-config16_0))) + (let ((config_0 + (if (read-config/outer? elem-config_0) + (let ((indentations18_0 + (cons + indentation_0 + (begin-unsafe + (read-config/outer-indentations + seq-config16_0))))) + (let ((inner19_0 + (read-config/outer-inner elem-config_0))) + (let ((indentations18_1 indentations18_0)) + (let ((app_0 + (read-config/outer-wrap elem-config_0))) + (let ((app_1 + (read-config/outer-line elem-config_0))) - (let ((app_1 - (read-config/outer-line + (let ((app_2 + (read-config/outer-col elem-config_0))) - (let ((app_2 - (read-config/outer-col + (let ((app_3 + (read-config/outer-pos elem-config_0))) - (let ((app_3 - (read-config/outer-pos - elem-config_0))) - (read-config/outer1.1 - inner19_0 - app_0 - app_1 - app_2 - app_3 - indentations18_1 - (read-config/outer-keep-comment? - elem-config_0))))))))) - (raise-argument-error - 'struct-copy - "read-config/outer?" - elem-config_0)))) - (call-with-values - (lambda () (port-next-location in15_0)) - (case-lambda - ((open-end-line_0 open-end-col_0 open-end-pos_0) - (let ((config/keep-comment_0 (keep-comment config_0))) + (read-config/outer1.1 + inner19_0 + app_0 + app_1 + app_2 + app_3 + indentations18_1 + (read-config/outer-keep-comment? + elem-config_0))))))))) + (raise-argument-error + 'struct-copy + "read-config/outer?" + elem-config_0)))) + (call-with-values + (lambda () (port-next-location in15_0)) + (case-lambda + ((open-end-line_0 open-end-col_0 open-end-pos_0) + (let ((config/keep-comment_0 (keep-comment config_0))) + (let ((read-one/not-eof_0 + (|#%name| + read-one/not-eof + (lambda (init-c_0 read-one_0 config_1) + (begin + (let ((e_0 + (|#%app| + read-one_0 + init-c_0 + in15_0 + config_1))) + (begin + (if (eof-object? e_0) + (let ((temp24_0 + "expected a ~a to close `~a`~a")) + (let ((temp25_0 + (begin-unsafe + (effective-char-names + closer14_0 + config_1 + "closer")))) + (let ((temp27_0 + (indentation-possible-cause + config_1))) + (let ((temp25_1 temp25_0) + (temp24_1 temp24_0)) + (reader-error.1 + unsafe-undefined + e_0 + open-end-pos_0 + unsafe-undefined + in15_0 + seq-config16_0 + temp24_1 + (list + temp25_1 + opener-c12_0 + temp27_0)))))) + (void)) + e_0))))))) (let ((seq_0 - (loop_0 - closer14_0 - config/keep-comment_0 - config_0 - dot-mode2_0 - head_0 - in15_0 - open-end-pos_0 - opener-c12_0 - read-one11_0 - seq-config16_0 - whitespace-read-one_0 - 0 - null - #f - #t - first-read-one_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (depth_0 + accum_0 + init-c_0 + first?_0 + first-read-one_1) + (begin + (let ((c_0 + (read-char/skip-whitespace-and-comments + init-c_0 + whitespace-read-one_0 + in15_0 + seq-config16_0))) + (let ((ec_0 + (effective-char + c_0 + seq-config16_0))) + (if (eqv? ec_0 closer14_0) + (if (null? accum_0) + null + (reverse$1 accum_0)) + (if (if (not first?_0) + (if (eqv? ec_0 '#\x2e) + (if (check-parameter + 1/read-accept-dot + config_0) + (let ((c_1 + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config_0))))) + (let ((c_1 + (peek-char-or-special + in15_0 + 0 + 'special + source_0))) + (if (eq? + c_1 + 'special) + (special1.1 + 'special) + c_1))))) + (begin-unsafe + (readtable-char-delimiter? + (begin-unsafe + (read-config/inner-readtable + (read-config/outer-inner + seq-config16_0))) + c_1 + seq-config16_0))) + #f) + #f) + #f) + (call-with-values + (lambda () + (port-next-location* + in15_0 + c_0)) + (case-lambda + ((dot-line_0 + dot-col_0 + dot-pos_0) + (begin + (track-indentation! + config_0 + dot-line_0 + dot-col_0) + (begin + (if (if dot-mode2_0 + (not head_0) + #f) + (void) + (let ((temp29_0 + (reading-at + config_0 + dot-line_0 + dot-col_0 + dot-pos_0))) + (let ((temp30_0 + "illegal use of `.`")) + (let ((temp29_1 + temp29_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in15_0 + temp29_1 + temp30_0 + (list)))))) + (let ((v_0 + (read-one/not-eof_0 + #f + first-read-one_1 + config_0))) + (let ((rest-c_0 + (read-char/skip-whitespace-and-comments + #f + whitespace-read-one_0 + in15_0 + seq-config16_0))) + (let ((rest-ec_0 + (effective-char + rest-c_0 + seq-config16_0))) + (if (eqv? + rest-ec_0 + closer14_0) + (if (null? + accum_0) + v_0 + (append + (reverse$1 + accum_0) + v_0)) + (if (if (eqv? + rest-ec_0 + '#\x2e) + (if (check-parameter + 1/read-accept-dot + config_0) + (if (check-parameter + 1/read-accept-infix-dot + config_0) + (let ((c_1 + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config_0))))) + (let ((c_1 + (peek-char-or-special + in15_0 + 0 + 'special + source_0))) + (if (eq? + c_1 + 'special) + (special1.1 + 'special) + c_1))))) + (begin-unsafe + (readtable-char-delimiter? + (begin-unsafe + (read-config/inner-readtable + (read-config/outer-inner + seq-config16_0))) + c_1 + seq-config16_0))) + #f) + #f) + #f) + (begin + (set! head_0 + (box + v_0)) + (call-with-values + (lambda () + (port-next-location + in15_0)) + (case-lambda + ((dot2-line_0 + dot2-col_0 + dot2-pos_0) + (begin + (track-indentation! + config_0 + dot2-line_0 + dot2-col_0) + (let ((post-c_0 + (read-char/skip-whitespace-and-comments + #f + whitespace-read-one_0 + in15_0 + seq-config16_0))) + (let ((post-ec_0 + (effective-char + post-c_0 + seq-config16_0))) + (begin + (if (let ((or-part_0 + (eof-object? + post-ec_0))) + (if or-part_0 + or-part_0 + (eqv? + post-ec_0 + closer14_0))) + (let ((temp32_0 + (reading-at + config_0 + dot-line_0 + dot-col_0 + dot-pos_0))) + (let ((temp34_0 + "illegal use of `.`")) + (let ((temp32_1 + temp32_0)) + (reader-error.1 + unsafe-undefined + post-ec_0 + #f + unsafe-undefined + in15_0 + temp32_1 + temp34_0 + (list))))) + (void)) + (loop_0 + depth_0 + accum_0 + post-c_0 + #f + read-one11_0)))))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (let ((temp36_0 + (reading-at + config_0 + dot-line_0 + dot-col_0 + dot-pos_0))) + (let ((temp38_0 + "illegal use of `.`")) + (let ((temp36_1 + temp36_0)) + (reader-error.1 + unsafe-undefined + rest-c_0 + #f + unsafe-undefined + in15_0 + temp36_1 + temp38_0 + (list))))))))))))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (let ((v_0 + (read-one/not-eof_0 + c_0 + first-read-one_1 + config/keep-comment_0))) + (if (1/special-comment? v_0) + (loop_0 + depth_0 + accum_0 + #f + #f + read-one11_0) + (if (> depth_0 1024) + (loop_0 + depth_0 + (cons v_0 accum_0) + #f + #f + read-one11_0) + (cons + v_0 + (loop_0 + (add1 depth_0) + null + #f + #f + read-one11_0)))))))))))))) + (loop_0 0 null #f #t first-read-one_0)))) (let ((full-seq_0 - (if (unsafe-unbox* head_0) - (cons - (unbox (unsafe-unbox* head_0)) - seq_0) + (if head_0 + (cons (unbox head_0) seq_0) seq_0))) (if shape-tag?3_0 (add-shape-tag @@ -64013,9 +63441,9 @@ in15_0 config_0 full-seq_0) - full-seq_0))))) - (args - (raise-binding-result-arity-error 3 args))))))))))))))) + full-seq_0)))))) + (args + (raise-binding-result-arity-error 3 args)))))))))))))) (define add-shape-tag (lambda (opener_0 in_0 config_0 seq_0) (let ((tag_0 @@ -64034,77 +63462,65 @@ not-an-fX (lambda (who_0 v_0) (begin (raise-argument-error who_0 "flonum?" v_0))))) (define read-digits.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (accum-str9_0 base1_0 config11_0 in10_0 v_0 max-count_0) - (begin - (if (zero? max-count_0) - v_0 - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config11_0))))) - (let ((c_0 - (peek-char-or-special - in10_0 - 0 - 'special - source_0))) - (if (eq? c_0 'special) - (special1.1 'special) - c_0))))) - (if (digit? c_0 base1_0) - (begin - (begin-unsafe (begin (read-char in10_0) (void))) - (if accum-str9_0 - (accum-string-add! accum-str9_0 c_0) - (void)) - (let ((app_0 - (let ((app_0 (digit->number c_0))) - (+ app_0 (* v_0 base1_0))))) - (loop_0 - accum-str9_0 - base1_0 - config11_0 - in10_0 - app_0 - (sub1 max-count_0)))) - v_0)))))))) - (|#%name| - read-digits - (lambda (base1_0 - init3_0 - max-count2_0 - zero-digits-result4_0 - in10_0 - config11_0 - accum-str9_0) - (begin - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config11_0))))) - (let ((c_0 - (peek-char-or-special in10_0 0 'special source_0))) - (if (eq? c_0 'special) (special1.1 'special) c_0))))) - (if (digit? c_0 base1_0) - (begin - (begin-unsafe (begin (read-char in10_0) (void))) - (if accum-str9_0 (accum-string-add! accum-str9_0 c_0) (void)) - (let ((app_0 - (let ((app_0 (digit->number c_0))) - (+ app_0 (* init3_0 base1_0))))) - (loop_0 - accum-str9_0 - base1_0 - config11_0 - in10_0 - app_0 - (sub1 max-count2_0)))) - (if zero-digits-result4_0 zero-digits-result4_0 c_0)))))))) + (|#%name| + read-digits + (lambda (base1_0 + init3_0 + max-count2_0 + zero-digits-result4_0 + in10_0 + config11_0 + accum-str9_0) + (begin + (let ((c_0 + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config11_0))))) + (let ((c_0 (peek-char-or-special in10_0 0 'special source_0))) + (if (eq? c_0 'special) (special1.1 'special) c_0))))) + (if (digit? c_0 base1_0) + (begin + (begin-unsafe (begin (read-char in10_0) (void))) + (if accum-str9_0 (accum-string-add! accum-str9_0 c_0) (void)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_0 max-count_0) + (begin + (if (zero? max-count_0) + v_0 + (let ((c_1 + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config11_0))))) + (let ((c_1 + (peek-char-or-special + in10_0 + 0 + 'special + source_0))) + (if (eq? c_1 'special) + (special1.1 'special) + c_1))))) + (if (digit? c_1 base1_0) + (begin + (begin-unsafe (begin (read-char in10_0) (void))) + (if accum-str9_0 + (accum-string-add! accum-str9_0 c_1) + (void)) + (let ((app_0 + (let ((app_0 (digit->number c_1))) + (+ app_0 (* v_0 base1_0))))) + (loop_0 app_0 (sub1 max-count_0)))) + v_0)))))))) + (let ((app_0 + (let ((app_0 (digit->number c_0))) + (+ app_0 (* init3_0 base1_0))))) + (loop_0 app_0 (sub1 max-count2_0))))) + (if zero-digits-result4_0 zero-digits-result4_0 c_0))))))) (define digit? (lambda (c_0 base_0) (if (not (char? c_0)) @@ -65251,16 +64667,15 @@ (read-nan c_0 s_0 (fx+ 1 start_0) end_0 radix_0 state_0) (bad-digit c_0 s_0 state_0))))))))) (define read-integer - (letrec ((get-n_0 - (|#%name| get-n (lambda (n_0 sgn_0) (begin (* sgn_0 n_0)))))) - (lambda (sgn_0 n_0 s_0 start_0 end_0 radix_0 state_0) + (lambda (sgn_0 n_0 s_0 start_0 end_0 radix_0 state_0) + (let ((get-n_0 (|#%name| get-n (lambda () (begin (* sgn_0 n_0)))))) (let ((c_0 (if (fx= start_0 end_0) 'eof (let ((c_0 (string-ref s_0 start_0))) (maybe-digit c_0 radix_0))))) (if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f)) - (let ((temp109_0 (get-n_0 n_0 sgn_0))) + (let ((temp109_0 (get-n_0))) (finish.1 #f sgn_0 temp109_0 s_0 state_0)) (if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f)) (let ((app_0 (+ (* n_0 radix_0) c_0))) @@ -65332,7 +64747,7 @@ (if or-part_11 or-part_11 #f)))))))))))))))))))))))) - (let ((app_0 (get-n_0 n_0 sgn_0))) + (let ((app_0 (get-n_0))) (let ((app_1 (fx+ 1 start_0))) (read-exponent sgn_0 @@ -65345,7 +64760,7 @@ (set-exactness-by-char.1 #f state_0 c_0)))) (if (let ((or-part_0 (eqv? c_0 '#\x2f))) (if or-part_0 or-part_0 #f)) - (let ((app_0 (get-n_0 n_0 sgn_0))) + (let ((app_0 (get-n_0))) (read-rational sgn_0 app_0 @@ -65373,7 +64788,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x2d))) (if or-part_1 or-part_1 #f)))) - (let ((app_0 (get-n_0 n_0 sgn_0))) + (let ((app_0 (get-n_0))) (let ((app_1 (if (eqv? c_0 '#\x2b) 1 -1))) (read-imag c_0 @@ -65387,7 +64802,7 @@ state_0))) (if (let ((or-part_0 (eqv? c_0 '#\x40))) (if or-part_0 or-part_0 #f)) - (let ((app_0 (get-n_0 n_0 sgn_0))) + (let ((app_0 (get-n_0))) (read-polar sgn_0 app_0 @@ -65401,7 +64816,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x49))) (if or-part_1 or-part_1 #f)))) - (let ((app_0 (get-n_0 n_0 sgn_0))) + (let ((app_0 (get-n_0))) (finish-imaginary sgn_0 app_0 @@ -65411,16 +64826,16 @@ state_0)) (bad-digit c_0 s_0 state_0)))))))))))))) (define read-decimal - (letrec ((get-n_0 - (|#%name| - get-n - (lambda (exp_0 n_0 radix_0 s_0 sgn_0 state_0) - (begin - (if n_0 - (let ((app_0 (* sgn_0 n_0))) - (lazy-number app_0 radix_0 (- exp_0))) - (bad-no-digits "." s_0 state_0))))))) - (lambda (sgn_0 n_0 exp_0 s_0 start_0 end_0 radix_0 state_0) + (lambda (sgn_0 n_0 exp_0 s_0 start_0 end_0 radix_0 state_0) + (let ((get-n_0 + (|#%name| + get-n + (lambda () + (begin + (if n_0 + (let ((app_0 (* sgn_0 n_0))) + (lazy-number app_0 radix_0 (- exp_0))) + (bad-no-digits "." s_0 state_0))))))) (let ((c_0 (if (fx= start_0 end_0) 'eof @@ -65433,7 +64848,7 @@ #f))) (if or-part_0 or-part_0 - (let ((v_0 (get-n_0 exp_0 n_0 radix_0 s_0 sgn_0 state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_1 (not v_0))) (if or-part_1 or-part_1 (string? v_0))) v_0 @@ -65550,8 +64965,7 @@ (let ((or-part_1 (eqv? c_0 '#\x2d))) (if or-part_1 or-part_1 #f)))) (if n_0 - (let ((app_0 - (get-n_0 exp_0 n_0 radix_0 s_0 sgn_0 state_0))) + (let ((app_0 (get-n_0))) (let ((app_1 (if (eqv? c_0 '#\x2b) 1 -1))) (read-imag c_0 @@ -65566,8 +64980,7 @@ (bad-no-digits "." s_0 state_0)) (if (let ((or-part_0 (eqv? c_0 '#\x40))) (if or-part_0 or-part_0 #f)) - (let ((v_0 - (get-n_0 exp_0 n_0 radix_0 s_0 sgn_0 state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_0 (not v_0))) (if or-part_0 or-part_0 (string? v_0))) v_0 @@ -65584,14 +64997,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x49))) (if or-part_1 or-part_1 #f)))) - (let ((v_0 - (get-n_0 - exp_0 - n_0 - radix_0 - s_0 - sgn_0 - state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_0 (not v_0))) (if or-part_0 or-part_0 (string? v_0))) v_0 @@ -65604,19 +65010,18 @@ state_0))) (bad-digit c_0 s_0 state_0)))))))))))))) (define read-approx - (letrec ((get-n_0 - (|#%name| - get-n - (lambda (exp_0 n_0 radix_0 sgn_0) - (begin (lazy-number (* sgn_0 n_0) radix_0 exp_0)))))) - (lambda (sgn_0 n_0 exp_0 saw-.?_0 s_0 start_0 end_0 radix_0 state_0) + (lambda (sgn_0 n_0 exp_0 saw-.?_0 s_0 start_0 end_0 radix_0 state_0) + (let ((get-n_0 + (|#%name| + get-n + (lambda () (begin (lazy-number (* sgn_0 n_0) radix_0 exp_0)))))) (let ((c_0 (if (fx= start_0 end_0) 'eof (let ((c_0 (string-ref s_0 start_0))) (maybe-digit c_0 radix_0))))) (if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f)) - (let ((temp125_0 (get-n_0 exp_0 n_0 radix_0 sgn_0))) + (let ((temp125_0 (get-n_0))) (finish.1 #f sgn_0 temp125_0 s_0 state_0)) (if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f)) (bad-misplaced "#" s_0 state_0) @@ -65711,7 +65116,7 @@ (if or-part_0 or-part_0 #f)) (if saw-.?_0 (bad-mixed-decimal-fraction s_0 state_0) - (let ((app_0 (get-n_0 exp_0 n_0 radix_0 sgn_0))) + (let ((app_0 (get-n_0))) (read-rational sgn_0 app_0 @@ -65726,7 +65131,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x2d))) (if or-part_1 or-part_1 #f)))) - (let ((app_0 (get-n_0 exp_0 n_0 radix_0 sgn_0))) + (let ((app_0 (get-n_0))) (let ((app_1 (if (eqv? c_0 '#\x2b) 1 -1))) (read-imag c_0 @@ -65740,7 +65145,7 @@ state_0))) (if (let ((or-part_0 (eqv? c_0 '#\x40))) (if or-part_0 or-part_0 #f)) - (let ((app_0 (get-n_0 exp_0 n_0 radix_0 sgn_0))) + (let ((app_0 (get-n_0))) (read-polar sgn_0 app_0 @@ -65754,7 +65159,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x49))) (if or-part_1 or-part_1 #f)))) - (let ((app_0 (get-n_0 exp_0 n_0 radix_0 sgn_0))) + (let ((app_0 (get-n_0))) (finish-imaginary sgn_0 app_0 @@ -65884,26 +65289,17 @@ (bad-misplaced "i" s_0 state_0)) (bad-digit c_0 s_0 state_0))))))))) (define read-signed-exponent - (letrec ((get-n_0 - (|#%name| - get-n - (lambda (exp2_0 exp_0 radix_0 s_0 sgn-n_0 sgn2_0 state_0) - (begin - (if exp2_0 - (lazy-number sgn-n_0 radix_0 (+ exp_0 (* sgn2_0 exp2_0))) - (if (eq? (state->convert-mode state_0) 'must-read) - (format "empty exponent `~.a`" s_0) - #f))))))) - (lambda (sgn_0 - sgn-n_0 - exp_0 - sgn2_0 - exp2_0 - s_0 - start_0 - end_0 - radix_0 - state_0) + (lambda (sgn_0 sgn-n_0 exp_0 sgn2_0 exp2_0 s_0 start_0 end_0 radix_0 state_0) + (let ((get-n_0 + (|#%name| + get-n + (lambda () + (begin + (if exp2_0 + (lazy-number sgn-n_0 radix_0 (+ exp_0 (* sgn2_0 exp2_0))) + (if (eq? (state->convert-mode state_0) 'must-read) + (format "empty exponent `~.a`" s_0) + #f))))))) (let ((c_0 (if (fx= start_0 end_0) 'eof @@ -65925,15 +65321,7 @@ #f))) (if or-part_0 or-part_0 - (let ((v_0 - (get-n_0 - exp2_0 - exp_0 - radix_0 - s_0 - sgn-n_0 - sgn2_0 - state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_1 (not v_0))) (if or-part_1 or-part_1 (string? v_0))) v_0 @@ -65956,15 +65344,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x2d))) (if or-part_1 or-part_1 #f)))) - (let ((v_0 - (get-n_0 - exp2_0 - exp_0 - radix_0 - s_0 - sgn-n_0 - sgn2_0 - state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_0 (not v_0))) (if or-part_0 or-part_0 (string? v_0))) v_0 @@ -66048,15 +65428,7 @@ (bad-misplaced c_0 s_0 state_0) (if (let ((or-part_0 (eqv? c_0 '#\x40))) (if or-part_0 or-part_0 #f)) - (let ((v_0 - (get-n_0 - exp2_0 - exp_0 - radix_0 - s_0 - sgn-n_0 - sgn2_0 - state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_0 (not v_0))) (if or-part_0 or-part_0 (string? v_0))) v_0 @@ -66073,15 +65445,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x49))) (if or-part_1 or-part_1 #f)))) - (let ((v_0 - (get-n_0 - exp2_0 - exp_0 - radix_0 - s_0 - sgn-n_0 - sgn2_0 - state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_0 (not v_0))) (if or-part_0 or-part_0 (string? v_0))) v_0 @@ -66094,199 +65458,83 @@ state_0))) (bad-digit c_0 s_0 state_0))))))))))) (define read-infinity - (letrec ((fail_0 - (|#%name| - fail - (lambda (c_0 s_0 state_0) (begin (bad-digit c_0 s_0 state_0))))) - (fail_1 - (|#%name| - fail - (lambda (c_0 s_0 state_0) (begin (fail_0 c_0 s_0 state_0))))) - (fail_2 - (|#%name| - fail - (lambda (c_0 s_0 state_0) (begin (fail_1 c_0 s_0 state_0)))))) - (lambda (sgn_0 c_0 s_0 start_0 end_0 radix_0 state_0) + (lambda (sgn_0 c_0 s_0 start_0 end_0 radix_0 state_0) + (let ((fail_0 + (|#%name| fail (lambda () (begin (bad-digit c_0 s_0 state_0)))))) (let ((start+n_0 (fx+ start_0 0))) (let ((var_0 (if (fx= start+n_0 end_0) 'eof (string-ref s_0 start+n_0)))) (if (if (eqv? var_0 '#\x66) #t (eqv? var_0 '#\x46)) - (let ((start+n_1 (fx+ start_0 1))) - (let ((var_1 - (if (fx= start+n_1 end_0) - 'eof - (string-ref s_0 start+n_1)))) - (if (eqv? var_1 '#\x2e) - (let ((start+n_2 (fx+ start_0 2))) - (let ((var_2 - (if (fx= start+n_2 end_0) - 'eof - (string-ref s_0 start+n_2)))) - (if (if (eqv? var_2 '#\x30) - #t - (if (eqv? var_2 '#\x66) - #t - (if (eqv? var_2 '#\x74) + (let ((fail_1 (|#%name| fail (lambda () (begin (fail_0)))))) + (let ((start+n_1 (fx+ start_0 1))) + (let ((var_1 + (if (fx= start+n_1 end_0) + 'eof + (string-ref s_0 start+n_1)))) + (if (eqv? var_1 '#\x2e) + (let ((fail_2 + (|#%name| fail (lambda () (begin (fail_1)))))) + (let ((start+n_2 (fx+ start_0 2))) + (let ((var_2 + (if (fx= start+n_2 end_0) + 'eof + (string-ref s_0 start+n_2)))) + (if (if (eqv? var_2 '#\x30) #t - (if (eqv? var_2 '#\x46) + (if (eqv? var_2 '#\x66) #t - (eqv? var_2 '#\x54))))) - (let ((n_0 (if (negative? sgn_0) -inf.0 +inf.0))) - (let ((new-state_0 - (let ((temp135_0 - (string-ref s_0 (fx+ start_0 2)))) - (set-exactness-by-char.1 + (if (eqv? var_2 '#\x74) #t - state_0 - temp135_0)))) - (let ((c2_0 - (if (fx= (fx+ 3 start_0) end_0) - 'eof - (let ((c_1 - (string-ref s_0 (fx+ 3 start_0)))) - (maybe-digit c_1 radix_0))))) - (if (let ((or-part_0 (eqv? c2_0 'eof))) - (if or-part_0 or-part_0 #f)) - (finish.1 #f sgn_0 n_0 s_0 new-state_0) - (if (let ((or-part_0 (eqv? c2_0 '#\x2b))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (eqv? c2_0 '#\x2d))) - (if or-part_1 or-part_1 #f)))) - (let ((app_0 (if (eqv? c2_0 '#\x2b) 1 -1))) - (read-imag - c2_0 - sgn_0 - n_0 - app_0 - s_0 - (fx+ 4 start_0) - end_0 - radix_0 - new-state_0)) - (if (let ((or-part_0 (eqv? c2_0 '#\x40))) - (if or-part_0 or-part_0 #f)) - (read-polar - sgn_0 - n_0 - s_0 - (fx+ 4 start_0) - end_0 - radix_0 - new-state_0) - (if (let ((or-part_0 (eqv? c2_0 '#\x69))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (eqv? c2_0 '#\x49))) - (if or-part_1 or-part_1 #f)))) - (finish-imaginary - sgn_0 - n_0 - s_0 - (fx+ 4 start_0) - end_0 - new-state_0) - (bad-digit c_0 s_0 state_0)))))))) - (fail_2 c_0 s_0 state_0)))) - (fail_1 c_0 s_0 state_0)))) - (fail_0 c_0 s_0 state_0))))))) -(define read-nan - (letrec ((fail_0 - (|#%name| - fail - (lambda (c_0 s_0 state_0) (begin (fail_3 c_0 s_0 state_0))))) - (fail_1 - (|#%name| - fail - (lambda (c_0 s_0 state_0) (begin (fail_0 c_0 s_0 state_0))))) - (fail_2 - (|#%name| - fail - (lambda (c_0 s_0 state_0) (begin (fail_1 c_0 s_0 state_0))))) - (fail_3 - (|#%name| - fail - (lambda (c_0 s_0 state_0) (begin (bad-digit c_0 s_0 state_0)))))) - (lambda (c_0 s_0 start_0 end_0 radix_0 state_0) - (let ((start+n_0 (fx+ start_0 0))) - (let ((var_0 - (if (fx= start+n_0 end_0) 'eof (string-ref s_0 start+n_0)))) - (if (if (eqv? var_0 '#\x61) #t (eqv? var_0 '#\x41)) - (let ((start+n_1 (fx+ start_0 1))) - (let ((var_1 - (if (fx= start+n_1 end_0) - 'eof - (string-ref s_0 start+n_1)))) - (if (if (eqv? var_1 '#\x6e) #t (eqv? var_1 '#\x4e)) - (let ((start+n_2 (fx+ start_0 2))) - (let ((var_2 - (if (fx= start+n_2 end_0) - 'eof - (string-ref s_0 start+n_2)))) - (if (eqv? var_2 '#\x2e) - (let ((start+n_3 (fx+ start_0 3))) - (let ((var_3 - (if (fx= start+n_3 end_0) - 'eof - (string-ref s_0 start+n_3)))) - (if (if (eqv? var_3 '#\x30) - #t - (if (eqv? var_3 '#\x66) - #t - (if (eqv? var_3 '#\x74) + (if (eqv? var_2 '#\x46) #t - (if (eqv? var_3 '#\x46) - #t - (eqv? var_3 '#\x54))))) + (eqv? var_2 '#\x54))))) + (let ((n_0 (if (negative? sgn_0) -inf.0 +inf.0))) (let ((new-state_0 - (let ((temp142_0 - (string-ref s_0 (fx+ start_0 3)))) + (let ((temp135_0 + (string-ref s_0 (fx+ start_0 2)))) (set-exactness-by-char.1 #t state_0 - temp142_0)))) + temp135_0)))) (let ((c2_0 - (if (fx= (fx+ 4 start_0) end_0) + (if (fx= (fx+ 3 start_0) end_0) 'eof (let ((c_1 (string-ref s_0 - (fx+ 4 start_0)))) + (fx+ 3 start_0)))) (maybe-digit c_1 radix_0))))) (if (let ((or-part_0 (eqv? c2_0 'eof))) (if or-part_0 or-part_0 #f)) - (finish.1 #f 1 +nan.0 s_0 new-state_0) + (finish.1 #f sgn_0 n_0 s_0 new-state_0) (if (let ((or-part_0 (eqv? c2_0 '#\x2b))) (if or-part_0 or-part_0 (let ((or-part_1 (eqv? c2_0 '#\x2d))) (if or-part_1 or-part_1 #f)))) - (let ((app_0 +nan.0)) - (let ((app_1 - (if (eqv? c2_0 '#\x2b) 1 -1))) - (read-imag - c2_0 - 1 - app_0 - app_1 - s_0 - (fx+ 5 start_0) - end_0 - radix_0 - new-state_0))) + (let ((app_0 + (if (eqv? c2_0 '#\x2b) 1 -1))) + (read-imag + c2_0 + sgn_0 + n_0 + app_0 + s_0 + (fx+ 4 start_0) + end_0 + radix_0 + new-state_0)) (if (let ((or-part_0 (eqv? c2_0 '#\x40))) (if or-part_0 or-part_0 #f)) - (let ((app_0 +nan.0)) - (read-polar - 1 - app_0 - s_0 - (fx+ 5 start_0) - end_0 - radix_0 - new-state_0)) + (read-polar + sgn_0 + n_0 + s_0 + (fx+ 4 start_0) + end_0 + radix_0 + new-state_0) (if (let ((or-part_0 (eqv? c2_0 '#\x69))) (if or-part_0 @@ -66296,36 +65544,163 @@ (if or-part_1 or-part_1 #f)))) - (let ((app_0 +nan.0)) - (finish-imaginary - 1 - app_0 - s_0 - (fx+ 5 start_0) - end_0 - new-state_0)) - (bad-digit c_0 s_0 state_0))))))) - (fail_2 c_0 s_0 state_0)))) - (fail_1 c_0 s_0 state_0)))) - (fail_0 c_0 s_0 state_0)))) - (fail_3 c_0 s_0 state_0))))))) + (finish-imaginary + sgn_0 + n_0 + s_0 + (fx+ 4 start_0) + end_0 + new-state_0) + (bad-digit c_0 s_0 state_0)))))))) + (fail_2))))) + (fail_1))))) + (fail_0))))))) +(define read-nan + (lambda (c_0 s_0 start_0 end_0 radix_0 state_0) + (let ((fail_0 + (|#%name| fail (lambda () (begin (bad-digit c_0 s_0 state_0)))))) + (let ((start+n_0 (fx+ start_0 0))) + (let ((var_0 + (if (fx= start+n_0 end_0) 'eof (string-ref s_0 start+n_0)))) + (if (if (eqv? var_0 '#\x61) #t (eqv? var_0 '#\x41)) + (let ((fail_1 (|#%name| fail (lambda () (begin (fail_0)))))) + (let ((start+n_1 (fx+ start_0 1))) + (let ((var_1 + (if (fx= start+n_1 end_0) + 'eof + (string-ref s_0 start+n_1)))) + (if (if (eqv? var_1 '#\x6e) #t (eqv? var_1 '#\x4e)) + (let ((fail_2 + (|#%name| fail (lambda () (begin (fail_1)))))) + (let ((start+n_2 (fx+ start_0 2))) + (let ((var_2 + (if (fx= start+n_2 end_0) + 'eof + (string-ref s_0 start+n_2)))) + (if (eqv? var_2 '#\x2e) + (let ((fail_3 + (|#%name| + fail + (lambda () (begin (fail_2)))))) + (let ((start+n_3 (fx+ start_0 3))) + (let ((var_3 + (if (fx= start+n_3 end_0) + 'eof + (string-ref s_0 start+n_3)))) + (if (if (eqv? var_3 '#\x30) + #t + (if (eqv? var_3 '#\x66) + #t + (if (eqv? var_3 '#\x74) + #t + (if (eqv? var_3 '#\x46) + #t + (eqv? var_3 '#\x54))))) + (let ((new-state_0 + (let ((temp142_0 + (string-ref + s_0 + (fx+ start_0 3)))) + (set-exactness-by-char.1 + #t + state_0 + temp142_0)))) + (let ((c2_0 + (if (fx= (fx+ 4 start_0) end_0) + 'eof + (let ((c_1 + (string-ref + s_0 + (fx+ 4 start_0)))) + (maybe-digit c_1 radix_0))))) + (if (let ((or-part_0 (eqv? c2_0 'eof))) + (if or-part_0 or-part_0 #f)) + (finish.1 + #f + 1 + +nan.0 + s_0 + new-state_0) + (if (let ((or-part_0 + (eqv? c2_0 '#\x2b))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (eqv? c2_0 '#\x2d))) + (if or-part_1 + or-part_1 + #f)))) + (let ((app_0 +nan.0)) + (let ((app_1 + (if (eqv? c2_0 '#\x2b) + 1 + -1))) + (read-imag + c2_0 + 1 + app_0 + app_1 + s_0 + (fx+ 5 start_0) + end_0 + radix_0 + new-state_0))) + (if (let ((or-part_0 + (eqv? c2_0 '#\x40))) + (if or-part_0 or-part_0 #f)) + (let ((app_0 +nan.0)) + (read-polar + 1 + app_0 + s_0 + (fx+ 5 start_0) + end_0 + radix_0 + new-state_0)) + (if (let ((or-part_0 + (eqv? c2_0 '#\x69))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (eqv? + c2_0 + '#\x49))) + (if or-part_1 + or-part_1 + #f)))) + (let ((app_0 +nan.0)) + (finish-imaginary + 1 + app_0 + s_0 + (fx+ 5 start_0) + end_0 + new-state_0)) + (bad-digit + c_0 + s_0 + state_0))))))) + (fail_3))))) + (fail_2))))) + (fail_1))))) + (fail_0))))))) (define read-rational - (letrec ((get-n_0 - (|#%name| - get-n - (lambda (d_0 s_0 sgn-n_0 state_0) - (begin - (if d_0 - (lazy-divide sgn-n_0 d_0 'exact) - (bad-no-digits "/" s_0 state_0))))))) - (lambda (sgn_0 sgn-n_0 d_0 s_0 start_0 end_0 radix_0 state_0) + (lambda (sgn_0 sgn-n_0 d_0 s_0 start_0 end_0 radix_0 state_0) + (let ((get-n_0 + (|#%name| + get-n + (lambda () + (begin + (if d_0 + (lazy-divide sgn-n_0 d_0 'exact) + (bad-no-digits "/" s_0 state_0))))))) (let ((c_0 (if (fx= start_0 end_0) 'eof (let ((c_0 (string-ref s_0 start_0))) (maybe-digit c_0 radix_0))))) (if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f)) - (let ((v_0 (get-n_0 d_0 s_0 sgn-n_0 state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_0 (not v_0))) (if or-part_0 or-part_0 (string? v_0))) v_0 @@ -66408,7 +65783,7 @@ (if or-part_11 or-part_11 #f)))))))))))))))))))))))) - (let ((v_0 (get-n_0 d_0 s_0 sgn-n_0 state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_0 (not v_0))) (if or-part_0 or-part_0 (string? v_0))) v_0 @@ -66430,7 +65805,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x2d))) (if or-part_1 or-part_1 #f)))) - (let ((v_0 (get-n_0 d_0 s_0 sgn-n_0 state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_0 (not v_0))) (if or-part_0 or-part_0 (string? v_0))) v_0 @@ -66447,7 +65822,7 @@ state_0)))) (if (let ((or-part_0 (eqv? c_0 '#\x40))) (if or-part_0 or-part_0 #f)) - (let ((v_0 (get-n_0 d_0 s_0 sgn-n_0 state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_0 (not v_0))) (if or-part_0 or-part_0 (string? v_0))) v_0 @@ -66464,7 +65839,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x49))) (if or-part_1 or-part_1 #f)))) - (let ((v_0 (get-n_0 d_0 s_0 sgn-n_0 state_0))) + (let ((v_0 (get-n_0))) (if (let ((or-part_0 (not v_0))) (if or-part_0 or-part_0 (string? v_0))) v_0 @@ -66477,23 +65852,23 @@ state_0))) (bad-digit c_0 s_0 state_0)))))))))))))) (define read-denom-approx - (letrec ((get-n_0 - (|#%name| - get-n - (lambda (d_0 exp_0 radix_0 sgn-n_0) - (begin - (lazy-divide - sgn-n_0 - (lazy-number d_0 radix_0 exp_0) - 'approx)))))) - (lambda (sgn_0 sgn-n_0 d_0 exp_0 s_0 start_0 end_0 radix_0 state_0) + (lambda (sgn_0 sgn-n_0 d_0 exp_0 s_0 start_0 end_0 radix_0 state_0) + (let ((get-n_0 + (|#%name| + get-n + (lambda () + (begin + (lazy-divide + sgn-n_0 + (lazy-number d_0 radix_0 exp_0) + 'approx)))))) (let ((c_0 (if (fx= start_0 end_0) 'eof (let ((c_0 (string-ref s_0 start_0))) (maybe-digit c_0 radix_0))))) (if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f)) - (let ((temp157_0 (get-n_0 d_0 exp_0 radix_0 sgn-n_0))) + (let ((temp157_0 (get-n_0))) (finish.1 #f sgn_0 temp157_0 s_0 state_0)) (if (let ((or-part_0 (eqv? c_0 '#\x23))) (if or-part_0 or-part_0 #f)) (let ((app_0 (fx+ 1 exp_0))) @@ -66564,7 +65939,7 @@ (if or-part_11 or-part_11 #f)))))))))))))))))))))))) - (let ((app_0 (get-n_0 d_0 exp_0 radix_0 sgn-n_0))) + (let ((app_0 (get-n_0))) (let ((app_1 (fx+ 1 start_0))) (read-exponent sgn_0 @@ -66580,7 +65955,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x2d))) (if or-part_1 or-part_1 #f)))) - (let ((app_0 (get-n_0 d_0 exp_0 radix_0 sgn-n_0))) + (let ((app_0 (get-n_0))) (let ((app_1 (if (eqv? c_0 '#\x2b) 1 -1))) (read-imag c_0 @@ -66594,7 +65969,7 @@ state_0))) (if (let ((or-part_0 (eqv? c_0 '#\x40))) (if or-part_0 or-part_0 #f)) - (let ((app_0 (get-n_0 d_0 exp_0 radix_0 sgn-n_0))) + (let ((app_0 (get-n_0))) (read-polar sgn_0 app_0 @@ -66608,7 +65983,7 @@ or-part_0 (let ((or-part_1 (eqv? c_0 '#\x49))) (if or-part_1 or-part_1 #f)))) - (let ((app_0 (get-n_0 d_0 exp_0 radix_0 sgn-n_0))) + (let ((app_0 (get-n_0))) (finish-imaginary sgn_0 app_0 @@ -66679,76 +66054,81 @@ new-state_0)) (bad-digit c_0 s_0 state_0)))))))) (define read-symbol-or-number.1 - (letrec ((unexpected-quoted_0 - (|#%name| - unexpected-quoted - (lambda (config_0 in6_0 mode1_0 c_0 after-c_0) - (begin - (let ((temp12_0 "~a following `~a` in ~a")) - (let ((temp13_0 - (if (eof-object? c_0) - "end-of-file" - "non-character"))) - (let ((temp15_0 - (if (eq? mode1_0 'keyword) - "keyword" - (if (string? mode1_0) "number" "symbol")))) - (let ((temp13_1 temp13_0) (temp12_1 temp12_0)) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in6_0 - config_0 - temp12_1 - (list temp13_1 after-c_0 temp15_0))))))))))) - (|#%name| - read-symbol-or-number - (lambda (extra-prefix2_0 mode1_0 init-c5_0 in6_0 orig-config7_0) - (begin - (let ((config_0 - (if (string? mode1_0) - (override-parameter 1/read-cdot orig-config7_0 #f) - orig-config7_0))) - (let ((rt_0 - (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner config_0))))) - (let ((c1_0 - (if rt_0 - (if (let ((or-part_0 (eq? mode1_0 'symbol-or-number))) - (if or-part_0 - or-part_0 - (eq? mode1_0 'symbol/indirect))) - (readtable-symbol-parser rt_0) - #f) - #f))) - (if c1_0 - (let ((app_0 - (begin-unsafe (read-config/outer-line config_0)))) - (let ((app_1 - (begin-unsafe (read-config/outer-col config_0)))) - (readtable-apply - c1_0 - init-c5_0 - in6_0 - config_0 - app_0 - app_1 - (begin-unsafe (read-config/outer-pos config_0))))) - (let ((accum-str_0 (accum-string-init! config_0))) - (let ((quoted-ever?_0 (box #f))) - (let ((case-sens?_0 - (check-parameter read-case-sensitive config_0))) - (begin - (if extra-prefix2_0 - (accum-string-add! accum-str_0 extra-prefix2_0) - (void)) - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) + (|#%name| + read-symbol-or-number + (lambda (extra-prefix2_0 mode1_0 init-c5_0 in6_0 orig-config7_0) + (begin + (let ((config_0 + (if (string? mode1_0) + (override-parameter 1/read-cdot orig-config7_0 #f) + orig-config7_0))) + (let ((rt_0 + (begin-unsafe + (read-config/inner-readtable + (read-config/outer-inner config_0))))) + (let ((c1_0 + (if rt_0 + (if (let ((or-part_0 (eq? mode1_0 'symbol-or-number))) + (if or-part_0 + or-part_0 + (eq? mode1_0 'symbol/indirect))) + (readtable-symbol-parser rt_0) + #f) + #f))) + (if c1_0 + (let ((app_0 (begin-unsafe (read-config/outer-line config_0)))) + (let ((app_1 (begin-unsafe (read-config/outer-col config_0)))) + (readtable-apply + c1_0 + init-c5_0 + in6_0 + config_0 + app_0 + app_1 + (begin-unsafe (read-config/outer-pos config_0))))) + (let ((accum-str_0 (accum-string-init! config_0))) + (let ((quoted-ever?_0 #f)) + (let ((case-sens?_0 + (check-parameter read-case-sensitive config_0))) + (begin + (if extra-prefix2_0 + (accum-string-add! accum-str_0 extra-prefix2_0) + (void)) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((unexpected-quoted_0 + (|#%name| + unexpected-quoted + (lambda (c_0 after-c_0) + (begin + (let ((temp12_0 + "~a following `~a` in ~a")) + (let ((temp13_0 + (if (eof-object? c_0) + "end-of-file" + "non-character"))) + (let ((temp15_0 + (if (eq? mode1_0 'keyword) + "keyword" + (if (string? mode1_0) + "number" + "symbol")))) + (let ((temp13_1 temp13_0) + (temp12_1 temp12_0)) + (reader-error.1 + unsafe-undefined + c_0 + #f + unsafe-undefined + in6_0 + config_0 + temp12_1 + (list + temp13_1 + after-c_0 + temp15_0))))))))))) (begin (letrec* ((loop_0 @@ -66796,9 +66176,6 @@ config_0)))) (void)))) (unexpected-quoted_0 - config_0 - in6_0 - mode1_0 c_0 pipe-quote-c_0)) (if (if (not pipe-quote-c_0) @@ -66841,9 +66218,7 @@ (begin (read-char in6_0) (void)))) - (unsafe-set-box*! - quoted-ever?_0 - #t) + (set! quoted-ever?_0 #t) (if case-sens?_0 (void) (accum-string-convert! @@ -66875,9 +66250,6 @@ (if (char? next-c_0) (void) (unexpected-quoted_0 - config_0 - in6_0 - mode1_0 next-c_0 c_0)) (if (if pipe-quote-c_0 @@ -66891,9 +66263,8 @@ (accum-string-add! accum-str_0 next-c_0) - (unsafe-set-box*! - quoted-ever?_0 - #t) + (set! quoted-ever?_0 + #t) (loop_0 #f #f @@ -66922,7 +66293,7 @@ config_0))) (begin (if (if (= 1 (string-length str_0)) - (if (not (unsafe-unbox* quoted-ever?_0)) + (if (not quoted-ever?_0) (char=? '#\x2e (effective-char @@ -66949,8 +66320,7 @@ (if or-part_0 or-part_0 (string? mode1_0))) - (if (not - (unsafe-unbox* quoted-ever?_0)) + (if (not quoted-ever?_0) (let ((app_0 (if (string? mode1_0) (string-append @@ -67082,77 +66452,115 @@ c_0 (read-symbol-or-number.1 #f mode_0 c_0 in_0 config_0)))) (define read-vector.1 - (letrec ((last-or_0 - (|#%name| - last-or - (lambda (config10_0 in9_0 seq_0 v_0) - (begin - (if (null? seq_0) - (wrap v_0 in9_0 config10_0 #f) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (seq_1) - (begin - (if (null? (cdr seq_1)) - (car seq_1) - (loop_0 (cdr seq_1)))))))) - (loop_0 seq_0)))))))) - (|#%name| - read-vector - (lambda (length2_0 - mode1_0 - read-one5_0 - opener-c6_0 - opener7_0 - closer8_0 - in9_0 - config10_0) - (begin - (let ((read-one-element_0 - (if (eq? mode1_0 'any) - read-one5_0 - (if (eq? mode1_0 'fixnum) + (|#%name| + read-vector + (lambda (length2_0 + mode1_0 + read-one5_0 + opener-c6_0 + opener7_0 + closer8_0 + in9_0 + config10_0) + (begin + (let ((read-one-element_0 + (if (eq? mode1_0 'any) + read-one5_0 + (if (eq? mode1_0 'fixnum) + (|#%name| + read-one-element + (lambda (init-c_0 in_0 config_0) + (begin (read-fixnum read-one5_0 init-c_0 in_0 config_0)))) + (if (eq? mode1_0 'flonum) (|#%name| read-one-element (lambda (init-c_0 in_0 config_0) (begin - (read-fixnum read-one5_0 init-c_0 in_0 config_0)))) - (if (eq? mode1_0 'flonum) - (|#%name| - read-one-element - (lambda (init-c_0 in_0 config_0) - (begin - (read-flonum read-one5_0 init-c_0 in_0 config_0)))) - (void)))))) - (let ((seq_0 - (read-unwrapped-sequence.1 - #f - unsafe-undefined - unsafe-undefined - #f - read-one5_0 - read-one-element_0 - opener-c6_0 - opener7_0 - closer8_0 - in9_0 - config10_0))) - (let ((vec_0 - (if (not length2_0) - (if (eq? mode1_0 'any) - (list->vector seq_0) - (if (eq? mode1_0 'fixnum) + (read-flonum read-one5_0 init-c_0 in_0 config_0)))) + (void)))))) + (let ((seq_0 + (read-unwrapped-sequence.1 + #f + unsafe-undefined + unsafe-undefined + #f + read-one5_0 + read-one-element_0 + opener-c6_0 + opener7_0 + closer8_0 + in9_0 + config10_0))) + (let ((vec_0 + (if (not length2_0) + (if (eq? mode1_0 'any) + (list->vector seq_0) + (if (eq? mode1_0 'fixnum) + (let ((len_0 (length seq_0))) + (begin + (if (exact-nonnegative-integer? len_0) + (void) + (raise-argument-error + 'for/fxvector + "exact-nonnegative-integer?" + len_0)) + (let ((v_0 (make-fxvector len_0 0))) + (begin + (if (zero? len_0) + (void) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0 lst_0) + (begin + (if (pair? lst_0) + (let ((e_0 (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) + (let ((i_1 + (let ((i_1 + (begin + (if (fixnum? + e_0) + (unsafe-fxvector-set! + v_0 + i_0 + e_0) + (begin-unsafe + (raise-argument-error + 'for*/vector + "fixnum?" + e_0))) + (unsafe-fx+ + 1 + i_0)))) + (values i_1)))) + (if (if (not + (let ((x_0 + (list + e_0))) + (unsafe-fx= + i_1 + len_0))) + #t + #f) + (for-loop_0 i_1 rest_0) + i_1)))) + i_0)))))) + (for-loop_0 0 seq_0)))) + v_0)))) + (if (eq? mode1_0 'flonum) (let ((len_0 (length seq_0))) (begin (if (exact-nonnegative-integer? len_0) (void) (raise-argument-error - 'for/fxvector + 'for/flvector "exact-nonnegative-integer?" len_0)) - (let ((v_0 (make-fxvector len_0 0))) + (let ((v_0 (make-flvector len_0 0.0))) (begin (if (zero? len_0) (void) @@ -67170,16 +66578,16 @@ (let ((i_1 (let ((i_1 (begin - (if (fixnum? + (if (flonum? e_0) - (unsafe-fxvector-set! + (unsafe-flvector-set! v_0 i_0 e_0) (begin-unsafe (raise-argument-error 'for*/vector - "fixnum?" + "flonum?" e_0))) (unsafe-fx+ 1 @@ -67199,90 +66607,48 @@ i_0)))))) (for-loop_0 0 seq_0)))) v_0)))) - (if (eq? mode1_0 'flonum) - (let ((len_0 (length seq_0))) - (begin - (if (exact-nonnegative-integer? len_0) - (void) - (raise-argument-error - 'for/flvector - "exact-nonnegative-integer?" - len_0)) - (let ((v_0 (make-flvector len_0 0.0))) - (begin - (if (zero? len_0) - (void) - (begin + (void)))) + (let ((len_0 (length seq_0))) + (if (= length2_0 len_0) + (list->vector seq_0) + (if (< length2_0 len_0) + (let ((temp22_0 + "~avector length ~a is too small, ~a values provided")) + (let ((temp23_0 + (if (eq? mode1_0 'any) + "" + (if (eq? mode1_0 'fixnum) + "fx" + (if (eq? mode1_0 'flonum) + "fl" + (void)))))) + (let ((temp22_1 temp22_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in9_0 + config10_0 + temp22_1 + (list temp23_0 length2_0 len_0))))) + (let ((last-or_0 + (|#%name| + last-or + (lambda (v_0) + (begin + (if (null? seq_0) + (wrap v_0 in9_0 config10_0 #f) (letrec* - ((for-loop_0 + ((loop_0 (|#%name| - for-loop - (lambda (i_0 lst_0) + loop + (lambda (seq_1) (begin - (if (pair? lst_0) - (let ((e_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((i_1 - (let ((i_1 - (begin - (if (flonum? - e_0) - (unsafe-flvector-set! - v_0 - i_0 - e_0) - (begin-unsafe - (raise-argument-error - 'for*/vector - "flonum?" - e_0))) - (unsafe-fx+ - 1 - i_0)))) - (values i_1)))) - (if (if (not - (let ((x_0 - (list - e_0))) - (unsafe-fx= - i_1 - len_0))) - #t - #f) - (for-loop_0 - i_1 - rest_0) - i_1)))) - i_0)))))) - (for-loop_0 0 seq_0)))) - v_0)))) - (void)))) - (let ((len_0 (length seq_0))) - (if (= length2_0 len_0) - (list->vector seq_0) - (if (< length2_0 len_0) - (let ((temp22_0 - "~avector length ~a is too small, ~a values provided")) - (let ((temp23_0 - (if (eq? mode1_0 'any) - "" - (if (eq? mode1_0 'fixnum) - "fx" - (if (eq? mode1_0 'flonum) - "fl" - (void)))))) - (let ((temp22_1 temp22_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in9_0 - config10_0 - temp22_1 - (list temp23_0 length2_0 len_0))))) + (if (null? (cdr seq_1)) + (car seq_1) + (loop_0 (cdr seq_1)))))))) + (loop_0 seq_0)))))))) (begin (if (>= (integer-length length2_0) 48) (raise @@ -67293,21 +66659,15 @@ (void)) (let ((vec_0 (if (eq? mode1_0 'any) - (make-vector - length2_0 - (last-or_0 config10_0 in9_0 seq_0 0)) + (make-vector length2_0 (last-or_0 0)) (if (eq? mode1_0 'fixnum) (make-fxvector length2_0 - (last-or_0 config10_0 in9_0 seq_0 0)) + (last-or_0 0)) (if (eq? mode1_0 'flonum) (make-flvector length2_0 - (last-or_0 - config10_0 - in9_0 - seq_0 - 0.0)) + (last-or_0 0.0)) (void)))))) (begin (if (eq? mode1_0 'any) @@ -67391,16 +66751,16 @@ (for-loop_0 seq_0 0))) (void)) (void)))) - vec_0))))))))) - (wrap - (if (begin-unsafe - (read-config/inner-for-syntax? - (read-config/outer-inner config10_0))) - (vector->immutable-vector vec_0) - vec_0) - in9_0 - config10_0 - opener7_0))))))))) + vec_0)))))))))) + (wrap + (if (begin-unsafe + (read-config/inner-for-syntax? + (read-config/outer-inner config10_0))) + (vector->immutable-vector vec_0) + vec_0) + in9_0 + config10_0 + opener7_0)))))))) (define read-fixnum-or-flonum-vector (lambda (read-one_0 dispatch-c_0 c_0 c2_0 in_0 config_0) (let ((vector-mode_0 (if (char=? c2_0 '#\x78) 'fixnum 'flonum))) @@ -67517,66 +66877,76 @@ (read-config/outer-inner config_0))))) (read-char-or-special in_0 special1.1 source_0)))))))))) (define read-struct - (letrec ((procz1 - (|#%name| with-handlers-handler21 (lambda (exn_0) (begin #f))))) - (lambda (read-one_0 dispatch-c_0 in_0 config_0) - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (let ((ec_0 (effective-char c_0 config_0))) - (let ((seq_0 - (if (eqv? ec_0 '#\x28) - (read-struct-sequence - read-one_0 - c_0 - '#\x28 - '#\x29 - in_0 - config_0) - (if (eqv? ec_0 '#\x5b) - (if (check-parameter - 1/read-square-bracket-as-paren - config_0) + (lambda (read-one_0 dispatch-c_0 in_0 config_0) + (let ((c_0 + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (read-char-or-special in_0 special1.1 source_0)))) + (let ((ec_0 (effective-char c_0 config_0))) + (let ((seq_0 + (if (eqv? ec_0 '#\x28) + (read-struct-sequence + read-one_0 + c_0 + '#\x28 + '#\x29 + in_0 + config_0) + (if (eqv? ec_0 '#\x5b) + (if (check-parameter + 1/read-square-bracket-as-paren + config_0) + (read-struct-sequence + read-one_0 + c_0 + '#\x5b + '#\x5d + in_0 + config_0) + (let ((temp3_0 (format "~as~a" dispatch-c_0 c_0))) + (bad-syntax-error.1 '#\x78 in_0 config_0 temp3_0))) + (if (eqv? ec_0 '#\x7b) + (if (check-parameter 1/read-curly-brace-as-paren config_0) (read-struct-sequence read-one_0 c_0 - '#\x5b - '#\x5d + '#\x7b + '#\x7d in_0 config_0) - (let ((temp3_0 (format "~as~a" dispatch-c_0 c_0))) - (bad-syntax-error.1 '#\x78 in_0 config_0 temp3_0))) - (if (eqv? ec_0 '#\x7b) - (if (check-parameter - 1/read-curly-brace-as-paren - config_0) - (read-struct-sequence - read-one_0 - c_0 - '#\x7b - '#\x7d - in_0 - config_0) - (let ((temp6_0 (format "~as~a" dispatch-c_0 c_0))) - (bad-syntax-error.1 '#\x78 in_0 config_0 temp6_0))) - (let ((temp9_0 "expected ~a after `~as`")) - (let ((temp10_0 (all-openers-str config_0))) - (let ((temp9_1 temp9_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp9_1 - (list temp10_0 dispatch-c_0)))))))))) + (let ((temp6_0 (format "~as~a" dispatch-c_0 c_0))) + (bad-syntax-error.1 '#\x78 in_0 config_0 temp6_0))) + (let ((temp9_0 "expected ~a after `~as`")) + (let ((temp10_0 (all-openers-str config_0))) + (let ((temp9_1 temp9_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp9_1 + (list temp10_0 dispatch-c_0)))))))))) + (begin + (if (null? seq_0) + (let ((temp14_0 "missing structure description in `~as` form")) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp14_0 + (list dispatch-c_0))) + (void)) (begin - (if (null? seq_0) - (let ((temp14_0 "missing structure description in `~as` form")) + (if (prefab-key? (car seq_0)) + (void) + (let ((temp18_0 "invalid structure description in `~as` form")) (reader-error.1 unsafe-undefined '#\x78 @@ -67584,49 +66954,55 @@ unsafe-undefined in_0 config_0 - temp14_0 - (list dispatch-c_0))) - (void)) - (begin - (if (prefab-key? (car seq_0)) - (void) - (let ((temp18_0 - "invalid structure description in `~as` form")) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp18_0 - (list dispatch-c_0)))) - (let ((with-handlers-handler21_0 procz1)) - (let ((st_0 - (let ((bpz_0 - (continuation-mark-set-first - #f - break-enabled-key))) - (call-handled-body - bpz_0 - (lambda (e_0) - (select-handler/no-breaks - e_0 - bpz_0 - (list - (cons exn:fail? with-handlers-handler21_0)))) - (lambda () - (let ((app_0 (car seq_0))) - (prefab-key->struct-type - app_0 - (length (cdr seq_0))))))))) - (begin - (if st_0 + temp18_0 + (list dispatch-c_0)))) + (let ((with-handlers-handler21_0 + (|#%name| + with-handlers-handler21 + (lambda (exn_0) (begin #f))))) + (let ((st_0 + (let ((bpz_0 + (continuation-mark-set-first + #f + break-enabled-key))) + (call-handled-body + bpz_0 + (lambda (e_0) + (select-handler/no-breaks + e_0 + bpz_0 + (list + (cons exn:fail? with-handlers-handler21_0)))) + (lambda () + (let ((app_0 (car seq_0))) + (prefab-key->struct-type + app_0 + (length (cdr seq_0))))))))) + (begin + (if st_0 + (void) + (let ((temp24_0 + (string-append + "mismatch between structure description" + " and number of provided field values in `~as` form"))) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp24_0 + (list dispatch-c_0)))) + (if (begin-unsafe + (read-config/inner-for-syntax? + (read-config/outer-inner config_0))) + (if (let ((k_0 (car seq_0))) + (begin-unsafe + (prefab-key-all-fields-immutable? k_0))) (void) - (let ((temp24_0 - (string-append - "mismatch between structure description" - " and number of provided field values in `~as` form"))) + (let ((temp28_0 + "cannot read mutable `~as` form as syntax")) (reader-error.1 unsafe-undefined '#\x78 @@ -67634,32 +67010,14 @@ unsafe-undefined in_0 config_0 - temp24_0 + temp28_0 (list dispatch-c_0)))) - (if (begin-unsafe - (read-config/inner-for-syntax? - (read-config/outer-inner config_0))) - (if (let ((k_0 (car seq_0))) - (begin-unsafe - (prefab-key-all-fields-immutable? k_0))) - (void) - (let ((temp28_0 - "cannot read mutable `~as` form as syntax")) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp28_0 - (list dispatch-c_0)))) - (void)) - (wrap - (apply make-prefab-struct seq_0) - in_0 - config_0 - ec_0)))))))))))) + (void)) + (wrap + (apply make-prefab-struct seq_0) + in_0 + config_0 + ec_0))))))))))) (define read-struct-sequence (lambda (read-one_0 opener-c_0 opener_0 closer_0 in_0 config_0) (let ((temp36_0 @@ -67678,34 +67036,34 @@ in_0 config_0)))) (define read-vector-or-graph - (letrec ((get-accum_0 - (|#%name| - get-accum - (lambda (accum-str_0 config_0 dispatch-c_0 c_0) - (begin - (format - "~a~a~a" - dispatch-c_0 - (accum-string-get!.1 0 accum-str_0 config_0) - c_0)))))) - (lambda (read-one_0 dispatch-c_0 init-c_0 in_0 config_0) - (let ((accum-str_0 (accum-string-init! config_0))) - (begin - (accum-string-add! accum-str_0 init-c_0) - (let ((init-v_0 (digit->number init-c_0))) - (let ((v_0 - (read-digits.1 - 10 - init-v_0 - +inf.0 - init-v_0 - in_0 - config_0 - accum-str_0))) - (call-with-values - (lambda () (port-next-location in_0)) - (case-lambda - ((post-line_0 post-col_0 post-pos_0) + (lambda (read-one_0 dispatch-c_0 init-c_0 in_0 config_0) + (let ((accum-str_0 (accum-string-init! config_0))) + (begin + (accum-string-add! accum-str_0 init-c_0) + (let ((init-v_0 (digit->number init-c_0))) + (let ((v_0 + (read-digits.1 + 10 + init-v_0 + +inf.0 + init-v_0 + in_0 + config_0 + accum-str_0))) + (call-with-values + (lambda () (port-next-location in_0)) + (case-lambda + ((post-line_0 post-col_0 post-pos_0) + (let ((get-accum_0 + (|#%name| + get-accum + (lambda (c_0) + (begin + (format + "~a~a~a" + dispatch-c_0 + (accum-string-get!.1 0 accum-str_0 config_0) + c_0)))))) (let ((c_0 (let ((source_0 (begin-unsafe @@ -67750,16 +67108,7 @@ '#\x5d in_0 config_0) - (let ((temp26_0 - (get-accum_0 - accum-str_0 - config_0 - dispatch-c_0 - (get-accum_0 - accum-str_0 - config_0 - dispatch-c_0 - c_0)))) + (let ((temp26_0 (get-accum_0 (get-accum_0 c_0)))) (bad-syntax-error.1 '#\x78 in_0 @@ -67786,15 +67135,7 @@ in_0 config_0) (let ((temp36_0 - (get-accum_0 - accum-str_0 - config_0 - dispatch-c_0 - (get-accum_0 - accum-str_0 - config_0 - dispatch-c_0 - c_0)))) + (get-accum_0 (get-accum_0 c_0)))) (bad-syntax-error.1 '#\x78 in_0 @@ -67962,12 +67303,7 @@ accum-str_0))) (void)))) (let ((temp80_0 "bad syntax `~a`")) - (let ((temp81_0 - (get-accum_0 - accum-str_0 - config_0 - dispatch-c_0 - c_0))) + (let ((temp81_0 (get-accum_0 c_0))) (let ((temp80_1 temp80_0)) (reader-error.1 unsafe-undefined @@ -67977,8 +67313,8 @@ in_0 config_0 temp80_1 - (list temp81_0)))))))))))) - (args (raise-binding-result-arity-error 3 args))))))))))) + (list temp81_0))))))))))))) + (args (raise-binding-result-arity-error 3 args)))))))))) (define get-graph-hash (lambda (config_0) (let ((st_0 @@ -68001,47 +67337,55 @@ for-syntax?_0 key_0)))) (define read-hash - (letrec ((get-next!_0 - (|#%name| - get-next! - (lambda (accum-str_0 config_0 in_0 expect-c_0 expect-alt-c_0) - (begin - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (begin - (if (let ((or-part_0 (eqv? c_0 expect-c_0))) - (if or-part_0 or-part_0 (eqv? c_0 expect-alt-c_0))) - (void) - (let ((temp4_0 "expected `~a` after `~a`")) - (let ((temp6_0 - (accum-string-get!.1 0 accum-str_0 config_0))) - (let ((temp4_1 temp4_0)) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in_0 - config_0 - temp4_1 - (list expect-c_0 temp6_0)))))) - (accum-string-add! accum-str_0 c_0)))))))) - (lambda (read-one_0 dispatch-c_0 init-c_0 in_0 config_0) - (let ((accum-str_0 (accum-string-init! config_0))) + (lambda (read-one_0 dispatch-c_0 init-c_0 in_0 config_0) + (let ((accum-str_0 (accum-string-init! config_0))) + (begin + (accum-string-add! accum-str_0 dispatch-c_0) (begin - (accum-string-add! accum-str_0 dispatch-c_0) - (begin - (accum-string-add! accum-str_0 init-c_0) + (accum-string-add! accum-str_0 init-c_0) + (let ((get-next!_0 + (|#%name| + get-next! + (lambda (expect-c_0 expect-alt-c_0) + (begin + (let ((c_0 + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (read-char-or-special + in_0 + special1.1 + source_0)))) + (begin + (if (let ((or-part_0 (eqv? c_0 expect-c_0))) + (if or-part_0 + or-part_0 + (eqv? c_0 expect-alt-c_0))) + (void) + (let ((temp4_0 "expected `~a` after `~a`")) + (let ((temp6_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (let ((temp4_1 temp4_0)) + (reader-error.1 + unsafe-undefined + c_0 + #f + unsafe-undefined + in_0 + config_0 + temp4_1 + (list expect-c_0 temp6_0)))))) + (accum-string-add! accum-str_0 c_0)))))))) (begin - (get-next!_0 accum-str_0 config_0 in_0 '#\x61 '#\x41) + (get-next!_0 '#\x61 '#\x41) (begin - (get-next!_0 accum-str_0 config_0 in_0 '#\x73 '#\x53) + (get-next!_0 '#\x73 '#\x53) (begin - (get-next!_0 accum-str_0 config_0 in_0 '#\x68 '#\x48) + (get-next!_0 '#\x68 '#\x48) (call-with-values (lambda () (letrec* @@ -68189,12 +67533,7 @@ (eqv? ec_0 '#\x45)) (begin (accum-string-add! accum-str_0 c_0) - (get-next!_0 - accum-str_0 - config_0 - in_0 - '#\x71 - '#\x51) + (get-next!_0 '#\x71 '#\x51) (loop_0 'eq)) (if (if (eqv? ec_0 '#\x76) #t @@ -68505,72 +67844,46 @@ (raise-binding-result-arity-error 3 args))))))))))) (args (raise-binding-result-arity-error 3 args)))))))) (define read-string.1 - (letrec ((bad-end_0 - (|#%name| - bad-end - (lambda (config4_0 in3_0 mode1_0 open-end-pos_0 c_0) - (begin - (if (eof-object? c_0) - (let ((temp10_0 "expected a closing `\"`")) - (reader-error.1 - unsafe-undefined - c_0 - open-end-pos_0 - unsafe-undefined - in3_0 - config4_0 - temp10_0 - (list))) - (let ((temp14_0 "found non-character while reading a ~a")) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in3_0 - config4_0 - temp14_0 - (list mode1_0)))))))) - (next!_0 - (|#%name| - next! - (lambda (accum-str_0 in3_0 source_0) - (begin - (let ((next-c_0 - (read-char-or-special in3_0 special1.1 source_0))) - (begin - (if (char? next-c_0) - (accum-string-add! accum-str_0 next-c_0) - (void)) - next-c_0)))))) - (unknown-error_0 - (|#%name| - unknown-error - (lambda (c_0 config4_0 escaped-c_0 in3_0 mode1_0) - (begin - (let ((temp18_0 "unknown escape sequence `~a~a` in ~a")) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in3_0 - config4_0 - temp18_0 - (list c_0 escaped-c_0 mode1_0)))))))) - (|#%name| - read-string - (lambda (mode1_0 in3_0 config4_0) - (begin - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config4_0))))) - (call-with-values - (lambda () (port-next-location in3_0)) - (case-lambda - ((open-end-line_0 open-end-col_0 open-end-pos_0) - (let ((accum-str_0 (accum-string-init! config4_0))) + (|#%name| + read-string + (lambda (mode1_0 in3_0 config4_0) + (begin + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config4_0))))) + (call-with-values + (lambda () (port-next-location in3_0)) + (case-lambda + ((open-end-line_0 open-end-col_0 open-end-pos_0) + (let ((accum-str_0 (accum-string-init! config4_0))) + (let ((bad-end_0 + (|#%name| + bad-end + (lambda (c_0) + (begin + (if (eof-object? c_0) + (let ((temp10_0 "expected a closing `\"`")) + (reader-error.1 + unsafe-undefined + c_0 + open-end-pos_0 + unsafe-undefined + in3_0 + config4_0 + temp10_0 + (list))) + (let ((temp14_0 + "found non-character while reading a ~a")) + (reader-error.1 + unsafe-undefined + c_0 + #f + unsafe-undefined + in3_0 + config4_0 + temp14_0 + (list mode1_0))))))))) (begin (letrec* ((loop_0 @@ -68584,12 +67897,7 @@ special1.1 source_0))) (if (not (char? c_0)) - (bad-end_0 - config4_0 - in3_0 - mode1_0 - open-end-pos_0 - c_0) + (bad-end_0 c_0) (if (char=? '#\x5c c_0) (let ((escaped-c_0 (read-char-or-special @@ -68598,526 +67906,540 @@ source_0))) (begin (if (not (char? escaped-c_0)) - (bad-end_0 - config4_0 - in3_0 - mode1_0 - open-end-pos_0 - escaped-c_0) + (bad-end_0 escaped-c_0) (void)) - (begin - (let ((index_0 - (if (char? escaped-c_0) - (let ((codepoint_0 - (char->integer - escaped-c_0))) - (if (if (unsafe-fx>= + (let ((unknown-error_0 + (|#%name| + unknown-error + (lambda () + (begin + (let ((temp18_0 + "unknown escape sequence `~a~a` in ~a")) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in3_0 + config4_0 + temp18_0 + (list + c_0 + escaped-c_0 + mode1_0)))))))) + (begin + (let ((index_0 + (if (char? escaped-c_0) + (let ((codepoint_0 + (char->integer + escaped-c_0))) + (if (if (unsafe-fx>= + codepoint_0 + 10) + (unsafe-fx< codepoint_0 - 10) - (unsafe-fx< - codepoint_0 - 121) - #f) - (let ((tbl_0 - '#(10 - 0 - 0 - 11 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 1 - 0 - 0 - 0 - 0 - 1 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 12 - 12 - 12 - 12 - 12 - 12 - 12 - 12 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 15 - 0 - 0 - 0 - 0 - 0 - 0 - 1 - 0 - 0 - 0 - 0 - 2 - 3 - 0 - 0 - 9 - 7 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 5 - 0 - 0 - 0 - 8 - 0 - 4 - 14 - 6 - 0 - 13))) - (unsafe-vector*-ref - tbl_0 - (unsafe-fx- - codepoint_0 - 10))) - 0)) - 0))) - (if (unsafe-fx< index_0 7) - (if (unsafe-fx< index_0 3) - (if (unsafe-fx< index_0 1) - (unknown-error_0 - c_0 - config4_0 - escaped-c_0 - in3_0 - mode1_0) - (if (unsafe-fx< index_0 2) - (accum-string-add! - accum-str_0 - escaped-c_0) - (accum-string-add! - accum-str_0 - '#\x7))) - (if (unsafe-fx< index_0 4) - (accum-string-add! - accum-str_0 - '#\x8) - (if (unsafe-fx< index_0 5) - (accum-string-add! - accum-str_0 - '#\x9) - (if (unsafe-fx< index_0 6) - (accum-string-add! - accum-str_0 - '#\xa) - (accum-string-add! - accum-str_0 - '#\xb))))) - (if (unsafe-fx< index_0 11) - (if (unsafe-fx< index_0 8) - (accum-string-add! - accum-str_0 - '#\xc) - (if (unsafe-fx< index_0 9) - (accum-string-add! - accum-str_0 - '#\xd) - (if (unsafe-fx< index_0 10) - (accum-string-add! - accum-str_0 - '#\x1b) - (void)))) - (if (unsafe-fx< index_0 13) - (if (unsafe-fx< index_0 12) - (let ((maybe-newline-c_0 - (let ((c_1 - (peek-char-or-special - in3_0 + 121) + #f) + (let ((tbl_0 + '#(10 0 - 'special - source_0))) - (if (eq? c_1 'special) - (special1.1 - 'special) - c_1)))) - (begin - (if (eqv? - maybe-newline-c_0 - '#\xa) - (begin-unsafe - (begin - (read-char in3_0) - (void))) - (void)) - (void))) - (let ((pos_0 - (begin-unsafe - (accum-string-pos - accum-str_0)))) - (begin + 0 + 11 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 0 + 0 + 0 + 1 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 12 + 12 + 12 + 12 + 12 + 12 + 12 + 12 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 15 + 0 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 0 + 0 + 0 + 2 + 3 + 0 + 0 + 9 + 7 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 5 + 0 + 0 + 0 + 8 + 0 + 4 + 14 + 6 + 0 + 13))) + (unsafe-vector*-ref + tbl_0 + (unsafe-fx- + codepoint_0 + 10))) + 0)) + 0))) + (if (unsafe-fx< index_0 7) + (if (unsafe-fx< index_0 3) + (if (unsafe-fx< index_0 1) + (unknown-error_0) + (if (unsafe-fx< index_0 2) + (accum-string-add! + accum-str_0 + escaped-c_0) + (accum-string-add! + accum-str_0 + '#\x7))) + (if (unsafe-fx< index_0 4) + (accum-string-add! + accum-str_0 + '#\x8) + (if (unsafe-fx< index_0 5) + (accum-string-add! + accum-str_0 + '#\x9) + (if (unsafe-fx< index_0 6) (accum-string-add! accum-str_0 - escaped-c_0) - (let ((init-v_0 - (digit->number - escaped-c_0))) - (let ((v_0 - (read-digits.1 - 8 - init-v_0 - 2 - init-v_0 - in3_0 - config4_0 - accum-str_0))) - (begin - (if (<= v_0 255) - (void) - (let ((temp31_0 - "escape sequence `~a~a` is out of range in ~a")) - (let ((temp33_0 - (accum-string-get!.1 - pos_0 - accum-str_0 - config4_0))) - (let ((temp31_1 - temp31_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in3_0 - config4_0 - temp31_1 - (list - c_0 - temp33_0 - mode1_0)))))) - (begin-unsafe - (set-accum-string-pos! - accum-str_0 - pos_0)) - (accum-string-add! - accum-str_0 - (integer->char - v_0)))))))) - (if (unsafe-fx< index_0 14) - (let ((pos_0 - (begin-unsafe - (accum-string-pos - accum-str_0)))) - (let ((v_0 - (read-digits.1 - 16 - 0 - 2 - #f - in3_0 - config4_0 - accum-str_0))) + '#\xa) + (accum-string-add! + accum-str_0 + '#\xb))))) + (if (unsafe-fx< index_0 11) + (if (unsafe-fx< index_0 8) + (accum-string-add! + accum-str_0 + '#\xc) + (if (unsafe-fx< index_0 9) + (accum-string-add! + accum-str_0 + '#\xd) + (if (unsafe-fx< index_0 10) + (accum-string-add! + accum-str_0 + '#\x1b) + (void)))) + (if (unsafe-fx< index_0 13) + (if (unsafe-fx< index_0 12) + (let ((maybe-newline-c_0 + (let ((c_1 + (peek-char-or-special + in3_0 + 0 + 'special + source_0))) + (if (eq? + c_1 + 'special) + (special1.1 + 'special) + c_1)))) + (begin + (if (eqv? + maybe-newline-c_0 + '#\xa) + (begin-unsafe + (begin + (read-char in3_0) + (void))) + (void)) + (void))) + (let ((pos_0 + (begin-unsafe + (accum-string-pos + accum-str_0)))) (begin - (if (integer? v_0) - (void) - (no-hex-digits - in3_0 - config4_0 - v_0 - c_0 - escaped-c_0)) - (begin-unsafe - (set-accum-string-pos! - accum-str_0 - pos_0)) (accum-string-add! accum-str_0 - (integer->char v_0))))) - (if (unsafe-fx< index_0 15) - (begin - (if (eq? mode1_0 'string) - (void) - (unknown-error_0 - c_0 - config4_0 - escaped-c_0 - in3_0 - mode1_0)) - (let ((pos_0 - (begin-unsafe - (accum-string-pos - accum-str_0)))) - (let ((v_0 - (read-digits.1 - 16 - 0 - 4 - #f - in3_0 - config4_0 - accum-str_0))) - (begin - (if (integer? v_0) - (void) - (no-hex-digits - in3_0 - config4_0 - v_0 - c_0 - escaped-c_0)) - (if (let ((or-part_0 - (< - v_0 - 55296))) - (if or-part_0 - or-part_0 - (> - v_0 - 57343))) - (begin - (begin-unsafe - (set-accum-string-pos! - accum-str_0 - pos_0)) - (accum-string-add! - accum-str_0 - (integer->char - v_0))) - (let ((v2_0 - (let ((next-c_0 - (next!_0 - accum-str_0 - in3_0 - source_0))) - (if (char=? - next-c_0 - '#\x5c) - (let ((next-c_1 - (next!_0 - accum-str_0 - in3_0 - source_0))) + escaped-c_0) + (let ((init-v_0 + (digit->number + escaped-c_0))) + (let ((v_0 + (read-digits.1 + 8 + init-v_0 + 2 + init-v_0 + in3_0 + config4_0 + accum-str_0))) + (begin + (if (<= v_0 255) + (void) + (let ((temp31_0 + "escape sequence `~a~a` is out of range in ~a")) + (let ((temp33_0 + (accum-string-get!.1 + pos_0 + accum-str_0 + config4_0))) + (let ((temp31_1 + temp31_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in3_0 + config4_0 + temp31_1 + (list + c_0 + temp33_0 + mode1_0)))))) + (begin-unsafe + (set-accum-string-pos! + accum-str_0 + pos_0)) + (accum-string-add! + accum-str_0 + (integer->char + v_0)))))))) + (if (unsafe-fx< index_0 14) + (let ((pos_0 + (begin-unsafe + (accum-string-pos + accum-str_0)))) + (let ((v_0 + (read-digits.1 + 16 + 0 + 2 + #f + in3_0 + config4_0 + accum-str_0))) + (begin + (if (integer? v_0) + (void) + (no-hex-digits + in3_0 + config4_0 + v_0 + c_0 + escaped-c_0)) + (begin-unsafe + (set-accum-string-pos! + accum-str_0 + pos_0)) + (accum-string-add! + accum-str_0 + (integer->char + v_0))))) + (if (unsafe-fx< index_0 15) + (begin + (if (eq? mode1_0 'string) + (void) + (unknown-error_0)) + (let ((pos_0 + (begin-unsafe + (accum-string-pos + accum-str_0)))) + (let ((v_0 + (read-digits.1 + 16 + 0 + 4 + #f + in3_0 + config4_0 + accum-str_0))) + (begin + (if (integer? v_0) + (void) + (no-hex-digits + in3_0 + config4_0 + v_0 + c_0 + escaped-c_0)) + (if (let ((or-part_0 + (< + v_0 + 55296))) + (if or-part_0 + or-part_0 + (> + v_0 + 57343))) + (begin + (begin-unsafe + (set-accum-string-pos! + accum-str_0 + pos_0)) + (accum-string-add! + accum-str_0 + (integer->char + v_0))) + (let ((next!_0 + (|#%name| + next! + (lambda () + (begin + (let ((next-c_0 + (read-char-or-special + in3_0 + special1.1 + source_0))) + (begin + (if (char? + next-c_0) + (accum-string-add! + accum-str_0 + next-c_0) + (void)) + next-c_0))))))) + (let ((v2_0 + (let ((next-c_0 + (next!_0))) (if (char=? - next-c_1 - '#\x75) - (let ((v2_0 - (read-digits.1 - 16 - 0 - 4 - #f - in3_0 - config4_0 - accum-str_0))) - (if (integer? - v2_0) - (if (>= - v2_0 - 56320) - (if (<= - v2_0 - 57343) - v2_0 - #f) - #f) - v2_0)) - next-c_1)) - next-c_0)))) - (if (integer? - v2_0) - (let ((combined-v_0 - (let ((app_0 - (arithmetic-shift - (- - v_0 - 55296) - 10))) - (+ - app_0 - (- - v2_0 - 56320) - 65536)))) - (if (> - combined-v_0 - 1114111) - (let ((temp55_0 - "escape sequence `~au~a` is out of range in string")) - (let ((temp57_0 + next-c_0 + '#\x5c) + (let ((next-c_1 + (next!_0))) + (if (char=? + next-c_1 + '#\x75) + (let ((v2_0 + (read-digits.1 + 16 + 0 + 4 + #f + in3_0 + config4_0 + accum-str_0))) + (if (integer? + v2_0) + (if (>= + v2_0 + 56320) + (if (<= + v2_0 + 57343) + v2_0 + #f) + #f) + v2_0)) + next-c_1)) + next-c_0)))) + (if (integer? + v2_0) + (let ((combined-v_0 + (let ((app_0 + (arithmetic-shift + (- + v_0 + 55296) + 10))) + (+ + app_0 + (- + v2_0 + 56320) + 65536)))) + (if (> + combined-v_0 + 1114111) + (let ((temp55_0 + "escape sequence `~au~a` is out of range in string")) + (let ((temp57_0 + (accum-string-get!.1 + pos_0 + accum-str_0 + config4_0))) + (let ((temp55_1 + temp55_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in3_0 + config4_0 + temp55_1 + (list + c_0 + temp57_0))))) + (begin + (begin-unsafe + (set-accum-string-pos! + accum-str_0 + pos_0)) + (accum-string-add! + accum-str_0 + (integer->char + combined-v_0))))) + (let ((temp64_0 + "bad or incomplete surrogate-style encoding at `~au~a`")) + (let ((temp66_0 (accum-string-get!.1 pos_0 accum-str_0 config4_0))) - (let ((temp55_1 - temp55_0)) + (let ((temp64_1 + temp64_0)) (reader-error.1 unsafe-undefined - '#\x78 + v2_0 #f unsafe-undefined in3_0 config4_0 - temp55_1 + temp64_1 (list c_0 - temp57_0))))) - (begin - (begin-unsafe - (set-accum-string-pos! + temp66_0))))))))))))) + (begin + (if (eq? mode1_0 'string) + (void) + (unknown-error_0)) + (let ((pos_0 + (begin-unsafe + (accum-string-pos + accum-str_0)))) + (let ((v_0 + (read-digits.1 + 16 + 0 + 8 + #f + in3_0 + config4_0 + accum-str_0))) + (begin + (if (integer? v_0) + (void) + (no-hex-digits + in3_0 + config4_0 + v_0 + c_0 + escaped-c_0)) + (if (if (let ((or-part_0 + (< + v_0 + 55296))) + (if or-part_0 + or-part_0 + (> + v_0 + 57343))) + (<= + v_0 + 1114111) + #f) + (begin + (begin-unsafe + (set-accum-string-pos! + accum-str_0 + pos_0)) + (accum-string-add! + accum-str_0 + (integer->char + v_0))) + (let ((temp77_0 + "escape sequence `~aU~a` is out of range in string")) + (let ((temp79_0 + (accum-string-get!.1 + pos_0 accum-str_0 - pos_0)) - (accum-string-add! - accum-str_0 - (integer->char - combined-v_0))))) - (let ((temp64_0 - "bad or incomplete surrogate-style encoding at `~au~a`")) - (let ((temp66_0 - (accum-string-get!.1 - pos_0 - accum-str_0 - config4_0))) - (let ((temp64_1 - temp64_0)) - (reader-error.1 - unsafe-undefined - v2_0 - #f - unsafe-undefined - in3_0 - config4_0 - temp64_1 - (list - c_0 - temp66_0)))))))))))) - (begin - (if (eq? mode1_0 'string) - (void) - (unknown-error_0 - c_0 - config4_0 - escaped-c_0 - in3_0 - mode1_0)) - (let ((pos_0 - (begin-unsafe - (accum-string-pos - accum-str_0)))) - (let ((v_0 - (read-digits.1 - 16 - 0 - 8 - #f - in3_0 - config4_0 - accum-str_0))) - (begin - (if (integer? v_0) - (void) - (no-hex-digits - in3_0 - config4_0 - v_0 - c_0 - escaped-c_0)) - (if (if (let ((or-part_0 - (< - v_0 - 55296))) - (if or-part_0 - or-part_0 - (> - v_0 - 57343))) - (<= - v_0 - 1114111) - #f) - (begin - (begin-unsafe - (set-accum-string-pos! - accum-str_0 - pos_0)) - (accum-string-add! - accum-str_0 - (integer->char - v_0))) - (let ((temp77_0 - "escape sequence `~aU~a` is out of range in string")) - (let ((temp79_0 - (accum-string-get!.1 - pos_0 - accum-str_0 - config4_0))) - (let ((temp77_1 - temp77_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in3_0 - config4_0 - temp77_1 - (list - c_0 - temp79_0)))))))))))))))) - (loop_0)))) + config4_0))) + (let ((temp77_1 + temp77_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in3_0 + config4_0 + temp77_1 + (list + c_0 + temp79_0)))))))))))))))) + (loop_0))))) (if (char=? '#\x22 c_0) null (begin @@ -69143,86 +68465,35 @@ (if (eq? mode1_0 '|byte string|) (accum-string-get-bytes!.1 0 accum-str_0 config4_0) (accum-string-get!.1 0 accum-str_0 config4_0)))) - (wrap str_0 in3_0 config4_0 str_0))))) - (args (raise-binding-result-arity-error 3 args)))))))))) + (wrap str_0 in3_0 config4_0 str_0)))))) + (args (raise-binding-result-arity-error 3 args))))))))) (define read-here-string - (letrec ((loop_0 - (|#%name| - loop - (lambda (config_0 in_0 source_0) - (begin - (let ((c_0 (read-char-or-special in_0 special1.1 source_0))) - (if (eof-object? c_0) - (let ((temp94_0 - "found end-of-file after `#<<` and before a newline")) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in_0 - config_0 - temp94_0 - (list))) - (if (not (char? c_0)) - (let ((temp98_0 - "found non-character while reading `#<<`")) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in_0 - config_0 - temp98_0 - (list))) - (if (char=? c_0 '#\xa) - null - (cons c_0 (loop_0 config_0 in_0 source_0))))))))))) - (lambda (in_0 config_0) - (let ((source_0 - (begin-unsafe - (read-config/inner-source (read-config/outer-inner config_0))))) - (call-with-values - (lambda () (port-next-location in_0)) - (case-lambda - ((open-end-line_0 open-end-col_0 open-end-pos_0) - (let ((accum-str_0 (accum-string-init! config_0))) - (let ((full-terminator_0 - (cons '#\xa (loop_0 config_0 in_0 source_0)))) - (begin - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (terminator_0 terminator-accum_0) - (begin - (let ((c_0 - (read-char-or-special - in_0 - special1.1 - source_0))) - (if (eof-object? c_0) - (if (null? terminator_0) - (void) - (let ((temp103_0 - "found end-of-file before terminating `~a`")) - (let ((temp104_0 - (list->string - (cdr full-terminator_0)))) - (let ((temp103_1 temp103_0)) - (reader-error.1 - unsafe-undefined - c_0 - open-end-pos_0 - unsafe-undefined - in_0 - config_0 - temp103_1 - (list temp104_0)))))) - (if (not (char? c_0)) - (let ((temp108_0 - "found non-character while reading `#<<`")) + (lambda (in_0 config_0) + (let ((source_0 + (begin-unsafe + (read-config/inner-source (read-config/outer-inner config_0))))) + (call-with-values + (lambda () (port-next-location in_0)) + (case-lambda + ((open-end-line_0 open-end-col_0 open-end-pos_0) + (let ((accum-str_0 (accum-string-init! config_0))) + (let ((full-terminator_0 + (cons + '#\xa + (letrec* + ((loop_0 + (|#%name| + loop + (lambda () + (begin + (let ((c_0 + (read-char-or-special + in_0 + special1.1 + source_0))) + (if (eof-object? c_0) + (let ((temp94_0 + "found end-of-file after `#<<` and before a newline")) (reader-error.1 unsafe-undefined c_0 @@ -69230,64 +68501,117 @@ unsafe-undefined in_0 config_0 - temp108_0 + temp94_0 (list))) - (if (if (pair? terminator_0) - (char=? c_0 (car terminator_0)) + (if (not (char? c_0)) + (let ((temp98_0 + "found non-character while reading `#<<`")) + (reader-error.1 + unsafe-undefined + c_0 + #f + unsafe-undefined + in_0 + config_0 + temp98_0 + (list))) + (if (char=? c_0 '#\xa) + null + (cons c_0 (loop_0))))))))))) + (loop_0))))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (terminator_0 terminator-accum_0) + (begin + (let ((c_0 + (read-char-or-special in_0 special1.1 source_0))) + (if (eof-object? c_0) + (if (null? terminator_0) + (void) + (let ((temp103_0 + "found end-of-file before terminating `~a`")) + (let ((temp104_0 + (list->string (cdr full-terminator_0)))) + (let ((temp103_1 temp103_0)) + (reader-error.1 + unsafe-undefined + c_0 + open-end-pos_0 + unsafe-undefined + in_0 + config_0 + temp103_1 + (list temp104_0)))))) + (if (not (char? c_0)) + (let ((temp108_0 + "found non-character while reading `#<<`")) + (reader-error.1 + unsafe-undefined + c_0 + #f + unsafe-undefined + in_0 + config_0 + temp108_0 + (list))) + (if (if (pair? terminator_0) + (char=? c_0 (car terminator_0)) + #f) + (let ((app_0 (cdr terminator_0))) + (loop_0 + app_0 + (cons + (car terminator_0) + terminator-accum_0))) + (if (if (null? terminator_0) + (char=? c_0 '#\xa) #f) - (let ((app_0 (cdr terminator_0))) - (loop_1 - app_0 - (cons - (car terminator_0) - terminator-accum_0))) - (if (if (null? terminator_0) - (char=? c_0 '#\xa) - #f) - (void) - (begin - (if (null? terminator-accum_0) - (void) - (begin - (let ((lst_0 - (reverse$1 - terminator-accum_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((c_1 - (unsafe-car + (void) + (begin + (if (null? terminator-accum_0) + (void) + (begin + (let ((lst_0 + (reverse$1 terminator-accum_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? lst_1) + (let ((c_1 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (begin - (accum-string-add! - accum-str_0 - c_1) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void))) - (if (char=? c_0 '#\xa) - (loop_1 - (cdr full-terminator_0) - (list '#\xa)) - (begin - (accum-string-add! accum-str_0 c_0) - (loop_1 - full-terminator_0 - null)))))))))))))) - (loop_1 (cdr full-terminator_0) null)) - (let ((str_0 (accum-string-get!.1 0 accum-str_0 config_0))) - (wrap str_0 in_0 config_0 str_0)))))) - (args (raise-binding-result-arity-error 3 args)))))))) + (begin + (accum-string-add! + accum-str_0 + c_1) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 lst_0)))) + (void))) + (if (char=? c_0 '#\xa) + (loop_0 + (cdr full-terminator_0) + (list '#\xa)) + (begin + (accum-string-add! accum-str_0 c_0) + (loop_0 + full-terminator_0 + null)))))))))))))) + (loop_0 (cdr full-terminator_0) null)) + (let ((str_0 (accum-string-get!.1 0 accum-str_0 config_0))) + (wrap str_0 in_0 config_0 str_0)))))) + (args (raise-binding-result-arity-error 3 args))))))) (define no-hex-digits (lambda (in_0 config_0 c_0 escaping-c_0 escaped-c_0) (let ((temp114_0 "no hex digit following `~a~a`")) @@ -70420,24 +69744,24 @@ (lang-error in_0 l-config_0 (string c_0) c2_0)))))))) (args (raise-binding-result-arity-error 3 args))))))) (define lang-error - (letrec ((add-prefix_0 - (|#%name| - add-prefix - (lambda (prefix_0 s_0) - (begin - (if (string=? prefix_0 "") - (format "`~a` followed by ~a" prefix_0 s_0) - s_0)))))) - (lambda (in_0 config_0 prefix_0 c_0) + (lambda (in_0 config_0 prefix_0 c_0) + (let ((add-prefix_0 + (|#%name| + add-prefix + (lambda (s_0) + (begin + (if (string=? prefix_0 "") + (format "`~a` followed by ~a" prefix_0 s_0) + s_0)))))) (let ((temp15_0 (string-append "expected (after whitespace and comments) `#lang ` or `#!` followed" " immediately by a language name, found ~a"))) (let ((temp16_0 (if (eof-object? c_0) - (add-prefix_0 prefix_0 "end-of-file") + (add-prefix_0 "end-of-file") (if (not (char? c_0)) - (add-prefix_0 prefix_0 "non-character") + (add-prefix_0 "non-character") (format "`~a~a`" prefix_0 c_0))))) (let ((temp15_1 temp15_0)) (reader-error.1 @@ -71785,56 +71109,54 @@ (begin (module->.1 void module-requires 'module->imports mod_0 #f))))) (define 1/module->exports (let ((module->exports_0 - (letrec ((procz1 - (|#%name| - temp41 - (lambda (m_0) - (begin - (let ((app_0 (module-provides m_0))) - (values app_0 (module-self m_0)))))))) - (|#%name| - module->exports - (lambda (mod13_0 verbosity12_0) - (begin - (call-with-values - (lambda () - (let ((temp41_0 procz1)) - (let ((temp44_0 - (lambda () - (check-provides-verbosity - 'module->exports - verbosity12_0)))) - (module->.1 - temp44_0 - temp41_0 - 'module->exports - mod13_0 - #f)))) - (case-lambda - ((provides_0 self_0) - (provides->api-provides provides_0 self_0 verbosity12_0)) - (args (raise-binding-result-arity-error 2 args)))))))))) + (|#%name| + module->exports + (lambda (mod13_0 verbosity12_0) + (begin + (call-with-values + (lambda () + (let ((temp41_0 + (|#%name| + temp41 + (lambda (m_0) + (begin + (let ((app_0 (module-provides m_0))) + (values app_0 (module-self m_0)))))))) + (let ((temp44_0 + (lambda () + (check-provides-verbosity + 'module->exports + verbosity12_0)))) + (module->.1 + temp44_0 + temp41_0 + 'module->exports + mod13_0 + #f)))) + (case-lambda + ((provides_0 self_0) + (provides->api-provides provides_0 self_0 verbosity12_0)) + (args (raise-binding-result-arity-error 2 args))))))))) (|#%name| module->exports (case-lambda ((mod_0) (begin (module->exports_0 mod_0 #f))) ((mod_0 verbosity12_0) (module->exports_0 mod_0 verbosity12_0)))))) (define 1/module->indirect-exports - (letrec ((procz1 - (|#%name| - temp45 - (lambda (m_0) - (begin - (let ((app_0 (module-provides m_0))) - (variables->api-nonprovides - app_0 - (|#%app| (module-get-all-variables m_0))))))))) - (|#%name| - module->indirect-exports - (lambda (mod_0) - (begin - (let ((temp45_0 procz1)) - (module->.1 void temp45_0 'module->indirect-exports mod_0 #f))))))) + (|#%name| + module->indirect-exports + (lambda (mod_0) + (begin + (let ((temp45_0 + (|#%name| + temp45 + (lambda (m_0) + (begin + (let ((app_0 (module-provides m_0))) + (variables->api-nonprovides + app_0 + (|#%app| (module-get-all-variables m_0))))))))) + (module->.1 void temp45_0 'module->indirect-exports mod_0 #f)))))) (define 1/module-provide-protected? (|#%name| module-provide-protected? @@ -72031,36 +71353,105 @@ (1/module-path-index-join mod21_0 #f)))) (1/module-path-index-resolve mpi_0 load?19_0))))))) (define read-linklet-bundle-or-directory - (letrec ((read-bundle-directory_0 - (|#%name| - read-bundle-directory - (lambda (in_0 pos_0) - (begin - (let ((count_0 (read-int in_0))) - (let ((position-to-name_0 - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (count_1 accum_0) - (begin - (if (zero? count_1) - accum_0 - (let ((bstr_0 - (read-bytes (read-int in_0) in_0))) - (let ((offset_0 (read-int in_0))) - (let ((len_0 (read-int in_0))) - (begin - (read-int in_0) - (read-int in_0) - (let ((app_0 (sub1 count_1))) - (loop_0 - app_0 - (hash-set - accum_0 - offset_0 - bstr_0))))))))))))) - (loop_0 count_0 (hasheqv))))) + (lambda (in_0) + (letrec* + ((read-linklet-or-directory_0 + (|#%name| + read-linklet-or-directory + (lambda (initial?_0) + (begin + (let ((start-pos_0 (- (file-position in_0) 2))) + (let ((vers-len_0 (min 63 (read-byte in_0)))) + (let ((vers_0 (read-bytes vers-len_0 in_0))) + (begin + (if (equal? vers_0 version-bytes$1) + (void) + (let ((app_0 (bytes->string/utf-8 vers_0 '#\x3f))) + (raise-read-error + 'read-compiled-linklet + "version mismatch" + "expected" + (version) + "found" + app_0 + "in" + (let ((n_0 (object-name in_0))) + (if (path? n_0) + (unquoted-printing-string (path->string n_0)) + in_0))))) + (let ((vm-len_0 (min 63 (read-byte in_0)))) + (let ((vm_0 (read-bytes vm-len_0 in_0))) + (let ((as-correlated-linklet?_0 + (equal? vm_0 correlated-linklet-vm-bytes))) + (begin + (if (if as-correlated-linklet?_0 + as-correlated-linklet?_0 + (equal? vm_0 vm-bytes$1)) + (void) + (let ((app_0 (bytes->string/utf-8 vm-bytes$1))) + (let ((app_1 + (bytes->string/utf-8 vm_0 '#\x3f))) + (raise-read-error + 'read-compiled-linklet + "virtual-machine mismatch" + "expected" + app_0 + "found" + app_1 + "in" + (let ((n_0 (object-name in_0))) + (if (path? n_0) + (unquoted-printing-string + (path->string n_0)) + in_0)))))) + (let ((tag_0 (read-byte in_0))) + (if (eqv? tag_0 66) + (let ((sha-1_0 (read-bytes 20 in_0))) + (let ((b-ht_0 + (if as-correlated-linklet?_0 + (read-correlated-linklet-bundle-hash + in_0) + (read-linklet-bundle-hash in_0)))) + (begin + (if (hash? b-ht_0) + (void) + (let ((app_0 (format "~s" b-ht_0))) + (raise-read-error + 'read-linklet-bundle-hash + "bad read result" + "expected" + "hash/c" + "found" + app_0 + "in" + (let ((n_0 (object-name in_0))) + (if (path? n_0) + (path->string n_0) + in_0))))) + (hash->linklet-bundle + (add-hash-code + (if initial?_0 + (strip-submodule-references b-ht_0) + b-ht_0) + sha-1_0))))) + (if (eqv? tag_0 68) + (begin + (if initial?_0 + (void) + (raise-read-error + 'read-compiled-linklet + "expected a linklet bundle")) + (read-bundle-directory_0 start-pos_0)) + (raise-read-error + 'read-compiled-linklet + "expected a `B` or `D`")))))))))))))))) + (read-bundle-directory_0 + (|#%name| + read-bundle-directory + (lambda (pos_0) + (begin + (let ((count_0 (read-int in_0))) + (let ((position-to-name_0 (letrec* ((loop_0 (|#%name| @@ -72068,150 +71459,73 @@ (lambda (count_1 accum_0) (begin (if (zero? count_1) - (list->bundle-directory - accum_0 - hash->linklet-directory) - (let ((name_0 - (hash-ref - position-to-name_0 - (- (file-position in_0) pos_0) - #f))) - (begin - (if name_0 - (void) - (raise-read-error - 'read-compiled-linklet - "bundle not at an expected file position")) - (let ((bstr_0 (read-bytes 2 in_0))) - (let ((bundle_0 - (if (equal? #vu8(35 126) bstr_0) - (read-linklet-or-directory_0 - in_0 - #f) - (if (equal? #vu8(35 102) bstr_0) - #f - (raise-read-error - 'read-compiled-linklet - "expected a `#~` or `#f` for a bundle"))))) + accum_0 + (let ((bstr_0 + (read-bytes (read-int in_0) in_0))) + (let ((offset_0 (read-int in_0))) + (let ((len_0 (read-int in_0))) + (begin + (read-int in_0) + (read-int in_0) (let ((app_0 (sub1 count_1))) (loop_0 app_0 - (cons - (cons - (decode-name name_0 0) - bundle_0) - accum_0))))))))))))) - (loop_0 count_0 '())))))))) - (read-linklet-or-directory_0 - (|#%name| - read-linklet-or-directory - (lambda (in_0 initial?_0) - (begin - (let ((start-pos_0 (- (file-position in_0) 2))) - (let ((vers-len_0 (min 63 (read-byte in_0)))) - (let ((vers_0 (read-bytes vers-len_0 in_0))) - (begin - (if (equal? vers_0 version-bytes$1) - (void) - (let ((app_0 (bytes->string/utf-8 vers_0 '#\x3f))) - (raise-read-error - 'read-compiled-linklet - "version mismatch" - "expected" - (version) - "found" - app_0 - "in" - (let ((n_0 (object-name in_0))) - (if (path? n_0) - (unquoted-printing-string (path->string n_0)) - in_0))))) - (let ((vm-len_0 (min 63 (read-byte in_0)))) - (let ((vm_0 (read-bytes vm-len_0 in_0))) - (let ((as-correlated-linklet?_0 - (equal? vm_0 correlated-linklet-vm-bytes))) - (begin - (if (if as-correlated-linklet?_0 - as-correlated-linklet?_0 - (equal? vm_0 vm-bytes$1)) - (void) - (let ((app_0 - (bytes->string/utf-8 vm-bytes$1))) - (let ((app_1 - (bytes->string/utf-8 vm_0 '#\x3f))) - (raise-read-error - 'read-compiled-linklet - "virtual-machine mismatch" - "expected" - app_0 - "found" - app_1 - "in" - (let ((n_0 (object-name in_0))) - (if (path? n_0) - (unquoted-printing-string - (path->string n_0)) - in_0)))))) - (let ((tag_0 (read-byte in_0))) - (if (eqv? tag_0 66) - (let ((sha-1_0 (read-bytes 20 in_0))) - (let ((b-ht_0 - (if as-correlated-linklet?_0 - (read-correlated-linklet-bundle-hash - in_0) - (read-linklet-bundle-hash - in_0)))) - (begin - (if (hash? b-ht_0) - (void) - (let ((app_0 - (format "~s" b-ht_0))) - (raise-read-error - 'read-linklet-bundle-hash - "bad read result" - "expected" - "hash/c" - "found" - app_0 - "in" - (let ((n_0 (object-name in_0))) - (if (path? n_0) - (path->string n_0) - in_0))))) - (hash->linklet-bundle - (add-hash-code - (if initial?_0 - (strip-submodule-references - b-ht_0) - b-ht_0) - sha-1_0))))) - (if (eqv? tag_0 68) - (begin - (if initial?_0 - (void) + (hash-set + accum_0 + offset_0 + bstr_0))))))))))))) + (loop_0 count_0 (hasheqv))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (count_1 accum_0) + (begin + (if (zero? count_1) + (list->bundle-directory + accum_0 + hash->linklet-directory) + (let ((name_0 + (hash-ref + position-to-name_0 + (- (file-position in_0) pos_0) + #f))) + (begin + (if name_0 + (void) + (raise-read-error + 'read-compiled-linklet + "bundle not at an expected file position")) + (let ((bstr_0 (read-bytes 2 in_0))) + (let ((bundle_0 + (if (equal? #vu8(35 126) bstr_0) + (read-linklet-or-directory_0 #f) + (if (equal? #vu8(35 102) bstr_0) + #f (raise-read-error 'read-compiled-linklet - "expected a linklet bundle")) - (read-bundle-directory_0 - in_0 - start-pos_0)) - (raise-read-error - 'read-compiled-linklet - "expected a `B` or `D`"))))))))))))))))) - (lambda (in_0) (read-linklet-or-directory_0 in_0 #t)))) + "expected a `#~` or `#f` for a bundle"))))) + (let ((app_0 (sub1 count_1))) + (loop_0 + app_0 + (cons + (cons (decode-name name_0 0) bundle_0) + accum_0))))))))))))) + (loop_0 count_0 '()))))))))) + (read-linklet-or-directory_0 #t)))) (define read-int (lambda (in_0) (integer-bytes->integer (read-bytes 4 in_0) #f #f))) (define decode-name - (letrec ((bad-bundle_0 - (|#%name| - bad-bundle - (lambda () - (begin - (raise-read-error - 'read-compiled-linklet - "malformed bundle")))))) - (lambda (bstr_0 pos_0) - (let ((blen_0 (unsafe-bytes-length bstr_0))) + (lambda (bstr_0 pos_0) + (let ((blen_0 (unsafe-bytes-length bstr_0))) + (let ((bad-bundle_0 + (|#%name| + bad-bundle + (lambda () + (begin + (raise-read-error + 'read-compiled-linklet + "malformed bundle")))))) (if (= pos_0 blen_0) '() (if (> pos_0 blen_0) @@ -72340,27 +71654,31 @@ b-ht_0 (hash-set b-ht_0 'hash-code sha-1_0)))) (define raise-read-error - (letrec ((loop_0 - (|#%name| - loop - (lambda (details_0) - (begin - (if (null? details_0) - null - (let ((app_0 (car details_0))) - (let ((app_1 (format "~v" (cadr details_0)))) - (list* - " " - app_0 - ": " - app_1 - (loop_0 (cddr details_0))))))))))) - (lambda (who_0 msg_0 . details_0) - (raise - (let ((app_0 - (let ((app_0 (format "~a: ~a" who_0 msg_0))) - (apply string-append app_0 (loop_0 details_0))))) - (|#%app| exn:fail:read app_0 (current-continuation-marks) null)))))) + (lambda (who_0 msg_0 . details_0) + (raise + (let ((app_0 + (let ((app_0 (format "~a: ~a" who_0 msg_0))) + (apply + string-append + app_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (details_1) + (begin + (if (null? details_1) + null + (let ((app_1 (car details_1))) + (let ((app_2 (format "~v" (cadr details_1)))) + (list* + " " + app_1 + ": " + app_2 + (loop_0 (cddr details_1))))))))))) + (loop_0 details_0)))))) + (|#%app| exn:fail:read app_0 (current-continuation-marks) null))))) (define read-syntax$1 (|#%name| read-syntax @@ -72909,26 +72227,27 @@ 1/exn:fail:filesystem:missing-module? 1/exn:fail:filesystem:missing-module-path) (call-with-values - (letrec ((procz1 - (lambda (e_0) - (|#%app| - (check-not-unsafe-undefined - 1/exn:fail:filesystem:missing-module-path - '1/exn:fail:filesystem:missing-module-path) - e_0)))) - (lambda () - (make-struct-type - 'exn:fail:filesystem:missing-module - struct:exn:fail:filesystem - 1 - 0 - #f - (list (cons 1/prop:exn:missing-module procz1)) - #f - #f - '(0) - #f - 'exn:fail:filesystem:missing-module))) + (lambda () + (make-struct-type + 'exn:fail:filesystem:missing-module + struct:exn:fail:filesystem + 1 + 0 + #f + (list + (cons + 1/prop:exn:missing-module + (lambda (e_0) + (|#%app| + (check-not-unsafe-undefined + 1/exn:fail:filesystem:missing-module-path + '1/exn:fail:filesystem:missing-module-path) + e_0)))) + #f + #f + '(0) + #f + 'exn:fail:filesystem:missing-module)) (case-lambda ((struct:_0 make-_0 ?_0 -ref_0 -set!_0) (values struct:_0 make-_0 ?_0 (make-struct-field-accessor -ref_0 0 'path))) @@ -72939,26 +72258,27 @@ 1/exn:fail:syntax:missing-module? 1/exn:fail:syntax:missing-module-path) (call-with-values - (letrec ((procz1 - (lambda (e_0) - (|#%app| - (check-not-unsafe-undefined - 1/exn:fail:syntax:missing-module-path - '1/exn:fail:syntax:missing-module-path) - e_0)))) - (lambda () - (make-struct-type - 'exn:fail:syntax:missing-module - 1/struct:exn:fail:syntax - 1 - 0 - #f - (list (cons 1/prop:exn:missing-module procz1)) - #f - #f - '(0) - #f - 'exn:fail:syntax:missing-module))) + (lambda () + (make-struct-type + 'exn:fail:syntax:missing-module + 1/struct:exn:fail:syntax + 1 + 0 + #f + (list + (cons + 1/prop:exn:missing-module + (lambda (e_0) + (|#%app| + (check-not-unsafe-undefined + 1/exn:fail:syntax:missing-module-path + '1/exn:fail:syntax:missing-module-path) + e_0)))) + #f + #f + '(0) + #f + 'exn:fail:syntax:missing-module)) (case-lambda ((struct:_0 make-_0 ?_0 -ref_0 -set!_0) (values struct:_0 make-_0 ?_0 (make-struct-field-accessor -ref_0 0 'path))) @@ -75147,61 +74467,48 @@ filename_0) #f)))))) (define default-load-handler - (letrec ((procz1 - (lambda args_0 - (apply - abort-current-continuation - (default-continuation-prompt-tag) - args_0))) - (add-top-interaction_0 - (|#%name| - add-top-interaction - (lambda (s_0) - (begin - (1/namespace-syntax-introduce - (1/datum->syntax #f (cons '|#%top-interaction| s_0) s_0)))))) - (maybe-count-lines!_0 - (|#%name| - maybe-count-lines! - (lambda (path_0 i_0) - (begin - (if (regexp-match? rx2937 path_0) - (void) - (port-count-lines! i_0))))))) - (lambda (path_0 expected-mod_0) + (lambda (path_0 expected-mod_0) + (begin + (if (path-string? path_0) + (void) + (raise-argument-error 'default-load-handler "path-string?" path_0)) (begin - (if (path-string? path_0) - (void) - (raise-argument-error 'default-load-handler "path-string?" path_0)) - (begin - (if (let ((or-part_0 (not expected-mod_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (symbol? expected-mod_0))) - (if or-part_1 - or-part_1 - (if (pair? expected-mod_0) - (if (list? expected-mod_0) - (if (let ((or-part_2 (not (car expected-mod_0)))) - (if or-part_2 - or-part_2 - (symbol? (car expected-mod_0)))) - (andmap_2344 symbol? (cdr expected-mod_0)) - #f) + (if (let ((or-part_0 (not expected-mod_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (symbol? expected-mod_0))) + (if or-part_1 + or-part_1 + (if (pair? expected-mod_0) + (if (list? expected-mod_0) + (if (let ((or-part_2 (not (car expected-mod_0)))) + (if or-part_2 + or-part_2 + (symbol? (car expected-mod_0)))) + (andmap_2344 symbol? (cdr expected-mod_0)) #f) - #f))))) - (void) - (raise-argument-error - 'default-load-handler - "(or/c #f symbol? (cons/c (or/c #f symbol?) (non-empty-listof symbol?)))" - expected-mod_0)) + #f) + #f))))) + (void) + (raise-argument-error + 'default-load-handler + "(or/c #f symbol? (cons/c (or/c #f symbol?) (non-empty-listof symbol?)))" + expected-mod_0)) + (let ((maybe-count-lines!_0 + (|#%name| + maybe-count-lines! + (lambda (i_0) + (begin + (if (regexp-match? rx2937 path_0) + (void) + (port-count-lines! i_0))))))) (if expected-mod_0 (|#%app| (call-with-input-module-file path_0 (lambda (i_0) (begin - (maybe-count-lines!_0 path_0 i_0) + (maybe-count-lines!_0 i_0) (with-module-reading-parameterization+delay-source path_0 (lambda () @@ -75287,67 +74594,83 @@ (|#%app| (1/current-eval) m-s_0)))))))))))))))))) - (let ((temp2_0 + (let ((add-top-interaction_0 (|#%name| - temp2 - (lambda (i_0) + add-top-interaction + (lambda (s_0) (begin + (1/namespace-syntax-introduce + (1/datum->syntax + #f + (cons '|#%top-interaction| s_0) + s_0))))))) + (let ((temp2_0 + (|#%name| + temp2 + (lambda (i_0) (begin - (maybe-count-lines!_0 path_0 i_0) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (vals_0) - (begin - (let ((s_0 - (with-continuation-mark* - push-authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first - #f - parameterization-key) - 1/read-accept-compiled - #t - 1/read-accept-reader - #t - 1/read-accept-lang - #t) - (if (load-on-demand-enabled) - (with-continuation-mark* - authentic - parameterization-key - (let ((app_0 - (continuation-mark-set-first - #f - parameterization-key))) - (extend-parameterization - app_0 - read-on-demand-source - (path->complete-path path_0))) - (1/read-syntax - (object-name i_0) - i_0)) - (1/read-syntax - (object-name i_0) - i_0))))) - (if (eof-object? s_0) - (apply values vals_0) - (loop_0 - (call-with-continuation-prompt - (lambda () - (call-with-values - (lambda () - (let ((app_0 (1/current-eval))) - (|#%app| - app_0 - (add-top-interaction_0 s_0)))) - list)) - (default-continuation-prompt-tag) - procz1))))))))) - (loop_0 (list (void)))))))))) - (call-with-input-file*.1 'binary path_0 temp2_0)))))))) + (begin + (maybe-count-lines!_0 i_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (vals_0) + (begin + (let ((s_0 + (with-continuation-mark* + push-authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first + #f + parameterization-key) + 1/read-accept-compiled + #t + 1/read-accept-reader + #t + 1/read-accept-lang + #t) + (if (load-on-demand-enabled) + (with-continuation-mark* + authentic + parameterization-key + (let ((app_0 + (continuation-mark-set-first + #f + parameterization-key))) + (extend-parameterization + app_0 + read-on-demand-source + (path->complete-path + path_0))) + (1/read-syntax + (object-name i_0) + i_0)) + (1/read-syntax + (object-name i_0) + i_0))))) + (if (eof-object? s_0) + (apply values vals_0) + (loop_0 + (call-with-continuation-prompt + (lambda () + (call-with-values + (lambda () + (let ((app_0 (1/current-eval))) + (|#%app| + app_0 + (add-top-interaction_0 + s_0)))) + list)) + (default-continuation-prompt-tag) + (lambda args_0 + (apply + abort-current-continuation + (default-continuation-prompt-tag) + args_0))))))))))) + (loop_0 (list (void)))))))))) + (call-with-input-file*.1 'binary path_0 temp2_0))))))))) (define version-bytes (string->bytes/utf-8 (version))) (define version-length (unsafe-bytes-length version-bytes)) (define vm-bytes (string->bytes/utf-8 (symbol->string (system-type 'vm)))) @@ -75429,14 +74752,13 @@ (make-module-cache-key (linklet-bundle-hash-code i_0))))) (if c3_0 (lambda () (|#%app| c3_0 (1/current-namespace))) #f)))) (define read-number - (letrec ((read-byte/not-eof_0 - (|#%name| - read-byte/not-eof - (lambda (i_0) - (begin - (let ((v_0 (read-byte i_0))) - (if (eof-object? v_0) 0 v_0))))))) - (lambda (i_0) + (lambda (i_0) + (let ((read-byte/not-eof_0 + (|#%name| + read-byte/not-eof + (lambda (i_1) + (begin + (let ((v_0 (read-byte i_1))) (if (eof-object? v_0) 0 v_0))))))) (let ((app_0 (read-byte/not-eof_0 i_0))) (let ((app_1 (arithmetic-shift (read-byte/not-eof_0 i_0) 8))) (let ((app_2 (arithmetic-shift (read-byte/not-eof_0 i_0) 16))) @@ -75558,13 +74880,16 @@ (let ((d_0 (current-load-relative-directory))) (if d_0 (path->complete-path s_0 d_0) s_0)))))))) (let ((date-of-1_0 - (letrec ((procz1 (lambda () #f))) - (|#%name| - date-of-1 - (lambda (a_0) - (begin - (let ((v_0 (file-or-directory-modify-seconds a_0 #f procz1))) - (if v_0 (cons a_0 v_0) #f)))))))) + (|#%name| + date-of-1 + (lambda (a_0) + (begin + (let ((v_0 + (file-or-directory-modify-seconds + a_0 + #f + (lambda () #f)))) + (if v_0 (cons a_0 v_0) #f))))))) (let ((date-of_0 (|#%name| date-of @@ -75614,160 +74939,129 @@ current-load-relative-directory (if (path? base_0) base_0 (current-directory)))) (|#%app| t_0))))))) - (letrec ((get-so_0 - (|#%name| - get-so - (lambda (base_0 file_0 rep-sfx?_0) - (begin - (if (eq? 'racket (system-type 'vm)) - (lambda (root-dir_0 compiled-dir_0) - (let ((app_0 (reroot_0 base_0 root-dir_0))) - (let ((app_1 (system-library-subpath))) - (build-path - app_0 - compiled-dir_0 - "native" - app_1 - (if rep-sfx?_0 - (begin-unsafe - (path-adjust-extension - 'path-add-extension - #vu8(95) - subbytes - file_0 - dll-suffix - #t)) - file_0))))) - #f))))) - (reroot_0 - (|#%name| - reroot - (lambda (p_0 d_0) - (begin - (if (eq? d_0 'same) - p_0 - (if (relative-path? d_0) - (build-path p_0 d_0) - (reroot-path p_0 d_0))))))) - (with-dir_0 - (|#%name| - with-dir - (lambda (base_0 t_0) - (begin (with-dir*_0 base_0 t_0)))))) - (lambda (path_0 expect-module_0) + (lambda (path_0 expect-module_0) + (begin + (if (path-string? path_0) + (void) + (raise-argument-error + 'load/use-compiled + "path-string?" + path_0)) (begin - (if (path-string? path_0) + (if (let ((or-part_0 (not expect-module_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (symbol? expect-module_0))) + (if or-part_1 + or-part_1 + (if (list? expect-module_0) + (if (> (length expect-module_0) 1) + (if (let ((or-part_2 + (symbol? (car expect-module_0)))) + (if or-part_2 + or-part_2 + (not (car expect-module_0)))) + (andmap_2344 symbol? (cdr expect-module_0)) + #f) + #f) + #f))))) (void) (raise-argument-error 'load/use-compiled - "path-string?" + "(or/c #f symbol? (cons/c (or/c #f symbol?) (non-empty-listof symbol?)))" path_0)) - (begin - (if (let ((or-part_0 (not expect-module_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (symbol? expect-module_0))) - (if or-part_1 - or-part_1 - (if (list? expect-module_0) - (if (> (length expect-module_0) 1) - (if (let ((or-part_2 - (symbol? - (car expect-module_0)))) - (if or-part_2 - or-part_2 - (not (car expect-module_0)))) - (andmap_2344 - symbol? - (cdr expect-module_0)) - #f) - #f) - #f))))) - (void) - (raise-argument-error - 'load/use-compiled - "(or/c #f symbol? (cons/c (or/c #f symbol?) (non-empty-listof symbol?)))" - path_0)) - (let ((name_0 - (if expect-module_0 - (1/current-module-declare-name) + (let ((name_0 + (if expect-module_0 + (1/current-module-declare-name) + #f))) + (let ((ns-hts_0 + (if name_0 + (registry-table-ref + (namespace-module-registry$1 + (1/current-namespace))) #f))) - (let ((ns-hts_0 - (if name_0 - (registry-table-ref - (namespace-module-registry$1 - (1/current-namespace))) + (let ((use-path/src_0 + (if ns-hts_0 + (hash-ref (cdr ns-hts_0) name_0 #f) #f))) - (let ((use-path/src_0 - (if ns-hts_0 - (hash-ref (cdr ns-hts_0) name_0 #f) - #f))) - (if use-path/src_0 - (with-continuation-mark* - authentic - parameterization-key - (let ((app_0 - (continuation-mark-set-first - #f - parameterization-key))) - (extend-parameterization - app_0 - 1/current-module-declare-source - (cadr use-path/src_0))) - (with-dir*_0 - (caddr use-path/src_0) - (lambda () - (let ((app_0 (1/current-load))) - (|#%app| - app_0 - (car use-path/src_0) - expect-module_0))))) - (let ((orig-path_0 (resolve_0 path_0))) - (call-with-values - (lambda () (split-path path_0)) - (case-lambda - ((base_0 orig-file_0 dir?_0) - (call-with-values - (lambda () - (if expect-module_0 - (let ((b_0 (path->bytes orig-file_0))) - (let ((len_0 - (unsafe-bytes-length b_0))) - (if (if (>= len_0 4) - (bytes=? - #vu8(46 114 107 116) - (subbytes b_0 (- len_0 4))) - #f) - (values - orig-file_0 - (bytes->path - (bytes-append - (subbytes b_0 0 (- len_0 4)) - #vu8(46 115 115)))) - (values orig-file_0 #f)))) - (values orig-file_0 #f))) - (case-lambda - ((file_0 alt-file_0) - (let ((path_1 - (if (eq? file_0 orig-file_0) - orig-path_0 - (build-path base_0 file_0)))) - (let ((alt-path_0 - (if alt-file_0 - (if (eq? alt-file_0 orig-file_0) - orig-path_0 - (build-path - base_0 - alt-file_0)) - #f))) - (let ((base_1 - (if (eq? base_0 'relative) - 'same - base_0))) - (let ((modes_0 - (1/use-compiled-file-paths))) - (let ((roots_0 - (1/current-compiled-file-roots))) + (if use-path/src_0 + (with-continuation-mark* + authentic + parameterization-key + (let ((app_0 + (continuation-mark-set-first + #f + parameterization-key))) + (extend-parameterization + app_0 + 1/current-module-declare-source + (cadr use-path/src_0))) + (with-dir*_0 + (caddr use-path/src_0) + (lambda () + (let ((app_0 (1/current-load))) + (|#%app| + app_0 + (car use-path/src_0) + expect-module_0))))) + (let ((orig-path_0 (resolve_0 path_0))) + (call-with-values + (lambda () (split-path path_0)) + (case-lambda + ((base_0 orig-file_0 dir?_0) + (call-with-values + (lambda () + (if expect-module_0 + (let ((b_0 (path->bytes orig-file_0))) + (let ((len_0 (unsafe-bytes-length b_0))) + (if (if (>= len_0 4) + (bytes=? + #vu8(46 114 107 116) + (subbytes b_0 (- len_0 4))) + #f) + (values + orig-file_0 + (bytes->path + (bytes-append + (subbytes b_0 0 (- len_0 4)) + #vu8(46 115 115)))) + (values orig-file_0 #f)))) + (values orig-file_0 #f))) + (case-lambda + ((file_0 alt-file_0) + (let ((path_1 + (if (eq? file_0 orig-file_0) + orig-path_0 + (build-path base_0 file_0)))) + (let ((alt-path_0 + (if alt-file_0 + (if (eq? alt-file_0 orig-file_0) + orig-path_0 + (build-path base_0 alt-file_0)) + #f))) + (let ((base_1 + (if (eq? base_0 'relative) + 'same + base_0))) + (let ((modes_0 + (1/use-compiled-file-paths))) + (let ((roots_0 + (1/current-compiled-file-roots))) + (let ((reroot_0 + (|#%name| + reroot + (lambda (p_0 d_0) + (begin + (if (eq? d_0 'same) + p_0 + (if (relative-path? + d_0) + (build-path + p_0 + d_0) + (reroot-path + p_0 + d_0)))))))) (let ((main-path-d_0 (date-of-1_0 path_1))) (let ((alt-path-d_0 @@ -75782,32 +75076,43 @@ (if main-path-d_0 main-path-d_0 alt-path-d_0))) - (let ((zo_0 + (let ((get-so_0 (|#%name| - zo - (lambda (root-dir_0 - compiled-dir_0) + get-so + (lambda (file_1 + rep-sfx?_0) (begin - (let ((app_0 - (reroot_0 - base_1 - root-dir_0))) - (build-path - app_0 - compiled-dir_0 - (let ((sfx_0 - #vu8(46 122 111))) - (begin-unsafe - (path-adjust-extension - 'path-add-extension - #vu8(95) - subbytes - file_0 - sfx_0 - #t)))))))))) - (let ((alt-zo_0 + (if (eq? + 'racket + (system-type + 'vm)) + (lambda (root-dir_0 + compiled-dir_0) + (let ((app_0 + (reroot_0 + base_1 + root-dir_0))) + (let ((app_1 + (system-library-subpath))) + (build-path + app_0 + compiled-dir_0 + "native" + app_1 + (if rep-sfx?_0 + (begin-unsafe + (path-adjust-extension + 'path-add-extension + #vu8(95) + subbytes + file_1 + dll-suffix + #t)) + file_1))))) + #f)))))) + (let ((zo_0 (|#%name| - alt-zo + zo (lambda (root-dir_0 compiled-dir_0) (begin @@ -75825,76 +75130,71 @@ 'path-add-extension #vu8(95) subbytes - alt-file_0 + file_0 sfx_0 #t)))))))))) - (let ((so_0 - (get-so_0 - base_1 - file_0 - #t))) - (let ((alt-so_0 + (let ((alt-zo_0 + (|#%name| + alt-zo + (lambda (root-dir_0 + compiled-dir_0) + (begin + (let ((app_0 + (reroot_0 + base_1 + root-dir_0))) + (build-path + app_0 + compiled-dir_0 + (let ((sfx_0 + #vu8(46 122 111))) + (begin-unsafe + (path-adjust-extension + 'path-add-extension + #vu8(95) + subbytes + alt-file_0 + sfx_0 + #t)))))))))) + (let ((so_0 (get-so_0 - base_1 - alt-file_0 + file_0 #t))) - (let ((try-main?_0 - (if main-path-d_0 - main-path-d_0 - (not - alt-path-d_0)))) - (let ((try-alt?_0 - (if alt-file_0 - (if alt-path-d_0 - alt-path-d_0 - (not - main-path-d_0)) - #f))) - (let ((c4_0 - (if so_0 - (if try-main?_0 - (date>=?_0 - modes_0 - roots_0 - so_0 - path-d_0) - #f) + (let ((alt-so_0 + (get-so_0 + alt-file_0 + #t))) + (let ((try-main?_0 + (if main-path-d_0 + main-path-d_0 + (not + alt-path-d_0)))) + (let ((try-alt?_0 + (if alt-file_0 + (if alt-path-d_0 + alt-path-d_0 + (not + main-path-d_0)) #f))) - (if c4_0 - (with-continuation-mark* - authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first - #f - parameterization-key) - 1/current-module-declare-source - #f) - (let ((t_0 - (lambda () - (let ((app_0 - (current-load-extension))) - (|#%app| - app_0 - (car - c4_0) - expect-module_0))))) - (begin-unsafe - (begin - (with-dir*_0 - base_1 - t_0))))) - (let ((c3_0 - (if alt-so_0 - (if try-alt?_0 + (let ((with-dir_0 + (|#%name| + with-dir + (lambda (t_0) + (begin + (with-dir*_0 + base_1 + t_0)))))) + (let ((c4_0 + (if so_0 + (if try-main?_0 (date>=?_0 modes_0 roots_0 - alt-so_0 - alt-path-d_0) + so_0 + path-d_0) #f) #f))) - (if c3_0 + (if c4_0 (with-continuation-mark* authentic parameterization-key @@ -75903,7 +75203,7 @@ #f parameterization-key) 1/current-module-declare-source - alt-path_0) + #f) (let ((t_0 (lambda () (let ((app_0 @@ -75911,69 +75211,63 @@ (|#%app| app_0 (car - c3_0) + c4_0) expect-module_0))))) (begin-unsafe (begin (with-dir*_0 base_1 t_0))))) - (let ((c2_0 - (if try-main?_0 - (date>=?_0 - modes_0 - roots_0 - zo_0 - path-d_0) + (let ((c3_0 + (if alt-so_0 + (if try-alt?_0 + (date>=?_0 + modes_0 + roots_0 + alt-so_0 + alt-path-d_0) + #f) #f))) - (if c2_0 - (begin - (register-zo-path - name_0 - ns-hts_0 - (car - c2_0) + (if c3_0 + (with-continuation-mark* + authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first #f - base_1) - (with-continuation-mark* - authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first - #f - parameterization-key) - 1/current-module-declare-source - #f) - (let ((t_0 - (lambda () - (let ((app_0 - (1/current-load))) - (|#%app| - app_0 - (car - c2_0) - expect-module_0))))) - (begin-unsafe - (begin - (with-dir*_0 - base_1 - t_0)))))) - (let ((c1_0 - (if try-alt?_0 + parameterization-key) + 1/current-module-declare-source + alt-path_0) + (let ((t_0 + (lambda () + (let ((app_0 + (current-load-extension))) + (|#%app| + app_0 + (car + c3_0) + expect-module_0))))) + (begin-unsafe + (begin + (with-dir*_0 + base_1 + t_0))))) + (let ((c2_0 + (if try-main?_0 (date>=?_0 modes_0 roots_0 - alt-zo_0 + zo_0 path-d_0) #f))) - (if c1_0 + (if c2_0 (begin (register-zo-path name_0 ns-hts_0 (car - c1_0) - alt-path_0 + c2_0) + #f base_1) (with-continuation-mark* authentic @@ -75983,7 +75277,7 @@ #f parameterization-key) 1/current-module-declare-source - alt-path_0) + #f) (let ((t_0 (lambda () (let ((app_0 @@ -75991,68 +75285,106 @@ (|#%app| app_0 (car - c1_0) + c2_0) expect-module_0))))) (begin-unsafe (begin (with-dir*_0 base_1 t_0)))))) - (if (let ((or-part_0 - (not - (pair? - expect-module_0)))) - (if or-part_0 - or-part_0 - (car - expect-module_0))) - (let ((p_0 - (if try-main?_0 - path_1 - alt-path_0))) - (if (if (pair? - expect-module_0) - (not - (file-exists? - p_0)) - #f) - (void) + (let ((c1_0 + (if try-alt?_0 + (date>=?_0 + modes_0 + roots_0 + alt-zo_0 + path-d_0) + #f))) + (if c1_0 + (begin + (register-zo-path + name_0 + ns-hts_0 + (car + c1_0) + alt-path_0 + base_1) (with-continuation-mark* authentic parameterization-key - (let ((app_0 - (continuation-mark-set-first - #f - parameterization-key))) - (extend-parameterization - app_0 - 1/current-module-declare-source - (if expect-module_0 - (if (not - try-main?_0) - p_0 - #f) - #f))) + (extend-parameterization + (continuation-mark-set-first + #f + parameterization-key) + 1/current-module-declare-source + alt-path_0) (let ((t_0 (lambda () - (|#%app| - (1/current-load) - p_0 - expect-module_0)))) + (let ((app_0 + (1/current-load))) + (|#%app| + app_0 + (car + c1_0) + expect-module_0))))) (begin-unsafe (begin (with-dir*_0 base_1 - t_0))))))) - (void))))))))))))))))))))))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 3 - args))))))))))))))))))) + t_0)))))) + (if (let ((or-part_0 + (not + (pair? + expect-module_0)))) + (if or-part_0 + or-part_0 + (car + expect-module_0))) + (let ((p_0 + (if try-main?_0 + path_1 + alt-path_0))) + (if (if (pair? + expect-module_0) + (not + (file-exists? + p_0)) + #f) + (void) + (with-continuation-mark* + authentic + parameterization-key + (let ((app_0 + (continuation-mark-set-first + #f + parameterization-key))) + (extend-parameterization + app_0 + 1/current-module-declare-source + (if expect-module_0 + (if (not + try-main?_0) + p_0 + #f) + #f))) + (let ((t_0 + (lambda () + (|#%app| + (1/current-load) + p_0 + expect-module_0)))) + (begin-unsafe + (begin + (with-dir*_0 + base_1 + t_0))))))) + (void)))))))))))))))))))))))))))) + (args + (raise-binding-result-arity-error 2 args))))) + (args + (raise-binding-result-arity-error + 3 + args)))))))))))))))))) (define register-zo-path (lambda (name_0 ns-hts_0 path_0 src-path_0 base_0) (if ns-hts_0 @@ -76093,41 +75425,47 @@ (define cell.3 (unsafe-make-place-local #f)) (define cell.4 (unsafe-make-place-local #f)) (define split-relative-string - (letrec ((loop_0 - (|#%name| - loop - (lambda (l_0) - (begin - (if (null? (cdr l_0)) - (values null (car l_0)) - (call-with-values - (lambda () (loop_0 (cdr l_0))) - (case-lambda - ((c_0 f_0) (values (cons (car l_0) c_0) f_0)) - (args (raise-binding-result-arity-error 2 args))))))))) - (loop_1 - (|#%name| - loop - (lambda (s_0) - (begin - (let ((len_0 (string-length s_0))) - (letrec* - ((iloop_0 - (|#%name| - iloop - (lambda (i_0) - (begin - (if (= i_0 len_0) - (list s_0) - (if (char=? '#\x2f (string-ref s_0 i_0)) - (let ((app_0 (substring s_0 0 i_0))) - (cons - app_0 - (loop_1 (substring s_0 (add1 i_0))))) - (iloop_0 (add1 i_0))))))))) - (iloop_0 0)))))))) - (lambda (s_0 coll-mode?_0) - (let ((l_0 (loop_1 s_0))) (if coll-mode?_0 l_0 (loop_0 l_0)))))) + (lambda (s_0 coll-mode?_0) + (let ((l_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (s_1) + (begin + (let ((len_0 (string-length s_1))) + (letrec* + ((iloop_0 + (|#%name| + iloop + (lambda (i_0) + (begin + (if (= i_0 len_0) + (list s_1) + (if (char=? '#\x2f (string-ref s_1 i_0)) + (let ((app_0 (substring s_1 0 i_0))) + (cons + app_0 + (loop_0 (substring s_1 (add1 i_0))))) + (iloop_0 (add1 i_0))))))))) + (iloop_0 0)))))))) + (loop_0 s_0)))) + (if coll-mode?_0 + l_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1) + (begin + (if (null? (cdr l_1)) + (values null (car l_1)) + (call-with-values + (lambda () (loop_0 (cdr l_1))) + (case-lambda + ((c_0 f_0) (values (cons (car l_1) c_0) f_0)) + (args (raise-binding-result-arity-error 2 args)))))))))) + (loop_0 l_0)))))) (define format-source-location (lambda (stx_0) (srcloc->string @@ -76157,189 +75495,128 @@ '(lib "planet/resolver.rkt") 'planet-module-name-resolver)))))) (define standard-module-name-resolver - (letrec ((procz8 - (lambda (f_0) - (call-with-continuation-prompt f_0 -loading-prompt-tag))) - (procz7 (lambda (f_0) (|#%app| f_0))) - (procz6 (lambda (p_0) (split-relative-string p_0 #t))) - (procz5 - (lambda (s_0) - (if (string=? s_0 ".") 'same (if (string=? s_0 "..") 'up s_0)))) - (procz4 - (|#%name| - path-ss->rkt - (lambda (p_0) - (begin - (call-with-values - (lambda () (split-path p_0)) - (case-lambda - ((base_0 name_0 dir?_0) - (if (regexp-match rx2418 (path->bytes name_0)) - (path-replace-extension p_0 #vu8(46 114 107 116)) - p_0)) - (args (raise-binding-result-arity-error 3 args)))))))) - (procz3 - (|#%name| - ss->rkt - (lambda (s_0) - (begin - (let ((len_0 (string-length s_0))) - (if (if (>= len_0 3) - (if (eqv? '#\x2e (string-ref s_0 (- len_0 3))) - (if (eqv? '#\x73 (string-ref s_0 (- len_0 2))) - (eqv? '#\x73 (string-ref s_0 (- len_0 1))) - #f) - #f) - #f) - (string-append (substring s_0 0 (- len_0 3)) ".rkt") - s_0)))))) - (procz2 - (|#%name| - invent-collection-dir - (lambda (f-file_0 col_0 col-path_0 fail_0) - (begin - (lambda (msg_0) - (string->uninterned-symbol - (path->string - (build-path - (apply build-path col_0 col-path_0) - f-file_0)))))))) - (procz1 - (|#%name| - get-reg - (lambda () - (begin (namespace-module-registry$1 (1/current-namespace)))))) - (flatten-sub-path_0 - (|#%name| - flatten-sub-path - (lambda (base_0 orig-l_0) - (begin - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (a_0 l_0) - (begin - (if (null? l_0) - (if (null? a_0) - base_0 - (cons base_0 (reverse$1 a_0))) - (if (equal? (car l_0) "..") - (if (null? a_0) - (error - 'standard-module-name-resolver - "too many \"..\"s in submodule path: ~.s" - (list* - 'submod - (if (equal? base_0 ".") - base_0 - (if (path? base_0) - base_0 - (list - (if (symbol? base_0) 'quote 'file) - base_0))) - orig-l_0)) - (let ((app_0 (cdr a_0))) - (loop_1 app_0 (cdr l_0)))) - (let ((app_0 (cons (car l_0) a_0))) - (loop_1 app_0 (cdr l_0)))))))))) - (loop_1 null orig-l_0)))))) - (loop_0 - (|#%name| - loop - (lambda (l_0) - (begin - (if (null? l_0) - '() - (let ((app_0 (path->string (cdar l_0)))) - (list* "\n " app_0 (loop_0 (cdr l_0)))))))))) - (case-lambda - ((s_0 from-namespace_0) - (begin - (if (1/resolved-module-path? s_0) - (void) - (raise-argument-error - 'standard-module-name-resolver - "resolved-module-path?" - s_0)) - (if (let ((or-part_0 (not from-namespace_0))) - (if or-part_0 or-part_0 (1/namespace? from-namespace_0))) - (void) - (raise-argument-error - 'standard-module-name-resolver - "(or/c #f namespace?)" - from-namespace_0)) - (if (unsafe-place-local-ref cell.6) - (|#%app| (unsafe-place-local-ref cell.6) s_0) - (void)) - (let ((hts_0 - (let ((or-part_0 - (registry-table-ref - (namespace-module-registry$1 (1/current-namespace))))) - (if or-part_0 - or-part_0 - (let ((hts_0 - (let ((app_0 (make-hasheq))) - (cons app_0 (make-hasheq))))) - (begin - (registry-table-set! - (namespace-module-registry$1 (1/current-namespace)) - hts_0) - hts_0)))))) - (begin - (hash-set! (car hts_0) s_0 'declared) - (if from-namespace_0 - (let ((root-name_0 - (if (pair? (1/resolved-module-path-name s_0)) - (1/make-resolved-module-path - (car (1/resolved-module-path-name s_0))) - s_0))) - (let ((from-hts_0 - (registry-table-ref - (namespace-module-registry$1 from-namespace_0)))) - (let ((root-name_1 root-name_0)) - (if from-hts_0 - (let ((use-path/src_0 - (hash-ref (cdr from-hts_0) root-name_1 #f))) - (if use-path/src_0 - (hash-set! (cdr hts_0) root-name_1 use-path/src_0) - (void))) - (void))))) - (void)))))) - ((s_0 relto_0 stx_0) - (begin - (log-message - (current-logger) - 'error - "default module name resolver called with three arguments (deprecated)" - #f) - (standard-module-name-resolver s_0 relto_0 stx_0 #t))) - ((s_0 relto_0 stx_0 load?_0) - (begin - (if (1/module-path? s_0) - (void) - (if (syntax?$1 stx_0) - (raise-syntax-error$1 #f "bad module path" stx_0) - (raise-argument-error - 'standard-module-name-resolver - "module-path?" - s_0))) + (case-lambda + ((s_0 from-namespace_0) + (begin + (if (1/resolved-module-path? s_0) + (void) + (raise-argument-error + 'standard-module-name-resolver + "resolved-module-path?" + s_0)) + (if (let ((or-part_0 (not from-namespace_0))) + (if or-part_0 or-part_0 (1/namespace? from-namespace_0))) + (void) + (raise-argument-error + 'standard-module-name-resolver + "(or/c #f namespace?)" + from-namespace_0)) + (if (unsafe-place-local-ref cell.6) + (|#%app| (unsafe-place-local-ref cell.6) s_0) + (void)) + (let ((hts_0 + (let ((or-part_0 + (registry-table-ref + (namespace-module-registry$1 (1/current-namespace))))) + (if or-part_0 + or-part_0 + (let ((hts_0 + (let ((app_0 (make-hasheq))) + (cons app_0 (make-hasheq))))) + (begin + (registry-table-set! + (namespace-module-registry$1 (1/current-namespace)) + hts_0) + hts_0)))))) (begin - (if (let ((or-part_0 (not relto_0))) - (if or-part_0 or-part_0 (1/resolved-module-path? relto_0))) + (hash-set! (car hts_0) s_0 'declared) + (if from-namespace_0 + (let ((root-name_0 + (if (pair? (1/resolved-module-path-name s_0)) + (1/make-resolved-module-path + (car (1/resolved-module-path-name s_0))) + s_0))) + (let ((from-hts_0 + (registry-table-ref + (namespace-module-registry$1 from-namespace_0)))) + (let ((root-name_1 root-name_0)) + (if from-hts_0 + (let ((use-path/src_0 + (hash-ref (cdr from-hts_0) root-name_1 #f))) + (if use-path/src_0 + (hash-set! (cdr hts_0) root-name_1 use-path/src_0) + (void))) + (void))))) + (void)))))) + ((s_0 relto_0 stx_0) + (begin + (log-message + (current-logger) + 'error + "default module name resolver called with three arguments (deprecated)" + #f) + (standard-module-name-resolver s_0 relto_0 stx_0 #t))) + ((s_0 relto_0 stx_0 load?_0) + (begin + (if (1/module-path? s_0) + (void) + (if (syntax?$1 stx_0) + (raise-syntax-error$1 #f "bad module path" stx_0) + (raise-argument-error + 'standard-module-name-resolver + "module-path?" + s_0))) + (begin + (if (let ((or-part_0 (not relto_0))) + (if or-part_0 or-part_0 (1/resolved-module-path? relto_0))) + (void) + (raise-argument-error + 'standard-module-name-resolver + "(or/c #f resolved-module-path?)" + relto_0)) + (begin + (if (let ((or-part_0 (not stx_0))) + (if or-part_0 or-part_0 (syntax?$1 stx_0))) (void) (raise-argument-error 'standard-module-name-resolver - "(or/c #f resolved-module-path?)" - relto_0)) - (begin - (if (let ((or-part_0 (not stx_0))) - (if or-part_0 or-part_0 (syntax?$1 stx_0))) - (void) - (raise-argument-error - 'standard-module-name-resolver - "(or/c #f syntax?)" - stx_0)) + "(or/c #f syntax?)" + stx_0)) + (let ((flatten-sub-path_0 + (|#%name| + flatten-sub-path + (lambda (base_0 orig-l_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (a_0 l_0) + (begin + (if (null? l_0) + (if (null? a_0) + base_0 + (cons base_0 (reverse$1 a_0))) + (if (equal? (car l_0) "..") + (if (null? a_0) + (error + 'standard-module-name-resolver + "too many \"..\"s in submodule path: ~.s" + (list* + 'submod + (if (equal? base_0 ".") + base_0 + (if (path? base_0) + base_0 + (list + (if (symbol? base_0) 'quote 'file) + base_0))) + orig-l_0)) + (let ((app_0 (cdr a_0))) + (loop_0 app_0 (cdr l_0)))) + (let ((app_0 (cons (car l_0) a_0))) + (loop_0 app_0 (cdr l_0)))))))))) + (loop_0 null orig-l_0))))))) (if (if (pair? s_0) (eq? (car s_0) 'quote) #f) (1/make-resolved-module-path (cadr s_0)) (if (if (pair? s_0) @@ -76451,7 +75728,13 @@ (if or-part_1 or-part_1 (current-directory)))))))))) - (let ((get-reg_0 procz1)) + (let ((get-reg_0 + (|#%name| + get-reg + (lambda () + (begin + (namespace-module-registry$1 + (1/current-namespace))))))) (let ((show-collection-err_0 (|#%name| show-collection-err @@ -76491,9 +75774,69 @@ msg_1 (current-continuation-marks) s_0))))))))) - (let ((invent-collection-dir_0 procz2)) - (let ((ss->rkt_0 procz3)) - (let ((path-ss->rkt_0 procz4)) + (let ((invent-collection-dir_0 + (|#%name| + invent-collection-dir + (lambda (f-file_0 col_0 col-path_0 fail_0) + (begin + (lambda (msg_0) + (string->uninterned-symbol + (path->string + (build-path + (apply + build-path + col_0 + col-path_0) + f-file_0))))))))) + (let ((ss->rkt_0 + (|#%name| + ss->rkt + (lambda (s_1) + (begin + (let ((len_0 (string-length s_1))) + (if (if (>= len_0 3) + (if (eqv? + '#\x2e + (string-ref + s_1 + (- len_0 3))) + (if (eqv? + '#\x73 + (string-ref + s_1 + (- len_0 2))) + (eqv? + '#\x73 + (string-ref + s_1 + (- len_0 1))) + #f) + #f) + #f) + (string-append + (substring s_1 0 (- len_0 3)) + ".rkt") + s_1))))))) + (let ((path-ss->rkt_0 + (|#%name| + path-ss->rkt + (lambda (p_0) + (begin + (call-with-values + (lambda () (split-path p_0)) + (case-lambda + ((base_0 name_0 dir?_0) + (if (regexp-match + rx2418 + (path->bytes name_0)) + (path-replace-extension + p_0 + #vu8(46 114 107 116)) + p_0)) + (args + (raise-binding-result-arity-error + 3 + args))))))))) (let ((s_1 (if (if (pair? s_0) (eq? 'submod (car s_0)) @@ -76648,8 +75991,17 @@ build-path dir_0 (let ((app_0 - (map_2960 - procz5 + (map_1346 + (lambda (s_3) + (if (string=? + s_3 + ".") + 'same + (if (string=? + s_3 + "..") + 'up + s_3))) cols_0))) (append app_0 @@ -76717,8 +76069,11 @@ '("mzlib") (apply append - (map_2960 - procz6 + (map_1346 + (lambda (p_0) + (split-relative-string + p_0 + #t)) (cddr s_2)))) cols_0) @@ -76890,16 +76245,40 @@ filename_0 (apply string-append - (loop_0 - (reverse$1 - loading_1)))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_0) + (begin + (if (null? + l_0) + '() + (let ((app_0 + (path->string + (cdar + l_0)))) + (list* + "\n " + app_0 + (loop_0 + (cdr + l_0)))))))))) + (loop_0 + (reverse$1 + loading_1))))) (void))) loading_1) (|#%app| (if (continuation-prompt-available? -loading-prompt-tag) - procz7 - procz8) + (lambda (f_0) + (|#%app| + f_0)) + (lambda (f_0) + (call-with-continuation-prompt + f_0 + -loading-prompt-tag))) (lambda () (with-continuation-mark* general @@ -77105,142 +76484,146 @@ phase_0))) (namespace-visit-available-modules! ns_0 phase_0))))) (define expand-body.1 - (letrec ((maybe-increment-binding-layer_0 - (|#%name| - maybe-increment-binding-layer - (lambda (ctx6_0 inside-sc_0 ids_0 body-ctx_0) - (begin - (if (let ((app_0 - (begin-unsafe - (expand-context/outer-binding-layer body-ctx_0)))) - (eq? - app_0 - (begin-unsafe - (expand-context/outer-binding-layer ctx6_0)))) - (increment-binding-layer ids_0 body-ctx_0 inside-sc_0) - (begin-unsafe - (expand-context/outer-binding-layer body-ctx_0)))))))) - (|#%name| - expand-body - (lambda (source1_0 stratified?2_0 bodys5_0 ctx6_0) + (|#%name| + expand-body + (lambda (source1_0 stratified?2_0 bodys5_0 ctx6_0) + (begin (begin - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx6_0))))) - (if obs_0 - (call-expand-observe obs_0 'enter-block bodys5_0) - (void))) - (let ((inside-sc_0 (new-scope 'intdef))) - (let ((init-bodys_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((body_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (add-scope - body_0 - inside-sc_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null bodys5_0)))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx6_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'block-renames - init-bodys_0 - bodys5_0) - (void))) - (let ((phase_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx6_0))))) - (let ((frame-id_0 (make-reference-record))) - (let ((def-ctx-scopes_0 (box null))) - (let ((body-ctx_0 - (if (expand-context/outer? ctx6_0) - (let ((context51_0 - (list (make-liberal-define-context)))) - (let ((post-expansion55_0 - (|#%name| - post-expansion55 - (lambda (s_0) - (begin - (add-scope s_0 inside-sc_0)))))) - (let ((scopes56_0 - (cons - inside-sc_0 - (begin-unsafe - (expand-context/outer-scopes - ctx6_0))))) - (let ((use-site-scopes57_0 (box null))) - (let ((reference-records59_0 - (cons - frame-id_0 - (begin-unsafe - (expand-context/outer-reference-records - ctx6_0))))) - (let ((inner60_0 - (root-expand-context/outer-inner - ctx6_0))) - (let ((reference-records59_1 - reference-records59_0) - (use-site-scopes57_1 - use-site-scopes57_0) - (scopes56_1 scopes56_0) - (post-expansion55_1 - post-expansion55_0) - (context51_1 context51_0)) - (let ((app_0 - (expand-context/outer-env + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx6_0))))) + (if obs_0 (call-expand-observe obs_0 'enter-block bodys5_0) (void))) + (let ((inside-sc_0 (new-scope 'intdef))) + (let ((init-bodys_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((body_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (add-scope + body_0 + inside-sc_0) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 fold-var_1 rest_0)))) + fold-var_0)))))) + (for-loop_0 null bodys5_0)))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx6_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'block-renames + init-bodys_0 + bodys5_0) + (void))) + (let ((phase_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx6_0))))) + (let ((frame-id_0 (make-reference-record))) + (let ((def-ctx-scopes_0 (box null))) + (let ((body-ctx_0 + (if (expand-context/outer? ctx6_0) + (let ((context51_0 + (list (make-liberal-define-context)))) + (let ((post-expansion55_0 + (|#%name| + post-expansion55 + (lambda (s_0) + (begin + (add-scope s_0 inside-sc_0)))))) + (let ((scopes56_0 + (cons + inside-sc_0 + (begin-unsafe + (expand-context/outer-scopes + ctx6_0))))) + (let ((use-site-scopes57_0 (box null))) + (let ((reference-records59_0 + (cons + frame-id_0 + (begin-unsafe + (expand-context/outer-reference-records + ctx6_0))))) + (let ((inner60_0 + (root-expand-context/outer-inner + ctx6_0))) + (let ((reference-records59_1 + reference-records59_0) + (use-site-scopes57_1 + use-site-scopes57_0) + (scopes56_1 scopes56_0) + (post-expansion55_1 + post-expansion55_0) + (context51_1 context51_0)) + (let ((app_0 + (expand-context/outer-env + ctx6_0))) + (let ((app_1 + (expand-context/outer-binding-layer ctx6_0))) - (let ((app_1 - (expand-context/outer-binding-layer + (let ((app_2 + (expand-context/outer-need-eventually-defined ctx6_0))) - (let ((app_2 - (expand-context/outer-need-eventually-defined + (let ((app_3 + (expand-context/outer-current-introduction-scopes ctx6_0))) - (let ((app_3 - (expand-context/outer-current-introduction-scopes - ctx6_0))) - (expand-context/outer1.1 - inner60_0 - post-expansion55_1 - use-site-scopes57_1 - frame-id_0 - context51_1 - app_0 - scopes56_1 - def-ctx-scopes_0 - app_1 - reference-records59_1 - #t - app_2 - app_3 - (expand-context/outer-current-use-scopes - ctx6_0) - #f)))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx6_0)))) + (expand-context/outer1.1 + inner60_0 + post-expansion55_1 + use-site-scopes57_1 + frame-id_0 + context51_1 + app_0 + scopes56_1 + def-ctx-scopes_0 + app_1 + reference-records59_1 + #t + app_2 + app_3 + (expand-context/outer-current-use-scopes + ctx6_0) + #f)))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx6_0)))) + (let ((maybe-increment-binding-layer_0 + (|#%name| + maybe-increment-binding-layer + (lambda (ids_0 body-ctx_1) + (begin + (if (let ((app_0 + (begin-unsafe + (expand-context/outer-binding-layer + body-ctx_1)))) + (eq? + app_0 + (begin-unsafe + (expand-context/outer-binding-layer + ctx6_0)))) + (increment-binding-layer + ids_0 + body-ctx_1 + inside-sc_0) + (begin-unsafe + (expand-context/outer-binding-layer + body-ctx_1)))))))) (let ((name_0 (begin-unsafe (expand-context/outer-name ctx6_0)))) @@ -77477,7 +76860,7 @@ exp-body_0)))))) (let ((splice-bodys_0 (append - (map_2960 + (map_1346 track_0 e82_0) rest-bodys_0))) @@ -77845,8 +77228,6 @@ body-ctx_1) (let ((binding-layer106_0 (maybe-increment-binding-layer_0 - ctx6_0 - inside-sc_0 ids_0 body-ctx_1))) (let ((inner107_0 @@ -78471,8 +77852,6 @@ body-ctx_1) (let ((binding-layer132_0 (maybe-increment-binding-layer_0 - ctx6_0 - inside-sc_0 ids_0 body-ctx_1))) (let ((inner133_0 @@ -78957,16 +78336,29 @@ (void))) (list tracked-exp-s_0)))))))))))))))) (define expand-and-split-bindings-by-reference.1 - (letrec ((loop_0 + (|#%name| + expand-and-split-bindings-by-reference + (lambda (ctx34_0 + frame-id33_0 + get-body37_0 + had-stxes?36_0 + source35_0 + split?32_0 + track?38_0 + idss46_0 + keyss47_0 + rhss48_0 + track-stxs49_0) + (begin + (let ((phase_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx34_0))))) + (letrec* + ((loop_0 (|#%name| loop - (lambda (ctx34_0 - frame-id33_0 - get-body37_0 - phase_0 - source35_0 - split?32_0 - idss_0 + (lambda (idss_0 keyss_0 rhss_0 track-stxs_0 @@ -78998,7 +78390,7 @@ app_0 app_1 (reverse$1 - (map_2960 + (map_1346 list accum-keyss_0 accum-rhss_0)) @@ -79056,12 +78448,6 @@ (let ((app_1 (cdr keyss_0))) (let ((app_2 (cdr rhss_0))) (loop_0 - ctx34_0 - frame-id33_0 - get-body37_0 - phase_0 - source35_0 - split?32_0 app_0 app_1 app_2 @@ -79118,12 +78504,6 @@ (let ((app_1 (cdr keyss_0))) (let ((app_2 (cdr rhss_0))) (loop_0 - ctx34_0 - frame-id33_0 - get-body37_0 - phase_0 - source35_0 - split?32_0 app_0 app_1 app_2 @@ -79157,7 +78537,7 @@ expanded-rhs_0))) (cons app_2 - (map_2960 + (map_1346 list accum-keyss_0 accum-rhss_0)))) @@ -79192,12 +78572,6 @@ (let ((app_2 (cdr rhss_0))) (let ((app_3 (cdr track-stxs_0))) (loop_0 - ctx34_0 - frame-id33_0 - get-body37_0 - phase_0 - source35_0 - split?32_0 app_0 app_1 app_2 @@ -79214,46 +78588,22 @@ accum-track-stxs_0) track?_0 get-list?_0)))))))))))))))))))) - (|#%name| - expand-and-split-bindings-by-reference - (lambda (ctx34_0 - frame-id33_0 - get-body37_0 - had-stxes?36_0 - source35_0 - split?32_0 - track?38_0 - idss46_0 - keyss47_0 - rhss48_0 - track-stxs49_0) - (begin - (let ((phase_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx34_0))))) - (loop_0 - ctx34_0 - frame-id33_0 - get-body37_0 - phase_0 - source35_0 - split?32_0 - idss46_0 - keyss47_0 - rhss48_0 - track-stxs49_0 - null - null - null - null - track?38_0 - #f))))))) + (loop_0 + idss46_0 + keyss47_0 + rhss48_0 + track-stxs49_0 + null + null + null + null + track?38_0 + #f))))))) (define build-clauses (lambda (accum-idss_0 accum-rhss_0 accum-track-stxs_0) (let ((app_0 (reverse$1 accum-idss_0))) (let ((app_1 (reverse$1 accum-rhss_0))) - (map_2960 build-clause app_0 app_1 (reverse$1 accum-track-stxs_0)))))) + (map_1346 build-clause app_0 app_1 (reverse$1 accum-track-stxs_0)))))) (define build-clause (lambda (ids_0 rhs_0 track-stx_0) (let ((clause_0 (datum->syntax$1 #f (list ids_0 rhs_0)))) @@ -80006,66 +79356,63 @@ (args (raise-binding-result-arity-error 4 args))))))))) (void))) (define parse-and-flatten-formals - (letrec ((loop_0 - (|#%name| - loop - (lambda (all-formals_0 s_0 sc_0 formals_0) - (begin - (if (identifier? formals_0) - (list (if sc_0 (add-scope formals_0 sc_0) formals_0)) - (if (syntax?$1 formals_0) - (let ((p_0 (syntax-e$1 formals_0))) - (if (pair? p_0) - (loop_0 all-formals_0 s_0 sc_0 p_0) - (if (null? p_0) - null - (raise-syntax-error$1 - #f - "not an identifier" - s_0 - p_0)))) - (if (pair? formals_0) - (begin - (if (identifier? (car formals_0)) - (void) - (raise-syntax-error$1 - #f - "not an identifier" - s_0 - (car formals_0))) - (let ((app_0 - (if sc_0 - (add-scope (car formals_0) sc_0) - (car formals_0)))) - (cons - app_0 - (loop_0 all-formals_0 s_0 sc_0 (cdr formals_0))))) - (if (null? formals_0) - null - (raise-syntax-error$1 - "bad argument sequence" - s_0 - all-formals_0)))))))))) - (lambda (all-formals_0 sc_0 s_0) - (loop_0 all-formals_0 s_0 sc_0 all-formals_0)))) + (lambda (all-formals_0 sc_0 s_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (formals_0) + (begin + (if (identifier? formals_0) + (list (if sc_0 (add-scope formals_0 sc_0) formals_0)) + (if (syntax?$1 formals_0) + (let ((p_0 (syntax-e$1 formals_0))) + (if (pair? p_0) + (loop_0 p_0) + (if (null? p_0) + null + (raise-syntax-error$1 #f "not an identifier" s_0 p_0)))) + (if (pair? formals_0) + (begin + (if (identifier? (car formals_0)) + (void) + (raise-syntax-error$1 + #f + "not an identifier" + s_0 + (car formals_0))) + (let ((app_0 + (if sc_0 + (add-scope (car formals_0) sc_0) + (car formals_0)))) + (cons app_0 (loop_0 (cdr formals_0))))) + (if (null? formals_0) + null + (raise-syntax-error$1 + "bad argument sequence" + s_0 + all-formals_0)))))))))) + (loop_0 all-formals_0)))) (define unflatten-like-formals - (letrec ((loop_0 - (|#%name| - loop - (lambda (keys_0 formals_0) - (begin - (if (null? formals_0) - null - (if (pair? formals_0) - (let ((app_0 (car keys_0))) - (cons - app_0 - (let ((app_1 (cdr keys_0))) - (loop_0 app_1 (cdr formals_0))))) - (if (syntax?$1 formals_0) - (loop_0 keys_0 (syntax-e$1 formals_0)) - (car keys_0))))))))) - (lambda (keys_0 formals_0) (loop_0 keys_0 formals_0)))) + (lambda (keys_0 formals_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (keys_1 formals_1) + (begin + (if (null? formals_1) + null + (if (pair? formals_1) + (let ((app_0 (car keys_1))) + (cons + app_0 + (let ((app_1 (cdr keys_1))) + (loop_0 app_1 (cdr formals_1))))) + (if (syntax?$1 formals_1) + (loop_0 keys_1 (syntax-e$1 formals_1)) + (car keys_1))))))))) + (loop_0 keys_0 formals_0)))) (define make-let-values-form.1 (|#%name| make-let-values-form @@ -83601,105 +82948,109 @@ (args (raise-binding-result-arity-error 5 args))))))))) (void))) (define make-begin.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (ctx_0 expr-ctx_0 last-is-tail?10_0 es_0) - (begin - (if (null? es_0) - null - (let ((rest-es_0 (cdr es_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx_0))))) - (if obs_0 (call-expand-observe obs_0 'next) (void))) - (let ((app_0 - (let ((temp345_0 (car es_0))) - (let ((temp346_0 - (if (if last-is-tail?10_0 - (null? rest-es_0) - #f) - (as-tail-context.1 ctx_0 expr-ctx_0) - expr-ctx_0))) - (let ((temp345_1 temp345_0)) - (expand.1 #f #f temp345_1 temp346_0)))))) - (cons - app_0 - (loop_0 - ctx_0 - expr-ctx_0 - last-is-tail?10_0 - rest-es_0))))))))))) - (|#%name| - make-begin - (lambda (last-is-tail?10_0 log-tag12_0 parsed-begin13_0) - (begin - (lambda (s_0 ctx_0) - (let ((disarmed-s_0 (syntax-disarm$1 s_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx_0))))) - (if obs_0 - (call-expand-observe obs_0 log-tag12_0 disarmed-s_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_1 - (if (syntax?$1 disarmed-s_0) - (syntax-e$1 disarmed-s_0) - disarmed-s_0))) - (if (pair? s_1) - (let ((begin341_0 (let ((s_2 (car s_1))) s_2))) - (let ((e342_0 - (let ((s_2 (cdr s_1))) - (let ((s_3 - (if (syntax?$1 s_2) - (syntax-e$1 s_2) - s_2))) - (let ((flat-s_0 (to-syntax-list.1 s_3))) - (if (not flat-s_0) + (|#%name| + make-begin + (lambda (last-is-tail?10_0 log-tag12_0 parsed-begin13_0) + (begin + (lambda (s_0 ctx_0) + (let ((disarmed-s_0 (syntax-disarm$1 s_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx_0))))) + (if obs_0 + (call-expand-observe obs_0 log-tag12_0 disarmed-s_0) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_1 + (if (syntax?$1 disarmed-s_0) + (syntax-e$1 disarmed-s_0) + disarmed-s_0))) + (if (pair? s_1) + (let ((begin341_0 (let ((s_2 (car s_1))) s_2))) + (let ((e342_0 + (let ((s_2 (cdr s_1))) + (let ((s_3 + (if (syntax?$1 s_2) + (syntax-e$1 s_2) + s_2))) + (let ((flat-s_0 (to-syntax-list.1 s_3))) + (if (not flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-s_0) + (if (null? flat-s_0) (raise-syntax-error$1 #f "bad syntax" disarmed-s_0) - (if (null? flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-s_0) - flat-s_0))))))) - (let ((begin341_1 begin341_0)) - (values begin341_1 e342_0)))) - (raise-syntax-error$1 #f "bad syntax" disarmed-s_0)))) - (case-lambda - ((begin339_0 e340_0) (values #t begin339_0 e340_0)) - (args (raise-binding-result-arity-error 2 args))))) - (case-lambda - ((ok?_0 begin339_0 e340_0) - (let ((expr-ctx_0 - (if last-is-tail?10_0 - (as-begin-expression-context ctx_0) - (as-expression-context ctx_0)))) - (let ((rebuild-s_0 (keep-as-needed.1 #f #f #f ctx_0 s_0))) - (let ((exp-es_0 - (loop_0 - ctx_0 - expr-ctx_0 - last-is-tail?10_0 - e340_0))) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner ctx_0))) - (|#%app| parsed-begin13_0 rebuild-s_0 exp-es_0) - (let ((temp350_0 (cons begin339_0 exp-es_0))) - (rebuild.1 #t rebuild-s_0 temp350_0))))))) - (args (raise-binding-result-arity-error 3 args)))))))))))) + flat-s_0))))))) + (let ((begin341_1 begin341_0)) + (values begin341_1 e342_0)))) + (raise-syntax-error$1 #f "bad syntax" disarmed-s_0)))) + (case-lambda + ((begin339_0 e340_0) (values #t begin339_0 e340_0)) + (args (raise-binding-result-arity-error 2 args))))) + (case-lambda + ((ok?_0 begin339_0 e340_0) + (let ((expr-ctx_0 + (if last-is-tail?10_0 + (as-begin-expression-context ctx_0) + (as-expression-context ctx_0)))) + (let ((rebuild-s_0 (keep-as-needed.1 #f #f #f ctx_0 s_0))) + (let ((exp-es_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (es_0) + (begin + (if (null? es_0) + null + (let ((rest-es_0 (cdr es_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe obs_0 'next) + (void))) + (let ((app_0 + (let ((temp345_0 (car es_0))) + (let ((temp346_0 + (if (if last-is-tail?10_0 + (null? + rest-es_0) + #f) + (as-tail-context.1 + ctx_0 + expr-ctx_0) + expr-ctx_0))) + (let ((temp345_1 + temp345_0)) + (expand.1 + #f + #f + temp345_1 + temp346_0)))))) + (cons + app_0 + (loop_0 rest-es_0))))))))))) + (loop_0 e340_0)))) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner ctx_0))) + (|#%app| parsed-begin13_0 rebuild-s_0 exp-es_0) + (let ((temp350_0 (cons begin339_0 exp-es_0))) + (rebuild.1 #t rebuild-s_0 temp350_0))))))) + (args (raise-binding-result-arity-error 3 args))))))))))) (define effect_2494 (begin (void @@ -84369,7 +83720,7 @@ disarmed-s_0) s_0) s_0))) -(define effect_2817 +(define effect_2816 (begin (void (add-core-form!* @@ -84862,1949 +84213,144 @@ (define layers '(raw phaseless id)) (define provide-form-name 'provide) (define parse-and-expand-provides! - (letrec ((procz1 (lambda () 0)) - (check-nested_0 - (|#%name| - check-nested - (lambda (fm_0 layer_0 orig-s_0 spec_0 want-layer_0) - (begin - (if (member want-layer_0 (member layer_0 layers)) - (void) - (raise-syntax-error$1 - 'provide - (format "nested `~a' not allowed" fm_0) - orig-s_0 - spec_0)))))) - (loop_0 - (|#%name| - loop - (lambda (ctx_0 - ns_0 - orig-s_0 - rp_0 - self_0 - specs_0 - at-phase_0 - protected?_0 - layer_0) - (begin + (lambda (specs_0 orig-s_0 rp_0 self_0 phase_0 ctx_0) + (let ((ns_0 + (begin-unsafe + (expand-context/inner-namespace + (root-expand-context/outer-inner ctx_0))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (specs_1 at-phase_0 protected?_0 layer_0) + (begin + (call-with-values + (lambda () (call-with-values (lambda () - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (track-stxes_0 exp-specs_0 lst_0) - (begin - (if (pair? lst_0) - (let ((spec_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (track-stxes_0 exp-specs_0 lst_0) + (begin + (if (pair? lst_0) + (let ((spec_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (call-with-values + (lambda () (call-with-values (lambda () (call-with-values (lambda () - (call-with-values - (lambda () - (let ((disarmed-spec_0 - (syntax-disarm$1 - spec_0))) - (let ((fm_0 - (if (pair? + (let ((disarmed-spec_0 + (syntax-disarm$1 spec_0))) + (let ((fm_0 + (if (pair? + (syntax-e$1 + disarmed-spec_0)) + (if (identifier? + (car (syntax-e$1 - disarmed-spec_0)) + disarmed-spec_0))) + (syntax-e$1 + (car + (syntax-e$1 + disarmed-spec_0))) + #f) + #f))) + (let ((check-nested_0 + (|#%name| + check-nested + (lambda (want-layer_0) + (begin + (if (member + want-layer_0 + (member + layer_0 + layers)) + (void) + (raise-syntax-error$1 + 'provide + (format + "nested `~a' not allowed" + fm_0) + orig-s_0 + spec_0))))))) + (let ((index_0 + (if (symbol? fm_0) + (hash-ref + hash2294 + fm_0 + (lambda () 0)) + 0))) + (if (unsafe-fx< index_0 6) + (if (unsafe-fx< + index_0 + 2) + (if (unsafe-fx< + index_0 + 1) (if (identifier? - (car - (syntax-e$1 - disarmed-spec_0))) - (syntax-e$1 - (car - (syntax-e$1 - disarmed-spec_0))) - #f) - #f))) - (let ((index_0 - (if (symbol? fm_0) - (hash-ref - hash2294 - fm_0 - procz1) - 0))) - (if (unsafe-fx< - index_0 - 6) - (if (unsafe-fx< - index_0 - 2) - (if (unsafe-fx< - index_0 - 1) - (if (identifier? + spec_0) + (begin + (parse-identifier! + spec_0 + orig-s_0 + (syntax-e$1 spec_0) - (begin - (parse-identifier! - spec_0 - orig-s_0 - (syntax-e$1 - spec_0) - at-phase_0 - ns_0 - rp_0 - protected?_0) - (values - null - (list - spec_0))) - (raise-syntax-error$1 - 'provide - "bad syntax" - orig-s_0 - spec_0)) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'raw) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((for-meta6_0 - (let ((s_1 - (car - s_0))) - s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((phase-level9_0 - (let ((s_3 - (car - s_2))) - s_3))) - (let ((spec10_0 - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (let ((flat-s_0 - (to-syntax-list.1 - s_4))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0) - flat-s_0)))))) - (let ((phase-level9_1 - phase-level9_0)) - (values - phase-level9_1 - spec10_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - ((phase-level7_0 - spec8_0) - (let ((for-meta6_1 - for-meta6_0)) - (values - for-meta6_1 - phase-level7_0 - spec8_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((for-meta3_0 - phase-level4_0 - spec5_0) - (values - #t - for-meta3_0 - phase-level4_0 - spec5_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (case-lambda - ((ok?_0 - for-meta3_0 - phase-level4_0 - spec5_0) - (let ((p_0 - (syntax-e$1 - phase-level4_0))) - (begin - (if (phase? - p_0) - (void) - (raise-syntax-error$1 - 'provide - "bad `for-meta' phase" - orig-s_0 - spec_0)) - (call-with-values - (lambda () - (loop_0 - ctx_0 - ns_0 - orig-s_0 - rp_0 - self_0 - spec5_0 - (phase+ - p_0 - at-phase_0) - protected?_0 - 'phaseless)) - (case-lambda - ((track-stxes_1 - exp-specs_1) - (values - null - (list - (syntax-track-origin* - track-stxes_1 - (let ((temp12_0 - (list* - for-meta3_0 - phase-level4_0 - exp-specs_1))) - (rebuild.1 - #t - spec_0 - temp12_0)))))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (args - (raise-binding-result-arity-error - 4 - args)))))) - (if (unsafe-fx< - index_0 - 3) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'raw) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((for-syntax15_0 - (let ((s_1 - (car - s_0))) - s_1))) - (let ((spec16_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0) - flat-s_0)))))) - (let ((for-syntax15_1 - for-syntax15_0)) - (values - for-syntax15_1 - spec16_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((for-syntax13_0 - spec14_0) - (values - #t - for-syntax13_0 - spec14_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 - for-syntax13_0 - spec14_0) - (call-with-values - (lambda () - (loop_0 - ctx_0 - ns_0 - orig-s_0 - rp_0 - self_0 - spec14_0 - (phase+ - 1 - at-phase_0) - protected?_0 - 'phaseless)) - (case-lambda - ((track-stxes_1 - exp-specs_1) - (values - null - (list - (syntax-track-origin* - track-stxes_1 - (let ((temp18_0 - (list* - for-syntax13_0 - exp-specs_1))) - (rebuild.1 - #t - spec_0 - temp18_0)))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (if (unsafe-fx< - index_0 - 4) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'raw) + at-phase_0 + ns_0 + rp_0 + protected?_0) + (values + null + (list spec_0))) + (raise-syntax-error$1 + 'provide + "bad syntax" + orig-s_0 + spec_0)) + (begin + (check-nested_0 + 'raw) + (call-with-values + (lambda () (call-with-values (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((for-label21_0 - (let ((s_1 - (car - s_0))) - s_1))) - (let ((spec22_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0) - flat-s_0)))))) - (let ((for-label21_1 - for-label21_0)) - (values - for-label21_1 - spec22_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((for-label19_0 - spec20_0) - (values - #t - for-label19_0 - spec20_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 - for-label19_0 - spec20_0) - (call-with-values - (lambda () - (loop_0 - ctx_0 - ns_0 - orig-s_0 - rp_0 - self_0 - spec20_0 - #f - protected?_0 - 'phaseless)) - (case-lambda - ((track-stxes_1 - exp-specs_1) - (values - null - (list - (syntax-track-origin* - track-stxes_1 - (let ((temp24_0 - (list* - for-label19_0 - exp-specs_1))) - (rebuild.1 - #t - spec_0 - temp24_0)))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (if (unsafe-fx< - index_0 - 5) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'phaseless) - (begin - (if protected?_0 - (raise-syntax-error$1 - 'provide - "nested `protect' not allowed" - orig-s_0 - spec_0) - (void)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((protect27_0 - (let ((s_1 - (car - s_0))) + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((for-meta6_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) s_1))) - (let ((p-spec28_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0) - flat-s_0)))))) - (let ((protect27_1 - protect27_0)) - (values - protect27_1 - p-spec28_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((protect25_0 - p-spec26_0) - (values - #t - protect25_0 - p-spec26_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 - protect25_0 - p-spec26_0) - (call-with-values - (lambda () - (loop_0 - ctx_0 - ns_0 - orig-s_0 - rp_0 - self_0 - p-spec26_0 - at-phase_0 - #t - layer_0)) - (case-lambda - ((track-stxes_1 - exp-specs_1) - (values - null - (list - (syntax-track-origin* - track-stxes_1 - (let ((temp30_0 - (list* - protect25_0 - exp-specs_1))) - (rebuild.1 - #t - spec_0 - temp30_0)))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 3 - args)))))) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'phaseless) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((rename34_0 - (let ((s_1 - (car - s_0))) - s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((id:from37_0 - (let ((s_3 - (car - s_2))) - (if (let ((or-part_0 - (if (syntax?$1 - s_3) - (symbol? - (syntax-e$1 - s_3)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_3))) - s_3 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-spec_0 - s_3))))) - (let ((id:to38_0 - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? - s_4) - (let ((id:to39_0 - (let ((s_5 - (car - s_4))) - (if (let ((or-part_0 - (if (syntax?$1 - s_5) - (symbol? - (syntax-e$1 - s_5)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_5))) - s_5 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-spec_0 - s_5))))) - (call-with-values - (lambda () - (let ((s_5 - (cdr - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 - s_5) - s_5))) - (if (null? - s_6) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - (() - (let ((id:to39_1 - id:to39_0)) - (values - id:to39_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))))) - (let ((id:from37_1 - id:from37_0)) - (values - id:from37_1 - id:to38_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - ((id:from35_0 - id:to36_0) - (let ((rename34_1 - rename34_0)) - (values - rename34_1 - id:from35_0 - id:to36_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((rename31_0 - id:from32_0 - id:to33_0) - (values - #t - rename31_0 - id:from32_0 - id:to33_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (case-lambda - ((ok?_0 - rename31_0 - id:from32_0 - id:to33_0) - (begin - (parse-identifier! - id:from32_0 - orig-s_0 - (syntax-e$1 - id:to33_0) - at-phase_0 - ns_0 - rp_0 - protected?_0) - (values - null - (list - spec_0)))) - (args - (raise-binding-result-arity-error - 4 - args))))))))) - (if (unsafe-fx< - index_0 - 9) - (if (unsafe-fx< - index_0 - 7) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'phaseless) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((struct43_0 - (let ((s_1 - (car - s_0))) - s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((id:struct46_0 - (let ((s_3 - (car - s_2))) - (if (let ((or-part_0 - (if (syntax?$1 - s_3) - (symbol? - (syntax-e$1 - s_3)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_3))) - s_3 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-spec_0 - s_3))))) - (let ((id:field47_0 - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? - s_4) - (let ((id:field48_0 - (let ((s_5 - (car - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 - s_5) - s_5))) - (let ((flat-s_0 - (to-syntax-list.1 - s_6))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0) - (let ((id:field_0 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (id:field_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((s_7 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((id:field_1 - (let ((id:field_1 - (let ((id:field49_0 - (if (let ((or-part_0 - (if (syntax?$1 - s_7) - (symbol? - (syntax-e$1 - s_7)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_7))) - s_7 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-spec_0 - s_7)))) - (cons - id:field49_0 - id:field_0)))) - (values - id:field_1)))) - (for-loop_1 - id:field_1 - rest_1)))) - id:field_0)))))) - (for-loop_1 - null - flat-s_0))))) - (reverse$1 - id:field_0)))))))) - (call-with-values - (lambda () - (let ((s_5 - (cdr - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 - s_5) - s_5))) - (if (null? - s_6) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - (() - (let ((id:field48_1 - id:field48_0)) - (values - id:field48_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))))) - (let ((id:struct46_1 - id:struct46_0)) - (values - id:struct46_1 - id:field47_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - ((id:struct44_0 - id:field45_0) - (let ((struct43_1 - struct43_0)) - (values - struct43_1 - id:struct44_0 - id:field45_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((struct40_0 - id:struct41_0 - id:field42_0) - (values - #t - struct40_0 - id:struct41_0 - id:field42_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (case-lambda - ((ok?_0 - struct40_0 - id:struct41_0 - id:field42_0) - (begin - (parse-struct! - id:struct41_0 - orig-s_0 - id:field42_0 - at-phase_0 - ns_0 - rp_0 - protected?_0) - (values - null - (list - spec_0)))) - (args - (raise-binding-result-arity-error - 4 - args))))) - (if (unsafe-fx< - index_0 - 8) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'phaseless) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((all-from52_0 - (let ((s_1 - (car - s_0))) - s_1))) - (let ((mod-path53_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((mod-path54_0 - (let ((s_3 - (car - s_2))) - s_3))) - (call-with-values - (lambda () - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (null? - s_4) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - (() - (let ((mod-path54_1 - mod-path54_0)) - (values - mod-path54_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))))) - (let ((all-from52_1 - all-from52_0)) - (values - all-from52_1 - mod-path53_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((all-from50_0 - mod-path51_0) - (values - #t - all-from50_0 - mod-path51_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 - all-from50_0 - mod-path51_0) - (begin - (parse-all-from - mod-path51_0 - orig-s_0 - self_0 - null - at-phase_0 - ns_0 - rp_0 - protected?_0 - ctx_0) - (values - null - (list - spec_0)))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'phaseless) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((all-from-except58_0 - (let ((s_1 - (car - s_0))) - s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((mod-path61_0 - (let ((s_3 - (car - s_2))) - s_3))) - (let ((id62_0 - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (let ((flat-s_0 - (to-syntax-list.1 - s_4))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0) - (let ((id_0 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (id_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((s_5 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((id_1 - (let ((id_1 - (let ((id63_0 - (if (let ((or-part_0 - (if (syntax?$1 - s_5) - (symbol? - (syntax-e$1 - s_5)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_5))) - s_5 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-spec_0 - s_5)))) - (cons - id63_0 - id_0)))) - (values - id_1)))) - (for-loop_1 - id_1 - rest_1)))) - id_0)))))) - (for-loop_1 - null - flat-s_0))))) - (reverse$1 - id_0)))))))) - (let ((mod-path61_1 - mod-path61_0)) - (values - mod-path61_1 - id62_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - ((mod-path59_0 - id60_0) - (let ((all-from-except58_1 - all-from-except58_0)) - (values - all-from-except58_1 - mod-path59_0 - id60_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((all-from-except55_0 - mod-path56_0 - id57_0) - (values - #t - all-from-except55_0 - mod-path56_0 - id57_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (case-lambda - ((ok?_0 - all-from-except55_0 - mod-path56_0 - id57_0) - (begin - (parse-all-from - mod-path56_0 - orig-s_0 - self_0 - id57_0 - at-phase_0 - ns_0 - rp_0 - protected?_0 - ctx_0) - (values - null - (list - spec_0)))) - (args - (raise-binding-result-arity-error - 4 - args))))))) - (if (unsafe-fx< - index_0 - 11) - (if (unsafe-fx< - index_0 - 10) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'phaseless) - (call-with-values - (lambda () - (let ((all-defined64_0 - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((all-defined65_0 - (let ((s_1 - (car - s_0))) - s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (null? - s_2) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - (() - (let ((all-defined65_1 - all-defined65_0)) - (values - all-defined65_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (values - #t - all-defined64_0))) - (case-lambda - ((ok?_0 - all-defined64_0) - (begin - (parse-all-from-module - self_0 - spec_0 - orig-s_0 - null - #f - at-phase_0 - ns_0 - rp_0 - protected?_0) - (values - null - (list - spec_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'phaseless) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((all-defined-except68_0 - (let ((s_1 - (car - s_0))) - s_1))) - (let ((id69_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0) - (let ((id_0 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (id_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((s_3 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((id_1 - (let ((id_1 - (let ((id70_0 - (if (let ((or-part_0 - (if (syntax?$1 - s_3) - (symbol? - (syntax-e$1 - s_3)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_3))) - s_3 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-spec_0 - s_3)))) - (cons - id70_0 - id_0)))) - (values - id_1)))) - (for-loop_1 - id_1 - rest_1)))) - id_0)))))) - (for-loop_1 - null - flat-s_0))))) - (reverse$1 - id_0)))))))) - (let ((all-defined-except68_1 - all-defined-except68_0)) - (values - all-defined-except68_1 - id69_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((all-defined-except66_0 - id67_0) - (values - #t - all-defined-except66_0 - id67_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 - all-defined-except66_0 - id67_0) - (begin - (parse-all-from-module - self_0 - spec_0 - orig-s_0 - id67_0 - #f - at-phase_0 - ns_0 - rp_0 - protected?_0) - (values - null - (list - spec_0)))) - (args - (raise-binding-result-arity-error - 3 - args)))))) - (if (unsafe-fx< - index_0 - 12) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'phaseless) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((prefix-all-defined73_0 - (let ((s_1 - (car - s_0))) - s_1))) - (let ((id:prefix74_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((id:prefix75_0 - (let ((s_3 - (car - s_2))) - (if (let ((or-part_0 - (if (syntax?$1 - s_3) - (symbol? - (syntax-e$1 - s_3)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_3))) - s_3 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-spec_0 - s_3))))) - (call-with-values - (lambda () - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (null? - s_4) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - (() - (let ((id:prefix75_1 - id:prefix75_0)) - (values - id:prefix75_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))))) - (let ((prefix-all-defined73_1 - prefix-all-defined73_0)) - (values - prefix-all-defined73_1 - id:prefix74_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((prefix-all-defined71_0 - id:prefix72_0) - (values - #t - prefix-all-defined71_0 - id:prefix72_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 - prefix-all-defined71_0 - id:prefix72_0) - (begin - (parse-all-from-module - self_0 - spec_0 - orig-s_0 - null - (syntax-e$1 - id:prefix72_0) - at-phase_0 - ns_0 - rp_0 - protected?_0) - (values - null - (list - spec_0)))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (if (unsafe-fx< - index_0 - 13) - (begin - (check-nested_0 - fm_0 - layer_0 - orig-s_0 - spec_0 - 'phaseless) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((prefix-all-defined-except79_0 - (let ((s_1 - (car - s_0))) - s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((id:prefix82_0 - (let ((s_3 - (car - s_2))) - (if (let ((or-part_0 - (if (syntax?$1 - s_3) - (symbol? - (syntax-e$1 - s_3)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_3))) - s_3 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-spec_0 - s_3))))) - (let ((id83_0 - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (let ((flat-s_0 - (to-syntax-list.1 - s_4))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0) - (let ((id_0 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (id_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((s_5 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((id_1 - (let ((id_1 - (let ((id84_0 - (if (let ((or-part_0 - (if (syntax?$1 - s_5) - (symbol? - (syntax-e$1 - s_5)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_5))) - s_5 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-spec_0 - s_5)))) - (cons - id84_0 - id_0)))) - (values - id_1)))) - (for-loop_1 - id_1 - rest_1)))) - id_0)))))) - (for-loop_1 - null - flat-s_0))))) - (reverse$1 - id_0)))))))) - (let ((id:prefix82_1 - id:prefix82_0)) - (values - id:prefix82_1 - id83_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - ((id:prefix80_0 - id81_0) - (let ((prefix-all-defined-except79_1 - prefix-all-defined-except79_0)) - (values - prefix-all-defined-except79_1 - id:prefix80_0 - id81_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((prefix-all-defined-except76_0 - id:prefix77_0 - id78_0) - (values - #t - prefix-all-defined-except76_0 - id:prefix77_0 - id78_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (case-lambda - ((ok?_0 - prefix-all-defined-except76_0 - id:prefix77_0 - id78_0) - (begin - (parse-all-from-module - self_0 - spec_0 - orig-s_0 - id78_0 - (syntax-e$1 - id:prefix77_0) - at-phase_0 - ns_0 - rp_0 - protected?_0) - (values - null - (list - spec_0)))) - (args - (raise-binding-result-arity-error - 4 - args))))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-spec_0) - (syntax-e$1 - disarmed-spec_0) - disarmed-spec_0))) - (if (pair? - s_0) - (let ((expand88_0 - (let ((s_1 - (car - s_0))) - s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (call-with-values - (lambda () - (let ((s_3 - (car - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? - s_4) - (let ((id93_0 - (let ((s_5 - (car - s_4))) - (if (let ((or-part_0 - (if (syntax?$1 - s_5) - (symbol? - (syntax-e$1 - s_5)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_5))) - s_5 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-spec_0 - s_5))))) - (let ((datum94_0 - (let ((s_5 - (cdr - s_4))) - s_5))) - (let ((id93_1 - id93_0)) - (values - id93_1 - datum94_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - ((id91_0 - datum92_0) - (call-with-values - (lambda () + (if (pair? + s_2) + (let ((phase-level9_0 + (let ((s_3 + (car + s_2))) + s_3))) + (let ((spec10_0 (let ((s_3 (cdr s_2))) @@ -86814,69 +84360,318 @@ (syntax-e$1 s_3) s_3))) - (if (null? - s_4) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - (() - (let ((id91_1 - id91_0) - (datum92_1 - datum92_0)) - (values - id91_1 - datum92_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - ((id89_0 - datum90_0) - (let ((expand88_1 - expand88_0)) - (values - expand88_1 - id89_0 - datum90_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))) - (case-lambda - ((expand85_0 - id86_0 - datum87_0) - (values - #t - expand85_0 - id86_0 - datum87_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0) + flat-s_0)))))) + (let ((phase-level9_1 + phase-level9_0)) + (values + phase-level9_1 + spec10_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + ((phase-level7_0 + spec8_0) + (let ((for-meta6_1 + for-meta6_0)) + (values + for-meta6_1 + phase-level7_0 + spec8_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) (case-lambda - ((ok?_0 - expand85_0 - id86_0 - datum87_0) + ((for-meta3_0 + phase-level4_0 + spec5_0) + (values + #t + for-meta3_0 + phase-level4_0 + spec5_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + for-meta3_0 + phase-level4_0 + spec5_0) + (let ((p_0 + (syntax-e$1 + phase-level4_0))) + (begin + (if (phase? + p_0) + (void) + (raise-syntax-error$1 + 'provide + "bad `for-meta' phase" + orig-s_0 + spec_0)) + (call-with-values + (lambda () + (loop_0 + spec5_0 + (phase+ + p_0 + at-phase_0) + protected?_0 + 'phaseless)) + (case-lambda + ((track-stxes_1 + exp-specs_1) + (values + null + (list + (syntax-track-origin* + track-stxes_1 + (let ((temp12_0 + (list* + for-meta3_0 + phase-level4_0 + exp-specs_1))) + (rebuild.1 + #t + spec_0 + temp12_0)))))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (args + (raise-binding-result-arity-error + 4 + args)))))) + (if (unsafe-fx< + index_0 + 3) + (begin + (check-nested_0 + 'raw) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((for-syntax15_0 + (let ((s_1 + (car + s_0))) + s_1))) + (let ((spec16_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0) + flat-s_0)))))) + (let ((for-syntax15_1 + for-syntax15_0)) + (values + for-syntax15_1 + spec16_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((for-syntax13_0 + spec14_0) + (values + #t + for-syntax13_0 + spec14_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + for-syntax13_0 + spec14_0) + (call-with-values + (lambda () + (loop_0 + spec14_0 + (phase+ + 1 + at-phase_0) + protected?_0 + 'phaseless)) + (case-lambda + ((track-stxes_1 + exp-specs_1) + (values + null + (list + (syntax-track-origin* + track-stxes_1 + (let ((temp18_0 + (list* + for-syntax13_0 + exp-specs_1))) + (rebuild.1 + #t + spec_0 + temp18_0)))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (if (unsafe-fx< + index_0 + 4) + (begin + (check-nested_0 + 'raw) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((for-label21_0 + (let ((s_1 + (car + s_0))) + s_1))) + (let ((spec22_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0) + flat-s_0)))))) + (let ((for-label21_1 + for-label21_0)) + (values + for-label21_1 + spec22_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((for-label19_0 + spec20_0) + (values + #t + for-label19_0 + spec20_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + for-label19_0 + spec20_0) + (call-with-values + (lambda () + (loop_0 + spec20_0 + #f + protected?_0 + 'phaseless)) + (case-lambda + ((track-stxes_1 + exp-specs_1) + (values + null + (list + (syntax-track-origin* + track-stxes_1 + (let ((temp24_0 + (list* + for-label19_0 + exp-specs_1))) + (rebuild.1 + #t + spec_0 + temp24_0)))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (if (unsafe-fx< + index_0 + 5) + (begin + (check-nested_0 + 'phaseless) + (begin + (if protected?_0 + (raise-syntax-error$1 + 'provide + "nested `protect' not allowed" + orig-s_0 + spec_0) + (void)) (call-with-values (lambda () (call-with-values @@ -86889,12 +84684,12 @@ disarmed-spec_0))) (if (pair? s_0) - (let ((expand97_0 + (let ((protect27_0 (let ((s_1 (car s_0))) s_1))) - (let ((form98_0 + (let ((p-spec28_0 (let ((s_1 (cdr s_0))) @@ -86904,433 +84699,1906 @@ (syntax-e$1 s_1) s_1))) - (if (pair? - s_2) - (let ((form99_0 - (let ((s_3 - (car - s_2))) - s_3))) - (call-with-values - (lambda () - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (null? - s_4) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0))))) - (case-lambda - (() - (let ((form99_1 - form99_0)) - (values - form99_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-spec_0)))))) - (let ((expand97_1 - expand97_0)) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0) + flat-s_0)))))) + (let ((protect27_1 + protect27_0)) (values - expand97_1 - form98_0)))) + protect27_1 + p-spec28_0)))) (raise-syntax-error$1 #f "bad syntax" disarmed-spec_0)))) (case-lambda - ((expand95_0 - form96_0) + ((protect25_0 + p-spec26_0) (values #t - expand95_0 - form96_0)) + protect25_0 + p-spec26_0)) (args (raise-binding-result-arity-error 2 args))))) (case-lambda - ((ok?_1 - expand95_0 - form96_0) - (let ((exp-spec_0 - (let ((temp105_0 - (if (expand-context/outer? - ctx_0) - (let ((inner107_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_0))) - (if (expand-context/inner? - the-struct_0) - (let ((stops108_0 - (free-id-set - at-phase_0 - (list - (core-id - 'begin - at-phase_0))))) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_12 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_13 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_14 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_21 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_22 - (expand-context/inner-observer - the-struct_0))) - (let ((app_23 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_24 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_25 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_26 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - stops108_0 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - app_26 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_0))) - (let ((app_3 - (expand-context/outer-context - ctx_0))) - (let ((app_4 - (expand-context/outer-env - ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - ctx_0))) - (let ((app_6 - (expand-context/outer-binding-layer - ctx_0))) - (let ((app_7 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner107_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - #f - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - ctx_0))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx_0)))) - (expand.1 - #f - #f - form96_0 - temp105_0)))) - (begin - (if (if (pair? - (syntax-e$1 - exp-spec_0)) - (if (identifier? - (car - (syntax-e$1 - exp-spec_0))) - (eq? - 'begin - (core-form-sym - exp-spec_0 - at-phase_0)) - #f) - #f) - (void) - (raise-syntax-error$1 - 'provide - "expansion was not a `begin' sequence" - orig-s_0 - spec_0)) - (call-with-values - (lambda () + ((ok?_0 + protect25_0 + p-spec26_0) + (call-with-values + (lambda () + (loop_0 + p-spec26_0 + at-phase_0 + #t + layer_0)) + (case-lambda + ((track-stxes_1 + exp-specs_1) + (values + null + (list + (syntax-track-origin* + track-stxes_1 + (let ((temp30_0 + (list* + protect25_0 + exp-specs_1))) + (rebuild.1 + #t + spec_0 + temp30_0)))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 3 + args)))))) + (begin + (check-nested_0 + 'phaseless) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((rename34_0 + (let ((s_1 + (car + s_0))) + s_1))) (call-with-values (lambda () - (let ((s_0 - (if (syntax?$1 - exp-spec_0) - (syntax-e$1 - exp-spec_0) - exp-spec_0))) - (if (pair? - s_0) - (let ((begin102_0 - (let ((s_1 - (car - s_0))) - s_1))) - (let ((spec103_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((id:from37_0 + (let ((s_3 + (car + s_2))) + (if (let ((or-part_0 + (if (syntax?$1 + s_3) + (symbol? + (syntax-e$1 + s_3)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_3))) + s_3 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-spec_0 + s_3))))) + (let ((id:to38_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((id:to39_0 + (let ((s_5 + (car + s_4))) + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-spec_0 + s_5))))) + (call-with-values + (lambda () + (let ((s_5 + (cdr + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 + s_5) + s_5))) + (if (null? + s_6) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + (() + (let ((id:to39_1 + id:to39_0)) + (values + id:to39_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))))) + (let ((id:from37_1 + id:from37_0)) + (values + id:from37_1 + id:to38_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + ((id:from35_0 + id:to36_0) + (let ((rename34_1 + rename34_0)) + (values + rename34_1 + id:from35_0 + id:to36_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((rename31_0 + id:from32_0 + id:to33_0) + (values + #t + rename31_0 + id:from32_0 + id:to33_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + rename31_0 + id:from32_0 + id:to33_0) + (begin + (parse-identifier! + id:from32_0 + orig-s_0 + (syntax-e$1 + id:to33_0) + at-phase_0 + ns_0 + rp_0 + protected?_0) + (values + null + (list + spec_0)))) + (args + (raise-binding-result-arity-error + 4 + args))))))))) + (if (unsafe-fx< + index_0 + 9) + (if (unsafe-fx< + index_0 + 7) + (begin + (check-nested_0 + 'phaseless) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((struct43_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((id:struct46_0 + (let ((s_3 + (car + s_2))) + (if (let ((or-part_0 (if (syntax?$1 - s_1) + s_3) + (symbol? + (syntax-e$1 + s_3)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_3))) + s_3 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-spec_0 + s_3))))) + (let ((id:field47_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((id:field48_0 + (let ((s_5 + (car + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 + s_5) + s_5))) + (let ((flat-s_0 + (to-syntax-list.1 + s_6))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0) + (let ((id:field_0 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (id:field_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((s_7 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((id:field_1 + (let ((id:field_1 + (let ((id:field49_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_7) + (symbol? + (syntax-e$1 + s_7)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_7))) + s_7 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-spec_0 + s_7)))) + (cons + id:field49_0 + id:field_0)))) + (values + id:field_1)))) + (for-loop_1 + id:field_1 + rest_1)))) + id:field_0)))))) + (for-loop_1 + null + flat-s_0))))) + (reverse$1 + id:field_0)))))))) + (call-with-values + (lambda () + (let ((s_5 + (cdr + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 + s_5) + s_5))) + (if (null? + s_6) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + (() + (let ((id:field48_1 + id:field48_0)) + (values + id:field48_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))))) + (let ((id:struct46_1 + id:struct46_0)) + (values + id:struct46_1 + id:field47_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + ((id:struct44_0 + id:field45_0) + (let ((struct43_1 + struct43_0)) + (values + struct43_1 + id:struct44_0 + id:field45_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((struct40_0 + id:struct41_0 + id:field42_0) + (values + #t + struct40_0 + id:struct41_0 + id:field42_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + struct40_0 + id:struct41_0 + id:field42_0) + (begin + (parse-struct! + id:struct41_0 + orig-s_0 + id:field42_0 + at-phase_0 + ns_0 + rp_0 + protected?_0) + (values + null + (list + spec_0)))) + (args + (raise-binding-result-arity-error + 4 + args))))) + (if (unsafe-fx< + index_0 + 8) + (begin + (check-nested_0 + 'phaseless) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((all-from52_0 + (let ((s_1 + (car + s_0))) + s_1))) + (let ((mod-path53_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((mod-path54_0 + (let ((s_3 + (car + s_2))) + s_3))) + (call-with-values + (lambda () + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) (syntax-e$1 - s_1) - s_1))) + s_3) + s_3))) + (if (null? + s_4) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + (() + (let ((mod-path54_1 + mod-path54_0)) + (values + mod-path54_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))))) + (let ((all-from52_1 + all-from52_0)) + (values + all-from52_1 + mod-path53_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((all-from50_0 + mod-path51_0) + (values + #t + all-from50_0 + mod-path51_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + all-from50_0 + mod-path51_0) + (begin + (parse-all-from + mod-path51_0 + orig-s_0 + self_0 + null + at-phase_0 + ns_0 + rp_0 + protected?_0 + ctx_0) + (values + null + (list + spec_0)))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (begin + (check-nested_0 + 'phaseless) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((all-from-except58_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((mod-path61_0 + (let ((s_3 + (car + s_2))) + s_3))) + (let ((id62_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) (let ((flat-s_0 (to-syntax-list.1 - s_2))) + s_4))) (if (not flat-s_0) (raise-syntax-error$1 #f "bad syntax" - exp-spec_0) - flat-s_0)))))) - (let ((begin102_1 - begin102_0)) + disarmed-spec_0) + (let ((id_0 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (id_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((s_5 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((id_1 + (let ((id_1 + (let ((id63_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-spec_0 + s_5)))) + (cons + id63_0 + id_0)))) + (values + id_1)))) + (for-loop_1 + id_1 + rest_1)))) + id_0)))))) + (for-loop_1 + null + flat-s_0))))) + (reverse$1 + id_0)))))))) + (let ((mod-path61_1 + mod-path61_0)) (values - begin102_1 - spec103_0)))) + mod-path61_1 + id62_0)))) (raise-syntax-error$1 #f "bad syntax" - exp-spec_0)))) - (case-lambda - ((begin100_0 - spec101_0) + disarmed-spec_0))))) + (case-lambda + ((mod-path59_0 + id60_0) + (let ((all-from-except58_1 + all-from-except58_0)) (values - #t - begin100_0 - spec101_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_2 - begin100_0 - spec101_0) + all-from-except58_1 + mod-path59_0 + id60_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((all-from-except55_0 + mod-path56_0 + id57_0) + (values + #t + all-from-except55_0 + mod-path56_0 + id57_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + all-from-except55_0 + mod-path56_0 + id57_0) + (begin + (parse-all-from + mod-path56_0 + orig-s_0 + self_0 + id57_0 + at-phase_0 + ns_0 + rp_0 + protected?_0 + ctx_0) + (values + null + (list + spec_0)))) + (args + (raise-binding-result-arity-error + 4 + args))))))) + (if (unsafe-fx< + index_0 + 11) + (if (unsafe-fx< + index_0 + 10) + (begin + (check-nested_0 + 'phaseless) + (call-with-values + (lambda () + (let ((all-defined64_0 + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((all-defined65_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (null? + s_2) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + (() + (let ((all-defined65_1 + all-defined65_0)) + (values + all-defined65_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (values + #t + all-defined64_0))) + (case-lambda + ((ok?_0 + all-defined64_0) + (begin + (parse-all-from-module + self_0 + spec_0 + orig-s_0 + null + #f + at-phase_0 + ns_0 + rp_0 + protected?_0) + (values + null + (list + spec_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (begin + (check-nested_0 + 'phaseless) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((all-defined-except68_0 + (let ((s_1 + (car + s_0))) + s_1))) + (let ((id69_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0) + (let ((id_0 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (id_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((s_3 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((id_1 + (let ((id_1 + (let ((id70_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_3) + (symbol? + (syntax-e$1 + s_3)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_3))) + s_3 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-spec_0 + s_3)))) + (cons + id70_0 + id_0)))) + (values + id_1)))) + (for-loop_1 + id_1 + rest_1)))) + id_0)))))) + (for-loop_1 + null + flat-s_0))))) + (reverse$1 + id_0)))))))) + (let ((all-defined-except68_1 + all-defined-except68_0)) + (values + all-defined-except68_1 + id69_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((all-defined-except66_0 + id67_0) + (values + #t + all-defined-except66_0 + id67_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + all-defined-except66_0 + id67_0) + (begin + (parse-all-from-module + self_0 + spec_0 + orig-s_0 + id67_0 + #f + at-phase_0 + ns_0 + rp_0 + protected?_0) + (values + null + (list + spec_0)))) + (args + (raise-binding-result-arity-error + 3 + args)))))) + (if (unsafe-fx< + index_0 + 12) + (begin + (check-nested_0 + 'phaseless) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((prefix-all-defined73_0 + (let ((s_1 + (car + s_0))) + s_1))) + (let ((id:prefix74_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((id:prefix75_0 + (let ((s_3 + (car + s_2))) + (if (let ((or-part_0 + (if (syntax?$1 + s_3) + (symbol? + (syntax-e$1 + s_3)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_3))) + s_3 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-spec_0 + s_3))))) + (call-with-values + (lambda () + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (null? + s_4) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + (() + (let ((id:prefix75_1 + id:prefix75_0)) + (values + id:prefix75_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))))) + (let ((prefix-all-defined73_1 + prefix-all-defined73_0)) + (values + prefix-all-defined73_1 + id:prefix74_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((prefix-all-defined71_0 + id:prefix72_0) + (values + #t + prefix-all-defined71_0 + id:prefix72_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + prefix-all-defined71_0 + id:prefix72_0) + (begin + (parse-all-from-module + self_0 + spec_0 + orig-s_0 + null + (syntax-e$1 + id:prefix72_0) + at-phase_0 + ns_0 + rp_0 + protected?_0) + (values + null + (list + spec_0)))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (if (unsafe-fx< + index_0 + 13) + (begin + (check-nested_0 + 'phaseless) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((prefix-all-defined-except79_0 + (let ((s_1 + (car + s_0))) + s_1))) (call-with-values (lambda () - (loop_0 - ctx_0 - ns_0 - orig-s_0 - rp_0 - self_0 - spec101_0 - at-phase_0 - protected?_0 - layer_0)) + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((id:prefix82_0 + (let ((s_3 + (car + s_2))) + (if (let ((or-part_0 + (if (syntax?$1 + s_3) + (symbol? + (syntax-e$1 + s_3)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_3))) + s_3 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-spec_0 + s_3))))) + (let ((id83_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0) + (let ((id_0 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (id_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((s_5 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((id_1 + (let ((id_1 + (let ((id84_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-spec_0 + s_5)))) + (cons + id84_0 + id_0)))) + (values + id_1)))) + (for-loop_1 + id_1 + rest_1)))) + id_0)))))) + (for-loop_1 + null + flat-s_0))))) + (reverse$1 + id_0)))))))) + (let ((id:prefix82_1 + id:prefix82_0)) + (values + id:prefix82_1 + id83_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) (case-lambda - ((track-stxes_1 - exp-specs_1) - (values - (list* - spec_0 - exp-spec_0 - track-stxes_1) - exp-specs_1)) + ((id:prefix80_0 + id81_0) + (let ((prefix-all-defined-except79_1 + prefix-all-defined-except79_0)) + (values + prefix-all-defined-except79_1 + id:prefix80_0 + id81_0))) (args (raise-binding-result-arity-error 2 args))))) - (args - (raise-binding-result-arity-error - 3 - args))))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (args - (raise-binding-result-arity-error - 4 - args))))))))))))) - (case-lambda - ((track-stxes1_0 exp-specs2_0) - (values - (cons - track-stxes1_0 - track-stxes_0) - (cons - exp-specs2_0 - exp-specs_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((prefix-all-defined-except76_0 + id:prefix77_0 + id78_0) + (values + #t + prefix-all-defined-except76_0 + id:prefix77_0 + id78_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + prefix-all-defined-except76_0 + id:prefix77_0 + id78_0) + (begin + (parse-all-from-module + self_0 + spec_0 + orig-s_0 + id78_0 + (syntax-e$1 + id:prefix77_0) + at-phase_0 + ns_0 + rp_0 + protected?_0) + (values + null + (list + spec_0)))) + (args + (raise-binding-result-arity-error + 4 + args))))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((expand88_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (call-with-values + (lambda () + (let ((s_3 + (car + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((id93_0 + (let ((s_5 + (car + s_4))) + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-spec_0 + s_5))))) + (let ((datum94_0 + (let ((s_5 + (cdr + s_4))) + s_5))) + (let ((id93_1 + id93_0)) + (values + id93_1 + datum94_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + ((id91_0 + datum92_0) + (call-with-values + (lambda () + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (null? + s_4) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + (() + (let ((id91_1 + id91_0) + (datum92_1 + datum92_0)) + (values + id91_1 + datum92_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + ((id89_0 + datum90_0) + (let ((expand88_1 + expand88_0)) + (values + expand88_1 + id89_0 + datum90_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((expand85_0 + id86_0 + datum87_0) + (values + #t + expand85_0 + id86_0 + datum87_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + expand85_0 + id86_0 + datum87_0) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-spec_0) + (syntax-e$1 + disarmed-spec_0) + disarmed-spec_0))) + (if (pair? + s_0) + (let ((expand97_0 + (let ((s_1 + (car + s_0))) + s_1))) + (let ((form98_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((form99_0 + (let ((s_3 + (car + s_2))) + s_3))) + (call-with-values + (lambda () + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (null? + s_4) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0))))) + (case-lambda + (() + (let ((form99_1 + form99_0)) + (values + form99_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))))) + (let ((expand97_1 + expand97_0)) + (values + expand97_1 + form98_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-spec_0)))) + (case-lambda + ((expand95_0 + form96_0) + (values + #t + expand95_0 + form96_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_1 + expand95_0 + form96_0) + (let ((exp-spec_0 + (let ((temp105_0 + (if (expand-context/outer? + ctx_0) + (let ((inner107_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx_0))) + (if (expand-context/inner? + the-struct_0) + (let ((stops108_0 + (free-id-set + at-phase_0 + (list + (core-id + 'begin + at-phase_0))))) + (let ((app_0 + (root-expand-context/inner-self-mpi + the-struct_0))) + (let ((app_1 + (root-expand-context/inner-module-scopes + the-struct_0))) + (let ((app_2 + (root-expand-context/inner-top-level-bind-scope + the-struct_0))) + (let ((app_3 + (root-expand-context/inner-all-scopes-stx + the-struct_0))) + (let ((app_4 + (root-expand-context/inner-defined-syms + the-struct_0))) + (let ((app_5 + (root-expand-context/inner-counter + the-struct_0))) + (let ((app_6 + (root-expand-context/inner-lift-key + the-struct_0))) + (let ((app_7 + (expand-context/inner-to-parsed? + the-struct_0))) + (let ((app_8 + (expand-context/inner-phase + the-struct_0))) + (let ((app_9 + (expand-context/inner-namespace + the-struct_0))) + (let ((app_10 + (expand-context/inner-just-once? + the-struct_0))) + (let ((app_11 + (expand-context/inner-module-begin-k + the-struct_0))) + (let ((app_12 + (expand-context/inner-allow-unbound? + the-struct_0))) + (let ((app_13 + (expand-context/inner-in-local-expand? + the-struct_0))) + (let ((app_14 + (|expand-context/inner-keep-#%expression?| + the-struct_0))) + (let ((app_15 + (expand-context/inner-declared-submodule-names + the-struct_0))) + (let ((app_16 + (expand-context/inner-lifts + the-struct_0))) + (let ((app_17 + (expand-context/inner-lift-envs + the-struct_0))) + (let ((app_18 + (expand-context/inner-module-lifts + the-struct_0))) + (let ((app_19 + (expand-context/inner-require-lifts + the-struct_0))) + (let ((app_20 + (expand-context/inner-to-module-lifts + the-struct_0))) + (let ((app_21 + (expand-context/inner-requires+provides + the-struct_0))) + (let ((app_22 + (expand-context/inner-observer + the-struct_0))) + (let ((app_23 + (expand-context/inner-for-serializable? + the-struct_0))) + (let ((app_24 + (expand-context/inner-to-correlated-linklet? + the-struct_0))) + (let ((app_25 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_26 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + app_12 + app_13 + app_14 + stops108_0 + app_15 + app_16 + app_17 + app_18 + app_19 + app_20 + app_21 + app_22 + app_23 + app_24 + app_25 + app_26 + (expand-context/inner-skip-visit-available? + the-struct_0)))))))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((app_0 + (root-expand-context/outer-post-expansion + ctx_0))) + (let ((app_1 + (root-expand-context/outer-use-site-scopes + ctx_0))) + (let ((app_2 + (root-expand-context/outer-frame-id + ctx_0))) + (let ((app_3 + (expand-context/outer-context + ctx_0))) + (let ((app_4 + (expand-context/outer-env + ctx_0))) + (let ((app_5 + (expand-context/outer-scopes + ctx_0))) + (let ((app_6 + (expand-context/outer-binding-layer + ctx_0))) + (let ((app_7 + (expand-context/outer-reference-records + ctx_0))) + (let ((app_8 + (expand-context/outer-only-immediate? + ctx_0))) + (let ((app_9 + (expand-context/outer-need-eventually-defined + ctx_0))) + (let ((app_10 + (expand-context/outer-current-introduction-scopes + ctx_0))) + (let ((app_11 + (expand-context/outer-current-use-scopes + ctx_0))) + (expand-context/outer1.1 + inner107_0 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + #f + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + (expand-context/outer-name + ctx_0))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx_0)))) + (expand.1 + #f + #f + form96_0 + temp105_0)))) + (begin + (if (if (pair? + (syntax-e$1 + exp-spec_0)) + (if (identifier? + (car + (syntax-e$1 + exp-spec_0))) + (eq? + 'begin + (core-form-sym + exp-spec_0 + at-phase_0)) + #f) + #f) + (void) + (raise-syntax-error$1 + 'provide + "expansion was not a `begin' sequence" + orig-s_0 + spec_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + exp-spec_0) + (syntax-e$1 + exp-spec_0) + exp-spec_0))) + (if (pair? + s_0) + (let ((begin102_0 + (let ((s_1 + (car + s_0))) + s_1))) + (let ((spec103_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + exp-spec_0) + flat-s_0)))))) + (let ((begin102_1 + begin102_0)) + (values + begin102_1 + spec103_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + exp-spec_0)))) + (case-lambda + ((begin100_0 + spec101_0) + (values + #t + begin100_0 + spec101_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_2 + begin100_0 + spec101_0) + (call-with-values + (lambda () + (loop_0 + spec101_0 + at-phase_0 + protected?_0 + layer_0)) + (case-lambda + ((track-stxes_1 + exp-specs_1) + (values + (list* + spec_0 + exp-spec_0 + track-stxes_1) + exp-specs_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 3 + args))))))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (args + (raise-binding-result-arity-error + 4 + args)))))))))))))) (case-lambda - ((track-stxes_1 exp-specs_1) + ((track-stxes1_0 exp-specs2_0) (values - track-stxes_1 - exp-specs_1)) + (cons + track-stxes1_0 + track-stxes_0) + (cons exp-specs2_0 exp-specs_0))) (args (raise-binding-result-arity-error 2 args))))) (case-lambda ((track-stxes_1 exp-specs_1) - (for-loop_0 - track-stxes_1 - exp-specs_1 - rest_0)) + (values track-stxes_1 exp-specs_1)) (args (raise-binding-result-arity-error 2 - args)))))) - (values track-stxes_0 exp-specs_0))))))) - (for-loop_0 null null specs_0)))) - (case-lambda - ((track-stxes_0 exp-specs_0) - (let ((app_0 (reverse$1 track-stxes_0))) - (values app_0 (reverse$1 exp-specs_0)))) - (args (raise-binding-result-arity-error 2 args))))) + args))))) + (case-lambda + ((track-stxes_1 exp-specs_1) + (for-loop_0 + track-stxes_1 + exp-specs_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values track-stxes_0 exp-specs_0))))))) + (for-loop_0 null null specs_1)))) (case-lambda - ((track-stxess_0 exp-specss_0) - (let ((app_0 (apply append track-stxess_0))) - (values app_0 (apply append exp-specss_0)))) - (args (raise-binding-result-arity-error 2 args))))))))) - (lambda (specs_0 orig-s_0 rp_0 self_0 phase_0 ctx_0) - (let ((ns_0 - (begin-unsafe - (expand-context/inner-namespace - (root-expand-context/outer-inner ctx_0))))) - (loop_0 ctx_0 ns_0 orig-s_0 rp_0 self_0 specs_0 phase_0 #f 'raw))))) + ((track-stxes_0 exp-specs_0) + (let ((app_0 (reverse$1 track-stxes_0))) + (values app_0 (reverse$1 exp-specs_0)))) + (args (raise-binding-result-arity-error 2 args))))) + (case-lambda + ((track-stxess_0 exp-specss_0) + (let ((app_0 (apply append track-stxess_0))) + (values app_0 (apply append exp-specss_0)))) + (args (raise-binding-result-arity-error 2 args))))))))) + (loop_0 specs_0 phase_0 #f 'raw))))) (define parse-identifier! (lambda (spec_0 orig-s_0 sym_0 at-phase_0 ns_0 rp_0 protected?_0) (let ((b_0 (resolve+shift/extra-inspector spec_0 at-phase_0 ns_0))) @@ -87357,87 +86625,86 @@ spec_0 orig-s_0))))))) (define parse-struct! - (letrec ((mk2_0 - (|#%name| - mk2 - (lambda (id:struct_0 fmt_0 field-id_0) - (begin - (let ((sym_0 - (string->symbol - (let ((app_0 (syntax-e$1 id:struct_0))) - (format fmt_0 app_0 (syntax-e$1 field-id_0)))))) - (datum->syntax$1 id:struct_0 sym_0 id:struct_0)))))) - (mk_0 - (|#%name| - mk - (lambda (id:struct_0 fmt_0) - (begin - (let ((sym_0 - (string->symbol - (format fmt_0 (syntax-e$1 id:struct_0))))) - (datum->syntax$1 id:struct_0 sym_0 id:struct_0))))))) - (lambda (id:struct_0 orig-s_0 fields_0 at-phase_0 ns_0 rp_0 protected?_0) - (begin - (let ((lst_0 (list "~a" "make-~a" "struct:~a" "~a?"))) + (lambda (id:struct_0 orig-s_0 fields_0 at-phase_0 ns_0 rp_0 protected?_0) + (let ((mk_0 + (|#%name| + mk + (lambda (fmt_0) + (begin + (let ((sym_0 + (string->symbol + (format fmt_0 (syntax-e$1 id:struct_0))))) + (datum->syntax$1 id:struct_0 sym_0 id:struct_0))))))) + (let ((mk2_0 + (|#%name| + mk2 + (lambda (fmt_0 field-id_0) + (begin + (let ((sym_0 + (string->symbol + (let ((app_0 (syntax-e$1 id:struct_0))) + (format fmt_0 app_0 (syntax-e$1 field-id_0)))))) + (datum->syntax$1 id:struct_0 sym_0 id:struct_0))))))) + (begin + (let ((lst_0 (list "~a" "make-~a" "struct:~a" "~a?"))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? lst_1) + (let ((fmt_0 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (begin + (let ((id_0 (mk_0 fmt_0))) + (parse-identifier! + id_0 + orig-s_0 + (syntax-e$1 id_0) + at-phase_0 + ns_0 + rp_0 + protected?_0)) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 lst_0)))) + (void) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (lst_1) + (lambda (lst_0) (begin - (if (pair? lst_1) - (let ((fmt_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) + (if (pair? lst_0) + (let ((field_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) (begin - (let ((id_0 (mk_0 id:struct_0 fmt_0))) - (parse-identifier! - id_0 - orig-s_0 - (syntax-e$1 id_0) - at-phase_0 - ns_0 - rp_0 - protected?_0)) + (let ((get-id_0 (mk2_0 "~a-~a" field_0))) + (let ((set-id_0 (mk2_0 "set-~a-~a!" field_0))) + (begin + (parse-identifier! + get-id_0 + orig-s_0 + (syntax-e$1 get-id_0) + at-phase_0 + ns_0 + rp_0 + protected?_0) + (parse-identifier! + set-id_0 + orig-s_0 + (syntax-e$1 set-id_0) + at-phase_0 + ns_0 + rp_0 + protected?_0)))) (for-loop_0 rest_0)))) (values))))))) - (for-loop_0 lst_0)))) - (void) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((field_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (let ((get-id_0 (mk2_0 id:struct_0 "~a-~a" field_0))) - (let ((set-id_0 - (mk2_0 id:struct_0 "set-~a-~a!" field_0))) - (begin - (parse-identifier! - get-id_0 - orig-s_0 - (syntax-e$1 get-id_0) - at-phase_0 - ns_0 - rp_0 - protected?_0) - (parse-identifier! - set-id_0 - orig-s_0 - (syntax-e$1 set-id_0) - at-phase_0 - ns_0 - rp_0 - protected?_0)))) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 fields_0))) - (void))))) + (for-loop_0 fields_0))) + (void)))))) (define parse-all-from (lambda (mod-path-stx_0 orig-s_0 @@ -87469,36 +86736,26 @@ rp_0 protected?_0)))))) (define parse-all-from-module - (letrec ((add-prefix_0 - (|#%name| - add-prefix - (lambda (prefix-sym_0 sym_0) - (begin - (if prefix-sym_0 - (string->symbol - (let ((app_0 (symbol->string prefix-sym_0))) - (string-append app_0 (symbol->string sym_0)))) - sym_0))))) - (phase-desc_0 - (|#%name| - phase-desc - (lambda (at-phase_0) - (begin - (if (begin-unsafe (eq? at-phase_0 0)) - "" - (if (begin-unsafe (not at-phase_0)) - " for-label" - (format " for phase ~a" at-phase_0)))))))) - (lambda (mpi_0 - matching-stx_0 - orig-s_0 - except-ids_0 - prefix-sym_0 - at-phase_0 - ns_0 - rp_0 - protected?_0) - (let ((requireds_0 (extract-module-requires rp_0 mpi_0 at-phase_0))) + (lambda (mpi_0 + matching-stx_0 + orig-s_0 + except-ids_0 + prefix-sym_0 + at-phase_0 + ns_0 + rp_0 + protected?_0) + (let ((requireds_0 (extract-module-requires rp_0 mpi_0 at-phase_0))) + (let ((phase-desc_0 + (|#%name| + phase-desc + (lambda () + (begin + (if (begin-unsafe (eq? at-phase_0 0)) + "" + (if (begin-unsafe (not at-phase_0)) + " for-label" + (format " for phase ~a" at-phase_0)))))))) (begin (if requireds_0 (void) @@ -87506,10 +86763,218 @@ 'provide (format "cannot provide from a module without a matching require~a" - (phase-desc_0 at-phase_0)) + (phase-desc_0)) orig-s_0 matching-stx_0)) - (let ((found_0 (make-hasheq))) + (let ((add-prefix_0 + (|#%name| + add-prefix + (lambda (sym_0) + (begin + (if prefix-sym_0 + (string->symbol + (let ((app_0 (symbol->string prefix-sym_0))) + (string-append app_0 (symbol->string sym_0)))) + sym_0)))))) + (let ((found_0 (make-hasheq))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((i_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (let ((id_0 (required-id i_0))) + (let ((phase_0 (required-phase i_0))) + (if (let ((or-part_0 + (if matching-stx_0 + (not + (if (eqv? + phase_0 + at-phase_0) + (free-identifier=?$1 + id_0 + (datum->syntax$1 + matching-stx_0 + (syntax-e$1 id_0)) + phase_0 + phase_0) + #f)) + #f))) + (if or-part_0 + or-part_0 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (result_0 lst_1) + (begin + (if (pair? lst_1) + (let ((except-id_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((result_1 + (let ((result_1 + (if (free-identifier=?$1 + id_0 + except-id_0 + phase_0 + phase_0) + (hash-set! + found_0 + except-id_0 + #t) + #f))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + except-id_0))) + result_1)) + #t + #f) + (for-loop_1 + result_1 + rest_1) + result_1)))) + result_0)))))) + (for-loop_1 + #f + except-ids_0))))) + (void) + (let ((b_0 + (resolve+shift/extra-inspector + id_0 + phase_0 + ns_0))) + (let ((immed-b_0 + (resolve+shift.1 + #f + #f + null + #t + #f + id_0 + phase_0))) + (let ((temp122_0 + (add-prefix_0 + (syntax-e$1 id_0)))) + (let ((temp129_0 + (required-as-transformer? + i_0))) + (let ((temp122_1 temp122_0)) + (add-provide!.1 + protected?_0 + temp129_0 + rp_0 + temp122_1 + phase_0 + b_0 + immed-b_0 + id_0 + orig-s_0))))))))) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 requireds_0))) + (void) + (if (let ((app_0 (hash-count found_0))) + (= app_0 (length except-ids_0))) + (void) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((except-id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (if (let ((or-part_0 + (hash-ref + found_0 + except-id_0 + #f))) + (if or-part_0 + or-part_0 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (result_0 lst_1) + (begin + (if (pair? lst_1) + (let ((i_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((result_1 + (let ((result_1 + (let ((id_0 + (required-id + i_0))) + (let ((phase_0 + (required-phase + i_0))) + (free-identifier=?$1 + id_0 + except-id_0 + phase_0 + phase_0))))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + i_0))) + result_1)) + #t + #f) + (for-loop_1 + result_1 + rest_1) + result_1)))) + result_0)))))) + (for-loop_1 + #f + requireds_0))))) + (void) + (raise-syntax-error$1 + 'provide + (let ((app_0 + (if matching-stx_0 + "excluded identifier was not defined or required in the module~a" + "excluded identifier was not required from the specified module~a"))) + (format app_0 (phase-desc_0))) + orig-s_0 + except-id_0)) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 except-ids_0))) + (void))))))))))) +(define check-cross-phase-persistent-form + (lambda (bodys_0 self-mpi_0) + (letrec* + ((check-body_0 + (|#%name| + check-body + (lambda (bodys_1) + (begin (begin (begin (letrec* @@ -87519,481 +86984,247 @@ (lambda (lst_0) (begin (if (pair? lst_0) - (let ((i_0 (unsafe-car lst_0))) + (let ((body_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) (begin - (let ((id_0 (required-id i_0))) - (let ((phase_0 (required-phase i_0))) + (let ((p_0 + (if (expanded+parsed? body_0) + (expanded+parsed-parsed body_0) + body_0))) + (if (parsed-define-values? p_0) + (let ((app_0 + (parsed-define-values-rhs p_0))) + (check-expr_0 + app_0 + (length (parsed-define-values-syms p_0)) + p_0)) (if (let ((or-part_0 - (if matching-stx_0 - (not - (if (eqv? phase_0 at-phase_0) - (free-identifier=?$1 - id_0 - (datum->syntax$1 - matching-stx_0 - (syntax-e$1 id_0)) - phase_0 - phase_0) - #f)) - #f))) + (|parsed-#%declare?| p_0))) (if or-part_0 or-part_0 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (result_0 lst_1) - (begin - (if (pair? lst_1) - (let ((except-id_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((result_1 - (let ((result_1 - (if (free-identifier=?$1 - id_0 - except-id_0 - phase_0 - phase_0) - (hash-set! - found_0 - except-id_0 - #t) - #f))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - except-id_0))) - result_1)) - #t - #f) - (for-loop_1 - result_1 - rest_1) - result_1)))) - result_0)))))) - (for-loop_1 #f except-ids_0))))) + (let ((or-part_1 + (parsed-module? p_0))) + (if or-part_1 + or-part_1 + (syntax?$1 p_0))))) (void) - (let ((b_0 - (resolve+shift/extra-inspector - id_0 - phase_0 - ns_0))) - (let ((immed-b_0 - (resolve+shift.1 - #f - #f - null - #t - #f - id_0 - phase_0))) - (let ((temp122_0 - (add-prefix_0 - prefix-sym_0 - (syntax-e$1 id_0)))) - (let ((temp129_0 - (required-as-transformer? - i_0))) - (let ((temp122_1 temp122_0)) - (add-provide!.1 - protected?_0 - temp129_0 - rp_0 - temp122_1 - phase_0 - b_0 - immed-b_0 - id_0 - orig-s_0))))))))) + (disallow p_0)))) (for-loop_0 rest_0)))) (values))))))) - (for-loop_0 requireds_0))) - (void) - (if (let ((app_0 (hash-count found_0))) - (= app_0 (length except-ids_0))) - (void) + (for-loop_0 bodys_1))) + (void)))))) + (check-expr_0 + (|#%name| + check-expr + (lambda (e_0 num-results_0 enclosing_0) + (begin + (if (parsed-lambda? e_0) + (begin + (check-count 1 num-results_0 enclosing_0) + (check-no-disallowed-expr_0 e_0)) + (if (parsed-case-lambda? e_0) (begin + (check-count 1 num-results_0 enclosing_0) + (check-no-disallowed-expr_0 e_0)) + (if (parsed-quote? e_0) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((except-id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (if (let ((or-part_0 - (hash-ref - found_0 - except-id_0 - #f))) - (if or-part_0 - or-part_0 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (result_0 lst_1) - (begin - (if (pair? lst_1) - (let ((i_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((result_1 - (let ((result_1 - (let ((id_0 - (required-id - i_0))) - (let ((phase_0 - (required-phase - i_0))) - (free-identifier=?$1 - id_0 - except-id_0 - phase_0 - phase_0))))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - i_0))) - result_1)) - #t - #f) - (for-loop_1 - result_1 - rest_1) - result_1)))) - result_0)))))) - (for-loop_1 #f requireds_0))))) + (check-datum (parsed-quote-datum e_0) e_0) + (check-count 1 num-results_0 enclosing_0)) + (if (parsed-app? e_0) + (let ((rands_0 (parsed-app-rands e_0))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((rand_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (check-expr_0 rand_0 1 e_0) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 rands_0))) + (void) + (let ((tmp_0 + (cross-phase-primitive-name + (parsed-app-rator e_0)))) + (if (if (eq? tmp_0 'cons) #t (eq? tmp_0 'list)) + (check-count 1 num-results_0 enclosing_0) + (if (eq? tmp_0 'make-struct-type) + (check-count 5 num-results_0 enclosing_0) + (if (eq? tmp_0 'make-struct-type-property) + (check-count 3 num-results_0 enclosing_0) + (if (eq? tmp_0 'gensym) + (if (let ((or-part_0 (= 0 (length rands_0)))) + (if or-part_0 + or-part_0 + (if (= 1 (length rands_0)) + (quoted-string? (car rands_0)) + #f))) + (void) + (disallow e_0)) + (if (eq? tmp_0 'string->uninterned-symbol) + (if (if (= 1 (length rands_0)) + (quoted-string? (car rands_0)) + #f) (void) - (raise-syntax-error$1 - 'provide - (let ((app_0 - (if matching-stx_0 - "excluded identifier was not defined or required in the module~a" - "excluded identifier was not required from the specified module~a"))) - (format - app_0 - (phase-desc_0 at-phase_0))) - orig-s_0 - except-id_0)) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 except-ids_0))) - (void)))))))))) -(define check-cross-phase-persistent-form - (letrec ((check-body-no-disallowed-expr_0 - (|#%name| - check-body-no-disallowed-expr - (lambda (self-mpi_0 l_0) - (begin - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((e_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (check-no-disallowed-expr_0 - self-mpi_0 - e_0) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 l_0))) - (void)))))) - (check-body_0 - (|#%name| - check-body - (lambda (self-mpi_0 bodys_0) - (begin - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((body_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (let ((p_0 - (if (expanded+parsed? body_0) - (expanded+parsed-parsed body_0) - body_0))) - (if (parsed-define-values? p_0) - (let ((app_0 - (parsed-define-values-rhs - p_0))) - (check-expr_0 - self-mpi_0 - app_0 - (length - (parsed-define-values-syms p_0)) - p_0)) - (if (let ((or-part_0 - (|parsed-#%declare?| p_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (parsed-module? p_0))) - (if or-part_1 - or-part_1 - (syntax?$1 p_0))))) - (void) - (disallow p_0)))) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 bodys_0))) - (void)))))) - (check-expr_0 - (|#%name| - check-expr - (lambda (self-mpi_0 e_0 num-results_0 enclosing_0) - (begin - (if (parsed-lambda? e_0) - (begin - (check-count 1 num-results_0 enclosing_0) - (check-no-disallowed-expr_0 self-mpi_0 e_0)) - (if (parsed-case-lambda? e_0) - (begin - (check-count 1 num-results_0 enclosing_0) - (check-no-disallowed-expr_0 self-mpi_0 e_0)) - (if (parsed-quote? e_0) - (begin - (check-datum (parsed-quote-datum e_0) e_0) - (check-count 1 num-results_0 enclosing_0)) - (if (parsed-app? e_0) - (let ((rands_0 (parsed-app-rands e_0))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((rand_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (check-expr_0 - self-mpi_0 - rand_0 - 1 - e_0) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 rands_0))) - (void) - (let ((tmp_0 - (cross-phase-primitive-name - (parsed-app-rator e_0)))) - (if (if (eq? tmp_0 'cons) #t (eq? tmp_0 'list)) - (check-count 1 num-results_0 enclosing_0) - (if (eq? tmp_0 'make-struct-type) - (check-count 5 num-results_0 enclosing_0) - (if (eq? tmp_0 'make-struct-type-property) - (check-count 3 num-results_0 enclosing_0) - (if (eq? tmp_0 'gensym) - (if (let ((or-part_0 - (= 0 (length rands_0)))) - (if or-part_0 - or-part_0 - (if (= 1 (length rands_0)) - (quoted-string? (car rands_0)) - #f))) - (void) - (disallow e_0)) - (if (eq? - tmp_0 - 'string->uninterned-symbol) - (if (if (= 1 (length rands_0)) - (quoted-string? (car rands_0)) - #f) - (void) - (disallow e_0)) - (disallow e_0))))))))) - (check-no-disallowed-expr_0 self-mpi_0 e_0))))))))) - (check-no-disallowed-expr_0 - (|#%name| - check-no-disallowed-expr - (lambda (self-mpi_0 e_0) - (begin - (if (parsed-lambda? e_0) - (check-body-no-disallowed-expr_0 - self-mpi_0 - (parsed-lambda-body e_0)) - (if (parsed-case-lambda? e_0) - (begin - (let ((lst_0 (parsed-case-lambda-clauses e_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((clause_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (begin - (check-body-no-disallowed-expr_0 - self-mpi_0 - (cadr clause_0)) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void)) - (if (if (parsed-app? e_0) - (if (eq? - 'variable-reference-from-unsafe? - (cross-phase-primitive-name - (parsed-app-rator e_0))) - (andmap_2344 - |parsed-#%variable-reference?| - (parsed-app-rands e_0)) - #f) - #f) - (void) - (if (parsed-app? e_0) - (begin - (check-no-disallowed-expr_0 - self-mpi_0 - (parsed-app-rator e_0)) - (let ((lst_0 (parsed-app-rands e_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((e_1 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (begin - (check-no-disallowed-expr_0 - self-mpi_0 - e_1) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void)) - (if (parsed-if? e_0) - (begin - (check-no-disallowed-expr_0 - self-mpi_0 - (parsed-if-tst e_0)) - (check-no-disallowed-expr_0 - self-mpi_0 - (parsed-if-thn e_0)) - (check-no-disallowed-expr_0 - self-mpi_0 - (parsed-if-els e_0))) - (if (parsed-set!? e_0) - (let ((id_0 (parsed-set!-id e_0))) - (let ((normal-b_0 (parsed-id-binding id_0))) - (begin - (if (let ((or-part_0 (not normal-b_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (parsed-top-id? id_0))) - (if or-part_1 - or-part_1 - (if (not (symbol? normal-b_0)) - (eq? - (module-binding-module - normal-b_0) - self-mpi_0) - #f))))) - (disallow e_0) - (void)) - (check-no-disallowed-expr_0 - self-mpi_0 - (parsed-set!-rhs e_0))))) - (if (parsed-with-continuation-mark? e_0) - (begin - (check-no-disallowed-expr_0 - self-mpi_0 - (parsed-with-continuation-mark-key e_0)) - (check-no-disallowed-expr_0 - self-mpi_0 - (parsed-with-continuation-mark-val e_0)) - (check-no-disallowed-expr_0 - self-mpi_0 - (parsed-with-continuation-mark-body e_0))) - (if (parsed-begin? e_0) - (check-body-no-disallowed-expr_0 - self-mpi_0 - (parsed-begin-body e_0)) - (if (parsed-begin0? e_0) - (check-body-no-disallowed-expr_0 - self-mpi_0 - (parsed-begin0-body e_0)) - (if (parsed-let_-values? e_0) - (begin - (let ((lst_0 - (parsed-let_-values-clauses - e_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((clause_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (begin - (check-no-disallowed-expr_0 - self-mpi_0 - (cadr clause_0)) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void) - (check-body-no-disallowed-expr_0 - self-mpi_0 - (parsed-let_-values-body e_0))) - (if (let ((or-part_0 - (parsed-quote-syntax? e_0))) - (if or-part_0 - or-part_0 - (|parsed-#%variable-reference?| - e_0))) - (disallow e_0) - (void))))))))))))))))) - (lambda (bodys_0 self-mpi_0) (check-body_0 self-mpi_0 bodys_0)))) + (disallow e_0)) + (disallow e_0))))))))) + (check-no-disallowed-expr_0 e_0))))))))) + (check-no-disallowed-expr_0 + (|#%name| + check-no-disallowed-expr + (lambda (e_0) + (begin + (if (parsed-lambda? e_0) + (check-body-no-disallowed-expr_0 (parsed-lambda-body e_0)) + (if (parsed-case-lambda? e_0) + (begin + (let ((lst_0 (parsed-case-lambda-clauses e_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? lst_1) + (let ((clause_0 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (begin + (check-body-no-disallowed-expr_0 + (cadr clause_0)) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 lst_0)))) + (void)) + (if (if (parsed-app? e_0) + (if (eq? + 'variable-reference-from-unsafe? + (cross-phase-primitive-name (parsed-app-rator e_0))) + (andmap_2344 + |parsed-#%variable-reference?| + (parsed-app-rands e_0)) + #f) + #f) + (void) + (if (parsed-app? e_0) + (begin + (check-no-disallowed-expr_0 (parsed-app-rator e_0)) + (let ((lst_0 (parsed-app-rands e_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? lst_1) + (let ((e_1 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (begin + (check-no-disallowed-expr_0 e_1) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 lst_0)))) + (void)) + (if (parsed-if? e_0) + (begin + (check-no-disallowed-expr_0 (parsed-if-tst e_0)) + (check-no-disallowed-expr_0 (parsed-if-thn e_0)) + (check-no-disallowed-expr_0 (parsed-if-els e_0))) + (if (parsed-set!? e_0) + (let ((id_0 (parsed-set!-id e_0))) + (let ((normal-b_0 (parsed-id-binding id_0))) + (begin + (if (let ((or-part_0 (not normal-b_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (parsed-top-id? id_0))) + (if or-part_1 + or-part_1 + (if (not (symbol? normal-b_0)) + (eq? + (module-binding-module normal-b_0) + self-mpi_0) + #f))))) + (disallow e_0) + (void)) + (check-no-disallowed-expr_0 + (parsed-set!-rhs e_0))))) + (if (parsed-with-continuation-mark? e_0) + (begin + (check-no-disallowed-expr_0 + (parsed-with-continuation-mark-key e_0)) + (check-no-disallowed-expr_0 + (parsed-with-continuation-mark-val e_0)) + (check-no-disallowed-expr_0 + (parsed-with-continuation-mark-body e_0))) + (if (parsed-begin? e_0) + (check-body-no-disallowed-expr_0 + (parsed-begin-body e_0)) + (if (parsed-begin0? e_0) + (check-body-no-disallowed-expr_0 + (parsed-begin0-body e_0)) + (if (parsed-let_-values? e_0) + (begin + (let ((lst_0 + (parsed-let_-values-clauses e_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? lst_1) + (let ((clause_0 + (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) + (begin + (check-no-disallowed-expr_0 + (cadr clause_0)) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 lst_0)))) + (void) + (check-body-no-disallowed-expr_0 + (parsed-let_-values-body e_0))) + (if (let ((or-part_0 + (parsed-quote-syntax? e_0))) + (if or-part_0 + or-part_0 + (|parsed-#%variable-reference?| e_0))) + (disallow e_0) + (void)))))))))))))))) + (check-body-no-disallowed-expr_0 + (|#%name| + check-body-no-disallowed-expr + (lambda (l_0) + (begin + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((e_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (check-no-disallowed-expr_0 e_0) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 l_0))) + (void))))))) + (check-body_0 bodys_0)))) (define check-count (lambda (is-num_0 expected-num_0 enclosing_0) (if (= is-num_0 expected-num_0) (void) (disallow enclosing_0)))) @@ -88314,287 +87545,243 @@ s_0))))) (void))) (define expand-module.1 - (letrec ((initial-require!_0 - (|#%name| - initial-require! - (lambda (enclosing-is-cross-phase-persistent?3_0 - enclosing-mod_0 - enclosing-requires+provides4_0 - initial-require-s_0 - initial-require_0 - keep-enclosing-scope-at-phase2_0 - m-ns_0 - requires+provides_0 - self_0 - bind?217_0) - (begin - (if (not keep-enclosing-scope-at-phase2_0) - (let ((requires+provides259_0 - (unsafe-unbox* requires+provides_0))) - (perform-initial-require!.1 - bind?217_0 - 'module - initial-require_0 - self_0 - initial-require-s_0 - m-ns_0 - requires+provides259_0)) - (begin - (add-required-module! - (unsafe-unbox* requires+provides_0) - enclosing-mod_0 - keep-enclosing-scope-at-phase2_0 - enclosing-is-cross-phase-persistent?3_0) - (let ((requires+provides262_0 - (unsafe-unbox* requires+provides_0))) - (add-enclosing-module-defined-and-required!.1 - enclosing-requires+provides4_0 - requires+provides262_0 - enclosing-mod_0 - keep-enclosing-scope-at-phase2_0)) - (namespace-module-visit!.1 - unsafe-undefined - m-ns_0 - enclosing-mod_0 - keep-enclosing-scope-at-phase2_0))))))) - (make-m-ns_0 - (|#%name| - make-m-ns - (lambda (enclosing-self15_0 - root-ctx_0 - self_0 - for-submodule?213_0 - ns215_0) - (begin - (let ((for-submodule?_0 - (if (eq? for-submodule?213_0 unsafe-undefined) - (if enclosing-self15_0 #t #f) - for-submodule?213_0))) - (make-module-namespace.1 - for-submodule?_0 - self_0 - root-ctx_0 - ns215_0))))))) - (|#%name| - expand-module - (lambda (always-produce-compiled?1_0 - enclosing-is-cross-phase-persistent?3_0 - enclosing-requires+provides4_0 - keep-enclosing-scope-at-phase2_0 - modules-being-compiled6_0 - mpis-for-enclosing-reset5_0 - s13_0 - init-ctx14_0 - enclosing-self15_0) - (begin - (let ((modules-being-compiled_0 - (if (eq? modules-being-compiled6_0 unsafe-undefined) - (make-hasheq) - modules-being-compiled6_0))) - (let ((disarmed-s_0 (syntax-disarm$1 s13_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner init-ctx14_0))))) - (if obs_0 - (call-expand-observe obs_0 'prim-module disarmed-s_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 disarmed-s_0) - (syntax-e$1 disarmed-s_0) - disarmed-s_0))) - (if (pair? s_0) - (let ((module204_0 (let ((s_1 (car s_0))) s_1))) - (call-with-values - (lambda () - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (if (pair? s_2) - (let ((id:module-name208_0 - (let ((s_3 (car s_2))) - (if (let ((or-part_0 - (if (syntax?$1 s_3) - (symbol? - (syntax-e$1 s_3)) - #f))) - (if or-part_0 - or-part_0 - (symbol? s_3))) - s_3 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-s_0 - s_3))))) - (call-with-values - (lambda () - (let ((s_3 (cdr s_2))) - (let ((s_4 - (if (syntax?$1 s_3) - (syntax-e$1 s_3) - s_3))) - (if (pair? s_4) - (let ((initial-require211_0 - (let ((s_5 (car s_4))) - s_5))) - (let ((body212_0 - (let ((s_5 (cdr s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 + (|#%name| + expand-module + (lambda (always-produce-compiled?1_0 + enclosing-is-cross-phase-persistent?3_0 + enclosing-requires+provides4_0 + keep-enclosing-scope-at-phase2_0 + modules-being-compiled6_0 + mpis-for-enclosing-reset5_0 + s13_0 + init-ctx14_0 + enclosing-self15_0) + (begin + (let ((modules-being-compiled_0 + (if (eq? modules-being-compiled6_0 unsafe-undefined) + (make-hasheq) + modules-being-compiled6_0))) + (let ((disarmed-s_0 (syntax-disarm$1 s13_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner init-ctx14_0))))) + (if obs_0 + (call-expand-observe obs_0 'prim-module disarmed-s_0) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 disarmed-s_0) + (syntax-e$1 disarmed-s_0) + disarmed-s_0))) + (if (pair? s_0) + (let ((module204_0 (let ((s_1 (car s_0))) s_1))) + (call-with-values + (lambda () + (let ((s_1 (cdr s_0))) + (let ((s_2 + (if (syntax?$1 s_1) + (syntax-e$1 s_1) + s_1))) + (if (pair? s_2) + (let ((id:module-name208_0 + (let ((s_3 (car s_2))) + (if (let ((or-part_0 + (if (syntax?$1 s_3) + (symbol? + (syntax-e$1 s_3)) + #f))) + (if or-part_0 + or-part_0 + (symbol? s_3))) + s_3 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-s_0 + s_3))))) + (call-with-values + (lambda () + (let ((s_3 (cdr s_2))) + (let ((s_4 + (if (syntax?$1 s_3) + (syntax-e$1 s_3) + s_3))) + (if (pair? s_4) + (let ((initial-require211_0 + (let ((s_5 (car s_4))) + s_5))) + (let ((body212_0 + (let ((s_5 (cdr s_4))) + (let ((s_6 + (if (syntax?$1 s_5) - s_5))) - (let ((flat-s_0 - (to-syntax-list.1 - s_6))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-s_0) - flat-s_0)))))) - (let ((initial-require211_1 - initial-require211_0)) - (values - initial-require211_1 - body212_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-s_0))))) - (case-lambda - ((initial-require209_0 body210_0) - (let ((id:module-name208_1 - id:module-name208_0)) - (values - id:module-name208_1 - initial-require209_0 - body210_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-s_0))))) - (case-lambda - ((id:module-name205_0 + (syntax-e$1 + s_5) + s_5))) + (let ((flat-s_0 + (to-syntax-list.1 + s_6))) + (if (not flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-s_0) + flat-s_0)))))) + (let ((initial-require211_1 + initial-require211_0)) + (values + initial-require211_1 + body212_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-s_0))))) + (case-lambda + ((initial-require209_0 body210_0) + (let ((id:module-name208_1 + id:module-name208_0)) + (values + id:module-name208_1 + initial-require209_0 + body210_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-s_0))))) + (case-lambda + ((id:module-name205_0 + initial-require206_0 + body207_0) + (let ((module204_1 module204_0)) + (values + module204_1 + id:module-name205_0 initial-require206_0 - body207_0) - (let ((module204_1 module204_0)) - (values - module204_1 - id:module-name205_0 - initial-require206_0 - body207_0))) - (args - (raise-binding-result-arity-error 3 args))))) - (raise-syntax-error$1 #f "bad syntax" disarmed-s_0)))) - (case-lambda - ((module200_0 - id:module-name201_0 - initial-require202_0 - body203_0) - (values - #t - module200_0 - id:module-name201_0 - initial-require202_0 - body203_0)) - (args (raise-binding-result-arity-error 4 args))))) - (case-lambda - ((ok?_0 - module200_0 - id:module-name201_0 - initial-require202_0 - body203_0) - (let ((rebuild-s_0 - (keep-as-needed.1 #f #t #t init-ctx14_0 s13_0))) - (let ((initial-require_0 - (syntax->datum$1 initial-require202_0))) - (begin - (if (if keep-enclosing-scope-at-phase2_0 - keep-enclosing-scope-at-phase2_0 - (1/module-path? initial-require_0)) - (void) - (raise-syntax-error$1 - #f - "not a module path" - s13_0 - initial-require202_0)) - (let ((module-name-sym_0 - (syntax-e$1 id:module-name201_0))) - (let ((outside-scope_0 (new-scope 'module))) - (let ((inside-scope_0 - (new-multi-scope module-name-sym_0))) - (let ((self_0 - (make-self-module-path-index - (if enclosing-self15_0 - module-name-sym_0 - (string->uninterned-symbol - (symbol->string module-name-sym_0))) - enclosing-self15_0))) - (let ((enclosing-mod_0 - (if enclosing-self15_0 - (1/module-path-index-join - '(submod "..") - self_0) - #f))) - (begin - (if mpis-for-enclosing-reset5_0 - (set-box! - mpis-for-enclosing-reset5_0 - (cons - enclosing-mod_0 - (unbox mpis-for-enclosing-reset5_0))) - (void)) - (let ((apply-module-scopes_0 - (make-apply-module-scopes - outside-scope_0 - inside-scope_0 - init-ctx14_0 - keep-enclosing-scope-at-phase2_0 - self_0 - enclosing-self15_0 - enclosing-mod_0))) - (let ((initial-require-s_0 - (|#%app| - apply-module-scopes_0 - initial-require202_0))) - (let ((root-ctx_0 - (let ((temp226_0 - (if keep-enclosing-scope-at-phase2_0 - (begin-unsafe - (root-expand-context/inner-module-scopes - (root-expand-context/outer-inner - init-ctx14_0))) - null))) - (make-root-expand-context.1 - initial-require-s_0 - temp226_0 - outside-scope_0 - inside-scope_0 - self_0)))) - (let ((new-module-scopes_0 + body207_0))) + (args (raise-binding-result-arity-error 3 args))))) + (raise-syntax-error$1 #f "bad syntax" disarmed-s_0)))) + (case-lambda + ((module200_0 + id:module-name201_0 + initial-require202_0 + body203_0) + (values + #t + module200_0 + id:module-name201_0 + initial-require202_0 + body203_0)) + (args (raise-binding-result-arity-error 4 args))))) + (case-lambda + ((ok?_0 + module200_0 + id:module-name201_0 + initial-require202_0 + body203_0) + (let ((rebuild-s_0 + (keep-as-needed.1 #f #t #t init-ctx14_0 s13_0))) + (let ((initial-require_0 + (syntax->datum$1 initial-require202_0))) + (begin + (if (if keep-enclosing-scope-at-phase2_0 + keep-enclosing-scope-at-phase2_0 + (1/module-path? initial-require_0)) + (void) + (raise-syntax-error$1 + #f + "not a module path" + s13_0 + initial-require202_0)) + (let ((module-name-sym_0 + (syntax-e$1 id:module-name201_0))) + (let ((outside-scope_0 (new-scope 'module))) + (let ((inside-scope_0 + (new-multi-scope module-name-sym_0))) + (let ((self_0 + (make-self-module-path-index + (if enclosing-self15_0 + module-name-sym_0 + (string->uninterned-symbol + (symbol->string module-name-sym_0))) + enclosing-self15_0))) + (let ((enclosing-mod_0 + (if enclosing-self15_0 + (1/module-path-index-join + '(submod "..") + self_0) + #f))) + (begin + (if mpis-for-enclosing-reset5_0 + (set-box! + mpis-for-enclosing-reset5_0 + (cons + enclosing-mod_0 + (unbox mpis-for-enclosing-reset5_0))) + (void)) + (let ((apply-module-scopes_0 + (make-apply-module-scopes + outside-scope_0 + inside-scope_0 + init-ctx14_0 + keep-enclosing-scope-at-phase2_0 + self_0 + enclosing-self15_0 + enclosing-mod_0))) + (let ((initial-require-s_0 + (|#%app| + apply-module-scopes_0 + initial-require202_0))) + (let ((root-ctx_0 + (let ((temp226_0 + (if keep-enclosing-scope-at-phase2_0 + (begin-unsafe + (root-expand-context/inner-module-scopes + (root-expand-context/outer-inner + init-ctx14_0))) + null))) + (make-root-expand-context.1 + initial-require-s_0 + temp226_0 + outside-scope_0 + inside-scope_0 + self_0)))) + (let ((new-module-scopes_0 + (begin-unsafe + (root-expand-context/inner-module-scopes + (root-expand-context/outer-inner + root-ctx_0))))) + (let ((frame-id_0 (begin-unsafe - (root-expand-context/inner-module-scopes - (root-expand-context/outer-inner - root-ctx_0))))) - (let ((frame-id_0 - (begin-unsafe - (root-expand-context/outer-frame-id - root-ctx_0)))) + (root-expand-context/outer-frame-id + root-ctx_0)))) + (let ((make-m-ns_0 + (|#%name| + make-m-ns + (lambda (for-submodule?213_0 + ns215_0) + (begin + (let ((for-submodule?_0 + (if (eq? + for-submodule?213_0 + unsafe-undefined) + (if enclosing-self15_0 + #t + #f) + for-submodule?213_0))) + (make-module-namespace.1 + for-submodule?_0 + self_0 + root-ctx_0 + ns215_0))))))) (let ((m-ns_0 (let ((temp234_0 (begin-unsafe @@ -88602,9 +87789,6 @@ (root-expand-context/outer-inner init-ctx14_0))))) (make-m-ns_0 - enclosing-self15_0 - root-ctx_0 - self_0 unsafe-undefined temp234_0)))) (let ((ctx_0 @@ -88944,10 +88128,9 @@ 5 args))))))) (let ((requires+provides_0 - (box - (make-requires+provides.1 - #f - self_0)))) + (make-requires+provides.1 + #f + self_0))) (let ((defined-syms_0 (begin-unsafe (root-expand-context/inner-defined-syms @@ -88959,518 +88142,737 @@ (box #f))) (let ((mpis-to-reset_0 (box null))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - init-ctx14_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prepare-env) - (void))) - (begin - (initial-require!_0 - enclosing-is-cross-phase-persistent?3_0 - enclosing-mod_0 - enclosing-requires+provides4_0 - initial-require-s_0 - initial-require_0 - keep-enclosing-scope-at-phase2_0 - m-ns_0 - requires+provides_0 - self_0 - #t) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - init-ctx14_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'rename-one - bodys_0) - (void))) - (let ((again?_0 - #f)) - (letrec* - ((module-begin-k_0 - (|#%name| - module-begin-k - (lambda (mb-s_0 - mb-init-ctx_0) + (let ((initial-require!_0 + (|#%name| + initial-require! + (lambda (bind?217_0) + (begin + (if (not + keep-enclosing-scope-at-phase2_0) + (let ((requires+provides259_0 + requires+provides_0)) + (perform-initial-require!.1 + bind?217_0 + 'module + initial-require_0 + self_0 + initial-require-s_0 + m-ns_0 + requires+provides259_0)) (begin + (add-required-module! + requires+provides_0 + enclosing-mod_0 + keep-enclosing-scope-at-phase2_0 + enclosing-is-cross-phase-persistent?3_0) + (let ((requires+provides262_0 + requires+provides_0)) + (add-enclosing-module-defined-and-required!.1 + enclosing-requires+provides4_0 + requires+provides262_0 + enclosing-mod_0 + keep-enclosing-scope-at-phase2_0)) + (namespace-module-visit!.1 + unsafe-undefined + m-ns_0 + enclosing-mod_0 + keep-enclosing-scope-at-phase2_0)))))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + init-ctx14_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prepare-env) + (void))) + (begin + (initial-require!_0 + #t) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + init-ctx14_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'rename-one + bodys_0) + (void))) + (let ((again?_0 + #f)) + (letrec* + ((module-begin-k_0 + (|#%name| + module-begin-k + (lambda (mb-s_0 + mb-init-ctx_0) (begin - (if again?_0 - (begin - (requires+provides-reset! - (unsafe-unbox* - requires+provides_0)) - (initial-require!_0 - enclosing-is-cross-phase-persistent?3_0 - enclosing-mod_0 - enclosing-requires+provides4_0 - initial-require-s_0 - initial-require_0 - keep-enclosing-scope-at-phase2_0 - m-ns_0 - requires+provides_0 - self_0 - #f) - (hash-clear! - compiled-submodules_0) - (set-box! - compiled-module-box_0 - #f)) - (void)) (begin - (set! again?_0 - #t) - (let ((ctx_1 - (if (expand-context/outer? - mb-init-ctx_0) - (let ((post-expansion274_0 - (|#%name| - post-expansion274 - (lambda (s_0) - (begin - (add-scope - s_0 - inside-scope_0)))))) - (let ((inner275_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - mb-init-ctx_0))) - (if (expand-context/inner? - the-struct_0) - (let ((module-begin-k276_0 - (|#%name| - module-begin-k276 - (lambda (s_0 - ctx_1) - (begin - (let ((new-requires+provides_0 - (let ((requires+provides286_0 - (unsafe-unbox* - requires+provides_0))) - (make-requires+provides.1 - requires+provides286_0 - self_0)))) - (let ((requires+provides277_0 - (unsafe-unbox* - requires+provides_0))) - (let ((compiled-submodules278_0 - compiled-submodules_0)) - (let ((compiled-module-box279_0 - compiled-module-box_0)) - (let ((defined-syms280_0 - defined-syms_0)) - (let ((compiled-submodules282_0 - (make-hasheq))) - (let ((compiled-module-box283_0 - (box - #f))) - (let ((defined-syms284_0 - (make-hasheq))) - (let ((compiled-module-box283_1 - compiled-module-box283_0) - (compiled-submodules282_1 - compiled-submodules282_0) - (defined-syms280_1 - defined-syms280_0) - (compiled-module-box279_1 - compiled-module-box279_0) - (compiled-submodules278_1 - compiled-submodules278_0) - (requires+provides277_1 - requires+provides277_0)) - (dynamic-wind - (lambda () - (begin - (unsafe-set-box*! - requires+provides_0 - new-requires+provides_0) - (set! compiled-submodules_0 - compiled-submodules282_1) - (set! compiled-module-box_0 - compiled-module-box283_1) - (set! defined-syms_0 - defined-syms284_0))) - (lambda () - (module-begin-k_0 - s_0 - ctx_1)) - (lambda () - (begin - (unsafe-set-box*! - requires+provides_0 - requires+provides277_1) - (set! compiled-submodules_0 - compiled-submodules278_1) - (set! compiled-module-box_0 - compiled-module-box279_1) - (set! defined-syms_0 - defined-syms280_1)))))))))))))))))) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_21 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_22 - (expand-context/inner-observer - the-struct_0))) - (let ((app_23 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_24 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_25 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_26 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - module-begin-k276_0 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - app_26 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((post-expansion274_1 - post-expansion274_0)) - (let ((app_0 - (root-expand-context/outer-use-site-scopes - mb-init-ctx_0))) - (let ((app_1 - (root-expand-context/outer-frame-id - mb-init-ctx_0))) - (let ((app_2 - (expand-context/outer-context - mb-init-ctx_0))) - (let ((app_3 - (expand-context/outer-env - mb-init-ctx_0))) - (let ((app_4 - (expand-context/outer-scopes - mb-init-ctx_0))) - (let ((app_5 - (expand-context/outer-def-ctx-scopes - mb-init-ctx_0))) - (let ((app_6 - (expand-context/outer-binding-layer - mb-init-ctx_0))) - (let ((app_7 - (expand-context/outer-reference-records - mb-init-ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - mb-init-ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - mb-init-ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - mb-init-ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - mb-init-ctx_0))) - (expand-context/outer1.1 - inner275_0 - post-expansion274_1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - mb-init-ctx_0))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - mb-init-ctx_0)))) - (let ((added-s_0 - (add-scope - mb-s_0 - inside-scope_0))) - (let ((disarmed-mb-s_0 - (syntax-disarm$1 - added-s_0))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-mb-s_0) - (syntax-e$1 - disarmed-mb-s_0) - disarmed-mb-s_0))) - (if (pair? - s_0) - (let ((|#%module-begin271_0| - (let ((s_1 - (car - s_0))) - s_1))) - (let ((body272_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-mb-s_0) - flat-s_0)))))) - (let ((|#%module-begin271_1| - |#%module-begin271_0|)) - (values - |#%module-begin271_1| - body272_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-mb-s_0)))) - (case-lambda - ((|#%module-begin269_0| - body270_0) - (values - #t - |#%module-begin269_0| - body270_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_1 - |#%module-begin269_0| - body270_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_1))))) - (if obs_0 - (call-expand-observe - obs_0 - 'rename-one - added-s_0) - (void))) - (let ((rebuild-mb-s_0 - (keep-as-needed.1 - #f - #f - #f - ctx_1 - mb-s_0))) - (let ((need-eventually-defined_0 - (make-hasheqv))) - (let ((module-ends_0 - (make-shared-module-ends))) - (let ((declared-keywords_0 - (make-hasheq))) - (let ((declared-submodule-names_0 - (make-hasheq))) - (let ((expression-expanded-bodys_0 - (letrec* - ((pass-1-and-2-loop_0 + (if again?_0 + (begin + (requires+provides-reset! + requires+provides_0) + (initial-require!_0 + #f) + (hash-clear! + compiled-submodules_0) + (set-box! + compiled-module-box_0 + #f)) + (void)) + (begin + (set! again?_0 + #t) + (let ((ctx_1 + (if (expand-context/outer? + mb-init-ctx_0) + (let ((post-expansion274_0 + (|#%name| + post-expansion274 + (lambda (s_0) + (begin + (add-scope + s_0 + inside-scope_0)))))) + (let ((inner275_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + mb-init-ctx_0))) + (if (expand-context/inner? + the-struct_0) + (let ((module-begin-k276_0 (|#%name| - pass-1-and-2-loop - (lambda (bodys_1 - phase_0 - keep-stops?_0) + module-begin-k276 + (lambda (s_0 + ctx_1) (begin - (let ((def-ctx-scopes_0 - (box - null))) - (let ((partial-body-ctx_0 - (if (expand-context/outer? - ctx_1) - (let ((inner300_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_1))) - (if (expand-context/inner? - the-struct_0) - (let ((namespace302_0 - (namespace->namespace-at-phase - m-ns_0 - phase_0))) - (let ((stops303_0 - (free-id-set - phase_0 - (module-expand-stop-ids - phase_0)))) - (let ((lift-key305_0 - (generate-lift-key))) - (let ((lifts306_0 - (let ((temp310_0 - (let ((app_0 - defined-syms_0)) - (make-wrap-as-definition - self_0 - frame-id_0 - inside-scope_0 - initial-require-s_0 + (let ((new-requires+provides_0 + (let ((requires+provides286_0 + requires+provides_0)) + (make-requires+provides.1 + requires+provides286_0 + self_0)))) + (let ((requires+provides277_0 + requires+provides_0)) + (let ((compiled-submodules278_0 + compiled-submodules_0)) + (let ((compiled-module-box279_0 + compiled-module-box_0)) + (let ((defined-syms280_0 + defined-syms_0)) + (let ((compiled-submodules282_0 + (make-hasheq))) + (let ((compiled-module-box283_0 + (box + #f))) + (let ((defined-syms284_0 + (make-hasheq))) + (let ((compiled-module-box283_1 + compiled-module-box283_0) + (compiled-submodules282_1 + compiled-submodules282_0) + (defined-syms280_1 + defined-syms280_0) + (compiled-module-box279_1 + compiled-module-box279_0) + (compiled-submodules278_1 + compiled-submodules278_0) + (requires+provides277_1 + requires+provides277_0)) + (dynamic-wind + (lambda () + (begin + (set! requires+provides_0 + new-requires+provides_0) + (set! compiled-submodules_0 + compiled-submodules282_1) + (set! compiled-module-box_0 + compiled-module-box283_1) + (set! defined-syms_0 + defined-syms284_0))) + (lambda () + (module-begin-k_0 + s_0 + ctx_1)) + (lambda () + (begin + (set! requires+provides_0 + requires+provides277_1) + (set! compiled-submodules_0 + compiled-submodules278_1) + (set! compiled-module-box_0 + compiled-module-box279_1) + (set! defined-syms_0 + defined-syms280_1)))))))))))))))))) + (let ((app_0 + (root-expand-context/inner-self-mpi + the-struct_0))) + (let ((app_1 + (root-expand-context/inner-module-scopes + the-struct_0))) + (let ((app_2 + (root-expand-context/inner-top-level-bind-scope + the-struct_0))) + (let ((app_3 + (root-expand-context/inner-all-scopes-stx + the-struct_0))) + (let ((app_4 + (root-expand-context/inner-defined-syms + the-struct_0))) + (let ((app_5 + (root-expand-context/inner-counter + the-struct_0))) + (let ((app_6 + (root-expand-context/inner-lift-key + the-struct_0))) + (let ((app_7 + (expand-context/inner-to-parsed? + the-struct_0))) + (let ((app_8 + (expand-context/inner-phase + the-struct_0))) + (let ((app_9 + (expand-context/inner-namespace + the-struct_0))) + (let ((app_10 + (expand-context/inner-just-once? + the-struct_0))) + (let ((app_11 + (expand-context/inner-allow-unbound? + the-struct_0))) + (let ((app_12 + (expand-context/inner-in-local-expand? + the-struct_0))) + (let ((app_13 + (|expand-context/inner-keep-#%expression?| + the-struct_0))) + (let ((app_14 + (expand-context/inner-stops + the-struct_0))) + (let ((app_15 + (expand-context/inner-declared-submodule-names + the-struct_0))) + (let ((app_16 + (expand-context/inner-lifts + the-struct_0))) + (let ((app_17 + (expand-context/inner-lift-envs + the-struct_0))) + (let ((app_18 + (expand-context/inner-module-lifts + the-struct_0))) + (let ((app_19 + (expand-context/inner-require-lifts + the-struct_0))) + (let ((app_20 + (expand-context/inner-to-module-lifts + the-struct_0))) + (let ((app_21 + (expand-context/inner-requires+provides + the-struct_0))) + (let ((app_22 + (expand-context/inner-observer + the-struct_0))) + (let ((app_23 + (expand-context/inner-for-serializable? + the-struct_0))) + (let ((app_24 + (expand-context/inner-to-correlated-linklet? + the-struct_0))) + (let ((app_25 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_26 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 app_0 - (unsafe-unbox* - requires+provides_0))))) - (make-lift-context.1 - #f - temp310_0)))) - (let ((module-lifts307_0 - (begin-unsafe - (module-lift-context15.1 - phase_0 - (box - null) - #t)))) - (let ((require-lifts308_0 - (let ((do-require_0 - (let ((requires+provides313_0 - (unsafe-unbox* - requires+provides_0))) - (make-parse-lifted-require.1 - declared-submodule-names_0 - m-ns_0 - self_0 - requires+provides313_0)))) + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + module-begin-k276_0 + app_11 + app_12 + app_13 + app_14 + app_15 + app_16 + app_17 + app_18 + app_19 + app_20 + app_21 + app_22 + app_23 + app_24 + app_25 + app_26 + (expand-context/inner-skip-visit-available? + the-struct_0)))))))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((post-expansion274_1 + post-expansion274_0)) + (let ((app_0 + (root-expand-context/outer-use-site-scopes + mb-init-ctx_0))) + (let ((app_1 + (root-expand-context/outer-frame-id + mb-init-ctx_0))) + (let ((app_2 + (expand-context/outer-context + mb-init-ctx_0))) + (let ((app_3 + (expand-context/outer-env + mb-init-ctx_0))) + (let ((app_4 + (expand-context/outer-scopes + mb-init-ctx_0))) + (let ((app_5 + (expand-context/outer-def-ctx-scopes + mb-init-ctx_0))) + (let ((app_6 + (expand-context/outer-binding-layer + mb-init-ctx_0))) + (let ((app_7 + (expand-context/outer-reference-records + mb-init-ctx_0))) + (let ((app_8 + (expand-context/outer-only-immediate? + mb-init-ctx_0))) + (let ((app_9 + (expand-context/outer-need-eventually-defined + mb-init-ctx_0))) + (let ((app_10 + (expand-context/outer-current-introduction-scopes + mb-init-ctx_0))) + (let ((app_11 + (expand-context/outer-current-use-scopes + mb-init-ctx_0))) + (expand-context/outer1.1 + inner275_0 + post-expansion274_1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + (expand-context/outer-name + mb-init-ctx_0))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + mb-init-ctx_0)))) + (let ((added-s_0 + (add-scope + mb-s_0 + inside-scope_0))) + (let ((disarmed-mb-s_0 + (syntax-disarm$1 + added-s_0))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-mb-s_0) + (syntax-e$1 + disarmed-mb-s_0) + disarmed-mb-s_0))) + (if (pair? + s_0) + (let ((|#%module-begin271_0| + (let ((s_1 + (car + s_0))) + s_1))) + (let ((body272_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-mb-s_0) + flat-s_0)))))) + (let ((|#%module-begin271_1| + |#%module-begin271_0|)) + (values + |#%module-begin271_1| + body272_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-mb-s_0)))) + (case-lambda + ((|#%module-begin269_0| + body270_0) + (values + #t + |#%module-begin269_0| + body270_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_1 + |#%module-begin269_0| + body270_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_1))))) + (if obs_0 + (call-expand-observe + obs_0 + 'rename-one + added-s_0) + (void))) + (let ((rebuild-mb-s_0 + (keep-as-needed.1 + #f + #f + #f + ctx_1 + mb-s_0))) + (let ((need-eventually-defined_0 + (make-hasheqv))) + (let ((module-ends_0 + (make-shared-module-ends))) + (let ((declared-keywords_0 + (make-hasheq))) + (let ((declared-submodule-names_0 + (make-hasheq))) + (let ((expression-expanded-bodys_0 + (letrec* + ((pass-1-and-2-loop_0 + (|#%name| + pass-1-and-2-loop + (lambda (bodys_1 + phase_0 + keep-stops?_0) + (begin + (let ((def-ctx-scopes_0 + (box + null))) + (let ((partial-body-ctx_0 + (if (expand-context/outer? + ctx_1) + (let ((inner300_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx_1))) + (if (expand-context/inner? + the-struct_0) + (let ((namespace302_0 + (namespace->namespace-at-phase + m-ns_0 + phase_0))) + (let ((stops303_0 + (free-id-set + phase_0 + (module-expand-stop-ids + phase_0)))) + (let ((lift-key305_0 + (generate-lift-key))) + (let ((lifts306_0 + (let ((temp310_0 + (let ((app_0 + defined-syms_0)) + (make-wrap-as-definition + self_0 + frame-id_0 + inside-scope_0 + initial-require-s_0 + app_0 + requires+provides_0)))) + (make-lift-context.1 + #f + temp310_0)))) + (let ((module-lifts307_0 + (begin-unsafe + (module-lift-context15.1 + phase_0 + (box + null) + #t)))) + (let ((require-lifts308_0 + (let ((do-require_0 + (let ((requires+provides313_0 + requires+provides_0)) + (make-parse-lifted-require.1 + declared-submodule-names_0 + m-ns_0 + self_0 + requires+provides313_0)))) + (begin-unsafe + (require-lift-context16.1 + do-require_0 + phase_0 + (box + null)))))) + (let ((to-module-lifts309_0 + (make-to-module-lift-context.1 + #f + module-ends_0 + phase_0))) + (let ((require-lifts308_1 + require-lifts308_0) + (module-lifts307_1 + module-lifts307_0) + (lifts306_1 + lifts306_0) + (lift-key305_1 + lift-key305_0) + (stops303_1 + stops303_0) + (namespace302_1 + namespace302_0)) + (let ((app_0 + (root-expand-context/inner-self-mpi + the-struct_0))) + (let ((app_1 + (root-expand-context/inner-module-scopes + the-struct_0))) + (let ((app_2 + (root-expand-context/inner-top-level-bind-scope + the-struct_0))) + (let ((app_3 + (root-expand-context/inner-all-scopes-stx + the-struct_0))) + (let ((app_4 + (root-expand-context/inner-defined-syms + the-struct_0))) + (let ((app_5 + (root-expand-context/inner-counter + the-struct_0))) + (let ((app_6 + (expand-context/inner-to-parsed? + the-struct_0))) + (let ((app_7 + (expand-context/inner-just-once? + the-struct_0))) + (let ((app_8 + (expand-context/inner-module-begin-k + the-struct_0))) + (let ((app_9 + (expand-context/inner-allow-unbound? + the-struct_0))) + (let ((app_10 + (expand-context/inner-in-local-expand? + the-struct_0))) + (let ((app_11 + (|expand-context/inner-keep-#%expression?| + the-struct_0))) + (let ((app_12 + (expand-context/inner-lift-envs + the-struct_0))) + (let ((app_13 + (expand-context/inner-requires+provides + the-struct_0))) + (let ((app_14 + (expand-context/inner-observer + the-struct_0))) + (let ((app_15 + (expand-context/inner-for-serializable? + the-struct_0))) + (let ((app_16 + (expand-context/inner-to-correlated-linklet? + the-struct_0))) + (let ((app_17 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_18 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + lift-key305_1 + app_6 + phase_0 + namespace302_1 + app_7 + app_8 + app_9 + app_10 + app_11 + stops303_1 + declared-submodule-names_0 + lifts306_1 + app_12 + module-lifts307_1 + require-lifts308_1 + to-module-lifts309_0 + app_13 + app_14 + app_15 + app_16 + app_17 + app_18 + (expand-context/inner-skip-visit-available? + the-struct_0))))))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((app_0 + (root-expand-context/outer-post-expansion + ctx_1))) + (let ((app_1 + (root-expand-context/outer-use-site-scopes + ctx_1))) + (let ((app_2 + (root-expand-context/outer-frame-id + ctx_1))) + (let ((app_3 + (expand-context/outer-env + ctx_1))) + (let ((app_4 + (expand-context/outer-scopes + ctx_1))) + (let ((app_5 + (expand-context/outer-binding-layer + ctx_1))) + (let ((app_6 + (expand-context/outer-reference-records + ctx_1))) + (let ((app_7 + (expand-context/outer-only-immediate? + ctx_1))) + (let ((app_8 + (expand-context/outer-current-introduction-scopes + ctx_1))) + (let ((app_9 + (expand-context/outer-current-use-scopes + ctx_1))) + (expand-context/outer1.1 + inner300_0 + app_0 + app_1 + app_2 + 'module + app_3 + app_4 + def-ctx-scopes_0 + app_5 + app_6 + app_7 + need-eventually-defined_0 + app_8 + app_9 + (expand-context/outer-name + ctx_1))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx_1)))) + (let ((partially-expanded-bodys_0 + (let ((requires+provides324_0 + requires+provides_0)) + (let ((defined-syms327_0 + defined-syms_0)) + (let ((compiled-submodules330_0 + compiled-submodules_0)) + (let ((defined-syms327_1 + defined-syms327_0) + (requires+provides324_1 + requires+provides324_0)) + (partially-expand-bodys.1 + initial-require-s_0 + compiled-submodules330_0 + partial-body-ctx_0 + declared-keywords_0 + declared-submodule-names_0 + defined-syms327_1 + frame-id_0 + pass-1-and-2-loop_0 + modules-being-compiled_0 + mpis-to-reset_0 + m-ns_0 + need-eventually-defined_0 + phase_0 + requires+provides324_1 + self_0 + bodys_1))))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + partial-body-ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void))) + (let ((body-ctx_0 + (let ((v_0 + (accumulate-def-ctx-scopes + partial-body-ctx_0 + def-ctx-scopes_0))) + (if (expand-context/outer? + v_0) + (let ((inner336_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + v_0))) + (if (expand-context/inner? + the-struct_0) + (let ((stops337_0 + (if keep-stops?_0 (begin-unsafe - (require-lift-context16.1 - do-require_0 - phase_0 - (box - null)))))) - (let ((to-module-lifts309_0 + (expand-context/inner-stops + (root-expand-context/outer-inner + ctx_1))) + empty-free-id-set))) + (let ((to-module-lifts338_0 (make-to-module-lift-context.1 - #f + #t module-ends_0 phase_0))) - (let ((require-lifts308_1 - require-lifts308_0) - (module-lifts307_1 - module-lifts307_0) - (lifts306_1 - lifts306_0) - (lift-key305_1 - lift-key305_0) - (stops303_1 - stops303_0) - (namespace302_1 - namespace302_0)) + (let ((stops337_1 + stops337_0)) (let ((app_0 (root-expand-context/inner-self-mpi the-struct_0))) @@ -89490,1222 +88892,1002 @@ (root-expand-context/inner-counter the-struct_0))) (let ((app_6 - (expand-context/inner-to-parsed? + (root-expand-context/inner-lift-key the-struct_0))) (let ((app_7 - (expand-context/inner-just-once? + (expand-context/inner-to-parsed? the-struct_0))) (let ((app_8 - (expand-context/inner-module-begin-k + (expand-context/inner-phase the-struct_0))) (let ((app_9 - (expand-context/inner-allow-unbound? + (expand-context/inner-namespace the-struct_0))) (let ((app_10 - (expand-context/inner-in-local-expand? + (expand-context/inner-just-once? the-struct_0))) (let ((app_11 - (|expand-context/inner-keep-#%expression?| + (expand-context/inner-module-begin-k the-struct_0))) (let ((app_12 - (expand-context/inner-lift-envs + (expand-context/inner-allow-unbound? the-struct_0))) (let ((app_13 - (expand-context/inner-requires+provides + (expand-context/inner-in-local-expand? the-struct_0))) (let ((app_14 - (expand-context/inner-observer + (|expand-context/inner-keep-#%expression?| the-struct_0))) (let ((app_15 - (expand-context/inner-for-serializable? + (expand-context/inner-declared-submodule-names the-struct_0))) (let ((app_16 - (expand-context/inner-to-correlated-linklet? + (expand-context/inner-lifts the-struct_0))) (let ((app_17 - (expand-context/inner-normalize-locals? + (expand-context/inner-lift-envs the-struct_0))) (let ((app_18 - (expand-context/inner-parsing-expanded? + (expand-context/inner-module-lifts the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - lift-key305_1 - app_6 - phase_0 - namespace302_1 - app_7 - app_8 - app_9 - app_10 - app_11 - stops303_1 - declared-submodule-names_0 - lifts306_1 - app_12 - module-lifts307_1 - require-lifts308_1 - to-module-lifts309_0 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_1))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_1))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_1))) - (let ((app_3 - (expand-context/outer-env - ctx_1))) - (let ((app_4 - (expand-context/outer-scopes - ctx_1))) - (let ((app_5 - (expand-context/outer-binding-layer - ctx_1))) - (let ((app_6 - (expand-context/outer-reference-records - ctx_1))) - (let ((app_7 - (expand-context/outer-only-immediate? - ctx_1))) - (let ((app_8 - (expand-context/outer-current-introduction-scopes - ctx_1))) - (let ((app_9 - (expand-context/outer-current-use-scopes - ctx_1))) - (expand-context/outer1.1 - inner300_0 - app_0 - app_1 - app_2 - 'module - app_3 - app_4 - def-ctx-scopes_0 - app_5 - app_6 - app_7 - need-eventually-defined_0 - app_8 - app_9 - (expand-context/outer-name - ctx_1))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx_1)))) - (let ((partially-expanded-bodys_0 - (let ((requires+provides324_0 - (unsafe-unbox* - requires+provides_0))) - (let ((defined-syms327_0 - defined-syms_0)) - (let ((compiled-submodules330_0 - compiled-submodules_0)) - (let ((defined-syms327_1 - defined-syms327_0) - (requires+provides324_1 - requires+provides324_0)) - (partially-expand-bodys.1 - initial-require-s_0 - compiled-submodules330_0 - partial-body-ctx_0 - declared-keywords_0 - declared-submodule-names_0 - defined-syms327_1 - frame-id_0 - pass-1-and-2-loop_0 - modules-being-compiled_0 - mpis-to-reset_0 - m-ns_0 - need-eventually-defined_0 - phase_0 - requires+provides324_1 - self_0 - bodys_1))))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - partial-body-ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void))) - (let ((body-ctx_0 - (let ((v_0 - (accumulate-def-ctx-scopes - partial-body-ctx_0 - def-ctx-scopes_0))) - (if (expand-context/outer? - v_0) - (let ((inner336_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - v_0))) - (if (expand-context/inner? - the-struct_0) - (let ((stops337_0 - (if keep-stops?_0 - (begin-unsafe - (expand-context/inner-stops - (root-expand-context/outer-inner - ctx_1))) - empty-free-id-set))) - (let ((to-module-lifts338_0 - (make-to-module-lift-context.1 - #t - module-ends_0 - phase_0))) - (let ((stops337_1 - stops337_0)) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_12 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_13 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_14 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-requires+provides + (let ((app_19 + (expand-context/inner-require-lifts the-struct_0))) - (let ((app_21 - (expand-context/inner-observer + (let ((app_20 + (expand-context/inner-requires+provides the-struct_0))) - (let ((app_22 - (expand-context/inner-for-serializable? + (let ((app_21 + (expand-context/inner-observer the-struct_0))) - (let ((app_23 - (expand-context/inner-to-correlated-linklet? + (let ((app_22 + (expand-context/inner-for-serializable? the-struct_0))) - (let ((app_24 - (expand-context/inner-normalize-locals? + (let ((app_23 + (expand-context/inner-to-correlated-linklet? the-struct_0))) - (let ((app_25 - (expand-context/inner-parsing-expanded? + (let ((app_24 + (expand-context/inner-normalize-locals? the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - stops337_1 - app_15 - app_16 - app_17 - app_18 - app_19 - to-module-lifts338_0 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-use-site-scopes - v_0))) - (let ((app_1 - (root-expand-context/outer-frame-id - v_0))) - (let ((app_2 - (expand-context/outer-context - v_0))) - (let ((app_3 - (expand-context/outer-env - v_0))) - (let ((app_4 - (expand-context/outer-scopes - v_0))) - (let ((app_5 - (expand-context/outer-binding-layer - v_0))) - (let ((app_6 - (expand-context/outer-reference-records - v_0))) - (let ((app_7 - (expand-context/outer-only-immediate? - v_0))) - (let ((app_8 - (expand-context/outer-need-eventually-defined - v_0))) - (let ((app_9 - (expand-context/outer-current-introduction-scopes - v_0))) - (let ((app_10 - (expand-context/outer-current-use-scopes - v_0))) - (expand-context/outer1.1 - inner336_0 - #f - app_0 - app_1 - app_2 - app_3 - app_4 - #f - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - (expand-context/outer-name - v_0)))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - v_0))))) - (let ((compiled-submodules294_0 - compiled-submodules_0)) - (finish-expanding-body-expressions.1 - compiled-submodules294_0 - body-ctx_0 - declared-submodule-names_0 - modules-being-compiled_0 - mpis-to-reset_0 - phase_0 - self_0 - partially-expanded-bodys_0)))))))))))) - (pass-1-and-2-loop_0 - body270_0 - 0 - (stop-at-module*? - ctx_1))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_1))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void))) - (begin - (check-defined-by-now - need-eventually-defined_0 - self_0 - ctx_1 - (unsafe-unbox* - requires+provides_0)) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_1))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void))) - (let ((fully-expanded-bodys-except-post-submodules_0 - (let ((requires+provides343_0 - (unsafe-unbox* - requires+provides_0))) - (resolve-provides.1 - ctx_1 - declared-submodule-names_0 - m-ns_0 - 0 - requires+provides343_0 - self_0 - expression-expanded-bodys_0)))) - (let ((is-cross-phase-persistent?_0 - (hash-ref - declared-keywords_0 - kw2208 - #f))) - (begin - (if is-cross-phase-persistent?_0 - (begin - (if (requires+provides-can-cross-phase-persistent? - (unsafe-unbox* - requires+provides_0)) - (void) - (raise-syntax-error$1 - #f - "cannot be cross-phase persistent due to required modules" - rebuild-s_0 - (hash-ref - declared-keywords_0 - kw2208))) - (check-cross-phase-persistent-form - fully-expanded-bodys-except-post-submodules_0 - self_0)) - (void)) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_1))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void))) - (let ((submod-m-ns_0 - (make-m-ns_0 - enclosing-self15_0 - root-ctx_0 - self_0 - #t - m-ns_0))) - (let ((submod-ctx_0 - (if (expand-context/outer? - ctx_1) - (let ((inner353_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_1))) - (if (expand-context/inner? - the-struct_0) + (let ((app_25 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + app_12 + app_13 + app_14 + stops337_1 + app_15 + app_16 + app_17 + app_18 + app_19 + to-module-lifts338_0 + app_20 + app_21 + app_22 + app_23 + app_24 + app_25 + (expand-context/inner-skip-visit-available? + the-struct_0))))))))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) + (root-expand-context/outer-use-site-scopes + v_0))) (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) + (root-expand-context/outer-frame-id + v_0))) (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) + (expand-context/outer-context + v_0))) (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) + (expand-context/outer-env + v_0))) (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) + (expand-context/outer-scopes + v_0))) (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) + (expand-context/outer-binding-layer + v_0))) (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) + (expand-context/outer-reference-records + v_0))) (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) + (expand-context/outer-only-immediate? + v_0))) (let ((app_8 - (expand-context/inner-phase - the-struct_0))) + (expand-context/outer-need-eventually-defined + v_0))) (let ((app_9 - (expand-context/inner-just-once? - the-struct_0))) + (expand-context/outer-current-introduction-scopes + v_0))) (let ((app_10 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_21 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_22 - (expand-context/inner-observer - the-struct_0))) - (let ((app_23 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_24 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_25 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_26 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - submod-m-ns_0 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - app_26 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-use-site-scopes - ctx_1))) - (let ((app_1 - (expand-context/outer-context - ctx_1))) - (let ((app_2 - (expand-context/outer-env - ctx_1))) - (let ((app_3 - (expand-context/outer-scopes - ctx_1))) - (let ((app_4 - (expand-context/outer-def-ctx-scopes - ctx_1))) - (let ((app_5 - (expand-context/outer-binding-layer - ctx_1))) - (let ((app_6 - (expand-context/outer-reference-records - ctx_1))) - (let ((app_7 - (expand-context/outer-only-immediate? - ctx_1))) - (let ((app_8 - (expand-context/outer-need-eventually-defined - ctx_1))) - (let ((app_9 - (expand-context/outer-current-introduction-scopes - ctx_1))) - (let ((app_10 - (expand-context/outer-current-use-scopes - ctx_1))) - (expand-context/outer1.1 - inner353_0 - #f - app_0 - #f - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - (expand-context/outer-name - ctx_1)))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx_1)))) - (let ((declare-enclosing-module_0 - (promise1.1 - (lambda () - (let ((requires+provides358_0 - (unsafe-unbox* - requires+provides_0))) - (let ((compiled-module-box365_0 - compiled-module-box_0)) - (let ((requires+provides358_1 - requires+provides358_0)) - (declare-module-for-expansion.1 - submod-ctx_0 - enclosing-self15_0 - compiled-module-box365_0 - id:module-name201_0 - modules-being-compiled_0 - submod-m-ns_0 - rebuild-s_0 - requires+provides358_1 - root-ctx_0 - self_0 - fully-expanded-bodys-except-post-submodules_0))))) - #f))) - (let ((fully-expanded-bodys_0 - (if (stop-at-module*? - submod-ctx_0) - fully-expanded-bodys-except-post-submodules_0 - (let ((requires+provides370_0 - (unsafe-unbox* - requires+provides_0))) - (let ((compiled-submodules375_0 - compiled-submodules_0)) - (let ((requires+provides370_1 - requires+provides370_0)) - (expand-post-submodules.1 - initial-require-s_0 - compiled-submodules375_0 - submod-ctx_0 - declare-enclosing-module_0 - declared-submodule-names_0 - is-cross-phase-persistent?_0 - modules-being-compiled_0 - mpis-to-reset_0 - 0 - requires+provides370_1 - self_0 - fully-expanded-bodys-except-post-submodules_0))))))) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - submod-ctx_0))) - (|parsed-#%module-begin24.1| - rebuild-mb-s_0 - (parsed-only - fully-expanded-bodys_0)) - (let ((mb-result-s_0 - (let ((temp379_0 - (list* - |#%module-begin269_0| - (syntax-only - fully-expanded-bodys_0)))) - (rebuild.1 - #t - rebuild-mb-s_0 - temp379_0)))) - (if (not - (begin-unsafe - (expand-context/inner-in-local-expand? - (root-expand-context/outer-inner - submod-ctx_0)))) - (expanded+parsed1.1 - mb-result-s_0 - (|parsed-#%module-begin24.1| - rebuild-mb-s_0 - (parsed-only - fully-expanded-bodys_0))) - mb-result-s_0)))))))))))))))))))))) - (args - (raise-binding-result-arity-error - 3 - args)))))))))))))) - (let ((mb-ctx_0 - (if (expand-context/outer? - ctx_0) - (let ((inner381_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_0))) - (if (expand-context/inner? - the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_13 - (expand-context/inner-stops - the-struct_0))) - (let ((app_14 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_15 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_16 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_17 - (expand-context/inner-observer - the-struct_0))) - (let ((app_18 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_19 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_20 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_21 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - module-begin-k_0 - app_11 - #f - app_12 - app_13 - app_14 - #f - app_15 - #f - #f - #f - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_0))) - (let ((app_3 - (expand-context/outer-env - ctx_0))) - (let ((app_4 - (expand-context/outer-scopes - ctx_0))) - (let ((app_5 - (expand-context/outer-def-ctx-scopes - ctx_0))) - (let ((app_6 - (expand-context/outer-binding-layer - ctx_0))) - (let ((app_7 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner381_0 - app_0 - app_1 - app_2 - 'module-begin - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - ctx_0))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx_0)))) - (let ((mb-scopes-s_0 - (if keep-enclosing-scope-at-phase2_0 - (|#%app| - apply-module-scopes_0 - disarmed-s_0) - initial-require-s_0))) - (let ((mb-def-ctx-scopes_0 - (box - null))) - (let ((mb_0 - (ensure-module-begin.1 - mb-ctx_0 - mb-def-ctx-scopes_0 - m-ns_0 - module-name-sym_0 - 0 - s13_0 - mb-scopes-s_0 - bodys_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next) - (void))) - (let ((expanded-mb_0 - (begin - (if log-performance? - (start-performance-region - 'expand - 'module-begin) - (void)) - (begin0 - (let ((temp397_0 - (let ((v_0 - (accumulate-def-ctx-scopes - mb-ctx_0 - mb-def-ctx-scopes_0))) - (if (expand-context/outer? - v_0) - (let ((inner399_0 - (root-expand-context/outer-inner - v_0))) - (let ((app_0 - (root-expand-context/outer-post-expansion - v_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - v_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - v_0))) - (let ((app_3 - (expand-context/outer-context - v_0))) - (let ((app_4 - (expand-context/outer-env - v_0))) - (let ((app_5 - (expand-context/outer-scopes - v_0))) - (let ((app_6 - (expand-context/outer-binding-layer - v_0))) - (let ((app_7 - (expand-context/outer-reference-records - v_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - v_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - v_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - v_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - v_0))) - (expand-context/outer1.1 - inner399_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - #f - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - v_0))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - v_0))))) - (expand.1 - #f - #f - mb_0 - temp397_0)) - (if log-performance? - (end-performance-region) - (void)))))) - (call-with-values - (lambda () - (extract-requires-and-provides - (unsafe-unbox* - requires+provides_0) - self_0 - self_0)) - (case-lambda - ((requires_0 - provides_0) - (let ((result-form_0 - (if (let ((or-part_0 - (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - init-ctx14_0))))) - (if or-part_0 - or-part_0 - always-produce-compiled?1_0)) - (let ((app_0 - (requires+provides-all-bindings-simple? - (unsafe-unbox* - requires+provides_0)))) - (let ((app_1 - (root-expand-context-encode-for-module - root-ctx_0 - self_0 - self_0))) - (let ((app_2 - (|parsed-#%module-begin-body| - (if (expanded+parsed? - expanded-mb_0) - (expanded+parsed-parsed - expanded-mb_0) - expanded-mb_0)))) - (let ((app_3 - (unbox - compiled-module-box_0))) - (parsed-module25.1 - rebuild-s_0 - #f - id:module-name201_0 - self_0 - requires_0 - provides_0 - app_0 - app_1 - app_2 - app_3 - compiled-submodules_0))))) - #f))) - (let ((result-s_0 - (if (not - (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - init-ctx14_0)))) - (let ((generic-self_0 - (make-generic-self-module-path-index - self_0))) - (begin - (imitate-generic-module-path-index! - self_0) - (let ((lst_0 - (unbox - mpis-to-reset_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? - lst_1) - (let ((mpi_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (begin - (imitate-generic-module-path-index! - mpi_0) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 - lst_0)))) - (void) - (let ((result-s_0 - (let ((temp401_0 - (list - module200_0 - id:module-name201_0 - initial-require-s_0 - (expanded+parsed-s - expanded-mb_0)))) - (rebuild.1 - #t - rebuild-s_0 - temp401_0)))) - (let ((result-s_1 - (syntax-module-path-index-shift.1 - #f - result-s_0 - self_0 - generic-self_0 - #f))) - (let ((result-s_2 - (attach-root-expand-context-properties - result-s_1 - root-ctx_0 - self_0 - generic-self_0))) - (let ((result-s_3 - (if (requires+provides-all-bindings-simple? - (unsafe-unbox* - requires+provides_0)) - (syntax-property$1 - result-s_2 - 'module-body-context-simple? - #t) - result-s_2))) + (expand-context/outer-current-use-scopes + v_0))) + (expand-context/outer1.1 + inner336_0 + #f + app_0 + app_1 + app_2 + app_3 + app_4 + #f + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + (expand-context/outer-name + v_0)))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + v_0))))) + (let ((compiled-submodules294_0 + compiled-submodules_0)) + (finish-expanding-body-expressions.1 + compiled-submodules294_0 + body-ctx_0 + declared-submodule-names_0 + modules-being-compiled_0 + mpis-to-reset_0 + phase_0 + self_0 + partially-expanded-bodys_0)))))))))))) + (pass-1-and-2-loop_0 + body270_0 + 0 + (stop-at-module*? + ctx_1))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_1))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void))) (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - init-ctx14_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'rename-one - result-s_3) - (void))) - result-s_3))))))) - (void)))) - (if (begin-unsafe - (expand-context/inner-to-parsed? + (check-defined-by-now + need-eventually-defined_0 + self_0 + ctx_1 + requires+provides_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_1))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void))) + (let ((fully-expanded-bodys-except-post-submodules_0 + (let ((requires+provides343_0 + requires+provides_0)) + (resolve-provides.1 + ctx_1 + declared-submodule-names_0 + m-ns_0 + 0 + requires+provides343_0 + self_0 + expression-expanded-bodys_0)))) + (let ((is-cross-phase-persistent?_0 + (hash-ref + declared-keywords_0 + kw2208 + #f))) + (begin + (if is-cross-phase-persistent?_0 + (begin + (if (requires+provides-can-cross-phase-persistent? + requires+provides_0) + (void) + (raise-syntax-error$1 + #f + "cannot be cross-phase persistent due to required modules" + rebuild-s_0 + (hash-ref + declared-keywords_0 + kw2208))) + (check-cross-phase-persistent-form + fully-expanded-bodys-except-post-submodules_0 + self_0)) + (void)) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_1))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void))) + (let ((submod-m-ns_0 + (make-m-ns_0 + #t + m-ns_0))) + (let ((submod-ctx_0 + (if (expand-context/outer? + ctx_1) + (let ((inner353_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx_1))) + (if (expand-context/inner? + the-struct_0) + (let ((app_0 + (root-expand-context/inner-self-mpi + the-struct_0))) + (let ((app_1 + (root-expand-context/inner-module-scopes + the-struct_0))) + (let ((app_2 + (root-expand-context/inner-top-level-bind-scope + the-struct_0))) + (let ((app_3 + (root-expand-context/inner-all-scopes-stx + the-struct_0))) + (let ((app_4 + (root-expand-context/inner-defined-syms + the-struct_0))) + (let ((app_5 + (root-expand-context/inner-counter + the-struct_0))) + (let ((app_6 + (root-expand-context/inner-lift-key + the-struct_0))) + (let ((app_7 + (expand-context/inner-to-parsed? + the-struct_0))) + (let ((app_8 + (expand-context/inner-phase + the-struct_0))) + (let ((app_9 + (expand-context/inner-just-once? + the-struct_0))) + (let ((app_10 + (expand-context/inner-module-begin-k + the-struct_0))) + (let ((app_11 + (expand-context/inner-allow-unbound? + the-struct_0))) + (let ((app_12 + (expand-context/inner-in-local-expand? + the-struct_0))) + (let ((app_13 + (|expand-context/inner-keep-#%expression?| + the-struct_0))) + (let ((app_14 + (expand-context/inner-stops + the-struct_0))) + (let ((app_15 + (expand-context/inner-declared-submodule-names + the-struct_0))) + (let ((app_16 + (expand-context/inner-lifts + the-struct_0))) + (let ((app_17 + (expand-context/inner-lift-envs + the-struct_0))) + (let ((app_18 + (expand-context/inner-module-lifts + the-struct_0))) + (let ((app_19 + (expand-context/inner-require-lifts + the-struct_0))) + (let ((app_20 + (expand-context/inner-to-module-lifts + the-struct_0))) + (let ((app_21 + (expand-context/inner-requires+provides + the-struct_0))) + (let ((app_22 + (expand-context/inner-observer + the-struct_0))) + (let ((app_23 + (expand-context/inner-for-serializable? + the-struct_0))) + (let ((app_24 + (expand-context/inner-to-correlated-linklet? + the-struct_0))) + (let ((app_25 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_26 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + submod-m-ns_0 + app_9 + app_10 + app_11 + app_12 + app_13 + app_14 + app_15 + app_16 + app_17 + app_18 + app_19 + app_20 + app_21 + app_22 + app_23 + app_24 + app_25 + app_26 + (expand-context/inner-skip-visit-available? + the-struct_0))))))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((app_0 + (root-expand-context/outer-use-site-scopes + ctx_1))) + (let ((app_1 + (expand-context/outer-context + ctx_1))) + (let ((app_2 + (expand-context/outer-env + ctx_1))) + (let ((app_3 + (expand-context/outer-scopes + ctx_1))) + (let ((app_4 + (expand-context/outer-def-ctx-scopes + ctx_1))) + (let ((app_5 + (expand-context/outer-binding-layer + ctx_1))) + (let ((app_6 + (expand-context/outer-reference-records + ctx_1))) + (let ((app_7 + (expand-context/outer-only-immediate? + ctx_1))) + (let ((app_8 + (expand-context/outer-need-eventually-defined + ctx_1))) + (let ((app_9 + (expand-context/outer-current-introduction-scopes + ctx_1))) + (let ((app_10 + (expand-context/outer-current-use-scopes + ctx_1))) + (expand-context/outer1.1 + inner353_0 + #f + app_0 + #f + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + (expand-context/outer-name + ctx_1)))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx_1)))) + (let ((declare-enclosing-module_0 + (promise1.1 + (lambda () + (let ((requires+provides358_0 + requires+provides_0)) + (let ((compiled-module-box365_0 + compiled-module-box_0)) + (let ((requires+provides358_1 + requires+provides358_0)) + (declare-module-for-expansion.1 + submod-ctx_0 + enclosing-self15_0 + compiled-module-box365_0 + id:module-name201_0 + modules-being-compiled_0 + submod-m-ns_0 + rebuild-s_0 + requires+provides358_1 + root-ctx_0 + self_0 + fully-expanded-bodys-except-post-submodules_0))))) + #f))) + (let ((fully-expanded-bodys_0 + (if (stop-at-module*? + submod-ctx_0) + fully-expanded-bodys-except-post-submodules_0 + (let ((requires+provides370_0 + requires+provides_0)) + (let ((compiled-submodules375_0 + compiled-submodules_0)) + (let ((requires+provides370_1 + requires+provides370_0)) + (expand-post-submodules.1 + initial-require-s_0 + compiled-submodules375_0 + submod-ctx_0 + declare-enclosing-module_0 + declared-submodule-names_0 + is-cross-phase-persistent?_0 + modules-being-compiled_0 + mpis-to-reset_0 + 0 + requires+provides370_1 + self_0 + fully-expanded-bodys-except-post-submodules_0))))))) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + submod-ctx_0))) + (|parsed-#%module-begin24.1| + rebuild-mb-s_0 + (parsed-only + fully-expanded-bodys_0)) + (let ((mb-result-s_0 + (let ((temp379_0 + (list* + |#%module-begin269_0| + (syntax-only + fully-expanded-bodys_0)))) + (rebuild.1 + #t + rebuild-mb-s_0 + temp379_0)))) + (if (not + (begin-unsafe + (expand-context/inner-in-local-expand? + (root-expand-context/outer-inner + submod-ctx_0)))) + (expanded+parsed1.1 + mb-result-s_0 + (|parsed-#%module-begin24.1| + rebuild-mb-s_0 + (parsed-only + fully-expanded-bodys_0))) + mb-result-s_0)))))))))))))))))))))) + (args + (raise-binding-result-arity-error + 3 + args)))))))))))))) + (let ((mb-ctx_0 + (if (expand-context/outer? + ctx_0) + (let ((inner381_0 + (let ((the-struct_0 (root-expand-context/outer-inner - init-ctx14_0))) - result-form_0 - (if always-produce-compiled?1_0 - (expanded+parsed1.1 - result-s_0 - result-form_0) - result-s_0))))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))))))))))))))))))))))))))))))) - (args (raise-binding-result-arity-error 5 args)))))))))))) + ctx_0))) + (if (expand-context/inner? + the-struct_0) + (let ((app_0 + (root-expand-context/inner-self-mpi + the-struct_0))) + (let ((app_1 + (root-expand-context/inner-module-scopes + the-struct_0))) + (let ((app_2 + (root-expand-context/inner-top-level-bind-scope + the-struct_0))) + (let ((app_3 + (root-expand-context/inner-all-scopes-stx + the-struct_0))) + (let ((app_4 + (root-expand-context/inner-defined-syms + the-struct_0))) + (let ((app_5 + (root-expand-context/inner-counter + the-struct_0))) + (let ((app_6 + (root-expand-context/inner-lift-key + the-struct_0))) + (let ((app_7 + (expand-context/inner-to-parsed? + the-struct_0))) + (let ((app_8 + (expand-context/inner-phase + the-struct_0))) + (let ((app_9 + (expand-context/inner-namespace + the-struct_0))) + (let ((app_10 + (expand-context/inner-just-once? + the-struct_0))) + (let ((app_11 + (expand-context/inner-allow-unbound? + the-struct_0))) + (let ((app_12 + (|expand-context/inner-keep-#%expression?| + the-struct_0))) + (let ((app_13 + (expand-context/inner-stops + the-struct_0))) + (let ((app_14 + (expand-context/inner-declared-submodule-names + the-struct_0))) + (let ((app_15 + (expand-context/inner-lift-envs + the-struct_0))) + (let ((app_16 + (expand-context/inner-requires+provides + the-struct_0))) + (let ((app_17 + (expand-context/inner-observer + the-struct_0))) + (let ((app_18 + (expand-context/inner-for-serializable? + the-struct_0))) + (let ((app_19 + (expand-context/inner-to-correlated-linklet? + the-struct_0))) + (let ((app_20 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_21 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + module-begin-k_0 + app_11 + #f + app_12 + app_13 + app_14 + #f + app_15 + #f + #f + #f + app_16 + app_17 + app_18 + app_19 + app_20 + app_21 + (expand-context/inner-skip-visit-available? + the-struct_0)))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((app_0 + (root-expand-context/outer-post-expansion + ctx_0))) + (let ((app_1 + (root-expand-context/outer-use-site-scopes + ctx_0))) + (let ((app_2 + (root-expand-context/outer-frame-id + ctx_0))) + (let ((app_3 + (expand-context/outer-env + ctx_0))) + (let ((app_4 + (expand-context/outer-scopes + ctx_0))) + (let ((app_5 + (expand-context/outer-def-ctx-scopes + ctx_0))) + (let ((app_6 + (expand-context/outer-binding-layer + ctx_0))) + (let ((app_7 + (expand-context/outer-reference-records + ctx_0))) + (let ((app_8 + (expand-context/outer-only-immediate? + ctx_0))) + (let ((app_9 + (expand-context/outer-need-eventually-defined + ctx_0))) + (let ((app_10 + (expand-context/outer-current-introduction-scopes + ctx_0))) + (let ((app_11 + (expand-context/outer-current-use-scopes + ctx_0))) + (expand-context/outer1.1 + inner381_0 + app_0 + app_1 + app_2 + 'module-begin + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + (expand-context/outer-name + ctx_0))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx_0)))) + (let ((mb-scopes-s_0 + (if keep-enclosing-scope-at-phase2_0 + (|#%app| + apply-module-scopes_0 + disarmed-s_0) + initial-require-s_0))) + (let ((mb-def-ctx-scopes_0 + (box + null))) + (let ((mb_0 + (ensure-module-begin.1 + mb-ctx_0 + mb-def-ctx-scopes_0 + m-ns_0 + module-name-sym_0 + 0 + s13_0 + mb-scopes-s_0 + bodys_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next) + (void))) + (let ((expanded-mb_0 + (begin + (if log-performance? + (start-performance-region + 'expand + 'module-begin) + (void)) + (begin0 + (let ((temp397_0 + (let ((v_0 + (accumulate-def-ctx-scopes + mb-ctx_0 + mb-def-ctx-scopes_0))) + (if (expand-context/outer? + v_0) + (let ((inner399_0 + (root-expand-context/outer-inner + v_0))) + (let ((app_0 + (root-expand-context/outer-post-expansion + v_0))) + (let ((app_1 + (root-expand-context/outer-use-site-scopes + v_0))) + (let ((app_2 + (root-expand-context/outer-frame-id + v_0))) + (let ((app_3 + (expand-context/outer-context + v_0))) + (let ((app_4 + (expand-context/outer-env + v_0))) + (let ((app_5 + (expand-context/outer-scopes + v_0))) + (let ((app_6 + (expand-context/outer-binding-layer + v_0))) + (let ((app_7 + (expand-context/outer-reference-records + v_0))) + (let ((app_8 + (expand-context/outer-only-immediate? + v_0))) + (let ((app_9 + (expand-context/outer-need-eventually-defined + v_0))) + (let ((app_10 + (expand-context/outer-current-introduction-scopes + v_0))) + (let ((app_11 + (expand-context/outer-current-use-scopes + v_0))) + (expand-context/outer1.1 + inner399_0 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + #f + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + (expand-context/outer-name + v_0))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + v_0))))) + (expand.1 + #f + #f + mb_0 + temp397_0)) + (if log-performance? + (end-performance-region) + (void)))))) + (call-with-values + (lambda () + (extract-requires-and-provides + requires+provides_0 + self_0 + self_0)) + (case-lambda + ((requires_0 + provides_0) + (let ((result-form_0 + (if (let ((or-part_0 + (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + init-ctx14_0))))) + (if or-part_0 + or-part_0 + always-produce-compiled?1_0)) + (let ((app_0 + (requires+provides-all-bindings-simple? + requires+provides_0))) + (let ((app_1 + (root-expand-context-encode-for-module + root-ctx_0 + self_0 + self_0))) + (let ((app_2 + (|parsed-#%module-begin-body| + (if (expanded+parsed? + expanded-mb_0) + (expanded+parsed-parsed + expanded-mb_0) + expanded-mb_0)))) + (let ((app_3 + (unbox + compiled-module-box_0))) + (parsed-module25.1 + rebuild-s_0 + #f + id:module-name201_0 + self_0 + requires_0 + provides_0 + app_0 + app_1 + app_2 + app_3 + compiled-submodules_0))))) + #f))) + (let ((result-s_0 + (if (not + (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + init-ctx14_0)))) + (let ((generic-self_0 + (make-generic-self-module-path-index + self_0))) + (begin + (imitate-generic-module-path-index! + self_0) + (let ((lst_0 + (unbox + mpis-to-reset_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? + lst_1) + (let ((mpi_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (begin + (imitate-generic-module-path-index! + mpi_0) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + lst_0)))) + (void) + (let ((result-s_0 + (let ((temp401_0 + (list + module200_0 + id:module-name201_0 + initial-require-s_0 + (expanded+parsed-s + expanded-mb_0)))) + (rebuild.1 + #t + rebuild-s_0 + temp401_0)))) + (let ((result-s_1 + (syntax-module-path-index-shift.1 + #f + result-s_0 + self_0 + generic-self_0 + #f))) + (let ((result-s_2 + (attach-root-expand-context-properties + result-s_1 + root-ctx_0 + self_0 + generic-self_0))) + (let ((result-s_3 + (if (requires+provides-all-bindings-simple? + requires+provides_0) + (syntax-property$1 + result-s_2 + 'module-body-context-simple? + #t) + result-s_2))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + init-ctx14_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'rename-one + result-s_3) + (void))) + result-s_3))))))) + (void)))) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + init-ctx14_0))) + result-form_0 + (if always-produce-compiled?1_0 + (expanded+parsed1.1 + result-s_0 + result-form_0) + result-s_0))))) + (args + (raise-binding-result-arity-error + 2 + args)))))))))))))))))))))))))))))))))))))))) + (args (raise-binding-result-arity-error 5 args))))))))))) (define ensure-module-begin.1 - (letrec ((make-mb-ctx_0 - (|#%name| - make-mb-ctx - (lambda (ctx20_0 def-ctx-scopes21_0) - (begin - (if (expand-context/outer? ctx20_0) - (let ((inner408_0 - (root-expand-context/outer-inner ctx20_0))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx20_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes + (|#%name| + ensure-module-begin + (lambda (ctx20_0 + def-ctx-scopes21_0 + m-ns19_0 + module-name-sym17_0 + phase22_0 + s23_0 + scopes-s18_0 + bodys31_0) + (begin + (let ((make-mb-ctx_0 + (|#%name| + make-mb-ctx + (lambda () + (begin + (if (expand-context/outer? ctx20_0) + (let ((inner408_0 + (root-expand-context/outer-inner ctx20_0))) + (let ((app_0 + (root-expand-context/outer-post-expansion ctx20_0))) - (let ((app_2 - (root-expand-context/outer-frame-id ctx20_0))) - (let ((app_3 (expand-context/outer-env ctx20_0))) - (let ((app_4 - (expand-context/outer-scopes ctx20_0))) - (let ((app_5 - (expand-context/outer-binding-layer - ctx20_0))) - (let ((app_6 - (expand-context/outer-reference-records + (let ((app_1 + (root-expand-context/outer-use-site-scopes + ctx20_0))) + (let ((app_2 + (root-expand-context/outer-frame-id + ctx20_0))) + (let ((app_3 (expand-context/outer-env ctx20_0))) + (let ((app_4 + (expand-context/outer-scopes ctx20_0))) + (let ((app_5 + (expand-context/outer-binding-layer ctx20_0))) - (let ((app_7 - (expand-context/outer-need-eventually-defined + (let ((app_6 + (expand-context/outer-reference-records ctx20_0))) - (let ((app_8 - (expand-context/outer-current-introduction-scopes + (let ((app_7 + (expand-context/outer-need-eventually-defined ctx20_0))) - (let ((app_9 - (expand-context/outer-current-use-scopes + (let ((app_8 + (expand-context/outer-current-introduction-scopes ctx20_0))) - (expand-context/outer1.1 - inner408_0 - app_0 - app_1 - app_2 - 'module-begin - app_3 - app_4 - def-ctx-scopes21_0 - app_5 - app_6 - #t - app_7 - app_8 - app_9 - (expand-context/outer-name - ctx20_0))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx20_0))))))) - (|#%name| - ensure-module-begin - (lambda (ctx20_0 - def-ctx-scopes21_0 - m-ns19_0 - module-name-sym17_0 - phase22_0 - s23_0 - scopes-s18_0 - bodys31_0) - (begin + (let ((app_9 + (expand-context/outer-current-use-scopes + ctx20_0))) + (expand-context/outer1.1 + inner408_0 + app_0 + app_1 + app_2 + 'module-begin + app_3 + app_4 + def-ctx-scopes21_0 + app_5 + app_6 + #t + app_7 + app_8 + app_9 + (expand-context/outer-name + ctx20_0))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx20_0))))))) (let ((mb_0 (if (= 1 (length bodys31_0)) (if (eq? @@ -90742,10 +89924,7 @@ 'module-begin) (void)) (begin0 - (let ((temp410_0 - (make-mb-ctx_0 - ctx20_0 - def-ctx-scopes21_0))) + (let ((temp410_0 (make-mb-ctx_0))) (expand.1 #f #f named-body-s_0 temp410_0)) (if log-performance? (end-performance-region) @@ -90757,10 +89936,7 @@ phase22_0)) partly-expanded-body_0 (let ((temp411_0 (list partly-expanded-body_0))) - (let ((temp416_0 - (make-mb-ctx_0 - ctx20_0 - def-ctx-scopes21_0))) + (let ((temp416_0 (make-mb-ctx_0))) (let ((temp411_1 temp411_0)) (add-module-begin.1 #f @@ -90770,7 +89946,7 @@ phase22_0 module-name-sym17_0 temp416_0))))))))) - (let ((temp423_0 (make-mb-ctx_0 ctx20_0 def-ctx-scopes21_0))) + (let ((temp423_0 (make-mb-ctx_0))) (add-module-begin.1 #t bodys31_0 @@ -90927,1573 +90103,32 @@ temp431_0))))))) (if log-performance? (end-performance-region) (void))))))) (define partially-expand-bodys.1 - (letrec ((finish_0 - (|#%name| - finish - (lambda (all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - disarmed-exp-body_0 - exp-body_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - rest-bodys_0 - self45_0 - tail?_0) - (begin - (let ((tmp_0 (core-form-sym disarmed-exp-body_0 phase42_0))) - (if (eq? tmp_0 'begin) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-begin - disarmed-exp-body_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 disarmed-exp-body_0) - (syntax-e$1 disarmed-exp-body_0) - disarmed-exp-body_0))) - (if (pair? s_0) - (let ((begin439_0 - (let ((s_1 (car s_0))) s_1))) - (let ((e440_0 - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 s_2))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0) - flat-s_0)))))) - (let ((begin439_1 begin439_0)) - (values begin439_1 e440_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))) - (case-lambda - ((begin437_0 e438_0) (values #t begin437_0 e438_0)) - (args (raise-binding-result-arity-error 2 args))))) - (case-lambda - ((ok?_0 begin437_0 e438_0) - (let ((track_0 - (|#%name| - track - (lambda (e_0) - (begin - (syntax-track-origin$1 - e_0 - exp-body_0)))))) - (let ((spliced-bodys_0 - (append - (map_2960 track_0 e438_0) - rest-bodys_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'splice - spliced-bodys_0) - (void))) - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - spliced-bodys_0))))) - (args (raise-binding-result-arity-error 3 args))))) - (if (eq? tmp_0 'begin-for-syntax) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-begin-for-syntax - disarmed-exp-body_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 disarmed-exp-body_0) - (syntax-e$1 disarmed-exp-body_0) - disarmed-exp-body_0))) - (if (pair? s_0) - (let ((begin-for-syntax443_0 - (let ((s_1 (car s_0))) s_1))) - (let ((e444_0 - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 s_2))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0) - flat-s_0)))))) - (let ((begin-for-syntax443_1 - begin-for-syntax443_0)) - (values - begin-for-syntax443_1 - e444_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))) - (case-lambda - ((begin-for-syntax441_0 e442_0) - (values #t begin-for-syntax441_0 e442_0)) - (args - (raise-binding-result-arity-error 2 args))))) - (case-lambda - ((ok?_0 begin-for-syntax441_0 e442_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe obs_0 'prepare-env) - (void))) - (let ((ct-m-ns_0 - (namespace->namespace-at-phase - namespace44_0 - (add1 phase42_0)))) - (begin - (prepare-next-phase-namespace ctx43_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe obs_0 'phase-up) - (void))) - (let ((nested-bodys_0 - (|#%app| - loop56_0 - e442_0 - (add1 phase42_0) - #f))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void))) - (namespace-run-available-modules! - namespace44_0 - (add1 phase42_0)) - (eval-nested-bodys - nested-bodys_0 - (add1 phase42_0) - ct-m-ns_0 - self45_0 - ctx43_0) - (namespace-visit-available-modules! - namespace44_0 - phase42_0) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-case - (let ((s-nested-bodys_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((nested-body_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (extract-syntax - nested-body_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - nested-bodys_0)))))) - (cons - begin-for-syntax441_0 - s-nested-bodys_0))) - (void))) - (cons - (semi-parsed-begin-for-syntax3.1 - exp-body_0 - nested-bodys_0) - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - rest-bodys_0))))))))) - (args (raise-binding-result-arity-error 3 args))))) - (if (eq? tmp_0 'define-values) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-define-values - disarmed-exp-body_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 disarmed-exp-body_0) - (syntax-e$1 disarmed-exp-body_0) - disarmed-exp-body_0))) - (if (pair? s_0) - (let ((define-values448_0 - (let ((s_1 (car s_0))) s_1))) - (call-with-values - (lambda () - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (if (pair? s_2) - (let ((id451_0 - (let ((s_3 (car s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (let ((flat-s_0 - (to-syntax-list.1 - s_4))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0) - (let ((id_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (id_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((s_5 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((id_1 - (let ((id_1 - (let ((id464_0 - (if (let ((or-part_0 - (if (syntax?$1 - s_5) - (symbol? - (syntax-e$1 - s_5)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_5))) - s_5 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-exp-body_0 - s_5)))) - (cons - id464_0 - id_0)))) - (values - id_1)))) - (for-loop_0 - id_1 - rest_0)))) - id_0)))))) - (for-loop_0 - null - flat-s_0))))) - (reverse$1 - id_0)))))))) - (let ((rhs452_0 - (let ((s_3 (cdr s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? s_4) - (let ((rhs453_0 - (let ((s_5 - (car - s_4))) - s_5))) - (call-with-values - (lambda () - (let ((s_5 - (cdr - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 - s_5) - s_5))) - (if (null? - s_6) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0))))) - (case-lambda - (() - (let ((rhs453_1 - rhs453_0)) - (values - rhs453_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))))) - (let ((id451_1 id451_0)) - (values - id451_1 - rhs452_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0))))) - (case-lambda - ((id449_0 rhs450_0) - (let ((define-values448_1 - define-values448_0)) - (values - define-values448_1 - id449_0 - rhs450_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))) - (case-lambda - ((define-values445_0 id446_0 rhs447_0) - (values - #t - define-values445_0 - id446_0 - rhs447_0)) - (args - (raise-binding-result-arity-error 3 args))))) - (case-lambda - ((ok?_0 define-values445_0 id446_0 rhs447_0) - (let ((ids_0 - (remove-use-site-scopes id446_0 ctx43_0))) - (begin - (check-no-duplicate-ids.1 - unsafe-undefined - ids_0 - phase42_0 - exp-body_0 - unsafe-undefined) - (begin - (check-ids-unbound.1 - exp-body_0 - ids_0 - phase42_0 - requires-and-provides47_0) - (let ((syms_0 - (select-defined-syms-and-bind!.1 - #f - frame-id46_0 - exp-body_0 - requires-and-provides47_0 - #f - ids_0 - defined-syms50_0 - self45_0 - phase42_0 - all-scopes-stx49_0))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((sym_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (begin - (namespace-unset-transformer! - namespace44_0 - phase42_0 - sym_0) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 syms_0))) - (void) - (add-defined-syms!.1 - #f - requires-and-provides47_0 - syms_0 - phase42_0) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-case - (list - define-values445_0 - ids_0 - rhs447_0)) - (void))) - (cons - (semi-parsed-define-values2.1 - exp-body_0 - syms_0 - ids_0 - rhs447_0) - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - rest-bodys_0)))))))) - (args - (raise-binding-result-arity-error 4 args))))) - (if (eq? tmp_0 'define-syntaxes) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-define-syntaxes - disarmed-exp-body_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 disarmed-exp-body_0) - (syntax-e$1 disarmed-exp-body_0) - disarmed-exp-body_0))) - (if (pair? s_0) - (let ((define-syntaxes476_0 - (let ((s_1 (car s_0))) s_1))) - (call-with-values - (lambda () - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (if (pair? s_2) - (let ((id479_0 - (let ((s_3 (car s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (let ((flat-s_0 - (to-syntax-list.1 - s_4))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0) - (let ((id_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (id_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((s_5 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((id_1 - (let ((id_1 - (let ((id493_0 - (if (let ((or-part_0 - (if (syntax?$1 - s_5) - (symbol? - (syntax-e$1 - s_5)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_5))) - s_5 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-exp-body_0 - s_5)))) - (cons - id493_0 - id_0)))) - (values - id_1)))) - (for-loop_0 - id_1 - rest_0)))) - id_0)))))) - (for-loop_0 - null - flat-s_0))))) - (reverse$1 - id_0)))))))) - (let ((rhs480_0 - (let ((s_3 - (cdr s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? s_4) - (let ((rhs481_0 - (let ((s_5 - (car - s_4))) - s_5))) - (call-with-values - (lambda () - (let ((s_5 - (cdr - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 - s_5) - s_5))) - (if (null? - s_6) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0))))) - (case-lambda - (() - (let ((rhs481_1 - rhs481_0)) - (values - rhs481_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))))) - (let ((id479_1 id479_0)) - (values - id479_1 - rhs480_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0))))) - (case-lambda - ((id477_0 rhs478_0) - (let ((define-syntaxes476_1 - define-syntaxes476_0)) - (values - define-syntaxes476_1 - id477_0 - rhs478_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))) - (case-lambda - ((define-syntaxes473_0 id474_0 rhs475_0) - (values - #t - define-syntaxes473_0 - id474_0 - rhs475_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (case-lambda - ((ok?_0 define-syntaxes473_0 id474_0 rhs475_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe obs_0 'prepare-env) - (void))) - (begin - (prepare-next-phase-namespace ctx43_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe obs_0 'phase-up) - (void))) - (let ((ids_0 - (remove-use-site-scopes - id474_0 - ctx43_0))) - (begin - (check-no-duplicate-ids.1 - unsafe-undefined - ids_0 - phase42_0 - exp-body_0 - unsafe-undefined) - (begin - (check-ids-unbound.1 - exp-body_0 - ids_0 - phase42_0 - requires-and-provides47_0) - (let ((syms_0 - (select-defined-syms-and-bind!.1 - #t - frame-id46_0 - exp-body_0 - requires-and-provides47_0 - #f - ids_0 - defined-syms50_0 - self45_0 - phase42_0 - all-scopes-stx49_0))) - (begin - (add-defined-syms!.1 - #t - requires-and-provides47_0 - syms_0 - phase42_0) - (call-with-values - (lambda () - (let ((temp506_0 - (if (expand-context/outer? - ctx43_0) - (let ((inner509_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx43_0))) - (if (expand-context/inner? - the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_12 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_13 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_14 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_15 - (expand-context/inner-stops - the-struct_0))) - (let ((app_16 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_20 - (expand-context/inner-observer - the-struct_0))) - (let ((app_21 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_22 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_23 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_24 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - #f - app_17 - #f - app_18 - #f - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx43_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx43_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx43_0))) - (let ((app_3 - (expand-context/outer-context - ctx43_0))) - (let ((app_4 - (expand-context/outer-env - ctx43_0))) - (let ((app_5 - (expand-context/outer-scopes - ctx43_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - ctx43_0))) - (let ((app_7 - (expand-context/outer-binding-layer - ctx43_0))) - (let ((app_8 - (expand-context/outer-reference-records - ctx43_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - ctx43_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - ctx43_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - ctx43_0))) - (expand-context/outer1.1 - inner509_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - need-eventually-defined48_0 - app_10 - app_11 - (expand-context/outer-name - ctx43_0))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx43_0)))) - (expand+eval-for-syntaxes-binding.1 - #f - 'define-syntaxes - rhs475_0 - ids_0 - temp506_0))) - (case-lambda - ((exp-rhs_0 - parsed-rhs_0 - vals_0) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0 - lst_1 - lst_2) - (begin - (if (if (pair? - lst_0) - (if (pair? - lst_1) - (pair? - lst_2) - #f) - #f) - (let ((sym_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((val_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((id_0 - (unsafe-car - lst_2))) - (let ((rest_2 - (unsafe-cdr - lst_2))) - (begin - (begin - (maybe-install-free=id-in-context! - val_0 - id_0 - phase42_0 - ctx43_0) - (namespace-set-transformer! - namespace44_0 - phase42_0 - sym_0 - val_0)) - (for-loop_0 - rest_0 - rest_1 - rest_2)))))))) - (values))))))) - (for-loop_0 - syms_0 - vals_0 - ids_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-case - (list - define-syntaxes473_0 - ids_0 - exp-rhs_0)) - (void))) - (let ((parsed-body_0 - (parsed-define-syntaxes20.1 - (keep-properties-only - exp-body_0) - ids_0 - syms_0 - parsed-rhs_0))) - (let ((app_0 - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx43_0))) - parsed-body_0 - (expanded+parsed1.1 - (let ((temp514_0 - (list - define-syntaxes473_0 - ids_0 - exp-rhs_0))) - (rebuild.1 - #t - exp-body_0 - temp514_0)) - parsed-body_0)))) - (cons - app_0 - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - rest-bodys_0))))))) - (args - (raise-binding-result-arity-error - 3 - args))))))))))))) - (args - (raise-binding-result-arity-error 4 args))))) - (if (eq? tmp_0 '|#%require|) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-require - disarmed-exp-body_0) - (void))) - (let ((ready-body_0 - (remove-use-site-scopes - disarmed-exp-body_0 - ctx43_0))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 ready-body_0) - (syntax-e$1 ready-body_0) - ready-body_0))) - (if (pair? s_0) - (let ((|#%require517_0| - (let ((s_1 (car s_0))) s_1))) - (let ((req518_0 - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - ready-body_0) - flat-s_0)))))) - (let ((|#%require517_1| - |#%require517_0|)) - (values - |#%require517_1| - req518_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - ready-body_0)))) - (case-lambda - ((|#%require515_0| req516_0) - (values #t |#%require515_0| req516_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 |#%require515_0| req516_0) - (begin - (parse-and-perform-requires!.1 - #f - #f - declared-submodule-names52_0 - #f - phase42_0 - #f - self45_0 - #f - #t - 'module - req516_0 - exp-body_0 - namespace44_0 - phase42_0 - requires-and-provides47_0) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-case - ready-body_0) - (void))) - (cons - exp-body_0 - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - rest-bodys_0)))) - (args - (raise-binding-result-arity-error - 3 - args)))))) - (if (eq? tmp_0 '|#%provide|) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe obs_0 'prim-stop #f) - (void))) - (cons - exp-body_0 - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - rest-bodys_0))) - (if (eq? tmp_0 'module) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-submodule - #f) - (void))) - (let ((ready-body_0 - (remove-use-site-scopes - exp-body_0 - ctx43_0))) - (let ((submod_0 - (expand-submodule.1 - compiled-submodules53_0 - declared-submodule-names52_0 - #f - #f - #f - #f - modules-being-compiled54_0 - mpis-to-reset55_0 - ready-body_0 - self45_0 - ctx43_0))) - (cons - submod_0 - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - rest-bodys_0))))) - (if (eq? tmp_0 'module*) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-stop - #f) - (void))) - (cons - exp-body_0 - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - rest-bodys_0))) - (if (eq? tmp_0 '|#%declare|) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-declare - disarmed-exp-body_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-exp-body_0) - (syntax-e$1 - disarmed-exp-body_0) - disarmed-exp-body_0))) - (if (pair? s_0) - (let ((|#%declare538_0| - (let ((s_1 (car s_0))) - s_1))) - (let ((kw539_0 - (let ((s_1 - (cdr s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0) - flat-s_0)))))) - (let ((|#%declare538_1| - |#%declare538_0|)) - (values - |#%declare538_1| - kw539_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))) - (case-lambda - ((|#%declare536_0| kw537_0) - (values - #t - |#%declare536_0| - kw537_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 |#%declare536_0| kw537_0) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((kw_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (begin - (begin - (if (keyword? - (syntax-e$1 - kw_0)) - (void) - (raise-syntax-error$1 - #f - "expected a keyword" - exp-body_0 - kw_0)) - (if (memq - (syntax-e$1 - kw_0) - kws2278) - (void) - (raise-syntax-error$1 - #f - "not an allowed declaration keyword" - exp-body_0 - kw_0)) - (if (hash-ref - declared-keywords51_0 - (syntax-e$1 - kw_0) - #f) - (raise-syntax-error$1 - #f - "keyword declared multiple times" - exp-body_0 - kw_0) - (void)) - (if (eq? - (syntax-e$1 - kw_0) - kw2838) - (if (eq? - (current-code-inspector) - initial-code-inspector) - (void) - (raise-syntax-error$1 - #f - "unsafe compilation disallowed by code inspector" - exp-body_0 - kw_0)) - (void)) - (hash-set! - declared-keywords51_0 - (syntax-e$1 - kw_0) - kw_0)) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 kw537_0))) - (let ((parsed-body_0 - (|parsed-#%declare22.1| - exp-body_0))) - (let ((app_0 - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx43_0))) - parsed-body_0 - (expanded+parsed1.1 - exp-body_0 - parsed-body_0)))) - (cons - app_0 - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - rest-bodys_0)))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-stop - #f) - (void))) - (cons - exp-body_0 - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - rest-bodys_0))))))))))))))))) - (loop_0 + (|#%name| + partially-expand-bodys + (lambda (all-scopes-stx49_0 + compiled-submodules53_0 + ctx43_0 + declared-keywords51_0 + declared-submodule-names52_0 + defined-syms50_0 + frame-id46_0 + loop56_0 + modules-being-compiled54_0 + mpis-to-reset55_0 + namespace44_0 + need-eventually-defined48_0 + phase42_0 + requires-and-provides47_0 + self45_0 + bodys72_0) + (begin + (begin + (namespace-visit-available-modules! namespace44_0 phase42_0) + (letrec* + ((loop_0 (|#%name| loop - (lambda (all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - tail?_0 - bodys_0) + (lambda (tail?_0 bodys_0) (begin (if (null? bodys_0) (if (if tail?_0 (not (zero? phase42_0)) #f) @@ -92537,24 +90172,7 @@ 'module-end-lifts added-bodys_0) (void))) - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - #t - added-bodys_0))))) + (loop_0 #t added-bodys_0))))) null)) (let ((rest-bodys_0 (cdr bodys_0))) (begin @@ -92633,24 +90251,7 @@ added-lifted-mods_0) (void)))) (let ((exp-lifted-mods_0 - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - #f - added-lifted-mods_0))) + (loop_0 #f added-lifted-mods_0))) (begin (let ((obs_0 (begin-unsafe @@ -92663,93 +90264,1569 @@ 'module-pass1-case exp-body_0) (void))) - (let ((l_0 - (append - lifted-reqs_0 - lifted-defns_0 - exp-lifted-mods_0))) - (if (null? l_0) - (finish_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - disarmed-exp-body_0 - exp-body_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - rest-bodys_0 - self45_0 - tail?_0) - (append - l_0 - (finish_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - disarmed-exp-body_0 - exp-body_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - rest-bodys_0 - self45_0 - tail?_0))))))))))))))))))))) - (|#%name| - partially-expand-bodys - (lambda (all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - bodys72_0) - (begin - (begin - (namespace-visit-available-modules! namespace44_0 phase42_0) - (loop_0 - all-scopes-stx49_0 - compiled-submodules53_0 - ctx43_0 - declared-keywords51_0 - declared-submodule-names52_0 - defined-syms50_0 - frame-id46_0 - loop56_0 - modules-being-compiled54_0 - mpis-to-reset55_0 - namespace44_0 - need-eventually-defined48_0 - phase42_0 - requires-and-provides47_0 - self45_0 - #t - bodys72_0))))))) + (let ((finish_0 + (|#%name| + finish + (lambda () + (begin + (let ((tmp_0 + (core-form-sym + disarmed-exp-body_0 + phase42_0))) + (if (eq? tmp_0 'begin) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-begin + disarmed-exp-body_0) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-exp-body_0) + (syntax-e$1 + disarmed-exp-body_0) + disarmed-exp-body_0))) + (if (pair? + s_0) + (let ((begin439_0 + (let ((s_1 + (car + s_0))) + s_1))) + (let ((e440_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0) + flat-s_0)))))) + (let ((begin439_1 + begin439_0)) + (values + begin439_1 + e440_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))) + (case-lambda + ((begin437_0 + e438_0) + (values + #t + begin437_0 + e438_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + begin437_0 + e438_0) + (let ((track_0 + (|#%name| + track + (lambda (e_0) + (begin + (syntax-track-origin$1 + e_0 + exp-body_0)))))) + (let ((spliced-bodys_0 + (append + (map_1346 + track_0 + e438_0) + rest-bodys_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'splice + spliced-bodys_0) + (void))) + (loop_0 + tail?_0 + spliced-bodys_0))))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (if (eq? + tmp_0 + 'begin-for-syntax) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-begin-for-syntax + disarmed-exp-body_0) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-exp-body_0) + (syntax-e$1 + disarmed-exp-body_0) + disarmed-exp-body_0))) + (if (pair? + s_0) + (let ((begin-for-syntax443_0 + (let ((s_1 + (car + s_0))) + s_1))) + (let ((e444_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0) + flat-s_0)))))) + (let ((begin-for-syntax443_1 + begin-for-syntax443_0)) + (values + begin-for-syntax443_1 + e444_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))) + (case-lambda + ((begin-for-syntax441_0 + e442_0) + (values + #t + begin-for-syntax441_0 + e442_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + begin-for-syntax441_0 + e442_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prepare-env) + (void))) + (let ((ct-m-ns_0 + (namespace->namespace-at-phase + namespace44_0 + (add1 + phase42_0)))) + (begin + (prepare-next-phase-namespace + ctx43_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'phase-up) + (void))) + (let ((nested-bodys_0 + (|#%app| + loop56_0 + e442_0 + (add1 + phase42_0) + #f))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void))) + (namespace-run-available-modules! + namespace44_0 + (add1 + phase42_0)) + (eval-nested-bodys + nested-bodys_0 + (add1 + phase42_0) + ct-m-ns_0 + self45_0 + ctx43_0) + (namespace-visit-available-modules! + namespace44_0 + phase42_0) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-case + (let ((s-nested-bodys_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((nested-body_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (extract-syntax + nested-body_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + nested-bodys_0)))))) + (cons + begin-for-syntax441_0 + s-nested-bodys_0))) + (void))) + (cons + (semi-parsed-begin-for-syntax3.1 + exp-body_0 + nested-bodys_0) + (loop_0 + tail?_0 + rest-bodys_0))))))))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (if (eq? + tmp_0 + 'define-values) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-define-values + disarmed-exp-body_0) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-exp-body_0) + (syntax-e$1 + disarmed-exp-body_0) + disarmed-exp-body_0))) + (if (pair? + s_0) + (let ((define-values448_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((id451_0 + (let ((s_3 + (car + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0) + (let ((id_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (id_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((s_5 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((id_1 + (let ((id_1 + (let ((id464_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-exp-body_0 + s_5)))) + (cons + id464_0 + id_0)))) + (values + id_1)))) + (for-loop_0 + id_1 + rest_0)))) + id_0)))))) + (for-loop_0 + null + flat-s_0))))) + (reverse$1 + id_0)))))))) + (let ((rhs452_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((rhs453_0 + (let ((s_5 + (car + s_4))) + s_5))) + (call-with-values + (lambda () + (let ((s_5 + (cdr + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 + s_5) + s_5))) + (if (null? + s_6) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0))))) + (case-lambda + (() + (let ((rhs453_1 + rhs453_0)) + (values + rhs453_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))))) + (let ((id451_1 + id451_0)) + (values + id451_1 + rhs452_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0))))) + (case-lambda + ((id449_0 + rhs450_0) + (let ((define-values448_1 + define-values448_0)) + (values + define-values448_1 + id449_0 + rhs450_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))) + (case-lambda + ((define-values445_0 + id446_0 + rhs447_0) + (values + #t + define-values445_0 + id446_0 + rhs447_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + define-values445_0 + id446_0 + rhs447_0) + (let ((ids_0 + (remove-use-site-scopes + id446_0 + ctx43_0))) + (begin + (check-no-duplicate-ids.1 + unsafe-undefined + ids_0 + phase42_0 + exp-body_0 + unsafe-undefined) + (begin + (check-ids-unbound.1 + exp-body_0 + ids_0 + phase42_0 + requires-and-provides47_0) + (let ((syms_0 + (select-defined-syms-and-bind!.1 + #f + frame-id46_0 + exp-body_0 + requires-and-provides47_0 + #f + ids_0 + defined-syms50_0 + self45_0 + phase42_0 + all-scopes-stx49_0))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? + lst_0) + (let ((sym_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (begin + (namespace-unset-transformer! + namespace44_0 + phase42_0 + sym_0) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + syms_0))) + (void) + (add-defined-syms!.1 + #f + requires-and-provides47_0 + syms_0 + phase42_0) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-case + (list + define-values445_0 + ids_0 + rhs447_0)) + (void))) + (cons + (semi-parsed-define-values2.1 + exp-body_0 + syms_0 + ids_0 + rhs447_0) + (loop_0 + tail?_0 + rest-bodys_0)))))))) + (args + (raise-binding-result-arity-error + 4 + args))))) + (if (eq? + tmp_0 + 'define-syntaxes) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-define-syntaxes + disarmed-exp-body_0) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-exp-body_0) + (syntax-e$1 + disarmed-exp-body_0) + disarmed-exp-body_0))) + (if (pair? + s_0) + (let ((define-syntaxes476_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((id479_0 + (let ((s_3 + (car + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0) + (let ((id_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (id_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((s_5 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((id_1 + (let ((id_1 + (let ((id493_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-exp-body_0 + s_5)))) + (cons + id493_0 + id_0)))) + (values + id_1)))) + (for-loop_0 + id_1 + rest_0)))) + id_0)))))) + (for-loop_0 + null + flat-s_0))))) + (reverse$1 + id_0)))))))) + (let ((rhs480_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((rhs481_0 + (let ((s_5 + (car + s_4))) + s_5))) + (call-with-values + (lambda () + (let ((s_5 + (cdr + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 + s_5) + s_5))) + (if (null? + s_6) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0))))) + (case-lambda + (() + (let ((rhs481_1 + rhs481_0)) + (values + rhs481_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))))) + (let ((id479_1 + id479_0)) + (values + id479_1 + rhs480_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0))))) + (case-lambda + ((id477_0 + rhs478_0) + (let ((define-syntaxes476_1 + define-syntaxes476_0)) + (values + define-syntaxes476_1 + id477_0 + rhs478_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))) + (case-lambda + ((define-syntaxes473_0 + id474_0 + rhs475_0) + (values + #t + define-syntaxes473_0 + id474_0 + rhs475_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + define-syntaxes473_0 + id474_0 + rhs475_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prepare-env) + (void))) + (begin + (prepare-next-phase-namespace + ctx43_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'phase-up) + (void))) + (let ((ids_0 + (remove-use-site-scopes + id474_0 + ctx43_0))) + (begin + (check-no-duplicate-ids.1 + unsafe-undefined + ids_0 + phase42_0 + exp-body_0 + unsafe-undefined) + (begin + (check-ids-unbound.1 + exp-body_0 + ids_0 + phase42_0 + requires-and-provides47_0) + (let ((syms_0 + (select-defined-syms-and-bind!.1 + #t + frame-id46_0 + exp-body_0 + requires-and-provides47_0 + #f + ids_0 + defined-syms50_0 + self45_0 + phase42_0 + all-scopes-stx49_0))) + (begin + (add-defined-syms!.1 + #t + requires-and-provides47_0 + syms_0 + phase42_0) + (call-with-values + (lambda () + (let ((temp506_0 + (if (expand-context/outer? + ctx43_0) + (let ((inner509_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx43_0))) + (if (expand-context/inner? + the-struct_0) + (let ((app_0 + (root-expand-context/inner-self-mpi + the-struct_0))) + (let ((app_1 + (root-expand-context/inner-module-scopes + the-struct_0))) + (let ((app_2 + (root-expand-context/inner-top-level-bind-scope + the-struct_0))) + (let ((app_3 + (root-expand-context/inner-all-scopes-stx + the-struct_0))) + (let ((app_4 + (root-expand-context/inner-defined-syms + the-struct_0))) + (let ((app_5 + (root-expand-context/inner-counter + the-struct_0))) + (let ((app_6 + (root-expand-context/inner-lift-key + the-struct_0))) + (let ((app_7 + (expand-context/inner-to-parsed? + the-struct_0))) + (let ((app_8 + (expand-context/inner-phase + the-struct_0))) + (let ((app_9 + (expand-context/inner-namespace + the-struct_0))) + (let ((app_10 + (expand-context/inner-just-once? + the-struct_0))) + (let ((app_11 + (expand-context/inner-module-begin-k + the-struct_0))) + (let ((app_12 + (expand-context/inner-allow-unbound? + the-struct_0))) + (let ((app_13 + (expand-context/inner-in-local-expand? + the-struct_0))) + (let ((app_14 + (|expand-context/inner-keep-#%expression?| + the-struct_0))) + (let ((app_15 + (expand-context/inner-stops + the-struct_0))) + (let ((app_16 + (expand-context/inner-declared-submodule-names + the-struct_0))) + (let ((app_17 + (expand-context/inner-lift-envs + the-struct_0))) + (let ((app_18 + (expand-context/inner-require-lifts + the-struct_0))) + (let ((app_19 + (expand-context/inner-requires+provides + the-struct_0))) + (let ((app_20 + (expand-context/inner-observer + the-struct_0))) + (let ((app_21 + (expand-context/inner-for-serializable? + the-struct_0))) + (let ((app_22 + (expand-context/inner-to-correlated-linklet? + the-struct_0))) + (let ((app_23 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_24 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + app_12 + app_13 + app_14 + app_15 + app_16 + #f + app_17 + #f + app_18 + #f + app_19 + app_20 + app_21 + app_22 + app_23 + app_24 + (expand-context/inner-skip-visit-available? + the-struct_0))))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((app_0 + (root-expand-context/outer-post-expansion + ctx43_0))) + (let ((app_1 + (root-expand-context/outer-use-site-scopes + ctx43_0))) + (let ((app_2 + (root-expand-context/outer-frame-id + ctx43_0))) + (let ((app_3 + (expand-context/outer-context + ctx43_0))) + (let ((app_4 + (expand-context/outer-env + ctx43_0))) + (let ((app_5 + (expand-context/outer-scopes + ctx43_0))) + (let ((app_6 + (expand-context/outer-def-ctx-scopes + ctx43_0))) + (let ((app_7 + (expand-context/outer-binding-layer + ctx43_0))) + (let ((app_8 + (expand-context/outer-reference-records + ctx43_0))) + (let ((app_9 + (expand-context/outer-only-immediate? + ctx43_0))) + (let ((app_10 + (expand-context/outer-current-introduction-scopes + ctx43_0))) + (let ((app_11 + (expand-context/outer-current-use-scopes + ctx43_0))) + (expand-context/outer1.1 + inner509_0 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + need-eventually-defined48_0 + app_10 + app_11 + (expand-context/outer-name + ctx43_0))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx43_0)))) + (expand+eval-for-syntaxes-binding.1 + #f + 'define-syntaxes + rhs475_0 + ids_0 + temp506_0))) + (case-lambda + ((exp-rhs_0 + parsed-rhs_0 + vals_0) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0 + lst_1 + lst_2) + (begin + (if (if (pair? + lst_0) + (if (pair? + lst_1) + (pair? + lst_2) + #f) + #f) + (let ((sym_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((val_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((id_0 + (unsafe-car + lst_2))) + (let ((rest_2 + (unsafe-cdr + lst_2))) + (begin + (begin + (maybe-install-free=id-in-context! + val_0 + id_0 + phase42_0 + ctx43_0) + (namespace-set-transformer! + namespace44_0 + phase42_0 + sym_0 + val_0)) + (for-loop_0 + rest_0 + rest_1 + rest_2)))))))) + (values))))))) + (for-loop_0 + syms_0 + vals_0 + ids_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-case + (list + define-syntaxes473_0 + ids_0 + exp-rhs_0)) + (void))) + (let ((parsed-body_0 + (parsed-define-syntaxes20.1 + (keep-properties-only + exp-body_0) + ids_0 + syms_0 + parsed-rhs_0))) + (let ((app_0 + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx43_0))) + parsed-body_0 + (expanded+parsed1.1 + (let ((temp514_0 + (list + define-syntaxes473_0 + ids_0 + exp-rhs_0))) + (rebuild.1 + #t + exp-body_0 + temp514_0)) + parsed-body_0)))) + (cons + app_0 + (loop_0 + tail?_0 + rest-bodys_0))))))) + (args + (raise-binding-result-arity-error + 3 + args))))))))))))) + (args + (raise-binding-result-arity-error + 4 + args))))) + (if (eq? + tmp_0 + '|#%require|) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-require + disarmed-exp-body_0) + (void))) + (let ((ready-body_0 + (remove-use-site-scopes + disarmed-exp-body_0 + ctx43_0))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + ready-body_0) + (syntax-e$1 + ready-body_0) + ready-body_0))) + (if (pair? + s_0) + (let ((|#%require517_0| + (let ((s_1 + (car + s_0))) + s_1))) + (let ((req518_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + ready-body_0) + flat-s_0)))))) + (let ((|#%require517_1| + |#%require517_0|)) + (values + |#%require517_1| + req518_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + ready-body_0)))) + (case-lambda + ((|#%require515_0| + req516_0) + (values + #t + |#%require515_0| + req516_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + |#%require515_0| + req516_0) + (begin + (parse-and-perform-requires!.1 + #f + #f + declared-submodule-names52_0 + #f + phase42_0 + #f + self45_0 + #f + #t + 'module + req516_0 + exp-body_0 + namespace44_0 + phase42_0 + requires-and-provides47_0) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-case + ready-body_0) + (void))) + (cons + exp-body_0 + (loop_0 + tail?_0 + rest-bodys_0)))) + (args + (raise-binding-result-arity-error + 3 + args)))))) + (if (eq? + tmp_0 + '|#%provide|) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-stop + #f) + (void))) + (cons + exp-body_0 + (loop_0 + tail?_0 + rest-bodys_0))) + (if (eq? + tmp_0 + 'module) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-submodule + #f) + (void))) + (let ((ready-body_0 + (remove-use-site-scopes + exp-body_0 + ctx43_0))) + (let ((submod_0 + (expand-submodule.1 + compiled-submodules53_0 + declared-submodule-names52_0 + #f + #f + #f + #f + modules-being-compiled54_0 + mpis-to-reset55_0 + ready-body_0 + self45_0 + ctx43_0))) + (cons + submod_0 + (loop_0 + tail?_0 + rest-bodys_0))))) + (if (eq? + tmp_0 + 'module*) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-stop + #f) + (void))) + (cons + exp-body_0 + (loop_0 + tail?_0 + rest-bodys_0))) + (if (eq? + tmp_0 + '|#%declare|) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-declare + disarmed-exp-body_0) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-exp-body_0) + (syntax-e$1 + disarmed-exp-body_0) + disarmed-exp-body_0))) + (if (pair? + s_0) + (let ((|#%declare538_0| + (let ((s_1 + (car + s_0))) + s_1))) + (let ((kw539_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0) + flat-s_0)))))) + (let ((|#%declare538_1| + |#%declare538_0|)) + (values + |#%declare538_1| + kw539_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))) + (case-lambda + ((|#%declare536_0| + kw537_0) + (values + #t + |#%declare536_0| + kw537_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + |#%declare536_0| + kw537_0) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? + lst_0) + (let ((kw_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (begin + (begin + (if (keyword? + (syntax-e$1 + kw_0)) + (void) + (raise-syntax-error$1 + #f + "expected a keyword" + exp-body_0 + kw_0)) + (if (memq + (syntax-e$1 + kw_0) + kws2278) + (void) + (raise-syntax-error$1 + #f + "not an allowed declaration keyword" + exp-body_0 + kw_0)) + (if (hash-ref + declared-keywords51_0 + (syntax-e$1 + kw_0) + #f) + (raise-syntax-error$1 + #f + "keyword declared multiple times" + exp-body_0 + kw_0) + (void)) + (if (eq? + (syntax-e$1 + kw_0) + kw2838) + (if (eq? + (current-code-inspector) + initial-code-inspector) + (void) + (raise-syntax-error$1 + #f + "unsafe compilation disallowed by code inspector" + exp-body_0 + kw_0)) + (void)) + (hash-set! + declared-keywords51_0 + (syntax-e$1 + kw_0) + kw_0)) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + kw537_0))) + (let ((parsed-body_0 + (|parsed-#%declare22.1| + exp-body_0))) + (let ((app_0 + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx43_0))) + parsed-body_0 + (expanded+parsed1.1 + exp-body_0 + parsed-body_0)))) + (cons + app_0 + (loop_0 + tail?_0 + rest-bodys_0)))))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-stop + #f) + (void))) + (cons + exp-body_0 + (loop_0 + tail?_0 + rest-bodys_0)))))))))))))))))) + (let ((l_0 + (append + lifted-reqs_0 + lifted-defns_0 + exp-lifted-mods_0))) + (if (null? l_0) + (finish_0) + (append + l_0 + (finish_0)))))))))))))))))))))) + (loop_0 #t bodys72_0))))))) (define make-wrap-as-definition (lambda (self_0 frame-id_0 @@ -92836,518 +91913,474 @@ (for-loop_0 null bodys_0)))) bodys_0)))) (define finish-expanding-body-expressions.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (compiled-submodules78_0 - ctx75_0 - declared-submodule-names77_0 - modules-being-compiled79_0 - mpis-to-reset80_0 - phase74_0 - self76_0 - tail?_0 - bodys_0) - (begin - (if (null? bodys_0) - (if (if tail?_0 (not (zero? phase74_0)) #f) - null - (if tail?_0 - (let ((bodys_1 - (let ((app_0 - (let ((to-module-lifts_0 - (begin-unsafe - (expand-context/inner-to-module-lifts - (root-expand-context/outer-inner - ctx75_0))))) - (begin-unsafe - (box-clear! - (to-module-lift-context-ends - to-module-lifts_0)))))) - (append - app_0 - (let ((to-module-lifts_0 - (begin-unsafe - (expand-context/inner-to-module-lifts - (root-expand-context/outer-inner - ctx75_0))))) - (begin-unsafe - (box-clear! - (to-module-lift-context-provides - to-module-lifts_0)))))))) - (if (null? bodys_1) - null - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx75_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'module-end-lifts - bodys_1) - (void))) - (loop_0 - compiled-submodules78_0 - ctx75_0 - declared-submodule-names77_0 - modules-being-compiled79_0 - mpis-to-reset80_0 - phase74_0 - self76_0 - #t - (add-post-expansion-scope bodys_1 ctx75_0))))) - null)) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx75_0))))) - (if obs_0 (call-expand-observe obs_0 'next) (void))) - (let ((body_0 (car bodys_0))) - (let ((rest-bodys_0 (cdr bodys_0))) - (let ((exp-body_0 - (if (let ((or-part_0 (parsed? body_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (expanded+parsed? body_0))) - (if or-part_1 - or-part_1 - (semi-parsed-begin-for-syntax? - body_0))))) - body_0 - (if (semi-parsed-define-values? body_0) - (let ((ids_0 - (semi-parsed-define-values-ids - body_0))) - (let ((rhs-ctx_0 - (as-named-context - (as-expression-context ctx75_0) - ids_0))) - (let ((syms_0 - (semi-parsed-define-values-syms + (|#%name| + finish-expanding-body-expressions + (lambda (compiled-submodules78_0 + ctx75_0 + declared-submodule-names77_0 + modules-being-compiled79_0 + mpis-to-reset80_0 + phase74_0 + self76_0 + partially-expanded-bodys88_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (tail?_0 bodys_0) + (begin + (if (null? bodys_0) + (if (if tail?_0 (not (zero? phase74_0)) #f) + null + (if tail?_0 + (let ((bodys_1 + (let ((app_0 + (let ((to-module-lifts_0 + (begin-unsafe + (expand-context/inner-to-module-lifts + (root-expand-context/outer-inner + ctx75_0))))) + (begin-unsafe + (box-clear! + (to-module-lift-context-ends + to-module-lifts_0)))))) + (append + app_0 + (let ((to-module-lifts_0 + (begin-unsafe + (expand-context/inner-to-module-lifts + (root-expand-context/outer-inner + ctx75_0))))) + (begin-unsafe + (box-clear! + (to-module-lift-context-provides + to-module-lifts_0)))))))) + (if (null? bodys_1) + null + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx75_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'module-end-lifts + bodys_1) + (void))) + (loop_0 + #t + (add-post-expansion-scope bodys_1 ctx75_0))))) + null)) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx75_0))))) + (if obs_0 (call-expand-observe obs_0 'next) (void))) + (let ((body_0 (car bodys_0))) + (let ((rest-bodys_0 (cdr bodys_0))) + (let ((exp-body_0 + (if (let ((or-part_0 (parsed? body_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (expanded+parsed? body_0))) + (if or-part_1 + or-part_1 + (semi-parsed-begin-for-syntax? + body_0))))) + body_0 + (if (semi-parsed-define-values? body_0) + (let ((ids_0 + (semi-parsed-define-values-ids + body_0))) + (let ((rhs-ctx_0 + (as-named-context + (as-expression-context ctx75_0) + ids_0))) + (let ((syms_0 + (semi-parsed-define-values-syms + body_0))) + (let ((s_0 + (semi-parsed-define-values-s body_0))) - (let ((s_0 - (semi-parsed-define-values-s - body_0))) - (call-with-values - (lambda () - (let ((s_1 - (syntax-disarm$1 s_0))) - (if (if (not - (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - rhs-ctx_0)))) - #t - #f) - (call-with-values - (lambda () - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 s_1) - s_1))) - (if (pair? s_2) - (let ((define-values550_0 - (let ((s_3 - (car - s_2))) - s_3))) - (call-with-values - (lambda () + (call-with-values + (lambda () + (let ((s_1 (syntax-disarm$1 s_0))) + (if (if (not + (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + rhs-ctx_0)))) + #t + #f) + (call-with-values + (lambda () + (let ((s_2 + (if (syntax?$1 s_1) + (syntax-e$1 s_1) + s_1))) + (if (pair? s_2) + (let ((define-values550_0 (let ((s_3 - (cdr + (car s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 + s_3))) + (call-with-values + (lambda () + (let ((s_3 + (cdr s_2))) + (let ((s_4 + (if (syntax?$1 s_3) - s_3))) - (if (pair? - s_4) - (let ((_0 + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((_0 + (let ((s_5 + (car + s_4))) + s_5))) + (let ((_1 (let ((s_5 - (car + (cdr s_4))) - s_5))) - (let ((_1 - (let ((s_5 - (cdr - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 + (let ((s_6 + (if (syntax?$1 s_5) - s_5))) - (if (pair? - s_6) - (let ((_1 - (let ((s_7 - (car - s_6))) - s_7))) - (call-with-values - (lambda () + (syntax-e$1 + s_5) + s_5))) + (if (pair? + s_6) + (let ((_1 (let ((s_7 - (cdr + (car s_6))) - (let ((s_8 - (if (syntax?$1 - s_7) - (syntax-e$1 + s_7))) + (call-with-values + (lambda () + (let ((s_7 + (cdr + s_6))) + (let ((s_8 + (if (syntax?$1 s_7) - s_7))) - (if (null? - s_8) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - s_1))))) - (case-lambda - (() - (let ((_2 - _1)) - (values - _2))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - s_1)))))) - (let ((_2 - _0)) - (values - _2 - _1)))) - (raise-syntax-error$1 - #f - "bad syntax" - s_1))))) - (case-lambda - ((_0 _1) - (let ((define-values550_1 - define-values550_0)) - (values - define-values550_1 - _0 - _1))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - s_1)))) - (case-lambda - ((define-values547_0 - _0 - _1) - (values - #t - define-values547_0 - _0 - _1)) - (args - (raise-binding-result-arity-error - 3 - args)))) - (values #f #f #f #f)))) - (case-lambda - ((ok?_0 define-values547_0 _0 _1) - (let ((rebuild-s_0 - (keep-as-needed.1 - #f - #f - #t - rhs-ctx_0 - s_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx75_0))))) - (if obs_0 - (begin - (call-expand-observe - obs_0 - 'visit - #f) - (call-expand-observe - obs_0 - 'enter-prim - #f) - (call-expand-observe - obs_0 - 'prim-define-values - #f)) - (void))) - (let ((exp-rhs_0 - (begin - (if log-performance? - (start-performance-region - 'expand - 'form-in-module/2) - (void)) - (begin0 - (let ((temp559_0 - (semi-parsed-define-values-rhs - body_0))) - (expand.1 - #f - #f - temp559_0 - rhs-ctx_0)) - (if log-performance? - (end-performance-region) - (void)))))) + (syntax-e$1 + s_7) + s_7))) + (if (null? + s_8) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + s_1))))) + (case-lambda + (() + (let ((_2 + _1)) + (values + _2))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + s_1)))))) + (let ((_2 + _0)) + (values + _2 + _1)))) + (raise-syntax-error$1 + #f + "bad syntax" + s_1))))) + (case-lambda + ((_0 _1) + (let ((define-values550_1 + define-values550_0)) + (values + define-values550_1 + _0 + _1))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + s_1)))) + (case-lambda + ((define-values547_0 _0 _1) + (values + #t + define-values547_0 + _0 + _1)) + (args + (raise-binding-result-arity-error + 3 + args)))) + (values #f #f #f #f)))) + (case-lambda + ((ok?_0 define-values547_0 _0 _1) + (let ((rebuild-s_0 + (keep-as-needed.1 + #f + #f + #t + rhs-ctx_0 + s_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx75_0))))) + (if obs_0 (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx75_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-prim/return - #f) - (void))) - (let ((comp-form_0 - (parsed-define-values19.1 - rebuild-s_0 - ids_0 - syms_0 - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - rhs-ctx_0))) - exp-rhs_0 - (let ((temp562_0 - (as-to-parsed-context - rhs-ctx_0))) - (expand.1 - #f - #f - exp-rhs_0 - temp562_0)))))) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - rhs-ctx_0))) - comp-form_0 - (expanded+parsed1.1 - (let ((temp564_0 - (list - define-values547_0 - ids_0 - exp-rhs_0))) - (rebuild.1 - #t - rebuild-s_0 - temp564_0)) - comp-form_0)))))))) - (args - (raise-binding-result-arity-error - 4 - args)))))))) - (let ((disarmed-body_0 - (syntax-disarm$1 body_0))) - (let ((tmp_0 - (core-form-sym - disarmed-body_0 - phase74_0))) - (if (if (eq? tmp_0 '|#%require|) + (call-expand-observe + obs_0 + 'visit + #f) + (call-expand-observe + obs_0 + 'enter-prim + #f) + (call-expand-observe + obs_0 + 'prim-define-values + #f)) + (void))) + (let ((exp-rhs_0 + (begin + (if log-performance? + (start-performance-region + 'expand + 'form-in-module/2) + (void)) + (begin0 + (let ((temp559_0 + (semi-parsed-define-values-rhs + body_0))) + (expand.1 + #f + #f + temp559_0 + rhs-ctx_0)) + (if log-performance? + (end-performance-region) + (void)))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx75_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-prim/return + #f) + (void))) + (let ((comp-form_0 + (parsed-define-values19.1 + rebuild-s_0 + ids_0 + syms_0 + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + rhs-ctx_0))) + exp-rhs_0 + (let ((temp562_0 + (as-to-parsed-context + rhs-ctx_0))) + (expand.1 + #f + #f + exp-rhs_0 + temp562_0)))))) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + rhs-ctx_0))) + comp-form_0 + (expanded+parsed1.1 + (let ((temp564_0 + (list + define-values547_0 + ids_0 + exp-rhs_0))) + (rebuild.1 + #t + rebuild-s_0 + temp564_0)) + comp-form_0)))))))) + (args + (raise-binding-result-arity-error + 4 + args)))))))) + (let ((disarmed-body_0 + (syntax-disarm$1 body_0))) + (let ((tmp_0 + (core-form-sym + disarmed-body_0 + phase74_0))) + (if (if (eq? tmp_0 '|#%require|) + #t + (if (eq? tmp_0 '|#%provide|) #t - (if (eq? tmp_0 '|#%provide|) - #t - (eq? tmp_0 'module*))) - body_0 - (begin - (if log-performance? - (start-performance-region - 'expand - 'form-in-module/2) - (void)) - (begin0 - (let ((exp-body_0 - (let ((temp566_0 - (as-expression-context - ctx75_0))) - (expand.1 - #f - #f - body_0 - temp566_0)))) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx75_0))) - exp-body_0 - (expanded+parsed1.1 - exp-body_0 - (let ((temp568_0 - (as-to-parsed-context + (eq? tmp_0 'module*))) + body_0 + (begin + (if log-performance? + (start-performance-region + 'expand + 'form-in-module/2) + (void)) + (begin0 + (let ((exp-body_0 + (let ((temp566_0 + (as-expression-context ctx75_0))) (expand.1 #f #f - exp-body_0 - temp568_0))))) - (if log-performance? - (end-performance-region) - (void))))))))))) - (let ((lifted-defns_0 - (let ((lifts_0 + body_0 + temp566_0)))) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx75_0))) + exp-body_0 + (expanded+parsed1.1 + exp-body_0 + (let ((temp568_0 + (as-to-parsed-context + ctx75_0))) + (expand.1 + #f + #f + exp-body_0 + temp568_0))))) + (if log-performance? + (end-performance-region) + (void))))))))))) + (let ((lifted-defns_0 + (let ((lifts_0 + (begin-unsafe + (expand-context/inner-lifts + (root-expand-context/outer-inner + ctx75_0))))) + (begin-unsafe + (box-clear! + (lift-context-lifts lifts_0)))))) + (let ((lifted-requires_0 + (let ((require-lifts_0 (begin-unsafe - (expand-context/inner-lifts + (expand-context/inner-require-lifts (root-expand-context/outer-inner ctx75_0))))) (begin-unsafe (box-clear! - (lift-context-lifts lifts_0)))))) - (let ((lifted-requires_0 - (let ((require-lifts_0 + (require-lift-context-requires + require-lifts_0)))))) + (let ((lifted-modules_0 + (let ((module-lifts_0 (begin-unsafe - (expand-context/inner-require-lifts + (expand-context/inner-module-lifts (root-expand-context/outer-inner ctx75_0))))) (begin-unsafe (box-clear! - (require-lift-context-requires - require-lifts_0)))))) - (let ((lifted-modules_0 - (let ((module-lifts_0 - (begin-unsafe - (expand-context/inner-module-lifts - (root-expand-context/outer-inner - ctx75_0))))) - (begin-unsafe - (box-clear! - (module-lift-context-lifts - module-lifts_0)))))) - (let ((no-lifts?_0 - (if (null? lifted-defns_0) - (if (null? lifted-modules_0) - (null? lifted-requires_0) - #f) - #f))) - (begin - (if no-lifts?_0 - (void) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx75_0))))) - (if obs_0 - (let ((app_0 - (add-post-expansion-scope - lifted-modules_0 - ctx75_0))) + (module-lift-context-lifts + module-lifts_0)))))) + (let ((no-lifts?_0 + (if (null? lifted-defns_0) + (if (null? lifted-modules_0) + (null? lifted-requires_0) + #f) + #f))) + (begin + (if no-lifts?_0 + (void) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx75_0))))) + (if obs_0 + (let ((app_0 + (add-post-expansion-scope + lifted-modules_0 + ctx75_0))) + (call-expand-observe + obs_0 + 'module-pass2-lifts + lifted-requires_0 + app_0 + (lifted-defns-extract-syntax + lifted-defns_0))) + (void)))) + (let ((exp-lifted-modules_0 + (expand-non-module*-submodules.1 + compiled-submodules78_0 + declared-submodule-names77_0 + modules-being-compiled79_0 + mpis-to-reset80_0 + lifted-modules_0 + phase74_0 + self76_0 + ctx75_0))) + (begin + (if no-lifts?_0 + (void) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx75_0))))) + (if obs_0 (call-expand-observe obs_0 - 'module-pass2-lifts - lifted-requires_0 - app_0 - (lifted-defns-extract-syntax - lifted-defns_0))) - (void)))) - (let ((exp-lifted-modules_0 - (expand-non-module*-submodules.1 - compiled-submodules78_0 - declared-submodule-names77_0 - modules-being-compiled79_0 - mpis-to-reset80_0 - lifted-modules_0 - phase74_0 - self76_0 - ctx75_0))) - (begin - (if no-lifts?_0 - (void) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx75_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void)))) - (let ((exp-lifted-defns_0 - (loop_0 - compiled-submodules78_0 - ctx75_0 - declared-submodule-names77_0 - modules-being-compiled79_0 - mpis-to-reset80_0 - phase74_0 - self76_0 - #f - lifted-defns_0))) - (begin - (if no-lifts?_0 - (void) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx75_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void)))) - (append - lifted-requires_0 - exp-lifted-modules_0 - exp-lifted-defns_0 - (cons - exp-body_0 - (loop_0 - compiled-submodules78_0 - ctx75_0 - declared-submodule-names77_0 - modules-being-compiled79_0 - mpis-to-reset80_0 - phase74_0 - self76_0 - tail?_0 - rest-bodys_0)))))))))))))))))))))) - (|#%name| - finish-expanding-body-expressions - (lambda (compiled-submodules78_0 - ctx75_0 - declared-submodule-names77_0 - modules-being-compiled79_0 - mpis-to-reset80_0 - phase74_0 - self76_0 - partially-expanded-bodys88_0) - (begin - (loop_0 - compiled-submodules78_0 - ctx75_0 - declared-submodule-names77_0 - modules-being-compiled79_0 - mpis-to-reset80_0 - phase74_0 - self76_0 - #t - partially-expanded-bodys88_0)))))) + 'next-group) + (void)))) + (let ((exp-lifted-defns_0 + (loop_0 #f lifted-defns_0))) + (begin + (if no-lifts?_0 + (void) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx75_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void)))) + (append + lifted-requires_0 + exp-lifted-modules_0 + exp-lifted-defns_0 + (cons + exp-body_0 + (loop_0 + tail?_0 + rest-bodys_0)))))))))))))))))))))) + (loop_0 #t partially-expanded-bodys88_0)))))) (define check-defined-by-now (lambda (need-eventually-defined_0 self_0 ctx_0 requires+provides_0) (begin @@ -93456,99 +92489,58 @@ (for-loop_0 (hash-iterate-first need-eventually-defined_0)))) (void)))) (define resolve-provides.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (ctx95_0 - declared-submodule-names91_0 - namespace92_0 - requires-and-provides90_0 - self94_0 - bodys_0 - phase_0) - (begin - (if (null? bodys_0) - null - (if (let ((or-part_0 (parsed? (car bodys_0)))) - (if or-part_0 - or-part_0 - (expanded+parsed? (car bodys_0)))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx95_0))))) - (if obs_0 (call-expand-observe obs_0 'next) (void))) - (let ((app_0 (car bodys_0))) - (cons - app_0 - (loop_0 - ctx95_0 - declared-submodule-names91_0 - namespace92_0 - requires-and-provides90_0 - self94_0 - (cdr bodys_0) - phase_0)))) - (if (semi-parsed-begin-for-syntax? (car bodys_0)) + (|#%name| + resolve-provides + (lambda (ctx95_0 + declared-submodule-names91_0 + namespace92_0 + phase93_0 + requires-and-provides90_0 + self94_0 + expression-expanded-bodys102_0) + (begin + (begin + (if log-performance? + (start-performance-region 'expand 'provide) + (void)) + (begin0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (bodys_0 phase_0) + (begin + (if (null? bodys_0) + null + (if (let ((or-part_0 (parsed? (car bodys_0)))) + (if or-part_0 + or-part_0 + (expanded+parsed? (car bodys_0)))) (begin (let ((obs_0 (begin-unsafe (expand-context/inner-observer (root-expand-context/outer-inner ctx95_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'enter-begin-for-syntax) - (void))) - (let ((nested-bodys_0 - (let ((app_0 - (semi-parsed-begin-for-syntax-body - (car bodys_0)))) - (loop_0 - ctx95_0 - declared-submodule-names91_0 - namespace92_0 - requires-and-provides90_0 - self94_0 - app_0 - (add1 phase_0))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx95_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-begin-for-syntax) - (void))) - (let ((app_0 - (let ((the-struct_0 (car bodys_0))) - (if (semi-parsed-begin-for-syntax? - the-struct_0) - (semi-parsed-begin-for-syntax3.1 - (semi-parsed-begin-for-syntax-s - the-struct_0) - nested-bodys_0) - (raise-argument-error - 'struct-copy - "semi-parsed-begin-for-syntax?" - the-struct_0))))) - (cons - app_0 - (loop_0 - ctx95_0 - declared-submodule-names91_0 - namespace92_0 - requires-and-provides90_0 - self94_0 - (cdr bodys_0) - phase_0)))))) - (let ((disarmed-body_0 (syntax-disarm$1 (car bodys_0)))) - (let ((tmp_0 (core-form-sym disarmed-body_0 phase_0))) - (if (eq? tmp_0 '|#%provide|) + (if obs_0 (call-expand-observe obs_0 'next) (void))) + (let ((app_0 (car bodys_0))) + (cons app_0 (loop_0 (cdr bodys_0) phase_0)))) + (if (semi-parsed-begin-for-syntax? (car bodys_0)) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx95_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'enter-begin-for-syntax) + (void))) + (let ((nested-bodys_0 + (let ((app_0 + (semi-parsed-begin-for-syntax-body + (car bodys_0)))) + (loop_0 app_0 (add1 phase_0))))) (begin (let ((obs_0 (begin-unsafe @@ -93556,343 +92548,340 @@ (root-expand-context/outer-inner ctx95_0))))) (if obs_0 - (begin - (call-expand-observe - obs_0 - 'enter-prim - (car bodys_0)) - (call-expand-observe - obs_0 - 'prim-provide - disarmed-body_0)) + (call-expand-observe + obs_0 + 'exit-begin-for-syntax) (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 disarmed-body_0) - (syntax-e$1 disarmed-body_0) - disarmed-body_0))) - (if (pair? s_0) - (let ((|#%provide582_0| - (let ((s_1 (car s_0))) s_1))) - (let ((spec583_0 - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 s_1) - (syntax-e$1 s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-body_0) - flat-s_0)))))) - (let ((|#%provide582_1| - |#%provide582_0|)) - (values - |#%provide582_1| - spec583_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-body_0)))) - (case-lambda - ((|#%provide580_0| spec581_0) - (values #t |#%provide580_0| spec581_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 |#%provide580_0| spec581_0) - (call-with-values - (lambda () - (let ((app_0 (car bodys_0))) - (parse-and-expand-provides! - spec581_0 - app_0 - requires-and-provides90_0 - self94_0 - phase_0 - (if (expand-context/outer? ctx95_0) - (let ((inner585_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx95_0))) - (if (expand-context/inner? - the-struct_0) - (let ((namespace587_0 - (namespace->namespace-at-phase - namespace92_0 - phase_0))) - (let ((app_1 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_7 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_8 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_9 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_10 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_16 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_17 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_18 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-observer - the-struct_0))) - (let ((app_21 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_22 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_23 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_24 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - phase_0 - namespace587_0 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - declared-submodule-names91_0 - app_15 - app_16 - app_17 - app_18 - app_19 - requires-and-provides90_0 - app_20 - app_21 - app_22 - app_23 - app_24 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_1 - (root-expand-context/outer-post-expansion - ctx95_0))) - (let ((app_2 - (root-expand-context/outer-use-site-scopes - ctx95_0))) - (let ((app_3 - (root-expand-context/outer-frame-id - ctx95_0))) - (let ((app_4 - (expand-context/outer-env - ctx95_0))) - (let ((app_5 - (expand-context/outer-scopes - ctx95_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - ctx95_0))) - (let ((app_7 - (expand-context/outer-binding-layer - ctx95_0))) - (let ((app_8 - (expand-context/outer-reference-records - ctx95_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - ctx95_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - ctx95_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - ctx95_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - ctx95_0))) - (expand-context/outer1.1 - inner585_0 - app_1 - app_2 - app_3 - 'top-level - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - ctx95_0))))))))))))))) + (let ((app_0 + (let ((the-struct_0 (car bodys_0))) + (if (semi-parsed-begin-for-syntax? + the-struct_0) + (semi-parsed-begin-for-syntax3.1 + (semi-parsed-begin-for-syntax-s + the-struct_0) + nested-bodys_0) (raise-argument-error 'struct-copy - "expand-context/outer?" - ctx95_0))))) - (case-lambda - ((track-stxes_0 specs_0) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx95_0))) - (loop_0 - ctx95_0 - declared-submodule-names91_0 - namespace92_0 - requires-and-provides90_0 - self94_0 - (cdr bodys_0) - phase_0) - (let ((new-s_0 - (syntax-track-origin* - track-stxes_0 - (let ((temp590_0 (car bodys_0))) - (let ((temp591_0 - (list* - |#%provide580_0| - specs_0))) - (let ((temp590_1 temp590_0)) - (rebuild.1 - #t - temp590_1 - temp591_0))))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx95_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-prim - new-s_0) - (void))) - (cons - new-s_0 - (loop_0 - ctx95_0 - declared-submodule-names91_0 - namespace92_0 - requires-and-provides90_0 - self94_0 - (cdr bodys_0) - phase_0)))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error 3 args))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx95_0))))) - (if obs_0 - (call-expand-observe obs_0 'next) - (void))) - (let ((app_0 (car bodys_0))) + "semi-parsed-begin-for-syntax?" + the-struct_0))))) (cons app_0 - (loop_0 - ctx95_0 - declared-submodule-names91_0 - namespace92_0 - requires-and-provides90_0 - self94_0 - (cdr bodys_0) - phase_0))))))))))))))) - (|#%name| - resolve-provides - (lambda (ctx95_0 - declared-submodule-names91_0 - namespace92_0 - phase93_0 - requires-and-provides90_0 - self94_0 - expression-expanded-bodys102_0) - (begin - (begin - (if log-performance? - (start-performance-region 'expand 'provide) - (void)) - (begin0 - (loop_0 - ctx95_0 - declared-submodule-names91_0 - namespace92_0 - requires-and-provides90_0 - self94_0 - expression-expanded-bodys102_0 - phase93_0) - (if log-performance? (end-performance-region) (void))))))))) + (loop_0 (cdr bodys_0) phase_0)))))) + (let ((disarmed-body_0 + (syntax-disarm$1 (car bodys_0)))) + (let ((tmp_0 + (core-form-sym disarmed-body_0 phase_0))) + (if (eq? tmp_0 '|#%provide|) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx95_0))))) + (if obs_0 + (begin + (call-expand-observe + obs_0 + 'enter-prim + (car bodys_0)) + (call-expand-observe + obs_0 + 'prim-provide + disarmed-body_0)) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 disarmed-body_0) + (syntax-e$1 disarmed-body_0) + disarmed-body_0))) + (if (pair? s_0) + (let ((|#%provide582_0| + (let ((s_1 (car s_0))) s_1))) + (let ((spec583_0 + (let ((s_1 (cdr s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-body_0) + flat-s_0)))))) + (let ((|#%provide582_1| + |#%provide582_0|)) + (values + |#%provide582_1| + spec583_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-body_0)))) + (case-lambda + ((|#%provide580_0| spec581_0) + (values #t |#%provide580_0| spec581_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 |#%provide580_0| spec581_0) + (call-with-values + (lambda () + (let ((app_0 (car bodys_0))) + (parse-and-expand-provides! + spec581_0 + app_0 + requires-and-provides90_0 + self94_0 + phase_0 + (if (expand-context/outer? ctx95_0) + (let ((inner585_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx95_0))) + (if (expand-context/inner? + the-struct_0) + (let ((namespace587_0 + (namespace->namespace-at-phase + namespace92_0 + phase_0))) + (let ((app_1 + (root-expand-context/inner-self-mpi + the-struct_0))) + (let ((app_2 + (root-expand-context/inner-module-scopes + the-struct_0))) + (let ((app_3 + (root-expand-context/inner-top-level-bind-scope + the-struct_0))) + (let ((app_4 + (root-expand-context/inner-all-scopes-stx + the-struct_0))) + (let ((app_5 + (root-expand-context/inner-defined-syms + the-struct_0))) + (let ((app_6 + (root-expand-context/inner-counter + the-struct_0))) + (let ((app_7 + (root-expand-context/inner-lift-key + the-struct_0))) + (let ((app_8 + (expand-context/inner-to-parsed? + the-struct_0))) + (let ((app_9 + (expand-context/inner-just-once? + the-struct_0))) + (let ((app_10 + (expand-context/inner-module-begin-k + the-struct_0))) + (let ((app_11 + (expand-context/inner-allow-unbound? + the-struct_0))) + (let ((app_12 + (expand-context/inner-in-local-expand? + the-struct_0))) + (let ((app_13 + (|expand-context/inner-keep-#%expression?| + the-struct_0))) + (let ((app_14 + (expand-context/inner-stops + the-struct_0))) + (let ((app_15 + (expand-context/inner-lifts + the-struct_0))) + (let ((app_16 + (expand-context/inner-lift-envs + the-struct_0))) + (let ((app_17 + (expand-context/inner-module-lifts + the-struct_0))) + (let ((app_18 + (expand-context/inner-require-lifts + the-struct_0))) + (let ((app_19 + (expand-context/inner-to-module-lifts + the-struct_0))) + (let ((app_20 + (expand-context/inner-observer + the-struct_0))) + (let ((app_21 + (expand-context/inner-for-serializable? + the-struct_0))) + (let ((app_22 + (expand-context/inner-to-correlated-linklet? + the-struct_0))) + (let ((app_23 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_24 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + phase_0 + namespace587_0 + app_9 + app_10 + app_11 + app_12 + app_13 + app_14 + declared-submodule-names91_0 + app_15 + app_16 + app_17 + app_18 + app_19 + requires-and-provides90_0 + app_20 + app_21 + app_22 + app_23 + app_24 + (expand-context/inner-skip-visit-available? + the-struct_0))))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((app_1 + (root-expand-context/outer-post-expansion + ctx95_0))) + (let ((app_2 + (root-expand-context/outer-use-site-scopes + ctx95_0))) + (let ((app_3 + (root-expand-context/outer-frame-id + ctx95_0))) + (let ((app_4 + (expand-context/outer-env + ctx95_0))) + (let ((app_5 + (expand-context/outer-scopes + ctx95_0))) + (let ((app_6 + (expand-context/outer-def-ctx-scopes + ctx95_0))) + (let ((app_7 + (expand-context/outer-binding-layer + ctx95_0))) + (let ((app_8 + (expand-context/outer-reference-records + ctx95_0))) + (let ((app_9 + (expand-context/outer-only-immediate? + ctx95_0))) + (let ((app_10 + (expand-context/outer-need-eventually-defined + ctx95_0))) + (let ((app_11 + (expand-context/outer-current-introduction-scopes + ctx95_0))) + (let ((app_12 + (expand-context/outer-current-use-scopes + ctx95_0))) + (expand-context/outer1.1 + inner585_0 + app_1 + app_2 + app_3 + 'top-level + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + app_12 + (expand-context/outer-name + ctx95_0))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx95_0))))) + (case-lambda + ((track-stxes_0 specs_0) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx95_0))) + (loop_0 (cdr bodys_0) phase_0) + (let ((new-s_0 + (syntax-track-origin* + track-stxes_0 + (let ((temp590_0 + (car bodys_0))) + (let ((temp591_0 + (list* + |#%provide580_0| + specs_0))) + (let ((temp590_1 + temp590_0)) + (rebuild.1 + #t + temp590_1 + temp591_0))))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx95_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-prim + new-s_0) + (void))) + (cons + new-s_0 + (loop_0 + (cdr bodys_0) + phase_0)))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx95_0))))) + (if obs_0 + (call-expand-observe obs_0 'next) + (void))) + (let ((app_0 (car bodys_0))) + (cons + app_0 + (loop_0 + (cdr bodys_0) + phase_0))))))))))))))) + (loop_0 expression-expanded-bodys102_0 phase93_0)) + (if log-performance? (end-performance-region) (void)))))))) (define declare-module-for-expansion.1 (|#%name| declare-module-for-expansion @@ -94017,455 +93006,377 @@ empty-syntax)))) s_2)))) (define expand-post-submodules.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (compiled-submodules134_0 - ctx136_0 - declare-enclosing126_0 - declared-submodule-names133_0 - enclosing-is-cross-phase-persistent?130_0 - modules-being-compiled135_0 - mpis-to-reset132_0 - requires-and-provides129_0 - self128_0 - bodys_0 - phase_0) - (begin - (if (null? bodys_0) - null - (let ((body_0 (car bodys_0))) - (let ((rest-bodys_0 (cdr bodys_0))) - (if (semi-parsed-begin-for-syntax? body_0) - (let ((body-s_0 - (semi-parsed-begin-for-syntax-s body_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx136_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'enter-begin-for-syntax) - (void))) - (call-with-values - (lambda () - (let ((s_0 (syntax-disarm$1 body-s_0))) - (call-with-values - (lambda () - (let ((s_1 - (if (syntax?$1 s_0) - (syntax-e$1 s_0) - s_0))) - (if (pair? s_1) - (let ((begin-for-syntax605_0 - (let ((s_2 (car s_1))) s_2))) - (let ((_0 - (let ((s_2 (cdr s_1))) - (let ((s_3 - (if (syntax?$1 s_2) - (syntax-e$1 s_2) - s_2))) - (let ((flat-s_0 - (to-syntax-list.1 - s_3))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - s_0) - flat-s_0)))))) - (let ((begin-for-syntax605_1 - begin-for-syntax605_0)) - (values - begin-for-syntax605_1 - _0)))) - (raise-syntax-error$1 - #f - "bad syntax" - s_0)))) - (case-lambda - ((begin-for-syntax603_0 _0) - (values #t begin-for-syntax603_0 _0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((ok?_0 begin-for-syntax603_0 _0) - (let ((rebuild-body-s_0 - (keep-as-needed.1 + (|#%name| + expand-post-submodules + (lambda (all-scopes-s131_0 + compiled-submodules134_0 + ctx136_0 + declare-enclosing126_0 + declared-submodule-names133_0 + enclosing-is-cross-phase-persistent?130_0 + modules-being-compiled135_0 + mpis-to-reset132_0 + phase127_0 + requires-and-provides129_0 + self128_0 + fully-expanded-bodys-except-post-submodules148_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (bodys_0 phase_0) + (begin + (if (null? bodys_0) + null + (let ((body_0 (car bodys_0))) + (let ((rest-bodys_0 (cdr bodys_0))) + (if (semi-parsed-begin-for-syntax? body_0) + (let ((body-s_0 + (semi-parsed-begin-for-syntax-s body_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx136_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'enter-begin-for-syntax) + (void))) + (call-with-values + (lambda () + (let ((s_0 (syntax-disarm$1 body-s_0))) + (call-with-values + (lambda () + (let ((s_1 + (if (syntax?$1 s_0) + (syntax-e$1 s_0) + s_0))) + (if (pair? s_1) + (let ((begin-for-syntax605_0 + (let ((s_2 (car s_1))) s_2))) + (let ((_0 + (let ((s_2 (cdr s_1))) + (let ((s_3 + (if (syntax?$1 s_2) + (syntax-e$1 s_2) + s_2))) + (let ((flat-s_0 + (to-syntax-list.1 + s_3))) + (if (not flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + s_0) + flat-s_0)))))) + (let ((begin-for-syntax605_1 + begin-for-syntax605_0)) + (values + begin-for-syntax605_1 + _0)))) + (raise-syntax-error$1 #f - #f - #f - ctx136_0 - body-s_0))) - (let ((nested-bodys_0 - (let ((app_0 - (semi-parsed-begin-for-syntax-body - body_0))) - (loop_0 - compiled-submodules134_0 - ctx136_0 - declare-enclosing126_0 - declared-submodule-names133_0 - enclosing-is-cross-phase-persistent?130_0 - modules-being-compiled135_0 - mpis-to-reset132_0 - requires-and-provides129_0 - self128_0 - app_0 - (add1 phase_0))))) - (let ((parsed-bfs_0 - (parsed-begin-for-syntax21.1 - rebuild-body-s_0 - (parsed-only nested-bodys_0)))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx136_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-begin-for-syntax) - (void))) - (let ((app_0 - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx136_0))) - parsed-bfs_0 - (expanded+parsed1.1 - (let ((temp610_0 - (list* - begin-for-syntax603_0 - (syntax-only - nested-bodys_0)))) - (rebuild.1 - #t - rebuild-body-s_0 - temp610_0)) - parsed-bfs_0)))) - (cons - app_0 - (loop_0 - compiled-submodules134_0 - ctx136_0 - declare-enclosing126_0 - declared-submodule-names133_0 - enclosing-is-cross-phase-persistent?130_0 - modules-being-compiled135_0 - mpis-to-reset132_0 - requires-and-provides129_0 - self128_0 - rest-bodys_0 - phase_0)))))))) - (args - (raise-binding-result-arity-error 3 args)))))) - (if (let ((or-part_0 (parsed? body_0))) - (if or-part_0 - or-part_0 - (expanded+parsed? body_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx136_0))))) - (if obs_0 - (call-expand-observe obs_0 'next) - (void))) - (cons - body_0 - (loop_0 - compiled-submodules134_0 - ctx136_0 - declare-enclosing126_0 - declared-submodule-names133_0 - enclosing-is-cross-phase-persistent?130_0 - modules-being-compiled135_0 - mpis-to-reset132_0 - requires-and-provides129_0 - self128_0 - rest-bodys_0 - phase_0))) - (let ((disarmed-body_0 (syntax-disarm$1 body_0))) - (let ((tmp_0 - (core-form-sym disarmed-body_0 phase_0))) - (if (eq? tmp_0 'module*) - (begin - (force declare-enclosing126_0) - (let ((ready-body_0 - (remove-use-site-scopes - body_0 - ctx136_0))) - (call-with-values - (lambda () - (if (let ((s_0 - (if (syntax?$1 - disarmed-body_0) - (syntax-e$1 + "bad syntax" + s_0)))) + (case-lambda + ((begin-for-syntax603_0 _0) + (values #t begin-for-syntax603_0 _0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((ok?_0 begin-for-syntax603_0 _0) + (let ((rebuild-body-s_0 + (keep-as-needed.1 + #f + #f + #f + ctx136_0 + body-s_0))) + (let ((nested-bodys_0 + (let ((app_0 + (semi-parsed-begin-for-syntax-body + body_0))) + (loop_0 app_0 (add1 phase_0))))) + (let ((parsed-bfs_0 + (parsed-begin-for-syntax21.1 + rebuild-body-s_0 + (parsed-only nested-bodys_0)))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx136_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-begin-for-syntax) + (void))) + (let ((app_0 + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx136_0))) + parsed-bfs_0 + (expanded+parsed1.1 + (let ((temp610_0 + (list* + begin-for-syntax603_0 + (syntax-only + nested-bodys_0)))) + (rebuild.1 + #t + rebuild-body-s_0 + temp610_0)) + parsed-bfs_0)))) + (cons + app_0 + (loop_0 rest-bodys_0 phase_0)))))))) + (args + (raise-binding-result-arity-error 3 args)))))) + (if (let ((or-part_0 (parsed? body_0))) + (if or-part_0 + or-part_0 + (expanded+parsed? body_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx136_0))))) + (if obs_0 + (call-expand-observe obs_0 'next) + (void))) + (cons body_0 (loop_0 rest-bodys_0 phase_0))) + (let ((disarmed-body_0 (syntax-disarm$1 body_0))) + (let ((tmp_0 + (core-form-sym disarmed-body_0 phase_0))) + (if (eq? tmp_0 'module*) + (begin + (force declare-enclosing126_0) + (let ((ready-body_0 + (remove-use-site-scopes + body_0 + ctx136_0))) + (call-with-values + (lambda () + (if (let ((s_0 + (if (syntax?$1 disarmed-body_0) - disarmed-body_0))) - (if (pair? s_0) - (if (let ((s_1 (car s_0))) #t) + (syntax-e$1 disarmed-body_0) + disarmed-body_0))) + (if (pair? s_0) + (if (let ((s_1 (car s_0))) #t) + (let ((s_1 (cdr s_0))) + (let ((s_2 + (if (syntax?$1 s_1) + (syntax-e$1 s_1) + s_1))) + (if (pair? s_2) + (if (let ((s_3 + (car s_2))) + #t) + (let ((s_3 (cdr s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? s_4) + (if (let ((s_5 + (car + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 + s_5) + s_5))) + (eq? + #f + s_6))) + (let ((s_5 + (cdr + s_4))) + #t) + #f) + #f))) + #f) + #f))) + #f) + #f)) + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-body_0) + (syntax-e$1 + disarmed-body_0) + disarmed-body_0))) + (let ((module*614_0 + (let ((s_1 (car s_0))) + s_1))) + (call-with-values + (lambda () (let ((s_1 (cdr s_0))) (let ((s_2 (if (syntax?$1 s_1) (syntax-e$1 s_1) s_1))) - (if (pair? s_2) - (if (let ((s_3 - (car s_2))) - #t) - (let ((s_3 - (cdr s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? s_4) - (if (let ((s_5 - (car - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 - s_5) - s_5))) - (eq? - #f - s_6))) - (let ((s_5 - (cdr - s_4))) - #t) - #f) - #f))) - #f) - #f))) - #f) - #f)) - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-body_0) - (syntax-e$1 - disarmed-body_0) - disarmed-body_0))) - (let ((module*614_0 - (let ((s_1 (car s_0))) - s_1))) - (call-with-values - (lambda () - (let ((s_1 (cdr s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 s_1) - s_1))) - (let ((name617_0 + (let ((name617_0 + (let ((s_3 + (car s_2))) + s_3))) + (let ((_0 (let ((s_3 - (car + (cdr s_2))) - s_3))) - (let ((_0 - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 + (let ((s_4 + (if (syntax?$1 s_3) - s_3))) - (call-with-values - (lambda () - (let ((s_5 - (car - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 + (syntax-e$1 + s_3) + s_3))) + (call-with-values + (lambda () + (let ((s_5 + (car + s_4))) + (let ((s_6 + (if (syntax?$1 s_5) - s_5))) - (values)))) - (case-lambda - (() - (let ((_0 - (let ((s_5 - (cdr - s_4))) + (syntax-e$1 + s_5) s_5))) + (values)))) + (case-lambda + (() + (let ((_0 + (let ((s_5 + (cdr + s_4))) + s_5))) + (let () (values - _0))) - (args - (raise-binding-result-arity-error - 0 - args)))))))) - (let ((name617_1 - name617_0)) - (values - name617_1 - _0))))))) - (case-lambda - ((name615_0 _0) - (let ((module*614_1 - module*614_0)) - (values - module*614_1 - name615_0 - _0))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((module*611_0 name612_0 _0) - (values - #t - module*611_0 - name612_0 - _0)) - (args - (raise-binding-result-arity-error - 3 - args)))) - (values #f #f #f #f))) - (case-lambda - ((ok?_0 module*611_0 name612_0 _0) - (let ((submod_0 - (if ok?_0 - (let ((neg-phase_0 - (phase- 0 phase_0))) - (let ((shifted-s_0 - (syntax-shift-phase-level$1 - ready-body_0 - neg-phase_0))) - (let ((submod_0 - (expand-submodule.1 - compiled-submodules134_0 - declared-submodule-names133_0 - enclosing-is-cross-phase-persistent?130_0 - requires-and-provides129_0 - #t - neg-phase_0 - modules-being-compiled135_0 - mpis-to-reset132_0 - shifted-s_0 - self128_0 - ctx136_0))) - (if (parsed? submod_0) - submod_0 + _0)))) + (args + (raise-binding-result-arity-error + 0 + args)))))))) + (let ((name617_1 + name617_0)) + (values + name617_1 + _0))))))) + (case-lambda + ((name615_0 _0) + (let ((module*614_1 + module*614_0)) + (values + module*614_1 + name615_0 + _0))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((module*611_0 name612_0 _0) + (values + #t + module*611_0 + name612_0 + _0)) + (args + (raise-binding-result-arity-error + 3 + args)))) + (values #f #f #f #f))) + (case-lambda + ((ok?_0 module*611_0 name612_0 _0) + (let ((submod_0 + (if ok?_0 + (let ((neg-phase_0 + (phase- 0 phase_0))) + (let ((shifted-s_0 + (syntax-shift-phase-level$1 + ready-body_0 + neg-phase_0))) + (let ((submod_0 + (expand-submodule.1 + compiled-submodules134_0 + declared-submodule-names133_0 + enclosing-is-cross-phase-persistent?130_0 + requires-and-provides129_0 + #t + neg-phase_0 + modules-being-compiled135_0 + mpis-to-reset132_0 + shifted-s_0 + self128_0 + ctx136_0))) + (if (parsed? submod_0) + submod_0 + (if (expanded+parsed? + submod_0) (if (expanded+parsed? submod_0) - (if (expanded+parsed? - submod_0) - (let ((s631_0 - (syntax-shift-phase-level$1 - (expanded+parsed-s - submod_0) - phase_0))) - (expanded+parsed1.1 - s631_0 - (expanded+parsed-parsed - submod_0))) - (raise-argument-error - 'struct-copy - "expanded+parsed?" - submod_0)) - (syntax-shift-phase-level$1 - submod_0 - phase_0)))))) - (expand-submodule.1 - compiled-submodules134_0 - declared-submodule-names133_0 - #f - #f - #t - #f - modules-being-compiled135_0 - mpis-to-reset132_0 - ready-body_0 - self128_0 - ctx136_0)))) - (cons - submod_0 - (loop_0 - compiled-submodules134_0 - ctx136_0 - declare-enclosing126_0 - declared-submodule-names133_0 - enclosing-is-cross-phase-persistent?130_0 - modules-being-compiled135_0 - mpis-to-reset132_0 - requires-and-provides129_0 - self128_0 - rest-bodys_0 - phase_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx136_0))))) - (if obs_0 - (call-expand-observe obs_0 'next) - (void))) - (cons - body_0 - (loop_0 - compiled-submodules134_0 - ctx136_0 - declare-enclosing126_0 - declared-submodule-names133_0 - enclosing-is-cross-phase-persistent?130_0 - modules-being-compiled135_0 - mpis-to-reset132_0 - requires-and-provides129_0 - self128_0 - rest-bodys_0 - phase_0)))))))))))))))) - (|#%name| - expand-post-submodules - (lambda (all-scopes-s131_0 - compiled-submodules134_0 - ctx136_0 - declare-enclosing126_0 - declared-submodule-names133_0 - enclosing-is-cross-phase-persistent?130_0 - modules-being-compiled135_0 - mpis-to-reset132_0 - phase127_0 - requires-and-provides129_0 - self128_0 - fully-expanded-bodys-except-post-submodules148_0) - (begin - (loop_0 - compiled-submodules134_0 - ctx136_0 - declare-enclosing126_0 - declared-submodule-names133_0 - enclosing-is-cross-phase-persistent?130_0 - modules-being-compiled135_0 - mpis-to-reset132_0 - requires-and-provides129_0 - self128_0 - fully-expanded-bodys-except-post-submodules148_0 - phase127_0)))))) + (let ((s631_0 + (syntax-shift-phase-level$1 + (expanded+parsed-s + submod_0) + phase_0))) + (expanded+parsed1.1 + s631_0 + (expanded+parsed-parsed + submod_0))) + (raise-argument-error + 'struct-copy + "expanded+parsed?" + submod_0)) + (syntax-shift-phase-level$1 + submod_0 + phase_0)))))) + (expand-submodule.1 + compiled-submodules134_0 + declared-submodule-names133_0 + #f + #f + #t + #f + modules-being-compiled135_0 + mpis-to-reset132_0 + ready-body_0 + self128_0 + ctx136_0)))) + (cons + submod_0 + (loop_0 rest-bodys_0 phase_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx136_0))))) + (if obs_0 + (call-expand-observe obs_0 'next) + (void))) + (cons + body_0 + (loop_0 rest-bodys_0 phase_0)))))))))))))))) + (loop_0 + fully-expanded-bodys-except-post-submodules148_0 + phase127_0)))))) (define stop-at-module*? (lambda (ctx_0) (let ((app_0 @@ -95686,378 +94597,367 @@ (args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 4 args)))))))))) (void))) -(define effect_2651 +(define effect_2635 (begin (void (add-core-form!* 'begin-for-syntax - (letrec ((loop_0 - (|#%name| - loop - (lambda (capture-ctx_0 - ctx_0 - form30_0 - lift-ctx_0 - trans-ctx_0 - forms_0) - (begin - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx_0))))) - (if obs_0 - (call-expand-observe obs_0 'enter-list form30_0) - (void))) - (let ((exp-forms_0 + (lambda (s_0 ctx_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx_0))))) + (if obs_0 + (call-expand-observe obs_0 'prim-begin-for-syntax #f) + (void))) + (begin + (if (eq? + (begin-unsafe (expand-context/outer-context ctx_0)) + 'top-level) + (void) + (raise-syntax-error$1 #f "not in a definition context" s_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_1 (if (syntax?$1 s_0) (syntax-e$1 s_0) s_0))) + (if (pair? s_1) + (let ((begin-for-syntax31_0 (let ((s_2 (car s_1))) s_2))) + (let ((form32_0 + (let ((s_2 (cdr s_1))) + (let ((s_3 + (if (syntax?$1 s_2) + (syntax-e$1 s_2) + s_2))) + (let ((flat-s_0 (to-syntax-list.1 s_3))) + (if (not flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + s_0) + flat-s_0)))))) + (let ((begin-for-syntax31_1 begin-for-syntax31_0)) + (values begin-for-syntax31_1 form32_0)))) + (raise-syntax-error$1 #f "bad syntax" s_0)))) + (case-lambda + ((begin-for-syntax29_0 form30_0) + (values #t begin-for-syntax29_0 form30_0)) + (args (raise-binding-result-arity-error 2 args))))) + (case-lambda + ((ok?_0 begin-for-syntax29_0 form30_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx_0))))) + (if obs_0 (call-expand-observe obs_0 'prepare-env) (void))) + (let ((trans-ctx_0 + (context->transformer-context.1 #t ctx_0 'top-level))) + (let ((lift-ctx_0 + (let ((temp36_0 (make-top-level-lift trans-ctx_0))) + (make-lift-context.1 #f temp36_0)))) + (let ((capture-ctx_0 + (if (expand-context/outer? trans-ctx_0) + (let ((inner37_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + trans-ctx_0))) + (if (expand-context/inner? the-struct_0) + (let ((lift-key38_0 + (generate-lift-key))) + (let ((app_0 + (root-expand-context/inner-self-mpi + the-struct_0))) + (let ((app_1 + (root-expand-context/inner-module-scopes + the-struct_0))) + (let ((app_2 + (root-expand-context/inner-top-level-bind-scope + the-struct_0))) + (let ((app_3 + (root-expand-context/inner-all-scopes-stx + the-struct_0))) + (let ((app_4 + (root-expand-context/inner-defined-syms + the-struct_0))) + (let ((app_5 + (root-expand-context/inner-counter + the-struct_0))) + (let ((app_6 + (expand-context/inner-to-parsed? + the-struct_0))) + (let ((app_7 + (expand-context/inner-phase + the-struct_0))) + (let ((app_8 + (expand-context/inner-namespace + the-struct_0))) + (let ((app_9 + (expand-context/inner-just-once? + the-struct_0))) + (let ((app_10 + (expand-context/inner-module-begin-k + the-struct_0))) + (let ((app_11 + (expand-context/inner-allow-unbound? + the-struct_0))) + (let ((app_12 + (expand-context/inner-in-local-expand? + the-struct_0))) + (let ((app_13 + (|expand-context/inner-keep-#%expression?| + the-struct_0))) + (let ((app_14 + (expand-context/inner-stops + the-struct_0))) + (let ((app_15 + (expand-context/inner-declared-submodule-names + the-struct_0))) + (let ((app_16 + (expand-context/inner-lift-envs + the-struct_0))) + (let ((app_17 + (expand-context/inner-module-lifts + the-struct_0))) + (let ((app_18 + (expand-context/inner-require-lifts + the-struct_0))) + (let ((app_19 + (expand-context/inner-to-module-lifts + the-struct_0))) + (let ((app_20 + (expand-context/inner-requires+provides + the-struct_0))) + (let ((app_21 + (expand-context/inner-observer + the-struct_0))) + (let ((app_22 + (expand-context/inner-for-serializable? + the-struct_0))) + (let ((app_23 + (expand-context/inner-to-correlated-linklet? + the-struct_0))) + (let ((app_24 + (expand-context/inner-normalize-locals? + the-struct_0))) + (let ((app_25 + (expand-context/inner-parsing-expanded? + the-struct_0))) + (expand-context/inner2.1 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + lift-key38_0 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + app_12 + app_13 + app_14 + app_15 + lift-ctx_0 + app_16 + app_17 + app_18 + app_19 + app_20 + app_21 + app_22 + app_23 + app_24 + app_25 + (expand-context/inner-skip-visit-available? + the-struct_0))))))))))))))))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((app_0 + (root-expand-context/outer-post-expansion + trans-ctx_0))) + (let ((app_1 + (root-expand-context/outer-use-site-scopes + trans-ctx_0))) + (let ((app_2 + (root-expand-context/outer-frame-id + trans-ctx_0))) + (let ((app_3 + (expand-context/outer-context + trans-ctx_0))) + (let ((app_4 + (expand-context/outer-env + trans-ctx_0))) + (let ((app_5 + (expand-context/outer-scopes + trans-ctx_0))) + (let ((app_6 + (expand-context/outer-def-ctx-scopes + trans-ctx_0))) + (let ((app_7 + (expand-context/outer-binding-layer + trans-ctx_0))) + (let ((app_8 + (expand-context/outer-reference-records + trans-ctx_0))) + (let ((app_9 + (expand-context/outer-only-immediate? + trans-ctx_0))) + (let ((app_10 + (expand-context/outer-need-eventually-defined + trans-ctx_0))) + (let ((app_11 + (expand-context/outer-current-introduction-scopes + trans-ctx_0))) + (let ((app_12 + (expand-context/outer-current-use-scopes + trans-ctx_0))) + (expand-context/outer1.1 + inner37_0 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + app_10 + app_11 + app_12 + (expand-context/outer-name + trans-ctx_0)))))))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + trans-ctx_0)))) + (let ((all-exp-forms_0 (letrec* - ((loop_1 + ((loop_0 (|#%name| loop - (lambda (forms_1 accum_0) + (lambda (forms_0) (begin - (if (null? forms_1) - (let ((forms_2 (reverse$1 accum_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-list - forms_2) - (void))) - forms_2)) - (begin - (let ((obs_0 + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'enter-list + form30_0) + (void))) + (let ((exp-forms_0 + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (forms_1 accum_0) + (begin + (if (null? forms_1) + (let ((forms_2 + (reverse$1 + accum_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-list + forms_2) + (void))) + forms_2)) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next) + (void))) + (let ((exp-form_0 + (let ((temp40_0 + (car + forms_1))) + (expand.1 + #f + #f + temp40_0 + capture-ctx_0)))) + (loop_1 + (cdr forms_1) + (cons + exp-form_0 + accum_0)))))))))) + (loop_1 forms_0 null)))) + (let ((lifts_0 (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe obs_0 'next) - (void))) - (let ((exp-form_0 - (let ((temp40_0 - (car forms_1))) - (expand.1 - #f - #f - temp40_0 - capture-ctx_0)))) - (loop_1 - (cdr forms_1) - (cons exp-form_0 accum_0)))))))))) - (loop_1 forms_0 null)))) - (let ((lifts_0 - (begin-unsafe - (box-clear! - (lift-context-lifts lift-ctx_0))))) - (if (null? lifts_0) - exp-forms_0 - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'module-lift-loop - lifts_0) - (void))) - (let ((beg_0 - (let ((temp44_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner - trans-ctx_0))))) - (wrap-lifts-as-begin.1 - unsafe-undefined - unsafe-undefined - lifts_0 - #f - temp44_0)))) - (let ((exprs_0 - (reverse$1 - (cdr - (reverse$1 - (cdr (syntax-e$1 beg_0))))))) - (append - (loop_0 - capture-ctx_0 - ctx_0 - form30_0 - lift-ctx_0 - trans-ctx_0 - exprs_0) - exp-forms_0))))))))))))) - (lambda (s_0 ctx_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx_0))))) - (if obs_0 - (call-expand-observe obs_0 'prim-begin-for-syntax #f) - (void))) - (begin - (if (eq? - (begin-unsafe (expand-context/outer-context ctx_0)) - 'top-level) - (void) - (raise-syntax-error$1 #f "not in a definition context" s_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_1 (if (syntax?$1 s_0) (syntax-e$1 s_0) s_0))) - (if (pair? s_1) - (let ((begin-for-syntax31_0 - (let ((s_2 (car s_1))) s_2))) - (let ((form32_0 - (let ((s_2 (cdr s_1))) - (let ((s_3 - (if (syntax?$1 s_2) - (syntax-e$1 s_2) - s_2))) - (let ((flat-s_0 (to-syntax-list.1 s_3))) - (if (not flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - s_0) - flat-s_0)))))) - (let ((begin-for-syntax31_1 begin-for-syntax31_0)) - (values begin-for-syntax31_1 form32_0)))) - (raise-syntax-error$1 #f "bad syntax" s_0)))) - (case-lambda - ((begin-for-syntax29_0 form30_0) - (values #t begin-for-syntax29_0 form30_0)) - (args (raise-binding-result-arity-error 2 args))))) - (case-lambda - ((ok?_0 begin-for-syntax29_0 form30_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx_0))))) - (if obs_0 - (call-expand-observe obs_0 'prepare-env) - (void))) - (let ((trans-ctx_0 - (context->transformer-context.1 - #t - ctx_0 - 'top-level))) - (let ((lift-ctx_0 - (let ((temp36_0 (make-top-level-lift trans-ctx_0))) - (make-lift-context.1 #f temp36_0)))) - (let ((capture-ctx_0 - (if (expand-context/outer? trans-ctx_0) - (let ((inner37_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - trans-ctx_0))) - (if (expand-context/inner? - the-struct_0) - (let ((lift-key38_0 - (generate-lift-key))) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_7 - (expand-context/inner-phase - the-struct_0))) - (let ((app_8 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_9 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_10 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_17 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_18 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_21 - (expand-context/inner-observer - the-struct_0))) - (let ((app_22 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_23 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_24 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_25 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - lift-key38_0 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - lift-ctx_0 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - trans-ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - trans-ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - trans-ctx_0))) - (let ((app_3 - (expand-context/outer-context - trans-ctx_0))) - (let ((app_4 - (expand-context/outer-env - trans-ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - trans-ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - trans-ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer - trans-ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - trans-ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - trans-ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - trans-ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - trans-ctx_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - trans-ctx_0))) - (expand-context/outer1.1 - inner37_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - trans-ctx_0)))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - trans-ctx_0)))) - (let ((all-exp-forms_0 - (loop_0 - capture-ctx_0 - ctx_0 - form30_0 - lift-ctx_0 - trans-ctx_0 - form30_0))) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner ctx_0))) - (parsed-begin-for-syntax21.1 s_0 all-exp-forms_0) - (let ((temp46_0 - (cons - begin-for-syntax29_0 - all-exp-forms_0))) - (rebuild.1 #t s_0 temp46_0))))))))) - (args (raise-binding-result-arity-error 3 args)))))))))) + (box-clear! + (lift-context-lifts + lift-ctx_0))))) + (if (null? lifts_0) + exp-forms_0 + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'module-lift-loop + lifts_0) + (void))) + (let ((beg_0 + (let ((temp44_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner + trans-ctx_0))))) + (wrap-lifts-as-begin.1 + unsafe-undefined + unsafe-undefined + lifts_0 + #f + temp44_0)))) + (let ((exprs_0 + (reverse$1 + (cdr + (reverse$1 + (cdr + (syntax-e$1 + beg_0))))))) + (append + (loop_0 exprs_0) + exp-forms_0))))))))))))) + (loop_0 form30_0)))) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner ctx_0))) + (parsed-begin-for-syntax21.1 s_0 all-exp-forms_0) + (let ((temp46_0 + (cons begin-for-syntax29_0 all-exp-forms_0))) + (rebuild.1 #t s_0 temp46_0))))))))) + (args (raise-binding-result-arity-error 3 args))))))))) (void))) (define effect_2818 (begin diff --git a/racket/src/cs/schemified/io.scm b/racket/src/cs/schemified/io.scm index 5aa6033b58..f125d4b668 100644 --- a/racket/src/cs/schemified/io.scm +++ b/racket/src/cs/schemified/io.scm @@ -636,286 +636,31 @@ (define-values (sort vector-sort vector-sort!) (let ((generic-sort_0 - (letrec ((copying-mergesort_0 - (|#%name| - copying-mergesort - (lambda (A_0 less-than?_0 Alo_0 Blo_0 n_0) - (begin - (if (unsafe-fx= n_0 1) - (unsafe-vector-set! - A_0 - Blo_0 - (unsafe-vector-ref A_0 Alo_0)) - (if (unsafe-fx= n_0 2) - (let ((x_0 (unsafe-vector-ref A_0 Alo_0))) - (let ((y_0 - (unsafe-vector-ref - A_0 - (unsafe-fx+ Alo_0 1)))) - (let ((x_1 x_0)) - (if (|#%app| less-than?_0 y_0 x_1) - (begin - (unsafe-vector-set! A_0 Blo_0 y_0) - (unsafe-vector-set! - A_0 - (unsafe-fx+ Blo_0 1) - x_1)) - (begin - (unsafe-vector-set! A_0 Blo_0 x_1) - (unsafe-vector-set! - A_0 - (unsafe-fx+ Blo_0 1) - y_0)))))) - (if (unsafe-fx< n_0 16) - (begin - (unsafe-vector-set! - A_0 - Blo_0 - (unsafe-vector-ref A_0 Alo_0)) - (letrec* - ((iloop_0 - (|#%name| - iloop - (lambda (i_0) - (begin - (if (unsafe-fx< i_0 n_0) - (let ((ref-i_0 - (unsafe-vector-ref - A_0 - (unsafe-fx+ Alo_0 i_0)))) - (letrec* - ((jloop_0 - (|#%name| - jloop - (lambda (j_0) - (begin - (let ((ref-j-1_0 - (unsafe-vector-ref - A_0 - (unsafe-fx- - j_0 - 1)))) - (if (if (unsafe-fx< - Blo_0 - j_0) - (|#%app| - less-than?_0 - ref-i_0 - ref-j-1_0) - #f) - (begin - (unsafe-vector-set! - A_0 - j_0 - ref-j-1_0) - (jloop_0 - (unsafe-fx- j_0 1))) - (begin - (unsafe-vector-set! - A_0 - j_0 - ref-i_0) - (iloop_0 - (unsafe-fx+ - i_0 - 1)))))))))) - (jloop_0 (unsafe-fx+ Blo_0 i_0)))) - (void))))))) - (iloop_0 1))) - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_0))) - (let ((Amid2_0 (unsafe-fx+ Alo_0 n/2+_0))) - (let ((Bmid1_0 (unsafe-fx+ Blo_0 n/2-_0))) - (begin - (copying-mergesort_0 - A_0 - less-than?_0 - Amid1_0 - Bmid1_0 - n/2+_0) - (copying-mergesort_0 - A_0 - less-than?_0 - Alo_0 - Amid2_0 - n/2-_0) - (let ((b2_0 (unsafe-fx+ Blo_0 n_0))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (a1_0 b1_0 c1_0) - (begin - (let ((x_0 - (unsafe-vector-ref - A_0 - a1_0))) - (let ((y_0 - (unsafe-vector-ref - A_0 - b1_0))) - (let ((x_1 x_0)) - (if (not - (|#%app| - less-than?_0 - y_0 - x_1)) - (begin - (unsafe-vector-set! - A_0 - c1_0 - x_1) - (let ((a1_1 - (unsafe-fx+ - a1_0 - 1))) - (let ((c1_1 - (unsafe-fx+ - c1_0 - 1))) - (if (unsafe-fx< - c1_1 - b1_0) - (loop_0 - a1_1 - b1_0 - c1_1) - (void))))) - (begin - (unsafe-vector-set! - A_0 - c1_0 - y_0) - (let ((b1_1 - (unsafe-fx+ - b1_0 - 1))) - (let ((c1_1 - (unsafe-fx+ - c1_0 - 1))) - (if (unsafe-fx<= - b2_0 - b1_1) - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (a1_1 - c1_2) - (begin - (if (unsafe-fx< - c1_2 - b1_1) - (begin - (unsafe-vector-set! - A_0 - c1_2 - (unsafe-vector-ref - A_0 - a1_1)) - (loop_1 - (unsafe-fx+ - a1_1 - 1) - (unsafe-fx+ - c1_2 - 1))) - (void))))))) - (loop_1 - a1_0 - c1_1)) - (loop_0 - a1_0 - b1_1 - c1_1)))))))))))))) - (loop_0 - Amid2_0 - Bmid1_0 - Blo_0))))))))))))))))) - (|#%name| - generic-sort - (lambda (A_0 less-than?_0 n_0) - (begin - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (begin - (copying-mergesort_0 A_0 less-than?_0 n/2-_0 n_0 n/2+_0) - (if (zero? n/2-_0) - (void) - (copying-mergesort_0 A_0 less-than?_0 0 n/2+_0 n/2-_0)) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (a1_0 b1_0 c1_0) - (begin - (let ((x_0 (unsafe-vector-ref A_0 a1_0))) - (let ((y_0 (unsafe-vector-ref A_0 b1_0))) - (let ((x_1 x_0)) - (if (|#%app| less-than?_0 x_1 y_0) - (begin - (unsafe-vector-set! A_0 c1_0 x_1) - (let ((a1_1 (unsafe-fx+ a1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx< c1_1 b1_0) - (loop_0 a1_1 b1_0 c1_1) - (void))))) - (begin - (unsafe-vector-set! A_0 c1_0 y_0) - (let ((b1_1 (unsafe-fx+ b1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx<= n_0 b1_1) - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (a1_1 c1_2) - (begin - (if (unsafe-fx< c1_2 b1_1) - (begin - (unsafe-vector-set! - A_0 - c1_2 - (unsafe-vector-ref - A_0 - a1_1)) - (loop_1 - (unsafe-fx+ a1_1 1) - (unsafe-fx+ c1_2 1))) - (void))))))) - (loop_1 a1_0 c1_1)) - (loop_0 - a1_0 - b1_1 - c1_1)))))))))))))) - (loop_0 n_0 n/2+_0 0))))))))))) - (let ((generic-sort/key_0 - (letrec ((copying-mergesort_0 + (|#%name| + generic-sort + (lambda (A_0 less-than?_0 n_0) + (begin + (let ((n/2-_0 (unsafe-fxrshift n_0 1))) + (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) + (letrec* + ((copying-mergesort_0 (|#%name| copying-mergesort - (lambda (A_0 key_0 less-than?_0 Alo_0 Blo_0 n_0) + (lambda (Alo_0 Blo_0 n_1) (begin - (if (unsafe-fx= n_0 1) + (if (unsafe-fx= n_1 1) (unsafe-vector-set! A_0 Blo_0 (unsafe-vector-ref A_0 Alo_0)) - (if (unsafe-fx= n_0 2) + (if (unsafe-fx= n_1 2) (let ((x_0 (unsafe-vector-ref A_0 Alo_0))) (let ((y_0 (unsafe-vector-ref A_0 (unsafe-fx+ Alo_0 1)))) (let ((x_1 x_0)) - (if (if key_0 - (let ((app_0 (|#%app| key_0 y_0))) - (|#%app| - less-than?_0 - app_0 - (|#%app| key_0 x_1))) - (|#%app| less-than?_0 y_0 x_1)) + (if (|#%app| less-than?_0 y_0 x_1) (begin (unsafe-vector-set! A_0 Blo_0 y_0) (unsafe-vector-set! @@ -928,7 +673,7 @@ A_0 (unsafe-fx+ Blo_0 1) y_0)))))) - (if (unsafe-fx< n_0 16) + (if (unsafe-fx< n_1 16) (begin (unsafe-vector-set! A_0 @@ -940,7 +685,7 @@ iloop (lambda (i_0) (begin - (if (unsafe-fx< i_0 n_0) + (if (unsafe-fx< i_0 n_1) (let ((ref-i_0 (unsafe-vector-ref A_0 @@ -960,21 +705,10 @@ (if (if (unsafe-fx< Blo_0 j_0) - (if key_0 - (let ((app_0 - (|#%app| - key_0 - ref-i_0))) - (|#%app| - less-than?_0 - app_0 - (|#%app| - key_0 - ref-j-1_0))) - (|#%app| - less-than?_0 - ref-i_0 - ref-j-1_0)) + (|#%app| + less-than?_0 + ref-i_0 + ref-j-1_0) #f) (begin (unsafe-vector-set! @@ -998,28 +732,22 @@ (unsafe-fx+ Blo_0 i_0)))) (void))))))) (iloop_0 1))) - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_0))) - (let ((Amid2_0 (unsafe-fx+ Alo_0 n/2+_0))) + (let ((n/2-_1 (unsafe-fxrshift n_1 1))) + (let ((n/2+_1 (unsafe-fx- n_1 n/2-_1))) + (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_1))) + (let ((Amid2_0 (unsafe-fx+ Alo_0 n/2+_1))) (let ((Bmid1_0 - (unsafe-fx+ Blo_0 n/2-_0))) + (unsafe-fx+ Blo_0 n/2-_1))) (begin (copying-mergesort_0 - A_0 - key_0 - less-than?_0 Amid1_0 Bmid1_0 - n/2+_0) + n/2+_1) (copying-mergesort_0 - A_0 - key_0 - less-than?_0 Alo_0 Amid2_0 - n/2-_0) - (let ((b2_0 (unsafe-fx+ Blo_0 n_0))) + n/2-_1) + (let ((b2_0 (unsafe-fx+ Blo_0 n_1))) (letrec* ((loop_0 (|#%name| @@ -1036,21 +764,10 @@ b1_0))) (let ((x_1 x_0)) (if (not - (if key_0 - (let ((app_0 - (|#%app| - key_0 - y_0))) - (|#%app| - less-than?_0 - app_0 - (|#%app| - key_0 - x_1))) - (|#%app| - less-than?_0 - y_0 - x_1))) + (|#%app| + less-than?_0 + y_0 + x_1)) (begin (unsafe-vector-set! A_0 @@ -1124,274 +841,530 @@ Amid2_0 Bmid1_0 Blo_0))))))))))))))))) - (|#%name| - generic-sort/key - (lambda (A_0 less-than?_0 n_0 key_0) - (begin - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (begin - (copying-mergesort_0 - A_0 - key_0 - less-than?_0 - n/2-_0 - n_0 - n/2+_0) - (if (zero? n/2-_0) - (void) - (copying-mergesort_0 - A_0 - key_0 - less-than?_0 - 0 - n/2+_0 - n/2-_0)) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (a1_0 b1_0 c1_0) - (begin - (let ((x_0 (unsafe-vector-ref A_0 a1_0))) - (let ((y_0 (unsafe-vector-ref A_0 b1_0))) + (begin + (copying-mergesort_0 n/2-_0 n_0 n/2+_0) + (if (zero? n/2-_0) + (void) + (copying-mergesort_0 0 n/2+_0 n/2-_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (a1_0 b1_0 c1_0) + (begin + (let ((x_0 (unsafe-vector-ref A_0 a1_0))) + (let ((y_0 (unsafe-vector-ref A_0 b1_0))) + (let ((x_1 x_0)) + (if (|#%app| less-than?_0 x_1 y_0) + (begin + (unsafe-vector-set! A_0 c1_0 x_1) + (let ((a1_1 (unsafe-fx+ a1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx< c1_1 b1_0) + (loop_0 a1_1 b1_0 c1_1) + (void))))) + (begin + (unsafe-vector-set! A_0 c1_0 y_0) + (let ((b1_1 (unsafe-fx+ b1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx<= n_0 b1_1) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (a1_1 c1_2) + (begin + (if (unsafe-fx< c1_2 b1_1) + (begin + (unsafe-vector-set! + A_0 + c1_2 + (unsafe-vector-ref + A_0 + a1_1)) + (loop_1 + (unsafe-fx+ a1_1 1) + (unsafe-fx+ c1_2 1))) + (void))))))) + (loop_1 a1_0 c1_1)) + (loop_0 + a1_0 + b1_1 + c1_1)))))))))))))) + (loop_0 n_0 n/2+_0 0))))))))))) + (let ((generic-sort/key_0 + (|#%name| + generic-sort/key + (lambda (A_0 less-than?_0 n_0 key_0) + (begin + (let ((n/2-_0 (unsafe-fxrshift n_0 1))) + (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) + (letrec* + ((copying-mergesort_0 + (|#%name| + copying-mergesort + (lambda (Alo_0 Blo_0 n_1) + (begin + (if (unsafe-fx= n_1 1) + (unsafe-vector-set! + A_0 + Blo_0 + (unsafe-vector-ref A_0 Alo_0)) + (if (unsafe-fx= n_1 2) + (let ((x_0 (unsafe-vector-ref A_0 Alo_0))) + (let ((y_0 + (unsafe-vector-ref + A_0 + (unsafe-fx+ Alo_0 1)))) (let ((x_1 x_0)) (if (if key_0 - (let ((app_0 (|#%app| key_0 x_1))) + (let ((app_0 (|#%app| key_0 y_0))) (|#%app| less-than?_0 app_0 - (|#%app| key_0 y_0))) - (|#%app| less-than?_0 x_1 y_0)) + (|#%app| key_0 x_1))) + (|#%app| less-than?_0 y_0 x_1)) (begin - (unsafe-vector-set! A_0 c1_0 x_1) - (let ((a1_1 (unsafe-fx+ a1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx< c1_1 b1_0) - (loop_0 a1_1 b1_0 c1_1) - (void))))) + (unsafe-vector-set! A_0 Blo_0 y_0) + (unsafe-vector-set! + A_0 + (unsafe-fx+ Blo_0 1) + x_1)) (begin - (unsafe-vector-set! A_0 c1_0 y_0) - (let ((b1_1 (unsafe-fx+ b1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx<= n_0 b1_1) + (unsafe-vector-set! A_0 Blo_0 x_1) + (unsafe-vector-set! + A_0 + (unsafe-fx+ Blo_0 1) + y_0)))))) + (if (unsafe-fx< n_1 16) + (begin + (unsafe-vector-set! + A_0 + Blo_0 + (unsafe-vector-ref A_0 Alo_0)) + (letrec* + ((iloop_0 + (|#%name| + iloop + (lambda (i_0) + (begin + (if (unsafe-fx< i_0 n_1) + (let ((ref-i_0 + (unsafe-vector-ref + A_0 + (unsafe-fx+ Alo_0 i_0)))) (letrec* - ((loop_1 + ((jloop_0 + (|#%name| + jloop + (lambda (j_0) + (begin + (let ((ref-j-1_0 + (unsafe-vector-ref + A_0 + (unsafe-fx- + j_0 + 1)))) + (if (if (unsafe-fx< + Blo_0 + j_0) + (if key_0 + (let ((app_0 + (|#%app| + key_0 + ref-i_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| + key_0 + ref-j-1_0))) + (|#%app| + less-than?_0 + ref-i_0 + ref-j-1_0)) + #f) + (begin + (unsafe-vector-set! + A_0 + j_0 + ref-j-1_0) + (jloop_0 + (unsafe-fx- + j_0 + 1))) + (begin + (unsafe-vector-set! + A_0 + j_0 + ref-i_0) + (iloop_0 + (unsafe-fx+ + i_0 + 1)))))))))) + (jloop_0 + (unsafe-fx+ Blo_0 i_0)))) + (void))))))) + (iloop_0 1))) + (let ((n/2-_1 (unsafe-fxrshift n_1 1))) + (let ((n/2+_1 (unsafe-fx- n_1 n/2-_1))) + (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_1))) + (let ((Amid2_0 + (unsafe-fx+ Alo_0 n/2+_1))) + (let ((Bmid1_0 + (unsafe-fx+ Blo_0 n/2-_1))) + (begin + (copying-mergesort_0 + Amid1_0 + Bmid1_0 + n/2+_1) + (copying-mergesort_0 + Alo_0 + Amid2_0 + n/2-_1) + (let ((b2_0 + (unsafe-fx+ Blo_0 n_1))) + (letrec* + ((loop_0 (|#%name| loop - (lambda (a1_1 c1_2) + (lambda (a1_0 b1_0 c1_0) (begin - (if (unsafe-fx< - c1_2 - b1_1) - (begin - (unsafe-vector-set! - A_0 - c1_2 - (unsafe-vector-ref - A_0 - a1_1)) - (loop_1 - (unsafe-fx+ a1_1 1) - (unsafe-fx+ - c1_2 - 1))) - (void))))))) - (loop_1 a1_0 c1_1)) - (loop_0 - a1_0 - b1_1 - c1_1)))))))))))))) - (loop_0 n_0 n/2+_0 0))))))))))) - (values - (letrec ((loop_0 - (|#%name| - loop - (lambda (getkey_0 less-than?_0 last_0 next_0) - (begin - (let ((or-part_0 (null? next_0))) - (if or-part_0 - or-part_0 - (if (not - (if getkey_0 - (let ((app_0 - (|#%app| getkey_0 (unsafe-car next_0)))) - (|#%app| - less-than?_0 - app_0 - (|#%app| getkey_0 last_0))) - (|#%app| - less-than?_0 - (unsafe-car next_0) - last_0))) - (loop_0 - getkey_0 - less-than?_0 - (unsafe-car next_0) - (unsafe-cdr next_0)) - #f))))))) - (loop_1 - (|#%name| - loop - (lambda (less-than?_0 last_0 next_0) - (begin - (let ((or-part_0 (null? next_0))) - (if or-part_0 - or-part_0 - (if (not - (|#%app| - less-than?_0 - (unsafe-car next_0) - last_0)) - (loop_1 - less-than?_0 - (unsafe-car next_0) - (unsafe-cdr next_0)) - #f)))))))) - (case-lambda - ((lst_0 less-than?_0) - (let ((n_0 (length lst_0))) - (if (unsafe-fx= n_0 0) - lst_0 - (if (let ((app_0 (car lst_0))) - (loop_1 less-than?_0 app_0 (cdr lst_0))) - lst_0 - (if (unsafe-fx<= n_0 3) - (if (unsafe-fx= n_0 1) - lst_0 - (if (unsafe-fx= n_0 2) - (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) - (let ((a_0 (car lst_0))) - (let ((b_0 (cadr lst_0))) - (let ((c_0 (caddr lst_0))) - (let ((b_1 b_0) (a_1 a_0)) - (if (|#%app| less-than?_0 b_1 a_1) - (if (|#%app| less-than?_0 c_0 b_1) - (list c_0 b_1 a_1) - (if (|#%app| less-than?_0 c_0 a_1) - (list b_1 c_0 a_1) - (list b_1 a_1 c_0))) - (if (|#%app| less-than?_0 c_0 a_1) - (list c_0 a_1 b_1) - (list a_1 c_0 b_1))))))))) - (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (let ((x_0 + (unsafe-vector-ref + A_0 + a1_0))) + (let ((y_0 + (unsafe-vector-ref + A_0 + b1_0))) + (let ((x_1 x_0)) + (if (not + (if key_0 + (let ((app_0 + (|#%app| + key_0 + y_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| + key_0 + x_1))) + (|#%app| + less-than?_0 + y_0 + x_1))) + (begin + (unsafe-vector-set! + A_0 + c1_0 + x_1) + (let ((a1_1 + (unsafe-fx+ + a1_0 + 1))) + (let ((c1_1 + (unsafe-fx+ + c1_0 + 1))) + (if (unsafe-fx< + c1_1 + b1_0) + (loop_0 + a1_1 + b1_0 + c1_1) + (void))))) + (begin + (unsafe-vector-set! + A_0 + c1_0 + y_0) + (let ((b1_1 + (unsafe-fx+ + b1_0 + 1))) + (let ((c1_1 + (unsafe-fx+ + c1_0 + 1))) + (if (unsafe-fx<= + b2_0 + b1_1) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (a1_1 + c1_2) + (begin + (if (unsafe-fx< + c1_2 + b1_1) + (begin + (unsafe-vector-set! + A_0 + c1_2 + (unsafe-vector-ref + A_0 + a1_1)) + (loop_1 + (unsafe-fx+ + a1_1 + 1) + (unsafe-fx+ + c1_2 + 1))) + (void))))))) + (loop_1 + a1_0 + c1_1)) + (loop_0 + a1_0 + b1_1 + c1_1)))))))))))))) + (loop_0 + Amid2_0 + Bmid1_0 + Blo_0))))))))))))))))) (begin + (copying-mergesort_0 n/2-_0 n_0 n/2+_0) + (if (zero? n/2-_0) + (void) + (copying-mergesort_0 0 n/2+_0 n/2-_0)) (letrec* - ((loop_2 + ((loop_0 (|#%name| loop - (lambda (i_0 lst_1) + (lambda (a1_0 b1_0 c1_0) (begin - (if (pair? lst_1) - (begin - (vector-set! vec_0 i_0 (car lst_1)) - (let ((app_0 (add1 i_0))) - (loop_2 app_0 (cdr lst_1)))) - (void))))))) - (loop_2 0 lst_0)) - (generic-sort_0 vec_0 less-than?_0 n_0) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 r_0) - (begin - (let ((i_1 (sub1 i_0))) - (if (< i_1 0) - r_0 - (loop_2 - i_1 - (cons (vector-ref vec_0 i_1) r_0))))))))) - (loop_2 n_0 '()))))))))) - ((lst_0 less-than?_0 getkey_0) - (if (if getkey_0 (not (eq? values getkey_0)) #f) - (|#%app| - (check-not-unsafe-undefined sort 'sort) - lst_0 - less-than?_0 - getkey_0 - #f) - (|#%app| - (check-not-unsafe-undefined sort 'sort) - lst_0 - less-than?_0))) - ((lst_0 less-than?_0 getkey_0 cache-keys?_0) - (if (if getkey_0 (not (eq? values getkey_0)) #f) - (let ((n_0 (length lst_0))) - (if (unsafe-fx= n_0 0) - lst_0 - (if cache-keys?_0 - (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) - (begin - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 lst_1) - (begin - (if (pair? lst_1) - (let ((x_0 (car lst_1))) - (begin - (unsafe-vector-set! - vec_0 - i_0 - (cons (|#%app| getkey_0 x_0) x_0)) - (loop_2 (unsafe-fx+ i_0 1) (cdr lst_1)))) - (void))))))) - (loop_2 0 lst_0)) - (generic-sort/key_0 vec_0 less-than?_0 n_0 unsafe-car) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 r_0) - (begin - (let ((i_1 (unsafe-fx- i_0 1))) - (if (unsafe-fx< i_1 0) - r_0 - (loop_2 - i_1 - (cons - (unsafe-cdr (unsafe-vector-ref vec_0 i_1)) - r_0))))))))) - (loop_2 n_0 '())))) - (if (let ((app_0 (car lst_0))) - (loop_0 getkey_0 less-than?_0 app_0 (cdr lst_0))) - lst_0 - (if (unsafe-fx<= n_0 3) - (if (unsafe-fx= n_0 1) - lst_0 - (if (unsafe-fx= n_0 2) - (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) - (let ((a_0 (car lst_0))) - (let ((b_0 (cadr lst_0))) - (let ((c_0 (caddr lst_0))) - (let ((b_1 b_0) (a_1 a_0)) - (if (if getkey_0 - (let ((app_0 (|#%app| getkey_0 b_1))) - (|#%app| - less-than?_0 - app_0 - (|#%app| getkey_0 a_1))) - (|#%app| less-than?_0 b_1 a_1)) - (if (if getkey_0 - (let ((app_0 (|#%app| getkey_0 c_0))) + (let ((x_0 (unsafe-vector-ref A_0 a1_0))) + (let ((y_0 (unsafe-vector-ref A_0 b1_0))) + (let ((x_1 x_0)) + (if (if key_0 + (let ((app_0 (|#%app| key_0 x_1))) (|#%app| less-than?_0 app_0 - (|#%app| getkey_0 b_1))) - (|#%app| less-than?_0 c_0 b_1)) - (list c_0 b_1 a_1) - (if (if getkey_0 - (let ((app_0 - (|#%app| getkey_0 c_0))) + (|#%app| key_0 y_0))) + (|#%app| less-than?_0 x_1 y_0)) + (begin + (unsafe-vector-set! A_0 c1_0 x_1) + (let ((a1_1 (unsafe-fx+ a1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx< c1_1 b1_0) + (loop_0 a1_1 b1_0 c1_1) + (void))))) + (begin + (unsafe-vector-set! A_0 c1_0 y_0) + (let ((b1_1 (unsafe-fx+ b1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx<= n_0 b1_1) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (a1_1 c1_2) + (begin + (if (unsafe-fx< + c1_2 + b1_1) + (begin + (unsafe-vector-set! + A_0 + c1_2 + (unsafe-vector-ref + A_0 + a1_1)) + (loop_1 + (unsafe-fx+ a1_1 1) + (unsafe-fx+ + c1_2 + 1))) + (void))))))) + (loop_1 a1_0 c1_1)) + (loop_0 + a1_0 + b1_1 + c1_1)))))))))))))) + (loop_0 n_0 n/2+_0 0))))))))))) + (values + (case-lambda + ((lst_0 less-than?_0) + (let ((n_0 (length lst_0))) + (if (unsafe-fx= n_0 0) + lst_0 + (if (letrec* + ((loop_0 + (|#%name| + loop + (lambda (last_0 next_0) + (begin + (let ((or-part_0 (null? next_0))) + (if or-part_0 + or-part_0 + (if (not + (|#%app| + less-than?_0 + (unsafe-car next_0) + last_0)) + (loop_0 (unsafe-car next_0) (unsafe-cdr next_0)) + #f)))))))) + (let ((app_0 (car lst_0))) (loop_0 app_0 (cdr lst_0)))) + lst_0 + (if (unsafe-fx<= n_0 3) + (if (unsafe-fx= n_0 1) + lst_0 + (if (unsafe-fx= n_0 2) + (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) + (let ((a_0 (car lst_0))) + (let ((b_0 (cadr lst_0))) + (let ((c_0 (caddr lst_0))) + (let ((b_1 b_0) (a_1 a_0)) + (if (|#%app| less-than?_0 b_1 a_1) + (if (|#%app| less-than?_0 c_0 b_1) + (list c_0 b_1 a_1) + (if (|#%app| less-than?_0 c_0 a_1) + (list b_1 c_0 a_1) + (list b_1 a_1 c_0))) + (if (|#%app| less-than?_0 c_0 a_1) + (list c_0 a_1 b_1) + (list a_1 c_0 b_1))))))))) + (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 lst_1) + (begin + (if (pair? lst_1) + (begin + (vector-set! vec_0 i_0 (car lst_1)) + (let ((app_0 (add1 i_0))) + (loop_0 app_0 (cdr lst_1)))) + (void))))))) + (loop_0 0 lst_0)) + (generic-sort_0 vec_0 less-than?_0 n_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 r_0) + (begin + (let ((i_1 (sub1 i_0))) + (if (< i_1 0) + r_0 + (loop_0 + i_1 + (cons (vector-ref vec_0 i_1) r_0))))))))) + (loop_0 n_0 '()))))))))) + ((lst_0 less-than?_0 getkey_0) + (if (if getkey_0 (not (eq? values getkey_0)) #f) + (|#%app| + (check-not-unsafe-undefined sort 'sort) + lst_0 + less-than?_0 + getkey_0 + #f) + (|#%app| + (check-not-unsafe-undefined sort 'sort) + lst_0 + less-than?_0))) + ((lst_0 less-than?_0 getkey_0 cache-keys?_0) + (if (if getkey_0 (not (eq? values getkey_0)) #f) + (let ((n_0 (length lst_0))) + (if (unsafe-fx= n_0 0) + lst_0 + (if cache-keys?_0 + (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 lst_1) + (begin + (if (pair? lst_1) + (let ((x_0 (car lst_1))) + (begin + (unsafe-vector-set! + vec_0 + i_0 + (cons (|#%app| getkey_0 x_0) x_0)) + (loop_0 (unsafe-fx+ i_0 1) (cdr lst_1)))) + (void))))))) + (loop_0 0 lst_0)) + (generic-sort/key_0 vec_0 less-than?_0 n_0 unsafe-car) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 r_0) + (begin + (let ((i_1 (unsafe-fx- i_0 1))) + (if (unsafe-fx< i_1 0) + r_0 + (loop_0 + i_1 + (cons + (unsafe-cdr (unsafe-vector-ref vec_0 i_1)) + r_0))))))))) + (loop_0 n_0 '())))) + (if (letrec* + ((loop_0 + (|#%name| + loop + (lambda (last_0 next_0) + (begin + (let ((or-part_0 (null? next_0))) + (if or-part_0 + or-part_0 + (if (not + (if getkey_0 + (let ((app_0 (|#%app| - less-than?_0 - app_0 - (|#%app| getkey_0 a_1))) - (|#%app| less-than?_0 c_0 a_1)) - (list b_1 c_0 a_1) - (list b_1 a_1 c_0))) + getkey_0 + (unsafe-car next_0)))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 last_0))) + (|#%app| + less-than?_0 + (unsafe-car next_0) + last_0))) + (loop_0 + (unsafe-car next_0) + (unsafe-cdr next_0)) + #f)))))))) + (let ((app_0 (car lst_0))) (loop_0 app_0 (cdr lst_0)))) + lst_0 + (if (unsafe-fx<= n_0 3) + (if (unsafe-fx= n_0 1) + lst_0 + (if (unsafe-fx= n_0 2) + (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) + (let ((a_0 (car lst_0))) + (let ((b_0 (cadr lst_0))) + (let ((c_0 (caddr lst_0))) + (let ((b_1 b_0) (a_1 a_0)) + (if (if getkey_0 + (let ((app_0 (|#%app| getkey_0 b_1))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 a_1))) + (|#%app| less-than?_0 b_1 a_1)) + (if (if getkey_0 + (let ((app_0 (|#%app| getkey_0 c_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 b_1))) + (|#%app| less-than?_0 c_0 b_1)) + (list c_0 b_1 a_1) (if (if getkey_0 (let ((app_0 (|#%app| getkey_0 c_0))) (|#%app| @@ -1399,43 +1372,50 @@ app_0 (|#%app| getkey_0 a_1))) (|#%app| less-than?_0 c_0 a_1)) - (list c_0 a_1 b_1) - (list a_1 c_0 b_1))))))))) - (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) - (begin - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 lst_1) - (begin - (if (pair? lst_1) - (begin - (vector-set! vec_0 i_0 (car lst_1)) - (let ((app_0 (add1 i_0))) - (loop_2 app_0 (cdr lst_1)))) - (void))))))) - (loop_2 0 lst_0)) - (generic-sort/key_0 vec_0 less-than?_0 n_0 getkey_0) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 r_0) - (begin - (let ((i_1 (sub1 i_0))) - (if (< i_1 0) - r_0 - (loop_2 - i_1 - (cons - (vector-ref vec_0 i_1) - r_0))))))))) - (loop_2 n_0 '()))))))))) - (|#%app| - (check-not-unsafe-undefined sort 'sort) - lst_0 - less-than?_0))))) + (list b_1 c_0 a_1) + (list b_1 a_1 c_0))) + (if (if getkey_0 + (let ((app_0 (|#%app| getkey_0 c_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 a_1))) + (|#%app| less-than?_0 c_0 a_1)) + (list c_0 a_1 b_1) + (list a_1 c_0 b_1))))))))) + (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 lst_1) + (begin + (if (pair? lst_1) + (begin + (vector-set! vec_0 i_0 (car lst_1)) + (let ((app_0 (add1 i_0))) + (loop_0 app_0 (cdr lst_1)))) + (void))))))) + (loop_0 0 lst_0)) + (generic-sort/key_0 vec_0 less-than?_0 n_0 getkey_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 r_0) + (begin + (let ((i_1 (sub1 i_0))) + (if (< i_1 0) + r_0 + (loop_0 + i_1 + (cons (vector-ref vec_0 i_1) r_0))))))))) + (loop_0 n_0 '()))))))))) + (|#%app| + (check-not-unsafe-undefined sort 'sort) + lst_0 + less-than?_0)))) (case-lambda ((vec_0 less-than?_0 start_0 end_0) (let ((n_0 (- end_0 start_0))) @@ -2292,37 +2272,42 @@ (lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 1))) (lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 2)))))))) (define empty-stream (make-do-stream (lambda () #t) void void)) -(define map_2960 +(define map_1346 (|#%name| map - (letrec ((loop_0 - (|#%name| - loop - (lambda (f_0 l1_0 l2_0) - (begin - (if (null? l1_0) - null - (let ((r1_0 (cdr l1_0))) - (let ((r2_0 (cdr l2_0))) - (let ((r1_1 r1_0)) - (let ((app_0 - (let ((app_0 (car l1_0))) - (|#%app| f_0 app_0 (car l2_0))))) - (cons app_0 (loop_0 f_0 r1_1 r2_0))))))))))) - (loop_1 - (|#%name| - loop - (lambda (f_0 l_0) - (begin - (if (null? l_0) - null - (let ((r_0 (cdr l_0))) - (let ((app_0 (|#%app| f_0 (car l_0)))) - (cons app_0 (loop_1 f_0 r_0)))))))))) - (case-lambda - ((f_0 l_0) (begin (loop_1 f_0 l_0))) - ((f_0 l1_0 l2_0) (loop_0 f_0 l1_0 l2_0)) - ((f_0 l_0 . args_0) (gen-map f_0 (cons l_0 args_0))))))) + (case-lambda + ((f_0 l_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1) + (begin + (if (null? l_1) + null + (let ((r_0 (cdr l_1))) + (let ((app_0 (|#%app| f_0 (car l_1)))) + (cons app_0 (loop_0 r_0)))))))))) + (loop_0 l_0)))) + ((f_0 l1_0 l2_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l1_1 l2_1) + (begin + (if (null? l1_1) + null + (let ((r1_0 (cdr l1_1))) + (let ((r2_0 (cdr l2_1))) + (let ((r1_1 r1_0)) + (let ((app_0 + (let ((app_0 (car l1_1))) + (|#%app| f_0 app_0 (car l2_1))))) + (cons app_0 (loop_0 r1_1 r2_0)))))))))))) + (loop_0 l1_0 l2_0))) + ((f_0 l_0 . args_0) (gen-map f_0 (cons l_0 args_0)))))) (define andmap_2344 (|#%name| andmap @@ -2363,144 +2348,165 @@ (loop_0 l1_0 l2_0)))) ((f_0 l_0 . args_0) (gen-andmap f_0 (cons l_0 args_0)))))) (define check-args - (letrec ((loop_0 - (|#%name| - loop - (lambda (kws_0) - (begin - (if (null? kws_0) - null - (let ((app_0 - (string-append "#:" (keyword->string (car kws_0))))) - (list* " " app_0 (loop_0 (cdr kws_0))))))))) - (loop_1 - (|#%name| - loop - (lambda (w_0 ls_0) - (begin - (if (null? ls_0) - null - (let ((app_0 - (string-append - "\n " - (let ((app_0 (error-value->string-handler))) - (|#%app| app_0 (car ls_0) w_0))))) - (cons app_0 (loop_1 w_0 (cdr ls_0)))))))))) - (lambda (who_0 f_0 ls_0) - (begin - (if (procedure? f_0) - (void) - (raise-argument-error who_0 "procedure?" f_0)) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (prev-len_0 ls_1 i_0) - (begin - (if (null? ls_1) - (void) - (let ((l_0 (car ls_1))) - (begin - (if (list? l_0) - (void) - (raise-argument-error who_0 "list?" l_0)) - (let ((len_0 (length l_0))) - (begin - (if (if prev-len_0 (not (= len_0 prev-len_0)) #f) - (raise-arguments-error - who_0 - "all lists must have same size" - "first list length" - prev-len_0 - "other list length" - len_0 - "procedure" - f_0) - (void)) - (let ((app_0 (cdr ls_1))) - (loop_2 len_0 app_0 (add1 i_0))))))))))))) - (loop_2 #f ls_0 1)) - (if (procedure-arity-includes? f_0 (length ls_0)) - (void) - (call-with-values - (lambda () (procedure-keywords f_0)) - (case-lambda - ((required-keywords_0 optional-keywords_0) - (let ((app_0 - (if (pair? required-keywords_0) - (string-append - "argument mismatch;\n" - " the given procedure expects keyword arguments") - (string-append - "argument mismatch;\n" - " the given procedure's expected number of arguments does not match" - " the given number of lists")))) - (let ((app_1 - (unquoted-printing-string - (let ((or-part_0 - (let ((n_0 (object-name f_0))) - (if (symbol? n_0) (symbol->string n_0) #f)))) - (if or-part_0 or-part_0 "#"))))) - (apply - raise-arguments-error - who_0 - app_0 - "given procedure" - app_1 - (let ((app_2 - (let ((a_0 (procedure-arity f_0))) - (if (pair? required-keywords_0) - null - (if (integer? a_0) - (list "expected" a_0) - (if (arity-at-least? a_0) - (list - "expected" - (unquoted-printing-string - (string-append - "at least " - (number->string - (arity-at-least-value a_0))))) - null)))))) - (let ((app_3 - (if (pair? required-keywords_0) - null - (list "given" (length ls_0))))) - (let ((app_4 - (if (pair? required-keywords_0) + (lambda (who_0 f_0 ls_0) + (begin + (if (procedure? f_0) + (void) + (raise-argument-error who_0 "procedure?" f_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (prev-len_0 ls_1 i_0) + (begin + (if (null? ls_1) + (void) + (let ((l_0 (car ls_1))) + (begin + (if (list? l_0) + (void) + (raise-argument-error who_0 "list?" l_0)) + (let ((len_0 (length l_0))) + (begin + (if (if prev-len_0 (not (= len_0 prev-len_0)) #f) + (raise-arguments-error + who_0 + "all lists must have same size" + "first list length" + prev-len_0 + "other list length" + len_0 + "procedure" + f_0) + (void)) + (let ((app_0 (cdr ls_1))) + (loop_0 len_0 app_0 (add1 i_0))))))))))))) + (loop_0 #f ls_0 1)) + (if (procedure-arity-includes? f_0 (length ls_0)) + (void) + (call-with-values + (lambda () (procedure-keywords f_0)) + (case-lambda + ((required-keywords_0 optional-keywords_0) + (let ((app_0 + (if (pair? required-keywords_0) + (string-append + "argument mismatch;\n" + " the given procedure expects keyword arguments") + (string-append + "argument mismatch;\n" + " the given procedure's expected number of arguments does not match" + " the given number of lists")))) + (let ((app_1 + (unquoted-printing-string + (let ((or-part_0 + (let ((n_0 (object-name f_0))) + (if (symbol? n_0) (symbol->string n_0) #f)))) + (if or-part_0 or-part_0 "#"))))) + (apply + raise-arguments-error + who_0 + app_0 + "given procedure" + app_1 + (let ((app_2 + (let ((a_0 (procedure-arity f_0))) + (if (pair? required-keywords_0) + null + (if (integer? a_0) + (list "expected" a_0) + (if (arity-at-least? a_0) (list - "required keywords" + "expected" (unquoted-printing-string - (apply - string-append - (cdr (loop_0 required-keywords_0))))) - null))) - (append - app_2 - app_3 - app_4 - (let ((w_0 - (let ((app_5 (error-print-width))) - (quotient app_5 (length ls_0))))) - (if (> w_0 10) + (string-append + "at least " + (number->string + (arity-at-least-value a_0))))) + null)))))) + (let ((app_3 + (if (pair? required-keywords_0) + null + (list "given" (length ls_0))))) + (let ((app_4 + (if (pair? required-keywords_0) (list - "argument lists..." + "required keywords" (unquoted-printing-string - (apply string-append (loop_1 w_0 ls_0)))) - null)))))))))) - (args (raise-binding-result-arity-error 2 args))))))))) + (apply + string-append + (cdr + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (kws_0) + (begin + (if (null? kws_0) + null + (let ((app_4 + (string-append + "#:" + (keyword->string + (car kws_0))))) + (list* + " " + app_4 + (loop_0 (cdr kws_0)))))))))) + (loop_0 required-keywords_0)))))) + null))) + (append + app_2 + app_3 + app_4 + (let ((w_0 + (let ((app_5 (error-print-width))) + (quotient app_5 (length ls_0))))) + (if (> w_0 10) + (list + "argument lists..." + (unquoted-printing-string + (apply + string-append + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ls_1) + (begin + (if (null? ls_1) + null + (let ((app_5 + (string-append + "\n " + (let ((app_5 + (error-value->string-handler))) + (|#%app| + app_5 + (car ls_1) + w_0))))) + (cons + app_5 + (loop_0 (cdr ls_1)))))))))) + (loop_0 ls_0))))) + null)))))))))) + (args (raise-binding-result-arity-error 2 args)))))))) (define gen-map - (letrec ((loop_0 - (|#%name| - loop - (lambda (f_0 ls_0) - (begin - (if (null? (car ls_0)) - null - (let ((next-ls_0 (map_2960 cdr ls_0))) - (let ((app_0 (apply f_0 (map_2960 car ls_0)))) - (cons app_0 (loop_0 f_0 next-ls_0)))))))))) - (lambda (f_0 ls_0) (begin #t (loop_0 f_0 ls_0))))) + (lambda (f_0 ls_0) + (begin + #t + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ls_1) + (begin + (if (null? (car ls_1)) + null + (let ((next-ls_0 (map_1346 cdr ls_1))) + (let ((app_0 (apply f_0 (map_1346 car ls_1)))) + (cons app_0 (loop_0 next-ls_0)))))))))) + (loop_0 ls_0))))) (define gen-andmap (lambda (f_0 ls_0) (begin @@ -2514,31 +2520,32 @@ (if (null? (car ls_1)) #t (if (null? (cdar ls_1)) - (apply f_0 (map_2960 car ls_1)) - (let ((next-ls_0 (map_2960 cdr ls_1))) - (if (apply f_0 (map_2960 car ls_1)) + (apply f_0 (map_1346 car ls_1)) + (let ((next-ls_0 (map_1346 cdr ls_1))) + (if (apply f_0 (map_1346 car ls_1)) (loop_0 next-ls_0) #f))))))))) (loop_0 ls_0))))) (define hash-keys - (letrec ((loop_0 - (|#%name| - loop - (lambda (h_0 pos_0) - (begin - (if pos_0 - (let ((app_0 (hash-iterate-key h_0 pos_0))) - (cons app_0 (loop_0 h_0 (hash-iterate-next h_0 pos_0)))) - null)))))) - (lambda (h_0) (loop_0 h_0 (hash-iterate-first h_0))))) + (lambda (h_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_0) + (begin + (if pos_0 + (let ((app_0 (hash-iterate-key h_0 pos_0))) + (cons app_0 (loop_0 (hash-iterate-next h_0 pos_0)))) + null)))))) + (loop_0 (hash-iterate-first h_0))))) (define hash-values - (letrec ((procz1 (lambda (k_0 v_0) v_0))) - (lambda (table_0) - (begin - (if (hash? table_0) - (void) - (raise-argument-error 'hash-values "hash?" table_0)) - (hash-map table_0 procz1))))) + (lambda (table_0) + (begin + (if (hash? table_0) + (void) + (raise-argument-error 'hash-values "hash?" table_0)) + (hash-map table_0 (lambda (k_0 v_0) v_0))))) (define sort.1 (|#%name| sort @@ -2571,23 +2578,22 @@ lst5_0 less?6_0))))))) (define do-remove - (letrec ((loop_0 - (|#%name| - loop - (lambda (equal?_0 item_0 list_0) - (begin - (if (null? list_0) - null - (if (|#%app| equal?_0 item_0 (car list_0)) - (cdr list_0) - (let ((app_0 (car list_0))) - (cons - app_0 - (loop_0 equal?_0 item_0 (cdr list_0))))))))))) - (lambda (who_0 item_0 list_0 equal?_0) - (begin - (if (list? list_0) (void) (raise-argument-error who_0 "list?" list_0)) - (loop_0 equal?_0 item_0 list_0))))) + (lambda (who_0 item_0 list_0 equal?_0) + (begin + (if (list? list_0) (void) (raise-argument-error who_0 "list?" list_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (list_1) + (begin + (if (null? list_1) + null + (if (|#%app| equal?_0 item_0 (car list_1)) + (cdr list_1) + (let ((app_0 (car list_1))) + (cons app_0 (loop_0 (cdr list_1))))))))))) + (loop_0 list_0))))) (define remq (lambda (item_0 list_0) (do-remove 'remq item_0 list_0 eq?))) (define internal-error (lambda (msg_0) @@ -3477,31 +3483,29 @@ (unsafe-place-local-ref cell.1))) (void))) (define make-ltps - (letrec ((procz1 - (lambda (ltps_0) - (begin - (|#%app| - rktio_ltps_remove_all - (unsafe-place-local-ref cell.1) - ltps_0) - (|#%app| - rktio_ltps_close - (unsafe-place-local-ref cell.1) - ltps_0) - (|#%app| shared-ltps-reset!))))) - (lambda () - (let ((ltps_0 (|#%app| rktio_ltps_open (unsafe-place-local-ref cell.1)))) - (begin - (if (vector? ltps_0) - (void) - (|#%app| - 1/unsafe-custodian-register - (current-custodian) - ltps_0 - procz1 - #f - #f)) - (if (vector? ltps_0) rktio_NULL ltps_0)))))) + (lambda () + (let ((ltps_0 (|#%app| rktio_ltps_open (unsafe-place-local-ref cell.1)))) + (begin + (if (vector? ltps_0) + (void) + (|#%app| + 1/unsafe-custodian-register + (current-custodian) + ltps_0 + (lambda (ltps_1) + (begin + (|#%app| + rktio_ltps_remove_all + (unsafe-place-local-ref cell.1) + ltps_1) + (|#%app| + rktio_ltps_close + (unsafe-place-local-ref cell.1) + ltps_1) + (|#%app| shared-ltps-reset!))) + #f + #f)) + (if (vector? ltps_0) rktio_NULL ltps_0))))) (define cell.1$5 (unsafe-make-place-local (make-ltps))) (define shared-ltps-place-init! (lambda () (unsafe-place-local-set! cell.1$5 (make-ltps)))) @@ -3677,66 +3681,67 @@ (begin (unsafe-place-local-set! cell.1$10 sleep_0) (unsafe-place-local-set! cell.2$3 fd_0)))) -(define effect_2049 +(define effect_2807 (begin (void (|#%app| current-sandman (let ((timeout-sandman_0 (|#%app| current-sandman))) (sandman1.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (ps_0 fd-adders_0) - (begin - (if (not fd-adders_0) - (void) - (if (pair? fd-adders_0) - (begin - (loop_0 ps_0 (car fd-adders_0)) - (loop_0 ps_0 (cdr fd-adders_0))) - (|#%app| fd-adders_0 ps_0)))))))) - (lambda (exts_0) - (let ((timeout-at_0 (if exts_0 (exts-timeout-at exts_0) #f))) - (let ((fd-adders_0 (if exts_0 (exts-fd-adders exts_0) #f))) - (let ((ps_0 - (|#%app| - rktio_make_poll_set - (unsafe-place-local-ref cell.1)))) - (begin - (loop_0 ps_0 fd-adders_0) - (let ((sleep-secs_0 - (if timeout-at_0 - (/ - (- timeout-at_0 (current-inexact-milliseconds)) - 1000.0) - #f))) - (begin - (if (if sleep-secs_0 (<= sleep-secs_0 0.0) #f) - (void) - (if (unsafe-place-local-ref cell.1$10) - (begin - (|#%app| - rktio_start_sleep - (unsafe-place-local-ref cell.1) - (if sleep-secs_0 sleep-secs_0 0.0) - ps_0 - (unsafe-place-local-ref cell.1$5) - (unsafe-place-local-ref cell.2$3)) - (|#%app| (unsafe-place-local-ref cell.1$10)) - (|#%app| - rktio_end_sleep - (unsafe-place-local-ref cell.1))) + (lambda (exts_0) + (let ((timeout-at_0 (if exts_0 (exts-timeout-at exts_0) #f))) + (let ((fd-adders_0 (if exts_0 (exts-fd-adders exts_0) #f))) + (let ((ps_0 + (|#%app| + rktio_make_poll_set + (unsafe-place-local-ref cell.1)))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (fd-adders_1) + (begin + (if (not fd-adders_1) + (void) + (if (pair? fd-adders_1) + (begin + (loop_0 (car fd-adders_1)) + (loop_0 (cdr fd-adders_1))) + (|#%app| fd-adders_1 ps_0)))))))) + (loop_0 fd-adders_0)) + (let ((sleep-secs_0 + (if timeout-at_0 + (/ + (- timeout-at_0 (current-inexact-milliseconds)) + 1000.0) + #f))) + (begin + (if (if sleep-secs_0 (<= sleep-secs_0 0.0) #f) + (void) + (if (unsafe-place-local-ref cell.1$10) + (begin (|#%app| - rktio_sleep + rktio_start_sleep (unsafe-place-local-ref cell.1) (if sleep-secs_0 sleep-secs_0 0.0) ps_0 - (unsafe-place-local-ref cell.1$5)))) - (|#%app| - rktio_poll_set_forget - (unsafe-place-local-ref cell.1) - ps_0))))))))) + (unsafe-place-local-ref cell.1$5) + (unsafe-place-local-ref cell.2$3)) + (|#%app| (unsafe-place-local-ref cell.1$10)) + (|#%app| + rktio_end_sleep + (unsafe-place-local-ref cell.1))) + (|#%app| + rktio_sleep + (unsafe-place-local-ref cell.1) + (if sleep-secs_0 sleep-secs_0 0.0) + ps_0 + (unsafe-place-local-ref cell.1$5)))) + (|#%app| + rktio_poll_set_forget + (unsafe-place-local-ref cell.1) + ps_0)))))))) (lambda (wakeup_0) (begin (letrec* @@ -4880,383 +4885,208 @@ 'utf-8-state 'pending-amt)))))) (define utf-8-decode!.1 - (letrec ((complete_0 - (|#%name| - complete - (lambda (abort-mode3_0 - error-char2_0 - i_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0 - accum_0) - (begin - (begin - (if out-str11_0 - (string-set! out-str11_0 j_0 (integer->char accum_0)) - (void)) - (let ((next-j_0 (fx+ j_0 1))) - (let ((next-i_0 (fx+ i_0 1))) - (if (if out-end13_0 (fx= next-j_0 out-end13_0) #f) - (let ((app_0 (fx- next-i_0 in-start9_0))) - (let ((app_1 (fx- next-j_0 out-start12_0))) - (values - app_0 - app_1 - (if (fx= next-i_0 in-end10_0) - 'complete - 'continues)))) - (loop_0 - abort-mode3_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-end13_0 - out-start12_0 - out-str11_0 - next-i_0 - next-j_0 - next-i_0 - 0 - 0))))))))) - (encoding-failure_0 - (|#%name| - encoding-failure - (lambda (abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0) - (begin - (if error-char2_0 + (|#%name| + utf-8-decode! + (lambda (abort-mode3_0 + error-char2_0 + state4_0 + in-bstr8_0 + in-start9_0 + in-end10_0 + out-str11_0 + out-start12_0 + out-end13_0) + (begin + (let ((base-i_0 + (if state4_0 + (fx- in-start9_0 (utf-8-state-pending-amt state4_0)) + in-start9_0))) + (let ((accum_0 (if state4_0 (utf-8-state-accum state4_0) 0))) + (let ((remaining_0 + (if state4_0 (utf-8-state-remaining state4_0) 0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 j_0 base-i_1 accum_1 remaining_1) (begin - (if out-str11_0 - (string-set! out-str11_0 j_0 error-char2_0) - (void)) - (let ((next-j_0 (fx+ j_0 1))) - (let ((next-i_0 (fx+ base-i_0 1))) - (if (if out-end13_0 (fx= next-j_0 out-end13_0) #f) - (let ((app_0 (fx- next-i_0 in-start9_0))) - (values - app_0 - (fx- next-j_0 out-start12_0) - 'continues)) - (loop_0 - abort-mode3_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-end13_0 - out-start12_0 - out-str11_0 - next-i_0 - next-j_0 - next-i_0 - 0 - 0))))) - (let ((app_0 (fx- base-i_0 in-start9_0))) - (values app_0 (fx- j_0 out-start12_0) 'error))))))) - (loop_0 - (|#%name| - loop - (lambda (abort-mode3_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-end13_0 - out-start12_0 - out-str11_0 - i_0 - j_0 - base-i_0 - accum_0 - remaining_0) - (begin - (if (fx= i_0 in-end10_0) - (if (fx= remaining_0 0) - (let ((app_0 (fx- base-i_0 in-start9_0))) - (values app_0 (fx- j_0 out-start12_0) 'complete)) - (if (eq? abort-mode3_0 'error) - (encoding-failure_0 - abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0) - (if (eq? abort-mode3_0 'state) - (let ((app_0 (fx- i_0 in-start9_0))) - (let ((app_1 (fx- j_0 out-start12_0))) - (values - app_0 - app_1 - (utf-8-state1.1 - accum_0 - remaining_0 - (fx- i_0 base-i_0))))) - (let ((app_0 (fx- base-i_0 in-start9_0))) - (values app_0 (fx- j_0 out-start12_0) 'aborts))))) - (if (fx< i_0 in-start9_0) - (encoding-failure_0 - abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0) - (let ((b_0 (unsafe-bytes-ref in-bstr8_0 i_0))) - (if (fx< b_0 128) - (if (fx= remaining_0 0) - (complete_0 - abort-mode3_0 - error-char2_0 - i_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0 - b_0) - (encoding-failure_0 - abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0)) - (if (fx= 128 (fxand b_0 192)) - (if (fx= remaining_0 0) - (encoding-failure_0 - abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0) - (let ((next_0 (fxand b_0 63))) - (let ((next-accum_0 - (fxior (fxlshift accum_0 6) next_0))) - (if (fx= 1 remaining_0) - (if (if (fx> next-accum_0 127) - (if (fx<= next-accum_0 1114111) - (not - (if (fx>= next-accum_0 55296) - (fx<= next-accum_0 57343) - #f)) - #f) - #f) - (complete_0 - abort-mode3_0 - error-char2_0 - i_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 + (let ((complete_0 + (|#%name| + complete + (lambda (accum_2) + (begin + (begin + (if out-str11_0 + (string-set! out-str11_0 - next-accum_0) - (encoding-failure_0 - abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 j_0 - out-end13_0 - out-start12_0 - out-str11_0)) - (if (if (fx= 2 remaining_0) - (fx<= next-accum_0 31) - #f) - (encoding-failure_0 - abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0) - (if (if (fx= 3 remaining_0) - (fx<= next-accum_0 15) - #f) - (encoding-failure_0 - abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0) - (let ((remaining_1 (fx- remaining_0 1))) + (integer->char accum_2)) + (void)) + (let ((next-j_0 (fx+ j_0 1))) + (let ((next-i_0 (fx+ i_0 1))) + (if (if out-end13_0 + (fx= next-j_0 out-end13_0) + #f) + (let ((app_0 + (fx- next-i_0 in-start9_0))) + (let ((app_1 + (fx- + next-j_0 + out-start12_0))) + (values + app_0 + app_1 + (if (fx= next-i_0 in-end10_0) + 'complete + 'continues)))) (loop_0 - abort-mode3_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-end13_0 - out-start12_0 + next-i_0 + next-j_0 + next-i_0 + 0 + 0)))))))))) + (let ((encoding-failure_0 + (|#%name| + encoding-failure + (lambda () + (begin + (if error-char2_0 + (begin + (if out-str11_0 + (string-set! out-str11_0 - (fx+ i_0 1) j_0 - base-i_0 - next-accum_0 - remaining_1)))))))) - (if (not (fx= remaining_0 0)) - (encoding-failure_0 - abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0) - (if (fx= 192 (fxand b_0 224)) - (let ((accum_1 (fxand b_0 31))) - (if (fx= accum_1 0) - (encoding-failure_0 - abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0) - (loop_0 - abort-mode3_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-end13_0 - out-start12_0 - out-str11_0 - (fx+ i_0 1) - j_0 - i_0 - accum_1 - 1))) - (if (fx= 224 (fxand b_0 240)) - (let ((accum_1 (fxand b_0 15))) - (loop_0 - abort-mode3_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-end13_0 - out-start12_0 - out-str11_0 - (fx+ i_0 1) - j_0 - i_0 - accum_1 - 2)) - (if (fx= 240 (fxand b_0 248)) - (let ((accum_1 (fxand b_0 7))) - (loop_0 - abort-mode3_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-end13_0 - out-start12_0 - out-str11_0 - (fx+ i_0 1) - j_0 - i_0 - accum_1 - 3)) - (encoding-failure_0 - abort-mode3_0 - base-i_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-end13_0 - out-start12_0 - out-str11_0))))))))))))))) - (|#%name| - utf-8-decode! - (lambda (abort-mode3_0 - error-char2_0 - state4_0 - in-bstr8_0 - in-start9_0 - in-end10_0 - out-str11_0 - out-start12_0 - out-end13_0) - (begin - (let ((base-i_0 - (if state4_0 - (fx- in-start9_0 (utf-8-state-pending-amt state4_0)) - in-start9_0))) - (let ((accum_0 (if state4_0 (utf-8-state-accum state4_0) 0))) - (let ((remaining_0 - (if state4_0 (utf-8-state-remaining state4_0) 0))) - (loop_0 - abort-mode3_0 - error-char2_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-end13_0 - out-start12_0 - out-str11_0 - in-start9_0 - out-start12_0 - base-i_0 - accum_0 - remaining_0))))))))) + error-char2_0) + (void)) + (let ((next-j_0 (fx+ j_0 1))) + (let ((next-i_0 (fx+ base-i_1 1))) + (if (if out-end13_0 + (fx= next-j_0 out-end13_0) + #f) + (let ((app_0 + (fx- + next-i_0 + in-start9_0))) + (values + app_0 + (fx- next-j_0 out-start12_0) + 'continues)) + (loop_0 + next-i_0 + next-j_0 + next-i_0 + 0 + 0))))) + (let ((app_0 (fx- base-i_1 in-start9_0))) + (values + app_0 + (fx- j_0 out-start12_0) + 'error)))))))) + (if (fx= i_0 in-end10_0) + (if (fx= remaining_1 0) + (let ((app_0 (fx- base-i_1 in-start9_0))) + (values + app_0 + (fx- j_0 out-start12_0) + 'complete)) + (if (eq? abort-mode3_0 'error) + (encoding-failure_0) + (if (eq? abort-mode3_0 'state) + (let ((app_0 (fx- i_0 in-start9_0))) + (let ((app_1 (fx- j_0 out-start12_0))) + (values + app_0 + app_1 + (utf-8-state1.1 + accum_1 + remaining_1 + (fx- i_0 base-i_1))))) + (let ((app_0 (fx- base-i_1 in-start9_0))) + (values + app_0 + (fx- j_0 out-start12_0) + 'aborts))))) + (if (fx< i_0 in-start9_0) + (encoding-failure_0) + (let ((b_0 (unsafe-bytes-ref in-bstr8_0 i_0))) + (if (fx< b_0 128) + (if (fx= remaining_1 0) + (complete_0 b_0) + (encoding-failure_0)) + (if (fx= 128 (fxand b_0 192)) + (if (fx= remaining_1 0) + (encoding-failure_0) + (let ((next_0 (fxand b_0 63))) + (let ((next-accum_0 + (fxior + (fxlshift accum_1 6) + next_0))) + (if (fx= 1 remaining_1) + (if (if (fx> next-accum_0 127) + (if (fx<= + next-accum_0 + 1114111) + (not + (if (fx>= + next-accum_0 + 55296) + (fx<= next-accum_0 57343) + #f)) + #f) + #f) + (complete_0 next-accum_0) + (encoding-failure_0)) + (if (if (fx= 2 remaining_1) + (fx<= next-accum_0 31) + #f) + (encoding-failure_0) + (if (if (fx= 3 remaining_1) + (fx<= next-accum_0 15) + #f) + (encoding-failure_0) + (let ((remaining_2 + (fx- remaining_1 1))) + (loop_0 + (fx+ i_0 1) + j_0 + base-i_1 + next-accum_0 + remaining_2)))))))) + (if (not (fx= remaining_1 0)) + (encoding-failure_0) + (if (fx= 192 (fxand b_0 224)) + (let ((accum_2 (fxand b_0 31))) + (if (fx= accum_2 0) + (encoding-failure_0) + (loop_0 + (fx+ i_0 1) + j_0 + i_0 + accum_2 + 1))) + (if (fx= 224 (fxand b_0 240)) + (let ((accum_2 (fxand b_0 15))) + (loop_0 + (fx+ i_0 1) + j_0 + i_0 + accum_2 + 2)) + (if (fx= 240 (fxand b_0 248)) + (let ((accum_2 (fxand b_0 7))) + (loop_0 + (fx+ i_0 1) + j_0 + i_0 + accum_2 + 3)) + (encoding-failure_0))))))))))))))))) + (loop_0 + in-start9_0 + out-start12_0 + base-i_0 + accum_0 + remaining_0))))))))) (define utf-8-decode-byte (lambda (b_0 accum_0 remaining_0) (if (fx< b_0 128) @@ -5379,164 +5209,100 @@ str_0))))) (args (raise-binding-result-arity-error 3 args))))))))) (define utf-8-encode! - (letrec ((continue_0 - (|#%name| - continue - (lambda (i_0 - in-end_0 - in-start_0 - in-str_0 - out-bstr_0 - out-end_0 - out-start_0 - next-j_0) - (begin - (loop_0 - in-end_0 - in-start_0 - in-str_0 - out-bstr_0 - out-end_0 - out-start_0 - (fx+ i_0 1) - next-j_0))))) - (loop_0 - (|#%name| - loop - (lambda (in-end_0 - in-start_0 - in-str_0 - out-bstr_0 - out-end_0 - out-start_0 - i_0 - j_0) - (begin - (if (fx= i_0 in-end_0) - (let ((app_0 (fx- in-end_0 in-start_0))) - (values app_0 (fx- j_0 out-start_0) 'complete)) - (let ((b_0 (char->integer (string-ref in-str_0 i_0)))) - (if (fx<= b_0 127) - (if (if out-end_0 (fx= j_0 out-end_0) #f) - (let ((app_0 (fx- i_0 in-start_0))) - (values app_0 (fx- j_0 out-start_0) 'continues)) - (begin - (if out-bstr_0 - (unsafe-bytes-set! out-bstr_0 j_0 b_0) - (void)) - (continue_0 - i_0 - in-end_0 - in-start_0 - in-str_0 - out-bstr_0 - out-end_0 - out-start_0 - (fx+ j_0 1)))) - (if (fx<= b_0 2047) - (if (if out-end_0 (fx>= (fx+ j_0 1) out-end_0) #f) - (let ((app_0 (fx- i_0 in-start_0))) - (values app_0 (fx- j_0 out-start_0) 'continues)) - (begin - (if out-bstr_0 - (begin - (unsafe-bytes-set! - out-bstr_0 - j_0 - (fxior 192 (fxrshift b_0 6))) - (let ((app_0 (fx+ j_0 1))) - (unsafe-bytes-set! - out-bstr_0 - app_0 - (fxior 128 (fxand b_0 63))))) - (void)) - (continue_0 - i_0 - in-end_0 - in-start_0 - in-str_0 - out-bstr_0 - out-end_0 - out-start_0 - (+ j_0 2)))) - (if (fx<= b_0 65535) - (if (if out-end_0 (fx>= (fx+ j_0 2) out-end_0) #f) - (let ((app_0 (fx- i_0 in-start_0))) - (values app_0 (fx- j_0 out-start_0) 'continues)) - (begin - (if out-bstr_0 - (begin - (unsafe-bytes-set! - out-bstr_0 - j_0 - (fxior 224 (fxrshift b_0 12))) - (let ((app_0 (fx+ j_0 1))) - (unsafe-bytes-set! - out-bstr_0 - app_0 - (fxior 128 (fxand (fxrshift b_0 6) 63)))) - (let ((app_0 (fx+ j_0 2))) - (unsafe-bytes-set! - out-bstr_0 - app_0 - (fxior 128 (fxand b_0 63))))) - (void)) - (continue_0 - i_0 - in-end_0 - in-start_0 - in-str_0 - out-bstr_0 - out-end_0 - out-start_0 - (fx+ j_0 3)))) - (if (if out-end_0 (fx>= (fx+ j_0 3) out-end_0) #f) - (let ((app_0 (fx- i_0 in-start_0))) - (values app_0 (fx- j_0 out-start_0) 'continues)) - (begin - (if out-bstr_0 - (begin - (unsafe-bytes-set! - out-bstr_0 - j_0 - (fxior 240 (fxrshift b_0 18))) - (let ((app_0 (fx+ j_0 1))) - (unsafe-bytes-set! - out-bstr_0 - app_0 - (fxior - 128 - (fxand (fxrshift b_0 12) 63)))) - (let ((app_0 (fx+ j_0 2))) - (unsafe-bytes-set! - out-bstr_0 - app_0 - (fxior 128 (fxand (fxrshift b_0 6) 63)))) - (let ((app_0 (fx+ j_0 3))) - (unsafe-bytes-set! - out-bstr_0 - app_0 - (fxior 128 (fxand b_0 63))))) - (void)) - (continue_0 - i_0 - in-end_0 - in-start_0 - in-str_0 - out-bstr_0 - out-end_0 - out-start_0 - (fx+ j_0 4)))))))))))))) - (lambda (in-str_0 in-start_0 in-end_0 out-bstr_0 out-start_0 out-end_0) - (loop_0 - in-end_0 - in-start_0 - in-str_0 - out-bstr_0 - out-end_0 - out-start_0 - in-start_0 - out-start_0)))) + (lambda (in-str_0 in-start_0 in-end_0 out-bstr_0 out-start_0 out-end_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 j_0) + (begin + (if (fx= i_0 in-end_0) + (let ((app_0 (fx- in-end_0 in-start_0))) + (values app_0 (fx- j_0 out-start_0) 'complete)) + (let ((b_0 (char->integer (string-ref in-str_0 i_0)))) + (let ((continue_0 + (|#%name| + continue + (lambda (next-j_0) + (begin (loop_0 (fx+ i_0 1) next-j_0)))))) + (if (fx<= b_0 127) + (if (if out-end_0 (fx= j_0 out-end_0) #f) + (let ((app_0 (fx- i_0 in-start_0))) + (values app_0 (fx- j_0 out-start_0) 'continues)) + (begin + (if out-bstr_0 + (unsafe-bytes-set! out-bstr_0 j_0 b_0) + (void)) + (continue_0 (fx+ j_0 1)))) + (if (fx<= b_0 2047) + (if (if out-end_0 (fx>= (fx+ j_0 1) out-end_0) #f) + (let ((app_0 (fx- i_0 in-start_0))) + (values app_0 (fx- j_0 out-start_0) 'continues)) + (begin + (if out-bstr_0 + (begin + (unsafe-bytes-set! + out-bstr_0 + j_0 + (fxior 192 (fxrshift b_0 6))) + (let ((app_0 (fx+ j_0 1))) + (unsafe-bytes-set! + out-bstr_0 + app_0 + (fxior 128 (fxand b_0 63))))) + (void)) + (continue_0 (+ j_0 2)))) + (if (fx<= b_0 65535) + (if (if out-end_0 (fx>= (fx+ j_0 2) out-end_0) #f) + (let ((app_0 (fx- i_0 in-start_0))) + (values app_0 (fx- j_0 out-start_0) 'continues)) + (begin + (if out-bstr_0 + (begin + (unsafe-bytes-set! + out-bstr_0 + j_0 + (fxior 224 (fxrshift b_0 12))) + (let ((app_0 (fx+ j_0 1))) + (unsafe-bytes-set! + out-bstr_0 + app_0 + (fxior 128 (fxand (fxrshift b_0 6) 63)))) + (let ((app_0 (fx+ j_0 2))) + (unsafe-bytes-set! + out-bstr_0 + app_0 + (fxior 128 (fxand b_0 63))))) + (void)) + (continue_0 (fx+ j_0 3)))) + (if (if out-end_0 (fx>= (fx+ j_0 3) out-end_0) #f) + (let ((app_0 (fx- i_0 in-start_0))) + (values app_0 (fx- j_0 out-start_0) 'continues)) + (begin + (if out-bstr_0 + (begin + (unsafe-bytes-set! + out-bstr_0 + j_0 + (fxior 240 (fxrshift b_0 18))) + (let ((app_0 (fx+ j_0 1))) + (unsafe-bytes-set! + out-bstr_0 + app_0 + (fxior 128 (fxand (fxrshift b_0 12) 63)))) + (let ((app_0 (fx+ j_0 2))) + (unsafe-bytes-set! + out-bstr_0 + app_0 + (fxior 128 (fxand (fxrshift b_0 6) 63)))) + (let ((app_0 (fx+ j_0 3))) + (unsafe-bytes-set! + out-bstr_0 + app_0 + (fxior 128 (fxand b_0 63))))) + (void)) + (continue_0 (fx+ j_0 4))))))))))))))) + (loop_0 in-start_0 out-start_0)))) (define 1/bytes->string/latin-1 (let ((bytes->string/latin-1_0 (|#%name| @@ -6399,11 +6165,10 @@ "position" pos_0))))))))) (define 1/file-position* - (letrec ((procz1 (lambda () #f))) - (|#%name| - file-position* - (lambda (p_0) - (begin (do-simple-file-position 'file-position* p_0 procz1)))))) + (|#%name| + file-position* + (lambda (p_0) + (begin (do-simple-file-position 'file-position* p_0 (lambda () #f)))))) (define do-simple-file-position (lambda (who_0 orig-p_0 fail-k_0) (let ((p_0 @@ -6489,45 +6254,41 @@ #t #f))))) (define 1/port-next-location - (letrec ((procz1 (lambda () #f))) - (|#%name| - port-next-location - (lambda (p_0) - (begin - (let ((p_1 - (if (1/input-port? p_0) - (->core-input-port.1 unsafe-undefined p_0 #f) - (if (1/output-port? p_0) - (->core-output-port.1 unsafe-undefined p_0 #f) - (raise-argument-error 'port-next-location "port?" p_0))))) - (let ((loc_0 (core-port-count p_1))) - (if loc_0 - (begin - (unsafe-start-atomic) - (begin0 - (begin - (check-not-closed 'port-next-location p_1) - (let ((get-location_0 - (core-port-methods-get-location.1 - (core-port-vtable p_1)))) - (if get-location_0 - (|#%app| get-location_0 p_1) - (let ((app_0 (location-line loc_0))) - (let ((app_1 (location-column loc_0))) - (values - app_0 - app_1 - (location-position loc_0))))))) - (unsafe-end-atomic))) - (if (core-port-methods-file-position.1 (core-port-vtable p_1)) - (let ((offset_0 - (do-simple-file-position - 'port-next-location - p_1 - procz1))) - (values #f #f (if offset_0 (add1 offset_0) #f))) - (let ((offset_0 (get-core-port-offset p_1))) - (values #f #f (if offset_0 (add1 offset_0) #f)))))))))))) + (|#%name| + port-next-location + (lambda (p_0) + (begin + (let ((p_1 + (if (1/input-port? p_0) + (->core-input-port.1 unsafe-undefined p_0 #f) + (if (1/output-port? p_0) + (->core-output-port.1 unsafe-undefined p_0 #f) + (raise-argument-error 'port-next-location "port?" p_0))))) + (let ((loc_0 (core-port-count p_1))) + (if loc_0 + (begin + (unsafe-start-atomic) + (begin0 + (begin + (check-not-closed 'port-next-location p_1) + (let ((get-location_0 + (core-port-methods-get-location.1 + (core-port-vtable p_1)))) + (if get-location_0 + (|#%app| get-location_0 p_1) + (let ((app_0 (location-line loc_0))) + (let ((app_1 (location-column loc_0))) + (values app_0 app_1 (location-position loc_0))))))) + (unsafe-end-atomic))) + (if (core-port-methods-file-position.1 (core-port-vtable p_1)) + (let ((offset_0 + (do-simple-file-position + 'port-next-location + p_1 + (lambda () #f)))) + (values #f #f (if offset_0 (add1 offset_0) #f))) + (let ((offset_0 (get-core-port-offset p_1))) + (values #f #f (if offset_0 (add1 offset_0) #f))))))))))) (define 1/set-port-next-location! (|#%name| set-port-next-location! @@ -6579,289 +6340,214 @@ (void))) (unsafe-end-atomic))))))))) (define port-count! - (letrec ((end-utf-8_0 - (|#%name| - end-utf-8 - (lambda (bstr_0 - column_0 - end_0 - i_0 - line_0 - loc_0 - position_0 - span_0 - state_0) - (begin - (finish-utf-8_0 - bstr_0 - column_0 - end_0 - line_0 - loc_0 - position_0 - span_0 - state_0 - i_0 - 'error))))) - (finish-utf-8_0 - (|#%name| - finish-utf-8 - (lambda (bstr_0 - column_0 - end_0 - line_0 - loc_0 - position_0 - span_0 - state_0 - i_0 - abort-mode_0) - (begin - (call-with-values - (lambda () - (let ((temp14_0 (- i_0 span_0))) - (utf-8-decode!.1 - abort-mode_0 - '#\x3f - state_0 - bstr_0 - temp14_0 - i_0 - #f - 0 - #f))) - (case-lambda - ((used-bytes_0 got-chars_0 new-state_0) - (let ((delta-chars_0 - (- - got-chars_0 - (+ - span_0 - (let ((app_0 - (if (utf-8-state? state_0) - (utf-8-state-pending-amt state_0) - 0))) - (- - app_0 - (if (utf-8-state? new-state_0) - (utf-8-state-pending-amt new-state_0) - 0))))))) - (let ((app_0 - (if column_0 (+ column_0 delta-chars_0) #f))) - (let ((app_1 - (if position_0 - (+ position_0 delta-chars_0) - #f))) - (loop_0 - bstr_0 - end_0 - loc_0 - i_0 - 0 - line_0 - app_0 - app_1 - (keep-aborts_0 new-state_0) - #f))))) - (args (raise-binding-result-arity-error 3 args)))))))) - (keep-aborts_0 - (|#%name| - keep-aborts - (lambda (s_0) (begin (if (eq? s_0 'complete) #f s_0))))) - (loop_0 - (|#%name| - loop - (lambda (bstr_0 - end_0 - loc_0 - i_0 - span_0 - line_0 - column_0 - position_0 - state_0 - cr-state_0) - (begin - (if (= i_0 end_0) - (if (zero? span_0) - (begin - (set-location-line! loc_0 line_0) - (set-location-column! loc_0 column_0) - (set-location-position! loc_0 position_0) - (set-location-state! loc_0 state_0) - (set-location-cr-state! loc_0 cr-state_0)) - (finish-utf-8_0 - bstr_0 - column_0 - end_0 - line_0 - loc_0 - position_0 - span_0 - state_0 - end_0 - 'state)) - (let ((b_0 (unsafe-bytes-ref bstr_0 i_0))) - (if (eq? b_0 10) - (if (if state_0 state_0 (not (zero? span_0))) - (end-utf-8_0 - bstr_0 - column_0 - end_0 - i_0 - line_0 - loc_0 - position_0 - span_0 - state_0) - (if cr-state_0 - (loop_0 - bstr_0 - end_0 - loc_0 - (add1 i_0) - 0 - line_0 - column_0 - position_0 - #f - #f) - (let ((app_0 (add1 i_0))) - (let ((app_1 (if line_0 (add1 line_0) #f))) - (let ((app_2 (if column_0 0 #f))) - (loop_0 - bstr_0 - end_0 - loc_0 - app_0 - 0 - app_1 - app_2 - (if position_0 (add1 position_0) #f) - #f - #f)))))) - (if (eq? b_0 13) - (if (if (zero? span_0) (not state_0) #f) - (let ((app_0 (add1 i_0))) - (let ((app_1 (if line_0 (add1 line_0) #f))) - (let ((app_2 (if column_0 0 #f))) - (loop_0 - bstr_0 - end_0 - loc_0 - app_0 - 0 - app_1 - app_2 - (if position_0 (add1 position_0) #f) - #f - #t)))) - (end-utf-8_0 - bstr_0 - column_0 - end_0 - i_0 - line_0 - loc_0 - position_0 - span_0 - state_0)) - (if (eq? b_0 9) - (if (if (zero? span_0) (not state_0) #f) - (let ((app_0 (add1 i_0))) - (let ((app_1 - (if column_0 - (+ (bitwise-and column_0 -8) 8) - #f))) - (loop_0 - bstr_0 - end_0 - loc_0 - app_0 - 0 - line_0 - app_1 - (if position_0 (add1 position_0) #f) - #f - #f))) - (end-utf-8_0 - bstr_0 - column_0 - end_0 - i_0 - line_0 - loc_0 - position_0 - span_0 - state_0)) - (if (< b_0 128) - (if (if (zero? span_0) (not state_0) #f) - (let ((app_0 (add1 i_0))) - (let ((app_1 - (if column_0 (add1 column_0) #f))) - (loop_0 - bstr_0 - end_0 - loc_0 - app_0 - 0 - line_0 - app_1 - (if position_0 (add1 position_0) #f) - #f - #f))) - (let ((app_0 (add1 i_0))) - (let ((app_1 (add1 span_0))) - (let ((app_2 - (if column_0 (add1 column_0) #f))) - (loop_0 - bstr_0 - end_0 - loc_0 - app_0 - app_1 - line_0 - app_2 - (if position_0 (add1 position_0) #f) + (lambda (in_0 amt_0 bstr_0 start_0) + (begin + (increment-offset! in_0 amt_0) + (let ((loc_0 (core-port-count in_0))) + (if loc_0 + (let ((end_0 (+ start_0 amt_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 + span_0 + line_0 + column_0 + position_0 + state_0 + cr-state_0) + (begin + (let ((finish-utf-8_0 + (|#%name| + finish-utf-8 + (lambda (i_1 abort-mode_0) + (begin + (call-with-values + (lambda () + (let ((temp14_0 (- i_1 span_0))) + (utf-8-decode!.1 + abort-mode_0 + '#\x3f state_0 - #f))))) - (let ((app_0 (add1 i_0))) - (let ((app_1 (add1 span_0))) - (let ((app_2 - (if column_0 (add1 column_0) #f))) - (loop_0 - bstr_0 - end_0 - loc_0 - app_0 - app_1 - line_0 - app_2 - (if position_0 (add1 position_0) #f) - state_0 - #f))))))))))))))) - (lambda (in_0 amt_0 bstr_0 start_0) - (begin - (increment-offset! in_0 amt_0) - (let ((loc_0 (core-port-count in_0))) - (if loc_0 - (let ((end_0 (+ start_0 amt_0))) - (let ((app_0 (location-line loc_0))) - (let ((app_1 (location-column loc_0))) - (let ((app_2 (location-position loc_0))) - (let ((app_3 (location-state loc_0))) - (loop_0 - bstr_0 - end_0 - loc_0 - start_0 - 0 - app_0 - app_1 - app_2 - app_3 - (location-cr-state loc_0))))))) - (void))))))) + bstr_0 + temp14_0 + i_1 + #f + 0 + #f))) + (case-lambda + ((used-bytes_0 got-chars_0 new-state_0) + (let ((delta-chars_0 + (- + got-chars_0 + (+ + span_0 + (let ((app_0 + (if (utf-8-state? state_0) + (utf-8-state-pending-amt + state_0) + 0))) + (- + app_0 + (if (utf-8-state? new-state_0) + (utf-8-state-pending-amt + new-state_0) + 0))))))) + (let ((keep-aborts_0 + (|#%name| + keep-aborts + (lambda (s_0) + (begin + (if (eq? s_0 'complete) + #f + s_0)))))) + (let ((app_0 + (if column_0 + (+ column_0 delta-chars_0) + #f))) + (let ((app_1 + (if position_0 + (+ position_0 delta-chars_0) + #f))) + (loop_0 + i_1 + 0 + line_0 + app_0 + app_1 + (keep-aborts_0 new-state_0) + #f)))))) + (args + (raise-binding-result-arity-error + 3 + args))))))))) + (if (= i_0 end_0) + (if (zero? span_0) + (begin + (set-location-line! loc_0 line_0) + (set-location-column! loc_0 column_0) + (set-location-position! loc_0 position_0) + (set-location-state! loc_0 state_0) + (set-location-cr-state! loc_0 cr-state_0)) + (finish-utf-8_0 end_0 'state)) + (let ((b_0 (unsafe-bytes-ref bstr_0 i_0))) + (let ((end-utf-8_0 + (|#%name| + end-utf-8 + (lambda () + (begin (finish-utf-8_0 i_0 'error)))))) + (if (eq? b_0 10) + (if (if state_0 state_0 (not (zero? span_0))) + (end-utf-8_0) + (if cr-state_0 + (loop_0 + (add1 i_0) + 0 + line_0 + column_0 + position_0 + #f + #f) + (let ((app_0 (add1 i_0))) + (let ((app_1 (if line_0 (add1 line_0) #f))) + (let ((app_2 (if column_0 0 #f))) + (loop_0 + app_0 + 0 + app_1 + app_2 + (if position_0 (add1 position_0) #f) + #f + #f)))))) + (if (eq? b_0 13) + (if (if (zero? span_0) (not state_0) #f) + (let ((app_0 (add1 i_0))) + (let ((app_1 (if line_0 (add1 line_0) #f))) + (let ((app_2 (if column_0 0 #f))) + (loop_0 + app_0 + 0 + app_1 + app_2 + (if position_0 (add1 position_0) #f) + #f + #t)))) + (end-utf-8_0)) + (if (eq? b_0 9) + (if (if (zero? span_0) (not state_0) #f) + (let ((app_0 (add1 i_0))) + (let ((app_1 + (if column_0 + (+ (bitwise-and column_0 -8) 8) + #f))) + (loop_0 + app_0 + 0 + line_0 + app_1 + (if position_0 (add1 position_0) #f) + #f + #f))) + (end-utf-8_0)) + (if (< b_0 128) + (if (if (zero? span_0) (not state_0) #f) + (let ((app_0 (add1 i_0))) + (let ((app_1 + (if column_0 + (add1 column_0) + #f))) + (loop_0 + app_0 + 0 + line_0 + app_1 + (if position_0 (add1 position_0) #f) + #f + #f))) + (let ((app_0 (add1 i_0))) + (let ((app_1 (add1 span_0))) + (let ((app_2 + (if column_0 + (add1 column_0) + #f))) + (loop_0 + app_0 + app_1 + line_0 + app_2 + (if position_0 + (add1 position_0) + #f) + state_0 + #f))))) + (let ((app_0 (add1 i_0))) + (let ((app_1 (add1 span_0))) + (let ((app_2 + (if column_0 + (add1 column_0) + #f))) + (loop_0 + app_0 + app_1 + line_0 + app_2 + (if position_0 (add1 position_0) #f) + state_0 + #f))))))))))))))))) + (let ((app_0 (location-line loc_0))) + (let ((app_1 (location-column loc_0))) + (let ((app_2 (location-position loc_0))) + (let ((app_3 (location-state loc_0))) + (loop_0 + start_0 + 0 + app_0 + app_1 + app_2 + app_3 + (location-cr-state loc_0)))))))) + (void)))))) (define port-count-all! (lambda (in_0 extra-ins_0 amt_0 bstr_0 start_0) (begin @@ -7211,143 +6897,139 @@ 'commit-response 'result-put-evt)))))) (define make-commit-manager - (letrec ((loop_0 - (|#%name| - loop - (lambda (commit-ch_0 pause-ch_0 reqs_0 resps_0) - (begin - (call-with-values - (lambda () (poll-commit-liveness reqs_0 resps_0)) - (case-lambda - ((live-reqs_0 new-resps_0) - (let ((live-resps_0 (drop-abandoned new-resps_0))) - (let ((app_0 - (handle-evt - pause-ch_0 - (lambda (evt_0) - (begin - (sync evt_0) - (loop_0 - commit-ch_0 - pause-ch_0 - live-reqs_0 - live-resps_0)))))) - (let ((app_1 - (handle-evt - commit-ch_0 - (lambda (req_0) - (loop_0 - commit-ch_0 - pause-ch_0 - (cons req_0 live-reqs_0) - live-resps_0))))) - (apply - sync - app_0 - app_1 - (let ((app_2 - (1/reverse + (lambda () + (let ((pause-ch_0 (make-channel))) + (let ((commit-ch_0 (make-channel))) + (commit-manager1.1 + pause-ch_0 + commit-ch_0 + (thread + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (reqs_0 resps_0) + (begin + (call-with-values + (lambda () (poll-commit-liveness reqs_0 resps_0)) + (case-lambda + ((live-reqs_0 new-resps_0) + (let ((live-resps_0 (drop-abandoned new-resps_0))) + (let ((app_0 + (handle-evt + pause-ch_0 + (lambda (evt_0) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((req_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (handle-evt - (commit-request-ext-evt - req_0) - (lambda (v_0) - (begin - (unsafe-start-atomic) - (begin0 - (|#%app| - (commit-request-finish - req_0)) - (unsafe-end-atomic)) - (let ((app_2 - (begin-unsafe - (do-remove - 'remq - req_0 - live-reqs_0 - eq?)))) - (loop_0 - commit-ch_0 - pause-ch_0 - app_2 - (cons - (let ((app_3 - (commit-request-abandon-evt - req_0))) - (commit-response3.1 - app_3 - (channel-put-evt - (commit-request-result-ch - req_0) - #t))) - live-resps_0)))))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null live-reqs_0)))))) - (append - app_2 - (1/reverse - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((resp_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 + (sync evt_0) + (loop_0 live-reqs_0 live-resps_0)))))) + (let ((app_1 + (handle-evt + commit-ch_0 + (lambda (req_0) + (loop_0 + (cons req_0 live-reqs_0) + live-resps_0))))) + (apply + sync + app_0 + app_1 + (let ((app_2 + (1/reverse + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((req_0 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) (let ((fold-var_1 - (cons - (handle-evt - (commit-response-result-put-evt - resp_0) - (lambda (ignored_0) - (loop_0 - commit-ch_0 - pause-ch_0 - live-reqs_0 - (begin-unsafe - (do-remove - 'remq - resp_0 - live-resps_0 - eq?))))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null live-resps_0))))))))))) - (args (raise-binding-result-arity-error 2 args))))))))) - (lambda () - (let ((pause-ch_0 (make-channel))) - (let ((commit-ch_0 (make-channel))) - (commit-manager1.1 - pause-ch_0 - commit-ch_0 - (thread (lambda () (loop_0 commit-ch_0 pause-ch_0 '() '()))))))))) + (let ((fold-var_1 + (cons + (handle-evt + (commit-request-ext-evt + req_0) + (lambda (v_0) + (begin + (unsafe-start-atomic) + (begin0 + (|#%app| + (commit-request-finish + req_0)) + (unsafe-end-atomic)) + (let ((app_2 + (begin-unsafe + (do-remove + 'remq + req_0 + live-reqs_0 + eq?)))) + (loop_0 + app_2 + (cons + (let ((app_3 + (commit-request-abandon-evt + req_0))) + (commit-response3.1 + app_3 + (channel-put-evt + (commit-request-result-ch + req_0) + #t))) + live-resps_0)))))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 null live-reqs_0)))))) + (append + app_2 + (1/reverse + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((resp_0 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (handle-evt + (commit-response-result-put-evt + resp_0) + (lambda (ignored_0) + (loop_0 + live-reqs_0 + (begin-unsafe + (do-remove + 'remq + resp_0 + live-resps_0 + eq?))))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 null live-resps_0))))))))))) + (args (raise-binding-result-arity-error 2 args))))))))) + (loop_0 '() '()))))))))) (define poll-commit-liveness (lambda (reqs_0 resps_0) (letrec* @@ -8078,93 +7760,86 @@ (temp1.1 this-id_0) (|#%app| temp11.1 this-id_0 amt_0) amt_0))))))))))) - (letrec ((procz1 (lambda (v_0) 0))) - (|#%name| - peek-in - (lambda (this-id_0 - dest-bstr448_0 - dest-start449_0 - dest-end450_0 - skip451_0 - progress-evt452_0 - copy?453_0) - (begin - (let ((o_0 (pipe-input-port-d this-id_0))) - (begin - (temp3.1$3 o_0) - (let ((content-amt_0 (temp4.1$2 o_0))) - (if (if progress-evt452_0 - (sync/timeout 0 progress-evt452_0) - #f) - #f - (if (<= content-amt_0 skip451_0) - (if (not (pipe-data-output-ref o_0)) - eof - (begin - (if (let ((or-part_0 (zero? skip451_0))) - (if or-part_0 - or-part_0 - (pipe-data-more-read-ready-sema o_0))) - (void) - (begin - (set-pipe-data-more-read-ready-sema! - o_0 - (make-semaphore)) - (let ((out_0 - (let ((r_0 (pipe-data-output-ref o_0))) - (begin-unsafe (weak-box-value r_0))))) - (if out_0 - (|#%app| temp19.1$1 out_0) - (void))))) - (let ((evt_0 - (if (zero? skip451_0) - (pipe-data-read-ready-evt o_0) - (wrap-evt - (semaphore-peek-evt - (pipe-data-more-read-ready-sema o_0)) - procz1)))) - evt_0))) - (let ((peek-start_0 - (let ((app_2 - (fx+ (pipe-data-start o_0) skip451_0))) - (fxmodulo app_2 (pipe-data-len o_0))))) - (if (fx< peek-start_0 (pipe-data-end o_0)) - (let ((amt_0 - (let ((app_2 - (fx- dest-end450_0 dest-start449_0))) - (fxmin - app_2 - (fx- - (pipe-data-end o_0) - peek-start_0))))) - (begin - (let ((app_2 (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - dest-bstr448_0 - dest-start449_0 - app_2 - peek-start_0 - (fx+ peek-start_0 amt_0))) - (temp9.1$1 o_0 (+ skip451_0 amt_0)) - amt_0)) - (let ((amt_0 - (let ((app_2 - (fx- dest-end450_0 dest-start449_0))) - (fxmin - app_2 - (fx- - (pipe-data-len o_0) - peek-start_0))))) - (begin - (let ((app_2 (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - dest-bstr448_0 - dest-start449_0 - app_2 - peek-start_0 - (fx+ peek-start_0 amt_0))) - (temp9.1$1 o_0 (+ skip451_0 amt_0)) - amt_0))))))))))))) + (|#%name| + peek-in + (lambda (this-id_0 + dest-bstr448_0 + dest-start449_0 + dest-end450_0 + skip451_0 + progress-evt452_0 + copy?453_0) + (begin + (let ((o_0 (pipe-input-port-d this-id_0))) + (begin + (temp3.1$3 o_0) + (let ((content-amt_0 (temp4.1$2 o_0))) + (if (if progress-evt452_0 + (sync/timeout 0 progress-evt452_0) + #f) + #f + (if (<= content-amt_0 skip451_0) + (if (not (pipe-data-output-ref o_0)) + eof + (begin + (if (let ((or-part_0 (zero? skip451_0))) + (if or-part_0 + or-part_0 + (pipe-data-more-read-ready-sema o_0))) + (void) + (begin + (set-pipe-data-more-read-ready-sema! + o_0 + (make-semaphore)) + (let ((out_0 + (let ((r_0 (pipe-data-output-ref o_0))) + (begin-unsafe (weak-box-value r_0))))) + (if out_0 (|#%app| temp19.1$1 out_0) (void))))) + (let ((evt_0 + (if (zero? skip451_0) + (pipe-data-read-ready-evt o_0) + (wrap-evt + (semaphore-peek-evt + (pipe-data-more-read-ready-sema o_0)) + (lambda (v_0) 0))))) + evt_0))) + (let ((peek-start_0 + (let ((app_2 + (fx+ (pipe-data-start o_0) skip451_0))) + (fxmodulo app_2 (pipe-data-len o_0))))) + (if (fx< peek-start_0 (pipe-data-end o_0)) + (let ((amt_0 + (let ((app_2 + (fx- dest-end450_0 dest-start449_0))) + (fxmin + app_2 + (fx- (pipe-data-end o_0) peek-start_0))))) + (begin + (let ((app_2 (pipe-data-bstr o_0))) + (unsafe-bytes-copy! + dest-bstr448_0 + dest-start449_0 + app_2 + peek-start_0 + (fx+ peek-start_0 amt_0))) + (temp9.1$1 o_0 (+ skip451_0 amt_0)) + amt_0)) + (let ((amt_0 + (let ((app_2 + (fx- dest-end450_0 dest-start449_0))) + (fxmin + app_2 + (fx- (pipe-data-len o_0) peek-start_0))))) + (begin + (let ((app_2 (pipe-data-bstr o_0))) + (unsafe-bytes-copy! + dest-bstr448_0 + dest-start449_0 + app_2 + peek-start_0 + (fx+ peek-start_0 amt_0))) + (temp9.1$1 o_0 (+ skip451_0 amt_0)) + amt_0)))))))))))) (|#%name| byte-ready (lambda (this-id_0 work-done!504_0) @@ -8414,291 +8089,322 @@ app_1 app_2 app_3 - (letrec ((procz1 (lambda (v_0) #f)) - (apply-limit_0 - (|#%name| - apply-limit - (lambda (o_0 amt_0) - (begin - (if (pipe-data-limit o_0) - (min - amt_0 - (let ((app_6 - (let ((app_6 (pipe-data-limit o_0))) - (+ - app_6 - (pipe-data-peeked-amt o_0))))) - (- app_6 (temp4.1$2 o_0)))) - amt_0))))) - (maybe-grow_0 - (|#%name| - maybe-grow - (lambda (o_0 - src-bstr818_0 - src-end820_0 - src-start819_0 - this-id_0) - (begin - (if (let ((or-part_0 - (not (pipe-data-limit o_0)))) - (if or-part_0 - or-part_0 - (let ((app_6 - (let ((app_6 - (pipe-data-limit o_0))) - (+ - app_6 - (pipe-data-peeked-amt o_0))))) - (> - app_6 - (fx- (pipe-data-len o_0) 1))))) - (let ((in_0 - (let ((r_0 (pipe-data-input-ref o_0))) - (begin-unsafe (weak-box-value r_0))))) - (begin - (if in_0 (temp13.1 in_0) (void)) - (let ((new-bstr_0 - (make-bytes - (let ((app_6 - (if (pipe-data-limit o_0) - (let ((app_6 - (pipe-data-limit - o_0))) - (+ - app_6 - (pipe-data-peeked-amt - o_0))) - #f))) - (min+1 - app_6 - (* (pipe-data-len o_0) 2)))))) - (begin - (if (fx= 0 (pipe-data-start o_0)) - (let ((app_6 (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - new-bstr_0 - 0 - app_6 - 0 - (fx- (pipe-data-len o_0) 1))) - (begin - (let ((app_6 (pipe-data-bstr o_0))) - (let ((app_7 - (pipe-data-start o_0))) - (unsafe-bytes-copy! - new-bstr_0 - 0 - app_6 - app_7 - (pipe-data-len o_0)))) - (let ((app_6 - (let ((app_6 - (pipe-data-len o_0))) - (fx- - app_6 - (pipe-data-start o_0))))) - (let ((app_7 - (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - new-bstr_0 - app_6 - app_7 - 0 - (pipe-data-end o_0)))) - (set-pipe-data-start! o_0 0) - (set-pipe-data-end! - o_0 - (fx- (pipe-data-len o_0) 1)))) - (set-pipe-data-bstr! o_0 new-bstr_0) - (set-pipe-data-len! - o_0 - (unsafe-bytes-length new-bstr_0)) - (try-again_0 - o_0 - src-bstr818_0 - src-end820_0 - src-start819_0 - this-id_0))))) - (pipe-is-full_0 o_0)))))) - (pipe-is-full_0 - (|#%name| - pipe-is-full - (lambda (o_0) - (begin - (wrap-evt - (pipe-data-write-ready-evt o_0) - procz1))))) - (try-again_0 - (|#%name| - try-again - (lambda (o_0 - src-bstr818_0 - src-end820_0 - src-start819_0 - this-id_0) - (begin - (let ((top-pos_0 - (if (fx= (pipe-data-start o_0) 0) - (fx- (pipe-data-len o_0) 1) - (pipe-data-len o_0)))) - (if (fx= src-start819_0 src-end820_0) - 0 - (if (not (pipe-data-input-ref o_0)) - (fx- src-end820_0 src-start819_0) - (if (if (let ((app_6 (pipe-data-end o_0))) - (fx>= - app_6 - (pipe-data-start o_0))) - (fx< (pipe-data-end o_0) top-pos_0) - #f) - (let ((amt_0 - (apply-limit_0 - o_0 - (let ((app_6 - (fx- - top-pos_0 - (pipe-data-end o_0)))) - (fxmin - app_6 - (fx- - src-end820_0 - src-start819_0)))))) - (if (fx= amt_0 0) - (pipe-is-full_0 o_0) - (begin - (temp8.1$1 o_0) - (let ((app_6 (pipe-data-bstr o_0))) - (let ((app_7 - (pipe-data-end o_0))) - (unsafe-bytes-copy! - app_6 - app_7 - src-bstr818_0 - src-start819_0 - (fx+ src-start819_0 amt_0)))) - (let ((new-end_0 - (fx+ - (pipe-data-end o_0) - amt_0))) - (set-pipe-data-end! - o_0 - (if (fx= - new-end_0 - (pipe-data-len o_0)) - 0 - new-end_0))) - (|#%app| temp16.1 this-id_0 amt_0) - amt_0))) - (if (fx= (pipe-data-end o_0) top-pos_0) - (if (fx= (pipe-data-start o_0) 0) - (maybe-grow_0 - o_0 - src-bstr818_0 - src-end820_0 - src-start819_0 - this-id_0) - (let ((amt_0 - (let ((app_6 - (fx- - (pipe-data-start o_0) - 1))) - (fxmin - app_6 - (fx- - src-end820_0 - src-start819_0))))) - (if (fx= amt_0 0) - (pipe-is-full_0 o_0) - (begin - (temp8.1$1 o_0) - (let ((app_6 - (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - app_6 - 0 - src-bstr818_0 - src-start819_0 - (fx+ src-start819_0 amt_0))) - (set-pipe-data-end! o_0 amt_0) - (|#%app| - temp16.1 - this-id_0 - amt_0) - amt_0)))) - (if (let ((app_6 (pipe-data-end o_0))) - (fx< - app_6 - (fx- (pipe-data-start o_0) 1))) - (let ((amt_0 - (apply-limit_0 - o_0 + (|#%name| + write-out + (lambda (this-id_0 + src-bstr818_0 + src-start819_0 + src-end820_0 + nonblock?821_0 + enable-break?822_0 + copy?823_0) + (begin + (begin + (begin-unsafe (void)) + (|#%app| temp17.1 this-id_0) + (let ((o_0 (pipe-output-port-d this-id_0))) + (letrec* + ((try-again_0 + (|#%name| + try-again + (lambda () + (begin + (let ((top-pos_0 + (if (fx= (pipe-data-start o_0) 0) + (fx- (pipe-data-len o_0) 1) + (pipe-data-len o_0)))) + (letrec* + ((maybe-grow_0 + (|#%name| + maybe-grow + (lambda () + (begin + (if (let ((or-part_0 + (not + (pipe-data-limit o_0)))) + (if or-part_0 + or-part_0 (let ((app_6 (let ((app_6 - (fx- - (pipe-data-start - o_0) - 1))) - (fx- + (pipe-data-limit + o_0))) + (+ app_6 - (pipe-data-end + (pipe-data-peeked-amt o_0))))) - (fxmin + (> app_6 (fx- - src-end820_0 - src-start819_0)))))) - (if (fx= amt_0 0) - (pipe-is-full_0 o_0) + (pipe-data-len o_0) + 1))))) + (let ((in_0 + (let ((r_0 + (pipe-data-input-ref + o_0))) + (begin-unsafe + (weak-box-value r_0))))) (begin - (temp8.1$1 o_0) - (let ((app_6 - (pipe-data-bstr o_0))) - (let ((app_7 - (pipe-data-end o_0))) - (unsafe-bytes-copy! - app_6 - app_7 - src-bstr818_0 - src-start819_0 - (fx+ + (if in_0 + (temp13.1 in_0) + (void)) + (let ((new-bstr_0 + (make-bytes + (let ((app_6 + (if (pipe-data-limit + o_0) + (let ((app_6 + (pipe-data-limit + o_0))) + (+ + app_6 + (pipe-data-peeked-amt + o_0))) + #f))) + (min+1 + app_6 + (* + (pipe-data-len o_0) + 2)))))) + (begin + (if (fx= + 0 + (pipe-data-start o_0)) + (let ((app_6 + (pipe-data-bstr + o_0))) + (unsafe-bytes-copy! + new-bstr_0 + 0 + app_6 + 0 + (fx- + (pipe-data-len o_0) + 1))) + (begin + (let ((app_6 + (pipe-data-bstr + o_0))) + (let ((app_7 + (pipe-data-start + o_0))) + (unsafe-bytes-copy! + new-bstr_0 + 0 + app_6 + app_7 + (pipe-data-len + o_0)))) + (let ((app_6 + (let ((app_6 + (pipe-data-len + o_0))) + (fx- + app_6 + (pipe-data-start + o_0))))) + (let ((app_7 + (pipe-data-bstr + o_0))) + (unsafe-bytes-copy! + new-bstr_0 + app_6 + app_7 + 0 + (pipe-data-end + o_0)))) + (set-pipe-data-start! + o_0 + 0) + (set-pipe-data-end! + o_0 + (fx- + (pipe-data-len o_0) + 1)))) + (set-pipe-data-bstr! + o_0 + new-bstr_0) + (set-pipe-data-len! + o_0 + (unsafe-bytes-length + new-bstr_0)) + (try-again_0))))) + (pipe-is-full_0)))))) + (pipe-is-full_0 + (|#%name| + pipe-is-full + (lambda () + (begin + (wrap-evt + (pipe-data-write-ready-evt o_0) + (lambda (v_0) #f))))))) + (let ((apply-limit_0 + (|#%name| + apply-limit + (lambda (amt_0) + (begin + (if (pipe-data-limit o_0) + (min + amt_0 + (let ((app_6 + (let ((app_6 + (pipe-data-limit + o_0))) + (+ + app_6 + (pipe-data-peeked-amt + o_0))))) + (- app_6 (temp4.1$2 o_0)))) + amt_0)))))) + (if (fx= src-start819_0 src-end820_0) + 0 + (if (not (pipe-data-input-ref o_0)) + (fx- src-end820_0 src-start819_0) + (if (if (let ((app_6 + (pipe-data-end o_0))) + (fx>= + app_6 + (pipe-data-start o_0))) + (fx< + (pipe-data-end o_0) + top-pos_0) + #f) + (let ((amt_0 + (apply-limit_0 + (let ((app_6 + (fx- + top-pos_0 + (pipe-data-end + o_0)))) + (fxmin + app_6 + (fx- + src-end820_0 + src-start819_0)))))) + (if (fx= amt_0 0) + (pipe-is-full_0) + (begin + (temp8.1$1 o_0) + (let ((app_6 + (pipe-data-bstr o_0))) + (let ((app_7 + (pipe-data-end o_0))) + (unsafe-bytes-copy! + app_6 + app_7 + src-bstr818_0 src-start819_0 - amt_0)))) - (set-pipe-data-end! - o_0 - (fx+ - (pipe-data-end o_0) - amt_0)) - (|#%app| - temp16.1 - this-id_0 - amt_0) - amt_0))) - (maybe-grow_0 - o_0 - src-bstr818_0 - src-end820_0 - src-start819_0 - this-id_0)))))))))))) - (|#%name| - write-out - (lambda (this-id_0 - src-bstr818_0 - src-start819_0 - src-end820_0 - nonblock?821_0 - enable-break?822_0 - copy?823_0) - (begin - (begin - (begin-unsafe (void)) - (|#%app| temp17.1 this-id_0) - (let ((o_0 (pipe-output-port-d this-id_0))) - (try-again_0 - o_0 - src-bstr818_0 - src-end820_0 - src-start819_0 - this-id_0))))))) + (fx+ + src-start819_0 + amt_0)))) + (let ((new-end_0 + (fx+ + (pipe-data-end o_0) + amt_0))) + (set-pipe-data-end! + o_0 + (if (fx= + new-end_0 + (pipe-data-len o_0)) + 0 + new-end_0))) + (|#%app| + temp16.1 + this-id_0 + amt_0) + amt_0))) + (if (fx= + (pipe-data-end o_0) + top-pos_0) + (if (fx= (pipe-data-start o_0) 0) + (maybe-grow_0) + (let ((amt_0 + (let ((app_6 + (fx- + (pipe-data-start + o_0) + 1))) + (fxmin + app_6 + (fx- + src-end820_0 + src-start819_0))))) + (if (fx= amt_0 0) + (pipe-is-full_0) + (begin + (temp8.1$1 o_0) + (let ((app_6 + (pipe-data-bstr + o_0))) + (unsafe-bytes-copy! + app_6 + 0 + src-bstr818_0 + src-start819_0 + (fx+ + src-start819_0 + amt_0))) + (set-pipe-data-end! + o_0 + amt_0) + (|#%app| + temp16.1 + this-id_0 + amt_0) + amt_0)))) + (if (let ((app_6 + (pipe-data-end o_0))) + (fx< + app_6 + (fx- + (pipe-data-start o_0) + 1))) + (let ((amt_0 + (apply-limit_0 + (let ((app_6 + (let ((app_6 + (fx- + (pipe-data-start + o_0) + 1))) + (fx- + app_6 + (pipe-data-end + o_0))))) + (fxmin + app_6 + (fx- + src-end820_0 + src-start819_0)))))) + (if (fx= amt_0 0) + (pipe-is-full_0) + (begin + (temp8.1$1 o_0) + (let ((app_6 + (pipe-data-bstr + o_0))) + (let ((app_7 + (pipe-data-end + o_0))) + (unsafe-bytes-copy! + app_6 + app_7 + src-bstr818_0 + src-start819_0 + (fx+ + src-start819_0 + amt_0)))) + (set-pipe-data-end! + o_0 + (fx+ + (pipe-data-end o_0) + amt_0)) + (|#%app| + temp16.1 + this-id_0 + amt_0) + amt_0))) + (maybe-grow_0)))))))))))))) + (try-again_0))))))) app_4 app_5 (core-output-port-methods-get-write-special-evt.1 @@ -8963,7 +8669,7 @@ 'd)))))) (define struct:pipe-read-poller (make-record-type-descriptor* 'pipe-read-poller #f #f #f #f 1 0)) -(define effect_2394 +(define effect_2439 (struct-type-install-properties! struct:pipe-read-poller 'pipe-read-poller @@ -8975,33 +8681,32 @@ prop:evt (|#%app| poller - (letrec ((procz1 (lambda (v_0) 0))) - (lambda (prp_0 ctx_0) - (let ((o_0 (|#%app| pipe-read-poller-d prp_0))) - (begin - (temp3.1$3 o_0) - (if (let ((or-part_0 (not (temp5.1$2 o_0)))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (not (pipe-data-output-ref o_0)))) - (if or-part_1 - or-part_1 - (not (pipe-data-input-ref o_0)))))) - (values (list 0) #f) - (begin - (if (pipe-data-read-ready-sema o_0) - (void) - (set-pipe-data-read-ready-sema! o_0 (make-semaphore))) - (let ((out_0 - (let ((r_0 (pipe-data-output-ref o_0))) - (begin-unsafe (weak-box-value r_0))))) - (begin - (if out_0 (temp18.1$1 out_0) (void)) - (values - #f - (wrap-evt - (semaphore-peek-evt (pipe-data-read-ready-sema o_0)) - procz1))))))))))))) + (lambda (prp_0 ctx_0) + (let ((o_0 (|#%app| pipe-read-poller-d prp_0))) + (begin + (temp3.1$3 o_0) + (if (let ((or-part_0 (not (temp5.1$2 o_0)))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (not (pipe-data-output-ref o_0)))) + (if or-part_1 + or-part_1 + (not (pipe-data-input-ref o_0)))))) + (values (list 0) #f) + (begin + (if (pipe-data-read-ready-sema o_0) + (void) + (set-pipe-data-read-ready-sema! o_0 (make-semaphore))) + (let ((out_0 + (let ((r_0 (pipe-data-output-ref o_0))) + (begin-unsafe (weak-box-value r_0))))) + (begin + (if out_0 (temp18.1$1 out_0) (void)) + (values + #f + (wrap-evt + (semaphore-peek-evt (pipe-data-read-ready-sema o_0)) + (lambda (v_0) 0))))))))))))) (current-inspector) #f '(0) @@ -9702,74 +9407,73 @@ (define 1/file-stream-buffer-mode (|#%name| file-stream-buffer-mode - (letrec ((set-buffer-mode_0 - (|#%name| - set-buffer-mode - (lambda (mode_0 p_0) - (begin - (begin - (unsafe-start-atomic) - (begin0 - (begin - (check-not-closed 'file-stream-buffer-mode p_0) - (let ((buffer-mode_0 - (core-port-methods-buffer-mode.1 - (core-port-vtable p_0)))) - (if buffer-mode_0 - (begin (|#%app| buffer-mode_0 p_0 mode_0) #t) - #f))) - (unsafe-end-atomic)))))))) - (case-lambda - ((p_0) - (begin - (let ((p_1 - (if (1/input-port? p_0) - (->core-input-port.1 unsafe-undefined p_0 #f) - (if (1/output-port? p_0) - (->core-output-port.1 unsafe-undefined p_0 #f) - (raise-argument-error - 'file-stream-buffer-mode - "port?" - p_0))))) - (let ((buffer-mode_0 - (core-port-methods-buffer-mode.1 (core-port-vtable p_1)))) - (begin - (unsafe-start-atomic) - (begin0 - (begin - (check-not-closed 'file-stream-buffer-mode p_1) - (if buffer-mode_0 (|#%app| buffer-mode_0 p_1) #f)) - (unsafe-end-atomic))))))) - ((p_0 mode_0) - (begin - (if (let ((or-part_0 (1/input-port? p_0))) - (if or-part_0 or-part_0 (1/output-port? p_0))) - (void) - (raise-argument-error 'file-stream-buffer-mode "port?" p_0)) - (begin - (if (let ((or-part_0 (eq? mode_0 'none))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (eq? mode_0 'line))) - (if or-part_1 or-part_1 (eq? mode_0 'block))))) - (void) - (raise-argument-error - 'file-stream-buffer-mode - "(or/c 'none 'line 'block)" - mode_0)) + (case-lambda + ((p_0) + (begin + (let ((p_1 + (if (1/input-port? p_0) + (->core-input-port.1 unsafe-undefined p_0 #f) + (if (1/output-port? p_0) + (->core-output-port.1 unsafe-undefined p_0 #f) + (raise-argument-error + 'file-stream-buffer-mode + "port?" + p_0))))) + (let ((buffer-mode_0 + (core-port-methods-buffer-mode.1 (core-port-vtable p_1)))) (begin - (if (if (eq? mode_0 'line) (not (1/output-port? p_0)) #f) - (raise-arguments-error - 'file-stream-buffer-mode - "'line buffering not supported for an input port" - "port" - p_0) - (void)) + (unsafe-start-atomic) + (begin0 + (begin + (check-not-closed 'file-stream-buffer-mode p_1) + (if buffer-mode_0 (|#%app| buffer-mode_0 p_1) #f)) + (unsafe-end-atomic))))))) + ((p_0 mode_0) + (begin + (if (let ((or-part_0 (1/input-port? p_0))) + (if or-part_0 or-part_0 (1/output-port? p_0))) + (void) + (raise-argument-error 'file-stream-buffer-mode "port?" p_0)) + (begin + (if (let ((or-part_0 (eq? mode_0 'none))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (eq? mode_0 'line))) + (if or-part_1 or-part_1 (eq? mode_0 'block))))) + (void) + (raise-argument-error + 'file-stream-buffer-mode + "(or/c 'none 'line 'block)" + mode_0)) + (begin + (if (if (eq? mode_0 'line) (not (1/output-port? p_0)) #f) + (raise-arguments-error + 'file-stream-buffer-mode + "'line buffering not supported for an input port" + "port" + p_0) + (void)) + (let ((set-buffer-mode_0 + (|#%name| + set-buffer-mode + (lambda (p_1) + (begin + (begin + (unsafe-start-atomic) + (begin0 + (begin + (check-not-closed 'file-stream-buffer-mode p_1) + (let ((buffer-mode_0 + (core-port-methods-buffer-mode.1 + (core-port-vtable p_1)))) + (if buffer-mode_0 + (begin (|#%app| buffer-mode_0 p_1 mode_0) #t) + #f))) + (unsafe-end-atomic)))))))) (begin (if (1/input-port? p_0) (let ((or-part_0 (set-buffer-mode_0 - mode_0 (->core-input-port.1 unsafe-undefined p_0 #f)))) (if or-part_0 or-part_0 @@ -9782,7 +9486,6 @@ p_0))) (let ((or-part_0 (set-buffer-mode_0 - mode_0 (->core-output-port.1 unsafe-undefined p_0 #f)))) (if or-part_0 or-part_0 @@ -10396,96 +10099,97 @@ ((this-id_0) (begin (fd-output-port-buffer-mode this-id_0))) ((this-id_0 mode313_0) (set-fd-output-port-buffer-mode! this-id_0 mode313_0)))) - (letrec ((procz3 (lambda (v_0) #f)) - (procz2 (lambda (v_0) #f)) - (procz1 (lambda (v_0) #f))) - (|#%name| - write-out - (lambda (this-id_0 - src-bstr369_0 - src-start370_0 - src-end371_0 - nonbuffer/nonblock?372_0 - enable-break?373_0 - copy?374_0) + (|#%name| + write-out + (lambda (this-id_0 + src-bstr369_0 + src-start370_0 + src-end371_0 + nonbuffer/nonblock?372_0 + enable-break?373_0 + copy?374_0) + (begin (begin - (begin - (|#%app| temp23.1 this-id_0) - (if (fx= src-start370_0 src-end371_0) - (let ((or-part_0 (if (|#%app| temp18.1 this-id_0) 0 #f))) - (if or-part_0 - or-part_0 - (wrap-evt (core-output-port-evt this-id_0) procz1))) - (if (if (not - (eq? - (fd-output-port-buffer-mode this-id_0) - 'none)) - (if (not nonbuffer/nonblock?372_0) - (let ((app_4 (fd-output-port-end-pos this-id_0))) - (fx< - app_4 - (unsafe-bytes-length - (fd-output-port-bstr this-id_0)))) - #f) + (|#%app| temp23.1 this-id_0) + (if (fx= src-start370_0 src-end371_0) + (let ((or-part_0 (if (|#%app| temp18.1 this-id_0) 0 #f))) + (if or-part_0 + or-part_0 + (wrap-evt + (core-output-port-evt this-id_0) + (lambda (v_0) #f)))) + (if (if (not + (eq? + (fd-output-port-buffer-mode this-id_0) + 'none)) + (if (not nonbuffer/nonblock?372_0) + (let ((app_4 (fd-output-port-end-pos this-id_0))) + (fx< + app_4 + (unsafe-bytes-length + (fd-output-port-bstr this-id_0)))) #f) - (let ((amt_0 - (let ((app_4 (fx- src-end371_0 src-start370_0))) - (fxmin - app_4 - (let ((app_5 - (unsafe-bytes-length - (fd-output-port-bstr this-id_0)))) - (fx- - app_5 - (fd-output-port-end-pos this-id_0))))))) - (begin - (let ((app_4 (fd-output-port-bstr this-id_0))) - (let ((app_5 (fd-output-port-end-pos this-id_0))) - (unsafe-bytes-copy! - app_4 - app_5 - src-bstr369_0 - src-start370_0 - (fx+ src-start370_0 amt_0)))) - (set-fd-output-port-end-pos! - this-id_0 - (fx+ (fd-output-port-end-pos this-id_0) amt_0)) - (if (eq? - (fd-output-port-buffer-mode this-id_0) - 'line) - (|#%app| - temp20.1 - this-id_0 + #f) + (let ((amt_0 + (let ((app_4 (fx- src-end371_0 src-start370_0))) + (fxmin + app_4 + (let ((app_5 + (unsafe-bytes-length + (fd-output-port-bstr this-id_0)))) + (fx- + app_5 + (fd-output-port-end-pos this-id_0))))))) + (begin + (let ((app_4 (fd-output-port-bstr this-id_0))) + (let ((app_5 (fd-output-port-end-pos this-id_0))) + (unsafe-bytes-copy! + app_4 + app_5 src-bstr369_0 src-start370_0 - src-end371_0 - enable-break?373_0) - (void)) - (|#%app| temp22.1 this-id_0 amt_0) - amt_0)) - (if (not (|#%app| temp18.1 this-id_0)) - (wrap-evt (core-output-port-evt this-id_0) procz2) - (let ((n_0 - (|#%app| - rktio_write_in - (unsafe-place-local-ref cell.1) - (fd-output-port-fd this-id_0) - src-bstr369_0 - src-start370_0 - src-end371_0))) - (if (vector? n_0) - (begin - (unsafe-end-atomic) - (|#%app| - (fd-output-port-methods-raise-write-error.1 - (core-port-vtable this-id_0)) - this-id_0 - n_0)) - (if (fx= n_0 0) - (wrap-evt - (core-output-port-evt this-id_0) - procz3) - n_0))))))))))) + (fx+ src-start370_0 amt_0)))) + (set-fd-output-port-end-pos! + this-id_0 + (fx+ (fd-output-port-end-pos this-id_0) amt_0)) + (if (eq? + (fd-output-port-buffer-mode this-id_0) + 'line) + (|#%app| + temp20.1 + this-id_0 + src-bstr369_0 + src-start370_0 + src-end371_0 + enable-break?373_0) + (void)) + (|#%app| temp22.1 this-id_0 amt_0) + amt_0)) + (if (not (|#%app| temp18.1 this-id_0)) + (wrap-evt + (core-output-port-evt this-id_0) + (lambda (v_0) #f)) + (let ((n_0 + (|#%app| + rktio_write_in + (unsafe-place-local-ref cell.1) + (fd-output-port-fd this-id_0) + src-bstr369_0 + src-start370_0 + src-end371_0))) + (if (vector? n_0) + (begin + (unsafe-end-atomic) + (|#%app| + (fd-output-port-methods-raise-write-error.1 + (core-port-vtable this-id_0)) + this-id_0 + n_0)) + (if (fx= n_0 0) + (wrap-evt + (core-output-port-evt this-id_0) + (lambda (v_0) #f)) + n_0)))))))))) app_2 app_3 (core-output-port-methods-get-write-special-evt.1 @@ -10625,69 +10329,53 @@ (if (fd-output-port-bstr this-id_0) (loop_0) (void))))))))) (loop_0)))))) (define temp20.1 - (letrec ((for-loop_0 - (|#%name| - for-loop - (lambda (enable-break?633_0 stop*_0 this-id_0 v*_0 idx_0) - (begin - (if (unsafe-fx< idx_0 stop*_0) - (let ((b_0 (unsafe-bytes-ref v*_0 idx_0))) - (let ((or-part_0 (eqv? b_0 10))) - (let ((newline?_0 - (if or-part_0 or-part_0 (eqv? b_0 13)))) - (begin - (if newline?_0 - (temp19.1 this-id_0 enable-break?633_0) - (void)) - (if newline?_0 - (values) - (next-k-proc_0 - enable-break?633_0 - idx_0 - stop*_0 - this-id_0 - v*_0)))))) - (values)))))) - (next-k-proc_0 - (|#%name| - next-k-proc - (lambda (enable-break?633_0 idx_0 stop*_0 this-id_0 v*_0) - (begin - (for-loop_0 - enable-break?633_0 - stop*_0 - this-id_0 - v*_0 - (unsafe-fx+ idx_0 1))))))) - (|#%name| - flush-buffer-fully-if-newline - (lambda (this-id_0 - src-bstr630_0 - src-start631_0 - src-end632_0 - enable-break?633_0) + (|#%name| + flush-buffer-fully-if-newline + (lambda (this-id_0 + src-bstr630_0 + src-start631_0 + src-end632_0 + enable-break?633_0) + (begin (begin - (begin - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-bytes-length - src-bstr630_0 - src-start631_0 - src-end632_0 - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (for-loop_0 - enable-break?633_0 - stop*_0 - this-id_0 - v*_0 - start*_0))) - (args (raise-binding-result-arity-error 4 args)))) - (void))))))) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + src-bstr630_0 + src-start631_0 + src-end632_0 + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0) + (begin + (if (unsafe-fx< idx_0 stop*_0) + (let ((b_0 (unsafe-bytes-ref v*_0 idx_0))) + (let ((next-k-proc_0 + (|#%name| + next-k-proc + (lambda () + (begin + (for-loop_0 (unsafe-fx+ idx_0 1))))))) + (let ((or-part_0 (eqv? b_0 10))) + (let ((newline?_0 + (if or-part_0 or-part_0 (eqv? b_0 13)))) + (begin + (if newline?_0 + (temp19.1 this-id_0 enable-break?633_0) + (void)) + (if newline?_0 (values) (next-k-proc_0))))))) + (values))))))) + (for-loop_0 start*_0)))) + (args (raise-binding-result-arity-error 4 args)))) + (void)))))) (define temp21.1 (|#%name| flush-rktio-buffer-fully @@ -10857,7 +10545,7 @@ (|#%app| exn:fail app_0 (current-continuation-marks))))))) (void))))) (define struct:fd-evt (make-record-type-descriptor* 'fd-evt #f #f #f #f 3 4)) -(define effect_2590 +(define effect_2551 (struct-type-install-properties! struct:fd-evt 'fd-evt @@ -10869,56 +10557,52 @@ prop:evt (|#%app| poller - (letrec ((procz1 (lambda (s_0) 0))) - (lambda (fde_0 ctx_0) - (if (core-port-closed? (|#%app| fd-evt-closed fde_0)) - (values '(0) #f) - (let ((mode_0 (|#%app| fd-evt-mode fde_0))) - (let ((ready?_0 - (let ((or-part_0 - (if (eqv? 1 (bitwise-and mode_0 1)) - (eqv? - (|#%app| - rktio_poll_read_ready - (unsafe-place-local-ref cell.1) - (|#%app| fd-evt-fd fde_0)) - 1) - #f))) - (if or-part_0 - or-part_0 - (if (eqv? 2 (bitwise-and mode_0 2)) - (eqv? - (|#%app| - rktio_poll_write_ready - (unsafe-place-local-ref cell.1) - (|#%app| fd-evt-fd fde_0)) - 1) - #f))))) - (if ready?_0 - (values '(0) #f) - (let ((c1_0 - (if (not - (begin-unsafe (|#%app| poll-ctx-poll? ctx_0))) - (let ((app_0 (|#%app| fd-evt-fd fde_0))) - (fd-semaphore-update! - app_0 - (if (eqv? 1 (bitwise-and mode_0 1)) - 'read - 'write))) - #f))) - (if c1_0 - (values #f (wrap-evt c1_0 procz1)) - (begin - (sandman-poll-ctx-add-poll-set-adder! - ctx_0 - (lambda (ps_0) - (|#%app| - rktio_poll_add - (unsafe-place-local-ref cell.1) - (|#%app| fd-evt-fd fde_0) - ps_0 - mode_0))) - (values #f fde_0))))))))))))) + (lambda (fde_0 ctx_0) + (if (core-port-closed? (|#%app| fd-evt-closed fde_0)) + (values '(0) #f) + (let ((mode_0 (|#%app| fd-evt-mode fde_0))) + (let ((ready?_0 + (let ((or-part_0 + (if (eqv? 1 (bitwise-and mode_0 1)) + (eqv? + (|#%app| + rktio_poll_read_ready + (unsafe-place-local-ref cell.1) + (|#%app| fd-evt-fd fde_0)) + 1) + #f))) + (if or-part_0 + or-part_0 + (if (eqv? 2 (bitwise-and mode_0 2)) + (eqv? + (|#%app| + rktio_poll_write_ready + (unsafe-place-local-ref cell.1) + (|#%app| fd-evt-fd fde_0)) + 1) + #f))))) + (if ready?_0 + (values '(0) #f) + (let ((c1_0 + (if (not (begin-unsafe (|#%app| poll-ctx-poll? ctx_0))) + (let ((app_0 (|#%app| fd-evt-fd fde_0))) + (fd-semaphore-update! + app_0 + (if (eqv? 1 (bitwise-and mode_0 1)) 'read 'write))) + #f))) + (if c1_0 + (values #f (wrap-evt c1_0 (lambda (s_0) 0))) + (begin + (sandman-poll-ctx-add-poll-set-adder! + ctx_0 + (lambda (ps_0) + (|#%app| + rktio_poll_add + (unsafe-place-local-ref cell.1) + (|#%app| fd-evt-fd fde_0) + ps_0 + mode_0))) + (values #f fde_0)))))))))))) (current-inspector) #f '(0 1) @@ -11095,51 +10779,48 @@ fd-place-message-opener-ref) (make-struct-type-property 'fd-place-message-opener)) (define fd-port->place-message - (letrec ((procz2 - (|#%name| - opener - (lambda (port_0 name_0) - (begin - (open-output-fd.1 - 'infer - unsafe-undefined - unsafe-undefined - unsafe-undefined - port_0 - name_0))))) - (procz1 - (|#%name| - opener - (lambda (port_0 name_0) - (begin - (open-input-fd.1 - unsafe-undefined - unsafe-undefined - port_0 - name_0)))))) - (lambda (port_0) - (begin - (unsafe-start-atomic) - (if (1/port-closed? port_0) - #f - (let ((input?_0 (1/input-port? port_0))) - (let ((fd-dup_0 (dup-port-fd port_0))) - (let ((name_0 (core-port-name port_0))) - (let ((opener_0 - (let ((or-part_0 - (fd-place-message-opener-ref port_0 #f))) - (if or-part_0 - or-part_0 - (if input?_0 procz1 procz2))))) - (begin - (unsafe-end-atomic) - (lambda () - (begin - (unsafe-start-atomic) - (begin0 - (let ((fd_0 (claim-dup fd-dup_0))) - (|#%app| opener_0 fd_0 name_0)) - (unsafe-end-atomic)))))))))))))) + (lambda (port_0) + (begin + (unsafe-start-atomic) + (if (1/port-closed? port_0) + #f + (let ((input?_0 (1/input-port? port_0))) + (let ((fd-dup_0 (dup-port-fd port_0))) + (let ((name_0 (core-port-name port_0))) + (let ((opener_0 + (let ((or-part_0 (fd-place-message-opener-ref port_0 #f))) + (if or-part_0 + or-part_0 + (if input?_0 + (|#%name| + opener + (lambda (port_1 name_1) + (begin + (open-input-fd.1 + unsafe-undefined + unsafe-undefined + port_1 + name_1)))) + (|#%name| + opener + (lambda (port_1 name_1) + (begin + (open-output-fd.1 + 'infer + unsafe-undefined + unsafe-undefined + unsafe-undefined + port_1 + name_1))))))))) + (begin + (unsafe-end-atomic) + (lambda () + (begin + (unsafe-start-atomic) + (begin0 + (let ((fd_0 (claim-dup fd-dup_0))) + (|#%app| opener_0 fd_0 name_0)) + (unsafe-end-atomic))))))))))))) (define dup-port-fd (lambda (port_0) (let ((fd_0 (fd-port-fd port_0))) @@ -11281,208 +10962,205 @@ (core-input-port-methods-prepare-change.1 (core-port-vtable in_0)))) (if prepare-change_0 (|#%app| prepare-change_0 in_0) (void))))) (define read-some-bytes!.1 - (letrec ((procz1 (|#%name| timeout (lambda () (begin 0))))) - (|#%name| - read-some-bytes! - (lambda (copy-bstr?3_0 - enable-break?2_0 - keep-eof?4_0 - limit-special-arity?6_0 - special-ok?5_0 - zero-ok?1_0 - who13_0 - orig-in14_0 - bstr15_0 - start16_0 - end17_0) - (begin - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (in_0 extra-count-ins_0) + (|#%name| + read-some-bytes! + (lambda (copy-bstr?3_0 + enable-break?2_0 + keep-eof?4_0 + limit-special-arity?6_0 + special-ok?5_0 + zero-ok?1_0 + who13_0 + orig-in14_0 + bstr15_0 + start16_0 + end17_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (in_0 extra-count-ins_0) + (begin (begin - (begin - (unsafe-start-atomic) - (prepare-change in_0) - (if (fx= start16_0 end17_0) - (begin (unsafe-end-atomic) 0) - (if (core-port-closed? in_0) - (check-not-closed who13_0 in_0) - (if (core-input-port-pending-eof? in_0) - (begin - (if keep-eof?4_0 - (void) - (set-core-input-port-pending-eof?! in_0 #f)) - (unsafe-end-atomic) - eof) - (let ((buffer_0 (core-port-buffer in_0))) - (let ((buf-pos_0 (direct-pos buffer_0))) - (let ((buf-end_0 (direct-end buffer_0))) - (if (fx< buf-pos_0 buf-end_0) - (let ((v_0 - (let ((app_0 - (fx- buf-end_0 buf-pos_0))) - (fxmin - app_0 - (fx- end17_0 start16_0))))) - (let ((new-pos_0 (fx+ buf-pos_0 v_0))) - (begin - (unsafe-bytes-copy! + (unsafe-start-atomic) + (prepare-change in_0) + (if (fx= start16_0 end17_0) + (begin (unsafe-end-atomic) 0) + (if (core-port-closed? in_0) + (check-not-closed who13_0 in_0) + (if (core-input-port-pending-eof? in_0) + (begin + (if keep-eof?4_0 + (void) + (set-core-input-port-pending-eof?! in_0 #f)) + (unsafe-end-atomic) + eof) + (let ((buffer_0 (core-port-buffer in_0))) + (let ((buf-pos_0 (direct-pos buffer_0))) + (let ((buf-end_0 (direct-end buffer_0))) + (if (fx< buf-pos_0 buf-end_0) + (let ((v_0 + (let ((app_0 (fx- buf-end_0 buf-pos_0))) + (fxmin + app_0 + (fx- end17_0 start16_0))))) + (let ((new-pos_0 (fx+ buf-pos_0 v_0))) + (begin + (unsafe-bytes-copy! + bstr15_0 + start16_0 + (direct-bstr buffer_0) + buf-pos_0 + new-pos_0) + (set-direct-pos! buffer_0 new-pos_0) + (if (let ((or-part_0 + (pair? extra-count-ins_0))) + (if or-part_0 + or-part_0 + (core-port-count in_0))) + (port-count-all! + in_0 + extra-count-ins_0 + v_0 bstr15_0 - start16_0 - (direct-bstr buffer_0) - buf-pos_0 - new-pos_0) - (set-direct-pos! buffer_0 new-pos_0) - (if (let ((or-part_0 - (pair? extra-count-ins_0))) - (if or-part_0 - or-part_0 - (core-port-count in_0))) - (port-count-all! - in_0 - extra-count-ins_0 - v_0 - bstr15_0 - start16_0) - (void)) - (unsafe-end-atomic) - v_0))) - (let ((read-in_0 - (core-input-port-methods-read-in.1 - (core-port-vtable in_0)))) - (if (procedure? read-in_0) - (let ((v_0 - (|#%app| - read-in_0 - in_0 - bstr15_0 - start16_0 - end17_0 - copy-bstr?3_0))) - (letrec* - ((result-loop_0 - (|#%name| - result-loop - (lambda (v_1) + start16_0) + (void)) + (unsafe-end-atomic) + v_0))) + (let ((read-in_0 + (core-input-port-methods-read-in.1 + (core-port-vtable in_0)))) + (if (procedure? read-in_0) + (let ((v_0 + (|#%app| + read-in_0 + in_0 + bstr15_0 + start16_0 + end17_0 + copy-bstr?3_0))) + (letrec* + ((result-loop_0 + (|#%name| + result-loop + (lambda (v_1) + (begin (begin - (begin - (if (if (integer? v_1) - (not (eq? v_1 0)) - #f) - (port-count-all! + (if (if (integer? v_1) + (not (eq? v_1 0)) + #f) + (port-count-all! + in_0 + extra-count-ins_0 + v_1 + bstr15_0 + start16_0) + (if (procedure? v_1) + (port-count-byte-all! in_0 extra-count-ins_0 - v_1 - bstr15_0 - start16_0) - (if (procedure? v_1) - (port-count-byte-all! + #f) + (void))) + (unsafe-end-atomic) + (if (exact-nonnegative-integer? + v_1) + (if (zero? v_1) + (if zero-ok?1_0 + 0 + (loop_0 in_0 - extra-count-ins_0 - #f) - (void))) - (unsafe-end-atomic) - (if (exact-nonnegative-integer? - v_1) - (if (zero? v_1) - (if zero-ok?1_0 - 0 - (loop_0 - in_0 - extra-count-ins_0)) - (if (<= - v_1 - (- - end17_0 - start16_0)) - v_1 - (raise-arguments-error - who13_0 - "result integer is larger than the supplied byte string" - "result" + extra-count-ins_0)) + (if (<= v_1 - "byte-string length" - (- - end17_0 - start16_0)))) - (if (eof-object? v_1) - eof - (if (semaphore? v_1) - (if zero-ok?1_0 - (if (semaphore-try-wait? - v_1) - (loop_0 - in_0 - extra-count-ins_0) - 0) - (begin - (if enable-break?2_0 - (semaphore-wait/enable-break - v_1) - (semaphore-wait - v_1)) - (loop_0 - in_0 - extra-count-ins_0))) - (if (evt? v_1) - (let ((timeout_0 - (if zero-ok?1_0 - procz1 - #f))) - (let ((next-v_0 - (if enable-break?2_0 - (sync/timeout/enable-break - timeout_0 - v_1) - (sync/timeout - timeout_0 - v_1)))) - (if (if zero-ok?1_0 - (evt? - next-v_0) - #f) - 0 - (begin - (unsafe-start-atomic) - (result-loop_0 - next-v_0))))) - (if (procedure? v_1) - (if special-ok?5_0 - (if limit-special-arity?6_0 - (lambda (a_0 - b_0 - c_0 - d_0) - (|#%app| - v_1 - a_0 - b_0 - c_0 - d_0)) - v_1) - (raise-arguments-error - who13_0 - "non-character in an unsupported context" - "port" - orig-in14_0)) - (internal-error - (format - "weird read-bytes result ~s" - v_1))))))))))))) - (result-loop_0 v_0))) - (begin - (unsafe-end-atomic) - (loop_0 - (->core-input-port.1 - unsafe-undefined - read-in_0 - #f) - (cons - in_0 - extra-count-ins_0)))))))))))))))))) - (loop_0 orig-in14_0 null))))))) + (- end17_0 start16_0)) + v_1 + (raise-arguments-error + who13_0 + "result integer is larger than the supplied byte string" + "result" + v_1 + "byte-string length" + (- end17_0 start16_0)))) + (if (eof-object? v_1) + eof + (if (semaphore? v_1) + (if zero-ok?1_0 + (if (semaphore-try-wait? + v_1) + (loop_0 + in_0 + extra-count-ins_0) + 0) + (begin + (if enable-break?2_0 + (semaphore-wait/enable-break + v_1) + (semaphore-wait + v_1)) + (loop_0 + in_0 + extra-count-ins_0))) + (if (evt? v_1) + (let ((timeout_0 + (if zero-ok?1_0 + (|#%name| + timeout + (lambda () + (begin 0))) + #f))) + (let ((next-v_0 + (if enable-break?2_0 + (sync/timeout/enable-break + timeout_0 + v_1) + (sync/timeout + timeout_0 + v_1)))) + (if (if zero-ok?1_0 + (evt? + next-v_0) + #f) + 0 + (begin + (unsafe-start-atomic) + (result-loop_0 + next-v_0))))) + (if (procedure? v_1) + (if special-ok?5_0 + (if limit-special-arity?6_0 + (lambda (a_0 + b_0 + c_0 + d_0) + (|#%app| + v_1 + a_0 + b_0 + c_0 + d_0)) + v_1) + (raise-arguments-error + who13_0 + "non-character in an unsupported context" + "port" + orig-in14_0)) + (internal-error + (format + "weird read-bytes result ~s" + v_1))))))))))))) + (result-loop_0 v_0))) + (begin + (unsafe-end-atomic) + (loop_0 + (->core-input-port.1 + unsafe-undefined + read-in_0 + #f) + (cons + in_0 + extra-count-ins_0)))))))))))))))))) + (loop_0 orig-in14_0 null)))))) (define peek-some-bytes!.1 (|#%name| peek-some-bytes! @@ -11717,36 +11395,40 @@ skip-k60_0))) (if (eq? v_0 1) (unsafe-bytes-ref bstr_0 0) v_0))))))) (define maybe-read-a-line - (letrec ((finish_0 - (|#%name| - finish - (lambda (as-string?_0 bstr_0 buffer_0 in_0 pos_0 end_0 read-end_0) - (begin - (begin - (set-direct-pos! buffer_0 read-end_0) - (begin - (if (core-port-count in_0) - (port-count! in_0 (fx- read-end_0 pos_0) bstr_0 pos_0) - (void)) - (let ((result_0 - (if as-string?_0 - (a-bytes->string/utf-8.1 - #f - bstr_0 - pos_0 - end_0 - '#\xfffd) - (subbytes bstr_0 pos_0 end_0)))) - (begin (unsafe-end-atomic) result_0))))))))) - (lambda (in_0 cr?_0 lf?_0 crlf?_0 as-string?_0) - (begin - (unsafe-start-atomic) - (let ((buffer_0 (core-port-buffer in_0))) - (let ((bstr_0 (direct-bstr buffer_0))) - (let ((pos_0 (direct-pos buffer_0))) - (let ((end_0 - (let ((app_0 (direct-end buffer_0))) - (fxmin app_0 (fx+ pos_0 4096))))) + (lambda (in_0 cr?_0 lf?_0 crlf?_0 as-string?_0) + (begin + (unsafe-start-atomic) + (let ((buffer_0 (core-port-buffer in_0))) + (let ((bstr_0 (direct-bstr buffer_0))) + (let ((pos_0 (direct-pos buffer_0))) + (let ((end_0 + (let ((app_0 (direct-end buffer_0))) + (fxmin app_0 (fx+ pos_0 4096))))) + (let ((finish_0 + (|#%name| + finish + (lambda (end_1 read-end_0) + (begin + (begin + (set-direct-pos! buffer_0 read-end_0) + (begin + (if (core-port-count in_0) + (port-count! + in_0 + (fx- read-end_0 pos_0) + bstr_0 + pos_0) + (void)) + (let ((result_0 + (if as-string?_0 + (a-bytes->string/utf-8.1 + #f + bstr_0 + pos_0 + end_1 + '#\xfffd) + (subbytes bstr_0 pos_0 end_1)))) + (begin (unsafe-end-atomic) result_0))))))))) (letrec* ((loop_0 (|#%name| @@ -11757,14 +11439,7 @@ (begin (unsafe-end-atomic) #f) (let ((b_0 (unsafe-bytes-ref bstr_0 i_0))) (if (if lf?_0 (eqv? b_0 10) #f) - (finish_0 - as-string?_0 - bstr_0 - buffer_0 - in_0 - pos_0 - i_0 - (fx+ i_0 1)) + (finish_0 i_0 (fx+ i_0 1)) (if (if (if cr?_0 cr?_0 crlf?_0) (eqv? b_0 13) #f) @@ -11775,25 +11450,11 @@ 10) #f) #f) - (finish_0 - as-string?_0 - bstr_0 - buffer_0 - in_0 - pos_0 - i_0 - (fx+ i_0 2)) + (finish_0 i_0 (fx+ i_0 2)) (if cr?_0 (if (if crlf?_0 (fx= (fx+ i_0 1) end_0) #f) (begin (unsafe-end-atomic) #f) - (finish_0 - as-string?_0 - bstr_0 - buffer_0 - in_0 - pos_0 - i_0 - (fx+ i_0 1))) + (finish_0 i_0 (fx+ i_0 1))) (loop_0 (fx+ i_0 1)))) (loop_0 (fx+ i_0 1))))))))))) (loop_0 pos_0)))))))))) @@ -12900,242 +12561,242 @@ 0 unsafe-undefined)))))) (define read-some-chars!.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (bstr_0 - consumed-v_0 - just-peek?4_0 - orig-in14_0 - special-ok?6_0 - str15_0 - who13_0 - zero-ok?1_0 - skip-k_0 - total-used-bytes_0 - state_0 - total-chars_0 - start_0 - amt_0) - (begin - (let ((v_0 - (peek-some-bytes!.1 - #t - #f - #t - #f - special-ok?6_0 - zero-ok?1_0 - who13_0 - orig-in14_0 - bstr_0 - 0 - 1 - skip-k_0))) - (if (if (eq? v_0 0) (zero? consumed-v_0) #f) - (values 0 0) - (call-with-values - (lambda () - (if (eq? v_0 0) - (values 0 0 state_0) - (let ((temp108_0 (if (integer? v_0) v_0 0))) - (let ((temp111_0 (+ start_0 amt_0))) - (let ((temp113_0 - (if (utf-8-state? state_0) state_0 #f))) - (let ((temp114_0 - (if (integer? v_0) 'state 'error))) - (let ((temp113_1 temp113_0) - (temp111_1 temp111_0) - (temp108_1 temp108_0)) - (utf-8-decode!.1 - temp114_0 - '#\xfffd - temp113_1 - bstr_0 - 0 - temp108_1 - str15_0 - start_0 - temp111_1)))))))) - (case-lambda - ((used-bytes_0 got-chars_0 new-state_0) - (if (zero? got-chars_0) - (let ((app_0 (+ skip-k_0 v_0))) - (loop_0 - bstr_0 - consumed-v_0 - just-peek?4_0 - orig-in14_0 - special-ok?6_0 - str15_0 - who13_0 - zero-ok?1_0 - app_0 - (+ total-used-bytes_0 used-bytes_0) - new-state_0 - total-chars_0 - start_0 - amt_0)) - (let ((actually-used-bytes_0 - (let ((app_0 - (+ total-used-bytes_0 used-bytes_0))) - (- - app_0 - (if (utf-8-state? new-state_0) - (utf-8-state-pending-amt new-state_0) - 0))))) - (if (< actually-used-bytes_0 consumed-v_0) - (let ((app_0 (+ skip-k_0 v_0))) - (let ((app_1 - (+ total-used-bytes_0 used-bytes_0))) - (let ((app_2 (+ total-chars_0 got-chars_0))) - (let ((app_3 (+ start_0 got-chars_0))) - (loop_0 - bstr_0 - consumed-v_0 - just-peek?4_0 - orig-in14_0 - special-ok?6_0 - str15_0 - who13_0 - zero-ok?1_0 - app_0 - app_1 - new-state_0 - app_2 - app_3 - (- amt_0 got-chars_0)))))) - (begin - (if just-peek?4_0 - (void) - (let ((discard-bytes_0 - (- - actually-used-bytes_0 - consumed-v_0))) - (let ((finish-bstr_0 - (if (<= - discard-bytes_0 - (unsafe-bytes-length bstr_0)) - bstr_0 - (make-bytes discard-bytes_0)))) - (do-read-bytes! - who13_0 - orig-in14_0 - finish-bstr_0 - 0 - discard-bytes_0)))) - (values - (+ total-chars_0 got-chars_0) - actually-used-bytes_0)))))) - (args - (raise-binding-result-arity-error 3 args))))))))))) - (|#%name| - read-some-chars! - (lambda (extra-bytes-amt2_0 - just-peek?4_0 - keep-eof?3_0 - skip5_0 - special-ok?6_0 - zero-ok?1_0 - who13_0 - orig-in14_0 - str15_0 - start16_0 - end17_0) - (begin - (let ((amt_0 (- end17_0 start16_0))) - (let ((bstr_0 (make-bytes amt_0))) - (let ((consumed-v_0 + (|#%name| + read-some-chars! + (lambda (extra-bytes-amt2_0 + just-peek?4_0 + keep-eof?3_0 + skip5_0 + special-ok?6_0 + zero-ok?1_0 + who13_0 + orig-in14_0 + str15_0 + start16_0 + end17_0) + (begin + (let ((amt_0 (- end17_0 start16_0))) + (let ((bstr_0 (make-bytes amt_0))) + (let ((consumed-v_0 + (if just-peek?4_0 + 0 + (read-some-bytes!.1 + #f + #f + keep-eof?3_0 + #t + special-ok?6_0 + zero-ok?1_0 + who13_0 + orig-in14_0 + bstr_0 + 0 + amt_0)))) + (let ((v_0 (if just-peek?4_0 - 0 - (read-some-bytes!.1 + (peek-some-bytes!.1 #f #f - keep-eof?3_0 #t - special-ok?6_0 + #f + #t zero-ok?1_0 who13_0 orig-in14_0 bstr_0 - 0 - amt_0)))) - (let ((v_0 - (if just-peek?4_0 - (peek-some-bytes!.1 + consumed-v_0 + amt_0 + skip5_0) + consumed-v_0))) + (if (not (exact-integer? v_0)) + (values v_0 0) + (if (zero? v_0) + (values 0 0) + (call-with-values + (lambda () + (let ((temp95_0 (+ start16_0 amt_0))) + (utf-8-decode!.1 + 'state + '#\xfffd #f - #f - #t - #f - #t - zero-ok?1_0 - who13_0 - orig-in14_0 bstr_0 - consumed-v_0 - amt_0 - skip5_0) - consumed-v_0))) - (if (not (exact-integer? v_0)) - (values v_0 0) - (if (zero? v_0) - (values 0 0) - (call-with-values - (lambda () - (let ((temp95_0 (+ start16_0 amt_0))) - (utf-8-decode!.1 - 'state - '#\xfffd - #f - bstr_0 - 0 - v_0 - str15_0 - start16_0 - temp95_0))) - (case-lambda - ((used-bytes_0 got-chars_0 state_0) - (let ((actually-used-bytes_0 - (- + 0 + v_0 + str15_0 + start16_0 + temp95_0))) + (case-lambda + ((used-bytes_0 got-chars_0 state_0) + (let ((actually-used-bytes_0 + (- + used-bytes_0 + (if (utf-8-state? state_0) + (utf-8-state-pending-amt state_0) + 0)))) + (if (let ((or-part_0 (zero? got-chars_0))) + (if or-part_0 + or-part_0 + (< actually-used-bytes_0 consumed-v_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (skip-k_0 + total-used-bytes_0 + state_1 + total-chars_0 + start_0 + amt_1) + (begin + (let ((v_1 + (peek-some-bytes!.1 + #t + #f + #t + #f + special-ok?6_0 + zero-ok?1_0 + who13_0 + orig-in14_0 + bstr_0 + 0 + 1 + skip-k_0))) + (if (if (eq? v_1 0) + (zero? consumed-v_0) + #f) + (values 0 0) + (call-with-values + (lambda () + (if (eq? v_1 0) + (values 0 0 state_1) + (let ((temp108_0 + (if (integer? v_1) v_1 0))) + (let ((temp111_0 + (+ start_0 amt_1))) + (let ((temp113_0 + (if (utf-8-state? + state_1) + state_1 + #f))) + (let ((temp114_0 + (if (integer? v_1) + 'state + 'error))) + (let ((temp113_1 temp113_0) + (temp111_1 temp111_0) + (temp108_1 temp108_0)) + (utf-8-decode!.1 + temp114_0 + '#\xfffd + temp113_1 + bstr_0 + 0 + temp108_1 + str15_0 + start_0 + temp111_1)))))))) + (case-lambda + ((used-bytes_1 got-chars_1 new-state_0) + (if (zero? got-chars_1) + (let ((app_0 (+ skip-k_0 v_1))) + (loop_0 + app_0 + (+ + total-used-bytes_0 + used-bytes_1) + new-state_0 + total-chars_0 + start_0 + amt_1)) + (let ((actually-used-bytes_1 + (let ((app_0 + (+ + total-used-bytes_0 + used-bytes_1))) + (- + app_0 + (if (utf-8-state? + new-state_0) + (utf-8-state-pending-amt + new-state_0) + 0))))) + (if (< + actually-used-bytes_1 + consumed-v_0) + (let ((app_0 (+ skip-k_0 v_1))) + (let ((app_1 + (+ + total-used-bytes_0 + used-bytes_1))) + (let ((app_2 + (+ + total-chars_0 + got-chars_1))) + (let ((app_3 + (+ + start_0 + got-chars_1))) + (loop_0 + app_0 + app_1 + new-state_0 + app_2 + app_3 + (- + amt_1 + got-chars_1)))))) + (begin + (if just-peek?4_0 + (void) + (let ((discard-bytes_0 + (- + actually-used-bytes_1 + consumed-v_0))) + (let ((finish-bstr_0 + (if (<= + discard-bytes_0 + (unsafe-bytes-length + bstr_0)) + bstr_0 + (make-bytes + discard-bytes_0)))) + (do-read-bytes! + who13_0 + orig-in14_0 + finish-bstr_0 + 0 + discard-bytes_0)))) + (values + (+ total-chars_0 got-chars_1) + actually-used-bytes_1)))))) + (args + (raise-binding-result-arity-error + 3 + args))))))))))) + (let ((app_0 (+ skip5_0 (- v_0 consumed-v_0)))) + (let ((app_1 (+ start16_0 got-chars_0))) + (loop_0 + app_0 used-bytes_0 - (if (utf-8-state? state_0) - (utf-8-state-pending-amt state_0) - 0)))) - (if (let ((or-part_0 (zero? got-chars_0))) - (if or-part_0 - or-part_0 - (< actually-used-bytes_0 consumed-v_0))) - (let ((app_0 (+ skip5_0 (- v_0 consumed-v_0)))) - (let ((app_1 (+ start16_0 got-chars_0))) - (loop_0 - bstr_0 - consumed-v_0 - just-peek?4_0 - orig-in14_0 - special-ok?6_0 - str15_0 - who13_0 - zero-ok?1_0 - app_0 - used-bytes_0 - state_0 - got-chars_0 - app_1 - (- amt_0 got-chars_0)))) - (begin - (if (if just-peek?4_0 - just-peek?4_0 - (= actually-used-bytes_0 consumed-v_0)) - (void) - (do-read-bytes! - who13_0 - orig-in14_0 - bstr_0 - 0 - (- actually-used-bytes_0 consumed-v_0))) - (values got-chars_0 actually-used-bytes_0))))) - (args - (raise-binding-result-arity-error 3 args))))))))))))))) + state_0 + got-chars_0 + app_1 + (- amt_0 got-chars_0))))) + (begin + (if (if just-peek?4_0 + just-peek?4_0 + (= actually-used-bytes_0 consumed-v_0)) + (void) + (do-read-bytes! + who13_0 + orig-in14_0 + bstr_0 + 0 + (- actually-used-bytes_0 consumed-v_0))) + (values got-chars_0 actually-used-bytes_0))))) + (args + (raise-binding-result-arity-error 3 args)))))))))))))) (define do-read-string!.1 (|#%name| do-read-string! @@ -14682,134 +14343,136 @@ (define ok-mode-str "(or/c 'linefeed 'return 'return-linefeed 'any 'any-one)") (define 1/read-line (let ((read-line_0 - (letrec ((keep-char_0 - (|#%name| - keep-char - (lambda (ch_0 cr?_0 crlf?_0 in_0 len_0 lf?_0 pos_0 str_0) - (begin - (if (fx< pos_0 len_0) - (begin - (string-set! str_0 pos_0 ch_0) - (loop_0 - cr?_0 - crlf?_0 - in_0 - lf?_0 - str_0 - len_0 - (fx+ pos_0 1))) - (let ((new-len_0 (fx* len_0 2))) - (let ((new-str_0 (make-string new-len_0))) - (begin - (string-copy! new-str_0 0 str_0 0) - (string-set! new-str_0 pos_0 ch_0) - (loop_0 - cr?_0 - crlf?_0 - in_0 - lf?_0 - new-str_0 - new-len_0 - (fx+ pos_0 1)))))))))) - (loop_0 - (|#%name| - loop - (lambda (cr?_0 crlf?_0 in_0 lf?_0 str_0 len_0 pos_0) - (begin - (let ((ch_0 (read-a-char.1 #f 'read-line in_0))) - (if (eof-object? ch_0) - (if (fx= pos_0 0) eof (substring str_0 0 pos_0)) - (if (if (if cr?_0 cr?_0 crlf?_0) - (eqv? ch_0 (values '#\xd)) - #f) - (if (if crlf?_0 - (eqv? - (peek-a-char.1 #f 'read-line in_0 0) - (values '#\xa)) - #f) - (begin - (read-a-char.1 #f 'read-line in_0) - (substring str_0 0 pos_0)) - (if cr?_0 - (substring str_0 0 pos_0) - (keep-char_0 - ch_0 - cr?_0 - crlf?_0 - in_0 - len_0 - lf?_0 - pos_0 - str_0))) - (if (if lf?_0 (eqv? ch_0 (values '#\xa)) #f) - (substring str_0 0 pos_0) - (keep-char_0 - ch_0 - cr?_0 - crlf?_0 - in_0 - len_0 - lf?_0 - pos_0 - str_0)))))))))) - (|#%name| - read-line - (lambda (orig-in1_0 mode2_0) - (begin - (let ((orig-in_0 - (if (eq? orig-in1_0 unsafe-undefined) - (1/current-input-port) - orig-in1_0))) - (let ((in_0 - (->core-input-port.1 - unsafe-undefined - orig-in_0 - 'read-line))) + (|#%name| + read-line + (lambda (orig-in1_0 mode2_0) + (begin + (let ((orig-in_0 + (if (eq? orig-in1_0 unsafe-undefined) + (1/current-input-port) + orig-in1_0))) + (let ((in_0 + (->core-input-port.1 + unsafe-undefined + orig-in_0 + 'read-line))) + (begin + (if (ok-mode? mode2_0) + (void) + (raise-argument-error 'read-line ok-mode-str mode2_0)) (begin - (if (ok-mode? mode2_0) - (void) - (raise-argument-error 'read-line ok-mode-str mode2_0)) - (begin - (maybe-flush-stdout orig-in_0) - (let ((cr?_0 - (if (if (eq? mode2_0 'return) + (maybe-flush-stdout orig-in_0) + (let ((cr?_0 + (if (if (eq? mode2_0 'return) + #t + (if (eq? mode2_0 'any) + #t + (eq? mode2_0 'any-one))) + #t + #f))) + (let ((lf?_0 + (if (if (eq? mode2_0 'linefeed) #t (if (eq? mode2_0 'any) #t (eq? mode2_0 'any-one))) #t #f))) - (let ((lf?_0 - (if (if (eq? mode2_0 'linefeed) + (let ((crlf?_0 + (if (if (eq? mode2_0 'return-linefeed) #t - (if (eq? mode2_0 'any) - #t - (eq? mode2_0 'any-one))) + (eq? mode2_0 'any)) #t #f))) - (let ((crlf?_0 - (if (if (eq? mode2_0 'return-linefeed) - #t - (eq? mode2_0 'any)) - #t - #f))) - (let ((c1_0 - (maybe-read-a-line - in_0 - cr?_0 - lf?_0 - crlf?_0 - #t))) - (if c1_0 - c1_0 - (loop_0 - cr?_0 - crlf?_0 - in_0 - lf?_0 - (make-string 32) - 32 - 0)))))))))))))))) + (let ((c1_0 + (maybe-read-a-line + in_0 + cr?_0 + lf?_0 + crlf?_0 + #t))) + (if c1_0 + c1_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (str_0 len_0 pos_0) + (begin + (let ((ch_0 + (read-a-char.1 + #f + 'read-line + in_0))) + (let ((keep-char_0 + (|#%name| + keep-char + (lambda () + (begin + (if (fx< pos_0 len_0) + (begin + (string-set! + str_0 + pos_0 + ch_0) + (loop_0 + str_0 + len_0 + (fx+ pos_0 1))) + (let ((new-len_0 + (fx* len_0 2))) + (let ((new-str_0 + (make-string + new-len_0))) + (begin + (string-copy! + new-str_0 + 0 + str_0 + 0) + (string-set! + new-str_0 + pos_0 + ch_0) + (loop_0 + new-str_0 + new-len_0 + (fx+ + pos_0 + 1))))))))))) + (if (eof-object? ch_0) + (if (fx= pos_0 0) + eof + (substring str_0 0 pos_0)) + (if (if (if cr?_0 cr?_0 crlf?_0) + (eqv? ch_0 (values '#\xd)) + #f) + (if (if crlf?_0 + (eqv? + (peek-a-char.1 + #f + 'read-line + in_0 + 0) + (values '#\xa)) + #f) + (begin + (read-a-char.1 + #f + 'read-line + in_0) + (substring str_0 0 pos_0)) + (if cr?_0 + (substring str_0 0 pos_0) + (keep-char_0))) + (if (if lf?_0 + (eqv? + ch_0 + (values '#\xa)) + #f) + (substring str_0 0 pos_0) + (keep-char_0))))))))))) + (loop_0 (make-string 32) 32 0)))))))))))))))) (|#%name| read-line (case-lambda @@ -14818,135 +14481,137 @@ ((orig-in1_0) (read-line_0 orig-in1_0 'linefeed)))))) (define 1/read-bytes-line (let ((read-bytes-line_0 - (letrec ((keep-char_0 - (|#%name| - keep-char - (lambda (ch_0 cr?_0 crlf?_0 in_0 len_0 lf?_0 pos_0 str_0) - (begin - (if (fx< pos_0 len_0) - (begin - (unsafe-bytes-set! str_0 pos_0 ch_0) - (loop_0 - cr?_0 - crlf?_0 - in_0 - lf?_0 - str_0 - len_0 - (fx+ pos_0 1))) - (let ((new-len_0 (fx* len_0 2))) - (let ((new-str_0 (make-bytes new-len_0))) - (begin - (unsafe-bytes-copy! new-str_0 0 str_0 0) - (unsafe-bytes-set! new-str_0 pos_0 ch_0) - (loop_0 - cr?_0 - crlf?_0 - in_0 - lf?_0 - new-str_0 - new-len_0 - (fx+ pos_0 1)))))))))) - (loop_0 - (|#%name| - loop - (lambda (cr?_0 crlf?_0 in_0 lf?_0 str_0 len_0 pos_0) - (begin - (let ((ch_0 (read-a-byte.1 #f 'read-bytes-line in_0))) - (if (eof-object? ch_0) - (if (fx= pos_0 0) eof (subbytes str_0 0 pos_0)) - (if (if (if cr?_0 cr?_0 crlf?_0) (eqv? ch_0 13) #f) - (if (if crlf?_0 - (eqv? - (peek-a-byte.1 #f 'read-bytes-line in_0 0) - 10) - #f) - (begin - (read-a-byte.1 #f 'read-bytes-line in_0) - (subbytes str_0 0 pos_0)) - (if cr?_0 - (subbytes str_0 0 pos_0) - (keep-char_0 - ch_0 - cr?_0 - crlf?_0 - in_0 - len_0 - lf?_0 - pos_0 - str_0))) - (if (if lf?_0 (eqv? ch_0 10) #f) - (subbytes str_0 0 pos_0) - (keep-char_0 - ch_0 - cr?_0 - crlf?_0 - in_0 - len_0 - lf?_0 - pos_0 - str_0)))))))))) - (|#%name| - read-bytes-line - (lambda (orig-in3_0 mode4_0) - (begin - (let ((orig-in_0 - (if (eq? orig-in3_0 unsafe-undefined) - (1/current-input-port) - orig-in3_0))) - (let ((in_0 - (->core-input-port.1 - unsafe-undefined - orig-in_0 - 'read-bytes-line))) + (|#%name| + read-bytes-line + (lambda (orig-in3_0 mode4_0) + (begin + (let ((orig-in_0 + (if (eq? orig-in3_0 unsafe-undefined) + (1/current-input-port) + orig-in3_0))) + (let ((in_0 + (->core-input-port.1 + unsafe-undefined + orig-in_0 + 'read-bytes-line))) + (begin + (if (ok-mode? mode4_0) + (void) + (raise-argument-error + 'read-bytes-line + ok-mode-str + mode4_0)) (begin - (if (ok-mode? mode4_0) - (void) - (raise-argument-error - 'read-bytes-line - ok-mode-str - mode4_0)) - (begin - (maybe-flush-stdout orig-in_0) - (let ((cr?_0 - (if (if (eq? mode4_0 'return) + (maybe-flush-stdout orig-in_0) + (let ((cr?_0 + (if (if (eq? mode4_0 'return) + #t + (if (eq? mode4_0 'any) + #t + (eq? mode4_0 'any-one))) + #t + #f))) + (let ((lf?_0 + (if (if (eq? mode4_0 'linefeed) #t (if (eq? mode4_0 'any) #t (eq? mode4_0 'any-one))) #t #f))) - (let ((lf?_0 - (if (if (eq? mode4_0 'linefeed) + (let ((crlf?_0 + (if (if (eq? mode4_0 'return-linefeed) #t - (if (eq? mode4_0 'any) - #t - (eq? mode4_0 'any-one))) + (eq? mode4_0 'any)) #t #f))) - (let ((crlf?_0 - (if (if (eq? mode4_0 'return-linefeed) - #t - (eq? mode4_0 'any)) - #t - #f))) - (let ((c2_0 - (maybe-read-a-line - in_0 - cr?_0 - lf?_0 - crlf?_0 - #f))) - (if c2_0 - c2_0 - (loop_0 - cr?_0 - crlf?_0 - in_0 - lf?_0 - (make-bytes 32) - 32 - 0)))))))))))))))) + (let ((c2_0 + (maybe-read-a-line + in_0 + cr?_0 + lf?_0 + crlf?_0 + #f))) + (if c2_0 + c2_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (str_0 len_0 pos_0) + (begin + (let ((ch_0 + (read-a-byte.1 + #f + 'read-bytes-line + in_0))) + (let ((keep-char_0 + (|#%name| + keep-char + (lambda () + (begin + (if (fx< pos_0 len_0) + (begin + (unsafe-bytes-set! + str_0 + pos_0 + ch_0) + (loop_0 + str_0 + len_0 + (fx+ pos_0 1))) + (let ((new-len_0 + (fx* len_0 2))) + (let ((new-str_0 + (make-bytes + new-len_0))) + (begin + (unsafe-bytes-copy! + new-str_0 + 0 + str_0 + 0) + (unsafe-bytes-set! + new-str_0 + pos_0 + ch_0) + (loop_0 + new-str_0 + new-len_0 + (fx+ + pos_0 + 1))))))))))) + (if (eof-object? ch_0) + (if (fx= pos_0 0) + eof + (subbytes str_0 0 pos_0)) + (if (if (if cr?_0 cr?_0 crlf?_0) + (eqv? ch_0 13) + #f) + (if (if crlf?_0 + (eqv? + (peek-a-byte.1 + #f + 'read-bytes-line + in_0 + 0) + 10) + #f) + (begin + (read-a-byte.1 + #f + 'read-bytes-line + in_0) + (subbytes str_0 0 pos_0)) + (if cr?_0 + (subbytes str_0 0 pos_0) + (keep-char_0))) + (if (if lf?_0 + (eqv? ch_0 10) + #f) + (subbytes str_0 0 pos_0) + (keep-char_0))))))))))) + (loop_0 (make-bytes 32) 32 0)))))))))))))))) (|#%name| read-bytes-line (case-lambda @@ -15235,894 +14900,537 @@ (if (eq? status_0 'continues) 28 #f))))) (args (raise-binding-result-arity-error 3 args)))))))) (define utf-8-ish-reencode!.1 - (letrec ((continue-after-permissive_0 - (|#%name| - continue-after-permissive - (lambda (base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - next-j_0) - (begin - (let ((next-i_0 (add1 base-i_0))) - (if (= next-j_0 out-end13_0) - (let ((app_0 (- next-i_0 in-start9_0))) - (values app_0 (- next-j_0 out-start12_0) 'continues)) - (loop_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - next-i_0 - next-j_0 - next-i_0 - 0 - 0))))))) - (continue_0 - (|#%name| - continue - (lambda (from-utf-8-ish?3_0 - i_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - next-j_0) - (begin - (let ((next-i_0 (add1 i_0))) - (if (= next-j_0 out-end13_0) - (let ((app_0 (- next-i_0 in-start9_0))) - (let ((app_1 (- next-j_0 out-start12_0))) - (values - app_0 - app_1 - (if (= next-i_0 in-end10_0) 'complete 'continues)))) - (loop_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - next-i_0 - next-j_0 - next-i_0 - 0 - 0))))))) - (encoding-failure_0 - (|#%name| - encoding-failure - (lambda (base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0) - (begin - (if permissive?2_0 - (if (if (not to-utf-16?4_0) (<= (+ j_0 3) out-end13_0) #f) - (begin - (unsafe-bytes-set! out-bstr11_0 j_0 239) - (unsafe-bytes-set! out-bstr11_0 (+ j_0 1) 191) - (unsafe-bytes-set! out-bstr11_0 (+ j_0 2) 189) - (continue-after-permissive_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - (+ j_0 3))) - (if (if to-utf-16?4_0 (<= (+ j_0 2) out-end13_0) #f) - (begin - (bytes-set-two! out-bstr11_0 j_0 255 253) - (continue-after-permissive_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - (+ j_0 2))) - (let ((app_0 (- base-i_0 in-start9_0))) - (values app_0 (- j_0 out-start12_0) 'continues)))) - (let ((app_0 (- base-i_0 in-start9_0))) - (values app_0 (- j_0 out-start12_0) 'error))))))) - (loop_0 - (|#%name| - loop - (lambda (from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - i_0 - j_0 - base-i_0 - accum_0 - remaining_0) - (begin - (if (= i_0 in-end10_0) - (if (zero? remaining_0) - (let ((app_0 (- base-i_0 in-start9_0))) - (values app_0 (- j_0 out-start12_0) 'complete)) - (let ((app_0 (- base-i_0 in-start9_0))) - (values app_0 (- j_0 out-start12_0) 'aborts))) - (let ((b_0 (unsafe-bytes-ref in-bstr8_0 i_0))) - (if (< b_0 128) - (if (zero? remaining_0) - (if (if (not to-utf-16?4_0) (< j_0 out-end13_0) #f) - (begin - (unsafe-bytes-set! out-bstr11_0 j_0 b_0) - (continue_0 - from-utf-8-ish?3_0 - i_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - (add1 j_0))) - (if (< (add1 j_0) out-end13_0) - (begin - (bytes-set-two! out-bstr11_0 j_0 0 b_0) - (continue_0 - from-utf-8-ish?3_0 - i_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - (+ j_0 2))) + (|#%name| + utf-8-ish-reencode! + (lambda (from-utf-8-ish?3_0 + permissive?2_0 + to-utf-16?4_0 + in-bstr8_0 + in-start9_0 + in-end10_0 + out-bstr11_0 + out-start12_0 + out-end13_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 j_0 base-i_0 accum_0 remaining_0) + (begin + (let ((encoding-failure_0 + (|#%name| + encoding-failure + (lambda () + (begin + (if permissive?2_0 + (let ((continue-after-permissive_0 + (|#%name| + continue-after-permissive + (lambda (next-j_0) + (begin + (let ((next-i_0 (add1 base-i_0))) + (if (= next-j_0 out-end13_0) + (let ((app_0 + (- next-i_0 in-start9_0))) + (values + app_0 + (- next-j_0 out-start12_0) + 'continues)) + (loop_0 + next-i_0 + next-j_0 + next-i_0 + 0 + 0)))))))) + (if (if (not to-utf-16?4_0) + (<= (+ j_0 3) out-end13_0) + #f) + (begin + (unsafe-bytes-set! out-bstr11_0 j_0 239) + (unsafe-bytes-set! + out-bstr11_0 + (+ j_0 1) + 191) + (unsafe-bytes-set! + out-bstr11_0 + (+ j_0 2) + 189) + (continue-after-permissive_0 (+ j_0 3))) + (if (if to-utf-16?4_0 + (<= (+ j_0 2) out-end13_0) + #f) + (begin + (bytes-set-two! out-bstr11_0 j_0 255 253) + (continue-after-permissive_0 (+ j_0 2))) + (let ((app_0 (- base-i_0 in-start9_0))) + (values + app_0 + (- j_0 out-start12_0) + 'continues))))) (let ((app_0 (- base-i_0 in-start9_0))) (values app_0 (- j_0 out-start12_0) - 'continues)))) - (encoding-failure_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0)) - (if (= 128 (bitwise-and b_0 192)) + 'error)))))))) + (let ((continue_0 + (|#%name| + continue + (lambda (next-j_0) + (begin + (let ((next-i_0 (add1 i_0))) + (if (= next-j_0 out-end13_0) + (let ((app_0 (- next-i_0 in-start9_0))) + (let ((app_1 (- next-j_0 out-start12_0))) + (values + app_0 + app_1 + (if (= next-i_0 in-end10_0) + 'complete + 'continues)))) + (loop_0 next-i_0 next-j_0 next-i_0 0 0)))))))) + (if (= i_0 in-end10_0) + (if (zero? remaining_0) + (let ((app_0 (- base-i_0 in-start9_0))) + (values app_0 (- j_0 out-start12_0) 'complete)) + (let ((app_0 (- base-i_0 in-start9_0))) + (values app_0 (- j_0 out-start12_0) 'aborts))) + (let ((b_0 (unsafe-bytes-ref in-bstr8_0 i_0))) + (if (< b_0 128) (if (zero? remaining_0) - (encoding-failure_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0) - (let ((next_0 (bitwise-and b_0 63))) - (let ((next-accum_0 - (+ (arithmetic-shift accum_0 6) next_0))) - (if (= 1 remaining_0) - (let ((next-i_0 (add1 i_0))) - (if (< next-accum_0 128) - (encoding-failure_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0) - (if (if from-utf-8-ish?3_0 - from-utf-8-ish?3_0 - (not - (let ((or-part_0 - (> next-accum_0 1114111))) - (if or-part_0 - or-part_0 - (if (>= next-accum_0 55296) - (<= next-accum_0 57343) - #f))))) - (if to-utf-16?4_0 - (if (if (< next-accum_0 65536) - (<= (+ j_0 2) out-end13_0) - #f) - (begin - (let ((app_0 - (arithmetic-shift - next-accum_0 - -8))) - (bytes-set-two! - out-bstr11_0 - j_0 - app_0 - (bitwise-and - next-accum_0 - 255))) - (continue_0 - from-utf-8-ish?3_0 - i_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - (+ j_0 2))) - (if (<= (+ j_0 4) out-end13_0) - (let ((av_0 - (- next-accum_0 65536))) - (let ((hi_0 - (bitwise-ior - 55296 - (bitwise-and - (arithmetic-shift - av_0 - -10) - 1023)))) - (let ((lo_0 + (if (if (not to-utf-16?4_0) (< j_0 out-end13_0) #f) + (begin + (unsafe-bytes-set! out-bstr11_0 j_0 b_0) + (continue_0 (add1 j_0))) + (if (< (add1 j_0) out-end13_0) + (begin + (bytes-set-two! out-bstr11_0 j_0 0 b_0) + (continue_0 (+ j_0 2))) + (let ((app_0 (- base-i_0 in-start9_0))) + (values + app_0 + (- j_0 out-start12_0) + 'continues)))) + (encoding-failure_0)) + (if (= 128 (bitwise-and b_0 192)) + (if (zero? remaining_0) + (encoding-failure_0) + (let ((next_0 (bitwise-and b_0 63))) + (let ((next-accum_0 + (+ (arithmetic-shift accum_0 6) next_0))) + (if (= 1 remaining_0) + (let ((next-i_0 (add1 i_0))) + (if (< next-accum_0 128) + (encoding-failure_0) + (if (if from-utf-8-ish?3_0 + from-utf-8-ish?3_0 + (not + (let ((or-part_0 + (> next-accum_0 1114111))) + (if or-part_0 + or-part_0 + (if (>= next-accum_0 55296) + (<= next-accum_0 57343) + #f))))) + (if to-utf-16?4_0 + (if (if (< next-accum_0 65536) + (<= (+ j_0 2) out-end13_0) + #f) + (begin + (let ((app_0 + (arithmetic-shift + next-accum_0 + -8))) + (bytes-set-two! + out-bstr11_0 + j_0 + app_0 + (bitwise-and + next-accum_0 + 255))) + (continue_0 (+ j_0 2))) + (if (<= (+ j_0 4) out-end13_0) + (let ((av_0 + (- next-accum_0 65536))) + (let ((hi_0 (bitwise-ior - 56320 + 55296 (bitwise-and - av_0 + (arithmetic-shift + av_0 + -10) 1023)))) - (begin - (let ((app_0 - (arithmetic-shift - hi_0 - -8))) - (bytes-set-two! - out-bstr11_0 - j_0 - app_0 - (bitwise-and - hi_0 - 255))) - (let ((app_0 (+ j_0 2))) - (let ((app_1 + (let ((lo_0 + (bitwise-ior + 56320 + (bitwise-and + av_0 + 1023)))) + (begin + (let ((app_0 (arithmetic-shift - lo_0 + hi_0 -8))) (bytes-set-two! out-bstr11_0 + j_0 app_0 - app_1 (bitwise-and - lo_0 - 255)))) - (continue_0 - from-utf-8-ish?3_0 - i_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - (+ j_0 4)))))) - (let ((app_0 - (- base-i_0 in-start9_0))) - (values - app_0 - (- j_0 out-start12_0) - 'continues)))) - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (from-i_0 to-j_0) - (begin - (if (= from-i_0 next-i_0) - (continue_0 - from-utf-8-ish?3_0 - i_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - to-j_0) - (if (= to-j_0 out-end13_0) - (let ((app_0 - (- - base-i_0 - in-start9_0))) - (values - app_0 - (- j_0 out-start12_0) - 'continues)) - (begin - (unsafe-bytes-set! - out-bstr11_0 - to-j_0 - (unsafe-bytes-ref - in-bstr8_0 - from-i_0)) + hi_0 + 255))) + (let ((app_0 (+ j_0 2))) + (let ((app_1 + (arithmetic-shift + lo_0 + -8))) + (bytes-set-two! + out-bstr11_0 + app_0 + app_1 + (bitwise-and + lo_0 + 255)))) + (continue_0 + (+ j_0 4)))))) + (let ((app_0 + (- + base-i_0 + in-start9_0))) + (values + app_0 + (- j_0 out-start12_0) + 'continues)))) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (from-i_0 to-j_0) + (begin + (if (= from-i_0 next-i_0) + (continue_0 to-j_0) + (if (= to-j_0 out-end13_0) (let ((app_0 - (add1 from-i_0))) - (loop_1 + (- + base-i_0 + in-start9_0))) + (values app_0 - (add1 - to-j_0))))))))))) - (loop_1 base-i_0 j_0))) - (encoding-failure_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0)))) - (if (if (= 2 remaining_0) - (<= next-accum_0 31) - #f) - (encoding-failure_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0) - (if (if (= 3 remaining_0) - (<= next-accum_0 15) + (- j_0 out-start12_0) + 'continues)) + (begin + (unsafe-bytes-set! + out-bstr11_0 + to-j_0 + (unsafe-bytes-ref + in-bstr8_0 + from-i_0)) + (let ((app_0 + (add1 + from-i_0))) + (loop_1 + app_0 + (add1 + to-j_0))))))))))) + (loop_1 base-i_0 j_0))) + (encoding-failure_0)))) + (if (if (= 2 remaining_0) + (<= next-accum_0 31) #f) - (encoding-failure_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0) - (let ((app_0 (add1 i_0))) - (loop_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - app_0 - j_0 - base-i_0 - next-accum_0 - (sub1 remaining_0))))))))) - (if (not (zero? remaining_0)) - (encoding-failure_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0) - (if (= 192 (bitwise-and b_0 224)) - (let ((accum_1 (bitwise-and b_0 31))) - (if (zero? accum_1) - (encoding-failure_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0) - (loop_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - (add1 i_0) - j_0 - i_0 - accum_1 - 1))) - (if (= 224 (bitwise-and b_0 240)) - (let ((accum_1 (bitwise-and b_0 15))) - (loop_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - (add1 i_0) - j_0 - i_0 - accum_1 - 2)) - (if (= 240 (bitwise-and b_0 248)) - (let ((accum_1 (bitwise-and b_0 7))) - (if (> accum_1 4) - (encoding-failure_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0) - (loop_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - (add1 i_0) - j_0 - i_0 - accum_1 - 3))) - (encoding-failure_0 - base-i_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - j_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0)))))))))))))) - (|#%name| - utf-8-ish-reencode! - (lambda (from-utf-8-ish?3_0 - permissive?2_0 - to-utf-16?4_0 - in-bstr8_0 - in-start9_0 - in-end10_0 - out-bstr11_0 - out-start12_0 - out-end13_0) - (begin - (loop_0 - from-utf-8-ish?3_0 - in-bstr8_0 - in-end10_0 - in-start9_0 - out-bstr11_0 - out-end13_0 - out-start12_0 - permissive?2_0 - to-utf-16?4_0 - in-start9_0 - out-start12_0 - in-start9_0 - 0 - 0)))))) + (encoding-failure_0) + (if (if (= 3 remaining_0) + (<= next-accum_0 15) + #f) + (encoding-failure_0) + (let ((app_0 (add1 i_0))) + (loop_0 + app_0 + j_0 + base-i_0 + next-accum_0 + (sub1 remaining_0))))))))) + (if (not (zero? remaining_0)) + (encoding-failure_0) + (if (= 192 (bitwise-and b_0 224)) + (let ((accum_1 (bitwise-and b_0 31))) + (if (zero? accum_1) + (encoding-failure_0) + (loop_0 (add1 i_0) j_0 i_0 accum_1 1))) + (if (= 224 (bitwise-and b_0 240)) + (let ((accum_1 (bitwise-and b_0 15))) + (loop_0 (add1 i_0) j_0 i_0 accum_1 2)) + (if (= 240 (bitwise-and b_0 248)) + (let ((accum_1 (bitwise-and b_0 7))) + (if (> accum_1 4) + (encoding-failure_0) + (loop_0 (add1 i_0) j_0 i_0 accum_1 3))) + (encoding-failure_0)))))))))))))))) + (loop_0 in-start9_0 out-start12_0 in-start9_0 0 0)))))) (define utf-16-ish-reencode!.1 - (letrec ((continue_0 - (|#%name| - continue - (lambda (assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - i_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - j_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - v_0 - next-i_0) - (begin - (if (fx<= v_0 127) - (if (if out-end24_0 (fx= j_0 out-end24_0) #f) - (let ((app_0 (fx- i_0 in-start20_0))) - (values app_0 (fx- j_0 out-start23_0) 'continues)) - (begin - (if out-bstr22_0 - (unsafe-bytes-set! out-bstr22_0 j_0 v_0) - (void)) - (let ((next-j_0 (fx+ j_0 1))) - (begin-unsafe - (begin - (loop_0 - assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - next-i_0 - next-j_0)))))) - (if (fx<= v_0 2047) - (if (if out-end24_0 (fx>= (fx+ j_0 1) out-end24_0) #f) - (let ((app_0 (fx- i_0 in-start20_0))) - (values app_0 (fx- j_0 out-start23_0) 'continues)) - (begin - (if out-bstr22_0 - (begin - (unsafe-bytes-set! - out-bstr22_0 - j_0 - (fxior 192 (fxrshift v_0 6))) - (let ((app_0 (fx+ j_0 1))) - (unsafe-bytes-set! - out-bstr22_0 - app_0 - (fxior 128 (fxand v_0 63))))) - (void)) - (let ((next-j_0 (+ j_0 2))) - (begin-unsafe - (begin - (loop_0 - assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - next-i_0 - next-j_0)))))) - (if (fx<= v_0 65535) - (if (if out-end24_0 (fx>= (fx+ j_0 2) out-end24_0) #f) - (let ((app_0 (fx- i_0 in-start20_0))) - (values app_0 (fx- j_0 out-start23_0) 'continues)) + (|#%name| + utf-16-ish-reencode! + (lambda (assume-paired-surrogates?16_0 + from-utf-16-ish?15_0 + in-bstr19_0 + in-start20_0 + in-end21_0 + out-bstr22_0 + out-start23_0 + out-end24_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 j_0) + (begin + (let ((done_0 + (|#%name| + done + (lambda (status_0) (begin - (if out-bstr22_0 - (begin - (unsafe-bytes-set! - out-bstr22_0 - j_0 - (fxior 224 (fxrshift v_0 12))) - (let ((app_0 (fx+ j_0 1))) - (unsafe-bytes-set! - out-bstr22_0 - app_0 - (fxior 128 (fxand (fxrshift v_0 6) 63)))) - (let ((app_0 (fx+ j_0 2))) - (unsafe-bytes-set! - out-bstr22_0 - app_0 - (fxior 128 (fxand v_0 63))))) - (void)) - (let ((next-j_0 (fx+ j_0 3))) - (begin-unsafe - (begin - (loop_0 - assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - next-i_0 - next-j_0)))))) - (if (if out-end24_0 (fx>= (fx+ j_0 3) out-end24_0) #f) - (let ((app_0 (fx- i_0 in-start20_0))) - (values app_0 (fx- j_0 out-start23_0) 'continues)) - (begin - (if out-bstr22_0 - (begin - (unsafe-bytes-set! - out-bstr22_0 - j_0 - (fxior 240 (fxrshift v_0 18))) - (let ((app_0 (fx+ j_0 1))) - (unsafe-bytes-set! - out-bstr22_0 - app_0 - (fxior 128 (fxand (fxrshift v_0 12) 63)))) - (let ((app_0 (fx+ j_0 2))) - (unsafe-bytes-set! - out-bstr22_0 - app_0 - (fxior 128 (fxand (fxrshift v_0 6) 63)))) - (let ((app_0 (fx+ j_0 3))) - (unsafe-bytes-set! - out-bstr22_0 - app_0 - (fxior 128 (fxand v_0 63))))) - (void)) - (let ((next-j_0 (fx+ j_0 4))) - (begin-unsafe - (begin - (loop_0 - assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - next-i_0 - next-j_0))))))))))))) - (continue_1 - (|#%name| - continue - (lambda (assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - next-i_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - next-j_0) - (begin - (loop_0 - assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - next-i_0 - next-j_0))))) - (done_0 - (|#%name| - done - (lambda (i_0 in-start20_0 j_0 out-start23_0 status_0) - (begin - (let ((app_0 (- i_0 in-start20_0))) - (values app_0 (- j_0 out-start23_0) status_0)))))) - (loop_0 - (|#%name| - loop - (lambda (assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - i_0 - j_0) - (begin + (let ((app_0 (- i_0 in-start20_0))) + (values + app_0 + (- j_0 out-start23_0) + status_0))))))) (if (= i_0 in-end21_0) - (done_0 i_0 in-start20_0 j_0 out-start23_0 'complete) + (done_0 'complete) (if (> (+ i_0 2) in-end21_0) - (done_0 i_0 in-start20_0 j_0 out-start23_0 'aborts) + (done_0 'aborts) (let ((a_0 (unsafe-bytes-ref in-bstr19_0 i_0))) (let ((b_0 (unsafe-bytes-ref in-bstr19_0 (add1 i_0)))) (let ((v_0 (if big-endian?$1 (+ (arithmetic-shift a_0 8) b_0) (+ (arithmetic-shift b_0 8) a_0)))) - (if (if (>= v_0 55296) (<= v_0 57343) #f) - (if (if assume-paired-surrogates?16_0 - assume-paired-surrogates?16_0 - (<= v_0 56319)) - (if (> (+ i_0 4) in-end21_0) - (done_0 - i_0 - in-start20_0 - j_0 - out-start23_0 - 'aborts) - (let ((a_1 - (unsafe-bytes-ref - in-bstr19_0 - (+ i_0 2)))) - (let ((b_1 + (let ((continue_0 + (|#%name| + continue + (lambda (v_1 next-i_0) + (begin + (let ((continue_0 + (|#%name| + continue + (lambda (next-j_0) + (begin + (loop_0 + next-i_0 + next-j_0)))))) + (if (fx<= v_1 127) + (if (if out-end24_0 + (fx= j_0 out-end24_0) + #f) + (let ((app_0 + (fx- i_0 in-start20_0))) + (values + app_0 + (fx- j_0 out-start23_0) + 'continues)) + (begin + (if out-bstr22_0 + (unsafe-bytes-set! + out-bstr22_0 + j_0 + v_1) + (void)) + (let ((next-j_0 (fx+ j_0 1))) + (begin-unsafe + (begin + (loop_0 + next-i_0 + next-j_0)))))) + (if (fx<= v_1 2047) + (if (if out-end24_0 + (fx>= + (fx+ j_0 1) + out-end24_0) + #f) + (let ((app_0 + (fx- i_0 in-start20_0))) + (values + app_0 + (fx- j_0 out-start23_0) + 'continues)) + (begin + (if out-bstr22_0 + (begin + (unsafe-bytes-set! + out-bstr22_0 + j_0 + (fxior + 192 + (fxrshift v_1 6))) + (let ((app_0 (fx+ j_0 1))) + (unsafe-bytes-set! + out-bstr22_0 + app_0 + (fxior + 128 + (fxand v_1 63))))) + (void)) + (let ((next-j_0 (+ j_0 2))) + (begin-unsafe + (begin + (loop_0 + next-i_0 + next-j_0)))))) + (if (fx<= v_1 65535) + (if (if out-end24_0 + (fx>= + (fx+ j_0 2) + out-end24_0) + #f) + (let ((app_0 + (fx- + i_0 + in-start20_0))) + (values + app_0 + (fx- j_0 out-start23_0) + 'continues)) + (begin + (if out-bstr22_0 + (begin + (unsafe-bytes-set! + out-bstr22_0 + j_0 + (fxior + 224 + (fxrshift v_1 12))) + (let ((app_0 + (fx+ j_0 1))) + (unsafe-bytes-set! + out-bstr22_0 + app_0 + (fxior + 128 + (fxand + (fxrshift v_1 6) + 63)))) + (let ((app_0 + (fx+ j_0 2))) + (unsafe-bytes-set! + out-bstr22_0 + app_0 + (fxior + 128 + (fxand v_1 63))))) + (void)) + (let ((next-j_0 + (fx+ j_0 3))) + (begin-unsafe + (begin + (loop_0 + next-i_0 + next-j_0)))))) + (if (if out-end24_0 + (fx>= + (fx+ j_0 3) + out-end24_0) + #f) + (let ((app_0 + (fx- + i_0 + in-start20_0))) + (values + app_0 + (fx- j_0 out-start23_0) + 'continues)) + (begin + (if out-bstr22_0 + (begin + (unsafe-bytes-set! + out-bstr22_0 + j_0 + (fxior + 240 + (fxrshift v_1 18))) + (let ((app_0 + (fx+ j_0 1))) + (unsafe-bytes-set! + out-bstr22_0 + app_0 + (fxior + 128 + (fxand + (fxrshift v_1 12) + 63)))) + (let ((app_0 + (fx+ j_0 2))) + (unsafe-bytes-set! + out-bstr22_0 + app_0 + (fxior + 128 + (fxand + (fxrshift v_1 6) + 63)))) + (let ((app_0 + (fx+ j_0 3))) + (unsafe-bytes-set! + out-bstr22_0 + app_0 + (fxior + 128 + (fxand v_1 63))))) + (void)) + (let ((next-j_0 + (fx+ j_0 4))) + (begin-unsafe + (begin + (loop_0 + next-i_0 + next-j_0))))))))))))))) + (if (if (>= v_0 55296) (<= v_0 57343) #f) + (if (if assume-paired-surrogates?16_0 + assume-paired-surrogates?16_0 + (<= v_0 56319)) + (if (> (+ i_0 4) in-end21_0) + (done_0 'aborts) + (let ((a_1 (unsafe-bytes-ref in-bstr19_0 - (+ i_0 3)))) - (let ((v2_0 - (if big-endian?$1 - (+ (arithmetic-shift a_1 8) b_1) - (+ - (arithmetic-shift b_1 8) - a_1)))) - (if (if assume-paired-surrogates?16_0 - assume-paired-surrogates?16_0 - (if (>= v2_0 56320) - (<= v2_0 57343) - #f)) - (let ((v3_0 + (+ i_0 2)))) + (let ((b_1 + (unsafe-bytes-ref + in-bstr19_0 + (+ i_0 3)))) + (let ((v2_0 + (if big-endian?$1 (+ - 65536 - (let ((app_0 - (arithmetic-shift - (bitwise-and v_0 1023) - 10))) - (bitwise-ior - app_0 - (bitwise-and - v2_0 - 1023)))))) - (continue_0 - assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - i_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - j_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - v3_0 - (+ i_0 4))) - (if from-utf-16-ish?15_0 - (continue_0 - assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - i_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - j_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - v_0 - (+ i_0 2)) - (done_0 - i_0 - in-start20_0 - j_0 - out-start23_0 - 'error))))))) - (if from-utf-16-ish?15_0 - (continue_0 - assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - i_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - j_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - v_0 - (+ i_0 2)) - (done_0 - i_0 - in-start20_0 - j_0 - out-start23_0 - 'error))) - (continue_0 - assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - i_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - j_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - v_0 - (+ i_0 2))))))))))))) - (|#%name| - utf-16-ish-reencode! - (lambda (assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - in-bstr19_0 - in-start20_0 - in-end21_0 - out-bstr22_0 - out-start23_0 - out-end24_0) - (begin - (loop_0 - assume-paired-surrogates?16_0 - from-utf-16-ish?15_0 - in-bstr19_0 - in-end21_0 - in-start20_0 - out-bstr22_0 - out-end24_0 - out-start23_0 - in-start20_0 - out-start23_0)))))) + (arithmetic-shift a_1 8) + b_1) + (+ + (arithmetic-shift b_1 8) + a_1)))) + (if (if assume-paired-surrogates?16_0 + assume-paired-surrogates?16_0 + (if (>= v2_0 56320) + (<= v2_0 57343) + #f)) + (let ((v3_0 + (+ + 65536 + (let ((app_0 + (arithmetic-shift + (bitwise-and + v_0 + 1023) + 10))) + (bitwise-ior + app_0 + (bitwise-and + v2_0 + 1023)))))) + (continue_0 v3_0 (+ i_0 4))) + (if from-utf-16-ish?15_0 + (continue_0 v_0 (+ i_0 2)) + (done_0 'error))))))) + (if from-utf-16-ish?15_0 + (continue_0 v_0 (+ i_0 2)) + (done_0 'error))) + (continue_0 v_0 (+ i_0 2))))))))))))))) + (loop_0 in-start20_0 out-start23_0)))))) (define struct:bytes-converter (make-record-type-descriptor* 'bytes-converter #f #f #f #f 2 3)) (define effect_2529 @@ -16662,130 +15970,118 @@ dest-end-pos_0)) (void))))) (define do-convert - (letrec ((loop_0 - (|#%name| - loop - (lambda (c_0 - dest-bstr_0 - dest-end-pos_0 - src-bstr_0 - src-end-pos_0 - use-dest-bstr_0 - src-start-pos_0 - use-dest-start-pos_0 - use-dest-end-pos_0 - in-already-consumed_0 - out-already-produced_0) - (begin - (call-with-values - (lambda () - (convert-in - c_0 - src-bstr_0 - src-start-pos_0 - src-end-pos_0 - use-dest-bstr_0 - use-dest-start-pos_0 - use-dest-end-pos_0)) - (case-lambda - ((in-consumed_0 out-produced_0 err_0) - (if (if (eqv? err_0 28) - (if (not dest-bstr_0) (not dest-end-pos_0) #f) - #f) - (let ((all-out-produced_0 - (+ out-produced_0 out-already-produced_0))) - (let ((new-dest-bstr_0 - (make-bytes - (* 2 (unsafe-bytes-length use-dest-bstr_0))))) - (begin - (unsafe-bytes-copy! - new-dest-bstr_0 - 0 - use-dest-bstr_0 - 0 - all-out-produced_0) - (let ((app_0 (+ src-start-pos_0 in-consumed_0))) - (loop_0 - c_0 - dest-bstr_0 - dest-end-pos_0 - src-bstr_0 - src-end-pos_0 - new-dest-bstr_0 - app_0 - all-out-produced_0 - (unsafe-bytes-length new-dest-bstr_0) - (+ in-consumed_0 in-already-consumed_0) - all-out-produced_0))))) - (let ((all-out-produced_0 - (+ out-produced_0 out-already-produced_0))) - (begin - (unsafe-end-atomic) - (let ((app_0 - (if dest-bstr_0 - all-out-produced_0 - (subbytes - use-dest-bstr_0 - 0 - all-out-produced_0)))) - (let ((app_1 - (+ in-already-consumed_0 in-consumed_0))) - (values - app_0 - app_1 - (if (eqv? err_0 29) - 'error - (if (eqv? err_0 30) - 'aborts - (if (eqv? err_0 28) - 'continues - 'complete)))))))))) - (args (raise-binding-result-arity-error 3 args))))))))) - (lambda (who_0 - converter_0 - src-bstr_0 - src-start-pos_0 - src-end-pos_0 - dest-bstr_0 - dest-start-pos_0 - dest-end-pos_0 - guess-dest-size_0) - (begin - (unsafe-start-atomic) - (let ((c_0 (bytes-converter-c converter_0))) - (begin - (if c_0 - (void) - (begin - (unsafe-end-atomic) - (raise-arguments-error - who_0 - "converter is closed" - "converter" - converter_0))) - (let ((use-dest-bstr_0 - (if dest-bstr_0 - dest-bstr_0 - (make-bytes - (if dest-end-pos_0 - (- dest-end-pos_0 dest-start-pos_0) - guess-dest-size_0))))) - (let ((app_0 (if dest-bstr_0 dest-start-pos_0 0))) - (loop_0 - c_0 - dest-bstr_0 - dest-end-pos_0 - src-bstr_0 - src-end-pos_0 - use-dest-bstr_0 - src-start-pos_0 - app_0 - (let ((or-part_0 (if dest-bstr_0 dest-end-pos_0 #f))) - (if or-part_0 - or-part_0 - (unsafe-bytes-length use-dest-bstr_0))) - 0 - 0))))))))) + (lambda (who_0 + converter_0 + src-bstr_0 + src-start-pos_0 + src-end-pos_0 + dest-bstr_0 + dest-start-pos_0 + dest-end-pos_0 + guess-dest-size_0) + (begin + (unsafe-start-atomic) + (let ((c_0 (bytes-converter-c converter_0))) + (begin + (if c_0 + (void) + (begin + (unsafe-end-atomic) + (raise-arguments-error + who_0 + "converter is closed" + "converter" + converter_0))) + (let ((use-dest-bstr_0 + (if dest-bstr_0 + dest-bstr_0 + (make-bytes + (if dest-end-pos_0 + (- dest-end-pos_0 dest-start-pos_0) + guess-dest-size_0))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (use-dest-bstr_1 + src-start-pos_1 + use-dest-start-pos_0 + use-dest-end-pos_0 + in-already-consumed_0 + out-already-produced_0) + (begin + (call-with-values + (lambda () + (convert-in + c_0 + src-bstr_0 + src-start-pos_1 + src-end-pos_0 + use-dest-bstr_1 + use-dest-start-pos_0 + use-dest-end-pos_0)) + (case-lambda + ((in-consumed_0 out-produced_0 err_0) + (if (if (eqv? err_0 28) + (if (not dest-bstr_0) (not dest-end-pos_0) #f) + #f) + (let ((all-out-produced_0 + (+ out-produced_0 out-already-produced_0))) + (let ((new-dest-bstr_0 + (make-bytes + (* + 2 + (unsafe-bytes-length use-dest-bstr_1))))) + (begin + (unsafe-bytes-copy! + new-dest-bstr_0 + 0 + use-dest-bstr_1 + 0 + all-out-produced_0) + (let ((app_0 (+ src-start-pos_1 in-consumed_0))) + (loop_0 + new-dest-bstr_0 + app_0 + all-out-produced_0 + (unsafe-bytes-length new-dest-bstr_0) + (+ in-consumed_0 in-already-consumed_0) + all-out-produced_0))))) + (let ((all-out-produced_0 + (+ out-produced_0 out-already-produced_0))) + (begin + (unsafe-end-atomic) + (let ((app_0 + (if dest-bstr_0 + all-out-produced_0 + (subbytes + use-dest-bstr_1 + 0 + all-out-produced_0)))) + (let ((app_1 + (+ in-already-consumed_0 in-consumed_0))) + (values + app_0 + app_1 + (if (eqv? err_0 29) + 'error + (if (eqv? err_0 30) + 'aborts + (if (eqv? err_0 28) + 'continues + 'complete)))))))))) + (args (raise-binding-result-arity-error 3 args))))))))) + (let ((app_0 (if dest-bstr_0 dest-start-pos_0 0))) + (loop_0 + use-dest-bstr_0 + src-start-pos_0 + app_0 + (let ((or-part_0 (if dest-bstr_0 dest-end-pos_0 #f))) + (if or-part_0 + or-part_0 + (unsafe-bytes-length use-dest-bstr_0))) + 0 + 0))))))))) (define convert-in (lambda (c_0 src_0 src-start_0 src-end_0 dest_0 dest-start_0 dest-end_0) (if (utf-8-converter? c_0) @@ -17128,112 +16424,115 @@ (lambda (c_0 enc_0) (cache-save! c_0 enc_0 cache-from set-cache-from!))) (define 1/string->bytes/locale (let ((string->bytes/locale_0 - (letrec ((loop_0 - (|#%name| - loop - (lambda (c_0 err-byte1_0 in-bstr_0 str4_0 pos_0) - (begin - (call-with-values - (lambda () - (1/bytes-convert - (unsafe-unbox* c_0) - in-bstr_0 - pos_0)) - (case-lambda - ((bstr_0 in-used_0 status_0) - (if (eq? status_0 'complete) - (if (eqv? pos_0 0) bstr_0 (list bstr_0)) - (if (not err-byte1_0) - (raise-arguments-error - 'string->bytes/locale - "string cannot be encoded for the current locale" - "string" - str4_0) - (let ((err-bstr_0 (bytes err-byte1_0))) - (if (eq? status_0 'aborts) - (if (eqv? pos_0 0) - (bytes-append bstr_0 err-bstr_0) - (list bstr_0 err-bstr_0)) - (let ((r_0 - (loop_0 - c_0 - err-byte1_0 - in-bstr_0 - str4_0 - (+ pos_0 in-used_0 4)))) - (if (eqv? pos_0 0) - (apply - bytes-append - (cons bstr_0 (cons err-bstr_0 r_0))) - (cons - bstr_0 - (cons err-bstr_0 r_0))))))))) - (args - (raise-binding-result-arity-error 3 args))))))))) - (|#%name| - string->bytes/locale - (lambda (str4_0 err-byte1_0 start2_0 end3_0) - (begin - (let ((end_0 - (if (eq? end3_0 unsafe-undefined) - (if (string? str4_0) (string-length str4_0) #f) - end3_0))) - (begin - (if (string? str4_0) - (void) - (raise-argument-error - 'string->bytes/locale - "string?" - str4_0)) - (if (let ((or-part_0 (not err-byte1_0))) - (if or-part_0 or-part_0 (byte? err-byte1_0))) - (void) - (raise-argument-error - 'string->bytes/locale - "(or/c byte? #f)" - err-byte1_0)) - (if (exact-nonnegative-integer? start2_0) - (void) - (raise-argument-error - 'string->bytes/locale - "exact-nonnegative-integer?" - start2_0)) - (if (exact-nonnegative-integer? end_0) - (void) - (raise-argument-error - 'string->bytes/locale - "exact-nonnegative-integer?" - end_0)) - (check-range$1 + (|#%name| + string->bytes/locale + (lambda (str4_0 err-byte1_0 start2_0 end3_0) + (begin + (let ((end_0 + (if (eq? end3_0 unsafe-undefined) + (if (string? str4_0) (string-length str4_0) #f) + end3_0))) + (begin + (if (string? str4_0) + (void) + (raise-argument-error 'string->bytes/locale - start2_0 - end_0 - (string-length str4_0) - str4_0) - (if (locale-encoding-is-utf-8?) - (1/string->bytes/utf-8 str4_0 err-byte1_0 start2_0 end_0) - (let ((c_0 (box #f))) - (let ((enc_0 (1/locale-string-encoding))) - (dynamic-wind - (lambda () - (unsafe-set-box*! - c_0 - (bytes-open-converter/cached-to enc_0))) - (lambda () - (let ((in-bstr_0 - (string->bytes/ucs-4 - str4_0 - start2_0 - end_0))) - (loop_0 c_0 err-byte1_0 in-bstr_0 str4_0 0))) - (lambda () - (let ((c_1 (unsafe-unbox* c_0))) - (begin-unsafe - (cache-save! - c_1 - enc_0 - cache-to - set-cache-to!)))))))))))))))) + "string?" + str4_0)) + (if (let ((or-part_0 (not err-byte1_0))) + (if or-part_0 or-part_0 (byte? err-byte1_0))) + (void) + (raise-argument-error + 'string->bytes/locale + "(or/c byte? #f)" + err-byte1_0)) + (if (exact-nonnegative-integer? start2_0) + (void) + (raise-argument-error + 'string->bytes/locale + "exact-nonnegative-integer?" + start2_0)) + (if (exact-nonnegative-integer? end_0) + (void) + (raise-argument-error + 'string->bytes/locale + "exact-nonnegative-integer?" + end_0)) + (check-range$1 + 'string->bytes/locale + start2_0 + end_0 + (string-length str4_0) + str4_0) + (if (locale-encoding-is-utf-8?) + (1/string->bytes/utf-8 str4_0 err-byte1_0 start2_0 end_0) + (let ((c_0 #f)) + (let ((enc_0 (1/locale-string-encoding))) + (dynamic-wind + (lambda () + (set! c_0 (bytes-open-converter/cached-to enc_0))) + (lambda () + (let ((in-bstr_0 + (string->bytes/ucs-4 str4_0 start2_0 end_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_0) + (begin + (call-with-values + (lambda () + (1/bytes-convert c_0 in-bstr_0 pos_0)) + (case-lambda + ((bstr_0 in-used_0 status_0) + (if (eq? status_0 'complete) + (if (eqv? pos_0 0) + bstr_0 + (list bstr_0)) + (if (not err-byte1_0) + (raise-arguments-error + 'string->bytes/locale + "string cannot be encoded for the current locale" + "string" + str4_0) + (let ((err-bstr_0 + (bytes err-byte1_0))) + (if (eq? status_0 'aborts) + (if (eqv? pos_0 0) + (bytes-append + bstr_0 + err-bstr_0) + (list bstr_0 err-bstr_0)) + (let ((r_0 + (loop_0 + (+ + pos_0 + in-used_0 + 4)))) + (if (eqv? pos_0 0) + (apply + bytes-append + (cons + bstr_0 + (cons err-bstr_0 r_0))) + (cons + bstr_0 + (cons + err-bstr_0 + r_0))))))))) + (args + (raise-binding-result-arity-error + 3 + args))))))))) + (loop_0 0)))) + (lambda () + (let ((c_1 c_0)) + (begin-unsafe + (cache-save! + c_1 + enc_0 + cache-to + set-cache-to!))))))))))))))) (|#%name| string->bytes/locale (case-lambda @@ -17246,117 +16545,119 @@ (string->bytes/locale_0 str_0 err-byte1_0 0 unsafe-undefined)))))) (define 1/bytes->string/locale (let ((bytes->string/locale_0 - (letrec ((loop_0 - (|#%name| - loop - (lambda (c_0 err-char5_0 in-bstr8_0 pos_0) - (begin - (call-with-values - (lambda () - (1/bytes-convert - (unsafe-unbox* c_0) - in-bstr8_0 - pos_0)) - (case-lambda - ((bstr_0 in-used_0 status_0) - (if (eq? status_0 'complete) - (if (eqv? pos_0 0) - (1/bytes->string/utf-8 bstr_0) - (list bstr_0)) - (if (not err-char5_0) - (raise-arguments-error - 'bytes->string/locale - "byte string is not a valid encoding for the current locale" - "byte string" - in-bstr8_0) - (let ((err-bstr_0 - (1/string->bytes/utf-8 - (string err-char5_0)))) - (if (eq? status_0 'aborts) - (if (eqv? pos_0 0) - (1/bytes->string/utf-8 - (bytes-append bstr_0 err-bstr_0)) - (list bstr_0 err-bstr_0)) - (let ((r_0 - (loop_0 - c_0 - err-char5_0 - in-bstr8_0 - (+ pos_0 in-used_0 1)))) - (if (eqv? pos_0 0) - (1/bytes->string/utf-8 - (apply - bytes-append - (cons bstr_0 (cons err-bstr_0 r_0)))) - (cons - bstr_0 - (cons err-bstr_0 r_0))))))))) - (args - (raise-binding-result-arity-error 3 args))))))))) - (|#%name| - bytes->string/locale - (lambda (in-bstr8_0 err-char5_0 start6_0 end7_0) - (begin - (let ((end_0 - (if (eq? end7_0 unsafe-undefined) - (if (bytes? in-bstr8_0) - (unsafe-bytes-length in-bstr8_0) - #f) - end7_0))) - (begin - (if (bytes? in-bstr8_0) - (void) - (raise-argument-error - 'bytes->string/locale - "bytes?" - in-bstr8_0)) - (if (let ((or-part_0 (not err-char5_0))) - (if or-part_0 or-part_0 (char? err-char5_0))) - (void) - (raise-argument-error - 'bytes->string/locale - "(or/c char? #f)" - err-char5_0)) - (if (exact-nonnegative-integer? start6_0) - (void) - (raise-argument-error - 'bytes->string/locale - "exact-nonnegative-integer?" - start6_0)) - (if (exact-nonnegative-integer? end_0) - (void) - (raise-argument-error - 'bytes->string/locale - "exact-nonnegative-integer?" - end_0)) - (check-range$1 + (|#%name| + bytes->string/locale + (lambda (in-bstr8_0 err-char5_0 start6_0 end7_0) + (begin + (let ((end_0 + (if (eq? end7_0 unsafe-undefined) + (if (bytes? in-bstr8_0) + (unsafe-bytes-length in-bstr8_0) + #f) + end7_0))) + (begin + (if (bytes? in-bstr8_0) + (void) + (raise-argument-error 'bytes->string/locale + "bytes?" + in-bstr8_0)) + (if (let ((or-part_0 (not err-char5_0))) + (if or-part_0 or-part_0 (char? err-char5_0))) + (void) + (raise-argument-error + 'bytes->string/locale + "(or/c char? #f)" + err-char5_0)) + (if (exact-nonnegative-integer? start6_0) + (void) + (raise-argument-error + 'bytes->string/locale + "exact-nonnegative-integer?" + start6_0)) + (if (exact-nonnegative-integer? end_0) + (void) + (raise-argument-error + 'bytes->string/locale + "exact-nonnegative-integer?" + end_0)) + (check-range$1 + 'bytes->string/locale + start6_0 + end_0 + (unsafe-bytes-length in-bstr8_0) + in-bstr8_0) + (if (locale-encoding-is-utf-8?) + (1/bytes->string/utf-8 + in-bstr8_0 + err-char5_0 start6_0 - end_0 - (unsafe-bytes-length in-bstr8_0) - in-bstr8_0) - (if (locale-encoding-is-utf-8?) - (1/bytes->string/utf-8 - in-bstr8_0 - err-char5_0 - start6_0 - end_0) - (let ((c_0 (box #f))) - (let ((enc_0 (1/locale-string-encoding))) - (dynamic-wind - (lambda () - (unsafe-set-box*! - c_0 - (bytes-open-converter/cached-from enc_0))) - (lambda () (loop_0 c_0 err-char5_0 in-bstr8_0 0)) - (lambda () - (let ((c_1 (unsafe-unbox* c_0))) - (begin-unsafe - (cache-save! - c_1 - enc_0 - cache-from - set-cache-from!)))))))))))))))) + end_0) + (let ((c_0 #f)) + (let ((enc_0 (1/locale-string-encoding))) + (dynamic-wind + (lambda () + (set! c_0 (bytes-open-converter/cached-from enc_0))) + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_0) + (begin + (call-with-values + (lambda () + (1/bytes-convert c_0 in-bstr8_0 pos_0)) + (case-lambda + ((bstr_0 in-used_0 status_0) + (if (eq? status_0 'complete) + (if (eqv? pos_0 0) + (1/bytes->string/utf-8 bstr_0) + (list bstr_0)) + (if (not err-char5_0) + (raise-arguments-error + 'bytes->string/locale + "byte string is not a valid encoding for the current locale" + "byte string" + in-bstr8_0) + (let ((err-bstr_0 + (1/string->bytes/utf-8 + (string err-char5_0)))) + (if (eq? status_0 'aborts) + (if (eqv? pos_0 0) + (1/bytes->string/utf-8 + (bytes-append + bstr_0 + err-bstr_0)) + (list bstr_0 err-bstr_0)) + (let ((r_0 + (loop_0 + (+ pos_0 in-used_0 1)))) + (if (eqv? pos_0 0) + (1/bytes->string/utf-8 + (apply + bytes-append + (cons + bstr_0 + (cons err-bstr_0 r_0)))) + (cons + bstr_0 + (cons + err-bstr_0 + r_0))))))))) + (args + (raise-binding-result-arity-error + 3 + args))))))))) + (loop_0 0))) + (lambda () + (let ((c_1 c_0)) + (begin-unsafe + (cache-save! + c_1 + enc_0 + cache-from + set-cache-from!))))))))))))))) (|#%name| bytes->string/locale (case-lambda @@ -17620,269 +16921,257 @@ "LPT8" "LPT9")) (define special-filename?.1 - (letrec () - (|#%name| - special-filename? - (lambda (immediate?1_0 in-bstr3_0) - (begin - (let ((bstr_0 (box unsafe-undefined))) - (unsafe-set-box*! - bstr_0 - (if immediate?1_0 - in-bstr3_0 - (if (backslash-backslash-questionmark? in-bstr3_0) - #vu8() - (let ((len_0 (unsafe-bytes-length in-bstr3_0))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (i+1_0) - (begin - (if (zero? i+1_0) - (if (letter-drive-start? - (check-not-unsafe-undefined - (unsafe-unbox* bstr_0) - 'bstr_119) - len_0) - (subbytes in-bstr3_0 2) - in-bstr3_0) - (let ((i_0 (sub1 i+1_0))) - (if (is-sep? - (unsafe-bytes-ref in-bstr3_0 i_0) - 'windows) - (subbytes in-bstr3_0 i+1_0) - (loop_0 i_0))))))))) - (loop_0 len_0)))))) - (let ((len_0 (unsafe-bytes-length (unsafe-unbox* bstr_0)))) - (if (zero? len_0) + (|#%name| + special-filename? + (lambda (immediate?1_0 in-bstr3_0) + (begin + (let ((bstr_0 unsafe-undefined)) + (set! bstr_0 + (if immediate?1_0 + in-bstr3_0 + (if (backslash-backslash-questionmark? in-bstr3_0) + #vu8() + (let ((len_0 (unsafe-bytes-length in-bstr3_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i+1_0) + (begin + (if (zero? i+1_0) + (if (letter-drive-start? + (check-not-unsafe-undefined bstr_0 'bstr_119) + len_0) + (subbytes in-bstr3_0 2) + in-bstr3_0) + (let ((i_0 (sub1 i+1_0))) + (if (is-sep? + (unsafe-bytes-ref in-bstr3_0 i_0) + 'windows) + (subbytes in-bstr3_0 i+1_0) + (loop_0 i_0))))))))) + (loop_0 len_0)))))) + (let ((len_0 (unsafe-bytes-length bstr_0))) + (if (zero? len_0) + #f + (if (backslash-backslash-questionmark? bstr_0) #f - (if (backslash-backslash-questionmark? (unsafe-unbox* bstr_0)) - #f - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (pair? lst_0) - (let ((fn_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((result_1 - (let ((result_1 - (let ((fn-len_0 - (string-length fn_0))) - (if (>= len_0 fn-len_0) - (if (call-with-values - (lambda () - (begin - (check-string fn_0) - (values - fn_0 - (unsafe-string-length - fn_0)))) - (case-lambda - ((vec_0 len_1) - (call-with-values - (lambda () - (let ((vec_1 - (unsafe-unbox* - bstr_0))) - (begin - (check-bytes - vec_1) - (values - vec_1 - (unsafe-bytes-length - vec_1))))) - (case-lambda - ((vec_1 len_2) - (let ((vec_2 - vec_0) - (len_3 - len_1)) - (begin - #f - #f - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (result_1 - pos_0 - pos_1) - (begin - (if (if (unsafe-fx< - pos_0 - len_3) - (unsafe-fx< - pos_1 - len_2) - #f) - (let ((c_0 - (string-ref - vec_2 - pos_0))) - (let ((b_0 - (unsafe-bytes-ref - vec_1 - pos_1))) - (let ((c_1 - c_0)) - (let ((result_2 - (let ((result_2 - (let ((or-part_0 - (eqv? - (char->integer - c_1) - b_0))) - (if or-part_0 - or-part_0 - (eqv? - (char->integer - (char-downcase - c_1)) - b_0))))) - (values - result_2)))) - (if (if (not + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (pair? lst_0) + (let ((fn_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((result_1 + (let ((result_1 + (let ((fn-len_0 + (string-length fn_0))) + (if (>= len_0 fn-len_0) + (if (call-with-values + (lambda () + (begin + (check-string fn_0) + (values + fn_0 + (unsafe-string-length + fn_0)))) + (case-lambda + ((vec_0 len_1) + (call-with-values + (lambda () + (let ((vec_1 + bstr_0)) + (begin + (check-bytes + vec_1) + (values + vec_1 + (unsafe-bytes-length + vec_1))))) + (case-lambda + ((vec_1 len_2) + (let ((vec_2 vec_0) + (len_3 len_1)) + (begin + #f + #f + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (result_1 + pos_0 + pos_1) + (begin + (if (if (unsafe-fx< + pos_0 + len_3) + (unsafe-fx< + pos_1 + len_2) + #f) + (let ((c_0 + (string-ref + vec_2 + pos_0))) + (let ((b_0 + (unsafe-bytes-ref + vec_1 + pos_1))) + (let ((c_1 + c_0)) + (let ((result_2 + (let ((result_2 + (let ((or-part_0 + (eqv? + (char->integer + c_1) + b_0))) + (if or-part_0 + or-part_0 + (eqv? + (char->integer + (char-downcase + c_1)) + b_0))))) + (values + result_2)))) + (if (if (not + (let ((x_0 + (list + c_1))) + (not + result_2))) + (if (not (let ((x_0 (list - c_1))) + b_0))) (not result_2))) - (if (not - (let ((x_0 - (list - b_0))) - (not - result_2))) - #t - #f) + #t #f) - (for-loop_1 - result_2 - (unsafe-fx+ - 1 - pos_0) - (unsafe-fx+ - 1 - pos_1)) - result_2))))) - result_1)))))) - (for-loop_1 - #t - 0 - 0))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (let ((or-part_0 - (= - len_0 - fn-len_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (eqv? - (unsafe-bytes-ref - (unsafe-unbox* - bstr_0) - fn-len_0) - 46))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (eqv? - (unsafe-bytes-ref - (unsafe-unbox* - bstr_0) - fn-len_0) - 58))) - (if or-part_2 - or-part_2 - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-bytes-length - (unsafe-unbox* - bstr_0) - fn-len_0 - #f - 1)) - (case-lambda - ((v*_0 - start*_0 - stop*_0 - step*_0) - (begin + #f) + (for-loop_1 + result_2 + (unsafe-fx+ + 1 + pos_0) + (unsafe-fx+ + 1 + pos_1)) + result_2))))) + result_1)))))) + (for-loop_1 + #t + 0 + 0))))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (let ((or-part_0 + (= len_0 fn-len_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (eqv? + (unsafe-bytes-ref + bstr_0 + fn-len_0) + 46))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (eqv? + (unsafe-bytes-ref + bstr_0 + fn-len_0) + 58))) + (if or-part_2 + or-part_2 + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + bstr_0 + fn-len_0 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin + #t + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (result_1 + idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((b_0 + (unsafe-bytes-ref + v*_0 + idx_0))) + (let ((or-part_3 + (eqv? + b_0 + 32))) + (let ((result_2 + (let ((result_2 + (if or-part_3 + or-part_3 + (eqv? + b_0 + 46)))) + (values + result_2)))) + (if (if (not + (let ((x_0 + (list + b_0))) + (not + result_2))) + #t + #f) + (for-loop_1 + result_2 + (unsafe-fx+ + idx_0 + 1)) + result_2)))) + result_1)))))) + (for-loop_1 #t - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (result_1 - idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((b_0 - (unsafe-bytes-ref - v*_0 - idx_0))) - (let ((or-part_3 - (eqv? - b_0 - 32))) - (let ((result_2 - (let ((result_2 - (if or-part_3 - or-part_3 - (eqv? - b_0 - 46)))) - (values - result_2)))) - (if (if (not - (let ((x_0 - (list - b_0))) - (not - result_2))) - #t - #f) - (for-loop_1 - result_2 - (unsafe-fx+ - idx_0 - 1)) - result_2)))) - result_1)))))) - (for-loop_1 - #t - start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))))))))) - #f) - #f)))) - (values result_1)))) - (if (if (not - (let ((x_0 (list fn_0))) result_1)) - #t - #f) - (for-loop_0 result_1 rest_0) - result_1)))) - result_0)))))) - (for-loop_0 #f special-filenames)))))))))))) + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))))))))) + #f) + #f)))) + (values result_1)))) + (if (if (not + (let ((x_0 (list fn_0))) result_1)) + #t + #f) + (for-loop_0 result_1 rest_0) + result_1)))) + result_0)))))) + (for-loop_0 #f special-filenames))))))))))) (define drive-letter? (lambda (c_0) (let ((or-part_0 (<= 97 c_0 122))) @@ -18154,38 +17443,36 @@ clean-start-pos_0 #vu8(92 92)))))))))))))))))) (define parse-unc.1 - (letrec ((is-a-sep?_0 - (|#%name| - is-a-sep? - (lambda (no-forward-slash?6_0 c_0) - (begin - (if no-forward-slash?6_0 - (eqv? c_0 92) - (is-sep? c_0 'windows))))))) - (|#%name| - parse-unc - (lambda (exact?5_0 no-forward-slash?6_0 bstr9_0 delta10_0) - (begin + (|#%name| + parse-unc + (lambda (exact?5_0 no-forward-slash?6_0 bstr9_0 delta10_0) + (begin + (if (if (zero? delta10_0) + (backslash-backslash-questionmark? bstr9_0) + #f) + #f (if (if (zero? delta10_0) - (backslash-backslash-questionmark? bstr9_0) + (not + (if (> (unsafe-bytes-length bstr9_0) 2) + (if (is-sep? (unsafe-bytes-ref bstr9_0 0) 'windows) + (is-sep? (unsafe-bytes-ref bstr9_0 1) 'windows) + #f) + #f)) #f) #f - (if (if (zero? delta10_0) - (not - (if (> (unsafe-bytes-length bstr9_0) 2) - (if (is-sep? (unsafe-bytes-ref bstr9_0 0) 'windows) - (is-sep? (unsafe-bytes-ref bstr9_0 1) 'windows) - #f) - #f)) - #f) - #f + (let ((is-a-sep?_0 + (|#%name| + is-a-sep? + (lambda (c_0) + (begin + (if no-forward-slash?6_0 + (eqv? c_0 92) + (is-sep? c_0 'windows))))))) (let ((len_0 (unsafe-bytes-length bstr9_0))) (let ((j_0 (if (zero? delta10_0) 2 delta10_0))) (if (not (if (> len_0 j_0) - (is-a-sep?_0 - no-forward-slash?6_0 - (unsafe-bytes-ref bstr9_0 j_0)) + (is-a-sep?_0 (unsafe-bytes-ref bstr9_0 j_0)) #f)) (letrec* ((loop_0 @@ -18196,9 +17483,7 @@ (if (= j_1 len_0) #f (if (not - (is-a-sep?_0 - no-forward-slash?6_0 - (unsafe-bytes-ref bstr9_0 j_1))) + (is-a-sep?_0 (unsafe-bytes-ref bstr9_0 j_1))) (if (if no-forward-slash?6_0 (eqv? (unsafe-bytes-ref bstr9_0 j_1) 47) #f) @@ -18209,7 +17494,6 @@ (if (if no-forward-slash?6_0 (if (< j_2 len_0) (is-a-sep?_0 - no-forward-slash?6_0 (unsafe-bytes-ref bstr9_0 j_2)) @@ -18230,7 +17514,6 @@ (if (if (not no-forward-slash?6_0) (if (< j_3 len_0) (is-a-sep?_0 - no-forward-slash?6_0 (unsafe-bytes-ref bstr9_0 j_3)) #f) #f) @@ -18244,7 +17527,6 @@ (if (= j_4 len_0) #f (if (is-a-sep?_0 - no-forward-slash?6_0 (unsafe-bytes-ref bstr9_0 j_4)) @@ -18258,7 +17540,6 @@ (if (= j_5 len_0) len_0 (if (is-a-sep?_0 - no-forward-slash?6_0 (unsafe-bytes-ref bstr9_0 j_5)) @@ -18301,7 +17582,6 @@ (let ((result_1 (not (is-a-sep?_0 - no-forward-slash?6_0 b_0)))) (values result_1)))) @@ -19753,27 +19033,32 @@ (lambda (o_0 max-length_0) (if max-length_0 (max-output-port-max-length o_0) #f))) (define print-string - (letrec ((pad_0 - (|#%name| - pad - (lambda (n_0 s_0) - (begin - (let ((len_0 (string-length s_0))) - (if (< len_0 n_0) - (string-append (make-string (- n_0 len_0) '#\x30) s_0) - s_0))))))) - (lambda (str_0 o_0 max-length_0) - (let ((max-length_1 (write-bytes/max #vu8(34) o_0 max-length_0))) - (let ((len_0 (string-length str_0))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (start-i_0 i_0 max-length_2) - (begin - (if (eq? max-length_2 'full) - 'full - (if (= i_0 len_0) + (lambda (str_0 o_0 max-length_0) + (let ((max-length_1 (write-bytes/max #vu8(34) o_0 max-length_0))) + (let ((len_0 (string-length str_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (start-i_0 i_0 max-length_2) + (begin + (if (eq? max-length_2 'full) + 'full + (if (= i_0 len_0) + (let ((max-length_3 + (write-string/max + str_0 + o_0 + max-length_2 + start-i_0 + i_0))) + (write-bytes/max #vu8(34) o_0 max-length_3)) + (if (if max-length_2 + (let ((or-part_0 (pair? max-length_2))) + (if or-part_0 + or-part_0 + (> (- i_0 start-i_0) max-length_2))) + #f) (let ((max-length_3 (write-string/max str_0 @@ -19781,64 +19066,63 @@ max-length_2 start-i_0 i_0))) - (write-bytes/max #vu8(34) o_0 max-length_3)) - (if (if max-length_2 - (let ((or-part_0 (pair? max-length_2))) - (if or-part_0 - or-part_0 - (> (- i_0 start-i_0) max-length_2))) - #f) - (let ((max-length_3 - (write-string/max - str_0 - o_0 - max-length_2 - start-i_0 - i_0))) - (loop_0 i_0 (add1 i_0) max-length_3)) - (let ((c_0 (string-ref str_0 i_0))) - (let ((escaped_0 - (let ((tmp_0 c_0)) - (if (eqv? tmp_0 '#\x22) - #vu8(92 34) - (if (eqv? tmp_0 '#\x5c) - #vu8(92 92) - (if (eqv? tmp_0 '#\x7) - #vu8(92 97) - (if (eqv? tmp_0 '#\x8) - #vu8(92 98) - (if (eqv? tmp_0 '#\x1b) - #vu8(92 101) - (if (eqv? tmp_0 '#\xc) - #vu8(92 102) - (if (eqv? tmp_0 '#\xa) - #vu8(92 110) - (if (eqv? tmp_0 '#\xd) - #vu8(92 114) - (if (eqv? tmp_0 '#\x9) - #vu8(92 116) - (if (eqv? tmp_0 '#\xb) - #vu8(92 118) - #f))))))))))))) - (if escaped_0 - (let ((max-length_3 - (write-string/max - str_0 + (loop_0 i_0 (add1 i_0) max-length_3)) + (let ((c_0 (string-ref str_0 i_0))) + (let ((escaped_0 + (let ((tmp_0 c_0)) + (if (eqv? tmp_0 '#\x22) + #vu8(92 34) + (if (eqv? tmp_0 '#\x5c) + #vu8(92 92) + (if (eqv? tmp_0 '#\x7) + #vu8(92 97) + (if (eqv? tmp_0 '#\x8) + #vu8(92 98) + (if (eqv? tmp_0 '#\x1b) + #vu8(92 101) + (if (eqv? tmp_0 '#\xc) + #vu8(92 102) + (if (eqv? tmp_0 '#\xa) + #vu8(92 110) + (if (eqv? tmp_0 '#\xd) + #vu8(92 114) + (if (eqv? tmp_0 '#\x9) + #vu8(92 116) + (if (eqv? tmp_0 '#\xb) + #vu8(92 118) + #f))))))))))))) + (if escaped_0 + (let ((max-length_3 + (write-string/max + str_0 + o_0 + max-length_2 + start-i_0 + i_0))) + (let ((max-length_4 + (write-bytes/max + escaped_0 o_0 - max-length_2 - start-i_0 - i_0))) - (let ((max-length_4 - (write-bytes/max - escaped_0 - o_0 - max-length_3))) - (let ((i_1 (add1 i_0))) - (loop_0 i_1 i_1 max-length_4)))) - (if (let ((or-part_0 (char-graphic? c_0))) - (if or-part_0 or-part_0 (char-blank? c_0))) - (loop_0 start-i_0 (add1 i_0) max-length_2) - (let ((n_0 (char->integer c_0))) + max-length_3))) + (let ((i_1 (add1 i_0))) + (loop_0 i_1 i_1 max-length_4)))) + (if (let ((or-part_0 (char-graphic? c_0))) + (if or-part_0 or-part_0 (char-blank? c_0))) + (loop_0 start-i_0 (add1 i_0) max-length_2) + (let ((n_0 (char->integer c_0))) + (let ((pad_0 + (|#%name| + pad + (lambda (n_1 s_0) + (begin + (let ((len_1 (string-length s_0))) + (if (< len_1 n_1) + (string-append + (make-string + (- n_1 len_1) + '#\x30) + s_0) + s_0))))))) (let ((max-length_3 (write-string/max str_0 @@ -19876,8 +19160,8 @@ (loop_0 i_1 i_1 - max-length_4))))))))))))))))) - (loop_0 0 0 max-length_1))))))) + max-length_4)))))))))))))))))) + (loop_0 0 0 max-length_1)))))) (define print-bytes (lambda (bstr_0 o_0 max-length_0) (let ((max-length_1 (write-bytes/max #vu8(35 34) o_0 max-length_0))) @@ -20083,213 +19367,173 @@ sym3_0))) (write-string/max str_0 o4_0 max-length5_0)))))) (define symbol->print-string.1 - (letrec ((is-simple?_0 - (|#%name| - is-simple? - (lambda (case-sensitive?_0 config8_0 for-type?9_0 str_0 ch_0 i_0) - (begin - (not - (let ((or-part_0 (char=? ch_0 '#\x28))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (char=? ch_0 '#\x5b))) - (if or-part_1 - or-part_1 - (let ((or-part_2 (char=? ch_0 '#\x7b))) - (if or-part_2 - or-part_2 - (let ((or-part_3 (char=? ch_0 '#\x29))) - (if or-part_3 - or-part_3 - (let ((or-part_4 (char=? ch_0 '#\x5d))) - (if or-part_4 - or-part_4 - (let ((or-part_5 (char=? ch_0 '#\x7d))) - (if or-part_5 - or-part_5 - (let ((or-part_6 - (char=? ch_0 '#\x22))) - (if or-part_6 - or-part_6 - (let ((or-part_7 - (char=? ch_0 '#\x5c))) - (if or-part_7 - or-part_7 - (let ((or-part_8 - (char=? ch_0 '#\x27))) - (if or-part_8 - or-part_8 - (let ((or-part_9 - (char=? - ch_0 - '#\x2c))) - (if or-part_9 - or-part_9 - (let ((or-part_10 - (char=? - ch_0 - '#\x3b))) - (if or-part_10 - or-part_10 - (let ((or-part_11 - (char=? - ch_0 - '#\x60))) - (if or-part_11 - or-part_11 - (let ((or-part_12 - (char=? - ch_0 - '#\xfeff))) - (if or-part_12 - or-part_12 - (let ((or-part_13 - (if (char=? - ch_0 - '#\x7c) - (let ((or-part_13 - (not - config8_0))) - (if or-part_13 - or-part_13 - (config-get - config8_0 - 1/read-accept-bar-quote))) - #f))) - (if or-part_13 - or-part_13 - (let ((or-part_14 - (if for-type?9_0 - (let ((or-part_14 - (char=? - ch_0 - '#\x3c))) - (if or-part_14 - or-part_14 - (char=? + (|#%name| + symbol->print-string + (lambda (case-sensitive?10_0 + config8_0 + for-keyword?11_0 + for-type?9_0 + sym16_0) + (begin + (let ((case-sensitive?_0 + (if (eq? case-sensitive?10_0 unsafe-undefined) + (if config8_0 (config-get config8_0 1/read-case-sensitive) #t) + case-sensitive?10_0))) + (let ((str_0 (symbol->immutable-string sym16_0))) + (let ((is-simple?_0 + (|#%name| + is-simple? + (lambda (ch_0 i_0) + (begin + (not + (let ((or-part_0 (char=? ch_0 '#\x28))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (char=? ch_0 '#\x5b))) + (if or-part_1 + or-part_1 + (let ((or-part_2 (char=? ch_0 '#\x7b))) + (if or-part_2 + or-part_2 + (let ((or-part_3 (char=? ch_0 '#\x29))) + (if or-part_3 + or-part_3 + (let ((or-part_4 (char=? ch_0 '#\x5d))) + (if or-part_4 + or-part_4 + (let ((or-part_5 + (char=? ch_0 '#\x7d))) + (if or-part_5 + or-part_5 + (let ((or-part_6 + (char=? ch_0 '#\x22))) + (if or-part_6 + or-part_6 + (let ((or-part_7 + (char=? + ch_0 + '#\x5c))) + (if or-part_7 + or-part_7 + (let ((or-part_8 + (char=? + ch_0 + '#\x27))) + (if or-part_8 + or-part_8 + (let ((or-part_9 + (char=? + ch_0 + '#\x2c))) + (if or-part_9 + or-part_9 + (let ((or-part_10 + (char=? + ch_0 + '#\x3b))) + (if or-part_10 + or-part_10 + (let ((or-part_11 + (char=? + ch_0 + '#\x60))) + (if or-part_11 + or-part_11 + (let ((or-part_12 + (char=? + ch_0 + '#\xfeff))) + (if or-part_12 + or-part_12 + (let ((or-part_13 + (if (char=? ch_0 - '#\x3e))) - #f))) - (if or-part_14 - or-part_14 - (let ((or-part_15 - (if (char-whitespace? - ch_0) - (let ((or-part_15 - (not - for-type?9_0))) - (if or-part_15 - or-part_15 - (not - (char=? - ch_0 - '#\x20)))) - #f))) - (if or-part_15 - or-part_15 - (let ((or-part_16 - (if (char=? - ch_0 - '#\x23) - (if (zero? - i_0) - (let ((or-part_16 - (< - (string-length - str_0) - 2))) - (if or-part_16 - or-part_16 - (not - (char=? - (string-ref - str_0 - 1) - '#\x25)))) - #f) - #f))) - (if or-part_16 - or-part_16 - (let ((or-part_17 - (if (char=? - ch_0 - '#\x2e) - (if (zero? - i_0) - (= - (string-length - str_0) - 1) - #f) - #f))) - (if or-part_17 - or-part_17 - (if (not - case-sensitive?_0) + '#\x7c) + (let ((or-part_13 (not + config8_0))) + (if or-part_13 + or-part_13 + (config-get + config8_0 + 1/read-accept-bar-quote))) + #f))) + (if or-part_13 + or-part_13 + (let ((or-part_14 + (if for-type?9_0 + (let ((or-part_14 + (char=? + ch_0 + '#\x3c))) + (if or-part_14 + or-part_14 (char=? ch_0 - (char-foldcase - ch_0))) - #f)))))))))))))))))))))))))))))))))))))))))) - (loop_0 - (|#%name| - loop - (lambda (case-sensitive?_0 - config8_0 - for-type?9_0 - len_0 - str_0 - start_0 - i_0) - (begin - (if (= i_0 len_0) - (list (substring str_0 start_0 len_0)) - (if (is-simple?_0 - case-sensitive?_0 - config8_0 - for-type?9_0 - str_0 - (string-ref str_0 i_0) - i_0) - (loop_0 - case-sensitive?_0 - config8_0 - for-type?9_0 - len_0 - str_0 - start_0 - (add1 i_0)) - (let ((app_0 (substring str_0 start_0 i_0))) - (let ((app_1 (substring str_0 i_0 (add1 i_0)))) - (list* - app_0 - "\\" - app_1 - (let ((app_2 (add1 i_0))) - (loop_0 - case-sensitive?_0 - config8_0 - for-type?9_0 - len_0 - str_0 - app_2 - (add1 i_0))))))))))))) - (|#%name| - symbol->print-string - (lambda (case-sensitive?10_0 - config8_0 - for-keyword?11_0 - for-type?9_0 - sym16_0) - (begin - (let ((case-sensitive?_0 - (if (eq? case-sensitive?10_0 unsafe-undefined) - (if config8_0 - (config-get config8_0 1/read-case-sensitive) - #t) - case-sensitive?10_0))) - (let ((str_0 (symbol->immutable-string sym16_0))) + '#\x3e))) + #f))) + (if or-part_14 + or-part_14 + (let ((or-part_15 + (if (char-whitespace? + ch_0) + (let ((or-part_15 + (not + for-type?9_0))) + (if or-part_15 + or-part_15 + (not + (char=? + ch_0 + '#\x20)))) + #f))) + (if or-part_15 + or-part_15 + (let ((or-part_16 + (if (char=? + ch_0 + '#\x23) + (if (zero? + i_0) + (let ((or-part_16 + (< + (string-length + str_0) + 2))) + (if or-part_16 + or-part_16 + (not + (char=? + (string-ref + str_0 + 1) + '#\x25)))) + #f) + #f))) + (if or-part_16 + or-part_16 + (let ((or-part_17 + (if (char=? + ch_0 + '#\x2e) + (if (zero? + i_0) + (= + (string-length + str_0) + 1) + #f) + #f))) + (if or-part_17 + or-part_17 + (if (not + case-sensitive?_0) + (not + (char=? + ch_0 + (char-foldcase + ch_0))) + #f))))))))))))))))))))))))))))))))))))))))))) (if (call-with-values (lambda () (begin @@ -20312,13 +19556,7 @@ (let ((ch_0 (string-ref vec_1 pos_0))) (let ((result_1 (let ((result_1 - (is-simple?_0 - case-sensitive?_0 - config8_0 - for-type?9_0 - str_0 - ch_0 - pos_1))) + (is-simple?_0 ch_0 pos_1))) (values result_1)))) (if (if (not (let ((x_0 (list ch_0))) @@ -20393,50 +19631,64 @@ (let ((len_0 (string-length str_0))) (apply string-append - (loop_0 - case-sensitive?_0 - config8_0 - for-type?9_0 - len_0 - str_0 - 0 - 0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (start_0 i_0) + (begin + (if (= i_0 len_0) + (list (substring str_0 start_0 len_0)) + (if (is-simple?_0 (string-ref str_0 i_0) i_0) + (loop_0 start_0 (add1 i_0)) + (let ((app_0 (substring str_0 start_0 i_0))) + (let ((app_1 + (substring str_0 i_0 (add1 i_0)))) + (list* + app_0 + "\\" + app_1 + (let ((app_2 (add1 i_0))) + (loop_0 app_2 (add1 i_0))))))))))))) + (loop_0 0 0)))) (string-append "|" str_0 "|")))))))))) (define print-char - (letrec ((pad_0 - (|#%name| - pad - (lambda (n_0 s_0) - (begin - (let ((len_0 (string-length s_0))) - (if (< len_0 n_0) - (string-append (make-string (- n_0 len_0) '#\x30) s_0) - s_0))))))) - (lambda (c_0 o_0 max-length_0) - (let ((esc-str_0 - (if (eqv? c_0 '#\x0) - "#\\nul" - (if (eqv? c_0 '#\x8) - "#\\backspace" - (if (eqv? c_0 '#\x9) - "#\\tab" - (if (eqv? c_0 '#\xc) - "#\\page" - (if (eqv? c_0 '#\xa) - "#\\newline" - (if (eqv? c_0 '#\xd) - "#\\return" - (if (eqv? c_0 '#\xb) - "#\\vtab" - (if (eqv? c_0 '#\x20) - "#\\space" - (if (eqv? c_0 '#\x7f) "#\\rubout" #f))))))))))) - (if esc-str_0 - (write-string/max esc-str_0 o_0 max-length_0) - (if (char-graphic? c_0) - (let ((max-length_1 (write-string/max "#\\" o_0 max-length_0))) - (write-string/max (string c_0) o_0 max-length_1)) - (let ((n_0 (char->integer c_0))) + (lambda (c_0 o_0 max-length_0) + (let ((esc-str_0 + (if (eqv? c_0 '#\x0) + "#\\nul" + (if (eqv? c_0 '#\x8) + "#\\backspace" + (if (eqv? c_0 '#\x9) + "#\\tab" + (if (eqv? c_0 '#\xc) + "#\\page" + (if (eqv? c_0 '#\xa) + "#\\newline" + (if (eqv? c_0 '#\xd) + "#\\return" + (if (eqv? c_0 '#\xb) + "#\\vtab" + (if (eqv? c_0 '#\x20) + "#\\space" + (if (eqv? c_0 '#\x7f) "#\\rubout" #f))))))))))) + (if esc-str_0 + (write-string/max esc-str_0 o_0 max-length_0) + (if (char-graphic? c_0) + (let ((max-length_1 (write-string/max "#\\" o_0 max-length_0))) + (write-string/max (string c_0) o_0 max-length_1)) + (let ((n_0 (char->integer c_0))) + (let ((pad_0 + (|#%name| + pad + (lambda (n_1 s_0) + (begin + (let ((len_0 (string-length s_0))) + (if (< len_0 n_1) + (string-append + (make-string (- n_1 len_0) '#\x30) + s_0) + s_0))))))) (if (<= n_0 65535) (let ((max-length_1 (write-string/max "#\\u" o_0 max-length_0))) @@ -20581,28 +19833,27 @@ #f #f)))) (define set-port-handlers-to-recur! - (letrec ((...nt/recur-handler.rkt:9:39_0 - (|#%name| - ...nt/recur-handler.rkt:9:39 - (lambda (handle_0 e2_0 p3_0 mode1_0) - (begin (|#%app| handle_0 e2_0 p3_0 mode1_0)))))) - (lambda (port_0 handle_0) - (begin - (set-core-output-port-print-handler! - port_0 + (lambda (port_0 handle_0) + (begin + (set-core-output-port-print-handler! + port_0 + (let ((...nt/recur-handler.rkt:9:39_0 + (|#%name| + ...nt/recur-handler.rkt:9:39 + (lambda (e2_0 p3_0 mode1_0) + (begin (|#%app| handle_0 e2_0 p3_0 mode1_0)))))) (|#%name| ...nt/recur-handler.rkt:9:39 (case-lambda - ((e_0 p_0) - (begin (...nt/recur-handler.rkt:9:39_0 handle_0 e_0 p_0 0))) + ((e_0 p_0) (begin (...nt/recur-handler.rkt:9:39_0 e_0 p_0 0))) ((e_0 p_0 mode1_0) - (...nt/recur-handler.rkt:9:39_0 handle_0 e_0 p_0 mode1_0))))) - (set-core-output-port-write-handler! - port_0 - (lambda (e_0 p_0) (|#%app| handle_0 e_0 p_0 #t))) - (set-core-output-port-display-handler! - port_0 - (lambda (e_0 p_0) (|#%app| handle_0 e_0 p_0 #f))))))) + (...nt/recur-handler.rkt:9:39_0 e_0 p_0 mode1_0)))))) + (set-core-output-port-write-handler! + port_0 + (lambda (e_0 p_0) (|#%app| handle_0 e_0 p_0 #t))) + (set-core-output-port-display-handler! + port_0 + (lambda (e_0 p_0) (|#%app| handle_0 e_0 p_0 #f)))))) (define detect-graph (lambda (v_0 mode_0 config_0) (let ((print-graph?_0 (1/print-graph))) @@ -20611,196 +19862,132 @@ (let ((ht_0 (make-hasheq))) (build-graph v_0 ht_0 print-graph?_0 mode_0 config_0)))))) (define quick-no-graph? - (letrec ((for-loop_0 - (|#%name| - for-loop - (lambda (config_0 len_0 mode_0 print-graph?_0 vec_0 fuel_0 pos_0) - (begin - (if (unsafe-fx< pos_0 len_0) - (let ((e_0 (unsafe-vector-ref vec_0 pos_0))) - (if (not fuel_0) - fuel_0 - (let ((fuel_1 + (lambda (v_0 fuel_0 mode_0 print-graph?_0 config_0) + (letrec* + ((quick-no-graph?_0 + (|#%name| + quick-no-graph? + (lambda (v_1 fuel_1) + (begin + (if (let ((or-part_0 (not fuel_1))) + (if or-part_0 or-part_0 (zero? fuel_1))) + #f + (if (pair? v_1) + (if (not print-graph?_0) + (let ((app_0 (cdr v_1))) + (quick-no-graph?_0 + app_0 + (let ((app_1 (car v_1))) + (quick-no-graph?_0 app_1 (sub1 fuel_1))))) + #f) + (if (vector? v_1) + (if (not print-graph?_0) + (call-with-values + (lambda () + (begin + (check-vector v_1) + (values v_1 (unsafe-vector-length v_1)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fuel_2 pos_0) + (begin + (if (unsafe-fx< pos_0 len_0) + (let ((e_0 (unsafe-vector-ref vec_0 pos_0))) + (let ((next-k-proc_0 + (|#%name| + next-k-proc + (lambda (fuel_3) + (begin + (for-loop_0 + fuel_3 + (unsafe-fx+ 1 pos_0))))))) + (if (not fuel_2) + fuel_2 + (let ((fuel_3 + (quick-no-graph?_0 + e_0 + fuel_2))) + (next-k-proc_0 fuel_3))))) + fuel_2)))))) + (for-loop_0 (sub1 fuel_1) 0)))) + (args (raise-binding-result-arity-error 2 args)))) + #f) + (if (if (box? v_1) (config-get config_0 1/print-box) #f) + (if (not print-graph?_0) + (let ((app_0 (unbox v_1))) + (quick-no-graph?_0 app_0 (sub1 fuel_1))) + #f) + (if (if (hash? v_1) + (if (not (hash-weak? v_1)) + (config-get config_0 1/print-hash-table) + #f) + #f) + (if (not print-graph?_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fuel_2 i_0) + (begin + (if i_0 + (let ((k_0 (hash-iterate-key v_1 i_0 #f))) + (let ((next-k-proc_0 + (|#%name| + next-k-proc + (lambda (fuel_3) + (begin + (for-loop_0 + fuel_3 + (hash-iterate-next + v_1 + i_0))))))) + (if (not fuel_2) + fuel_2 + (let ((fuel_3 + (let ((val_0 + (hash-ref v_1 k_0 #f))) + (quick-no-graph?_0 + val_0 + (quick-no-graph?_0 + k_0 + fuel_2))))) + (next-k-proc_0 fuel_3))))) + fuel_2)))))) + (let ((app_0 (sub1 fuel_1))) + (for-loop_0 app_0 (hash-iterate-first v_1))))) + #f) + (if (mpair? v_1) + (if (not print-graph?_0) + (if (not (eq? mode_0 0)) + (let ((app_0 (unsafe-mcdr v_1))) (quick-no-graph?_0 - config_0 - mode_0 - print-graph?_0 - e_0 - fuel_0))) - (next-k-proc_0 - config_0 - len_0 - mode_0 - pos_0 - print-graph?_0 - vec_0 - fuel_1)))) - fuel_0))))) - (for-loop_1 - (|#%name| - for-loop - (lambda (config_0 mode_0 print-graph?_0 v_0 fuel_0 i_0) - (begin - (if i_0 - (let ((k_0 (hash-iterate-key v_0 i_0 #f))) - (if (not fuel_0) - fuel_0 - (let ((fuel_1 - (let ((val_0 (hash-ref v_0 k_0 #f))) - (quick-no-graph?_0 - config_0 - mode_0 - print-graph?_0 - val_0 - (quick-no-graph?_0 - config_0 - mode_0 - print-graph?_0 - k_0 - fuel_0))))) - (next-k-proc_1 - config_0 - i_0 - mode_0 - print-graph?_0 - v_0 - fuel_1)))) - fuel_0))))) - (next-k-proc_0 - (|#%name| - next-k-proc - (lambda (config_0 len_0 mode_0 pos_0 print-graph?_0 vec_0 fuel_0) - (begin - (for-loop_0 - config_0 - len_0 - mode_0 - print-graph?_0 - vec_0 - fuel_0 - (unsafe-fx+ 1 pos_0)))))) - (next-k-proc_1 - (|#%name| - next-k-proc - (lambda (config_0 i_0 mode_0 print-graph?_0 v_0 fuel_0) - (begin - (for-loop_1 - config_0 - mode_0 - print-graph?_0 - v_0 - fuel_0 - (hash-iterate-next v_0 i_0)))))) - (quick-no-graph?_0 - (|#%name| - quick-no-graph? - (lambda (config_0 mode_0 print-graph?_0 v_0 fuel_0) - (begin - (if (let ((or-part_0 (not fuel_0))) - (if or-part_0 or-part_0 (zero? fuel_0))) - #f - (if (pair? v_0) - (if (not print-graph?_0) - (let ((app_0 (cdr v_0))) - (quick-no-graph?_0 - config_0 - mode_0 - print-graph?_0 - app_0 - (let ((app_1 (car v_0))) - (quick-no-graph?_0 - config_0 - mode_0 - print-graph?_0 - app_1 - (sub1 fuel_0))))) - #f) - (if (vector? v_0) - (if (not print-graph?_0) - (call-with-values - (lambda () - (begin - (check-vector v_0) - (values v_0 (unsafe-vector-length v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (for-loop_0 - config_0 - len_0 - mode_0 - print-graph?_0 - vec_0 - (sub1 fuel_0) - 0))) - (args (raise-binding-result-arity-error 2 args)))) - #f) - (if (if (box? v_0) (config-get config_0 1/print-box) #f) - (if (not print-graph?_0) - (let ((app_0 (unbox v_0))) - (quick-no-graph?_0 - config_0 - mode_0 - print-graph?_0 - app_0 - (sub1 fuel_0))) - #f) - (if (if (hash? v_0) - (if (not (hash-weak? v_0)) - (config-get config_0 1/print-hash-table) - #f) - #f) - (if (not print-graph?_0) - (begin - (let ((app_0 (sub1 fuel_0))) - (for-loop_1 - config_0 - mode_0 - print-graph?_0 - v_0 - app_0 - (hash-iterate-first v_0)))) - #f) - (if (mpair? v_0) - (if (not print-graph?_0) - (if (not (eq? mode_0 0)) - (let ((app_0 (unsafe-mcdr v_0))) - (quick-no-graph?_0 - config_0 - mode_0 - print-graph?_0 - app_0 - (let ((app_1 (unsafe-mcar v_0))) - (quick-no-graph?_0 - config_0 - mode_0 - print-graph?_0 - app_1 - (sub1 fuel_0))))) - #f) - #f) - (if (if (1/custom-write? v_0) - (not (struct-type? v_0)) - #f) - #f - (if (if (struct? v_0) - (config-get config_0 1/print-struct) - #f) - (if (not print-graph?_0) - (if (prefab-struct-key v_0) - (let ((app_0 (struct->vector v_0))) - (quick-no-graph?_0 - config_0 - mode_0 - print-graph?_0 - app_0 - (sub1 fuel_0))) - #f) - #f) - fuel_0))))))))))))) - (lambda (v_0 fuel_0 mode_0 print-graph?_0 config_0) - (quick-no-graph?_0 config_0 mode_0 print-graph?_0 v_0 fuel_0)))) + app_0 + (let ((app_1 (unsafe-mcar v_1))) + (quick-no-graph?_0 app_1 (sub1 fuel_1))))) + #f) + #f) + (if (if (1/custom-write? v_1) + (not (struct-type? v_1)) + #f) + #f + (if (if (struct? v_1) + (config-get config_0 1/print-struct) + #f) + (if (not print-graph?_0) + (if (prefab-struct-key v_1) + (let ((app_0 (struct->vector v_1))) + (quick-no-graph?_0 app_0 (sub1 fuel_1))) + #f) + #f) + fuel_1))))))))))))) + (quick-no-graph?_0 v_0 fuel_0)))) (define struct:as-constructor (make-record-type-descriptor* 'as-constructor #f #f #f #f 1 0)) (define effect_2971 @@ -20850,583 +20037,498 @@ 'as-constructor 'tag)))))) (define build-graph - (letrec ((build-graph_0 - (|#%name| - build-graph - (lambda (checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - v_0 - mode_0) - (begin - (if (not v_0) - #f - (let ((c1_0 (hash-ref ht_0 v_0 #f))) - (if c1_0 - (begin - (if (let ((or-part_0 (eq? c1_0 'checking))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (eq? c1_0 'checked))) - (if or-part_1 - or-part_1 - (if (as-constructor? c1_0) - (not (as-constructor-tag c1_0)) - #f))))) - (begin - (hash-set! - ht_0 - v_0 - (if (as-constructor? c1_0) - (as-constructor1.1 (unsafe-unbox* counter_0)) - (unsafe-unbox* counter_0))) - (unsafe-set-box*! - counter_0 - (add1 (unsafe-unbox* counter_0))) - (if (eq? c1_0 'checking) - (unsafe-set-box*! cycle?_0 #t) - (void))) - (void)) - (as-constructor? c1_0)) - (if (pair? v_0) - (begin - (checking!_0 ht_0 v_0) - (let ((car-unquoted?_0 - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 + (lambda (v_0 ht_0 print-graph?_0 mode_0 config_0) + (let ((counter_0 0)) + (let ((cycle?_0 #f)) + (let ((constructor?_0 #f)) + (let ((checking-port_0 #f)) + (let ((checking!_0 + (|#%name| + checking! + (lambda (v_1) (begin (hash-set! ht_0 v_1 'checking)))))) + (let ((done!_0 + (|#%name| + done! + (lambda (v_1 unquoted?_0) + (begin + (begin + (if (eq? 'checking (hash-ref ht_0 v_1 #f)) + (hash-set! ht_0 v_1 'checked) + (void)) + (if unquoted?_0 + (let ((c_0 (hash-ref ht_0 v_1 #f))) + (begin + (hash-set! ht_0 - (car v_0) - mode_0))) - (let ((unquoted?_0 - (let ((or-part_0 - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - (cdr v_0) - mode_0))) - (if or-part_0 - or-part_0 - car-unquoted?_0)))) - (done!_0 constructor?_0 ht_0 v_0 unquoted?_0)))) - (if (vector? v_0) - (begin - (checking!_0 ht_0 v_0) - (let ((unquoted?_0 - (call-with-values - (lambda () - (begin - (check-vector v_0) - (values - v_0 - (unsafe-vector-length v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (unquoted?_0 pos_0) - (begin - (if (unsafe-fx< pos_0 len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (let ((unquoted?_1 - (let ((unquoted?_1 - (let ((or-part_0 - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - e_0 - mode_0))) - (if or-part_0 - or-part_0 - unquoted?_0)))) - (values - unquoted?_1)))) - (for-loop_0 - unquoted?_1 - (unsafe-fx+ 1 pos_0)))) - unquoted?_0)))))) - (for-loop_0 #f 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (done!_0 constructor?_0 ht_0 v_0 unquoted?_0))) - (if (if (box? v_0) - (config-get config_0 1/print-box) - #f) - (begin - (checking!_0 ht_0 v_0) - (let ((unquoted?_0 - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 + v_1 + (as-constructor1.1 + (if (integer? c_0) c_0 #f))) + (set! constructor?_0 #t))) + (void)) + unquoted?_0)))))) + (begin + (letrec* + ((build-graph_0 + (|#%name| + build-graph + (lambda (v_1 mode_1) + (begin + (if (not v_1) + #f + (let ((c1_0 (hash-ref ht_0 v_1 #f))) + (if c1_0 + (begin + (if (let ((or-part_0 (eq? c1_0 'checking))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (eq? c1_0 'checked))) + (if or-part_1 + or-part_1 + (if (as-constructor? c1_0) + (not (as-constructor-tag c1_0)) + #f))))) + (begin + (hash-set! ht_0 - (unbox v_0) - mode_0))) - (done!_0 - constructor?_0 - ht_0 - v_0 - unquoted?_0))) - (if (if (hash? v_0) - (if (not (hash-weak? v_0)) - (config-get config_0 1/print-hash-table) - #f) - #f) - (begin - (checking!_0 ht_0 v_0) - (let ((unquoted?_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (unquoted?_0 i_0) + v_1 + (if (as-constructor? c1_0) + (as-constructor1.1 counter_0) + counter_0)) + (set! counter_0 (add1 counter_0)) + (if (eq? c1_0 'checking) + (set! cycle?_0 #t) + (void))) + (void)) + (as-constructor? c1_0)) + (if (pair? v_1) + (begin + (checking!_0 v_1) + (let ((car-unquoted?_0 + (build-graph_0 (car v_1) mode_1))) + (let ((unquoted?_0 + (let ((or-part_0 + (build-graph_0 + (cdr v_1) + mode_1))) + (if or-part_0 + or-part_0 + car-unquoted?_0)))) + (done!_0 v_1 unquoted?_0)))) + (if (vector? v_1) + (begin + (checking!_0 v_1) + (let ((unquoted?_0 + (call-with-values + (lambda () (begin - (if i_0 - (let ((k_0 - (hash-iterate-key - v_0 - i_0))) - (let ((unquoted?_1 - (let ((unquoted?_1 - (let ((val_0 - (hash-ref - v_0 - k_0 - #f))) - (let ((k-unquoted?_0 - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - k_0 - mode_0))) - (let ((or-part_0 - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - val_0 - mode_0))) - (if or-part_0 - or-part_0 - (if k-unquoted?_0 - k-unquoted?_0 - unquoted?_0))))))) - (values - unquoted?_1)))) - (for-loop_0 - unquoted?_1 - (hash-iterate-next - v_0 - i_0)))) - unquoted?_0)))))) - (for-loop_0 - #f - (hash-iterate-first v_0)))))) - (done!_0 - constructor?_0 - ht_0 - v_0 - unquoted?_0))) - (if (mpair? v_0) - (begin - (checking!_0 ht_0 v_0) - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - (unsafe-mcar v_0) - mode_0) - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - (unsafe-mcdr v_0) - mode_0) - (done!_0 - constructor?_0 - ht_0 - v_0 - (eq? mode_0 0))) - (if (if (1/custom-write? v_0) - (not (struct-type? v_0)) - #f) - (let ((print-quotable_0 - (if (eq? mode_0 0) - (1/custom-print-quotable-accessor - v_0 - 'self) - 'self))) - (let ((unquoted?_0 - (eq? print-quotable_0 'never))) - (begin - (if (unsafe-unbox* checking-port_0) - (void) - (begin - (unsafe-set-box*! - checking-port_0 - (open-output-nowhere)) - (set-port-handlers-to-recur! - (unsafe-unbox* checking-port_0) - (lambda (e_0 p_0 mode_1) - (if (let ((or-part_0 - (eq? mode_1 1))) - (if or-part_0 - or-part_0 - (eq? mode_1 0))) - (let ((e-unquoted?_0 - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - e_0 - mode_1))) - (if (let ((or-part_0 - (eq? - print-quotable_0 - 'always))) - (if or-part_0 - or-part_0 - (eq? - print-quotable_0 - 'self))) - (void) - (set! unquoted?_0 - (if e-unquoted?_0 - e-unquoted?_0 - unquoted?_0)))) - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - e_0 - mode_1)))))) - (checking!_0 ht_0 v_0) - (let ((app_0 - (1/custom-write-accessor v_0))) - (let ((app_1 - (unsafe-unbox* - checking-port_0))) - (|#%app| - app_0 - v_0 - app_1 - (if (if (eq? mode_0 0) - (eq? - print-quotable_0 - 'always) - #f) - 1 - mode_0)))) - (done!_0 - constructor?_0 - ht_0 - v_0 - unquoted?_0)))) - (if (if (struct? v_0) - (config-get config_0 1/print-struct) - #f) - (begin - (checking!_0 ht_0 v_0) - (let ((unquoted?_0 - (let ((or-part_0 - (call-with-values - (lambda () - (let ((vec_0 - (struct->vector - v_0))) - (begin - (check-vector - vec_0) - (values - vec_0 - (unsafe-vector-length - vec_0))))) - (case-lambda - ((vec_0 len_0) + (check-vector v_1) + (values + v_1 + (unsafe-vector-length + v_1)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (unquoted?_0 + pos_0) (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (unquoted?_0 - pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) + (if (unsafe-fx< + pos_0 + len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (let ((unquoted?_1 + (let ((unquoted?_1 + (let ((or-part_0 + (build-graph_0 + e_0 + mode_1))) + (if or-part_0 + or-part_0 + unquoted?_0)))) + (values + unquoted?_1)))) + (for-loop_0 + unquoted?_1 + (unsafe-fx+ + 1 + pos_0)))) + unquoted?_0)))))) + (for-loop_0 #f 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (done!_0 v_1 unquoted?_0))) + (if (if (box? v_1) + (config-get config_0 1/print-box) + #f) + (begin + (checking!_0 v_1) + (let ((unquoted?_0 + (build-graph_0 + (unbox v_1) + mode_1))) + (done!_0 v_1 unquoted?_0))) + (if (if (hash? v_1) + (if (not (hash-weak? v_1)) + (config-get + config_0 + 1/print-hash-table) + #f) + #f) + (begin + (checking!_0 v_1) + (let ((unquoted?_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (unquoted?_0 + i_0) + (begin + (if i_0 + (let ((k_0 + (hash-iterate-key + v_1 + i_0))) + (let ((unquoted?_1 (let ((unquoted?_1 - (let ((unquoted?_1 - (let ((or-part_0 - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - e_0 - mode_0))) - (if or-part_0 - or-part_0 - unquoted?_0)))) - (values - unquoted?_1)))) - (for-loop_0 - unquoted?_1 - (unsafe-fx+ - 1 - pos_0)))) - unquoted?_0)))))) - (for-loop_0 #f 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (if or-part_0 - or-part_0 - (if (eq? mode_0 0) - (not - (prefab-struct-key v_0)) - #f))))) - (done!_0 - constructor?_0 - ht_0 - v_0 - unquoted?_0))) - #f)))))))))))))) - (checking!_0 - (|#%name| - checking! - (lambda (ht_0 v_0) (begin (hash-set! ht_0 v_0 'checking))))) - (done!_0 - (|#%name| - done! - (lambda (constructor?_0 ht_0 v_0 unquoted?_0) - (begin - (begin - (if (eq? 'checking (hash-ref ht_0 v_0 #f)) - (hash-set! ht_0 v_0 'checked) - (void)) - (if unquoted?_0 - (let ((c_0 (hash-ref ht_0 v_0 #f))) - (begin - (hash-set! - ht_0 - v_0 - (as-constructor1.1 (if (integer? c_0) c_0 #f))) - (unsafe-set-box*! constructor?_0 #t))) - (void)) - unquoted?_0)))))) - (lambda (v_0 ht_0 print-graph?_0 mode_0 config_0) - (let ((counter_0 (box 0))) - (let ((cycle?_0 (box #f))) - (let ((constructor?_0 (box #f))) - (let ((checking-port_0 (box #f))) - (begin - (build-graph_0 - checking-port_0 - config_0 - constructor?_0 - counter_0 - cycle?_0 - ht_0 - v_0 - mode_0) - (if (if (not (unsafe-unbox* cycle?_0)) - (if (not (unsafe-unbox* constructor?_0)) - (not print-graph?_0) + (let ((val_0 + (hash-ref + v_1 + k_0 + #f))) + (let ((k-unquoted?_0 + (build-graph_0 + k_0 + mode_1))) + (let ((or-part_0 + (build-graph_0 + val_0 + mode_1))) + (if or-part_0 + or-part_0 + (if k-unquoted?_0 + k-unquoted?_0 + unquoted?_0))))))) + (values + unquoted?_1)))) + (for-loop_0 + unquoted?_1 + (hash-iterate-next + v_1 + i_0)))) + unquoted?_0)))))) + (for-loop_0 + #f + (hash-iterate-first + v_1)))))) + (done!_0 v_1 unquoted?_0))) + (if (mpair? v_1) + (begin + (checking!_0 v_1) + (build-graph_0 + (unsafe-mcar v_1) + mode_1) + (build-graph_0 + (unsafe-mcdr v_1) + mode_1) + (done!_0 v_1 (eq? mode_1 0))) + (if (if (1/custom-write? v_1) + (not (struct-type? v_1)) + #f) + (let ((print-quotable_0 + (if (eq? mode_1 0) + (1/custom-print-quotable-accessor + v_1 + 'self) + 'self))) + (let ((unquoted?_0 + (eq? + print-quotable_0 + 'never))) + (begin + (if checking-port_0 + (void) + (begin + (set! checking-port_0 + (open-output-nowhere)) + (set-port-handlers-to-recur! + checking-port_0 + (lambda (e_0 p_0 mode_2) + (if (let ((or-part_0 + (eq? + mode_2 + 1))) + (if or-part_0 + or-part_0 + (eq? + mode_2 + 0))) + (let ((e-unquoted?_0 + (build-graph_0 + e_0 + mode_2))) + (if (let ((or-part_0 + (eq? + print-quotable_0 + 'always))) + (if or-part_0 + or-part_0 + (eq? + print-quotable_0 + 'self))) + (void) + (set! unquoted?_0 + (if e-unquoted?_0 + e-unquoted?_0 + unquoted?_0)))) + (build-graph_0 + e_0 + mode_2)))))) + (checking!_0 v_1) + (let ((app_0 + (1/custom-write-accessor + v_1))) + (let ((app_1 + checking-port_0)) + (|#%app| + app_0 + v_1 + app_1 + (if (if (eq? mode_1 0) + (eq? + print-quotable_0 + 'always) + #f) + 1 + mode_1)))) + (done!_0 v_1 unquoted?_0)))) + (if (if (struct? v_1) + (config-get + config_0 + 1/print-struct) + #f) + (begin + (checking!_0 v_1) + (let ((unquoted?_0 + (let ((or-part_0 + (call-with-values + (lambda () + (let ((vec_0 + (struct->vector + v_1))) + (begin + (check-vector + vec_0) + (values + vec_0 + (unsafe-vector-length + vec_0))))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (unquoted?_0 + pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (let ((unquoted?_1 + (let ((unquoted?_1 + (let ((or-part_0 + (build-graph_0 + e_0 + mode_1))) + (if or-part_0 + or-part_0 + unquoted?_0)))) + (values + unquoted?_1)))) + (for-loop_0 + unquoted?_1 + (unsafe-fx+ + 1 + pos_0)))) + unquoted?_0)))))) + (for-loop_0 + #f + 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (if or-part_0 + or-part_0 + (if (eq? mode_1 0) + (not + (prefab-struct-key + v_1)) + #f))))) + (done!_0 v_1 unquoted?_0))) + #f))))))))))))))) + (build-graph_0 v_0 mode_0)) + (if (if (not cycle?_0) + (if (not constructor?_0) (not print-graph?_0) #f) #f) - #f) - #f - (if (if (not (unsafe-unbox* cycle?_0)) - (not print-graph?_0) - #f) - (begin - (let ((lst_0 (hash-keys ht_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((k_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (begin - (let ((v_1 (hash-ref ht_0 k_0))) - (if (not (as-constructor? v_1)) + #f + (if (if (not cycle?_0) (not print-graph?_0) #f) + (begin + (let ((lst_0 (hash-keys ht_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? lst_1) + (let ((k_0 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (begin + (let ((v_1 (hash-ref ht_0 k_0))) + (if (not (as-constructor? v_1)) + (hash-remove! ht_0 k_0) + (if (as-constructor-tag v_1) + (hash-set! + ht_0 + k_0 + (as-constructor1.1 #f)) + (void)))) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 lst_0)))) + (void) + ht_0) + (begin + (let ((lst_0 (hash-keys ht_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? lst_1) + (let ((k_0 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (begin + (if (eq? + 'checked + (hash-ref ht_0 k_0)) (hash-remove! ht_0 k_0) - (if (as-constructor-tag v_1) - (hash-set! - ht_0 - k_0 - (as-constructor1.1 #f)) - (void)))) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void) - ht_0) - (begin - (let ((lst_0 (hash-keys ht_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((k_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (begin - (if (eq? - 'checked - (hash-ref ht_0 k_0)) - (hash-remove! ht_0 k_0) - (void)) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void) - ht_0))))))))))) + (void)) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 lst_0)))) + (void) + ht_0)))))))))))) (define print-list - (letrec ((abbreviation_0 - (|#%name| - abbreviation - (lambda (alt-list-constructor_0 config_0 mode_0 v_0) - (begin - (if (not (eq? mode_0 #f)) - (if (pair? v_0) - (if (pair? (cdr v_0)) - (if (null? (cddr v_0)) - (if (not alt-list-constructor_0) - (if (let ((or-part_0 (not (eq? mode_0 #t)))) - (if or-part_0 - or-part_0 - (config-get - config_0 - 1/print-reader-abbreviations))) - (let ((tmp_0 (car v_0))) - (if (eq? tmp_0 'quote) - "'" - (if (eq? tmp_0 'quasiquote) - "`" - (if (eq? tmp_0 'unquote) - (if (starts-@?_0 config_0 (cadr v_0)) - ", " - ",") - (if (eq? tmp_0 'unquote-splicing) - ",@" - (if (eq? tmp_0 'syntax) - "#'" - (if (eq? tmp_0 'quasisyntax) - "#`" - (if (eq? tmp_0 'unsyntax) - (if (starts-@?_0 - config_0 - (cadr v_0)) - "#, " - "#,") - (if (eq? tmp_0 'unsyntax-splicing) - "#,@" - #f))))))))) - #f) - #f) - #f) - #f) - #f) - #f))))) - (starts-@?_0 - (|#%name| - starts-@? - (lambda (config_0 v_0) - (begin - (if (symbol? v_0) - (let ((s_0 - (symbol->print-string.1 - unsafe-undefined - config_0 - #f - #f - v_0))) - (char=? '#\x40 (string-ref s_0 0))) - #f)))))) - (lambda (p_0 - who_0 - v_0 - mode_0 - o_0 - max-length_0 - graph_0 - config_0 - alt-list-prefix_0 - alt-list-constructor_0) - (let ((unquoted-pairs?_0 - (if (eq? mode_0 0) - (if (not alt-list-constructor_0) - (not (uninterrupted-list? v_0 graph_0)) + (lambda (p_0 + who_0 + v_0 + mode_0 + o_0 + max-length_0 + graph_0 + config_0 + alt-list-prefix_0 + alt-list-constructor_0) + (let ((unquoted-pairs?_0 + (if (eq? mode_0 0) + (if (not alt-list-constructor_0) + (not (uninterrupted-list? v_0 graph_0)) + #f) + #f))) + (let ((curly?_0 + (if (not (eq? mode_0 0)) + (if (not alt-list-prefix_0) + (config-get config_0 1/print-pair-curly-braces) #f) #f))) - (let ((curly?_0 - (if (not (eq? mode_0 0)) - (if (not alt-list-prefix_0) - (config-get config_0 1/print-pair-curly-braces) - #f) - #f))) - (let ((c1_0 - (abbreviation_0 alt-list-constructor_0 config_0 mode_0 v_0))) + (let ((abbreviation_0 + (|#%name| + abbreviation + (lambda (v_1) + (begin + (if (not (eq? mode_0 #f)) + (if (pair? v_1) + (if (pair? (cdr v_1)) + (if (null? (cddr v_1)) + (if (not alt-list-constructor_0) + (if (let ((or-part_0 (not (eq? mode_0 #t)))) + (if or-part_0 + or-part_0 + (config-get + config_0 + 1/print-reader-abbreviations))) + (let ((starts-@?_0 + (|#%name| + starts-@? + (lambda (v_2) + (begin + (if (symbol? v_2) + (let ((s_0 + (symbol->print-string.1 + unsafe-undefined + config_0 + #f + #f + v_2))) + (char=? + '#\x40 + (string-ref s_0 0))) + #f)))))) + (let ((tmp_0 (car v_1))) + (if (eq? tmp_0 'quote) + "'" + (if (eq? tmp_0 'quasiquote) + "`" + (if (eq? tmp_0 'unquote) + (if (starts-@?_0 (cadr v_1)) + ", " + ",") + (if (eq? tmp_0 'unquote-splicing) + ",@" + (if (eq? tmp_0 'syntax) + "#'" + (if (eq? tmp_0 'quasisyntax) + "#`" + (if (eq? tmp_0 'unsyntax) + (if (starts-@?_0 (cadr v_1)) + "#, " + "#,") + (if (eq? + tmp_0 + 'unsyntax-splicing) + "#,@" + #f)))))))))) + #f) + #f) + #f) + #f) + #f) + #f)))))) + (let ((c1_0 (abbreviation_0 v_0))) (if c1_0 (let ((app_0 (cadr v_0))) (|#%app| @@ -21496,12 +20598,7 @@ or-part_0 (non-graph? (hash-ref graph_0 (cdr v_1) #f)))) - (not - (abbreviation_0 - alt-list-constructor_0 - config_0 - mode_0 - (cdr v_1))) + (not (abbreviation_0 (cdr v_1))) #f) #f) (let ((max-length_3 @@ -21518,12 +20615,7 @@ (loop_0 app_0 (write-string/max " " o_0 max-length_3)))) - (let ((c2_0 - (abbreviation_0 - alt-list-constructor_0 - config_0 - mode_0 - v_1))) + (let ((c2_0 (abbreviation_0 v_1))) (if c2_0 (let ((app_0 (cadr v_1))) (|#%app| @@ -21683,36 +20775,36 @@ max-length_5)))))))))))) (loop_0 v_0 max-length_1))))))) (define print-vector - (letrec ((v->list_0 - (|#%name| - v->list - (lambda (v-ref_0 v_0 len_0) - (begin - (if (zero? len_0) - '() - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (i_0 accum_0) - (begin - (let ((val_0 (|#%app| v-ref_0 v_0 i_0))) - (if (zero? i_0) - (cons val_0 accum_0) - (loop_0 (sub1 i_0) (cons val_0 accum_0))))))))) - (loop_0 (sub1 len_0) '())))))))) - (lambda (p_0 - who_0 - v_0 - mode_0 - o_0 - max-length_0 - graph_0 - config_0 - fx/l-prefix_0 - v-length_0 - v-ref_0 - equ?_0) + (lambda (p_0 + who_0 + v_0 + mode_0 + o_0 + max-length_0 + graph_0 + config_0 + fx/l-prefix_0 + v-length_0 + v-ref_0 + equ?_0) + (let ((v->list_0 + (|#%name| + v->list + (lambda (v_1 len_0) + (begin + (if (zero? len_0) + '() + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 accum_0) + (begin + (let ((val_0 (|#%app| v-ref_0 v_1 i_0))) + (if (zero? i_0) + (cons val_0 accum_0) + (loop_0 (sub1 i_0) (cons val_0 accum_0))))))))) + (loop_0 (sub1 len_0) '())))))))) (let ((cns_0 (string-append "(" fx/l-prefix_0 "vector"))) (if (if (not (eq? mode_0 0)) (if (not (eq? mode_0 #f)) @@ -21740,7 +20832,7 @@ (loop_0 app_0 (add1 accum_0))) accum_0))))))) (loop_0 (- len_0 2) 0)))))) - (let ((lst_0 (v->list_0 v-ref_0 v_0 (- len_0 same-n_0)))) + (let ((lst_0 (v->list_0 v_0 (- len_0 same-n_0)))) (let ((lbl_0 (string-append "#" @@ -21762,7 +20854,7 @@ (print-list p_0 who_0 - (v->list_0 v-ref_0 v_0 (|#%app| v-length_0 v_0)) + (v->list_0 v_0 (|#%app| v-length_0 v_0)) mode_0 o_0 max-length_0 @@ -22068,90 +21160,83 @@ (do-print_0 who_0 v_0 o_0 quote-depth16_0 #f))))) (define do-global-print void) (define install-do-global-print! - (letrec ((...rc/io/print/main.rkt:123:8_0 - (|#%name| - ...rc/io/print/main.rkt:123:8 - (lambda (default-value_0 - param_0 - who34_0 - v35_0 - o36_0 - quote-depth-in32_0 - max-length33_0) - (begin - (let ((quote-depth-in_0 - (if (eq? quote-depth-in32_0 unsafe-undefined) - 0 - quote-depth-in32_0))) - (let ((global-print_0 (|#%app| param_0))) - (begin - (if (eq? global-print_0 default-value_0) - (let ((quote-depth_0 - (if (1/print-as-expression) - quote-depth-in_0 - #t))) - (do-print - who34_0 - v35_0 - o36_0 - quote-depth_0 - max-length33_0)) - (if (not max-length33_0) - (|#%app| - global-print_0 - v35_0 - o36_0 - quote-depth-in_0) - (let ((o2_0 (1/open-output-bytes))) - (begin - (|#%app| - global-print_0 - v35_0 - o2_0 - quote-depth-in_0) - (let ((bstr_0 (1/get-output-bytes o2_0))) - (if (<= - (unsafe-bytes-length bstr_0) - max-length33_0) - (begin-unsafe - (do-write-bytes - who34_0 - o36_0 - bstr_0 - 0 - (unsafe-bytes-length bstr_0))) - (begin - (let ((bstr_1 - (subbytes - bstr_0 - 0 - (sub3 max-length33_0)))) - (begin-unsafe - (do-write-bytes - who34_0 - o36_0 - bstr_1 - 0 - (unsafe-bytes-length bstr_1)))) - (let ((bstr_1 #vu8(46 46 46))) - (begin-unsafe - (do-write-bytes - who34_0 - o36_0 - bstr_1 - 0 - (unsafe-bytes-length bstr_1))))))))))) - (void))))))))) - (lambda (param_0 default-value_0) - (set! do-global-print + (lambda (param_0 default-value_0) + (set! do-global-print + (let ((...rc/io/print/main.rkt:123:8_0 + (|#%name| + ...rc/io/print/main.rkt:123:8 + (lambda (who34_0 v35_0 o36_0 quote-depth-in32_0 max-length33_0) + (begin + (let ((quote-depth-in_0 + (if (eq? quote-depth-in32_0 unsafe-undefined) + 0 + quote-depth-in32_0))) + (let ((global-print_0 (|#%app| param_0))) + (begin + (if (eq? global-print_0 default-value_0) + (let ((quote-depth_0 + (if (1/print-as-expression) + quote-depth-in_0 + #t))) + (do-print + who34_0 + v35_0 + o36_0 + quote-depth_0 + max-length33_0)) + (if (not max-length33_0) + (|#%app| + global-print_0 + v35_0 + o36_0 + quote-depth-in_0) + (let ((o2_0 (1/open-output-bytes))) + (begin + (|#%app| + global-print_0 + v35_0 + o2_0 + quote-depth-in_0) + (let ((bstr_0 (1/get-output-bytes o2_0))) + (if (<= + (unsafe-bytes-length bstr_0) + max-length33_0) + (begin-unsafe + (do-write-bytes + who34_0 + o36_0 + bstr_0 + 0 + (unsafe-bytes-length bstr_0))) + (begin + (let ((bstr_1 + (subbytes + bstr_0 + 0 + (sub3 max-length33_0)))) + (begin-unsafe + (do-write-bytes + who34_0 + o36_0 + bstr_1 + 0 + (unsafe-bytes-length bstr_1)))) + (let ((bstr_1 #vu8(46 46 46))) + (begin-unsafe + (do-write-bytes + who34_0 + o36_0 + bstr_1 + 0 + (unsafe-bytes-length + bstr_1))))))))))) + (void))))))))) (|#%name| ...rc/io/print/main.rkt:123:8 (case-lambda ((who_0 v_0 o_0) (begin (...rc/io/print/main.rkt:123:8_0 - default-value_0 - param_0 who_0 v_0 o_0 @@ -22159,8 +21244,6 @@ #f))) ((who_0 v_0 o_0 quote-depth-in_0 max-length33_0) (...rc/io/print/main.rkt:123:8_0 - default-value_0 - param_0 who_0 v_0 o_0 @@ -22168,8 +21251,6 @@ max-length33_0)) ((who_0 v_0 o_0 quote-depth-in32_0) (...rc/io/print/main.rkt:123:8_0 - default-value_0 - param_0 who_0 v_0 o_0 @@ -22723,432 +21804,15 @@ (void)))) (define struct-dots (unquoted-printing-string "...")) (define do-printf - (letrec ((bad-dot_0 - (|#%name| - bad-dot - (lambda (all-args_0 fmt_0 who_0) - (begin - (ill-formed-error - who_0 - "tag `~.` not followed by `a`, `s`, or `v`" - fmt_0 - all-args_0))))) - (loop_0 - (|#%name| - loop - (lambda (fmt_0 len_0 o_0 who_0 start-i_0 i_0 args_0) - (begin - (if (= i_0 len_0) - (1/write-string fmt_0 o_0 start-i_0 i_0) - (let ((tmp_0 (string-ref fmt_0 i_0))) - (if (eqv? tmp_0 '#\x7e) - (begin - (1/write-string fmt_0 o_0 start-i_0 i_0) - (let ((i_1 (add1 i_0))) - (let ((c_0 (string-ref fmt_0 i_1))) - (let ((index_0 - (if (char? c_0) - (let ((codepoint_0 (char->integer c_0))) - (if (if (unsafe-fx>= codepoint_0 37) - (unsafe-fx< codepoint_0 127) - #f) - (let ((tbl_0 - '#(2 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 7 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 3 - 10 - 11 - 0 - 6 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 2 - 9 - 0 - 0 - 0 - 4 - 0 - 0 - 5 - 0 - 8 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 3 - 10 - 11 - 0 - 6 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 2 - 9 - 0 - 0 - 0 - 4 - 0 - 0 - 5 - 0 - 8 - 0 - 0 - 0 - 0 - 0 - 1))) - (unsafe-vector*-ref - tbl_0 - (unsafe-fx- codepoint_0 37))) - 0)) - 0))) - (if (unsafe-fx< index_0 5) - (if (unsafe-fx< index_0 2) - (if (unsafe-fx< index_0 1) - (if (char-whitespace? c_0) - (letrec* - ((ws-loop_0 - (|#%name| - ws-loop - (lambda (i_2 saw-newline?_0) - (begin - (if (= i_2 len_0) - (loop_0 - fmt_0 - len_0 - o_0 - who_0 - i_2 - i_2 - args_0) - (let ((c_1 - (string-ref - fmt_0 - i_2))) - (if (eqv? c_1 '#\xa) - (if saw-newline?_0 - (loop_0 - fmt_0 - len_0 - o_0 - who_0 - i_2 - i_2 - args_0) - (ws-loop_0 - (add1 i_2) - #t)) - (if (eqv? c_1 '#\xd) - (if saw-newline?_0 - (loop_0 - fmt_0 - len_0 - o_0 - who_0 - i_2 - i_2 - args_0) - (ws-loop_0 - (if (if (< - (add1 i_2) - len_0) - (char=? - '#\xa - (string-ref - fmt_0 - (add1 i_2))) - #f) - (+ i_2 2) - (add1 i_2)) - #t)) - (if (char-whitespace? - c_1) - (ws-loop_0 - (add1 i_2) - saw-newline?_0) - (loop_0 - fmt_0 - len_0 - o_0 - who_0 - i_2 - i_2 - args_0))))))))))) - (ws-loop_0 i_1 #f)) - (void)) - (begin - (1/write-string "~" o_0) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_1 - args_0))) - (if (unsafe-fx< index_0 3) - (begin - (1/write-string "\n" o_0) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_1 - args_0)) - (if (unsafe-fx< index_0 4) - (begin - (display-via-handler - who_0 - (car args_0) - o_0) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_1 - (cdr args_0))) - (begin - (write-via-handler - who_0 - (car args_0) - o_0) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_1 - (cdr args_0)))))) - (if (unsafe-fx< index_0 8) - (if (unsafe-fx< index_0 6) - (begin - (print-via-handler - who_0 - (car args_0) - o_0 - 0) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_1 - (cdr args_0))) - (if (unsafe-fx< index_0 7) - (begin - (with-continuation-mark* - push-authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first - #f - parameterization-key) - 1/print-unreadable - #t) - (1/write-string - (let ((app_0 - (error-value->string-handler))) - (let ((app_1 (car args_0))) - (|#%app| - app_0 - app_1 - (error-print-width)))) - o_0)) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_1 - (cdr args_0))) - (let ((i_2 (add1 i_1))) - (let ((tmp_1 (string-ref fmt_0 i_2))) - (if (if (eqv? tmp_1 '#\x61) - #t - (eqv? tmp_1 '#\x41)) - (begin - (let ((app_0 (car args_0))) - (let ((app_1 - (->core-output-port.1 - unsafe-undefined - o_0 - #f))) - (do-display - who_0 - app_0 - app_1 - (error-print-width)))) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_2 - (cdr args_0))) - (if (if (eqv? tmp_1 '#\x73) - #t - (eqv? tmp_1 '#\x53)) - (begin - (let ((app_0 (car args_0))) - (let ((app_1 - (->core-output-port.1 - unsafe-undefined - o_0 - #f))) - (do-write - who_0 - app_0 - app_1 - (error-print-width)))) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_2 - (cdr args_0))) - (if (if (eqv? tmp_1 '#\x76) - #t - (eqv? tmp_1 '#\x56)) - (begin - (let ((app_0 (car args_0))) - (let ((app_1 - (->core-output-port.1 - unsafe-undefined - o_0 - #f))) - (do-print - who_0 - app_0 - app_1 - 0 - (error-print-width)))) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_2 - (cdr args_0))) - (void)))))))) - (if (unsafe-fx< index_0 9) - (begin - (1/write-string - (number->string (car args_0) 16) - o_0) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_1 - (cdr args_0))) - (if (unsafe-fx< index_0 10) - (begin - (1/write-string - (number->string (car args_0) 8) - o_0) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_1 - (cdr args_0))) - (if (unsafe-fx< index_0 11) - (begin - (1/write-string - (number->string (car args_0) 2) - o_0) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_1 - (cdr args_0))) - (begin - (1/write-string - (string (car args_0)) - o_0) - (next_1 - fmt_0 - len_0 - o_0 - who_0 - i_1 - (cdr args_0)))))))))))) - (loop_0 - fmt_0 - len_0 - o_0 - who_0 - start-i_0 - (add1 i_0) - args_0)))))))) - (next_0 - (|#%name| - next - (lambda (args_0) (begin (if (pair? args_0) (cdr args_0) #f))))) - (next_1 - (|#%name| - next - (lambda (fmt_0 len_0 o_0 who_0 i_0 args_0) - (begin - (let ((i_1 (add1 i_0))) - (loop_0 fmt_0 len_0 o_0 who_0 i_1 i_1 args_0))))))) - (lambda (who_0 o_0 fmt_0 all-args_0) - (let ((len_0 (string-length fmt_0))) + (lambda (who_0 o_0 fmt_0 all-args_0) + (let ((len_0 (string-length fmt_0))) + (let ((next_0 + (|#%name| + next + (lambda (args_0) (begin (if (pair? args_0) (cdr args_0) #f)))))) (begin (letrec* - ((loop_1 + ((loop_0 (|#%name| loop (lambda (i_0 expected-count_0 args_0 error-thunk_0) @@ -23280,7 +21944,7 @@ (if (unsafe-fx< index_0 1) (if (char-whitespace? (string-ref fmt_0 i_1)) - (loop_1 + (loop_0 (add1 i_1) expected-count_0 args_0 @@ -23293,7 +21957,7 @@ "` not allowed") fmt_0 all-args_0)) - (loop_1 + (loop_0 (add1 i_1) expected-count_0 args_0 @@ -23301,44 +21965,54 @@ (if (unsafe-fx< index_0 3) (let ((app_0 (add1 i_1))) (let ((app_1 (add1 expected-count_0))) - (loop_1 + (loop_0 app_0 app_1 (next_0 args_0) error-thunk_0))) (if (unsafe-fx< index_0 4) (let ((i_2 (add1 i_1))) - (begin - (if (= i_2 len_0) - (bad-dot_0 all-args_0 fmt_0 who_0) - (void)) - (let ((tmp_2 (string-ref fmt_0 i_2))) - (if (if (eqv? tmp_2 '#\x61) - #t - (if (eqv? tmp_2 '#\x41) + (let ((bad-dot_0 + (|#%name| + bad-dot + (lambda () + (begin + (ill-formed-error + who_0 + "tag `~.` not followed by `a`, `s`, or `v`" + fmt_0 + all-args_0)))))) + (begin + (if (= i_2 len_0) + (bad-dot_0) + (void)) + (let ((tmp_2 + (string-ref fmt_0 i_2))) + (if (if (eqv? tmp_2 '#\x61) #t - (if (eqv? tmp_2 '#\x73) + (if (eqv? tmp_2 '#\x41) #t - (if (eqv? tmp_2 '#\x53) + (if (eqv? tmp_2 '#\x73) #t - (if (eqv? tmp_2 '#\x76) + (if (eqv? tmp_2 '#\x53) #t - (eqv? - tmp_2 - '#\x56)))))) - (let ((app_0 (add1 i_2))) - (let ((app_1 - (add1 - expected-count_0))) - (loop_1 - app_0 - app_1 - (next_0 args_0) - error-thunk_0))) - (bad-dot_0 - all-args_0 - fmt_0 - who_0))))) + (if (eqv? + tmp_2 + '#\x76) + #t + (eqv? + tmp_2 + '#\x56)))))) + (let ((app_0 (add1 i_2))) + (let ((app_1 + (add1 + expected-count_0))) + (loop_0 + app_0 + app_1 + (next_0 args_0) + error-thunk_0))) + (bad-dot_0)))))) (if (unsafe-fx< index_0 5) (let ((new-error-thunk_0 (if (not error-thunk_0) @@ -23369,7 +22043,7 @@ (let ((app_0 (add1 i_1))) (let ((app_1 (add1 expected-count_0))) - (loop_1 + (loop_0 app_0 app_1 (next_0 args_0) @@ -23395,18 +22069,331 @@ (let ((app_0 (add1 i_1))) (let ((app_1 (add1 expected-count_0))) - (loop_1 + (loop_0 app_0 app_1 (next_0 args_0) new-error-thunk_0)))))))))))) - (loop_1 + (loop_0 (add1 i_0) expected-count_0 args_0 error-thunk_0))))))))) - (loop_1 0 0 all-args_0 #f)) - (loop_0 fmt_0 len_0 o_0 who_0 0 0 all-args_0) + (loop_0 0 0 all-args_0 #f)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (start-i_0 i_0 args_0) + (begin + (if (= i_0 len_0) + (1/write-string fmt_0 o_0 start-i_0 i_0) + (let ((tmp_0 (string-ref fmt_0 i_0))) + (if (eqv? tmp_0 '#\x7e) + (let ((next_1 + (|#%name| + next + (lambda (i_1 args_1) + (begin + (let ((i_2 (add1 i_1))) + (loop_0 i_2 i_2 args_1))))))) + (begin + (1/write-string fmt_0 o_0 start-i_0 i_0) + (let ((i_1 (add1 i_0))) + (let ((c_0 (string-ref fmt_0 i_1))) + (let ((index_0 + (if (char? c_0) + (let ((codepoint_0 + (char->integer c_0))) + (if (if (unsafe-fx>= codepoint_0 37) + (unsafe-fx< codepoint_0 127) + #f) + (let ((tbl_0 + '#(2 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 7 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 3 + 10 + 11 + 0 + 6 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 2 + 9 + 0 + 0 + 0 + 4 + 0 + 0 + 5 + 0 + 8 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 3 + 10 + 11 + 0 + 6 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 2 + 9 + 0 + 0 + 0 + 4 + 0 + 0 + 5 + 0 + 8 + 0 + 0 + 0 + 0 + 0 + 1))) + (unsafe-vector*-ref + tbl_0 + (unsafe-fx- codepoint_0 37))) + 0)) + 0))) + (if (unsafe-fx< index_0 5) + (if (unsafe-fx< index_0 2) + (if (unsafe-fx< index_0 1) + (if (char-whitespace? c_0) + (letrec* + ((ws-loop_0 + (|#%name| + ws-loop + (lambda (i_2 saw-newline?_0) + (begin + (if (= i_2 len_0) + (loop_0 i_2 i_2 args_0) + (let ((c_1 + (string-ref + fmt_0 + i_2))) + (if (eqv? c_1 '#\xa) + (if saw-newline?_0 + (loop_0 + i_2 + i_2 + args_0) + (ws-loop_0 + (add1 i_2) + #t)) + (if (eqv? c_1 '#\xd) + (if saw-newline?_0 + (loop_0 + i_2 + i_2 + args_0) + (ws-loop_0 + (if (if (< + (add1 + i_2) + len_0) + (char=? + '#\xa + (string-ref + fmt_0 + (add1 + i_2))) + #f) + (+ i_2 2) + (add1 i_2)) + #t)) + (if (char-whitespace? + c_1) + (ws-loop_0 + (add1 i_2) + saw-newline?_0) + (loop_0 + i_2 + i_2 + args_0))))))))))) + (ws-loop_0 i_1 #f)) + (void)) + (begin + (1/write-string "~" o_0) + (next_1 i_1 args_0))) + (if (unsafe-fx< index_0 3) + (begin + (1/write-string "\n" o_0) + (next_1 i_1 args_0)) + (if (unsafe-fx< index_0 4) + (begin + (display-via-handler + who_0 + (car args_0) + o_0) + (next_1 i_1 (cdr args_0))) + (begin + (write-via-handler + who_0 + (car args_0) + o_0) + (next_1 i_1 (cdr args_0)))))) + (if (unsafe-fx< index_0 8) + (if (unsafe-fx< index_0 6) + (begin + (print-via-handler + who_0 + (car args_0) + o_0 + 0) + (next_1 i_1 (cdr args_0))) + (if (unsafe-fx< index_0 7) + (begin + (with-continuation-mark* + push-authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first + #f + parameterization-key) + 1/print-unreadable + #t) + (1/write-string + (let ((app_0 + (error-value->string-handler))) + (let ((app_1 (car args_0))) + (|#%app| + app_0 + app_1 + (error-print-width)))) + o_0)) + (next_1 i_1 (cdr args_0))) + (let ((i_2 (add1 i_1))) + (let ((tmp_1 + (string-ref fmt_0 i_2))) + (if (if (eqv? tmp_1 '#\x61) + #t + (eqv? tmp_1 '#\x41)) + (begin + (let ((app_0 (car args_0))) + (let ((app_1 + (->core-output-port.1 + unsafe-undefined + o_0 + #f))) + (do-display + who_0 + app_0 + app_1 + (error-print-width)))) + (next_1 i_2 (cdr args_0))) + (if (if (eqv? tmp_1 '#\x73) + #t + (eqv? tmp_1 '#\x53)) + (begin + (let ((app_0 (car args_0))) + (let ((app_1 + (->core-output-port.1 + unsafe-undefined + o_0 + #f))) + (do-write + who_0 + app_0 + app_1 + (error-print-width)))) + (next_1 i_2 (cdr args_0))) + (if (if (eqv? tmp_1 '#\x76) + #t + (eqv? tmp_1 '#\x56)) + (begin + (let ((app_0 + (car args_0))) + (let ((app_1 + (->core-output-port.1 + unsafe-undefined + o_0 + #f))) + (do-print + who_0 + app_0 + app_1 + 0 + (error-print-width)))) + (next_1 + i_2 + (cdr args_0))) + (void)))))))) + (if (unsafe-fx< index_0 9) + (begin + (1/write-string + (number->string (car args_0) 16) + o_0) + (next_1 i_1 (cdr args_0))) + (if (unsafe-fx< index_0 10) + (begin + (1/write-string + (number->string (car args_0) 8) + o_0) + (next_1 i_1 (cdr args_0))) + (if (unsafe-fx< index_0 11) + (begin + (1/write-string + (number->string (car args_0) 2) + o_0) + (next_1 i_1 (cdr args_0))) + (begin + (1/write-string + (string (car args_0)) + o_0) + (next_1 + i_1 + (cdr args_0))))))))))))) + (loop_0 start-i_0 (add1 i_0) args_0))))))))) + (loop_0 0 0 all-args_0)) (void)))))) (define raise-error (lambda (str_0) @@ -23459,37 +22446,37 @@ (let ((app_0 (error-value->string-handler))) (|#%app| app_0 v_0 (error-print-width))))) (define arguments->string - (letrec ((loop_0 - (|#%name| - loop - (lambda (ss_0) - (begin - (if (let ((or-part_0 (null? ss_0))) - (if or-part_0 or-part_0 (null? (cdr ss_0)))) - ss_0 - (let ((app_0 (car ss_0))) - (cons app_0 (cons " " (loop_0 (cdr ss_0))))))))))) - (lambda (fmt+args_0) - (let ((args_0 (cdr fmt+args_0))) - (if (<= 1 (length args_0) 50) - (with-continuation-mark* - authentic - parameterization-key - (let ((app_0 (continuation-mark-set-first #f parameterization-key))) - (extend-parameterization - app_0 - error-print-width - (max - 2 - (round - (let ((app_1 (error-print-width))) - (/ app_1 (length args_0))))))) - (apply - string-append - "; " - "arguments were: " - (loop_0 (map_2960 value->string args_0)))) - ""))))) + (lambda (fmt+args_0) + (let ((args_0 (cdr fmt+args_0))) + (if (<= 1 (length args_0) 50) + (with-continuation-mark* + authentic + parameterization-key + (let ((app_0 (continuation-mark-set-first #f parameterization-key))) + (extend-parameterization + app_0 + error-print-width + (max + 2 + (round + (let ((app_1 (error-print-width))) (/ app_1 (length args_0))))))) + (apply + string-append + "; " + "arguments were: " + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ss_0) + (begin + (if (let ((or-part_0 (null? ss_0))) + (if or-part_0 or-part_0 (null? (cdr ss_0)))) + ss_0 + (let ((app_0 (car ss_0))) + (cons app_0 (cons " " (loop_0 (cdr ss_0))))))))))) + (loop_0 (map_1346 value->string args_0))))) + "")))) (define 1/fprintf (|#%name| fprintf @@ -23623,308 +22610,225 @@ "(or/c path-string? path-for-some-system? 'up 'same)" p_0)))) (define argument->convention.1 - (letrec ((check_0 - (|#%name| - check - (lambda (convention4_0 first?1_0 p3_0 who5_0 c_0) - (begin + (|#%name| + argument->convention + (lambda (first?1_0 p3_0 convention4_0 who5_0) + (begin + (let ((check_0 + (|#%name| + check + (lambda (c_0) (begin - (if (if convention4_0 (not (eq? c_0 convention4_0)) #f) - (let ((app_0 - (let ((app_0 - (if first?1_0 - "specified convention incompatible with ~a path element" - "preceding path's convention incompatible with ~a path element"))) - (1/format - app_0 - (if (string? p3_0) "string" "given"))))) - (raise-arguments-error - who5_0 - app_0 - "path element" - p3_0 - (if first?1_0 - "convention" - "preceding path's convention") - convention4_0)) - (void)) - c_0)))))) - (|#%name| - argument->convention - (lambda (first?1_0 p3_0 convention4_0 who5_0) - (begin + (begin + (if (if convention4_0 (not (eq? c_0 convention4_0)) #f) + (let ((app_0 + (let ((app_0 + (if first?1_0 + "specified convention incompatible with ~a path element" + "preceding path's convention incompatible with ~a path element"))) + (1/format + app_0 + (if (string? p3_0) "string" "given"))))) + (raise-arguments-error + who5_0 + app_0 + "path element" + p3_0 + (if first?1_0 + "convention" + "preceding path's convention") + convention4_0)) + (void)) + c_0)))))) (if (1/path? p3_0) - (check_0 convention4_0 first?1_0 p3_0 who5_0 (path-convention p3_0)) + (check_0 (path-convention p3_0)) (if (string? p3_0) - (check_0 - convention4_0 - first?1_0 - p3_0 - who5_0 - (system-path-convention-type)) + (check_0 (system-path-convention-type)) convention4_0))))))) (define append-path-parts - (letrec ((combine_0 - (|#%name| - combine - (lambda (accum_0 - bstr_0 - convention_0 - first?_0 - result-is-backslash-backslash-questionmark?_0 - sub_0 - subs_0 - unc-result?_0 - who_0 - is-rel?_0 - is-complete?_0 - is-drive?_0) + (lambda (convention_0 who_0 base_0 subs_0) + (let ((result-is-backslash-backslash-questionmark?_0 + (if (eq? convention_0 'windows) + (let ((lst_0 (cons base_0 subs_0))) (begin - (begin - (if (if is-complete?_0 - is-complete?_0 - (if (not is-rel?_0) - (let ((or-part_0 (not first?_0))) - (if or-part_0 - or-part_0 - (not - (if (null? (cdr accum_0)) - (drive? (car accum_0)) - #f)))) - #f)) - (let ((what_0 (if is-drive?_0 "drive" "absolute path"))) - (let ((app_0 - (string-append - what_0 - " cannot be added to a base path"))) - (raise-arguments-error - who_0 - app_0 - what_0 - sub_0 - "base path" - (path1.1 - (combine-build-elements - (1/reverse accum_0) - unc-result?_0) - 'windows)))) - (void)) - (let ((app_0 - (let ((app_0 - (if (if (null? subs_0) - (not - result-is-backslash-backslash-questionmark?_0) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_1) + (begin + (if (pair? lst_1) + (let ((sub_0 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (let ((result_1 + (let ((result_1 + (backslash-backslash-questionmark? + (as-bytes sub_0)))) + (values result_1)))) + (if (if (not + (let ((x_0 (list sub_0))) result_1)) + #t #f) - bstr_0 - (strip-trailing-spaces bstr_0)))) - (combine-windows-path - app_0 - accum_0 - result-is-backslash-backslash-questionmark?_0 - (null? (cdr subs_0)))))) - (loop_0 - convention_0 - result-is-backslash-backslash-questionmark?_0 - unc-result?_0 - who_0 - app_0 - (cdr subs_0) - #f))))))) - (loop_0 - (|#%name| - loop - (lambda (convention_0 - result-is-backslash-backslash-questionmark?_0 - unc-result?_0 - who_0 - accum_0 - subs_0 - first?_0) - (begin - (if (null? subs_0) - (let ((elems_0 (1/reverse accum_0))) - (combine-build-elements elems_0 unc-result?_0)) - (let ((sub_0 (car subs_0))) - (let ((bstr_0 (as-bytes sub_0))) - (if (eq? convention_0 'unix) - (begin - (if (is-sep? (unsafe-bytes-ref bstr_0 0) 'unix) - (raise-arguments-error - who_0 - "absolute path cannot be added to a path" - "absolute path" - sub_0) - (void)) - (let ((prev_0 (car accum_0))) - (if (is-sep? - (unsafe-bytes-ref - prev_0 - (sub1 (unsafe-bytes-length prev_0))) - 'unix) - (loop_0 - convention_0 - result-is-backslash-backslash-questionmark?_0 - unc-result?_0 - who_0 - (cons bstr_0 accum_0) - (cdr subs_0) - #f) - (loop_0 - convention_0 - result-is-backslash-backslash-questionmark?_0 - unc-result?_0 - who_0 - (list* bstr_0 #vu8(47) accum_0) - (cdr subs_0) - #f)))) - (if (eq? convention_0 'windows) - (let ((len_0 (unsafe-bytes-length bstr_0))) - (if (is-sep? (unsafe-bytes-ref bstr_0 0) 'windows) - (if (backslash-backslash-questionmark? bstr_0) - (call-with-values - (lambda () - (parse-backslash-backslash-questionmark - bstr_0)) - (case-lambda - ((kind_0 - drive-len_0 - orig-drive-len_0 - clean-start-pos_0 - add-sep-pos_0) - (let ((or-part_0 (eq? kind_0 'abs))) - (let ((abs?_0 - (if or-part_0 - or-part_0 - (eq? kind_0 'unc)))) + (for-loop_0 result_1 rest_0) + result_1)))) + result_0)))))) + (for-loop_0 #f lst_0)))) + #f))) + (let ((base-accum_0 + (let ((bstr_0 (as-bytes base_0))) + (if (eq? convention_0 'windows) + (if result-is-backslash-backslash-questionmark?_0 + (convert-to-initial-backslash-backslash-questionmark bstr_0) + (list (strip-trailing-spaces bstr_0))) + (list bstr_0))))) + (let ((unc-result?_0 + (if (eq? convention_0 'windows) + (if (not result-is-backslash-backslash-questionmark?_0) + (let ((temp39_0 (car base-accum_0))) + (parse-unc.1 #f #f temp39_0 0)) + #f) + #f))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (accum_0 subs_1 first?_0) + (begin + (if (null? subs_1) + (let ((elems_0 (1/reverse accum_0))) + (combine-build-elements elems_0 unc-result?_0)) + (let ((sub_0 (car subs_1))) + (let ((bstr_0 (as-bytes sub_0))) + (if (eq? convention_0 'unix) + (begin + (if (is-sep? (unsafe-bytes-ref bstr_0 0) 'unix) + (raise-arguments-error + who_0 + "absolute path cannot be added to a path" + "absolute path" + sub_0) + (void)) + (let ((prev_0 (car accum_0))) + (if (is-sep? + (unsafe-bytes-ref + prev_0 + (sub1 (unsafe-bytes-length prev_0))) + 'unix) + (loop_0 (cons bstr_0 accum_0) (cdr subs_1) #f) + (loop_0 + (list* bstr_0 #vu8(47) accum_0) + (cdr subs_1) + #f)))) + (if (eq? convention_0 'windows) + (let ((len_0 (unsafe-bytes-length bstr_0))) + (let ((combine_0 + (|#%name| + combine + (lambda (is-rel?_0 + is-complete?_0 + is-drive?_0) + (begin + (begin + (if (if is-complete?_0 + is-complete?_0 + (if (not is-rel?_0) + (let ((or-part_0 + (not first?_0))) + (if or-part_0 + or-part_0 + (not + (if (null? + (cdr accum_0)) + (drive? + (car accum_0)) + #f)))) + #f)) + (let ((what_0 + (if is-drive?_0 + "drive" + "absolute path"))) + (let ((app_0 + (string-append + what_0 + " cannot be added to a base path"))) + (raise-arguments-error + who_0 + app_0 + what_0 + sub_0 + "base path" + (path1.1 + (combine-build-elements + (1/reverse accum_0) + unc-result?_0) + 'windows)))) + (void)) + (let ((app_0 + (let ((app_0 + (if (if (null? + subs_1) + (not + result-is-backslash-backslash-questionmark?_0) + #f) + bstr_0 + (strip-trailing-spaces + bstr_0)))) + (combine-windows-path + app_0 + accum_0 + result-is-backslash-backslash-questionmark?_0 + (null? (cdr subs_1)))))) + (loop_0 + app_0 + (cdr subs_1) + #f)))))))) + (if (is-sep? + (unsafe-bytes-ref bstr_0 0) + 'windows) + (if (backslash-backslash-questionmark? + bstr_0) + (call-with-values + (lambda () + (parse-backslash-backslash-questionmark + bstr_0)) + (case-lambda + ((kind_0 + drive-len_0 + orig-drive-len_0 + clean-start-pos_0 + add-sep-pos_0) + (let ((or-part_0 (eq? kind_0 'abs))) + (let ((abs?_0 + (if or-part_0 + or-part_0 + (eq? kind_0 'unc)))) + (combine_0 + (eq? kind_0 'rel) + abs?_0 + (if abs?_0 + (just-backslashes-after? + bstr_0 + drive-len_0) + #f))))) + (args + (raise-binding-result-arity-error + 5 + args)))) + (let ((c1_0 (parse-unc.1 #f #f bstr_0 0))) + (if c1_0 (combine_0 - accum_0 - bstr_0 - convention_0 - first?_0 - result-is-backslash-backslash-questionmark?_0 - sub_0 - subs_0 - unc-result?_0 - who_0 - (eq? kind_0 'rel) - abs?_0 - (if abs?_0 - (just-backslashes-after? - bstr_0 - drive-len_0) - #f))))) - (args - (raise-binding-result-arity-error - 5 - args)))) - (let ((c1_0 (parse-unc.1 #f #f bstr_0 0))) - (if c1_0 - (combine_0 - accum_0 - bstr_0 - convention_0 - first?_0 - result-is-backslash-backslash-questionmark?_0 - sub_0 - subs_0 - unc-result?_0 - who_0 - #t - #t - (just-separators-after? bstr_0 c1_0)) - (combine_0 - accum_0 - bstr_0 - convention_0 - first?_0 - result-is-backslash-backslash-questionmark?_0 - sub_0 - subs_0 - unc-result?_0 - who_0 - #f - #f - #f)))) - (if (letter-drive-start? bstr_0 len_0) - (combine_0 - accum_0 - bstr_0 - convention_0 - first?_0 - result-is-backslash-backslash-questionmark?_0 - sub_0 - subs_0 - unc-result?_0 - who_0 - #f - #t - (just-separators-after? bstr_0 2)) - (combine_0 - accum_0 - bstr_0 - convention_0 - first?_0 - result-is-backslash-backslash-questionmark?_0 - sub_0 - subs_0 - unc-result?_0 - who_0 - #t - #f - #f)))) - (void))))))))))) - (lambda (convention_0 who_0 base_0 subs_0) - (let ((result-is-backslash-backslash-questionmark?_0 - (if (eq? convention_0 'windows) - (let ((lst_0 (cons base_0 subs_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_1) - (begin - (if (pair? lst_1) - (let ((sub_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (let ((result_1 - (let ((result_1 - (backslash-backslash-questionmark? - (as-bytes sub_0)))) - (values result_1)))) - (if (if (not - (let ((x_0 (list sub_0))) - result_1)) #t - #f) - (for-loop_0 result_1 rest_0) - result_1)))) - result_0)))))) - (for-loop_0 #f lst_0)))) - #f))) - (let ((base-accum_0 - (let ((bstr_0 (as-bytes base_0))) - (if (eq? convention_0 'windows) - (if result-is-backslash-backslash-questionmark?_0 - (convert-to-initial-backslash-backslash-questionmark - bstr_0) - (list (strip-trailing-spaces bstr_0))) - (list bstr_0))))) - (let ((unc-result?_0 - (if (eq? convention_0 'windows) - (if (not result-is-backslash-backslash-questionmark?_0) - (let ((temp39_0 (car base-accum_0))) - (parse-unc.1 #f #f temp39_0 0)) - #f) - #f))) - (loop_0 - convention_0 - result-is-backslash-backslash-questionmark?_0 - unc-result?_0 - who_0 - base-accum_0 - subs_0 - #t))))))) + #t + (just-separators-after? bstr_0 c1_0)) + (combine_0 #f #f #f)))) + (if (letter-drive-start? bstr_0 len_0) + (combine_0 + #f + #t + (just-separators-after? bstr_0 2)) + (combine_0 #t #f #f))))) + (void))))))))))) + (loop_0 base-accum_0 subs_0 #t))))))) (define combine-windows-path (lambda (bstr_0 accum_0 @@ -24452,111 +23356,95 @@ (loop_0 app_0 (cdr elems_1))))))))) (loop_0 null elems_0)))))))))))) (define extract-separate-parts.1 - (letrec ((is-a-sep?_0 - (|#%name| - is-a-sep? - (lambda (bbq-mode?20_0 b_0) - (begin - (if bbq-mode?20_0 (eqv? b_0 92) (is-sep? b_0 'windows)))))) - (loop_0 - (|#%name| - loop - (lambda (bbq-mode?20_0 - bstr24_0 - keep-trailing-separator?21_0 - len_0 - pos_0) - (begin - (if (= pos_0 len_0) - null - (if (is-a-sep?_0 - bbq-mode?20_0 - (unsafe-bytes-ref bstr24_0 pos_0)) - (loop_0 - bbq-mode?20_0 - bstr24_0 - keep-trailing-separator?21_0 - len_0 - (add1 pos_0)) - (letrec* - ((e-loop_0 - (|#%name| - e-loop - (lambda (end-pos_0) - (begin - (if (let ((or-part_0 (= end-pos_0 len_0))) - (if or-part_0 - or-part_0 - (is-a-sep?_0 - bbq-mode?20_0 - (unsafe-bytes-ref bstr24_0 end-pos_0)))) - (let ((rest_0 - (loop_0 - bbq-mode?20_0 - bstr24_0 - keep-trailing-separator?21_0 - len_0 - end-pos_0))) - (let ((elem-bstr_0 - (subbytes bstr24_0 pos_0 end-pos_0))) - (let ((new-bstr_0 - (if (if (null? rest_0) - (not bbq-mode?20_0) - #f) - (strip-trailing-spaces elem-bstr_0) - elem-bstr_0))) - (let ((new-sub_0 - (if (if (not bbq-mode?20_0) - (bytes=? new-bstr_0 #vu8(46)) - #f) - 'same - (if (if (not bbq-mode?20_0) - (bytes=? new-bstr_0 #vu8(46 46)) - #f) - 'up - (if (if keep-trailing-separator?21_0 - (if (null? rest_0) - (< end-pos_0 len_0) - #f) - #f) - (bytes-append - #vu8(92) - new-bstr_0 - #vu8(92)) - (bytes-append - #vu8(92) - new-bstr_0)))))) - (cons new-sub_0 rest_0))))) - (e-loop_0 (add1 end-pos_0)))))))) - (e-loop_0 (add1 pos_0)))))))))) - (|#%name| - extract-separate-parts - (lambda (bbq-mode?20_0 keep-trailing-separator?21_0 bstr24_0 pos25_0) - (begin + (|#%name| + extract-separate-parts + (lambda (bbq-mode?20_0 keep-trailing-separator?21_0 bstr24_0 pos25_0) + (begin + (let ((is-a-sep?_0 + (|#%name| + is-a-sep? + (lambda (b_0) + (begin + (if bbq-mode?20_0 (eqv? b_0 92) (is-sep? b_0 'windows))))))) (let ((len_0 (unsafe-bytes-length bstr24_0))) - (loop_0 - bbq-mode?20_0 - bstr24_0 - keep-trailing-separator?21_0 - len_0 - pos25_0))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_0) + (begin + (if (= pos_0 len_0) + null + (if (is-a-sep?_0 (unsafe-bytes-ref bstr24_0 pos_0)) + (loop_0 (add1 pos_0)) + (letrec* + ((e-loop_0 + (|#%name| + e-loop + (lambda (end-pos_0) + (begin + (if (let ((or-part_0 (= end-pos_0 len_0))) + (if or-part_0 + or-part_0 + (is-a-sep?_0 + (unsafe-bytes-ref + bstr24_0 + end-pos_0)))) + (let ((rest_0 (loop_0 end-pos_0))) + (let ((elem-bstr_0 + (subbytes bstr24_0 pos_0 end-pos_0))) + (let ((new-bstr_0 + (if (if (null? rest_0) + (not bbq-mode?20_0) + #f) + (strip-trailing-spaces + elem-bstr_0) + elem-bstr_0))) + (let ((new-sub_0 + (if (if (not bbq-mode?20_0) + (bytes=? new-bstr_0 #vu8(46)) + #f) + 'same + (if (if (not bbq-mode?20_0) + (bytes=? + new-bstr_0 + #vu8(46 46)) + #f) + 'up + (if (if keep-trailing-separator?21_0 + (if (null? rest_0) + (< end-pos_0 len_0) + #f) + #f) + (bytes-append + #vu8(92) + new-bstr_0 + #vu8(92)) + (bytes-append + #vu8(92) + new-bstr_0)))))) + (cons new-sub_0 rest_0))))) + (e-loop_0 (add1 end-pos_0)))))))) + (e-loop_0 (add1 pos_0)))))))))) + (loop_0 pos25_0)))))))) (define extract-dot-ups - (letrec ((loop_0 - (|#%name| - loop - (lambda (bstr_0 dots-end_0 i_0) - (begin - (if (>= i_0 dots-end_0) - '() - (if (if (eqv? (unsafe-bytes-ref bstr_0 i_0) 46) - (eqv? (unsafe-bytes-ref bstr_0 (sub1 i_0)) 46) - #f) - (cons 'up (loop_0 bstr_0 dots-end_0 (add1 i_0))) - (loop_0 bstr_0 dots-end_0 (add1 i_0))))))))) - (lambda (bstr_0 start_0 dots-end_0) - (if (= start_0 dots-end_0) - '() - (loop_0 bstr_0 dots-end_0 (add1 start_0)))))) + (lambda (bstr_0 start_0 dots-end_0) + (if (= start_0 dots-end_0) + '() + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0) + (begin + (if (>= i_0 dots-end_0) + '() + (if (if (eqv? (unsafe-bytes-ref bstr_0 i_0) 46) + (eqv? (unsafe-bytes-ref bstr_0 (sub1 i_0)) 46) + #f) + (cons 'up (loop_0 (add1 i_0))) + (loop_0 (add1 i_0))))))))) + (loop_0 (add1 start_0)))))) (define starting-point-add-up (lambda (s_0) (if (starting-point-add-ups? s_0) @@ -24714,22 +23602,19 @@ (do-cleanse-path (->path p-in_0) #f)))))) (define cleanse-path/convert-slashes (lambda (p_0) (do-cleanse-path p_0 #t))) (define do-cleanse-path - (letrec ((return_0 - (|#%name| - return - (lambda (convention_0 p_0 bstr_0) - (begin - (if (eq? bstr_0 (path-bytes p_0)) - p_0 - (path1.1 bstr_0 convention_0))))))) - (lambda (p_0 convert-slashes?_0) - (let ((convention_0 (path-convention p_0))) + (lambda (p_0 convert-slashes?_0) + (let ((convention_0 (path-convention p_0))) + (let ((return_0 + (|#%name| + return + (lambda (bstr_0) + (begin + (if (eq? bstr_0 (path-bytes p_0)) + p_0 + (path1.1 bstr_0 convention_0))))))) (let ((bstr_0 (path-bytes p_0))) (if (eq? convention_0 'unix) - (return_0 - convention_0 - p_0 - (clean-double-slashes.1 #f #f bstr_0 'unix 0)) + (return_0 (clean-double-slashes.1 #f #f bstr_0 'unix 0)) (if (eq? convention_0 'windows) (if (backslash-backslash-questionmark? bstr_0) (call-with-values @@ -24743,8 +23628,6 @@ sep-bstr_0) (if clean-start-pos_0 (return_0 - convention_0 - p_0 (clean-double-slashes.1 #t #f @@ -24778,14 +23661,12 @@ 92) #f))) (if has-extra-backslash?_0 - (return_0 convention_0 p_0 new-bstr_0) + (return_0 new-bstr_0) (if (= literal-start_0 (unsafe-bytes-length new-bstr_0)) - (return_0 convention_0 p_0 new-bstr_0) + (return_0 new-bstr_0) (return_0 - convention_0 - p_0 (let ((app_0 (subbytes new-bstr_0 @@ -24802,8 +23683,6 @@ (let ((c1_0 (parse-unc.1 #f #f bstr_0 0))) (if c1_0 (return_0 - convention_0 - p_0 (let ((temp25_0 (sub1 c1_0))) (let ((temp26_0 (if convert-slashes?_0 0 #f))) (let ((temp25_1 temp25_0)) @@ -24820,8 +23699,6 @@ (is-sep? (unsafe-bytes-ref bstr_0 2) 'windows) #f) (return_0 - convention_0 - p_0 (let ((temp30_0 (if convert-slashes?_0 2 #f))) (clean-double-slashes.1 #f @@ -24830,8 +23707,6 @@ 'windows 2))) (return_0 - convention_0 - p_0 (let ((app_0 (subbytes bstr_0 0 2))) (bytes-append app_0 @@ -24846,8 +23721,6 @@ 'windows 0)))))))) (return_0 - convention_0 - p_0 (let ((temp38_0 (if convert-slashes?_0 0 #f))) (clean-double-slashes.1 #f @@ -24857,125 +23730,38 @@ 0))))))) (void)))))))) (define clean-double-slashes.1 - (letrec ((is-a-sep?_0 - (|#%name| - is-a-sep? - (lambda (convention6_0 only-backslash?1_0 b_0) - (begin - (if only-backslash?1_0 - (eqv? b_0 92) - (is-sep? b_0 convention6_0)))))) - (loop_0 - (|#%name| - loop - (lambda (allow-double-before7_0 - bstr5_0 - convention6_0 - new-bstr_0 - only-backslash?1_0 - to-backslash-from2_0 - i_0 - j_0) - (begin - (if (<= i_0 allow-double-before7_0) - (void) - (if (is-a-sep?_0 - convention6_0 - only-backslash?1_0 - (unsafe-bytes-ref bstr5_0 i_0)) - (if (is-a-sep?_0 - convention6_0 - only-backslash?1_0 - (unsafe-bytes-ref bstr5_0 (sub1 i_0))) - (loop_0 - allow-double-before7_0 - bstr5_0 - convention6_0 - new-bstr_0 - only-backslash?1_0 - to-backslash-from2_0 - (sub1 i_0) - j_0) - (begin - (if to-backslash-from2_0 - (unsafe-bytes-set! new-bstr_0 j_0 92) - (unsafe-bytes-set! - new-bstr_0 - j_0 - (unsafe-bytes-ref bstr5_0 i_0))) - (let ((app_0 (sub1 i_0))) - (loop_0 - allow-double-before7_0 - bstr5_0 - convention6_0 - new-bstr_0 - only-backslash?1_0 - to-backslash-from2_0 - app_0 - (sub1 j_0))))) - (begin - (unsafe-bytes-set! - new-bstr_0 - j_0 - (unsafe-bytes-ref bstr5_0 i_0)) - (let ((app_0 (sub1 i_0))) - (loop_0 - allow-double-before7_0 - bstr5_0 - convention6_0 - new-bstr_0 - only-backslash?1_0 - to-backslash-from2_0 - app_0 - (sub1 j_0)))))))))) - (loop_1 - (|#%name| - loop - (lambda (allow-double-before7_0 - bstr5_0 - convention6_0 - only-backslash?1_0 - i_0) - (begin - (if (<= i_0 allow-double-before7_0) - 0 - (if (if (is-a-sep?_0 - convention6_0 - only-backslash?1_0 - (unsafe-bytes-ref bstr5_0 i_0)) - (is-a-sep?_0 - convention6_0 - only-backslash?1_0 - (unsafe-bytes-ref bstr5_0 (sub1 i_0))) - #f) - (add1 - (loop_1 - allow-double-before7_0 - bstr5_0 - convention6_0 - only-backslash?1_0 - (sub1 i_0))) - (loop_1 - allow-double-before7_0 - bstr5_0 - convention6_0 - only-backslash?1_0 - (sub1 i_0))))))))) - (|#%name| - clean-double-slashes - (lambda (only-backslash?1_0 - to-backslash-from2_0 - bstr5_0 - convention6_0 - allow-double-before7_0) - (begin + (|#%name| + clean-double-slashes + (lambda (only-backslash?1_0 + to-backslash-from2_0 + bstr5_0 + convention6_0 + allow-double-before7_0) + (begin + (let ((is-a-sep?_0 + (|#%name| + is-a-sep? + (lambda (b_0) + (begin + (if only-backslash?1_0 + (eqv? b_0 92) + (is-sep? b_0 convention6_0))))))) (let ((extra-count_0 - (loop_1 - allow-double-before7_0 - bstr5_0 - convention6_0 - only-backslash?1_0 - (sub1 (unsafe-bytes-length bstr5_0))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0) + (begin + (if (<= i_0 allow-double-before7_0) + 0 + (if (if (is-a-sep?_0 (unsafe-bytes-ref bstr5_0 i_0)) + (is-a-sep?_0 + (unsafe-bytes-ref bstr5_0 (sub1 i_0))) + #f) + (add1 (loop_0 (sub1 i_0))) + (loop_0 (sub1 i_0))))))))) + (loop_0 (sub1 (unsafe-bytes-length bstr5_0)))))) (if (if (zero? extra-count_0) (let ((or-part_0 (not to-backslash-from2_0))) (if or-part_0 @@ -25021,16 +23807,36 @@ (make-bytes (- (unsafe-bytes-length bstr5_0) extra-count_0)))) (begin - (let ((app_0 (sub1 (unsafe-bytes-length bstr5_0)))) - (loop_0 - allow-double-before7_0 - bstr5_0 - convention6_0 - new-bstr_0 - only-backslash?1_0 - to-backslash-from2_0 - app_0 - (sub1 (unsafe-bytes-length new-bstr_0)))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 j_0) + (begin + (if (<= i_0 allow-double-before7_0) + (void) + (if (is-a-sep?_0 (unsafe-bytes-ref bstr5_0 i_0)) + (if (is-a-sep?_0 + (unsafe-bytes-ref bstr5_0 (sub1 i_0))) + (loop_0 (sub1 i_0) j_0) + (begin + (if to-backslash-from2_0 + (unsafe-bytes-set! new-bstr_0 j_0 92) + (unsafe-bytes-set! + new-bstr_0 + j_0 + (unsafe-bytes-ref bstr5_0 i_0))) + (let ((app_0 (sub1 i_0))) + (loop_0 app_0 (sub1 j_0))))) + (begin + (unsafe-bytes-set! + new-bstr_0 + j_0 + (unsafe-bytes-ref bstr5_0 i_0)) + (let ((app_0 (sub1 i_0))) + (loop_0 app_0 (sub1 j_0))))))))))) + (let ((app_0 (sub1 (unsafe-bytes-length bstr5_0)))) + (loop_0 app_0 (sub1 (unsafe-bytes-length new-bstr_0))))) (if to-backslash-from2_0 (begin (unsafe-bytes-copy! @@ -25427,152 +24233,149 @@ (args (raise-binding-result-arity-error 5 args)))))) (define parse-//-drive (lambda (bstr_0) (parse-unc.1 #f #f bstr_0 0))) (define split-reld.1 - (letrec ((explode-loop_0 - (|#%name| - explode-loop - (lambda (explode?30_0 bstr_0) - (begin - (call-with-values - (lambda () - (let ((len_0 (unsafe-bytes-length bstr_0))) - (if (eqv? (unsafe-bytes-ref bstr_0 (sub1 len_0)) 92) - (values (sub1 len_0) #t) - (values len_0 #f)))) - (case-lambda - ((len_0 is-dir?_0) - (call-with-values - (lambda () - (backslash-backslash-questionmark-dot-ups-end - bstr_0 - len_0)) - (case-lambda - ((dots-end_0 literal-start_0) - (if (< literal-start_0 len_0) - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (p_0) - (begin - (if (< - p_0 - (if dots-end_0 - (sub1 literal-start_0) - literal-start_0)) - (if (eqv? (unsafe-bytes-ref bstr_0 6) 76) + (|#%name| + split-reld + (lambda (explode?30_0 bstr32_0) + (begin + (letrec* + ((explode-loop_0 + (|#%name| + explode-loop + (lambda (bstr_0) + (begin + (call-with-values + (lambda () + (let ((len_0 (unsafe-bytes-length bstr_0))) + (if (eqv? (unsafe-bytes-ref bstr_0 (sub1 len_0)) 92) + (values (sub1 len_0) #t) + (values len_0 #f)))) + (case-lambda + ((len_0 is-dir?_0) + (call-with-values + (lambda () + (backslash-backslash-questionmark-dot-ups-end + bstr_0 + len_0)) + (case-lambda + ((dots-end_0 literal-start_0) + (if (< literal-start_0 len_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (p_0) + (begin + (if (< + p_0 + (if dots-end_0 + (sub1 literal-start_0) + literal-start_0)) + (if (eqv? (unsafe-bytes-ref bstr_0 6) 76) + (let ((elem_0 + (path1.1 + (if is-dir?_0 + (subbytes bstr_0 0 len_0) + bstr_0) + 'windows))) + (if explode?30_0 + (list elem_0) + (values 'relative elem_0 is-dir?_0))) + (let ((base_0 (path1.1 #vu8(92) 'windows))) (let ((elem_0 (path1.1 - (if is-dir?_0 - (subbytes bstr_0 0 len_0) - bstr_0) + (let ((app_0 + (if (eqv? + (unsafe-bytes-ref + bstr_0 + 8) + 92) + #vu8() + #vu8(92)))) + (bytes-append + #vu8(92 92 63 92 82 69 76 92) + app_0 + (subbytes + bstr_0 + 8 + (let ((len_1 + (unsafe-bytes-length + bstr_0))) + (if is-dir?_0 + (sub1 len_1) + len_1))))) 'windows))) (if explode?30_0 - (list elem_0) - (values 'relative elem_0 is-dir?_0))) - (let ((base_0 (path1.1 #vu8(92) 'windows))) - (let ((elem_0 - (path1.1 - (let ((app_0 - (if (eqv? - (unsafe-bytes-ref - bstr_0 - 8) - 92) - #vu8() - #vu8(92)))) - (bytes-append - #vu8(92 92 63 92 82 69 76 92) - app_0 - (subbytes - bstr_0 - 8 - (let ((len_1 - (unsafe-bytes-length - bstr_0))) - (if is-dir?_0 - (sub1 len_1) - len_1))))) - 'windows))) - (if explode?30_0 - (list elem_0 base_0) - (values base_0 elem_0 is-dir?_0))))) - (if (eqv? (unsafe-bytes-ref bstr_0 p_0) 92) - (let ((elem-bstr_0 - (bytes-append - #vu8(92 92 63 92 82 69 76 92 92) - (subbytes - bstr_0 - (add1 p_0) - len_0)))) - (let ((nsep_0 - (if (let ((or-part_0 - (eqv? - dots-end_0 - p_0))) - (if or-part_0 - or-part_0 - (eqv? - dots-end_0 - (sub1 p_0)))) - (if (eqv? dots-end_0 p_0) 0 -1) + (list elem_0 base_0) + (values base_0 elem_0 is-dir?_0))))) + (if (eqv? (unsafe-bytes-ref bstr_0 p_0) 92) + (let ((elem-bstr_0 + (bytes-append + #vu8(92 92 63 92 82 69 76 92 92) + (subbytes + bstr_0 + (add1 p_0) + len_0)))) + (let ((nsep_0 + (if (let ((or-part_0 + (eqv? dots-end_0 p_0))) + (if or-part_0 + or-part_0 + (eqv? + dots-end_0 + (sub1 p_0)))) + (if (eqv? dots-end_0 p_0) 0 -1) + (if (eqv? + (unsafe-bytes-ref bstr_0 6) + 76) + 1 (if (eqv? (unsafe-bytes-ref bstr_0 - 6) - 76) - 1 - (if (eqv? - (unsafe-bytes-ref - bstr_0 - (sub1 p_0)) - 92) - 0 - 1))))) - (let ((base-bstr_0 - (subbytes - bstr_0 - 0 - (+ p_0 nsep_0)))) - (let ((elem_0 - (path1.1 - elem-bstr_0 - 'windows))) - (if explode?30_0 - (cons - elem_0 - (explode-loop_0 - explode?30_0 - base-bstr_0)) - (values - (path1.1 base-bstr_0 'windows) - elem_0 - is-dir?_0)))))) - (loop_1 (sub1 p_0))))))))) - (loop_1 (sub1 len_0))) - (if explode?30_0 - (loop_0 dots-end_0) - (if (> (- dots-end_0 3) 8) - (values - (path1.1 - (subbytes bstr_0 0 (- dots-end_0 3)) - 'windows) - 'up - #t) - (values 'relative 'up #t))))) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))))))) - (loop_0 - (|#%name| - loop - (lambda (dots-end_0) - (begin - (if (> dots-end_0 9) - (cons 'up (loop_0 (- dots-end_0 3))) - '())))))) - (|#%name| - split-reld - (lambda (explode?30_0 bstr32_0) - (begin (explode-loop_0 explode?30_0 bstr32_0)))))) + (sub1 p_0)) + 92) + 0 + 1))))) + (let ((base-bstr_0 + (subbytes + bstr_0 + 0 + (+ p_0 nsep_0)))) + (let ((elem_0 + (path1.1 + elem-bstr_0 + 'windows))) + (if explode?30_0 + (cons + elem_0 + (explode-loop_0 base-bstr_0)) + (values + (path1.1 base-bstr_0 'windows) + elem_0 + is-dir?_0)))))) + (loop_0 (sub1 p_0))))))))) + (loop_0 (sub1 len_0))) + (if explode?30_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (dots-end_1) + (begin + (if (> dots-end_1 9) + (cons 'up (loop_0 (- dots-end_1 3))) + '())))))) + (loop_0 dots-end_0)) + (if (> (- dots-end_0 3) 8) + (values + (path1.1 + (subbytes bstr_0 0 (- dots-end_0 3)) + 'windows) + 'up + #t) + (values 'relative 'up #t))))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args))))))))) + (explode-loop_0 bstr32_0)))))) (define 1/path->directory-path (|#%name| path->directory-path @@ -25590,63 +24393,69 @@ (path1.1 (bytes-append (path-bytes p_0) #vu8(92)) 'windows) (void))))))))))) (define directory-path?.1 - (letrec ((unixish-path-directory-path?_0 - (|#%name| - unixish-path-directory-path? - (lambda (bstr_0 convention_0 len_0 require-sep?1_0) - (begin - (let ((or-part_0 - (is-sep? - (unsafe-bytes-ref bstr_0 (sub1 len_0)) - convention_0))) - (if or-part_0 - or-part_0 - (if (not require-sep?1_0) - (let ((or-part_1 - (if (>= len_0 2) - (if (eq? - (unsafe-bytes-ref bstr_0 (sub1 len_0)) - 46) - (if (eq? - (unsafe-bytes-ref bstr_0 (- len_0 2)) - 46) - (let ((or-part_1 (= len_0 2))) - (if or-part_1 - or-part_1 - (is-sep? - (unsafe-bytes-ref bstr_0 (- len_0 3)) - convention_0))) - #f) - #f) - #f))) - (if or-part_1 - or-part_1 - (if (>= len_0 1) - (if (eq? - (unsafe-bytes-ref bstr_0 (sub1 len_0)) - 46) - (let ((or-part_2 (= len_0 1))) - (if or-part_2 - or-part_2 - (is-sep? - (unsafe-bytes-ref bstr_0 (- len_0 2)) - convention_0))) - #f) - #f))) - #f)))))))) - (|#%name| - directory-path? - (lambda (require-sep?1_0 p3_0) - (begin - (let ((bstr_0 (path-bytes p3_0))) - (let ((len_0 (unsafe-bytes-length bstr_0))) - (let ((convention_0 (path-convention p3_0))) + (|#%name| + directory-path? + (lambda (require-sep?1_0 p3_0) + (begin + (let ((bstr_0 (path-bytes p3_0))) + (let ((len_0 (unsafe-bytes-length bstr_0))) + (let ((convention_0 (path-convention p3_0))) + (let ((unixish-path-directory-path?_0 + (|#%name| + unixish-path-directory-path? + (lambda () + (begin + (let ((or-part_0 + (is-sep? + (unsafe-bytes-ref bstr_0 (sub1 len_0)) + convention_0))) + (if or-part_0 + or-part_0 + (if (not require-sep?1_0) + (let ((or-part_1 + (if (>= len_0 2) + (if (eq? + (unsafe-bytes-ref + bstr_0 + (sub1 len_0)) + 46) + (if (eq? + (unsafe-bytes-ref + bstr_0 + (- len_0 2)) + 46) + (let ((or-part_1 (= len_0 2))) + (if or-part_1 + or-part_1 + (is-sep? + (unsafe-bytes-ref + bstr_0 + (- len_0 3)) + convention_0))) + #f) + #f) + #f))) + (if or-part_1 + or-part_1 + (if (>= len_0 1) + (if (eq? + (unsafe-bytes-ref + bstr_0 + (sub1 len_0)) + 46) + (let ((or-part_2 (= len_0 1))) + (if or-part_2 + or-part_2 + (is-sep? + (unsafe-bytes-ref + bstr_0 + (- len_0 2)) + convention_0))) + #f) + #f))) + #f)))))))) (if (eq? convention_0 'unix) - (unixish-path-directory-path?_0 - bstr_0 - convention_0 - len_0 - require-sep?1_0) + (unixish-path-directory-path?_0) (if (eq? convention_0 'windows) (if (backslash-backslash-questionmark? bstr_0) (let ((or-part_0 @@ -25670,11 +24479,7 @@ (raise-binding-result-arity-error 2 args))))) #f) #f))) - (unixish-path-directory-path?_0 - bstr_0 - convention_0 - len_0 - require-sep?1_0)) + (unixish-path-directory-path?_0)) (void))))))))))) (define host-path->host-path-without-trailing-separator (lambda (bstr_0) @@ -25702,95 +24507,108 @@ (if (< len_0 orig-len_0) (subbytes bstr_0 0 len_0) bstr_0))))))) (define simplify-path-syntactically (let ((simplify-path-syntactically_0 - (letrec ((loop_0 - (|#%name| - loop - (lambda (l_0 accum_0) - (begin - (if (null? l_0) - (1/reverse accum_0) - (if (eq? 'same (car l_0)) - (loop_0 (cdr l_0) accum_0) - (if (eq? 'up (car l_0)) - (if (pair? accum_0) - (let ((app_0 (cdr l_0))) - (loop_0 app_0 (cdr accum_0))) - (cons 'up (loop_0 (cdr l_0) null))) - (let ((app_0 (cdr l_0))) - (loop_0 - app_0 - (cons (car l_0) accum_0))))))))))) - (|#%name| - simplify-path-syntactically - (lambda (who2_0 p3_0 use-filesystem1_0) - (begin - (let ((convention_0 (path-convention p3_0))) - (begin - (if use-filesystem1_0 - (if (eq? convention_0 (system-path-convention-type)) - (void) - (raise-arguments-error - who2_0 - "in use-filesystem mode, path is not for the current platform" - "path" - p3_0)) - (void)) - (if (simple? p3_0 convention_0) - p3_0 - (let ((clean-p_0 - (begin-unsafe (do-cleanse-path p3_0 #t)))) - (if (simple? clean-p_0 convention_0) - (if (let ((or-part_0 (not use-filesystem1_0))) - (if or-part_0 - or-part_0 - (if (eq? 'windows (system-type)) - (same-modulo-slashes? p3_0 clean-p_0) - #f))) - clean-p_0 - (let ((temp5_0 (current-directory$1))) - (path->complete-path.1 #t clean-p_0 temp5_0))) - (let ((l_0 (1/explode-path clean-p_0))) - (let ((simple-p_0 - (if use-filesystem1_0 - (|#%app| use-filesystem1_0 who2_0 l_0) - (let ((simpler-l_0 (loop_0 l_0 null))) - (apply - 1/build-path/convention-type - convention_0 - (if (null? simpler-l_0) - '(same) - simpler-l_0)))))) - (let ((simpler-p_0 - (if (eq? convention_0 'windows) - (simplify-backslash-backslash-questionmark - simple-p_0) - simple-p_0))) - (if (let ((or-part_0 - (directory-path?.1 #f p3_0))) - (if or-part_0 - or-part_0 - (if (eq? convention_0 'windows) - (unc-without-trailing-separator? - simpler-p_0) - #f))) - (1/path->directory-path simpler-p_0) - simpler-p_0))))))))))))))) + (|#%name| + simplify-path-syntactically + (lambda (who2_0 p3_0 use-filesystem1_0) + (begin + (let ((convention_0 (path-convention p3_0))) + (begin + (if use-filesystem1_0 + (if (eq? convention_0 (system-path-convention-type)) + (void) + (raise-arguments-error + who2_0 + "in use-filesystem mode, path is not for the current platform" + "path" + p3_0)) + (void)) + (if (simple? p3_0 convention_0) + p3_0 + (let ((clean-p_0 (begin-unsafe (do-cleanse-path p3_0 #t)))) + (if (simple? clean-p_0 convention_0) + (if (let ((or-part_0 (not use-filesystem1_0))) + (if or-part_0 + or-part_0 + (if (eq? 'windows (system-type)) + (same-modulo-slashes? p3_0 clean-p_0) + #f))) + clean-p_0 + (let ((temp5_0 (current-directory$1))) + (path->complete-path.1 #t clean-p_0 temp5_0))) + (let ((l_0 (1/explode-path clean-p_0))) + (let ((simple-p_0 + (if use-filesystem1_0 + (|#%app| use-filesystem1_0 who2_0 l_0) + (let ((simpler-l_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1 accum_0) + (begin + (if (null? l_1) + (1/reverse accum_0) + (if (eq? 'same (car l_1)) + (loop_0 + (cdr l_1) + accum_0) + (if (eq? 'up (car l_1)) + (if (pair? accum_0) + (let ((app_0 + (cdr l_1))) + (loop_0 + app_0 + (cdr accum_0))) + (cons + 'up + (loop_0 + (cdr l_1) + null))) + (let ((app_0 + (cdr l_1))) + (loop_0 + app_0 + (cons + (car l_1) + accum_0))))))))))) + (loop_0 l_0 null)))) + (apply + 1/build-path/convention-type + convention_0 + (if (null? simpler-l_0) + '(same) + simpler-l_0)))))) + (let ((simpler-p_0 + (if (eq? convention_0 'windows) + (simplify-backslash-backslash-questionmark + simple-p_0) + simple-p_0))) + (if (let ((or-part_0 + (directory-path?.1 #f p3_0))) + (if or-part_0 + or-part_0 + (if (eq? convention_0 'windows) + (unc-without-trailing-separator? + simpler-p_0) + #f))) + (1/path->directory-path simpler-p_0) + simpler-p_0)))))))))))))) (case-lambda ((who_0 p_0) (simplify-path-syntactically_0 who_0 p_0 #f)) ((who_0 p_0 use-filesystem1_0) (simplify-path-syntactically_0 who_0 p_0 use-filesystem1_0))))) (define simple? - (letrec ((is-a-sep?_0 - (|#%name| - is-a-sep? - (lambda (convention_0 b_0) - (begin - (if (eq? convention_0 'windows) - (eqv? b_0 92) - (is-sep? b_0 convention_0))))))) - (lambda (p_0 convention_0) - (let ((bstr_0 (path-bytes p_0))) - (let ((len_0 (unsafe-bytes-length bstr_0))) + (lambda (p_0 convention_0) + (let ((bstr_0 (path-bytes p_0))) + (let ((len_0 (unsafe-bytes-length bstr_0))) + (let ((is-a-sep?_0 + (|#%name| + is-a-sep? + (lambda (b_0) + (begin + (if (eq? convention_0 'windows) + (eqv? b_0 92) + (is-sep? b_0 convention_0))))))) (if (if (eq? convention_0 'windows) (if (= len_0 2) (letter-drive-start? bstr_0 2) #f) #f) @@ -25809,13 +24627,10 @@ (begin (if (= i_0 len_0) #t - (if (is-a-sep?_0 - convention_0 - (unsafe-bytes-ref bstr_0 i_0)) + (if (is-a-sep?_0 (unsafe-bytes-ref bstr_0 i_0)) (if (= (add1 i_0) len_0) #t (if (is-a-sep?_0 - convention_0 (unsafe-bytes-ref bstr_0 (add1 i_0))) #f (if (if (eqv? @@ -25826,7 +24641,6 @@ or-part_0 (let ((or-part_1 (is-a-sep?_0 - convention_0 (unsafe-bytes-ref bstr_0 (+ i_0 2))))) @@ -25842,7 +24656,6 @@ (if or-part_2 or-part_2 (is-a-sep?_0 - convention_0 (unsafe-bytes-ref bstr_0 (+ i_0 3))))) @@ -25937,155 +24750,161 @@ (let ((bstr_0 (path-bytes p_0))) (eqv? (parse-unc.1 #f #f bstr_0 0) (unsafe-bytes-length bstr_0))))) (define simplify-backslash-backslash-questionmark - (letrec ((no-special-in-content?_0 - (|#%name| - no-special-in-content? - (lambda (bstr_0 len_0 len9_0 start-pos11_0) - (begin - (let ((len_1 (if (eq? len9_0 unsafe-undefined) len_0 len9_0))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (i_0 elem-start_0) - (begin - (if (= i_0 len_1) - (not - (special-element?_0 bstr_0 elem-start_0 i_0 #t)) - (let ((b_0 (unsafe-bytes-ref bstr_0 i_0))) - (if (eqv? b_0 92) - (if (special-element?_0 - bstr_0 - elem-start_0 - i_0 - #f) - #f - (let ((app_0 (add1 i_0))) - (loop_0 app_0 (add1 i_0)))) - (if (let ((or-part_0 (eqv? b_0 47))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (eqv? b_0 58))) - (if or-part_1 - or-part_1 - (let ((or-part_2 (eqv? b_0 34))) - (if or-part_2 - or-part_2 - (let ((or-part_3 - (eqv? b_0 124))) - (if or-part_3 - or-part_3 - (let ((or-part_4 - (eqv? b_0 60))) - (if or-part_4 - or-part_4 - (eqv? - b_0 - 62))))))))))) - #f - (loop_0 (add1 i_0) elem-start_0)))))))))) - (loop_0 start-pos11_0 start-pos11_0))))))) - (special-element?_0 - (|#%name| - special-element? - (lambda (bstr_0 elem-start_0 i_0 at-end?_0) - (begin - (if (< elem-start_0 i_0) - (let ((or-part_0 - (let ((b_0 (unsafe-bytes-ref bstr_0 (sub1 i_0)))) - (let ((or-part_0 - (if (eqv? b_0 46) - (if at-end?_0 - at-end?_0 - (let ((or-part_0 - (= elem-start_0 (- i_0 1)))) - (if or-part_0 - or-part_0 - (if (= elem-start_0 (- i_0 2)) - (eqv? - (unsafe-bytes-ref - bstr_0 - elem-start_0) - 46) - #f)))) - #f))) - (if or-part_0 - or-part_0 - (if at-end?_0 (eqv? b_0 32) #f)))))) - (if or-part_0 - or-part_0 - (let ((temp13_0 (subbytes bstr_0 elem-start_0 i_0))) - (special-filename?.1 #t temp13_0)))) - #f)))))) - (lambda (p_0) - (let ((bstr_0 (path-bytes p_0))) - (let ((len_0 (unsafe-bytes-length bstr_0))) - (call-with-values - (lambda () (parse-backslash-backslash-questionmark bstr_0)) - (case-lambda - ((kind_0 drive-len_0 orig-drive-len_0 clean-start-pos_0 sep-bstr_0) - (if (eq? kind_0 'abs) - (if (if (= drive-len_0 7) - (if (drive-letter? (unsafe-bytes-ref bstr_0 4)) - (if (eqv? (unsafe-bytes-ref bstr_0 5) 58) - (no-special-in-content?_0 - bstr_0 - len_0 - unsafe-undefined - orig-drive-len_0) + (lambda (p_0) + (let ((bstr_0 (path-bytes p_0))) + (let ((len_0 (unsafe-bytes-length bstr_0))) + (call-with-values + (lambda () (parse-backslash-backslash-questionmark bstr_0)) + (case-lambda + ((kind_0 drive-len_0 orig-drive-len_0 clean-start-pos_0 sep-bstr_0) + (let ((special-element?_0 + (|#%name| + special-element? + (lambda (elem-start_0 i_0 at-end?_0) + (begin + (if (< elem-start_0 i_0) + (let ((or-part_0 + (let ((b_0 + (unsafe-bytes-ref bstr_0 (sub1 i_0)))) + (let ((or-part_0 + (if (eqv? b_0 46) + (if at-end?_0 + at-end?_0 + (let ((or-part_0 + (= + elem-start_0 + (- i_0 1)))) + (if or-part_0 + or-part_0 + (if (= elem-start_0 (- i_0 2)) + (eqv? + (unsafe-bytes-ref + bstr_0 + elem-start_0) + 46) + #f)))) + #f))) + (if or-part_0 + or-part_0 + (if at-end?_0 (eqv? b_0 32) #f)))))) + (if or-part_0 + or-part_0 + (let ((temp13_0 + (subbytes bstr_0 elem-start_0 i_0))) + (special-filename?.1 #t temp13_0)))) + #f)))))) + (let ((no-special-in-content?_0 + (|#%name| + no-special-in-content? + (lambda (len9_0 start-pos11_0) + (begin + (let ((len_1 + (if (eq? len9_0 unsafe-undefined) + len_0 + len9_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 elem-start_0) + (begin + (if (= i_0 len_1) + (not + (special-element?_0 elem-start_0 i_0 #t)) + (let ((b_0 (unsafe-bytes-ref bstr_0 i_0))) + (if (eqv? b_0 92) + (if (special-element?_0 + elem-start_0 + i_0 + #f) + #f + (let ((app_0 (add1 i_0))) + (loop_0 app_0 (add1 i_0)))) + (if (let ((or-part_0 (eqv? b_0 47))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (eqv? b_0 58))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (eqv? b_0 34))) + (if or-part_2 + or-part_2 + (let ((or-part_3 + (eqv? + b_0 + 124))) + (if or-part_3 + or-part_3 + (let ((or-part_4 + (eqv? + b_0 + 60))) + (if or-part_4 + or-part_4 + (eqv? + b_0 + 62))))))))))) + #f + (loop_0 + (add1 i_0) + elem-start_0)))))))))) + (loop_0 start-pos11_0 start-pos11_0)))))))) + (if (eq? kind_0 'abs) + (if (if (= drive-len_0 7) + (if (drive-letter? (unsafe-bytes-ref bstr_0 4)) + (if (eqv? (unsafe-bytes-ref bstr_0 5) 58) + (no-special-in-content?_0 + unsafe-undefined + orig-drive-len_0) + #f) #f) #f) - #f) - (path1.1 (subbytes bstr_0 4) 'windows) - p_0) - (if (eq? kind_0 'unc) - (let ((norm-bstr_0 - (normalize-backslash-backslash-unc bstr_0))) - (if (let ((temp16_0 - (if (= orig-drive-len_0 len_0) - (sub1 len_0) - len_0))) - (no-special-in-content?_0 bstr_0 len_0 temp16_0 4)) - (path1.1 - (bytes-append #vu8(92) (subbytes norm-bstr_0 7)) - 'windows) - (if (eq? norm-bstr_0 bstr_0) - p_0 - (path1.1 norm-bstr_0 'windows)))) - (if (eq? kind_0 'red) - (if (no-special-in-content?_0 - bstr_0 - len_0 - unsafe-undefined - 9) - (path1.1 (subbytes bstr_0 8) 'windows) - p_0) - (if (eq? kind_0 'rel) - (call-with-values - (lambda () - (backslash-backslash-questionmark-dot-ups-end - bstr_0 - len_0)) - (case-lambda - ((dots-end_0 literal-start_0) - (if (no-special-in-content?_0 - bstr_0 - len_0 - unsafe-undefined - literal-start_0) - (path1.1 - (let ((app_0 - (if dots-end_0 - (subbytes bstr_0 8 (add1 dots-end_0)) - #vu8()))) - (bytes-append - app_0 - (subbytes bstr_0 literal-start_0))) - 'windows) - p_0)) - (args (raise-binding-result-arity-error 2 args)))) - p_0))))) - (args (raise-binding-result-arity-error 5 args))))))))) + (path1.1 (subbytes bstr_0 4) 'windows) + p_0) + (if (eq? kind_0 'unc) + (let ((norm-bstr_0 + (normalize-backslash-backslash-unc bstr_0))) + (if (let ((temp16_0 + (if (= orig-drive-len_0 len_0) + (sub1 len_0) + len_0))) + (no-special-in-content?_0 temp16_0 4)) + (path1.1 + (bytes-append #vu8(92) (subbytes norm-bstr_0 7)) + 'windows) + (if (eq? norm-bstr_0 bstr_0) + p_0 + (path1.1 norm-bstr_0 'windows)))) + (if (eq? kind_0 'red) + (if (no-special-in-content?_0 unsafe-undefined 9) + (path1.1 (subbytes bstr_0 8) 'windows) + p_0) + (if (eq? kind_0 'rel) + (call-with-values + (lambda () + (backslash-backslash-questionmark-dot-ups-end + bstr_0 + len_0)) + (case-lambda + ((dots-end_0 literal-start_0) + (if (no-special-in-content?_0 + unsafe-undefined + literal-start_0) + (path1.1 + (let ((app_0 + (if dots-end_0 + (subbytes bstr_0 8 (add1 dots-end_0)) + #vu8()))) + (bytes-append + app_0 + (subbytes bstr_0 literal-start_0))) + 'windows) + p_0)) + (args (raise-binding-result-arity-error 2 args)))) + p_0))))))) + (args (raise-binding-result-arity-error 5 args)))))))) (define normalize-backslash-backslash-unc (lambda (bstr_0) (if (if (eqv? (unsafe-bytes-ref bstr_0 4) 85) @@ -26611,25 +25430,26 @@ (define none$1 (gensym)) (define 1/open-input-file (let ((open-input-file_0 - (letrec ((mode->flags_0 - (|#%name| - mode->flags - (lambda (mode_0) (begin (if (eq? mode_0 'text) 4 0)))))) - (|#%name| - open-input-file - (lambda (path3_0 mode11_0 mode22_0) - (begin - (let ((mode1_0 - (if (eq? mode11_0 unsafe-undefined) none$1 mode11_0))) - (let ((mode2_0 - (if (eq? mode22_0 unsafe-undefined) none$1 mode22_0))) - (begin - (if (path-string? path3_0) - (void) - (raise-argument-error - 'open-input-file - "path-string?" - path3_0)) + (|#%name| + open-input-file + (lambda (path3_0 mode11_0 mode22_0) + (begin + (let ((mode1_0 + (if (eq? mode11_0 unsafe-undefined) none$1 mode11_0))) + (let ((mode2_0 + (if (eq? mode22_0 unsafe-undefined) none$1 mode22_0))) + (begin + (if (path-string? path3_0) + (void) + (raise-argument-error + 'open-input-file + "path-string?" + path3_0)) + (let ((mode->flags_0 + (|#%name| + mode->flags + (lambda (mode_0) + (begin (if (eq? mode_0 'text) 4 0)))))) (let ((host-path_0 (->host path3_0 'open-input-file '(read)))) (begin @@ -26695,179 +25515,166 @@ ((path_0 mode11_0) (open-input-file_0 path_0 mode11_0 unsafe-undefined)))))) (define do-open-output-file.1 - (letrec ((mode->flags_0 - (|#%name| - mode->flags - (lambda (mode_0) - (begin - (if (eq? mode_0 'test) - 4 - (if (if (eq? mode_0 'truncate) - #t - (eq? mode_0 'truncate/replace)) - 72 - (if (eq? mode_0 'must-truncate) - 40 - (if (eq? mode_0 'can-update) - 64 - (if (eq? mode_0 'update) - 32 - (if (eq? mode_0 'append) 16 0)))))))))) - (mode?_0 - (|#%name| - mode? - (lambda (mode18_0 mode29_0 v_0) - (begin - (let ((or-part_0 (eq? mode18_0 v_0))) - (if or-part_0 or-part_0 (eq? mode29_0 v_0)))))))) - (|#%name| - do-open-output-file - (lambda (plus-input?4_0 who6_0 path7_0 mode18_0 mode29_0) + (|#%name| + do-open-output-file + (lambda (plus-input?4_0 who6_0 path7_0 mode18_0 mode29_0) + (begin (begin - (begin - (if (path-string? path7_0) - (void) - (raise-argument-error who6_0 "path-string?" path7_0)) - (let ((host-path_0 - (->host - path7_0 - who6_0 - (let ((app_0 - (if (let ((or-part_0 - (mode?_0 mode18_0 mode29_0 'replace))) - (if or-part_0 - or-part_0 - (mode?_0 - mode18_0 - mode29_0 - 'truncate/replace))) - '(delete) - '()))) - (append - '(write) - app_0 - (if (let ((or-part_0 - (mode?_0 mode18_0 mode29_0 'append))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (mode?_0 mode18_0 mode29_0 'update))) - (if or-part_1 - or-part_1 - (mode?_0 mode18_0 mode29_0 'must-update))))) - '(read) - '())))))) - (begin - (unsafe-start-atomic) + (if (path-string? path7_0) + (void) + (raise-argument-error who6_0 "path-string?" path7_0)) + (let ((mode->flags_0 + (|#%name| + mode->flags + (lambda (mode_0) + (begin + (if (eq? mode_0 'test) + 4 + (if (if (eq? mode_0 'truncate) + #t + (eq? mode_0 'truncate/replace)) + 72 + (if (eq? mode_0 'must-truncate) + 40 + (if (eq? mode_0 'can-update) + 64 + (if (eq? mode_0 'update) + 32 + (if (eq? mode_0 'append) 16 0))))))))))) + (let ((mode?_0 + (|#%name| + mode? + (lambda (v_0) + (begin + (let ((or-part_0 (eq? mode18_0 v_0))) + (if or-part_0 or-part_0 (eq? mode29_0 v_0)))))))) + (let ((host-path_0 + (->host + path7_0 + who6_0 + (let ((app_0 + (if (let ((or-part_0 (mode?_0 'replace))) + (if or-part_0 + or-part_0 + (mode?_0 'truncate/replace))) + '(delete) + '()))) + (append + '(write) + app_0 + (if (let ((or-part_0 (mode?_0 'append))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (mode?_0 'update))) + (if or-part_1 + or-part_1 + (mode?_0 'must-update))))) + '(read) + '())))))) (begin - (check-current-custodian who6_0) - (let ((flags_0 - (let ((app_0 (if plus-input?4_0 1 0))) - (let ((app_1 (mode->flags_0 mode18_0))) - (+ 2 app_0 app_1 (mode->flags_0 mode29_0)))))) - (let ((fd0_0 - (|#%app| - rktio_open - (unsafe-place-local-ref cell.1) - host-path_0 - flags_0))) - (let ((fd_0 - (if (not (vector? fd0_0)) - fd0_0 - (if (if (let ((or-part_0 - (racket-error? fd0_0 4))) + (unsafe-start-atomic) + (begin + (check-current-custodian who6_0) + (let ((flags_0 + (let ((app_0 (if plus-input?4_0 1 0))) + (let ((app_1 (mode->flags_0 mode18_0))) + (+ 2 app_0 app_1 (mode->flags_0 mode29_0)))))) + (let ((fd0_0 + (|#%app| + rktio_open + (unsafe-place-local-ref cell.1) + host-path_0 + flags_0))) + (let ((fd_0 + (if (not (vector? fd0_0)) + fd0_0 + (if (if (let ((or-part_0 + (racket-error? fd0_0 4))) + (if or-part_0 + or-part_0 + (racket-error? fd0_0 5))) + (let ((or-part_0 (mode?_0 'replace))) (if or-part_0 or-part_0 - (racket-error? fd0_0 5))) - (let ((or-part_0 - (mode?_0 - mode18_0 - mode29_0 - 'replace))) - (if or-part_0 - or-part_0 - (mode?_0 - mode18_0 - mode29_0 - 'truncate/replace))) - #f) - (let ((r_0 - (|#%app| - rktio_delete_file - (unsafe-place-local-ref cell.1) - host-path_0 - (1/current-force-delete-permissions)))) - (begin - (if (vector? r_0) - (begin - (unsafe-end-atomic) - (raise-filesystem-error - who6_0 - r_0 - (let ((app_0 - (string-append - "error deleting file\n" - " path: ~a"))) - (1/format - app_0 - (host-> host-path_0))))) - (void)) - (|#%app| - rktio_open - (unsafe-place-local-ref cell.1) - host-path_0 - flags_0))) - fd0_0)))) - (begin - (if (vector? fd_0) - (begin - (unsafe-end-atomic) - (raise-filesystem-error - who6_0 - fd_0 - (let ((app_0 - (string-append "~a\n" " path: ~a"))) - (let ((app_1 - (if (racket-error? fd0_0 4) - "file exists" - (if (racket-error? fd0_0 9) - "path is a directory" - "error opening file")))) - (1/format - app_0 - app_1 - (host-> host-path_0)))))) - (void)) - (let ((opened-path_0 (host-> host-path_0))) - (let ((refcount_0 (box (if plus-input?4_0 2 1)))) - (let ((op_0 - (open-output-fd.1 - 'infer - unsafe-undefined - refcount_0 - unsafe-undefined - fd_0 - opened-path_0))) - (let ((ip_0 - (if plus-input?4_0 - (open-input-fd.1 - unsafe-undefined - refcount_0 - fd_0 - opened-path_0) - #f))) - (begin - (unsafe-end-atomic) - (if (1/port-count-lines-enabled) - (begin - (1/port-count-lines! op_0) - (if plus-input?4_0 - (1/port-count-lines! ip_0) - (void))) - (void)) - (if plus-input?4_0 - (values ip_0 op_0) - op_0))))))))))))))))))) + (mode?_0 'truncate/replace))) + #f) + (let ((r_0 + (|#%app| + rktio_delete_file + (unsafe-place-local-ref cell.1) + host-path_0 + (1/current-force-delete-permissions)))) + (begin + (if (vector? r_0) + (begin + (unsafe-end-atomic) + (raise-filesystem-error + who6_0 + r_0 + (let ((app_0 + (string-append + "error deleting file\n" + " path: ~a"))) + (1/format + app_0 + (host-> host-path_0))))) + (void)) + (|#%app| + rktio_open + (unsafe-place-local-ref cell.1) + host-path_0 + flags_0))) + fd0_0)))) + (begin + (if (vector? fd_0) + (begin + (unsafe-end-atomic) + (raise-filesystem-error + who6_0 + fd_0 + (let ((app_0 + (string-append "~a\n" " path: ~a"))) + (let ((app_1 + (if (racket-error? fd0_0 4) + "file exists" + (if (racket-error? fd0_0 9) + "path is a directory" + "error opening file")))) + (1/format + app_0 + app_1 + (host-> host-path_0)))))) + (void)) + (let ((opened-path_0 (host-> host-path_0))) + (let ((refcount_0 (box (if plus-input?4_0 2 1)))) + (let ((op_0 + (open-output-fd.1 + 'infer + unsafe-undefined + refcount_0 + unsafe-undefined + fd_0 + opened-path_0))) + (let ((ip_0 + (if plus-input?4_0 + (open-input-fd.1 + unsafe-undefined + refcount_0 + fd_0 + opened-path_0) + #f))) + (begin + (unsafe-end-atomic) + (if (1/port-count-lines-enabled) + (begin + (1/port-count-lines! op_0) + (if plus-input?4_0 + (1/port-count-lines! ip_0) + (void))) + (void)) + (if plus-input?4_0 + (values ip_0 op_0) + op_0)))))))))))))))))))) (define 1/open-output-file (let ((open-output-file_0 (|#%name| @@ -27433,831 +26240,874 @@ (unsafe-start-atomic))))))))) (define 1/make-input-port (let ((make-input-port_0 - (letrec ((procz1 - (case-lambda - ((self_0) (temp9.1 self_0)) - ((self_0 mode_0) (temp9.1 self_0 mode_0)))) - (called!_0 - (|#%name| - called! - (lambda (called?_0) - (begin - (begin - (if (unsafe-unbox* called?_0) - (raise-arguments-error - 'read-special - "cannot be called a second time") - (void)) - (unsafe-set-box*! called?_0 #t)))))) - (check-read-result_0 - (|#%name| - check-read-result - (lambda (input-pipe_0 - user-peek-in9_0 - ok-false?13_0 - peek?12_0 - who16_0 - r17_0 - dest-start18_0 - dest-end19_0) - (begin - (if (exact-nonnegative-integer? r17_0) - (if (<= r17_0 (- dest-end19_0 dest-start18_0)) - (void) - (begin - (unsafe-end-atomic) - (raise-arguments-error - who16_0 - "result integer is larger than the supplied byte string" - "result" - r17_0 - "byte-string length" - (- dest-end19_0 dest-start18_0)))) - (if (eof-object? r17_0) - (void) - (if (if (procedure? r17_0) - (procedure-arity-includes? r17_0 4) - #f) - (if user-peek-in9_0 - (void) - (begin - (unsafe-end-atomic) - (raise-arguments-error - who16_0 - (string-append - "the port has no specific peek procedure, so" - " a special read result is not allowed") - "special result" - r17_0))) - (if (pipe-input-port?* r17_0) - (unsafe-set-box*! input-pipe_0 r17_0) - (if (evt? r17_0) - r17_0 - (if (if peek?12_0 (not r17_0) #f) - (if ok-false?13_0 - (void) - (begin - (unsafe-end-atomic) - (raise-arguments-error - who16_0 - "returned #f when no progress evt was supplied"))) - (begin - (unsafe-end-atomic) - (raise-result-error - who16_0 - (let ((app_0 - (if (if peek?12_0 - ok-false?13_0 - #f) - " #f" - ""))) - (string-append - "(or/c exact-nonnegative-integer? eof-object? evt? pipe-input-port?" - app_0 - (if user-peek-in9_0 - " (procedure-arity-includes/c 4)" - "") - ")")) - r17_0)))))))))))) - (protect-in_0 - (|#%name| - protect-in - (lambda (dest-bstr_0 - dest-start_0 - dest-end_0 - copy?_0 - user-read-in_0) - (begin - (let ((len_0 (- dest-end_0 dest-start_0))) - (let ((user-bstr_0 - (if (if copy?_0 - copy?_0 - (let ((or-part_0 - (not (zero? dest-start_0)))) - (if or-part_0 - or-part_0 - (not (= len_0 dest-end_0))))) - (make-bytes len_0) - dest-bstr_0))) - (let ((n_0 (|#%app| user-read-in_0 user-bstr_0))) - (if (eq? user-bstr_0 dest-bstr_0) - n_0 - (if (evt? n_0) - (wrap-evt - n_0 - (lambda (n_1) - (begin - (if (exact-positive-integer? n_1) - (unsafe-bytes-copy! - dest-bstr_0 - dest-start_0 - user-bstr_0 - 0 - n_1) - (void)) - n_1))) - (begin - (if (exact-positive-integer? n_0) - (unsafe-bytes-copy! - dest-bstr_0 - dest-start_0 - user-bstr_0 - 0 - n_0) - (void)) - n_0)))))))))) - (wrap-check-read-evt-result_0 - (|#%name| - wrap-check-read-evt-result - (lambda (input-pipe_0 - user-peek-in9_0 - who_0 - evt_0 - dest-start_0 - dest-end_0 - peek?_0 - ok-false?_0) - (begin - (wrap-evt - evt_0 - (lambda (r_0) - (begin - (unsafe-start-atomic) - (check-read-result_0 - input-pipe_0 - user-peek-in9_0 - ok-false?_0 - peek?_0 - who_0 - r_0 - dest-start_0 - dest-end_0) - (unsafe-end-atomic) - (if (pipe-input-port?* r_0) - 0 - (if (evt? r_0) - (wrap-check-read-evt-result_0 - input-pipe_0 - user-peek-in9_0 - who_0 - r_0 - dest-start_0 - dest-end_0 - peek?_0 - ok-false?_0) - r_0))))))))) - (wrap-procedure-result_0 - (|#%name| - wrap-procedure-result - (lambda (r_0) - (begin - (let ((called?_0 (box #f))) - (let ((four-args_0 - (|#%name| - four-args - (lambda (a_0 b_0 c_0 d_0) - (begin - (begin - (called!_0 called?_0) - (if (let ((or-part_0 (not b_0))) - (if or-part_0 - or-part_0 - (exact-positive-integer? b_0))) - (void) - (raise-argument-error - 'read-special - "(or/c exact-positive-integer? #f)" - b_0)) - (if (let ((or-part_0 (not c_0))) - (if or-part_0 - or-part_0 - (exact-nonnegative-integer? - c_0))) - (void) - (raise-argument-error - 'read-special - "(or/c exact-nonnegative-integer? #f)" - c_0)) - (if (let ((or-part_0 (not d_0))) - (if or-part_0 - or-part_0 - (exact-positive-integer? d_0))) - (void) - (raise-argument-error - 'read-special - "(or/c exact-positive-integer? #f)" - d_0)) - (|#%app| r_0 a_0 b_0 c_0 d_0))))))) - (if (procedure-arity-includes? r_0 0) - (case-lambda - (() (begin (called!_0 called?_0) (|#%app| r_0))) - ((a_0 b_0 c_0 d_0) - (four-args_0 a_0 b_0 c_0 d_0))) - four-args_0)))))))) - (|#%name| - make-input-port - (lambda (name7_0 - user-read-in8_0 - user-peek-in9_0 - user-close10_0 - user-get-progress-evt1_0 - user-commit2_0 - user-get-location3_0 - user-count-lines!4_0 - user-init-position5_0 - user-buffer-mode6_0) + (|#%name| + make-input-port + (lambda (name7_0 + user-read-in8_0 + user-peek-in9_0 + user-close10_0 + user-get-progress-evt1_0 + user-commit2_0 + user-get-location3_0 + user-count-lines!4_0 + user-init-position5_0 + user-buffer-mode6_0) + (begin (begin + (if (let ((or-part_0 (1/input-port? user-read-in8_0))) + (if or-part_0 + or-part_0 + (if (procedure? user-read-in8_0) + (procedure-arity-includes? user-read-in8_0 1) + #f))) + (void) + (raise-argument-error + 'make-input-port + "(or/c (procedure-arity-includes/c 1) input-port?)" + user-read-in8_0)) (begin - (if (let ((or-part_0 (1/input-port? user-read-in8_0))) + (if (let ((or-part_0 (not user-peek-in9_0))) (if or-part_0 or-part_0 - (if (procedure? user-read-in8_0) - (procedure-arity-includes? user-read-in8_0 1) - #f))) + (let ((or-part_1 (1/input-port? user-peek-in9_0))) + (if or-part_1 + or-part_1 + (if (procedure? user-peek-in9_0) + (procedure-arity-includes? user-peek-in9_0 3) + #f))))) (void) (raise-argument-error 'make-input-port - "(or/c (procedure-arity-includes/c 1) input-port?)" - user-read-in8_0)) + "(or/c (procedure-arity-includes/c 3) input-port? #f)" + user-peek-in9_0)) (begin - (if (let ((or-part_0 (not user-peek-in9_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (1/input-port? user-peek-in9_0))) - (if or-part_1 - or-part_1 - (if (procedure? user-peek-in9_0) - (procedure-arity-includes? user-peek-in9_0 3) - #f))))) + (if (if (procedure? user-close10_0) + (procedure-arity-includes? user-close10_0 0) + #f) (void) (raise-argument-error 'make-input-port - "(or/c (procedure-arity-includes/c 3) input-port? #f)" - user-peek-in9_0)) + "(procedure-arity-includes/c 0)" + user-close10_0)) (begin - (if (if (procedure? user-close10_0) - (procedure-arity-includes? user-close10_0 0) - #f) + (if (let ((or-part_0 (not user-get-progress-evt1_0))) + (if or-part_0 + or-part_0 + (if (procedure? user-get-progress-evt1_0) + (procedure-arity-includes? + user-get-progress-evt1_0 + 0) + #f))) (void) (raise-argument-error 'make-input-port - "(procedure-arity-includes/c 0)" - user-close10_0)) + "(or/c (procedure-arity-includes/c 0) #f)" + user-get-progress-evt1_0)) (begin - (if (let ((or-part_0 (not user-get-progress-evt1_0))) + (if (let ((or-part_0 (not user-commit2_0))) (if or-part_0 or-part_0 - (if (procedure? user-get-progress-evt1_0) - (procedure-arity-includes? - user-get-progress-evt1_0 - 0) + (if (procedure? user-commit2_0) + (procedure-arity-includes? user-commit2_0 3) #f))) (void) (raise-argument-error 'make-input-port - "(or/c (procedure-arity-includes/c 0) #f)" - user-get-progress-evt1_0)) + "(or/c (procedure-arity-includes/c 3) #f)" + user-commit2_0)) (begin - (if (let ((or-part_0 (not user-commit2_0))) + (if (let ((or-part_0 (not user-get-location3_0))) (if or-part_0 or-part_0 - (if (procedure? user-commit2_0) + (if (procedure? user-get-location3_0) (procedure-arity-includes? - user-commit2_0 - 3) + user-get-location3_0 + 0) #f))) (void) (raise-argument-error 'make-input-port - "(or/c (procedure-arity-includes/c 3) #f)" - user-commit2_0)) + "(or/c (procedure-arity-includes/c 0) #f)" + user-get-location3_0)) (begin - (if (let ((or-part_0 (not user-get-location3_0))) + (if (let ((or-part_0 (not user-count-lines!4_0))) (if or-part_0 or-part_0 - (if (procedure? user-get-location3_0) + (if (procedure? user-count-lines!4_0) (procedure-arity-includes? - user-get-location3_0 + user-count-lines!4_0 0) #f))) (void) (raise-argument-error 'make-input-port "(or/c (procedure-arity-includes/c 0) #f)" - user-get-location3_0)) + user-count-lines!4_0)) (begin - (if (let ((or-part_0 (not user-count-lines!4_0))) - (if or-part_0 - or-part_0 - (if (procedure? user-count-lines!4_0) - (procedure-arity-includes? - user-count-lines!4_0 - 0) - #f))) - (void) - (raise-argument-error - 'make-input-port - "(or/c (procedure-arity-includes/c 0) #f)" - user-count-lines!4_0)) + (check-init-position + 'make-input-port + user-init-position5_0) (begin - (check-init-position + (check-buffer-mode 'make-input-port - user-init-position5_0) + user-buffer-mode6_0) (begin - (check-buffer-mode - 'make-input-port - user-buffer-mode6_0) + (if (not + (let ((app_0 + (1/input-port? user-read-in8_0))) + (eqv? + app_0 + (1/input-port? user-peek-in9_0)))) + (raise-arguments-error + 'make-input-port + (if (1/input-port? user-read-in8_0) + "read argument is an input port, but peek argument is not a port" + "read argument is not an input port, but peek argument is a port") + "read argument" + user-read-in8_0 + "peek argument" + user-peek-in9_0) + (void)) (begin - (if (not - (let ((app_0 - (1/input-port? - user-read-in8_0))) - (eqv? - app_0 - (1/input-port? user-peek-in9_0)))) + (if (if (not user-peek-in9_0) + user-get-progress-evt1_0 + #f) (raise-arguments-error 'make-input-port - (if (1/input-port? user-read-in8_0) - "read argument is an input port, but peek argument is not a port" - "read argument is not an input port, but peek argument is a port") - "read argument" - user-read-in8_0 - "peek argument" - user-peek-in9_0) + "peek argument is #f, but progress-evt argument is not" + "progress-evt argument" + user-get-progress-evt1_0) (void)) (begin - (if (if (not user-peek-in9_0) - user-get-progress-evt1_0 + (if (if (not user-get-progress-evt1_0) + user-commit2_0 #f) (raise-arguments-error 'make-input-port - "peek argument is #f, but progress-evt argument is not" - "progress-evt argument" - user-get-progress-evt1_0) + "progress-evt argument is #f, but commit argument is not" + "commit argument" + user-commit2_0) (void)) (begin - (if (if (not user-get-progress-evt1_0) - user-commit2_0 + (if (if (not user-commit2_0) + user-get-progress-evt1_0 #f) (raise-arguments-error 'make-input-port - "progress-evt argument is #f, but commit argument is not" - "commit argument" - user-commit2_0) + "commit argument is #f, but progress-evt argument is not" + "progress-evt argument" + user-get-progress-evt1_0) (void)) - (begin - (if (if (not user-commit2_0) - user-get-progress-evt1_0 - #f) - (raise-arguments-error - 'make-input-port - "commit argument is #f, but progress-evt argument is not" - "progress-evt argument" - user-get-progress-evt1_0) - (void)) - (let ((input-pipe_0 (box #f))) - (letrec* - ((read-in_0 - (|#%name| - read-in - (lambda (self_0 - dest-bstr_0 - dest-start_0 - dest-end_0 - copy?_0) - (begin - (if (unsafe-unbox* - input-pipe_0) - (if (zero? - (1/pipe-content-length - (unsafe-unbox* - input-pipe_0))) - (begin - (unsafe-set-box*! - input-pipe_0 - #f) - (read-in_0 - self_0 - dest-bstr_0 + (let ((input-pipe_0 #f)) + (let ((protect-in_0 + (|#%name| + protect-in + (lambda (dest-bstr_0 dest-start_0 dest-end_0 - copy?_0)) - (let ((o_0 - (unsafe-unbox* - input-pipe_0))) - (|#%app| - (core-input-port-methods-read-in.1 - (core-port-vtable - o_0)) - o_0 - dest-bstr_0 - dest-start_0 - dest-end_0 - copy?_0))) - (let ((r_0 - (with-continuation-mark* - push-authentic - break-enabled-key - (make-thread-cell - #f) - (begin - (check-for-break) + copy?_0 + user-read-in_0) + (begin + (let ((len_0 + (- + dest-end_0 + dest-start_0))) + (let ((user-bstr_0 + (if (if copy?_0 + copy?_0 + (let ((or-part_0 + (not + (zero? + dest-start_0)))) + (if or-part_0 + or-part_0 + (not + (= + len_0 + dest-end_0))))) + (make-bytes + len_0) + dest-bstr_0))) + (let ((n_0 + (|#%app| + user-read-in_0 + user-bstr_0))) + (if (eq? + user-bstr_0 + dest-bstr_0) + n_0 + (if (evt? n_0) + (wrap-evt + n_0 + (lambda (n_1) + (begin + (if (exact-positive-integer? + n_1) + (unsafe-bytes-copy! + dest-bstr_0 + dest-start_0 + user-bstr_0 + 0 + n_1) + (void)) + n_1))) (begin - (unsafe-end-atomic) - (begin0 - (protect-in_0 + (if (exact-positive-integer? + n_0) + (unsafe-bytes-copy! dest-bstr_0 dest-start_0 - dest-end_0 - copy?_0 - user-read-in8_0) - (unsafe-start-atomic))))))) - (begin - (check-read-result_0 - input-pipe_0 - user-peek-in9_0 - #f - #f - '|user port read| - r_0 + user-bstr_0 + 0 + n_0) + (void)) + n_0))))))))))) + (let ((check-read-result_0 + (|#%name| + check-read-result + (lambda (ok-false?13_0 + peek?12_0 + who16_0 + r17_0 + dest-start18_0 + dest-end19_0) + (begin + (if (exact-nonnegative-integer? + r17_0) + (if (<= + r17_0 + (- + dest-end19_0 + dest-start18_0)) + (void) + (begin + (unsafe-end-atomic) + (raise-arguments-error + who16_0 + "result integer is larger than the supplied byte string" + "result" + r17_0 + "byte-string length" + (- + dest-end19_0 + dest-start18_0)))) + (if (eof-object? + r17_0) + (void) + (if (if (procedure? + r17_0) + (procedure-arity-includes? + r17_0 + 4) + #f) + (if user-peek-in9_0 + (void) + (begin + (unsafe-end-atomic) + (raise-arguments-error + who16_0 + (string-append + "the port has no specific peek procedure, so" + " a special read result is not allowed") + "special result" + r17_0))) + (if (pipe-input-port?* + r17_0) + (set! input-pipe_0 + r17_0) + (if (evt? + r17_0) + r17_0 + (if (if peek?12_0 + (not + r17_0) + #f) + (if ok-false?13_0 + (void) + (begin + (unsafe-end-atomic) + (raise-arguments-error + who16_0 + "returned #f when no progress evt was supplied"))) + (begin + (unsafe-end-atomic) + (raise-result-error + who16_0 + (let ((app_0 + (if (if peek?12_0 + ok-false?13_0 + #f) + " #f" + ""))) + (string-append + "(or/c exact-nonnegative-integer? eof-object? evt? pipe-input-port?" + app_0 + (if user-peek-in9_0 + " (procedure-arity-includes/c 4)" + "") + ")")) + r17_0))))))))))))) + (letrec* + ((wrap-check-read-evt-result_0 + (|#%name| + wrap-check-read-evt-result + (lambda (who_0 + evt_0 dest-start_0 - dest-end_0) - (if (pipe-input-port?* - r_0) - (read-in_0 - self_0 - dest-bstr_0 - dest-start_0 - dest-end_0 - copy?_0) - (if (evt? r_0) - (wrap-check-read-evt-result_0 - input-pipe_0 - user-peek-in9_0 - '|user port read| - r_0 - dest-start_0 - dest-end_0 - #f - #f) - (if (procedure? - r_0) - (wrap-procedure-result_0 - r_0) - r_0))))))))))) - (letrec* - ((peek-in_0 - (|#%name| - peek-in - (lambda (self_0 - dest-bstr_0 - dest-start_0 - dest-end_0 - skip-k_0 - progress-evt_0 - copy?_0) - (begin - (if (unsafe-unbox* - input-pipe_0) - (if (<= - (1/pipe-content-length - (unsafe-unbox* - input-pipe_0)) - skip-k_0) - (begin - (unsafe-set-box*! - input-pipe_0 - #f) - (peek-in_0 - self_0 - dest-bstr_0 - dest-start_0 - dest-end_0 - skip-k_0 - progress-evt_0 - copy?_0)) - (let ((o_0 - (unsafe-unbox* - input-pipe_0))) - (|#%app| - (core-input-port-methods-peek-in.1 - (core-port-vtable - o_0)) - o_0 - dest-bstr_0 - dest-start_0 - dest-end_0 - skip-k_0 - progress-evt_0 - copy?_0))) - (let ((r_0 - (with-continuation-mark* - push-authentic - break-enabled-key - (make-thread-cell - #f) - (begin - (check-for-break) - (begin - (unsafe-end-atomic) - (begin0 - (protect-in_0 - dest-bstr_0 - dest-start_0 - dest-end_0 - copy?_0 - (lambda (user-bstr_0) - (|#%app| - user-peek-in9_0 - user-bstr_0 - skip-k_0 - progress-evt_0))) - (unsafe-start-atomic))))))) + dest-end_0 + peek?_0 + ok-false?_0) + (begin + (wrap-evt + evt_0 + (lambda (r_0) (begin + (unsafe-start-atomic) (check-read-result_0 - input-pipe_0 - user-peek-in9_0 - progress-evt_0 - #t - '|user port peek| + ok-false?_0 + peek?_0 + who_0 r_0 dest-start_0 dest-end_0) + (unsafe-end-atomic) (if (pipe-input-port?* r_0) - (peek-in_0 - self_0 - dest-bstr_0 - dest-start_0 - dest-end_0 - skip-k_0 - progress-evt_0 - copy?_0) + 0 (if (evt? r_0) (wrap-check-read-evt-result_0 - input-pipe_0 - user-peek-in9_0 - '|user port peek| + who_0 r_0 dest-start_0 dest-end_0 - #t - progress-evt_0) - (if (procedure? + peek?_0 + ok-false?_0) + r_0)))))))))) + (let ((wrap-procedure-result_0 + (|#%name| + wrap-procedure-result + (lambda (r_0) + (begin + (let ((called?_0 + #f)) + (let ((called!_0 + (|#%name| + called! + (lambda () + (begin + (begin + (if called?_0 + (raise-arguments-error + 'read-special + "cannot be called a second time") + (void)) + (set! called?_0 + #t))))))) + (let ((four-args_0 + (|#%name| + four-args + (lambda (a_0 + b_0 + c_0 + d_0) + (begin + (begin + (called!_0) + (if (let ((or-part_0 + (not + b_0))) + (if or-part_0 + or-part_0 + (exact-positive-integer? + b_0))) + (void) + (raise-argument-error + 'read-special + "(or/c exact-positive-integer? #f)" + b_0)) + (if (let ((or-part_0 + (not + c_0))) + (if or-part_0 + or-part_0 + (exact-nonnegative-integer? + c_0))) + (void) + (raise-argument-error + 'read-special + "(or/c exact-nonnegative-integer? #f)" + c_0)) + (if (let ((or-part_0 + (not + d_0))) + (if or-part_0 + or-part_0 + (exact-positive-integer? + d_0))) + (void) + (raise-argument-error + 'read-special + "(or/c exact-positive-integer? #f)" + d_0)) + (|#%app| + r_0 + a_0 + b_0 + c_0 + d_0))))))) + (if (procedure-arity-includes? + r_0 + 0) + (case-lambda + (() + (begin + (called!_0) + (|#%app| + r_0))) + ((a_0 + b_0 + c_0 + d_0) + (four-args_0 + a_0 + b_0 + c_0 + d_0))) + four-args_0))))))))) + (letrec* + ((read-in_0 + (|#%name| + read-in + (lambda (self_0 + dest-bstr_0 + dest-start_0 + dest-end_0 + copy?_0) + (begin + (if input-pipe_0 + (if (zero? + (1/pipe-content-length + input-pipe_0)) + (begin + (set! input-pipe_0 + #f) + (read-in_0 + self_0 + dest-bstr_0 + dest-start_0 + dest-end_0 + copy?_0)) + (let ((o_0 + input-pipe_0)) + (|#%app| + (core-input-port-methods-read-in.1 + (core-port-vtable + o_0)) + o_0 + dest-bstr_0 + dest-start_0 + dest-end_0 + copy?_0))) + (let ((r_0 + (with-continuation-mark* + push-authentic + break-enabled-key + (make-thread-cell + #f) + (begin + (check-for-break) + (begin + (unsafe-end-atomic) + (begin0 + (protect-in_0 + dest-bstr_0 + dest-start_0 + dest-end_0 + copy?_0 + user-read-in8_0) + (unsafe-start-atomic))))))) + (begin + (check-read-result_0 + #f + #f + '|user port read| + r_0 + dest-start_0 + dest-end_0) + (if (pipe-input-port?* r_0) - (wrap-procedure-result_0 - r_0) - r_0))))))))))) - (let ((byte-ready_0 - (|#%name| - byte-ready - (lambda (self_0 - work-done!_0) - (begin - (if (if (unsafe-unbox* - input-pipe_0) - (positive? - (1/pipe-content-length - (unsafe-unbox* - input-pipe_0))) - #f) - #t - (let ((bstr_0 - (make-bytes - 1))) - (let ((v_0 - (peek-in_0 - self_0 - bstr_0 - 0 - 1 - 0 - #f - #f))) - (begin - (|#%app| - work-done!_0) - (if (evt? - v_0) - v_0 - (not - (eqv? - v_0 - 0)))))))))))) - (let ((close_0 - (|#%name| - close - (lambda (self_0) - (begin - (begin - (unsafe-end-atomic) - (|#%app| - user-close10_0) - (unsafe-start-atomic))))))) - (let ((get-progress-evt_0 - (|#%name| - get-progress-evt - (lambda (self_0) - (begin - (let ((r_0 - (|#%app| - user-get-progress-evt1_0))) - (begin - (if (evt? - r_0) - (void) - (raise-result-error - '|user port progress-evt| - "evt?" - r_0)) - r_0))))))) - (let ((commit_0 - (|#%name| - commit - (lambda (self_0 - amt_0 - evt_0 - ext-evt_0 - finish_0) - (begin - (let ((r_0 - (with-continuation-mark* - push-authentic - break-enabled-key - (make-thread-cell - #f) - (begin - (check-for-break) - (begin - (unsafe-end-atomic) - (begin0 - (|#%app| - user-commit2_0 - amt_0 - evt_0 - ext-evt_0) - (unsafe-start-atomic))))))) - (if (not r_0) + (read-in_0 + self_0 + dest-bstr_0 + dest-start_0 + dest-end_0 + copy?_0) + (if (evt? r_0) + (wrap-check-read-evt-result_0 + '|user port read| + r_0 + dest-start_0 + dest-end_0 #f - (if (bytes? - r_0) - (begin - (|#%app| - finish_0 - r_0) - #t) - (begin - (|#%app| - finish_0 - (make-bytes - amt_0 - 120)) - #t))))))))) - (let ((get-location_0 - (if user-get-location3_0 - (make-get-location - user-get-location3_0) - #f))) - (let ((count-lines!_0 - (if user-count-lines!4_0 - (|#%name| - count-lines! - (lambda (self_0) + #f) + (if (procedure? + r_0) + (wrap-procedure-result_0 + r_0) + r_0))))))))))) + (letrec* + ((peek-in_0 + (|#%name| + peek-in + (lambda (self_0 + dest-bstr_0 + dest-start_0 + dest-end_0 + skip-k_0 + progress-evt_0 + copy?_0) + (begin + (if input-pipe_0 + (if (<= + (1/pipe-content-length + input-pipe_0) + skip-k_0) + (begin + (set! input-pipe_0 + #f) + (peek-in_0 + self_0 + dest-bstr_0 + dest-start_0 + dest-end_0 + skip-k_0 + progress-evt_0 + copy?_0)) + (let ((o_0 + input-pipe_0)) + (|#%app| + (core-input-port-methods-peek-in.1 + (core-port-vtable + o_0)) + o_0 + dest-bstr_0 + dest-start_0 + dest-end_0 + skip-k_0 + progress-evt_0 + copy?_0))) + (let ((r_0 + (with-continuation-mark* + push-authentic + break-enabled-key + (make-thread-cell + #f) (begin + (check-for-break) (begin (unsafe-end-atomic) - (|#%app| - user-count-lines!4_0) - (unsafe-start-atomic))))) - #f))) - (call-with-values - (lambda () - (make-init-offset+file-position - user-init-position5_0)) - (case-lambda - ((init-offset_0 - file-position_0) - (let ((buffer-mode_0 - (if user-buffer-mode6_0 - (make-buffer-mode.1 - #f - user-buffer-mode6_0) + (begin0 + (protect-in_0 + dest-bstr_0 + dest-start_0 + dest-end_0 + copy?_0 + (lambda (user-bstr_0) + (|#%app| + user-peek-in9_0 + user-bstr_0 + skip-k_0 + progress-evt_0))) + (unsafe-start-atomic))))))) + (begin + (check-read-result_0 + progress-evt_0 + #t + '|user port peek| + r_0 + dest-start_0 + dest-end_0) + (if (pipe-input-port?* + r_0) + (peek-in_0 + self_0 + dest-bstr_0 + dest-start_0 + dest-end_0 + skip-k_0 + progress-evt_0 + copy?_0) + (if (evt? + r_0) + (wrap-check-read-evt-result_0 + '|user port peek| + r_0 + dest-start_0 + dest-end_0 + #t + progress-evt_0) + (if (procedure? + r_0) + (wrap-procedure-result_0 + r_0) + r_0))))))))))) + (let ((byte-ready_0 + (|#%name| + byte-ready + (lambda (self_0 + work-done!_0) + (begin + (if (if input-pipe_0 + (positive? + (1/pipe-content-length + input-pipe_0)) + #f) + #t + (let ((bstr_0 + (make-bytes + 1))) + (let ((v_0 + (peek-in_0 + self_0 + bstr_0 + 0 + 1 + 0 + #f + #f))) + (begin + (|#%app| + work-done!_0) + (if (evt? + v_0) + v_0 + (not + (eqv? + v_0 + 0)))))))))))) + (let ((close_0 + (|#%name| + close + (lambda (self_0) + (begin + (begin + (unsafe-end-atomic) + (|#%app| + user-close10_0) + (unsafe-start-atomic))))))) + (let ((get-progress-evt_0 + (|#%name| + get-progress-evt + (lambda (self_0) + (begin + (let ((r_0 + (|#%app| + user-get-progress-evt1_0))) + (begin + (if (evt? + r_0) + (void) + (raise-result-error + '|user port progress-evt| + "evt?" + r_0)) + r_0))))))) + (let ((commit_0 + (|#%name| + commit + (lambda (self_0 + amt_0 + evt_0 + ext-evt_0 + finish_0) + (begin + (let ((r_0 + (with-continuation-mark* + push-authentic + break-enabled-key + (make-thread-cell + #f) + (begin + (check-for-break) + (begin + (unsafe-end-atomic) + (begin0 + (|#%app| + user-commit2_0 + amt_0 + evt_0 + ext-evt_0) + (unsafe-start-atomic))))))) + (if (not + r_0) + #f + (if (bytes? + r_0) + (begin + (|#%app| + finish_0 + r_0) + #t) + (begin + (|#%app| + finish_0 + (make-bytes + amt_0 + 120)) + #t))))))))) + (let ((get-location_0 + (if user-get-location3_0 + (make-get-location + user-get-location3_0) + #f))) + (let ((count-lines!_0 + (if user-count-lines!4_0 + (|#%name| + count-lines! + (lambda (self_0) + (begin + (begin + (unsafe-end-atomic) + (|#%app| + user-count-lines!4_0) + (unsafe-start-atomic))))) #f))) - (finish-port/count - (if user-peek-in9_0 - (create-core-input-port - (let ((app_0 - (core-input-port-methods-prepare-change.1 - core-input-port-vtable.1))) - (let ((app_1 - (if (1/input-port? - user-read-in8_0) - user-read-in8_0 - read-in_0))) - (let ((app_2 - (if (1/input-port? - user-peek-in9_0) - user-peek-in9_0 - peek-in_0))) - (let ((app_3 - (if (1/input-port? - user-peek-in9_0) - user-peek-in9_0 - byte-ready_0))) - (let ((app_4 - (if user-get-progress-evt1_0 - get-progress-evt_0 - #f))) - (core-input-port-methods6.1 - close_0 - count-lines!_0 - get-location_0 - file-position_0 - buffer-mode_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (if user-commit2_0 - commit_0 - #f))))))) - name7_0 - (direct2.1 - #f - 0 - 0) - #f - #f - init-offset_0 - #f - #f - #f) - (let ((app_0 - (let ((app_0 - (if buffer-mode_0 - buffer-mode_0 - procz1))) - (let ((app_1 - (core-input-port-methods-prepare-change.1 - peek-via-read-input-port-vtable.1))) - (let ((app_2 - (core-input-port-methods-read-in.1 - peek-via-read-input-port-vtable.1))) - (let ((app_3 - (core-input-port-methods-peek-in.1 - peek-via-read-input-port-vtable.1))) - (let ((app_4 - (core-input-port-methods-byte-ready.1 - peek-via-read-input-port-vtable.1))) - (let ((app_5 - (core-input-port-methods-get-progress-evt.1 - peek-via-read-input-port-vtable.1))) - (peek-via-read-input-port-methods10.1 - (values - (lambda (self_0) - (begin - (close_0 - self_0) - (temp7.1 - self_0)))) - count-lines!_0 - get-location_0 - file-position_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - (core-input-port-methods-commit.1 - peek-via-read-input-port-vtable.1) - read-in_0))))))))) - (create-peek-via-read-input-port - app_0 - name7_0 - (direct2.1 - #f - 0 - 0) - #f - #f - init-offset_0 - #f - #f - #f - #f - #f - (make-bytes - 4096) - 0 - 0 - #f - 'block)))))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))))))))))))))))))))))))) + (call-with-values + (lambda () + (make-init-offset+file-position + user-init-position5_0)) + (case-lambda + ((init-offset_0 + file-position_0) + (let ((buffer-mode_0 + (if user-buffer-mode6_0 + (make-buffer-mode.1 + #f + user-buffer-mode6_0) + #f))) + (finish-port/count + (if user-peek-in9_0 + (create-core-input-port + (let ((app_0 + (core-input-port-methods-prepare-change.1 + core-input-port-vtable.1))) + (let ((app_1 + (if (1/input-port? + user-read-in8_0) + user-read-in8_0 + read-in_0))) + (let ((app_2 + (if (1/input-port? + user-peek-in9_0) + user-peek-in9_0 + peek-in_0))) + (let ((app_3 + (if (1/input-port? + user-peek-in9_0) + user-peek-in9_0 + byte-ready_0))) + (let ((app_4 + (if user-get-progress-evt1_0 + get-progress-evt_0 + #f))) + (core-input-port-methods6.1 + close_0 + count-lines!_0 + get-location_0 + file-position_0 + buffer-mode_0 + app_0 + app_1 + app_2 + app_3 + app_4 + (if user-commit2_0 + commit_0 + #f))))))) + name7_0 + (direct2.1 + #f + 0 + 0) + #f + #f + init-offset_0 + #f + #f + #f) + (let ((app_0 + (let ((app_0 + (if buffer-mode_0 + buffer-mode_0 + (case-lambda + ((self_0) + (temp9.1 + self_0)) + ((self_0 + mode_0) + (temp9.1 + self_0 + mode_0)))))) + (let ((app_1 + (core-input-port-methods-prepare-change.1 + peek-via-read-input-port-vtable.1))) + (let ((app_2 + (core-input-port-methods-read-in.1 + peek-via-read-input-port-vtable.1))) + (let ((app_3 + (core-input-port-methods-peek-in.1 + peek-via-read-input-port-vtable.1))) + (let ((app_4 + (core-input-port-methods-byte-ready.1 + peek-via-read-input-port-vtable.1))) + (let ((app_5 + (core-input-port-methods-get-progress-evt.1 + peek-via-read-input-port-vtable.1))) + (peek-via-read-input-port-methods10.1 + (values + (lambda (self_0) + (begin + (close_0 + self_0) + (temp7.1 + self_0)))) + count-lines!_0 + get-location_0 + file-position_0 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + (core-input-port-methods-commit.1 + peek-via-read-input-port-vtable.1) + read-in_0))))))))) + (create-peek-via-read-input-port + app_0 + name7_0 + (direct2.1 + #f + 0 + 0) + #f + #f + init-offset_0 + #f + #f + #f + #f + #f + (make-bytes + 4096) + 0 + 0 + #f + 'block)))))) + (args + (raise-binding-result-arity-error + 2 + args))))))))))))))))))))))))))))))))))) (|#%name| make-input-port (case-lambda @@ -28387,581 +27237,587 @@ #f)))))) (define 1/make-output-port (let ((make-output-port_0 - (letrec ((check-write-result_0 - (|#%name| - check-write-result - (lambda (output-pipe_0 - as-evt?13_0 - who15_0 - r16_0 - start17_0 - end18_0 - non-block/buffer?19_0) - (begin - (if (exact-nonnegative-integer? r16_0) - (if (eqv? r16_0 0) - (if (= start17_0 end18_0) - (void) - (begin - (unsafe-end-atomic) - (raise-arguments-error - who15_0 - (string-append - "bad result for non-flush write" - (if as-evt?13_0 " event" "")) - "result" - r16_0))) - (if (<= r16_0 (- end18_0 start17_0)) - (void) - (begin - (unsafe-end-atomic) - (raise-arguments-error - who15_0 - "result integer is larger than the supplied byte string" - "result" - r16_0 - "byte string length" - (- end18_0 start17_0))))) - (if (not r16_0) - r16_0 - (if (pipe-output-port?* r16_0) - (begin - (if (= start17_0 end18_0) - (begin - (unsafe-end-atomic) - (raise-arguments-error - who15_0 - "bad result for a flushing write" - "result" - r16_0)) - (void)) - (if non-block/buffer?19_0 - (begin - (unsafe-end-atomic) - (raise-arguments-error - who15_0 - "bad result for a non-blocking write" - "result" - r16_0)) - (void)) - (unsafe-set-box*! output-pipe_0 r16_0)) - (if (evt? r16_0) - (void) - (begin - (unsafe-end-atomic) - (raise-result-error - who15_0 - "(or/c exact-nonnegative-integer? #f evt?)" - r16_0)))))))))) - (wrap-check-write-evt-result_0 - (|#%name| - wrap-check-write-evt-result - (lambda (output-pipe_0 - who_0 - evt_0 - start_0 - end_0 - non-block/buffer?_0) - (begin - (wrap-evt - evt_0 - (lambda (r_0) - (begin - (unsafe-start-atomic) - (check-write-result_0 - output-pipe_0 - #t - who_0 - r_0 - start_0 - end_0 - non-block/buffer?_0) - (unsafe-end-atomic) - (if (pipe-output-port?* r_0) - 0 - (if (evt? r_0) - (wrap-check-write-evt-result_0 - output-pipe_0 - who_0 - r_0 - start_0 - end_0 - non-block/buffer?_0) - r_0)))))))))) - (|#%name| - make-output-port - (lambda (name8_0 - evt9_0 - user-write-out10_0 - user-close11_0 - user-write-out-special1_0 - user-get-write-evt2_0 - user-get-write-special-evt3_0 - user-get-location4_0 - user-count-lines!5_0 - user-init-position6_0 - user-buffer-mode7_0) + (|#%name| + make-output-port + (lambda (name8_0 + evt9_0 + user-write-out10_0 + user-close11_0 + user-write-out-special1_0 + user-get-write-evt2_0 + user-get-write-special-evt3_0 + user-get-location4_0 + user-count-lines!5_0 + user-init-position6_0 + user-buffer-mode7_0) + (begin (begin + (if (evt? evt9_0) + (void) + (raise-argument-error 'make-output-port "evt?" evt9_0)) (begin - (if (evt? evt9_0) + (if (let ((or-part_0 (1/output-port? user-write-out10_0))) + (if or-part_0 + or-part_0 + (if (procedure? user-write-out10_0) + (procedure-arity-includes? user-write-out10_0 5) + #f))) (void) - (raise-argument-error 'make-output-port "evt?" evt9_0)) + (raise-argument-error + 'make-output-port + "(or/c output-port? (procedure-arity-includes/c 5))" + user-write-out10_0)) (begin - (if (let ((or-part_0 (1/output-port? user-write-out10_0))) - (if or-part_0 - or-part_0 - (if (procedure? user-write-out10_0) - (procedure-arity-includes? user-write-out10_0 5) - #f))) + (if (if (procedure? user-close11_0) + (procedure-arity-includes? user-close11_0 0) + #f) (void) (raise-argument-error 'make-output-port - "(or/c output-port? (procedure-arity-includes/c 5))" - user-write-out10_0)) + "(procedure-arity-includes/c 0)" + user-close11_0)) (begin - (if (if (procedure? user-close11_0) - (procedure-arity-includes? user-close11_0 0) - #f) + (if (let ((or-part_0 (not user-write-out-special1_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (1/output-port? + user-write-out-special1_0))) + (if or-part_1 + or-part_1 + (if (procedure? user-write-out-special1_0) + (procedure-arity-includes? + user-write-out-special1_0 + 3) + #f))))) (void) (raise-argument-error 'make-output-port - "(procedure-arity-includes/c 0)" - user-close11_0)) + "(or/c #f output-port? (procedure-arity-includes/c 3))" + user-write-out-special1_0)) (begin - (if (let ((or-part_0 (not user-write-out-special1_0))) + (if (let ((or-part_0 (not user-get-write-evt2_0))) (if or-part_0 or-part_0 - (let ((or-part_1 - (1/output-port? - user-write-out-special1_0))) - (if or-part_1 - or-part_1 - (if (procedure? user-write-out-special1_0) - (procedure-arity-includes? - user-write-out-special1_0 - 3) - #f))))) + (if (procedure? user-get-write-evt2_0) + (procedure-arity-includes? + user-get-write-evt2_0 + 3) + #f))) (void) (raise-argument-error 'make-output-port - "(or/c #f output-port? (procedure-arity-includes/c 3))" - user-write-out-special1_0)) + "(or/c #f (procedure-arity-includes/c 3))" + user-get-write-evt2_0)) (begin - (if (let ((or-part_0 (not user-get-write-evt2_0))) + (if (let ((or-part_0 + (not user-get-write-special-evt3_0))) (if or-part_0 or-part_0 - (if (procedure? user-get-write-evt2_0) + (if (procedure? + user-get-write-special-evt3_0) (procedure-arity-includes? - user-get-write-evt2_0 - 3) + user-get-write-special-evt3_0 + 1) #f))) (void) (raise-argument-error 'make-output-port - "(or/c #f (procedure-arity-includes/c 3))" - user-get-write-evt2_0)) + "(or/c #f (procedure-arity-includes/c 1))" + user-get-write-special-evt3_0)) (begin - (if (let ((or-part_0 - (not user-get-write-special-evt3_0))) + (if (let ((or-part_0 (not user-get-location4_0))) (if or-part_0 or-part_0 - (if (procedure? - user-get-write-special-evt3_0) + (if (procedure? user-get-location4_0) (procedure-arity-includes? - user-get-write-special-evt3_0 - 1) + user-get-location4_0 + 0) #f))) (void) (raise-argument-error 'make-output-port - "(or/c #f (procedure-arity-includes/c 1))" - user-get-write-special-evt3_0)) + "(or/c #f (procedure-arity-includes/c 0))" + user-get-location4_0)) (begin - (if (let ((or-part_0 (not user-get-location4_0))) - (if or-part_0 - or-part_0 - (if (procedure? user-get-location4_0) - (procedure-arity-includes? - user-get-location4_0 - 0) - #f))) + (if (if (procedure? user-count-lines!5_0) + (procedure-arity-includes? + user-count-lines!5_0 + 0) + #f) (void) (raise-argument-error 'make-output-port - "(or/c #f (procedure-arity-includes/c 0))" - user-get-location4_0)) + "(procedure-arity-includes/c 0)" + user-count-lines!5_0)) (begin - (if (if (procedure? user-count-lines!5_0) - (procedure-arity-includes? - user-count-lines!5_0 - 0) - #f) - (void) - (raise-argument-error - 'make-output-port - "(procedure-arity-includes/c 0)" - user-count-lines!5_0)) + (check-init-position + 'make-output-port + user-init-position6_0) (begin - (check-init-position + (check-buffer-mode 'make-output-port - user-init-position6_0) + user-buffer-mode7_0) (begin - (check-buffer-mode - 'make-output-port - user-buffer-mode7_0) + (if (if (not user-write-out-special1_0) + user-get-write-special-evt3_0 + #f) + (raise-arguments-error + 'make-output-port + "write-special argument is #f, but get-write-special-evt argument is not" + "get-write-special-evt argument" + user-get-write-special-evt3_0) + (void)) (begin - (if (if (not user-write-out-special1_0) + (if (if (not user-get-write-evt2_0) user-get-write-special-evt3_0 #f) (raise-arguments-error 'make-output-port - "write-special argument is #f, but get-write-special-evt argument is not" + "get-write-evt argument is #f, but get-write-special-evt argument is not" "get-write-special-evt argument" user-get-write-special-evt3_0) (void)) (begin - (if (if (not user-get-write-evt2_0) - user-get-write-special-evt3_0 + (if (if (not + user-get-write-special-evt3_0) + (if user-get-write-evt2_0 + user-write-out-special1_0 + #f) #f) (raise-arguments-error 'make-output-port - "get-write-evt argument is #f, but get-write-special-evt argument is not" + "get-write-special-evt argument is #f, but get-write-evt argument is not, and write-special argument is not" + "get-write-evt argument" + user-get-write-evt2_0 "get-write-special-evt argument" user-get-write-special-evt3_0) (void)) - (begin - (if (if (not - user-get-write-special-evt3_0) - (if user-get-write-evt2_0 - user-write-out-special1_0 - #f) - #f) - (raise-arguments-error - 'make-output-port - "get-write-special-evt argument is #f, but get-write-evt argument is not, and write-special argument is not" - "get-write-evt argument" - user-get-write-evt2_0 - "get-write-special-evt argument" - user-get-write-special-evt3_0) - (void)) - (let ((output-pipe_0 (box #f))) - (letrec* - ((write-out_0 - (|#%name| - write-out - (lambda (self_0 - bstr_0 - start_0 - end_0 - non-block/buffer?_0 - enable-break?_0 - copy?_0) - (begin - (if (unsafe-unbox* - output-pipe_0) - (if (if non-block/buffer?_0 - non-block/buffer?_0 - (let ((or-part_0 - (= - start_0 - end_0))) - (if or-part_0 - or-part_0 - (not - (sync/timeout - 0 - (unsafe-unbox* - output-pipe_0)))))) - (begin - (unsafe-set-box*! - output-pipe_0 - #f) - (write-out_0 - self_0 - bstr_0 - start_0 - end_0 - non-block/buffer?_0 - enable-break?_0 - copy?_0)) - (let ((o_0 - (unsafe-unbox* - output-pipe_0))) - (|#%app| - (core-output-port-methods-write-out.1 - (core-port-vtable - o_0)) - o_0 - bstr_0 - start_0 - end_0 - non-block/buffer?_0 - enable-break?_0 - copy?_0))) - (call-with-values - (lambda () - (if (if copy?_0 - (not - (immutable? - bstr_0)) - #f) - (let ((app_0 - (unsafe-bytes->immutable-bytes! - (subbytes - bstr_0 - start_0 - end_0)))) - (values - app_0 - 0 - (- - end_0 - start_0))) - (values - (unsafe-bytes->immutable-bytes! - bstr_0) - start_0 - end_0))) - (case-lambda - ((imm-bstr_0 - imm-start_0 - imm-end_0) - (let ((r_0 - (let ((enable-break?_1 - (if (not - non-block/buffer?_0) - (break-enabled) - #f))) - (with-continuation-mark* - push-authentic - break-enabled-key - (make-thread-cell - #f) - (begin - (check-for-break) - (begin - (unsafe-end-atomic) - (begin0 - (|#%app| - user-write-out10_0 - imm-bstr_0 - imm-start_0 - imm-end_0 - non-block/buffer?_0 - enable-break?_1) - (unsafe-start-atomic)))))))) - (begin - (check-write-result_0 - output-pipe_0 - #f - '|user port write| - r_0 - imm-start_0 - imm-end_0 - non-block/buffer?_0) - (if (pipe-output-port?* - r_0) - (write-out_0 - self_0 - imm-bstr_0 - imm-start_0 - imm-end_0 - non-block/buffer?_0 - enable-break?_0 - copy?_0) - (if (evt? r_0) - (wrap-check-write-evt-result_0 - output-pipe_0 - '|user port write| - r_0 - imm-start_0 - imm-end_0 - non-block/buffer?_0) - r_0))))) - (args - (raise-binding-result-arity-error - 3 - args)))))))))) - (let ((get-write-evt_0 - (|#%name| - get-write-evt - (lambda (self_0 - bstr_0 - start_0 - end_0) - (begin - (call-with-values - (lambda () - (if (immutable? - bstr_0) - (values - bstr_0 - start_0 - end_0) - (let ((app_0 - (unsafe-bytes->immutable-bytes! - (subbytes - bstr_0 - start_0 - end_0)))) - (values - app_0 - 0 - (- - end_0 - start_0))))) - (case-lambda - ((imm-bstr_0 - imm-start_0 - imm-end_0) + (let ((output-pipe_0 #f)) + (let ((check-write-result_0 + (|#%name| + check-write-result + (lambda (as-evt?13_0 + who15_0 + r16_0 + start17_0 + end18_0 + non-block/buffer?19_0) + (begin + (if (exact-nonnegative-integer? + r16_0) + (if (eqv? r16_0 0) + (if (= + start17_0 + end18_0) + (void) (begin (unsafe-end-atomic) - (let ((r_0 - (|#%app| - user-get-write-evt2_0 - imm-bstr_0 - imm-start_0 - imm-end_0))) + (raise-arguments-error + who15_0 + (string-append + "bad result for non-flush write" + (if as-evt?13_0 + " event" + "")) + "result" + r16_0))) + (if (<= + r16_0 + (- + end18_0 + start17_0)) + (void) + (begin + (unsafe-end-atomic) + (raise-arguments-error + who15_0 + "result integer is larger than the supplied byte string" + "result" + r16_0 + "byte string length" + (- + end18_0 + start17_0))))) + (if (not r16_0) + r16_0 + (if (pipe-output-port?* + r16_0) + (begin + (if (= + start17_0 + end18_0) (begin - (if (evt? - r_0) - (void) - (raise-result-error - '|user port get-write-evt| - "evt?" - r_0)) - (unsafe-start-atomic) + (unsafe-end-atomic) + (raise-arguments-error + who15_0 + "bad result for a flushing write" + "result" + r16_0)) + (void)) + (if non-block/buffer?19_0 + (begin + (unsafe-end-atomic) + (raise-arguments-error + who15_0 + "bad result for a non-blocking write" + "result" + r16_0)) + (void)) + (set! output-pipe_0 + r16_0)) + (if (evt? r16_0) + (void) + (begin + (unsafe-end-atomic) + (raise-result-error + who15_0 + "(or/c exact-nonnegative-integer? #f evt?)" + r16_0))))))))))) + (letrec* + ((wrap-check-write-evt-result_0 + (|#%name| + wrap-check-write-evt-result + (lambda (who_0 + evt_0 + start_0 + end_0 + non-block/buffer?_0) + (begin + (wrap-evt + evt_0 + (lambda (r_0) + (begin + (unsafe-start-atomic) + (check-write-result_0 + #t + who_0 + r_0 + start_0 + end_0 + non-block/buffer?_0) + (unsafe-end-atomic) + (if (pipe-output-port?* + r_0) + 0 + (if (evt? r_0) + (wrap-check-write-evt-result_0 + who_0 + r_0 + start_0 + end_0 + non-block/buffer?_0) + r_0)))))))))) + (letrec* + ((write-out_0 + (|#%name| + write-out + (lambda (self_0 + bstr_0 + start_0 + end_0 + non-block/buffer?_0 + enable-break?_0 + copy?_0) + (begin + (if output-pipe_0 + (if (if non-block/buffer?_0 + non-block/buffer?_0 + (let ((or-part_0 + (= + start_0 + end_0))) + (if or-part_0 + or-part_0 + (not + (sync/timeout + 0 + output-pipe_0))))) + (begin + (set! output-pipe_0 + #f) + (write-out_0 + self_0 + bstr_0 + start_0 + end_0 + non-block/buffer?_0 + enable-break?_0 + copy?_0)) + (let ((o_0 + output-pipe_0)) + (|#%app| + (core-output-port-methods-write-out.1 + (core-port-vtable + o_0)) + o_0 + bstr_0 + start_0 + end_0 + non-block/buffer?_0 + enable-break?_0 + copy?_0))) + (call-with-values + (lambda () + (if (if copy?_0 + (not + (immutable? + bstr_0)) + #f) + (let ((app_0 + (unsafe-bytes->immutable-bytes! + (subbytes + bstr_0 + start_0 + end_0)))) + (values + app_0 + 0 + (- + end_0 + start_0))) + (values + (unsafe-bytes->immutable-bytes! + bstr_0) + start_0 + end_0))) + (case-lambda + ((imm-bstr_0 + imm-start_0 + imm-end_0) + (let ((r_0 + (let ((enable-break?_1 + (if (not + non-block/buffer?_0) + (break-enabled) + #f))) + (with-continuation-mark* + push-authentic + break-enabled-key + (make-thread-cell + #f) + (begin + (check-for-break) + (begin + (unsafe-end-atomic) + (begin0 + (|#%app| + user-write-out10_0 + imm-bstr_0 + imm-start_0 + imm-end_0 + non-block/buffer?_0 + enable-break?_1) + (unsafe-start-atomic)))))))) + (begin + (check-write-result_0 + #f + '|user port write| + r_0 + imm-start_0 + imm-end_0 + non-block/buffer?_0) + (if (pipe-output-port?* + r_0) + (write-out_0 + self_0 + imm-bstr_0 + imm-start_0 + imm-end_0 + non-block/buffer?_0 + enable-break?_0 + copy?_0) + (if (evt? r_0) (wrap-check-write-evt-result_0 - output-pipe_0 - '|user port write-evt| + '|user port write| r_0 imm-start_0 imm-end_0 - #t))))) - (args - (raise-binding-result-arity-error - 3 - args))))))))) - (let ((write-out-special_0 - (|#%name| - write-out-special - (lambda (self_0 - v_0 - non-block/buffer?_0 - enable-break?_0) - (begin - (let ((enable-break?_1 - (if (not - non-block/buffer?_0) - (break-enabled) - #f))) - (with-continuation-mark* - authentic - break-enabled-key - (make-thread-cell - #f) - (begin - (check-for-break) - (begin - (unsafe-end-atomic) - (begin0 - (|#%app| - user-write-out-special1_0 - v_0 - non-block/buffer?_0 - enable-break?_1) - (unsafe-start-atomic))))))))))) - (let ((get-location_0 - (if user-get-location4_0 - (make-get-location - user-get-location4_0) - #f))) - (let ((count-lines!_0 - (if user-count-lines!5_0 - (|#%name| - count-lines! - (lambda (self_0) + non-block/buffer?_0) + r_0))))) + (args + (raise-binding-result-arity-error + 3 + args)))))))))) + (let ((get-write-evt_0 + (|#%name| + get-write-evt + (lambda (self_0 + bstr_0 + start_0 + end_0) + (begin + (call-with-values + (lambda () + (if (immutable? + bstr_0) + (values + bstr_0 + start_0 + end_0) + (let ((app_0 + (unsafe-bytes->immutable-bytes! + (subbytes + bstr_0 + start_0 + end_0)))) + (values + app_0 + 0 + (- + end_0 + start_0))))) + (case-lambda + ((imm-bstr_0 + imm-start_0 + imm-end_0) + (begin + (unsafe-end-atomic) + (let ((r_0 + (|#%app| + user-get-write-evt2_0 + imm-bstr_0 + imm-start_0 + imm-end_0))) + (begin + (if (evt? + r_0) + (void) + (raise-result-error + '|user port get-write-evt| + "evt?" + r_0)) + (unsafe-start-atomic) + (wrap-check-write-evt-result_0 + '|user port write-evt| + r_0 + imm-start_0 + imm-end_0 + #t))))) + (args + (raise-binding-result-arity-error + 3 + args))))))))) + (let ((write-out-special_0 + (|#%name| + write-out-special + (lambda (self_0 + v_0 + non-block/buffer?_0 + enable-break?_0) + (begin + (let ((enable-break?_1 + (if (not + non-block/buffer?_0) + (break-enabled) + #f))) + (with-continuation-mark* + authentic + break-enabled-key + (make-thread-cell + #f) (begin + (check-for-break) (begin (unsafe-end-atomic) - (|#%app| - user-count-lines!5_0) - (unsafe-start-atomic))))) - #f))) - (call-with-values - (lambda () - (make-init-offset+file-position - user-init-position6_0)) - (case-lambda - ((init-offset_0 - file-position_0) - (let ((buffer-mode_0 - (if user-buffer-mode7_0 - (make-buffer-mode.1 - #t - user-buffer-mode7_0) - #f))) - (let ((close_0 - (|#%name| - close - (lambda (self_0) - (begin - (begin - (unsafe-end-atomic) - (|#%app| - user-close11_0) - (unsafe-start-atomic))))))) - (finish-port/count - (create-core-output-port - (let ((app_0 - (if (1/output-port? - user-write-out10_0) - user-write-out10_0 - write-out_0))) - (let ((app_1 - (if (1/output-port? - user-write-out-special1_0) - user-write-out-special1_0 - (if user-write-out-special1_0 - write-out-special_0 - #f)))) - (let ((app_2 - (if user-get-write-evt2_0 - get-write-evt_0 - #f))) - (core-output-port-methods6.1 - close_0 - count-lines!_0 - get-location_0 - file-position_0 - buffer-mode_0 - app_0 - app_1 - app_2 - (if user-get-write-special-evt3_0 - (lambda (self_0 - v_0) + (begin0 + (|#%app| + user-write-out-special1_0 + v_0 + non-block/buffer?_0 + enable-break?_1) + (unsafe-start-atomic))))))))))) + (let ((get-location_0 + (if user-get-location4_0 + (make-get-location + user-get-location4_0) + #f))) + (let ((count-lines!_0 + (if user-count-lines!5_0 + (|#%name| + count-lines! + (lambda (self_0) + (begin + (begin + (unsafe-end-atomic) + (|#%app| + user-count-lines!5_0) + (unsafe-start-atomic))))) + #f))) + (call-with-values + (lambda () + (make-init-offset+file-position + user-init-position6_0)) + (case-lambda + ((init-offset_0 + file-position_0) + (let ((buffer-mode_0 + (if user-buffer-mode7_0 + (make-buffer-mode.1 + #t + user-buffer-mode7_0) + #f))) + (let ((close_0 + (|#%name| + close + (lambda (self_0) + (begin + (begin + (unsafe-end-atomic) (|#%app| - user-get-write-special-evt3_0 - v_0)) - #f))))) - name8_0 - (direct2.1 + user-close11_0) + (unsafe-start-atomic))))))) + (finish-port/count + (create-core-output-port + (let ((app_0 + (if (1/output-port? + user-write-out10_0) + user-write-out10_0 + write-out_0))) + (let ((app_1 + (if (1/output-port? + user-write-out-special1_0) + user-write-out-special1_0 + (if user-write-out-special1_0 + write-out-special_0 + #f)))) + (let ((app_2 + (if user-get-write-evt2_0 + get-write-evt_0 + #f))) + (core-output-port-methods6.1 + close_0 + count-lines!_0 + get-location_0 + file-position_0 + buffer-mode_0 + app_0 + app_1 + app_2 + (if user-get-write-special-evt3_0 + (lambda (self_0 + v_0) + (|#%app| + user-get-write-special-evt3_0 + v_0)) + #f))))) + name8_0 + (direct2.1 + #f + 0 + 0) #f - 0 - 0) - #f - #f - init-offset_0 - #f - evt9_0 - #f - #f - #f))))) - (args - (raise-binding-result-arity-error - 2 - args))))))))))))))))))))))))))))) + #f + init-offset_0 + #f + evt9_0 + #f + #f + #f))))) + (args + (raise-binding-result-arity-error + 2 + args)))))))))))))))))))))))))))))) (|#%name| make-output-port (case-lambda @@ -29247,47 +28103,46 @@ (define 1/port-print-handler (|#%name| port-print-handler - (letrec ((.../io/port/handler.rkt:118:49_0 - (|#%name| - .../io/port/handler.rkt:118:49 - (lambda (h_0 v27_0 o28_0 w26_0) - (begin (|#%app| h_0 v27_0 o28_0)))))) - (case-lambda - ((o_0) - (begin - (begin - (if (1/output-port? o_0) - (void) - (raise-argument-error 'port-print-handler "output-port?" o_0)) - (let ((o_1 (->core-output-port.1 unsafe-undefined o_0 #f))) - (let ((or-part_0 (core-output-port-print-handler o_1))) - (if or-part_0 or-part_0 default-port-print-handler)))))) - ((o_0 h_0) + (case-lambda + ((o_0) + (begin (begin (if (1/output-port? o_0) (void) (raise-argument-error 'port-print-handler "output-port?" o_0)) - (if (if (procedure? h_0) (procedure-arity-includes? h_0 2) #f) - (void) - (raise-argument-error - 'port-print-handler - "(procedure-arity-includes/c 2)" - h_0)) (let ((o_1 (->core-output-port.1 unsafe-undefined o_0 #f))) - (set-core-output-port-print-handler! - o_1 - (if (eq? h_0 default-port-print-handler) - #f - (if (procedure-arity-includes? h_0 3) - h_0 + (let ((or-part_0 (core-output-port-print-handler o_1))) + (if or-part_0 or-part_0 default-port-print-handler)))))) + ((o_0 h_0) + (begin + (if (1/output-port? o_0) + (void) + (raise-argument-error 'port-print-handler "output-port?" o_0)) + (if (if (procedure? h_0) (procedure-arity-includes? h_0 2) #f) + (void) + (raise-argument-error + 'port-print-handler + "(procedure-arity-includes/c 2)" + h_0)) + (let ((o_1 (->core-output-port.1 unsafe-undefined o_0 #f))) + (set-core-output-port-print-handler! + o_1 + (if (eq? h_0 default-port-print-handler) + #f + (if (procedure-arity-includes? h_0 3) + h_0 + (let ((.../io/port/handler.rkt:118:49_0 + (|#%name| + .../io/port/handler.rkt:118:49 + (lambda (v27_0 o28_0 w26_0) + (begin (|#%app| h_0 v27_0 o28_0)))))) (|#%name| .../io/port/handler.rkt:118:49 (case-lambda ((v_0 o_2) - (begin (.../io/port/handler.rkt:118:49_0 h_0 v_0 o_2 #f))) + (begin (.../io/port/handler.rkt:118:49_0 v_0 o_2 #f))) ((v_0 o_2 w26_0) (.../io/port/handler.rkt:118:49_0 - h_0 v_0 o_2 w26_0)))))))))))))) @@ -29347,34 +28202,29 @@ (define 1/global-port-print-handler (make-parameter default-global-port-print-handler - (letrec ((.../io/port/handler.rkt:145:24_0 - (|#%name| - .../io/port/handler.rkt:145:24 - (lambda (p_0 v35_0 o36_0 quote-depth34_0) - (begin (|#%app| p_0 v35_0 o36_0)))))) - (lambda (p_0) - (begin - (if (if (procedure? p_0) (procedure-arity-includes? p_0 2) #f) - (void) - (raise-argument-error - 'global-port-print-handler - (string-append - "(or/c (->* (any/c output-port?) ((or/c 0 1)) any)\n" - " (any/c output-port? . -> . any))") - p_0)) - (if (procedure-arity-includes? p_0 3) - p_0 + (lambda (p_0) + (begin + (if (if (procedure? p_0) (procedure-arity-includes? p_0 2) #f) + (void) + (raise-argument-error + 'global-port-print-handler + (string-append + "(or/c (->* (any/c output-port?) ((or/c 0 1)) any)\n" + " (any/c output-port? . -> . any))") + p_0)) + (if (procedure-arity-includes? p_0 3) + p_0 + (let ((.../io/port/handler.rkt:145:24_0 + (|#%name| + .../io/port/handler.rkt:145:24 + (lambda (v35_0 o36_0 quote-depth34_0) + (begin (|#%app| p_0 v35_0 o36_0)))))) (|#%name| .../io/port/handler.rkt:145:24 (case-lambda - ((v_0 o_0) - (begin (.../io/port/handler.rkt:145:24_0 p_0 v_0 o_0 0))) + ((v_0 o_0) (begin (.../io/port/handler.rkt:145:24_0 v_0 o_0 0))) ((v_0 o_0 quote-depth34_0) - (.../io/port/handler.rkt:145:24_0 - p_0 - v_0 - o_0 - quote-depth34_0)))))))) + (.../io/port/handler.rkt:145:24_0 v_0 o_0 quote-depth34_0)))))))) 'global-port-print-handler)) (define effect_2170 (begin @@ -29642,102 +28492,93 @@ (lambda (proc_0) (set! simplify-path/dl proc_0))) (define 1/directory-list (let ((directory-list_0 - (letrec ((procz1 - (lambda (dl_0) - (|#%app| - rktio_directory_list_stop - (unsafe-place-local-ref cell.1) - dl_0)))) - (|#%name| - directory-list - (lambda (p3_0) - (begin - (let ((p_0 - (if (eq? p3_0 unsafe-undefined) - (current-directory$1) - p3_0))) - (begin - (if (path-string? p_0) - (void) - (raise-argument-error - 'directory-list - "path-string?" - p_0)) - (let ((host-path/initial_0 - (->host p_0 'directory-list '(read)))) - (let ((host-path_0 - (let ((tmp_0 (system-type))) - (if (eq? tmp_0 'windows) - (->host - (let ((app_0 simplify-path/dl)) - (|#%app| - app_0 - (host-> host-path/initial_0))) - #f - '()) - host-path/initial_0)))) - (begin - (unsafe-start-atomic) - (begin0 - (call-with-resource + (|#%name| + directory-list + (lambda (p3_0) + (begin + (let ((p_0 + (if (eq? p3_0 unsafe-undefined) + (current-directory$1) + p3_0))) + (begin + (if (path-string? p_0) + (void) + (raise-argument-error 'directory-list "path-string?" p_0)) + (let ((host-path/initial_0 + (->host p_0 'directory-list '(read)))) + (let ((host-path_0 + (let ((tmp_0 (system-type))) + (if (eq? tmp_0 'windows) + (->host + (let ((app_0 simplify-path/dl)) + (|#%app| app_0 (host-> host-path/initial_0))) + #f + '()) + host-path/initial_0)))) + (begin + (unsafe-start-atomic) + (begin0 + (call-with-resource + (|#%app| + rktio_directory_list_start + (unsafe-place-local-ref cell.1) + host-path_0) + (lambda (dl_0) (|#%app| - rktio_directory_list_start + rktio_directory_list_stop (unsafe-place-local-ref cell.1) - host-path_0) - procz1 - (lambda (dl_0) - (if (vector? dl_0) - (begin - (unsafe-end-atomic) - (raise-filesystem-error - 'directory-list - dl_0 - (let ((app_0 - (string-append - "could not open directory\n" - " path: ~a"))) - (1/format app_0 (host-> host-path_0))))) - (begin - (unsafe-end-atomic) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (accum_0) + dl_0)) + (lambda (dl_0) + (if (vector? dl_0) + (begin + (unsafe-end-atomic) + (raise-filesystem-error + 'directory-list + dl_0 + (let ((app_0 + (string-append + "could not open directory\n" + " path: ~a"))) + (1/format app_0 (host-> host-path_0))))) + (begin + (unsafe-end-atomic) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (accum_0) + (begin (begin - (begin - (unsafe-start-atomic) - (let ((fnp_0 - (|#%app| - rktio_directory_list_step - (unsafe-place-local-ref - cell.1) - dl_0))) - (let ((fn_0 - (if (vector? fnp_0) - fnp_0 - (|#%app| - rktio_to_bytes - fnp_0)))) - (if (vector? fn_0) + (unsafe-start-atomic) + (let ((fnp_0 + (|#%app| + rktio_directory_list_step + (unsafe-place-local-ref + cell.1) + dl_0))) + (let ((fn_0 + (if (vector? fnp_0) + fnp_0 + (|#%app| + rktio_to_bytes + fnp_0)))) + (if (vector? fn_0) + (begin + (unsafe-end-atomic) + (check-rktio-error + fn_0 + "error reading directory")) + (if (equal? fn_0 #vu8()) + accum_0 (begin + (|#%app| rktio_free fnp_0) (unsafe-end-atomic) - (check-rktio-error - fn_0 - "error reading directory")) - (if (equal? fn_0 #vu8()) - accum_0 - (begin - (|#%app| - rktio_free - fnp_0) - (unsafe-end-atomic) - (loop_0 - (cons - (host-element-> fn_0) - accum_0))))))))))))) - (loop_0 null)))))) - (unsafe-end-atomic))))))))))))) + (loop_0 + (cons + (host-element-> fn_0) + accum_0))))))))))))) + (loop_0 null)))))) + (unsafe-end-atomic)))))))))))) (|#%name| directory-list (case-lambda @@ -29964,95 +28805,91 @@ r_0))))))))) (define 1/file-or-directory-permissions (let ((file-or-directory-permissions_0 - (letrec ((set?_0 - (|#%name| - set? - (lambda (r_0 n_0) - (begin (eqv? n_0 (bitwise-and r_0 n_0))))))) - (|#%name| - file-or-directory-permissions - (lambda (p8_0 mode7_0) + (|#%name| + file-or-directory-permissions + (lambda (p8_0 mode7_0) + (begin (begin + (if (path-string? p8_0) + (void) + (raise-argument-error + 'file-or-directory-permissions + "path-string?" + p8_0)) (begin - (if (path-string? p8_0) + (if (let ((or-part_0 (not mode7_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (eq? mode7_0 'bits))) + (if or-part_1 + or-part_1 + (if (exact-integer? mode7_0) + (<= 0 mode7_0 65535) + #f))))) (void) (raise-argument-error 'file-or-directory-permissions - "path-string?" - p8_0)) - (begin - (if (let ((or-part_0 (not mode7_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (eq? mode7_0 'bits))) - (if or-part_1 - or-part_1 - (if (exact-integer? mode7_0) - (<= 0 mode7_0 65535) - #f))))) - (void) - (raise-argument-error - 'file-or-directory-permissions - "(or/c #f 'bits (integer-in 0 65535))" - mode7_0)) - (let ((host-path_0 - (->host - p8_0 - 'file-or-directory-permissions - (if (integer? mode7_0) '(write) '(read))))) - (let ((r_0 - (if (integer? mode7_0) - (|#%app| - rktio_set_file_or_directory_permissions - (unsafe-place-local-ref cell.1) - host-path_0 - mode7_0) - (|#%app| - rktio_get_file_or_directory_permissions - (unsafe-place-local-ref cell.1) - host-path_0 - (eq? mode7_0 'bits))))) - (begin - (if (vector? r_0) - (raise-filesystem-error - 'file-or-directory-permissions - r_0 - (let ((app_0 - (string-append - "~a failed~a\n" - " path: ~a~a"))) - (let ((app_1 - (if (integer? mode7_0) - "update" - "access"))) - (let ((app_2 - (if (racket-error? r_0 4) - ";\n unsupported bit combination" - ""))) - (let ((app_3 (host-> host-path_0))) - (1/format - app_0 - app_1 - app_2 - app_3 + "(or/c #f 'bits (integer-in 0 65535))" + mode7_0)) + (let ((host-path_0 + (->host + p8_0 + 'file-or-directory-permissions + (if (integer? mode7_0) '(write) '(read))))) + (let ((r_0 + (if (integer? mode7_0) + (|#%app| + rktio_set_file_or_directory_permissions + (unsafe-place-local-ref cell.1) + host-path_0 + mode7_0) + (|#%app| + rktio_get_file_or_directory_permissions + (unsafe-place-local-ref cell.1) + host-path_0 + (eq? mode7_0 'bits))))) + (begin + (if (vector? r_0) + (raise-filesystem-error + 'file-or-directory-permissions + r_0 + (let ((app_0 + (string-append + "~a failed~a\n" + " path: ~a~a"))) + (let ((app_1 + (if (integer? mode7_0) "update" "access"))) + (let ((app_2 (if (racket-error? r_0 4) - (1/format - "\n permission value: ~a" - mode7_0) - ""))))))) - (void)) - (if (integer? mode7_0) - (void) - (if (eq? 'bits mode7_0) - r_0 - (let ((l_0 - (if (set?_0 r_0 4) (cons 'read '()) '()))) + ";\n unsupported bit combination" + ""))) + (let ((app_3 (host-> host-path_0))) + (1/format + app_0 + app_1 + app_2 + app_3 + (if (racket-error? r_0 4) + (1/format + "\n permission value: ~a" + mode7_0) + ""))))))) + (void)) + (if (integer? mode7_0) + (void) + (if (eq? 'bits mode7_0) + r_0 + (let ((set?_0 + (|#%name| + set? + (lambda (n_0) + (begin + (eqv? n_0 (bitwise-and r_0 n_0))))))) + (let ((l_0 (if (set?_0 4) (cons 'read '()) '()))) (let ((l_1 - (if (set?_0 r_0 2) - (cons 'write l_0) - l_0))) + (if (set?_0 2) (cons 'write l_0) l_0))) (let ((l_2 - (if (set?_0 r_0 1) + (if (set?_0 1) (cons 'execute l_1) l_1))) l_2)))))))))))))))) @@ -30125,44 +28962,41 @@ r_0))))))))))) (define 1/copy-file (let ((copy-file_0 - (letrec ((report-error_0 - (|#%name| - report-error - (lambda (dest-host_0 src-host_0 r_0) - (begin - (raise-filesystem-error - 'copy-file - r_0 - (let ((app_0 - (string-append - "~a\n" - " source path: ~a\n" - " destination path: ~a"))) - (let ((app_1 (copy-file-step-string r_0))) - (let ((app_2 (host-> src-host_0))) - (1/format - app_0 - app_1 - app_2 - (host-> dest-host_0))))))))))) - (|#%name| - copy-file - (lambda (src12_0 dest13_0 exists-ok?11_0) + (|#%name| + copy-file + (lambda (src12_0 dest13_0 exists-ok?11_0) + (begin (begin + (if (path-string? src12_0) + (void) + (raise-argument-error 'copy-file "path-string?" src12_0)) (begin - (if (path-string? src12_0) + (if (path-string? dest13_0) (void) - (raise-argument-error 'copy-file "path-string?" src12_0)) - (begin - (if (path-string? dest13_0) - (void) - (raise-argument-error - 'copy-file - "path-string?" - dest13_0)) - (let ((src-host_0 (->host src12_0 'copy-file '(read)))) - (let ((dest-host_0 - (->host dest13_0 'copy-file '(write delete)))) + (raise-argument-error 'copy-file "path-string?" dest13_0)) + (let ((src-host_0 (->host src12_0 'copy-file '(read)))) + (let ((dest-host_0 + (->host dest13_0 'copy-file '(write delete)))) + (let ((report-error_0 + (|#%name| + report-error + (lambda (r_0) + (begin + (raise-filesystem-error + 'copy-file + r_0 + (let ((app_0 + (string-append + "~a\n" + " source path: ~a\n" + " destination path: ~a"))) + (let ((app_1 (copy-file-step-string r_0))) + (let ((app_2 (host-> src-host_0))) + (1/format + app_0 + app_1 + app_2 + (host-> dest-host_0))))))))))) (begin (unsafe-start-atomic) (let ((cp_0 @@ -30173,9 +29007,7 @@ src-host_0 exists-ok?11_0))) (if (vector? cp_0) - (begin - (unsafe-end-atomic) - (report-error_0 dest-host_0 src-host_0 cp_0)) + (begin (unsafe-end-atomic) (report-error_0 cp_0)) (begin (|#%app| thread-push-kill-callback! @@ -30207,10 +29039,7 @@ cell.1) cp_0))) (if (vector? r_0) - (report-error_0 - dest-host_0 - src-host_0 - r_0) + (report-error_0 r_0) (void))) (let ((r_0 (|#%app| @@ -30220,10 +29049,7 @@ cp_0))) (begin (if (vector? r_0) - (report-error_0 - dest-host_0 - src-host_0 - r_0) + (report-error_0 r_0) (void)) (loop_0))))))))) (loop_0)))) @@ -30433,109 +29259,97 @@ ((p-in_0 use-filesystem?1_0) (simplify-path_0 p-in_0 use-filesystem?1_0)))))) (define use-filesystem - (letrec ((combine_0 - (|#%name| - combine - (lambda (base_0 accum_0) - (begin - (if (null? accum_0) - base_0 - (apply 1/build-path base_0 (1/reverse accum_0))))))) - (loop_0 - (|#%name| - loop - (lambda (who_0 l_0 base_0 accum_0 seen_0) - (begin - (if (null? l_0) - (combine_0 base_0 accum_0) - (if (eq? 'same (car l_0)) - (loop_0 who_0 (cdr l_0) base_0 accum_0 seen_0) - (if (eq? 'up (car l_0)) - (let ((new-base_0 (combine_0 base_0 accum_0))) - (let ((target_0 - (begin-unsafe - (do-resolve-path new-base_0 'simplify-path)))) + (lambda (who_0 l_0) + (let ((combine_0 + (|#%name| + combine + (lambda (base_0 accum_0) + (begin + (if (null? accum_0) + base_0 + (apply 1/build-path base_0 (1/reverse accum_0)))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1 base_0 accum_0 seen_0) + (begin + (if (null? l_1) + (combine_0 base_0 accum_0) + (if (eq? 'same (car l_1)) + (loop_0 (cdr l_1) base_0 accum_0 seen_0) + (if (eq? 'up (car l_1)) + (let ((new-base_0 (combine_0 base_0 accum_0))) + (let ((target_0 + (begin-unsafe + (do-resolve-path new-base_0 'simplify-path)))) + (call-with-values + (lambda () + (if (eq? target_0 new-base_0) + (values new-base_0 seen_0) + (let ((from-base_0 + (if (1/complete-path? target_0) + target_0 + (call-with-values + (lambda () (1/split-path new-base_0)) + (case-lambda + ((base-dir_0 name_0 dir?_0) + (path->complete-path.1 + #t + target_0 + base-dir_0)) + (args + (raise-binding-result-arity-error + 3 + args))))))) + (begin + (if (hash-ref seen_0 from-base_0 #f) + (raise + (let ((app_0 + (let ((app_0 + (symbol->string who_0))) + (string-append + app_0 + ": cycle detected at link" + "\n link path: " + (path->string new-base_0))))) + (|#%app| + exn:fail:filesystem + app_0 + (current-continuation-marks)))) + (void)) + (values + from-base_0 + (hash-set seen_0 from-base_0 #t)))))) + (case-lambda + ((from-base_0 new-seen_0) (call-with-values - (lambda () - (if (eq? target_0 new-base_0) - (values new-base_0 seen_0) - (let ((from-base_0 - (if (1/complete-path? target_0) - target_0 - (call-with-values - (lambda () (1/split-path new-base_0)) - (case-lambda - ((base-dir_0 name_0 dir?_0) - (path->complete-path.1 - #t - target_0 - base-dir_0)) - (args - (raise-binding-result-arity-error - 3 - args))))))) - (begin - (if (hash-ref seen_0 from-base_0 #f) - (raise - (let ((app_0 - (let ((app_0 - (symbol->string who_0))) - (string-append - app_0 - ": cycle detected at link" - "\n link path: " - (path->string new-base_0))))) - (|#%app| - exn:fail:filesystem - app_0 - (current-continuation-marks)))) - (void)) - (values - from-base_0 - (hash-set seen_0 from-base_0 #t)))))) + (lambda () (1/split-path from-base_0)) (case-lambda - ((from-base_0 new-seen_0) - (call-with-values - (lambda () (1/split-path from-base_0)) - (case-lambda - ((next-base_0 name_0 dir?_0) - (if (not next-base_0) - (loop_0 - who_0 - (cdr l_0) - from-base_0 - '() - new-seen_0) - (loop_0 - who_0 - (cdr l_0) - next-base_0 - '() - new-seen_0))) - (args - (raise-binding-result-arity-error 3 args))))) + ((next-base_0 name_0 dir?_0) + (if (not next-base_0) + (loop_0 (cdr l_1) from-base_0 '() new-seen_0) + (loop_0 (cdr l_1) next-base_0 '() new-seen_0))) (args - (raise-binding-result-arity-error 2 args)))))) - (let ((app_0 (cdr l_0))) - (loop_0 - who_0 - app_0 - base_0 - (cons (car l_0) accum_0) - seen_0)))))))))) - (lambda (who_0 l_0) - (let ((app_0 (if (1/path? (car l_0)) (cdr l_0) l_0))) - (loop_0 - who_0 - app_0 - (if (1/path? (car l_0)) - (let ((temp6_0 (car l_0))) - (let ((temp7_0 (current-directory$1))) - (let ((temp6_1 temp6_0)) - (path->complete-path.1 #t temp6_1 temp7_0)))) - (current-directory$1)) - '() - hash2725))))) + (raise-binding-result-arity-error 3 args))))) + (args (raise-binding-result-arity-error 2 args)))))) + (let ((app_0 (cdr l_1))) + (loop_0 + app_0 + base_0 + (cons (car l_1) accum_0) + seen_0)))))))))) + (let ((app_0 (if (1/path? (car l_0)) (cdr l_0) l_0))) + (loop_0 + app_0 + (if (1/path? (car l_0)) + (let ((temp6_0 (car l_0))) + (let ((temp7_0 (current-directory$1))) + (let ((temp6_1 temp6_0)) + (path->complete-path.1 #t temp6_1 temp7_0)))) + (current-directory$1)) + '() + hash2725)))))) (define effect_2315 (begin (void (begin-unsafe (set! simplify-path/dl 1/simplify-path))) (void))) (define bytes-no-nuls? @@ -30915,20 +29729,21 @@ (let ((ht_0 (environment-variables-ht e_0))) (if (not ht_0) (1/environment-variables-names (1/environment-variables-copy e_0)) - (map_2960 car (hash-values ht_0))))))))) + (map_1346 car (hash-values ht_0))))))))) (define 1/find-system-path - (letrec ((procz1 (lambda () 0)) - (as-dir_0 - (|#%name| - as-dir - (lambda (p_0) (begin (1/path->directory-path p_0)))))) - (|#%name| - find-system-path - (lambda (key_0) - (begin + (|#%name| + find-system-path + (lambda (key_0) + (begin + (let ((as-dir_0 + (|#%name| + as-dir + (lambda (p_0) (begin (1/path->directory-path p_0)))))) (begin0 (let ((index_0 - (if (symbol? key_0) (hash-ref hash2702 key_0 procz1) 0))) + (if (symbol? key_0) + (hash-ref hash2702 key_0 (lambda () 0)) + 0))) (if (unsafe-fx< index_0 9) (if (unsafe-fx< index_0 4) (if (unsafe-fx< index_0 1) @@ -31375,19 +30190,19 @@ #f))))) (define path-element? (lambda (p_0) (if (path-element-clean.1 #t p_0) #t #f))) (define do-bytes->path-element - (letrec ((bad-element_0 - (|#%name| - bad-element - (lambda (orig-arg_0 who_0) - (begin - (raise-arguments-error - who_0 - "cannot be converted to a path element" - "path" - orig-arg_0 - "explanation" - "path can be split, is not relative, or names a special element")))))) - (lambda (bstr_0 convention_0 who_0 orig-arg_0) + (lambda (bstr_0 convention_0 who_0 orig-arg_0) + (let ((bad-element_0 + (|#%name| + bad-element + (lambda () + (begin + (raise-arguments-error + who_0 + "cannot be converted to a path element" + "path" + orig-arg_0 + "explanation" + "path can be split, is not relative, or names a special element")))))) (begin (if (eq? 'windows convention_0) (if (call-with-values @@ -31418,7 +30233,7 @@ result_0)))))) (for-loop_0 #f 0)))) (args (raise-binding-result-arity-error 2 args)))) - (bad-element_0 orig-arg_0 who_0) + (bad-element_0) (void)) (void)) (let ((len_0 (unsafe-bytes-length bstr_0))) @@ -31428,9 +30243,7 @@ (bytes->immutable-bytes bstr_0) convention_0) convention_0))) - (begin - (if (path-element? p_0) (void) (bad-element_0 orig-arg_0 who_0)) - p_0))))))) + (begin (if (path-element? p_0) (void) (bad-element_0)) p_0))))))) (define 1/path-element->string (|#%name| path-element->string @@ -31734,10 +30547,16 @@ (raise-argument-error 'string-locale-downcase "string?" s_0)) (recase.1 #f s_0)))))) (define recase.1 - (letrec ((loop_0 + (|#%name| + recase + (lambda (up?1_0 s3_0) + (begin + (let ((len_0 (string-length s3_0))) + (letrec* + ((loop_0 (|#%name| loop - (lambda (len_0 s3_0 up?1_0 pos_0) + (lambda (pos_0) (begin (let ((i-len_0 (fx+ @@ -31756,94 +30575,92 @@ (recase/no-nul (substring s3_0 pos_0 i-len_0) up?1_0))) - (let ((r_0 (loop_0 len_0 s3_0 up?1_0 (fx+ i-len_0 1)))) + (let ((r_0 (loop_0 (fx+ i-len_0 1)))) (if (eqv? pos_0 0) (apply string-append new-s_0 (string '#\x0) r_0) (cons new-s_0 (cons (string '#\x0) r_0)))))))))))) - (|#%name| - recase - (lambda (up?1_0 s3_0) - (begin - (let ((len_0 (string-length s3_0))) (loop_0 len_0 s3_0 up?1_0 0))))))) + (loop_0 0))))))) (define recase/no-nul - (letrec ((loop_0 - (|#%name| - loop - (lambda (c_0 in-bstr_0 s_0 up?_0 pos_0) - (begin - (if (fx= pos_0 (unsafe-bytes-length in-bstr_0)) - (if (eqv? pos_0 0) "" '("")) - (call-with-values - (lambda () - (1/bytes-convert (unsafe-unbox* c_0) in-bstr_0 pos_0)) - (case-lambda - ((bstr_0 in-used_0 status_0) - (begin - (unsafe-start-atomic) - (begin - (sync-locale!) - (let ((sr_0 (locale-recase.1 up?_0 bstr_0))) + (lambda (s_0 up?_0) + (if (if (equal? (1/current-locale) "") + (not + (fx= + 0 + (fxand + (|#%app| rktio_convert_properties (unsafe-place-local-ref cell.1)) + 4))) + #f) + (let ((s-16_0 (utf-16-encode s_0))) + (begin + (unsafe-start-atomic) + (let ((r_0 + (|#%app| + rktio_recase_utf16 + (unsafe-place-local-ref cell.1) + up?_0 + s-16_0 + (fxrshift (unsafe-bytes-length s-16_0) 1) + #f))) + (let ((sr_0 (|#%app| rktio_to_shorts r_0))) + (begin + (|#%app| rktio_free r_0) + (unsafe-end-atomic) + (utf-16-decode sr_0)))))) + (let ((c_0 #f)) + (let ((in-bstr_0 (string->bytes/ucs-4 s_0 0 (string-length s_0)))) + (let ((enc_0 (1/locale-string-encoding))) + (dynamic-wind + (lambda () (set! c_0 (bytes-open-converter/cached-to enc_0))) + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_0) + (begin + (if (fx= pos_0 (unsafe-bytes-length in-bstr_0)) + (if (eqv? pos_0 0) "" '("")) + (call-with-values + (lambda () (1/bytes-convert c_0 in-bstr_0 pos_0)) + (case-lambda + ((bstr_0 in-used_0 status_0) (begin - (unsafe-end-atomic) - (let ((ls_0 (1/bytes->string/locale sr_0))) - (if (eq? status_0 'complete) - (if (eqv? pos_0 0) ls_0 (list ls_0)) - (let ((r_0 - (loop_0 - c_0 - in-bstr_0 - s_0 - up?_0 - (fx+ pos_0 in-used_0 4)))) - (let ((err-s_0 - (string - (string-ref - s_0 - (fxrshift - (+ pos_0 in-used_0) - 2))))) - (if (eqv? pos_0 0) - (apply string-append ls_0 err-s_0 r_0) - (list* ls_0 err-s_0 r_0))))))))))) - (args (raise-binding-result-arity-error 3 args)))))))))) - (lambda (s_0 up?_0) - (if (if (equal? (1/current-locale) "") - (not - (fx= - 0 - (fxand - (|#%app| - rktio_convert_properties - (unsafe-place-local-ref cell.1)) - 4))) - #f) - (let ((s-16_0 (utf-16-encode s_0))) - (begin - (unsafe-start-atomic) - (let ((r_0 - (|#%app| - rktio_recase_utf16 - (unsafe-place-local-ref cell.1) - up?_0 - s-16_0 - (fxrshift (unsafe-bytes-length s-16_0) 1) - #f))) - (let ((sr_0 (|#%app| rktio_to_shorts r_0))) - (begin - (|#%app| rktio_free r_0) - (unsafe-end-atomic) - (utf-16-decode sr_0)))))) - (let ((c_0 (box #f))) - (let ((in-bstr_0 (string->bytes/ucs-4 s_0 0 (string-length s_0)))) - (let ((enc_0 (1/locale-string-encoding))) - (dynamic-wind - (lambda () - (unsafe-set-box*! c_0 (bytes-open-converter/cached-to enc_0))) - (lambda () (loop_0 c_0 in-bstr_0 s_0 up?_0 0)) - (lambda () - (let ((c_1 (unsafe-unbox* c_0))) - (begin-unsafe - (cache-save! c_1 enc_0 cache-to set-cache-to!)))))))))))) + (unsafe-start-atomic) + (begin + (sync-locale!) + (let ((sr_0 (locale-recase.1 up?_0 bstr_0))) + (begin + (unsafe-end-atomic) + (let ((ls_0 (1/bytes->string/locale sr_0))) + (if (eq? status_0 'complete) + (if (eqv? pos_0 0) ls_0 (list ls_0)) + (let ((r_0 + (loop_0 + (fx+ pos_0 in-used_0 4)))) + (let ((err-s_0 + (string + (string-ref + s_0 + (fxrshift + (+ pos_0 in-used_0) + 2))))) + (if (eqv? pos_0 0) + (apply + string-append + ls_0 + err-s_0 + r_0) + (list* + ls_0 + err-s_0 + r_0))))))))))) + (args + (raise-binding-result-arity-error 3 args)))))))))) + (loop_0 0))) + (lambda () + (let ((c_1 c_0)) + (begin-unsafe + (cache-save! c_1 enc_0 cache-to set-cache-to!))))))))))) (define locale-recase.1 (|#%name| locale-recase @@ -31955,227 +30772,187 @@ (loop_0 app_0 (+ t-l2_0 1))))))))))))))) (loop_0 0 0)))))) (define collate/no-nul - (letrec ((check-one-byte_0 - (|#%name| - check-one-byte - (lambda (c1_0 - c2_0 - ci?_0 - in-bstr1_0 - in-bstr2_0 - new-pos1_0 - new-pos2_0 - s1_0 - s2_0) - (begin - (let ((ch1_0 - (string-ref s1_0 (arithmetic-shift new-pos1_0 -2)))) - (let ((ch2_0 - (string-ref s2_0 (arithmetic-shift new-pos2_0 -2)))) - (if (charbytes/ucs-4 s1_0 0 (string-length s1_0)))) - (let ((in-bstr2_0 - (string->bytes/ucs-4 s2_0 0 (string-length s2_0)))) - (let ((enc_0 (1/locale-string-encoding))) - (dynamic-wind - (lambda () - (begin - (unsafe-set-box*! - c1_0 - (bytes-open-converter/cached-to enc_0)) - (unsafe-set-box*! - c2_0 - (bytes-open-converter/cached-to2 enc_0)))) - (lambda () - (loop_0 - c1_0 - c2_0 - ci?_0 - in-bstr1_0 - in-bstr2_0 - s1_0 - s2_0 - 0 - 0 - (unsafe-bytes-length in-bstr1_0) - (unsafe-bytes-length in-bstr2_0))) - (lambda () - (begin - (let ((c_0 (unsafe-unbox* c1_0))) - (begin-unsafe - (cache-save! c_0 enc_0 cache-to set-cache-to!))) - (let ((c_0 (unsafe-unbox* c2_0))) - (begin-unsafe - (cache-save! - c_0 - enc_0 - cache-to_3068 - set-cache-to2!))))))))))))))) + (lambda (s1_0 s2_0 ci?_0) + (if (if (equal? (1/current-locale) "") + (not + (zero? + (bitwise-and + (|#%app| rktio_convert_properties (unsafe-place-local-ref cell.1)) + 2))) + #f) + (let ((s1-16_0 (utf-16-encode s1_0))) + (let ((s2-16_0 (utf-16-encode s2_0))) + (let ((app_0 (arithmetic-shift (unsafe-bytes-length s1-16_0) -1))) + (|#%app| + rktio_strcoll_utf16 + (unsafe-place-local-ref cell.1) + s1-16_0 + app_0 + s2-16_0 + (arithmetic-shift (unsafe-bytes-length s2-16_0) -1) + ci?_0)))) + (let ((c1_0 #f)) + (let ((c2_0 #f)) + (let ((in-bstr1_0 (string->bytes/ucs-4 s1_0 0 (string-length s1_0)))) + (let ((in-bstr2_0 + (string->bytes/ucs-4 s2_0 0 (string-length s2_0)))) + (let ((enc_0 (1/locale-string-encoding))) + (dynamic-wind + (lambda () + (begin + (set! c1_0 (bytes-open-converter/cached-to enc_0)) + (set! c2_0 (bytes-open-converter/cached-to2 enc_0)))) + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos1_0 pos2_0 end1_0 end2_0) + (begin + (call-with-values + (lambda () + (1/bytes-convert c1_0 in-bstr1_0 pos1_0 end1_0)) + (case-lambda + ((bstr1_0 in-used1_0 status1_0) + (call-with-values + (lambda () + (1/bytes-convert + c2_0 + in-bstr2_0 + pos2_0 + end2_0)) + (case-lambda + ((bstr2_0 in-used2_0 status2_0) + (let ((new-pos1_0 (+ in-used1_0 pos1_0))) + (let ((new-pos2_0 (+ in-used2_0 pos2_0))) + (let ((done1?_0 (= new-pos1_0 end1_0))) + (let ((done2?_0 (= new-pos2_0 end2_0))) + (let ((check-one-byte_0 + (|#%name| + check-one-byte + (lambda () + (begin + (let ((ch1_0 + (string-ref + s1_0 + (arithmetic-shift + new-pos1_0 + -2)))) + (let ((ch2_0 + (string-ref + s2_0 + (arithmetic-shift + new-pos2_0 + -2)))) + (if (charstring-handler! - (letrec ((procz1 - (|#%name| - default-error-value->string-handler - (lambda (v_0 len_0) - (begin - (begin - (if (exact-nonnegative-integer? len_0) - (void) - (raise-argument-error - 'default-error-value->string-handler - "exact-nonnegative-integer?" - len_0)) - (let ((o_0 (1/open-output-string))) - (begin - (|#%app| - do-global-print - 'default-error-value->string-handler - v_0 - o_0 - 0 - len_0) - (1/get-output-string o_0))))))))) - (lambda () (error-value->string-handler procz1)))) + (lambda () + (error-value->string-handler + (|#%name| + default-error-value->string-handler + (lambda (v_0 len_0) + (begin + (begin + (if (exact-nonnegative-integer? len_0) + (void) + (raise-argument-error + 'default-error-value->string-handler + "exact-nonnegative-integer?" + len_0)) + (let ((o_0 (1/open-output-string))) + (begin + (|#%app| + do-global-print + 'default-error-value->string-handler + v_0 + o_0 + 0 + len_0) + (1/get-output-string o_0)))))))))) (define effect_2767 (begin (void (install-error-value->string-handler!)) (void))) (define relative-to-user-directory @@ -33515,264 +32292,246 @@ (update-logger-wanted-level! logger_0 #f) (logger-max-receiver-level logger_0))))) (define update-logger-wanted-level! - (letrec ((for-loop_0 - (|#%name| - for-loop - (lambda (ceiling-level_0 - topic-ceiling-level_0 - topic_0 - max-level_0 - topic-max-level_0 - lst_0) - (begin - (if (pair? lst_0) - (let ((r_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (if (if (begin-unsafe - (let ((app_0 (level->value max-level_0))) - (>= app_0 (level->value ceiling-level_0)))) - (let ((or-part_0 (not topic_0))) - (if or-part_0 - or-part_0 - (begin-unsafe - (let ((app_0 - (level->value topic-max-level_0))) - (>= - app_0 - (level->value ceiling-level_0)))))) - #f) - (values max-level_0 topic-max-level_0) - (call-with-values - (lambda () - (let ((app_0 - (level-max - max-level_0 - (level-min - (filters-max-level - (log-receiver-filters r_0)) - ceiling-level_0)))) - (values - app_0 - (if topic_0 - (level-max - topic-max-level_0 - (level-min - (filters-level-for-topic - (log-receiver-filters r_0) - topic_0) - topic-ceiling-level_0)) - #f)))) - (case-lambda - ((max-level_1 topic-max-level_1) - (begin-unsafe - (begin - (for-loop_0 - ceiling-level_0 - topic-ceiling-level_0 - topic_0 - max-level_1 - topic-max-level_1 - rest_0)))) - (args - (raise-binding-result-arity-error 2 args))))))) - (values max-level_0 topic-max-level_0)))))) - (next-k-proc_0 - (|#%name| - next-k-proc - (lambda (ceiling-level_0 - rest_0 - topic-ceiling-level_0 - topic_0 - max-level_0 - topic-max-level_0) - (begin - (for-loop_0 - ceiling-level_0 - topic-ceiling-level_0 - topic_0 - max-level_0 - topic-max-level_0 - rest_0)))))) - (lambda (logger_0 topic_0) - (begin - (if (let ((app_0 (logger-local-level-timestamp logger_0))) - (>= app_0 (unbox (logger-root-level-timestamp-box logger_0)))) - (void) - (let ((cache_0 (logger-topic-level-cache logger_0))) - (begin - (let ((end_0 (vector-length cache_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (< pos_0 end_0) - (begin - (vector-set! cache_0 pos_0 #f) - (for-loop_1 (+ pos_0 2))) - (values))))))) - (for-loop_1 0)))) - (void) - (set-logger-local-level-timestamp! - logger_0 - (unbox (logger-root-level-timestamp-box logger_0)))))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (parent_0 - ceiling-level_0 - old-max-level_0 - topic-ceiling-level_0 - old-topic-max-level_0) + (lambda (logger_0 topic_0) + (begin + (if (let ((app_0 (logger-local-level-timestamp logger_0))) + (>= app_0 (unbox (logger-root-level-timestamp-box logger_0)))) + (void) + (let ((cache_0 (logger-topic-level-cache logger_0))) + (begin + (let ((end_0 (vector-length cache_0))) (begin - (call-with-values - (lambda () - (let ((lst_0 (logger-receivers parent_0))) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (< pos_0 end_0) + (begin + (vector-set! cache_0 pos_0 #f) + (for-loop_0 (+ pos_0 2))) + (values))))))) + (for-loop_0 0)))) + (void) + (set-logger-local-level-timestamp! + logger_0 + (unbox (logger-root-level-timestamp-box logger_0)))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (parent_0 + ceiling-level_0 + old-max-level_0 + topic-ceiling-level_0 + old-topic-max-level_0) + (begin + (call-with-values + (lambda () + (let ((lst_0 (logger-receivers parent_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (max-level_0 topic-max-level_0 lst_1) + (begin + (if (pair? lst_1) + (let ((r_0 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (let ((next-k-proc_0 + (|#%name| + next-k-proc + (lambda (max-level_1 + topic-max-level_1) + (begin + (for-loop_0 + max-level_1 + topic-max-level_1 + rest_0)))))) + (if (if (begin-unsafe + (let ((app_0 + (level->value + max-level_0))) + (>= + app_0 + (level->value + ceiling-level_0)))) + (let ((or-part_0 (not topic_0))) + (if or-part_0 + or-part_0 + (begin-unsafe + (let ((app_0 + (level->value + topic-max-level_0))) + (>= + app_0 + (level->value + ceiling-level_0)))))) + #f) + (values max-level_0 topic-max-level_0) + (call-with-values + (lambda () + (let ((app_0 + (level-max + max-level_0 + (level-min + (filters-max-level + (log-receiver-filters r_0)) + ceiling-level_0)))) + (values + app_0 + (if topic_0 + (level-max + topic-max-level_0 + (level-min + (filters-level-for-topic + (log-receiver-filters r_0) + topic_0) + topic-ceiling-level_0)) + #f)))) + (case-lambda + ((max-level_1 topic-max-level_1) + (begin-unsafe + (begin + (for-loop_0 + max-level_1 + topic-max-level_1 + rest_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (values max-level_0 topic-max-level_0))))))) + (for-loop_0 + old-max-level_0 + old-topic-max-level_0 + lst_0))))) + (case-lambda + ((max-level_0 topic-max-level_0) + (let ((c1_0 + (if (let ((or-part_0 + (begin-unsafe + (let ((app_0 + (level->value ceiling-level_0))) + (>= app_0 (level->value max-level_0)))))) + (if or-part_0 + or-part_0 + (if topic_0 + (begin-unsafe + (let ((app_0 + (level->value ceiling-level_0))) + (>= + app_0 + (level->value topic-max-level_0)))) + #f))) + (logger-parent parent_0) + #f))) + (if c1_0 + (let ((filters_0 (logger-propagate-filters parent_0))) + (let ((ceiling-level_1 + (level-min + ceiling-level_0 + (filters-max-level filters_0)))) + (let ((topic-ceiling-level_1 + (if topic_0 + (level-min + topic-ceiling-level_0 + (filters-level-for-topic filters_0 topic_0)) + topic-ceiling-level_0))) + (let ((ceiling-level_2 ceiling-level_1)) + (loop_0 + c1_0 + ceiling-level_2 + max-level_0 + topic-ceiling-level_1 + topic-max-level_0))))) (begin - (for-loop_0 - ceiling-level_0 - topic-ceiling-level_0 - topic_0 - old-max-level_0 - old-topic-max-level_0 - lst_0)))) - (case-lambda - ((max-level_0 topic-max-level_0) - (let ((c1_0 - (if (let ((or-part_0 - (begin-unsafe - (let ((app_0 - (level->value ceiling-level_0))) - (>= - app_0 - (level->value max-level_0)))))) - (if or-part_0 - or-part_0 - (if topic_0 - (begin-unsafe - (let ((app_0 - (level->value ceiling-level_0))) - (>= - app_0 - (level->value topic-max-level_0)))) - #f))) - (logger-parent parent_0) - #f))) - (if c1_0 - (let ((filters_0 (logger-propagate-filters parent_0))) - (let ((ceiling-level_1 - (level-min - ceiling-level_0 - (filters-max-level filters_0)))) - (let ((topic-ceiling-level_1 - (if topic_0 - (level-min - topic-ceiling-level_0 - (filters-level-for-topic - filters_0 - topic_0)) - topic-ceiling-level_0))) - (let ((ceiling-level_2 ceiling-level_1)) - (loop_0 - c1_0 - ceiling-level_2 - max-level_0 - topic-ceiling-level_1 - topic-max-level_0))))) - (begin - (set-logger-max-receiver-level! logger_0 max-level_0) - (if topic_0 - (let ((cache_0 (logger-topic-level-cache logger_0))) - (let ((or-part_0 - (let ((end_0 (vector-length cache_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (result_0 pos_0) - (begin - (if (< pos_0 end_0) - (let ((result_1 - (let ((result_1 - (if (not - (vector-ref - cache_0 - pos_0)) - (if (begin - (vector-set! - cache_0 - pos_0 - topic_0) - (vector-set! - cache_0 - (add1 - pos_0) - topic-max-level_0)) - #t - #f) - #f))) - (values result_1)))) - (if (if (not - (let ((x_0 - (list - pos_0))) - result_1)) - #t - #f) - (for-loop_1 - result_1 - (+ pos_0 2)) - result_1)) - result_0)))))) - (for-loop_1 #f 0)))))) - (if or-part_0 - or-part_0 + (set-logger-max-receiver-level! logger_0 max-level_0) + (if topic_0 + (let ((cache_0 (logger-topic-level-cache logger_0))) + (let ((or-part_0 + (let ((end_0 (vector-length cache_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 pos_0) + (begin + (if (< pos_0 end_0) + (let ((result_1 + (let ((result_1 + (if (not + (vector-ref + cache_0 + pos_0)) + (if (begin + (vector-set! + cache_0 + pos_0 + topic_0) + (vector-set! + cache_0 + (add1 + pos_0) + topic-max-level_0)) + #t + #f) + #f))) + (values result_1)))) + (if (if (not + (let ((x_0 + (list + pos_0))) + result_1)) + #t + #f) + (for-loop_0 + result_1 + (+ pos_0 2)) + result_1)) + result_0)))))) + (for-loop_0 #f 0)))))) + (if or-part_0 + or-part_0 + (begin (begin - (begin - (let ((end_0 - (- (vector-length cache_0) 2))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (< pos_0 end_0) + (let ((end_0 (- (vector-length cache_0) 2))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (< pos_0 end_0) + (begin (begin - (begin - (let ((app_0 - (+ pos_0 2))) - (vector-set! - cache_0 - app_0 - (vector-ref - cache_0 - pos_0))) - (let ((app_0 - (+ pos_0 3))) - (vector-set! - cache_0 - app_0 - (vector-ref - cache_0 - (+ pos_0 1))))) - (for-loop_1 (+ pos_0 2))) - (values))))))) - (for-loop_1 0)))) - (void)) - (vector-set! cache_0 0 topic_0) - (vector-set! - cache_0 - 1 - topic-max-level_0))))) - (void)))))) - (args (raise-binding-result-arity-error 2 args))))))))) - (loop_0 logger_0 'debug 'none 'debug 'none)))))) + (let ((app_0 (+ pos_0 2))) + (vector-set! + cache_0 + app_0 + (vector-ref + cache_0 + pos_0))) + (let ((app_0 (+ pos_0 3))) + (vector-set! + cache_0 + app_0 + (vector-ref + cache_0 + (+ pos_0 1))))) + (for-loop_0 (+ pos_0 2))) + (values))))))) + (for-loop_0 0)))) + (void)) + (vector-set! cache_0 0 topic_0) + (vector-set! cache_0 1 topic-max-level_0))))) + (void)))))) + (args (raise-binding-result-arity-error 2 args))))))))) + (loop_0 logger_0 'debug 'none 'debug 'none))))) (define logger-all-levels (lambda (logger_0) (call-with-values @@ -34173,87 +32932,78 @@ #f) (|#%app| end-atomic/no-interrupts))))) (define log-message* - (letrec () - (lambda (logger_0 - level_0 - topic_0 - message_0 - data_0 - prefix?_0 - in-interrupt?_0) - (let ((msg_0 (box #f))) - (if (let ((a_0 (logger-max-wanted-level* logger_0))) - (begin-unsafe - (let ((app_0 (level->value a_0))) - (>= app_0 (level->value level_0))))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (logger_1) + (lambda (logger_0 level_0 topic_0 message_0 data_0 prefix?_0 in-interrupt?_0) + (let ((msg_0 #f)) + (if (let ((a_0 (logger-max-wanted-level* logger_0))) + (begin-unsafe + (let ((app_0 (level->value a_0))) + (>= app_0 (level->value level_0))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (logger_1) + (begin (begin - (begin - (let ((lst_0 (logger-receivers logger_1))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((r_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (begin - (if (let ((a_0 - (filters-level-for-topic - (log-receiver-filters r_0) - topic_0))) - (begin-unsafe - (let ((app_0 - (level->value a_0))) - (>= - app_0 - (level->value level_0))))) - (begin - (if (unsafe-unbox* msg_0) - (void) - (unsafe-set-box*! - msg_0 - (vector-immutable - level_0 - (string->immutable-string - (if (if prefix?_0 topic_0 #f) - (string-append - (symbol->string topic_0) - ": " - message_0) - message_0)) - data_0 - topic_0))) - (log-receiver-send! - r_0 - (unsafe-unbox* msg_0) - in-interrupt?_0)) - (void)) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void) - (let ((parent_0 (logger-parent logger_1))) - (if (if parent_0 - (let ((a_0 - (filters-level-for-topic - (logger-propagate-filters logger_1) - topic_0))) - (begin-unsafe - (let ((app_0 (level->value a_0))) - (>= app_0 (level->value level_0))))) - #f) - (loop_0 parent_0) - (void))))))))) - (loop_0 logger_0)) - (void)))))) + (let ((lst_0 (logger-receivers logger_1))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? lst_1) + (let ((r_0 (unsafe-car lst_1))) + (let ((rest_0 (unsafe-cdr lst_1))) + (begin + (if (let ((a_0 + (filters-level-for-topic + (log-receiver-filters r_0) + topic_0))) + (begin-unsafe + (let ((app_0 (level->value a_0))) + (>= + app_0 + (level->value level_0))))) + (begin + (if msg_0 + (void) + (set! msg_0 + (vector-immutable + level_0 + (string->immutable-string + (if (if prefix?_0 topic_0 #f) + (string-append + (symbol->string topic_0) + ": " + message_0) + message_0)) + data_0 + topic_0))) + (log-receiver-send! + r_0 + msg_0 + in-interrupt?_0)) + (void)) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 lst_0)))) + (void) + (let ((parent_0 (logger-parent logger_1))) + (if (if parent_0 + (let ((a_0 + (filters-level-for-topic + (logger-propagate-filters logger_1) + topic_0))) + (begin-unsafe + (let ((app_0 (level->value a_0))) + (>= app_0 (level->value level_0))))) + #f) + (loop_0 parent_0) + (void))))))))) + (loop_0 logger_0)) + (void))))) (define struct:fs-change-evt (make-record-type-descriptor* 'filesystem-change-evt #f #f #f #f 2 3)) (define effect_2322 @@ -34393,117 +33143,109 @@ (lambda (v_0) (begin (fs-change-evt? v_0))))) (define 1/filesystem-change-evt (let ((filesystem-change-evt_0 - (letrec ((procz1 (lambda (fc_0) (close-fc fc_0)))) - (|#%name| - filesystem-change-evt - (lambda (p3_0 fail2_0) + (|#%name| + filesystem-change-evt + (lambda (p3_0 fail2_0) + (begin (begin + (if (path-string? p3_0) + (void) + (raise-argument-error + 'filesystem-change-evt + "path-string?" + p3_0)) (begin - (if (path-string? p3_0) + (if (let ((or-part_0 (not fail2_0))) + (if or-part_0 + or-part_0 + (if (procedure? fail2_0) + (procedure-arity-includes? fail2_0 0) + #f))) (void) (raise-argument-error 'filesystem-change-evt - "path-string?" - p3_0)) - (begin - (if (let ((or-part_0 (not fail2_0))) - (if or-part_0 - or-part_0 - (if (procedure? fail2_0) - (procedure-arity-includes? fail2_0 0) - #f))) - (void) - (raise-argument-error - 'filesystem-change-evt - "(or/c (procedure-arity-includes/c 0) #f)" - fail2_0)) - (let ((fn_0 - (->host p3_0 'filesystem-change-evt '(exists)))) - (begin - (unsafe-start-atomic) - (let ((file-rfc_0 - (|#%app| - rktio_fs_change - (unsafe-place-local-ref cell.1) - fn_0 - (unsafe-place-local-ref cell.1$5)))) - (let ((rfc_0 - (if (vector? file-rfc_0) - (begin - (unsafe-end-atomic) - (if (if (zero? - (bitwise-and - (|#%app| - rktio_fs_change_properties - (unsafe-place-local-ref - cell.1)) - 8)) - (|#%app| - rktio_file_exists - (unsafe-place-local-ref cell.1) - fn_0) - #f) - (call-with-values - (lambda () - (1/split-path (host-> fn_0))) - (case-lambda - ((base_0 name_0 dir_0) - (let ((base-fn_0 - (->host - base_0 - 'filesystem-change-evt - '(exists)))) - (begin - (unsafe-start-atomic) - (|#%app| - rktio_fs_change - (unsafe-place-local-ref cell.1) - base-fn_0 - (unsafe-place-local-ref - cell.1$5))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (begin - (unsafe-start-atomic) - file-rfc_0))) - file-rfc_0))) - (if (vector? rfc_0) - (begin - (unsafe-end-atomic) - (if fail2_0 - (|#%app| fail2_0) - (if (racket-error? rfc_0 1) - (raise + "(or/c (procedure-arity-includes/c 0) #f)" + fail2_0)) + (let ((fn_0 (->host p3_0 'filesystem-change-evt '(exists)))) + (begin + (unsafe-start-atomic) + (let ((file-rfc_0 + (|#%app| + rktio_fs_change + (unsafe-place-local-ref cell.1) + fn_0 + (unsafe-place-local-ref cell.1$5)))) + (let ((rfc_0 + (if (vector? file-rfc_0) + (begin + (unsafe-end-atomic) + (if (if (zero? + (bitwise-and + (|#%app| + rktio_fs_change_properties + (unsafe-place-local-ref cell.1)) + 8)) + (|#%app| + rktio_file_exists + (unsafe-place-local-ref cell.1) + fn_0) + #f) + (call-with-values + (lambda () (1/split-path (host-> fn_0))) + (case-lambda + ((base_0 name_0 dir_0) + (let ((base-fn_0 + (->host + base_0 + 'filesystem-change-evt + '(exists)))) + (begin + (unsafe-start-atomic) + (|#%app| + rktio_fs_change + (unsafe-place-local-ref cell.1) + base-fn_0 + (unsafe-place-local-ref + cell.1$5))))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (begin (unsafe-start-atomic) file-rfc_0))) + file-rfc_0))) + (if (vector? rfc_0) + (begin + (unsafe-end-atomic) + (if fail2_0 + (|#%app| fail2_0) + (if (racket-error? rfc_0 1) + (raise + (|#%app| + exn:fail:unsupported + "filesystem-change-evt: unsupported" + (current-continuation-marks))) + (raise-filesystem-error + 'filesystem-change-evt + rfc_0 + (1/format + "error generating event\n path: ~a" + (host-> fn_0)))))) + (let ((fc_0 (fs-change-evt1.1 rfc_0 #f))) + (let ((cust-ref_0 (|#%app| - exn:fail:unsupported - "filesystem-change-evt: unsupported" - (current-continuation-marks))) - (raise-filesystem-error - 'filesystem-change-evt - rfc_0 - (1/format - "error generating event\n path: ~a" - (host-> fn_0)))))) - (let ((fc_0 (fs-change-evt1.1 rfc_0 #f))) - (let ((cust-ref_0 - (|#%app| - 1/unsafe-custodian-register - (current-custodian) - fc_0 - procz1 - #f - #t))) - (begin - (set-fs-change-evt-cust-ref! - fc_0 - cust-ref_0) - (unsafe-add-global-finalizer - fc_0 - (lambda () (close-fc fc_0))) - (unsafe-end-atomic) - fc_0)))))))))))))))) + 1/unsafe-custodian-register + (current-custodian) + fc_0 + (lambda (fc_1) (close-fc fc_1)) + #f + #t))) + (begin + (set-fs-change-evt-cust-ref! fc_0 cust-ref_0) + (unsafe-add-global-finalizer + fc_0 + (lambda () (close-fc fc_0))) + (unsafe-end-atomic) + fc_0))))))))))))))) (|#%name| filesystem-change-evt (case-lambda @@ -34591,21 +33333,20 @@ ((in_0 start1_0) (sha1-bytes_0 in_0 start1_0 #f)))))) (define 1/sha224-bytes (let ((sha224-bytes_0 - (letrec ((procz1 (lambda (p_0) (|#%app| rktio_sha2_init p_0 #t)))) - (|#%name| - sha224-bytes - (lambda (in6_0 start4_0 end5_0) - (begin - (sha - 'sha224-bytes - in6_0 - start4_0 - end5_0 - (|#%app| rktio_make_sha2_ctx) - 28 - procz1 - rktio_sha2_update - rktio_sha2_final))))))) + (|#%name| + sha224-bytes + (lambda (in6_0 start4_0 end5_0) + (begin + (sha + 'sha224-bytes + in6_0 + start4_0 + end5_0 + (|#%app| rktio_make_sha2_ctx) + 28 + (lambda (p_0) (|#%app| rktio_sha2_init p_0 #t)) + rktio_sha2_update + rktio_sha2_final)))))) (|#%name| sha224-bytes (case-lambda @@ -34614,21 +33355,20 @@ ((in_0 start4_0) (sha224-bytes_0 in_0 start4_0 #f)))))) (define 1/sha256-bytes (let ((sha256-bytes_0 - (letrec ((procz1 (lambda (p_0) (|#%app| rktio_sha2_init p_0 #f)))) - (|#%name| - sha256-bytes - (lambda (in9_0 start7_0 end8_0) - (begin - (sha - 'sha256-bytes - in9_0 - start7_0 - end8_0 - (|#%app| rktio_make_sha2_ctx) - 32 - procz1 - rktio_sha2_update - rktio_sha2_final))))))) + (|#%name| + sha256-bytes + (lambda (in9_0 start7_0 end8_0) + (begin + (sha + 'sha256-bytes + in9_0 + start7_0 + end8_0 + (|#%app| rktio_make_sha2_ctx) + 32 + (lambda (p_0) (|#%app| rktio_sha2_init p_0 #f)) + rktio_sha2_update + rktio_sha2_final)))))) (|#%name| sha256-bytes (case-lambda @@ -34898,200 +33638,198 @@ 'subprocess 'cust-ref)))))) (define do-subprocess - (letrec ((maybe-wait_0 - (|#%name| - maybe-wait - (lambda (fd_0) - (begin - (if (if fd_0 - (|#%app| - rktio_fd_is_pending_open - (unsafe-place-local-ref cell.1) - (fd-port-fd fd_0)) - #f) - (sync fd_0) - (void))))))) - (|#%name| - subprocess - (lambda (stdout_0 stdin_0 stderr_0 group/command_0 . command/args_0) + (|#%name| + subprocess + (lambda (stdout_0 stdin_0 stderr_0 group/command_0 . command/args_0) + (begin (begin + (if (let ((or-part_0 (not stdout_0))) + (if or-part_0 + or-part_0 + (if (1/output-port? stdout_0) + (1/file-stream-port? stdout_0) + #f))) + (void) + (raise-argument-error + 'subprocess + "(or/c (and/c output-port? file-stream-port?) #f)" + stdout_0)) (begin - (if (let ((or-part_0 (not stdout_0))) + (if (let ((or-part_0 (not stdin_0))) (if or-part_0 or-part_0 - (if (1/output-port? stdout_0) - (1/file-stream-port? stdout_0) + (if (1/input-port? stdin_0) + (1/file-stream-port? stdin_0) #f))) (void) (raise-argument-error 'subprocess - "(or/c (and/c output-port? file-stream-port?) #f)" - stdout_0)) + "(or/c (and/c input-port? file-stream-port?) #f)" + stdin_0)) (begin - (if (let ((or-part_0 (not stdin_0))) + (if (let ((or-part_0 (not stderr_0))) (if or-part_0 or-part_0 - (if (1/input-port? stdin_0) - (1/file-stream-port? stdin_0) - #f))) + (let ((or-part_1 (eq? stderr_0 'stdout))) + (if or-part_1 + or-part_1 + (if (1/output-port? stderr_0) + (1/file-stream-port? stderr_0) + #f))))) (void) (raise-argument-error 'subprocess - "(or/c (and/c input-port? file-stream-port?) #f)" - stdin_0)) - (begin - (if (let ((or-part_0 (not stderr_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (eq? stderr_0 'stdout))) - (if or-part_1 - or-part_1 - (if (1/output-port? stderr_0) - (1/file-stream-port? stderr_0) - #f))))) - (void) - (raise-argument-error - 'subprocess - "(or/c (and/c output-port? file-stream-port?) #f 'stdout)" - stderr_0)) - (let ((lr3566 unsafe-undefined) - (group_0 unsafe-undefined) - (command_0 unsafe-undefined) - (exact/args_0 unsafe-undefined)) - (set! lr3566 - (call-with-values - (lambda () - (if (path-string? group/command_0) - (values - (if (1/subprocess-group-enabled) 'new #f) - group/command_0 - command/args_0) - (if (null? command/args_0) - (raise-argument-error - 'subprocess - "path-string?" - (check-not-unsafe-undefined command_0 'command_0)) - (if (let ((or-part_0 (not group/command_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (eq? group/command_0 'new))) - (if or-part_1 - or-part_1 - (1/subprocess? group/command_0))))) - (begin - (if (pair? command/args_0) - (void) - (raise-arguments-error - 'subprocess - "missing command argument after group argument")) - (let ((command_1 (car command/args_0))) - (begin - (if (path-string? command_1) - (void) - (raise-argument-error - 'subprocess - "path-string?" - command_1)) - (if (1/subprocess? group/command_0) - (if (subprocess-is-group? group/command_0) - (void) - (raise-arguments-error - 'subprocess - "subprocess does not represent a new group" - "subprocess" - group/command_0)) - (void)) - (values - group/command_0 - command_1 - (cdr command/args_0))))) - (raise-argument-error - 'subprocess - "(or/c path-string? #f 'new subprocess?)" - group/command_0))))) - (case-lambda - ((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 lr3566 0)) - (set! command_0 (unsafe-vector*-ref lr3566 1)) - (set! exact/args_0 (unsafe-vector*-ref lr3566 2)) + "(or/c (and/c output-port? file-stream-port?) #f 'stdout)" + stderr_0)) + (let ((lr3566 unsafe-undefined) + (group_0 unsafe-undefined) + (command_0 unsafe-undefined) + (exact/args_0 unsafe-undefined)) + (set! lr3566 (call-with-values (lambda () - (if (if (pair? exact/args_0) - (eq? 'exact (car exact/args_0)) - #f) - (values #t (cdr exact/args_0)) - (values #f exact/args_0))) - (case-lambda - ((exact?_0 args_0) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0 pos_0) + (if (path-string? group/command_0) + (values + (if (1/subprocess-group-enabled) 'new #f) + group/command_0 + command/args_0) + (if (null? command/args_0) + (raise-argument-error + 'subprocess + "path-string?" + (check-not-unsafe-undefined command_0 'command_0)) + (if (let ((or-part_0 (not group/command_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (eq? group/command_0 'new))) + (if or-part_1 + or-part_1 + (1/subprocess? group/command_0))))) + (begin + (if (pair? command/args_0) + (void) + (raise-arguments-error + 'subprocess + "missing command argument after group argument")) + (let ((command_1 (car command/args_0))) (begin - (if (if (pair? lst_0) #t #f) - (let ((arg_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (if (let ((or-part_0 (1/path? arg_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (string-no-nuls? - arg_0))) - (if or-part_1 - or-part_1 - (bytes-no-nuls? arg_0))))) - (void) - (raise-argument-error - 'subprocess - (if (if (not exact?_0) - (if (= pos_0 0) - (= (length args_0) 2) - #f) + (if (path-string? command_1) + (void) + (raise-argument-error + 'subprocess + "path-string?" + command_1)) + (if (1/subprocess? group/command_0) + (if (subprocess-is-group? group/command_0) + (void) + (raise-arguments-error + 'subprocess + "subprocess does not represent a new group" + "subprocess" + group/command_0)) + (void)) + (values + group/command_0 + command_1 + (cdr command/args_0))))) + (raise-argument-error + 'subprocess + "(or/c path-string? #f 'new subprocess?)" + group/command_0))))) + (case-lambda + ((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 lr3566 0)) + (set! command_0 (unsafe-vector*-ref lr3566 1)) + (set! exact/args_0 (unsafe-vector*-ref lr3566 2)) + (call-with-values + (lambda () + (if (if (pair? exact/args_0) + (eq? 'exact (car exact/args_0)) + #f) + (values #t (cdr exact/args_0)) + (values #f exact/args_0))) + (case-lambda + ((exact?_0 args_0) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0 pos_0) + (begin + (if (if (pair? lst_0) #t #f) + (let ((arg_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (if (let ((or-part_0 (1/path? arg_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (string-no-nuls? arg_0))) + (if or-part_1 + or-part_1 + (bytes-no-nuls? arg_0))))) + (void) + (raise-argument-error + 'subprocess + (if (if (not exact?_0) + (if (= pos_0 0) + (= (length args_0) 2) #f) - "(or/c path? string-no-nuls? bytes-no-nuls? 'exact)" - "(or/c path? string-no-nuls? bytes-no-nuls?)") - arg_0)) - (for-loop_0 rest_0 (+ pos_0 1))))) - (values))))))) - (for-loop_0 args_0 0))) - (let ((cust-mode_0 - (1/current-subprocess-custodian-mode))) - (let ((env-vars_0 (1/current-environment-variables))) - (let ((flags_0 (if (eq? stderr_0 'stdout) 2 0))) - (let ((flags_1 - (if exact?_0 - (bitwise-ior flags_0 4) - flags_0))) - (let ((flags_2 - (if (eq? group_0 'new) - (bitwise-ior flags_1 1) - flags_1))) - (let ((flags_3 - (if (if (eq? cust-mode_0 'kill) - (positive? - (bitwise-and - (|#%app| - rktio_process_allowed_flags - (unsafe-place-local-ref - cell.1)) - 8)) - #f) - (bitwise-ior flags_2 8) - flags_2))) - (let ((command-bstr_0 - (->host - (->path - (check-not-unsafe-undefined - command_0 - 'command_0)) - 'subprocess - '(execute)))) + #f) + "(or/c path? string-no-nuls? bytes-no-nuls? 'exact)" + "(or/c path? string-no-nuls? bytes-no-nuls?)") + arg_0)) + (for-loop_0 rest_0 (+ pos_0 1))))) + (values))))))) + (for-loop_0 args_0 0))) + (let ((cust-mode_0 (1/current-subprocess-custodian-mode))) + (let ((env-vars_0 (1/current-environment-variables))) + (let ((flags_0 (if (eq? stderr_0 'stdout) 2 0))) + (let ((flags_1 + (if exact?_0 + (bitwise-ior flags_0 4) + flags_0))) + (let ((flags_2 + (if (eq? group_0 'new) + (bitwise-ior flags_1 1) + flags_1))) + (let ((flags_3 + (if (if (eq? cust-mode_0 'kill) + (positive? + (bitwise-and + (|#%app| + rktio_process_allowed_flags + (unsafe-place-local-ref cell.1)) + 8)) + #f) + (bitwise-ior flags_2 8) + flags_2))) + (let ((command-bstr_0 + (->host + (->path + (check-not-unsafe-undefined + command_0 + 'command_0)) + 'subprocess + '(execute)))) + (let ((maybe-wait_0 + (|#%name| + maybe-wait + (lambda (fd_0) + (begin + (if (if fd_0 + (|#%app| + rktio_fd_is_pending_open + (unsafe-place-local-ref + cell.1) + (fd-port-fd fd_0)) + #f) + (sync fd_0) + (void))))))) (begin (maybe-wait_0 stdout_0) (begin @@ -35346,8 +34084,8 @@ sp_0 in_0 out_0 - err_0))))))))))))))))))))))))))) - (args (raise-binding-result-arity-error 2 args))))))))))))) + err_0)))))))))))))))))))))))))))) + (args (raise-binding-result-arity-error 2 args)))))))))))) (define 1/subprocess-wait (|#%name| subprocess-wait @@ -35450,21 +34188,22 @@ (define subprocess-init! (lambda () (unsafe-place-local-set! cell.1$4 (make-will-executor)))) (define register-subprocess-finalizer - (letrec ((procz1 - (lambda (sp_0) - (begin - (if (|#%app| subprocess-process sp_0) - (begin - (|#%app| - rktio_process_forget - (unsafe-place-local-ref cell.1) - (|#%app| subprocess-process sp_0)) - (set-subprocess-process! sp_0 #f)) - (void)) - (no-custodian! sp_0) - #t)))) - (lambda (sp_0) - (will-register (unsafe-place-local-ref cell.1$4) sp_0 procz1)))) + (lambda (sp_0) + (will-register + (unsafe-place-local-ref cell.1$4) + sp_0 + (lambda (sp_1) + (begin + (if (|#%app| subprocess-process sp_1) + (begin + (|#%app| + rktio_process_forget + (unsafe-place-local-ref cell.1) + (|#%app| subprocess-process sp_1)) + (set-subprocess-process! sp_1 #f)) + (void)) + (no-custodian! sp_1) + #t))))) (define poll-subprocess-finalizations (lambda () (if (will-try-execute (unsafe-place-local-ref cell.1$4)) @@ -35490,90 +34229,83 @@ (define 1/subprocess-group-enabled (make-parameter #f (lambda (v_0) (if v_0 #t #f)) 'subprocess-group-enabled)) (define 1/shell-execute - (letrec ((procz1 (lambda () 0))) - (|#%name| - shell-execute - (lambda (verb_0 target_0 parameters_0 dir_0 show-mode_0) + (|#%name| + shell-execute + (lambda (verb_0 target_0 parameters_0 dir_0 show-mode_0) + (begin (begin + (if (let ((or-part_0 (not verb_0))) + (if or-part_0 or-part_0 (string? verb_0))) + (void) + (raise-argument-error 'shell-execute "(or/c string? #f)" verb_0)) (begin - (if (let ((or-part_0 (not verb_0))) - (if or-part_0 or-part_0 (string? verb_0))) + (if (string? target_0) (void) - (raise-argument-error 'shell-execute "(or/c string? #f)" verb_0)) + (raise-argument-error 'shell-execute "string?" target_0)) (begin - (if (string? target_0) + (if (string? parameters_0) (void) - (raise-argument-error 'shell-execute "string?" target_0)) + (raise-argument-error 'shell-execute "string?" parameters_0)) (begin - (if (string? parameters_0) + (if (path-string? dir_0) (void) - (raise-argument-error 'shell-execute "string?" parameters_0)) - (begin - (if (path-string? dir_0) - (void) - (raise-argument-error 'shell-execute "path-string?" dir_0)) - (let ((show_mode_0 - (let ((index_0 - (if (symbol? show-mode_0) - (hash-ref hash3229 show-mode_0 procz1) - 0))) - (if (unsafe-fx< index_0 6) - (if (unsafe-fx< index_0 2) - (if (unsafe-fx< index_0 1) - (raise-argument-error - 'shell-execute - "(or/c 'sw_hide ....)" - show-mode_0) - 0) - (if (unsafe-fx< index_0 3) - 1 - (if (unsafe-fx< index_0 4) - 2 - (if (unsafe-fx< index_0 5) 3 4)))) - (if (unsafe-fx< index_0 9) - (if (unsafe-fx< index_0 7) - 5 - (if (unsafe-fx< index_0 8) 6 7)) - (if (unsafe-fx< index_0 10) - 8 - (if (unsafe-fx< index_0 11) - 9 - (if (unsafe-fx< index_0 12) 10 11)))))))) - (let ((r_0 - (let ((app_0 - (if verb_0 - (1/string->bytes/utf-8 verb_0) - #f))) - (let ((app_1 (1/string->bytes/utf-8 target_0))) - (let ((app_2 - (1/string->bytes/utf-8 parameters_0))) - (|#%app| - rktio_shell_execute - (unsafe-place-local-ref cell.1) - app_0 - app_1 - app_2 - (->host - (->path dir_0) - 'shell-execute - '(exists)) - show_mode_0)))))) - (begin - (if (vector? r_0) - (let ((base-msg_0 "failed")) - (begin-unsafe - (raise - (let ((app_0 - (format-rktio-message - 'shell-execute - r_0 - base-msg_0))) - (|#%app| - exn:fail - app_0 - (current-continuation-marks)))))) - (void)) - #f)))))))))))) + (raise-argument-error 'shell-execute "path-string?" dir_0)) + (let ((show_mode_0 + (let ((index_0 + (if (symbol? show-mode_0) + (hash-ref hash3229 show-mode_0 (lambda () 0)) + 0))) + (if (unsafe-fx< index_0 6) + (if (unsafe-fx< index_0 2) + (if (unsafe-fx< index_0 1) + (raise-argument-error + 'shell-execute + "(or/c 'sw_hide ....)" + show-mode_0) + 0) + (if (unsafe-fx< index_0 3) + 1 + (if (unsafe-fx< index_0 4) + 2 + (if (unsafe-fx< index_0 5) 3 4)))) + (if (unsafe-fx< index_0 9) + (if (unsafe-fx< index_0 7) + 5 + (if (unsafe-fx< index_0 8) 6 7)) + (if (unsafe-fx< index_0 10) + 8 + (if (unsafe-fx< index_0 11) + 9 + (if (unsafe-fx< index_0 12) 10 11)))))))) + (let ((r_0 + (let ((app_0 + (if verb_0 (1/string->bytes/utf-8 verb_0) #f))) + (let ((app_1 (1/string->bytes/utf-8 target_0))) + (let ((app_2 (1/string->bytes/utf-8 parameters_0))) + (|#%app| + rktio_shell_execute + (unsafe-place-local-ref cell.1) + app_0 + app_1 + app_2 + (->host (->path dir_0) 'shell-execute '(exists)) + show_mode_0)))))) + (begin + (if (vector? r_0) + (let ((base-msg_0 "failed")) + (begin-unsafe + (raise + (let ((app_0 + (format-rktio-message + 'shell-execute + r_0 + base-msg_0))) + (|#%app| + exn:fail + app_0 + (current-continuation-marks)))))) + (void)) + #f))))))))))) (define effect_3140 (begin (void @@ -36051,145 +34783,139 @@ (define rktio-evt-add-to-poll-set (|#%name| rktio-evt-add-to-poll-set (record-accessor struct:rktio-evt 1))) (define call-with-resolved-address.1 - (letrec ((procz2 - (lambda (addr_0) - (|#%app| - rktio_addrinfo_free - (unsafe-place-local-ref cell.1) - addr_0))) - (procz1 - (lambda (lookup-box_0) - (let ((lookup_0 (unbox lookup-box_0))) - (if lookup_0 - (|#%app| - rktio_addrinfo_lookup_stop - (unsafe-place-local-ref cell.1) - lookup_0) - (void)))))) - (|#%name| - call-with-resolved-address - (lambda (enable-break?4_0 - family5_0 - passive?6_0 - port-number-on-error?3_0 - retain-address?8_0 - tcp?7_0 - which2_0 - who1_0 - hostname17_0 - port-no18_0 - proc19_0) - (begin - (let ((family_0 (if (eq? family5_0 unsafe-undefined) -1 family5_0))) - (begin - (poll-address-finalizations) - (if (if (not hostname17_0) (not port-no18_0) #f) - (|#%app| proc19_0 #f) - (call-with-resource - (box - (let ((app_0 - (if hostname17_0 - (1/string->bytes/utf-8 hostname17_0) - #f))) - (|#%app| - rktio_start_addrinfo_lookup - (unsafe-place-local-ref cell.1) - app_0 - (if port-no18_0 port-no18_0 0) - family_0 - passive?6_0 - tcp?7_0))) - procz1 - (lambda (lookup-box_0) - (let ((lookup_0 (unbox lookup-box_0))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda () - (begin - (if (if (not (vector? lookup_0)) - (eqv? - (|#%app| - rktio_poll_addrinfo_lookup_ready - (unsafe-place-local-ref cell.1) - lookup_0) - 0) - #f) - (begin - (unsafe-end-atomic) - (|#%app| - (if enable-break?4_0 sync/enable-break sync) - (rktio-evt1.1 - (lambda () - (not - (eqv? - (|#%app| - rktio_poll_addrinfo_lookup_ready - (unsafe-place-local-ref cell.1) - lookup_0) - 0))) - (lambda (ps_0) + (|#%name| + call-with-resolved-address + (lambda (enable-break?4_0 + family5_0 + passive?6_0 + port-number-on-error?3_0 + retain-address?8_0 + tcp?7_0 + which2_0 + who1_0 + hostname17_0 + port-no18_0 + proc19_0) + (begin + (let ((family_0 (if (eq? family5_0 unsafe-undefined) -1 family5_0))) + (begin + (poll-address-finalizations) + (if (if (not hostname17_0) (not port-no18_0) #f) + (|#%app| proc19_0 #f) + (call-with-resource + (box + (let ((app_0 + (if hostname17_0 + (1/string->bytes/utf-8 hostname17_0) + #f))) + (|#%app| + rktio_start_addrinfo_lookup + (unsafe-place-local-ref cell.1) + app_0 + (if port-no18_0 port-no18_0 0) + family_0 + passive?6_0 + tcp?7_0))) + (lambda (lookup-box_0) + (let ((lookup_0 (unbox lookup-box_0))) + (if lookup_0 + (|#%app| + rktio_addrinfo_lookup_stop + (unsafe-place-local-ref cell.1) + lookup_0) + (void)))) + (lambda (lookup-box_0) + (let ((lookup_0 (unbox lookup-box_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda () + (begin + (if (if (not (vector? lookup_0)) + (eqv? + (|#%app| + rktio_poll_addrinfo_lookup_ready + (unsafe-place-local-ref cell.1) + lookup_0) + 0) + #f) + (begin + (unsafe-end-atomic) + (|#%app| + (if enable-break?4_0 sync/enable-break sync) + (rktio-evt1.1 + (lambda () + (not + (eqv? (|#%app| - rktio_poll_add_addrinfo_lookup + rktio_poll_addrinfo_lookup_ready (unsafe-place-local-ref cell.1) - lookup_0 - ps_0)))) - (unsafe-start-atomic) - (loop_0)) - (begin - (set-box! lookup-box_0 #f) - (call-with-resource - (if (vector? lookup_0) + lookup_0) + 0))) + (lambda (ps_0) + (|#%app| + rktio_poll_add_addrinfo_lookup + (unsafe-place-local-ref cell.1) lookup_0 - (|#%app| - rktio_addrinfo_lookup_get - (unsafe-place-local-ref cell.1) - lookup_0)) - procz2 - (lambda (addr_0) - (if (if who1_0 (vector? addr_0) #f) - (raise-network-error - who1_0 - addr_0 - (let ((app_0 - (if hostname17_0 - hostname17_0 - ""))) - (string-append - "can't resolve " - which2_0 - "address" - "\n address: " - app_0 - (if (if port-number-on-error?3_0 - port-no18_0 - #f) - (string-append - "\n port number: " - (number->string port-no18_0)) - "")))) - (begin0 - (|#%app| proc19_0 addr_0) - (if retain-address?8_0 - (void) - (|#%app| - rktio_addrinfo_free - (unsafe-place-local-ref cell.1) - addr_0))))))))))))) - (loop_0))))))))))))) + ps_0)))) + (unsafe-start-atomic) + (loop_0)) + (begin + (set-box! lookup-box_0 #f) + (call-with-resource + (if (vector? lookup_0) + lookup_0 + (|#%app| + rktio_addrinfo_lookup_get + (unsafe-place-local-ref cell.1) + lookup_0)) + (lambda (addr_0) + (|#%app| + rktio_addrinfo_free + (unsafe-place-local-ref cell.1) + addr_0)) + (lambda (addr_0) + (if (if who1_0 (vector? addr_0) #f) + (raise-network-error + who1_0 + addr_0 + (let ((app_0 + (if hostname17_0 + hostname17_0 + ""))) + (string-append + "can't resolve " + which2_0 + "address" + "\n address: " + app_0 + (if (if port-number-on-error?3_0 + port-no18_0 + #f) + (string-append + "\n port number: " + (number->string port-no18_0)) + "")))) + (begin0 + (|#%app| proc19_0 addr_0) + (if retain-address?8_0 + (void) + (|#%app| + rktio_addrinfo_free + (unsafe-place-local-ref cell.1) + addr_0))))))))))))) + (loop_0)))))))))))) (define cell.1$3 (unsafe-make-place-local (make-will-executor))) (define register-address-finalizer - (letrec ((procz1 - (lambda (addr_0) - (begin - (|#%app| - rktio_addrinfo_free - (unsafe-place-local-ref cell.1) - addr_0) - #t)))) - (lambda (addr_0) - (will-register (unsafe-place-local-ref cell.1$3) addr_0 procz1)))) + (lambda (addr_0) + (will-register + (unsafe-place-local-ref cell.1$3) + addr_0 + (lambda (addr_1) + (begin + (|#%app| rktio_addrinfo_free (unsafe-place-local-ref cell.1) addr_1) + #t))))) (define poll-address-finalizations (lambda () (if (will-try-execute (unsafe-place-local-ref cell.1$3)) @@ -36286,299 +35012,267 @@ local-hostname6_0 #f)))))) (define do-tcp-connect.1 - (letrec ((procz1 - (lambda (conn-prog_0) - (begin - (remove-trying-fd! conn-prog_0) - (let ((conn_0 (connect-progress-conn conn-prog_0))) - (if conn_0 - (|#%app| - rktio_connect_stop - (unsafe-place-local-ref cell.1) - conn_0) - (void)))))) - (raise-connect-error_0 - (|#%name| - raise-connect-error - (case-lambda - ((hostname15_0 port-no16_0 who14_0 err_0) - (begin - (raise-connect-error_1 - hostname15_0 - port-no16_0 - who14_0 - err_0 - unsafe-undefined - unsafe-undefined - unsafe-undefined))) - ((hostname15_0 - port-no16_0 - who14_0 - err_0 - what_0 - hostname_0 - port-no34_0) - (raise-connect-error_1 - hostname15_0 - port-no16_0 - who14_0 - err_0 - what_0 - hostname_0 - port-no34_0)) - ((hostname15_0 port-no16_0 who14_0 err_0 what_0 hostname33_0) - (raise-connect-error_1 - hostname15_0 - port-no16_0 - who14_0 - err_0 - what_0 - hostname33_0 - unsafe-undefined)) - ((hostname15_0 port-no16_0 who14_0 err_0 what32_0) - (raise-connect-error_1 - hostname15_0 - port-no16_0 - who14_0 - err_0 - what32_0 - unsafe-undefined - unsafe-undefined))))) - (raise-connect-error_1 - (|#%name| - raise-connect-error - (lambda (hostname15_0 - port-no16_0 - who14_0 - err35_0 - what32_0 - hostname33_0 - port-no34_0) - (begin - (let ((what_0 - (if (eq? what32_0 unsafe-undefined) - "connection failed" - what32_0))) - (let ((hostname_0 - (if (eq? hostname33_0 unsafe-undefined) - hostname15_0 - hostname33_0))) - (let ((port-no_0 - (if (eq? port-no34_0 unsafe-undefined) - port-no16_0 - port-no34_0))) - (begin - (unsafe-end-atomic) - (raise-network-error - who14_0 - err35_0 - (let ((app_0 - (if hostname_0 - (1/format "\n hostname: ~a" hostname_0) - ""))) - (string-append - what_0 - app_0 - (if port-no_0 - (1/format "\n port number: ~a" port-no_0) - ""))))))))))))) - (|#%name| - do-tcp-connect - (lambda (enable-break?10_0 - who14_0 - hostname15_0 - port-no16_0 - local-hostname12_0 - local-port-no13_0) + (|#%name| + do-tcp-connect + (lambda (enable-break?10_0 + who14_0 + hostname15_0 + port-no16_0 + local-hostname12_0 + local-port-no13_0) + (begin (begin + (if (string? hostname15_0) + (void) + (raise-argument-error who14_0 "string?" hostname15_0)) (begin - (if (string? hostname15_0) + (if (port-number? port-no16_0) (void) - (raise-argument-error who14_0 "string?" hostname15_0)) + (raise-argument-error who14_0 "port-number?" port-no16_0)) (begin - (if (port-number? port-no16_0) + (if (let ((or-part_0 (not local-hostname12_0))) + (if or-part_0 or-part_0 (string? local-hostname12_0))) (void) - (raise-argument-error who14_0 "port-number?" port-no16_0)) + (raise-argument-error + who14_0 + "(or/c string? #f)" + local-hostname12_0)) (begin - (if (let ((or-part_0 (not local-hostname12_0))) - (if or-part_0 or-part_0 (string? local-hostname12_0))) + (if (let ((or-part_0 (not local-port-no13_0))) + (if or-part_0 or-part_0 (port-number? local-port-no13_0))) (void) (raise-argument-error who14_0 - "(or/c string? #f)" - local-hostname12_0)) + "(or/c port-number? #f)" + local-port-no13_0)) (begin - (if (let ((or-part_0 (not local-port-no13_0))) - (if or-part_0 - or-part_0 - (port-number? local-port-no13_0))) - (void) - (raise-argument-error + (if (if local-hostname12_0 (not local-port-no13_0) #f) + (raise-arguments-error who14_0 - "(or/c port-number? #f)" - local-port-no13_0)) - (begin - (if (if local-hostname12_0 (not local-port-no13_0) #f) - (raise-arguments-error - who14_0 - "no local port number supplied when local hostname was supplied" - "hostname" - local-hostname12_0) - (void)) - (begin - (1/security-guard-check-network - who14_0 - hostname15_0 - port-no16_0 - 'client) - (unsafe-start-atomic) - (begin0 - (let ((temp39_0 - (|#%name| - temp39 - (lambda (remote-addr_0) - (begin - (if (vector? remote-addr_0) - (raise-connect-error_0 - hostname15_0 - port-no16_0 + "no local port number supplied when local hostname was supplied" + "hostname" + local-hostname12_0) + (void)) + (let ((raise-connect-error_0 + (|#%name| + raise-connect-error + (lambda (err35_0 what32_0 hostname33_0 port-no34_0) + (begin + (let ((what_0 + (if (eq? what32_0 unsafe-undefined) + "connection failed" + what32_0))) + (let ((hostname_0 + (if (eq? hostname33_0 unsafe-undefined) + hostname15_0 + hostname33_0))) + (let ((port-no_0 + (if (eq? port-no34_0 unsafe-undefined) + port-no16_0 + port-no34_0))) + (begin + (unsafe-end-atomic) + (raise-network-error who14_0 - remote-addr_0 - "host not found") - (let ((temp43_0 - (|#%name| - temp43 - (lambda (local-addr_0) - (begin - (if (vector? local-addr_0) - (raise-connect-error_0 - hostname15_0 - port-no16_0 - who14_0 - local-addr_0 - "local host not found" - local-hostname12_0 - local-port-no13_0) - (call-with-resource - (connect-progress1.1 - (|#%app| - rktio_start_connect - (unsafe-place-local-ref - cell.1) - remote-addr_0 - local-addr_0) - #f) - procz1 - (lambda (conn-prog_0) - (let ((conn_0 - (connect-progress-conn - conn-prog_0))) - (if (vector? conn_0) - (raise-connect-error_0 - hostname15_0 - port-no16_0 - who14_0 - conn_0) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda () - (begin - (if (eqv? - (|#%app| - rktio_poll_connect_ready - (unsafe-place-local-ref - cell.1) - conn_0) - 0) - (begin - (init-trying-fd! - conn-prog_0) - (unsafe-end-atomic) - (|#%app| - (if enable-break?10_0 - sync/enable-break - sync) - (rktio-evt1.1 - (lambda () - (not - (eqv? + err35_0 + (let ((app_0 + (if hostname_0 + (1/format + "\n hostname: ~a" + hostname_0) + ""))) + (string-append + what_0 + app_0 + (if port-no_0 + (1/format + "\n port number: ~a" + port-no_0) + ""))))))))))))) + (let ((raise-connect-error_1 + (|#%name| + raise-connect-error + (case-lambda + ((err_0) + (begin + (raise-connect-error_0 + err_0 + unsafe-undefined + unsafe-undefined + unsafe-undefined))) + ((err_0 what_0 hostname_0 port-no34_0) + (raise-connect-error_0 + err_0 + what_0 + hostname_0 + port-no34_0)) + ((err_0 what_0 hostname33_0) + (raise-connect-error_0 + err_0 + what_0 + hostname33_0 + unsafe-undefined)) + ((err_0 what32_0) + (raise-connect-error_0 + err_0 + what32_0 + unsafe-undefined + unsafe-undefined)))))) + (begin + (1/security-guard-check-network + who14_0 + hostname15_0 + port-no16_0 + 'client) + (unsafe-start-atomic) + (begin0 + (let ((temp39_0 + (|#%name| + temp39 + (lambda (remote-addr_0) + (begin + (if (vector? remote-addr_0) + (raise-connect-error_1 + remote-addr_0 + "host not found") + (let ((temp43_0 + (|#%name| + temp43 + (lambda (local-addr_0) + (begin + (if (vector? local-addr_0) + (raise-connect-error_1 + local-addr_0 + "local host not found" + local-hostname12_0 + local-port-no13_0) + (call-with-resource + (connect-progress1.1 + (|#%app| + rktio_start_connect + (unsafe-place-local-ref + cell.1) + remote-addr_0 + local-addr_0) + #f) + (lambda (conn-prog_0) + (begin + (remove-trying-fd! + conn-prog_0) + (let ((conn_0 + (connect-progress-conn + conn-prog_0))) + (if conn_0 + (|#%app| + rktio_connect_stop + (unsafe-place-local-ref + cell.1) + conn_0) + (void))))) + (lambda (conn-prog_0) + (let ((conn_0 + (connect-progress-conn + conn-prog_0))) + (if (vector? conn_0) + (raise-connect-error_1 + conn_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda () + (begin + (if (eqv? + (|#%app| + rktio_poll_connect_ready + (unsafe-place-local-ref + cell.1) + conn_0) + 0) + (begin + (init-trying-fd! + conn-prog_0) + (unsafe-end-atomic) + (|#%app| + (if enable-break?10_0 + sync/enable-break + sync) + (rktio-evt1.1 + (lambda () + (not + (eqv? + (|#%app| + rktio_poll_connect_ready + (unsafe-place-local-ref + cell.1) + conn_0) + 0))) + (lambda (ps_0) (|#%app| - rktio_poll_connect_ready + rktio_poll_add_connect (unsafe-place-local-ref cell.1) - conn_0) - 0))) - (lambda (ps_0) - (|#%app| - rktio_poll_add_connect - (unsafe-place-local-ref - cell.1) - conn_0 - ps_0)))) - (unsafe-start-atomic) - (loop_0)) - (begin - (remove-trying-fd! - conn-prog_0) + conn_0 + ps_0)))) + (unsafe-start-atomic) + (loop_0)) (begin - (check-current-custodian - who14_0) - (let ((fd_0 - (|#%app| - rktio_connect_finish - (unsafe-place-local-ref - cell.1) - conn_0))) - (if (vector? - fd_0) - (if (racket-error? + (remove-trying-fd! + conn-prog_0) + (begin + (check-current-custodian + who14_0) + (let ((fd_0 + (|#%app| + rktio_connect_finish + (unsafe-place-local-ref + cell.1) + conn_0))) + (if (vector? + fd_0) + (if (racket-error? + fd_0 + 19) + (loop_0) + (begin + (set-connect-progress-conn! + conn-prog_0 + #f) + (raise-connect-error_1 + fd_0))) + (let ((name_0 + (string->immutable-string + hostname15_0))) + (open-input-output-tcp.1 + #t fd_0 - 19) - (loop_0) - (begin - (set-connect-progress-conn! - conn-prog_0 - #f) - (raise-connect-error_0 - hostname15_0 - port-no16_0 - who14_0 - fd_0))) - (let ((name_0 - (string->immutable-string - hostname15_0))) - (open-input-output-tcp.1 - #t - fd_0 - name_0)))))))))))) - (loop_0)))))))))))) - (call-with-resolved-address.1 - enable-break?10_0 - unsafe-undefined - #f - #t - #f - #t - "" - #f - local-hostname12_0 - local-port-no13_0 - temp43_0)))))))) - (call-with-resolved-address.1 - enable-break?10_0 - unsafe-undefined - #f - #t - #f - #t - "" - #f - hostname15_0 - port-no16_0 - temp39_0)) - (unsafe-end-atomic))))))))))))) + name_0)))))))))))) + (loop_0)))))))))))) + (call-with-resolved-address.1 + enable-break?10_0 + unsafe-undefined + #f + #t + #f + #t + "" + #f + local-hostname12_0 + local-port-no13_0 + temp43_0)))))))) + (call-with-resolved-address.1 + enable-break?10_0 + unsafe-undefined + #f + #t + #f + #t + "" + #f + hostname15_0 + port-no16_0 + temp39_0)) + (unsafe-end-atomic)))))))))))))) (define init-trying-fd! (lambda (conn-prog_0) (if (connect-progress-trying-fd conn-prog_0) @@ -36686,148 +35380,137 @@ 'custodian-reference)))))) (define 1/tcp-listen (let ((tcp-listen_0 - (letrec ((loop_0 - (|#%name| - loop - (lambda (hostname4_0 - max-allow-wait2_0 - port-no5_0 - reuse?3_0 - family_0) - (begin - (|#%app| - (begin - (unsafe-start-atomic) - (begin0 - (let ((temp12_0 - (|#%name| - temp12 - (lambda (addr_0) - (begin - (if (vector? addr_0) - (raise-listen-error_0 - hostname4_0 - port-no5_0 - "address-resolution error" - addr_0) - (begin - (check-current-custodian - 'tcp-listen) - (let ((lnr_0 - (|#%app| - rktio_listen - (unsafe-place-local-ref - cell.1) - addr_0 - (min - max-allow-wait2_0 - 10000) - reuse?3_0))) - (if (vector? lnr_0) - (if (racket-error? lnr_0 24) - (lambda () - (loop_0 - hostname4_0 - max-allow-wait2_0 - port-no5_0 - reuse?3_0 - (|#%app| - rktio_get_ipv4_family - (unsafe-place-local-ref - cell.1)))) - (raise-listen-error_0 - hostname4_0 - port-no5_0 - "listen failed" - lnr_0)) - (let ((closed_0 (box #f))) - (let ((custodian-reference_0 - (|#%app| - 1/unsafe-custodian-register - (current-custodian) - lnr_0 - (lambda (fd_0) - (do-tcp-close - lnr_0 - closed_0)) - #f - #f))) - (lambda () - (tcp-listener1.1 - lnr_0 - closed_0 - custodian-reference_0))))))))))))) - (call-with-resolved-address.1 - #f - family_0 - #t - #t - #f - #t - "" - #f - hostname4_0 - port-no5_0 - temp12_0)) - (unsafe-end-atomic)))))))) - (raise-listen-error_0 - (|#%name| - raise-listen-error - (lambda (hostname4_0 port-no5_0 what_0 err_0) - (begin - (begin - (unsafe-end-atomic) - (raise-network-error - 'tcp-listen - err_0 - (let ((app_0 - (if hostname4_0 - (1/format "\n hostname: ~a" hostname4_0) - ""))) - (string-append - what_0 - app_0 - (1/format - "\n port number: ~a" - port-no5_0)))))))))) - (|#%name| - tcp-listen - (lambda (port-no5_0 max-allow-wait2_0 reuse?3_0 hostname4_0) + (|#%name| + tcp-listen + (lambda (port-no5_0 max-allow-wait2_0 reuse?3_0 hostname4_0) + (begin (begin + (if (listen-port-number? port-no5_0) + (void) + (raise-argument-error + 'tcp-listen + "listen-port-number?" + port-no5_0)) (begin - (if (listen-port-number? port-no5_0) + (if (exact-nonnegative-integer? max-allow-wait2_0) (void) (raise-argument-error 'tcp-listen - "listen-port-number?" - port-no5_0)) + "exact-nonnegative-integer?" + max-allow-wait2_0)) (begin - (if (exact-nonnegative-integer? max-allow-wait2_0) + (if (let ((or-part_0 (not hostname4_0))) + (if or-part_0 or-part_0 (string? hostname4_0))) (void) (raise-argument-error 'tcp-listen - "exact-nonnegative-integer?" - max-allow-wait2_0)) - (begin - (if (let ((or-part_0 (not hostname4_0))) - (if or-part_0 or-part_0 (string? hostname4_0))) - (void) - (raise-argument-error - 'tcp-listen - "(or/c string? #f)" - hostname4_0)) + "(or/c string? #f)" + hostname4_0)) + (let ((raise-listen-error_0 + (|#%name| + raise-listen-error + (lambda (what_0 err_0) + (begin + (begin + (unsafe-end-atomic) + (raise-network-error + 'tcp-listen + err_0 + (let ((app_0 + (if hostname4_0 + (1/format + "\n hostname: ~a" + hostname4_0) + ""))) + (string-append + what_0 + app_0 + (1/format + "\n port number: ~a" + port-no5_0)))))))))) (begin (1/security-guard-check-network 'tcp-listen hostname4_0 port-no5_0 'server) - (loop_0 - hostname4_0 - max-allow-wait2_0 - port-no5_0 - reuse?3_0 - -1))))))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (family_0) + (begin + (|#%app| + (begin + (unsafe-start-atomic) + (begin0 + (let ((temp12_0 + (|#%name| + temp12 + (lambda (addr_0) + (begin + (if (vector? addr_0) + (raise-listen-error_0 + "address-resolution error" + addr_0) + (begin + (check-current-custodian + 'tcp-listen) + (let ((lnr_0 + (|#%app| + rktio_listen + (unsafe-place-local-ref + cell.1) + addr_0 + (min + max-allow-wait2_0 + 10000) + reuse?3_0))) + (if (vector? lnr_0) + (if (racket-error? + lnr_0 + 24) + (lambda () + (loop_0 + (|#%app| + rktio_get_ipv4_family + (unsafe-place-local-ref + cell.1)))) + (raise-listen-error_0 + "listen failed" + lnr_0)) + (let ((closed_0 + (box #f))) + (let ((custodian-reference_0 + (|#%app| + 1/unsafe-custodian-register + (current-custodian) + lnr_0 + (lambda (fd_0) + (do-tcp-close + lnr_0 + closed_0)) + #f + #f))) + (lambda () + (tcp-listener1.1 + lnr_0 + closed_0 + custodian-reference_0))))))))))))) + (call-with-resolved-address.1 + #f + family_0 + #t + #t + #f + #t + "" + #f + hostname4_0 + port-no5_0 + temp12_0)) + (unsafe-end-atomic))))))))) + (loop_0 -1)))))))))))) (|#%name| tcp-listen (case-lambda @@ -37180,67 +35863,66 @@ (|#%name| set-udp-is-connected?! (record-mutator struct:udp 2))) (define 1/udp-open-socket (let ((udp-open-socket_0 - (letrec ((procz1 - (|#%name| - temp21 - (lambda (addr_0) - (begin - (let ((s_0 - (|#%app| - rktio_udp_open - (unsafe-place-local-ref cell.1) - addr_0 - (udp-default-family)))) - (if (vector? s_0) - (begin - (unsafe-end-atomic) - (raise-network-error - 'udp-open-socket - s_0 - "creation failed")) - (udp1.1 s_0 #f #f)))))))) - (|#%name| - udp-open-socket - (lambda (family-hostname2_0 family-port-no3_0) + (|#%name| + udp-open-socket + (lambda (family-hostname2_0 family-port-no3_0) + (begin (begin - (begin - (if (let ((or-part_0 (not family-hostname2_0))) - (if or-part_0 or-part_0 (string? family-hostname2_0))) - (void) - (raise-argument-error - 'udp-open-socket - "(or/c string? #f)" - family-hostname2_0)) - (if (let ((or-part_0 (not family-port-no3_0))) - (if or-part_0 - or-part_0 - (port-number? family-port-no3_0))) - (void) - (raise-argument-error - 'udp-open-socket - "(or/c port-number? #f)" - family-port-no3_0)) - (1/security-guard-check-network + (if (let ((or-part_0 (not family-hostname2_0))) + (if or-part_0 or-part_0 (string? family-hostname2_0))) + (void) + (raise-argument-error 'udp-open-socket - family-hostname2_0 - family-port-no3_0 - 'server) - (unsafe-start-atomic) - (begin0 - (let ((temp21_0 procz1)) - (call-with-resolved-address.1 - #f - unsafe-undefined - #f - #t - #f - #f - "" - 'udp-open-socket - family-hostname2_0 - family-port-no3_0 - temp21_0)) - (unsafe-end-atomic))))))))) + "(or/c string? #f)" + family-hostname2_0)) + (if (let ((or-part_0 (not family-port-no3_0))) + (if or-part_0 + or-part_0 + (port-number? family-port-no3_0))) + (void) + (raise-argument-error + 'udp-open-socket + "(or/c port-number? #f)" + family-port-no3_0)) + (1/security-guard-check-network + 'udp-open-socket + family-hostname2_0 + family-port-no3_0 + 'server) + (unsafe-start-atomic) + (begin0 + (let ((temp21_0 + (|#%name| + temp21 + (lambda (addr_0) + (begin + (let ((s_0 + (|#%app| + rktio_udp_open + (unsafe-place-local-ref cell.1) + addr_0 + (udp-default-family)))) + (if (vector? s_0) + (begin + (unsafe-end-atomic) + (raise-network-error + 'udp-open-socket + s_0 + "creation failed")) + (udp1.1 s_0 #f #f)))))))) + (call-with-resolved-address.1 + #f + unsafe-undefined + #f + #t + #f + #f + "" + 'udp-open-socket + family-hostname2_0 + family-port-no3_0 + temp21_0)) + (unsafe-end-atomic)))))))) (|#%name| udp-open-socket (case-lambda @@ -37579,107 +36261,110 @@ (unsafe-end-atomic))))))) (define 1/tcp-addresses (let ((tcp-addresses_0 - (letrec ((convert_0 - (|#%name| - convert - (lambda (bstr_0) - (begin (1/bytes->string/utf-8 bstr_0 '#\x3f)))))) - (|#%name| - tcp-addresses - (lambda (p2_0 port-numbers?1_0) + (|#%name| + tcp-addresses + (lambda (p2_0 port-numbers?1_0) + (begin (begin + (if (let ((or-part_0 (1/tcp-port? p2_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (1/tcp-listener? p2_0))) + (if or-part_1 or-part_1 (1/udp? p2_0))))) + (void) + (raise-argument-error + 'tcp-addresses + "(or/c tcp-port? tcp-listener? udp?)" + p2_0)) (begin - (if (let ((or-part_0 (1/tcp-port? p2_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (1/tcp-listener? p2_0))) - (if or-part_1 or-part_1 (1/udp? p2_0))))) - (void) - (raise-argument-error - 'tcp-addresses - "(or/c tcp-port? tcp-listener? udp?)" - p2_0)) - (begin - (unsafe-start-atomic) - (call-with-values - (lambda () - (if (1/tcp-listener? p2_0) - (if (begin-unsafe (unbox (tcp-listener-closed p2_0))) - (begin - (unsafe-end-atomic) - (raise-arguments-error - 'tcp-addresses - "listener is closed" - "listener" - p2_0)) - (values - (|#%app| - rktio_listener_address - (unsafe-place-local-ref cell.1) - (tcp-listener-lnr p2_0)) - #f)) - (let ((fd_0 - (if (1/udp? p2_0) + (unsafe-start-atomic) + (call-with-values + (lambda () + (if (1/tcp-listener? p2_0) + (if (begin-unsafe (unbox (tcp-listener-closed p2_0))) + (begin + (unsafe-end-atomic) + (raise-arguments-error + 'tcp-addresses + "listener is closed" + "listener" + p2_0)) + (values + (|#%app| + rktio_listener_address + (unsafe-place-local-ref cell.1) + (tcp-listener-lnr p2_0)) + #f)) + (let ((fd_0 + (if (1/udp? p2_0) + (begin + (check-udp-closed.1 + void + unsafe-undefined + 'tcp-addresses + p2_0) + (udp-s p2_0)) + (if (1/port-closed? p2_0) (begin - (check-udp-closed.1 - void - unsafe-undefined + (unsafe-end-atomic) + (raise-arguments-error 'tcp-addresses - p2_0) - (udp-s p2_0)) - (if (1/port-closed? p2_0) - (begin - (unsafe-end-atomic) - (raise-arguments-error - 'tcp-addresses - "port is closed" - "port" - p2_0)) - (fd-port-fd p2_0))))) - (let ((app_0 + "port is closed" + "port" + p2_0)) + (fd-port-fd p2_0))))) + (let ((app_0 + (|#%app| + rktio_socket_address + (unsafe-place-local-ref cell.1) + fd_0))) + (values + app_0 + (|#%app| + rktio_socket_peer_address + (unsafe-place-local-ref cell.1) + fd_0)))))) + (case-lambda + ((local-address_0 peer-address_0) + (let ((local-address-bytes_0 + (if (not (vector? local-address_0)) + (|#%app| rktio_to_bytes_list local-address_0 2) + #f))) + (let ((peer-address-bytes_0 + (if peer-address_0 + (if (not (vector? peer-address_0)) (|#%app| - rktio_socket_address - (unsafe-place-local-ref cell.1) - fd_0))) - (values - app_0 - (|#%app| - rktio_socket_peer_address - (unsafe-place-local-ref cell.1) - fd_0)))))) - (case-lambda - ((local-address_0 peer-address_0) - (let ((local-address-bytes_0 - (if (not (vector? local-address_0)) - (|#%app| rktio_to_bytes_list local-address_0 2) + rktio_to_bytes_list + peer-address_0 + 2) + #f) #f))) - (let ((peer-address-bytes_0 - (if peer-address_0 - (if (not (vector? peer-address_0)) - (|#%app| - rktio_to_bytes_list - peer-address_0 - 2) - #f) - #f))) + (begin + (unsafe-end-atomic) (begin - (unsafe-end-atomic) + (if (vector? local-address_0) + (raise-network-error + 'tcp-addresses + local-address_0 + "could not get address") + (void)) (begin - (if (vector? local-address_0) + (if (if (vector? peer-address_0) + (not (1/udp? p2_0)) + #f) (raise-network-error 'tcp-addresses - local-address_0 - "could not get address") + peer-address_0 + "could not get peer address") (void)) - (begin - (if (if (vector? peer-address_0) - (not (1/udp? p2_0)) - #f) - (raise-network-error - 'tcp-addresses - peer-address_0 - "could not get peer address") - (void)) + (let ((convert_0 + (|#%name| + convert + (lambda (bstr_0) + (begin + (1/bytes->string/utf-8 + bstr_0 + '#\x3f)))))) (let ((local-hostname_0 (convert_0 (car local-address-bytes_0)))) @@ -37705,9 +36390,8 @@ 0))) (values local-hostname_0 - peer-hostname_0)))))))))) - (args - (raise-binding-result-arity-error 2 args)))))))))))) + peer-hostname_0))))))))))) + (args (raise-binding-result-arity-error 2 args))))))))))) (|#%name| tcp-addresses (case-lambda @@ -38157,60 +36841,66 @@ temp127_0)) (unsafe-end-atomic))))))) (define do-udp-send-to-evt - (letrec ((procz1 (lambda (thunk_0) thunk_0))) - (lambda (who_0 u_0 hostname_0 port-no_0 bstr_0 start_0 end_0) - (begin - (unsafe-start-atomic) - (begin0 - (let ((temp141_0 - (|#%name| - temp141 - (lambda (addr_0) - (begin - (udp-sending-evt66.1 - u_0 - (lambda () - (begin - (if addr_0 - (register-address-finalizer addr_0) - (void)) - (let ((temp149_0 procz1)) - (do-udp-maybe-send-to-addr.1 - #f - temp149_0 - #f - who_0 - u_0 - addr_0 - bstr_0 - start_0 - end_0)))))))))) - (call-with-resolved-address.1 - #f - unsafe-undefined - #f - #t - #t - #f - "" - who_0 - hostname_0 - port-no_0 - temp141_0)) - (unsafe-end-atomic)))))) + (lambda (who_0 u_0 hostname_0 port-no_0 bstr_0 start_0 end_0) + (begin + (unsafe-start-atomic) + (begin0 + (let ((temp141_0 + (|#%name| + temp141 + (lambda (addr_0) + (begin + (udp-sending-evt66.1 + u_0 + (lambda () + (begin + (if addr_0 (register-address-finalizer addr_0) (void)) + (let ((temp149_0 (lambda (thunk_0) thunk_0))) + (do-udp-maybe-send-to-addr.1 + #f + temp149_0 + #f + who_0 + u_0 + addr_0 + bstr_0 + start_0 + end_0)))))))))) + (call-with-resolved-address.1 + #f + unsafe-undefined + #f + #t + #t + #f + "" + who_0 + hostname_0 + port-no_0 + temp141_0)) + (unsafe-end-atomic))))) (define do-udp-maybe-send-to-addr.1 - (letrec ((loop_0 + (|#%name| + do-udp-maybe-send-to-addr + (lambda (enable-break?54_0 + handle-error55_0 + wait?53_0 + who59_0 + u60_0 + addr61_0 + bstr62_0 + start63_0 + end64_0) + (begin + (let ((handle-error_0 + (if (eq? handle-error55_0 unsafe-undefined) + handle-error-immediately + handle-error55_0))) + (letrec* + ((loop_0 (|#%name| loop - (lambda (addr61_0 - bstr62_0 - enable-break?54_0 - end64_0 - handle-error_0 - start63_0 - u60_0 - wait?53_0 - who59_0) + (lambda () (begin (let ((temp153_0 (lambda () @@ -38284,16 +36974,7 @@ ps_0 2)))) (unsafe-start-atomic) - (loop_0 - addr61_0 - bstr62_0 - enable-break?54_0 - end64_0 - handle-error_0 - start63_0 - u60_0 - wait?53_0 - who59_0))) + (loop_0))) (if (= r_0 (- end64_0 start63_0)) (if wait?53_0 (void) #t) (|#%app| @@ -38321,32 +37002,7 @@ handle-error_0 who59_0 u60_0))))))) - (|#%name| - do-udp-maybe-send-to-addr - (lambda (enable-break?54_0 - handle-error55_0 - wait?53_0 - who59_0 - u60_0 - addr61_0 - bstr62_0 - start63_0 - end64_0) - (begin - (let ((handle-error_0 - (if (eq? handle-error55_0 unsafe-undefined) - handle-error-immediately - handle-error55_0))) - (loop_0 - addr61_0 - bstr62_0 - enable-break?54_0 - end64_0 - handle-error_0 - start63_0 - u60_0 - wait?53_0 - who59_0))))))) + (loop_0))))))) (define struct:udp-sending-evt (make-record-type-descriptor* 'udp-send-evt #f #f #f #f 2 0)) (define effect_2358 @@ -38531,37 +37187,34 @@ (unsafe-end-atomic))))))) (define 1/udp-receive!-evt (let ((udp-receive!-evt_0 - (letrec ((procz1 (lambda (thunk_0) thunk_0))) - (|#%name| - udp-receive!-evt - (lambda (u25_0 bstr26_0 start23_0 end24_0) - (begin - (let ((end_0 - (if (eq? end24_0 unsafe-undefined) - (if (bytes? bstr26_0) - (unsafe-bytes-length bstr26_0) - #f) - end24_0))) - (begin - (check-receive! - 'udp-receive!-evt - u25_0 - bstr26_0 - start23_0 - end_0) - (udp-receiving-evt39.1 - u25_0 - (lambda () - (let ((temp75_0 procz1)) - (do-udp-maybe-receive!.1 - #f - temp75_0 - #f - 'udp-receive!-evt - u25_0 - bstr26_0 - start23_0 - end_0)))))))))))) + (|#%name| + udp-receive!-evt + (lambda (u25_0 bstr26_0 start23_0 end24_0) + (begin + (let ((end_0 + (if (eq? end24_0 unsafe-undefined) + (if (bytes? bstr26_0) (unsafe-bytes-length bstr26_0) #f) + end24_0))) + (begin + (check-receive! + 'udp-receive!-evt + u25_0 + bstr26_0 + start23_0 + end_0) + (udp-receiving-evt39.1 + u25_0 + (lambda () + (let ((temp75_0 (lambda (thunk_0) thunk_0))) + (do-udp-maybe-receive!.1 + #f + temp75_0 + #f + 'udp-receive!-evt + u25_0 + bstr26_0 + start23_0 + end_0))))))))))) (|#%name| udp-receive!-evt (case-lambda @@ -38604,17 +37257,26 @@ (if (1/udp? u_0) (void) (raise-argument-error who_0 "udp?" u_0)) (check-bstr who_0 bstr_0 start_0 end_0)))) (define do-udp-maybe-receive!.1 - (letrec ((loop_0 + (|#%name| + do-udp-maybe-receive! + (lambda (enable-break?28_0 + handle-error29_0 + wait?27_0 + who33_0 + u34_0 + bstr35_0 + start36_0 + end37_0) + (begin + (let ((handle-error_0 + (if (eq? handle-error29_0 unsafe-undefined) + handle-error-immediately + handle-error29_0))) + (letrec* + ((loop_0 (|#%name| loop - (lambda (bstr35_0 - enable-break?28_0 - end37_0 - handle-error_0 - start36_0 - u34_0 - wait?27_0 - who33_0) + (lambda () (begin (let ((temp80_0 (lambda () @@ -38669,15 +37331,7 @@ ps_0 1)))) (unsafe-start-atomic) - (loop_0 - bstr35_0 - enable-break?28_0 - end37_0 - handle-error_0 - start36_0 - u34_0 - wait?27_0 - who33_0)) + (loop_0)) (values #f #f #f)) (|#%app| handle-error_0 @@ -38725,30 +37379,7 @@ handle-error_0 who33_0 u34_0))))))) - (|#%name| - do-udp-maybe-receive! - (lambda (enable-break?28_0 - handle-error29_0 - wait?27_0 - who33_0 - u34_0 - bstr35_0 - start36_0 - end37_0) - (begin - (let ((handle-error_0 - (if (eq? handle-error29_0 unsafe-undefined) - handle-error-immediately - handle-error29_0))) - (loop_0 - bstr35_0 - enable-break?28_0 - end37_0 - handle-error_0 - start36_0 - u34_0 - wait?27_0 - who33_0))))))) + (loop_0))))))) (define cell.1$2 (unsafe-make-place-local #vu8())) (define cell.2 (unsafe-make-place-local "")) (define struct:udp-receiving-evt @@ -39796,7 +38427,7 @@ 'current-command-line-arguments "(vectorof string?)" l_0)) - (list->vector (map_2960 string->immutable-string l_0))))) + (list->vector (map_1346 string->immutable-string l_0))))) 'current-command-line-arguments)) (define 1/current-print (make-parameter diff --git a/racket/src/cs/schemified/regexp.scm b/racket/src/cs/schemified/regexp.scm index db805f244f..e0b043cba3 100644 --- a/racket/src/cs/schemified/regexp.scm +++ b/racket/src/cs/schemified/regexp.scm @@ -431,37 +431,42 @@ (lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 1))) (lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 2)))))))) (define empty-stream (make-do-stream (lambda () #t) void void)) -(define map_2960 +(define map_1346 (|#%name| map - (letrec ((loop_0 - (|#%name| - loop - (lambda (f_0 l1_0 l2_0) - (begin - (if (null? l1_0) - null - (let ((r1_0 (cdr l1_0))) - (let ((r2_0 (cdr l2_0))) - (let ((r1_1 r1_0)) - (let ((app_0 - (let ((app_0 (car l1_0))) - (|#%app| f_0 app_0 (car l2_0))))) - (cons app_0 (loop_0 f_0 r1_1 r2_0))))))))))) - (loop_1 - (|#%name| - loop - (lambda (f_0 l_0) - (begin - (if (null? l_0) - null - (let ((r_0 (cdr l_0))) - (let ((app_0 (|#%app| f_0 (car l_0)))) - (cons app_0 (loop_1 f_0 r_0)))))))))) - (case-lambda - ((f_0 l_0) (begin (loop_1 f_0 l_0))) - ((f_0 l1_0 l2_0) (loop_0 f_0 l1_0 l2_0)) - ((f_0 l_0 . args_0) (gen-map f_0 (cons l_0 args_0))))))) + (case-lambda + ((f_0 l_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1) + (begin + (if (null? l_1) + null + (let ((r_0 (cdr l_1))) + (let ((app_0 (|#%app| f_0 (car l_1)))) + (cons app_0 (loop_0 r_0)))))))))) + (loop_0 l_0)))) + ((f_0 l1_0 l2_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l1_1 l2_1) + (begin + (if (null? l1_1) + null + (let ((r1_0 (cdr l1_1))) + (let ((r2_0 (cdr l2_1))) + (let ((r1_1 r1_0)) + (let ((app_0 + (let ((app_0 (car l1_1))) + (|#%app| f_0 app_0 (car l2_1))))) + (cons app_0 (loop_0 r1_1 r2_0)))))))))))) + (loop_0 l1_0 l2_0))) + ((f_0 l_0 . args_0) (gen-map f_0 (cons l_0 args_0)))))) (define ormap_2765 (|#%name| ormap @@ -503,144 +508,165 @@ (loop_0 l1_0 l2_0)))) ((f_0 l_0 . args_0) (gen-ormap f_0 (cons l_0 args_0)))))) (define check-args - (letrec ((loop_0 - (|#%name| - loop - (lambda (kws_0) - (begin - (if (null? kws_0) - null - (let ((app_0 - (string-append "#:" (keyword->string (car kws_0))))) - (list* " " app_0 (loop_0 (cdr kws_0))))))))) - (loop_1 - (|#%name| - loop - (lambda (w_0 ls_0) - (begin - (if (null? ls_0) - null - (let ((app_0 - (string-append - "\n " - (let ((app_0 (error-value->string-handler))) - (|#%app| app_0 (car ls_0) w_0))))) - (cons app_0 (loop_1 w_0 (cdr ls_0)))))))))) - (lambda (who_0 f_0 ls_0) - (begin - (if (procedure? f_0) - (void) - (raise-argument-error who_0 "procedure?" f_0)) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (prev-len_0 ls_1 i_0) - (begin - (if (null? ls_1) - (void) - (let ((l_0 (car ls_1))) - (begin - (if (list? l_0) - (void) - (raise-argument-error who_0 "list?" l_0)) - (let ((len_0 (length l_0))) - (begin - (if (if prev-len_0 (not (= len_0 prev-len_0)) #f) - (raise-arguments-error - who_0 - "all lists must have same size" - "first list length" - prev-len_0 - "other list length" - len_0 - "procedure" - f_0) - (void)) - (let ((app_0 (cdr ls_1))) - (loop_2 len_0 app_0 (add1 i_0))))))))))))) - (loop_2 #f ls_0 1)) - (if (procedure-arity-includes? f_0 (length ls_0)) - (void) - (call-with-values - (lambda () (procedure-keywords f_0)) - (case-lambda - ((required-keywords_0 optional-keywords_0) - (let ((app_0 - (if (pair? required-keywords_0) - (string-append - "argument mismatch;\n" - " the given procedure expects keyword arguments") - (string-append - "argument mismatch;\n" - " the given procedure's expected number of arguments does not match" - " the given number of lists")))) - (let ((app_1 - (unquoted-printing-string - (let ((or-part_0 - (let ((n_0 (object-name f_0))) - (if (symbol? n_0) (symbol->string n_0) #f)))) - (if or-part_0 or-part_0 "#"))))) - (apply - raise-arguments-error - who_0 - app_0 - "given procedure" - app_1 - (let ((app_2 - (let ((a_0 (procedure-arity f_0))) - (if (pair? required-keywords_0) - null - (if (integer? a_0) - (list "expected" a_0) - (if (arity-at-least? a_0) - (list - "expected" - (unquoted-printing-string - (string-append - "at least " - (number->string - (arity-at-least-value a_0))))) - null)))))) - (let ((app_3 - (if (pair? required-keywords_0) - null - (list "given" (length ls_0))))) - (let ((app_4 - (if (pair? required-keywords_0) + (lambda (who_0 f_0 ls_0) + (begin + (if (procedure? f_0) + (void) + (raise-argument-error who_0 "procedure?" f_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (prev-len_0 ls_1 i_0) + (begin + (if (null? ls_1) + (void) + (let ((l_0 (car ls_1))) + (begin + (if (list? l_0) + (void) + (raise-argument-error who_0 "list?" l_0)) + (let ((len_0 (length l_0))) + (begin + (if (if prev-len_0 (not (= len_0 prev-len_0)) #f) + (raise-arguments-error + who_0 + "all lists must have same size" + "first list length" + prev-len_0 + "other list length" + len_0 + "procedure" + f_0) + (void)) + (let ((app_0 (cdr ls_1))) + (loop_0 len_0 app_0 (add1 i_0))))))))))))) + (loop_0 #f ls_0 1)) + (if (procedure-arity-includes? f_0 (length ls_0)) + (void) + (call-with-values + (lambda () (procedure-keywords f_0)) + (case-lambda + ((required-keywords_0 optional-keywords_0) + (let ((app_0 + (if (pair? required-keywords_0) + (string-append + "argument mismatch;\n" + " the given procedure expects keyword arguments") + (string-append + "argument mismatch;\n" + " the given procedure's expected number of arguments does not match" + " the given number of lists")))) + (let ((app_1 + (unquoted-printing-string + (let ((or-part_0 + (let ((n_0 (object-name f_0))) + (if (symbol? n_0) (symbol->string n_0) #f)))) + (if or-part_0 or-part_0 "#"))))) + (apply + raise-arguments-error + who_0 + app_0 + "given procedure" + app_1 + (let ((app_2 + (let ((a_0 (procedure-arity f_0))) + (if (pair? required-keywords_0) + null + (if (integer? a_0) + (list "expected" a_0) + (if (arity-at-least? a_0) (list - "required keywords" + "expected" (unquoted-printing-string - (apply - string-append - (cdr (loop_0 required-keywords_0))))) - null))) - (append - app_2 - app_3 - app_4 - (let ((w_0 - (let ((app_5 (error-print-width))) - (quotient app_5 (length ls_0))))) - (if (> w_0 10) + (string-append + "at least " + (number->string + (arity-at-least-value a_0))))) + null)))))) + (let ((app_3 + (if (pair? required-keywords_0) + null + (list "given" (length ls_0))))) + (let ((app_4 + (if (pair? required-keywords_0) (list - "argument lists..." + "required keywords" (unquoted-printing-string - (apply string-append (loop_1 w_0 ls_0)))) - null)))))))))) - (args (raise-binding-result-arity-error 2 args))))))))) + (apply + string-append + (cdr + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (kws_0) + (begin + (if (null? kws_0) + null + (let ((app_4 + (string-append + "#:" + (keyword->string + (car kws_0))))) + (list* + " " + app_4 + (loop_0 (cdr kws_0)))))))))) + (loop_0 required-keywords_0)))))) + null))) + (append + app_2 + app_3 + app_4 + (let ((w_0 + (let ((app_5 (error-print-width))) + (quotient app_5 (length ls_0))))) + (if (> w_0 10) + (list + "argument lists..." + (unquoted-printing-string + (apply + string-append + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ls_1) + (begin + (if (null? ls_1) + null + (let ((app_5 + (string-append + "\n " + (let ((app_5 + (error-value->string-handler))) + (|#%app| + app_5 + (car ls_1) + w_0))))) + (cons + app_5 + (loop_0 (cdr ls_1)))))))))) + (loop_0 ls_0))))) + null)))))))))) + (args (raise-binding-result-arity-error 2 args)))))))) (define gen-map - (letrec ((loop_0 - (|#%name| - loop - (lambda (f_0 ls_0) - (begin - (if (null? (car ls_0)) - null - (let ((next-ls_0 (map_2960 cdr ls_0))) - (let ((app_0 (apply f_0 (map_2960 car ls_0)))) - (cons app_0 (loop_0 f_0 next-ls_0)))))))))) - (lambda (f_0 ls_0) (begin #t (loop_0 f_0 ls_0))))) + (lambda (f_0 ls_0) + (begin + #t + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ls_1) + (begin + (if (null? (car ls_1)) + null + (let ((next-ls_0 (map_1346 cdr ls_1))) + (let ((app_0 (apply f_0 (map_1346 car ls_1)))) + (cons app_0 (loop_0 next-ls_0)))))))))) + (loop_0 ls_0))))) (define gen-ormap (lambda (f_0 ls_0) (begin @@ -654,9 +680,9 @@ (if (null? (car ls_1)) #f (if (null? (cdar ls_1)) - (apply f_0 (map_2960 car ls_1)) - (let ((next-ls_0 (map_2960 cdr ls_1))) - (let ((or-part_0 (apply f_0 (map_2960 car ls_1)))) + (apply f_0 (map_1346 car ls_1)) + (let ((next-ls_0 (map_1346 cdr ls_1))) + (let ((or-part_0 (apply f_0 (map_1346 car ls_1)))) (if or-part_0 or-part_0 (loop_0 next-ls_0))))))))))) (loop_0 ls_0))))) (define regexp-error-tag (make-continuation-prompt-tag 'regexp-error)) @@ -684,24 +710,23 @@ (define chytes-limit (lambda (s_0) (if (bytes? s_0) 255 1114111))) (define empty-range null) (define range-invert - (letrec ((loop_0 - (|#%name| - loop - (lambda (limit-c_0 r_0 start_0) - (begin - (if (null? r_0) - (if (> start_0 limit-c_0) - null - (list (cons start_0 limit-c_0))) - (if (= start_0 (caar r_0)) - (let ((app_0 (cdr r_0))) - (loop_0 limit-c_0 app_0 (add1 (cdar r_0)))) - (let ((app_0 (cons start_0 (sub1 (caar r_0))))) - (cons - app_0 - (let ((app_1 (cdr r_0))) - (loop_0 limit-c_0 app_1 (add1 (cdar r_0))))))))))))) - (lambda (r_0 limit-c_0) (loop_0 limit-c_0 r_0 0)))) + (lambda (r_0 limit-c_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (r_1 start_0) + (begin + (if (null? r_1) + (if (> start_0 limit-c_0) null (list (cons start_0 limit-c_0))) + (if (= start_0 (caar r_1)) + (let ((app_0 (cdr r_1))) (loop_0 app_0 (add1 (cdar r_1)))) + (let ((app_0 (cons start_0 (sub1 (caar r_1))))) + (cons + app_0 + (let ((app_1 (cdr r_1))) + (loop_0 app_1 (add1 (cdar r_1))))))))))))) + (loop_0 r_0 0)))) (define range-in? (lambda (r_0 v_0) (begin @@ -1860,132 +1885,125 @@ merged-l_0 (ormap_2765 needs-backtrack? merged-l_0)))))))) (define merge-adjacent - (letrec ((loop_0 - (|#%name| - loop - (lambda (mode_0 accum_0 l_0) - (begin - (if (if (pair? l_0) (rx:sequence? (car l_0)) #f) - (loop_0 - mode_0 - accum_0 - (let ((app_0 (rx:sequence-rxs (car l_0)))) - (append app_0 (cdr l_0)))) - (if (if (pair? l_0) - (let ((or-part_0 (eq? 'empty (car l_0)))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (equal? "" (car l_0)))) - (if or-part_1 or-part_1 (equal? #vu8() (car l_0)))))) - #f) - (loop_0 mode_0 accum_0 (cdr l_0)) - (if (let ((or-part_0 (null? l_0))) - (if or-part_0 - or-part_0 - (not - (if (eq? mode_0 'byte) - (let ((or-part_1 (byte? (car l_0)))) - (if or-part_1 or-part_1 (bytes? (car l_0)))) - (if (eq? mode_0 'char) - (let ((or-part_1 (integer? (car l_0)))) - (if or-part_1 - or-part_1 - (string? (car l_0)))) - #t))))) - (if (null? accum_0) - null - (if (null? (cdr accum_0)) - (let ((app_0 (car accum_0))) - (cons app_0 (loop_0 #f null l_0))) - (let ((app_0 - (if (eq? mode_0 'byte) - (apply - bytes-append - (reverse$1 - (let ((lst_0 (reverse$1 accum_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_1) - (begin - (if (pair? lst_1) - (let ((a_0 - (unsafe-car lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if (byte? - a_0) - (bytes - a_0) - a_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null lst_0)))))) - (if (eq? mode_0 'char) - (apply - string-append - (reverse$1 - (let ((lst_0 (reverse$1 accum_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_1) - (begin - (if (pair? lst_1) - (let ((a_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) + (lambda (l_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (mode_0 accum_0 l_1) + (begin + (if (if (pair? l_1) (rx:sequence? (car l_1)) #f) + (loop_0 + mode_0 + accum_0 + (let ((app_0 (rx:sequence-rxs (car l_1)))) + (append app_0 (cdr l_1)))) + (if (if (pair? l_1) + (let ((or-part_0 (eq? 'empty (car l_1)))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (equal? "" (car l_1)))) + (if or-part_1 or-part_1 (equal? #vu8() (car l_1)))))) + #f) + (loop_0 mode_0 accum_0 (cdr l_1)) + (if (let ((or-part_0 (null? l_1))) + (if or-part_0 + or-part_0 + (not + (if (eq? mode_0 'byte) + (let ((or-part_1 (byte? (car l_1)))) + (if or-part_1 or-part_1 (bytes? (car l_1)))) + (if (eq? mode_0 'char) + (let ((or-part_1 (integer? (car l_1)))) + (if or-part_1 or-part_1 (string? (car l_1)))) + #t))))) + (if (null? accum_0) + null + (if (null? (cdr accum_0)) + (let ((app_0 (car accum_0))) + (cons app_0 (loop_0 #f null l_1))) + (let ((app_0 + (if (eq? mode_0 'byte) + (apply + bytes-append + (reverse$1 + (let ((lst_0 (reverse$1 accum_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_1) + (begin + (if (pair? lst_1) + (let ((a_0 (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) + (let ((fold-var_1 (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if (integer? - a_0) - (string - (integer->char - a_0)) - a_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null lst_0)))))) - (error "internal error"))))) - (cons app_0 (loop_0 #f null l_0))))) - (if mode_0 - (let ((app_0 (cons (car l_0) accum_0))) - (loop_0 mode_0 app_0 (cdr l_0))) - (if (let ((or-part_0 (byte? (car l_0)))) - (if or-part_0 or-part_0 (bytes? (car l_0)))) - (let ((app_0 (list (car l_0)))) - (loop_0 'byte app_0 (cdr l_0))) - (if (let ((or-part_0 (integer? (car l_0)))) - (if or-part_0 or-part_0 (string? (car l_0)))) - (let ((app_0 (list (car l_0)))) - (loop_0 'char app_0 (cdr l_0))) - (let ((app_0 (car l_0))) - (cons - app_0 - (loop_0 #f null (cdr l_0))))))))))))))) - (lambda (l_0) (loop_0 #f null l_0)))) + (cons + (if (byte? + a_0) + (bytes a_0) + a_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 null lst_0)))))) + (if (eq? mode_0 'char) + (apply + string-append + (reverse$1 + (let ((lst_0 (reverse$1 accum_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_1) + (begin + (if (pair? lst_1) + (let ((a_0 + (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if (integer? + a_0) + (string + (integer->char + a_0)) + a_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 null lst_0)))))) + (error "internal error"))))) + (cons app_0 (loop_0 #f null l_1))))) + (if mode_0 + (let ((app_0 (cons (car l_1) accum_0))) + (loop_0 mode_0 app_0 (cdr l_1))) + (if (let ((or-part_0 (byte? (car l_1)))) + (if or-part_0 or-part_0 (bytes? (car l_1)))) + (let ((app_0 (list (car l_1)))) + (loop_0 'byte app_0 (cdr l_1))) + (if (let ((or-part_0 (integer? (car l_1)))) + (if or-part_0 or-part_0 (string? (car l_1)))) + (let ((app_0 (list (car l_1)))) + (loop_0 'char app_0 (cdr l_1))) + (let ((app_0 (car l_1))) + (cons app_0 (loop_0 #f null (cdr l_1))))))))))))))) + (loop_0 #f null l_0)))) (define rx-alts (lambda (rx1_0 rx2_0 limit-c_0) (if (eq? 'never rx1_0) @@ -2232,30 +2250,27 @@ (lambda (s_0 pos_0 config_0 fmt_0 . args_0) (apply regexp-error fmt_0 args_0))) (define parse-class - (letrec ((success_0 - (|#%name| - success - (lambda (pos_0 v_0) (begin (values #t v_0 (add1 pos_0))))))) - (lambda (s_0 pos_0 config_0) + (lambda (s_0 pos_0 config_0) + (let ((success_0 + (|#%name| + success + (lambda (v_0) (begin (values #t v_0 (add1 pos_0))))))) (let ((tmp_0 (integer->char (chytes-ref$1 s_0 pos_0)))) (if (eqv? tmp_0 '#\x64) - (success_0 pos_0 (range:d)) + (success_0 (range:d)) (if (eqv? tmp_0 '#\x44) (success_0 - pos_0 (let ((app_0 (range:d))) (range-invert app_0 (chytes-limit s_0)))) (if (eqv? tmp_0 '#\x77) - (success_0 pos_0 (range:w)) + (success_0 (range:w)) (if (eqv? tmp_0 '#\x57) (success_0 - pos_0 (let ((app_0 (range:w))) (range-invert app_0 (chytes-limit s_0)))) (if (eqv? tmp_0 '#\x73) - (success_0 pos_0 (range:s)) + (success_0 (range:s)) (if (eqv? tmp_0 '#\x53) (success_0 - pos_0 (let ((app_0 (range:s))) (range-invert app_0 (chytes-limit s_0)))) (values #f #f #f))))))))))) @@ -2277,278 +2292,268 @@ (let ((r_3 (range-add r_2 12))) (let ((r_4 (range-add r_3 13))) r_4))))))) (define parse-posix-char-class - (letrec ((procz1 (lambda () 0))) - (lambda (s_0 pos_0) - (let ((pos_1 pos_0)) - (let ((tmp_0 - (if (= pos_1 (chytes-length$1 s_0)) - 'eos - (chytes-ref/char s_0 pos_1)))) - (if (eqv? tmp_0 '#\x3a) - (let ((class_0 - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (accum_0 pos_2) - (begin - (if (= pos_2 (chytes-length$1 s_0)) - #f - (let ((c_0 (chytes-ref$1 s_0 pos_2))) - (if (if (>= c_0 97) (<= c_0 122) #f) - (loop_0 (cons c_0 accum_0) (add1 pos_2)) - (if (if (= c_0 58) - (if (let ((app_0 (add1 pos_2))) - (< app_0 (chytes-length$1 s_0))) - (= (chytes-ref$1 s_0 (add1 pos_2)) 93) - #f) + (lambda (s_0 pos_0) + (let ((pos_1 pos_0)) + (let ((tmp_0 + (if (= pos_1 (chytes-length$1 s_0)) + 'eos + (chytes-ref/char s_0 pos_1)))) + (if (eqv? tmp_0 '#\x3a) + (let ((class_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (accum_0 pos_2) + (begin + (if (= pos_2 (chytes-length$1 s_0)) + #f + (let ((c_0 (chytes-ref$1 s_0 pos_2))) + (if (if (>= c_0 97) (<= c_0 122) #f) + (loop_0 (cons c_0 accum_0) (add1 pos_2)) + (if (if (= c_0 58) + (if (let ((app_0 (add1 pos_2))) + (< app_0 (chytes-length$1 s_0))) + (= (chytes-ref$1 s_0 (add1 pos_2)) 93) #f) - (list->bytes (reverse$1 accum_0)) - #f))))))))) - (loop_0 null (add1 pos_0))))) - (let ((range_0 - (let ((index_0 (hash-ref hash1688 class_0 procz1))) - (if (unsafe-fx< index_0 6) - (if (unsafe-fx< index_0 2) - (if (unsafe-fx< index_0 1) - #f - (let ((range_0 - (begin-unsafe - (range-union null (list (cons 97 122)))))) - (begin-unsafe - (range-union range_0 (list (cons 65 90)))))) - (if (unsafe-fx< index_0 3) - (begin-unsafe - (range-union null (list (cons 65 90)))) - (if (unsafe-fx< index_0 4) - (begin-unsafe - (range-union null (list (cons 97 122)))) - (if (unsafe-fx< index_0 5) - (begin-unsafe - (range-union null (list (cons 48 57)))) - (let ((range_0 - (let ((range_0 - (begin-unsafe - (range-union - null - (list (cons 48 57)))))) - (begin-unsafe - (range-union - range_0 - (list (cons 97 102))))))) - (begin-unsafe - (range-union - range_0 - (list (cons 65 70))))))))) - (if (unsafe-fx< index_0 9) - (if (unsafe-fx< index_0 7) - (let ((range_0 - (let ((range_0 - (begin-unsafe - (range-union - null - (list (cons 48 57)))))) - (begin-unsafe - (range-union - range_0 - (list (cons 97 122))))))) - (begin-unsafe - (range-union range_0 (list (cons 65 90))))) - (if (unsafe-fx< index_0 8) - (range-add - (let ((range_0 - (begin-unsafe - (range-union - null - (list (cons 97 122)))))) + #f) + (list->bytes (reverse$1 accum_0)) + #f))))))))) + (loop_0 null (add1 pos_0))))) + (let ((range_0 + (let ((index_0 (hash-ref hash1688 class_0 (lambda () 0)))) + (if (unsafe-fx< index_0 6) + (if (unsafe-fx< index_0 2) + (if (unsafe-fx< index_0 1) + #f + (let ((range_0 (begin-unsafe - (range-union range_0 (list (cons 65 90))))) - 95) - (range-add (range-add null 32) 9))) - (if (unsafe-fx< index_0 10) - (range:s) - (if (unsafe-fx< index_0 11) + (range-union null (list (cons 97 122)))))) + (begin-unsafe + (range-union range_0 (list (cons 65 90)))))) + (if (unsafe-fx< index_0 3) + (begin-unsafe + (range-union null (list (cons 65 90)))) + (if (unsafe-fx< index_0 4) + (begin-unsafe + (range-union null (list (cons 97 122)))) + (if (unsafe-fx< index_0 5) + (begin-unsafe + (range-union null (list (cons 48 57)))) (let ((range_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (range_0 pos_2) - (begin - (if (unsafe-fx< pos_2 128) - (let ((range_1 - (let ((range_1 - (if (char-graphic? - (integer->char - pos_2)) - (range-add - range_0 - pos_2) - range_0))) - (values range_1)))) - (for-loop_0 - range_1 - (unsafe-fx+ pos_2 1))) - range_0)))))) - (for-loop_0 null 0))))) - (if (equal? class_0 #vu8(112 114 105 110 116)) - (range-add (range-add range_0 32) 9) - range_0)) - (if (unsafe-fx< index_0 12) - (begin-unsafe - (range-union null (list (cons 0 31)))) + (let ((range_0 + (begin-unsafe + (range-union + null + (list (cons 48 57)))))) + (begin-unsafe + (range-union + range_0 + (list (cons 97 102))))))) (begin-unsafe (range-union - null - (list (cons 0 127)))))))))))) - (if range_0 - (values #t range_0 (+ pos_0 3 (unsafe-bytes-length class_0))) - (values #f #f #f)))) - (values #f #f #f))))))) + range_0 + (list (cons 65 70))))))))) + (if (unsafe-fx< index_0 9) + (if (unsafe-fx< index_0 7) + (let ((range_0 + (let ((range_0 + (begin-unsafe + (range-union + null + (list (cons 48 57)))))) + (begin-unsafe + (range-union + range_0 + (list (cons 97 122))))))) + (begin-unsafe + (range-union range_0 (list (cons 65 90))))) + (if (unsafe-fx< index_0 8) + (range-add + (let ((range_0 + (begin-unsafe + (range-union + null + (list (cons 97 122)))))) + (begin-unsafe + (range-union range_0 (list (cons 65 90))))) + 95) + (range-add (range-add null 32) 9))) + (if (unsafe-fx< index_0 10) + (range:s) + (if (unsafe-fx< index_0 11) + (let ((range_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (range_0 pos_2) + (begin + (if (unsafe-fx< pos_2 128) + (let ((range_1 + (let ((range_1 + (if (char-graphic? + (integer->char + pos_2)) + (range-add + range_0 + pos_2) + range_0))) + (values range_1)))) + (for-loop_0 + range_1 + (unsafe-fx+ pos_2 1))) + range_0)))))) + (for-loop_0 null 0))))) + (if (equal? class_0 #vu8(112 114 105 110 116)) + (range-add (range-add range_0 32) 9) + range_0)) + (if (unsafe-fx< index_0 12) + (begin-unsafe + (range-union null (list (cons 0 31)))) + (begin-unsafe + (range-union null (list (cons 0 127)))))))))))) + (if range_0 + (values #t range_0 (+ pos_0 3 (unsafe-bytes-length class_0))) + (values #f #f #f)))) + (values #f #f #f)))))) (define xor (lambda (a_0 b_0) (if a_0 (if b_0 #f a_0) b_0))) (define parse-unicode-categories - (letrec ((procz1 (lambda () 0))) - (lambda (p-c_0 s_0 pos_0 config_0) - (let ((tmp_0 - (if (= pos_0 (chytes-length$1 s_0)) - 'eos - (chytes-ref/char s_0 pos_0)))) - (if (eqv? tmp_0 '#\x7b) - (call-with-values - (lambda () - (let ((pos_1 (add1 pos_0))) - (let ((tmp_1 - (if (= pos_1 (chytes-length$1 s_0)) - 'eos - (chytes-ref/char s_0 pos_1)))) - (if (eqv? tmp_1 '#\x5e) - (values #t (+ pos_0 2)) - (values #f (add1 pos_0)))))) - (case-lambda - ((cat-negated?_0 next-pos_0) - (call-with-values - (lambda () - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (accum_0 pos_1) - (begin - (let ((tmp_1 - (if (= pos_1 (chytes-length$1 s_0)) - 'eos - (chytes-ref/char s_0 pos_1)))) - (if (eq? tmp_1 'eos) - (let ((fmt_0 "missing `}` to close `\\~a{`")) - (let ((args_0 (list (integer->char p-c_0)))) - (let ((fmt_1 fmt_0)) - (begin-unsafe - (apply regexp-error fmt_1 args_0))))) - (if (eqv? tmp_1 '#\x7d) - (let ((app_0 (reverse$1 accum_0))) - (values app_0 (add1 pos_1))) - (let ((app_0 - (cons (chytes-ref$1 s_0 pos_1) accum_0))) - (loop_0 app_0 (add1 pos_1))))))))))) - (loop_0 null next-pos_0))) - (case-lambda - ((l_0 pos2_0) - (let ((categories_0 - (let ((tmp_1 (list->bytes l_0))) - (let ((index_0 (hash-ref hash2956 tmp_1 procz1))) - (if (unsafe-fx< index_0 19) - (if (unsafe-fx< index_0 9) - (if (unsafe-fx< index_0 4) - (if (unsafe-fx< index_0 1) - (let ((fmt_0 - "unrecognized property name in `\\~a{}`: `~a`")) - (let ((args_0 - (let ((app_0 - (integer->char p-c_0))) - (list - app_0 - (list->string - (map_2960 - integer->char - l_0)))))) - (let ((fmt_1 fmt_0)) - (begin-unsafe - (apply regexp-error fmt_1 args_0))))) - (if (unsafe-fx< index_0 2) - 'll - (if (unsafe-fx< index_0 3) 'lu 'lt))) - (if (unsafe-fx< index_0 6) - (if (unsafe-fx< index_0 5) - 'lm - '(ll lu lt lm)) - (if (unsafe-fx< index_0 7) - 'lo - (if (unsafe-fx< index_0 8) - '(ll lu lt lm lo) - 'nd)))) - (if (unsafe-fx< index_0 13) - (if (unsafe-fx< index_0 10) - 'nl - (if (unsafe-fx< index_0 11) - 'no - (if (unsafe-fx< index_0 12) - '(nd nl no) - 'ps))) - (if (unsafe-fx< index_0 15) - (if (unsafe-fx< index_0 14) 'pe 'pi) - (if (unsafe-fx< index_0 16) - 'pf - (if (unsafe-fx< index_0 17) - 'pc - (if (unsafe-fx< index_0 18) - 'pd - 'po)))))) - (if (unsafe-fx< index_0 29) - (if (unsafe-fx< index_0 23) - (if (unsafe-fx< index_0 20) - '(ps pe pi pf pc pd po) - (if (unsafe-fx< index_0 21) - 'mn - (if (unsafe-fx< index_0 22) 'mc 'me))) - (if (unsafe-fx< index_0 25) - (if (unsafe-fx< index_0 24) '(mn mc me) 'sc) - (if (unsafe-fx< index_0 26) - 'sk - (if (unsafe-fx< index_0 27) - 'sm - (if (unsafe-fx< index_0 28) - 'so - '(sc sk sm so)))))) - (if (unsafe-fx< index_0 34) - (if (unsafe-fx< index_0 31) - (if (unsafe-fx< index_0 30) 'zl 'zp) - (if (unsafe-fx< index_0 32) - 'zs - (if (unsafe-fx< index_0 33) - '(zl zp zs) - 'cc))) - (if (unsafe-fx< index_0 36) - (if (unsafe-fx< index_0 35) 'cf 'cs) - (if (unsafe-fx< index_0 37) - 'cn - (if (unsafe-fx< index_0 38) - 'co - (if (unsafe-fx< index_0 39) - '(cc cf cs cn so) - #t))))))))))) - (let ((prop-negated?_0 (= p-c_0 80))) - (values - (rx:unicode-categories12.1 - categories_0 - (not (xor prop-negated?_0 cat-negated?_0))) - pos2_0)))) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (let ((fmt_0 "expected `{` after `\\~a`")) - (let ((args_0 (list (integer->char p-c_0)))) - (let ((fmt_1 fmt_0)) - (begin-unsafe (apply regexp-error fmt_1 args_0)))))))))) + (lambda (p-c_0 s_0 pos_0 config_0) + (let ((tmp_0 + (if (= pos_0 (chytes-length$1 s_0)) + 'eos + (chytes-ref/char s_0 pos_0)))) + (if (eqv? tmp_0 '#\x7b) + (call-with-values + (lambda () + (let ((pos_1 (add1 pos_0))) + (let ((tmp_1 + (if (= pos_1 (chytes-length$1 s_0)) + 'eos + (chytes-ref/char s_0 pos_1)))) + (if (eqv? tmp_1 '#\x5e) + (values #t (+ pos_0 2)) + (values #f (add1 pos_0)))))) + (case-lambda + ((cat-negated?_0 next-pos_0) + (call-with-values + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (accum_0 pos_1) + (begin + (let ((tmp_1 + (if (= pos_1 (chytes-length$1 s_0)) + 'eos + (chytes-ref/char s_0 pos_1)))) + (if (eq? tmp_1 'eos) + (let ((fmt_0 "missing `}` to close `\\~a{`")) + (let ((args_0 (list (integer->char p-c_0)))) + (let ((fmt_1 fmt_0)) + (begin-unsafe + (apply regexp-error fmt_1 args_0))))) + (if (eqv? tmp_1 '#\x7d) + (let ((app_0 (reverse$1 accum_0))) + (values app_0 (add1 pos_1))) + (let ((app_0 + (cons (chytes-ref$1 s_0 pos_1) accum_0))) + (loop_0 app_0 (add1 pos_1))))))))))) + (loop_0 null next-pos_0))) + (case-lambda + ((l_0 pos2_0) + (let ((categories_0 + (let ((tmp_1 (list->bytes l_0))) + (let ((index_0 + (hash-ref hash2956 tmp_1 (lambda () 0)))) + (if (unsafe-fx< index_0 19) + (if (unsafe-fx< index_0 9) + (if (unsafe-fx< index_0 4) + (if (unsafe-fx< index_0 1) + (let ((fmt_0 + "unrecognized property name in `\\~a{}`: `~a`")) + (let ((args_0 + (let ((app_0 (integer->char p-c_0))) + (list + app_0 + (list->string + (map_1346 integer->char l_0)))))) + (let ((fmt_1 fmt_0)) + (begin-unsafe + (apply regexp-error fmt_1 args_0))))) + (if (unsafe-fx< index_0 2) + 'll + (if (unsafe-fx< index_0 3) 'lu 'lt))) + (if (unsafe-fx< index_0 6) + (if (unsafe-fx< index_0 5) 'lm '(ll lu lt lm)) + (if (unsafe-fx< index_0 7) + 'lo + (if (unsafe-fx< index_0 8) + '(ll lu lt lm lo) + 'nd)))) + (if (unsafe-fx< index_0 13) + (if (unsafe-fx< index_0 10) + 'nl + (if (unsafe-fx< index_0 11) + 'no + (if (unsafe-fx< index_0 12) + '(nd nl no) + 'ps))) + (if (unsafe-fx< index_0 15) + (if (unsafe-fx< index_0 14) 'pe 'pi) + (if (unsafe-fx< index_0 16) + 'pf + (if (unsafe-fx< index_0 17) + 'pc + (if (unsafe-fx< index_0 18) 'pd 'po)))))) + (if (unsafe-fx< index_0 29) + (if (unsafe-fx< index_0 23) + (if (unsafe-fx< index_0 20) + '(ps pe pi pf pc pd po) + (if (unsafe-fx< index_0 21) + 'mn + (if (unsafe-fx< index_0 22) 'mc 'me))) + (if (unsafe-fx< index_0 25) + (if (unsafe-fx< index_0 24) '(mn mc me) 'sc) + (if (unsafe-fx< index_0 26) + 'sk + (if (unsafe-fx< index_0 27) + 'sm + (if (unsafe-fx< index_0 28) + 'so + '(sc sk sm so)))))) + (if (unsafe-fx< index_0 34) + (if (unsafe-fx< index_0 31) + (if (unsafe-fx< index_0 30) 'zl 'zp) + (if (unsafe-fx< index_0 32) + 'zs + (if (unsafe-fx< index_0 33) + '(zl zp zs) + 'cc))) + (if (unsafe-fx< index_0 36) + (if (unsafe-fx< index_0 35) 'cf 'cs) + (if (unsafe-fx< index_0 37) + 'cn + (if (unsafe-fx< index_0 38) + 'co + (if (unsafe-fx< index_0 39) + '(cc cf cs cn so) + #t))))))))))) + (let ((prop-negated?_0 (= p-c_0 80))) + (values + (rx:unicode-categories12.1 + categories_0 + (not (xor prop-negated?_0 cat-negated?_0))) + pos2_0)))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))) + (let ((fmt_0 "expected `{` after `\\~a`")) + (let ((args_0 (list (integer->char p-c_0)))) + (let ((fmt_1 fmt_0)) + (begin-unsafe (apply regexp-error fmt_1 args_0))))))))) (define range-add* (lambda (range_0 c_0 config_0) (if (not c_0) @@ -2868,40 +2873,39 @@ (unbox (parse-config-references?-box config_0))))) (args (raise-binding-result-arity-error 2 args))))))))) (define parse-regexp.1 - (letrec ((procz1 - (|#%name| - parse-regexp - (lambda (s_0 pos_0 config_0) - (begin (parse-regexp.1 unsafe-undefined s_0 pos_0 config_0)))))) - (|#%name| - parse-regexp - (lambda (parse-regexp5_0 s7_0 pos8_0 config9_0) - (begin - (let ((parse-regexp_0 - (if (eq? parse-regexp5_0 unsafe-undefined) - procz1 - parse-regexp5_0))) - (call-with-values - (lambda () (parse-pces s7_0 pos8_0 config9_0)) - (case-lambda - ((rxs_0 pos2_0) - (let ((tmp_0 - (if (= pos2_0 (chytes-length$1 s7_0)) - 'eos - (chytes-ref/char s7_0 pos2_0)))) - (if (eqv? tmp_0 '#\x7c) - (call-with-values - (lambda () - (|#%app| parse-regexp_0 s7_0 (add1 pos2_0) config9_0)) - (case-lambda - ((rx_0 pos3_0) - (values - (let ((app_0 (rx-sequence rxs_0))) - (rx-alts app_0 rx_0 (chytes-limit s7_0))) - pos3_0)) - (args (raise-binding-result-arity-error 2 args)))) - (values (rx-sequence rxs_0) pos2_0)))) - (args (raise-binding-result-arity-error 2 args)))))))))) + (|#%name| + parse-regexp + (lambda (parse-regexp5_0 s7_0 pos8_0 config9_0) + (begin + (let ((parse-regexp_0 + (if (eq? parse-regexp5_0 unsafe-undefined) + (|#%name| + parse-regexp + (lambda (s_0 pos_0 config_0) + (begin + (parse-regexp.1 unsafe-undefined s_0 pos_0 config_0)))) + parse-regexp5_0))) + (call-with-values + (lambda () (parse-pces s7_0 pos8_0 config9_0)) + (case-lambda + ((rxs_0 pos2_0) + (let ((tmp_0 + (if (= pos2_0 (chytes-length$1 s7_0)) + 'eos + (chytes-ref/char s7_0 pos2_0)))) + (if (eqv? tmp_0 '#\x7c) + (call-with-values + (lambda () + (|#%app| parse-regexp_0 s7_0 (add1 pos2_0) config9_0)) + (case-lambda + ((rx_0 pos3_0) + (values + (let ((app_0 (rx-sequence rxs_0))) + (rx-alts app_0 rx_0 (chytes-limit s7_0))) + pos3_0)) + (args (raise-binding-result-arity-error 2 args)))) + (values (rx-sequence rxs_0) pos2_0)))) + (args (raise-binding-result-arity-error 2 args))))))))) (define parse-regexp/maybe-empty (lambda (s_0 pos_0 config_0) (let ((tmp_0 @@ -3209,18 +3213,18 @@ (check-close-paren s_0 pos2_0 config_0))) (args (raise-binding-result-arity-error 2 args)))))))))) (define parse-look - (letrec ((span-num-groups_0 - (|#%name| - span-num-groups - (lambda (config_0 pre-num-groups_0) - (begin - (- - (begin-unsafe - (unbox (parse-config-group-number-box config_0))) - pre-num-groups_0)))))) - (lambda (s_0 pos2_0 config_0) - (let ((pre-num-groups_0 - (begin-unsafe (unbox (parse-config-group-number-box config_0))))) + (lambda (s_0 pos2_0 config_0) + (let ((pre-num-groups_0 + (begin-unsafe (unbox (parse-config-group-number-box config_0))))) + (let ((span-num-groups_0 + (|#%name| + span-num-groups + (lambda () + (begin + (- + (begin-unsafe + (unbox (parse-config-group-number-box config_0))) + pre-num-groups_0)))))) (let ((tmp_0 (integer->char (chytes-ref$1 s_0 pos2_0)))) (if (eqv? tmp_0 '#\x3d) (call-with-values @@ -3232,7 +3236,7 @@ rx_0 #t pre-num-groups_0 - (span-num-groups_0 config_0 pre-num-groups_0)))) + (span-num-groups_0)))) (values app_0 (check-close-paren s_0 pos3_0 config_0)))) (args (raise-binding-result-arity-error 2 args)))) (if (eqv? tmp_0 '#\x21) @@ -3246,7 +3250,7 @@ rx_0 #f pre-num-groups_0 - (span-num-groups_0 config_0 pre-num-groups_0)))) + (span-num-groups_0)))) (values app_0 (check-close-paren s_0 pos3_0 config_0)))) (args (raise-binding-result-arity-error 2 args)))) (if (eqv? tmp_0 '#\x3c) @@ -3278,9 +3282,7 @@ 0 0 pre-num-groups_0 - (span-num-groups_0 - config_0 - pre-num-groups_0)))) + (span-num-groups_0)))) (values app_0 (check-close-paren s_0 pos3_0 config_0)))) @@ -3301,9 +3303,7 @@ 0 0 pre-num-groups_0 - (span-num-groups_0 - config_0 - pre-num-groups_0)))) + (span-num-groups_0)))) (values app_0 (check-close-paren s_0 pos3_0 config_0)))) @@ -3580,419 +3580,366 @@ config_0 "expected `:`, `=`, `!`, `<=`, `alts - (letrec ((loop_0 - (|#%name| - loop - (lambda (l_0) - (begin - (if (null? l_0) - 'never - (let ((start_0 (caar l_0))) - (let ((end_0 (cdar l_0))) - (let ((start_1 start_0)) - (let ((seg-end_0 - (if (<= start_1 127) - 127 - (if (<= start_1 2047) - 2047 - (if (<= start_1 65535) - 65535 - (if (<= start_1 2097151) - 2097151 - (void))))))) - (if (> end_0 seg-end_0) - (loop_0 - (cons - (cons start_1 seg-end_0) - (let ((app_0 (cons (add1 seg-end_0) end_0))) - (cons app_0 (cdr l_0))))) - (if (<= end_0 127) - (let ((app_0 - (rx-range - (begin-unsafe - (range-union - null - (list (cons start_1 end_0)))) - 255))) - (rx-alts app_0 (loop_0 (cdr l_0)) 255)) - (let ((app_0 - (let ((app_0 - (string->bytes/utf-8 - (string - (integer->char start_1))))) - (bytes-range - app_0 - (string->bytes/utf-8 - (string (integer->char end_0))))))) - (rx-alts - app_0 - (loop_0 (cdr l_0)) - 255)))))))))))))) - (lambda (args_0) (let ((l_0 (begin-unsafe args_0))) (loop_0 l_0))))) + (lambda (args_0) + (let ((l_0 (begin-unsafe args_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1) + (begin + (if (null? l_1) + 'never + (let ((start_0 (caar l_1))) + (let ((end_0 (cdar l_1))) + (let ((start_1 start_0)) + (let ((seg-end_0 + (if (<= start_1 127) + 127 + (if (<= start_1 2047) + 2047 + (if (<= start_1 65535) + 65535 + (if (<= start_1 2097151) + 2097151 + (void))))))) + (if (> end_0 seg-end_0) + (loop_0 + (cons + (cons start_1 seg-end_0) + (let ((app_0 (cons (add1 seg-end_0) end_0))) + (cons app_0 (cdr l_1))))) + (if (<= end_0 127) + (let ((app_0 + (rx-range + (begin-unsafe + (range-union + null + (list (cons start_1 end_0)))) + 255))) + (rx-alts app_0 (loop_0 (cdr l_1)) 255)) + (let ((app_0 + (let ((app_0 + (string->bytes/utf-8 + (string (integer->char start_1))))) + (bytes-range + app_0 + (string->bytes/utf-8 + (string (integer->char end_0))))))) + (rx-alts + app_0 + (loop_0 (cdr l_1)) + 255)))))))))))))) + (loop_0 l_0))))) (define bytes-range (lambda (start-str_0 end-str_0) (if (equal? start-str_0 end-str_0) @@ -4506,57 +4452,59 @@ #f) #f)))))))))) (define must-range - (letrec ((loop_0 - (|#%name| - loop - (lambda (seq_0 l_0) - (begin - (if (null? l_0) - (if (pair? seq_0) (reverse$1 seq_0) #f) - (if (bytes? (car l_0)) - (let ((app_0 - (append - (reverse$1 (bytes->list (car l_0))) - seq_0))) - (loop_0 app_0 (cdr l_0))) - (if (rx:range? (car l_0)) - (let ((app_0 (cons (rx:range-range (car l_0)) seq_0))) - (loop_0 app_0 (cdr l_0))) - (if (null? seq_0) - (loop_0 null (cdr l_0)) - (let ((rest-seq_0 (loop_0 null (cdr l_0)))) - (if (if rest-seq_0 - (let ((app_0 (length rest-seq_0))) - (> app_0 (length seq_0))) - #f) - rest-seq_0 - (reverse$1 seq_0)))))))))))) - (lambda (rx_0) - (if (bytes? rx_0) - (bytes->list rx_0) - (if (integer? rx_0) - (list rx_0) - (if (rx:range? rx_0) - (list (rx:range-range rx_0)) - (if (rx:sequence? rx_0) - (loop_0 null (rx:sequence-rxs rx_0)) - (if (rx:repeat? rx_0) - (if (positive? (rx:repeat-min rx_0)) - (must-range (rx:repeat-rx rx_0)) - #f) - (if (rx:group? rx_0) - (must-range (rx:group-rx rx_0)) - (if (rx:cut? rx_0) - (must-range (rx:cut-rx rx_0)) - (if (rx:lookahead? rx_0) - (if (rx:lookahead-match? rx_0) - (must-range (rx:lookahead-rx rx_0)) + (lambda (rx_0) + (if (bytes? rx_0) + (bytes->list rx_0) + (if (integer? rx_0) + (list rx_0) + (if (rx:range? rx_0) + (list (rx:range-range rx_0)) + (if (rx:sequence? rx_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (seq_0 l_0) + (begin + (if (null? l_0) + (if (pair? seq_0) (reverse$1 seq_0) #f) + (if (bytes? (car l_0)) + (let ((app_0 + (append + (reverse$1 (bytes->list (car l_0))) + seq_0))) + (loop_0 app_0 (cdr l_0))) + (if (rx:range? (car l_0)) + (let ((app_0 + (cons (rx:range-range (car l_0)) seq_0))) + (loop_0 app_0 (cdr l_0))) + (if (null? seq_0) + (loop_0 null (cdr l_0)) + (let ((rest-seq_0 (loop_0 null (cdr l_0)))) + (if (if rest-seq_0 + (let ((app_0 (length rest-seq_0))) + (> app_0 (length seq_0))) + #f) + rest-seq_0 + (reverse$1 seq_0)))))))))))) + (loop_0 null (rx:sequence-rxs rx_0))) + (if (rx:repeat? rx_0) + (if (positive? (rx:repeat-min rx_0)) + (must-range (rx:repeat-rx rx_0)) + #f) + (if (rx:group? rx_0) + (must-range (rx:group-rx rx_0)) + (if (rx:cut? rx_0) + (must-range (rx:cut-rx rx_0)) + (if (rx:lookahead? rx_0) + (if (rx:lookahead-match? rx_0) + (must-range (rx:lookahead-rx rx_0)) + #f) + (if (rx:lookbehind? rx_0) + (if (rx:lookbehind-match? rx_0) + (must-range (rx:lookbehind-rx rx_0)) #f) - (if (rx:lookbehind? rx_0) - (if (rx:lookbehind-match? rx_0) - (must-range (rx:lookbehind-rx rx_0)) - #f) - #f)))))))))))) + #f))))))))))) (define compile-range-sequence (lambda (seq_0) (reverse$1 @@ -5736,9 +5684,7 @@ (loop_0 app_0 (add1 n_0))))))))) (loop_0 pos_0 0)))))))) (define never-matcher - (letrec ((procz1 - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) #f))) - (lambda () procz1))) + (lambda () (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) #f))) (define any-matcher (lambda (next-m_0) (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) @@ -5756,14 +5702,13 @@ stack_0) #f)))) (define any-tail-matcher - (letrec ((procz1 - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) - (if (if (bytes? s_0) - (< pos_0 limit_0) - (lazy-bytes-before-end? s_0 pos_0 limit_0)) - (add1 pos_0) - #f)))) - (lambda () procz1))) + (lambda () + (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) + (if (if (bytes? s_0) + (< pos_0 limit_0) + (lazy-bytes-before-end? s_0 pos_0 limit_0)) + (add1 pos_0) + #f)))) (define any-matcher* (lambda (max-repeat_0) (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0) @@ -5977,162 +5922,117 @@ or-part_0 (|#%app| m2_0 s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0)))))) (define repeat-matcher - (letrec ((rloop_0 - (|#%name| - rloop - (lambda (end_0 - limit_0 - max_0 - min_0 - next-m_0 - r-m_0 - s_0 - stack_0 - start_0 - state_0 - pos_0 - n_0) - (begin - (if (< n_0 min_0) - (let ((new-stack_0 - (cons - (lambda (pos_1) - (rloop_0 - end_0 - limit_0 - max_0 - min_0 - next-m_0 - r-m_0 - s_0 - stack_0 - start_0 - state_0 - pos_1 - (add1 n_0))) - stack_0))) - (|#%app| - r-m_0 - s_0 - pos_0 - start_0 - limit_0 - end_0 - state_0 - new-stack_0)) - (if (if max_0 (= n_0 max_0) #f) - (|#%app| - next-m_0 - s_0 - pos_0 - start_0 - limit_0 - end_0 - state_0 - stack_0) - (let ((new-stack_0 - (cons - (lambda (pos_1) - (rloop_0 - end_0 - limit_0 - max_0 - min_0 - next-m_0 - r-m_0 - s_0 - stack_0 - start_0 - state_0 - pos_1 - (add1 n_0))) - stack_0))) - (let ((or-part_0 - (|#%app| - r-m_0 - s_0 - pos_0 - start_0 - limit_0 - end_0 - state_0 - new-stack_0))) - (if or-part_0 - or-part_0 + (lambda (r-m_0 min_0 max_0 next-m_0) + (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) + (letrec* + ((rloop_0 + (|#%name| + rloop + (lambda (pos_1 n_0) + (begin + (if (< n_0 min_0) + (let ((new-stack_0 + (cons + (lambda (pos_2) (rloop_0 pos_2 (add1 n_0))) + stack_0))) + (|#%app| + r-m_0 + s_0 + pos_1 + start_0 + limit_0 + end_0 + state_0 + new-stack_0)) + (if (if max_0 (= n_0 max_0) #f) + (|#%app| + next-m_0 + s_0 + pos_1 + start_0 + limit_0 + end_0 + state_0 + stack_0) + (let ((new-stack_0 + (cons + (lambda (pos_2) (rloop_0 pos_2 (add1 n_0))) + stack_0))) + (let ((or-part_0 (|#%app| - next-m_0 + r-m_0 s_0 - pos_0 + pos_1 start_0 limit_0 end_0 state_0 - stack_0))))))))))) - (lambda (r-m_0 min_0 max_0 next-m_0) - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) - (rloop_0 - end_0 - limit_0 - max_0 - min_0 - next-m_0 - r-m_0 - s_0 - stack_0 - start_0 - state_0 - pos_0 - 0))))) + new-stack_0))) + (if or-part_0 + or-part_0 + (|#%app| + next-m_0 + s_0 + pos_1 + start_0 + limit_0 + end_0 + state_0 + stack_0))))))))))) + (rloop_0 pos_0 0))))) (define r-stack (list (lambda (pos_0) pos_0))) (define repeat-simple-matcher - (letrec ((group-revert_0 - (|#%name| - group-revert - (lambda (group-n_0 old-span_0 state_0) - (begin (vector-set! state_0 group-n_0 old-span_0))))) - (group-revert_1 (|#%name| group-revert (lambda () (begin (void)))))) - (lambda (r-m_0 min_0 max_0 group-n_0 next-m_0) - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) - (letrec* - ((rloop_0 - (|#%name| - rloop - (lambda (pos_1 n_0 back-amt_0) - (begin - (let ((pos2_0 - (if (let ((or-part_0 (not max_0))) - (if or-part_0 or-part_0 (< n_0 max_0))) - (|#%app| - r-m_0 - s_0 - pos_1 - start_0 - limit_0 - end_0 - state_0 - r-stack) - #f))) - (if pos2_0 - (let ((app_0 (add1 n_0))) - (rloop_0 pos2_0 app_0 (- pos2_0 pos_1))) - (letrec* - ((bloop_0 - (|#%name| - bloop - (lambda (pos_2 n_1) - (begin - (if (< n_1 min_0) - #f - (if (if group-n_0 state_0 #f) - (let ((old-span_0 - (vector-ref state_0 group-n_0))) - (begin - (vector-set! - state_0 - group-n_0 - (if (zero? n_1) - #f - (cons (- pos_2 back-amt_0) pos_2))) + (lambda (r-m_0 min_0 max_0 group-n_0 next-m_0) + (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) + (letrec* + ((rloop_0 + (|#%name| + rloop + (lambda (pos_1 n_0 back-amt_0) + (begin + (let ((pos2_0 + (if (let ((or-part_0 (not max_0))) + (if or-part_0 or-part_0 (< n_0 max_0))) + (|#%app| + r-m_0 + s_0 + pos_1 + start_0 + limit_0 + end_0 + state_0 + r-stack) + #f))) + (if pos2_0 + (let ((app_0 (add1 n_0))) + (rloop_0 pos2_0 app_0 (- pos2_0 pos_1))) + (letrec* + ((bloop_0 + (|#%name| + bloop + (lambda (pos_2 n_1) + (begin + (if (< n_1 min_0) + #f + (if (if group-n_0 state_0 #f) + (let ((old-span_0 + (vector-ref state_0 group-n_0))) + (begin + (vector-set! + state_0 + group-n_0 + (if (zero? n_1) + #f + (cons (- pos_2 back-amt_0) pos_2))) + (let ((group-revert_0 + (|#%name| + group-revert + (lambda () + (begin + (vector-set! + state_0 + group-n_0 + old-span_0)))))) (let ((or-part_0 (|#%app| next-m_0 @@ -6146,12 +6046,13 @@ (if or-part_0 or-part_0 (begin - (group-revert_0 - group-n_0 - old-span_0 - state_0) + (group-revert_0) (let ((app_0 (- pos_2 back-amt_0))) - (bloop_0 app_0 (sub1 n_1)))))))) + (bloop_0 app_0 (sub1 n_1))))))))) + (let ((group-revert_0 + (|#%name| + group-revert + (lambda () (begin (void)))))) (let ((or-part_0 (|#%app| next-m_0 @@ -6165,41 +6066,44 @@ (if or-part_0 or-part_0 (begin - (group-revert_1) + (group-revert_0) (let ((app_0 (- pos_2 back-amt_0))) - (bloop_0 app_0 (sub1 n_1))))))))))))) - (bloop_0 pos_1 n_0))))))))) - (rloop_0 pos_0 0 0)))))) + (bloop_0 app_0 (sub1 n_1)))))))))))))) + (bloop_0 pos_1 n_0))))))))) + (rloop_0 pos_0 0 0))))) (define repeat-simple-many-matcher - (letrec ((group-revert_0 + (lambda (r-m*_0 min_0 max_0 group-n_0 next-m_0) + (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) + (call-with-values + (lambda () (|#%app| r-m*_0 s_0 pos_0 start_0 limit_0 end_0 state_0)) + (case-lambda + ((pos2_0 n_0 back-amt_0) + (letrec* + ((bloop_0 (|#%name| - group-revert - (lambda (group-n_0 old-span_0 state_0) - (begin (vector-set! state_0 group-n_0 old-span_0))))) - (group-revert_1 (|#%name| group-revert (lambda () (begin (void)))))) - (lambda (r-m*_0 min_0 max_0 group-n_0 next-m_0) - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) - (call-with-values - (lambda () (|#%app| r-m*_0 s_0 pos_0 start_0 limit_0 end_0 state_0)) - (case-lambda - ((pos2_0 n_0 back-amt_0) - (letrec* - ((bloop_0 - (|#%name| - bloop - (lambda (pos_1 n_1) - (begin - (if (< n_1 min_0) - #f - (if (if group-n_0 state_0 #f) - (let ((old-span_0 (vector-ref state_0 group-n_0))) - (begin - (vector-set! - state_0 - group-n_0 - (if (zero? n_1) - #f - (cons (- pos_1 back-amt_0) pos_1))) + bloop + (lambda (pos_1 n_1) + (begin + (if (< n_1 min_0) + #f + (if (if group-n_0 state_0 #f) + (let ((old-span_0 (vector-ref state_0 group-n_0))) + (begin + (vector-set! + state_0 + group-n_0 + (if (zero? n_1) + #f + (cons (- pos_1 back-amt_0) pos_1))) + (let ((group-revert_0 + (|#%name| + group-revert + (lambda () + (begin + (vector-set! + state_0 + group-n_0 + old-span_0)))))) (let ((or-part_0 (|#%app| next-m_0 @@ -6213,9 +6117,13 @@ (if or-part_0 or-part_0 (begin - (group-revert_0 group-n_0 old-span_0 state_0) + (group-revert_0) (let ((app_0 (- pos_1 back-amt_0))) - (bloop_0 app_0 (sub1 n_1)))))))) + (bloop_0 app_0 (sub1 n_1))))))))) + (let ((group-revert_0 + (|#%name| + group-revert + (lambda () (begin (void)))))) (let ((or-part_0 (|#%app| next-m_0 @@ -6229,105 +6137,58 @@ (if or-part_0 or-part_0 (begin - (group-revert_1) + (group-revert_0) (let ((app_0 (- pos_1 back-amt_0))) - (bloop_0 app_0 (sub1 n_1))))))))))))) - (bloop_0 pos2_0 n_0))) - (args (raise-binding-result-arity-error 3 args)))))))) + (bloop_0 app_0 (sub1 n_1)))))))))))))) + (bloop_0 pos2_0 n_0))) + (args (raise-binding-result-arity-error 3 args))))))) (define lazy-repeat-matcher - (letrec ((rloop_0 - (|#%name| - rloop - (lambda (end_0 - limit_0 - max_0 - next-m_0 - r-m_0 - s_0 - stack_0 - start_0 - state_0 - pos_0 - n_0 - min_0) - (begin - (if (< n_0 min_0) - (let ((new-stack_0 - (cons - (lambda (pos_1) - (rloop_0 - end_0 - limit_0 - max_0 - next-m_0 - r-m_0 - s_0 - stack_0 - start_0 - state_0 - pos_1 - (add1 n_0) - min_0)) - stack_0))) - (|#%app| - r-m_0 - s_0 - pos_0 - start_0 - limit_0 - end_0 - state_0 - new-stack_0)) - (if (if max_0 (= n_0 max_0) #f) - (|#%app| - next-m_0 - s_0 - pos_0 - start_0 - limit_0 - end_0 - state_0 - stack_0) - (let ((or-part_0 - (|#%app| - next-m_0 - s_0 - pos_0 - start_0 - limit_0 - end_0 - state_0 - stack_0))) - (if or-part_0 - or-part_0 - (rloop_0 - end_0 - limit_0 - max_0 + (lambda (r-m_0 min_0 max_0 next-m_0) + (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) + (letrec* + ((rloop_0 + (|#%name| + rloop + (lambda (pos_1 n_0 min_1) + (begin + (if (< n_0 min_1) + (let ((new-stack_0 + (cons + (lambda (pos_2) (rloop_0 pos_2 (add1 n_0) min_1)) + stack_0))) + (|#%app| + r-m_0 + s_0 + pos_1 + start_0 + limit_0 + end_0 + state_0 + new-stack_0)) + (if (if max_0 (= n_0 max_0) #f) + (|#%app| + next-m_0 + s_0 + pos_1 + start_0 + limit_0 + end_0 + state_0 + stack_0) + (let ((or-part_0 + (|#%app| next-m_0 - r-m_0 s_0 - stack_0 + pos_1 start_0 + limit_0 + end_0 state_0 - pos_0 - n_0 - (add1 min_0))))))))))) - (lambda (r-m_0 min_0 max_0 next-m_0) - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) - (rloop_0 - end_0 - limit_0 - max_0 - next-m_0 - r-m_0 - s_0 - stack_0 - start_0 - state_0 - pos_0 - 0 - min_0))))) + stack_0))) + (if or-part_0 + or-part_0 + (rloop_0 pos_1 n_0 (add1 min_1))))))))))) + (rloop_0 pos_0 0 min_0))))) (define lazy-repeat-simple-matcher (lambda (r-m_0 min_0 max_0 next-m_0) (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) @@ -6944,315 +6805,321 @@ (loop_0 (add1 pos_1) (cons b_0 accum_0)))))))))))) (loop_0 pos_0 null))))) (define 1/compile - (letrec ((compile_0 - (|#%name| - compile - (lambda (rx_0 next-m_0) - (begin - (if (exact-integer? rx_0) - (if (eq? next-m_0 done-m) - (byte-tail-matcher rx_0) - (byte-matcher rx_0 next-m_0)) - (if (bytes? rx_0) - (let ((len_0 (unsafe-bytes-length rx_0))) - (if (eq? next-m_0 done-m) - (bytes-tail-matcher rx_0 len_0) - (bytes-matcher rx_0 len_0 next-m_0))) - (if (eq? rx_0 'empty) - next-m_0 - (if (eq? rx_0 'never) - (never-matcher) - (if (eq? rx_0 'any) - (if (eq? next-m_0 done-m) - (any-tail-matcher) - (any-matcher next-m_0)) - (if (rx:range? rx_0) - (let ((rng_0 - (compile-range (rx:range-range rx_0)))) - (if (eq? next-m_0 done-m) - (range-tail-matcher rng_0) - (range-matcher rng_0 next-m_0))) - (if (eq? rx_0 'start) - (start-matcher next-m_0) - (if (eq? rx_0 'end) - (end-matcher next-m_0) - (if (eq? rx_0 'line-start) - (line-start-matcher next-m_0) - (if (eq? rx_0 'line-end) - (line-end-matcher next-m_0) - (if (eq? rx_0 'word-boundary) - (word-boundary-matcher next-m_0) - (if (eq? rx_0 'not-word-boundary) - (not-word-boundary-matcher next-m_0) - (if (rx:sequence? rx_0) - (let ((rxs_0 - (rx:sequence-rxs rx_0))) - (loop_0 next-m_0 rxs_0)) - (if (rx:alts? rx_0) - (let ((app_0 - (compile_0 - (rx:alts-rx_1874 rx_0) - next-m_0))) + (|#%name| + compile + (lambda (rx_0) + (begin + (letrec* + ((compile_0 + (|#%name| + compile + (lambda (rx_1 next-m_0) + (begin + (if (exact-integer? rx_1) + (if (eq? next-m_0 done-m) + (byte-tail-matcher rx_1) + (byte-matcher rx_1 next-m_0)) + (if (bytes? rx_1) + (let ((len_0 (unsafe-bytes-length rx_1))) + (if (eq? next-m_0 done-m) + (bytes-tail-matcher rx_1 len_0) + (bytes-matcher rx_1 len_0 next-m_0))) + (if (eq? rx_1 'empty) + next-m_0 + (if (eq? rx_1 'never) + (never-matcher) + (if (eq? rx_1 'any) + (if (eq? next-m_0 done-m) + (any-tail-matcher) + (any-matcher next-m_0)) + (if (rx:range? rx_1) + (let ((rng_0 (compile-range (rx:range-range rx_1)))) + (if (eq? next-m_0 done-m) + (range-tail-matcher rng_0) + (range-matcher rng_0 next-m_0))) + (if (eq? rx_1 'start) + (start-matcher next-m_0) + (if (eq? rx_1 'end) + (end-matcher next-m_0) + (if (eq? rx_1 'line-start) + (line-start-matcher next-m_0) + (if (eq? rx_1 'line-end) + (line-end-matcher next-m_0) + (if (eq? rx_1 'word-boundary) + (word-boundary-matcher next-m_0) + (if (eq? rx_1 'not-word-boundary) + (not-word-boundary-matcher next-m_0) + (if (rx:sequence? rx_1) + (let ((rxs_0 (rx:sequence-rxs rx_1))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (rxs_1) + (begin + (if (null? rxs_1) + next-m_0 + (let ((rest-node_0 + (loop_0 + (cdr rxs_1)))) + (compile_0 + (car rxs_1) + rest-node_0)))))))) + (loop_0 rxs_0))) + (if (rx:alts? rx_1) + (let ((app_0 + (compile_0 + (rx:alts-rx_1874 rx_1) + next-m_0))) + (alts-matcher + app_0 + (compile_0 + (rx:alts-rx_2761 rx_1) + next-m_0))) + (if (rx:maybe? rx_1) + (if (rx:maybe-non-greedy? rx_1) (alts-matcher - app_0 + next-m_0 (compile_0 - (rx:alts-rx_2761 rx_0) - next-m_0))) - (if (rx:maybe? rx_0) - (if (rx:maybe-non-greedy? rx_0) - (alts-matcher - next-m_0 - (compile_0 - (rx:maybe-rx rx_0) - next-m_0)) - (alts-matcher - (compile_0 - (rx:maybe-rx rx_0) - next-m_0) - next-m_0)) - (if (rx:repeat? rx_0) - (let ((actual-r-rx_0 - (rx:repeat-rx rx_0))) - (let ((r-rx_0 - (if (if (rx:group? - actual-r-rx_0) - (if (not - (rx:repeat-non-greedy? - rx_0)) - (not - (needs-backtrack? - (rx:group-rx - actual-r-rx_0))) - #f) + (rx:maybe-rx rx_1) + next-m_0)) + (alts-matcher + (compile_0 + (rx:maybe-rx rx_1) + next-m_0) + next-m_0)) + (if (rx:repeat? rx_1) + (let ((actual-r-rx_0 + (rx:repeat-rx rx_1))) + (let ((r-rx_0 + (if (if (rx:group? + actual-r-rx_0) + (if (not + (rx:repeat-non-greedy? + rx_1)) + (not + (needs-backtrack? + (rx:group-rx + actual-r-rx_0))) #f) - (rx:group-rx - actual-r-rx_0) - actual-r-rx_0))) - (let ((simple?_0 - (not - (needs-backtrack? - r-rx_0)))) - (let ((group-n_0 - (if simple?_0 - (if (rx:group? - actual-r-rx_0) - (rx:group-number + #f) + (rx:group-rx + actual-r-rx_0) + actual-r-rx_0))) + (let ((simple?_0 + (not + (needs-backtrack? + r-rx_0)))) + (let ((group-n_0 + (if simple?_0 + (if (rx:group? actual-r-rx_0) - #f) - #f))) - (let ((min_0 - (rx:repeat-min - rx_0))) - (let ((max_0 - (let ((n_0 - (rx:repeat-max - rx_0))) - (if (= - n_0 - +inf.0) - #f - n_0)))) - (let ((r-m*_0 - (compile*/maybe - r-rx_0 - min_0 - max_0))) - (if (if r-m*_0 - (not - (rx:repeat-non-greedy? - rx_0)) - #f) - (repeat-simple-many-matcher - r-m*_0 - min_0 - max_0 - group-n_0 - next-m_0) - (let ((r-m_0 - (compile_0 - r-rx_0 - (if simple?_0 - done-m - continue-m)))) - (if (rx:repeat-non-greedy? - rx_0) - (if simple?_0 - (lazy-repeat-simple-matcher - r-m_0 - min_0 - max_0 - next-m_0) - (lazy-repeat-matcher - r-m_0 - min_0 - max_0 - next-m_0)) - (if simple?_0 - (repeat-simple-matcher - r-m_0 - min_0 - max_0 - group-n_0 - next-m_0) - (repeat-matcher - r-m_0 - min_0 - max_0 - next-m_0)))))))))))) - (if (rx:group? rx_0) + (rx:group-number + actual-r-rx_0) + #f) + #f))) + (let ((min_0 + (rx:repeat-min + rx_1))) + (let ((max_0 + (let ((n_0 + (rx:repeat-max + rx_1))) + (if (= + n_0 + +inf.0) + #f + n_0)))) + (let ((r-m*_0 + (compile*/maybe + r-rx_0 + min_0 + max_0))) + (if (if r-m*_0 + (not + (rx:repeat-non-greedy? + rx_1)) + #f) + (repeat-simple-many-matcher + r-m*_0 + min_0 + max_0 + group-n_0 + next-m_0) + (let ((r-m_0 + (compile_0 + r-rx_0 + (if simple?_0 + done-m + continue-m)))) + (if (rx:repeat-non-greedy? + rx_1) + (if simple?_0 + (lazy-repeat-simple-matcher + r-m_0 + min_0 + max_0 + next-m_0) + (lazy-repeat-matcher + r-m_0 + min_0 + max_0 + next-m_0)) + (if simple?_0 + (repeat-simple-matcher + r-m_0 + min_0 + max_0 + group-n_0 + next-m_0) + (repeat-matcher + r-m_0 + min_0 + max_0 + next-m_0)))))))))))) + (if (rx:group? rx_1) + (let ((n_0 + (rx:group-number + rx_1))) + (let ((m_0 + (let ((app_0 + (rx:group-rx + rx_1))) + (compile_0 + app_0 + (group-set-matcher + n_0 + next-m_0))))) + (group-push-matcher + n_0 + m_0))) + (if (rx:reference? rx_1) (let ((n_0 - (rx:group-number - rx_0))) - (let ((m_0 - (let ((app_0 - (rx:group-rx - rx_0))) - (compile_0 - app_0 - (group-set-matcher - n_0 - next-m_0))))) - (group-push-matcher - n_0 - m_0))) - (if (rx:reference? rx_0) - (let ((n_0 - (rx:reference-n - rx_0))) - (if (zero? n_0) - (never-matcher) - (if (rx:reference-case-sensitive? - rx_0) - (reference-matcher - (sub1 n_0) - next-m_0) - (reference-matcher/case-insensitive - (sub1 n_0) - next-m_0)))) - (if (rx:cut? rx_0) - (let ((app_0 - (compile_0 - (rx:cut-rx rx_0) - done-m))) - (let ((app_1 - (rx:cut-n-start - rx_0))) - (cut-matcher - app_0 - app_1 - (rx:cut-num-n rx_0) - next-m_0))) - (if (rx:conditional? - rx_0) - (let ((tst_0 - (rx:conditional-tst - rx_0))) - (let ((m1_0 + (rx:reference-n + rx_1))) + (if (zero? n_0) + (never-matcher) + (if (rx:reference-case-sensitive? + rx_1) + (reference-matcher + (sub1 n_0) + next-m_0) + (reference-matcher/case-insensitive + (sub1 n_0) + next-m_0)))) + (if (rx:cut? rx_1) + (let ((app_0 + (compile_0 + (rx:cut-rx rx_1) + done-m))) + (let ((app_1 + (rx:cut-n-start + rx_1))) + (cut-matcher + app_0 + app_1 + (rx:cut-num-n rx_1) + next-m_0))) + (if (rx:conditional? rx_1) + (let ((tst_0 + (rx:conditional-tst + rx_1))) + (let ((m1_0 + (compile_0 + (rx:conditional-rx_2013 + rx_1) + next-m_0))) + (let ((m2_0 (compile_0 - (rx:conditional-rx_2013 - rx_0) + (rx:conditional-rx_2094 + rx_1) next-m_0))) - (let ((m2_0 - (compile_0 - (rx:conditional-rx_2094 - rx_0) - next-m_0))) - (if (rx:reference? - tst_0) - (let ((n_0 - (sub1 - (rx:reference-n - tst_0)))) - (conditional/reference-matcher - n_0 - m1_0 - m2_0)) - (let ((app_0 - (compile_0 - tst_0 - done-m))) - (let ((app_1 - (rx:conditional-n-start - rx_0))) - (conditional/look-matcher - app_0 - m1_0 - m2_0 - app_1 - (rx:conditional-num-n - rx_0)))))))) - (if (rx:lookahead? - rx_0) - (let ((app_0 - (rx:lookahead-match? - rx_0))) - (let ((app_1 - (compile_0 - (rx:lookahead-rx - rx_0) - done-m))) - (let ((app_2 - (rx:lookahead-n-start - rx_0))) - (lookahead-matcher - app_0 - app_1 - app_2 - (rx:lookahead-num-n - rx_0) - next-m_0)))) - (if (rx:lookbehind? - rx_0) - (let ((app_0 - (rx:lookbehind-match? - rx_0))) - (let ((app_1 - (rx:lookbehind-lb-min - rx_0))) - (let ((app_2 - (rx:lookbehind-lb-max - rx_0))) - (let ((app_3 - (compile_0 - (rx:lookbehind-rx - rx_0) - limit-m))) - (let ((app_4 - (rx:lookbehind-n-start - rx_0))) - (lookbehind-matcher - app_0 - app_1 - app_2 - app_3 - app_4 - (rx:lookbehind-num-n - rx_0) - next-m_0)))))) - (if (rx:unicode-categories? - rx_0) + (if (rx:reference? + tst_0) + (let ((n_0 + (sub1 + (rx:reference-n + tst_0)))) + (conditional/reference-matcher + n_0 + m1_0 + m2_0)) (let ((app_0 - (rx:unicode-categories-symlist - rx_0))) - (unicode-categories-matcher - app_0 - (rx:unicode-categories-match? - rx_0) - next-m_0)) - (error - 'compile/bt - "internal error: unrecognized ~s" - rx_0)))))))))))))))))))))))))))) - (loop_0 - (|#%name| - loop - (lambda (next-m_0 rxs_0) - (begin - (if (null? rxs_0) - next-m_0 - (let ((rest-node_0 (loop_0 next-m_0 (cdr rxs_0)))) - (compile_0 (car rxs_0) rest-node_0)))))))) - (|#%name| compile (lambda (rx_0) (begin (compile_0 rx_0 done-m)))))) + (compile_0 + tst_0 + done-m))) + (let ((app_1 + (rx:conditional-n-start + rx_1))) + (conditional/look-matcher + app_0 + m1_0 + m2_0 + app_1 + (rx:conditional-num-n + rx_1)))))))) + (if (rx:lookahead? rx_1) + (let ((app_0 + (rx:lookahead-match? + rx_1))) + (let ((app_1 + (compile_0 + (rx:lookahead-rx + rx_1) + done-m))) + (let ((app_2 + (rx:lookahead-n-start + rx_1))) + (lookahead-matcher + app_0 + app_1 + app_2 + (rx:lookahead-num-n + rx_1) + next-m_0)))) + (if (rx:lookbehind? + rx_1) + (let ((app_0 + (rx:lookbehind-match? + rx_1))) + (let ((app_1 + (rx:lookbehind-lb-min + rx_1))) + (let ((app_2 + (rx:lookbehind-lb-max + rx_1))) + (let ((app_3 + (compile_0 + (rx:lookbehind-rx + rx_1) + limit-m))) + (let ((app_4 + (rx:lookbehind-n-start + rx_1))) + (lookbehind-matcher + app_0 + app_1 + app_2 + app_3 + app_4 + (rx:lookbehind-num-n + rx_1) + next-m_0)))))) + (if (rx:unicode-categories? + rx_1) + (let ((app_0 + (rx:unicode-categories-symlist + rx_1))) + (unicode-categories-matcher + app_0 + (rx:unicode-categories-match? + rx_1) + next-m_0)) + (error + 'compile/bt + "internal error: unrecognized ~s" + rx_1))))))))))))))))))))))))))))) + (compile_0 rx_0 done-m)))))) (define compile*/maybe (lambda (rx_0 min_0 max_0) (if (exact-integer? rx_0) @@ -7530,21 +7397,21 @@ (if (rx:regexp-bytes? v_0) (rx:regexp-px? v_0) #f) #f))))) (define copy-port-bytes - (letrec ((copy_0 - (|#%name| - copy - (lambda (bstr_0 n_0 out_0 got_0 expect_0) - (begin - (if (eof-object? got_0) - #f - (begin - (if out_0 (write-bytes bstr_0 out_0 0 got_0) (void)) - (let ((or-part_0 (if (not n_0) (positive? got_0) #f))) - (if or-part_0 - or-part_0 - (if n_0 (= got_0 expect_0) #f)))))))))) - (lambda (in_0 out_0 n_0) - (let ((bstr_0 (make-bytes (min 4096 (if n_0 n_0 4096))))) + (lambda (in_0 out_0 n_0) + (let ((bstr_0 (make-bytes (min 4096 (if n_0 n_0 4096))))) + (let ((copy_0 + (|#%name| + copy + (lambda (got_0 expect_0) + (begin + (if (eof-object? got_0) + #f + (begin + (if out_0 (write-bytes bstr_0 out_0 0 got_0) (void)) + (let ((or-part_0 (if (not n_0) (positive? got_0) #f))) + (if or-part_0 + or-part_0 + (if n_0 (= got_0 expect_0) #f)))))))))) (letrec* ((loop_0 (|#%name| @@ -7552,189 +7419,135 @@ (lambda (n_1) (begin (if (if n_1 (< n_1 4096) #f) - (copy_0 bstr_0 n_0 out_0 (read-bytes! bstr_0 in_0 0 n_1) n_1) - (if (copy_0 bstr_0 n_0 out_0 (read-bytes! bstr_0 in_0) 4096) + (copy_0 (read-bytes! bstr_0 in_0 0 n_1) n_1) + (if (copy_0 (read-bytes! bstr_0 in_0) 4096) (loop_0 (if n_1 (- n_1 4096) #f)) #f))))))) (loop_0 n_0)))))) (define open-input-bytes/no-copy - (letrec ((fill!_0 - (|#%name| - fill! - (lambda (bstr_0 end_0 pos_0 dest-bstr_0 skip_0) - (begin - (let ((pos+skip_0 (+ (unsafe-unbox* pos_0) skip_0))) - (if (>= pos+skip_0 end_0) - eof - (let ((len_0 - (min - (unsafe-bytes-length dest-bstr_0) - (- end_0 pos+skip_0)))) - (begin - (unsafe-bytes-copy! - dest-bstr_0 - 0 - bstr_0 - pos+skip_0 - (+ pos+skip_0 len_0)) - len_0))))))))) - (lambda (bstr_0 pos_0 end_0) - (let ((pos_1 (box pos_0))) - (make-input-port - 'bytes - (lambda (dest-bstr_0) - (let ((len_0 (fill!_0 bstr_0 end_0 pos_1 dest-bstr_0 0))) - (begin - (if (eof-object? len_0) - (void) - (unsafe-set-box*! pos_1 (+ len_0 (unsafe-unbox* pos_1)))) - len_0))) - (lambda (dest-bstr_0 skip_0 evt_0) - (fill!_0 bstr_0 end_0 pos_1 dest-bstr_0 skip_0)) - void))))) + (lambda (bstr_0 pos_0 end_0) + (let ((fill!_0 + (|#%name| + fill! + (lambda (dest-bstr_0 skip_0) + (begin + (let ((pos+skip_0 (+ pos_0 skip_0))) + (if (>= pos+skip_0 end_0) + eof + (let ((len_0 + (min + (unsafe-bytes-length dest-bstr_0) + (- end_0 pos+skip_0)))) + (begin + (unsafe-bytes-copy! + dest-bstr_0 + 0 + bstr_0 + pos+skip_0 + (+ pos+skip_0 len_0)) + len_0))))))))) + (make-input-port + 'bytes + (lambda (dest-bstr_0) + (let ((len_0 (fill!_0 dest-bstr_0 0))) + (begin + (if (eof-object? len_0) (void) (set! pos_0 (+ len_0 pos_0))) + len_0))) + (lambda (dest-bstr_0 skip_0 evt_0) (fill!_0 dest-bstr_0 skip_0)) + void)))) (define open-input-string/lazy - (letrec ((decode-more!_0 - (|#%name| - decode-more! - (lambda (bstr-end_0 bstr_0 end_0 pos_0 str_0 target-pos_0) - (begin - (if (= (unsafe-unbox* pos_0) end_0) - (void) - (let ((len_0 (min 64 (- end_0 (unsafe-unbox* pos_0))))) - (let ((new-bstr_0 - (let ((app_0 (unsafe-unbox* pos_0))) - (string->bytes/utf-8 - str_0 + (lambda (str_0 pos_0 end_0) + (let ((bstr_0 (make-bytes 64))) + (let ((bstr-pos_0 0)) + (let ((bstr-end_0 0)) + (letrec* + ((fill!_0 + (|#%name| + fill! + (lambda (dest-bstr_0 skip_0) + (begin + (let ((bstr-pos+skip_0 (+ bstr-pos_0 skip_0))) + (begin + (if (>= bstr-pos+skip_0 bstr-end_0) + (decode-more!_0 (add1 bstr-pos+skip_0)) + (void)) + (if (>= bstr-pos+skip_0 bstr-end_0) + eof + (let ((len_0 + (min + (unsafe-bytes-length dest-bstr_0) + (- bstr-end_0 bstr-pos+skip_0)))) + (begin + (let ((app_0 bstr_0)) + (unsafe-bytes-copy! + dest-bstr_0 0 app_0 - (+ (unsafe-unbox* pos_0) len_0))))) - (begin - (unsafe-set-box*! - pos_0 - (+ len_0 (unsafe-unbox* pos_0))) - (let ((new-len_0 (unsafe-bytes-length new-bstr_0))) - (begin - (if (< - (let ((app_0 - (unsafe-bytes-length - (unsafe-unbox* bstr_0)))) - (- app_0 (unsafe-unbox* bstr-end_0))) - new-len_0) - (let ((bstr2_0 - (make-bytes - (let ((app_0 - (* - (unsafe-bytes-length - (unsafe-unbox* bstr_0)) - 2))) - (max - app_0 - (+ - (unsafe-unbox* bstr-end_0) - new-len_0)))))) - (begin - (let ((app_0 (unsafe-unbox* bstr_0))) - (unsafe-bytes-copy! - bstr2_0 - 0 - app_0 - 0 - (unsafe-unbox* bstr-end_0))) - (unsafe-set-box*! bstr_0 bstr2_0))) - (void)) - (let ((app_0 (unsafe-unbox* bstr_0))) - (unsafe-bytes-copy! - app_0 - (unsafe-unbox* bstr-end_0) - new-bstr_0)) - (unsafe-set-box*! - bstr-end_0 - (+ (unsafe-unbox* bstr-end_0) new-len_0)) - (if (< (unsafe-unbox* bstr-end_0) target-pos_0) - (decode-more!_0 - bstr-end_0 - bstr_0 - end_0 - pos_0 + bstr-pos+skip_0 + (+ bstr-pos+skip_0 len_0))) + len_0))))))))) + (decode-more!_0 + (|#%name| + decode-more! + (lambda (target-pos_0) + (begin + (if (= pos_0 end_0) + (void) + (let ((len_0 (min 64 (- end_0 pos_0)))) + (let ((new-bstr_0 + (let ((app_0 pos_0)) + (string->bytes/utf-8 str_0 - target-pos_0) - (void)))))))))))) - (fill!_0 - (|#%name| - fill! - (lambda (bstr-end_0 - bstr-pos_0 - bstr_0 - end_0 - pos_0 - str_0 - dest-bstr_0 - skip_0) - (begin - (let ((bstr-pos+skip_0 (+ (unsafe-unbox* bstr-pos_0) skip_0))) - (begin - (if (>= bstr-pos+skip_0 (unsafe-unbox* bstr-end_0)) - (decode-more!_0 - bstr-end_0 - bstr_0 - end_0 - pos_0 - str_0 - (add1 bstr-pos+skip_0)) - (void)) - (if (>= bstr-pos+skip_0 (unsafe-unbox* bstr-end_0)) - eof - (let ((len_0 - (min - (unsafe-bytes-length dest-bstr_0) - (- - (unsafe-unbox* bstr-end_0) - bstr-pos+skip_0)))) - (begin - (let ((app_0 (unsafe-unbox* bstr_0))) - (unsafe-bytes-copy! - dest-bstr_0 - 0 - app_0 - bstr-pos+skip_0 - (+ bstr-pos+skip_0 len_0))) - len_0)))))))))) - (lambda (str_0 pos_0 end_0) - (let ((pos_1 (box pos_0))) - (let ((bstr_0 (box (make-bytes 64)))) - (let ((bstr-pos_0 (box 0))) - (let ((bstr-end_0 (box 0))) - (make-input-port - 'string - (lambda (dest-bstr_0) - (let ((len_0 - (fill!_0 - bstr-end_0 - bstr-pos_0 - bstr_0 - end_0 - pos_1 - str_0 - dest-bstr_0 - 0))) - (begin - (if (eof-object? len_0) - (void) - (unsafe-set-box*! - bstr-pos_0 - (+ (unsafe-unbox* bstr-pos_0) len_0))) - len_0))) - (lambda (dest-bstr_0 skip_0 evt_0) - (fill!_0 - bstr-end_0 - bstr-pos_0 - bstr_0 - end_0 - pos_1 - str_0 - dest-bstr_0 - skip_0)) - void)))))))) + 0 + app_0 + (+ pos_0 len_0))))) + (begin + (set! pos_0 (+ len_0 pos_0)) + (let ((new-len_0 (unsafe-bytes-length new-bstr_0))) + (begin + (if (< + (let ((app_0 (unsafe-bytes-length bstr_0))) + (- app_0 bstr-end_0)) + new-len_0) + (let ((bstr2_0 + (make-bytes + (let ((app_0 + (* + (unsafe-bytes-length bstr_0) + 2))) + (max + app_0 + (+ bstr-end_0 new-len_0)))))) + (begin + (let ((app_0 bstr_0)) + (unsafe-bytes-copy! + bstr2_0 + 0 + app_0 + 0 + bstr-end_0)) + (set! bstr_0 bstr2_0))) + (void)) + (let ((app_0 bstr_0)) + (unsafe-bytes-copy! + app_0 + bstr-end_0 + new-bstr_0)) + (set! bstr-end_0 (+ bstr-end_0 new-len_0)) + (if (< bstr-end_0 target-pos_0) + (decode-more!_0 target-pos_0) + (void))))))))))))) + (make-input-port + 'string + (lambda (dest-bstr_0) + (let ((len_0 (fill!_0 dest-bstr_0 0))) + (begin + (if (eof-object? len_0) + (void) + (set! bstr-pos_0 (+ bstr-pos_0 len_0))) + len_0))) + (lambda (dest-bstr_0 skip_0 evt_0) (fill!_0 dest-bstr_0 skip_0)) + void))))))) (define byte-positions->byte-positions.1 (|#%name| byte-positions->byte-positions @@ -7837,48 +7650,31 @@ (args (raise-binding-result-arity-error 2 args))))) null))))))) (define byte-positions->string-positions.1 - (letrec ((string-offset_0 - (|#%name| - string-offset - (lambda (bstr-in20_0 - delta15_0 - result-offset16_0 - start-index14_0 - pos_0) - (begin - (+ - result-offset16_0 - (bytes-utf-8-length - bstr-in20_0 - '#\x3f - start-index14_0 - (- pos_0 delta15_0)))))))) - (|#%name| - byte-positions->string-positions - (lambda (delta15_0 - result-offset16_0 - start-index14_0 - bstr-in20_0 - ms-pos21_0 - me-pos22_0 - state23_0) - (begin - (let ((app_0 - (let ((app_0 - (string-offset_0 - bstr-in20_0 - delta15_0 - result-offset16_0 - start-index14_0 - ms-pos21_0))) - (cons - app_0 - (string-offset_0 - bstr-in20_0 - delta15_0 + (|#%name| + byte-positions->string-positions + (lambda (delta15_0 + result-offset16_0 + start-index14_0 + bstr-in20_0 + ms-pos21_0 + me-pos22_0 + state23_0) + (begin + (let ((string-offset_0 + (|#%name| + string-offset + (lambda (pos_0) + (begin + (+ result-offset16_0 - start-index14_0 - me-pos22_0))))) + (bytes-utf-8-length + bstr-in20_0 + '#\x3f + start-index14_0 + (- pos_0 delta15_0)))))))) + (let ((app_0 + (let ((app_0 (string-offset_0 ms-pos21_0))) + (cons app_0 (string-offset_0 me-pos22_0))))) (cons app_0 (if state23_0 @@ -7906,18 +7702,10 @@ (if p_0 (let ((app_1 (string-offset_0 - bstr-in20_0 - delta15_0 - result-offset16_0 - start-index14_0 (car p_0)))) (cons app_1 (string-offset_0 - bstr-in20_0 - delta15_0 - result-offset16_0 - start-index14_0 (cdr p_0)))) #f) fold-var_0))) @@ -8361,36 +8149,33 @@ #f)) (args (raise-binding-result-arity-error 2 args))))))) (define fast-drive-regexp-match-positions/string - (letrec ((string-offset_0 - (|#%name| - string-offset - (lambda (in_0 start-offset_0 pos_0) - (begin - (+ - start-offset_0 - (bytes-utf-8-length in_0 '#\x3f 0 pos_0))))))) - (lambda (rx_0 in-str_0 start-offset_0 end-offset_0) - (let ((in_0 - (string->bytes/utf-8 - in-str_0 - 0 - start-offset_0 - (if end-offset_0 end-offset_0 (string-length in-str_0))))) - (let ((state_0 - (let ((n_0 (rx:regexp-num-groups rx_0))) - (if (positive? n_0) (make-vector n_0 #f) #f)))) - (call-with-values - (lambda () - (search-match rx_0 in_0 0 0 (unsafe-bytes-length in_0) state_0)) - (case-lambda - ((ms-pos_0 me-pos_0) + (lambda (rx_0 in-str_0 start-offset_0 end-offset_0) + (let ((in_0 + (string->bytes/utf-8 + in-str_0 + 0 + start-offset_0 + (if end-offset_0 end-offset_0 (string-length in-str_0))))) + (let ((state_0 + (let ((n_0 (rx:regexp-num-groups rx_0))) + (if (positive? n_0) (make-vector n_0 #f) #f)))) + (call-with-values + (lambda () + (search-match rx_0 in_0 0 0 (unsafe-bytes-length in_0) state_0)) + (case-lambda + ((ms-pos_0 me-pos_0) + (let ((string-offset_0 + (|#%name| + string-offset + (lambda (pos_0) + (begin + (+ + start-offset_0 + (bytes-utf-8-length in_0 '#\x3f 0 pos_0))))))) (if ms-pos_0 (let ((app_0 - (let ((app_0 - (string-offset_0 in_0 start-offset_0 ms-pos_0))) - (cons - app_0 - (string-offset_0 in_0 start-offset_0 me-pos_0))))) + (let ((app_0 (string-offset_0 ms-pos_0))) + (cons app_0 (string-offset_0 me-pos_0))))) (cons app_0 (if state_0 @@ -8419,14 +8204,10 @@ (if p_0 (let ((app_1 (string-offset_0 - in_0 - start-offset_0 (car p_0)))) (cons app_1 (string-offset_0 - in_0 - start-offset_0 (cdr p_0)))) #f) fold-var_0))) @@ -8438,8 +8219,8 @@ (for-loop_0 null 0)))) (args (raise-binding-result-arity-error 2 args))))) null))) - #f)) - (args (raise-binding-result-arity-error 2 args))))))))) + #f))) + (args (raise-binding-result-arity-error 2 args)))))))) (define fast-drive-regexp-match/bytes (lambda (rx_0 in_0 start-pos_0 end-pos_0) (let ((state_0 @@ -8562,462 +8343,467 @@ #f)) (args (raise-binding-result-arity-error 2 args)))))))) (define drive-regexp-match.1 - (letrec ((write/consume-skipped_0 - (|#%name| - write/consume-skipped - (lambda (end-pos_0 - in_0 - lb-in_0 - me-pos_0 - ms-pos_0 - out24_0 - peek?5_0 - port-in_0 - prefix-len_0) - (begin - (if (not peek?5_0) - (if ms-pos_0 - (begin - (if out24_0 - (lazy-bytes-advance! lb-in_0 ms-pos_0 #t) - (void)) - (if (input-port? in_0) - (copy-port-bytes - port-in_0 - #f - (- me-pos_0 prefix-len_0)) - (void))) - (if (eq? end-pos_0 'eof) - (if (if out24_0 out24_0 (input-port? in_0)) - (copy-port-bytes port-in_0 out24_0 #f) - (void)) - (begin - (if out24_0 - (lazy-bytes-advance! lb-in_0 end-pos_0 #t) - (void)) - (if (input-port? in_0) - (copy-port-bytes - port-in_0 - #f - (- end-pos_0 prefix-len_0)) - (void))))) - (void))))))) - (|#%name| - drive-regexp-match - (lambda (end-bytes-count9_0 - end-bytes?8_0 - immediate-only?6_0 - in-path-ok?4_0 - in-port-ok?3_0 - mode2_0 - peek?5_0 - progress-evt7_0 - search-offset1_0 - who19_0 - orig-rx20_0 - orig-in21_0 - orig-start-offset22_0 - orig-end-offset23_0 - out24_0 - prefix25_0) - (begin - (let ((search-offset_0 - (if (eq? search-offset1_0 unsafe-undefined) - orig-start-offset22_0 - search-offset1_0))) - (let ((rx_0 - (if (rx:regexp? orig-rx20_0) - orig-rx20_0 - (if (string? orig-rx20_0) - (make-regexp who19_0 orig-rx20_0 #f #f #f) - (if (bytes? orig-rx20_0) - (make-regexp who19_0 orig-rx20_0 #f #t #f) - (raise-argument-error - who19_0 - "(or/c regexp? byte-regexp? string? bytes?)" - orig-rx20_0)))))) - (let ((in_0 - (if (if in-path-ok?4_0 (path? orig-in21_0) #f) - (if (rx:regexp-bytes? rx_0) - (path->bytes orig-in21_0) - (path->string orig-in21_0)) - orig-in21_0))) - (begin - (if (let ((or-part_0 (if (bytes? in_0) (not peek?5_0) #f))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (if (string? in_0) (not peek?5_0) #f))) - (if or-part_1 - or-part_1 - (if in-port-ok?3_0 (input-port? in_0) #f))))) - (void) - (raise-argument-error - who19_0 - (if peek?5_0 - "input-port?" - (if in-port-ok?3_0 - "(or/c bytes? string? input-port? path?)" - (if in-path-ok?4_0 - "(or/c bytes? string? path?)" - "(or/c bytes? string?)"))) - orig-in21_0)) - (let ((start-offset_0 - (if orig-start-offset22_0 + (|#%name| + drive-regexp-match + (lambda (end-bytes-count9_0 + end-bytes?8_0 + immediate-only?6_0 + in-path-ok?4_0 + in-port-ok?3_0 + mode2_0 + peek?5_0 + progress-evt7_0 + search-offset1_0 + who19_0 + orig-rx20_0 + orig-in21_0 + orig-start-offset22_0 + orig-end-offset23_0 + out24_0 + prefix25_0) + (begin + (let ((search-offset_0 + (if (eq? search-offset1_0 unsafe-undefined) + orig-start-offset22_0 + search-offset1_0))) + (let ((rx_0 + (if (rx:regexp? orig-rx20_0) + orig-rx20_0 + (if (string? orig-rx20_0) + (make-regexp who19_0 orig-rx20_0 #f #f #f) + (if (bytes? orig-rx20_0) + (make-regexp who19_0 orig-rx20_0 #f #t #f) + (raise-argument-error + who19_0 + "(or/c regexp? byte-regexp? string? bytes?)" + orig-rx20_0)))))) + (let ((in_0 + (if (if in-path-ok?4_0 (path? orig-in21_0) #f) + (if (rx:regexp-bytes? rx_0) + (path->bytes orig-in21_0) + (path->string orig-in21_0)) + orig-in21_0))) + (begin + (if (let ((or-part_0 (if (bytes? in_0) (not peek?5_0) #f))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (if (string? in_0) (not peek?5_0) #f))) + (if or-part_1 + or-part_1 + (if in-port-ok?3_0 (input-port? in_0) #f))))) + (void) + (raise-argument-error + who19_0 + (if peek?5_0 + "input-port?" + (if in-port-ok?3_0 + "(or/c bytes? string? input-port? path?)" + (if in-path-ok?4_0 + "(or/c bytes? string? path?)" + "(or/c bytes? string?)"))) + orig-in21_0)) + (let ((start-offset_0 + (if orig-start-offset22_0 + (begin + (if (exact-nonnegative-integer? + orig-start-offset22_0) + (void) + (raise-argument-error + who19_0 + "exact-nonnegative-integer?" + orig-start-offset22_0)) + (check-range + who19_0 + "starting index" + in_0 + orig-start-offset22_0 + 0) + orig-start-offset22_0) + 0))) + (let ((end-offset_0 + (if orig-end-offset23_0 (begin (if (exact-nonnegative-integer? - orig-start-offset22_0) + orig-end-offset23_0) (void) (raise-argument-error who19_0 - "exact-nonnegative-integer?" - orig-start-offset22_0)) + "(or/c #f exact-nonnegative-integer?)" + orig-end-offset23_0)) (check-range who19_0 - "starting index" + "ending index" in_0 - orig-start-offset22_0 - 0) - orig-start-offset22_0) - 0))) - (let ((end-offset_0 - (if orig-end-offset23_0 - (begin - (if (exact-nonnegative-integer? - orig-end-offset23_0) - (void) - (raise-argument-error - who19_0 - "(or/c #f exact-nonnegative-integer?)" - orig-end-offset23_0)) - (check-range - who19_0 - "ending index" - in_0 - orig-end-offset23_0 - start-offset_0) - orig-end-offset23_0) - (if (bytes? in_0) - (unsafe-bytes-length in_0) - (if (string? in_0) (string-length in_0) 'eof))))) + orig-end-offset23_0 + start-offset_0) + orig-end-offset23_0) + (if (bytes? in_0) + (unsafe-bytes-length in_0) + (if (string? in_0) (string-length in_0) 'eof))))) + (begin + (if (let ((or-part_0 (not out24_0))) + (if or-part_0 or-part_0 (output-port? out24_0))) + (void) + (raise-argument-error + who19_0 + "(or/c #f output-port?)" + out24_0)) (begin - (if (let ((or-part_0 (not out24_0))) - (if or-part_0 or-part_0 (output-port? out24_0))) + (if (bytes? prefix25_0) (void) - (raise-argument-error - who19_0 - "(or/c #f output-port?)" - out24_0)) + (raise-argument-error who19_0 "bytes?" prefix25_0)) (begin - (if (bytes? prefix25_0) - (void) - (raise-argument-error who19_0 "bytes?" prefix25_0)) - (begin - (if end-bytes?8_0 - (if (exact-nonnegative-integer? - end-bytes-count9_0) - (void) - (raise-argument-error - who19_0 - "exact-nonnegative-integer?" - end-bytes-count9_0)) - (void)) - (let ((state_0 - (if (let ((or-part_0 (not (eq? mode2_0 '?)))) - (if or-part_0 - or-part_0 - (rx:regexp-references? rx_0))) - (let ((n_0 (rx:regexp-num-groups rx_0))) - (if (positive? n_0) - (make-vector n_0 #f) - #f)) - #f))) - (if (if (bytes? in_0) - (if (not out24_0) (equal? #vu8() prefix25_0) #f) - #f) - (call-with-values - (lambda () - (search-match - rx_0 - in_0 - search-offset_0 - start-offset_0 - end-offset_0 - state_0)) - (case-lambda - ((ms-pos_0 me-pos_0) - (begin - (if out24_0 - (write-bytes - in_0 - out24_0 - 0 - (if ms-pos_0 ms-pos_0 end-offset_0)) - (void)) - (let ((tmp_0 (if ms-pos_0 mode2_0 #f))) - (if (eq? tmp_0 #f) - (add-end-bytes - #f - end-bytes-count9_0 - #f - #f) - (if (eq? tmp_0 '?) - #t - (if (eq? tmp_0 'positions) - (let ((positions_0 - (byte-positions->byte-positions.1 + (if end-bytes?8_0 + (if (exact-nonnegative-integer? end-bytes-count9_0) + (void) + (raise-argument-error + who19_0 + "exact-nonnegative-integer?" + end-bytes-count9_0)) + (void)) + (let ((state_0 + (if (let ((or-part_0 (not (eq? mode2_0 '?)))) + (if or-part_0 + or-part_0 + (rx:regexp-references? rx_0))) + (let ((n_0 (rx:regexp-num-groups rx_0))) + (if (positive? n_0) + (make-vector n_0 #f) + #f)) + #f))) + (if (if (bytes? in_0) + (if (not out24_0) (equal? #vu8() prefix25_0) #f) + #f) + (call-with-values + (lambda () + (search-match + rx_0 + in_0 + search-offset_0 + start-offset_0 + end-offset_0 + state_0)) + (case-lambda + ((ms-pos_0 me-pos_0) + (begin + (if out24_0 + (write-bytes + in_0 + out24_0 + 0 + (if ms-pos_0 ms-pos_0 end-offset_0)) + (void)) + (let ((tmp_0 (if ms-pos_0 mode2_0 #f))) + (if (eq? tmp_0 #f) + (add-end-bytes + #f + end-bytes-count9_0 + #f + #f) + (if (eq? tmp_0 '?) + #t + (if (eq? tmp_0 'positions) + (let ((positions_0 + (byte-positions->byte-positions.1 + 0 + ms-pos_0 + me-pos_0 + state_0))) + (add-end-bytes + positions_0 + end-bytes-count9_0 + in_0 + me-pos_0)) + (if (eq? tmp_0 'strings) + (let ((bytess_0 + (byte-positions->bytess.1 0 + in_0 ms-pos_0 me-pos_0 state_0))) (add-end-bytes - positions_0 + bytess_0 end-bytes-count9_0 in_0 me-pos_0)) - (if (eq? tmp_0 'strings) - (let ((bytess_0 - (byte-positions->bytess.1 - 0 - in_0 - ms-pos_0 - me-pos_0 - state_0))) - (add-end-bytes - bytess_0 - end-bytes-count9_0 - in_0 - me-pos_0)) - (void)))))))) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (string? in_0) - (if (not out24_0) - (if (equal? #vu8() prefix25_0) - (< (- end-offset_0 start-offset_0) 64) - #f) + (void)))))))) + (args + (raise-binding-result-arity-error 2 args)))) + (if (if (string? in_0) + (if (not out24_0) + (if (equal? #vu8() prefix25_0) + (< (- end-offset_0 start-offset_0) 64) #f) #f) - (let ((bstr-in_0 - (string->bytes/utf-8 - in_0 + #f) + (let ((bstr-in_0 + (string->bytes/utf-8 + in_0 + 0 + start-offset_0 + end-offset_0))) + (let ((search-pos_0 + (if (= start-offset_0 search-offset_0) + 0 + (string-utf-8-length + in_0 + start-offset_0 + search-offset_0)))) + (let ((end-pos_0 + (unsafe-bytes-length bstr-in_0))) + (call-with-values + (lambda () + (search-match + rx_0 + bstr-in_0 + search-pos_0 0 - start-offset_0 - end-offset_0))) - (let ((search-pos_0 - (if (= - start-offset_0 - search-offset_0) - 0 - (string-utf-8-length - in_0 - start-offset_0 - search-offset_0)))) - (let ((end-pos_0 - (unsafe-bytes-length bstr-in_0))) - (call-with-values - (lambda () - (search-match - rx_0 - bstr-in_0 - search-pos_0 - 0 - end-pos_0 - state_0)) - (case-lambda - ((ms-pos_0 me-pos_0) - (begin - (if out24_0 - (begin - (write-string - in_0 - out24_0 - 0 - start-offset_0) - (write-bytes - bstr-in_0 - out24_0 - 0 - (if ms-pos_0 - ms-pos_0 - end-pos_0))) - (void)) - (let ((tmp_0 - (if ms-pos_0 mode2_0 #f))) - (if (eq? tmp_0 #f) - (add-end-bytes - #f - end-bytes-count9_0 - #f - #f) - (if (eq? tmp_0 '?) - #t - (if (eq? tmp_0 'positions) - (let ((positions_0 + end-pos_0 + state_0)) + (case-lambda + ((ms-pos_0 me-pos_0) + (begin + (if out24_0 + (begin + (write-string + in_0 + out24_0 + 0 + start-offset_0) + (write-bytes + bstr-in_0 + out24_0 + 0 + (if ms-pos_0 + ms-pos_0 + end-pos_0))) + (void)) + (let ((tmp_0 + (if ms-pos_0 mode2_0 #f))) + (if (eq? tmp_0 #f) + (add-end-bytes + #f + end-bytes-count9_0 + #f + #f) + (if (eq? tmp_0 '?) + #t + (if (eq? tmp_0 'positions) + (let ((positions_0 + (if (rx:regexp-bytes? + rx_0) + (let ((delta_0 + (string-utf-8-length + in_0 + 0 + start-offset_0))) + (byte-positions->byte-positions.1 + delta_0 + ms-pos_0 + me-pos_0 + state_0)) + (byte-positions->string-positions.1 + 0 + start-offset_0 + 0 + bstr-in_0 + ms-pos_0 + me-pos_0 + state_0)))) + (add-end-bytes + positions_0 + end-bytes-count9_0 + bstr-in_0 + me-pos_0)) + (if (eq? tmp_0 'strings) + (let ((bytes/strings_0 (if (rx:regexp-bytes? rx_0) - (let ((delta_0 - (string-utf-8-length - in_0 - 0 - start-offset_0))) - (byte-positions->byte-positions.1 - delta_0 - ms-pos_0 - me-pos_0 - state_0)) - (byte-positions->string-positions.1 + (byte-positions->bytess.1 0 - start-offset_0 + bstr-in_0 + ms-pos_0 + me-pos_0 + state_0) + (byte-positions->strings.1 0 bstr-in_0 ms-pos_0 me-pos_0 state_0)))) (add-end-bytes - positions_0 + bytes/strings_0 end-bytes-count9_0 bstr-in_0 me-pos_0)) - (if (eq? tmp_0 'strings) - (let ((bytes/strings_0 - (if (rx:regexp-bytes? - rx_0) - (byte-positions->bytess.1 - 0 - bstr-in_0 - ms-pos_0 - me-pos_0 - state_0) - (byte-positions->strings.1 - 0 - bstr-in_0 - ms-pos_0 - me-pos_0 - state_0)))) - (add-end-bytes - bytes/strings_0 - end-bytes-count9_0 - bstr-in_0 - me-pos_0)) - (void)))))))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (let ((prefix-len_0 - (unsafe-bytes-length prefix25_0))) - (let ((search-pos_0 - (if (= - start-offset_0 - search-offset_0) - prefix-len_0 - (+ - prefix-len_0 - (if (string? in_0) - (string-utf-8-length - in_0 - start-offset_0 - search-offset_0) - (- - search-offset_0 - start-offset_0)))))) - (let ((port-in_0 - (if (bytes? in_0) - (open-input-bytes/no-copy + (void)))))))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (let ((prefix-len_0 + (unsafe-bytes-length prefix25_0))) + (let ((search-pos_0 + (if (= start-offset_0 search-offset_0) + prefix-len_0 + (+ + prefix-len_0 + (if (string? in_0) + (string-utf-8-length + in_0 + start-offset_0 + search-offset_0) + (- + search-offset_0 + start-offset_0)))))) + (let ((port-in_0 + (if (bytes? in_0) + (open-input-bytes/no-copy + in_0 + start-offset_0 + end-offset_0) + (if (string? in_0) + (open-input-string/lazy in_0 start-offset_0 end-offset_0) - (if (string? in_0) - (open-input-string/lazy - in_0 - start-offset_0 - end-offset_0) - in_0)))) - (let ((any-bytes-left?_0 - (if (if (input-port? in_0) - (positive? start-offset_0) - #f) - (if peek?5_0 - (not - (eof-object? - (peek-byte - port-in_0 - (sub1 start-offset_0)))) - (copy-port-bytes + in_0)))) + (let ((any-bytes-left?_0 + (if (if (input-port? in_0) + (positive? start-offset_0) + #f) + (if peek?5_0 + (not + (eof-object? + (peek-byte port-in_0 - #f - start-offset_0)) - #t))) - (let ((lb-in_0 - (let ((skip-amt_0 - (if peek?5_0 - start-offset_0 - 0))) - (let ((max-lookbehind_0 - (rx:regexp-max-lookbehind - rx_0))) - (let ((max-peek_0 - (if (input-port? - in_0) - (if (not - (eq? - 'eof - end-offset_0)) - (- - end-offset_0 - start-offset_0) - #f) - #f))) - (let ((max-lookbehind_1 - max-lookbehind_0) - (skip-amt_1 - skip-amt_0)) - (begin-unsafe - (let ((len_0 - (unsafe-bytes-length - prefix25_0))) - (lazy-bytes1.1 - prefix25_0 - len_0 - port-in_0 - skip-amt_1 - len_0 - peek?5_0 - immediate-only?6_0 - progress-evt7_0 - out24_0 - max-lookbehind_1 - #f - 0 - max-peek_0))))))))) - (let ((end-pos_0 - (if (let ((or-part_0 - (eq? - 'eof - end-offset_0))) - (if or-part_0 - or-part_0 - (string? in_0))) - 'eof - (+ - prefix-len_0 - (- - end-offset_0 - start-offset_0))))) - (call-with-values - (lambda () - (if any-bytes-left?_0 - (search-match - rx_0 - lb-in_0 - search-pos_0 - 0 - end-pos_0 - state_0) - (values #f #f))) - (case-lambda - ((ms-pos_0 me-pos_0) + (sub1 start-offset_0)))) + (copy-port-bytes + port-in_0 + #f + start-offset_0)) + #t))) + (let ((lb-in_0 + (let ((skip-amt_0 + (if peek?5_0 + start-offset_0 + 0))) + (let ((max-lookbehind_0 + (rx:regexp-max-lookbehind + rx_0))) + (let ((max-peek_0 + (if (input-port? in_0) + (if (not + (eq? + 'eof + end-offset_0)) + (- + end-offset_0 + start-offset_0) + #f) + #f))) + (let ((max-lookbehind_1 + max-lookbehind_0) + (skip-amt_1 + skip-amt_0)) + (begin-unsafe + (let ((len_0 + (unsafe-bytes-length + prefix25_0))) + (lazy-bytes1.1 + prefix25_0 + len_0 + port-in_0 + skip-amt_1 + len_0 + peek?5_0 + immediate-only?6_0 + progress-evt7_0 + out24_0 + max-lookbehind_1 + #f + 0 + max-peek_0))))))))) + (let ((end-pos_0 + (if (let ((or-part_0 + (eq? + 'eof + end-offset_0))) + (if or-part_0 + or-part_0 + (string? in_0))) + 'eof + (+ + prefix-len_0 + (- + end-offset_0 + start-offset_0))))) + (call-with-values + (lambda () + (if any-bytes-left?_0 + (search-match + rx_0 + lb-in_0 + search-pos_0 + 0 + end-pos_0 + state_0) + (values #f #f))) + (case-lambda + ((ms-pos_0 me-pos_0) + (let ((write/consume-skipped_0 + (|#%name| + write/consume-skipped + (lambda () + (begin + (if (not peek?5_0) + (if ms-pos_0 + (begin + (if out24_0 + (lazy-bytes-advance! + lb-in_0 + ms-pos_0 + #t) + (void)) + (if (input-port? + in_0) + (copy-port-bytes + port-in_0 + #f + (- + me-pos_0 + prefix-len_0)) + (void))) + (if (eq? + end-pos_0 + 'eof) + (if (if out24_0 + out24_0 + (input-port? + in_0)) + (copy-port-bytes + port-in_0 + out24_0 + #f) + (void)) + (begin + (if out24_0 + (lazy-bytes-advance! + lb-in_0 + end-pos_0 + #t) + (void)) + (if (input-port? + in_0) + (copy-port-bytes + port-in_0 + #f + (- + end-pos_0 + prefix-len_0)) + (void))))) + (void))))))) (begin0 (let ((tmp_0 (if ms-pos_0 @@ -9128,20 +8914,11 @@ bstr_0 me-pos_0)))) (void)))))) - (write/consume-skipped_0 - end-pos_0 - in_0 - lb-in_0 - me-pos_0 - ms-pos_0 - out24_0 - peek?5_0 - port-in_0 - prefix-len_0))) - (args - (raise-binding-result-arity-error - 2 - args))))))))))))))))))))))))))) + (write/consume-skipped_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))))))))))))))))))))))) (define check-range (lambda (who_0 what_0 in_0 pos_0 start-pos_0) (let ((len_0 @@ -9238,304 +9015,248 @@ ((rx_0 orig-in_0 insert_0 prefix5_0) (regexp-replace*_0 rx_0 orig-in_0 insert_0 prefix5_0)))))) (define do-regexp-replace - (letrec ((loop_0 - (|#%name| - loop - (lambda (all?_0 in_0 ins_0 prefix_0 rx_0 who_0 search-pos_0) - (begin - (let ((poss_0 - (drive-regexp-match.1 - #f - #f - #f - #f - #f - 'positions - #f - #f - search-pos_0 - who_0 - rx_0 - in_0 - 0 - #f - #f - prefix_0))) - (if (not poss_0) - (if (zero? search-pos_0) - in_0 - (subchytes in_0 search-pos_0)) - (let ((app_0 (subchytes in_0 search-pos_0 (caar poss_0)))) - (let ((app_1 (replacements who_0 in_0 poss_0 ins_0))) - (chytes-append - app_0 - app_1 - (if all?_0 - (recur_0 - all?_0 - in_0 - ins_0 - poss_0 - prefix_0 - rx_0 - search-pos_0 - who_0) - (subchytes in_0 (cdar poss_0)))))))))))) - (recur_0 - (|#%name| - recur - (lambda (all?_0 - in_0 - ins_0 - poss_0 - prefix_0 - rx_0 - search-pos_0 - who_0) - (begin - (let ((pos_0 (cdar poss_0))) - (if (= pos_0 search-pos_0) - (if (= search-pos_0 (chytes-length in_0)) - (subchytes in_0 0 0) - (let ((app_0 - (subchytes - in_0 - search-pos_0 - (add1 search-pos_0)))) - (chytes-append - app_0 - (loop_0 - all?_0 - in_0 - ins_0 - prefix_0 - rx_0 - who_0 - (add1 search-pos_0))))) - (loop_0 - all?_0 - in_0 - ins_0 - prefix_0 - rx_0 - who_0 - (cdar poss_0))))))))) - (lambda (who_0 rx-in_0 orig-in_0 insert_0 prefix_0 all?_0) - (let ((string-mode?_0 - (if (let ((or-part_0 (string? rx-in_0))) - (if or-part_0 or-part_0 (1/regexp? rx-in_0))) - (string? orig-in_0) - #f))) - (let ((in_0 - (if (if (not string-mode?_0) (string? orig-in_0) #f) - (string->bytes/utf-8 orig-in_0) - orig-in_0))) - (begin - (if (if string-mode?_0 - string-mode?_0 - (if (let ((or-part_0 (bytes? rx-in_0))) - (if or-part_0 or-part_0 (1/byte-regexp? rx-in_0))) - (let ((or-part_0 (string? orig-in_0))) - (if or-part_0 or-part_0 (bytes? orig-in_0))) - #f)) - (if (let ((or-part_0 (string? insert_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (bytes? insert_0))) - (if or-part_1 or-part_1 (procedure? insert_0))))) - (void) - (raise-argument-error - who_0 - "(or/c string? bytes? procedure?)" - insert_0)) - (void)) - (begin - (if string-mode?_0 - (if (bytes? insert_0) - (raise-arguments-error - who_0 - "cannot replace a string with a byte string" - "byte string" - insert_0) - (void)) - (void)) - (let ((rx_0 - (if (string? rx-in_0) - (make-regexp who_0 rx-in_0 #f #f #f) - (if (bytes? rx-in_0) - (make-regexp who_0 rx-in_0 #f #t #f) - rx-in_0)))) - (let ((ins_0 - (if (if (not string-mode?_0) (string? insert_0) #f) - (string->bytes/utf-8 insert_0) - insert_0))) - (loop_0 all?_0 in_0 ins_0 prefix_0 rx_0 who_0 0)))))))))) -(define replacements - (letrec ((cons-chytes_0 - (|#%name| - cons-chytes - (lambda (insert_0 since_0 pos_0 l_0) - (begin - (if (= since_0 pos_0) - l_0 - (cons (subchytes insert_0 since_0 pos_0) l_0)))))) - (get-chytes_0 - (|#%name| - get-chytes - (lambda (count_0 in_0 poss_0 n_0) - (begin - (if (< n_0 count_0) - (let ((pos_0 (list-ref poss_0 n_0))) - (if pos_0 - (let ((app_0 (car pos_0))) - (subchytes in_0 app_0 (cdr pos_0))) - (subchytes in_0 0 0))) - (subchytes in_0 0 0)))))) - (loop_0 - (|#%name| - loop - (lambda (count_0 in_0 insert_0 len_0 poss_0 pos_0 since_0) - (begin - (if (= pos_0 len_0) - (cons-chytes_0 insert_0 since_0 pos_0 null) - (if (= 38 (chytes-ref insert_0 pos_0)) - (cons-chytes_0 - insert_0 - since_0 - pos_0 - (let ((app_0 (get-chytes_0 count_0 in_0 poss_0 0))) - (cons - app_0 - (let ((app_1 (add1 pos_0))) - (loop_0 - count_0 - in_0 - insert_0 - len_0 - poss_0 - app_1 - (add1 pos_0)))))) - (if (= 92 (chytes-ref insert_0 pos_0)) - (cons-chytes_0 - insert_0 - since_0 - pos_0 - (let ((c_0 - (if (< (add1 pos_0) len_0) - (chytes-ref insert_0 (add1 pos_0)) - #f))) - (if (let ((or-part_0 (eq? c_0 38))) - (if or-part_0 or-part_0 (eq? c_0 92))) - (let ((app_0 (+ pos_0 2))) - (loop_0 - count_0 - in_0 - insert_0 - len_0 - poss_0 - app_0 - (add1 pos_0))) - (if (eq? c_0 36) - (let ((app_0 (+ pos_0 2))) - (loop_0 - count_0 - in_0 - insert_0 - len_0 - poss_0 - app_0 - (+ pos_0 2))) - (letrec* - ((d-loop_0 - (|#%name| - d-loop - (lambda (pos_1 accum_0) - (begin - (if (= pos_1 len_0) - (list - (get-chytes_0 - count_0 - in_0 - poss_0 - accum_0)) - (let ((c_1 - (chytes-ref insert_0 pos_1))) - (if (if (>= c_1 48) (<= c_1 57) #f) - (let ((app_0 (add1 pos_1))) - (d-loop_0 - app_0 - (let ((app_1 (* accum_0 10))) - (+ app_1 (- c_1 48))))) - (let ((app_0 - (get-chytes_0 - count_0 - in_0 - poss_0 - accum_0))) - (cons - app_0 - (loop_0 - count_0 - in_0 - insert_0 - len_0 - poss_0 - pos_1 - pos_1))))))))))) - (d-loop_0 (add1 pos_0) 0)))))) - (loop_0 - count_0 - in_0 - insert_0 - len_0 - poss_0 - (add1 pos_0) - since_0))))))))) - (lambda (who_0 in_0 poss_0 insert_0) - (if (procedure? insert_0) - (let ((a_0 - (apply - insert_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((pos_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if pos_0 - (let ((app_0 (car pos_0))) - (subchytes - in_0 - app_0 - (cdr pos_0))) - #f) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null poss_0))))))) - (begin - (if (chytes? in_0 a_0) + (lambda (who_0 rx-in_0 orig-in_0 insert_0 prefix_0 all?_0) + (let ((string-mode?_0 + (if (let ((or-part_0 (string? rx-in_0))) + (if or-part_0 or-part_0 (1/regexp? rx-in_0))) + (string? orig-in_0) + #f))) + (let ((in_0 + (if (if (not string-mode?_0) (string? orig-in_0) #f) + (string->bytes/utf-8 orig-in_0) + orig-in_0))) + (begin + (if (if string-mode?_0 + string-mode?_0 + (if (let ((or-part_0 (bytes? rx-in_0))) + (if or-part_0 or-part_0 (1/byte-regexp? rx-in_0))) + (let ((or-part_0 (string? orig-in_0))) + (if or-part_0 or-part_0 (bytes? orig-in_0))) + #f)) + (if (let ((or-part_0 (string? insert_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (bytes? insert_0))) + (if or-part_1 or-part_1 (procedure? insert_0))))) (void) - (raise-result-error + (raise-argument-error who_0 - (if (bytes? in_0) "bytes?" "string?") - a_0)) - a_0)) - (let ((count_0 (length poss_0))) - (let ((len_0 (chytes-length insert_0))) - (let ((app_0 (if (bytes? insert_0) bytes-append string-append))) - (apply - app_0 - (loop_0 count_0 in_0 insert_0 len_0 poss_0 0 0))))))))) + "(or/c string? bytes? procedure?)" + insert_0)) + (void)) + (begin + (if string-mode?_0 + (if (bytes? insert_0) + (raise-arguments-error + who_0 + "cannot replace a string with a byte string" + "byte string" + insert_0) + (void)) + (void)) + (let ((rx_0 + (if (string? rx-in_0) + (make-regexp who_0 rx-in_0 #f #f #f) + (if (bytes? rx-in_0) + (make-regexp who_0 rx-in_0 #f #t #f) + rx-in_0)))) + (let ((ins_0 + (if (if (not string-mode?_0) (string? insert_0) #f) + (string->bytes/utf-8 insert_0) + insert_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (search-pos_0) + (begin + (let ((poss_0 + (drive-regexp-match.1 + #f + #f + #f + #f + #f + 'positions + #f + #f + search-pos_0 + who_0 + rx_0 + in_0 + 0 + #f + #f + prefix_0))) + (let ((recur_0 + (|#%name| + recur + (lambda () + (begin + (let ((pos_0 (cdar poss_0))) + (if (= pos_0 search-pos_0) + (if (= + search-pos_0 + (chytes-length in_0)) + (subchytes in_0 0 0) + (let ((app_0 + (subchytes + in_0 + search-pos_0 + (add1 search-pos_0)))) + (chytes-append + app_0 + (loop_0 (add1 search-pos_0))))) + (loop_0 (cdar poss_0))))))))) + (if (not poss_0) + (if (zero? search-pos_0) + in_0 + (subchytes in_0 search-pos_0)) + (let ((app_0 + (subchytes + in_0 + search-pos_0 + (caar poss_0)))) + (let ((app_1 + (replacements who_0 in_0 poss_0 ins_0))) + (chytes-append + app_0 + app_1 + (if all?_0 + (recur_0) + (subchytes in_0 (cdar poss_0)))))))))))))) + (loop_0 0)))))))))) +(define replacements + (lambda (who_0 in_0 poss_0 insert_0) + (if (procedure? insert_0) + (let ((a_0 + (apply + insert_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((pos_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if pos_0 + (let ((app_0 (car pos_0))) + (subchytes + in_0 + app_0 + (cdr pos_0))) + #f) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 fold-var_1 rest_0)))) + fold-var_0)))))) + (for-loop_0 null poss_0))))))) + (begin + (if (chytes? in_0 a_0) + (void) + (raise-result-error + who_0 + (if (bytes? in_0) "bytes?" "string?") + a_0)) + a_0)) + (let ((count_0 (length poss_0))) + (let ((get-chytes_0 + (|#%name| + get-chytes + (lambda (n_0) + (begin + (if (< n_0 count_0) + (let ((pos_0 (list-ref poss_0 n_0))) + (if pos_0 + (let ((app_0 (car pos_0))) + (subchytes in_0 app_0 (cdr pos_0))) + (subchytes in_0 0 0))) + (subchytes in_0 0 0))))))) + (let ((cons-chytes_0 + (|#%name| + cons-chytes + (lambda (since_0 pos_0 l_0) + (begin + (if (= since_0 pos_0) + l_0 + (cons (subchytes insert_0 since_0 pos_0) l_0))))))) + (let ((len_0 (chytes-length insert_0))) + (let ((app_0 (if (bytes? insert_0) bytes-append string-append))) + (apply + app_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_0 since_0) + (begin + (if (= pos_0 len_0) + (cons-chytes_0 since_0 pos_0 null) + (if (= 38 (chytes-ref insert_0 pos_0)) + (cons-chytes_0 + since_0 + pos_0 + (let ((app_1 (get-chytes_0 0))) + (cons + app_1 + (let ((app_2 (add1 pos_0))) + (loop_0 app_2 (add1 pos_0)))))) + (if (= 92 (chytes-ref insert_0 pos_0)) + (cons-chytes_0 + since_0 + pos_0 + (let ((c_0 + (if (< (add1 pos_0) len_0) + (chytes-ref insert_0 (add1 pos_0)) + #f))) + (if (let ((or-part_0 (eq? c_0 38))) + (if or-part_0 or-part_0 (eq? c_0 92))) + (let ((app_1 (+ pos_0 2))) + (loop_0 app_1 (add1 pos_0))) + (if (eq? c_0 36) + (let ((app_1 (+ pos_0 2))) + (loop_0 app_1 (+ pos_0 2))) + (letrec* + ((d-loop_0 + (|#%name| + d-loop + (lambda (pos_1 accum_0) + (begin + (if (= pos_1 len_0) + (list (get-chytes_0 accum_0)) + (let ((c_1 + (chytes-ref + insert_0 + pos_1))) + (if (if (>= c_1 48) + (<= c_1 57) + #f) + (let ((app_1 (add1 pos_1))) + (d-loop_0 + app_1 + (let ((app_2 + (* accum_0 10))) + (+ + app_2 + (- c_1 48))))) + (let ((app_1 + (get-chytes_0 + accum_0))) + (cons + app_1 + (loop_0 + pos_1 + pos_1))))))))))) + (d-loop_0 (add1 pos_0) 0)))))) + (loop_0 (add1 pos_0) since_0))))))))) + (loop_0 0 0))))))))))) (define 1/regexp (let ((regexp_0 (|#%name| diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm index fd9bd2fc2f..7ff65a7ff2 100644 --- a/racket/src/cs/schemified/schemify.scm +++ b/racket/src/cs/schemified/schemify.scm @@ -1,5 +1,4 @@ (define hash2610 (hasheq)) -(define kw2080 (string->keyword "empty")) (define hash2725 (hash)) (define kw2846 (string->keyword "direct")) (define kw2615 (string->keyword "anonymous")) @@ -204,286 +203,31 @@ (define-values (sort vector-sort vector-sort!) (let ((generic-sort_0 - (letrec ((copying-mergesort_0 - (|#%name| - copying-mergesort - (lambda (A_0 less-than?_0 Alo_0 Blo_0 n_0) - (begin - (if (unsafe-fx= n_0 1) - (unsafe-vector-set! - A_0 - Blo_0 - (unsafe-vector-ref A_0 Alo_0)) - (if (unsafe-fx= n_0 2) - (let ((x_0 (unsafe-vector-ref A_0 Alo_0))) - (let ((y_0 - (unsafe-vector-ref - A_0 - (unsafe-fx+ Alo_0 1)))) - (let ((x_1 x_0)) - (if (|#%app| less-than?_0 y_0 x_1) - (begin - (unsafe-vector-set! A_0 Blo_0 y_0) - (unsafe-vector-set! - A_0 - (unsafe-fx+ Blo_0 1) - x_1)) - (begin - (unsafe-vector-set! A_0 Blo_0 x_1) - (unsafe-vector-set! - A_0 - (unsafe-fx+ Blo_0 1) - y_0)))))) - (if (unsafe-fx< n_0 16) - (begin - (unsafe-vector-set! - A_0 - Blo_0 - (unsafe-vector-ref A_0 Alo_0)) - (letrec* - ((iloop_0 - (|#%name| - iloop - (lambda (i_0) - (begin - (if (unsafe-fx< i_0 n_0) - (let ((ref-i_0 - (unsafe-vector-ref - A_0 - (unsafe-fx+ Alo_0 i_0)))) - (letrec* - ((jloop_0 - (|#%name| - jloop - (lambda (j_0) - (begin - (let ((ref-j-1_0 - (unsafe-vector-ref - A_0 - (unsafe-fx- - j_0 - 1)))) - (if (if (unsafe-fx< - Blo_0 - j_0) - (|#%app| - less-than?_0 - ref-i_0 - ref-j-1_0) - #f) - (begin - (unsafe-vector-set! - A_0 - j_0 - ref-j-1_0) - (jloop_0 - (unsafe-fx- j_0 1))) - (begin - (unsafe-vector-set! - A_0 - j_0 - ref-i_0) - (iloop_0 - (unsafe-fx+ - i_0 - 1)))))))))) - (jloop_0 (unsafe-fx+ Blo_0 i_0)))) - (void))))))) - (iloop_0 1))) - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_0))) - (let ((Amid2_0 (unsafe-fx+ Alo_0 n/2+_0))) - (let ((Bmid1_0 (unsafe-fx+ Blo_0 n/2-_0))) - (begin - (copying-mergesort_0 - A_0 - less-than?_0 - Amid1_0 - Bmid1_0 - n/2+_0) - (copying-mergesort_0 - A_0 - less-than?_0 - Alo_0 - Amid2_0 - n/2-_0) - (let ((b2_0 (unsafe-fx+ Blo_0 n_0))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (a1_0 b1_0 c1_0) - (begin - (let ((x_0 - (unsafe-vector-ref - A_0 - a1_0))) - (let ((y_0 - (unsafe-vector-ref - A_0 - b1_0))) - (let ((x_1 x_0)) - (if (not - (|#%app| - less-than?_0 - y_0 - x_1)) - (begin - (unsafe-vector-set! - A_0 - c1_0 - x_1) - (let ((a1_1 - (unsafe-fx+ - a1_0 - 1))) - (let ((c1_1 - (unsafe-fx+ - c1_0 - 1))) - (if (unsafe-fx< - c1_1 - b1_0) - (loop_0 - a1_1 - b1_0 - c1_1) - (void))))) - (begin - (unsafe-vector-set! - A_0 - c1_0 - y_0) - (let ((b1_1 - (unsafe-fx+ - b1_0 - 1))) - (let ((c1_1 - (unsafe-fx+ - c1_0 - 1))) - (if (unsafe-fx<= - b2_0 - b1_1) - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (a1_1 - c1_2) - (begin - (if (unsafe-fx< - c1_2 - b1_1) - (begin - (unsafe-vector-set! - A_0 - c1_2 - (unsafe-vector-ref - A_0 - a1_1)) - (loop_1 - (unsafe-fx+ - a1_1 - 1) - (unsafe-fx+ - c1_2 - 1))) - (void))))))) - (loop_1 - a1_0 - c1_1)) - (loop_0 - a1_0 - b1_1 - c1_1)))))))))))))) - (loop_0 - Amid2_0 - Bmid1_0 - Blo_0))))))))))))))))) - (|#%name| - generic-sort - (lambda (A_0 less-than?_0 n_0) - (begin - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (begin - (copying-mergesort_0 A_0 less-than?_0 n/2-_0 n_0 n/2+_0) - (if (zero? n/2-_0) - (void) - (copying-mergesort_0 A_0 less-than?_0 0 n/2+_0 n/2-_0)) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (a1_0 b1_0 c1_0) - (begin - (let ((x_0 (unsafe-vector-ref A_0 a1_0))) - (let ((y_0 (unsafe-vector-ref A_0 b1_0))) - (let ((x_1 x_0)) - (if (|#%app| less-than?_0 x_1 y_0) - (begin - (unsafe-vector-set! A_0 c1_0 x_1) - (let ((a1_1 (unsafe-fx+ a1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx< c1_1 b1_0) - (loop_0 a1_1 b1_0 c1_1) - (void))))) - (begin - (unsafe-vector-set! A_0 c1_0 y_0) - (let ((b1_1 (unsafe-fx+ b1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx<= n_0 b1_1) - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (a1_1 c1_2) - (begin - (if (unsafe-fx< c1_2 b1_1) - (begin - (unsafe-vector-set! - A_0 - c1_2 - (unsafe-vector-ref - A_0 - a1_1)) - (loop_1 - (unsafe-fx+ a1_1 1) - (unsafe-fx+ c1_2 1))) - (void))))))) - (loop_1 a1_0 c1_1)) - (loop_0 - a1_0 - b1_1 - c1_1)))))))))))))) - (loop_0 n_0 n/2+_0 0))))))))))) - (let ((generic-sort/key_0 - (letrec ((copying-mergesort_0 + (|#%name| + generic-sort + (lambda (A_0 less-than?_0 n_0) + (begin + (let ((n/2-_0 (unsafe-fxrshift n_0 1))) + (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) + (letrec* + ((copying-mergesort_0 (|#%name| copying-mergesort - (lambda (A_0 key_0 less-than?_0 Alo_0 Blo_0 n_0) + (lambda (Alo_0 Blo_0 n_1) (begin - (if (unsafe-fx= n_0 1) + (if (unsafe-fx= n_1 1) (unsafe-vector-set! A_0 Blo_0 (unsafe-vector-ref A_0 Alo_0)) - (if (unsafe-fx= n_0 2) + (if (unsafe-fx= n_1 2) (let ((x_0 (unsafe-vector-ref A_0 Alo_0))) (let ((y_0 (unsafe-vector-ref A_0 (unsafe-fx+ Alo_0 1)))) (let ((x_1 x_0)) - (if (if key_0 - (let ((app_0 (|#%app| key_0 y_0))) - (|#%app| - less-than?_0 - app_0 - (|#%app| key_0 x_1))) - (|#%app| less-than?_0 y_0 x_1)) + (if (|#%app| less-than?_0 y_0 x_1) (begin (unsafe-vector-set! A_0 Blo_0 y_0) (unsafe-vector-set! @@ -496,7 +240,7 @@ A_0 (unsafe-fx+ Blo_0 1) y_0)))))) - (if (unsafe-fx< n_0 16) + (if (unsafe-fx< n_1 16) (begin (unsafe-vector-set! A_0 @@ -508,7 +252,7 @@ iloop (lambda (i_0) (begin - (if (unsafe-fx< i_0 n_0) + (if (unsafe-fx< i_0 n_1) (let ((ref-i_0 (unsafe-vector-ref A_0 @@ -528,21 +272,10 @@ (if (if (unsafe-fx< Blo_0 j_0) - (if key_0 - (let ((app_0 - (|#%app| - key_0 - ref-i_0))) - (|#%app| - less-than?_0 - app_0 - (|#%app| - key_0 - ref-j-1_0))) - (|#%app| - less-than?_0 - ref-i_0 - ref-j-1_0)) + (|#%app| + less-than?_0 + ref-i_0 + ref-j-1_0) #f) (begin (unsafe-vector-set! @@ -566,28 +299,22 @@ (unsafe-fx+ Blo_0 i_0)))) (void))))))) (iloop_0 1))) - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_0))) - (let ((Amid2_0 (unsafe-fx+ Alo_0 n/2+_0))) + (let ((n/2-_1 (unsafe-fxrshift n_1 1))) + (let ((n/2+_1 (unsafe-fx- n_1 n/2-_1))) + (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_1))) + (let ((Amid2_0 (unsafe-fx+ Alo_0 n/2+_1))) (let ((Bmid1_0 - (unsafe-fx+ Blo_0 n/2-_0))) + (unsafe-fx+ Blo_0 n/2-_1))) (begin (copying-mergesort_0 - A_0 - key_0 - less-than?_0 Amid1_0 Bmid1_0 - n/2+_0) + n/2+_1) (copying-mergesort_0 - A_0 - key_0 - less-than?_0 Alo_0 Amid2_0 - n/2-_0) - (let ((b2_0 (unsafe-fx+ Blo_0 n_0))) + n/2-_1) + (let ((b2_0 (unsafe-fx+ Blo_0 n_1))) (letrec* ((loop_0 (|#%name| @@ -604,21 +331,10 @@ b1_0))) (let ((x_1 x_0)) (if (not - (if key_0 - (let ((app_0 - (|#%app| - key_0 - y_0))) - (|#%app| - less-than?_0 - app_0 - (|#%app| - key_0 - x_1))) - (|#%app| - less-than?_0 - y_0 - x_1))) + (|#%app| + less-than?_0 + y_0 + x_1)) (begin (unsafe-vector-set! A_0 @@ -692,274 +408,530 @@ Amid2_0 Bmid1_0 Blo_0))))))))))))))))) - (|#%name| - generic-sort/key - (lambda (A_0 less-than?_0 n_0 key_0) - (begin - (let ((n/2-_0 (unsafe-fxrshift n_0 1))) - (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) - (begin - (copying-mergesort_0 - A_0 - key_0 - less-than?_0 - n/2-_0 - n_0 - n/2+_0) - (if (zero? n/2-_0) - (void) - (copying-mergesort_0 - A_0 - key_0 - less-than?_0 - 0 - n/2+_0 - n/2-_0)) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (a1_0 b1_0 c1_0) - (begin - (let ((x_0 (unsafe-vector-ref A_0 a1_0))) - (let ((y_0 (unsafe-vector-ref A_0 b1_0))) + (begin + (copying-mergesort_0 n/2-_0 n_0 n/2+_0) + (if (zero? n/2-_0) + (void) + (copying-mergesort_0 0 n/2+_0 n/2-_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (a1_0 b1_0 c1_0) + (begin + (let ((x_0 (unsafe-vector-ref A_0 a1_0))) + (let ((y_0 (unsafe-vector-ref A_0 b1_0))) + (let ((x_1 x_0)) + (if (|#%app| less-than?_0 x_1 y_0) + (begin + (unsafe-vector-set! A_0 c1_0 x_1) + (let ((a1_1 (unsafe-fx+ a1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx< c1_1 b1_0) + (loop_0 a1_1 b1_0 c1_1) + (void))))) + (begin + (unsafe-vector-set! A_0 c1_0 y_0) + (let ((b1_1 (unsafe-fx+ b1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx<= n_0 b1_1) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (a1_1 c1_2) + (begin + (if (unsafe-fx< c1_2 b1_1) + (begin + (unsafe-vector-set! + A_0 + c1_2 + (unsafe-vector-ref + A_0 + a1_1)) + (loop_1 + (unsafe-fx+ a1_1 1) + (unsafe-fx+ c1_2 1))) + (void))))))) + (loop_1 a1_0 c1_1)) + (loop_0 + a1_0 + b1_1 + c1_1)))))))))))))) + (loop_0 n_0 n/2+_0 0))))))))))) + (let ((generic-sort/key_0 + (|#%name| + generic-sort/key + (lambda (A_0 less-than?_0 n_0 key_0) + (begin + (let ((n/2-_0 (unsafe-fxrshift n_0 1))) + (let ((n/2+_0 (unsafe-fx- n_0 n/2-_0))) + (letrec* + ((copying-mergesort_0 + (|#%name| + copying-mergesort + (lambda (Alo_0 Blo_0 n_1) + (begin + (if (unsafe-fx= n_1 1) + (unsafe-vector-set! + A_0 + Blo_0 + (unsafe-vector-ref A_0 Alo_0)) + (if (unsafe-fx= n_1 2) + (let ((x_0 (unsafe-vector-ref A_0 Alo_0))) + (let ((y_0 + (unsafe-vector-ref + A_0 + (unsafe-fx+ Alo_0 1)))) (let ((x_1 x_0)) (if (if key_0 - (let ((app_0 (|#%app| key_0 x_1))) + (let ((app_0 (|#%app| key_0 y_0))) (|#%app| less-than?_0 app_0 - (|#%app| key_0 y_0))) - (|#%app| less-than?_0 x_1 y_0)) + (|#%app| key_0 x_1))) + (|#%app| less-than?_0 y_0 x_1)) (begin - (unsafe-vector-set! A_0 c1_0 x_1) - (let ((a1_1 (unsafe-fx+ a1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx< c1_1 b1_0) - (loop_0 a1_1 b1_0 c1_1) - (void))))) + (unsafe-vector-set! A_0 Blo_0 y_0) + (unsafe-vector-set! + A_0 + (unsafe-fx+ Blo_0 1) + x_1)) (begin - (unsafe-vector-set! A_0 c1_0 y_0) - (let ((b1_1 (unsafe-fx+ b1_0 1))) - (let ((c1_1 (unsafe-fx+ c1_0 1))) - (if (unsafe-fx<= n_0 b1_1) + (unsafe-vector-set! A_0 Blo_0 x_1) + (unsafe-vector-set! + A_0 + (unsafe-fx+ Blo_0 1) + y_0)))))) + (if (unsafe-fx< n_1 16) + (begin + (unsafe-vector-set! + A_0 + Blo_0 + (unsafe-vector-ref A_0 Alo_0)) + (letrec* + ((iloop_0 + (|#%name| + iloop + (lambda (i_0) + (begin + (if (unsafe-fx< i_0 n_1) + (let ((ref-i_0 + (unsafe-vector-ref + A_0 + (unsafe-fx+ Alo_0 i_0)))) (letrec* - ((loop_1 + ((jloop_0 + (|#%name| + jloop + (lambda (j_0) + (begin + (let ((ref-j-1_0 + (unsafe-vector-ref + A_0 + (unsafe-fx- + j_0 + 1)))) + (if (if (unsafe-fx< + Blo_0 + j_0) + (if key_0 + (let ((app_0 + (|#%app| + key_0 + ref-i_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| + key_0 + ref-j-1_0))) + (|#%app| + less-than?_0 + ref-i_0 + ref-j-1_0)) + #f) + (begin + (unsafe-vector-set! + A_0 + j_0 + ref-j-1_0) + (jloop_0 + (unsafe-fx- + j_0 + 1))) + (begin + (unsafe-vector-set! + A_0 + j_0 + ref-i_0) + (iloop_0 + (unsafe-fx+ + i_0 + 1)))))))))) + (jloop_0 + (unsafe-fx+ Blo_0 i_0)))) + (void))))))) + (iloop_0 1))) + (let ((n/2-_1 (unsafe-fxrshift n_1 1))) + (let ((n/2+_1 (unsafe-fx- n_1 n/2-_1))) + (let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_1))) + (let ((Amid2_0 + (unsafe-fx+ Alo_0 n/2+_1))) + (let ((Bmid1_0 + (unsafe-fx+ Blo_0 n/2-_1))) + (begin + (copying-mergesort_0 + Amid1_0 + Bmid1_0 + n/2+_1) + (copying-mergesort_0 + Alo_0 + Amid2_0 + n/2-_1) + (let ((b2_0 + (unsafe-fx+ Blo_0 n_1))) + (letrec* + ((loop_0 (|#%name| loop - (lambda (a1_1 c1_2) + (lambda (a1_0 b1_0 c1_0) (begin - (if (unsafe-fx< - c1_2 - b1_1) - (begin - (unsafe-vector-set! - A_0 - c1_2 - (unsafe-vector-ref - A_0 - a1_1)) - (loop_1 - (unsafe-fx+ a1_1 1) - (unsafe-fx+ - c1_2 - 1))) - (void))))))) - (loop_1 a1_0 c1_1)) - (loop_0 - a1_0 - b1_1 - c1_1)))))))))))))) - (loop_0 n_0 n/2+_0 0))))))))))) - (values - (letrec ((loop_0 - (|#%name| - loop - (lambda (getkey_0 less-than?_0 last_0 next_0) - (begin - (let ((or-part_0 (null? next_0))) - (if or-part_0 - or-part_0 - (if (not - (if getkey_0 - (let ((app_0 - (|#%app| getkey_0 (unsafe-car next_0)))) - (|#%app| - less-than?_0 - app_0 - (|#%app| getkey_0 last_0))) - (|#%app| - less-than?_0 - (unsafe-car next_0) - last_0))) - (loop_0 - getkey_0 - less-than?_0 - (unsafe-car next_0) - (unsafe-cdr next_0)) - #f))))))) - (loop_1 - (|#%name| - loop - (lambda (less-than?_0 last_0 next_0) - (begin - (let ((or-part_0 (null? next_0))) - (if or-part_0 - or-part_0 - (if (not - (|#%app| - less-than?_0 - (unsafe-car next_0) - last_0)) - (loop_1 - less-than?_0 - (unsafe-car next_0) - (unsafe-cdr next_0)) - #f)))))))) - (case-lambda - ((lst_0 less-than?_0) - (let ((n_0 (length lst_0))) - (if (unsafe-fx= n_0 0) - lst_0 - (if (let ((app_0 (car lst_0))) - (loop_1 less-than?_0 app_0 (cdr lst_0))) - lst_0 - (if (unsafe-fx<= n_0 3) - (if (unsafe-fx= n_0 1) - lst_0 - (if (unsafe-fx= n_0 2) - (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) - (let ((a_0 (car lst_0))) - (let ((b_0 (cadr lst_0))) - (let ((c_0 (caddr lst_0))) - (let ((b_1 b_0) (a_1 a_0)) - (if (|#%app| less-than?_0 b_1 a_1) - (if (|#%app| less-than?_0 c_0 b_1) - (list c_0 b_1 a_1) - (if (|#%app| less-than?_0 c_0 a_1) - (list b_1 c_0 a_1) - (list b_1 a_1 c_0))) - (if (|#%app| less-than?_0 c_0 a_1) - (list c_0 a_1 b_1) - (list a_1 c_0 b_1))))))))) - (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (let ((x_0 + (unsafe-vector-ref + A_0 + a1_0))) + (let ((y_0 + (unsafe-vector-ref + A_0 + b1_0))) + (let ((x_1 x_0)) + (if (not + (if key_0 + (let ((app_0 + (|#%app| + key_0 + y_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| + key_0 + x_1))) + (|#%app| + less-than?_0 + y_0 + x_1))) + (begin + (unsafe-vector-set! + A_0 + c1_0 + x_1) + (let ((a1_1 + (unsafe-fx+ + a1_0 + 1))) + (let ((c1_1 + (unsafe-fx+ + c1_0 + 1))) + (if (unsafe-fx< + c1_1 + b1_0) + (loop_0 + a1_1 + b1_0 + c1_1) + (void))))) + (begin + (unsafe-vector-set! + A_0 + c1_0 + y_0) + (let ((b1_1 + (unsafe-fx+ + b1_0 + 1))) + (let ((c1_1 + (unsafe-fx+ + c1_0 + 1))) + (if (unsafe-fx<= + b2_0 + b1_1) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (a1_1 + c1_2) + (begin + (if (unsafe-fx< + c1_2 + b1_1) + (begin + (unsafe-vector-set! + A_0 + c1_2 + (unsafe-vector-ref + A_0 + a1_1)) + (loop_1 + (unsafe-fx+ + a1_1 + 1) + (unsafe-fx+ + c1_2 + 1))) + (void))))))) + (loop_1 + a1_0 + c1_1)) + (loop_0 + a1_0 + b1_1 + c1_1)))))))))))))) + (loop_0 + Amid2_0 + Bmid1_0 + Blo_0))))))))))))))))) (begin + (copying-mergesort_0 n/2-_0 n_0 n/2+_0) + (if (zero? n/2-_0) + (void) + (copying-mergesort_0 0 n/2+_0 n/2-_0)) (letrec* - ((loop_2 + ((loop_0 (|#%name| loop - (lambda (i_0 lst_1) + (lambda (a1_0 b1_0 c1_0) (begin - (if (pair? lst_1) - (begin - (vector-set! vec_0 i_0 (car lst_1)) - (let ((app_0 (add1 i_0))) - (loop_2 app_0 (cdr lst_1)))) - (void))))))) - (loop_2 0 lst_0)) - (generic-sort_0 vec_0 less-than?_0 n_0) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 r_0) - (begin - (let ((i_1 (sub1 i_0))) - (if (< i_1 0) - r_0 - (loop_2 - i_1 - (cons (vector-ref vec_0 i_1) r_0))))))))) - (loop_2 n_0 '()))))))))) - ((lst_0 less-than?_0 getkey_0) - (if (if getkey_0 (not (eq? values getkey_0)) #f) - (|#%app| - (check-not-unsafe-undefined sort 'sort) - lst_0 - less-than?_0 - getkey_0 - #f) - (|#%app| - (check-not-unsafe-undefined sort 'sort) - lst_0 - less-than?_0))) - ((lst_0 less-than?_0 getkey_0 cache-keys?_0) - (if (if getkey_0 (not (eq? values getkey_0)) #f) - (let ((n_0 (length lst_0))) - (if (unsafe-fx= n_0 0) - lst_0 - (if cache-keys?_0 - (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) - (begin - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 lst_1) - (begin - (if (pair? lst_1) - (let ((x_0 (car lst_1))) - (begin - (unsafe-vector-set! - vec_0 - i_0 - (cons (|#%app| getkey_0 x_0) x_0)) - (loop_2 (unsafe-fx+ i_0 1) (cdr lst_1)))) - (void))))))) - (loop_2 0 lst_0)) - (generic-sort/key_0 vec_0 less-than?_0 n_0 unsafe-car) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 r_0) - (begin - (let ((i_1 (unsafe-fx- i_0 1))) - (if (unsafe-fx< i_1 0) - r_0 - (loop_2 - i_1 - (cons - (unsafe-cdr (unsafe-vector-ref vec_0 i_1)) - r_0))))))))) - (loop_2 n_0 '())))) - (if (let ((app_0 (car lst_0))) - (loop_0 getkey_0 less-than?_0 app_0 (cdr lst_0))) - lst_0 - (if (unsafe-fx<= n_0 3) - (if (unsafe-fx= n_0 1) - lst_0 - (if (unsafe-fx= n_0 2) - (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) - (let ((a_0 (car lst_0))) - (let ((b_0 (cadr lst_0))) - (let ((c_0 (caddr lst_0))) - (let ((b_1 b_0) (a_1 a_0)) - (if (if getkey_0 - (let ((app_0 (|#%app| getkey_0 b_1))) - (|#%app| - less-than?_0 - app_0 - (|#%app| getkey_0 a_1))) - (|#%app| less-than?_0 b_1 a_1)) - (if (if getkey_0 - (let ((app_0 (|#%app| getkey_0 c_0))) + (let ((x_0 (unsafe-vector-ref A_0 a1_0))) + (let ((y_0 (unsafe-vector-ref A_0 b1_0))) + (let ((x_1 x_0)) + (if (if key_0 + (let ((app_0 (|#%app| key_0 x_1))) (|#%app| less-than?_0 app_0 - (|#%app| getkey_0 b_1))) - (|#%app| less-than?_0 c_0 b_1)) - (list c_0 b_1 a_1) - (if (if getkey_0 - (let ((app_0 - (|#%app| getkey_0 c_0))) + (|#%app| key_0 y_0))) + (|#%app| less-than?_0 x_1 y_0)) + (begin + (unsafe-vector-set! A_0 c1_0 x_1) + (let ((a1_1 (unsafe-fx+ a1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx< c1_1 b1_0) + (loop_0 a1_1 b1_0 c1_1) + (void))))) + (begin + (unsafe-vector-set! A_0 c1_0 y_0) + (let ((b1_1 (unsafe-fx+ b1_0 1))) + (let ((c1_1 (unsafe-fx+ c1_0 1))) + (if (unsafe-fx<= n_0 b1_1) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (a1_1 c1_2) + (begin + (if (unsafe-fx< + c1_2 + b1_1) + (begin + (unsafe-vector-set! + A_0 + c1_2 + (unsafe-vector-ref + A_0 + a1_1)) + (loop_1 + (unsafe-fx+ a1_1 1) + (unsafe-fx+ + c1_2 + 1))) + (void))))))) + (loop_1 a1_0 c1_1)) + (loop_0 + a1_0 + b1_1 + c1_1)))))))))))))) + (loop_0 n_0 n/2+_0 0))))))))))) + (values + (case-lambda + ((lst_0 less-than?_0) + (let ((n_0 (length lst_0))) + (if (unsafe-fx= n_0 0) + lst_0 + (if (letrec* + ((loop_0 + (|#%name| + loop + (lambda (last_0 next_0) + (begin + (let ((or-part_0 (null? next_0))) + (if or-part_0 + or-part_0 + (if (not + (|#%app| + less-than?_0 + (unsafe-car next_0) + last_0)) + (loop_0 (unsafe-car next_0) (unsafe-cdr next_0)) + #f)))))))) + (let ((app_0 (car lst_0))) (loop_0 app_0 (cdr lst_0)))) + lst_0 + (if (unsafe-fx<= n_0 3) + (if (unsafe-fx= n_0 1) + lst_0 + (if (unsafe-fx= n_0 2) + (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) + (let ((a_0 (car lst_0))) + (let ((b_0 (cadr lst_0))) + (let ((c_0 (caddr lst_0))) + (let ((b_1 b_0) (a_1 a_0)) + (if (|#%app| less-than?_0 b_1 a_1) + (if (|#%app| less-than?_0 c_0 b_1) + (list c_0 b_1 a_1) + (if (|#%app| less-than?_0 c_0 a_1) + (list b_1 c_0 a_1) + (list b_1 a_1 c_0))) + (if (|#%app| less-than?_0 c_0 a_1) + (list c_0 a_1 b_1) + (list a_1 c_0 b_1))))))))) + (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 lst_1) + (begin + (if (pair? lst_1) + (begin + (vector-set! vec_0 i_0 (car lst_1)) + (let ((app_0 (add1 i_0))) + (loop_0 app_0 (cdr lst_1)))) + (void))))))) + (loop_0 0 lst_0)) + (generic-sort_0 vec_0 less-than?_0 n_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 r_0) + (begin + (let ((i_1 (sub1 i_0))) + (if (< i_1 0) + r_0 + (loop_0 + i_1 + (cons (vector-ref vec_0 i_1) r_0))))))))) + (loop_0 n_0 '()))))))))) + ((lst_0 less-than?_0 getkey_0) + (if (if getkey_0 (not (eq? values getkey_0)) #f) + (|#%app| + (check-not-unsafe-undefined sort 'sort) + lst_0 + less-than?_0 + getkey_0 + #f) + (|#%app| + (check-not-unsafe-undefined sort 'sort) + lst_0 + less-than?_0))) + ((lst_0 less-than?_0 getkey_0 cache-keys?_0) + (if (if getkey_0 (not (eq? values getkey_0)) #f) + (let ((n_0 (length lst_0))) + (if (unsafe-fx= n_0 0) + lst_0 + (if cache-keys?_0 + (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 lst_1) + (begin + (if (pair? lst_1) + (let ((x_0 (car lst_1))) + (begin + (unsafe-vector-set! + vec_0 + i_0 + (cons (|#%app| getkey_0 x_0) x_0)) + (loop_0 (unsafe-fx+ i_0 1) (cdr lst_1)))) + (void))))))) + (loop_0 0 lst_0)) + (generic-sort/key_0 vec_0 less-than?_0 n_0 unsafe-car) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 r_0) + (begin + (let ((i_1 (unsafe-fx- i_0 1))) + (if (unsafe-fx< i_1 0) + r_0 + (loop_0 + i_1 + (cons + (unsafe-cdr (unsafe-vector-ref vec_0 i_1)) + r_0))))))))) + (loop_0 n_0 '())))) + (if (letrec* + ((loop_0 + (|#%name| + loop + (lambda (last_0 next_0) + (begin + (let ((or-part_0 (null? next_0))) + (if or-part_0 + or-part_0 + (if (not + (if getkey_0 + (let ((app_0 (|#%app| - less-than?_0 - app_0 - (|#%app| getkey_0 a_1))) - (|#%app| less-than?_0 c_0 a_1)) - (list b_1 c_0 a_1) - (list b_1 a_1 c_0))) + getkey_0 + (unsafe-car next_0)))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 last_0))) + (|#%app| + less-than?_0 + (unsafe-car next_0) + last_0))) + (loop_0 + (unsafe-car next_0) + (unsafe-cdr next_0)) + #f)))))))) + (let ((app_0 (car lst_0))) (loop_0 app_0 (cdr lst_0)))) + lst_0 + (if (unsafe-fx<= n_0 3) + (if (unsafe-fx= n_0 1) + lst_0 + (if (unsafe-fx= n_0 2) + (let ((app_0 (cadr lst_0))) (list app_0 (car lst_0))) + (let ((a_0 (car lst_0))) + (let ((b_0 (cadr lst_0))) + (let ((c_0 (caddr lst_0))) + (let ((b_1 b_0) (a_1 a_0)) + (if (if getkey_0 + (let ((app_0 (|#%app| getkey_0 b_1))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 a_1))) + (|#%app| less-than?_0 b_1 a_1)) + (if (if getkey_0 + (let ((app_0 (|#%app| getkey_0 c_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 b_1))) + (|#%app| less-than?_0 c_0 b_1)) + (list c_0 b_1 a_1) (if (if getkey_0 (let ((app_0 (|#%app| getkey_0 c_0))) (|#%app| @@ -967,43 +939,50 @@ app_0 (|#%app| getkey_0 a_1))) (|#%app| less-than?_0 c_0 a_1)) - (list c_0 a_1 b_1) - (list a_1 c_0 b_1))))))))) - (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) - (begin - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 lst_1) - (begin - (if (pair? lst_1) - (begin - (vector-set! vec_0 i_0 (car lst_1)) - (let ((app_0 (add1 i_0))) - (loop_2 app_0 (cdr lst_1)))) - (void))))))) - (loop_2 0 lst_0)) - (generic-sort/key_0 vec_0 less-than?_0 n_0 getkey_0) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (i_0 r_0) - (begin - (let ((i_1 (sub1 i_0))) - (if (< i_1 0) - r_0 - (loop_2 - i_1 - (cons - (vector-ref vec_0 i_1) - r_0))))))))) - (loop_2 n_0 '()))))))))) - (|#%app| - (check-not-unsafe-undefined sort 'sort) - lst_0 - less-than?_0))))) + (list b_1 c_0 a_1) + (list b_1 a_1 c_0))) + (if (if getkey_0 + (let ((app_0 (|#%app| getkey_0 c_0))) + (|#%app| + less-than?_0 + app_0 + (|#%app| getkey_0 a_1))) + (|#%app| less-than?_0 c_0 a_1)) + (list c_0 a_1 b_1) + (list a_1 c_0 b_1))))))))) + (let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2)))))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 lst_1) + (begin + (if (pair? lst_1) + (begin + (vector-set! vec_0 i_0 (car lst_1)) + (let ((app_0 (add1 i_0))) + (loop_0 app_0 (cdr lst_1)))) + (void))))))) + (loop_0 0 lst_0)) + (generic-sort/key_0 vec_0 less-than?_0 n_0 getkey_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 r_0) + (begin + (let ((i_1 (sub1 i_0))) + (if (< i_1 0) + r_0 + (loop_0 + i_1 + (cons (vector-ref vec_0 i_1) r_0))))))))) + (loop_0 n_0 '()))))))))) + (|#%app| + (check-not-unsafe-undefined sort 'sort) + lst_0 + less-than?_0)))) (case-lambda ((vec_0 less-than?_0 start_0 end_0) (let ((n_0 (- end_0 start_0))) @@ -1757,11 +1736,6 @@ (if (hash? ht_0) (void) (raise-argument-error 'in-hash-keys "hash?" ht_0)))) -(define check-in-hash-values - (lambda (ht_0) - (if (hash? ht_0) - (void) - (raise-argument-error 'in-hash-values "hash?" ht_0)))) (define check-ranges (lambda (who_0 type-name_0 vec_0 start_0 stop_0 step_0 len_0) (begin @@ -1863,24 +1837,18 @@ (lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 2)))))))) (define empty-stream (make-do-stream (lambda () #t) void void)) (define hash-keys - (letrec ((loop_0 - (|#%name| - loop - (lambda (h_0 pos_0) - (begin - (if pos_0 - (let ((app_0 (hash-iterate-key h_0 pos_0))) - (cons app_0 (loop_0 h_0 (hash-iterate-next h_0 pos_0)))) - null)))))) - (lambda (h_0) (loop_0 h_0 (hash-iterate-first h_0))))) -(define hash-values - (letrec ((procz1 (lambda (k_0 v_0) v_0))) - (lambda (table_0) - (begin - (if (hash? table_0) - (void) - (raise-argument-error 'hash-values "hash?" table_0)) - (hash-map table_0 procz1))))) + (lambda (h_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_0) + (begin + (if pos_0 + (let ((app_0 (hash-iterate-key h_0 pos_0))) + (cons app_0 (loop_0 (hash-iterate-next h_0 pos_0)))) + null)))))) + (loop_0 (hash-iterate-first h_0))))) (define hash-empty? (lambda (table_0) (begin @@ -4977,435 +4945,99 @@ 'set!ed-too-early (if (eq? v_0 'implicitly-set!ed) v_0 'set!ed)))))) (define simple?.1 - (letrec ((returns_0 - (|#%name| - returns - (lambda (result-arity_0 n_0) - (begin - (let ((or-part_0 (not result-arity_0))) - (if or-part_0 or-part_0 (eqv? n_0 result-arity_0))))))) - (simple-begin?_0 - (|#%name| - simple-begin? - (lambda (e_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - result-arity_0 - simples10_0 - es_0) - (begin - (let ((c_0 (hash-ref simples10_0 e_0 '#(unknown unknown 1)))) - (let ((r_0 (vector-ref c_0 (if pure?1_0 0 1)))) - (let ((arity-match?_0 - (eqv? result-arity_0 (vector-ref c_0 2)))) - (if (let ((or-part_0 (eq? 'unknown r_0))) - (if or-part_0 or-part_0 (not arity-match?_0))) - (let ((r_1 - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (es_1) - (begin - (if (null? (cdr es_1)) - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - (car es_1) - result-arity_0) - (if (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - (car es_1) - #f) - (loop_0 (cdr es_1)) - #f))))))) - (loop_0 es_0)))) + (|#%name| + simple? + (lambda (pure?1_0 + result-arity2_0 + e5_0 + prim-knowns6_0 + knowns7_0 + imports8_0 + mutated9_0 + simples10_0) + (begin + (letrec* + ((simple?_0 + (|#%name| + simple? + (lambda (e_0 result-arity_0) + (begin + (let ((returns_0 + (|#%name| + returns + (lambda (n_0) + (begin + (let ((or-part_0 (not result-arity_0))) + (if or-part_0 + or-part_0 + (eqv? n_0 result-arity_0)))))))) + (let ((simple-begin?_0 + (|#%name| + simple-begin? + (lambda (es_0) (begin - (hash-set! - simples10_0 - e_0 - (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref c_0 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref c_0 0) - 'unknown) - r_1 - result-arity_0))) - r_1)) - r_0)))))))) - (simple?_0 - (|#%name| - simple? - (lambda (imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - e_0 - result-arity_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap e_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) #t #f) - (returns_0 result-arity_0 1) - (if (if (eq? 'case-lambda hd_0) #t #f) - (returns_0 result-arity_0 1) - (if (if (eq? 'quote hd_0) #t #f) - (returns_0 result-arity_0 1) - (if (if (eq? '|#%variable-reference| hd_0) #t #f) - (returns_0 result-arity_0 1) - (if (if (eq? 'let-values hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - (let ((a_1 (cdr p_0))) - (let ((p_1 (unwrap a_1))) - (if (pair? p_1) - (let ((a_2 (cdr p_1))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_2))))) - #f))) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idss_0 rhss_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((idss_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((idss_2 - idss_1)) - (values - idss_2 - rhss_1)))))) - (case-lambda - ((idss12_0 - rhss13_0) - (values - (cons - idss12_0 - idss_0) - (cons - rhss13_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 - rhss_1) - (values - idss_1 - rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 - rhss_1) - (for-loop_0 - idss_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - idss_0 - rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((idss_0 rhss_0) - (let ((app_0 (reverse$1 idss_0))) - (values - app_0 - (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((idss_0 rhss_0) - (let ((body_0 - (let ((d_1 (cdr p_0))) - (let ((a_0 (car (unwrap d_1)))) - a_0)))) - (let ((idss_1 idss_0) (rhss_1 rhss_0)) - (values idss_1 rhss_1 body_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((idss_0 rhss_0 body_0) - (let ((c_0 - (hash-ref - simples10_0 - e_0 - '#(unknown unknown 1)))) - (let ((r_0 - (vector-ref c_0 (if pure?1_0 0 1)))) - (let ((arity-match?_0 - (eqv? - result-arity_0 - (vector-ref c_0 2)))) - (if (let ((or-part_0 (eq? 'unknown r_0))) - (if or-part_0 - or-part_0 - (not arity-match?_0))) - (let ((r_1 - (if (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - lst_0 - lst_1) - (begin - (if (if (pair? - lst_0) - (pair? - lst_1) - #f) - (let ((ids_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((rhs_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((result_1 - (let ((result_1 - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - rhs_0 - (length - ids_0)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - ids_0))) - (not - result_1))) - (if (not - (let ((x_0 - (list - rhs_0))) - (not - result_1))) - #t - #f) - #f) - (for-loop_0 - result_1 - rest_0 - rest_1) - result_1)))))) - result_0)))))) - (for-loop_0 - #t - idss_0 - rhss_0))) - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - body_0 - result-arity_0) - #f))) - (begin - (hash-set! - simples10_0 - e_0 - (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref c_0 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref c_0 0) - 'unknown) - r_1 - result-arity_0))) - r_1)) - r_0))))) - (args - (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'let hd_0) + (let ((c_0 + (hash-ref + simples10_0 + e_0 + '#(unknown unknown 1)))) + (let ((r_0 (vector-ref c_0 (if pure?1_0 0 1)))) + (let ((arity-match?_0 + (eqv? + result-arity_0 + (vector-ref c_0 2)))) + (if (let ((or-part_0 (eq? 'unknown r_0))) + (if or-part_0 + or-part_0 + (not arity-match?_0))) + (let ((r_1 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (es_1) + (begin + (if (null? (cdr es_1)) + (simple?_0 + (car es_1) + result-arity_0) + (if (simple?_0 + (car es_1) + #f) + (loop_0 (cdr es_1)) + #f))))))) + (loop_0 es_0)))) + (begin + (hash-set! + simples10_0 + e_0 + (if pure?1_0 + (vector + r_1 + (if arity-match?_0 + (vector-ref c_0 1) + 'unknown) + result-arity_0) + (vector + (if arity-match?_0 + (vector-ref c_0 0) + 'unknown) + r_1 + result-arity_0))) + r_1)) + r_0))))))))) + (let ((hd_0 + (let ((p_0 (unwrap e_0))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) #t #f) + (returns_0 1) + (if (if (eq? 'case-lambda hd_0) #t #f) + (returns_0 1) + (if (if (eq? 'quote hd_0) #t #f) + (returns_0 1) + (if (if (eq? '|#%variable-reference| hd_0) #t #f) + (returns_0 1) + (if (if (eq? 'let-values hd_0) (let ((a_0 (cdr (unwrap e_0)))) (let ((p_0 (unwrap a_0))) (if (pair? p_0) @@ -5503,74 +5135,135 @@ (lambda () (let ((d_0 (cdr (unwrap e_0)))) (let ((p_0 (unwrap d_0))) - (let ((rhss_0 - (let ((a_0 (car p_0))) - (let ((rhss_0 + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idss_0 + rhss_0 + lst_0) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (rhss_0 - lst_0) - (begin - (if (not - (begin-unsafe - (null? + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? (unwrap - lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 - v_0)) - (let ((rhss_1 - (let ((rhss_1 - (let ((rhss14_0 - (let ((d_1 - (cdr - (unwrap - v_1)))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (cons - rhss14_0 - rhss_0)))) + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_1 v_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_1))) + (let ((idss_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((idss_2 + idss_1)) (values - rhss_1)))) - (for-loop_0 - rhss_1 - rest_0))))) - rhss_0)))))) - (for-loop_0 - null - a_0))))) - (reverse$1 rhss_0))))) - (let ((body_0 - (let ((d_1 (cdr p_0))) - (let ((a_0 - (car (unwrap d_1)))) - a_0)))) - (let ((rhss_1 rhss_0)) - (values rhss_1 body_0))))))) + idss_2 + rhss_1)))))) + (case-lambda + ((idss12_0 + rhss13_0) + (values + (cons + idss12_0 + idss_0) + (cons + rhss13_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((idss_1 + rhss_1) + (values + idss_1 + rhss_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((idss_1 + rhss_1) + (for-loop_0 + idss_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values + idss_0 + rhss_0))))))) + (for-loop_0 null null a_0)))) + (case-lambda + ((idss_0 rhss_0) + (let ((app_0 (reverse$1 idss_0))) + (values + app_0 + (reverse$1 rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((idss_0 rhss_0) + (let ((body_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car (unwrap d_1)))) + a_0)))) + (let ((idss_1 idss_0) + (rhss_1 rhss_0)) + (values idss_1 rhss_1 body_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) (case-lambda - ((rhss_0 body_0) + ((idss_0 rhss_0 body_0) (let ((c_0 (hash-ref simples10_0 @@ -5594,52 +5287,60 @@ (|#%name| for-loop (lambda (result_0 - lst_0) + lst_0 + lst_1) (begin - (if (pair? - lst_0) - (let ((rhs_0 + (if (if (pair? + lst_0) + (pair? + lst_1) + #f) + (let ((ids_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) - (let ((result_1 - (let ((result_1 - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - rhs_0 - 1))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - rhs_0))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1)))) + (let ((rhs_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((result_1 + (let ((result_1 + (simple?_0 + rhs_0 + (length + ids_0)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + ids_0))) + (not + result_1))) + (if (not + (let ((x_0 + (list + rhs_0))) + (not + result_1))) + #t + #f) + #f) + (for-loop_0 + result_1 + rest_0 + rest_1) + result_1)))))) result_0)))))) (for-loop_0 #t + idss_0 rhss_0))) (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 body_0 result-arity_0) #f))) @@ -5663,8 +5364,8 @@ r_1)) r_0))))) (args - (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'letrec-values hd_0) + (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'let hd_0) (let ((a_0 (cdr (unwrap e_0)))) (let ((p_0 (unwrap a_0))) (if (pair? p_0) @@ -5708,32 +5409,26 @@ v_1))) (if (pair? p_1) - (if (let ((a_2 - (car - p_1))) - (wrap-list? - a_2)) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) #f)))) (values result_1)))) @@ -5770,141 +5465,74 @@ (lambda () (let ((d_0 (cdr (unwrap e_0)))) (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idss_0 - rhss_0 - lst_0) + (let ((rhss_0 + (let ((a_0 (car p_0))) + (let ((rhss_0 (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (rhss_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 - v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((idss_1 - (let ((a_1 - (car - p_1))) - (unwrap-list - a_1)))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((idss_2 - idss_1)) + lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_1 + v_0)) + (let ((rhss_1 + (let ((rhss_1 + (let ((rhss14_0 + (let ((d_1 + (cdr + (unwrap + v_1)))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (cons + rhss14_0 + rhss_0)))) (values - idss_2 - rhss_1)))))) - (case-lambda - ((idss15_0 - rhss16_0) - (values - (cons - idss15_0 - idss_0) - (cons - rhss16_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 - rhss_1) - (values - idss_1 - rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 - rhss_1) - (for-loop_0 - idss_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - idss_0 - rhss_0))))))) - (for-loop_0 - null - null - a_0)))) - (case-lambda - ((idss_0 rhss_0) - (let ((app_0 - (reverse$1 idss_0))) - (values - app_0 - (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((idss_0 rhss_0) - (let ((body_0 - (let ((d_1 (cdr p_0))) - (let ((a_0 - (car (unwrap d_1)))) - a_0)))) - (let ((idss_1 idss_0) - (rhss_1 rhss_0)) - (values idss_1 rhss_1 body_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) + rhss_1)))) + (for-loop_0 + rhss_1 + rest_0))))) + rhss_0)))))) + (for-loop_0 + null + a_0))))) + (reverse$1 rhss_0))))) + (let ((body_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car (unwrap d_1)))) + a_0)))) + (let ((rhss_1 rhss_0)) + (values rhss_1 body_0))))))) (case-lambda - ((idss_0 rhss_0 body_0) + ((rhss_0 body_0) (let ((c_0 (hash-ref simples10_0 @@ -5930,72 +5558,40 @@ (|#%name| for-loop (lambda (result_0 - lst_0 - lst_1) + lst_0) (begin - (if (if (pair? - lst_0) - (pair? - lst_1) - #f) - (let ((ids_0 + (if (pair? + lst_0) + (let ((rhs_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) - (let ((rhs_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((result_1 - (let ((result_1 - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - rhs_0 - (length - ids_0)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - ids_0))) - (not - result_1))) - (if (not - (let ((x_0 - (list - rhs_0))) - (not - result_1))) - #t - #f) - #f) - (for-loop_0 - result_1 - rest_0 - rest_1) - result_1)))))) + (let ((result_1 + (let ((result_1 + (simple?_0 + rhs_0 + 1))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + rhs_0))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1)))) result_0)))))) (for-loop_0 #t - idss_0 rhss_0))) (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 body_0 result-arity_0) #f))) @@ -6020,9 +5616,9 @@ r_0))))) (args (raise-binding-result-arity-error - 3 + 2 args)))) - (if (if (eq? 'letrec* hd_0) + (if (if (eq? 'letrec-values hd_0) (let ((a_0 (cdr (unwrap e_0)))) (let ((p_0 (unwrap a_0))) (if (pair? p_0) @@ -6066,26 +5662,32 @@ v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) + (if (let ((a_2 + (car + p_1))) + (wrap-list? + a_2)) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f) #f)))) (values result_1)))) @@ -6132,7 +5734,7 @@ ((for-loop_0 (|#%name| for-loop - (lambda (ids_0 + (lambda (idss_0 rhss_0 lst_0) (begin @@ -6168,11 +5770,12 @@ (let ((p_1 (unwrap v_1))) - (let ((ids_1 + (let ((idss_1 (let ((a_1 (car p_1))) - a_1))) + (unwrap-list + a_1)))) (let ((rhss_1 (let ((d_1 (cdr @@ -6182,40 +5785,40 @@ (unwrap d_1)))) a_1)))) - (let ((ids_2 - ids_1)) + (let ((idss_2 + idss_1)) (values - ids_2 + idss_2 rhss_1)))))) (case-lambda - ((ids17_0 - rhss18_0) + ((idss15_0 + rhss16_0) (values (cons - ids17_0 - ids_0) + idss15_0 + idss_0) (cons - rhss18_0 + rhss16_0 rhss_0))) (args (raise-binding-result-arity-error 2 args))))) (case-lambda - ((ids_1 + ((idss_1 rhss_1) (values - ids_1 + idss_1 rhss_1)) (args (raise-binding-result-arity-error 2 args))))) (case-lambda - ((ids_1 + ((idss_1 rhss_1) (for-loop_0 - ids_1 + idss_1 rhss_1 rest_0)) (args @@ -6223,16 +5826,16 @@ 2 args))))))) (values - ids_0 + idss_0 rhss_0))))))) (for-loop_0 null null a_0)))) (case-lambda - ((ids_0 rhss_0) + ((idss_0 rhss_0) (let ((app_0 - (reverse$1 ids_0))) + (reverse$1 idss_0))) (values app_0 (reverse$1 rhss_0)))) @@ -6241,17 +5844,17 @@ 2 args)))))) (case-lambda - ((ids_0 rhss_0) + ((idss_0 rhss_0) (let ((body_0 (let ((d_1 (cdr p_0))) (let ((a_0 (car (unwrap d_1)))) a_0)))) - (let ((ids_1 ids_0) + (let ((idss_1 idss_0) (rhss_1 rhss_0)) (values - ids_1 + idss_1 rhss_1 body_0)))) (args @@ -6259,7 +5862,7 @@ 2 args))))))) (case-lambda - ((ids_0 rhss_0 body_0) + ((idss_0 rhss_0 body_0) (let ((c_0 (hash-ref simples10_0 @@ -6285,52 +5888,60 @@ (|#%name| for-loop (lambda (result_0 - lst_0) + lst_0 + lst_1) (begin - (if (pair? - lst_0) - (let ((rhs_0 + (if (if (pair? + lst_0) + (pair? + lst_1) + #f) + (let ((ids_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) - (let ((result_1 - (let ((result_1 - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - rhs_0 - 1))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - rhs_0))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1)))) + (let ((rhs_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((result_1 + (let ((result_1 + (simple?_0 + rhs_0 + (length + ids_0)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + ids_0))) + (not + result_1))) + (if (not + (let ((x_0 + (list + rhs_0))) + (not + result_1))) + #t + #f) + #f) + (for-loop_0 + result_1 + rest_0 + rest_1) + result_1)))))) result_0)))))) (for-loop_0 #t + idss_0 rhss_0))) (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 body_0 result-arity_0) #f))) @@ -6357,546 +5968,810 @@ (raise-binding-result-arity-error 3 args)))) - (if (if (if (eq? 'begin hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (wrap-list? a_0)) - #f) - (not pure?1_0) + (if (if (eq? 'letrec* hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_1 + v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + (let ((a_1 (cdr p_0))) + (let ((p_1 (unwrap a_1))) + (if (pair? p_1) + (let ((a_2 (cdr p_1))) + (begin-unsafe + (let ((app_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_2))))) + #f))) + #f) + #f))) #f) - (let ((es_0 - (let ((d_0 (cdr (unwrap e_0)))) - (unwrap-list d_0)))) - (simple-begin?_0 - e_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - result-arity_0 - simples10_0 - es_0)) - (if (if (eq? 'begin-unsafe hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (wrap-list? a_0)) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ids_0 + rhss_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_1 + v_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_1))) + (let ((ids_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) + (case-lambda + ((ids17_0 + rhss18_0) + (values + (cons + ids17_0 + ids_0) + (cons + rhss18_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 + rhss_1) + (values + ids_1 + rhss_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 + rhss_1) + (for-loop_0 + ids_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values + ids_0 + rhss_0))))))) + (for-loop_0 + null + null + a_0)))) + (case-lambda + ((ids_0 rhss_0) + (let ((app_0 + (reverse$1 ids_0))) + (values + app_0 + (reverse$1 rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((ids_0 rhss_0) + (let ((body_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car + (unwrap d_1)))) + a_0)))) + (let ((ids_1 ids_0) + (rhss_1 rhss_0)) + (values + ids_1 + rhss_1 + body_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((ids_0 rhss_0 body_0) + (let ((c_0 + (hash-ref + simples10_0 + e_0 + '#(unknown unknown 1)))) + (let ((r_0 + (vector-ref + c_0 + (if pure?1_0 0 1)))) + (let ((arity-match?_0 + (eqv? + result-arity_0 + (vector-ref c_0 2)))) + (if (let ((or-part_0 + (eq? 'unknown r_0))) + (if or-part_0 + or-part_0 + (not arity-match?_0))) + (let ((r_1 + (if (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((rhs_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((result_1 + (let ((result_1 + (simple?_0 + rhs_0 + 1))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + rhs_0))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1)))) + result_0)))))) + (for-loop_0 + #t + rhss_0))) + (simple?_0 + body_0 + result-arity_0) + #f))) + (begin + (hash-set! + simples10_0 + e_0 + (if pure?1_0 + (vector + r_1 + (if arity-match?_0 + (vector-ref c_0 1) + 'unknown) + result-arity_0) + (vector + (if arity-match?_0 + (vector-ref c_0 0) + 'unknown) + r_1 + result-arity_0))) + r_1)) + r_0))))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (if (eq? 'begin hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (wrap-list? a_0)) + #f) + (not pure?1_0) #f) (let ((es_0 (let ((d_0 (cdr (unwrap e_0)))) (unwrap-list d_0)))) - (simple-begin?_0 - e_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - result-arity_0 - simples10_0 - es_0)) - (if (if (eq? 'begin0 hd_0) + (simple-begin?_0 es_0)) + (if (if (eq? 'begin-unsafe hd_0) (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (wrap-list? a_1)) - #f))) + (wrap-list? a_0)) #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((e0_0 - (let ((a_0 (car p_0))) - a_0))) - (let ((es_0 - (let ((d_1 (cdr p_0))) - (unwrap-list d_1)))) - (let ((e0_1 e0_0)) - (values e0_1 es_0))))))) - (case-lambda - ((e0_0 es_0) - (let ((c_0 - (hash-ref - simples10_0 - e_0 - '#(unknown unknown 1)))) - (let ((r_0 - (vector-ref - c_0 - (if pure?1_0 0 1)))) - (let ((arity-match?_0 - (eqv? - result-arity_0 - (vector-ref c_0 2)))) - (if (let ((or-part_0 - (eq? - 'unknown - r_0))) - (if or-part_0 - or-part_0 - (not - arity-match?_0))) - (let ((r_1 - (if (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - e0_0 - result-arity_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((e_1 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((result_1 - (let ((result_1 - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - e_1 - #f))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - e_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1)))) - result_0)))))) - (for-loop_0 - #t - es_0))) - #f))) - (begin - (hash-set! - simples10_0 - e_0 - (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref - c_0 - 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref - c_0 - 0) - 'unknown) - r_1 - result-arity_0))) - r_1)) - r_0))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (if (eq? 'set! hd_0) - (let ((a_0 - (cdr (unwrap e_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (not pure?1_0) + (let ((es_0 + (let ((d_0 (cdr (unwrap e_0)))) + (unwrap-list d_0)))) + (simple-begin?_0 es_0)) + (if (if (eq? 'begin0 hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (wrap-list? a_1)) + #f))) #f) - (let ((e_1 - (let ((d_0 - (cdr (unwrap e_0)))) - (let ((d_1 - (cdr (unwrap d_0)))) - (let ((a_0 - (car - (unwrap d_1)))) - a_0))))) - (begin - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - e_1 - 1) - (returns_0 result-arity_0 1))) - (if (if (eq? 'values hd_0) - (let ((a_0 - (cdr (unwrap e_0)))) - (wrap-list? a_0)) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((e0_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((es_0 + (let ((d_1 + (cdr p_0))) + (unwrap-list + d_1)))) + (let ((e0_1 e0_0)) + (values + e0_1 + es_0))))))) + (case-lambda + ((e0_0 es_0) + (let ((c_0 + (hash-ref + simples10_0 + e_0 + '#(unknown unknown 1)))) + (let ((r_0 + (vector-ref + c_0 + (if pure?1_0 0 1)))) + (let ((arity-match?_0 + (eqv? + result-arity_0 + (vector-ref c_0 2)))) + (if (let ((or-part_0 + (eq? + 'unknown + r_0))) + (if or-part_0 + or-part_0 + (not + arity-match?_0))) + (let ((r_1 + (if (simple?_0 + e0_0 + result-arity_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((e_1 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((result_1 + (let ((result_1 + (simple?_0 + e_1 + #f))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + e_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1)))) + result_0)))))) + (for-loop_0 + #t + es_0))) + #f))) + (begin + (hash-set! + simples10_0 + e_0 + (if pure?1_0 + (vector + r_1 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown) + result-arity_0) + (vector + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown) + r_1 + result-arity_0))) + r_1)) + r_0))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (if (eq? 'set! hd_0) + (let ((a_0 + (cdr + (unwrap e_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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (not pure?1_0) #f) - (let ((es_0 + (let ((e_1 (let ((d_0 (cdr (unwrap e_0)))) - (unwrap-list d_0)))) - (let ((c_0 - (hash-ref - simples10_0 - e_0 - '#(unknown unknown 1)))) - (let ((r_0 - (vector-ref - c_0 - (if pure?1_0 0 1)))) - (let ((arity-match?_0 - (eqv? - result-arity_0 - (vector-ref - c_0 - 2)))) - (if (let ((or-part_0 - (eq? - 'unknown - r_0))) - (if or-part_0 - or-part_0 - (not - arity-match?_0))) - (let ((r_1 - (if (returns_0 - result-arity_0 - (length - es_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((e_1 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr + (let ((d_1 + (cdr + (unwrap d_0)))) + (let ((a_0 + (car + (unwrap d_1)))) + a_0))))) + (begin + (simple?_0 e_1 1) + (returns_0 1))) + (if (if (eq? 'values hd_0) + (let ((a_0 + (cdr (unwrap e_0)))) + (wrap-list? a_0)) + #f) + (let ((es_0 + (let ((d_0 + (cdr + (unwrap e_0)))) + (unwrap-list d_0)))) + (let ((c_0 + (hash-ref + simples10_0 + e_0 + '#(unknown + unknown + 1)))) + (let ((r_0 + (vector-ref + c_0 + (if pure?1_0 0 1)))) + (let ((arity-match?_0 + (eqv? + result-arity_0 + (vector-ref + c_0 + 2)))) + (if (let ((or-part_0 + (eq? + 'unknown + r_0))) + (if or-part_0 + or-part_0 + (not + arity-match?_0))) + (let ((r_1 + (if (returns_0 + (length + es_0)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((e_1 + (unsafe-car lst_0))) - (let ((result_1 - (let ((result_1 - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - e_1 - 1))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - e_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1)))) - result_0)))))) - (for-loop_0 - #t - es_0))) - #f))) - (begin - (hash-set! + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((result_1 + (let ((result_1 + (simple?_0 + e_1 + 1))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + e_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1)))) + result_0)))))) + (for-loop_0 + #t + es_0))) + #f))) + (begin + (hash-set! + simples10_0 + e_0 + (if pure?1_0 + (vector + r_1 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown) + result-arity_0) + (vector + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown) + r_1 + result-arity_0))) + r_1)) + r_0))))) + (if (let ((p_0 (unwrap e_0))) + (if (pair? p_0) #t #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap e_0))) + (let ((proc_0 + (let ((a_0 + (car p_0))) + a_0))) + (let ((args_0 + (let ((d_0 + (cdr + p_0))) + d_0))) + (let ((proc_1 + proc_0)) + (values + proc_1 + args_0)))))) + (case-lambda + ((proc_0 args_0) + (let ((c_0 + (hash-ref simples10_0 e_0 - (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref - c_0 - 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref - c_0 - 0) - 'unknown) - r_1 - result-arity_0))) - r_1)) - r_0))))) - (if (let ((p_0 (unwrap e_0))) - (if (pair? p_0) #t #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap e_0))) - (let ((proc_0 - (let ((a_0 - (car p_0))) - a_0))) - (let ((args_0 - (let ((d_0 - (cdr p_0))) - d_0))) - (let ((proc_1 proc_0)) - (values - proc_1 - args_0)))))) - (case-lambda - ((proc_0 args_0) - (let ((c_0 - (hash-ref - simples10_0 - e_0 - '#(unknown - unknown - 1)))) - (let ((r_0 - (vector-ref - c_0 - (if pure?1_0 - 0 - 1)))) - (let ((arity-match?_0 - (eqv? - result-arity_0 - (vector-ref - c_0 - 2)))) - (if (let ((or-part_0 - (eq? - 'unknown - r_0))) - (if or-part_0 - or-part_0 - (not - arity-match?_0))) - (let ((r_1 - (let ((proc_1 - (unwrap - proc_0))) - (if (symbol? - proc_1) - (if (let ((v_0 - (let ((or-part_0 - (hash-ref-either - knowns7_0 - imports8_0 - proc_1))) - (if or-part_0 - or-part_0 - (hash-ref - prim-knowns6_0 - proc_1 - #f))))) - (if (if pure?1_0 - (if (known-procedure/pure? - v_0) - (returns_0 - result-arity_0 - 1) - #f) - (if (let ((or-part_0 - (known-procedure/no-prompt? - v_0))) - (if or-part_0 - or-part_0 - (known-procedure/no-prompt/multi? - v_0))) - (eqv? - result-arity_0 - #f) - #f)) - (let ((app_0 - (known-procedure-arity-mask - v_0))) - (bitwise-bit-set? - app_0 - (length - args_0))) - #f)) - (if (simple-mutated-state? - (hash-ref - mutated9_0 - proc_1 - #f)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((arg_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr + '#(unknown + unknown + 1)))) + (let ((r_0 + (vector-ref + c_0 + (if pure?1_0 + 0 + 1)))) + (let ((arity-match?_0 + (eqv? + result-arity_0 + (vector-ref + c_0 + 2)))) + (if (let ((or-part_0 + (eq? + 'unknown + r_0))) + (if or-part_0 + or-part_0 + (not + arity-match?_0))) + (let ((r_1 + (let ((proc_1 + (unwrap + proc_0))) + (if (symbol? + proc_1) + (if (let ((v_0 + (let ((or-part_0 + (hash-ref-either + knowns7_0 + imports8_0 + proc_1))) + (if or-part_0 + or-part_0 + (hash-ref + prim-knowns6_0 + proc_1 + #f))))) + (if (if pure?1_0 + (if (known-procedure/pure? + v_0) + (returns_0 + 1) + #f) + (if (let ((or-part_0 + (known-procedure/no-prompt? + v_0))) + (if or-part_0 + or-part_0 + (known-procedure/no-prompt/multi? + v_0))) + (eqv? + result-arity_0 + #f) + #f)) + (let ((app_0 + (known-procedure-arity-mask + v_0))) + (bitwise-bit-set? + app_0 + (length + args_0))) + #f)) + (if (simple-mutated-state? + (hash-ref + mutated9_0 + proc_1 + #f)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((arg_0 + (unsafe-car lst_0))) - (let ((result_1 - (let ((result_1 - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - arg_0 - 1))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - arg_0))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1)))) - result_0)))))) - (for-loop_0 - #t - args_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((result_1 + (let ((result_1 + (simple?_0 + arg_0 + 1))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + arg_0))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1)))) + result_0)))))) + (for-loop_0 + #t + args_0))) + #f) #f) - #f) - #f)))) - (begin - (hash-set! - simples10_0 - e_0 - (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref - c_0 - 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref - c_0 - 0) - 'unknown) - r_1 - result-arity_0))) - r_1)) - r_0))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (let ((e_1 (unwrap e_0))) - (if (returns_0 - result-arity_0 - 1) - (let ((or-part_0 - (if (symbol? e_1) - (simple-mutated-state? - (hash-ref - mutated9_0 - e_1 - #f)) - #f))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (integer? e_1))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (boolean? - e_1))) - (if or-part_2 - or-part_2 - (let ((or-part_3 - (string? - e_1))) - (if or-part_3 - or-part_3 - (let ((or-part_4 - (bytes? - e_1))) - (if or-part_4 - or-part_4 - (regexp? - e_1))))))))))) - #f)))))))))))))))))))))) - (|#%name| - simple? - (lambda (pure?1_0 - result-arity2_0 - e5_0 - prim-knowns6_0 - knowns7_0 - imports8_0 - mutated9_0 - simples10_0) - (begin - (simple?_0 - imports8_0 - knowns7_0 - mutated9_0 - prim-knowns6_0 - pure?1_0 - simples10_0 - e5_0 - result-arity2_0)))))) + #f)))) + (begin + (hash-set! + simples10_0 + e_0 + (if pure?1_0 + (vector + r_1 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown) + result-arity_0) + (vector + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown) + r_1 + result-arity_0))) + r_1)) + r_0))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (let ((e_1 (unwrap e_0))) + (if (returns_0 1) + (let ((or-part_0 + (if (symbol? e_1) + (simple-mutated-state? + (hash-ref + mutated9_0 + e_1 + #f)) + #f))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (integer? + e_1))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (boolean? + e_1))) + (if or-part_2 + or-part_2 + (let ((or-part_3 + (string? + e_1))) + (if or-part_3 + or-part_3 + (let ((or-part_4 + (bytes? + e_1))) + (if or-part_4 + or-part_4 + (regexp? + e_1))))))))))) + #f)))))))))))))))))))))))) + (simple?_0 e5_0 result-arity2_0)))))) (define simple/can-copy? (lambda (e_0 prim-knowns_0 knowns_0 imports_0 mutated_0) (let ((hd_0 @@ -7165,424 +7040,154 @@ 'rest)))))) (define struct-type-info-rest-properties-list-pos 0) (define make-struct-type-info - (letrec ((handle-proc-spec_0 - (|#%name| - handle-proc-spec - (lambda (imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - proc-spec_0 - imms_0) - (begin - (if (not proc-spec_0) - imms_0 - (if (exact-nonnegative-integer? proc-spec_0) - (cons proc-spec_0 imms_0) - (let ((proc-spec_1 (unwrap proc-spec_0))) - (if (symbol? proc-spec_1) - (let ((k_0 - (begin-unsafe - (call-with-values - (lambda () - (find-known+import - proc-spec_1 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0)) - (case-lambda - ((k_0 im_0) k_0) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (if (not k_0) - #f - (if (known-literal? k_0) - (let ((v_0 (known-literal-value k_0))) - (if (let ((or-part_0 (not v_0))) - (if or-part_0 - or-part_0 - (exact-nonnegative-integer? v_0))) - (handle-proc-spec_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - v_0 - imms_0) - #f)) - (if (known-procedure? k_0) imms_0 #f)))) - #f)))))))) - (includes-property?_0 - (|#%name| - includes-property? - (lambda (rest_0 name_0) - (begin - (if (pair? rest_0) - (let ((v_0 (car rest_0))) - (let ((hd_0 - (let ((p_0 (unwrap v_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'list hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_1 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_2))) - (if (pair? - p_0) - (if (let ((a_1 - (car - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - 'cons))) - (eq? - app_0 - (unwrap - a_1))))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_2))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_1) - result_1))))) - result_0)))))) - (for-loop_0 #t a_0))) - #f)) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (props_0 vals_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_1 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((d_1 - (cdr - (unwrap - v_2)))) - (let ((p_0 - (unwrap - d_1))) - (let ((props_1 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((vals_1 - (let ((d_2 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((props_2 - props_1)) - (values - props_2 - vals_1))))))) - (case-lambda - ((props3_0 vals4_0) - (values - (cons - props3_0 - props_0) - (cons - vals4_0 - vals_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((props_1 vals_1) - (values - props_1 - vals_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((props_1 vals_1) - (for-loop_0 - props_1 - vals_1 - rest_1)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values props_0 vals_0))))))) - (for-loop_0 null null d_0)))) - (case-lambda - ((props_0 vals_0) - (let ((app_0 (reverse$1 props_0))) - (values app_0 (reverse$1 vals_0)))) - (args - (raise-binding-result-arity-error 2 args)))))) - (case-lambda - ((props_0 vals_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (pair? lst_0) - (let ((prop_0 (unsafe-car lst_0))) - (let ((rest_1 (unsafe-cdr lst_0))) - (let ((result_1 - (let ((result_1 - (eq? - (unwrap prop_0) - name_0))) - (values result_1)))) - (if (if (not - (let ((x_0 - (list prop_0))) - result_1)) - #t - #f) - (for-loop_0 result_1 rest_1) - result_1)))) - result_0)))))) - (for-loop_0 #f props_0)))) - (args (raise-binding-result-arity-error 2 args)))) - #f))) - #f)))))) - (lambda (v_0 prim-knowns_0 knowns_0 imports_0 mutated_0) - (let ((hd_0 - (let ((p_0 (unwrap v_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'make-struct-type hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (let ((p_1 (unwrap a_1))) - (if (pair? p_1) - (if (let ((a_2 (car p_1))) - (begin-unsafe - (let ((app_0 (unwrap 'quote))) - (eq? app_0 (unwrap a_2))))) - (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_0 (unwrap '()))) - (eq? app_0 (unwrap a_3))))) - #f))) - #f) - #f))) - (let ((a_1 (cdr p_0))) + (lambda (v_0 prim-knowns_0 knowns_0 imports_0 mutated_0) + (let ((hd_0 + (let ((p_0 (unwrap v_0))) (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'make-struct-type hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car 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))) - (let ((p_3 (unwrap a_3))) - (if (pair? p_3) - (if (let ((a_4 (car p_3))) - (wrap-equal? 0 a_4)) - (let ((a_4 (cdr p_3))) - (let ((p_4 (unwrap a_4))) - (if (pair? p_4) - (if (let ((a_5 (car p_4))) + (if (let ((a_2 (car p_1))) + (begin-unsafe + (let ((app_0 (unwrap 'quote))) + (eq? app_0 (unwrap a_2))))) + (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_0 (unwrap '()))) + (eq? app_0 (unwrap a_3))))) + #f))) + #f) + #f))) + (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))) + (let ((p_3 (unwrap a_3))) + (if (pair? p_3) + (if (let ((a_4 (car p_3))) + (wrap-equal? 0 a_4)) + (let ((a_4 (cdr p_3))) + (let ((p_4 (unwrap a_4))) + (if (pair? p_4) + (if (let ((a_5 (car p_4))) + (begin-unsafe + (let ((app_0 (unwrap #f))) + (eq? + app_0 + (unwrap a_5))))) + #t + #f) + #f))) + #f) + #f))) + #f))) + #f))) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap d_0))) + (let ((name_0 + (let ((a_0 (car p_0))) + (let ((d_1 (cdr (unwrap a_0)))) + (let ((a_1 (car (unwrap d_1)))) a_1))))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((parent_0 (let ((a_0 (car p_1))) a_0))) + (call-with-values + (lambda () + (let ((d_2 (cdr p_1))) + (let ((p_2 (unwrap d_2))) + (let ((fields_0 (let ((a_0 (car p_2))) a_0))) + (let ((rest_0 + (let ((d_3 (cdr p_2))) + (let ((d_4 (cdr (unwrap d_3)))) + (let ((d_5 (cdr (unwrap d_4)))) + d_5))))) + (let ((fields_1 fields_0)) + (values fields_1 rest_0))))))) + (case-lambda + ((fields_0 rest_0) + (let ((parent_1 parent_0)) + (values parent_1 fields_0 rest_0))) + (args + (raise-binding-result-arity-error 2 args)))))))) + (case-lambda + ((parent_0 fields_0 rest_0) + (let ((name_1 name_0)) + (values name_1 parent_0 fields_0 rest_0))) + (args (raise-binding-result-arity-error 3 args)))))))) + (case-lambda + ((name_0 parent_0 fields_0 rest_0) + (let ((u-name_0 (unwrap name_0))) + (let ((u-parent_0 + (let ((u-parent_0 (unwrap parent_0))) + (let ((or-part_0 + (extract-struct-typed-from-checked u-parent_0))) + (if or-part_0 or-part_0 u-parent_0))))) + (let ((u-name_1 u-name_0)) + (if (symbol? u-name_1) + (if (let ((or-part_0 (not u-parent_0))) + (if or-part_0 + or-part_0 + (known-struct-type? + (begin-unsafe + (call-with-values + (lambda () + (find-known+import + u-parent_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0)) + (case-lambda + ((k_0 im_0) k_0) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (if (exact-nonnegative-integer? fields_0) + (let ((prefab-imms_0 + (if (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap rest_0)))) + 'non-prefab + (if (let ((p_0 (unwrap rest_0))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_0))))) + #f)) + 'non-prefab + (if (let ((p_0 (unwrap rest_0))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 (car p_1))) (begin-unsafe (let ((app_0 (unwrap #f))) (eq? app_0 - (unwrap a_5))))) + (unwrap a_1))))) #t #f) #f))) - #f) - #f))) - #f))) - #f))) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((name_0 - (let ((a_0 (car p_0))) - (let ((d_1 (cdr (unwrap a_0)))) - (let ((a_1 (car (unwrap d_1)))) a_1))))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((parent_0 (let ((a_0 (car p_1))) a_0))) - (call-with-values - (lambda () - (let ((d_2 (cdr p_1))) - (let ((p_2 (unwrap d_2))) - (let ((fields_0 - (let ((a_0 (car p_2))) a_0))) - (let ((rest_0 - (let ((d_3 (cdr p_2))) - (let ((d_4 (cdr (unwrap d_3)))) - (let ((d_5 (cdr (unwrap d_4)))) - d_5))))) - (let ((fields_1 fields_0)) - (values fields_1 rest_0))))))) - (case-lambda - ((fields_0 rest_0) - (let ((parent_1 parent_0)) - (values parent_1 fields_0 rest_0))) - (args - (raise-binding-result-arity-error 2 args)))))))) - (case-lambda - ((parent_0 fields_0 rest_0) - (let ((name_1 name_0)) - (values name_1 parent_0 fields_0 rest_0))) - (args (raise-binding-result-arity-error 3 args)))))))) - (case-lambda - ((name_0 parent_0 fields_0 rest_0) - (let ((u-name_0 (unwrap name_0))) - (let ((u-parent_0 - (let ((u-parent_0 (unwrap parent_0))) - (let ((or-part_0 - (extract-struct-typed-from-checked u-parent_0))) - (if or-part_0 or-part_0 u-parent_0))))) - (let ((u-name_1 u-name_0)) - (if (symbol? u-name_1) - (if (let ((or-part_0 (not u-parent_0))) - (if or-part_0 - or-part_0 - (known-struct-type? - (begin-unsafe - (call-with-values - (lambda () - (find-known+import - u-parent_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0)) - (case-lambda - ((k_0 im_0) k_0) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (if (exact-nonnegative-integer? fields_0) - (let ((prefab-imms_0 - (if (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap rest_0)))) - 'non-prefab - (if (let ((p_0 (unwrap rest_0))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_0))))) #f)) 'non-prefab (if (let ((p_0 (unwrap rest_0))) @@ -7591,12 +7196,33 @@ (let ((p_1 (unwrap a_0))) (if (pair? p_1) (if (let ((a_1 (car p_1))) - (begin-unsafe - (let ((app_0 - (unwrap #f))) - (eq? - app_0 - (unwrap a_1))))) + (let ((p_2 + (unwrap a_1))) + (if (pair? p_2) + (if (let ((a_2 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + 'current-inspector))) + (eq? + app_0 + (unwrap + a_2))))) + (let ((a_2 + (cdr + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f) + #f))) #t #f) #f))) @@ -7617,7 +7243,7 @@ (begin-unsafe (let ((app_0 (unwrap - 'current-inspector))) + 'quote))) (eq? app_0 (unwrap @@ -7625,21 +7251,114 @@ (let ((a_2 (cdr p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (if (let ((a_3 + (car + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + 'prefab))) + (eq? + app_0 + (unwrap + a_3))))) + (let ((a_3 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f) + #f))) #f) #f))) - #t + (let ((a_1 (cdr p_1))) + (let ((p_2 + (unwrap a_1))) + (if (pair? p_2) + (let ((a_2 + (cdr p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? p_3) + (if (let ((a_3 + (car + p_3))) + (let ((p_4 + (unwrap + a_3))) + (if (pair? + p_4) + (if (let ((a_4 + (car + p_4))) + (begin-unsafe + (let ((app_0 + (unwrap + 'quote))) + (eq? + app_0 + (unwrap + a_4))))) + (let ((a_4 + (cdr + p_4))) + (let ((p_5 + (unwrap + a_4))) + (if (pair? + p_5) + (let ((a_5 + (cdr + p_5))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_5))))) + #f))) + #f) + #f))) + #t + #f) + #f))) + #f))) #f) #f))) #f)) - 'non-prefab + (let ((immutables_0 + (let ((d_0 + (cdr (unwrap rest_0)))) + (let ((d_1 + (cdr (unwrap d_0)))) + (let ((d_2 + (cdr (unwrap d_1)))) + (let ((a_0 + (car + (unwrap d_2)))) + (let ((d_3 + (cdr + (unwrap a_0)))) + (let ((a_1 + (car + (unwrap + d_3)))) + a_1)))))))) + immutables_0) (if (let ((p_0 (unwrap rest_0))) (if (pair? p_0) (let ((a_0 (cdr p_0))) @@ -7703,80 +7422,19 @@ (let ((a_2 (cdr p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (if (let ((a_3 - (car - p_3))) - (let ((p_4 - (unwrap - a_3))) - (if (pair? - p_4) - (if (let ((a_4 - (car - p_4))) - (begin-unsafe - (let ((app_0 - (unwrap - 'quote))) - (eq? - app_0 - (unwrap - a_4))))) - (let ((a_4 - (cdr - p_4))) - (let ((p_5 - (unwrap - a_4))) - (if (pair? - p_5) - (let ((a_5 - (cdr - p_5))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f))) - #f) - #f))) - #t - #f) - #f))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) #f))) #f) #f))) #f)) - (let ((immutables_0 - (let ((d_0 - (cdr (unwrap rest_0)))) - (let ((d_1 - (cdr (unwrap d_0)))) - (let ((d_2 - (cdr - (unwrap d_1)))) - (let ((a_0 - (car - (unwrap d_2)))) - (let ((d_3 - (cdr - (unwrap - a_0)))) - (let ((a_1 - (car - (unwrap - d_3)))) - a_1)))))))) - immutables_0) + '() (if (let ((p_0 (unwrap rest_0))) (if (pair? p_0) (let ((a_0 (cdr p_0))) @@ -7835,422 +7493,673 @@ #f))) (let ((a_1 (cdr p_1))) - (let ((p_2 - (unwrap - a_1))) - (if (pair? p_2) - (let ((a_2 - (cdr - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) #f) #f))) #f)) '() - (if (let ((p_0 (unwrap rest_0))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 - (car - p_1))) - (let ((p_2 - (unwrap - a_1))) - (if (pair? - p_2) - (if (let ((a_2 - (car - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - 'quote))) - (eq? - app_0 - (unwrap - a_2))))) - (let ((a_2 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (if (let ((a_3 - (car - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - 'prefab))) - (eq? - app_0 - (unwrap - a_3))))) - (let ((a_3 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f) - #f))) - #f) - #f))) - (let ((a_1 - (cdr p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f) - #f))) - #f)) - '() - #f))))))))) - (let ((parent-sti_0 - (if u-parent_0 - (begin-unsafe - (call-with-values - (lambda () - (find-known+import - u-parent_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0)) - (case-lambda - ((k_0 im_0) k_0) - (args - (raise-binding-result-arity-error - 2 - args))))) - #f))) - (let ((prefab-imms_1 prefab-imms_0)) - (let ((constructor-name-expr_0 - (if (> (length rest_0) 5) - (list-ref rest_0 5) - #f))) - (let ((non-prefab-imms_0 - (if (eq? prefab-imms_1 'non-prefab) - (if (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap rest_0)))) - '() - (if (let ((p_0 (unwrap rest_0))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_0))))) - #f)) - '() - (if (let ((p_0 (unwrap rest_0))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 - (unwrap a_0))) - (if (pair? p_1) - (let ((a_1 - (cdr p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f)) - '() - (if (let ((p_0 - (unwrap rest_0))) + #f))))))))) + (let ((parent-sti_0 + (if u-parent_0 + (begin-unsafe + (call-with-values + (lambda () + (find-known+import + u-parent_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0)) + (case-lambda + ((k_0 im_0) k_0) + (args + (raise-binding-result-arity-error + 2 + args))))) + #f))) + (let ((prefab-imms_1 prefab-imms_0)) + (let ((includes-property?_0 + (|#%name| + includes-property? + (lambda (name_1) + (begin + (if (pair? rest_0) + (let ((v_1 (car rest_0))) + (let ((hd_1 + (let ((p_0 (unwrap v_1))) (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 - (unwrap a_0))) - (if (pair? p_1) - (let ((a_1 - (cdr - p_1))) - (let ((p_2 - (unwrap - a_1))) - (if (pair? - p_2) - (let ((a_2 - (cdr - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 + (unwrap (car p_0)) + #f)))) + (if (if (eq? 'list hd_1) + (let ((a_0 + (cdr + (unwrap v_1)))) + (if (wrap-list? a_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap - a_2))))) - #f))) - #f))) - #f)) - (let ((proc-spec_0 - (let ((d_0 - (cdr - (unwrap - rest_0)))) - (let ((d_1 - (cdr - (unwrap - d_0)))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0))))) - (handle-proc-spec_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - proc-spec_0 - '())) - (if (let ((p_0 - (unwrap rest_0))) - (if (pair? p_0) - (let ((a_0 - (cdr p_0))) - (let ((p_1 - (unwrap - a_0))) - (if (pair? p_1) - (let ((a_1 - (cdr - p_1))) - (let ((p_2 - (unwrap - a_1))) - (if (pair? - p_2) - (let ((a_2 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (if (let ((a_3 - (car - p_3))) - (let ((p_4 - (unwrap - a_3))) - (if (pair? - p_4) - (if (let ((a_4 - (car - p_4))) - (begin-unsafe - (let ((app_0 - (unwrap - 'quote))) - (eq? - app_0 - (unwrap - a_4))))) - (let ((a_4 - (cdr - p_4))) - (let ((p_5 - (unwrap - a_4))) - (if (pair? - p_5) - (let ((a_5 - (cdr - p_5))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f))) - #f) - #f))) - #t - #f) - #f))) - #f))) - #f))) - #f)) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - rest_0)))) - (let ((d_1 - (cdr - (unwrap - d_0)))) - (let ((p_0 - (unwrap - d_1))) - (let ((proc-spec_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((immutables_0 - (let ((d_2 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_2)))) - (let ((d_3 - (cdr + lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? (unwrap - a_0)))) - (let ((a_1 - (car + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_1 + (if (begin-unsafe + (pair? (unwrap - d_3)))) - a_1)))))) - (let ((proc-spec_1 - proc-spec_0)) - (values - proc-spec_1 - immutables_0)))))))) - (case-lambda - ((proc-spec_0 - immutables_0) - (handle-proc-spec_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - proc-spec_0 - immutables_0)) - (args - (raise-binding-result-arity-error - 2 - args)))) - #f))))) - #f))) - (if (if (eq? prefab-imms_1 'non-prefab) - non-prefab-imms_0 - prefab-imms_1) - (let ((app_0 - (+ + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_3 + v_2)) + (let ((result_1 + (let ((result_1 + (let ((p_0 + (unwrap + v_3))) + (if (pair? + p_0) + (if (let ((a_1 + (car + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + 'cons))) + (eq? + app_0 + (unwrap + a_1))))) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f))) + #f) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_3))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_1) + result_1))))) + result_0)))))) + (for-loop_0 + #t + a_0))) + #f)) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr (unwrap v_1)))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (props_0 + vals_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_1 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_3 + v_2)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((d_1 + (cdr + (unwrap + v_3)))) + (let ((p_0 + (unwrap + d_1))) + (let ((props_1 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((vals_1 + (let ((d_2 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_2)))) + a_0)))) + (let ((props_2 + props_1)) + (values + props_2 + vals_1))))))) + (case-lambda + ((props3_0 + vals4_0) + (values + (cons + props3_0 + props_0) + (cons + vals4_0 + vals_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((props_1 + vals_1) + (values + props_1 + vals_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((props_1 + vals_1) + (for-loop_0 + props_1 + vals_1 + rest_1)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values + props_0 + vals_0))))))) + (for-loop_0 + null + null + d_0)))) + (case-lambda + ((props_0 vals_0) + (let ((app_0 + (reverse$1 + props_0))) + (values + app_0 + (reverse$1 + vals_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((props_0 vals_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (pair? lst_0) + (let ((prop_0 + (unsafe-car + lst_0))) + (let ((rest_1 + (unsafe-cdr + lst_0))) + (let ((result_1 + (let ((result_1 + (eq? + (unwrap + prop_0) + name_1))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + prop_0))) + result_1)) + #t + #f) + (for-loop_0 + result_1 + rest_1) + result_1)))) + result_0)))))) + (for-loop_0 + #f + props_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + #f))) + #f)))))) + (letrec* + ((handle-proc-spec_0 + (|#%name| + handle-proc-spec + (lambda (proc-spec_0 imms_0) + (begin + (if (not proc-spec_0) + imms_0 + (if (exact-nonnegative-integer? + proc-spec_0) + (cons proc-spec_0 imms_0) + (let ((proc-spec_1 + (unwrap proc-spec_0))) + (if (symbol? proc-spec_1) + (let ((k_0 + (begin-unsafe + (call-with-values + (lambda () + (find-known+import + proc-spec_1 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0)) + (case-lambda + ((k_0 im_0) k_0) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (if (not k_0) + #f + (if (known-literal? k_0) + (let ((v_1 + (known-literal-value + k_0))) + (if (let ((or-part_0 + (not v_1))) + (if or-part_0 + or-part_0 + (exact-nonnegative-integer? + v_1))) + (handle-proc-spec_0 + v_1 + imms_0) + #f)) + (if (known-procedure? k_0) + imms_0 + #f)))) + #f))))))))) + (let ((constructor-name-expr_0 + (if (> (length rest_0) 5) + (list-ref rest_0 5) + #f))) + (let ((non-prefab-imms_0 + (if (eq? prefab-imms_1 'non-prefab) + (if (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap rest_0)))) + '() + (if (let ((p_0 (unwrap rest_0))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (begin-unsafe + (let ((app_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_0))))) + #f)) + '() + (if (let ((p_0 (unwrap rest_0))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 + (unwrap a_0))) + (if (pair? p_1) + (let ((a_1 + (cdr p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f)) + '() + (if (let ((p_0 + (unwrap rest_0))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 + (unwrap + a_0))) + (if (pair? p_1) + (let ((a_1 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_1))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f)) + (let ((proc-spec_0 + (let ((d_0 + (cdr + (unwrap + rest_0)))) + (let ((d_1 + (cdr + (unwrap + d_0)))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0))))) + (handle-proc-spec_0 + proc-spec_0 + '())) + (if (let ((p_0 + (unwrap rest_0))) + (if (pair? p_0) + (let ((a_0 + (cdr p_0))) + (let ((p_1 + (unwrap + a_0))) + (if (pair? p_1) + (let ((a_1 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_1))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (if (let ((a_3 + (car + p_3))) + (let ((p_4 + (unwrap + a_3))) + (if (pair? + p_4) + (if (let ((a_4 + (car + p_4))) + (begin-unsafe + (let ((app_0 + (unwrap + 'quote))) + (eq? + app_0 + (unwrap + a_4))))) + (let ((a_4 + (cdr + p_4))) + (let ((p_5 + (unwrap + a_4))) + (if (pair? + p_5) + (let ((a_5 + (cdr + p_5))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_5))))) + #f))) + #f) + #f))) + #t + #f) + #f))) + #f))) + #f))) + #f)) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + rest_0)))) + (let ((d_1 + (cdr + (unwrap + d_0)))) + (let ((p_0 + (unwrap + d_1))) + (let ((proc-spec_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((immutables_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 ((proc-spec_1 + proc-spec_0)) + (values + proc-spec_1 + immutables_0)))))))) + (case-lambda + ((proc-spec_0 + immutables_0) + (handle-proc-spec_0 + proc-spec_0 + immutables_0)) + (args + (raise-binding-result-arity-error + 2 + args)))) + #f))))) + #f))) + (if (if (eq? prefab-imms_1 'non-prefab) + non-prefab-imms_0 + prefab-imms_1) + (let ((app_0 + (+ + fields_0 + (if u-parent_0 + (known-struct-type-field-count + parent-sti_0) + 0)))) + (let ((app_1 + (if (let ((or-part_0 + (not u-parent_0))) + (if or-part_0 + or-part_0 + (known-struct-type-pure-constructor? + parent-sti_0))) + (if (let ((or-part_0 + (< + (length rest_0) + 5))) + (if or-part_0 + or-part_0 + (not + (unwrap + (list-ref + rest_0 + 4))))) + (not + (includes-property?_0 + 'prop:chaperone-unsafe-undefined)) + #f) + #f))) + (let ((app_2 + (includes-property?_0 + 'prop:authentic))) + (struct-type-info1.1 + name_0 + parent_0 fields_0 - (if u-parent_0 - (known-struct-type-field-count - parent-sti_0) - 0)))) - (let ((app_1 - (if (let ((or-part_0 - (not u-parent_0))) - (if or-part_0 - or-part_0 - (known-struct-type-pure-constructor? - parent-sti_0))) - (if (let ((or-part_0 - (< - (length rest_0) - 5))) - (if or-part_0 - or-part_0 - (not - (unwrap - (list-ref - rest_0 - 4))))) - (not - (includes-property?_0 - rest_0 - 'prop:chaperone-unsafe-undefined)) - #f) - #f))) - (let ((app_2 - (includes-property?_0 - rest_0 - 'prop:authentic))) - (struct-type-info1.1 - name_0 - parent_0 - fields_0 - app_0 - app_1 - app_2 - (if (eq? prefab-imms_1 'non-prefab) - #f - prefab-imms_1) - non-prefab-imms_0 - constructor-name-expr_0 - rest_0)))) - #f)))))) - #f) + app_0 + app_1 + app_2 + (if (eq? + prefab-imms_1 + 'non-prefab) + #f + prefab-imms_1) + non-prefab-imms_0 + constructor-name-expr_0 + rest_0)))) + #f)))))))) #f) - #f))))) - (args (raise-binding-result-arity-error 4 args)))) - (if (if (eq? 'let-values hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_1))))) - (let ((a_1 (cdr p_0))) - (let ((p_1 (unwrap a_1))) - (if (pair? p_1) - (let ((a_2 (cdr p_1))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_2))))) - #f))) - #f) - #f))) - #f) - (let ((body_0 - (let ((d_0 (cdr (unwrap v_0)))) - (let ((d_1 (cdr (unwrap d_0)))) - (let ((a_0 (car (unwrap d_1)))) a_0))))) - (make-struct-type-info - body_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0)) - #f)))))) + #f) + #f))))) + (args (raise-binding-result-arity-error 4 args)))) + (if (if (eq? 'let-values hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) + (let ((a_1 (cdr p_0))) + (let ((p_1 (unwrap a_1))) + (if (pair? p_1) + (let ((a_2 (cdr p_1))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_2))))) + #f))) + #f) + #f))) + #f) + (let ((body_0 + (let ((d_0 (cdr (unwrap v_0)))) + (let ((d_1 (cdr (unwrap d_0)))) + (let ((a_0 (car (unwrap d_1)))) a_0))))) + (make-struct-type-info + body_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0)) + #f))))) (define pure-properties-list (lambda (e_0 prim-knowns_0 knowns_0 imports_0 mutated_0 simples_0) (let ((hd_0 @@ -8702,307 +8611,277 @@ (list 'quote (void)) (if (eof-object? x_0) 'eof (list 'quote x_0)))))) (define register-literal-serialization - (letrec ((check-register_0 - (|#%name| - check-register - (lambda (datum-intern?_0 serializable?-box_0 q_0 seen_0) - (begin - (if (symbol? q_0) - (if (let ((or-part_0 (symbol-interned? q_0))) - (if or-part_0 or-part_0 (symbol-unreadable? q_0))) - (void) - (register!_0 serializable?-box_0 q_0)) - (if (let ((or-part_0 (null? q_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (number? q_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 (char? q_0))) - (if or-part_2 - or-part_2 - (let ((or-part_3 (boolean? q_0))) - (if or-part_3 - or-part_3 - (let ((or-part_4 (eof-object? q_0))) - (if or-part_4 - or-part_4 - (let ((or-part_5 (void? q_0))) - (if or-part_5 - or-part_5 - (eq? - q_0 - unsafe-undefined))))))))))))) - (void) - (if (let ((or-part_0 (string? q_0))) - (if or-part_0 or-part_0 (bytes? q_0))) - (if datum-intern?_0 - (register!_0 serializable?-box_0 q_0) - (void)) - (if (pair? q_0) - (if (hash-ref seen_0 q_0 #f) - (raise-arguments-error - 'compile - "cannot compile cyclic value" - "value" - q_0) - (let ((seen_1 (hash-set seen_0 q_0 #t))) - (begin - (check-register_0 - datum-intern?_0 - serializable?-box_0 - (car q_0) - seen_1) - (check-register_0 - datum-intern?_0 - serializable?-box_0 - (cdr q_0) - seen_1)))) - (if (vector? q_0) - (if (hash-ref seen_0 q_0 #f) - (raise-arguments-error - 'compile - "cannot compile cyclic value" - "value" - q_0) - (let ((seen_1 (hash-set seen_0 q_0 #t))) - (begin - (call-with-values - (lambda () - (begin - (check-vector q_0) - (values q_0 (unsafe-vector-length q_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (unsafe-fx< pos_0 len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (check-register_0 - datum-intern?_0 - serializable?-box_0 - e_0 - seen_1) - (for-loop_0 - (unsafe-fx+ 1 pos_0)))) - (values))))))) - (for-loop_0 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (void)))) - (if (hash? q_0) - (begin - (register!_0 serializable?-box_0 q_0) - (if (hash-ref seen_0 q_0 #f) - (raise-arguments-error - 'compile - "cannot compile cyclic value" - "value" - q_0) - (let ((seen_1 (hash-set seen_0 q_0 #t))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - q_0 - i_0)) - (case-lambda - ((k_0 v_0) - (begin - (begin - (check-register_0 - datum-intern?_0 - serializable?-box_0 - k_0 - seen_1) - (check-register_0 - datum-intern?_0 - serializable?-box_0 - v_0 - seen_1)) - (for-loop_0 - (hash-iterate-next - q_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values))))))) - (for-loop_0 (hash-iterate-first q_0)))) - (void))))) - (if (box? q_0) - (if (hash-ref seen_0 q_0 #f) - (raise-arguments-error - 'compile - "cannot compile cyclic value" - "value" - q_0) - (let ((seen_1 (hash-set seen_0 q_0 #t))) - (check-register_0 - datum-intern?_0 - serializable?-box_0 - (unbox q_0) - seen_1))) - (if (srcloc? q_0) - (begin - (register!_0 serializable?-box_0 q_0) - (srcloc-source q_0)) - (if (prefab-struct-key q_0) - (begin - (register!_0 serializable?-box_0 q_0) - (if (hash-ref seen_0 q_0 #f) - (raise-arguments-error - 'compile - "cannot compile cyclic value" - "value" - q_0) - (let ((seen_1 (hash-set seen_0 q_0 #t))) - (check-register_0 - datum-intern?_0 - serializable?-box_0 - (struct->vector q_0) - seen_1)))) - (register!_0 - serializable?-box_0 - q_0)))))))))))))) - (register!_0 - (|#%name| - register! - (lambda (serializable?-box_0 q_0) - (begin - (begin - (if (unbox serializable?-box_0) - (void) - (set-box! serializable?-box_0 (make-hasheq))) - (hash-set! (unbox serializable?-box_0) q_0 #t))))))) - (lambda (q_0 serializable?-box_0 datum-intern?_0) - (check-register_0 datum-intern?_0 serializable?-box_0 q_0 hash2610)))) -(define try-fold-primitive - (letrec ((procz1 (lambda args_0 (error "missing")))) - (lambda (orig-prim-sym_0 orig-k_0 exps_0 prim-knowns_0 primitives_0) - (let ((prim-sym_0 - (if (known-procedure/pure/folding-unsafe? orig-k_0) - (known-procedure/pure/folding-unsafe-safe orig-k_0) - orig-prim-sym_0))) - (let ((k_0 - (if (known-procedure/pure/folding-unsafe? orig-k_0) - (hash-ref prim-knowns_0 prim-sym_0 #f) - orig-k_0))) - (let ((vals_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((exp_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (unwrap-literal exp_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null exps_0)))))) - (let ((check-result_0 (limit-check k_0 vals_0))) - (if check-result_0 - (call-with-escape-continuation - (lambda (esc_0) - (call-with-exception-handler - (lambda (exn_0) - (if (exn:fail? exn_0) (|#%app| esc_0 #f) exn_0)) - (lambda () - (let ((result_0 - (apply - (hash-ref primitives_0 prim-sym_0 procz1) - vals_0))) + (lambda (q_0 serializable?-box_0 datum-intern?_0) + (letrec* + ((check-register_0 + (|#%name| + check-register + (lambda (q_1 seen_0) + (begin + (let ((register!_0 + (|#%name| + register! + (lambda (q_2) + (begin (begin - (|#%app| check-result_0 result_0) - (list (wrap-literal result_0)))))))) - #f)))))))) -(define limit-check - (letrec ((procz1 - (lambda (v_0) - (if (fixnum-for-every-system? v_0) - (void) - (error "result is not a fixnum for every system"))))) - (lambda (k_0 vals_0) - (let ((kind_0 - (if (known-procedure/folding/limited? k_0) - (known-procedure/folding/limited-kind k_0) - (if (known-procedure/has-unsafe/folding/limited? k_0) - (known-procedure/has-unsafe/folding/limited-kind k_0) - #f)))) - (if (eq? kind_0 #f) - void - (if (eq? kind_0 'expt) - (if (not - (if (= 2 (length vals_0)) - (if (exact-integer? (car vals_0)) - (if (exact-integer? (cadr vals_0)) - (> - (let ((app_0 (integer-length (car vals_0)))) - (* app_0 (cadr vals_0))) - 1000) - #f) - #f) - #f)) - void - #f) - (if (eq? kind_0 'fixnum) - (if (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) + (if (unbox serializable?-box_0) + (void) + (set-box! serializable?-box_0 (make-hasheq))) + (hash-set! (unbox serializable?-box_0) q_2 #t))))))) + (if (symbol? q_1) + (if (let ((or-part_0 (symbol-interned? q_1))) + (if or-part_0 or-part_0 (symbol-unreadable? q_1))) + (void) + (register!_0 q_1)) + (if (let ((or-part_0 (null? q_1))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (number? q_1))) + (if or-part_1 + or-part_1 + (let ((or-part_2 (char? q_1))) + (if or-part_2 + or-part_2 + (let ((or-part_3 (boolean? q_1))) + (if or-part_3 + or-part_3 + (let ((or-part_4 (eof-object? q_1))) + (if or-part_4 + or-part_4 + (let ((or-part_5 (void? q_1))) + (if or-part_5 + or-part_5 + (eq? + q_1 + unsafe-undefined))))))))))))) + (void) + (if (let ((or-part_0 (string? q_1))) + (if or-part_0 or-part_0 (bytes? q_1))) + (if datum-intern?_0 (register!_0 q_1) (void)) + (if (pair? q_1) + (if (hash-ref seen_0 q_1 #f) + (raise-arguments-error + 'compile + "cannot compile cyclic value" + "value" + q_1) + (let ((seen_1 (hash-set seen_0 q_1 #t))) (begin - (if (pair? lst_0) - (let ((v_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((result_1 - (let ((result_1 - (fixnum-for-every-system? - v_0))) - (values result_1)))) - (if (if (not - (let ((x_0 (list v_0))) - (not result_1))) - #t - #f) - (for-loop_0 result_1 rest_0) - result_1)))) - result_0)))))) - (for-loop_0 #t vals_0))) - procz1 - #f) - (error 'schemify:limited-ok? "unknown limit kind: ~a" k_0)))))))) + (check-register_0 (car q_1) seen_1) + (check-register_0 (cdr q_1) seen_1)))) + (if (vector? q_1) + (if (hash-ref seen_0 q_1 #f) + (raise-arguments-error + 'compile + "cannot compile cyclic value" + "value" + q_1) + (let ((seen_1 (hash-set seen_0 q_1 #t))) + (begin + (call-with-values + (lambda () + (begin + (check-vector q_1) + (values q_1 (unsafe-vector-length q_1)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< pos_0 len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (check-register_0 e_0 seen_1) + (for-loop_0 + (unsafe-fx+ 1 pos_0)))) + (values))))))) + (for-loop_0 0)))) + (args + (raise-binding-result-arity-error 2 args)))) + (void)))) + (if (hash? q_1) + (begin + (register!_0 q_1) + (if (hash-ref seen_0 q_1 #f) + (raise-arguments-error + 'compile + "cannot compile cyclic value" + "value" + q_1) + (let ((seen_1 (hash-set seen_0 q_1 #t))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + q_1 + i_0)) + (case-lambda + ((k_0 v_0) + (begin + (begin + (check-register_0 + k_0 + seen_1) + (check-register_0 + v_0 + seen_1)) + (for-loop_0 + (hash-iterate-next + q_1 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values))))))) + (for-loop_0 (hash-iterate-first q_1)))) + (void))))) + (if (box? q_1) + (if (hash-ref seen_0 q_1 #f) + (raise-arguments-error + 'compile + "cannot compile cyclic value" + "value" + q_1) + (let ((seen_1 (hash-set seen_0 q_1 #t))) + (check-register_0 (unbox q_1) seen_1))) + (if (srcloc? q_1) + (begin (register!_0 q_1) (srcloc-source q_1)) + (if (prefab-struct-key q_1) + (begin + (register!_0 q_1) + (if (hash-ref seen_0 q_1 #f) + (raise-arguments-error + 'compile + "cannot compile cyclic value" + "value" + q_1) + (let ((seen_1 (hash-set seen_0 q_1 #t))) + (check-register_0 + (struct->vector q_1) + seen_1)))) + (register!_0 q_1)))))))))))))))) + (check-register_0 q_0 hash2610)))) +(define try-fold-primitive + (lambda (orig-prim-sym_0 orig-k_0 exps_0 prim-knowns_0 primitives_0) + (let ((prim-sym_0 + (if (known-procedure/pure/folding-unsafe? orig-k_0) + (known-procedure/pure/folding-unsafe-safe orig-k_0) + orig-prim-sym_0))) + (let ((k_0 + (if (known-procedure/pure/folding-unsafe? orig-k_0) + (hash-ref prim-knowns_0 prim-sym_0 #f) + orig-k_0))) + (let ((vals_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((exp_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (unwrap-literal exp_0) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 fold-var_1 rest_0)))) + fold-var_0)))))) + (for-loop_0 null exps_0)))))) + (let ((check-result_0 (limit-check k_0 vals_0))) + (if check-result_0 + (call-with-escape-continuation + (lambda (esc_0) + (call-with-exception-handler + (lambda (exn_0) + (if (exn:fail? exn_0) (|#%app| esc_0 #f) exn_0)) + (lambda () + (let ((result_0 + (apply + (hash-ref + primitives_0 + prim-sym_0 + (lambda args_0 (error "missing"))) + vals_0))) + (begin + (|#%app| check-result_0 result_0) + (list (wrap-literal result_0)))))))) + #f))))))) +(define limit-check + (lambda (k_0 vals_0) + (let ((kind_0 + (if (known-procedure/folding/limited? k_0) + (known-procedure/folding/limited-kind k_0) + (if (known-procedure/has-unsafe/folding/limited? k_0) + (known-procedure/has-unsafe/folding/limited-kind k_0) + #f)))) + (if (eq? kind_0 #f) + void + (if (eq? kind_0 'expt) + (if (not + (if (= 2 (length vals_0)) + (if (exact-integer? (car vals_0)) + (if (exact-integer? (cadr vals_0)) + (> + (let ((app_0 (integer-length (car vals_0)))) + (* app_0 (cadr vals_0))) + 1000) + #f) + #f) + #f)) + void + #f) + (if (eq? kind_0 'fixnum) + (if (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (pair? lst_0) + (let ((v_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((result_1 + (let ((result_1 + (fixnum-for-every-system? v_0))) + (values result_1)))) + (if (if (not + (let ((x_0 (list v_0))) + (not result_1))) + #t + #f) + (for-loop_0 result_1 rest_0) + result_1)))) + result_0)))))) + (for-loop_0 #t vals_0))) + (lambda (v_0) + (if (fixnum-for-every-system? v_0) + (void) + (error "result is not a fixnum for every system"))) + #f) + (error 'schemify:limited-ok? "unknown limit kind: ~a" k_0))))))) (define optimize (lambda (v_0 prim-knowns_0 primitives_0 knowns_0 imports_0 mutated_0) (let ((hd_0 @@ -9272,1161 +9151,901 @@ v_0)) v_0))))))))))) (define optimize* - (letrec ((optimize*-body_0 - (|#%name| - optimize*-body - (lambda (imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - body_0) - (begin - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (not (begin-unsafe (null? (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_1 v_0)) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - v_1) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0))))) - fold-var_0)))))) - (for-loop_0 null body_0)))))))) - (optimize*-let_0 - (|#%name| - optimize*-let - (lambda (imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - v_0) - (begin - (if (let ((p_0 (unwrap v_0))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_2 - (unwrap - v_2))) - (if (pair? - p_2) - (let ((a_2 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (let ((a_3 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_2))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - (let ((a_1 (cdr p_1))) (wrap-list? a_1)) - #f) - #f))) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap v_0))) - (let ((let-id_0 (let ((a_0 (car p_0))) a_0))) - (call-with-values - (lambda () - (let ((d_0 (cdr p_0))) - (let ((p_1 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_1))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idss_0 rhss_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_2 v_1)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_2 - (unwrap - v_2))) - (let ((idss_1 - (let ((a_1 - (car - p_2))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_2))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((idss_2 - idss_1)) - (values - idss_2 - rhss_1)))))) - (case-lambda - ((idss3_0 - rhss4_0) - (values - (cons - idss3_0 - idss_0) - (cons - rhss4_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 - rhss_1) - (values - idss_1 - rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 rhss_1) - (for-loop_0 - idss_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - idss_0 - rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((idss_0 rhss_0) - (let ((app_0 (reverse$1 idss_0))) - (values app_0 (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((idss_0 rhss_0) - (let ((body_0 - (let ((d_1 (cdr p_1))) - (unwrap-list d_1)))) - (let ((idss_1 idss_0) (rhss_1 rhss_0)) - (values idss_1 rhss_1 body_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((idss_0 rhss_0 body_0) - (let ((let-id_1 let-id_0)) - (values let-id_1 idss_0 rhss_0 body_0))) - (args - (raise-binding-result-arity-error 3 args))))))) - (case-lambda - ((let-id_0 idss_0 rhss_0 body_0) - (let ((app_0 - (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 ((ids_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((rhs_0 (unsafe-car lst_1))) - (let ((rest_1 - (unsafe-cdr lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (list - ids_0 - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - rhs_0)) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 null idss_0 rhss_0)))))) - (list* - let-id_0 - app_0 - (optimize*-body_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - body_0)))) - (args (raise-binding-result-arity-error 4 args)))) - (error 'match "failed ~e" v_0)))))) - (optimize*_0 - (|#%name| - optimize* - (lambda (imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - v_0) - (begin - (let ((new-v_0 - (reannotate - v_0 - (let ((hd_0 - (let ((p_0 (unwrap v_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) (wrap-list? a_1)) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((formal_0 - (let ((a_0 (car p_0))) a_0))) - (let ((body_0 - (let ((d_1 (cdr p_0))) - (unwrap-list d_1)))) - (let ((formal_1 formal_0)) - (values formal_1 body_0))))))) - (case-lambda - ((formal_0 body_0) - (list* - 'lambda - formal_0 - (optimize*-body_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - body_0))) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_2))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (wrap-list? - a_1)) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_2))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_0))) - #f)) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (formalss_0 bodys_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () + (lambda (v_0 + prim-knowns_0 + primitives_0 + knowns_0 + imports_0 + mutated_0 + unsafe-mode?_0) + (letrec* + ((optimize*_0 + (|#%name| + optimize* + (lambda (v_1) + (begin + (let ((new-v_0 + (reannotate + v_1 + (let ((hd_0 + (let ((p_0 (unwrap v_1))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) (wrap-list? a_1)) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((formal_0 (let ((a_0 (car p_0))) a_0))) + (let ((body_0 + (let ((d_1 (cdr p_0))) + (unwrap-list d_1)))) + (let ((formal_1 formal_0)) + (values formal_1 body_0))))))) + (case-lambda + ((formal_0 body_0) + (list* 'lambda formal_0 (optimize*-body_0 body_0))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'case-lambda hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (if (wrap-list? a_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (let ((result_1 + (let ((result_1 (let ((p_0 (unwrap - v_2))) - (let ((formalss_1 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((bodys_1 - (let ((d_1 - (cdr - p_0))) - (unwrap-list - d_1)))) - (let ((formalss_2 - formalss_1)) - (values - formalss_2 - bodys_1)))))) - (case-lambda - ((formalss1_0 - bodys2_0) - (values - (cons - formalss1_0 - formalss_0) - (cons - bodys2_0 - bodys_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((formalss_1 - bodys_1) - (values - formalss_1 - bodys_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((formalss_1 - bodys_1) - (for-loop_0 - formalss_1 - bodys_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - formalss_0 - bodys_0))))))) - (for-loop_0 null null d_0)))) - (case-lambda - ((formalss_0 bodys_0) - (let ((app_0 (reverse$1 formalss_0))) - (values app_0 (reverse$1 bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) + v_3))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_3))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_0))) + #f)) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (formalss_0 bodys_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_0 + (unwrap + v_3))) + (let ((formalss_1 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((bodys_1 + (let ((d_1 + (cdr + p_0))) + (unwrap-list + d_1)))) + (let ((formalss_2 + formalss_1)) + (values + formalss_2 + bodys_1)))))) + (case-lambda + ((formalss1_0 + bodys2_0) + (values + (cons + formalss1_0 + formalss_0) + (cons + bodys2_0 + bodys_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((formalss_1 bodys_1) + (values + formalss_1 + bodys_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((formalss_1 bodys_1) + (for-loop_0 + formalss_1 + bodys_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values formalss_0 bodys_0))))))) + (for-loop_0 null null d_0)))) (case-lambda ((formalss_0 bodys_0) - (list* - 'case-lambda - (reverse$1 + (let ((app_0 (reverse$1 formalss_0))) + (values app_0 (reverse$1 bodys_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((formalss_0 bodys_0) + (list* + 'case-lambda + (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 ((formals_0 + (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((body_0 + (unsafe-car lst_1))) + (let ((rest_1 + (unsafe-cdr lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (list* + formals_0 + (optimize*-body_0 + body_0)) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 null formalss_0 bodys_0)))))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'let-values hd_0) #t #f) + (optimize*-let_0 v_1) + (if (if (eq? 'letrec-values hd_0) #t #f) + (optimize*-let_0 v_1) + (if (if (eq? 'if hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (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_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((tst_0 + (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((thn_0 + (let ((a_0 (car p_1))) + a_0))) + (let ((els_0 + (let ((d_2 (cdr p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + a_0)))) + (let ((thn_1 thn_0)) + (values + thn_1 + els_0))))))) + (case-lambda + ((thn_0 els_0) + (let ((tst_1 tst_0)) + (values tst_1 thn_0 els_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((tst_0 thn_0 els_0) + (let ((app_0 (optimize*_0 tst_0))) + (let ((app_1 (optimize*_0 thn_0))) + (list + 'if + app_0 + app_1 + (optimize*_0 els_0))))) + (args + (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'with-continuation-mark hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((key_0 + (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((val_0 + (let ((a_0 (car p_1))) + a_0))) + (let ((body_0 + (let ((d_2 + (cdr p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + a_0)))) + (let ((val_1 val_0)) + (values + val_1 + body_0))))))) + (case-lambda + ((val_0 body_0) + (let ((key_1 key_0)) + (values key_1 val_0 body_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((key_0 val_0 body_0) + (let ((app_0 (optimize*_0 key_0))) + (let ((app_1 (optimize*_0 val_0))) + (list + 'with-continuation-mark + app_0 + app_1 + (optimize*_0 body_0))))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? 'begin hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (wrap-list? a_0)) + #f) + (let ((body_0 + (let ((d_0 (cdr (unwrap v_1)))) + (unwrap-list d_0)))) + (list* 'begin (optimize*-body_0 body_0))) + (if (if (eq? 'begin-unsafe hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (wrap-list? a_0)) + #f) + (let ((body_0 + (let ((d_0 (cdr (unwrap v_1)))) + (unwrap-list d_0)))) + (list* + 'begin-unsafe + (optimize*-body_0 body_0))) + (if (if (eq? 'begin0 hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (wrap-list? a_1)) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((e_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((body_0 + (let ((d_1 (cdr p_0))) + (unwrap-list d_1)))) + (let ((e_1 e_0)) + (values e_1 body_0))))))) + (case-lambda + ((e_0 body_0) + (let ((app_0 (optimize*_0 e_0))) + (list* + 'begin0 + app_0 + (optimize*-body_0 body_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? 'set! hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((id_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_1 id_0)) + (values + id_1 + rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (list + 'set! + id_0 + (optimize*_0 rhs_0))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'variable-reference-from-unsafe? + hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car p_0))) + (let ((p_1 + (unwrap + a_1))) + (if (pair? p_1) + (if (let ((a_2 + (car + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '|#%variable-reference|))) + (eq? + app_0 + (unwrap + a_2))))) + (let ((a_2 + (cdr + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f) + #f))) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap a_1))))) + #f) + #f))) + #f) + unsafe-mode?_0 + (if (if (eq? + '|#%variable-reference| + hd_0) + (let ((a_0 + (cdr (unwrap v_1)))) + (begin-unsafe + (let ((app_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_0))))) + #f) + v_1 + (if (if (eq? + '|#%variable-reference| + hd_0) + (let ((a_0 + (cdr (unwrap v_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 + (cdr p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + (let ((id_0 + (let ((d_0 + (cdr + (unwrap v_1)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + v_1) + (if (if (eq? 'quote hd_0) + (let ((a_0 + (cdr + (unwrap v_1)))) + (let ((p_0 + (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 + (cdr p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + v_1 + (if (let ((p_0 (unwrap v_1))) + (if (pair? p_0) + (let ((a_0 + (cdr p_0))) + (wrap-list? a_0)) + #f)) + (call-with-values + (lambda () + (let ((p_0 + (unwrap v_1))) + (let ((rator_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((exps_0 + (let ((d_0 + (cdr + p_0))) + (unwrap-list + d_0)))) + (let ((rator_1 + rator_0)) + (values + rator_1 + exps_0)))))) + (case-lambda + ((rator_0 exps_0) + (let ((app_0 + (optimize*_0 + rator_0))) + (list* + app_0 + (optimize*-body_0 + exps_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + v_1))))))))))))))))))) + (optimize + new-v_0 + prim-knowns_0 + primitives_0 + knowns_0 + imports_0 + mutated_0)))))) + (optimize*-body_0 + (|#%name| + optimize*-body + (lambda (body_0) + (begin + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (not (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_1 + (if (begin-unsafe (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_2 v_1)) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (optimize*_0 v_2) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 fold-var_1 rest_0))))) + fold-var_0)))))) + (for-loop_0 null body_0)))))))) + (optimize*-let_0 + (|#%name| + optimize*-let + (lambda (v_1) + (begin + (if (let ((p_0 (unwrap v_1))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 (car p_1))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (let ((result_1 + (let ((result_1 + (let ((p_2 + (unwrap + v_3))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (let ((a_3 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_3))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + (let ((a_1 (cdr p_1))) (wrap-list? a_1)) + #f) + #f))) + #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap v_1))) + (let ((let-id_0 (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_0 (cdr p_0))) + (let ((p_1 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_1))) + (call-with-values + (lambda () (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (fold-var_0 lst_0 lst_1) + (lambda (idss_0 rhss_0 lst_0) (begin - (if (if (pair? lst_0) - (pair? lst_1) - #f) - (let ((formals_0 - (unsafe-car lst_0))) + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((body_0 - (unsafe-car lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (list* - formals_0 - (optimize*-body_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - body_0)) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 - null - formalss_0 - bodys_0)))))) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'let-values hd_0) #t #f) - (optimize*-let_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - v_0) - (if (if (eq? 'letrec-values hd_0) #t #f) - (optimize*-let_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - v_0) - (if (if (eq? 'if hd_0) - (let ((a_0 (cdr (unwrap v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((tst_0 - (let ((a_0 (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((thn_0 - (let ((a_0 - (car p_1))) - a_0))) - (let ((els_0 - (let ((d_2 - (cdr - p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((thn_1 thn_0)) - (values - thn_1 - els_0))))))) - (case-lambda - ((thn_0 els_0) - (let ((tst_1 tst_0)) - (values tst_1 thn_0 els_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((tst_0 thn_0 els_0) - (let ((app_0 - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - tst_0))) - (let ((app_1 - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - thn_0))) - (list - 'if - app_0 - app_1 - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - els_0))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? 'with-continuation-mark hd_0) - (let ((a_0 (cdr (unwrap v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((key_0 - (let ((a_0 (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((val_0 - (let ((a_0 - (car - p_1))) - a_0))) - (let ((body_0 - (let ((d_2 - (cdr - p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((val_1 val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 body_0) - (let ((key_1 key_0)) - (values - key_1 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((key_0 val_0 body_0) - (let ((app_0 - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - key_0))) - (let ((app_1 - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - val_0))) - (list - 'with-continuation-mark - app_0 - app_1 - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - body_0))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? 'begin hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (wrap-list? a_0)) - #f) - (let ((body_0 - (let ((d_0 (cdr (unwrap v_0)))) - (unwrap-list d_0)))) - (list* - 'begin - (optimize*-body_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - body_0))) - (if (if (eq? 'begin-unsafe hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (wrap-list? a_0)) - #f) - (let ((body_0 - (let ((d_0 - (cdr (unwrap v_0)))) - (unwrap-list d_0)))) - (list* - 'begin-unsafe - (optimize*-body_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - body_0))) - (if (if (eq? 'begin0 hd_0) - (let ((a_0 - (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (wrap-list? a_1)) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((e_0 - (let ((a_0 - (car p_0))) - a_0))) - (let ((body_0 - (let ((d_1 - (cdr p_0))) - (unwrap-list - d_1)))) - (let ((e_1 e_0)) - (values - e_1 - body_0))))))) - (case-lambda - ((e_0 body_0) - (let ((app_0 - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - e_0))) - (list* - 'begin0 - app_0 - (optimize*-body_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - body_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? 'set! hd_0) - (let ((a_0 - (cdr (unwrap v_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 - (let ((a_0 - (car p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((id_1 id_0)) - (values - id_1 - rhs_0))))))) - (case-lambda - ((id_0 rhs_0) - (list - 'set! - id_0 - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - rhs_0))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'variable-reference-from-unsafe? - hd_0) - (let ((a_0 - (cdr - (unwrap v_0)))) - (let ((p_0 - (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 - (car - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '|#%variable-reference|))) - (eq? - app_0 - (unwrap - a_2))))) - (let ((a_2 - (cdr - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f) - #f))) - (let ((a_1 - (cdr p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f) - #f))) - #f) - unsafe-mode?_0 - (if (if (eq? - '|#%variable-reference| - hd_0) - (let ((a_0 - (cdr - (unwrap v_0)))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_0))))) - #f) - v_0 - (if (if (eq? - '|#%variable-reference| - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? p_0) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - (let ((id_0 - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_0)))) - v_0) - (if (if (eq? 'quote hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? p_0) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - v_0 - (if (let ((p_0 - (unwrap - v_0))) - (if (pair? p_0) - (let ((a_0 - (cdr - p_0))) - (wrap-list? - a_0)) - #f)) + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (call-with-values + (lambda () (call-with-values (lambda () - (let ((p_0 - (unwrap - v_0))) - (let ((rator_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((exps_0 - (let ((d_0 - (cdr - p_0))) - (unwrap-list - d_0)))) - (let ((rator_1 - rator_0)) - (values - rator_1 - exps_0)))))) + (call-with-values + (lambda () + (let ((p_2 + (unwrap + v_3))) + (let ((idss_1 + (let ((a_1 + (car + p_2))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_2))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((idss_2 + idss_1)) + (values + idss_2 + rhss_1)))))) + (case-lambda + ((idss3_0 + rhss4_0) + (values + (cons + idss3_0 + idss_0) + (cons + rhss4_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) (case-lambda - ((rator_0 exps_0) - (let ((app_0 - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - rator_0))) - (list* - app_0 - (optimize*-body_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - exps_0)))) + ((idss_1 rhss_1) + (values + idss_1 + rhss_1)) (args (raise-binding-result-arity-error 2 - args)))) - v_0))))))))))))))))))) - (optimize - new-v_0 - prim-knowns_0 - primitives_0 - knowns_0 - imports_0 - mutated_0))))))) - (lambda (v_0 - prim-knowns_0 - primitives_0 - knowns_0 - imports_0 - mutated_0 - unsafe-mode?_0) - (optimize*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - primitives_0 - unsafe-mode?_0 - v_0)))) + args))))) + (case-lambda + ((idss_1 rhss_1) + (for-loop_0 + idss_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values idss_0 rhss_0))))))) + (for-loop_0 null null a_0)))) + (case-lambda + ((idss_0 rhss_0) + (let ((app_0 (reverse$1 idss_0))) + (values app_0 (reverse$1 rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((idss_0 rhss_0) + (let ((body_0 + (let ((d_1 (cdr p_1))) + (unwrap-list d_1)))) + (let ((idss_1 idss_0) (rhss_1 rhss_0)) + (values idss_1 rhss_1 body_0)))) + (args + (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((idss_0 rhss_0 body_0) + (let ((let-id_1 let-id_0)) + (values let-id_1 idss_0 rhss_0 body_0))) + (args (raise-binding-result-arity-error 3 args))))))) + (case-lambda + ((let-id_0 idss_0 rhss_0 body_0) + (let ((app_0 + (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 ((ids_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((rhs_0 (unsafe-car lst_1))) + (let ((rest_1 (unsafe-cdr lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (list + ids_0 + (optimize*_0 + rhs_0)) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 null idss_0 rhss_0)))))) + (list* let-id_0 app_0 (optimize*-body_0 body_0)))) + (args (raise-binding-result-arity-error 4 args)))) + (error 'match "failed ~e" v_1))))))) + (optimize*_0 v_0)))) (define parameter-result? (lambda (v_0 prim-knowns_0 knowns_0 mutated_0) (if (begin-unsafe (pair? (unwrap v_0))) @@ -10699,28 +10318,29 @@ (+ 1 (args-size (wrap-cdr args_0))) 1))) (define smaller-than? - (letrec ((loop_0 - (|#%name| - loop - (lambda (v_0 size_0) - (begin - (if (zero? size_0) - 0 - (if (begin-unsafe (pair? (unwrap v_0))) - (if (eq? (unwrap (wrap-car v_0)) 'quote) - (let ((v_1 (unwrap (wrap-car (wrap-cdr v_0))))) - (if (if (symbol? v_1) - (let ((or-part_0 (symbol-interned? v_1))) - (if or-part_0 - or-part_0 - (symbol-unreadable? v_1))) - #f) - (sub1 size_0) - 0)) - (let ((app_0 (wrap-cdr v_0))) - (loop_0 app_0 (loop_0 (wrap-car v_0) size_0)))) - (sub1 size_0)))))))) - (lambda (v_0 size_0) (positive? (loop_0 v_0 size_0))))) + (lambda (v_0 size_0) + (positive? + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_1 size_1) + (begin + (if (zero? size_1) + 0 + (if (begin-unsafe (pair? (unwrap v_1))) + (if (eq? (unwrap (wrap-car v_1)) 'quote) + (let ((v_2 (unwrap (wrap-car (wrap-cdr v_1))))) + (if (if (symbol? v_2) + (let ((or-part_0 (symbol-interned? v_2))) + (if or-part_0 or-part_0 (symbol-unreadable? v_2))) + #f) + (sub1 size_1) + 0)) + (let ((app_0 (wrap-cdr v_1))) + (loop_0 app_0 (loop_0 (wrap-car v_1) size_1)))) + (sub1 size_1)))))))) + (loop_0 v_0 size_0))))) (define inline-clone (lambda (k_0 im_0 add-import!_0 mutated_0 imports_0) (let ((env_0 @@ -11012,47 +10632,49 @@ env_0)))))) (for-loop_0 '() needed_0))))) (define clone-args - (letrec ((loop_0 - (|#%name| - loop - (lambda (base-env_0 mutated_0 args_0) - (begin - (if (begin-unsafe (null? (unwrap args_0))) - base-env_0 - (if (begin-unsafe (pair? (unwrap args_0))) - (let ((u_0 (unwrap (wrap-car args_0)))) - (let ((g_0 (deterministic-gensym u_0))) - (let ((m_0 (hash-ref mutated_0 u_0 #f))) - (begin - (if m_0 (hash-set! mutated_0 g_0 m_0) (void)) - (cons - (cons u_0 g_0) - (loop_0 - base-env_0 - mutated_0 - (wrap-cdr args_0))))))) - (let ((u_0 (unwrap args_0))) - (cons - (cons u_0 (deterministic-gensym u_0)) - base-env_0)))))))) - (loop_1 - (|#%name| - loop - (lambda (args_0 env_0) - (begin - (if (begin-unsafe (null? (unwrap args_0))) - '() - (if (begin-unsafe (pair? (unwrap args_0))) - (let ((u_0 (unwrap (wrap-car args_0)))) - (let ((app_0 (cdr (car env_0)))) + (lambda (args_0 base-env_0 mutated_0) + (let ((env_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (args_1) + (begin + (if (begin-unsafe (null? (unwrap args_1))) + base-env_0 + (if (begin-unsafe (pair? (unwrap args_1))) + (let ((u_0 (unwrap (wrap-car args_1)))) + (let ((g_0 (deterministic-gensym u_0))) + (let ((m_0 (hash-ref mutated_0 u_0 #f))) + (begin + (if m_0 (hash-set! mutated_0 g_0 m_0) (void)) + (cons + (cons u_0 g_0) + (loop_0 (wrap-cdr args_1))))))) + (let ((u_0 (unwrap args_1))) (cons - app_0 - (let ((app_1 (wrap-cdr args_0))) - (loop_1 app_1 (cdr env_0)))))) - (cdr (car env_0))))))))) - (lambda (args_0 base-env_0 mutated_0) - (let ((env_0 (loop_0 base-env_0 mutated_0 args_0))) - (values (loop_1 args_0 env_0) env_0))))) + (cons u_0 (deterministic-gensym u_0)) + base-env_0))))))))) + (loop_0 args_0)))) + (values + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (args_1 env_1) + (begin + (if (begin-unsafe (null? (unwrap args_1))) + '() + (if (begin-unsafe (pair? (unwrap args_1))) + (let ((u_0 (unwrap (wrap-car args_1)))) + (let ((app_0 (cdr (car env_1)))) + (cons + app_0 + (let ((app_1 (wrap-cdr args_1))) + (loop_0 app_1 (cdr env_1)))))) + (cdr (car env_1))))))))) + (loop_0 args_0 env_0)) + env_0)))) (define clone-body (lambda (l_0 env_0 mutated_0) (reverse$1 @@ -17775,324 +17397,488 @@ (args (raise-binding-result-arity-error 14 args)))) #f)))) (define struct-convert-local.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (new-seq_0) - (begin - (if (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap new-seq_0)))) - null - (if (let ((p_0 (unwrap new-seq_0))) - (if (pair? p_0) - (if (let ((a_0 (car p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (begin-unsafe - (let ((app_0 (unwrap 'begin))) - (eq? app_0 (unwrap a_1))))) - (let ((a_1 (cdr p_1))) (wrap-list? a_1)) - #f) - #f))) - #t - #f) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap new-seq_0))) - (let ((forms_0 - (let ((a_0 (car p_0))) - (let ((d_0 (cdr (unwrap a_0)))) - (unwrap-list d_0))))) - (let ((rest_0 (let ((d_0 (cdr p_0))) d_0))) - (let ((forms_1 forms_0)) - (values forms_1 rest_0)))))) - (case-lambda - ((forms_0 rest_0) (loop_0 (append forms_0 rest_0))) - (args (raise-binding-result-arity-error 2 args)))) - (if (let ((p_0 (unwrap new-seq_0))) - (if (pair? p_0) - (if (let ((a_0 (car p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (begin-unsafe - (let ((app_0 (unwrap 'define))) - (eq? app_0 (unwrap a_1))))) - (let ((a_1 (cdr p_1))) - (let ((p_2 (unwrap a_1))) - (if (pair? p_2) - (let ((a_2 (cdr p_2))) - (let ((p_3 (unwrap a_2))) - (if (pair? p_3) - (let ((a_3 (cdr p_3))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_3))))) - #f))) + (|#%name| + struct-convert-local + (lambda (letrec?1_0 + target3_0 + unsafe-mode?2_0 + form7_0 + prim-knowns8_0 + knowns9_0 + imports10_0 + mutated11_0 + simples12_0 + schemify13_0) + (begin + (if (let ((p_0 (unwrap form7_0))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 (car p_1))) + (let ((p_2 (unwrap a_1))) + (if (pair? p_2) + (if (let ((a_2 (car p_2))) + (let ((p_3 (unwrap a_2))) + (if (pair? p_3) + (let ((a_3 (cdr p_3))) + (let ((p_4 (unwrap a_3))) + (if (pair? p_4) + (let ((a_4 (cdr p_4))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_4))))) #f))) - #f) - #f))) - #t - #f) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap new-seq_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (let ((d_0 (cdr (unwrap a_0)))) - (let ((p_1 (unwrap d_0))) - (let ((id_0 (let ((a_1 (car p_1))) a_1))) - (let ((rhs_0 - (let ((d_1 (cdr p_1))) - (let ((a_1 (car (unwrap d_1)))) - a_1)))) - (let ((id_1 id_0)) - (values id_1 rhs_0)))))))) - (case-lambda - ((id_0 rhs_0) - (let ((rest_0 (let ((d_0 (cdr p_0))) d_0))) - (let ((id_1 id_0) (rhs_1 rhs_0)) - (values id_1 rhs_1 rest_0)))) - (args - (raise-binding-result-arity-error 2 args)))))) - (case-lambda - ((id_0 rhs_0 rest_0) - (cons (list id_0 rhs_0) (loop_0 rest_0))) - (args (raise-binding-result-arity-error 3 args)))) - (error 'match "failed ~e" new-seq_0)))))))) - (loop_1 - (|#%name| - loop - (lambda (bodys_0 new-knowns_0 schemify13_0 new-seq_0) - (begin - (if (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap new-seq_0)))) - (let ((exprs_0 - (schemify-body$1 schemify13_0 new-knowns_0 bodys_0))) - (if (if (pair? exprs_0) (null? (cdr exprs_0)) #f) - (car exprs_0) - (list* 'begin exprs_0))) - (if (let ((p_0 (unwrap new-seq_0))) - (if (pair? p_0) - (if (let ((a_0 (car p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (begin-unsafe - (let ((app_0 (unwrap 'begin))) - (eq? app_0 (unwrap a_1))))) - (let ((a_1 (cdr p_1))) (wrap-list? a_1)) - #f) - #f))) - #t - #f) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap new-seq_0))) - (let ((forms_0 - (let ((a_0 (car p_0))) - (let ((d_0 (cdr (unwrap a_0)))) - (unwrap-list d_0))))) - (let ((rest_0 (let ((d_0 (cdr p_0))) d_0))) - (let ((forms_1 forms_0)) - (values forms_1 rest_0)))))) - (case-lambda - ((forms_0 rest_0) - (loop_1 - bodys_0 - new-knowns_0 - schemify13_0 - (append forms_0 rest_0))) - (args (raise-binding-result-arity-error 2 args)))) - (if (let ((p_0 (unwrap new-seq_0))) - (if (pair? p_0) - (if (let ((a_0 (car p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (begin-unsafe - (let ((app_0 (unwrap 'define))) - (eq? app_0 (unwrap a_1))))) - (let ((a_1 (cdr p_1))) - (let ((p_2 (unwrap a_1))) - (if (pair? p_2) - (let ((a_2 (cdr p_2))) - (let ((p_3 (unwrap a_2))) - (if (pair? p_3) - (let ((a_3 (cdr p_3))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_3))))) - #f))) - #f))) - #f) - #f))) - #t - #f) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap new-seq_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (let ((d_0 (cdr (unwrap a_0)))) - (let ((p_1 (unwrap d_0))) - (let ((id_0 (let ((a_1 (car p_1))) a_1))) - (let ((rhs_0 - (let ((d_1 (cdr p_1))) - (let ((a_1 (car (unwrap d_1)))) - a_1)))) - (let ((id_1 id_0)) - (values id_1 rhs_0)))))))) - (case-lambda - ((id_0 rhs_0) - (let ((rest_0 (let ((d_0 (cdr p_0))) d_0))) - (let ((id_1 id_0) (rhs_1 rhs_0)) - (values id_1 rhs_1 rest_0)))) - (args - (raise-binding-result-arity-error 2 args)))))) - (case-lambda - ((id_0 rhs_0 rest_0) - (list - 'let - (list (list id_0 rhs_0)) - (loop_1 bodys_0 new-knowns_0 schemify13_0 rest_0))) - (args (raise-binding-result-arity-error 3 args)))) - (error 'match "failed ~e" new-seq_0))))))))) - (|#%name| - struct-convert-local - (lambda (letrec?1_0 - target3_0 - unsafe-mode?2_0 - form7_0 - prim-knowns8_0 - knowns9_0 - imports10_0 - mutated11_0 - simples12_0 - schemify13_0) - (begin - (if (let ((p_0 (unwrap form7_0))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (let ((p_2 (unwrap a_1))) - (if (pair? p_2) - (if (let ((a_2 (car p_2))) - (let ((p_3 (unwrap a_2))) - (if (pair? p_3) - (let ((a_3 (cdr p_3))) - (let ((p_4 (unwrap a_3))) - (if (pair? p_4) - (let ((a_4 (cdr p_4))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? - app_0 - (unwrap a_4))))) - #f))) - #f))) - (let ((a_2 (cdr p_2))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_2))))) - #f) - #f))) - (let ((a_1 (cdr p_1))) (wrap-list? a_1)) - #f) - #f))) - #f)) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap form7_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (let ((a_1 (car (unwrap a_0)))) - (let ((p_1 (unwrap a_1))) - (let ((ids_0 (let ((a_2 (car p_1))) a_2))) - (let ((rhs_0 - (let ((d_1 (cdr p_1))) - (let ((a_2 (car (unwrap d_1)))) a_2)))) - (let ((ids_1 ids_0)) (values ids_1 rhs_0)))))))) - (case-lambda - ((ids_0 rhs_0) - (let ((bodys_0 (let ((d_1 (cdr p_0))) (unwrap-list d_1)))) - (let ((ids_1 ids_0) (rhs_1 rhs_0)) - (values ids_1 rhs_1 bodys_0)))) - (args (raise-binding-result-arity-error 2 args))))))) - (case-lambda - ((ids_0 rhs_0 bodys_0) - (let ((defn_0 (list 'define-values ids_0 rhs_0))) - (let ((new-seq_0 - (struct-convert - defn_0 - prim-knowns8_0 - knowns9_0 - imports10_0 - #f - mutated11_0 - schemify13_0 - target3_0 - #t))) - (if new-seq_0 - (let ((hd_0 - (let ((p_0 (unwrap new-seq_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'begin hd_0) #t #f) - (let ((new-seq_1 - (let ((d_0 (cdr (unwrap new-seq_0)))) d_0))) - (call-with-values - (lambda () - (find-definitions.1 - #f - hash2610 - defn_0 - prim-knowns8_0 - knowns9_0 - imports10_0 - mutated11_0 - simples12_0 - unsafe-mode?2_0 - target3_0)) - (case-lambda - ((new-knowns_0 info_0) - (if letrec?1_0 - (let ((app_0 (loop_0 new-seq_1))) - (list* - 'letrec* - app_0 - (schemify-body$1 - schemify13_0 - new-knowns_0 - bodys_0))) - (loop_1 - bodys_0 - new-knowns_0 - schemify13_0 - new-seq_1))) - (args (raise-binding-result-arity-error 2 args))))) - (error 'match "failed ~e" new-seq_0))) - #f)))) - (args (raise-binding-result-arity-error 3 args)))) - #f)))))) + #f))) + (let ((a_2 (cdr p_2))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_2))))) + #f) + #f))) + (let ((a_1 (cdr p_1))) (wrap-list? a_1)) + #f) + #f))) + #f)) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap form7_0)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (let ((a_1 (car (unwrap a_0)))) + (let ((p_1 (unwrap a_1))) + (let ((ids_0 (let ((a_2 (car p_1))) a_2))) + (let ((rhs_0 + (let ((d_1 (cdr p_1))) + (let ((a_2 (car (unwrap d_1)))) a_2)))) + (let ((ids_1 ids_0)) (values ids_1 rhs_0)))))))) + (case-lambda + ((ids_0 rhs_0) + (let ((bodys_0 (let ((d_1 (cdr p_0))) (unwrap-list d_1)))) + (let ((ids_1 ids_0) (rhs_1 rhs_0)) + (values ids_1 rhs_1 bodys_0)))) + (args (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((ids_0 rhs_0 bodys_0) + (let ((defn_0 (list 'define-values ids_0 rhs_0))) + (let ((new-seq_0 + (struct-convert + defn_0 + prim-knowns8_0 + knowns9_0 + imports10_0 + #f + mutated11_0 + schemify13_0 + target3_0 + #t))) + (if new-seq_0 + (let ((hd_0 + (let ((p_0 (unwrap new-seq_0))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'begin hd_0) #t #f) + (let ((new-seq_1 + (let ((d_0 (cdr (unwrap new-seq_0)))) d_0))) + (call-with-values + (lambda () + (find-definitions.1 + #f + hash2610 + defn_0 + prim-knowns8_0 + knowns9_0 + imports10_0 + mutated11_0 + simples12_0 + unsafe-mode?2_0 + target3_0)) + (case-lambda + ((new-knowns_0 info_0) + (if letrec?1_0 + (let ((app_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (new-seq_2) + (begin + (if (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? + app_0 + (unwrap new-seq_2)))) + null + (if (let ((p_0 + (unwrap new-seq_2))) + (if (pair? p_0) + (if (let ((a_0 + (car p_0))) + (let ((p_1 + (unwrap + a_0))) + (if (pair? p_1) + (if (let ((a_1 + (car + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + 'begin))) + (eq? + app_0 + (unwrap + a_1))))) + (let ((a_1 + (cdr + p_1))) + (wrap-list? + a_1)) + #f) + #f))) + #t + #f) + #f)) + (call-with-values + (lambda () + (let ((p_0 + (unwrap new-seq_2))) + (let ((forms_0 + (let ((a_0 + (car p_0))) + (let ((d_0 + (cdr + (unwrap + a_0)))) + (unwrap-list + d_0))))) + (let ((rest_0 + (let ((d_0 + (cdr + p_0))) + d_0))) + (let ((forms_1 + forms_0)) + (values + forms_1 + rest_0)))))) + (case-lambda + ((forms_0 rest_0) + (loop_0 + (append forms_0 rest_0))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (let ((p_0 + (unwrap new-seq_2))) + (if (pair? p_0) + (if (let ((a_0 + (car p_0))) + (let ((p_1 + (unwrap + a_0))) + (if (pair? p_1) + (if (let ((a_1 + (car + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + 'define))) + (eq? + app_0 + (unwrap + a_1))))) + (let ((a_1 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_1))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (let ((a_3 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f))) + #f) + #f))) + #t + #f) + #f)) + (call-with-values + (lambda () + (let ((p_0 + (unwrap + new-seq_2))) + (call-with-values + (lambda () + (let ((a_0 + (car p_0))) + (let ((d_0 + (cdr + (unwrap + a_0)))) + (let ((p_1 + (unwrap + d_0))) + (let ((id_0 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhs_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((id_1 + id_0)) + (values + id_1 + rhs_1)))))))) + (case-lambda + ((id_0 rhs_1) + (let ((rest_0 + (let ((d_0 + (cdr + p_0))) + d_0))) + (let ((id_1 id_0) + (rhs_2 + rhs_1)) + (values + id_1 + rhs_2 + rest_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((id_0 rhs_1 rest_0) + (cons + (list id_0 rhs_1) + (loop_0 rest_0))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (error + 'match + "failed ~e" + new-seq_2))))))))) + (loop_0 new-seq_1)))) + (list* + 'letrec* + app_0 + (schemify-body$1 + schemify13_0 + new-knowns_0 + bodys_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (new-seq_2) + (begin + (if (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap new-seq_2)))) + (let ((exprs_0 + (schemify-body$1 + schemify13_0 + new-knowns_0 + bodys_0))) + (if (if (pair? exprs_0) + (null? (cdr exprs_0)) + #f) + (car exprs_0) + (list* 'begin exprs_0))) + (if (let ((p_0 (unwrap new-seq_2))) + (if (pair? p_0) + (if (let ((a_0 (car p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 + (car p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + 'begin))) + (eq? + app_0 + (unwrap + a_1))))) + (let ((a_1 + (cdr p_1))) + (wrap-list? a_1)) + #f) + #f))) + #t + #f) + #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap new-seq_2))) + (let ((forms_0 + (let ((a_0 (car p_0))) + (let ((d_0 + (cdr + (unwrap a_0)))) + (unwrap-list d_0))))) + (let ((rest_0 + (let ((d_0 (cdr p_0))) + d_0))) + (let ((forms_1 forms_0)) + (values + forms_1 + rest_0)))))) + (case-lambda + ((forms_0 rest_0) + (loop_0 (append forms_0 rest_0))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (let ((p_0 (unwrap new-seq_2))) + (if (pair? p_0) + (if (let ((a_0 (car p_0))) + (let ((p_1 + (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 + (car + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + 'define))) + (eq? + app_0 + (unwrap + a_1))))) + (let ((a_1 + (cdr p_1))) + (let ((p_2 + (unwrap + a_1))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (let ((a_3 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f))) + #f) + #f))) + #t + #f) + #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap new-seq_2))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (let ((d_0 + (cdr + (unwrap a_0)))) + (let ((p_1 + (unwrap d_0))) + (let ((id_0 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhs_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((id_1 id_0)) + (values + id_1 + rhs_1)))))))) + (case-lambda + ((id_0 rhs_1) + (let ((rest_0 + (let ((d_0 + (cdr p_0))) + d_0))) + (let ((id_1 id_0) + (rhs_2 rhs_1)) + (values + id_1 + rhs_2 + rest_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((id_0 rhs_1 rest_0) + (list + 'let + (list (list id_0 rhs_1)) + (loop_0 rest_0))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (error + 'match + "failed ~e" + new-seq_2))))))))) + (loop_0 new-seq_1)))) + (args (raise-binding-result-arity-error 2 args))))) + (error 'match "failed ~e" new-seq_0))) + #f)))) + (args (raise-binding-result-arity-error 3 args)))) + #f))))) (define schemify-body$1 (|#%name| schemify-body @@ -18296,253 +18082,243 @@ (for-loop_0 null lst_2 lst_1))))))) bodys_0))) (define letrec-conversion - (letrec ((loop_0 - (|#%name| - loop - (lambda (mutated_0 ids_0) - (begin - (if (symbol? ids_0) - (needs-letrec-convert-mutated-state? - (hash-ref mutated_0 ids_0 #f)) - (if (begin-unsafe (syntax? ids_0)) - (loop_0 mutated_0 (unwrap ids_0)) - (if (pair? ids_0) - (let ((or-part_0 (loop_0 mutated_0 (car ids_0)))) - (if or-part_0 - or-part_0 - (loop_0 mutated_0 (cdr ids_0)))) - #f)))))))) - (lambda (ids_0 mutated_0 target_0 e_0) - (let ((need-convert?_0 - (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) - (let ((a_0 (cdr p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_0 + (lambda (ids_0 mutated_0 target_0 e_0) + (let ((need-convert?_0 + (if (not (eq? target_0 'cify)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ids_1) + (begin + (if (symbol? ids_1) + (needs-letrec-convert-mutated-state? + (hash-ref mutated_0 ids_1 #f)) + (if (begin-unsafe (syntax? ids_1)) + (loop_0 (unwrap ids_1)) + (if (pair? ids_1) + (let ((or-part_0 (loop_0 (car ids_1)))) + (if or-part_0 or-part_0 (loop_0 (cdr ids_1)))) + #f)))))))) + (loop_0 ids_0)) + #f))) + (if need-convert?_0 + (if (let ((p_0 (unwrap e_0))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 (car p_1))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_2 - (unwrap - v_1))) - (if (pair? - p_2) - (let ((a_2 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (let ((a_3 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f)) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ids_1 rhss_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_0 + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_2 + (unwrap + v_1))) + (if (pair? p_2) + (let ((a_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (let ((a_3 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values result_1)))) + (if (if (not + (let ((x_0 + (list v_1))) + (not result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f)) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ids_1 rhss_0 lst_0) + (begin + (if (not + (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_1 v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_1 (unwrap v_1))) - (let ((ids_2 - (let ((a_1 - (car + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_1 (unwrap v_1))) + (let ((ids_2 + (let ((a_1 + (car p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_3 - ids_2)) - (values - ids_3 - rhss_1)))))) - (case-lambda - ((ids3_0 rhss4_0) - (values - (cons ids3_0 ids_1) - (cons rhss4_0 rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_2 rhss_1) - (values ids_2 rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_2 rhss_1) - (for-loop_0 - ids_2 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values ids_1 rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((ids_1 rhss_0) - (let ((app_0 (reverse$1 ids_1))) - (values app_0 (reverse$1 rhss_0)))) - (args (raise-binding-result-arity-error 2 args)))))) - (case-lambda - ((ids_1 rhss_0) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_2 ids_1) (rhss_1 rhss_0)) - (values ids_2 rhss_1 body_0)))) - (args (raise-binding-result-arity-error 2 args))))))) - (case-lambda - ((ids_1 rhss_0 body_0) - (let ((app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (cons - (list* id_0 '(unsafe-undefined)) - fold-var_0))) - (let ((fold-var_2 - (values fold-var_1))) - (for-loop_0 fold-var_2 rest_0))))) - fold-var_0)))))) - (for-loop_0 null ids_1)))))) - (list* - 'let - app_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 ((id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((rhs_0 (unsafe-car lst_1))) - (let ((rest_1 (unsafe-cdr lst_1))) - (let ((fold-var_1 - (cons - (list 'set! id_0 rhs_0) - fold-var_0))) - (let ((fold-var_2 - (values fold-var_1))) - (for-loop_0 - fold-var_2 - rest_0 - rest_1))))))) - fold-var_0)))))) - (for-loop_0 null ids_1 rhss_0)))) - body_0)))) - (args (raise-binding-result-arity-error 3 args)))) - (error 'match "failed ~e" e_0)) - e_0))))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_3 ids_2)) + (values + ids_3 + rhss_1)))))) + (case-lambda + ((ids3_0 rhss4_0) + (values + (cons ids3_0 ids_1) + (cons rhss4_0 rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_2 rhss_1) + (values ids_2 rhss_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_2 rhss_1) + (for-loop_0 ids_2 rhss_1 rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values ids_1 rhss_0))))))) + (for-loop_0 null null a_0)))) + (case-lambda + ((ids_1 rhss_0) + (let ((app_0 (reverse$1 ids_1))) + (values app_0 (reverse$1 rhss_0)))) + (args (raise-binding-result-arity-error 2 args)))))) + (case-lambda + ((ids_1 rhss_0) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((ids_2 ids_1) (rhss_1 rhss_0)) + (values ids_2 rhss_1 body_0)))) + (args (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((ids_1 rhss_0 body_0) + (let ((app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (cons + (list* id_0 '(unsafe-undefined)) + fold-var_0))) + (let ((fold-var_2 (values fold-var_1))) + (for-loop_0 fold-var_2 rest_0))))) + fold-var_0)))))) + (for-loop_0 null ids_1)))))) + (list* + 'let + app_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 ((id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((rhs_0 (unsafe-car lst_1))) + (let ((rest_1 (unsafe-cdr lst_1))) + (let ((fold-var_1 + (cons + (list 'set! id_0 rhs_0) + fold-var_0))) + (let ((fold-var_2 (values fold-var_1))) + (for-loop_0 + fold-var_2 + rest_0 + rest_1))))))) + fold-var_0)))))) + (for-loop_0 null ids_1 rhss_0)))) + body_0)))) + (args (raise-binding-result-arity-error 3 args)))) + (error 'match "failed ~e" e_0)) + e_0)))) (define mutated-in-body (lambda (l_0 exports_0 @@ -18979,731 +18755,318 @@ (void) mutated_0)))) (define find-mutated! - (letrec ((add-too-early-name!_0 - (|#%name| - add-too-early-name! - (lambda (id_0 mutated_0 state_0 u-id_0) - (begin - (let ((c2_0 - (if (eq? 'too-early state_0) - (wrap-property id_0 'undefined-error-name) - #f))) - (if c2_0 - (hash-set! mutated_0 u-id_0 (too-early1.1 c2_0 #f)) - (let ((c1_0 - (if (eq? 'set!ed-too-early state_0) - (wrap-property id_0 'undefined-error-name) - #f))) - (if c1_0 - (hash-set! mutated_0 u-id_0 (too-early1.1 c1_0 #t)) - (void))))))))) - (delay!_0 - (|#%name| - delay! - (lambda (mutated_0 ids_0 thunk_0) - (begin - (let ((done?_0 #f)) - (let ((force_0 - (|#%name| - force - (lambda () - (begin - (if done?_0 - (void) - (begin - (set! done?_0 #t) - (|#%app| thunk_0)))))))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (let ((id_1 (unwrap id_0))) - (let ((m_0 - (hash-ref - mutated_0 - id_1 - 'not-ready))) - (if (eq? 'not-ready m_0) - (hash-set! - mutated_0 - id_1 - force_0) - (if (procedure? m_0) - (hash-set! + (lambda (top-v_0 ids_0 prim-knowns_0 knowns_0 imports_0 mutated_0 simples_0) + (let ((delay!_0 + (|#%name| + delay! + (lambda (ids_1 thunk_0) + (begin + (let ((done?_0 #f)) + (let ((force_0 + (|#%name| + force + (lambda () + (begin + (if done?_0 + (void) + (begin + (set! done?_0 #t) + (|#%app| thunk_0)))))))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (let ((id_1 (unwrap id_0))) + (let ((m_0 + (hash-ref mutated_0 id_1 - (lambda () - (begin - (|#%app| m_0) - (force_0)))) - (force_0))))) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 ids_0))) - (void)))))))) - (find-mutated!*_0 - (|#%name| - find-mutated!* - (lambda (imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - l_0 - ids_0) - (begin - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (l_1) - (begin - (if (null? l_1) - (void) - (if (null? (cdr l_1)) - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - (car l_1) - ids_0) - (begin - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - (car l_1) - #f) - (loop_0 (cdr l_1)))))))))) - (loop_0 l_0)))))) - (find-mutated!_0 - (|#%name| - find-mutated! - (lambda (imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - v_0 - ids_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap v_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) (wrap-list? a_1)) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((formals_0 (let ((a_0 (car p_0))) a_0))) - (let ((body_0 - (let ((d_1 (cdr p_0))) - (unwrap-list d_1)))) - (let ((formals_1 formals_0)) - (values formals_1 body_0))))))) - (case-lambda - ((formals_0 body_0) - (if ids_0 - (delay!_0 - mutated_0 - ids_0 - (lambda () - (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - body_0 + 'not-ready))) + (if (eq? 'not-ready m_0) + (hash-set! + mutated_0 + id_1 + force_0) + (if (procedure? m_0) + (hash-set! + mutated_0 + id_1 + (lambda () + (begin + (|#%app| m_0) + (force_0)))) + (force_0))))) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 ids_1))) + (void))))))))) + (letrec* + ((find-mutated!_0 + (|#%name| + find-mutated! + (lambda (v_0 ids_1) + (begin + (let ((find-mutated!*_0 + (|#%name| + find-mutated!* + (lambda (l_0 ids_2) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1) + (begin + (if (null? l_1) + (void) + (if (null? (cdr l_1)) + (find-mutated!_0 (car l_1) ids_2) + (begin + (find-mutated!_0 (car l_1) #f) + (loop_0 (cdr l_1)))))))))) + (loop_0 l_0))))))) + (let ((hd_0 + (let ((p_0 (unwrap v_0))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) (wrap-list? a_1)) #f))) - (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - body_0 - #f))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_2))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (wrap-list? - a_1)) - #f)))) - (values result_1)))) - (if (if (not - (let ((x_0 - (list v_2))) - (not result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_0))) - #f)) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (formalss_0 bodys_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_0 - (unwrap v_2))) - (let ((formalss_1 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((bodys_1 - (let ((d_1 - (cdr - p_0))) - (unwrap-list - d_1)))) - (let ((formalss_2 - formalss_1)) - (values - formalss_2 - bodys_1)))))) - (case-lambda - ((formalss10_0 - bodys11_0) - (values - (cons - formalss10_0 - formalss_0) - (cons - bodys11_0 - bodys_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((formalss_1 bodys_1) - (values - formalss_1 - bodys_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((formalss_1 bodys_1) - (for-loop_0 - formalss_1 - bodys_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values formalss_0 bodys_0))))))) - (for-loop_0 null null d_0)))) - (case-lambda - ((formalss_0 bodys_0) - (let ((app_0 (reverse$1 formalss_0))) - (values app_0 (reverse$1 bodys_0)))) - (args - (raise-binding-result-arity-error 2 args)))))) - (case-lambda - ((formalss_0 bodys_0) - (if ids_0 - (delay!_0 - mutated_0 - ids_0 - (lambda () - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((body_0 (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (begin - (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - body_0 - #f) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 bodys_0))) - (void)))) - (begin + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap d_0))) + (let ((formals_0 (let ((a_0 (car p_0))) a_0))) + (let ((body_0 + (let ((d_1 (cdr p_0))) (unwrap-list d_1)))) + (let ((formals_1 formals_0)) + (values formals_1 body_0))))))) + (case-lambda + ((formals_0 body_0) + (if ids_1 + (delay!_0 + ids_1 + (lambda () (find-mutated!*_0 body_0 #f))) + (find-mutated!*_0 body_0 #f))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'case-lambda hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (if (wrap-list? a_0) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (lst_0) + (lambda (result_0 lst_0) (begin - (if (pair? lst_0) - (let ((body_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - body_0 - #f) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 bodys_0))) - (void)))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'quote hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_1))))) - #f))) - #f) - (void) - (if (if (eq? 'let-values hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_2 v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_2))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_2))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - (let ((a_1 (cdr p_0))) (wrap-list? a_1)) - #f) - #f))) - #f) + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_1 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_2 v_1)) + (let ((result_1 + (let ((result_1 + (let ((p_0 + (unwrap + v_2))) + (if (pair? p_0) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f)))) + (values result_1)))) + (if (if (not + (let ((x_0 + (list v_2))) + (not result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_0))) + #f)) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_0)))) (call-with-values (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idss_0 rhss_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_2 v_1)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_2))) - (let ((idss_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((idss_2 - idss_1)) - (values - idss_2 - rhss_1)))))) - (case-lambda - ((idss12_0 - rhss13_0) - (values - (cons - idss12_0 - idss_0) - (cons - rhss13_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 - rhss_1) - (values - idss_1 - rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 rhss_1) - (for-loop_0 - idss_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (formalss_0 bodys_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_1 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_2 v_1)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_0 + (unwrap v_2))) + (let ((formalss_1 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((bodys_1 + (let ((d_1 + (cdr + p_0))) + (unwrap-list + d_1)))) + (let ((formalss_2 + formalss_1)) + (values + formalss_2 + bodys_1)))))) + (case-lambda + ((formalss10_0 + bodys11_0) + (values + (cons + formalss10_0 + formalss_0) + (cons + bodys11_0 + bodys_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((formalss_1 bodys_1) (values - idss_0 - rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((idss_0 rhss_0) - (let ((app_0 (reverse$1 idss_0))) - (values app_0 (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((idss_0 rhss_0) - (let ((bodys_0 - (let ((d_1 (cdr p_0))) - (unwrap-list d_1)))) - (let ((idss_1 idss_0) (rhss_1 rhss_0)) - (values idss_1 rhss_1 bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) + formalss_1 + bodys_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((formalss_1 bodys_1) + (for-loop_0 + formalss_1 + bodys_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values formalss_0 bodys_0))))))) + (for-loop_0 null null d_0)))) (case-lambda - ((idss_0 rhss_0 bodys_0) + ((formalss_0 bodys_0) + (let ((app_0 (reverse$1 formalss_0))) + (values app_0 (reverse$1 bodys_0)))) + (args + (raise-binding-result-arity-error 2 args)))))) + (case-lambda + ((formalss_0 bodys_0) + (if ids_1 + (delay!_0 + ids_1 + (lambda () (begin (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (lst_0 lst_1) + (lambda (lst_0) (begin - (if (if (pair? lst_0) - (pair? lst_1) - #f) - (let ((ids_1 (unsafe-car lst_0))) + (if (pair? lst_0) + (let ((body_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) - (let ((rhs_0 - (unsafe-car lst_1))) - (let ((rest_1 - (unsafe-cdr lst_1))) - (begin - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - rhs_0 - ids_1) - (for-loop_0 - rest_0 - rest_1)))))) + (begin + (find-mutated!*_0 body_0 #f) + (for-loop_0 rest_0)))) (values))))))) - (for-loop_0 idss_0 rhss_0))) - (void) - (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - bodys_0 - ids_0))) - (args (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'letrec-values hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_2 v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_2))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_2))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - (let ((a_1 (cdr p_0))) - (wrap-list? a_1)) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () + (for-loop_0 bodys_0))) + (void)))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((body_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (find-mutated!*_0 body_0 #f) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 bodys_0))) + (void)))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'quote hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) + #f))) + #f) + (void) + (if (if (eq? 'let-values hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (idss_0 rhss_0 lst_0) + (lambda (result_0 lst_0) (begin (if (not (begin-unsafe @@ -19726,54 +19089,129 @@ lst_0) null))) (let ((v_2 v_1)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_2))) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_2))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + (let ((a_1 (cdr p_0))) (wrap-list? a_1)) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idss_0 rhss_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap lst_0)))) + (let ((v_1 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_2 v_1)) + (call-with-values + (lambda () (call-with-values (lambda () (call-with-values (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_2))) - (let ((idss_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((idss_2 - idss_1)) - (values - idss_2 - rhss_1)))))) - (case-lambda - ((idss14_0 - rhss15_0) - (values - (cons - idss14_0 - idss_0) - (cons - rhss15_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) + (let ((p_1 + (unwrap + v_2))) + (let ((idss_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((idss_2 + idss_1)) + (values + idss_2 + rhss_1)))))) (case-lambda - ((idss_1 - rhss_1) + ((idss12_0 + rhss13_0) (values - idss_1 - rhss_1)) + (cons + idss12_0 + idss_0) + (cons + rhss13_0 + rhss_0))) (args (raise-binding-result-arity-error 2 @@ -19781,793 +19219,937 @@ (case-lambda ((idss_1 rhss_1) - (for-loop_0 + (values idss_1 - rhss_1 - rest_0)) + rhss_1)) (args (raise-binding-result-arity-error 2 - args))))))) - (values - idss_0 - rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((idss_0 rhss_0) - (let ((app_0 (reverse$1 idss_0))) - (values - app_0 - (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((idss_0 rhss_0) - (let ((bodys_0 - (let ((d_1 (cdr p_0))) - (unwrap-list d_1)))) - (let ((idss_1 idss_0) (rhss_1 rhss_0)) - (values idss_1 rhss_1 bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((idss_0 rhss_0 bodys_0) - (if (letrec-splitable-values-binding? - idss_0 - rhss_0) - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - (letrec-split-values-binding - idss_0 - rhss_0 - bodys_0) - ids_0) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((ids_1 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_1)))) - (let ((id_0 - (if (begin-unsafe - (pair? - (unwrap - lst_1))) - (wrap-car - lst_1) - lst_1))) - (let ((rest_1 - (if (begin-unsafe - (pair? - (unwrap - lst_1))) - (wrap-cdr - lst_1) - null))) - (let ((id_1 - id_0)) - (begin - (hash-set! - mutated_0 - (unwrap - id_1) - 'not-ready) - (for-loop_1 - rest_1))))) - (values))))))) - (for-loop_1 ids_1)))) - (case-lambda - (() (for-loop_0 rest_0)) - (args - (raise-binding-result-arity-error - 0 - args)))))) - (values))))))) - (for-loop_0 idss_0))) - (void) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (maybe-cc?_0 lst_0 lst_1) - (begin - (if (if (pair? lst_0) - (pair? lst_1) - #f) - (let ((ids_1 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((rhs_0 - (unsafe-car lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((maybe-cc?_1 - (let ((maybe-cc?_1 - (begin - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - rhs_0 - (unwrap-list - ids_1)) - (let ((new-maybe-cc?_0 - (if maybe-cc?_0 - maybe-cc?_0 - (not - (let ((temp23_0 - (length - ids_1))) - (simple?.1 - #f - temp23_0 - rhs_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0)))))) - (begin - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (lst_2) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_2)))) - (let ((id_0 - (if (begin-unsafe - (pair? - (unwrap - lst_2))) - (wrap-car - lst_2) - lst_2))) - (let ((rest_2 - (if (begin-unsafe - (pair? - (unwrap - lst_2))) - (wrap-cdr - lst_2) - null))) - (let ((id_1 - id_0)) - (begin - (let ((u-id_0 - (unwrap - id_1))) - (let ((state_0 - (hash-ref - mutated_0 - u-id_0))) - (if new-maybe-cc?_0 - (begin - (if (let ((or-part_0 - (eq? - 'not-ready - state_0))) - (if or-part_0 - or-part_0 - (begin-unsafe - (procedure? - state_0)))) - (hash-set! - mutated_0 - u-id_0 - 'implicitly-set!ed) - (add-too-early-name!_0 - id_1 - mutated_0 - state_0 - u-id_0)) - (if (begin-unsafe - (procedure? - state_0)) - (|#%app| - state_0) - (void))) - (if (eq? - 'not-ready - state_0) - (hash-remove! - mutated_0 - u-id_0) - (add-too-early-name!_0 - id_1 - mutated_0 - state_0 - u-id_0))))) - (for-loop_1 - rest_2))))) - (values))))))) - (for-loop_1 - ids_1))) - (void) - new-maybe-cc?_0))))) - (values - maybe-cc?_1)))) - (for-loop_0 - maybe-cc?_1 - rest_0 - rest_1)))))) - maybe-cc?_0)))))) - (for-loop_0 #f idss_0 rhss_0))) - (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - bodys_0 - ids_0)))) - (args - (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'if hd_0) - (let ((a_0 (cdr (unwrap v_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_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((tst_0 - (let ((a_0 (car p_0))) a_0))) + args))))) + (case-lambda + ((idss_1 rhss_1) + (for-loop_0 + idss_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values + idss_0 + rhss_0))))))) + (for-loop_0 null null a_0)))) + (case-lambda + ((idss_0 rhss_0) + (let ((app_0 (reverse$1 idss_0))) + (values app_0 (reverse$1 rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((idss_0 rhss_0) + (let ((bodys_0 + (let ((d_1 (cdr p_0))) + (unwrap-list d_1)))) + (let ((idss_1 idss_0) (rhss_1 rhss_0)) + (values idss_1 rhss_1 bodys_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((idss_0 rhss_0 bodys_0) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0 lst_1) + (begin + (if (if (pair? lst_0) + (pair? lst_1) + #f) + (let ((ids_2 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((rhs_0 + (unsafe-car lst_1))) + (let ((rest_1 + (unsafe-cdr lst_1))) + (begin + (find-mutated!_0 + rhs_0 + ids_2) + (for-loop_0 + rest_0 + rest_1)))))) + (values))))))) + (for-loop_0 idss_0 rhss_0))) + (void) + (find-mutated!*_0 bodys_0 ids_1))) + (args (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'letrec-values hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_1 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_2 v_1)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_2))) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_2))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + (let ((a_1 (cdr p_0))) + (wrap-list? a_1)) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) (call-with-values (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((thn_0 - (let ((a_0 (car p_1))) - a_0))) - (let ((els_0 - (let ((d_2 (cdr p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((thn_1 thn_0)) - (values thn_1 els_0))))))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idss_0 rhss_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap lst_0)))) + (let ((v_1 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_2 v_1)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_2))) + (let ((idss_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((idss_2 + idss_1)) + (values + idss_2 + rhss_1)))))) + (case-lambda + ((idss14_0 + rhss15_0) + (values + (cons + idss14_0 + idss_0) + (cons + rhss15_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((idss_1 + rhss_1) + (values + idss_1 + rhss_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((idss_1 rhss_1) + (for-loop_0 + idss_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values + idss_0 + rhss_0))))))) + (for-loop_0 null null a_0)))) (case-lambda - ((thn_0 els_0) - (let ((tst_1 tst_0)) - (values tst_1 thn_0 els_0))) + ((idss_0 rhss_0) + (let ((app_0 (reverse$1 idss_0))) + (values + app_0 + (reverse$1 rhss_0)))) (args (raise-binding-result-arity-error 2 - args)))))))) - (case-lambda - ((tst_0 thn_0 els_0) - (begin - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - tst_0 - #f) - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - thn_0 - #f) - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - els_0 - #f))) - (args - (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'with-continuation-mark hd_0) - (let ((a_0 (cdr (unwrap v_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_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((key_0 - (let ((a_0 (car p_0))) a_0))) - (call-with-values - (lambda () + args)))))) + (case-lambda + ((idss_0 rhss_0) + (let ((bodys_0 (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((val_0 - (let ((a_0 (car p_1))) - a_0))) - (let ((body_0 - (let ((d_2 - (cdr p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((val_1 val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 body_0) - (let ((key_1 key_0)) - (values key_1 val_0 body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((key_0 val_0 body_0) - (begin - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - key_0 - #f) - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - val_0 - #f) - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - body_0 - ids_0))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? 'begin hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (wrap-list? a_0)) - #f) - (let ((exps_0 - (let ((d_0 (cdr (unwrap v_0)))) - (unwrap-list d_0)))) - (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - exps_0 - ids_0)) - (if (if (eq? 'begin-unsafe hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (wrap-list? a_0)) - #f) - (let ((exps_0 - (let ((d_0 (cdr (unwrap v_0)))) - (unwrap-list d_0)))) - (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - exps_0 - ids_0)) - (if (if (eq? 'begin0 hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (wrap-list? a_1)) - #f))) - #f) + (unwrap-list d_1)))) + (let ((idss_1 idss_0) (rhss_1 rhss_0)) + (values idss_1 rhss_1 bodys_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((idss_0 rhss_0 bodys_0) + (if (letrec-splitable-values-binding? + idss_0 + rhss_0) + (find-mutated!_0 + (letrec-split-values-binding + idss_0 + rhss_0 + bodys_0) + ids_1) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((ids_2 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_1)))) + (let ((id_0 + (if (begin-unsafe + (pair? + (unwrap + lst_1))) + (wrap-car + lst_1) + lst_1))) + (let ((rest_1 + (if (begin-unsafe + (pair? + (unwrap + lst_1))) + (wrap-cdr + lst_1) + null))) + (let ((id_1 + id_0)) + (begin + (hash-set! + mutated_0 + (unwrap + id_1) + 'not-ready) + (for-loop_1 + rest_1))))) + (values))))))) + (for-loop_1 ids_2)))) + (case-lambda + (() (for-loop_0 rest_0)) + (args + (raise-binding-result-arity-error + 0 + args)))))) + (values))))))) + (for-loop_0 idss_0))) + (void) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (maybe-cc?_0 lst_0 lst_1) + (begin + (if (if (pair? lst_0) + (pair? lst_1) + #f) + (let ((ids_2 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) + (let ((rhs_0 + (unsafe-car lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((maybe-cc?_1 + (let ((maybe-cc?_1 + (begin + (find-mutated!_0 + rhs_0 + (unwrap-list + ids_2)) + (let ((new-maybe-cc?_0 + (if maybe-cc?_0 + maybe-cc?_0 + (not + (let ((temp23_0 + (length + ids_2))) + (simple?.1 + #f + temp23_0 + rhs_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0)))))) + (begin + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (lst_2) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_2)))) + (let ((id_0 + (if (begin-unsafe + (pair? + (unwrap + lst_2))) + (wrap-car + lst_2) + lst_2))) + (let ((rest_2 + (if (begin-unsafe + (pair? + (unwrap + lst_2))) + (wrap-cdr + lst_2) + null))) + (let ((id_1 + id_0)) + (begin + (let ((u-id_0 + (unwrap + id_1))) + (let ((state_0 + (hash-ref + mutated_0 + u-id_0))) + (let ((add-too-early-name!_0 + (|#%name| + add-too-early-name! + (lambda () + (begin + (let ((c2_0 + (if (eq? + 'too-early + state_0) + (wrap-property + id_1 + 'undefined-error-name) + #f))) + (if c2_0 + (hash-set! + mutated_0 + u-id_0 + (too-early1.1 + c2_0 + #f)) + (let ((c1_0 + (if (eq? + 'set!ed-too-early + state_0) + (wrap-property + id_1 + 'undefined-error-name) + #f))) + (if c1_0 + (hash-set! + mutated_0 + u-id_0 + (too-early1.1 + c1_0 + #t)) + (void)))))))))) + (if new-maybe-cc?_0 + (begin + (if (let ((or-part_0 + (eq? + 'not-ready + state_0))) + (if or-part_0 + or-part_0 + (begin-unsafe + (procedure? + state_0)))) + (hash-set! + mutated_0 + u-id_0 + 'implicitly-set!ed) + (add-too-early-name!_0)) + (if (begin-unsafe + (procedure? + state_0)) + (|#%app| + state_0) + (void))) + (if (eq? + 'not-ready + state_0) + (hash-remove! + mutated_0 + u-id_0) + (add-too-early-name!_0)))))) + (for-loop_1 + rest_2))))) + (values))))))) + (for-loop_1 + ids_2))) + (void) + new-maybe-cc?_0))))) + (values + maybe-cc?_1)))) + (for-loop_0 + maybe-cc?_1 + rest_0 + rest_1)))))) + maybe-cc?_0)))))) + (for-loop_0 #f idss_0 rhss_0))) + (find-mutated!*_0 bodys_0 ids_1)))) + (args + (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'if hd_0) + (let ((a_0 (cdr (unwrap v_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_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap d_0))) + (let ((tst_0 (let ((a_0 (car p_0))) a_0))) (call-with-values (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((exp_0 - (let ((a_0 (car p_0))) + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((thn_0 + (let ((a_0 (car p_1))) a_0))) - (let ((exps_0 - (let ((d_1 (cdr p_0))) - (unwrap-list d_1)))) - (let ((exp_1 exp_0)) - (values exp_1 exps_0))))))) + (let ((els_0 + (let ((d_2 (cdr p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + a_0)))) + (let ((thn_1 thn_0)) + (values thn_1 els_0))))))) (case-lambda - ((exp_0 exps_0) - (begin - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - exp_0 - ids_0) - (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - exps_0 - #f))) + ((thn_0 els_0) + (let ((tst_1 tst_0)) + (values tst_1 thn_0 els_0))) (args (raise-binding-result-arity-error 2 - args)))) - (if (if (eq? 'set! hd_0) - (let ((a_0 (cdr (unwrap v_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap a_2))))) - #f))) - #f))) - #f) + args)))))))) + (case-lambda + ((tst_0 thn_0 els_0) + (begin + (find-mutated!_0 tst_0 #f) + (find-mutated!_0 thn_0 #f) + (find-mutated!_0 els_0 #f))) + (args + (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'with-continuation-mark hd_0) + (let ((a_0 (cdr (unwrap v_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_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap d_0))) + (let ((key_0 + (let ((a_0 (car p_0))) a_0))) (call-with-values (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 - (let ((a_0 (car p_0))) + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((val_0 + (let ((a_0 (car p_1))) a_0))) - (let ((rhs_0 - (let ((d_1 (cdr p_0))) + (let ((body_0 + (let ((d_2 (cdr p_1))) (let ((a_0 (car (unwrap - d_1)))) + d_2)))) a_0)))) - (let ((id_1 id_0)) - (values id_1 rhs_0))))))) + (let ((val_1 val_0)) + (values + val_1 + body_0))))))) (case-lambda - ((id_0 rhs_0) - (begin - (let ((id_1 (unwrap id_0))) - (let ((old-state_0 - (hash-ref - mutated_0 - id_1 - #f))) - (begin - (hash-set! - mutated_0 - id_1 - (state->set!ed-state - old-state_0)) - (if (begin-unsafe - (procedure? - old-state_0)) - (|#%app| old-state_0) - (void))))) - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - rhs_0 - #f))) + ((val_0 body_0) + (let ((key_1 key_0)) + (values key_1 val_0 body_0))) (args (raise-binding-result-arity-error 2 - args)))) - (if (if (eq? - '|#%variable-reference| - hd_0) - #t - #f) - (void) - (if (let ((p_0 (unwrap v_0))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (wrap-list? a_0)) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap v_0))) - (let ((rator_0 - (let ((a_0 (car p_0))) - a_0))) - (let ((exps_0 - (let ((d_0 - (cdr p_0))) - (unwrap-list - d_0)))) - (let ((rator_1 rator_0)) - (values - rator_1 - exps_0)))))) - (case-lambda - ((rator_0 exps_0) - (if (if ids_0 - (let ((rator_1 - (unwrap rator_0))) - (if (symbol? rator_1) - (if (let ((v_1 - (begin-unsafe - (call-with-values - (lambda () - (find-known+import - rator_1 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0)) - (case-lambda - ((k_0 - im_0) - k_0) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (if (let ((or-part_0 - (known-constructor? - v_1))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (eq? - rator_1 - 'cons))) - (if or-part_1 - or-part_1 - (let ((or-part_2 + args)))))))) + (case-lambda + ((key_0 val_0 body_0) + (begin + (find-mutated!_0 key_0 #f) + (find-mutated!_0 val_0 #f) + (find-mutated!_0 body_0 ids_1))) + (args + (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'begin hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (wrap-list? a_0)) + #f) + (let ((exps_0 + (let ((d_0 (cdr (unwrap v_0)))) + (unwrap-list d_0)))) + (find-mutated!*_0 exps_0 ids_1)) + (if (if (eq? 'begin-unsafe hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (wrap-list? a_0)) + #f) + (let ((exps_0 + (let ((d_0 (cdr (unwrap v_0)))) + (unwrap-list d_0)))) + (find-mutated!*_0 exps_0 ids_1)) + (if (if (eq? 'begin0 hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (wrap-list? a_1)) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap d_0))) + (let ((exp_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((exps_0 + (let ((d_1 (cdr p_0))) + (unwrap-list d_1)))) + (let ((exp_1 exp_0)) + (values exp_1 exps_0))))))) + (case-lambda + ((exp_0 exps_0) + (begin + (find-mutated!_0 exp_0 ids_1) + (find-mutated!*_0 exps_0 #f))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? 'set! hd_0) + (let ((a_0 (cdr (unwrap v_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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap d_0))) + (let ((id_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_1 id_0)) + (values id_1 rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (begin + (let ((id_1 (unwrap id_0))) + (let ((old-state_0 + (hash-ref + mutated_0 + id_1 + #f))) + (begin + (hash-set! + mutated_0 + id_1 + (state->set!ed-state + old-state_0)) + (if (begin-unsafe + (procedure? + old-state_0)) + (|#%app| old-state_0) + (void))))) + (find-mutated!_0 rhs_0 #f))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + '|#%variable-reference| + hd_0) + #t + #f) + (void) + (if (let ((p_0 (unwrap v_0))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (wrap-list? a_0)) + #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap v_0))) + (let ((rator_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((exps_0 + (let ((d_0 + (cdr p_0))) + (unwrap-list + d_0)))) + (let ((rator_1 rator_0)) + (values + rator_1 + exps_0)))))) + (case-lambda + ((rator_0 exps_0) + (if (if ids_1 + (let ((rator_1 + (unwrap rator_0))) + (if (symbol? rator_1) + (if (let ((v_1 + (begin-unsafe + (call-with-values + (lambda () + (find-known+import + rator_1 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0)) + (case-lambda + ((k_0 + im_0) + k_0) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (if (let ((or-part_0 + (known-constructor? + v_1))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (eq? + rator_1 + 'cons))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (eq? + rator_1 + 'list))) + (if or-part_2 + or-part_2 + (let ((or-part_3 + (eq? + rator_1 + 'vector))) + (if or-part_3 + or-part_3 (eq? rator_1 - 'list))) - (if or-part_2 - or-part_2 - (let ((or-part_3 - (eq? - rator_1 - 'vector))) - (if or-part_3 - or-part_3 - (eq? - rator_1 - 'make-struct-type-property))))))))) - (let ((app_0 - (known-procedure-arity-mask - v_1))) - (bitwise-bit-set? - app_0 - (length - exps_0))) - #f)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((exp_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((result_1 - (let ((result_1 - (simple?.1 - #t - 1 - exp_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - exp_0))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1)))) - result_0)))))) - (for-loop_0 - #t - exps_0))) - #f) - #f)) - #f) - (delay!_0 - mutated_0 - ids_0 - (lambda () - (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - exps_0 - #f))) - (begin - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - rator_0 + 'make-struct-type-property))))))))) + (let ((app_0 + (known-procedure-arity-mask + v_1))) + (bitwise-bit-set? + app_0 + (length + exps_0))) + #f)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((exp_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((result_1 + (let ((result_1 + (simple?.1 + #t + 1 + exp_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + exp_0))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1)))) + result_0)))))) + (for-loop_0 + #t + exps_0))) + #f) + #f)) #f) + (delay!_0 + ids_1 + (lambda () (find-mutated!*_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 exps_0 - #f)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (let ((v_1 (unwrap v_0))) - (if (symbol? v_1) - (let ((state_0 - (hash-ref - mutated_0 - v_1 - #f))) - (if (begin-unsafe - (eq? - state_0 - 'not-ready)) - (hash-set! - mutated_0 - v_1 - 'too-early) - (if (begin-unsafe - (procedure? state_0)) - (if ids_0 - (delay!_0 - mutated_0 - ids_0 - (lambda () - (begin - (if (eq? - (hash-ref - mutated_0 - v_1 - #f) - state_0) - (hash-remove! - mutated_0 - v_1) - (void)) - (|#%app| - state_0)))) - (begin - (hash-remove! - mutated_0 - v_1) - (|#%app| state_0))) - (void)))) - (void)))))))))))))))))))))) - (lambda (top-v_0 - ids_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - (find-mutated!_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - top-v_0 - ids_0)))) + #f))) + (begin + (find-mutated!_0 rator_0 #f) + (find-mutated!*_0 + exps_0 + #f)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (let ((v_1 (unwrap v_0))) + (if (symbol? v_1) + (let ((state_0 + (hash-ref + mutated_0 + v_1 + #f))) + (if (begin-unsafe + (eq? + state_0 + 'not-ready)) + (hash-set! + mutated_0 + v_1 + 'too-early) + (if (begin-unsafe + (procedure? state_0)) + (if ids_1 + (delay!_0 + ids_1 + (lambda () + (begin + (if (eq? + (hash-ref + mutated_0 + v_1 + #f) + state_0) + (hash-remove! + mutated_0 + v_1) + (void)) + (|#%app| + state_0)))) + (begin + (hash-remove! + mutated_0 + v_1) + (|#%app| state_0))) + (void)))) + (void))))))))))))))))))))))) + (find-mutated!_0 top-v_0 ids_0))))) (define update-mutated-state! (lambda (l_0 mut-l_0 mutated_0) (if (begin-unsafe (null? (unwrap mut-l_0))) @@ -20667,277 +20249,207 @@ (if (eq? mut-l_0 l_0) (wrap-cdr mut-l_0) l_0)) mut-l_0)))) (define left-to-right/let - (letrec ((loop_0 - (|#%name| - loop - (lambda (bodys_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - ids_0 - rhss_0 - all-simple?_0 - binds_0) - (begin - (if (null? (cdr rhss_0)) - (let ((id_0 (car ids_0))) - (let ((rhs_0 (car rhss_0))) - (if (if all-simple?_0 - (simple?.1 - #t - 1 - rhs_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - #f) - (list* 'let (list (list id_0 rhs_0)) bodys_0) - (list - 'let - (list (list id_0 rhs_0)) - (list* 'let binds_0 bodys_0))))) - (let ((id_0 (car ids_0))) - (let ((rhs_0 (car rhss_0))) - (list - 'let - (list (list id_0 rhs_0)) - (let ((app_0 (cdr ids_0))) - (let ((app_1 (cdr rhss_0))) - (loop_0 - bodys_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - app_0 - app_1 - (if all-simple?_0 - (simple?.1 - #t - 1 - rhs_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - #f) - (cons (list id_0 id_0) binds_0))))))))))))) - (lambda (ids_0 - rhss_0 - bodys_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - (if (null? ids_0) - (if (null? (cdr bodys_0)) (car bodys_0) (list* 'begin bodys_0)) - (if (null? (cdr ids_0)) - (list* - 'let - (list (let ((app_0 (car ids_0))) (list app_0 (car rhss_0)))) - bodys_0) - (loop_0 - bodys_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - ids_0 + (lambda (ids_0 rhss_0 - #t - null)))))) -(define left-to-right/let-values - (letrec ((loop_0 - (|#%name| - loop - (lambda (bodys_0 target_0 idss_0 rhss_0 binds_0) - (begin - (if (null? (cdr rhss_0)) - (let ((app_0 (car idss_0))) - (make-let-values - app_0 - (car rhss_0) - (list* 'let binds_0 bodys_0) - target_0)) - (let ((ids_0 (car idss_0))) - (let ((app_0 (car rhss_0))) - (make-let-values - ids_0 - app_0 - (let ((app_1 (cdr idss_0))) - (let ((app_2 (cdr rhss_0))) - (loop_0 - bodys_0 - target_0 - app_1 - app_2 - (append - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((id_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((id_1 id_0)) - (let ((fold-var_1 - (cons - (list id_1 id_1) - fold-var_0))) - (let ((fold-var_2 - (values fold-var_1))) - (for-loop_0 - fold-var_2 - rest_0)))))) - fold-var_0)))))) - (for-loop_0 null ids_0)))) - binds_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 target_0))) - (loop_0 bodys_0 target_0 idss_0 rhss_0 null))))) -(define left-to-right/app - (letrec ((loop_0 - (|#%name| - loop - (lambda (app-form_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - l_0 - accum_0 - pending-non-simple_0 - pending-id_0) - (begin - (if (null? l_0) - (let ((app_0 - (if pending-non-simple_0 - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (accum_1 rev-accum_0) - (begin - (if (null? accum_1) - rev-accum_0 - (if (eq? (car accum_1) pending-id_0) - (loop_1 - (cdr accum_1) - (cons - pending-non-simple_0 - rev-accum_0)) - (let ((app_0 (cdr accum_1))) - (loop_1 - app_0 - (cons - (car accum_1) - rev-accum_0)))))))))) - (loop_1 accum_0 null)) - (reverse$1 accum_0)))) - (if app-form_0 (cons app-form_0 app_0) app_0)) - (if (let ((temp13_0 (car l_0))) - (simple?.1 - #t - 1 - temp13_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0)) - (let ((app_0 (cdr l_0))) - (loop_0 - app-form_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - app_0 - (cons (car l_0) accum_0) - pending-non-simple_0 - pending-id_0)) - (if pending-non-simple_0 - (list - 'let - (list (list pending-id_0 pending-non-simple_0)) - (loop_0 - app-form_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - l_0 - accum_0 - #f - #f)) - (let ((g_0 (deterministic-gensym "app_"))) - (let ((app_0 (cdr l_0))) + bodys_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0) + (if (null? ids_0) + (if (null? (cdr bodys_0)) (car bodys_0) (list* 'begin bodys_0)) + (if (null? (cdr ids_0)) + (list* + 'let + (list (let ((app_0 (car ids_0))) (list app_0 (car rhss_0)))) + bodys_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ids_1 rhss_1 all-simple?_0 binds_0) + (begin + (if (null? (cdr rhss_1)) + (let ((id_0 (car ids_1))) + (let ((rhs_0 (car rhss_1))) + (if (if all-simple?_0 + (simple?.1 + #t + 1 + rhs_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0) + #f) + (list* 'let (list (list id_0 rhs_0)) bodys_0) + (list + 'let + (list (list id_0 rhs_0)) + (list* 'let binds_0 bodys_0))))) + (let ((id_0 (car ids_1))) + (let ((rhs_0 (car rhss_1))) + (list + 'let + (list (list id_0 rhs_0)) + (let ((app_0 (cdr ids_1))) + (let ((app_1 (cdr rhss_1))) (loop_0 - app-form_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 app_0 - (cons g_0 accum_0) - (car l_0) - g_0))))))))))) - (lambda (rator_0 - rands_0 - app-form_0 - target_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - (if (eq? target_0 'cify) - (cons rator_0 rands_0) - (loop_0 - app-form_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - simples_0 - (cons rator_0 rands_0) - null - #f - #f))))) + app_1 + (if all-simple?_0 + (simple?.1 + #t + 1 + rhs_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0) + #f) + (cons (list id_0 id_0) binds_0))))))))))))) + (loop_0 ids_0 rhss_0 #t null)))))) +(define left-to-right/let-values + (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 target_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (idss_1 rhss_1 binds_0) + (begin + (if (null? (cdr rhss_1)) + (let ((app_0 (car idss_1))) + (make-let-values + app_0 + (car rhss_1) + (list* 'let binds_0 bodys_0) + target_0)) + (let ((ids_0 (car idss_1))) + (let ((app_0 (car rhss_1))) + (make-let-values + ids_0 + app_0 + (let ((app_1 (cdr idss_1))) + (let ((app_2 (cdr rhss_1))) + (loop_0 + app_1 + app_2 + (append + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((id_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((id_1 id_0)) + (let ((fold-var_1 + (cons + (list id_1 id_1) + fold-var_0))) + (let ((fold-var_2 + (values fold-var_1))) + (for-loop_0 + fold-var_2 + rest_0)))))) + fold-var_0)))))) + (for-loop_0 null ids_0)))) + binds_0)))) + target_0))))))))) + (loop_0 idss_0 rhss_0 null))))) +(define left-to-right/app + (lambda (rator_0 + rands_0 + app-form_0 + target_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0) + (if (eq? target_0 'cify) + (cons rator_0 rands_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_0 accum_0 pending-non-simple_0 pending-id_0) + (begin + (if (null? l_0) + (let ((app_0 + (if pending-non-simple_0 + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (accum_1 rev-accum_0) + (begin + (if (null? accum_1) + rev-accum_0 + (if (eq? (car accum_1) pending-id_0) + (loop_1 + (cdr accum_1) + (cons pending-non-simple_0 rev-accum_0)) + (let ((app_0 (cdr accum_1))) + (loop_1 + app_0 + (cons + (car accum_1) + rev-accum_0)))))))))) + (loop_1 accum_0 null)) + (reverse$1 accum_0)))) + (if app-form_0 (cons app-form_0 app_0) app_0)) + (if (let ((temp13_0 (car l_0))) + (simple?.1 + #t + 1 + temp13_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0)) + (let ((app_0 (cdr l_0))) + (loop_0 + app_0 + (cons (car l_0) accum_0) + pending-non-simple_0 + pending-id_0)) + (if pending-non-simple_0 + (list + 'let + (list (list pending-id_0 pending-non-simple_0)) + (loop_0 l_0 accum_0 #f #f)) + (let ((g_0 (deterministic-gensym "app_"))) + (let ((app_0 (cdr l_0))) + (loop_0 + app_0 + (cons g_0 accum_0) + (car l_0) + g_0))))))))))) + (loop_0 (cons rator_0 rands_0) null #f #f))))) (define make-let-values (lambda (ids_0 rhs_0 body_0 target_0) (if (if (pair? ids_0) (null? (cdr ids_0)) #f) @@ -21601,51 +21113,51 @@ #f) #f))) (define infer-procedure-name - (letrec ((add-property_0 - (|#%name| - add-property - (lambda (new-s_0 orig-s_0 str_0) - (begin - (let ((app_0 (reannotate orig-s_0 new-s_0))) - (wrap-property-set - app_0 - 'inferred-name - (let ((prefix_0 - (if (let ((or-part_0 - (char=? (string-ref str_0 0) '#\x21))) - (if or-part_0 - or-part_0 - (char=? (string-ref str_0 0) '#\x5e))) - "[^" - "["))) - (string->symbol - (string-append-immutable prefix_0 str_0)))))))))) - (lambda (orig-s_0 new-s_0 explicit-unnamed?_0) - (let ((inferred-name_0 (wrap-property orig-s_0 'inferred-name))) - (if (symbol? inferred-name_0) - (let ((s_0 (symbol->immutable-string inferred-name_0))) - (if (if (fx> (string-length s_0) 0) - (let ((ch_0 (string-ref s_0 0))) - (let ((or-part_0 (char=? '#\x5b ch_0))) - (if or-part_0 or-part_0 (char=? '#\x5d ch_0)))) - #f) - (let ((app_0 (reannotate orig-s_0 new-s_0))) - (wrap-property-set - app_0 - 'inferred-name - (string->symbol (string-append-immutable "]" s_0)))) - new-s_0)) - (call-with-values - (lambda () (wrap-source orig-s_0)) - (case-lambda - ((src_0 line_0 col_0 pos_0 span_0) + (lambda (orig-s_0 new-s_0 explicit-unnamed?_0) + (let ((inferred-name_0 (wrap-property orig-s_0 'inferred-name))) + (if (symbol? inferred-name_0) + (let ((s_0 (symbol->immutable-string inferred-name_0))) + (if (if (fx> (string-length s_0) 0) + (let ((ch_0 (string-ref s_0 0))) + (let ((or-part_0 (char=? '#\x5b ch_0))) + (if or-part_0 or-part_0 (char=? '#\x5d ch_0)))) + #f) + (let ((app_0 (reannotate orig-s_0 new-s_0))) + (wrap-property-set + app_0 + 'inferred-name + (string->symbol (string-append-immutable "]" s_0)))) + new-s_0)) + (call-with-values + (lambda () (wrap-source orig-s_0)) + (case-lambda + ((src_0 line_0 col_0 pos_0 span_0) + (let ((add-property_0 + (|#%name| + add-property + (lambda (str_0) + (begin + (let ((app_0 (reannotate orig-s_0 new-s_0))) + (wrap-property-set + app_0 + 'inferred-name + (let ((prefix_0 + (if (let ((or-part_0 + (char=? + (string-ref str_0 0) + '#\x21))) + (if or-part_0 + or-part_0 + (char=? (string-ref str_0 0) '#\x5e))) + "[^" + "["))) + (string->symbol + (string-append-immutable prefix_0 str_0)))))))))) (if (if (let ((or-part_0 (path? src_0))) (if or-part_0 or-part_0 (string? src_0))) (if line_0 col_0 #f) #f) (add-property_0 - new-s_0 - orig-s_0 (let ((app_0 (source->string src_0))) (let ((app_1 (number->string line_0))) (string-append @@ -21659,8 +21171,6 @@ (if src_0 pos_0 #f) #f) (add-property_0 - new-s_0 - orig-s_0 (let ((app_0 (source->string src_0))) (string-append app_0 "::" (number->string pos_0)))) (if (if explicit-unnamed?_0 @@ -21670,8 +21180,8 @@ (reannotate orig-s_0 new-s_0) 'inferred-name '|[|) - new-s_0)))) - (args (raise-binding-result-arity-error 5 args))))))))) + new-s_0))))) + (args (raise-binding-result-arity-error 5 args)))))))) (define source->string (lambda (src_0) (let ((str_0 (if (string? src_0) src_0 (path->string src_0)))) @@ -22012,111 +21522,41 @@ (lambda (ref_0 set_0 ptr-e_0 offset-e_0 val-e_0 abs?_0) (list set_0 ptr-e_0 offset-e_0 val-e_0 abs?_0))) (define type->direct - (letrec ((do-make_0 - (|#%name| - do-make - (lambda (abs?_0 make_0 offset-e_0 ptr-e_0 val-e_0 ref_0 set_0) - (begin - (|#%app| - make_0 - ref_0 - set_0 - ptr-e_0 - offset-e_0 - val-e_0 - abs?_0)))))) - (lambda (type-e_0 ptr-e_0 offset-e_0 abs?_0 make_0 val-e_0) + (lambda (type-e_0 ptr-e_0 offset-e_0 abs?_0 make_0 val-e_0) + (let ((do-make_0 + (|#%name| + do-make + (lambda (ref_0 set_0) + (begin + (|#%app| + make_0 + ref_0 + set_0 + ptr-e_0 + offset-e_0 + val-e_0 + abs?_0)))))) (let ((tmp_0 (unwrap type-e_0))) (if (eq? tmp_0 '_int8) - (do-make_0 - abs?_0 - make_0 - offset-e_0 - ptr-e_0 - val-e_0 - 'ptr-ref/int8 - 'ptr-set!/int8) + (do-make_0 'ptr-ref/int8 'ptr-set!/int8) (if (eq? tmp_0 '_uint8) - (do-make_0 - abs?_0 - make_0 - offset-e_0 - ptr-e_0 - val-e_0 - 'ptr-ref/uint8 - 'ptr-set!/uint8) + (do-make_0 'ptr-ref/uint8 'ptr-set!/uint8) (if (eq? tmp_0 '_int16) - (do-make_0 - abs?_0 - make_0 - offset-e_0 - ptr-e_0 - val-e_0 - 'ptr-ref/int16 - 'ptr-set!/int16) + (do-make_0 'ptr-ref/int16 'ptr-set!/int16) (if (eq? tmp_0 '_uint16) - (do-make_0 - abs?_0 - make_0 - offset-e_0 - ptr-e_0 - val-e_0 - 'ptr-ref/uint16 - 'ptr-set!/uint16) + (do-make_0 'ptr-ref/uint16 'ptr-set!/uint16) (if (eq? tmp_0 '_int32) - (do-make_0 - abs?_0 - make_0 - offset-e_0 - ptr-e_0 - val-e_0 - 'ptr-ref/int32 - 'ptr-set!/int32) + (do-make_0 'ptr-ref/int32 'ptr-set!/int32) (if (eq? tmp_0 '_uint32) - (do-make_0 - abs?_0 - make_0 - offset-e_0 - ptr-e_0 - val-e_0 - 'ptr-ref/uint32 - 'ptr-set!/uint32) + (do-make_0 'ptr-ref/uint32 'ptr-set!/uint32) (if (eq? tmp_0 '_int64) - (do-make_0 - abs?_0 - make_0 - offset-e_0 - ptr-e_0 - val-e_0 - 'ptr-ref/int64 - 'ptr-set!/int64) + (do-make_0 'ptr-ref/int64 'ptr-set!/int64) (if (eq? tmp_0 '_uint64) - (do-make_0 - abs?_0 - make_0 - offset-e_0 - ptr-e_0 - val-e_0 - 'ptr-ref/uint64 - 'ptr-set!/uint64) + (do-make_0 'ptr-ref/uint64 'ptr-set!/uint64) (if (eq? tmp_0 '_double) - (do-make_0 - abs?_0 - make_0 - offset-e_0 - ptr-e_0 - val-e_0 - 'ptr-ref/double - 'ptr-set!/double) + (do-make_0 'ptr-ref/double 'ptr-set!/double) (if (eq? tmp_0 '_float) - (do-make_0 - abs?_0 - make_0 - offset-e_0 - ptr-e_0 - val-e_0 - 'ptr-ref/float - 'ptr-set!/float) + (do-make_0 'ptr-ref/float 'ptr-set!/float) #f)))))))))))))) (define authentic-valued? (lambda (v_0 knowns_0 prim-knowns_0 imports_0 mutated_0) @@ -22177,525 +21617,371 @@ (not (pair? u-v_0))))))))))) (authentic-valued?_0 v_0)))) (define schemify-linklet - (letrec ((ex-ext-id_0 - (|#%name| - ex-ext-id - (lambda (id_0) - (begin (unwrap (if (pair? id_0) (cadr id_0) id_0)))))) - (ex-int-id_0 - (|#%name| - ex-int-id - (lambda (id_0) - (begin (unwrap (if (pair? id_0) (car id_0) id_0)))))) - (im-ext-id_0 - (|#%name| - im-ext-id - (lambda (id_0) - (begin (unwrap (if (pair? id_0) (car id_0) id_0)))))) - (im-int-id_0 + (lambda (lk_0 + serializable?-box_0 + datum-intern?_0 + target_0 + allow-set!-undefined?_0 + unsafe-mode?_0 + enforce-constant?_0 + allow-inline?_0 + no-prompt?_0 + prim-knowns_0 + primitives_0 + get-import-knowns_0 + import-keys_0) + (with-continuation-mark* + authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first #f parameterization-key) + gensym-counter + (box 0)) + (let ((im-int-id_0 (|#%name| im-int-id (lambda (id_0) (begin (unwrap (if (pair? id_0) (cadr id_0) id_0))))))) - (lambda (lk_0 - serializable?-box_0 - datum-intern?_0 - target_0 - allow-set!-undefined?_0 - unsafe-mode?_0 - enforce-constant?_0 - allow-inline?_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - get-import-knowns_0 - import-keys_0) - (with-continuation-mark* - authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - gensym-counter - (box 0)) - (let ((hd_0 - (let ((p_0 (unwrap lk_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'linklet hd_0) - (let ((a_0 (cdr (unwrap lk_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) #t #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap lk_0)))) - (let ((p_0 (unwrap d_0))) - (let ((im-idss_0 (let ((a_0 (car p_0))) a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((ex-ids_0 (let ((a_0 (car p_1))) a_0))) - (let ((bodys_0 (let ((d_2 (cdr p_1))) d_2))) - (let ((ex-ids_1 ex-ids_0)) - (values ex-ids_1 bodys_0))))))) - (case-lambda - ((ex-ids_0 bodys_0) - (let ((im-idss_1 im-idss_0)) - (values im-idss_1 ex-ids_0 bodys_0))) - (args (raise-binding-result-arity-error 2 args)))))))) - (case-lambda - ((im-idss_0 ex-ids_0 bodys_0) - (let ((grps_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0 pos_0) - (begin - (if (if (pair? lst_0) #t #f) - (let ((im-ids_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (import-group2.1 - pos_0 - (if import-keys_0 - (vector-ref - import-keys_0 - pos_0) - #f) - get-import-knowns_0 - #f - #f - '()) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - (+ pos_0 1))))) - fold-var_0)))))) - (for-loop_0 null im-idss_0 0)))))) - (let ((imports_0 - (let ((imports_0 (make-hasheq))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0 lst_1) - (begin - (if (if (pair? lst_0) (pair? lst_1) #f) - (let ((im-ids_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((grp_0 (unsafe-car lst_1))) - (let ((rest_1 (unsafe-cdr lst_1))) - (begin - (set-import-group-imports! - grp_0 - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_2) - (begin - (if (pair? lst_2) - (let ((im-id_0 - (unsafe-car - lst_2))) - (let ((rest_2 - (unsafe-cdr - lst_2))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((id_0 - (im-int-id_0 - im-id_0))) - (let ((ext-id_0 - (im-ext-id_0 - im-id_0))) - (let ((int-id_0 - (deterministic-gensym - id_0))) - (let ((im_0 - (import1.1 - grp_0 - int-id_0 - id_0 - ext-id_0))) - (begin - (hash-set! - imports_0 - id_0 - im_0) - (hash-set! - imports_0 - int-id_0 - im_0) - im_0))))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_1 - fold-var_1 - rest_2)))) - fold-var_0)))))) - (for-loop_1 - null - im-ids_0))))) - (for-loop_0 - rest_0 - rest_1)))))) - (values))))))) - (for-loop_0 im-idss_0 grps_0))) - (void) - imports_0)))) - (let ((new-grps_0 '())) - (let ((add-import!_0 - (make-add-import! - imports_0 - grps_0 - get-import-knowns_0 - (lambda (new-grp_0) - (set! new-grps_0 (cons new-grp_0 new-grps_0)))))) - (let ((exports_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (exports_0 lst_0) - (begin - (if (pair? lst_0) - (let ((ex-id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((exports_1 - (let ((exports_1 - (let ((id_0 - (ex-int-id_0 - ex-id_0))) - (hash-set - exports_0 - id_0 - (let ((app_0 - (deterministic-gensym - id_0))) - (export1.1 - app_0 - (ex-ext-id_0 - ex-id_0))))))) - (values exports_1)))) - (for-loop_0 exports_1 rest_0)))) - exports_0)))))) - (for-loop_0 (hasheq) ex-ids_0))))) - (let ((src-syms_0 - (get-definition-source-syms bodys_0))) + (let ((im-ext-id_0 + (|#%name| + im-ext-id + (lambda (id_0) + (begin (unwrap (if (pair? id_0) (car id_0) id_0))))))) + (let ((ex-int-id_0 + (|#%name| + ex-int-id + (lambda (id_0) + (begin (unwrap (if (pair? id_0) (car id_0) id_0))))))) + (let ((ex-ext-id_0 + (|#%name| + ex-ext-id + (lambda (id_0) + (begin (unwrap (if (pair? id_0) (cadr id_0) id_0))))))) + (let ((hd_0 + (let ((p_0 (unwrap lk_0))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'linklet hd_0) + (let ((a_0 (cdr (unwrap lk_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) #t #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap lk_0)))) + (let ((p_0 (unwrap d_0))) + (let ((im-idss_0 (let ((a_0 (car p_0))) a_0))) (call-with-values (lambda () - (schemify-body* - bodys_0 - prim-knowns_0 - primitives_0 - imports_0 - exports_0 - serializable?-box_0 - datum-intern?_0 - allow-set!-undefined?_0 - add-import!_0 - target_0 - unsafe-mode?_0 - enforce-constant?_0 - allow-inline?_0 - no-prompt?_0 - #t)) + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((ex-ids_0 (let ((a_0 (car p_1))) a_0))) + (let ((bodys_0 (let ((d_2 (cdr p_1))) d_2))) + (let ((ex-ids_1 ex-ids_0)) + (values ex-ids_1 bodys_0))))))) (case-lambda - ((new-body_0 defn-info_0 mutated_0) - (let ((all-grps_0 - (append grps_0 (reverse$1 new-grps_0)))) - (let ((app_0 - (list* - 'lambda - (list* - 'instance-variable-reference - (let ((app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? lst_0) - (let ((grp_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((lst_1 - (import-group-imports - grp_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_1 - lst_2) - (begin - (if (pair? - lst_2) - (let ((im_0 - (unsafe-car - lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((fold-var_2 - (let ((fold-var_2 - (cons - (import-id - im_0) - fold-var_1))) - (values - fold-var_2)))) - (for-loop_1 - fold-var_2 - rest_1)))) - fold-var_1)))))) - (for-loop_1 - fold-var_0 - lst_1)))))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - all-grps_0)))))) - (qq-append - app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((ex-id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (export-id - (hash-ref - exports_0 - (ex-int-id_0 - ex-id_0))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null ex-ids_0))))))) - new-body_0))) - (let ((app_1 - (reverse$1 + ((ex-ids_0 bodys_0) + (let ((im-idss_1 im-idss_0)) + (values im-idss_1 ex-ids_0 bodys_0))) + (args + (raise-binding-result-arity-error 2 args)))))))) + (case-lambda + ((im-idss_0 ex-ids_0 bodys_0) + (let ((grps_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0 pos_0) + (begin + (if (if (pair? lst_0) #t #f) + (let ((im-ids_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (import-group2.1 + pos_0 + (if import-keys_0 + (vector-ref + import-keys_0 + pos_0) + #f) + get-import-knowns_0 + #f + #f + '()) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + (+ pos_0 1))))) + fold-var_0)))))) + (for-loop_0 null im-idss_0 0)))))) + (let ((imports_0 + (let ((imports_0 (make-hasheq))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0 lst_1) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((grp_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (reverse$1 - (let ((lst_1 - (import-group-imports - grp_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_1 - lst_2) - (begin - (if (pair? - lst_2) - (let ((im_0 - (unsafe-car - lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((fold-var_2 - (let ((fold-var_2 - (cons - (import-ext-id - im_0) - fold-var_1))) - (values - fold-var_2)))) - (for-loop_1 - fold-var_2 - rest_1)))) - fold-var_1)))))) - (for-loop_1 - null - lst_1))))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null all-grps_0)))))) - (let ((app_2 - (reverse$1 + (if (if (pair? lst_0) + (pair? lst_1) + #f) + (let ((im-ids_0 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) + (let ((grp_0 + (unsafe-car lst_1))) + (let ((rest_1 + (unsafe-cdr lst_1))) + (begin + (set-import-group-imports! + grp_0 + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_2) + (begin + (if (pair? + lst_2) + (let ((im-id_0 + (unsafe-car + lst_2))) + (let ((rest_2 + (unsafe-cdr + lst_2))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((id_0 + (im-int-id_0 + im-id_0))) + (let ((ext-id_0 + (im-ext-id_0 + im-id_0))) + (let ((int-id_0 + (deterministic-gensym + id_0))) + (let ((im_0 + (import1.1 + grp_0 + int-id_0 + id_0 + ext-id_0))) + (begin + (hash-set! + imports_0 + id_0 + im_0) + (hash-set! + imports_0 + int-id_0 + im_0) + im_0))))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_1 + fold-var_1 + rest_2)))) + fold-var_0)))))) + (for-loop_1 + null + im-ids_0))))) + (for-loop_0 + rest_0 + rest_1)))))) + (values))))))) + (for-loop_0 im-idss_0 grps_0))) + (void) + imports_0)))) + (let ((new-grps_0 '())) + (let ((add-import!_0 + (make-add-import! + imports_0 + grps_0 + get-import-knowns_0 + (lambda (new-grp_0) + (set! new-grps_0 + (cons new-grp_0 new-grps_0)))))) + (let ((exports_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (exports_0 lst_0) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((ex-id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 + (if (pair? lst_0) + (let ((ex-id_0 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) + (let ((exports_1 + (let ((exports_1 + (let ((id_0 + (ex-int-id_0 + ex-id_0))) + (hash-set + exports_0 + id_0 + (let ((app_0 + (deterministic-gensym + id_0))) + (export1.1 + app_0 + (ex-ext-id_0 + ex-id_0))))))) + (values + exports_1)))) + (for-loop_0 + exports_1 + rest_0)))) + exports_0)))))) + (for-loop_0 (hasheq) ex-ids_0))))) + (let ((src-syms_0 + (get-definition-source-syms bodys_0))) + (call-with-values + (lambda () + (schemify-body* + bodys_0 + prim-knowns_0 + primitives_0 + imports_0 + exports_0 + serializable?-box_0 + datum-intern?_0 + allow-set!-undefined?_0 + add-import!_0 + target_0 + unsafe-mode?_0 + enforce-constant?_0 + allow-inline?_0 + no-prompt?_0 + #t)) + (case-lambda + ((new-body_0 defn-info_0 mutated_0) + (let ((all-grps_0 + (append + grps_0 + (reverse$1 new-grps_0)))) + (let ((app_0 + (list* + 'lambda + (list* + 'instance-variable-reference + (let ((app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((grp_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((lst_1 + (import-group-imports + grp_0))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_1 + lst_2) + (begin + (if (pair? + lst_2) + (let ((im_0 + (unsafe-car + lst_2))) + (let ((rest_1 + (unsafe-cdr + lst_2))) + (let ((fold-var_2 + (let ((fold-var_2 + (cons + (import-id + im_0) + fold-var_1))) + (values + fold-var_2)))) + (for-loop_1 + fold-var_2 + rest_1)))) + fold-var_1)))))) + (for-loop_1 + fold-var_0 + lst_1)))))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + all-grps_0)))))) + (qq-append + app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? lst_0) + (let ((ex-id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) (let ((fold-var_1 - (cons - (let ((sym_0 - (ex-ext-id_0 - ex-id_0))) - (let ((int-sym_0 + (let ((fold-var_1 + (cons + (export-id + (hash-ref + exports_0 (ex-int-id_0 ex-id_0))) - (let ((src-sym_0 - (hash-ref - src-syms_0 - int-sym_0 - sym_0))) - (if (eq? - sym_0 - src-sym_0) - sym_0 - (cons - sym_0 - src-sym_0))))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null ex-ids_0)))))) - (let ((app_3 - (if (null? new-grps_0) - import-keys_0 - (let ((len_0 - (length all-grps_0))) - (begin - (if (exact-nonnegative-integer? - len_0) - (void) - (raise-argument-error - 'for/vector - "exact-nonnegative-integer?" - len_0)) - (let ((v_0 - (make-vector - len_0 - 0))) - (begin - (if (zero? len_0) - (void) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((grp_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((i_1 - (let ((i_1 - (begin - (unsafe-vector*-set! - v_0 - i_0 - (import-group-key - grp_0)) - (unsafe-fx+ - 1 - i_0)))) - (values - i_1)))) - (if (if (not - (let ((x_0 - (list - grp_0))) - (unsafe-fx= - i_1 - len_0))) - #t - #f) - (for-loop_0 - i_1 - rest_0) - i_1)))) - i_0)))))) - (for-loop_0 - 0 - all-grps_0)))) - v_0))))))) - (let ((app_4 + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + ex-ids_0))))))) + new-body_0))) + (let ((app_1 (reverse$1 (begin (letrec* @@ -22714,56 +22000,41 @@ (let ((fold-var_1 (let ((fold-var_1 (cons - (let ((im-ready?_0 - (import-group-lookup-ready? - grp_0))) - (reverse$1 - (let ((lst_1 - (import-group-imports - grp_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_1 - lst_2) - (begin - (if (pair? - lst_2) - (let ((im_0 - (unsafe-car + (reverse$1 + (let ((lst_1 + (import-group-imports + grp_0))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_1 + lst_2) + (begin + (if (pair? + lst_2) + (let ((im_0 + (unsafe-car + lst_2))) + (let ((rest_1 + (unsafe-cdr lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((fold-var_2 - (let ((fold-var_2 - (cons - (if im-ready?_0 - (let ((k_0 - (import-group-lookup - grp_0 - (import-ext-id - im_0)))) - (if (known-constant? - k_0) - (if (known-procedure? - k_0) - 'proc - #t) - #f)) - #f) - fold-var_1))) - (values - fold-var_2)))) - (for-loop_1 - fold-var_2 - rest_1)))) - fold-var_1)))))) - (for-loop_1 - null - lst_1)))))) + (let ((fold-var_2 + (let ((fold-var_2 + (cons + (import-ext-id + im_0) + fold-var_1))) + (values + fold-var_2)))) + (for-loop_1 + fold-var_2 + rest_1)))) + fold-var_1)))))) + (for-loop_1 + null + lst_1))))) fold-var_0))) (values fold-var_1)))) @@ -22774,1510 +22045,1560 @@ (for-loop_0 null all-grps_0)))))) - (values - app_0 - app_1 - app_2 - app_3 - app_4 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (knowns_0 lst_0) - (begin - (if (pair? lst_0) - (let ((ex-id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((knowns_1 - (let ((knowns_1 - (let ((id_0 - (ex-int-id_0 - ex-id_0))) - (let ((v_0 - (known-inline->export-known - (hash-ref - defn-info_0 - id_0 - #f) - prim-knowns_0 - imports_0 - exports_0 - serializable?-box_0))) - (if (not - (set!ed-mutated-state? - (hash-ref - mutated_0 - id_0 - #f))) - (let ((ext-id_0 - (ex-ext-id_0 - ex-id_0))) - (hash-set - knowns_0 - ext-id_0 - (if v_0 - v_0 - a-known-constant))) - knowns_0))))) - (values - knowns_1)))) - (for-loop_0 - knowns_1 - rest_0)))) - knowns_0)))))) - (for-loop_0 - (hasheq) - ex-ids_0))))))))))) - (args - (raise-binding-result-arity-error - 3 - args))))))))))) - (args (raise-binding-result-arity-error 3 args)))) - (error 'match "failed ~e" lk_0))))))) -(define schemify-body - (letrec ((procz1 (lambda (im_0 ext-id_0 index_0) #f))) - (lambda (l_0 - prim-knowns_0 - primitives_0 - imports_0 - exports_0 - target_0 - unsafe-mode?_0 - no-prompt?_0 - explicit-unnamed?_0) - (with-continuation-mark* - authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - gensym-counter - (box 0)) - (call-with-values - (lambda () - (schemify-body* - l_0 - prim-knowns_0 - primitives_0 - imports_0 - exports_0 - #f - #f - #f - procz1 - target_0 - unsafe-mode?_0 - #t - #t - no-prompt?_0 - explicit-unnamed?_0)) - (case-lambda - ((new-body_0 defn-info_0 mutated_0) new-body_0) - (args (raise-binding-result-arity-error 3 args)))))))) -(define schemify-body* - (letrec ((add-extra-variables_0 - (|#%name| - add-extra-variables - (lambda (extra-variables_0 l_0) - (begin - (append - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - extra-variables_0 - i_0)) - (case-lambda - ((int-id_0 ex_0) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (list* - 'define - (export-id ex_0) - '((make-internal-variable - 'int-id))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - (hash-iterate-next - extra-variables_0 - i_0)))) - (args - (raise-binding-result-arity-error 2 args)))) - fold-var_0)))))) - (for-loop_0 - null - (hash-iterate-first extra-variables_0))))) - l_0))))) - (finish-definition_0 - (|#%name| - finish-definition - (lambda (accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - knowns16_0 - next-k18_0 - schemified17_0 - ids24_0 - accum-exprs22_0 - accum-ids23_0) - (begin - (let ((accum-exprs_1 - (if (eq? accum-exprs22_0 unsafe-undefined) - accum-exprs_0 - accum-exprs22_0))) - (let ((accum-ids_1 - (if (eq? accum-ids23_0 unsafe-undefined) - accum-ids_0 - accum-ids23_0))) - (let ((knowns_1 - (if (eq? knowns16_0 unsafe-undefined) - knowns_0 - knowns16_0))) - (let ((schemified_1 - (if (eq? schemified17_0 unsafe-undefined) - schemified_0 - schemified17_0))) - (let ((next-knowns_0 - (if (if (pair? ids24_0) - (if (null? (cdr ids24_0)) - (can-improve-infer-known? - (hash-ref - knowns_1 - (unwrap (car ids24_0)) - #f)) - #f) - #f) - (let ((id_0 (car ids24_0))) - (let ((k_0 - (let ((hd_0 - (let ((p_0 - (unwrap - schemified_1))) - (if (pair? p_0) - (unwrap (car p_0)) - #f)))) - (if (if (eq? 'define hd_0) - (let ((a_0 - (cdr - (unwrap - schemified_1)))) - (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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - schemified_1)))) - (let ((p_0 (unwrap d_0))) - (let ((id_1 - (let ((a_0 - (car p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((id_2 id_1)) - (values - id_2 - rhs_0))))))) - (case-lambda - ((id_1 rhs_0) - (infer-known.1 - #f - #t - hash2610 - rhs_0 - #f - id_1 - knowns_1 - prim-knowns_0 - imports_0 - mutated_0 - simples_0 - unsafe-mode?_0 - target_0)) - (args - (raise-binding-result-arity-error - 2 - args)))) - (error - 'match - "failed ~e" - schemified_1))))) - (if k_0 - (hash-set knowns_1 (unwrap id_0) k_0) - knowns_1))) - knowns_1))) - (let ((app_0 - (make-expr-defns_0 target_0 accum-exprs_1))) - (append - app_0 - (cons - schemified_1 - (letrec* - ((id-loop_0 - (|#%name| - id-loop - (lambda (ids_0 accum-exprs_2 accum-ids_2) - (begin - (if (null? ids_0) - (if next-k18_0 - (|#%app| - next-k18_0 - accum-exprs_2 - accum-ids_2 - next-knowns_0) - (loop_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - (cdr l_0) - mut-l_0 - accum-exprs_2 - accum-ids_2 - next-knowns_0)) - (if (let ((or-part_0 - (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))) - (id-loop_0 - app_1 - (cons - (make-set-variable - id_0 - exports_0 - knowns_1 - mutated_0) - accum-exprs_2) - accum-ids_2)) - (id-loop_0 - (cdr ids_0) - accum-exprs_2 - accum-ids_2))) - (let ((app_1 (cdr ids_0))) - (id-loop_0 - app_1 - accum-exprs_2 - (cons - (car ids_0) - accum-ids_2)))))))))) - (id-loop_0 - ids24_0 - null - accum-ids_1)))))))))))))) - (finish-wrapped-definition_0 - (|#%name| - finish-wrapped-definition - (lambda (accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - ids_0 - rhs_0) - (begin - (let ((app_0 (make-expr-defns_0 target_0 accum-exprs_0))) - (let ((app_1 - (make-expr-defns_0 - target_0 - (make-set-variables_0 - accum-ids_0 - exports_0 - knowns_0 - mutated_0 - target_0)))) - (append - app_0 - app_1 - (if no-prompt?_0 - (let ((app_2 - (if (if unsafe-mode?_0 - unsafe-mode?_0 - (let ((or-part_0 (eq? target_0 'system))) - (if or-part_0 - or-part_0 - (if (pair? ids_0) - (null? (cdr ids_0)) - #f)))) - schemified_0 - (list - 'define-values - ids_0 - (list - 'call-with-values - (list 'lambda '() rhs_0) - (list - 'case-lambda - (list ids_0 (list* 'values ids_0)) - (list - 'vals - (list* - 'raise-definition-result-arity-error - (list 'quote ids_0) - '(vals))))))))) - (cons - app_2 - (let ((app_3 (cdr l_0))) - (loop_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - app_3 - mut-l_0 - null - (reverse$1 ids_0) - knowns_0)))) - (let ((expr_0 - (let ((app_2 - (list - 'quote - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((id_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (variable-constance - (unwrap - id_0) - knowns_0 - mutated_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null ids_0))))))) - (list* - 'call-with-module-prompt - (list 'lambda '() rhs_0) - (list 'quote ids_0) - app_2 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (id-to-variable - (unwrap - id_0) - exports_0 - knowns_0 - mutated_0 - extra-variables_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null ids_0)))))))) - (let ((defns_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (make-define-variable - id_0 - exports_0 - knowns_0 - mutated_0 - extra-variables_0) - fold-var_0))) - (values - fold-var_1)))) + (let ((app_2 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? lst_0) + (let ((ex-id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((sym_0 + (ex-ext-id_0 + ex-id_0))) + (let ((int-sym_0 + (ex-int-id_0 + ex-id_0))) + (let ((src-sym_0 + (hash-ref + src-syms_0 + int-sym_0 + sym_0))) + (if (eq? + sym_0 + src-sym_0) + sym_0 + (cons + sym_0 + src-sym_0))))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null ids_0)))))) - (let ((app_2 - (if (eq? target_0 'interp) - expr_0 - (make-expr-defn expr_0)))) - (cons - app_2 - (append - defns_0 - (loop_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - (cdr l_0) - mut-l_0 - null - null - knowns_0)))))))))))))) - (loop_0 - (|#%name| - loop - (lambda (add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - l_0 - in-mut-l_0 - accum-exprs_0 - accum-ids_0 - knowns_0) - (begin - (let ((mut-l_0 - (update-mutated-state! l_0 in-mut-l_0 mutated_0))) - (if (null? l_0) - (begin - (unsafe-set-box*! final-knowns_0 knowns_0) - (let ((set-vars_0 - (make-set-variables_0 - accum-ids_0 - exports_0 - knowns_0 - mutated_0 - target_0))) - (if (null? set-vars_0) - (if (null? accum-exprs_0) - '((void)) - (reverse$1 accum-exprs_0)) - (reverse$1 (append set-vars_0 accum-exprs_0))))) - (let ((form_0 (car l_0))) - (let ((schemified_0 - (schemify - form_0 - prim-knowns_0 - primitives_0 - knowns_0 - mutated_0 - imports_0 - exports_0 - simples_0 - allow-set!-undefined?_0 - add-import!_0 - serializable?-box_0 - datum-intern?_0 - target_0 - unsafe-mode?_0 - allow-inline?_0 - no-prompt?_0 - explicit-unnamed?_0 - (if (if no-prompt?_0 (null? (cdr l_0)) #f) - 'tail - 'fresh)))) - (let ((hd_0 - (let ((p_0 (unwrap schemified_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'define hd_0) - (let ((a_0 (cdr (unwrap schemified_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))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap schemified_0)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 (let ((a_0 (car p_0))) a_0))) - (let ((rhs_0 - (let ((d_1 (cdr p_0))) - (let ((a_0 (car (unwrap d_1)))) - a_0)))) - (let ((id_1 id_0)) - (values id_1 rhs_0))))))) - (case-lambda - ((id_0 rhs_0) - (if (simple?.1 - #f - 1 - rhs_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - (let ((temp44_0 (list id_0))) - (finish-definition_0 - accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - unsafe-undefined - #f - unsafe-undefined - temp44_0 - unsafe-undefined - unsafe-undefined)) - (finish-wrapped-definition_0 - accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - (list id_0) - rhs_0))) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'define-values hd_0) - (let ((a_0 (cdr (unwrap schemified_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))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap schemified_0)))) - (let ((p_0 (unwrap d_0))) - (let ((ids_0 - (let ((a_0 (car p_0))) a_0))) - (let ((rhs_0 - (let ((d_1 (cdr p_0))) - (let ((a_0 - (car (unwrap d_1)))) - a_0)))) - (let ((ids_1 ids_0)) - (values ids_1 rhs_0))))))) - (case-lambda - ((ids_0 rhs_0) - (if (let ((temp52_0 (length ids_0))) - (simple?.1 - #f - temp52_0 - rhs_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0)) - (let ((hd_1 - (let ((p_0 (unwrap rhs_0))) - (if (pair? p_0) - (unwrap (car p_0)) - #f)))) - (if (if (eq? 'values hd_1) - (let ((a_0 (cdr (unwrap rhs_0)))) - (wrap-list? a_0)) - #f) - (let ((rhss_0 - (let ((d_0 - (cdr (unwrap rhs_0)))) - (unwrap-list d_0)))) - (if (if (let ((app_0 - (length rhss_0))) - (= app_0 (length ids_0))) + null + ex-ids_0)))))) + (let ((app_3 + (if (null? new-grps_0) + import-keys_0 + (let ((len_0 + (length + all-grps_0))) + (begin + (if (exact-nonnegative-integer? + len_0) + (void) + (raise-argument-error + 'for/vector + "exact-nonnegative-integer?" + len_0)) + (let ((v_0 + (make-vector + len_0 + 0))) + (begin + (if (zero? len_0) + (void) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((grp_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((i_1 + (let ((i_1 + (begin + (unsafe-vector*-set! + v_0 + i_0 + (import-group-key + grp_0)) + (unsafe-fx+ + 1 + i_0)))) + (values + i_1)))) + (if (if (not + (let ((x_0 + (list + grp_0))) + (unsafe-fx= + i_1 + len_0))) + #t + #f) + (for-loop_0 + i_1 + rest_0) + i_1)))) + i_0)))))) + (for-loop_0 + 0 + all-grps_0)))) + v_0))))))) + (let ((app_4 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((grp_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((im-ready?_0 + (import-group-lookup-ready? + grp_0))) + (reverse$1 + (let ((lst_1 + (import-group-imports + grp_0))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_1 + lst_2) + (begin + (if (pair? + lst_2) + (let ((im_0 + (unsafe-car + lst_2))) + (let ((rest_1 + (unsafe-cdr + lst_2))) + (let ((fold-var_2 + (let ((fold-var_2 + (cons + (if im-ready?_0 + (let ((k_0 + (import-group-lookup + grp_0 + (import-ext-id + im_0)))) + (if (known-constant? + k_0) + (if (known-procedure? + k_0) + 'proc + #t) + #f)) + #f) + fold-var_1))) + (values + fold-var_2)))) + (for-loop_1 + fold-var_2 + rest_1)))) + fold-var_1)))))) + (for-loop_1 + null + lst_1)))))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + all-grps_0)))))) + (values + app_0 + app_1 + app_2 + app_3 + app_4 (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (result_0 lst_0) + (lambda (knowns_0 lst_0) (begin (if (pair? lst_0) - (let ((rhs_1 + (let ((ex-id_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) - (let ((result_1 - (let ((result_1 - (simple?.1 - #t - 1 - rhs_1 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0))) + (let ((knowns_1 + (let ((knowns_1 + (let ((id_0 + (ex-int-id_0 + ex-id_0))) + (let ((v_0 + (known-inline->export-known + (hash-ref + defn-info_0 + id_0 + #f) + prim-knowns_0 + imports_0 + exports_0 + serializable?-box_0))) + (if (not + (set!ed-mutated-state? + (hash-ref + mutated_0 + id_0 + #f))) + (let ((ext-id_0 + (ex-ext-id_0 + ex-id_0))) + (hash-set + knowns_0 + ext-id_0 + (if v_0 + v_0 + a-known-constant))) + knowns_0))))) (values - result_1)))) - (if (if (not - (let ((x_0 - (list - rhs_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1)))) - result_0)))))) - (for-loop_0 #t rhss_0))) - #f) - (values-loop_0 - accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - ids_0 - rhss_0 - accum-exprs_0 - accum-ids_0 - knowns_0) - (finish-definition_0 - accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - unsafe-undefined - #f - unsafe-undefined - ids_0 - unsafe-undefined - unsafe-undefined))) - (finish-definition_0 - accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - unsafe-undefined - #f - unsafe-undefined - ids_0 - unsafe-undefined - unsafe-undefined))) - (finish-wrapped-definition_0 - accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - ids_0 - rhs_0))) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (if (eq? 'quote hd_0) - (let ((a_0 - (cdr (unwrap schemified_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_1))))) - #f))) - #f) - (let ((or-part_0 (pair? (cdr l_0)))) - (if or-part_0 - or-part_0 - (pair? accum-ids_0))) - #f) - (loop_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - (cdr l_0) - mut-l_0 - accum-exprs_0 - accum-ids_0 - knowns_0) - (let ((hd_1 - (let ((p_0 (unwrap form_0))) - (if (pair? p_0) - (unwrap (car p_0)) - #f)))) - (if (if (eq? 'define-values hd_1) - (let ((a_0 (cdr (unwrap form_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))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_2))))) - #f))) - #f))) - #f) - (let ((ids_0 - (let ((d_0 (cdr (unwrap form_0)))) - (let ((a_0 (car (unwrap d_0)))) - a_0)))) - (let ((set-vars_0 - (make-set-variables_0 - accum-ids_0 - exports_0 - knowns_0 - mutated_0 - target_0))) - (let ((temp68_0 - (append - set-vars_0 - accum-exprs_0))) - (finish-definition_0 - accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - unsafe-undefined - #f - unsafe-undefined - ids_0 - temp68_0 - null)))) - (if (simple?.1 - #f - #f - schemified_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - (loop_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - (cdr l_0) - mut-l_0 - (cons schemified_0 accum-exprs_0) - accum-ids_0 - knowns_0) - (let ((set-vars_0 - (make-set-variables_0 - accum-ids_0 - exports_0 - knowns_0 - mutated_0 - target_0))) - (let ((expr_0 - (if no-prompt?_0 - schemified_0 - (list - 'call-with-module-prompt - (list - 'lambda - '() - schemified_0))))) - (let ((app_0 (cdr l_0))) - (loop_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - app_0 - mut-l_0 - (cons - expr_0 - (append - set-vars_0 - accum-exprs_0)) - null - knowns_0))))))))))))))))))) - (loop_1 - (|#%name| - loop - (lambda (exports_0 - knowns_0 - mutated_0 - accum-ids_0 - consistent-ids_0) + knowns_1)))) + (for-loop_0 + knowns_1 + rest_0)))) + knowns_0)))))) + (for-loop_0 + (hasheq) + ex-ids_0))))))))))) + (args + (raise-binding-result-arity-error + 3 + args))))))))))) + (args (raise-binding-result-arity-error 3 args)))) + (error 'match "failed ~e" lk_0)))))))))) +(define schemify-body + (lambda (l_0 + prim-knowns_0 + primitives_0 + imports_0 + exports_0 + target_0 + unsafe-mode?_0 + no-prompt?_0 + explicit-unnamed?_0) + (with-continuation-mark* + authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first #f parameterization-key) + gensym-counter + (box 0)) + (call-with-values + (lambda () + (schemify-body* + l_0 + prim-knowns_0 + primitives_0 + imports_0 + exports_0 + #f + #f + #f + (lambda (im_0 ext-id_0 index_0) #f) + target_0 + unsafe-mode?_0 + #t + #t + no-prompt?_0 + explicit-unnamed?_0)) + (case-lambda + ((new-body_0 defn-info_0 mutated_0) new-body_0) + (args (raise-binding-result-arity-error 3 args))))))) +(define schemify-body* + (lambda (l_0 + prim-knowns_0 + primitives_0 + imports_0 + exports_0 + serializable?-box_0 + datum-intern?_0 + allow-set!-undefined?_0 + add-import!_0 + target_0 + unsafe-mode?_0 + enforce-constant?_0 + allow-inline?_0 + no-prompt?_0 + explicit-unnamed?_0) + (let ((simples_0 (make-hasheq))) + (let ((mutated_0 + (mutated-in-body + l_0 + exports_0 + prim-knowns_0 + (hasheq) + imports_0 + simples_0 + unsafe-mode?_0 + target_0 + enforce-constant?_0))) + (let ((knowns_0 (begin - (if (null? accum-ids_0) - (make-set-consistent-variables - consistent-ids_0 - exports_0 - knowns_0 - mutated_0) - (let ((id_0 (car accum-ids_0))) - (let ((u-id_0 (unwrap id_0))) - (if (hash-ref exports_0 u-id_0 #f) - (if (eq? - 'consistent - (variable-constance u-id_0 knowns_0 mutated_0)) - (loop_1 - exports_0 - knowns_0 - mutated_0 - (cdr accum-ids_0) - (cons id_0 consistent-ids_0)) - (let ((app_0 - (make-set-consistent-variables - consistent-ids_0 - exports_0 - knowns_0 - mutated_0))) - (append - app_0 - (let ((app_1 - (make-set-variable - id_0 - exports_0 - knowns_0 - mutated_0))) - (cons - app_1 - (loop_1 - exports_0 - knowns_0 - mutated_0 - (cdr accum-ids_0) - '())))))) - (loop_1 - exports_0 - knowns_0 - mutated_0 - (cdr accum-ids_0) - consistent-ids_0))))))))) - (make-expr-defns_0 - (|#%name| - make-expr-defns - (lambda (target_0 es_0) - (begin - (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))) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (knowns_0 lst_0) + (begin + (if (pair? lst_0) + (let ((form_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((knowns_1 + (let ((knowns_1 + (call-with-values + (lambda () + (find-definitions.1 + #t + primitives_0 + form_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0 + target_0)) + (case-lambda + ((new-knowns_0 info_0) + new-knowns_0) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values knowns_1)))) + (for-loop_0 knowns_1 rest_0)))) + knowns_0)))))) + (for-loop_0 (hasheq) l_0))))) + (let ((extra-variables_0 (make-hasheq))) + (let ((add-extra-variables_0 + (|#%name| + add-extra-variables + (lambda (l_1) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_1) - (begin - (if (pair? lst_1) - (let ((e_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (make-expr-defn e_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null lst_0)))))))))) - (make-set-variables_0 - (|#%name| - make-set-variables - (lambda (accum-ids_0 exports_0 knowns_0 mutated_0 target_0) - (begin - (if (let ((or-part_0 (eq? target_0 'cify))) - (if or-part_0 or-part_0 (eq? target_0 'interp))) - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (if (hash-ref - exports_0 - (unwrap id_0) - #f) - (let ((fold-var_1 - (cons - (make-set-variable - id_0 - exports_0 - knowns_0 - mutated_0) - fold-var_0))) - (values fold-var_1)) - fold-var_0))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null accum-ids_0)))) - (loop_1 exports_0 knowns_0 mutated_0 accum-ids_0 null)))))) - (values-loop_0 - (|#%name| - values-loop - (lambda (accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - ids_0 - rhss_0 - accum-exprs_1 - accum-ids_1 - knowns_1) - (begin - (if (null? ids_0) - (loop_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - (cdr l_0) - mut-l_0 - accum-exprs_1 - accum-ids_1 - knowns_1) - (let ((id_0 (car ids_0))) - (let ((rhs_0 (car rhss_0))) - (let ((temp59_0 (list id_0))) - (let ((temp63_0 (list 'define id_0 rhs_0))) - (let ((temp64_0 - (lambda (accum-exprs_2 accum-ids_2 knowns_2) - (let ((app_0 (cdr ids_0))) - (values-loop_0 - accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - app_0 - (cdr rhss_0) - accum-exprs_2 - accum-ids_2 - knowns_2))))) - (finish-definition_0 - accum-exprs_0 - accum-ids_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - knowns_0 - l_0 - mut-l_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - schemified_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - knowns_1 - temp64_0 - temp63_0 - temp59_0 - accum-exprs_1 - accum-ids_1)))))))))))) - (lambda (l_0 - prim-knowns_0 - primitives_0 - imports_0 - exports_0 - serializable?-box_0 - datum-intern?_0 - allow-set!-undefined?_0 - add-import!_0 - target_0 - unsafe-mode?_0 - enforce-constant?_0 - allow-inline?_0 - no-prompt?_0 - explicit-unnamed?_0) - (let ((simples_0 (make-hasheq))) - (let ((mutated_0 - (mutated-in-body - l_0 - exports_0 - prim-knowns_0 - (hasheq) - imports_0 - simples_0 - unsafe-mode?_0 - target_0 - enforce-constant?_0))) - (let ((knowns_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (knowns_0 lst_0) - (begin - (if (pair? lst_0) - (let ((form_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((knowns_1 - (let ((knowns_1 - (call-with-values - (lambda () - (find-definitions.1 - #t - primitives_0 - form_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0 - unsafe-mode?_0 - target_0)) - (case-lambda - ((new-knowns_0 info_0) - new-knowns_0) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values knowns_1)))) - (for-loop_0 knowns_1 rest_0)))) - knowns_0)))))) - (for-loop_0 (hasheq) l_0))))) - (let ((extra-variables_0 (make-hasheq))) - (let ((final-knowns_0 (box knowns_0))) + (append + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + extra-variables_0 + i_0)) + (case-lambda + ((int-id_0 ex_0) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (list* + 'define + (export-id ex_0) + '((make-internal-variable + 'int-id))) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 + fold-var_1 + (hash-iterate-next + extra-variables_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + fold-var_0)))))) + (for-loop_0 + null + (hash-iterate-first extra-variables_0))))) + l_1)))))) + (let ((final-knowns_0 knowns_0)) (let ((schemified_0 - (loop_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - extra-variables_0 - final-knowns_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - l_0 - l_0 - null - null - knowns_0))) - (let ((app_0 - (add-extra-variables_0 - extra-variables_0 - schemified_0))) - (values - app_0 - (unsafe-unbox* final-knowns_0) - mutated_0))))))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1 + in-mut-l_0 + accum-exprs_0 + accum-ids_0 + knowns_1) + (begin + (let ((mut-l_0 + (update-mutated-state! + l_1 + in-mut-l_0 + mutated_0))) + (let ((make-set-variables_0 + (|#%name| + make-set-variables + (lambda () + (begin + (if (let ((or-part_0 + (eq? target_0 'cify))) + (if or-part_0 + or-part_0 + (eq? target_0 'interp))) + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? lst_0) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (if (hash-ref + exports_0 + (unwrap + id_0) + #f) + (let ((fold-var_1 + (cons + (make-set-variable + id_0 + exports_0 + knowns_1 + mutated_0) + fold-var_0))) + (values + fold-var_1)) + fold-var_0))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + accum-ids_0)))) + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (accum-ids_1 + consistent-ids_0) + (begin + (if (null? accum-ids_1) + (make-set-consistent-variables + consistent-ids_0 + exports_0 + knowns_1 + mutated_0) + (let ((id_0 + (car + accum-ids_1))) + (let ((u-id_0 + (unwrap + id_0))) + (if (hash-ref + exports_0 + u-id_0 + #f) + (if (eq? + 'consistent + (variable-constance + u-id_0 + knowns_1 + mutated_0)) + (loop_1 + (cdr + accum-ids_1) + (cons + id_0 + consistent-ids_0)) + (let ((app_0 + (make-set-consistent-variables + consistent-ids_0 + exports_0 + knowns_1 + mutated_0))) + (append + app_0 + (let ((app_1 + (make-set-variable + id_0 + exports_0 + knowns_1 + mutated_0))) + (cons + app_1 + (loop_1 + (cdr + accum-ids_1) + '())))))) + (loop_1 + (cdr + accum-ids_1) + consistent-ids_0)))))))))) + (loop_1 + accum-ids_0 + null)))))))) + (let ((make-expr-defns_0 + (|#%name| + make-expr-defns + (lambda (es_0) + (begin + (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))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1) + (begin + (if (pair? lst_1) + (let ((e_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (make-expr-defn + e_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + lst_0))))))))))) + (if (null? l_1) + (begin + (set! final-knowns_0 knowns_1) + (let ((set-vars_0 + (make-set-variables_0))) + (if (null? set-vars_0) + (if (null? accum-exprs_0) + '((void)) + (reverse$1 accum-exprs_0)) + (reverse$1 + (append + set-vars_0 + accum-exprs_0))))) + (let ((form_0 (car l_1))) + (let ((schemified_0 + (schemify + form_0 + prim-knowns_0 + primitives_0 + knowns_1 + mutated_0 + imports_0 + exports_0 + simples_0 + allow-set!-undefined?_0 + add-import!_0 + serializable?-box_0 + datum-intern?_0 + target_0 + unsafe-mode?_0 + allow-inline?_0 + no-prompt?_0 + explicit-unnamed?_0 + (if (if no-prompt?_0 + (null? (cdr l_1)) + #f) + 'tail + 'fresh)))) + (let ((finish-definition_0 + (|#%name| + finish-definition + (lambda (knowns16_0 + next-k18_0 + schemified17_0 + ids24_0 + accum-exprs22_0 + accum-ids23_0) + (begin + (let ((accum-exprs_1 + (if (eq? + accum-exprs22_0 + unsafe-undefined) + accum-exprs_0 + accum-exprs22_0))) + (let ((accum-ids_1 + (if (eq? + accum-ids23_0 + unsafe-undefined) + accum-ids_0 + accum-ids23_0))) + (let ((knowns_2 + (if (eq? + knowns16_0 + unsafe-undefined) + knowns_1 + knowns16_0))) + (let ((schemified_1 + (if (eq? + schemified17_0 + unsafe-undefined) + schemified_0 + schemified17_0))) + (let ((next-knowns_0 + (if (if (pair? + ids24_0) + (if (null? + (cdr + ids24_0)) + (can-improve-infer-known? + (hash-ref + knowns_2 + (unwrap + (car + ids24_0)) + #f)) + #f) + #f) + (let ((id_0 + (car + ids24_0))) + (let ((k_0 + (let ((hd_0 + (let ((p_0 + (unwrap + schemified_1))) + (if (pair? + p_0) + (unwrap + (car + p_0)) + #f)))) + (if (if (eq? + 'define + hd_0) + (let ((a_0 + (cdr + (unwrap + schemified_1)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + schemified_1)))) + (let ((p_0 + (unwrap + d_0))) + (let ((id_1 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_2 + id_1)) + (values + id_2 + rhs_0))))))) + (case-lambda + ((id_1 + rhs_0) + (infer-known.1 + #f + #t + hash2610 + rhs_0 + #f + id_1 + knowns_2 + prim-knowns_0 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0 + target_0)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (error + 'match + "failed ~e" + schemified_1))))) + (if k_0 + (hash-set + knowns_2 + (unwrap + id_0) + k_0) + knowns_2))) + knowns_2))) + (let ((app_0 + (make-expr-defns_0 + accum-exprs_1))) + (append + app_0 + (cons + schemified_1 + (letrec* + ((id-loop_0 + (|#%name| + id-loop + (lambda (ids_0 + accum-exprs_2 + accum-ids_2) + (begin + (if (null? + ids_0) + (if next-k18_0 + (|#%app| + next-k18_0 + accum-exprs_2 + accum-ids_2 + next-knowns_0) + (loop_0 + (cdr + l_1) + mut-l_0 + accum-exprs_2 + accum-ids_2 + next-knowns_0)) + (if (let ((or-part_0 + (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))) + (id-loop_0 + app_1 + (cons + (make-set-variable + id_0 + exports_0 + knowns_2 + mutated_0) + accum-exprs_2) + accum-ids_2)) + (id-loop_0 + (cdr + ids_0) + accum-exprs_2 + accum-ids_2))) + (let ((app_1 + (cdr + ids_0))) + (id-loop_0 + app_1 + accum-exprs_2 + (cons + (car + ids_0) + accum-ids_2)))))))))) + (id-loop_0 + ids24_0 + null + accum-ids_1))))))))))))))) + (let ((finish-wrapped-definition_0 + (|#%name| + finish-wrapped-definition + (lambda (ids_0 rhs_0) + (begin + (let ((app_0 + (make-expr-defns_0 + accum-exprs_0))) + (let ((app_1 + (make-expr-defns_0 + (make-set-variables_0)))) + (append + app_0 + app_1 + (if no-prompt?_0 + (let ((app_2 + (if (if unsafe-mode?_0 + unsafe-mode?_0 + (let ((or-part_0 + (eq? + target_0 + 'system))) + (if or-part_0 + or-part_0 + (if (pair? + ids_0) + (null? + (cdr + ids_0)) + #f)))) + schemified_0 + (list + 'define-values + ids_0 + (list + 'call-with-values + (list + 'lambda + '() + rhs_0) + (list + 'case-lambda + (list + ids_0 + (list* + 'values + ids_0)) + (list + 'vals + (list* + 'raise-definition-result-arity-error + (list + 'quote + ids_0) + '(vals))))))))) + (cons + app_2 + (let ((app_3 + (cdr + l_1))) + (loop_0 + app_3 + mut-l_0 + null + (reverse$1 + ids_0) + knowns_1)))) + (let ((expr_0 + (let ((app_2 + (list + 'quote + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (variable-constance + (unwrap + id_0) + knowns_1 + mutated_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + ids_0))))))) + (list* + 'call-with-module-prompt + (list + 'lambda + '() + rhs_0) + (list + 'quote + ids_0) + app_2 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (id-to-variable + (unwrap + id_0) + exports_0 + knowns_1 + mutated_0 + extra-variables_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + ids_0)))))))) + (let ((defns_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (make-define-variable + id_0 + exports_0 + knowns_1 + mutated_0 + extra-variables_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + ids_0)))))) + (let ((app_2 + (if (eq? + target_0 + 'interp) + expr_0 + (make-expr-defn + expr_0)))) + (cons + app_2 + (append + defns_0 + (loop_0 + (cdr + l_1) + mut-l_0 + null + null + knowns_1))))))))))))))) + (let ((hd_0 + (let ((p_0 + (unwrap + schemified_0))) + (if (pair? p_0) + (unwrap (car p_0)) + #f)))) + (if (if (eq? 'define hd_0) + (let ((a_0 + (cdr + (unwrap + schemified_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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + schemified_0)))) + (let ((p_0 + (unwrap d_0))) + (let ((id_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_1 + id_0)) + (values + id_1 + rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (if (simple?.1 + #f + 1 + rhs_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0) + (let ((temp44_0 + (list id_0))) + (finish-definition_0 + unsafe-undefined + #f + unsafe-undefined + temp44_0 + unsafe-undefined + unsafe-undefined)) + (finish-wrapped-definition_0 + (list id_0) + rhs_0))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'define-values + hd_0) + (let ((a_0 + (cdr + (unwrap + schemified_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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + schemified_0)))) + (let ((p_0 + (unwrap d_0))) + (let ((ids_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((ids_1 + ids_0)) + (values + ids_1 + rhs_0))))))) + (case-lambda + ((ids_0 rhs_0) + (if (let ((temp52_0 + (length + ids_0))) + (simple?.1 + #f + temp52_0 + rhs_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0)) + (let ((hd_1 + (let ((p_0 + (unwrap + rhs_0))) + (if (pair? + p_0) + (unwrap + (car + p_0)) + #f)))) + (if (if (eq? + 'values + hd_1) + (let ((a_0 + (cdr + (unwrap + rhs_0)))) + (wrap-list? + a_0)) + #f) + (let ((rhss_0 + (let ((d_0 + (cdr + (unwrap + rhs_0)))) + (unwrap-list + d_0)))) + (if (if (let ((app_0 + (length + rhss_0))) + (= + app_0 + (length + ids_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((rhs_1 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((result_1 + (let ((result_1 + (simple?.1 + #t + 1 + rhs_1 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + rhs_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1)))) + result_0)))))) + (for-loop_0 + #t + rhss_0))) + #f) + (letrec* + ((values-loop_0 + (|#%name| + values-loop + (lambda (ids_1 + rhss_1 + accum-exprs_1 + accum-ids_1 + knowns_2) + (begin + (if (null? + ids_1) + (loop_0 + (cdr + l_1) + mut-l_0 + accum-exprs_1 + accum-ids_1 + knowns_2) + (let ((id_0 + (car + ids_1))) + (let ((rhs_1 + (car + rhss_1))) + (let ((temp59_0 + (list + id_0))) + (let ((temp63_0 + (list + 'define + id_0 + rhs_1))) + (let ((temp64_0 + (lambda (accum-exprs_2 + accum-ids_2 + knowns_3) + (let ((app_0 + (cdr + ids_1))) + (values-loop_0 + app_0 + (cdr + rhss_1) + accum-exprs_2 + accum-ids_2 + knowns_3))))) + (finish-definition_0 + knowns_2 + temp64_0 + temp63_0 + temp59_0 + accum-exprs_1 + accum-ids_1)))))))))))) + (values-loop_0 + ids_0 + rhss_0 + accum-exprs_0 + accum-ids_0 + knowns_1)) + (finish-definition_0 + unsafe-undefined + #f + unsafe-undefined + ids_0 + unsafe-undefined + unsafe-undefined))) + (finish-definition_0 + unsafe-undefined + #f + unsafe-undefined + ids_0 + unsafe-undefined + unsafe-undefined))) + (finish-wrapped-definition_0 + ids_0 + rhs_0))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (if (eq? + 'quote + hd_0) + (let ((a_0 + (cdr + (unwrap + schemified_0)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + (let ((or-part_0 + (pair? + (cdr l_1)))) + (if or-part_0 + or-part_0 + (pair? + accum-ids_0))) + #f) + (loop_0 + (cdr l_1) + mut-l_0 + accum-exprs_0 + accum-ids_0 + knowns_1) + (let ((hd_1 + (let ((p_0 + (unwrap + form_0))) + (if (pair? p_0) + (unwrap + (car p_0)) + #f)))) + (if (if (eq? + 'define-values + hd_1) + (let ((a_0 + (cdr + (unwrap + form_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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (let ((ids_0 + (let ((d_0 + (cdr + (unwrap + form_0)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (let ((set-vars_0 + (make-set-variables_0))) + (let ((temp68_0 + (append + set-vars_0 + accum-exprs_0))) + (finish-definition_0 + unsafe-undefined + #f + unsafe-undefined + ids_0 + temp68_0 + null)))) + (if (simple?.1 + #f + #f + schemified_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0) + (loop_0 + (cdr l_1) + mut-l_0 + (cons + schemified_0 + accum-exprs_0) + accum-ids_0 + knowns_1) + (let ((set-vars_0 + (make-set-variables_0))) + (let ((expr_0 + (if no-prompt?_0 + schemified_0 + (list + 'call-with-module-prompt + (list + 'lambda + '() + schemified_0))))) + (let ((app_0 + (cdr + l_1))) + (loop_0 + app_0 + mut-l_0 + (cons + expr_0 + (append + set-vars_0 + accum-exprs_0)) + null + knowns_1)))))))))))))))))))))))) + (loop_0 l_0 l_0 null null knowns_0)))) + (let ((app_0 (add-extra-variables_0 schemified_0))) + (values app_0 final-knowns_0 mutated_0))))))))))) (define make-set-variable (let ((make-set-variable_0 (|#%name| @@ -24383,952 +23704,212 @@ 'consistent 'constant)))) (define schemify - (letrec ((inline-field-access_0 - (|#%name| - inline-field-access - (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 (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 - (let ((tmp_0 - (maybe-tmp_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - (car args_0) - 'v))) - (let ((sel_0 - (if unsafe-mode?_0 - (list - '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 - (|#%name| - inline-field-mutate - (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 (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))) - (if type-id_0 - (let ((tmp_0 - (maybe-tmp_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - (car args_0) - 'v))) - (let ((tmp-rhs_0 - (maybe-tmp_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - (cadr args_0) - 'rhs))) - (let ((mut_0 - (if unsafe-mode?_0 - (list - '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 - app_0 - (wrap-tmp_0 tmp-rhs_0 (cadr args_0) mut_0)))))) - #f)))))) - (inline-rator_0 - (|#%name| - inline-rator - (lambda (add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - exps_0 - imports_0 - inline-fuel_0 - knowns_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - rator_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - wcm-state_0) - (begin - (let ((u-rator_0 (unwrap rator_0))) - (if allow-inline?_0 - (if (symbol? u-rator_0) - (call-with-values - (lambda () - (find-known+import - u-rator_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0)) - (case-lambda - ((k_0 im_0) - (if (known-procedure/can-inline? k_0) - (let ((app_0 - (inline-clone - k_0 - im_0 - add-import!_0 - mutated_0 - imports_0))) - (left-left-lambda-convert_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - exps_0 - imports_0 - knowns_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - wcm-state_0 - app_0 - (sub1 inline-fuel_0))) - #f)) - (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) - #f - target_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - #f)))))) - (inline-struct-predicate_0 - (|#%name| - inline-struct-predicate - (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 (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))) - (if type-id_0 - (let ((tmp_0 - (maybe-tmp_0 - imports_0 - knowns_0 - mutated_0 - prim-knowns_0 - (car args_0) - 'v))) - (let ((ques_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)))) - (wrap-tmp_0 tmp_0 (car args_0) ques_0))) - #f)))))) - (left-left-lambda-convert_0 - (|#%name| - left-left-lambda-convert - (lambda (add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - exps_0 - imports_0 - knowns_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - wcm-state_0 - rator_0 - inline-fuel_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap rator_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap rator_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) (wrap-list? a_1)) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap rator_0)))) - (let ((p_0 (unwrap d_0))) - (let ((formal-args_0 (let ((a_0 (car p_0))) a_0))) - (let ((bodys_0 - (let ((d_1 (cdr p_0))) - (unwrap-list d_1)))) - (let ((formal-args_1 formal-args_0)) - (values formal-args_1 bodys_0))))))) - (case-lambda - ((formal-args_0 bodys_0) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (formal-args_1 args_0 binds_0) - (begin - (if (null? formal-args_1) - (if (null? args_0) - (schemify/knowns_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - knowns_0 - inline-fuel_0 - wcm-state_0 - (list* - 'let-values - (reverse$1 binds_0) - bodys_0)) + (lambda (v_0 + prim-knowns_0 + primitives_0 + knowns_0 + mutated_0 + imports_0 + exports_0 + simples_0 + allow-set!-undefined?_0 + add-import!_0 + serializable?-box_0 + datum-intern?_0 + target_0 + unsafe-mode?_0 + allow-inline?_0 + no-prompt?_0 + explicit-unnamed?_0 + wcm-state_0) + (letrec* + ((schemify/knowns_0 + (|#%name| + schemify/knowns + (lambda (knowns_1 inline-fuel_0 wcm-state_1 v_1) + (begin + (letrec* + ((schemify_0 + (|#%name| + schemify + (lambda (v_2 wcm-state_2) + (begin + (let ((s-v_0 + (reannotate + v_2 + (let ((hd_0 + (let ((p_0 (unwrap v_2))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap v_2)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (wrap-list? a_1)) + #f))) #f) - (if (null? args_0) - #f - (if (not (pair? formal-args_1)) - (loop_0 - '() - '() - (cons - (list - (list formal-args_1) - (if (null? args_0) - ''() - (cons 'list args_0))) - binds_0)) - (let ((app_0 (cdr formal-args_1))) - (let ((app_1 (cdr args_0))) - (loop_0 - app_0 - app_1 - (cons - (let ((app_2 - (list (car formal-args_1)))) - (list app_2 (car args_0))) - binds_0)))))))))))) - (loop_0 formal-args_0 exps_0 '()))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap rator_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (let ((p_1 (unwrap a_1))) - (if (pair? p_1) - (let ((a_2 (cdr p_1))) - (wrap-list? a_2)) - #f))) - #t - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap rator_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (let ((p_1 (unwrap a_0))) - (let ((formal-args_0 - (let ((a_1 (car p_1))) a_1))) - (let ((bodys_0 - (let ((d_1 (cdr p_1))) - (unwrap-list d_1)))) - (let ((formal-args_1 formal-args_0)) - (values formal-args_1 bodys_0))))))) - (case-lambda - ((formal-args_0 bodys_0) - (let ((rest_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((formal-args_1 formal-args_0) - (bodys_1 bodys_0)) - (values formal-args_1 bodys_1 rest_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((formal-args_0 bodys_0 rest_0) - (let ((or-part_0 - (left-left-lambda-convert_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - exps_0 - imports_0 - knowns_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - wcm-state_0 - (list* 'lambda formal-args_0 bodys_0) - inline-fuel_0))) - (if or-part_0 - or-part_0 - (left-left-lambda-convert_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - exps_0 - imports_0 - knowns_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - wcm-state_0 - (list* 'case-lambda rest_0) - inline-fuel_0)))) - (args (raise-binding-result-arity-error 3 args)))) - #f))))))) - (maybe-tmp_0 - (|#%name| - maybe-tmp - (lambda (imports_0 knowns_0 mutated_0 prim-knowns_0 e_0 name_0) - (begin - (if (simple/can-copy? - e_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0) - e_0 - (deterministic-gensym name_0)))))) - (merely-a-copy?_0 - (|#%name| - merely-a-copy? - (lambda (mutated_0 new-knowns_0 id_0) - (begin - (let ((u-id_0 (unwrap id_0))) - (let ((k_0 (hash-ref new-knowns_0 u-id_0 #f))) - (if (let ((or-part_0 (known-copy? k_0))) - (if or-part_0 or-part_0 (known-literal? k_0))) - (simple-mutated-state? (hash-ref mutated_0 u-id_0 #f)) - #f))))))) - (schemify-body_0 - (|#%name| - schemify-body - (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 - l_0 - wcm-state_0) - (begin - (if (null? l_0) - null - (if (null? (cdr l_0)) - (list - (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 - (car l_0) - wcm-state_0)) - (let ((app_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 - (car l_0) - 'fresh))) - (cons - app_0 - (schemify-body_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 - (cdr l_0) - wcm-state_0))))))))) - (schemify/knowns_0 - (|#%name| - schemify/knowns - (lambda (add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - knowns_0 - inline-fuel_0 - wcm-state_0 - v_0) - (begin - (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 - v_0 - wcm-state_0))))) - (schemify_0 - (|#%name| - schemify - (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 - v_0 - wcm-state_0) - (begin - (let ((s-v_0 - (reannotate - v_0 - (let ((hd_0 - (let ((p_0 (unwrap v_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) (wrap-list? a_1)) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((formals_0 - (let ((a_0 (car p_0))) a_0))) - (let ((body_0 - (let ((d_1 (cdr p_0))) - (unwrap-list d_1)))) - (let ((formals_1 formals_0)) - (values formals_1 body_0))))))) - (case-lambda - ((formals_0 body_0) - (infer-procedure-name - v_0 - (list* - 'lambda - formals_0 - (schemify-body_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 - body_0 - 'tail)) - explicit-unnamed?_0)) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_2))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (wrap-list? - a_1)) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_2))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_0))) - #f)) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (formalss_0 bodys_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (call-with-values - (lambda () + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_2)))) + (let ((p_0 (unwrap d_0))) + (let ((formals_0 + (let ((a_0 (car p_0))) a_0))) + (let ((body_0 + (let ((d_1 (cdr p_0))) + (unwrap-list d_1)))) + (let ((formals_1 formals_0)) + (values formals_1 body_0))))))) + (case-lambda + ((formals_0 body_0) + (infer-procedure-name + v_2 + (list* + 'lambda + formals_0 + (schemify-body_0 body_0 'tail)) + explicit-unnamed?_0)) + (args + (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'case-lambda hd_0) + (let ((a_0 (cdr (unwrap v_2)))) + (if (wrap-list? a_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap lst_0)))) + (let ((v_3 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_4 v_3)) + (let ((result_1 + (let ((result_1 + (let ((p_0 + (unwrap + v_4))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_4))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_0))) + #f)) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_2)))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (formalss_0 + bodys_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap lst_0)))) + (let ((v_3 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_4 v_3)) (call-with-values (lambda () (call-with-values (lambda () - (let ((p_0 - (unwrap - v_2))) - (let ((formalss_1 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((bodys_1 - (let ((d_1 - (cdr - p_0))) - (unwrap-list - d_1)))) - (let ((formalss_2 - formalss_1)) - (values - formalss_2 - bodys_1)))))) + (call-with-values + (lambda () + (let ((p_0 + (unwrap + v_4))) + (let ((formalss_1 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((bodys_1 + (let ((d_1 + (cdr + p_0))) + (unwrap-list + d_1)))) + (let ((formalss_2 + formalss_1)) + (values + formalss_2 + bodys_1)))))) + (case-lambda + ((formalss78_0 + bodys79_0) + (values + (cons + formalss78_0 + formalss_0) + (cons + bodys79_0 + bodys_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) (case-lambda - ((formalss78_0 - bodys79_0) + ((formalss_1 + bodys_1) (values - (cons - formalss78_0 - formalss_0) - (cons - bodys79_0 - bodys_0))) + formalss_1 + bodys_1)) (args (raise-binding-result-arity-error 2 @@ -25336,823 +23917,328 @@ (case-lambda ((formalss_1 bodys_1) - (values + (for-loop_0 formalss_1 - bodys_1)) + bodys_1 + rest_0)) (args (raise-binding-result-arity-error 2 - args))))) - (case-lambda - ((formalss_1 - bodys_1) - (for-loop_0 - formalss_1 - bodys_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - formalss_0 - bodys_0))))))) - (for-loop_0 null null d_0)))) - (case-lambda - ((formalss_0 bodys_0) - (let ((app_0 (reverse$1 formalss_0))) - (values app_0 (reverse$1 bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((formalss_0 bodys_0) - (infer-procedure-name - v_0 - (list* - 'case-lambda - (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 ((formals_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((body_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (list* - formals_0 - (schemify-body_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 - body_0 - 'tail)) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 - null - formalss_0 - bodys_0))))) - explicit-unnamed?_0)) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (if (eq? 'define-values hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car 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))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (let ((a_4 - (cdr - p_3))) - (wrap-list? - a_4)) - #f))) - #f))) - #f))) - (let ((a_1 (cdr p_0))) - (let ((p_1 (unwrap a_1))) - (if (pair? p_1) - (if (let ((a_2 - (car p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? p_2) - (if (let ((a_3 - (car - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - 'let-values))) - (eq? - app_0 - (unwrap - a_3))))) - (let ((a_3 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (if (let ((a_4 - (car - p_3))) - (let ((p_4 - (unwrap - a_4))) - (if (pair? - p_4) - (if (let ((a_5 - (car - p_4))) - (let ((p_5 - (unwrap - a_5))) - (if (pair? - p_5) - (if (let ((a_6 - (car - p_5))) - (let ((p_6 - (unwrap - a_6))) - (if (pair? - p_6) - (let ((a_7 - (cdr - p_6))) - (let ((p_7 - (unwrap - a_7))) - (if (pair? - p_7) - (let ((a_8 - (cdr - p_7))) - (let ((p_8 - (unwrap - a_8))) - (if (pair? - p_8) - (let ((a_9 - (cdr - p_8))) - (let ((p_9 - (unwrap - a_9))) - (if (pair? - p_9) - (let ((a_10 - (cdr - p_9))) - (let ((p_10 - (unwrap - a_10))) - (if (pair? - p_10) - (let ((a_11 - (cdr - p_10))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_11))))) - #f))) - #f))) - #f))) - #f))) - #f))) - (let ((a_6 - (cdr - p_5))) - (let ((p_6 - (unwrap - a_6))) - (if (pair? - p_6) - (let ((a_7 - (cdr - p_6))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_7))))) - #f))) - #f) - #f))) - (let ((a_5 - (cdr - p_4))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f) - #f))) - (let ((a_4 - (cdr - p_3))) - (let ((p_4 - (unwrap - a_4))) - (if (pair? - p_4) - (if (let ((a_5 - (car - p_4))) - (let ((p_5 - (unwrap - a_5))) - (if (pair? - p_5) - (if (let ((a_6 - (car - p_5))) - (begin-unsafe - (let ((app_0 - (unwrap - 'values))) - (eq? - app_0 - (unwrap - a_6))))) - (let ((a_6 - (cdr - p_5))) - (let ((p_6 - (unwrap - a_6))) - (if (pair? - p_6) - (let ((a_7 - (cdr - p_6))) - (let ((p_7 - (unwrap - a_7))) - (if (pair? - p_7) - (let ((a_8 - (cdr - p_7))) - (let ((p_8 - (unwrap - a_8))) - (if (pair? - p_8) - (let ((a_9 - (cdr - p_8))) - (wrap-list? - a_9)) - #f))) - #f))) - #f))) - #f) - #f))) - (let ((a_5 - (cdr - p_4))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f) - #f))) - #f) - #f))) - #f) - #f))) - (let ((a_2 (cdr p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap a_2))))) - #f) - #f))) - #f) - #f))) - #f) - (not - (let ((or-part_0 (eq? target_0 'interp))) - (if or-part_0 - or-part_0 - (eq? target_0 'cify)))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (let ((p_1 (unwrap a_0))) - (let ((struct:s_0 - (let ((a_1 (car p_1))) - a_1))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_1))) - (let ((p_2 (unwrap d_1))) - (let ((make-s_0 - (let ((a_1 - (car - p_2))) - a_1))) - (call-with-values - (lambda () - (let ((d_2 - (cdr p_2))) - (let ((p_3 - (unwrap - d_2))) - (let ((s?_0 - (let ((a_1 - (car - p_3))) - a_1))) - (let ((acc/muts_0 - (let ((d_3 - (cdr - p_3))) - (unwrap-list - d_3)))) - (let ((s?_1 - s?_0)) - (values - s?_1 - acc/muts_0))))))) - (case-lambda - ((s?_0 acc/muts_0) - (let ((make-s_1 - make-s_0)) - (values - make-s_1 - s?_0 - acc/muts_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((make-s_0 s?_0 acc/muts_0) - (let ((struct:s_1 - struct:s_0)) + args))))))) (values - struct:s_1 - make-s_0 - s?_0 - acc/muts_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (case-lambda - ((struct:s_0 - make-s_0 - s?_0 - acc/muts_0) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((a_0 (car (unwrap d_1)))) - (let ((d_2 - (cdr (unwrap a_0)))) - (let ((p_1 (unwrap d_2))) - (call-with-values - (lambda () - (let ((a_1 (car p_1))) - (let ((a_2 - (car - (unwrap - a_1)))) - (let ((p_2 - (unwrap - a_2))) - (call-with-values - (lambda () + formalss_0 + bodys_0))))))) + (for-loop_0 null null d_0)))) + (case-lambda + ((formalss_0 bodys_0) + (let ((app_0 (reverse$1 formalss_0))) + (values + app_0 + (reverse$1 bodys_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((formalss_0 bodys_0) + (infer-procedure-name + v_2 + (list* + 'case-lambda + (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 ((formals_0 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((body_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (list* + formals_0 + (schemify-body_0 + body_0 + 'tail)) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 + null + formalss_0 + bodys_0))))) + explicit-unnamed?_0)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (if (eq? 'define-values hd_0) + (let ((a_0 (cdr (unwrap v_2)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car 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 - (car + (cdr p_2))) (let ((p_3 (unwrap a_3))) - (let ((struct:_0 - (let ((a_4 - (car - p_3))) - a_4))) - (call-with-values - (lambda () - (let ((d_3 - (cdr - p_3))) - (let ((p_4 - (unwrap - d_3))) - (let ((make_0 - (let ((a_4 - (car - p_4))) - a_4))) - (call-with-values - (lambda () - (let ((d_4 - (cdr - p_4))) - (let ((p_5 - (unwrap - d_4))) - (let ((?1_0 - (let ((a_4 - (car - p_5))) - a_4))) - (call-with-values - (lambda () - (let ((d_5 - (cdr - p_5))) - (let ((p_6 - (unwrap - d_5))) - (let ((-ref_0 - (let ((a_4 - (car - p_6))) - a_4))) - (let ((-set!_0 - (let ((d_6 + (if (pair? + p_3) + (let ((a_4 + (cdr + p_3))) + (wrap-list? + a_4)) + #f))) + #f))) + #f))) + (let ((a_1 (cdr p_0))) + (let ((p_1 (unwrap a_1))) + (if (pair? p_1) + (if (let ((a_2 + (car + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + 'let-values))) + (eq? + app_0 + (unwrap + a_3))))) + (let ((a_3 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? + p_3) + (if (let ((a_4 + (car + p_3))) + (let ((p_4 + (unwrap + a_4))) + (if (pair? + p_4) + (if (let ((a_5 + (car + p_4))) + (let ((p_5 + (unwrap + a_5))) + (if (pair? + p_5) + (if (let ((a_6 + (car + p_5))) + (let ((p_6 + (unwrap + a_6))) + (if (pair? + p_6) + (let ((a_7 (cdr p_6))) - (let ((a_4 - (car - (unwrap - d_6)))) - a_4)))) - (let ((-ref_1 - -ref_0)) - (values - -ref_1 - -set!_0))))))) - (case-lambda - ((-ref_0 - -set!_0) - (let ((?1_1 - ?1_0)) - (values - ?1_1 - -ref_0 - -set!_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((?1_0 - -ref_0 - -set!_0) - (let ((make_1 - make_0)) - (values - make_1 - ?1_0 - -ref_0 - -set!_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (case-lambda - ((make_0 - ?1_0 - -ref_0 - -set!_0) - (let ((struct:_1 - struct:_0)) - (values - struct:_1 - make_0 - ?1_0 - -ref_0 - -set!_0))) - (args - (raise-binding-result-arity-error - 4 - args)))))))) - (case-lambda - ((struct:_0 - make_0 - ?1_0 - -ref_0 - -set!_0) - (let ((mk_0 - (let ((d_3 - (cdr - p_2))) - (let ((a_3 - (car - (unwrap - d_3)))) - a_3)))) - (let ((struct:_1 - struct:_0) - (make_1 - make_0) - (?1_1 - ?1_0) - (-ref_1 - -ref_0) - (-set!_1 - -set!_0)) - (values - struct:_1 - make_1 - ?1_1 - -ref_1 - -set!_1 - mk_0)))) - (args - (raise-binding-result-arity-error - 5 - args)))))))) - (case-lambda - ((struct:_0 - make_0 - ?1_0 - -ref_0 - -set!_0 - mk_0) - (call-with-values - (lambda () - (let ((d_3 - (cdr p_1))) - (let ((a_1 - (car - (unwrap - d_3)))) - (let ((d_4 - (cdr - (unwrap - a_1)))) - (let ((p_2 - (unwrap - d_4))) - (let ((struct:2_0 - (let ((a_2 - (car - p_2))) - a_2))) - (call-with-values - (lambda () - (let ((d_5 - (cdr - p_2))) - (let ((p_3 - (unwrap - d_5))) - (let ((make2_0 - (let ((a_2 - (car - p_3))) - a_2))) - (call-with-values - (lambda () - (let ((d_6 - (cdr - p_3))) - (let ((p_4 - (unwrap - d_6))) - (let ((?2_0 - (let ((a_2 - (car - p_4))) - a_2))) - (let ((make-acc/muts_0 - (let ((d_7 - (cdr - p_4))) - (unwrap-list - d_7)))) - (let ((?2_1 - ?2_0)) - (values - ?2_1 - make-acc/muts_0))))))) - (case-lambda - ((?2_0 - make-acc/muts_0) - (let ((make2_1 - make2_0)) - (values - make2_1 - ?2_0 - make-acc/muts_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((make2_0 - ?2_0 - make-acc/muts_0) - (let ((struct:2_1 - struct:2_0)) - (values - struct:2_1 - make2_0 - ?2_0 - make-acc/muts_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))))))) - (case-lambda - ((struct:2_0 - make2_0 - ?2_0 - make-acc/muts_0) - (let ((struct:_1 - struct:_0) - (make_1 - make_0) - (?1_1 ?1_0) - (-ref_1 - -ref_0) - (-set!_1 - -set!_0) - (mk_1 mk_0)) - (values - struct:_1 - make_1 - ?1_1 - -ref_1 - -set!_1 - mk_1 - struct:2_0 - make2_0 - ?2_0 - make-acc/muts_0))) - (args - (raise-binding-result-arity-error - 4 - args))))) - (args - (raise-binding-result-arity-error - 6 - args))))))))) - (case-lambda - ((struct:_0 - make_0 - ?1_0 - -ref_0 - -set!_0 - mk_0 - struct:2_0 - make2_0 - ?2_0 - make-acc/muts_0) - (let ((struct:s_1 struct:s_0) - (make-s_1 make-s_0) - (s?_1 s?_0) - (acc/muts_1 acc/muts_0)) - (values - struct:s_1 - make-s_1 - s?_1 - acc/muts_1 - struct:_0 - make_0 - ?1_0 - -ref_0 - -set!_0 - mk_0 - struct:2_0 - make2_0 - ?2_0 - make-acc/muts_0))) - (args - (raise-binding-result-arity-error - 10 - args))))) - (args - (raise-binding-result-arity-error - 4 - args))))))) - (case-lambda - ((struct:s_0 - make-s_0 - s?_0 - acc/muts_0 - struct:_0 - make_0 - ?1_0 - -ref_0 - -set!_0 - mk_0 - struct:2_0 - make2_0 - ?2_0 - make-acc/muts_0) - (let ((new-seq_0 - (struct-convert - v_0 - prim-knowns_0 - knowns_0 - imports_0 - exports_0 - mutated_0 - (lambda (v_1 knowns_1) - (schemify/knowns_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - 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 - (if (let ((p_0 (unwrap v_0))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (let ((a_1 (cdr p_1))) - (let ((p_2 - (unwrap a_1))) - (if (pair? p_2) + (let ((p_7 + (unwrap + a_7))) + (if (pair? + p_7) + (let ((a_8 + (cdr + p_7))) + (let ((p_8 + (unwrap + a_8))) + (if (pair? + p_8) + (let ((a_9 + (cdr + p_8))) + (let ((p_9 + (unwrap + a_9))) + (if (pair? + p_9) + (let ((a_10 + (cdr + p_9))) + (let ((p_10 + (unwrap + a_10))) + (if (pair? + p_10) + (let ((a_11 + (cdr + p_10))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_11))))) + #f))) + #f))) + #f))) + #f))) + #f))) + (let ((a_6 + (cdr + p_5))) + (let ((p_6 + (unwrap + a_6))) + (if (pair? + p_6) + (let ((a_7 + (cdr + p_6))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_7))))) + #f))) + #f) + #f))) + (let ((a_5 + (cdr + p_4))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_5))))) + #f) + #f))) + (let ((a_4 + (cdr + p_3))) + (let ((p_4 + (unwrap + a_4))) + (if (pair? + p_4) + (if (let ((a_5 + (car + p_4))) + (let ((p_5 + (unwrap + a_5))) + (if (pair? + p_5) + (if (let ((a_6 + (car + p_5))) + (begin-unsafe + (let ((app_0 + (unwrap + 'values))) + (eq? + app_0 + (unwrap + a_6))))) + (let ((a_6 + (cdr + p_5))) + (let ((p_6 + (unwrap + a_6))) + (if (pair? + p_6) + (let ((a_7 + (cdr + p_6))) + (let ((p_7 + (unwrap + a_7))) + (if (pair? + p_7) + (let ((a_8 + (cdr + p_7))) + (let ((p_8 + (unwrap + a_8))) + (if (pair? + p_8) + (let ((a_9 + (cdr + p_8))) + (wrap-list? + a_9)) + #f))) + #f))) + #f))) + #f) + #f))) + (let ((a_5 + (cdr + p_4))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_5))))) + #f) + #f))) + #f) + #f))) + #f) + #f))) (let ((a_2 - (cdr p_2))) + (cdr p_1))) (begin-unsafe (let ((app_0 (unwrap @@ -26161,336 +24247,864 @@ app_0 (unwrap a_2))))) - #f))) - #f))) - #f)) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((ids_0 - (let ((a_0 (car p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((ids_1 ids_0)) - (values - ids_1 - rhs_0))))))) - (case-lambda - ((ids_0 rhs_0) - (list - 'define-values - ids_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 + #f) + #f))) + #f) + #f))) + #f) + (not + (let ((or-part_0 + (eq? target_0 'interp))) + (if or-part_0 + or-part_0 + (eq? target_0 'cify)))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_2)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (let ((p_1 (unwrap a_0))) + (let ((struct:s_0 + (let ((a_1 (car p_1))) + a_1))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_1))) + (let ((p_2 + (unwrap d_1))) + (let ((make-s_0 + (let ((a_1 + (car + p_2))) + a_1))) + (call-with-values + (lambda () + (let ((d_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + d_2))) + (let ((s?_0 + (let ((a_1 + (car + p_3))) + a_1))) + (let ((acc/muts_0 + (let ((d_3 + (cdr + p_3))) + (unwrap-list + d_3)))) + (let ((s?_1 + s?_0)) + (values + s?_1 + acc/muts_0))))))) + (case-lambda + ((s?_0 + acc/muts_0) + (let ((make-s_1 + make-s_0)) + (values + make-s_1 + s?_0 + acc/muts_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((make-s_0 + s?_0 + acc/muts_0) + (let ((struct:s_1 + struct:s_0)) + (values + struct:s_1 + make-s_0 + s?_0 + acc/muts_0))) + (args + (raise-binding-result-arity-error + 3 + args)))))))) + (case-lambda + ((struct:s_0 + make-s_0 + s?_0 + acc/muts_0) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car (unwrap d_1)))) + (let ((d_2 + (cdr + (unwrap a_0)))) + (let ((p_1 + (unwrap d_2))) + (call-with-values + (lambda () + (let ((a_1 + (car p_1))) + (let ((a_2 + (car + (unwrap + a_1)))) + (let ((p_2 + (unwrap + a_2))) + (call-with-values + (lambda () + (let ((a_3 + (car + p_2))) + (let ((p_3 + (unwrap + a_3))) + (let ((struct:_0 + (let ((a_4 + (car + p_3))) + a_4))) + (call-with-values + (lambda () + (let ((d_3 + (cdr + p_3))) + (let ((p_4 + (unwrap + d_3))) + (let ((make_0 + (let ((a_4 + (car + p_4))) + a_4))) + (call-with-values + (lambda () + (let ((d_4 + (cdr + p_4))) + (let ((p_5 + (unwrap + d_4))) + (let ((?1_0 + (let ((a_4 + (car + p_5))) + a_4))) + (call-with-values + (lambda () + (let ((d_5 + (cdr + p_5))) + (let ((p_6 + (unwrap + d_5))) + (let ((-ref_0 + (let ((a_4 + (car + p_6))) + a_4))) + (let ((-set!_0 + (let ((d_6 + (cdr + p_6))) + (let ((a_4 + (car + (unwrap + d_6)))) + a_4)))) + (let ((-ref_1 + -ref_0)) + (values + -ref_1 + -set!_0))))))) + (case-lambda + ((-ref_0 + -set!_0) + (let ((?1_1 + ?1_0)) + (values + ?1_1 + -ref_0 + -set!_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((?1_0 + -ref_0 + -set!_0) + (let ((make_1 + make_0)) + (values + make_1 + ?1_0 + -ref_0 + -set!_0))) + (args + (raise-binding-result-arity-error + 3 + args)))))))) + (case-lambda + ((make_0 + ?1_0 + -ref_0 + -set!_0) + (let ((struct:_1 + struct:_0)) + (values + struct:_1 + make_0 + ?1_0 + -ref_0 + -set!_0))) + (args + (raise-binding-result-arity-error + 4 + args)))))))) + (case-lambda + ((struct:_0 + make_0 + ?1_0 + -ref_0 + -set!_0) + (let ((mk_0 + (let ((d_3 + (cdr + p_2))) + (let ((a_3 + (car + (unwrap + d_3)))) + a_3)))) + (let ((struct:_1 + struct:_0) + (make_1 + make_0) + (?1_1 + ?1_0) + (-ref_1 + -ref_0) + (-set!_1 + -set!_0)) + (values + struct:_1 + make_1 + ?1_1 + -ref_1 + -set!_1 + mk_0)))) + (args + (raise-binding-result-arity-error + 5 + args)))))))) + (case-lambda + ((struct:_0 + make_0 + ?1_0 + -ref_0 + -set!_0 + mk_0) + (call-with-values + (lambda () + (let ((d_3 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_3)))) + (let ((d_4 + (cdr + (unwrap + a_1)))) + (let ((p_2 + (unwrap + d_4))) + (let ((struct:2_0 + (let ((a_2 + (car + p_2))) + a_2))) + (call-with-values + (lambda () + (let ((d_5 + (cdr + p_2))) + (let ((p_3 + (unwrap + d_5))) + (let ((make2_0 + (let ((a_2 + (car + p_3))) + a_2))) + (call-with-values + (lambda () + (let ((d_6 + (cdr + p_3))) + (let ((p_4 + (unwrap + d_6))) + (let ((?2_0 + (let ((a_2 + (car + p_4))) + a_2))) + (let ((make-acc/muts_0 + (let ((d_7 + (cdr + p_4))) + (unwrap-list + d_7)))) + (let ((?2_1 + ?2_0)) + (values + ?2_1 + make-acc/muts_0))))))) + (case-lambda + ((?2_0 + make-acc/muts_0) + (let ((make2_1 + make2_0)) + (values + make2_1 + ?2_0 + make-acc/muts_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((make2_0 + ?2_0 + make-acc/muts_0) + (let ((struct:2_1 + struct:2_0)) + (values + struct:2_1 + make2_0 + ?2_0 + make-acc/muts_0))) + (args + (raise-binding-result-arity-error + 3 + args)))))))))) + (case-lambda + ((struct:2_0 + make2_0 + ?2_0 + make-acc/muts_0) + (let ((struct:_1 + struct:_0) + (make_1 + make_0) + (?1_1 + ?1_0) + (-ref_1 + -ref_0) + (-set!_1 + -set!_0) + (mk_1 + mk_0)) + (values + struct:_1 + make_1 + ?1_1 + -ref_1 + -set!_1 + mk_1 + struct:2_0 + make2_0 + ?2_0 + make-acc/muts_0))) + (args + (raise-binding-result-arity-error + 4 + args))))) + (args + (raise-binding-result-arity-error + 6 + args))))))))) + (case-lambda + ((struct:_0 + make_0 + ?1_0 + -ref_0 + -set!_0 + mk_0 + struct:2_0 + make2_0 + ?2_0 + make-acc/muts_0) + (let ((struct:s_1 struct:s_0) + (make-s_1 make-s_0) + (s?_1 s?_0) + (acc/muts_1 acc/muts_0)) + (values + struct:s_1 + make-s_1 + s?_1 + acc/muts_1 + struct:_0 + make_0 + ?1_0 + -ref_0 + -set!_0 + mk_0 + struct:2_0 + make2_0 + ?2_0 + make-acc/muts_0))) + (args + (raise-binding-result-arity-error + 10 + args))))) + (args + (raise-binding-result-arity-error + 4 + args))))))) + (case-lambda + ((struct:s_0 + make-s_0 + s?_0 + acc/muts_0 + struct:_0 + make_0 + ?1_0 + -ref_0 + -set!_0 + mk_0 + struct:2_0 + make2_0 + ?2_0 + make-acc/muts_0) + (let ((new-seq_0 + (struct-convert + v_2 prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 + knowns_1 + imports_0 + exports_0 + mutated_0 + (lambda (v_3 knowns_2) + (schemify/knowns_0 + knowns_2 + inline-fuel_0 + 'fresh + v_3)) target_0 - unsafe-mode?_0 - rhs_0 - 'fresh))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (error 'match "failed ~e" v_0))))) - (args - (raise-binding-result-arity-error - 14 - args)))) - (if (if (eq? 'define-values hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (let ((p_1 (unwrap a_1))) - (if (pair? p_1) - (let ((a_2 (cdr p_1))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_2))))) - #f))) - (let ((a_1 (cdr p_0))) - (let ((p_1 (unwrap a_1))) - (if (pair? p_1) - (let ((a_2 (cdr p_1))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_2))))) - #f))) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 - (let ((a_0 (car p_0))) - (let ((a_1 - (car (unwrap a_0)))) - a_1)))) - (let ((rhs_0 - (let ((d_1 (cdr p_0))) - (let ((a_0 - (car - (unwrap d_1)))) - a_0)))) - (let ((id_1 id_0)) - (values id_1 rhs_0))))))) - (case-lambda - ((id_0 rhs_0) - (list - 'define - id_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 - rhs_0 - 'fresh))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? 'define-values hd_0) - (let ((a_0 (cdr (unwrap v_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))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((ids_0 - (let ((a_0 (car p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 (cdr p_0))) + no-prompt?_0))) + (if new-seq_0 + new-seq_0 + (if (let ((p_0 (unwrap v_2))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (let ((a_1 (cdr p_1))) + (let ((p_2 + (unwrap + a_1))) + (if (pair? p_2) + (let ((a_2 + (cdr + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f)) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_2)))) + (let ((p_0 (unwrap d_0))) + (let ((ids_0 + (let ((a_0 + (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((ids_1 ids_0)) + (values + ids_1 + rhs_0))))))) + (case-lambda + ((ids_0 rhs_0) + (list + 'define-values + ids_0 + (schemify_0 rhs_0 'fresh))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (error 'match "failed ~e" v_2))))) + (args + (raise-binding-result-arity-error + 14 + args)))) + (if (if (eq? 'define-values hd_0) + (let ((a_0 (cdr (unwrap v_2)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (let ((p_1 (unwrap a_1))) + (if (pair? p_1) + (let ((a_2 + (cdr p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + (let ((a_1 (cdr p_0))) + (let ((p_1 (unwrap a_1))) + (if (pair? p_1) + (let ((a_2 (cdr p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap a_2))))) + #f))) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_2)))) + (let ((p_0 (unwrap d_0))) + (let ((id_0 + (let ((a_0 (car p_0))) + (let ((a_1 + (car + (unwrap a_0)))) + a_1)))) + (let ((rhs_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car + (unwrap d_1)))) + a_0)))) + (let ((id_1 id_0)) + (values id_1 rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (list + 'define + id_0 + (schemify_0 rhs_0 'fresh))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? 'define-values hd_0) + (let ((a_0 (cdr (unwrap v_2)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_2)))) + (let ((p_0 (unwrap d_0))) + (let ((ids_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((ids_1 ids_0)) + (values ids_1 rhs_0))))))) + (case-lambda + ((ids_0 rhs_0) + (list + 'define-values + ids_0 + (schemify_0 rhs_0 'fresh))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? 'quote hd_0) + (let ((a_0 (cdr (unwrap v_2)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_1))))) + #f))) + #f) + (let ((q_0 + (let ((d_0 + (cdr (unwrap v_2)))) + (let ((a_0 + (car (unwrap d_0)))) + a_0)))) + (begin + (if serializable?-box_0 + (register-literal-serialization + q_0 + serializable?-box_0 + datum-intern?_0) + (void)) + v_2)) + (if (if (eq? 'let-values hd_0) + (let ((a_0 (cdr (unwrap v_2)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + (let ((a_1 (cdr p_0))) + (let ((p_1 + (unwrap a_1))) + (if (pair? p_1) + (let ((a_2 + (cdr + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f) + #f))) + #f) + (let ((body_0 + (let ((d_0 + (cdr (unwrap v_2)))) + (let ((d_1 + (cdr + (unwrap d_0)))) (let ((a_0 (car (unwrap d_1)))) - a_0)))) - (let ((ids_1 ids_0)) - (values ids_1 rhs_0))))))) - (case-lambda - ((ids_0 rhs_0) - (list - 'define-values - ids_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 - rhs_0 - 'fresh))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? 'quote hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? - app_0 - (unwrap a_1))))) - #f))) - #f) - (let ((q_0 - (let ((d_0 (cdr (unwrap v_0)))) - (let ((a_0 (car (unwrap d_0)))) - a_0)))) - (begin - (if serializable?-box_0 - (register-literal-serialization - q_0 - serializable?-box_0 - datum-intern?_0) - (void)) - v_0)) - (if (if (eq? 'let-values hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_1))))) - (let ((a_1 (cdr p_0))) - (let ((p_1 - (unwrap a_1))) - (if (pair? p_1) - (let ((a_2 - (cdr p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f) - #f))) - #f) - (let ((body_0 - (let ((d_0 (cdr (unwrap v_0)))) - (let ((d_1 - (cdr (unwrap d_0)))) + a_0))))) + (schemify_0 body_0 wcm-state_2)) + (if (if (eq? 'let-values hd_0) + (let ((a_0 + (cdr (unwrap v_2)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + (let ((a_1 + (cdr p_0))) + (wrap-list? a_1)) + #f) + #f))) + #f) + (let ((bodys_0 + (let ((d_0 + (cdr + (unwrap v_2)))) + (let ((d_1 + (cdr + (unwrap d_0)))) + (unwrap-list d_1))))) + (schemify_0 + (list* 'begin bodys_0) + wcm-state_2)) + (if (if (eq? 'let-values hd_0) (let ((a_0 - (car (unwrap d_1)))) - a_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 - body_0 - wcm-state_0)) - (if (if (eq? 'let-values hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap a_1))))) - (let ((a_1 (cdr p_0))) - (wrap-list? a_1)) - #f) - #f))) - #f) - (let ((bodys_0 - (let ((d_0 - (cdr (unwrap v_0)))) - (let ((d_1 - (cdr (unwrap d_0)))) - (unwrap-list d_1))))) - (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 - (list* 'begin bodys_0) - wcm-state_0)) - (if (if (eq? 'let-values hd_0) - (let ((a_0 - (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 - (car p_0))) - (if (wrap-list? - a_1) + (cdr (unwrap v_2)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car + p_0))) + (if (wrap-list? + a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_3 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_4 + v_3)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_4))) + (if (pair? + p_1) + (if (let ((a_2 + (car + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (let ((a_3 + (cdr + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_4))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 + #t + a_1))) + #f)) + (let ((a_1 + (cdr p_0))) + (wrap-list? a_1)) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr (unwrap v_2)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 + (car p_0))) + (call-with-values + (lambda () (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (result_0 + (lambda (ids_0 + rhss_0 lst_0) (begin (if (not @@ -26498,7 +25112,7 @@ (null? (unwrap lst_0)))) - (let ((v_1 + (let ((v_3 (if (begin-unsafe (pair? (unwrap @@ -26514,164 +25128,60 @@ (wrap-cdr lst_0) null))) - (let ((v_2 - v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_2))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (let ((a_3 - (cdr - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_2))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 - #t - a_1))) - #f)) - (let ((a_1 (cdr p_0))) - (wrap-list? a_1)) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ids_0 - rhss_0 - lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_2 - v_1)) - (call-with-values - (lambda () + (let ((v_4 + v_3)) (call-with-values (lambda () (call-with-values (lambda () - (let ((p_1 - (unwrap - v_2))) - (let ((ids_1 - (let ((a_1 - (car - p_1))) - (let ((a_2 - (car - (unwrap - a_1)))) - a_2)))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_4))) + (let ((ids_1 + (let ((a_1 + (car + p_1))) + (let ((a_2 + (car + (unwrap + a_1)))) + a_2)))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) + (case-lambda + ((ids80_0 + rhss81_0) + (values + (cons + ids80_0 + ids_0) + (cons + rhss81_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) (case-lambda - ((ids80_0 - rhss81_0) + ((ids_1 + rhss_1) (values - (cons - ids80_0 - ids_0) - (cons - rhss81_0 - rhss_0))) + ids_1 + rhss_1)) (args (raise-binding-result-arity-error 2 @@ -26679,630 +25189,673 @@ (case-lambda ((ids_1 rhss_1) - (values + (for-loop_0 ids_1 - rhss_1)) + rhss_1 + rest_0)) (args (raise-binding-result-arity-error 2 - args))))) - (case-lambda - ((ids_1 - rhss_1) - (for-loop_0 - ids_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - ids_0 - rhss_0))))))) - (for-loop_0 - null - null - a_0)))) - (case-lambda - ((ids_0 rhss_0) - (let ((app_0 - (reverse$1 - ids_0))) - (values - app_0 - (reverse$1 - rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((ids_0 rhss_0) - (let ((bodys_0 - (let ((d_1 - (cdr - p_0))) - (unwrap-list - d_1)))) - (let ((ids_1 ids_0) - (rhss_1 rhss_0)) - (values - ids_1 - rhss_1 - bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((ids_0 rhss_0 bodys_0) - (if (if (pair? ids_0) - (if (null? (cdr ids_0)) - (if (pair? bodys_0) - (if (null? - (cdr bodys_0)) - (if (let ((app_0 - (unwrap - (car - ids_0)))) - (eq? - app_0 - (unwrap - (car - bodys_0)))) - (let ((temp82_0 - (car - rhss_0))) - (lambda?.1 - #f - temp82_0)) - #f) - #f) - #f) - #f) - #f) - (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 - (car rhss_0) - wcm-state_0) - (let ((new-knowns_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (knowns_1 - lst_0 - lst_1) - (begin - (if (if (pair? - lst_0) - (pair? - lst_1) - #f) - (let ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((rhs_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((knowns_2 - (let ((knowns_2 - (let ((k_0 - (infer-known.1 - #f - #f - hash2610 - rhs_0 - #f - id_0 - knowns_1 - prim-knowns_0 - imports_0 - mutated_0 - simples_0 - unsafe-mode?_0 - target_0))) - (if k_0 - (hash-set - knowns_1 - (unwrap - id_0) - k_0) - knowns_1)))) - (values - knowns_2)))) - (for-loop_0 - knowns_2 - rest_0 - rest_1)))))) - knowns_1)))))) - (for-loop_0 - knowns_0 - ids_0 - rhss_0))))) - (unnest-let - (let ((app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (if (merely-a-copy?_0 - mutated_0 - new-knowns_0 - id_0) - fold-var_0 - (let ((fold-var_1 - (cons - id_0 - fold-var_0))) - (values - fold-var_1))))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - ids_0)))))) - (let ((app_1 - (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 ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((rhs_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (if (merely-a-copy?_0 - mutated_0 - new-knowns_0 - id_0) - fold-var_0 - (let ((fold-var_1 - (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 - rhs_0 - 'fresh) - fold-var_0))) - (values - fold-var_1))))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) + args))))))) + (values + ids_0 + rhss_0))))))) (for-loop_0 null - ids_0 - rhss_0)))))) - (left-to-right/let - app_0 - app_1 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((body_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (schemify/knowns_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - new-knowns_0 - inline-fuel_0 - wcm-state_0 - body_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - bodys_0)))) - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0))) - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0)))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? 'let-values hd_0) - (let ((a_0 - (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 - (car p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (if (let ((a_3 - (car - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - (let ((a_3 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (if (let ((a_4 - (car - p_3))) - (let ((p_4 - (unwrap - a_4))) - (if (pair? - p_4) - (if (let ((a_5 - (car - p_4))) - (begin-unsafe - (let ((app_0 - (unwrap - 'begin))) - (eq? - app_0 - (unwrap - a_5))))) - (let ((a_5 - (cdr - p_4))) - (let ((p_5 - (unwrap - a_5))) - (if (pair? - p_5) - (let ((a_6 - (cdr - p_5))) - (let ((p_6 - (unwrap - a_6))) - (if (pair? - p_6) - (if (let ((a_7 - (car - p_6))) - (begin-unsafe - (let ((app_0 - (unwrap - '...))) - (eq? - app_0 - (unwrap - a_7))))) - (let ((a_7 - (cdr - p_6))) - (let ((p_7 - (unwrap - a_7))) - (if (pair? - p_7) - (if (let ((a_8 - (car - p_7))) - (let ((p_8 - (unwrap - a_8))) - (if (pair? - p_8) - (if (let ((a_9 - (car - p_8))) - (begin-unsafe - (let ((app_0 - (unwrap - 'values))) - (eq? - app_0 - (unwrap - a_9))))) - (let ((a_9 - (cdr - p_8))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_9))))) - #f) - #f))) - (let ((a_8 - (cdr - p_7))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_8))))) - #f) - #f))) - #f) - #f))) - #f))) - #f) - #f))) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f) - #f))) - #f) - #f))) - (let ((a_2 - (cdr - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f) - #f))) - (let ((a_1 - (cdr p_0))) - (wrap-list? a_1)) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((rhss_0 - (let ((a_0 - (car p_0))) - (let ((a_1 - (car - (unwrap - a_0)))) + null + a_0)))) + (case-lambda + ((ids_0 rhss_0) + (let ((app_0 + (reverse$1 + ids_0))) + (values + app_0 + (reverse$1 + rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((ids_0 rhss_0) + (let ((bodys_0 (let ((d_1 (cdr + p_0))) + (unwrap-list + d_1)))) + (let ((ids_1 ids_0) + (rhss_1 + rhss_0)) + (values + ids_1 + rhss_1 + bodys_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((ids_0 rhss_0 bodys_0) + (if (if (pair? ids_0) + (if (null? + (cdr ids_0)) + (if (pair? bodys_0) + (if (null? + (cdr + bodys_0)) + (if (let ((app_0 + (unwrap + (car + ids_0)))) + (eq? + app_0 + (unwrap + (car + bodys_0)))) + (let ((temp82_0 + (car + rhss_0))) + (lambda?.1 + #f + temp82_0)) + #f) + #f) + #f) + #f) + #f) + (schemify_0 + (car rhss_0) + wcm-state_2) + (let ((new-knowns_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (knowns_2 + lst_0 + lst_1) + (begin + (if (if (pair? + lst_0) + (pair? + lst_1) + #f) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((rhs_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((knowns_3 + (let ((knowns_3 + (let ((k_0 + (infer-known.1 + #f + #f + hash2610 + rhs_0 + #f + id_0 + knowns_2 + prim-knowns_0 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0 + target_0))) + (if k_0 + (hash-set + knowns_2 + (unwrap + id_0) + k_0) + knowns_2)))) + (values + knowns_3)))) + (for-loop_0 + knowns_3 + rest_0 + rest_1)))))) + knowns_2)))))) + (for-loop_0 + knowns_1 + ids_0 + rhss_0))))) + (let ((merely-a-copy?_0 + (|#%name| + merely-a-copy? + (lambda (id_0) + (begin + (let ((u-id_0 + (unwrap + id_0))) + (let ((k_0 + (hash-ref + new-knowns_0 + u-id_0 + #f))) + (if (let ((or-part_0 + (known-copy? + k_0))) + (if or-part_0 + or-part_0 + (known-literal? + k_0))) + (simple-mutated-state? + (hash-ref + mutated_0 + u-id_0 + #f)) + #f)))))))) + (unnest-let + (let ((app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (if (merely-a-copy?_0 + id_0) + fold-var_0 + (let ((fold-var_1 + (cons + id_0 + fold-var_0))) + (values + fold-var_1))))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + ids_0)))))) + (let ((app_1 + (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 ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((rhs_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (if (merely-a-copy?_0 + id_0) + fold-var_0 + (let ((fold-var_1 + (cons + (schemify_0 + rhs_0 + 'fresh) + fold-var_0))) + (values + fold-var_1))))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 + null + ids_0 + rhss_0)))))) + (left-to-right/let + app_0 + app_1 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((body_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (schemify/knowns_0 + new-knowns_0 + inline-fuel_0 + wcm-state_2 + body_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + bodys_0)))) + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0))) + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0))))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? 'let-values hd_0) + (let ((a_0 + (cdr + (unwrap v_2)))) + (let ((p_0 + (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car + p_0))) + (let ((p_1 (unwrap - a_1)))) - (let ((a_2 - (car - (unwrap - d_1)))) - (let ((d_2 - (cdr - (unwrap - a_2)))) - (let ((a_3 - (car - (unwrap - d_2)))) - a_3)))))))) - (let ((bodys_0 - (let ((d_1 - (cdr - p_0))) - (unwrap-list - d_1)))) - (let ((rhss_1 - rhss_0)) - (values - rhss_1 - bodys_0))))))) - (case-lambda - ((rhss_0 bodys_0) - (list* - 'begin - (let ((app_0 - (schemify-body_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 - rhss_0 - 'fresh))) - (qq-append - app_0 - (schemify-body_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 - bodys_0 - wcm-state_0))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? 'let-values hd_0) - (let ((a_0 + a_1))) + (if (pair? + p_1) + (if (let ((a_2 + (car + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + (let ((a_3 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? + p_3) + (if (let ((a_4 + (car + p_3))) + (let ((p_4 + (unwrap + a_4))) + (if (pair? + p_4) + (if (let ((a_5 + (car + p_4))) + (begin-unsafe + (let ((app_0 + (unwrap + 'begin))) + (eq? + app_0 + (unwrap + a_5))))) + (let ((a_5 + (cdr + p_4))) + (let ((p_5 + (unwrap + a_5))) + (if (pair? + p_5) + (let ((a_6 + (cdr + p_5))) + (let ((p_6 + (unwrap + a_6))) + (if (pair? + p_6) + (if (let ((a_7 + (car + p_6))) + (begin-unsafe + (let ((app_0 + (unwrap + '...))) + (eq? + app_0 + (unwrap + a_7))))) + (let ((a_7 + (cdr + p_6))) + (let ((p_7 + (unwrap + a_7))) + (if (pair? + p_7) + (if (let ((a_8 + (car + p_7))) + (let ((p_8 + (unwrap + a_8))) + (if (pair? + p_8) + (if (let ((a_9 + (car + p_8))) + (begin-unsafe + (let ((app_0 + (unwrap + 'values))) + (eq? + app_0 + (unwrap + a_9))))) + (let ((a_9 + (cdr + p_8))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_9))))) + #f) + #f))) + (let ((a_8 + (cdr + p_7))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_8))))) + #f) + #f))) + #f) + #f))) + #f))) + #f) + #f))) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f) + #f))) + #f) + #f))) + (let ((a_2 + (cdr + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f) + #f))) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr - (unwrap v_0)))) + (unwrap v_2)))) (let ((p_0 - (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 - (car - p_0))) - (if (wrap-list? - a_1) + (unwrap d_0))) + (let ((rhss_0 + (let ((a_0 + (car + p_0))) + (let ((a_1 + (car + (unwrap + a_0)))) + (let ((d_1 + (cdr + (unwrap + a_1)))) + (let ((a_2 + (car + (unwrap + d_1)))) + (let ((d_2 + (cdr + (unwrap + a_2)))) + (let ((a_3 + (car + (unwrap + d_2)))) + a_3)))))))) + (let ((bodys_0 + (let ((d_1 + (cdr + p_0))) + (unwrap-list + d_1)))) + (let ((rhss_1 + rhss_0)) + (values + rhss_1 + bodys_0))))))) + (case-lambda + ((rhss_0 bodys_0) + (list* + 'begin + (let ((app_0 + (schemify-body_0 + rhss_0 + 'fresh))) + (qq-append + app_0 + (schemify-body_0 + bodys_0 + wcm-state_2))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'let-values + hd_0) + (let ((a_0 + (cdr + (unwrap v_2)))) + (let ((p_0 + (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car + p_0))) + (if (wrap-list? + a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_3 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_4 + v_3)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_4))) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_4))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 + #t + a_1))) + #f)) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap v_2)))) + (let ((p_0 + (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 + (car + p_0))) + (call-with-values + (lambda () (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (result_0 + (lambda (idss_0 + rhss_0 lst_0) (begin (if (not @@ -27310,7 +25863,7 @@ (null? (unwrap lst_0)))) - (let ((v_1 + (let ((v_3 (if (begin-unsafe (pair? (unwrap @@ -27326,143 +25879,56 @@ (wrap-cdr lst_0) null))) - (let ((v_2 - v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_2))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_2))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 - #t - a_1))) - #f)) - (let ((a_1 - (cdr p_0))) - (wrap-list? - a_1)) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 - (car p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idss_0 - rhss_0 - lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_2 - v_1)) - (call-with-values - (lambda () + (let ((v_4 + v_3)) (call-with-values (lambda () (call-with-values (lambda () - (let ((p_1 - (unwrap - v_2))) - (let ((idss_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((idss_2 - idss_1)) - (values - idss_2 - rhss_1)))))) + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_4))) + (let ((idss_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((idss_2 + idss_1)) + (values + idss_2 + rhss_1)))))) + (case-lambda + ((idss93_0 + rhss94_0) + (values + (cons + idss93_0 + idss_0) + (cons + rhss94_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) (case-lambda - ((idss93_0 - rhss94_0) + ((idss_1 + rhss_1) (values - (cons - idss93_0 - idss_0) - (cons - rhss94_0 - rhss_0))) + idss_1 + rhss_1)) (args (raise-binding-result-arity-error 2 @@ -27470,666 +25936,689 @@ (case-lambda ((idss_1 rhss_1) - (values + (for-loop_0 idss_1 - rhss_1)) + rhss_1 + rest_0)) (args (raise-binding-result-arity-error 2 - args))))) - (case-lambda - ((idss_1 - rhss_1) - (for-loop_0 - idss_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - idss_0 - rhss_0))))))) - (for-loop_0 - null - null - a_0)))) - (case-lambda - ((idss_0 rhss_0) - (let ((app_0 - (reverse$1 - idss_0))) + args))))))) + (values + idss_0 + rhss_0))))))) + (for-loop_0 + null + null + a_0)))) + (case-lambda + ((idss_0 + rhss_0) + (let ((app_0 + (reverse$1 + idss_0))) + (values + app_0 + (reverse$1 + rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((idss_0 rhss_0) + (let ((bodys_0 + (let ((d_1 + (cdr + p_0))) + (unwrap-list + d_1)))) + (let ((idss_1 + idss_0) + (rhss_1 + rhss_0)) (values - app_0 - (reverse$1 - rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((idss_0 rhss_0) - (let ((bodys_0 - (let ((d_1 - (cdr - p_0))) - (unwrap-list - d_1)))) - (let ((idss_1 - idss_0) - (rhss_1 - rhss_0)) - (values - idss_1 - rhss_1 - bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((idss_0 rhss_0 bodys_0) - (let ((or-part_0 - (if (not - (let ((or-part_0 + idss_1 + rhss_1 + bodys_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((idss_0 rhss_0 bodys_0) + (let ((or-part_0 + (if (not + (let ((or-part_0 + (eq? + target_0 + 'interp))) + (if or-part_0 + or-part_0 (eq? target_0 - 'interp))) - (if or-part_0 - or-part_0 - (eq? - target_0 - 'cify)))) - (let ((temp101_0 - (|#%name| - temp101 - (lambda (v_1 - knowns_1) - (begin - (schemify/knowns_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - knowns_1 - inline-fuel_0 - 'fresh - v_1)))))) - (struct-convert-local.1 - #f - target_0 - unsafe-mode?_0 - v_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0 - temp101_0)) - #f))) - (if or-part_0 - or-part_0 - (unnest-let - (let ((app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((rhs_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (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 - rhs_0 - 'fresh) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - rhss_0)))))) - (left-to-right/let-values - idss_0 - app_0 - (schemify-body_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 - bodys_0 - wcm-state_0) + 'cify)))) + (let ((temp101_0 + (|#%name| + temp101 + (lambda (v_3 + knowns_2) + (begin + (schemify/knowns_0 + knowns_2 + inline-fuel_0 + 'fresh + v_3)))))) + (struct-convert-local.1 + #f + target_0 + unsafe-mode?_0 + v_2 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0 + temp101_0)) + #f))) + (if or-part_0 + or-part_0 + (unnest-let + (let ((app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((rhs_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (schemify_0 + rhs_0 + 'fresh) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + rhss_0)))))) + (left-to-right/let-values + idss_0 + app_0 + (schemify-body_0 + bodys_0 + wcm-state_2) + mutated_0 + target_0)) + prim-knowns_0 + knowns_1 + imports_0 mutated_0 - target_0)) - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0)))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'letrec-values - hd_0) - (let ((a_0 - (cdr - (unwrap v_0)))) - (let ((p_0 - (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 - (car - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - (let ((a_1 - (cdr - p_0))) - (wrap-list? - a_1)) - #f) - #f))) - #f) - (let ((bodys_0 - (let ((d_0 + simples_0)))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? + 'letrec-values + hd_0) + (let ((a_0 (cdr (unwrap - v_0)))) - (let ((d_1 - (cdr - (unwrap - d_0)))) - (unwrap-list - d_1))))) - (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 - (list* 'begin bodys_0) - wcm-state_0)) - (if (if (eq? - 'letrec-values - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? p_0) - (if (let ((a_1 - (car - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (if (let ((a_3 - (car - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - (let ((a_3 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (if (let ((a_4 - (car - p_3))) - (let ((p_4 - (unwrap - a_4))) - (if (pair? - p_4) - (if (let ((a_5 - (car - p_4))) - (begin-unsafe - (let ((app_0 - (unwrap - 'values))) - (eq? - app_0 - (unwrap - a_5))))) - (let ((a_5 - (cdr - p_4))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f) - #f))) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f) - #f))) - #f) - #f))) - (let ((a_2 - (cdr - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f) - #f))) - (let ((a_1 - (cdr - p_0))) - (wrap-list? - a_1)) - #f) - #f))) - #f) - (let ((bodys_0 - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((d_1 - (cdr - (unwrap - d_0)))) - (unwrap-list - d_1))))) - (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 - (list* 'begin bodys_0) - wcm-state_0)) - (if (if (eq? - 'letrec-values - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? p_0) - (if (let ((a_1 - (car - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - 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) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f))) - (let ((a_3 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (if (let ((a_4 - (car - p_3))) - (let ((p_4 - (unwrap - a_4))) - (if (pair? - p_4) - (if (let ((a_5 - (car - p_4))) - (begin-unsafe - (let ((app_0 - (unwrap - 'values))) - (eq? - app_0 - (unwrap - a_5))))) - (let ((a_5 - (cdr - p_4))) - (let ((p_5 - (unwrap - a_5))) - (if (pair? - p_5) - (let ((a_6 - (cdr - p_5))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_6))))) - #f))) - #f) - #f))) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f) - #f))) - #f) - #f))) - (let ((a_2 - (cdr - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f) - #f))) - (let ((a_1 - (cdr - p_0))) - (wrap-list? - a_1)) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) + v_2)))) (let ((p_0 (unwrap - d_0))) - (call-with-values - (lambda () - (let ((a_0 - (car - p_0))) - (let ((a_1 - (car - (unwrap - a_0)))) - (let ((p_1 - (unwrap - a_1))) - (let ((id_0 - (let ((a_2 - (car - p_1))) - (let ((a_3 - (car - (unwrap - a_2)))) - a_3)))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_1))) - (let ((a_2 - (car - (unwrap - d_1)))) - (let ((d_2 - (cdr - (unwrap - a_2)))) - (let ((a_3 - (car - (unwrap - d_2)))) - a_3)))))) - (let ((id_1 - id_0)) - (values - id_1 - rhs_0)))))))) - (case-lambda - ((id_0 rhs_0) - (let ((bodys_0 - (let ((d_1 - (cdr - p_0))) - (unwrap-list - d_1)))) - (let ((id_1 - id_0) - (rhs_1 - rhs_0)) - (values - id_1 - rhs_1 - bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((id_0 rhs_0 bodys_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 - (list* - 'letrec-values - (list - (list - (list id_0) - rhs_0)) - bodys_0) - wcm-state_0)) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'letrec-values - hd_0) - (let ((a_0 + a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f) + #f))) + #f) + (let ((bodys_0 + (let ((d_0 (cdr (unwrap - v_0)))) + v_2)))) + (let ((d_1 + (cdr + (unwrap + d_0)))) + (unwrap-list + d_1))))) + (schemify_0 + (list* 'begin bodys_0) + wcm-state_2)) + (if (if (eq? + 'letrec-values + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car + p_0))) + (let ((p_1 + (unwrap + a_1))) + (if (pair? + p_1) + (if (let ((a_2 + (car + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + (let ((a_3 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? + p_3) + (if (let ((a_4 + (car + p_3))) + (let ((p_4 + (unwrap + a_4))) + (if (pair? + p_4) + (if (let ((a_5 + (car + p_4))) + (begin-unsafe + (let ((app_0 + (unwrap + 'values))) + (eq? + app_0 + (unwrap + a_5))))) + (let ((a_5 + (cdr + p_4))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_5))))) + #f) + #f))) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f) + #f))) + #f) + #f))) + (let ((a_2 + (cdr + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f) + #f))) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f) + #f))) + #f) + (let ((bodys_0 + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((d_1 + (cdr + (unwrap + d_0)))) + (unwrap-list + d_1))))) + (schemify_0 + (list* + 'begin + bodys_0) + wcm-state_2)) + (if (if (eq? + 'letrec-values + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (if (let ((a_1 + (car + p_0))) + (let ((p_1 + (unwrap + a_1))) + (if (pair? + p_1) + (if (let ((a_2 + (car + 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) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f))) + (let ((a_3 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? + p_3) + (if (let ((a_4 + (car + p_3))) + (let ((p_4 + (unwrap + a_4))) + (if (pair? + p_4) + (if (let ((a_5 + (car + p_4))) + (begin-unsafe + (let ((app_0 + (unwrap + 'values))) + (eq? + app_0 + (unwrap + a_5))))) + (let ((a_5 + (cdr + p_4))) + (let ((p_5 + (unwrap + a_5))) + (if (pair? + p_5) + (let ((a_6 + (cdr + p_5))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_6))))) + #f))) + #f) + #f))) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f) + #f))) + #f) + #f))) + (let ((a_2 + (cdr + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f) + #f))) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_2)))) (let ((p_0 (unwrap - a_0))) - (if (pair? - p_0) - (if (let ((a_1 - (car - p_0))) - (if (wrap-list? - a_1) + d_0))) + (call-with-values + (lambda () + (let ((a_0 + (car + p_0))) + (let ((a_1 + (car + (unwrap + a_0)))) + (let ((p_1 + (unwrap + a_1))) + (let ((id_0 + (let ((a_2 + (car + p_1))) + (let ((a_3 + (car + (unwrap + a_2)))) + a_3)))) + (let ((rhs_0 + (let ((d_1 + (cdr + p_1))) + (let ((a_2 + (car + (unwrap + d_1)))) + (let ((d_2 + (cdr + (unwrap + a_2)))) + (let ((a_3 + (car + (unwrap + d_2)))) + a_3)))))) + (let ((id_1 + id_0)) + (values + id_1 + rhs_0)))))))) + (case-lambda + ((id_0 + rhs_0) + (let ((bodys_0 + (let ((d_1 + (cdr + p_0))) + (unwrap-list + d_1)))) + (let ((id_1 + id_0) + (rhs_1 + rhs_0)) + (values + id_1 + rhs_1 + bodys_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((id_0 + rhs_0 + bodys_0) + (schemify_0 + (list* + 'letrec-values + (list + (list + (list id_0) + rhs_0)) + bodys_0) + wcm-state_2)) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? + 'letrec-values + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (if (let ((a_1 + (car + p_0))) + (if (wrap-list? + a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_3 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_4 + v_3)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_4))) + (if (pair? + p_1) + (if (let ((a_2 + (car + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (let ((a_3 + (cdr + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_4))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 + #t + a_1))) + #f)) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + d_0))) + (call-with-values + (lambda () + (let ((a_0 + (car + p_0))) + (call-with-values + (lambda () (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (result_0 + (lambda (ids_0 + rhss_0 lst_0) (begin (if (not @@ -28137,7 +26626,7 @@ (null? (unwrap lst_0)))) - (let ((v_1 + (let ((v_3 (if (begin-unsafe (pair? (unwrap @@ -28153,174 +26642,60 @@ (wrap-cdr lst_0) null))) - (let ((v_2 - v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_2))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (let ((a_3 - (cdr - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_2))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 - #t - a_1))) - #f)) - (let ((a_1 - (cdr - p_0))) - (wrap-list? - a_1)) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - d_0))) - (call-with-values - (lambda () - (let ((a_0 - (car - p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ids_0 - rhss_0 - lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_2 - v_1)) - (call-with-values - (lambda () + (let ((v_4 + v_3)) (call-with-values (lambda () (call-with-values (lambda () - (let ((p_1 - (unwrap - v_2))) - (let ((ids_1 - (let ((a_1 - (car - p_1))) - (let ((a_2 - (car - (unwrap - a_1)))) - a_2)))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_4))) + (let ((ids_1 + (let ((a_1 + (car + p_1))) + (let ((a_2 + (car + (unwrap + a_1)))) + a_2)))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) + (case-lambda + ((ids104_0 + rhss105_0) + (values + (cons + ids104_0 + ids_0) + (cons + rhss105_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) (case-lambda - ((ids104_0 - rhss105_0) + ((ids_1 + rhss_1) (values - (cons - ids104_0 - ids_0) - (cons - rhss105_0 - rhss_0))) + ids_1 + rhss_1)) (args (raise-binding-result-arity-error 2 @@ -28328,341 +26703,404 @@ (case-lambda ((ids_1 rhss_1) - (values + (for-loop_0 ids_1 - rhss_1)) + rhss_1 + rest_0)) (args (raise-binding-result-arity-error 2 - args))))) - (case-lambda - ((ids_1 - rhss_1) - (for-loop_0 - ids_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - ids_0 - rhss_0))))))) - (for-loop_0 - null - null - a_0)))) - (case-lambda - ((ids_0 - rhss_0) - (let ((app_0 - (reverse$1 - ids_0))) + args))))))) + (values + ids_0 + rhss_0))))))) + (for-loop_0 + null + null + a_0)))) + (case-lambda + ((ids_0 + rhss_0) + (let ((app_0 + (reverse$1 + ids_0))) + (values + app_0 + (reverse$1 + rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((ids_0 + rhss_0) + (let ((bodys_0 + (let ((d_1 + (cdr + p_0))) + (unwrap-list + d_1)))) + (let ((ids_1 + ids_0) + (rhss_1 + rhss_0)) (values - app_0 - (reverse$1 - rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((ids_0 - rhss_0) - (let ((bodys_0 - (let ((d_1 - (cdr - p_0))) - (unwrap-list - d_1)))) - (let ((ids_1 - ids_0) - (rhss_1 - rhss_0)) - (values - ids_1 - rhss_1 - bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((ids_0 - rhss_0 - bodys_0) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (rhs-knowns_0 - body-knowns_0 - lst_0 - lst_1) - (begin - (if (if (pair? - lst_0) - (pair? - lst_1) - #f) - (let ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((rhs_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (call-with-values - (lambda () + ids_1 + rhss_1 + bodys_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((ids_0 + rhss_0 + bodys_0) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (rhs-knowns_0 + body-knowns_0 + lst_0 + lst_1) + (begin + (if (if (pair? + lst_0) + (pair? + lst_1) + #f) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((rhs_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) (call-with-values (lambda () - (let ((k_0 - (infer-known.1 - #f - #f - hash2610 - rhs_0 - #f - id_0 - knowns_0 - prim-knowns_0 - imports_0 - mutated_0 - simples_0 - unsafe-mode?_0 - target_0))) - (let ((u-id_0 - (unwrap - id_0))) - (if (too-early-mutated-state? - (hash-ref - mutated_0 - u-id_0 - #f)) - (values - rhs-knowns_0 - (hash-set - knowns_0 - u-id_0 - (if k_0 - k_0 - a-known-constant))) - (if k_0 - (let ((app_0 - (hash-set - rhs-knowns_0 - u-id_0 - k_0))) - (values - app_0 - (hash-set - body-knowns_0 - u-id_0 - k_0))) - (values - rhs-knowns_0 - body-knowns_0)))))) + (call-with-values + (lambda () + (let ((k_0 + (infer-known.1 + #f + #f + hash2610 + rhs_0 + #f + id_0 + knowns_1 + prim-knowns_0 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0 + target_0))) + (let ((u-id_0 + (unwrap + id_0))) + (if (too-early-mutated-state? + (hash-ref + mutated_0 + u-id_0 + #f)) + (values + rhs-knowns_0 + (hash-set + knowns_1 + u-id_0 + (if k_0 + k_0 + a-known-constant))) + (if k_0 + (let ((app_0 + (hash-set + rhs-knowns_0 + u-id_0 + k_0))) + (values + app_0 + (hash-set + body-knowns_0 + u-id_0 + k_0))) + (values + rhs-knowns_0 + body-knowns_0)))))) + (case-lambda + ((rhs-knowns_1 + body-knowns_1) + (values + rhs-knowns_1 + body-knowns_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) (case-lambda ((rhs-knowns_1 body-knowns_1) - (values + (for-loop_0 rhs-knowns_1 - body-knowns_1)) + body-knowns_1 + rest_0 + rest_1)) (args (raise-binding-result-arity-error 2 - args))))) - (case-lambda - ((rhs-knowns_1 - body-knowns_1) - (for-loop_0 - rhs-knowns_1 - body-knowns_1 - rest_0 - rest_1)) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (values - rhs-knowns_0 - body-knowns_0))))))) - (for-loop_0 - knowns_0 - knowns_0 - ids_0 - rhss_0)))) - (case-lambda - ((rhs-knowns_0 - body-knowns_0) - (unnest-let - (letrec-conversion - ids_0 - mutated_0 - target_0 - (let ((app_0 - (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 ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((rhs_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (list - id_0 - (schemify/knowns_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - rhs-knowns_0 - inline-fuel_0 - 'fresh - rhs_0)) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 - null - ids_0 - rhss_0)))))) - (list* - 'letrec* - app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((body_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (schemify/knowns_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - body-knowns_0 - inline-fuel_0 - wcm-state_0 - body_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - bodys_0))))))) - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0)) + args)))))))) + (values + rhs-knowns_0 + body-knowns_0))))))) + (for-loop_0 + knowns_1 + knowns_1 + ids_0 + rhss_0)))) + (case-lambda + ((rhs-knowns_0 + body-knowns_0) + (unnest-let + (letrec-conversion + ids_0 + mutated_0 + target_0 + (let ((app_0 + (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 ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((rhs_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (list + id_0 + (schemify/knowns_0 + rhs-knowns_0 + inline-fuel_0 + 'fresh + rhs_0)) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 + null + ids_0 + rhss_0)))))) + (list* + 'letrec* + app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((body_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (schemify/knowns_0 + body-knowns_0 + inline-fuel_0 + wcm-state_2 + body_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + bodys_0))))))) + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) (args (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'letrec-values - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (if (let ((a_1 - (car - p_0))) - (if (wrap-list? - a_1) + 3 + args)))) + (if (if (eq? + 'letrec-values + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (if (let ((a_1 + (car + p_0))) + (if (wrap-list? + a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_3 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_4 + v_3)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_4))) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_4))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 + #t + a_1))) + #f)) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + d_0))) + (call-with-values + (lambda () + (let ((a_0 + (car + p_0))) + (call-with-values + (lambda () (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (result_0 + (lambda (idss_0 + rhss_0 lst_0) (begin (if (not @@ -28670,7 +27108,7 @@ (null? (unwrap lst_0)))) - (let ((v_1 + (let ((v_3 (if (begin-unsafe (pair? (unwrap @@ -28686,149 +27124,56 @@ (wrap-cdr lst_0) null))) - (let ((v_2 - v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_2))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_2))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 - #t - a_1))) - #f)) - (let ((a_1 - (cdr - p_0))) - (wrap-list? - a_1)) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - d_0))) - (call-with-values - (lambda () - (let ((a_0 - (car - p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idss_0 - rhss_0 - lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_2 - v_1)) - (call-with-values - (lambda () + (let ((v_4 + v_3)) (call-with-values (lambda () (call-with-values (lambda () - (let ((p_1 - (unwrap - v_2))) - (let ((idss_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((idss_2 - idss_1)) - (values - idss_2 - rhss_1)))))) + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_4))) + (let ((idss_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((idss_2 + idss_1)) + (values + idss_2 + rhss_1)))))) + (case-lambda + ((idss116_0 + rhss117_0) + (values + (cons + idss116_0 + idss_0) + (cons + rhss117_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) (case-lambda - ((idss116_0 - rhss117_0) + ((idss_1 + rhss_1) (values - (cons - idss116_0 - idss_0) - (cons - rhss117_0 - rhss_0))) + idss_1 + rhss_1)) (args (raise-binding-result-arity-error 2 @@ -28836,6864 +27181,400 @@ (case-lambda ((idss_1 rhss_1) - (values + (for-loop_0 idss_1 - rhss_1)) + rhss_1 + rest_0)) (args (raise-binding-result-arity-error 2 - args))))) - (case-lambda - ((idss_1 - rhss_1) - (for-loop_0 - idss_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values + args))))))) + (values + idss_0 + rhss_0))))))) + (for-loop_0 + null + null + a_0)))) + (case-lambda + ((idss_0 + rhss_0) + (let ((app_0 + (reverse$1 + idss_0))) + (values + app_0 + (reverse$1 + rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((idss_0 + rhss_0) + (let ((bodys_0 + (let ((d_1 + (cdr + p_0))) + (unwrap-list + d_1)))) + (let ((idss_1 + idss_0) + (rhss_1 + rhss_0)) + (values + idss_1 + rhss_1 + bodys_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((idss_0 + rhss_0 + bodys_0) + (let ((temp125_0 + (|#%name| + temp125 + (lambda (v_3 + knowns_2) + (begin + (schemify/knowns_0 + knowns_2 + inline-fuel_0 + 'fresh + v_3)))))) + (let ((c1_0 + (struct-convert-local.1 + #t + target_0 + unsafe-mode?_0 + v_2 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0 + temp125_0))) + (if c1_0 + c1_0 + (if (letrec-splitable-values-binding? + idss_0 + rhss_0) + (schemify_0 + (letrec-split-values-binding + idss_0 + rhss_0 + bodys_0) + wcm-state_2) + (letrec-conversion + idss_0 + mutated_0 + target_0 + (let ((app_0 + (apply + 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 ((ids_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((rhs_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((rhs_1 + (schemify_0 + rhs_0 + 'fresh))) + (if (null? + ids_0) + (list + (let ((app_0 + (deterministic-gensym + "lr"))) + (list + app_0 + (make-let-values + null + rhs_1 + '(void) + target_0)))) + (if (if (pair? + ids_0) + (null? + (cdr + ids_0)) + #f) + (list + (list + (car + ids_0) + rhs_1)) + (let ((lr_0 + (deterministic-gensym + "lr"))) + (let ((app_0 + (list + lr_0 + (make-let-values + ids_0 + rhs_1 + (list* + 'vector + ids_0) + target_0)))) + (list* + app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_1 + lst_2 + pos_0) + (begin + (if (if (pair? + lst_2) + #t + #f) + (let ((id_0 + (unsafe-car + lst_2))) + (let ((rest_2 + (unsafe-cdr + lst_2))) + (let ((fold-var_2 + (cons + (list + id_0 + (list + 'unsafe-vector*-ref + lr_0 + pos_0)) + fold-var_1))) + (let ((fold-var_3 + (values + fold-var_2))) + (for-loop_1 + fold-var_3 + rest_2 + (+ + pos_0 + 1)))))) + fold-var_1)))))) + (for-loop_1 + null + ids_0 + 0)))))))))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 + null idss_0 rhss_0))))))) - (for-loop_0 - null - null - a_0)))) - (case-lambda - ((idss_0 - rhss_0) - (let ((app_0 - (reverse$1 - idss_0))) - (values + (list* + 'letrec* app_0 - (reverse$1 - rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((idss_0 - rhss_0) - (let ((bodys_0 + (schemify-body_0 + bodys_0 + wcm-state_2))))))))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? + 'if + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + d_0))) + (let ((tst_0 + (let ((a_0 + (car + p_0))) + a_0))) + (call-with-values + (lambda () (let ((d_1 (cdr p_0))) - (unwrap-list - d_1)))) - (let ((idss_1 - idss_0) - (rhss_1 - rhss_0)) - (values - idss_1 - rhss_1 - bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((idss_0 - rhss_0 - bodys_0) - (let ((temp125_0 - (|#%name| - temp125 - (lambda (v_1 - knowns_1) - (begin - (schemify/knowns_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - knowns_1 - inline-fuel_0 - 'fresh - v_1)))))) - (let ((c1_0 - (struct-convert-local.1 - #t - target_0 - unsafe-mode?_0 - v_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0 - temp125_0))) - (if c1_0 - c1_0 - (if (letrec-splitable-values-binding? - idss_0 - rhss_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 - (letrec-split-values-binding - idss_0 - rhss_0 - bodys_0) - wcm-state_0) - (letrec-conversion - idss_0 - mutated_0 - target_0 - (let ((app_0 - (apply - 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 ((ids_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((rhs_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((rhs_1 - (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 - rhs_0 - 'fresh))) - (if (null? - ids_0) - (list - (let ((app_0 - (deterministic-gensym - "lr"))) - (list - app_0 - (make-let-values - null - rhs_1 - '(void) - target_0)))) - (if (if (pair? - ids_0) - (null? - (cdr - ids_0)) - #f) - (list - (list - (car - ids_0) - rhs_1)) - (let ((lr_0 - (deterministic-gensym - "lr"))) - (let ((app_0 - (list - lr_0 - (make-let-values - ids_0 - rhs_1 - (list* - 'vector - ids_0) - target_0)))) - (list* - app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_1 - lst_2 - pos_0) - (begin - (if (if (pair? - lst_2) - #t - #f) - (let ((id_0 - (unsafe-car - lst_2))) - (let ((rest_2 - (unsafe-cdr - lst_2))) - (let ((fold-var_2 - (cons - (list - id_0 - (list - 'unsafe-vector*-ref - lr_0 - pos_0)) - fold-var_1))) - (let ((fold-var_3 - (values - fold-var_2))) - (for-loop_1 - fold-var_3 - rest_2 - (+ - pos_0 - 1)))))) - fold-var_1)))))) - (for-loop_1 - null - ids_0 - 0)))))))))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 - null - idss_0 - rhss_0))))))) - (list* - 'letrec* - app_0 - (schemify-body_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 - bodys_0 - wcm-state_0))))))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'if - hd_0) - (let ((a_0 - (cdr - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - d_0))) - (let ((tst_0 - (let ((a_0 - (car - p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 - (cdr - p_0))) - (let ((p_1 - (unwrap - d_1))) - (let ((thn_0 - (let ((a_0 - (car - p_1))) - a_0))) - (let ((els_0 - (let ((d_2 - (cdr - p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((thn_1 - thn_0)) - (values - thn_1 - els_0))))))) - (case-lambda - ((thn_0 - els_0) - (let ((tst_1 - tst_0)) - (values - tst_1 - thn_0 - els_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((tst_0 - thn_0 - els_0) - (let ((app_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 - tst_0 - 'fresh))) - (let ((app_1 - (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 - thn_0 - wcm-state_0))) - (list - 'if - app_0 - app_1 - (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 - els_0 - wcm-state_0))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'with-continuation-mark - hd_0) - (let ((a_0 - (cdr - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - d_0))) - (let ((key_0 - (let ((a_0 - (car - p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 - (cdr - p_0))) - (let ((p_1 - (unwrap - d_1))) - (let ((val_0 - (let ((a_0 - (car - p_1))) - a_0))) - (let ((body_0 - (let ((d_2 - (cdr - p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((val_1 - val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 - body_0) - (let ((key_1 - key_0)) - (values - key_1 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((key_0 - val_0 - body_0) - (let ((s-key_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 - key_0 - 'fresh))) - (let ((s-val_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 - val_0 - 'fresh))) - (let ((s-body_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 - body_0 - 'marked))) - (let ((authentic-key?_0 - (authentic-valued? - key_0 - knowns_0 - prim-knowns_0 - imports_0 - mutated_0))) - (if (if authentic-key?_0 - (simple?.1 - #t - #f - s-body_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - #f) - (let ((app_0 - (ensure-single-valued - s-key_0 - knowns_0 - prim-knowns_0 - imports_0 - mutated_0))) - (list - 'begin - app_0 - (ensure-single-valued - s-val_0 - knowns_0 - prim-knowns_0 - imports_0 - mutated_0) - s-body_0)) - (if (eq? - target_0 - 'cify) - (list - 'with-continuation-mark - s-key_0 - s-val_0 - s-body_0) - (let ((mode_0 - (if (eq? - wcm-state_0 - 'fresh) - (if authentic-key?_0 - 'push-authentic - 'push) - (if authentic-key?_0 - 'authentic - 'general)))) - (list - 'with-continuation-mark* - mode_0 - s-key_0 - s-val_0 - s-body_0))))))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'begin - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 + (let ((p_1 (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - (let ((exp_0 - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_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 - exp_0 - wcm-state_0)) - (if (if (eq? - 'begin - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (wrap-list? - a_0)) - #f) - (let ((exps_0 - (let ((d_0 - (cdr - (unwrap - v_0)))) - (unwrap-list - d_0)))) - (list* - 'begin - (schemify-body_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 - exps_0 - wcm-state_0))) - (if (if (eq? - 'begin-unsafe - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (wrap-list? - a_0)) - #f) - (let ((exps_0 - (let ((d_0 - (cdr - (unwrap - v_0)))) - (unwrap-list - d_0)))) - (list* - 'begin-unsafe - (schemify-body_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 - exps_0 - wcm-state_0))) - (if (if (eq? - 'begin0 - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - (let ((exp_0 - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_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 - exp_0 - wcm-state_0)) - (if (if (eq? - 'begin0 - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (wrap-list? - a_1)) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - d_0))) - (let ((exp_0 + d_1))) + (let ((thn_0 (let ((a_0 (car - p_0))) + p_1))) a_0))) - (let ((exps_0 - (let ((d_1 + (let ((els_0 + (let ((d_2 (cdr - p_0))) - (unwrap-list - d_1)))) - (let ((exp_1 - exp_0)) + p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + a_0)))) + (let ((thn_1 + thn_0)) (values - exp_1 - exps_0))))))) + thn_1 + els_0))))))) (case-lambda - ((exp_0 - exps_0) - (let ((app_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 - exp_0 - 'fresh))) - (list* - 'begin0 - app_0 - (schemify-body_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 - exps_0 - 'fresh)))) + ((thn_0 + els_0) + (let ((tst_1 + tst_0)) + (values + tst_1 + thn_0 + els_0))) (args (raise-binding-result-arity-error 2 - args)))) - (if (if (eq? - 'set! - hd_0) - (let ((a_0 - (cdr - (unwrap - v_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - d_0))) - (let ((id_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((id_1 - id_0)) - (values - id_1 - rhs_0))))))) - (case-lambda - ((id_0 - rhs_0) - (let ((int-id_0 - (unwrap - id_0))) - (let ((ex_0 - (hash-ref - exports_0 - int-id_0 - #f))) - (let ((new-rhs_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 - rhs_0 - 'fresh))) - (let ((state_0 - (hash-ref - mutated_0 - int-id_0 - #f))) - (if ex_0 - (let ((set-id_0 - (if (if allow-set!-undefined?_0 - allow-set!-undefined?_0 - (not - (too-early-mutated-state? - state_0))) - 'variable-set! - 'variable-set!/check-undefined))) - (list - set-id_0 - (export-id - ex_0) - new-rhs_0)) - (if (if (too-early-mutated-state? - state_0) - (not - (eq? - target_0 - 'cify)) - #f) - (let ((tmp_0 - (deterministic-gensym - "set"))) - (list - 'let - (list - (list - tmp_0 - new-rhs_0)) - (list - 'check-not-unsafe-undefined/assign - id_0 - (list - 'quote - (too-early-mutated-state-name - state_0 - int-id_0))) - (list - 'set! - id_0 - tmp_0))) - (if (not - state_0) - (list - 'void - new-rhs_0) - (list - 'set! - id_0 - new-rhs_0))))))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'variable-reference-constant? - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (if (let ((a_1 - (car - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '|#%variable-reference|))) - (eq? - app_0 - (unwrap - a_2))))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f) - #f))) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f) - #f))) - #f) - (let ((id_0 - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - (let ((d_1 - (cdr - (unwrap - a_0)))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))))) - (let ((u-id_0 - (unwrap - id_0))) - (if (hash-ref - mutated_0 - u-id_0 - #f) - #f - (let ((im_0 - (hash-ref - imports_0 - u-id_0 - #f))) - (if (not - im_0) - #t - (if (known-constant? - (import-lookup - im_0)) - #t - (list - 'variable-reference-constant? - (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 - (list - '|#%variable-reference| - id_0) - 'fresh)))))))) - (if (if (eq? - 'variable-reference-from-unsafe? - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (if (let ((a_1 - (car - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '|#%variable-reference|))) - (eq? - app_0 - (unwrap - a_2))))) - (let ((a_2 - (cdr - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f) - #f))) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f) - #f))) - #f) - unsafe-mode?_0 - (if (if (eq? - '|#%variable-reference| - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_0))))) - #f) - 'instance-variable-reference - (if (if (eq? - '|#%variable-reference| - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - (let ((id_0 - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_0)))) - (let ((u_0 - (unwrap - id_0))) - (let ((v_1 - (let ((or-part_0 - (let ((ex_0 - (hash-ref - exports_0 - u_0 - #f))) - (if ex_0 - (export-id - ex_0) - #f)))) - (if or-part_0 - or-part_0 - (let ((im_0 - (hash-ref - imports_0 - u_0 - #f))) - (if im_0 - (import-id - im_0) - #f)))))) - (if v_1 - (list - 'make-instance-variable-reference - 'instance-variable-reference - v_1) - (list - 'make-instance-variable-reference - 'instance-variable-reference - (list - 'quote - (if (hash-ref - mutated_0 - u_0 - #f) - 'mutable - (if (hash-ref - prim-knowns_0 - u_0 - #f) - u_0 - 'constant)))))))) - (if (if (eq? - 'equal? - hd_0) - (let ((a_0 - (cdr - (unwrap - v_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - d_0))) - (let ((exp1_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((exp2_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((exp1_1 - exp1_0)) - (values - exp1_1 - exp2_0))))))) - (case-lambda - ((exp1_0 - exp2_0) - (let ((exp1_1 - (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 - exp1_0 - 'fresh))) - (let ((exp2_1 - (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 - exp2_0 - 'fresh))) - (let ((exp1_2 - exp1_1)) - (if (eq? - exp1_2 - exp2_1) - #t - (if (let ((or-part_0 - (equal-implies-eq? - exp1_2))) - (if or-part_0 - or-part_0 - (equal-implies-eq? - exp2_1))) - (list - 'eq? - exp1_2 - exp2_1) - (if (let ((or-part_0 - (equal-implies-eqv? - exp1_2))) - (if or-part_0 - or-part_0 - (equal-implies-eqv? - exp2_1))) - (list - 'eqv? - exp1_2 - exp2_1) - (left-to-right/app - 'equal? - (list - exp1_2 - exp2_1) - #f - target_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0)))))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'call-with-values - hd_0) - (let ((a_0 - (cdr - (unwrap - v_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - d_0))) - (let ((generator_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((receiver_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((generator_1 - generator_0)) - (values - generator_1 - receiver_0))))))) - (case-lambda - ((generator_0 - receiver_0) - (if (if (lambda?.1 - #f - generator_0) - (let ((or-part_0 - (lambda?.1 - #f - receiver_0))) - (if or-part_0 - or-part_0 - (eq? - (unwrap - receiver_0) - 'list))) - #f) - (let ((app_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 - generator_0 - 'fresh))) - (list - 'call-with-values - app_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 - receiver_0 - 'fresh))) - (let ((app_0 - (if (eq? - target_0 - 'cify) - 'call-with-values - '|#%call-with-values|))) - (left-to-right/app - app_0 - (let ((app_1 - (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 - generator_0 - 'fresh))) - (list - app_1 - (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 - receiver_0 - 'fresh))) - #f - target_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'single-flonum-available? - hd_0) - (let ((a_0 - (cdr - (unwrap - v_0)))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_0))))) - #f) - (eq? - target_0 - 'cify) - (if (let ((p_0 - (unwrap - v_0))) - (if (pair? - p_0) - (if (let ((a_0 - (car - p_0))) - (let ((p_1 - (unwrap - a_0))) - (if (pair? - p_1) - (if (let ((a_1 - (car - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - 'letrec-values))) - (eq? - app_0 - (unwrap - a_1))))) - (let ((a_1 - (cdr - p_1))) - (let ((p_2 - (unwrap - a_1))) - (if (pair? - p_2) - (let ((a_2 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (let ((a_3 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f) - #f))) - (let ((a_0 - (cdr - p_0))) - (wrap-list? - a_0)) - #f) - #f)) - (call-with-values - (lambda () - (let ((p_0 - (unwrap - v_0))) - (call-with-values - (lambda () - (let ((a_0 - (car - p_0))) - (let ((d_0 - (cdr - (unwrap - a_0)))) - (let ((p_1 - (unwrap - d_0))) - (let ((binds_0 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rator_0 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((binds_1 - binds_0)) - (values - binds_1 - rator_0)))))))) - (case-lambda - ((binds_0 - rator_0) - (let ((rands_0 - (let ((d_0 - (cdr - p_0))) - (unwrap-list - d_0)))) - (let ((binds_1 - binds_0) - (rator_1 - rator_0)) - (values - binds_1 - rator_1 - rands_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((binds_0 - rator_0 - rands_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 - (list - 'letrec-values - binds_0 - (list* - rator_0 - rands_0)) - wcm-state_0)) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (let ((p_0 - (unwrap - v_0))) - (if (pair? - p_0) - (let ((a_0 - (cdr - p_0))) - (wrap-list? - a_0)) - #f)) - (call-with-values - (lambda () - (let ((p_0 - (unwrap - v_0))) - (let ((rator_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((exps_0 - (let ((d_0 - (cdr - p_0))) - (unwrap-list - d_0)))) - (let ((rator_1 - rator_0)) - (values - rator_1 - exps_0)))))) - (case-lambda - ((rator_0 - exps_0) - (let ((or-part_0 - (left-left-lambda-convert_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - exps_0 - imports_0 - knowns_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - wcm-state_0 - rator_0 - inline-fuel_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (if (positive? - inline-fuel_0) - (inline-rator_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - exps_0 - imports_0 - inline-fuel_0 - knowns_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - rator_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - wcm-state_0) - #f))) - (if or-part_1 - or-part_1 - (let ((s-rator_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 - rator_0 - 'fresh))) - (let ((args_0 - (schemify-body_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 - exps_0 - 'fresh))) - (let ((u-rator_0 - (unwrap - rator_0))) - (let ((args_1 - args_0) - (s-rator_1 - s-rator_0)) - (call-with-values - (lambda () - (find-known+import - u-rator_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0)) - (case-lambda - ((k_0 - im_0) - (let ((c6_0 - (let ((or-part_2 - (if (eq? - rator_0 - 'ptr-ref) - (inline-ptr-ref - args_1) - #f))) - (if or-part_2 - or-part_2 - (if (eq? - rator_0 - 'ptr-set!) - (inline-ptr-set - args_1) - #f))))) - (if c6_0 - (let ((app_0 - (car - c6_0))) - (left-to-right/app - app_0 - (cdr - c6_0) - #f - target_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0)) - (let ((c5_0 - (if (not - (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-constructor_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 c5_0 - c5_0 - (let ((c4_0 - (if (not - (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-struct-predicate_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 c4_0 - c4_0 - (let ((c3_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-accessor? - k_0) - (inline-field-access_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 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 - (known-procedure/has-unsafe-alternate - k_0) - args_1 - #f - target_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - (left-to-right/app - s-rator_1 - args_1 - (if (if (not - (eq? - target_0 - 'system)) - (known-procedure/no-return? - k_0) - #f) - '|#%app/no-return| - (if (if im_0 - (known-procedure/single-valued? - k_0) - #f) - '|#%app/value| - (if (let ((or-part_2 - (known-procedure? - k_0))) - (if or-part_2 - or-part_2 - (lambda?.1 - #f - rator_0))) - #f - '|#%app|))) - target_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0))))))))))))) - (args - (raise-binding-result-arity-error - 2 - args))))))))))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (let ((u-v_0 - (unwrap - v_0))) - (if (not - (symbol? - u-v_0)) - v_0 - (if (eq? - u-v_0 - 'call-with-values) - '|#%call-with-values| - (let ((state_0 - (hash-ref - mutated_0 - u-v_0 - #f))) - (let ((c9_0 - (if (via-variable-mutated-state? - state_0) - (hash-ref - exports_0 - u-v_0 - #f) - #f))) - (if c9_0 - (if (too-early-mutated-state? - state_0) - (list - 'variable-ref - (export-id - c9_0)) - (list - 'variable-ref/no-check - (export-id - c9_0))) - (let ((c8_0 - (hash-ref - imports_0 - u-v_0 - #f))) - (if c8_0 - (let ((k_0 - (import-lookup - c8_0))) - (if (known-constant? - k_0) - (if (known-literal? - k_0) - (wrap-literal - (known-literal-value - k_0)) - (if (if (known-copy? - k_0) - (hash-ref - prim-knowns_0 - (known-copy-id - k_0) - #f) - #f) - (known-copy-id - k_0) - (import-id - c8_0))) - (list - 'variable-ref/no-check - (import-id - c8_0)))) - (let ((c7_0 - (hash-ref - knowns_0 - u-v_0 - #f))) - (if c7_0 - (if (if (known-copy? - c7_0) - (simple-mutated-state? - (hash-ref - mutated_0 - u-v_0 - #f)) - #f) - (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 - (known-copy-id - c7_0) - wcm-state_0) - v_0) - (if (if (too-early-mutated-state? - state_0) - (not - (eq? - target_0 - 'cify)) - #f) - (list - 'check-not-unsafe-undefined - v_0 - (list - 'quote - (too-early-mutated-state-name - state_0 - u-v_0))) - v_0)))))))))))))))))))))))))))))))))))))))))))))))) - (optimize - s-v_0 - prim-knowns_0 - primitives_0 - knowns_0 - imports_0 - mutated_0)))))) - (wrap-tmp_0 - (|#%name| - wrap-tmp - (lambda (tmp_0 e_0 body_0) - (begin - (if (eq? tmp_0 e_0) - body_0 - (list 'let (list (list tmp_0 e_0)) body_0))))))) - (lambda (v_0 - prim-knowns_0 - primitives_0 - knowns_0 - mutated_0 - imports_0 - exports_0 - simples_0 - allow-set!-undefined?_0 - add-import!_0 - serializable?-box_0 - datum-intern?_0 - target_0 - unsafe-mode?_0 - allow-inline?_0 - no-prompt?_0 - explicit-unnamed?_0 - wcm-state_0) - (schemify/knowns_0 - add-import!_0 - allow-inline?_0 - allow-set!-undefined?_0 - datum-intern?_0 - explicit-unnamed?_0 - exports_0 - imports_0 - mutated_0 - no-prompt?_0 - prim-knowns_0 - primitives_0 - serializable?-box_0 - simples_0 - target_0 - unsafe-mode?_0 - knowns_0 - 8 - wcm-state_0 - v_0)))) -(define struct:liftable - (make-record-type-descriptor* 'liftable #f #f #f #f 3 6)) -(define effect_2347 - (struct-type-install-properties! - struct:liftable - 'liftable - 3 - 0 - #f - null - (current-inspector) - #f - '(0) - #f - 'liftable)) -(define liftable1.1 - (|#%name| - liftable - (record-constructor - (make-record-constructor-descriptor struct:liftable #f #f)))) -(define liftable?_2874 (|#%name| liftable? (record-predicate struct:liftable))) -(define liftable? - (|#%name| - liftable? - (lambda (v) - (if (liftable?_2874 v) - #t - ($value - (if (impersonator? v) (liftable?_2874 (impersonator-val v)) #f)))))) -(define liftable-expr_2683 - (|#%name| liftable-expr (record-accessor struct:liftable 0))) -(define liftable-expr - (|#%name| - liftable-expr - (lambda (s) - (if (liftable?_2874 s) - (liftable-expr_2683 s) - ($value - (impersonate-ref - liftable-expr_2683 - struct:liftable - 0 - s - 'liftable - 'expr)))))) -(define liftable-frees_2250 - (|#%name| liftable-frees (record-accessor struct:liftable 1))) -(define liftable-frees - (|#%name| - liftable-frees - (lambda (s) - (if (liftable?_2874 s) - (liftable-frees_2250 s) - ($value - (impersonate-ref - liftable-frees_2250 - struct:liftable - 1 - s - 'liftable - 'frees)))))) -(define liftable-binds_2405 - (|#%name| liftable-binds (record-accessor struct:liftable 2))) -(define liftable-binds - (|#%name| - liftable-binds - (lambda (s) - (if (liftable?_2874 s) - (liftable-binds_2405 s) - ($value - (impersonate-ref - liftable-binds_2405 - struct:liftable - 2 - s - 'liftable - 'binds)))))) -(define set-liftable-frees!_2551 - (|#%name| set-liftable-frees! (record-mutator struct:liftable 1))) -(define set-liftable-frees! - (|#%name| - set-liftable-frees! - (lambda (s v) - (if (liftable?_2874 s) - (set-liftable-frees!_2551 s v) - ($value - (impersonate-set! - set-liftable-frees!_2551 - struct:liftable - 1 - 1 - s - v - 'liftable - 'frees)))))) -(define set-liftable-binds!_3068 - (|#%name| set-liftable-binds! (record-mutator struct:liftable 2))) -(define set-liftable-binds! - (|#%name| - set-liftable-binds! - (lambda (s v) - (if (liftable?_2874 s) - (set-liftable-binds!_3068 s v) - ($value - (impersonate-set! - set-liftable-binds!_3068 - struct:liftable - 2 - 2 - s - v - 'liftable - 'binds)))))) -(define struct:indirected - (make-record-type-descriptor* 'indirected #f #f #f #f 1 1)) -(define effect_2558 - (struct-type-install-properties! - struct:indirected - 'indirected - 1 - 0 - #f - null - (current-inspector) - #f - '() - #f - 'indirected)) -(define indirected2.1 - (|#%name| - indirected - (record-constructor - (make-record-constructor-descriptor struct:indirected #f #f)))) -(define indirected?_2323 - (|#%name| indirected? (record-predicate struct:indirected))) -(define indirected? - (|#%name| - indirected? - (lambda (v) - (if (indirected?_2323 v) - #t - ($value - (if (impersonator? v) (indirected?_2323 (impersonator-val v)) #f)))))) -(define indirected-check?_2858 - (|#%name| indirected-check? (record-accessor struct:indirected 0))) -(define indirected-check? - (|#%name| - indirected-check? - (lambda (s) - (if (indirected?_2323 s) - (indirected-check?_2858 s) - ($value - (impersonate-ref - indirected-check?_2858 - struct:indirected - 0 - s - 'indirected - 'check?)))))) -(define set-indirected-check?!_2663 - (|#%name| set-indirected-check?! (record-mutator struct:indirected 0))) -(define set-indirected-check?! - (|#%name| - set-indirected-check?! - (lambda (s v) - (if (indirected?_2323 s) - (set-indirected-check?!_2663 s v) - ($value - (impersonate-set! - set-indirected-check?!_2663 - struct:indirected - 0 - 0 - s - v - 'indirected - 'check?)))))) -(define empty-frees+binds (cons hash2610 hash2610)) -(define lift-in-schemified-linklet - (let ((lift-in-schemified-linklet_0 - (letrec ((loop_0 - (|#%name| - loop - (lambda (leave-loops-intact?5_0 v_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap v_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) #t #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((args_0 (let ((a_0 (car p_0))) a_0))) - (let ((body_0 - (let ((d_1 (cdr p_0))) d_1))) - (let ((args_1 args_0)) - (values args_1 body_0))))))) - (case-lambda - ((args_0 body_0) - (let ((new-body_0 - (lift-in-schemified-body - body_0 - leave-loops-intact?5_0))) - (if (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0 lst_1) - (begin - (if (if (pair? lst_0) - (pair? lst_1) - #f) - (let ((old_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((new_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((result_1 - (eq? - old_0 - new_0))) - (let ((result_2 - (values - result_1))) - (if (if (not - (let ((x_0 - (list - old_0))) - (not - result_2))) - (if (not - (let ((x_0 - (list - new_0))) - (not - result_2))) - #t - #f) - #f) - (for-loop_0 - result_2 - rest_0 - rest_1) - result_2))))))) - result_0)))))) - (for-loop_0 #t body_0 new-body_0))) - v_0 - (list* 'lambda args_0 new-body_0)))) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'let* hd_0) - (let ((a_0 (cdr (unwrap v_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))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((bindings_0 - (let ((a_0 (car p_0))) a_0))) - (let ((body_0 - (let ((d_1 (cdr p_0))) - (let ((a_0 (car (unwrap d_1)))) - a_0)))) - (let ((bindings_1 bindings_0)) - (values bindings_1 body_0))))))) - (case-lambda - ((bindings_0 body_0) - (let ((new-body_0 - (loop_0 - leave-loops-intact?5_0 - body_0))) - (if (eq? body_0 new-body_0) - v_0 - (list 'let* bindings_0 new-body_0)))) - (args - (raise-binding-result-arity-error 2 args)))) - (error 'match "failed ~e" v_0))))))))) - (|#%name| - lift-in-schemified-linklet - (lambda (v6_0 leave-loops-intact?5_0) - (begin (loop_0 leave-loops-intact?5_0 v6_0))))))) - (case-lambda - ((v_0) (lift-in-schemified-linklet_0 v_0 #f)) - ((v_0 leave-loops-intact?5_0) - (lift-in-schemified-linklet_0 v_0 leave-loops-intact?5_0))))) -(define lift-in-schemified-body - (let ((lift-in-schemified-body_0 - (|#%name| - lift-in-schemified-body - (lambda (body8_0 leave-loops-intact?7_0) - (begin - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((v_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (lift-in-schemified - v_0 - leave-loops-intact?7_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null body8_0))))))))) - (case-lambda - ((body_0) (lift-in-schemified-body_0 body_0 #f)) - ((body_0 leave-loops-intact?7_0) - (lift-in-schemified-body_0 body_0 leave-loops-intact?7_0))))) -(define lift-in-schemified - (letrec ((add-args_0 - (|#%name| - add-args - (case-lambda - ((args_0 s_0) (begin (add-args_1 args_0 s_0 'ready))) - ((args_0 s_0 mode18_0) (add-args_1 args_0 s_0 mode18_0))))) - (add-args_1 - (|#%name| - add-args - (lambda (args19_0 s20_0 mode18_0) - (begin - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (args_0 s_0) - (begin - (if (begin-unsafe (null? (unwrap args_0))) - s_0 - (if (begin-unsafe (pair? (unwrap args_0))) - (let ((app_0 (wrap-cdr args_0))) - (loop_3 - app_0 - (hash-set - s_0 - (unwrap (wrap-car args_0)) - mode18_0))) - (hash-set s_0 (unwrap args_0) mode18_0)))))))) - (loop_3 args19_0 s20_0)))))) - (add-free_0 - (|#%name| - add-free - (lambda (frees+binds_0 var_0) - (begin - (let ((app_0 (hash-set (car frees+binds_0) var_0 #t))) - (cons app_0 (cdr frees+binds_0))))))) - (close-and-convert-lifts_0 - (|#%name| - close-and-convert-lifts - (lambda (lifts_0 loops_0) - (begin - (let ((new-lifts_0 (make-hasheq))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value lifts_0 i_0)) - (case-lambda - ((f_0 info_0) - (begin - (if (liftable? info_0) - (hash-set! new-lifts_0 f_0 info_0) - (void)) - (for-loop_0 - (hash-iterate-next lifts_0 i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values))))))) - (for-loop_0 (hash-iterate-first lifts_0)))) - (void) - (let ((lst_0 (hash-values new-lifts_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((proc_0 (unsafe-car lst_1))) - (let ((rest_0 (unsafe-cdr lst_1))) - (begin - (let ((frees_0 - (liftable-frees proc_0))) - (let ((binds_0 - (liftable-binds proc_0))) - (let ((closed-frees_0 - (loop_1 - binds_0 - lifts_0 - new-lifts_0 - frees_0 - (hash-keys frees_0)))) - (set-liftable-frees! - proc_0 - closed-frees_0)))) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (let ((proc_0 - (hash-iterate-value new-lifts_0 i_0))) - (call-with-values - (lambda () - (if (liftable? proc_0) - (begin - (set-liftable-frees! - proc_0 - (let ((temp40_0 - (reverse$1 - (let ((ht_0 - (liftable-frees - proc_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_0 - i_1) - (begin - (if i_1 - (let ((f_0 - (hash-iterate-key - ht_0 - i_1))) - (let ((fold-var_1 - (if (liftable? - (hash-ref - lifts_0 - f_0 - #f)) - fold-var_0 - (let ((fold-var_1 - (cons - f_0 - fold-var_0))) - (values - fold-var_1))))) - (for-loop_1 - fold-var_1 - (hash-iterate-next - ht_0 - i_1)))) - fold-var_0)))))) - (for-loop_1 - null - (hash-iterate-first - ht_0)))))))) - (sort.1 #f #f temp40_0 symbol app_0 (hash-count s2_0))) - (union_0 s2_0 s1_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (s2_1 i_0) - (begin - (if i_0 - (let ((k_0 (hash-iterate-key s1_0 i_0))) - (let ((s2_2 - (let ((s2_2 (hash-set s2_1 k_0 #t))) - (values s2_2)))) - (for-loop_0 - s2_2 - (hash-iterate-next s1_0 i_0)))) - s2_1)))))) - (for-loop_0 s2_0 (hash-iterate-first s1_0))))))))) - (v-loop_0 - (|#%name| - v-loop - (lambda (binds_0 - lifts_0 - new-lifts_0 - v-binds_0 - v-frees_0 - frees_0 - todo_0) - (begin - (if (null? v-frees_0) - (loop_1 binds_0 lifts_0 new-lifts_0 frees_0 todo_0) - (let ((g_0 (car v-frees_0))) - (if (let ((or-part_0 (hash-ref frees_0 g_0 #f))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (hash-ref binds_0 g_0 #f))) - (if or-part_1 - or-part_1 - (hash-ref v-binds_0 g_0 #f))))) - (v-loop_0 - binds_0 - lifts_0 - new-lifts_0 - v-binds_0 - (cdr v-frees_0) - frees_0 - todo_0) - (let ((app_0 (cdr v-frees_0))) - (v-loop_0 - binds_0 - lifts_0 - new-lifts_0 - v-binds_0 - app_0 - (hash-set frees_0 g_0 #t) - (cons g_0 todo_0))))))))))) - (lambda (v_0 leave-loops-intact?_0) - (letrec* - ((find-loops_0 - (|#%name| - find-loops - (lambda (v_1 lifts_0 loop-if-tail_0 loops_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap v_1))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'letrec hd_0) #t #f) - (find-letrec-loops_0 - find-loops_0 - v_1 - lifts_0 - loop-if-tail_0 - loops_0) - (if (if (eq? 'letrec* hd_0) #t #f) - (find-letrec-loops_0 - find-loops_0 - v_1 - lifts_0 - loop-if-tail_0 - loops_0) - (if (let ((p_0 (unwrap v_1))) - (if (pair? p_0) - (if (let ((a_0 (car p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (begin-unsafe - (let ((app_0 (unwrap 'letrec))) - (eq? app_0 (unwrap a_1))))) - (let ((a_1 (cdr p_1))) - (let ((p_2 (unwrap a_1))) - (if (pair? p_2) - (if (let ((a_2 (car p_2))) - (let ((p_3 (unwrap a_2))) - (if (pair? p_3) - (if (let ((a_3 - (car p_3))) - (let ((p_4 - (unwrap - a_3))) - (if (pair? p_4) - (let ((a_4 - (cdr - p_4))) - (let ((p_5 - (unwrap - a_4))) - (if (pair? - p_5) - (let ((a_5 - (cdr - p_5))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f))) - #f))) - (let ((a_3 - (cdr p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f) - #f))) - (let ((a_2 (cdr p_2))) - (let ((p_3 (unwrap a_2))) - (if (pair? p_3) - (let ((a_3 (cdr p_3))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_3))))) - #f))) - #f) - #f))) - #f) - #f))) - (let ((a_0 (cdr p_0))) (wrap-list? a_0)) - #f) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap v_1))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (let ((d_0 (cdr (unwrap a_0)))) - (let ((p_1 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_1 (car p_1))) - (let ((a_2 (car (unwrap a_1)))) - (let ((p_2 (unwrap a_2))) - (let ((id_0 - (let ((a_3 (car p_2))) - a_3))) - (let ((rhs_0 - (let ((d_1 (cdr p_2))) - (let ((a_3 - (car - (unwrap d_1)))) - a_3)))) - (let ((id_1 id_0)) - (values id_1 rhs_0)))))))) - (case-lambda - ((id_0 rhs_0) - (let ((rator_0 - (let ((d_1 (cdr p_1))) - (let ((a_1 (car (unwrap d_1)))) - a_1)))) - (let ((id_1 id_0) (rhs_1 rhs_0)) - (values id_1 rhs_1 rator_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((id_0 rhs_0 rator_0) - (let ((rands_0 - (let ((d_0 (cdr p_0))) - (unwrap-list d_0)))) - (let ((id_1 id_0) - (rhs_1 rhs_0) - (rator_1 rator_0)) - (values id_1 rhs_1 rator_1 rands_0)))) - (args - (raise-binding-result-arity-error 3 args)))))) - (case-lambda - ((id_0 rhs_0 rator_0 rands_0) - (find-loops_0 - (list - 'letrec - (list (list id_0 rhs_0)) - (list* rator_0 rands_0)) - lifts_0 - loop-if-tail_0 - loops_0)) - (args (raise-binding-result-arity-error 4 args)))) - (if (let ((p_0 (unwrap v_1))) - (if (pair? p_0) - (if (let ((a_0 (car p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (begin-unsafe - (let ((app_0 (unwrap 'letrec*))) - (eq? app_0 (unwrap a_1))))) - (let ((a_1 (cdr p_1))) - (let ((p_2 (unwrap a_1))) - (if (pair? p_2) - (if (let ((a_2 (car p_2))) - (let ((p_3 (unwrap a_2))) - (if (pair? p_3) - (if (let ((a_3 - (car - p_3))) - (let ((p_4 - (unwrap - a_3))) - (if (pair? - p_4) - (let ((a_4 - (cdr - p_4))) - (let ((p_5 - (unwrap - a_4))) - (if (pair? - p_5) - (let ((a_5 - (cdr - p_5))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f))) - #f))) - (let ((a_3 - (cdr p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f) - #f))) - (let ((a_2 (cdr p_2))) - (let ((p_3 (unwrap a_2))) - (if (pair? p_3) - (let ((a_3 (cdr p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap a_3))))) - #f))) - #f) - #f))) - #f) - #f))) - (let ((a_0 (cdr p_0))) (wrap-list? a_0)) - #f) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap v_1))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (let ((d_0 (cdr (unwrap a_0)))) - (let ((p_1 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_1 (car p_1))) - (let ((a_2 (car (unwrap a_1)))) - (let ((p_2 (unwrap a_2))) - (let ((id_0 - (let ((a_3 (car p_2))) - a_3))) - (let ((rhs_0 - (let ((d_1 (cdr p_2))) - (let ((a_3 - (car - (unwrap - d_1)))) - a_3)))) - (let ((id_1 id_0)) - (values id_1 rhs_0)))))))) - (case-lambda - ((id_0 rhs_0) - (let ((rator_0 - (let ((d_1 (cdr p_1))) - (let ((a_1 - (car (unwrap d_1)))) - a_1)))) - (let ((id_1 id_0) (rhs_1 rhs_0)) - (values id_1 rhs_1 rator_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((id_0 rhs_0 rator_0) - (let ((rands_0 - (let ((d_0 (cdr p_0))) - (unwrap-list d_0)))) - (let ((id_1 id_0) - (rhs_1 rhs_0) - (rator_1 rator_0)) - (values id_1 rhs_1 rator_1 rands_0)))) - (args - (raise-binding-result-arity-error 3 args)))))) - (case-lambda - ((id_0 rhs_0 rator_0 rands_0) - (find-loops_0 - (list - 'letrec - (list (list id_0 rhs_0)) - (list* rator_0 rands_0)) - lifts_0 - loop-if-tail_0 - loops_0)) - (args (raise-binding-result-arity-error 4 args)))) - (if (if (eq? 'let hd_0) #t #f) - (find-let-loops_0 - find-loops_0 - v_1 - lifts_0 - loop-if-tail_0 - loops_0) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) #t #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((args_0 (let ((a_0 (car p_0))) a_0))) - (let ((body_0 - (let ((d_1 (cdr p_0))) d_1))) - (let ((args_1 args_0)) - (values args_1 body_0))))))) - (case-lambda - ((args_0 body_0) - (find-seq-loops_0 - find-loops_0 - body_0 - lifts_0 - hash2610 - loops_0)) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_2 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_3 v_2)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_3))) - (if (pair? - p_0) - #t - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_3))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_0))) - #f)) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (argss_0 bodys_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_2 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_3 v_2)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_0 - (unwrap - v_3))) - (let ((argss_1 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((bodys_1 - (let ((d_1 - (cdr - p_0))) - d_1))) - (let ((argss_2 - argss_1)) - (values - argss_2 - bodys_1)))))) - (case-lambda - ((argss35_0 - bodys36_0) - (values - (cons - argss35_0 - argss_0) - (cons - bodys36_0 - bodys_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((argss_1 bodys_1) - (values - argss_1 - bodys_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((argss_1 bodys_1) - (for-loop_0 - argss_1 - bodys_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - argss_0 - bodys_0))))))) - (for-loop_0 null null d_0)))) - (case-lambda - ((argss_0 bodys_0) - (let ((app_0 (reverse$1 argss_0))) - (values app_0 (reverse$1 bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((argss_0 bodys_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (loops_1 lst_0) - (begin - (if (pair? lst_0) - (let ((body_0 (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((loops_2 - (let ((loops_2 - (find-seq-loops_0 - find-loops_0 - body_0 - lifts_0 - hash2610 - loops_1))) - (values loops_2)))) - (for-loop_0 - loops_2 - rest_0)))) - loops_1)))))) - (for-loop_0 loops_0 bodys_0)))) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'begin hd_0) #t #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap v_1)))) d_0))) - (find-seq-loops_0 - find-loops_0 - vs_0 - lifts_0 - loop-if-tail_0 - loops_0)) - (if (if (eq? 'begin-unsafe hd_0) #t #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap v_1)))) d_0))) - (find-seq-loops_0 - find-loops_0 - vs_0 - lifts_0 - loop-if-tail_0 - loops_0)) - (if (if (eq? 'begin0 hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) #t #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((v_2 - (let ((a_0 (car p_0))) a_0))) - (let ((vs_0 - (let ((d_1 (cdr p_0))) - d_1))) - (let ((v_3 v_2)) - (values v_3 vs_0))))))) - (case-lambda - ((v_2 vs_0) - (let ((new-loops_0 - (find-loops_0 - v_2 - lifts_0 - hash2610 - loops_0))) - (if (null? vs_0) - new-loops_0 - (find-seq-loops_0 - find-loops_0 - vs_0 - lifts_0 - hash2610 - new-loops_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? 'quote hd_0) #t #f) - loops_0 - (if (if (eq? 'if hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((tst_0 - (let ((a_0 (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((thn_0 - (let ((a_0 - (car - p_1))) - a_0))) - (let ((els_0 - (let ((d_2 - (cdr - p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((thn_1 - thn_0)) - (values - thn_1 - els_0))))))) - (case-lambda - ((thn_0 els_0) - (let ((tst_1 tst_0)) - (values - tst_1 - thn_0 - els_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((tst_0 thn_0 els_0) - (let ((loops_1 - (find-loops_0 - tst_0 - lifts_0 - hash2610 - loops_0))) - (let ((loops_2 - (find-loops_0 - thn_0 - lifts_0 - loop-if-tail_0 - loops_1))) - (let ((loops_3 - (find-loops_0 - els_0 - lifts_0 - loop-if-tail_0 - loops_2))) - loops_3)))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'with-continuation-mark* - hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (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))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((d_1 (cdr (unwrap d_0)))) - (let ((p_0 (unwrap d_1))) - (let ((key_0 - (let ((a_0 - (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_2 (cdr p_0))) - (let ((p_1 - (unwrap d_2))) - (let ((val_0 - (let ((a_0 - (car - p_1))) - a_0))) - (let ((body_0 - (let ((d_3 - (cdr - p_1))) - (let ((a_0 - (car - (unwrap - d_3)))) - a_0)))) - (let ((val_1 - val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 body_0) - (let ((key_1 key_0)) - (values - key_1 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args))))))))) - (case-lambda - ((key_0 val_0 body_0) - (let ((loops_1 - (find-loops_0 - key_0 - lifts_0 - hash2610 - loops_0))) - (let ((loops_2 - (find-loops_0 - val_0 - lifts_0 - hash2610 - loops_1))) - (find-loops_0 - body_0 - lifts_0 - loop-if-tail_0 - loops_2)))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? 'set! hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 - (let ((a_0 - (car p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((id_1 id_0)) - (values - id_1 - rhs_0))))))) - (case-lambda - ((id_0 rhs_0) - (find-loops_0 - rhs_0 - lifts_0 - hash2610 - loops_0)) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - '|#%variable-reference| - hd_0) - #t - #f) - (error - 'internal-error - "lift: unexpected variable reference") - (if (if (eq? - 'call-with-values - hd_0) - (let ((a_0 - (cdr (unwrap v_1)))) - (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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((producer_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((consumer_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((producer_1 - producer_0)) - (values - producer_1 - consumer_0))))))) - (case-lambda - ((producer_0 consumer_0) - (let ((loops_1 - (find-loops_0 - producer_0 - lifts_0 - hash2610 - loops_0))) - (find-loops-in-tail-called_0 - find-loops_0 - consumer_0 - lifts_0 - loop-if-tail_0 - loops_1))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (let ((p_0 (unwrap v_1))) - (if (pair? p_0) #t #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap v_1))) - (let ((rator_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((rands_0 - (let ((d_0 - (cdr - p_0))) - d_0))) - (let ((rator_1 - rator_0)) - (values - rator_1 - rands_0)))))) - (case-lambda - ((rator_0 rands_0) - (let ((f_0 - (unwrap rator_0))) - (let ((loops_1 - (let ((c2_0 - (if (symbol? - f_0) - (hash-ref - loop-if-tail_0 - f_0 - #f) - #f))) - (if c2_0 - (begin - (set-box! - c2_0 - #t) - loops_0) - (find-loops_0 - rator_0 - lifts_0 - hash2610 - loops_0))))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (loops_2 - lst_0) - (begin - (if (pair? - lst_0) - (let ((rand_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((loops_3 - (let ((loops_3 - (find-loops_0 - rand_0 - lifts_0 - hash2610 - loops_2))) - (values - loops_3)))) - (for-loop_0 - loops_3 - rest_0)))) - loops_2)))))) - (for-loop_0 - loops_1 - rands_0)))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (let ((x_0 (unwrap v_1))) - (if (symbol? x_0) - (hash-remove loops_0 x_0) - loops_0))))))))))))))))))))))))) - (if (lift-in?_0 v_0) - (with-continuation-mark* - authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - gensym-counter - (box 0)) - (lift-in_0 find-loops_0 leave-loops-intact?_0 v_0)) - v_0))))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_0))))) + #f) + 'instance-variable-reference + (if (if (eq? + '|#%variable-reference| + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + (let ((id_0 + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (let ((u_0 + (unwrap + id_0))) + (let ((v_3 + (let ((or-part_0 + (let ((ex_0 + (hash-ref + exports_0 + u_0 + #f))) + (if ex_0 + (export-id + ex_0) + #f)))) + (if or-part_0 + or-part_0 + (let ((im_0 + (hash-ref + imports_0 + u_0 + #f))) + (if im_0 + (import-id + im_0) + #f)))))) + (if v_3 + (list + 'make-instance-variable-reference + 'instance-variable-reference + v_3) + (list + 'make-instance-variable-reference + 'instance-variable-reference + (list + 'quote + (if (hash-ref + mutated_0 + u_0 + #f) + 'mutable + (if (hash-ref + prim-knowns_0 + u_0 + #f) + u_0 + 'constant)))))))) + (if (if (eq? + 'equal? + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + d_0))) + (let ((exp1_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((exp2_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((exp1_1 + exp1_0)) + (values + exp1_1 + exp2_0))))))) + (case-lambda + ((exp1_0 + exp2_0) + (let ((exp1_1 + (schemify_0 + exp1_0 + 'fresh))) + (let ((exp2_1 + (schemify_0 + exp2_0 + 'fresh))) + (let ((exp1_2 + exp1_1)) + (if (eq? + exp1_2 + exp2_1) + #t + (if (let ((or-part_0 + (equal-implies-eq? + exp1_2))) + (if or-part_0 + or-part_0 + (equal-implies-eq? + exp2_1))) + (list + 'eq? + exp1_2 + exp2_1) + (if (let ((or-part_0 + (equal-implies-eqv? + exp1_2))) + (if or-part_0 + or-part_0 + (equal-implies-eqv? + exp2_1))) + (list + 'eqv? + exp1_2 + exp2_1) + (left-to-right/app + 'equal? + (list + exp1_2 + exp2_1) + #f + target_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0)))))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'call-with-values + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + d_0))) + (let ((generator_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((receiver_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((generator_1 + generator_0)) + (values + generator_1 + receiver_0))))))) + (case-lambda + ((generator_0 + receiver_0) + (if (if (lambda?.1 + #f + generator_0) + (let ((or-part_0 + (lambda?.1 + #f + receiver_0))) + (if or-part_0 + or-part_0 + (eq? + (unwrap + receiver_0) + 'list))) + #f) + (let ((app_0 + (schemify_0 + generator_0 + 'fresh))) + (list + 'call-with-values + app_0 + (schemify_0 + receiver_0 + 'fresh))) + (let ((app_0 + (if (eq? + target_0 + 'cify) + 'call-with-values + '|#%call-with-values|))) + (left-to-right/app + app_0 + (let ((app_1 + (schemify_0 + generator_0 + 'fresh))) + (list + app_1 + (schemify_0 + receiver_0 + 'fresh))) + #f + target_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'single-flonum-available? + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_0))))) + #f) + (eq? + target_0 + 'cify) + (if (let ((p_0 + (unwrap + v_2))) + (if (pair? + p_0) + (if (let ((a_0 + (car + p_0))) + (let ((p_1 + (unwrap + a_0))) + (if (pair? + p_1) + (if (let ((a_1 + (car + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + 'letrec-values))) + (eq? + app_0 + (unwrap + a_1))))) + (let ((a_1 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_1))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (let ((a_3 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f))) + #f) + #f))) + (let ((a_0 + (cdr + p_0))) + (wrap-list? + a_0)) + #f) + #f)) + (call-with-values + (lambda () + (let ((p_0 + (unwrap + v_2))) + (call-with-values + (lambda () + (let ((a_0 + (car + p_0))) + (let ((d_0 + (cdr + (unwrap + a_0)))) + (let ((p_1 + (unwrap + d_0))) + (let ((binds_0 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rator_0 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((binds_1 + binds_0)) + (values + binds_1 + rator_0)))))))) + (case-lambda + ((binds_0 + rator_0) + (let ((rands_0 + (let ((d_0 + (cdr + p_0))) + (unwrap-list + d_0)))) + (let ((binds_1 + binds_0) + (rator_1 + rator_0)) + (values + binds_1 + rator_1 + rands_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((binds_0 + rator_0 + rands_0) + (schemify_0 + (list + 'letrec-values + binds_0 + (list* + rator_0 + rands_0)) + wcm-state_2)) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (let ((p_0 + (unwrap + v_2))) + (if (pair? + p_0) + (let ((a_0 + (cdr + p_0))) + (wrap-list? + a_0)) + #f)) + (call-with-values + (lambda () + (let ((p_0 + (unwrap + v_2))) + (let ((rator_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((exps_0 + (let ((d_0 + (cdr + p_0))) + (unwrap-list + d_0)))) + (let ((rator_1 + rator_0)) + (values + rator_1 + exps_0)))))) + (case-lambda + ((rator_0 + exps_0) + (letrec* + ((left-left-lambda-convert_0 + (|#%name| + left-left-lambda-convert + (lambda (rator_1 + inline-fuel_1) + (begin + (let ((hd_1 + (let ((p_0 + (unwrap + rator_1))) + (if (pair? + p_0) + (unwrap + (car + p_0)) + #f)))) + (if (if (eq? + 'lambda + hd_1) + (let ((a_0 + (cdr + (unwrap + rator_1)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (wrap-list? + a_1)) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + rator_1)))) + (let ((p_0 + (unwrap + d_0))) + (let ((formal-args_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((bodys_0 + (let ((d_1 + (cdr + p_0))) + (unwrap-list + d_1)))) + (let ((formal-args_1 + formal-args_0)) + (values + formal-args_1 + bodys_0))))))) + (case-lambda + ((formal-args_0 + bodys_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (formal-args_1 + args_0 + binds_0) + (begin + (if (null? + formal-args_1) + (if (null? + args_0) + (schemify/knowns_0 + knowns_1 + inline-fuel_1 + wcm-state_2 + (list* + 'let-values + (reverse$1 + binds_0) + bodys_0)) + #f) + (if (null? + args_0) + #f + (if (not + (pair? + formal-args_1)) + (loop_0 + '() + '() + (cons + (list + (list + formal-args_1) + (if (null? + args_0) + ''() + (cons + 'list + args_0))) + binds_0)) + (let ((app_0 + (cdr + formal-args_1))) + (let ((app_1 + (cdr + args_0))) + (loop_0 + app_0 + app_1 + (cons + (let ((app_2 + (list + (car + formal-args_1)))) + (list + app_2 + (car + args_0))) + binds_0)))))))))))) + (loop_0 + formal-args_0 + exps_0 + '()))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'case-lambda + hd_1) + (let ((a_0 + (cdr + (unwrap + rator_1)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (if (let ((a_1 + (car + p_0))) + (let ((p_1 + (unwrap + a_1))) + (if (pair? + p_1) + (let ((a_2 + (cdr + p_1))) + (wrap-list? + a_2)) + #f))) + #t + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + rator_1)))) + (let ((p_0 + (unwrap + d_0))) + (call-with-values + (lambda () + (let ((a_0 + (car + p_0))) + (let ((p_1 + (unwrap + a_0))) + (let ((formal-args_0 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((bodys_0 + (let ((d_1 + (cdr + p_1))) + (unwrap-list + d_1)))) + (let ((formal-args_1 + formal-args_0)) + (values + formal-args_1 + bodys_0))))))) + (case-lambda + ((formal-args_0 + bodys_0) + (let ((rest_0 + (let ((d_1 + (cdr + p_0))) + d_1))) + (let ((formal-args_1 + formal-args_0) + (bodys_1 + bodys_0)) + (values + formal-args_1 + bodys_1 + rest_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((formal-args_0 + bodys_0 + rest_0) + (let ((or-part_0 + (left-left-lambda-convert_0 + (list* + 'lambda + formal-args_0 + bodys_0) + inline-fuel_1))) + (if or-part_0 + or-part_0 + (left-left-lambda-convert_0 + (list* + 'case-lambda + rest_0) + inline-fuel_1)))) + (args + (raise-binding-result-arity-error + 3 + args)))) + #f)))))))) + (let ((inline-rator_0 + (|#%name| + inline-rator + (lambda () + (begin + (let ((u-rator_0 + (unwrap + rator_0))) + (if allow-inline?_0 + (if (symbol? + u-rator_0) + (call-with-values + (lambda () + (find-known+import + u-rator_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0)) + (case-lambda + ((k_0 + im_0) + (if (known-procedure/can-inline? + k_0) + (let ((app_0 + (inline-clone + k_0 + im_0 + add-import!_0 + mutated_0 + imports_0))) + (left-left-lambda-convert_0 + app_0 + (sub1 + inline-fuel_0))) + #f)) + (args + (raise-binding-result-arity-error + 2 + args)))) + #f) + #f))))))) + (let ((maybe-tmp_0 + (|#%name| + maybe-tmp + (lambda (e_0 + name_0) + (begin + (if (simple/can-copy? + e_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0) + e_0 + (deterministic-gensym + name_0))))))) + (let ((wrap-tmp_0 + (|#%name| + wrap-tmp + (lambda (tmp_0 + e_0 + body_0) + (begin + (if (eq? + tmp_0 + e_0) + body_0 + (list + 'let + (list + (list + tmp_0 + e_0)) + body_0))))))) + (let ((inline-struct-constructor_0 + (|#%name| + inline-struct-constructor + (lambda (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 + type-id_0 + 'fresh) + args_0) + #f + target_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0) + #f))))))) + (let ((inline-struct-predicate_0 + (|#%name| + inline-struct-predicate + (lambda (k_0 + s-rator_0 + im_0 + args_0) + (begin + (let ((type-id_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) + #f) + #f))) + (if type-id_0 + (let ((tmp_0 + (maybe-tmp_0 + (car + args_0) + 'v))) + (let ((ques_0 + (list + 'unsafe-struct? + tmp_0 + (schemify_0 + type-id_0 + 'fresh)))) + (wrap-tmp_0 + tmp_0 + (car + args_0) + ques_0))) + #f))))))) + (let ((inline-field-access_0 + (|#%name| + inline-field-access + (lambda (k_0 + s-rator_0 + im_0 + args_0) + (begin + (let ((type-id_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))) + (if type-id_0 + (let ((tmp_0 + (maybe-tmp_0 + (car + args_0) + 'v))) + (let ((sel_0 + (if unsafe-mode?_0 + (list + 'unsafe-struct*-ref + tmp_0 + (known-field-accessor-pos + k_0)) + (let ((app_0 + (list + 'unsafe-struct? + tmp_0 + (schemify_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))))))) + (let ((inline-field-mutate_0 + (|#%name| + inline-field-mutate + (lambda (k_0 + s-rator_0 + im_0 + args_0) + (begin + (let ((type-id_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) + #f) + #f))) + (if type-id_0 + (let ((tmp_0 + (maybe-tmp_0 + (car + args_0) + 'v))) + (let ((tmp-rhs_0 + (maybe-tmp_0 + (cadr + args_0) + 'rhs))) + (let ((mut_0 + (if unsafe-mode?_0 + (list + 'unsafe-struct*-set! + tmp_0 + (known-field-mutator-pos + k_0) + tmp-rhs_0) + (let ((app_0 + (list + 'unsafe-struct? + tmp_0 + (schemify_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 + app_0 + (wrap-tmp_0 + tmp-rhs_0 + (cadr + args_0) + mut_0)))))) + #f))))))) + (let ((or-part_0 + (left-left-lambda-convert_0 + rator_0 + inline-fuel_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (if (positive? + inline-fuel_0) + (inline-rator_0) + #f))) + (if or-part_1 + or-part_1 + (let ((s-rator_0 + (schemify_0 + rator_0 + 'fresh))) + (let ((args_0 + (schemify-body_0 + exps_0 + 'fresh))) + (let ((u-rator_0 + (unwrap + rator_0))) + (let ((args_1 + args_0) + (s-rator_1 + s-rator_0)) + (call-with-values + (lambda () + (find-known+import + u-rator_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0)) + (case-lambda + ((k_0 + im_0) + (let ((c6_0 + (let ((or-part_2 + (if (eq? + rator_0 + 'ptr-ref) + (inline-ptr-ref + args_1) + #f))) + (if or-part_2 + or-part_2 + (if (eq? + rator_0 + 'ptr-set!) + (inline-ptr-set + args_1) + #f))))) + (if c6_0 + (let ((app_0 + (car + c6_0))) + (left-to-right/app + app_0 + (cdr + c6_0) + #f + target_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0)) + (let ((c5_0 + (if im_0 + (if (known-struct-constructor? + k_0) + (inline-struct-constructor_0 + k_0 + s-rator_1 + im_0 + args_1) + #f) + #f))) + (if c5_0 + c5_0 + (let ((c4_0 + (if im_0 + (if (known-struct-predicate? + k_0) + (inline-struct-predicate_0 + k_0 + s-rator_1 + im_0 + args_1) + #f) + #f))) + (if c4_0 + c4_0 + (let ((c3_0 + (if im_0 + (if (known-field-accessor? + k_0) + (inline-field-access_0 + k_0 + s-rator_1 + im_0 + args_1) + #f) + #f))) + (if c3_0 + c3_0 + (let ((c2_0 + (if im_0 + (if (known-field-mutator? + k_0) + (inline-field-mutate_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 + (known-procedure/has-unsafe-alternate + k_0) + args_1 + #f + target_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0) + (left-to-right/app + s-rator_1 + args_1 + (if (if (not + (eq? + target_0 + 'system)) + (known-procedure/no-return? + k_0) + #f) + '|#%app/no-return| + (if (if im_0 + (known-procedure/single-valued? + k_0) + #f) + '|#%app/value| + (if (let ((or-part_2 + (known-procedure? + k_0))) + (if or-part_2 + or-part_2 + (lambda?.1 + #f + rator_0))) + #f + '|#%app|))) + target_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0))))))))))))) + (args + (raise-binding-result-arity-error + 2 + args))))))))))))))))))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (let ((u-v_0 + (unwrap + v_2))) + (if (not + (symbol? + u-v_0)) + v_2 + (if (eq? + u-v_0 + 'call-with-values) + '|#%call-with-values| + (let ((state_0 + (hash-ref + mutated_0 + u-v_0 + #f))) + (let ((c9_0 + (if (via-variable-mutated-state? + state_0) + (hash-ref + exports_0 + u-v_0 + #f) + #f))) + (if c9_0 + (if (too-early-mutated-state? + state_0) + (list + 'variable-ref + (export-id + c9_0)) + (list + 'variable-ref/no-check + (export-id + c9_0))) + (let ((c8_0 + (hash-ref + imports_0 + u-v_0 + #f))) + (if c8_0 + (let ((k_0 + (import-lookup + c8_0))) + (if (known-constant? + k_0) + (if (known-literal? + k_0) + (wrap-literal + (known-literal-value + k_0)) + (if (if (known-copy? + k_0) + (hash-ref + prim-knowns_0 + (known-copy-id + k_0) + #f) + #f) + (known-copy-id + k_0) + (import-id + c8_0))) + (list + 'variable-ref/no-check + (import-id + c8_0)))) + (let ((c7_0 + (hash-ref + knowns_1 + u-v_0 + #f))) + (if c7_0 + (if (if (known-copy? + c7_0) + (simple-mutated-state? + (hash-ref + mutated_0 + u-v_0 + #f)) + #f) + (schemify_0 + (known-copy-id + c7_0) + wcm-state_2) + v_2) + (if (if (too-early-mutated-state? + state_0) + (not + (eq? + target_0 + 'cify)) + #f) + (list + 'check-not-unsafe-undefined + v_2 + (list + 'quote + (too-early-mutated-state-name + state_0 + u-v_0))) + v_2)))))))))))))))))))))))))))))))))))))))))))))))) + (optimize + s-v_0 + prim-knowns_0 + primitives_0 + knowns_1 + imports_0 + mutated_0)))))) + (schemify-body_0 + (|#%name| + schemify-body + (lambda (l_0 wcm-state_2) + (begin + (if (null? l_0) + null + (if (null? (cdr l_0)) + (list (schemify_0 (car l_0) wcm-state_2)) + (let ((app_0 (schemify_0 (car l_0) 'fresh))) + (cons + app_0 + (schemify-body_0 (cdr l_0) wcm-state_2)))))))))) + (schemify_0 v_1 wcm-state_1))))))) + (schemify/knowns_0 knowns_0 8 wcm-state_0 v_0)))) (define struct:convert-mode (make-record-type-descriptor* 'convert-mode #f #f #f #f 4 0)) (define effect_2645 @@ -40488,1201 +29654,2311 @@ 'no-more-conversions?)))))) (define lifts-id (string->uninterned-symbol "_jits")) (define jitify-schemified-linklet - (letrec ((procz14 - (|#%name| - record-size! - (lambda (v_0 sizes_0 size_0) - (begin (begin (hash-set! sizes_0 v_0 size_0) size_0))))) - (procz13 - (|#%name| - add-lift - (lambda (e_0 lifts_0) - (begin - (let ((app_0 - (list 'unsafe-vector-ref lifts-id (car lifts_0)))) - (values - app_0 - (let ((app_1 (add1 (car lifts_0)))) - (cons app_1 (cons e_0 (cdr lifts_0)))))))))) - (procz12 - (|#%name| - lifts->datum - (lambda (v_0) (begin (list->vector (reverse$1 (cdr v_0))))))) - (procz11 - (|#%name| no-lifts? (lambda (v_0) (begin (zero? (car v_0)))))) - (procz10 - (|#%name| - convert-mode-need-lift? - (lambda (cm_0) - (begin - (if (convert-mode? cm_0) - (convert-mode-lift? cm_0) - (eq? 'lift (cdr cm_0))))))) - (procz9 - (|#%name| - convert-mode-box-mutables? - (lambda (cm_0) - (begin - (if (convert-mode? cm_0) - (not (convert-mode-no-more-conversions? cm_0)) - #t))))) - (procz8 - (|#%name| - convert-mode-called - (lambda (cm_0) - (begin - (if (convert-mode? cm_0) - (if (convert-mode? cm_0) - (let ((app_0 (convert-mode-sizes cm_0))) - (let ((app_1 (convert-mode-lift? cm_0))) - (convert-mode1.1 - app_0 - #t - app_1 - (convert-mode-no-more-conversions? cm_0)))) - (raise-argument-error 'struct-copy "convert-mode?" cm_0)) - (if (eq? 'no-lift (cdr cm_0)) - '(called . no-lift) - '(called . lift))))))) - (procz7 - (|#%name| - convert-mode-non-tail - (lambda (cm_0) - (begin - (if (convert-mode? cm_0) - (if (convert-mode? cm_0) - (let ((app_0 (convert-mode-sizes cm_0))) - (let ((app_1 (convert-mode-lift? cm_0))) - (convert-mode1.1 - app_0 - #f - app_1 - (convert-mode-no-more-conversions? cm_0)))) - (raise-argument-error 'struct-copy "convert-mode?" cm_0)) - (if (eq? 'no-lift (cdr cm_0)) - '(not-called . no-lift) - '(not-called . lift))))))) - (procz6 - (|#%name| - body->expr - (lambda (body_0) - (begin - (if (if (begin-unsafe (pair? (unwrap body_0))) - (let ((v_0 (wrap-cdr body_0))) - (begin-unsafe (null? (unwrap v_0)))) - #f) - (wrap-car body_0) - (list* 'begin body_0)))))) - (procz5 - (|#%name| - deactivate-self - (lambda (env_0 name_0) - (begin - (if name_0 - (let ((u_0 (unwrap name_0))) - (let ((v_0 (hash-ref env_0 u_0 #f))) - (let ((hd_0 - (let ((p_0 (unwrap v_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'self hd_0) - (let ((a_0 (cdr (unwrap v_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))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_2))))) - #f))) - #f))) - #f) - (let ((m_0 - (let ((d_0 (cdr (unwrap v_0)))) - (let ((a_0 (car (unwrap d_0)))) a_0)))) - (hash-set env_0 u_0 m_0)) - env_0)))) - env_0))))) - (procz4 - (|#%name| - add-self - (lambda (env_0 mutables_0 name_0) - (begin - (let ((u_0 (unwrap name_0))) - (if (hash-ref mutables_0 u_0 #f) - env_0 - (hash-set - env_0 - u_0 - (list 'self (hash-ref env_0 u_0 kw2846))))))))) - (procz3 (lambda (var_0) #t)) - (procz2 - (|#%name| - lambda? - (lambda (v_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap v_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) #t #f) - #t - (if (if (eq? 'case-lambda hd_0) #t #f) #t #f))))))) - (procz1 - (|#%name| - idarity-mask_0 argss_0))) + (let ((i-name_0 + (let ((or-part_0 + (wrap-property v_1 'inferred-name))) + (if or-part_0 or-part_0 name_0)))) + (if (if (null? captures_0) + (no-lifts?_0 body-lifts_0) + #f) + (let ((e_0 + (|#%app| + extractable-annotation_0 + jitted-proc_0 + arity-mask_0 + i-name_0))) + (call-with-values + (lambda () + (if (convert-mode-need-lift?_0 convert-mode_0) + (add-lift_0 e_0 lifts_0) + (values (list 'quote e_0) lifts_0))) + (case-lambda + ((get-e_0 new-lifts_0) + (values + (if need-extract?_0 + (list 'jitified-extract-closed get-e_0) + get-e_0) + new-lifts_0)) + (args + (raise-binding-result-arity-error 2 args))))) + (let ((e_0 + (|#%app| + extractable-annotation_0 + (reannotate + v_1 + (list + 'lambda + (if (no-lifts?_0 body-lifts_0) + captures_0 + (cons lifts-id captures_0)) + jitted-proc_0)) + arity-mask_0 + i-name_0))) + (call-with-values + (lambda () + (if (no-lifts?_0 body-lifts_0) + (values captures_0 lifts_0) + (if (not + (convert-mode-need-lift?_0 + convert-mode_0)) + (values + (cons + (list + 'quote + (lifts->datum_0 body-lifts_0)) + captures_0) + lifts_0) + (call-with-values + (lambda () + (add-lift_0 + (lifts->datum_0 body-lifts_0) + lifts_0)) + (case-lambda + ((get-sub-lift_0 new-lifts_0) + (values + (cons get-sub-lift_0 captures_0) + new-lifts_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((all-captures_0 new-lifts_0) + (call-with-values + (lambda () + (if (convert-mode-need-lift?_0 + convert-mode_0) + (add-lift_0 e_0 new-lifts_0) + (values (list 'quote e_0) new-lifts_0))) + (case-lambda + ((get-e_0 newer-lifts_0) + (values + (if need-extract?_0 + (list* + (list 'jitified-extract get-e_0) + all-captures_0) + (list* get-e_0 all-captures_0)) + newer-lifts_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args))))))))))))))))) + (top_0 + (|#%name| + top + (lambda () + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_1 env_0) + (begin + (let ((hd_0 + (let ((p_0 (unwrap v_1))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) #t #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((args_0 (let ((a_0 (car p_0))) a_0))) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((args_1 args_0)) + (values args_1 body_0))))))) + (case-lambda + ((args_0 body_0) + (let ((new-body_0 + (jitify-schemified-body_0 + body_0 + (plain-add-args_0 env_0 args_0)))) + (reannotate + v_1 + (list* 'lambda args_0 new-body_0)))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'let* hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (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))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((bindings_0 + (let ((a_0 (car p_0))) a_0))) + (let ((body_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 (car (unwrap d_1)))) + a_0)))) + (let ((bindings_1 bindings_0)) + (values bindings_1 body_0))))))) + (case-lambda + ((bindings_0 body_0) + (let ((new-body_0 + (loop_0 + body_0 + (add-bindings_0 env_0 bindings_0)))) + (reannotate + v_1 + (list 'let* bindings_0 new-body_0)))) + (args (raise-binding-result-arity-error 2 args)))) + (error 'match "failed ~e" v_1))))))))) + (loop_0 v_0 hash2610)))))) + (jitify-schemified-body_0 + (|#%name| + jitify-schemified-body + (lambda (body_0 env_0) + (begin + (let ((top-env_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (env_1 lst_0) + (begin + (if (pair? lst_0) + (let ((v_1 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((env_2 + (let ((env_2 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_2 env_2) + (begin + (let ((hd_0 + (let ((p_0 + (unwrap + v_2))) + (if (pair? + p_0) (unwrap - a_0))) - (if (pair? p_0) - (let ((a_1 + (car p_0)) + #f)))) + (if (if (eq? + 'variable-set! + hd_0) + (let ((a_0 (cdr - p_0))) - (let ((p_1 + (unwrap + v_2)))) + (let ((p_0 (unwrap - a_1))) + a_0))) (if (pair? - p_1) - (let ((a_2 + p_0) + (let ((a_1 (cdr - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) + p_0))) + (let ((p_1 + (unwrap + a_1))) + (if (pair? + p_1) + #t + #f))) #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - d_0))) - (let ((id_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((id_1 - id_0)) - (values - id_1 - rhs_0))))))) - (case-lambda - ((id_0 rhs_0) - (let ((self-env_0 - (add-self_0 - (unsafe-unbox* - top-env_0) - hash2610 - id_0))) - (reannotate - v_0 - (list - 'define - id_0 - (jitify-top-expr_0 - rhs_0 - self-env_0 - id_0))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'define-values - hd_0) - (let ((a_0 - (cdr - (unwrap - v_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - v_0)))) - (let ((p_0 - (unwrap - d_0))) - (let ((ids_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_0))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + d_0))) + (let ((var-id_0 (let ((a_0 (car - (unwrap - d_1)))) - a_0)))) - (let ((ids_1 - ids_0)) - (values - ids_1 - rhs_0))))))) - (case-lambda - ((ids_0 rhs_0) - (reannotate - v_0 - (list - 'define-values - ids_0 - (jitify-top-expr_0 - rhs_0 - (unsafe-unbox* - top-env_0) - #f)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'begin - hd_0) - #t - #f) - (let ((vs_0 + p_0))) + a_0))) + (let ((id_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((var-id_1 + var-id_0)) + (values + var-id_1 + id_0))))))) + (case-lambda + ((var-id_0 id_0) + (let ((app_0 + (unwrap + id_0))) + (hash-set + env_2 + app_0 + (list + 'variable-ref + (unwrap + var-id_0))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'variable-set!/define + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (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) + #t + #f))) + #f))) + #f) + (call-with-values + (lambda () (let ((d_0 (cdr (unwrap - v_0)))) - d_0))) - (reannotate - v_0 - (list* - 'begin - (loop_2 - add-self_0 - jitify-top-expr_0 - top-env_0 - vs_0)))) - (jitify-top-expr_0 - v_0 - (unsafe-unbox* - top-env_0) - #f)))))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null body_0)))))))) - (loop_3 - (|#%name| - loop - (lambda (convert-mode-non-tail_0 - convert-mode_0 - env_0 - in-name_0 - jitify-expr_0 - mutables_0 - name_0 - vs_0 - free_0 - lifts_0) - (begin - (if (begin-unsafe (null? (unwrap vs_0))) - (values null free_0 lifts_0) - (if (let ((v_0 (wrap-cdr vs_0))) - (begin-unsafe (null? (unwrap v_0)))) - (call-with-values - (lambda () - (jitify-expr_0 - (wrap-car vs_0) + v_2)))) + (let ((p_0 + (unwrap + d_0))) + (let ((var-id_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((id_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((var-id_1 + var-id_0)) + (values + var-id_1 + id_0))))))) + (case-lambda + ((var-id_0 + id_0) + (let ((app_0 + (unwrap + id_0))) + (hash-set + env_2 + app_0 + (list + 'variable-ref + (unwrap + var-id_0))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'call-with-module-prompt + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (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) + (if (let ((a_2 + (car + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + 'quote))) + (eq? + app_0 + (unwrap + a_3))))) + (let ((a_3 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? + p_3) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f))) + #f) + #f))) + (let ((a_2 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (let ((a_3 + (cdr + p_2))) + (wrap-list? + a_3)) + #f))) + #f) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((d_1 + (cdr + (unwrap + d_0)))) + (let ((p_0 + (unwrap + d_1))) + (let ((ids_0 + (let ((a_0 + (car + p_0))) + (let ((d_2 + (cdr + (unwrap + a_0)))) + (let ((a_1 + (car + (unwrap + d_2)))) + a_1))))) + (let ((var-ids_0 + (let ((d_2 + (cdr + p_0))) + (let ((d_3 + (cdr + (unwrap + d_2)))) + (unwrap-list + d_3))))) + (let ((ids_1 + ids_0)) + (values + ids_1 + var-ids_0)))))))) + (case-lambda + ((ids_0 + var-ids_0) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (env_3 + lst_1 + lst_2) + (begin + (if (if (pair? + lst_1) + (pair? + lst_2) + #f) + (let ((id_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((var-id_0 + (unsafe-car + lst_2))) + (let ((rest_2 + (unsafe-cdr + lst_2))) + (let ((env_4 + (let ((env_4 + (let ((app_0 + (unwrap + id_0))) + (hash-set + env_3 + app_0 + (list + 'variable-ref + (unwrap + var-id_0)))))) + (values + env_4)))) + (for-loop_1 + env_4 + rest_1 + rest_2)))))) + env_3)))))) + (for-loop_1 + env_2 + ids_0 + var-ids_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'define + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + d_0))) + (let ((id_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_1 + id_0)) + (values + id_1 + rhs_0))))))) + (case-lambda + ((id_0 + rhs_0) + (plain-add-args_0 + env_2 + id_0 + #f)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'define-values + hd_0) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((p_0 + (unwrap + d_0))) + (let ((ids_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((ids_1 + ids_0)) + (values + ids_1 + rhs_0))))))) + (case-lambda + ((ids_0 + rhs_0) + (plain-add-args_0 + env_2 + ids_0 + #f)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'begin + hd_0) + #t + #f) + (let ((vs_0 + (let ((d_0 + (cdr + (unwrap + v_2)))) + d_0))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (env_3 + lst_1) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_1)))) + (let ((v_3 + (if (begin-unsafe + (pair? + (unwrap + lst_1))) + (wrap-car + lst_1) + lst_1))) + (let ((rest_1 + (if (begin-unsafe + (pair? + (unwrap + lst_1))) + (wrap-cdr + lst_1) + null))) + (let ((v_4 + v_3)) + (let ((env_4 + (let ((env_4 + (loop_0 + v_4 + env_3))) + (values + env_4)))) + (for-loop_1 + env_4 + rest_1))))) + env_3)))))) + (for-loop_1 + env_2 + vs_0)))) + env_2)))))))))))) + (loop_0 v_1 env_1)))) + (values env_2)))) + (for-loop_0 env_2 rest_0)))) + env_1)))))) + (for-loop_0 env_0 body_0))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (body_1) + (begin + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((v_1 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((hd_0 + (let ((p_0 + (unwrap + v_1))) + (if (pair? p_0) + (unwrap + (car p_0)) + #f)))) + (if (if (eq? + 'variable-set!/define + hd_0) + (let ((a_0 + (cdr + (unwrap + v_1)))) + (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_0 + (unwrap + 'quote))) + (eq? + app_0 + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_5))))) + #f))) + #f) + #f))) + (let ((a_3 + (cdr + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_1)))) + (let ((p_0 + (unwrap + d_0))) + (let ((var-id_0 + (let ((a_0 + (car + p_0))) + a_0))) + (call-with-values + (lambda () + (let ((d_1 + (cdr + p_0))) + (let ((p_1 + (unwrap + d_1))) + (let ((id_0 + (let ((a_0 + (car + p_1))) + a_0))) + (let ((constance_0 + (let ((d_2 + (cdr + p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + (let ((d_3 + (cdr + (unwrap + a_0)))) + (let ((a_1 + (car + (unwrap + d_3)))) + a_1)))))) + (let ((id_1 + id_0)) + (values + id_1 + constance_0))))))) + (case-lambda + ((id_0 + constance_0) + (let ((var-id_1 + var-id_0)) + (values + var-id_1 + id_0 + constance_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((var-id_0 + id_0 + constance_0) + (begin + (if constance_0 + (set! top-env_0 + (let ((app_0 + top-env_0)) + (hash-set + app_0 + (unwrap + id_0) + kw2846))) + (void)) + v_1)) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? + 'define + hd_0) + (let ((a_0 + (cdr + (unwrap + v_1)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_1)))) + (let ((p_0 + (unwrap + d_0))) + (let ((id_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_1 + id_0)) + (values + id_1 + rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (let ((self-env_0 + (add-self_0 + top-env_0 + hash2610 + id_0))) + (reannotate + v_1 + (list + 'define + id_0 + (jitify-top-expr_0 + rhs_0 + self-env_0 + id_0))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'define-values + hd_0) + (let ((a_0 + (cdr + (unwrap + v_1)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + v_1)))) + (let ((p_0 + (unwrap + d_0))) + (let ((ids_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((ids_1 + ids_0)) + (values + ids_1 + rhs_0))))))) + (case-lambda + ((ids_0 rhs_0) + (reannotate + v_1 + (list + 'define-values + ids_0 + (jitify-top-expr_0 + rhs_0 + top-env_0 + #f)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'begin + hd_0) + #t + #f) + (let ((vs_0 + (let ((d_0 + (cdr + (unwrap + v_1)))) + d_0))) + (reannotate + v_1 + (list* + 'begin + (loop_0 + vs_0)))) + (jitify-top-expr_0 + v_1 + top-env_0 + #f)))))) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 fold-var_1 rest_0)))) + fold-var_0)))))) + (for-loop_0 null body_1))))))))) + (loop_0 body_0))))))) + (jitify-top-expr_0 + (|#%name| + jitify-top-expr + (lambda (v_1 env_0 name_0) + (begin + (let ((mutables_0 (find-mutable_0 hash2610 v_1 hash2610))) + (let ((convert-mode_0 (init-convert-mode_0 v_1))) + (call-with-values + (lambda () + (jitify-expr_0 + v_1 + env_0 + mutables_0 + hash2610 + no-lifts_0 + convert-mode_0 + name_0 + #f)) + (case-lambda + ((new-v_0 free_0 lifts_0) + (if (no-lifts?_0 lifts_0) + new-v_0 + (list + 'let + (list + (list lifts-id (list 'quote (lifts->datum_0 lifts_0)))) + new-v_0))) + (args (raise-binding-result-arity-error 3 args)))))))))) + (jitify-expr_0 + (|#%name| + jitify-expr + (lambda (v_1 + env_0 + mutables_0 + free_0 + lifts_0 + convert-mode_0 + name_0 + in-name_0) + (begin + (let ((hd_0 + (let ((p_0 (unwrap v_1))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((args_0 (let ((a_0 (car p_0))) a_0))) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((args_1 args_0)) (values args_1 body_0))))))) + (case-lambda + ((args_0 body_0) + (let ((convert?_0 + (convert-mode-convert-lambda?_0 convert-mode_0 v_1))) + (let ((body-convert-mode_0 + (convert-mode-lambda-body-mode_0 + convert-mode_0 + convert?_0))) + (let ((self-env_0 + (if convert?_0 + (activate-self_0 + (deactivate-self_0 env_0 in-name_0) + name_0) + env_0))) + (let ((body-env_0 + (add-args_0 + self-env_0 + args_0 + mutables_0 + body-convert-mode_0))) + (let ((body-in-name_0 + (if convert?_0 + (if name_0 name_0 kw2615) + in-name_0))) + (let ((body-lifts_0 + (if convert?_0 no-lifts_0 lifts_0))) + (call-with-values + (lambda () + (jitify-body_0 + body_0 + body-env_0 + mutables_0 + hash2610 + body-lifts_0 + body-convert-mode_0 + #f + body-in-name_0)) + (case-lambda + ((new-body_0 lam-body-free_0 new-body-lifts_0) + (let ((lam-free_0 + (remove-args_0 + lam-body-free_0 + args_0))) + (let ((new-v_0 + (reannotate + v_1 + (list* + 'lambda + args_0 + (mutable-box-bindings_0 + args_0 + mutables_0 + body-convert-mode_0 + new-body_0))))) + (call-with-values + (lambda () + (if (not convert?_0) + (values new-v_0 new-body-lifts_0) + (make-jit-on-call_0 + lam-free_0 + (list args_0) + new-v_0 + name_0 + self-env_0 + convert-mode_0 + new-body-lifts_0 + lifts_0))) + (case-lambda + ((converted-v_0 new-lifts_0) + (values + converted-v_0 + (union-free_0 free_0 lam-free_0) + new-lifts_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (args + (raise-binding-result-arity-error + 3 + args))))))))))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'case-lambda hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (if (wrap-list? a_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (let ((result_1 + (let ((result_1 + (let ((p_0 + (unwrap v_3))) + (if (pair? p_0) + #t + #f)))) + (values result_1)))) + (if (if (not + (let ((x_0 (list v_3))) + (not result_1))) + #t + #f) + (for-loop_0 result_1 rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_0))) + #f)) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (argss_0 bodys_0 lst_0) + (begin + (if (not + (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_0 (unwrap v_3))) + (let ((argss_1 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((bodys_1 + (let ((d_1 + (cdr + p_0))) + d_1))) + (let ((argss_2 + argss_1)) + (values + argss_2 + bodys_1)))))) + (case-lambda + ((argss8_0 bodys9_0) + (values + (cons argss8_0 argss_0) + (cons bodys9_0 bodys_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((argss_1 bodys_1) + (values argss_1 bodys_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((argss_1 bodys_1) + (for-loop_0 + argss_1 + bodys_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values argss_0 bodys_0))))))) + (for-loop_0 null null d_0)))) + (case-lambda + ((argss_0 bodys_0) + (let ((app_0 (reverse$1 argss_0))) + (values app_0 (reverse$1 bodys_0)))) + (args (raise-binding-result-arity-error 2 args)))))) + (case-lambda + ((argss_0 bodys_0) + (let ((convert?_0 + (convert-mode-convert-lambda?_0 + convert-mode_0 + v_1))) + (let ((body-convert-mode_0 + (convert-mode-lambda-body-mode_0 + convert-mode_0 + convert?_0))) + (let ((self-env_0 + (if convert?_0 + (activate-self_0 + (deactivate-self_0 env_0 in-name_0) + name_0) + env_0))) + (let ((body-in-name_0 + (if convert?_0 + (if name_0 name_0 kw2615) + in-name_0))) + (let ((body-lifts_0 + (if convert?_0 no-lifts_0 lifts_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (rev-new-bodys_0 + lam-free_0 + body-lifts_1 + lst_0 + lst_1) + (begin + (if (if (pair? lst_0) + (pair? lst_1) + #f) + (let ((args_0 + (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) + (let ((body_0 + (unsafe-car lst_1))) + (let ((rest_1 + (unsafe-cdr lst_1))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((body-env_0 + (add-args_0 + self-env_0 + args_0 + mutables_0 + body-convert-mode_0))) + (call-with-values + (lambda () + (jitify-body_0 + body_0 + body-env_0 + mutables_0 + hash2610 + body-lifts_1 + body-convert-mode_0 + #f + body-in-name_0)) + (case-lambda + ((new-body_0 + lam-body-free_0 + new-body-lifts_0) + (values + (cons + new-body_0 + rev-new-bodys_0) + (union-free_0 + (remove-args_0 + lam-body-free_0 + args_0) + lam-free_0) + new-body-lifts_0)) + (args + (raise-binding-result-arity-error + 3 + args)))))) + (case-lambda + ((rev-new-bodys_1 + lam-free_1 + body-lifts_2) + (values + rev-new-bodys_1 + lam-free_1 + body-lifts_2)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((rev-new-bodys_1 + lam-free_1 + body-lifts_2) + (for-loop_0 + rev-new-bodys_1 + lam-free_1 + body-lifts_2 + rest_0 + rest_1)) + (args + (raise-binding-result-arity-error + 3 + args)))))))) + (values + rev-new-bodys_0 + lam-free_0 + body-lifts_1))))))) + (for-loop_0 + '() + hash2610 + body-lifts_0 + argss_0 + bodys_0)))) + (case-lambda + ((rev-new-bodys_0 lam-free_0 new-body-lifts_0) + (let ((new-v_0 + (reannotate + v_1 + (list* + 'case-lambda + (reverse$1 + (let ((lst_0 + (reverse$1 + rev-new-bodys_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1 + lst_2) + (begin + (if (if (pair? lst_1) + (pair? lst_2) + #f) + (let ((args_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((body_0 + (unsafe-car + lst_2))) + (let ((rest_1 + (unsafe-cdr + lst_2))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (list* + args_0 + (mutable-box-bindings_0 + args_0 + mutables_0 + body-convert-mode_0 + body_0)) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 + null + argss_0 + lst_0))))))))) + (call-with-values + (lambda () + (if (not convert?_0) + (values new-v_0 new-body-lifts_0) + (make-jit-on-call_0 + lam-free_0 + argss_0 + new-v_0 + name_0 + self-env_0 + convert-mode_0 + new-body-lifts_0 + lifts_0))) + (case-lambda + ((converted-v_0 new-lifts_0) + (values + converted-v_0 + (union-free_0 free_0 lam-free_0) + new-lifts_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (args + (raise-binding-result-arity-error + 3 + args)))))))))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'let hd_0) #t #f) + (jitify-let_0 + v_1 + env_0 + mutables_0 + free_0 + lifts_0 + convert-mode_0 + name_0 + in-name_0) + (if (if (eq? 'letrec hd_0) #t #f) + (jitify-let_0 + v_1 + env_0 + mutables_0 + free_0 + lifts_0 + convert-mode_0 + name_0 + in-name_0) + (if (if (eq? 'letrec* hd_0) #t #f) + (jitify-let_0 + v_1 env_0 mutables_0 free_0 lifts_0 convert-mode_0 name_0 - in-name_0)) - (case-lambda - ((new-v_0 new-free_0 new-lifts_0) - (values (list new-v_0) new-free_0 new-lifts_0)) - (args (raise-binding-result-arity-error 3 args)))) - (call-with-values - (lambda () - (let ((app_0 (wrap-car vs_0))) - (jitify-expr_0 - app_0 - env_0 - mutables_0 - free_0 - lifts_0 - (convert-mode-non-tail_0 convert-mode_0) - #f - in-name_0))) - (case-lambda - ((new-v_0 new-free_0 new-lifts_0) - (call-with-values - (lambda () - (loop_3 - convert-mode-non-tail_0 - convert-mode_0 - env_0 - in-name_0 - jitify-expr_0 - mutables_0 - name_0 - (wrap-cdr vs_0) - new-free_0 - new-lifts_0)) - (case-lambda - ((new-rest_0 newer-free_0 newer-lifts_0) - (values - (cons new-v_0 new-rest_0) - newer-free_0 - newer-lifts_0)) - (args (raise-binding-result-arity-error 3 args))))) - (args (raise-binding-result-arity-error 3 args)))))))))) - (loop_4 - (|#%name| - loop - (lambda (mutables_0 args_0) - (begin - (if (begin-unsafe (null? (unwrap args_0))) - null - (if (begin-unsafe (pair? (unwrap args_0))) - (let ((id_0 (wrap-car args_0))) - (let ((var_0 (unwrap id_0))) - (let ((rest_0 (loop_4 mutables_0 (wrap-cdr args_0)))) - (if (hash-ref mutables_0 var_0 #f) - (cons (list id_0 (list 'box id_0)) rest_0) - rest_0)))) - (loop_4 mutables_0 (list args_0)))))))) - (plain-add-args_0 - (|#%name| - plain-add-args - (lambda (plain-add-args_1 env4_0 args5_0 replace?3_0) - (begin - (if (let ((p_0 (unwrap args5_0))) (if (pair? p_0) #t #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap args5_0))) - (let ((id_0 (let ((a_0 (car p_0))) a_0))) - (let ((args_0 (let ((d_0 (cdr p_0))) d_0))) - (let ((id_1 id_0)) (values id_1 args_0)))))) - (case-lambda - ((id_0 args_0) - (plain-add-args_1 - (add-one_0 env4_0 replace?3_0 id_0) - args_0 - replace?3_0)) - (args (raise-binding-result-arity-error 2 args)))) - (if (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap args5_0)))) - env4_0 - (add-one_0 env4_0 replace?3_0 args5_0)))))))) - (lambda (v_0 - need-extract?_0 - need-lift?_0 - convert-size-threshold_0 - extractable-annotation_0) - (letrec* - ((make-jit-on-call_0 - (|#%name| - make-jit-on-call - (lambda (free-vars_0 - argss_0 - v_1 - name_0 - env_0 - convert-mode_0 - body-lifts_0 - lifts_0) - (begin - (let ((ids_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 i_0) - (begin - (if i_0 - (let ((id_0 - (hash-iterate-key free-vars_0 i_0))) - (let ((fold-var_1 (cons id_0 fold-var_0))) - (let ((fold-var_2 (values fold-var_1))) - (for-loop_0 - fold-var_2 - (hash-iterate-next - free-vars_0 - i_0))))) - fold-var_0)))))) - (for-loop_0 - null - (hash-iterate-first free-vars_0))))))) - (let ((idarity-mask_0 argss_0))) - (let ((i-name_0 - (let ((or-part_0 - (wrap-property v_1 'inferred-name))) - (if or-part_0 or-part_0 name_0)))) - (if (if (null? captures_0) - (no-lifts?_0 body-lifts_0) - #f) - (let ((e_0 - (|#%app| - extractable-annotation_0 - jitted-proc_0 - arity-mask_0 - i-name_0))) - (call-with-values - (lambda () - (if (convert-mode-need-lift?_0 convert-mode_0) - (add-lift_0 e_0 lifts_0) - (values (list 'quote e_0) lifts_0))) - (case-lambda - ((get-e_0 new-lifts_0) - (values - (if need-extract?_0 - (list 'jitified-extract-closed get-e_0) - get-e_0) - new-lifts_0)) - (args - (raise-binding-result-arity-error 2 args))))) - (let ((e_0 - (|#%app| - extractable-annotation_0 - (reannotate - v_1 - (list - 'lambda - (if (no-lifts?_0 body-lifts_0) - captures_0 - (cons lifts-id captures_0)) - jitted-proc_0)) - arity-mask_0 - i-name_0))) - (call-with-values - (lambda () - (if (no-lifts?_0 body-lifts_0) - (values captures_0 lifts_0) - (if (not - (convert-mode-need-lift?_0 - convert-mode_0)) - (values - (cons - (list - 'quote - (lifts->datum_0 body-lifts_0)) - captures_0) - lifts_0) - (call-with-values - (lambda () - (add-lift_0 - (lifts->datum_0 body-lifts_0) - lifts_0)) - (case-lambda - ((get-sub-lift_0 new-lifts_0) - (values - (cons get-sub-lift_0 captures_0) - new-lifts_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((all-captures_0 new-lifts_0) - (call-with-values - (lambda () - (if (convert-mode-need-lift?_0 - convert-mode_0) - (add-lift_0 e_0 new-lifts_0) - (values (list 'quote e_0) new-lifts_0))) - (case-lambda - ((get-e_0 newer-lifts_0) - (values - (if need-extract?_0 - (list* - (list 'jitified-extract get-e_0) - all-captures_0) - (list* get-e_0 all-captures_0)) - newer-lifts_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))))))))) - (top_0 - (|#%name| - top - (lambda () - (begin - (loop_0 - add-bindings_0 - jitify-schemified-body_0 - plain-add-args_1 - v_0 - hash2610))))) - (jitify-schemified-body_0 - (|#%name| - jitify-schemified-body - (lambda (body_0 env_0) - (begin - (let ((top-env_0 - (box - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (env_1 lst_0) - (begin - (if (pair? lst_0) - (let ((v_1 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((env_2 - (let ((env_2 - (loop_1 - plain-add-args_1 - v_1 - env_1))) - (values env_2)))) - (for-loop_0 env_2 rest_0)))) - env_1)))))) - (for-loop_0 env_0 body_0)))))) - (loop_2 add-self_0 jitify-top-expr_0 top-env_0 body_0)))))) - (jitify-top-expr_0 - (|#%name| - jitify-top-expr - (lambda (v_1 env_0 name_0) - (begin - (let ((mutables_0 (find-mutable_0 hash2610 v_1 hash2610))) - (let ((convert-mode_0 (init-convert-mode_0 v_1))) - (call-with-values - (lambda () - (jitify-expr_0 - v_1 - env_0 - mutables_0 - hash2610 - no-lifts_0 - convert-mode_0 - name_0 - #f)) - (case-lambda - ((new-v_0 free_0 lifts_0) - (if (no-lifts?_0 lifts_0) - new-v_0 - (list - 'let - (list - (list - lifts-id - (list 'quote (lifts->datum_0 lifts_0)))) - new-v_0))) - (args (raise-binding-result-arity-error 3 args)))))))))) - (jitify-expr_0 - (|#%name| - jitify-expr - (lambda (v_1 - env_0 - mutables_0 - free_0 - lifts_0 - convert-mode_0 - name_0 - in-name_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap v_1))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((args_0 (let ((a_0 (car p_0))) a_0))) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((args_1 args_0)) - (values args_1 body_0))))))) - (case-lambda - ((args_0 body_0) - (let ((convert?_0 - (convert-mode-convert-lambda?_0 - convert-mode_0 - v_1))) - (let ((body-convert-mode_0 - (convert-mode-lambda-body-mode_0 - convert-mode_0 - convert?_0))) - (let ((self-env_0 - (if convert?_0 - (activate-self_0 - (deactivate-self_0 env_0 in-name_0) - name_0) - env_0))) - (let ((body-env_0 - (add-args_0 - self-env_0 - args_0 - mutables_0 - body-convert-mode_0))) - (let ((body-in-name_0 - (if convert?_0 - (if name_0 name_0 kw2615) - in-name_0))) - (let ((body-lifts_0 - (if convert?_0 no-lifts_0 lifts_0))) - (call-with-values - (lambda () - (jitify-body_0 - body_0 - body-env_0 - mutables_0 - hash2610 - body-lifts_0 - body-convert-mode_0 - #f - body-in-name_0)) - (case-lambda - ((new-body_0 - lam-body-free_0 - new-body-lifts_0) - (let ((lam-free_0 - (remove-args_0 - lam-body-free_0 - args_0))) - (let ((new-v_0 - (reannotate - v_1 - (list* - 'lambda - args_0 - (mutable-box-bindings_0 - args_0 - mutables_0 - body-convert-mode_0 - new-body_0))))) - (call-with-values - (lambda () - (if (not convert?_0) - (values new-v_0 new-body-lifts_0) - (make-jit-on-call_0 - lam-free_0 - (list args_0) - new-v_0 - name_0 - self-env_0 - convert-mode_0 - new-body-lifts_0 - lifts_0))) - (case-lambda - ((converted-v_0 new-lifts_0) - (values - converted-v_0 - (union-free_0 free_0 lam-free_0) - new-lifts_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (args - (raise-binding-result-arity-error - 3 - args))))))))))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_2 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_3 v_2)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_3))) - (if (pair? p_0) - #t - #f)))) - (values result_1)))) - (if (if (not - (let ((x_0 - (list v_3))) - (not result_1))) - #t - #f) - (for-loop_0 result_1 rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_0))) - #f)) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (argss_0 bodys_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_2 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_3 v_2)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_0 - (unwrap v_3))) - (let ((argss_1 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((bodys_1 - (let ((d_1 - (cdr - p_0))) - d_1))) - (let ((argss_2 - argss_1)) - (values - argss_2 - bodys_1)))))) - (case-lambda - ((argss8_0 bodys9_0) - (values - (cons argss8_0 argss_0) - (cons - bodys9_0 - bodys_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((argss_1 bodys_1) - (values argss_1 bodys_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((argss_1 bodys_1) - (for-loop_0 - argss_1 - bodys_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values argss_0 bodys_0))))))) - (for-loop_0 null null d_0)))) - (case-lambda - ((argss_0 bodys_0) - (let ((app_0 (reverse$1 argss_0))) - (values app_0 (reverse$1 bodys_0)))) - (args (raise-binding-result-arity-error 2 args)))))) - (case-lambda - ((argss_0 bodys_0) - (let ((convert?_0 - (convert-mode-convert-lambda?_0 - convert-mode_0 - v_1))) - (let ((body-convert-mode_0 - (convert-mode-lambda-body-mode_0 - convert-mode_0 - convert?_0))) - (let ((self-env_0 - (if convert?_0 - (activate-self_0 - (deactivate-self_0 env_0 in-name_0) - name_0) - env_0))) - (let ((body-in-name_0 - (if convert?_0 - (if name_0 name_0 kw2615) - in-name_0))) - (let ((body-lifts_0 - (if convert?_0 no-lifts_0 lifts_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (rev-new-bodys_0 - lam-free_0 - body-lifts_1 - lst_0 - lst_1) - (begin - (if (if (pair? lst_0) - (pair? lst_1) - #f) - (let ((args_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((body_0 - (unsafe-car lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((body-env_0 - (add-args_0 - self-env_0 - args_0 - mutables_0 - body-convert-mode_0))) - (call-with-values - (lambda () - (jitify-body_0 - body_0 - body-env_0 - mutables_0 - hash2610 - body-lifts_1 - body-convert-mode_0 - #f - body-in-name_0)) - (case-lambda - ((new-body_0 - lam-body-free_0 - new-body-lifts_0) - (values - (cons - new-body_0 - rev-new-bodys_0) - (union-free_0 - (remove-args_0 - lam-body-free_0 - args_0) - lam-free_0) - new-body-lifts_0)) - (args - (raise-binding-result-arity-error - 3 - args)))))) - (case-lambda - ((rev-new-bodys_1 - lam-free_1 - body-lifts_2) - (values - rev-new-bodys_1 - lam-free_1 - body-lifts_2)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (case-lambda - ((rev-new-bodys_1 - lam-free_1 - body-lifts_2) - (for-loop_0 - rev-new-bodys_1 - lam-free_1 - body-lifts_2 - rest_0 - rest_1)) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (values - rev-new-bodys_0 - lam-free_0 - body-lifts_1))))))) - (for-loop_0 - '() - hash2610 - body-lifts_0 - argss_0 - bodys_0)))) - (case-lambda - ((rev-new-bodys_0 - lam-free_0 - new-body-lifts_0) - (let ((new-v_0 - (reannotate - v_1 - (list* - 'case-lambda - (reverse$1 - (let ((lst_0 - (reverse$1 - rev-new-bodys_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1 - lst_2) - (begin - (if (if (pair? lst_1) - (pair? lst_2) - #f) - (let ((args_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((body_0 - (unsafe-car - lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (list* - args_0 - (mutable-box-bindings_0 - args_0 - mutables_0 - body-convert-mode_0 - body_0)) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 - null - argss_0 - lst_0))))))))) - (call-with-values - (lambda () - (if (not convert?_0) - (values new-v_0 new-body-lifts_0) - (make-jit-on-call_0 - lam-free_0 - argss_0 - new-v_0 - name_0 - self-env_0 - convert-mode_0 - new-body-lifts_0 - lifts_0))) - (case-lambda - ((converted-v_0 new-lifts_0) - (values - converted-v_0 - (union-free_0 free_0 lam-free_0) - new-lifts_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (args - (raise-binding-result-arity-error - 3 - args)))))))))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'let hd_0) #t #f) - (jitify-let_0 - v_1 - env_0 - mutables_0 - free_0 - lifts_0 - convert-mode_0 - name_0 - in-name_0) - (if (if (eq? 'letrec hd_0) #t #f) - (jitify-let_0 - v_1 - env_0 - mutables_0 - free_0 - lifts_0 - convert-mode_0 - name_0 - in-name_0) - (if (if (eq? 'letrec* hd_0) #t #f) - (jitify-let_0 - v_1 - env_0 - mutables_0 - free_0 - lifts_0 - convert-mode_0 - name_0 - in-name_0) - (if (if (eq? 'begin hd_0) #t #f) - (let ((vs_0 (let ((d_0 (cdr (unwrap v_1)))) d_0))) - (call-with-values - (lambda () - (jitify-body_0 - vs_0 - env_0 - mutables_0 - free_0 - lifts_0 - convert-mode_0 - name_0 - in-name_0)) - (case-lambda - ((new-body_0 new-free_0 new-lifts_0) - (values - (reannotate v_1 (list* 'begin new-body_0)) - new-free_0 - new-lifts_0)) - (args - (raise-binding-result-arity-error 3 args))))) - (if (if (eq? 'begin-unsafe hd_0) #t #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap v_1)))) d_0))) - (jitify-expr_0 - (list* 'begin vs_0) - env_0 - mutables_0 - free_0 - lifts_0 - convert-mode_0 - name_0 - in-name_0)) - (if (if (eq? 'begin0 hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) #t #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((v0_0 - (let ((a_0 (car p_0))) a_0))) - (let ((vs_0 - (let ((d_1 (cdr p_0))) d_1))) - (let ((v0_1 v0_0)) - (values v0_1 vs_0))))))) - (case-lambda - ((v0_0 vs_0) - (call-with-values - (lambda () - (jitify-expr_0 - v0_0 - env_0 - mutables_0 - free_0 - lifts_0 - (convert-mode-non-tail_0 convert-mode_0) - name_0 - in-name_0)) - (case-lambda - ((new-v0_0 v0-free_0 v0-lifts_0) - (call-with-values - (lambda () - (jitify-body_0 - vs_0 - env_0 - mutables_0 - v0-free_0 - v0-lifts_0 - (convert-mode-non-tail_0 - convert-mode_0) - #f - in-name_0)) - (case-lambda - ((new-body_0 new-free_0 new-lifts_0) - (values - (reannotate - v_1 - (list* 'begin0 new-v0_0 new-body_0)) - new-free_0 - new-lifts_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (eq? '$value hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_1))))) - #f))) - #f) - (let ((e_0 - (let ((d_0 (cdr (unwrap v_1)))) - (let ((a_0 (car (unwrap d_0)))) - a_0)))) - (call-with-values - (lambda () - (jitify-expr_0 - e_0 - env_0 - mutables_0 - free_0 - lifts_0 - convert-mode_0 - name_0 - in-name_0)) - (case-lambda - ((new-e_0 new-free_0 new-lifts_0) - (values - (reannotate v_1 (list '$value new-e_0)) - new-free_0 - new-lifts_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (if (if (eq? 'if hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((tst_0 - (let ((a_0 (car p_0))) a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((thn_0 - (let ((a_0 - (car p_1))) - a_0))) - (let ((els_0 - (let ((d_2 - (cdr p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((thn_1 thn_0)) - (values - thn_1 - els_0))))))) - (case-lambda - ((thn_0 els_0) - (let ((tst_1 tst_0)) - (values tst_1 thn_0 els_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((tst_0 thn_0 els_0) - (let ((sub-convert-mode_0 - (convert-mode-non-tail_0 - convert-mode_0))) - (call-with-values - (lambda () - (jitify-expr_0 - tst_0 - env_0 - mutables_0 - free_0 - lifts_0 - sub-convert-mode_0 - #f - in-name_0)) - (case-lambda - ((new-tst_0 - new-free/tst_0 - new-lifts/tst_0) - (call-with-values - (lambda () - (jitify-expr_0 - thn_0 - env_0 - mutables_0 - new-free/tst_0 - new-lifts/tst_0 - convert-mode_0 - name_0 - in-name_0)) - (case-lambda - ((new-thn_0 - new-free/thn_0 - new-lifts/thn_0) - (call-with-values - (lambda () - (jitify-expr_0 - els_0 - env_0 - mutables_0 - new-free/thn_0 - new-lifts/thn_0 - convert-mode_0 - name_0 - in-name_0)) - (case-lambda - ((new-els_0 - new-free/els_0 - new-lifts/els_0) - (values - (reannotate - v_1 - (list - 'if - new-tst_0 - new-thn_0 - new-els_0)) - new-free/els_0 - new-lifts/els_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (args - (raise-binding-result-arity-error - 3 - args)))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? 'with-continuation-mark* hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (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))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? p_3) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((mode_0 - (let ((a_0 (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((key_0 - (let ((a_0 - (car p_1))) - a_0))) - (call-with-values - (lambda () - (let ((d_2 - (cdr p_1))) - (let ((p_2 - (unwrap - d_2))) - (let ((val_0 - (let ((a_0 - (car - p_2))) - a_0))) - (let ((body_0 - (let ((d_3 - (cdr - p_2))) - (let ((a_0 - (car - (unwrap - d_3)))) - a_0)))) - (let ((val_1 - val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 body_0) - (let ((key_1 key_0)) - (values - key_1 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((key_0 val_0 body_0) - (let ((mode_1 mode_0)) - (values - mode_1 - key_0 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (case-lambda - ((mode_0 key_0 val_0 body_0) - (let ((sub-convert-mode_0 - (convert-mode-non-tail_0 - convert-mode_0))) + ((var_0 rhs_0) (call-with-values (lambda () (jitify-expr_0 - key_0 + rhs_0 env_0 mutables_0 free_0 lifts_0 - sub-convert-mode_0 - #f + (convert-mode-non-tail_0 + convert-mode_0) + var_0 in-name_0)) (case-lambda - ((new-key_0 - new-free/key_0 - new-lifts/key_0) - (call-with-values - (lambda () - (jitify-expr_0 - val_0 - env_0 - mutables_0 - new-free/key_0 - new-lifts/key_0 - sub-convert-mode_0 - #f - in-name_0)) - (case-lambda - ((new-val_0 - new-free/val_0 - new-lifts/val_0) - (call-with-values - (lambda () - (jitify-expr_0 - body_0 - env_0 - mutables_0 - new-free/val_0 - new-lifts/val_0 - convert-mode_0 - name_0 - in-name_0)) - (case-lambda - ((new-body_0 - new-free/body_0 - new-lifts/body_0) + ((new-rhs_0 + new-free_0 + new-lifts_0) + (let ((id_0 (unwrap var_0))) + (let ((dest_0 + (hash-ref + env_0 + id_0 + #f))) + (if (if (not in-name_0) + (let ((hd_1 + (let ((p_0 + (unwrap + dest_0))) + (if (pair? + p_0) + (unwrap + (car p_0)) + #f)))) + (if (if (eq? + 'variable-ref + hd_1) + (let ((a_0 + (cdr + (unwrap + dest_0)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + #t + #f)) + #f) (values - (reannotate - v_1 - (list - 'with-continuation-mark* - mode_0 - new-key_0 - new-val_0 - new-body_0)) - new-free/body_0 - new-lifts/body_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (args - (raise-binding-result-arity-error - 3 - args))))) + (list + 'set! + var_0 + new-rhs_0) + new-free_0 + new-lifts_0) + (let ((newer-free_0 + (if dest_0 + (hash-set + new-free_0 + id_0 + dest_0) + new-free_0))) + (let ((new-v_0 + (let ((v_2 + (hash-ref + env_0 + id_0 + kw2846))) + (if (let ((a_0 + kw2846)) + (begin-unsafe + (let ((app_0 + (unwrap + a_0))) + (eq? + app_0 + (unwrap + v_2))))) + (reannotate + v_1 + (list + 'set! + var_0 + new-rhs_0)) + (if (let ((p_0 + (unwrap + v_2))) + (if (pair? + p_0) + (if (let ((a_0 + (car + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + 'self))) + (eq? + app_0 + (unwrap + a_0))))) + (let ((a_0 + (cdr + p_0))) + (let ((p_1 + (unwrap + a_0))) + (if (pair? + p_1) + #t + #f))) + #f) + #f)) + (let ((m_0 + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (error + 'set! + "[internal error] self-referenceable ~s" + id_0)) + (if (let ((p_0 + (unwrap + v_2))) + (if (pair? + p_0) + (if (let ((a_0 + (car + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + 'variable-ref))) + (eq? + app_0 + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + #f)) + (let ((var-id_0 + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (reannotate + v_1 + (list + 'variable-set! + var-id_0 + new-rhs_0))) + (if (let ((p_0 + (unwrap + v_2))) + (if (pair? + p_0) + (if (let ((a_0 + (car + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + 'unsafe-unbox*))) + (eq? + app_0 + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + #f)) + (let ((box-id_0 + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (reannotate + v_1 + (list + 'set-box*! + box-id_0 + new-rhs_0))) + (error + 'match + "failed ~e" + v_2)))))))) + (values + new-v_0 + newer-free_0 + new-lifts_0))))))) (args (raise-binding-result-arity-error 3 - args)))))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (if (if (eq? 'quote hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_1))))) - #f))) - #f) - (values v_1 free_0 lifts_0) - (if (if (eq? 'set! hd_0) + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? 'call-with-values hd_0) (let ((a_0 (cdr (unwrap v_1)))) (let ((p_0 (unwrap a_0))) (if (pair? p_0) @@ -42883,10 +32279,10 @@ (lambda () (let ((d_0 (cdr (unwrap v_1)))) (let ((p_0 (unwrap d_0))) - (let ((var_0 + (let ((proc1_0 (let ((a_0 (car p_0))) a_0))) - (let ((rhs_0 + (let ((proc2_0 (let ((d_1 (cdr p_0))) (let ((a_0 @@ -42894,29 +32290,302 @@ (unwrap d_1)))) a_0)))) - (let ((var_1 var_0)) + (let ((proc1_1 proc1_0)) (values - var_1 - rhs_0))))))) + proc1_1 + proc2_0))))))) (case-lambda - ((var_0 rhs_0) - (call-with-values - (lambda () - (jitify-expr_0 - rhs_0 - env_0 - mutables_0 - free_0 - lifts_0 - (convert-mode-non-tail_0 - convert-mode_0) - var_0 - in-name_0)) - (case-lambda - ((new-rhs_0 - new-free_0 - new-lifts_0) - (let ((id_0 (unwrap var_0))) + ((proc1_0 proc2_0) + (let ((proc-convert-mode_0 + (convert-mode-called_0 + convert-mode_0))) + (call-with-values + (lambda () + (jitify-expr_0 + proc1_0 + env_0 + mutables_0 + free_0 + lifts_0 + proc-convert-mode_0 + #f + in-name_0)) + (case-lambda + ((new-proc1_0 + new-free1_0 + new-lifts1_0) + (call-with-values + (lambda () + (jitify-expr_0 + proc2_0 + env_0 + mutables_0 + new-free1_0 + new-lifts1_0 + proc-convert-mode_0 + #f + in-name_0)) + (case-lambda + ((new-proc2_0 + new-free2_0 + new-lifts2_0) + (let ((call-with-values-id_0 + (if (if (lambda?_0 + new-proc1_0) + (lambda?_0 + new-proc2_0) + #f) + 'call-with-values + '|#%call-with-values|))) + (values + (reannotate + v_1 + (list + call-with-values-id_0 + new-proc1_0 + new-proc2_0)) + new-free2_0 + new-lifts2_0))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (args + (raise-binding-result-arity-error + 3 + args)))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'call-with-module-prompt + hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (wrap-list? a_1)) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((proc_0 + (let ((a_0 + (car p_0))) + a_0))) + (let ((var-info_0 + (let ((d_1 + (cdr p_0))) + (unwrap-list + d_1)))) + (let ((proc_1 proc_0)) + (values + proc_1 + var-info_0))))))) + (case-lambda + ((proc_0 var-info_0) + (let ((proc-convert-mode_0 + (convert-mode-called_0 + convert-mode_0))) + (call-with-values + (lambda () + (jitify-expr_0 + proc_0 + env_0 + mutables_0 + free_0 + lifts_0 + proc-convert-mode_0 + #f + in-name_0)) + (case-lambda + ((new-proc_0 + new-free_0 + new-lifts_0) + (values + (reannotate + v_1 + (list* + 'call-with-module-prompt + new-proc_0 + var-info_0)) + new-free_0 + new-lifts_0)) + (args + (raise-binding-result-arity-error + 3 + args)))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? '|#%app| hd_0) + (let ((a_0 + (cdr (unwrap v_1)))) + (wrap-list? a_0)) + #f) + (call-with-values + (lambda () + (let ((app_0 (wrap-cdr v_1))) + (jitify-body_0 + app_0 + env_0 + mutables_0 + free_0 + lifts_0 + (convert-mode-non-tail_0 + convert-mode_0) + #f + in-name_0))) + (case-lambda + ((new-vs_0 + new-free_0 + new-lifts_0) + (values + (reannotate + v_1 + (list* '|#%app| new-vs_0)) + new-free_0 + new-lifts_0)) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (let ((p_0 (unwrap v_1))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (wrap-list? a_0)) + #f)) + (let ((rator_0 + (let ((a_0 + (car + (unwrap v_1)))) + a_0))) + (let ((u_0 (unwrap rator_0))) + (let ((v_2 + (if (symbol? u_0) + (hash-ref + env_0 + u_0 + #f) + #f))) + (let ((hd_1 + (let ((p_0 + (unwrap + v_2))) + (if (pair? p_0) + (unwrap + (car p_0)) + #f)))) + (if (if (eq? + 'self + hd_1) + (let ((a_0 + (cdr + (unwrap + v_2)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (let ((orig-id_0 + (let ((d_0 + (cdr + (unwrap + v_2)))) + (let ((d_1 + (cdr + (unwrap + d_0)))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0))))) + (call-with-values + (lambda () + (let ((app_0 + (wrap-cdr + v_1))) + (jitify-body_0 + app_0 + env_0 + mutables_0 + free_0 + lifts_0 + (convert-mode-non-tail_0 + convert-mode_0) + #f + in-name_0))) + (case-lambda + ((new-vs_0 + new-free_0 + new-lifts_0) + (values + (reannotate + v_1 + (list* + rator_0 + new-vs_0)) + new-free_0 + new-lifts_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (call-with-values + (lambda () + (jitify-body_0 + v_1 + env_0 + mutables_0 + free_0 + lifts_0 + (convert-mode-non-tail_0 + convert-mode_0) + #f + in-name_0)) + (case-lambda + ((new-vs_0 + new-free_0 + new-lifts_0) + (values + (reannotate + v_1 + new-vs_0) + new-free_0 + new-lifts_0)) + (args + (raise-binding-result-arity-error + 3 + args))))))))) + (let ((id_0 (unwrap v_1))) (let ((dest_0 (hash-ref env_0 @@ -42962,464 +32631,221 @@ #f)) #f) (values - (list - 'set! - var_0 - new-rhs_0) - new-free_0 - new-lifts_0) - (let ((newer-free_0 - (if dest_0 - (hash-set - new-free_0 - id_0 - dest_0) - new-free_0))) - (let ((new-v_0 - (let ((v_2 - (hash-ref - env_0 - id_0 - kw2846))) - (if (let ((a_0 - kw2846)) - (begin-unsafe - (let ((app_0 - (unwrap - a_0))) - (eq? - app_0 - (unwrap - v_2))))) + v_1 + free_0 + lifts_0) + (let ((new-var_0 + (if (begin-unsafe + (let ((app_0 + (unwrap + #f))) + (eq? + app_0 + (unwrap + dest_0)))) + v_1 + (if (let ((a_0 + kw2846)) + (begin-unsafe + (let ((app_0 + (unwrap + a_0))) + (eq? + app_0 + (unwrap + dest_0))))) + v_1 + (if (let ((p_0 + (unwrap + dest_0))) + (if (pair? + p_0) + (if (let ((a_0 + (car + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + 'self))) + (eq? + app_0 + (unwrap + a_0))))) + (let ((a_0 + (cdr + p_0))) + (let ((p_1 + (unwrap + a_0))) + (if (pair? + p_1) + #t + #f))) + #f) + #f)) + (let ((u_0 + (let ((d_0 + (cdr + (unwrap + dest_0)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (reannotate + v_1 + u_0)) (reannotate v_1 - (list - 'set! - var_0 - new-rhs_0)) - (if (let ((p_0 - (unwrap - v_2))) - (if (pair? - p_0) - (if (let ((a_0 - (car - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - 'self))) - (eq? - app_0 - (unwrap - a_0))))) - (let ((a_0 - (cdr - p_0))) - (let ((p_1 - (unwrap - a_0))) - (if (pair? - p_1) - #t - #f))) - #f) - #f)) - (let ((m_0 - (let ((d_0 - (cdr - (unwrap - v_2)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_0)))) - (error - 'set! - "[internal error] self-referenceable ~s" - id_0)) - (if (let ((p_0 - (unwrap - v_2))) - (if (pair? - p_0) - (if (let ((a_0 - (car - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - 'variable-ref))) - (eq? - app_0 - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - #f)) - (let ((var-id_0 - (let ((d_0 - (cdr - (unwrap - v_2)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_0)))) - (reannotate - v_1 - (list - 'variable-set! - var-id_0 - new-rhs_0))) - (if (let ((p_0 - (unwrap - v_2))) - (if (pair? - p_0) - (if (let ((a_0 - (car - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - 'unsafe-unbox*))) - (eq? - app_0 - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - #f)) - (let ((box-id_0 - (let ((d_0 - (cdr - (unwrap - v_2)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_0)))) - (reannotate - v_1 - (list - 'set-box*! - box-id_0 - new-rhs_0))) - (error - 'match - "failed ~e" - v_2)))))))) + dest_0)))))) + (let ((new-free_0 + (if dest_0 + (hash-set + free_0 + id_0 + dest_0) + free_0))) (values - new-v_0 - newer-free_0 - new-lifts_0))))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? 'call-with-values hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((proc1_0 - (let ((a_0 - (car p_0))) - a_0))) - (let ((proc2_0 - (let ((d_1 - (cdr p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((proc1_1 proc1_0)) - (values - proc1_1 - proc2_0))))))) - (case-lambda - ((proc1_0 proc2_0) - (let ((proc-convert-mode_0 - (convert-mode-called_0 - convert-mode_0))) - (call-with-values - (lambda () - (jitify-expr_0 - proc1_0 - env_0 - mutables_0 - free_0 - lifts_0 - proc-convert-mode_0 - #f - in-name_0)) - (case-lambda - ((new-proc1_0 - new-free1_0 - new-lifts1_0) - (call-with-values - (lambda () - (jitify-expr_0 - proc2_0 - env_0 - mutables_0 - new-free1_0 - new-lifts1_0 - proc-convert-mode_0 - #f - in-name_0)) - (case-lambda - ((new-proc2_0 - new-free2_0 - new-lifts2_0) - (let ((call-with-values-id_0 - (if (if (lambda?_0 - new-proc1_0) - (lambda?_0 - new-proc2_0) - #f) - 'call-with-values - '|#%call-with-values|))) - (values - (reannotate - v_1 - (list - call-with-values-id_0 - new-proc1_0 - new-proc2_0)) - new-free2_0 - new-lifts2_0))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (args - (raise-binding-result-arity-error - 3 - args)))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'call-with-module-prompt - hd_0) - (let ((a_0 - (cdr (unwrap v_1)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (wrap-list? a_1)) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((proc_0 - (let ((a_0 - (car p_0))) - a_0))) - (let ((var-info_0 - (let ((d_1 - (cdr - p_0))) - (unwrap-list - d_1)))) - (let ((proc_1 proc_0)) - (values - proc_1 - var-info_0))))))) - (case-lambda - ((proc_0 var-info_0) - (let ((proc-convert-mode_0 - (convert-mode-called_0 - convert-mode_0))) - (call-with-values - (lambda () - (jitify-expr_0 - proc_0 - env_0 - mutables_0 - free_0 - lifts_0 - proc-convert-mode_0 - #f - in-name_0)) - (case-lambda - ((new-proc_0 - new-free_0 - new-lifts_0) - (values - (reannotate - v_1 - (list* - 'call-with-module-prompt - new-proc_0 - var-info_0)) - new-free_0 - new-lifts_0)) - (args - (raise-binding-result-arity-error - 3 - args)))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? '|#%app| hd_0) - (let ((a_0 - (cdr (unwrap v_1)))) - (wrap-list? a_0)) - #f) - (call-with-values - (lambda () - (let ((app_0 - (wrap-cdr v_1))) - (jitify-body_0 - app_0 - env_0 - mutables_0 - free_0 - lifts_0 - (convert-mode-non-tail_0 - convert-mode_0) - #f - in-name_0))) - (case-lambda - ((new-vs_0 - new-free_0 - new-lifts_0) - (values - (reannotate - v_1 - (list* '|#%app| new-vs_0)) - new-free_0 - new-lifts_0)) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (let ((p_0 (unwrap v_1))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (wrap-list? a_0)) - #f)) - (let ((rator_0 - (let ((a_0 - (car - (unwrap - v_1)))) - a_0))) - (let ((u_0 - (unwrap rator_0))) - (let ((v_2 - (if (symbol? u_0) - (hash-ref - env_0 - u_0 - #f) - #f))) - (let ((hd_1 - (let ((p_0 - (unwrap - v_2))) - (if (pair? - p_0) - (unwrap - (car p_0)) - #f)))) - (if (if (eq? - 'self - hd_1) - (let ((a_0 - (cdr - (unwrap - v_2)))) - (let ((p_0 + new-var_0 + new-free_0 + lifts_0)))))))))))))))))))))))))))) + (lambda?_0 + (|#%name| + lambda? + (lambda (v_1) + (begin + (let ((hd_0 + (let ((p_0 (unwrap v_1))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) #t #f) + #t + (if (if (eq? 'case-lambda hd_0) #t #f) #t #f))))))) + (jitify-body_0 + (|#%name| + jitify-body + (lambda (vs_0 + env_0 + mutables_0 + free_0 + lifts_0 + convert-mode_0 + name_0 + in-name_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (vs_1 free_1 lifts_1) + (begin + (if (begin-unsafe (null? (unwrap vs_1))) + (values null free_1 lifts_1) + (if (let ((v_1 (wrap-cdr vs_1))) + (begin-unsafe (null? (unwrap v_1)))) + (call-with-values + (lambda () + (jitify-expr_0 + (wrap-car vs_1) + env_0 + mutables_0 + free_1 + lifts_1 + convert-mode_0 + name_0 + in-name_0)) + (case-lambda + ((new-v_0 new-free_0 new-lifts_0) + (values (list new-v_0) new-free_0 new-lifts_0)) + (args (raise-binding-result-arity-error 3 args)))) + (call-with-values + (lambda () + (let ((app_0 (wrap-car vs_1))) + (jitify-expr_0 + app_0 + env_0 + mutables_0 + free_1 + lifts_1 + (convert-mode-non-tail_0 convert-mode_0) + #f + in-name_0))) + (case-lambda + ((new-v_0 new-free_0 new-lifts_0) + (call-with-values + (lambda () + (loop_0 (wrap-cdr vs_1) new-free_0 new-lifts_0)) + (case-lambda + ((new-rest_0 newer-free_0 newer-lifts_0) + (values + (cons new-v_0 new-rest_0) + newer-free_0 + newer-lifts_0)) + (args + (raise-binding-result-arity-error 3 args))))) + (args + (raise-binding-result-arity-error 3 args))))))))))) + (loop_0 vs_0 free_0 lifts_0)))))) + (jitify-let_0 + (|#%name| + jitify-let + (lambda (v_1 + env_0 + mutables_0 + free_0 + lifts_0 + convert-mode_0 + name_0 + in-name_0) + (begin + (if (let ((p_0 (unwrap v_1))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 (car p_1))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (let ((result_1 + (let ((result_1 + (let ((p_2 (unwrap - a_0))) + v_3))) (if (pair? - p_0) - (let ((a_1 + p_2) + (let ((a_2 (cdr - p_0))) - (let ((p_1 + p_2))) + (let ((p_3 (unwrap - a_1))) + a_2))) (if (pair? - p_1) - (let ((a_2 + p_3) + (let ((a_3 (cdr - p_1))) + p_3))) (begin-unsafe (let ((app_0 (unwrap @@ -43427,255 +32853,49 @@ (eq? app_0 (unwrap - a_2))))) + a_3))))) #f))) - #f))) - #f) - (let ((orig-id_0 - (let ((d_0 - (cdr - (unwrap - v_2)))) - (let ((d_1 - (cdr - (unwrap - d_0)))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0))))) - (call-with-values - (lambda () - (let ((app_0 - (wrap-cdr - v_1))) - (jitify-body_0 - app_0 - env_0 - mutables_0 - free_0 - lifts_0 - (convert-mode-non-tail_0 - convert-mode_0) - #f - in-name_0))) - (case-lambda - ((new-vs_0 - new-free_0 - new-lifts_0) - (values - (reannotate - v_1 - (list* - rator_0 - new-vs_0)) - new-free_0 - new-lifts_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (call-with-values - (lambda () - (jitify-body_0 - v_1 - env_0 - mutables_0 - free_0 - lifts_0 - (convert-mode-non-tail_0 - convert-mode_0) - #f - in-name_0)) - (case-lambda - ((new-vs_0 - new-free_0 - new-lifts_0) - (values - (reannotate - v_1 - new-vs_0) - new-free_0 - new-lifts_0)) - (args - (raise-binding-result-arity-error - 3 - args))))))))) - (let ((id_0 (unwrap v_1))) - (let ((dest_0 - (hash-ref - env_0 - id_0 - #f))) - (if (if (not in-name_0) - (let ((hd_1 - (let ((p_0 - (unwrap - dest_0))) - (if (pair? - p_0) - (unwrap - (car - p_0)) - #f)))) - (if (if (eq? - 'variable-ref - hd_1) - (let ((a_0 - (cdr - (unwrap - dest_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - #t - #f)) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_3))) + (not + result_1))) + #t #f) - (values - v_1 - free_0 - lifts_0) - (let ((new-var_0 - (if (begin-unsafe - (let ((app_0 - (unwrap - #f))) - (eq? - app_0 - (unwrap - dest_0)))) - v_1 - (if (let ((a_0 - kw2846)) - (begin-unsafe - (let ((app_0 - (unwrap - a_0))) - (eq? - app_0 - (unwrap - dest_0))))) - v_1 - (if (let ((p_0 - (unwrap - dest_0))) - (if (pair? - p_0) - (if (let ((a_0 - (car - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - 'self))) - (eq? - app_0 - (unwrap - a_0))))) - (let ((a_0 - (cdr - p_0))) - (let ((p_1 - (unwrap - a_0))) - (if (pair? - p_1) - #t - #f))) - #f) - #f)) - (let ((u_0 - (let ((d_0 - (cdr - (unwrap - dest_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_0)))) - (reannotate - v_1 - u_0)) - (reannotate - v_1 - dest_0)))))) - (let ((new-free_0 - (if dest_0 - (hash-set - free_0 - id_0 - dest_0) - free_0))) - (values - new-var_0 - new-free_0 - lifts_0)))))))))))))))))))))))))))) - (lambda?_0 procz2) - (jitify-body_0 - (|#%name| - jitify-body - (lambda (vs_0 - env_0 - mutables_0 - free_0 - lifts_0 - convert-mode_0 - name_0 - in-name_0) - (begin - (loop_3 - convert-mode-non-tail_0 - convert-mode_0 - env_0 - in-name_0 - jitify-expr_0 - mutables_0 - name_0 - vs_0 - free_0 - lifts_0))))) - (jitify-let_0 - (|#%name| - jitify-let - (lambda (v_1 - env_0 - mutables_0 - free_0 - lifts_0 - convert-mode_0 - name_0 - in-name_0) - (begin - (if (let ((p_0 (unwrap v_1))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (if (wrap-list? a_1) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap v_1))) + (let ((let-form_0 (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_0 (cdr p_0))) + (let ((p_1 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_1))) + (call-with-values + (lambda () (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (result_0 lst_0) + (lambda (ids_0 rhss_0 lst_0) (begin (if (not (begin-unsafe @@ -43693,548 +32913,521 @@ (wrap-cdr lst_0) null))) (let ((v_3 v_2)) - (let ((result_1 - (let ((result_1 - (let ((p_2 - (unwrap - v_3))) - (if (pair? - p_2) - (let ((a_2 - (cdr + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_2 + (unwrap + v_3))) + (let ((ids_1 + (let ((a_1 + (car p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (let ((a_3 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_2))) + (let ((a_1 + (car (unwrap - a_3))))) - #f))) - #f)))) + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) + (case-lambda + ((ids10_0 + rhss11_0) (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_3))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap v_1))) - (let ((let-form_0 (let ((a_0 (car p_0))) a_0))) + (cons + ids10_0 + ids_0) + (cons + rhss11_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 rhss_1) + (values + ids_1 + rhss_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 rhss_1) + (for-loop_0 + ids_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values ids_0 rhss_0))))))) + (for-loop_0 null null a_0)))) + (case-lambda + ((ids_0 rhss_0) + (let ((app_0 (reverse$1 ids_0))) + (values app_0 (reverse$1 rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((ids_0 rhss_0) + (let ((body_0 (let ((d_1 (cdr p_1))) d_1))) + (let ((ids_1 ids_0) (rhss_1 rhss_0)) + (values ids_1 rhss_1 body_0)))) + (args + (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((ids_0 rhss_0 body_0) + (let ((let-form_1 let-form_0)) + (values let-form_1 ids_0 rhss_0 body_0))) + (args (raise-binding-result-arity-error 3 args))))))) + (case-lambda + ((let-form_0 ids_0 rhss_0 body_0) + (let ((rec?_0 + (if (let ((tmp_0 (unwrap let-form_0))) + (if (if (eq? tmp_0 'letrec) + #t + (eq? tmp_0 'letrec*)) + #t + #f)) + (convert-mode-box-mutables?_0 convert-mode_0) + #f))) + (let ((rhs-convert-mode_0 + (convert-mode-non-tail_0 convert-mode_0))) + (let ((rhs-env_0 + (if rec?_0 + (add-args/unbox_0 + env_0 + ids_0 + mutables_0 + (lambda (var_0) #t) + convert-mode_0) + env_0))) (call-with-values (lambda () - (let ((d_0 (cdr p_0))) - (let ((p_1 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_1))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ids_0 rhss_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_2 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_3 v_2)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_2 - (unwrap - v_3))) - (let ((ids_1 - (let ((a_1 - (car - p_2))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_2))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) - (case-lambda - ((ids10_0 - rhss11_0) - (values - (cons - ids10_0 - ids_0) - (cons - rhss11_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 rhss_1) - (values - ids_1 - rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 rhss_1) - (for-loop_0 - ids_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values ids_0 rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((ids_0 rhss_0) - (let ((app_0 (reverse$1 ids_0))) - (values app_0 (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((ids_0 rhss_0) - (let ((body_0 (let ((d_1 (cdr p_1))) d_1))) - (let ((ids_1 ids_0) (rhss_1 rhss_0)) - (values ids_1 rhss_1 body_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((ids_0 rhss_0 body_0) - (let ((let-form_1 let-form_0)) - (values let-form_1 ids_0 rhss_0 body_0))) - (args (raise-binding-result-arity-error 3 args))))))) - (case-lambda - ((let-form_0 ids_0 rhss_0 body_0) - (let ((rec?_0 - (if (let ((tmp_0 (unwrap let-form_0))) - (if (if (eq? tmp_0 'letrec) - #t - (eq? tmp_0 'letrec*)) - #t - #f)) - (convert-mode-box-mutables?_0 convert-mode_0) - #f))) - (let ((rhs-convert-mode_0 - (convert-mode-non-tail_0 convert-mode_0))) - (let ((rhs-env_0 - (if rec?_0 - (add-args/unbox_0 - env_0 - ids_0 - mutables_0 - procz3 - convert-mode_0) - env_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (rev-new-rhss_0 - free_1 - lifts_1 - lst_0 - lst_1) - (begin - (if (if (pair? lst_0) (pair? lst_1) #f) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((rhs_0 (unsafe-car lst_1))) - (let ((rest_1 - (unsafe-cdr lst_1))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((self-env_0 - (if rec?_0 - (add-self_0 - rhs-env_0 - mutables_0 - id_0) - rhs-env_0))) - (call-with-values - (lambda () - (jitify-expr_0 - rhs_0 - self-env_0 - mutables_0 - free_1 - lifts_1 - rhs-convert-mode_0 - id_0 - in-name_0)) - (case-lambda - ((new-rhs_0 - rhs-free_0 - rhs-lifts_0) - (values - (cons - new-rhs_0 - rev-new-rhss_0) - rhs-free_0 - rhs-lifts_0)) - (args - (raise-binding-result-arity-error - 3 - args)))))) - (case-lambda - ((rev-new-rhss_1 - free_2 - lifts_2) - (values - rev-new-rhss_1 - free_2 - lifts_2)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (case-lambda - ((rev-new-rhss_1 - free_2 - lifts_2) - (for-loop_0 - rev-new-rhss_1 - free_2 - lifts_2 - rest_0 - rest_1)) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (values - rev-new-rhss_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (rev-new-rhss_0 free_1 - lifts_1))))))) - (for-loop_0 - '() - hash2610 - lifts_0 - ids_0 - rhss_0)))) - (case-lambda - ((rev-new-rhss_0 rhs-free_0 rhs-lifts_0) - (let ((local-env_0 - (add-args/unbox_0 - env_0 - ids_0 - mutables_0 - (lambda (var_0) - (if rec?_0 - (hash-ref rhs-free_0 var_0 #f) - #f)) - convert-mode_0))) - (call-with-values - (lambda () - (jitify-body_0 - body_0 - local-env_0 + lifts_1 + lst_0 + lst_1) + (begin + (if (if (pair? lst_0) (pair? lst_1) #f) + (let ((id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((rhs_0 (unsafe-car lst_1))) + (let ((rest_1 (unsafe-cdr lst_1))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((self-env_0 + (if rec?_0 + (add-self_0 + rhs-env_0 + mutables_0 + id_0) + rhs-env_0))) + (call-with-values + (lambda () + (jitify-expr_0 + rhs_0 + self-env_0 + mutables_0 + free_1 + lifts_1 + rhs-convert-mode_0 + id_0 + in-name_0)) + (case-lambda + ((new-rhs_0 + rhs-free_0 + rhs-lifts_0) + (values + (cons + new-rhs_0 + rev-new-rhss_0) + rhs-free_0 + rhs-lifts_0)) + (args + (raise-binding-result-arity-error + 3 + args)))))) + (case-lambda + ((rev-new-rhss_1 + free_2 + lifts_2) + (values + rev-new-rhss_1 + free_2 + lifts_2)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((rev-new-rhss_1 + free_2 + lifts_2) + (for-loop_0 + rev-new-rhss_1 + free_2 + lifts_2 + rest_0 + rest_1)) + (args + (raise-binding-result-arity-error + 3 + args)))))))) + (values + rev-new-rhss_0 + free_1 + lifts_1))))))) + (for-loop_0 + '() + hash2610 + lifts_0 + ids_0 + rhss_0)))) + (case-lambda + ((rev-new-rhss_0 rhs-free_0 rhs-lifts_0) + (let ((local-env_0 + (add-args/unbox_0 + env_0 + ids_0 mutables_0 - (union-free_0 free_0 rhs-free_0) - rhs-lifts_0 - convert-mode_0 - name_0 - in-name_0)) - (case-lambda - ((new-body_0 new-free_0 new-lifts_0) - (let ((new-v_0 - (if (not rec?_0) - (list* - let-form_0 - (reverse$1 - (let ((lst_0 - (reverse$1 rev-new-rhss_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1 - lst_2) - (begin - (if (if (pair? lst_1) - (pair? lst_2) - #f) - (let ((id_0 - (unsafe-car + (lambda (var_0) + (if rec?_0 + (hash-ref rhs-free_0 var_0 #f) + #f)) + convert-mode_0))) + (call-with-values + (lambda () + (jitify-body_0 + body_0 + local-env_0 + mutables_0 + (union-free_0 free_0 rhs-free_0) + rhs-lifts_0 + convert-mode_0 + name_0 + in-name_0)) + (case-lambda + ((new-body_0 new-free_0 new-lifts_0) + (let ((new-v_0 + (if (not rec?_0) + (list* + let-form_0 + (reverse$1 + (let ((lst_0 + (reverse$1 rev-new-rhss_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1 + lst_2) + (begin + (if (if (pair? lst_1) + (pair? lst_2) + #f) + (let ((id_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((new-rhs_0 - (unsafe-car + (let ((new-rhs_0 + (unsafe-car + lst_2))) + (let ((rest_1 + (unsafe-cdr lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((fold-var_1 + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (list + id_0 + (if (if (convert-mode-box-mutables?_0 + convert-mode_0) + (hash-ref + mutables_0 + (unwrap + id_0) + #f) + #f) + (list + 'box + new-rhs_0) + new-rhs_0)) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 + null + ids_0 + lst_0))))) + new-body_0) + (let ((app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? lst_0) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (if (hash-ref + rhs-free_0 + (unwrap + id_0) + #f) (let ((fold-var_1 (cons - (list + (list* id_0 - (if (if (convert-mode-box-mutables?_0 - convert-mode_0) - (hash-ref - mutables_0 - (unwrap - id_0) - #f) - #f) - (list - 'box - new-rhs_0) - new-rhs_0)) + '((box + unsafe-undefined))) fold-var_0))) (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 - null - ids_0 - lst_0))))) - new-body_0) - (let ((app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? lst_0) - (let ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (if (hash-ref - rhs-free_0 - (unwrap - id_0) - #f) - (let ((fold-var_1 - (cons - (list* - id_0 - '((box - unsafe-undefined))) - fold-var_0))) - (values - fold-var_1)) - fold-var_0))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - ids_0)))))) - (list - 'let - app_0 - (let ((lst_0 (reverse$1 ids_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (body_1 - lst_1 - lst_2) - (begin - (if (if (pair? lst_1) - (pair? lst_2) - #f) - (let ((id_0 - (unsafe-car + fold-var_1)) + fold-var_0))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 null ids_0)))))) + (list + 'let + app_0 + (let ((lst_0 (reverse$1 ids_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (body_1 lst_1 lst_2) + (begin + (if (if (pair? lst_1) + (pair? lst_2) + #f) + (let ((id_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((new-rhs_0 - (unsafe-car + (let ((new-rhs_0 + (unsafe-car + lst_2))) + (let ((rest_1 + (unsafe-cdr lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((body_2 - (let ((body_2 - (if (hash-ref - rhs-free_0 - (unwrap - id_0) - #f) - (let ((e_0 - (list - 'set-box*! - id_0 - new-rhs_0))) - (let ((hd_0 - (let ((p_0 - (unwrap - body_1))) - (if (pair? - p_0) - (unwrap - (car - p_0)) - #f)))) - (if (if (eq? - 'begin - hd_0) - #t - #f) - (let ((es_0 - (let ((d_0 - (cdr - (unwrap - body_1)))) - d_0))) - (list* - 'begin - e_0 - es_0)) - (list + (let ((body_2 + (let ((body_2 + (if (hash-ref + rhs-free_0 + (unwrap + id_0) + #f) + (let ((e_0 + (list + 'set-box*! + id_0 + new-rhs_0))) + (let ((hd_0 + (let ((p_0 + (unwrap + body_1))) + (if (pair? + p_0) + (unwrap + (car + p_0)) + #f)))) + (if (if (eq? + 'begin + hd_0) + #t + #f) + (let ((es_0 + (let ((d_0 + (cdr + (unwrap + body_1)))) + d_0))) + (list* 'begin e_0 - body_1)))) - (list - 'let - (list - (if (hash-ref - mutables_0 - (unwrap - id_0) - #f) + es_0)) (list - id_0 - (list - 'box - new-rhs_0)) - (list - id_0 - new-rhs_0))) - body_1)))) - (values - body_2)))) - (for-loop_0 - body_2 - rest_0 - rest_1)))))) - body_1)))))) - (for-loop_0 - (body->expr_0 new-body_0) - lst_0 - rev-new-rhss_0))))))))) - (let ((app_0 (reannotate v_1 new-v_0))) - (values - app_0 - (remove-args_0 new-free_0 ids_0) - new-lifts_0)))) - (args - (raise-binding-result-arity-error 3 args)))))) - (args - (raise-binding-result-arity-error 3 args)))))))) - (args (raise-binding-result-arity-error 4 args)))) - (error 'match "failed ~e" v_1)))))) - (mutable-box-bindings_0 - (|#%name| - mutable-box-bindings - (lambda (args_0 mutables_0 convert-mode_0 body_0) - (begin - (if (convert-mode-box-mutables?_0 convert-mode_0) - (let ((bindings_0 (loop_4 mutables_0 args_0))) - (if (null? bindings_0) - body_0 - (list (list* 'let bindings_0 body_0)))) - body_0))))) - (plain-add-args_1 + 'begin + e_0 + body_1)))) + (list + 'let + (list + (if (hash-ref + mutables_0 + (unwrap + id_0) + #f) + (list + id_0 + (list + 'box + new-rhs_0)) + (list + id_0 + new-rhs_0))) + body_1)))) + (values + body_2)))) + (for-loop_0 + body_2 + rest_0 + rest_1)))))) + body_1)))))) + (for-loop_0 + (body->expr_0 new-body_0) + lst_0 + rev-new-rhss_0))))))))) + (let ((app_0 (reannotate v_1 new-v_0))) + (values + app_0 + (remove-args_0 new-free_0 ids_0) + new-lifts_0)))) + (args + (raise-binding-result-arity-error 3 args)))))) + (args (raise-binding-result-arity-error 3 args)))))))) + (args (raise-binding-result-arity-error 4 args)))) + (error 'match "failed ~e" v_1)))))) + (mutable-box-bindings_0 + (|#%name| + mutable-box-bindings + (lambda (args_0 mutables_0 convert-mode_0 body_0) + (begin + (if (convert-mode-box-mutables?_0 convert-mode_0) + (let ((bindings_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (args_1) + (begin + (if (begin-unsafe (null? (unwrap args_1))) + null + (if (begin-unsafe (pair? (unwrap args_1))) + (let ((id_0 (wrap-car args_1))) + (let ((var_0 (unwrap id_0))) + (let ((rest_0 (loop_0 (wrap-cdr args_1)))) + (if (hash-ref mutables_0 var_0 #f) + (cons + (list id_0 (list 'box id_0)) + rest_0) + rest_0)))) + (loop_0 (list args_1))))))))) + (loop_0 args_0)))) + (if (null? bindings_0) + body_0 + (list (list* 'let bindings_0 body_0)))) + body_0))))) + (plain-add-args_0 + (let ((plain-add-args_1 + (|#%name| + plain-add-args + (lambda (env4_0 args5_0 replace?3_0) + (begin + (let ((add-one_0 + (|#%name| + add-one + (lambda (id_0) + (begin + (let ((u-id_0 (unwrap id_0))) + (if (if replace?3_0 + replace?3_0 + (not (hash-ref env4_0 u-id_0 #f))) + (hash-set env4_0 u-id_0 kw2846) + env4_0))))))) + (if (let ((p_0 (unwrap args5_0))) (if (pair? p_0) #t #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap args5_0))) + (let ((id_0 (let ((a_0 (car p_0))) a_0))) + (let ((args_0 (let ((d_0 (cdr p_0))) d_0))) + (let ((id_1 id_0)) (values id_1 args_0)))))) + (case-lambda + ((id_0 args_0) + (plain-add-args_0 + (add-one_0 id_0) + args_0 + replace?3_0)) + (args (raise-binding-result-arity-error 2 args)))) + (if (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap args5_0)))) + env4_0 + (add-one_0 args5_0))))))))) (|#%name| plain-add-args (case-lambda - ((env_0 args_0) - (begin (plain-add-args_0 plain-add-args_1 env_0 args_0 #t))) + ((env_0 args_0) (begin (plain-add-args_1 env_0 args_0 #t))) ((env_0 args_0 replace?3_0) - (plain-add-args_0 plain-add-args_1 env_0 args_0 replace?3_0))))) - (add-args_0 - (|#%name| - add-args - (lambda (env_0 args_0 mutables_0 convert-mode_0) - (begin + (plain-add-args_1 env_0 args_0 replace?3_0)))))) + (add-args_0 + (|#%name| + add-args + (lambda (env_0 args_0 mutables_0 convert-mode_0) + (begin + (let ((add-one_0 + (|#%name| + add-one + (lambda (id_0) + (begin + (let ((u_0 (unwrap id_0))) + (let ((val_0 + (if (if (convert-mode-box-mutables?_0 + convert-mode_0) + (hash-ref mutables_0 u_0 #f) + #f) + (list 'unsafe-unbox* id_0) + kw2846))) + (hash-set env_0 u_0 val_0)))))))) (if (let ((p_0 (unwrap args_0))) (if (pair? p_0) #t #f)) (call-with-values (lambda () @@ -44245,12 +33438,7 @@ (case-lambda ((id_0 args_1) (add-args_0 - (add-one_1 - convert-mode-box-mutables?_0 - convert-mode_0 - env_0 - mutables_0 - id_0) + (add-one_0 id_0) args_1 mutables_0 convert-mode_0)) @@ -44258,17 +33446,31 @@ (if (begin-unsafe (let ((app_0 (unwrap '()))) (eq? app_0 (unwrap args_0)))) env_0 - (add-one_1 - convert-mode-box-mutables?_0 - convert-mode_0 - env_0 - mutables_0 - args_0))))))) - (add-args/unbox_0 - (|#%name| - add-args/unbox - (lambda (env_0 args_0 mutables_0 var-rec?_0 convert-mode_0) - (begin + (add-one_0 args_0)))))))) + (add-args/unbox_0 + (|#%name| + add-args/unbox + (lambda (env_0 args_0 mutables_0 var-rec?_0 convert-mode_0) + (begin + (let ((add-one_0 + (|#%name| + add-one + (lambda (id_0) + (begin + (let ((var_0 (unwrap id_0))) + (if (not + (let ((or-part_0 (|#%app| var-rec?_0 var_0))) + (if or-part_0 + or-part_0 + (if (convert-mode-box-mutables?_0 + convert-mode_0) + (hash-ref mutables_0 var_0 #f) + #f)))) + (hash-set env_0 var_0 kw2846) + (hash-set + env_0 + var_0 + (list 'unsafe-unbox* id_0))))))))) (if (let ((p_0 (unwrap args_0))) (if (pair? p_0) #t #f)) (call-with-values (lambda () @@ -44279,13 +33481,7 @@ (case-lambda ((id_0 args_1) (add-args/unbox_0 - (add-one_2 - convert-mode-box-mutables?_0 - convert-mode_0 - env_0 - mutables_0 - var-rec?_0 - id_0) + (add-one_0 id_0) args_1 mutables_0 var-rec?_0 @@ -44294,154 +33490,161 @@ (if (begin-unsafe (let ((app_0 (unwrap '()))) (eq? app_0 (unwrap args_0)))) env_0 - (add-one_2 - convert-mode-box-mutables?_0 - convert-mode_0 - env_0 - mutables_0 - var-rec?_0 - args_0))))))) - (remove-args_0 - (|#%name| - remove-args - (lambda (env_0 args_0) - (begin - (if (let ((p_0 (unwrap args_0))) (if (pair? p_0) #t #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap args_0))) - (let ((id_0 (let ((a_0 (car p_0))) a_0))) - (let ((args_1 (let ((d_0 (cdr p_0))) d_0))) - (let ((id_1 id_0)) (values id_1 args_1)))))) - (case-lambda - ((id_0 args_1) - (remove-args_0 (hash-remove env_0 (unwrap id_0)) args_1)) - (args (raise-binding-result-arity-error 2 args)))) - (if (begin-unsafe - (let ((app_0 (unwrap '()))) (eq? app_0 (unwrap args_0)))) - env_0 - (hash-remove env_0 (unwrap args_0)))))))) - (add-bindings_0 - (|#%name| - add-bindings - (lambda (env_0 bindings_0) - (begin - (if (if (wrap-list? bindings_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not (begin-unsafe (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (let ((result_1 - (let ((result_1 - (let ((p_0 (unwrap v_2))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 - (unwrap a_0))) - (if (pair? p_1) - (let ((a_1 - (cdr - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f)))) - (values result_1)))) - (if (if (not - (let ((x_0 (list v_2))) - (not result_1))) - #t - #f) - (for-loop_0 result_1 rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t bindings_0))) - #f) - (let ((ids_0 - (let ((ids_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ids_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (let ((ids_1 - (let ((ids_1 - (let ((ids12_0 - (let ((a_0 - (car - (unwrap - v_2)))) - a_0))) - (cons - ids12_0 - ids_0)))) - (values ids_1)))) - (for-loop_0 ids_1 rest_0))))) - ids_0)))))) - (for-loop_0 null bindings_0))))) - (reverse$1 ids_0)))) + (add-one_0 args_0)))))))) + (remove-args_0 + (|#%name| + remove-args + (lambda (env_0 args_0) + (begin + (if (let ((p_0 (unwrap args_0))) (if (pair? p_0) #t #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap args_0))) + (let ((id_0 (let ((a_0 (car p_0))) a_0))) + (let ((args_1 (let ((d_0 (cdr p_0))) d_0))) + (let ((id_1 id_0)) (values id_1 args_1)))))) + (case-lambda + ((id_0 args_1) + (remove-args_0 (hash-remove env_0 (unwrap id_0)) args_1)) + (args (raise-binding-result-arity-error 2 args)))) + (if (begin-unsafe + (let ((app_0 (unwrap '()))) (eq? app_0 (unwrap args_0)))) + env_0 + (hash-remove env_0 (unwrap args_0)))))))) + (add-bindings_0 + (|#%name| + add-bindings + (lambda (env_0 bindings_0) + (begin + (if (if (wrap-list? bindings_0) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (env_1 lst_0) + (lambda (result_0 lst_0) (begin - (if (pair? lst_0) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((env_2 - (let ((env_2 - (plain-add-args_1 env_1 id_0))) - (values env_2)))) - (for-loop_0 env_2 rest_0)))) - env_1)))))) - (for-loop_0 env_0 ids_0)))) - (error 'match "failed ~e" bindings_0)))))) - (add-self_0 procz4) - (activate-self_0 - (|#%name| - activate-self - (lambda (env_0 name_0) - (begin - (if name_0 + (if (not (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_1 + (if (begin-unsafe (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_2 v_1)) + (let ((result_1 + (let ((result_1 + (let ((p_0 (unwrap v_2))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 + (unwrap a_0))) + (if (pair? p_1) + (let ((a_1 + (cdr p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f)))) + (values result_1)))) + (if (if (not + (let ((x_0 (list v_2))) + (not result_1))) + #t + #f) + (for-loop_0 result_1 rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t bindings_0))) + #f) + (let ((ids_0 + (let ((ids_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ids_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_1 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_2 v_1)) + (let ((ids_1 + (let ((ids_1 + (let ((ids12_0 + (let ((a_0 + (car + (unwrap + v_2)))) + a_0))) + (cons + ids12_0 + ids_0)))) + (values ids_1)))) + (for-loop_0 ids_1 rest_0))))) + ids_0)))))) + (for-loop_0 null bindings_0))))) + (reverse$1 ids_0)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (env_1 lst_0) + (begin + (if (pair? lst_0) + (let ((id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((env_2 + (let ((env_2 + (plain-add-args_0 env_1 id_0))) + (values env_2)))) + (for-loop_0 env_2 rest_0)))) + env_1)))))) + (for-loop_0 env_0 ids_0)))) + (error 'match "failed ~e" bindings_0)))))) + (add-self_0 + (|#%name| + add-self + (lambda (env_0 mutables_0 name_0) + (begin + (let ((u_0 (unwrap name_0))) + (if (hash-ref mutables_0 u_0 #f) + env_0 + (hash-set + env_0 + u_0 + (list 'self (hash-ref env_0 u_0 kw2846))))))))) + (activate-self_0 + (|#%name| + activate-self + (lambda (env_0 name_0) + (begin + (if name_0 + (let ((genself_0 + (|#%name| + genself + (lambda () (begin (deterministic-gensym "self")))))) (let ((u_0 (unwrap name_0))) (let ((new-m_0 (let ((v_1 (hash-ref env_0 u_0 #f))) @@ -44570,303 +33773,397 @@ (list 'unsafe-unbox* (genself_0)) orig-id_0)) #f))))))) - (if new-m_0 (hash-set env_0 u_0 new-m_0) env_0))) - env_0))))) - (deactivate-self_0 procz5) - (argss->arity-mask_0 - (|#%name| - argss->arity-mask - (lambda (argss_0) + (if new-m_0 (hash-set env_0 u_0 new-m_0) env_0)))) + env_0))))) + (deactivate-self_0 + (|#%name| + deactivate-self + (lambda (env_0 name_0) + (begin + (if name_0 + (let ((u_0 (unwrap name_0))) + (let ((v_1 (hash-ref env_0 u_0 #f))) + (let ((hd_0 + (let ((p_0 (unwrap v_1))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'self hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (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))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_2))))) + #f))) + #f))) + #f) + (let ((m_0 + (let ((d_0 (cdr (unwrap v_1)))) + (let ((a_0 (car (unwrap d_0)))) a_0)))) + (hash-set env_0 u_0 m_0)) + env_0)))) + env_0))))) + (argss->arity-mask_0 + (|#%name| + argss->arity-mask + (lambda (argss_0) + (begin (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (mask_0 lst_0) + (begin + (if (pair? lst_0) + (let ((args_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((mask_1 + (let ((mask_1 + (bitwise-ior + mask_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (args_1 count_0) + (begin + (if (begin-unsafe + (null? + (unwrap args_1))) + (arithmetic-shift + 1 + count_0) + (if (begin-unsafe + (pair? + (unwrap args_1))) + (let ((app_0 + (wrap-cdr + args_1))) + (loop_0 + app_0 + (add1 count_0))) + (bitwise-xor + -1 + (sub1 + (arithmetic-shift + 1 + count_0)))))))))) + (loop_0 args_0 0))))) + (values mask_1)))) + (for-loop_0 mask_1 rest_0)))) + mask_0)))))) + (for-loop_0 0 argss_0))))))) + (de-dot_0 + (|#%name| + de-dot + (lambda (args_0) + (begin + (if (begin-unsafe (pair? (unwrap args_0))) + (let ((app_0 (wrap-car args_0))) + (cons app_0 (de-dot_0 (wrap-cdr args_0)))) + (list args_0)))))) + (union-free_0 + (|#%name| + union-free + (lambda (a_0 b_0) + (begin + (if (let ((app_0 (hash-count b_0))) (< app_0 (hash-count a_0))) + (union-free_0 b_0 a_0) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (mask_0 lst_0) + (lambda (b_1 i_0) (begin - (if (pair? lst_0) - (let ((args_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((mask_1 - (let ((mask_1 - (bitwise-ior - mask_0 - (letrec* - ((loop_5 - (|#%name| - loop - (lambda (args_1 count_0) - (begin - (if (begin-unsafe - (null? - (unwrap args_1))) - (arithmetic-shift - 1 - count_0) - (if (begin-unsafe - (pair? - (unwrap args_1))) - (let ((app_0 - (wrap-cdr - args_1))) - (loop_5 - app_0 - (add1 count_0))) - (bitwise-xor - -1 - (sub1 - (arithmetic-shift - 1 - count_0)))))))))) - (loop_5 args_0 0))))) - (values mask_1)))) - (for-loop_0 mask_1 rest_0)))) - mask_0)))))) - (for-loop_0 0 argss_0))))))) - (de-dot_0 - (|#%name| - de-dot - (lambda (args_0) - (begin - (if (begin-unsafe (pair? (unwrap args_0))) - (let ((app_0 (wrap-car args_0))) - (cons app_0 (de-dot_0 (wrap-cdr args_0)))) - (list args_0)))))) - (union-free_0 - (|#%name| - union-free - (lambda (a_0 b_0) - (begin - (if (let ((app_0 (hash-count b_0))) (< app_0 (hash-count a_0))) - (union-free_0 b_0 a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (b_1 i_0) - (begin - (if i_0 - (call-with-values - (lambda () (hash-iterate-key+value a_0 i_0)) - (case-lambda - ((k_0 v_1) - (let ((b_2 - (let ((b_2 (hash-set b_1 k_0 v_1))) - (values b_2)))) - (for-loop_0 b_2 (hash-iterate-next a_0 i_0)))) - (args - (raise-binding-result-arity-error 2 args)))) - b_1)))))) - (for-loop_0 b_0 (hash-iterate-first a_0))))))))) - (body->expr_0 procz6) - (find-mutable_0 - (|#%name| - find-mutable - (lambda (env_0 v_1 accum_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap v_1))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) + (if i_0 + (call-with-values + (lambda () (hash-iterate-key+value a_0 i_0)) + (case-lambda + ((k_0 v_1) + (let ((b_2 + (let ((b_2 (hash-set b_1 k_0 v_1))) + (values b_2)))) + (for-loop_0 b_2 (hash-iterate-next a_0 i_0)))) + (args (raise-binding-result-arity-error 2 args)))) + b_1)))))) + (for-loop_0 b_0 (hash-iterate-first a_0))))))))) + (body->expr_0 + (|#%name| + body->expr + (lambda (body_0) + (begin + (if (if (begin-unsafe (pair? (unwrap body_0))) + (let ((v_1 (wrap-cdr body_0))) + (begin-unsafe (null? (unwrap v_1)))) + #f) + (wrap-car body_0) + (list* 'begin body_0)))))) + (find-mutable_0 + (|#%name| + find-mutable + (lambda (env_0 v_1 accum_0) + (begin + (let ((hd_0 + (let ((p_0 (unwrap v_1))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((args_0 (let ((a_0 (car p_0))) a_0))) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((args_1 args_0)) (values args_1 body_0))))))) + (case-lambda + ((args_0 body_0) + (body-find-mutable_0 + (plain-add-args_0 env_0 args_0) + body_0 + accum_0)) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'case-lambda hd_0) (let ((a_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) + (if (wrap-list? a_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (let ((result_1 + (let ((result_1 + (let ((p_0 + (unwrap v_3))) + (if (pair? p_0) + #t + #f)))) + (values result_1)))) + (if (if (not + (let ((x_0 (list v_3))) + (not result_1))) + #t + #f) + (for-loop_0 result_1 rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_0))) + #f)) #f) (call-with-values (lambda () (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((args_0 (let ((a_0 (car p_0))) a_0))) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((args_1 args_0)) - (values args_1 body_0))))))) - (case-lambda - ((args_0 body_0) - (body-find-mutable_0 - (plain-add-args_1 env_0 args_0) - body_0 - accum_0)) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_2 + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (argss_0 bodys_0 lst_0) + (begin + (if (not + (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_3 v_2)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_3))) - (if (pair? p_0) - #t - #f)))) - (values result_1)))) - (if (if (not - (let ((x_0 - (list v_3))) - (not result_1))) - #t - #f) - (for-loop_0 result_1 rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_0))) - #f)) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (argss_0 bodys_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_2 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_3 v_2)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_0 - (unwrap v_3))) - (let ((argss_1 - (let ((a_0 - (car + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_0 (unwrap v_3))) + (let ((argss_1 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((bodys_1 + (let ((d_1 + (cdr p_0))) - a_0))) - (let ((bodys_1 - (let ((d_1 - (cdr - p_0))) - d_1))) - (let ((argss_2 - argss_1)) - (values - argss_2 - bodys_1)))))) - (case-lambda - ((argss13_0 bodys14_0) - (values - (cons - argss13_0 - argss_0) - (cons - bodys14_0 - bodys_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((argss_1 bodys_1) - (values argss_1 bodys_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((argss_1 bodys_1) - (for-loop_0 - argss_1 - bodys_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values argss_0 bodys_0))))))) - (for-loop_0 null null d_0)))) - (case-lambda - ((argss_0 bodys_0) - (let ((app_0 (reverse$1 argss_0))) - (values app_0 (reverse$1 bodys_0)))) - (args (raise-binding-result-arity-error 2 args)))))) - (case-lambda - ((argss_0 bodys_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (accum_1 lst_0 lst_1) - (begin - (if (if (pair? lst_0) (pair? lst_1) #f) - (let ((args_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((body_0 (unsafe-car lst_1))) - (let ((rest_1 (unsafe-cdr lst_1))) - (let ((accum_2 - (let ((accum_2 - (body-find-mutable_0 - (plain-add-args_1 - env_0 - args_0) - body_0 - accum_1))) - (values accum_2)))) - (for-loop_0 - accum_2 - rest_0 - rest_1)))))) - accum_1)))))) - (for-loop_0 accum_0 argss_0 bodys_0)))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'let hd_0) #t #f) + d_1))) + (let ((argss_2 + argss_1)) + (values + argss_2 + bodys_1)))))) + (case-lambda + ((argss13_0 bodys14_0) + (values + (cons argss13_0 argss_0) + (cons + bodys14_0 + bodys_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((argss_1 bodys_1) + (values argss_1 bodys_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((argss_1 bodys_1) + (for-loop_0 + argss_1 + bodys_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values argss_0 bodys_0))))))) + (for-loop_0 null null d_0)))) + (case-lambda + ((argss_0 bodys_0) + (let ((app_0 (reverse$1 argss_0))) + (values app_0 (reverse$1 bodys_0)))) + (args (raise-binding-result-arity-error 2 args)))))) + (case-lambda + ((argss_0 bodys_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (accum_1 lst_0 lst_1) + (begin + (if (if (pair? lst_0) (pair? lst_1) #f) + (let ((args_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((body_0 (unsafe-car lst_1))) + (let ((rest_1 (unsafe-cdr lst_1))) + (let ((accum_2 + (let ((accum_2 + (body-find-mutable_0 + (plain-add-args_0 + env_0 + args_0) + body_0 + accum_1))) + (values accum_2)))) + (for-loop_0 + accum_2 + rest_0 + rest_1)))))) + accum_1)))))) + (for-loop_0 accum_0 argss_0 bodys_0)))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'let hd_0) #t #f) + (find-mutable-in-let_0 env_0 v_1 accum_0) + (if (if (eq? 'letrec hd_0) #t #f) (find-mutable-in-let_0 env_0 v_1 accum_0) - (if (if (eq? 'letrec hd_0) #t #f) + (if (if (eq? 'letrec* hd_0) #t #f) (find-mutable-in-let_0 env_0 v_1 accum_0) - (if (if (eq? 'letrec* hd_0) #t #f) - (find-mutable-in-let_0 env_0 v_1 accum_0) - (if (if (eq? 'begin hd_0) #t #f) + (if (if (eq? 'begin hd_0) #t #f) + (let ((vs_0 (let ((d_0 (cdr (unwrap v_1)))) d_0))) + (body-find-mutable_0 env_0 vs_0 accum_0)) + (if (if (eq? 'begin0 hd_0) #t #f) (let ((vs_0 (let ((d_0 (cdr (unwrap v_1)))) d_0))) (body-find-mutable_0 env_0 vs_0 accum_0)) - (if (if (eq? 'begin0 hd_0) #t #f) + (if (if (eq? 'begin-unsafe hd_0) #t #f) (let ((vs_0 (let ((d_0 (cdr (unwrap v_1)))) d_0))) (body-find-mutable_0 env_0 vs_0 accum_0)) - (if (if (eq? 'begin-unsafe hd_0) #t #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap v_1)))) d_0))) - (body-find-mutable_0 env_0 vs_0 accum_0)) - (if (if (eq? 'if hd_0) + (if (if (eq? 'if hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (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_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((tst_0 + (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((thn_0 + (let ((a_0 (car p_1))) + a_0))) + (let ((els_0 + (let ((d_2 (cdr p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + a_0)))) + (let ((thn_1 thn_0)) + (values + thn_1 + els_0))))))) + (case-lambda + ((thn_0 els_0) + (let ((tst_1 tst_0)) + (values tst_1 thn_0 els_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((tst_0 thn_0 els_0) + (find-mutable_0 + env_0 + tst_0 + (find-mutable_0 + env_0 + thn_0 + (find-mutable_0 env_0 els_0 accum_0)))) + (args + (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'with-continuation-mark* hd_0) (let ((a_0 (cdr (unwrap v_1)))) (let ((p_0 (unwrap a_0))) (if (pair? p_0) @@ -44877,13 +34174,21 @@ (let ((p_2 (unwrap a_2))) (if (pair? p_2) (let ((a_3 (cdr p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap a_3))))) + (let ((p_3 + (unwrap a_3))) + (if (pair? p_3) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f))) #f))) #f))) #f))) @@ -44892,274 +34197,269 @@ (lambda () (let ((d_0 (cdr (unwrap v_1)))) (let ((p_0 (unwrap d_0))) - (let ((tst_0 + (let ((mode_0 (let ((a_0 (car p_0))) a_0))) (call-with-values (lambda () (let ((d_1 (cdr p_0))) (let ((p_1 (unwrap d_1))) - (let ((thn_0 + (let ((key_0 (let ((a_0 (car p_1))) a_0))) - (let ((els_0 - (let ((d_2 - (cdr p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((thn_1 thn_0)) - (values - thn_1 - els_0))))))) + (call-with-values + (lambda () + (let ((d_2 (cdr p_1))) + (let ((p_2 + (unwrap d_2))) + (let ((val_0 + (let ((a_0 + (car + p_2))) + a_0))) + (let ((body_0 + (let ((d_3 + (cdr + p_2))) + (let ((a_0 + (car + (unwrap + d_3)))) + a_0)))) + (let ((val_1 + val_0)) + (values + val_1 + body_0))))))) + (case-lambda + ((val_0 body_0) + (let ((key_1 key_0)) + (values + key_1 + val_0 + body_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) (case-lambda - ((thn_0 els_0) - (let ((tst_1 tst_0)) - (values tst_1 thn_0 els_0))) + ((key_0 val_0 body_0) + (let ((mode_1 mode_0)) + (values + mode_1 + key_0 + val_0 + body_0))) (args (raise-binding-result-arity-error - 2 + 3 args)))))))) (case-lambda - ((tst_0 thn_0 els_0) + ((mode_0 key_0 val_0 body_0) (find-mutable_0 env_0 - tst_0 + key_0 (find-mutable_0 env_0 - thn_0 - (find-mutable_0 env_0 els_0 accum_0)))) + val_0 + (find-mutable_0 env_0 body_0 accum_0)))) (args (raise-binding-result-arity-error - 3 + 4 args)))) - (if (if (eq? 'with-continuation-mark* hd_0) + (if (if (eq? 'quote hd_0) (let ((a_0 (cdr (unwrap v_1)))) (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))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? p_3) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f))) - #f))) - #f))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) #f))) #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((mode_0 - (let ((a_0 (car p_0))) a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((key_0 - (let ((a_0 - (car p_1))) - a_0))) - (call-with-values - (lambda () - (let ((d_2 (cdr p_1))) - (let ((p_2 - (unwrap - d_2))) - (let ((val_0 - (let ((a_0 - (car - p_2))) - a_0))) - (let ((body_0 - (let ((d_3 - (cdr - p_2))) - (let ((a_0 - (car - (unwrap - d_3)))) - a_0)))) - (let ((val_1 - val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 body_0) - (let ((key_1 key_0)) - (values - key_1 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((key_0 val_0 body_0) - (let ((mode_1 mode_0)) - (values - mode_1 - key_0 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (case-lambda - ((mode_0 key_0 val_0 body_0) - (find-mutable_0 - env_0 - key_0 - (find-mutable_0 - env_0 - val_0 - (find-mutable_0 - env_0 - body_0 - accum_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (if (if (eq? 'quote hd_0) + accum_0 + (if (if (eq? 'set! hd_0) (let ((a_0 (cdr (unwrap v_1)))) (let ((p_0 (unwrap a_0))) (if (pair? p_0) (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? - app_0 - (unwrap a_1))))) + (let ((p_1 (unwrap a_1))) + (if (pair? p_1) + (let ((a_2 (cdr p_1))) + (begin-unsafe + (let ((app_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_2))))) + #f))) #f))) #f) - accum_0 - (if (if (eq? 'set! hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((var_0 - (let ((a_0 (car p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 (cdr p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((var_1 var_0)) - (values var_1 rhs_0))))))) - (case-lambda - ((var_0 rhs_0) - (let ((id_0 (unwrap var_0))) - (find-mutable_0 - env_0 - rhs_0 - (if (hash-ref env_0 id_0 #f) - (hash-set accum_0 id_0 #t) - accum_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (wrap-list? v_1) - (body-find-mutable_0 - env_0 - v_1 - accum_0) - accum_0)))))))))))))))))) - (body-find-mutable_0 - (|#%name| - body-find-mutable - (lambda (env_0 body_0 accum_0) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((var_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car + (unwrap d_1)))) + a_0)))) + (let ((var_1 var_0)) + (values var_1 rhs_0))))))) + (case-lambda + ((var_0 rhs_0) + (let ((id_0 (unwrap var_0))) + (find-mutable_0 + env_0 + rhs_0 + (if (hash-ref env_0 id_0 #f) + (hash-set accum_0 id_0 #t) + accum_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (wrap-list? v_1) + (body-find-mutable_0 env_0 v_1 accum_0) + accum_0)))))))))))))))))) + (body-find-mutable_0 + (|#%name| + body-find-mutable + (lambda (env_0 body_0 accum_0) + (begin (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (accum_1 lst_0) - (begin - (if (not (begin-unsafe (null? (unwrap lst_0)))) - (let ((v_1 + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (accum_1 lst_0) + (begin + (if (not (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_1 + (if (begin-unsafe (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (let ((accum_2 - (let ((accum_2 - (find-mutable_0 - env_0 - v_2 - accum_1))) - (values accum_2)))) - (for-loop_0 accum_2 rest_0))))) - accum_1)))))) - (for-loop_0 accum_0 body_0))))))) - (find-mutable-in-let_0 - (|#%name| - find-mutable-in-let - (lambda (env_0 v_1 accum_0) - (begin - (if (let ((p_0 (unwrap v_1))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (if (wrap-list? a_1) + (wrap-cdr lst_0) + null))) + (let ((v_2 v_1)) + (let ((accum_2 + (let ((accum_2 + (find-mutable_0 + env_0 + v_2 + accum_1))) + (values accum_2)))) + (for-loop_0 accum_2 rest_0))))) + accum_1)))))) + (for-loop_0 accum_0 body_0))))))) + (find-mutable-in-let_0 + (|#%name| + find-mutable-in-let + (lambda (env_0 v_1 accum_0) + (begin + (if (let ((p_0 (unwrap v_1))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 (car p_1))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (let ((result_1 + (let ((result_1 + (let ((p_2 + (unwrap + v_3))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (let ((a_3 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_3))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap v_1))) + (let ((let-form_0 (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_0 (cdr p_0))) + (let ((p_1 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_1))) + (call-with-values + (lambda () (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (result_0 lst_0) + (lambda (ids_0 rhss_0 lst_0) (begin (if (not (begin-unsafe @@ -45177,66 +34477,1202 @@ (wrap-cdr lst_0) null))) (let ((v_3 v_2)) - (let ((result_1 - (let ((result_1 - (let ((p_2 - (unwrap - v_3))) - (if (pair? - p_2) - (let ((a_2 - (cdr + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_2 + (unwrap + v_3))) + (let ((ids_1 + (let ((a_1 + (car p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (let ((a_3 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_2))) + (let ((a_1 + (car (unwrap - a_3))))) - #f))) - #f)))) + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) + (case-lambda + ((ids15_0 + rhss16_0) (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_3))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f)) + (cons + ids15_0 + ids_0) + (cons + rhss16_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 rhss_1) + (values + ids_1 + rhss_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 rhss_1) + (for-loop_0 + ids_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values ids_0 rhss_0))))))) + (for-loop_0 null null a_0)))) + (case-lambda + ((ids_0 rhss_0) + (let ((app_0 (reverse$1 ids_0))) + (values app_0 (reverse$1 rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((ids_0 rhss_0) + (let ((body_0 (let ((d_1 (cdr p_1))) d_1))) + (let ((ids_1 ids_0) (rhss_1 rhss_0)) + (values ids_1 rhss_1 body_0)))) + (args + (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((ids_0 rhss_0 body_0) + (let ((let-form_1 let-form_0)) + (values let-form_1 ids_0 rhss_0 body_0))) + (args (raise-binding-result-arity-error 3 args))))))) + (case-lambda + ((let-form_0 ids_0 rhss_0 body_0) + (let ((local-env_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (env_1 lst_0) + (begin + (if (pair? lst_0) + (let ((id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((env_2 + (let ((env_2 + (plain-add-args_0 + env_1 + id_0))) + (values env_2)))) + (for-loop_0 env_2 rest_0)))) + env_1)))))) + (for-loop_0 env_0 ids_0))))) + (let ((rhs-env_0 + (let ((tmp_0 (unwrap let-form_0))) + (if (if (eq? tmp_0 'letrec) + #t + (if (eq? tmp_0 'letrec*) + #t + (eq? tmp_0 'letrec*-values))) + local-env_0 + env_0)))) + (body-find-mutable_0 + local-env_0 + body_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (accum_1 lst_0 lst_1) + (begin + (if (if (pair? lst_0) (pair? lst_1) #f) + (let ((id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((rhs_0 (unsafe-car lst_1))) + (let ((rest_1 (unsafe-cdr lst_1))) + (let ((accum_2 + (let ((accum_2 + (find-mutable_0 + rhs-env_0 + rhs_0 + accum_1))) + (values accum_2)))) + (for-loop_0 + accum_2 + rest_0 + rest_1)))))) + accum_1)))))) + (for-loop_0 accum_0 ids_0 rhss_0))))))) + (args (raise-binding-result-arity-error 4 args)))) + (error 'match "failed ~e" v_1)))))) + (init-convert-mode_0 + (|#%name| + init-convert-mode + (lambda (v_1) + (begin + (if convert-size-threshold_0 + (convert-mode1.1 (record-sizes_0 v_1) #f #f #f) + '(not-called . no-lift)))))) + (convert-mode-convert-lambda?_0 + (|#%name| + convert-mode-convert-lambda? + (lambda (cm_0 v_1) + (begin + (if (pair? cm_0) + (eq? (car cm_0) 'not-called) + (if (convert-mode-called? cm_0) + #f + (if (convert-mode-no-more-conversions? cm_0) + #f + (if (>= + (hash-ref (convert-mode-sizes cm_0) v_1) + convert-size-threshold_0) + #f + #t)))))))) + (convert-mode-lambda-body-mode_0 + (|#%name| + convert-mode-lambda-body-mode + (lambda (cm_0 convert?_0) + (begin + (if (convert-mode? cm_0) + (if convert?_0 + (convert-mode1.1 'not-needed #f need-lift?_0 #t) + (convert-mode-non-tail_0 cm_0)) + (if (let ((or-part_0 (not need-lift?_0))) + (if or-part_0 + or-part_0 + (if (eq? 'no-lift (cdr cm_0)) (not convert?_0) #f))) + '(not-called . no-lift) + '(not-called . lift))))))) + (convert-mode-non-tail_0 + (|#%name| + convert-mode-non-tail + (lambda (cm_0) + (begin + (if (convert-mode? cm_0) + (if (convert-mode? cm_0) + (let ((app_0 (convert-mode-sizes cm_0))) + (let ((app_1 (convert-mode-lift? cm_0))) + (convert-mode1.1 + app_0 + #f + app_1 + (convert-mode-no-more-conversions? cm_0)))) + (raise-argument-error 'struct-copy "convert-mode?" cm_0)) + (if (eq? 'no-lift (cdr cm_0)) + '(not-called . no-lift) + '(not-called . lift))))))) + (convert-mode-called_0 + (|#%name| + convert-mode-called + (lambda (cm_0) + (begin + (if (convert-mode? cm_0) + (if (convert-mode? cm_0) + (let ((app_0 (convert-mode-sizes cm_0))) + (let ((app_1 (convert-mode-lift? cm_0))) + (convert-mode1.1 + app_0 + #t + app_1 + (convert-mode-no-more-conversions? cm_0)))) + (raise-argument-error 'struct-copy "convert-mode?" cm_0)) + (if (eq? 'no-lift (cdr cm_0)) + '(called . no-lift) + '(called . lift))))))) + (convert-mode-box-mutables?_0 + (|#%name| + convert-mode-box-mutables? + (lambda (cm_0) + (begin + (if (convert-mode? cm_0) + (not (convert-mode-no-more-conversions? cm_0)) + #t))))) + (convert-mode-need-lift?_0 + (|#%name| + convert-mode-need-lift? + (lambda (cm_0) + (begin + (if (convert-mode? cm_0) + (convert-mode-lift? cm_0) + (eq? 'lift (cdr cm_0))))))) + (no-lifts_0 '(0)) + (no-lifts?_0 + (|#%name| no-lifts? (lambda (v_1) (begin (zero? (car v_1)))))) + (lifts->datum_0 + (|#%name| + lifts->datum + (lambda (v_1) (begin (list->vector (reverse$1 (cdr v_1))))))) + (add-lift_0 + (|#%name| + add-lift + (lambda (e_0 lifts_0) + (begin + (let ((app_0 (list 'unsafe-vector-ref lifts-id (car lifts_0)))) + (values + app_0 + (let ((app_1 (add1 (car lifts_0)))) + (cons app_1 (cons e_0 (cdr lifts_0)))))))))) + (record-sizes_0 + (|#%name| + record-sizes + (lambda (v_1) + (begin + (let ((sizes_0 (make-hasheq))) + (begin (record-sizes!_0 v_1 sizes_0) sizes_0)))))) + (record-size!_0 + (|#%name| + record-size! + (lambda (v_1 sizes_0 size_0) + (begin (begin (hash-set! sizes_0 v_1 size_0) size_0))))) + (record-sizes!_0 + (|#%name| + record-sizes! + (lambda (v_1 sizes_0) + (begin + (let ((hd_0 + (let ((p_0 (unwrap v_1))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) + #f) (call-with-values (lambda () - (let ((p_0 (unwrap v_1))) - (let ((let-form_0 (let ((a_0 (car p_0))) a_0))) + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((args_0 (let ((a_0 (car p_0))) a_0))) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((args_1 args_0)) (values args_1 body_0))))))) + (case-lambda + ((args_0 body_0) + (let ((size_0 (body-record-sizes!_0 body_0 sizes_0))) + (begin-unsafe + (begin (begin (hash-set! sizes_0 v_1 size_0) size_0))))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'case-lambda hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (if (wrap-list? a_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (let ((result_1 + (let ((result_1 + (let ((p_0 + (unwrap v_3))) + (if (pair? p_0) + #t + #f)))) + (values result_1)))) + (if (if (not + (let ((x_0 (list v_3))) + (not result_1))) + #t + #f) + (for-loop_0 result_1 rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_0))) + #f)) + #f) + (let ((bodys_0 + (let ((d_0 (cdr (unwrap v_1)))) + (let ((bodys_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (bodys_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (let ((bodys_1 + (let ((bodys_1 + (let ((bodys19_0 + (let ((d_1 + (cdr + (unwrap + v_3)))) + d_1))) + (cons + bodys19_0 + bodys_0)))) + (values + bodys_1)))) + (for-loop_0 + bodys_1 + rest_0))))) + bodys_0)))))) + (for-loop_0 null d_0))))) + (reverse$1 bodys_0))))) + (let ((new-size_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (pair? lst_0) + (let ((body_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((result_1 + (let ((result_1 + (+ + result_0 + (body-record-sizes!_0 + body_0 + sizes_0)))) + (values result_1)))) + (for-loop_0 result_1 rest_0)))) + result_0)))))) + (for-loop_0 0 bodys_0))))) + (begin-unsafe + (begin + (begin + (hash-set! sizes_0 v_1 new-size_0) + new-size_0))))) + (if (if (eq? 'let hd_0) #t #f) + (record-sizes-in-let!_0 v_1 sizes_0) + (if (if (eq? 'letrec hd_0) #t #f) + (record-sizes-in-let!_0 v_1 sizes_0) + (if (if (eq? 'letrec* hd_0) #t #f) + (record-sizes-in-let!_0 v_1 sizes_0) + (if (if (eq? 'begin hd_0) #t #f) + (let ((vs_0 (let ((d_0 (cdr (unwrap v_1)))) d_0))) + (add1 (body-record-sizes!_0 vs_0 sizes_0))) + (if (if (eq? 'begin0 hd_0) #t #f) + (let ((vs_0 (let ((d_0 (cdr (unwrap v_1)))) d_0))) + (add1 (body-record-sizes!_0 vs_0 sizes_0))) + (if (if (eq? 'begin-unsafe hd_0) #t #f) + (let ((vs_0 + (let ((d_0 (cdr (unwrap v_1)))) d_0))) + (add1 (body-record-sizes!_0 vs_0 sizes_0))) + (if (if (eq? 'if hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (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_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((tst_0 + (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((thn_0 + (let ((a_0 (car p_1))) + a_0))) + (let ((els_0 + (let ((d_2 (cdr p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + a_0)))) + (let ((thn_1 thn_0)) + (values + thn_1 + els_0))))))) + (case-lambda + ((thn_0 els_0) + (let ((tst_1 tst_0)) + (values tst_1 thn_0 els_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((tst_0 thn_0 els_0) + (let ((app_0 + (record-sizes!_0 tst_0 sizes_0))) + (let ((app_1 + (record-sizes!_0 thn_0 sizes_0))) + (+ + 1 + app_0 + app_1 + (record-sizes!_0 els_0 sizes_0))))) + (args + (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'with-continuation-mark* hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (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))) + (let ((p_3 + (unwrap a_3))) + (if (pair? p_3) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap d_0))) + (let ((mode_0 + (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((key_0 + (let ((a_0 (car p_1))) + a_0))) + (call-with-values + (lambda () + (let ((d_2 (cdr p_1))) + (let ((p_2 + (unwrap d_2))) + (let ((val_0 + (let ((a_0 + (car + p_2))) + a_0))) + (let ((body_0 + (let ((d_3 + (cdr + p_2))) + (let ((a_0 + (car + (unwrap + d_3)))) + a_0)))) + (let ((val_1 + val_0)) + (values + val_1 + body_0))))))) + (case-lambda + ((val_0 body_0) + (let ((key_1 key_0)) + (values + key_1 + val_0 + body_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((key_0 val_0 body_0) + (let ((mode_1 mode_0)) + (values + mode_1 + key_0 + val_0 + body_0))) + (args + (raise-binding-result-arity-error + 3 + args)))))))) + (case-lambda + ((mode_0 key_0 val_0 body_0) + (let ((app_0 + (record-sizes!_0 key_0 sizes_0))) + (let ((app_1 + (record-sizes!_0 val_0 sizes_0))) + (+ + 1 + app_0 + app_1 + (record-sizes!_0 body_0 sizes_0))))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (if (if (eq? 'quote hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) + #f))) + #f) + 1 + (if (if (eq? 'set! hd_0) + (let ((a_0 (cdr (unwrap v_1)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_2))))) + #f))) + #f))) + #f) + (let ((rhs_0 + (let ((d_0 (cdr (unwrap v_1)))) + (let ((d_1 (cdr (unwrap d_0)))) + (let ((a_0 + (car (unwrap d_1)))) + a_0))))) + (add1 (record-sizes!_0 rhs_0 sizes_0))) + (if (wrap-list? v_1) + (body-record-sizes!_0 v_1 sizes_0) + 1)))))))))))))))))) + (body-record-sizes!_0 + (|#%name| + body-record-sizes! + (lambda (body_0 sizes_0) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_1 + (if (begin-unsafe (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_2 v_1)) + (let ((result_1 + (let ((result_1 + (+ + result_0 + (record-sizes!_0 v_2 sizes_0)))) + (values result_1)))) + (for-loop_0 result_1 rest_0))))) + result_0)))))) + (for-loop_0 0 body_0))))))) + (record-sizes-in-let!_0 + (|#%name| + record-sizes-in-let! + (lambda (v_1 sizes_0) + (begin + (if (let ((p_0 (unwrap v_1))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 (car p_1))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_3 v_2)) + (let ((result_1 + (let ((result_1 + (let ((p_2 + (unwrap + v_3))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (let ((a_3 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_3))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap v_1))) + (let ((let-form_0 (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_0 (cdr p_0))) + (let ((p_1 (unwrap d_0))) + (let ((rhss_0 + (let ((a_0 (car p_1))) + (let ((rhss_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (rhss_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap lst_0)))) + (let ((v_2 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_3 v_2)) + (let ((rhss_1 + (let ((rhss_1 + (let ((rhss20_0 + (let ((d_1 + (cdr + (unwrap + v_3)))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (cons + rhss20_0 + rhss_0)))) + (values + rhss_1)))) + (for-loop_0 + rhss_1 + rest_0))))) + rhss_0)))))) + (for-loop_0 null a_0))))) + (reverse$1 rhss_0))))) + (let ((body_0 (let ((d_1 (cdr p_1))) d_1))) + (let ((rhss_1 rhss_0)) + (values rhss_1 body_0))))))) + (case-lambda + ((rhss_0 body_0) + (let ((let-form_1 let-form_0)) + (values let-form_1 rhss_0 body_0))) + (args (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((let-form_0 rhss_0 body_0) + (let ((app_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (pair? lst_0) + (let ((rhs_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((result_1 + (let ((result_1 + (+ + result_0 + (record-sizes!_0 + rhs_0 + sizes_0)))) + (values result_1)))) + (for-loop_0 result_1 rest_0)))) + result_0)))))) + (for-loop_0 0 rhss_0))))) + (+ 1 app_0 (body-record-sizes!_0 body_0 sizes_0)))) + (args (raise-binding-result-arity-error 3 args)))) + (error 'match "failed ~e" v_1))))))) + (with-continuation-mark* + authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first #f parameterization-key) + gensym-counter + (box 0)) + (top_0))))) +(define xify + (lambda (e_0) + (letrec* + ((xify_0 + (|#%name| + xify + (lambda (e_1 env_0) + (begin + (reannotate + e_1 + (let ((hd_0 + (let ((p_0 (unwrap e_1))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) + (let ((ids_0 (let ((a_0 (car p_0))) a_0))) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((ids_1 ids_0)) (values ids_1 body_0))))))) + (case-lambda + ((ids_0 body_0) + (call-with-values + (lambda () (xify-ids_0 ids_0 env_0)) + (case-lambda + ((new-ids_0 new-env_0) + (list* + 'lambda + new-ids_0 + (xify-body_0 body_0 new-env_0))) + (args (raise-binding-result-arity-error 2 args))))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'case-lambda hd_0) + (let ((a_0 (cdr (unwrap e_1)))) (wrap-list? a_0)) + #f) + (let ((clauses_0 + (let ((d_0 (cdr (unwrap e_1)))) (unwrap-list d_0)))) + (list* + 'case-lambda + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((clause_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (cdr + (xify_0 + (cons 'lambda clause_0) + env_0)) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 fold-var_1 rest_0)))) + fold-var_0)))))) + (for-loop_0 null clauses_0)))))) + (if (if (eq? 'let hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ids_0 rhss_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_1))) + (let ((ids_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) + (case-lambda + ((ids1_0 rhss2_0) + (values + (cons + ids1_0 + ids_0) + (cons + rhss2_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 rhss_1) + (values + ids_1 + rhss_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 rhss_1) + (for-loop_0 + ids_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values ids_0 rhss_0))))))) + (for-loop_0 null null a_0)))) + (case-lambda + ((ids_0 rhss_0) + (let ((app_0 (reverse$1 ids_0))) + (values app_0 (reverse$1 rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((ids_0 rhss_0) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((ids_1 ids_0) (rhss_1 rhss_0)) + (values ids_1 rhss_1 body_0)))) + (args + (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((ids_0 rhss_0 body_0) + (xify-let_0 'let ids_0 rhss_0 body_0 env_0)) + (args (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'letrec hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f) (call-with-values (lambda () - (let ((d_0 (cdr p_0))) - (let ((p_1 (unwrap d_0))) + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) (call-with-values (lambda () - (let ((a_0 (car p_1))) + (let ((a_0 (car p_0))) (call-with-values (lambda () (begin @@ -45249,7 +35685,7 @@ (if (not (begin-unsafe (null? (unwrap lst_0)))) - (let ((v_2 + (let ((v_0 (if (begin-unsafe (pair? (unwrap lst_0))) @@ -45262,25 +35698,25 @@ lst_0))) (wrap-cdr lst_0) null))) - (let ((v_3 v_2)) + (let ((v_1 v_0)) (call-with-values (lambda () (call-with-values (lambda () (call-with-values (lambda () - (let ((p_2 + (let ((p_1 (unwrap - v_3))) + v_1))) (let ((ids_1 (let ((a_1 (car - p_2))) + p_1))) a_1))) (let ((rhss_1 (let ((d_1 (cdr - p_2))) + p_1))) (let ((a_1 (car (unwrap @@ -45292,14 +35728,14 @@ ids_2 rhss_1)))))) (case-lambda - ((ids15_0 - rhss16_0) + ((ids3_0 + rhss4_0) (values (cons - ids15_0 + ids3_0 ids_0) (cons - rhss16_0 + rhss4_0 rhss_0))) (args (raise-binding-result-arity-error @@ -45336,7 +35772,7 @@ args)))))) (case-lambda ((ids_0 rhss_0) - (let ((body_0 (let ((d_1 (cdr p_1))) d_1))) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) (let ((ids_1 ids_0) (rhss_1 rhss_0)) (values ids_1 rhss_1 body_0)))) (args @@ -45345,1214 +35781,20 @@ args))))))) (case-lambda ((ids_0 rhss_0 body_0) - (let ((let-form_1 let-form_0)) - (values let-form_1 ids_0 rhss_0 body_0))) - (args (raise-binding-result-arity-error 3 args))))))) - (case-lambda - ((let-form_0 ids_0 rhss_0 body_0) - (let ((local-env_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (env_1 lst_0) - (begin - (if (pair? lst_0) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((env_2 - (let ((env_2 - (plain-add-args_1 - env_1 - id_0))) - (values env_2)))) - (for-loop_0 env_2 rest_0)))) - env_1)))))) - (for-loop_0 env_0 ids_0))))) - (let ((rhs-env_0 - (let ((tmp_0 (unwrap let-form_0))) - (if (if (eq? tmp_0 'letrec) - #t - (if (eq? tmp_0 'letrec*) - #t - (eq? tmp_0 'letrec*-values))) - local-env_0 - env_0)))) - (body-find-mutable_0 - local-env_0 - body_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (accum_1 lst_0 lst_1) - (begin - (if (if (pair? lst_0) (pair? lst_1) #f) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((rhs_0 (unsafe-car lst_1))) - (let ((rest_1 (unsafe-cdr lst_1))) - (let ((accum_2 - (let ((accum_2 - (find-mutable_0 - rhs-env_0 - rhs_0 - accum_1))) - (values accum_2)))) - (for-loop_0 - accum_2 - rest_0 - rest_1)))))) - accum_1)))))) - (for-loop_0 accum_0 ids_0 rhss_0))))))) - (args (raise-binding-result-arity-error 4 args)))) - (error 'match "failed ~e" v_1)))))) - (init-convert-mode_0 - (|#%name| - init-convert-mode - (lambda (v_1) - (begin - (if convert-size-threshold_0 - (convert-mode1.1 (record-sizes_0 v_1) #f #f #f) - '(not-called . no-lift)))))) - (convert-mode-convert-lambda?_0 - (|#%name| - convert-mode-convert-lambda? - (lambda (cm_0 v_1) - (begin - (if (pair? cm_0) - (eq? (car cm_0) 'not-called) - (if (convert-mode-called? cm_0) - #f - (if (convert-mode-no-more-conversions? cm_0) - #f - (if (>= - (hash-ref (convert-mode-sizes cm_0) v_1) - convert-size-threshold_0) - #f - #t)))))))) - (convert-mode-lambda-body-mode_0 - (|#%name| - convert-mode-lambda-body-mode - (lambda (cm_0 convert?_0) - (begin - (if (convert-mode? cm_0) - (if convert?_0 - (convert-mode1.1 'not-needed #f need-lift?_0 #t) - (convert-mode-non-tail_0 cm_0)) - (if (let ((or-part_0 (not need-lift?_0))) - (if or-part_0 - or-part_0 - (if (eq? 'no-lift (cdr cm_0)) (not convert?_0) #f))) - '(not-called . no-lift) - '(not-called . lift))))))) - (convert-mode-non-tail_0 procz7) - (convert-mode-called_0 procz8) - (convert-mode-box-mutables?_0 procz9) - (convert-mode-need-lift?_0 procz10) - (no-lifts_0 '(0)) - (no-lifts?_0 procz11) - (lifts->datum_0 procz12) - (add-lift_0 procz13) - (record-sizes_0 - (|#%name| - record-sizes - (lambda (v_1) - (begin - (let ((sizes_0 (make-hasheq))) - (begin (record-sizes!_0 v_1 sizes_0) sizes_0)))))) - (record-size!_0 procz14) - (record-sizes!_0 - (|#%name| - record-sizes! - (lambda (v_1 sizes_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap v_1))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((args_0 (let ((a_0 (car p_0))) a_0))) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((args_1 args_0)) - (values args_1 body_0))))))) - (case-lambda - ((args_0 body_0) - (let ((size_0 (body-record-sizes!_0 body_0 sizes_0))) - (begin-unsafe - (begin - (begin (hash-set! sizes_0 v_1 size_0) size_0))))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_2 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_3 v_2)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_3))) - (if (pair? p_0) - #t - #f)))) - (values result_1)))) - (if (if (not - (let ((x_0 - (list v_3))) - (not result_1))) - #t - #f) - (for-loop_0 result_1 rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_0))) - #f)) - #f) - (let ((bodys_0 - (let ((d_0 (cdr (unwrap v_1)))) - (let ((bodys_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (bodys_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_2 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_3 v_2)) - (let ((bodys_1 - (let ((bodys_1 - (let ((bodys19_0 - (let ((d_1 - (cdr - (unwrap - v_3)))) - d_1))) - (cons - bodys19_0 - bodys_0)))) - (values - bodys_1)))) - (for-loop_0 - bodys_1 - rest_0))))) - bodys_0)))))) - (for-loop_0 null d_0))))) - (reverse$1 bodys_0))))) - (let ((new-size_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (pair? lst_0) - (let ((body_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((result_1 - (let ((result_1 - (+ - result_0 - (body-record-sizes!_0 - body_0 - sizes_0)))) - (values result_1)))) - (for-loop_0 result_1 rest_0)))) - result_0)))))) - (for-loop_0 0 bodys_0))))) - (begin-unsafe - (begin - (begin - (hash-set! sizes_0 v_1 new-size_0) - new-size_0))))) - (if (if (eq? 'let hd_0) #t #f) - (record-sizes-in-let!_0 v_1 sizes_0) - (if (if (eq? 'letrec hd_0) #t #f) - (record-sizes-in-let!_0 v_1 sizes_0) - (if (if (eq? 'letrec* hd_0) #t #f) - (record-sizes-in-let!_0 v_1 sizes_0) - (if (if (eq? 'begin hd_0) #t #f) - (let ((vs_0 (let ((d_0 (cdr (unwrap v_1)))) d_0))) - (add1 (body-record-sizes!_0 vs_0 sizes_0))) - (if (if (eq? 'begin0 hd_0) #t #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap v_1)))) d_0))) - (add1 (body-record-sizes!_0 vs_0 sizes_0))) - (if (if (eq? 'begin-unsafe hd_0) #t #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap v_1)))) d_0))) - (add1 (body-record-sizes!_0 vs_0 sizes_0))) - (if (if (eq? 'if hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((tst_0 - (let ((a_0 (car p_0))) a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((thn_0 - (let ((a_0 (car p_1))) - a_0))) - (let ((els_0 - (let ((d_2 - (cdr p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((thn_1 thn_0)) - (values - thn_1 - els_0))))))) - (case-lambda - ((thn_0 els_0) - (let ((tst_1 tst_0)) - (values tst_1 thn_0 els_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((tst_0 thn_0 els_0) - (let ((app_0 - (record-sizes!_0 tst_0 sizes_0))) - (let ((app_1 - (record-sizes!_0 thn_0 sizes_0))) - (+ - 1 - app_0 - app_1 - (record-sizes!_0 els_0 sizes_0))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? 'with-continuation-mark* hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (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))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? p_3) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap d_0))) - (let ((mode_0 - (let ((a_0 (car p_0))) a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((key_0 - (let ((a_0 - (car p_1))) - a_0))) - (call-with-values - (lambda () - (let ((d_2 (cdr p_1))) - (let ((p_2 - (unwrap - d_2))) - (let ((val_0 - (let ((a_0 - (car - p_2))) - a_0))) - (let ((body_0 - (let ((d_3 - (cdr - p_2))) - (let ((a_0 - (car - (unwrap - d_3)))) - a_0)))) - (let ((val_1 - val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 body_0) - (let ((key_1 key_0)) - (values - key_1 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((key_0 val_0 body_0) - (let ((mode_1 mode_0)) - (values - mode_1 - key_0 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (case-lambda - ((mode_0 key_0 val_0 body_0) - (let ((app_0 - (record-sizes!_0 key_0 sizes_0))) - (let ((app_1 - (record-sizes!_0 - val_0 - sizes_0))) - (+ - 1 - app_0 - app_1 - (record-sizes!_0 - body_0 - sizes_0))))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (if (if (eq? 'quote hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? - app_0 - (unwrap a_1))))) - #f))) - #f) - 1 - (if (if (eq? 'set! hd_0) - (let ((a_0 (cdr (unwrap v_1)))) - (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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap a_2))))) - #f))) - #f))) - #f) - (let ((rhs_0 - (let ((d_0 (cdr (unwrap v_1)))) - (let ((d_1 - (cdr (unwrap d_0)))) - (let ((a_0 - (car (unwrap d_1)))) - a_0))))) - (add1 - (record-sizes!_0 rhs_0 sizes_0))) - (if (wrap-list? v_1) - (body-record-sizes!_0 v_1 sizes_0) - 1)))))))))))))))))) - (body-record-sizes!_0 - (|#%name| - body-record-sizes! - (lambda (body_0 sizes_0) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not (begin-unsafe (null? (unwrap lst_0)))) - (let ((v_1 - (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_2 v_1)) - (let ((result_1 - (let ((result_1 - (+ - result_0 - (record-sizes!_0 v_2 sizes_0)))) - (values result_1)))) - (for-loop_0 result_1 rest_0))))) - result_0)))))) - (for-loop_0 0 body_0))))))) - (record-sizes-in-let!_0 - (|#%name| - record-sizes-in-let! - (lambda (v_1 sizes_0) - (begin - (if (let ((p_0 (unwrap v_1))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_2 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_3 v_2)) - (let ((result_1 - (let ((result_1 - (let ((p_2 - (unwrap - v_3))) - (if (pair? - p_2) - (let ((a_2 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (let ((a_3 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_3))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap v_1))) - (let ((let-form_0 (let ((a_0 (car p_0))) a_0))) - (call-with-values - (lambda () - (let ((d_0 (cdr p_0))) - (let ((p_1 (unwrap d_0))) - (let ((rhss_0 - (let ((a_0 (car p_1))) - (let ((rhss_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (rhss_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_2 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_3 v_2)) - (let ((rhss_1 - (let ((rhss_1 - (let ((rhss20_0 - (let ((d_1 - (cdr - (unwrap - v_3)))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (cons - rhss20_0 - rhss_0)))) - (values - rhss_1)))) - (for-loop_0 - rhss_1 - rest_0))))) - rhss_0)))))) - (for-loop_0 null a_0))))) - (reverse$1 rhss_0))))) - (let ((body_0 (let ((d_1 (cdr p_1))) d_1))) - (let ((rhss_1 rhss_0)) - (values rhss_1 body_0))))))) - (case-lambda - ((rhss_0 body_0) - (let ((let-form_1 let-form_0)) - (values let-form_1 rhss_0 body_0))) - (args (raise-binding-result-arity-error 2 args))))))) - (case-lambda - ((let-form_0 rhss_0 body_0) - (let ((app_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (pair? lst_0) - (let ((rhs_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((result_1 - (let ((result_1 - (+ - result_0 - (record-sizes!_0 - rhs_0 - sizes_0)))) - (values result_1)))) - (for-loop_0 result_1 rest_0)))) - result_0)))))) - (for-loop_0 0 rhss_0))))) - (+ 1 app_0 (body-record-sizes!_0 body_0 sizes_0)))) - (args (raise-binding-result-arity-error 3 args)))) - (error 'match "failed ~e" v_1))))))) - (with-continuation-mark* - authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - gensym-counter - (box 0)) - (top_0)))))) -(define xify - (letrec ((xify-body_0 - (|#%name| - xify-body - (lambda (es_0 env_0) - (begin - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (not (begin-unsafe (null? (unwrap lst_0)))) - (let ((e_0 - (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((e_1 e_0)) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (xify_0 e_1 env_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0))))) - fold-var_0)))))) - (for-loop_0 null es_0)))))))) - (xify-ids_0 - (|#%name| - xify-ids - (lambda (ids_0 env_0) - (begin - (if (pair? ids_0) - (let ((u-id_0 (unwrap (car ids_0)))) - (let ((x_0 - (let ((or-part_0 (hash-ref env_0 u-id_0 #f))) - (if or-part_0 - or-part_0 - (string->symbol - (string-append - "x" - (number->string (hash-count env_0)))))))) - (call-with-values - (lambda () - (let ((app_0 (cdr ids_0))) - (xify-ids_0 app_0 (hash-set env_0 u-id_0 x_0)))) - (case-lambda - ((rest-xs_0 rest-env_0) - (values (cons x_0 rest-xs_0) rest-env_0)) - (args (raise-binding-result-arity-error 2 args)))))) - (if (null? ids_0) - (values '() env_0) - (call-with-values - (lambda () (xify-ids_0 (list ids_0) env_0)) - (case-lambda - ((xs_0 new-env_0) (values (car xs_0) new-env_0)) - (args (raise-binding-result-arity-error 2 args)))))))))) - (xify-let_0 - (|#%name| - xify-let - (lambda (form_0 ids_0 rhss_0 body_0 env_0) - (begin - (call-with-values - (lambda () (xify-ids_0 ids_0 env_0)) - (case-lambda - ((new-ids_0 new-env_0) - (let ((app_0 - (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 ((new-id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((rhs_0 (unsafe-car lst_1))) - (let ((rest_1 - (unsafe-cdr lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (list - new-id_0 - (xify_0 - rhs_0 - (if (eq? - form_0 - 'let) - env_0 - new-env_0))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 null new-ids_0 rhss_0)))))) - (list* form_0 app_0 (xify-body_0 body_0 new-env_0)))) - (args (raise-binding-result-arity-error 2 args)))))))) - (xify_0 - (|#%name| - xify - (lambda (e_0 env_0) - (begin - (reannotate - e_0 - (let ((hd_0 - (let ((p_0 (unwrap e_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((ids_0 (let ((a_0 (car p_0))) a_0))) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0)) - (values ids_1 body_0))))))) - (case-lambda - ((ids_0 body_0) - (call-with-values - (lambda () (xify-ids_0 ids_0 env_0)) - (case-lambda - ((new-ids_0 new-env_0) - (list* - 'lambda - new-ids_0 - (xify-body_0 body_0 new-env_0))) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap e_0)))) (wrap-list? a_0)) - #f) - (let ((clauses_0 - (let ((d_0 (cdr (unwrap e_0)))) - (unwrap-list d_0)))) - (list* - 'case-lambda - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((clause_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (cdr - (xify_0 - (cons - 'lambda - clause_0) - env_0)) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null clauses_0)))))) - (if (if (eq? 'let hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ids_0 rhss_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((ids_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) - (case-lambda - ((ids1_0 - rhss2_0) - (values - (cons - ids1_0 - ids_0) - (cons - rhss2_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 rhss_1) - (values - ids_1 - rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 rhss_1) - (for-loop_0 - ids_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - ids_0 - rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((ids_0 rhss_0) - (let ((app_0 (reverse$1 ids_0))) - (values app_0 (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((ids_0 rhss_0) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0) (rhss_1 rhss_0)) - (values ids_1 rhss_1 body_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((ids_0 rhss_0 body_0) - (xify-let_0 'let ids_0 rhss_0 body_0 env_0)) - (args (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'letrec hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () + (xify-let_0 'letrec ids_0 rhss_0 body_0 env_0)) + (args (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'letrec* hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (ids_0 rhss_0 lst_0) + (lambda (result_0 lst_0) (begin (if (not (begin-unsafe @@ -46575,577 +35817,515 @@ lst_0) null))) (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ids_0 rhss_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (call-with-values + (lambda () (call-with-values (lambda () (call-with-values (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((ids_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) - (case-lambda - ((ids3_0 - rhss4_0) - (values - (cons - ids3_0 - ids_0) - (cons - rhss4_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) + (let ((p_1 + (unwrap + v_1))) + (let ((ids_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) (case-lambda - ((ids_1 - rhss_1) + ((ids5_0 + rhss6_0) (values - ids_1 - rhss_1)) + (cons + ids5_0 + ids_0) + (cons + rhss6_0 + rhss_0))) (args (raise-binding-result-arity-error 2 args))))) (case-lambda ((ids_1 rhss_1) - (for-loop_0 + (values ids_1 - rhss_1 - rest_0)) + rhss_1)) (args (raise-binding-result-arity-error 2 - args))))))) - (values - ids_0 - rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((ids_0 rhss_0) - (let ((app_0 (reverse$1 ids_0))) - (values - app_0 - (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((ids_0 rhss_0) - (let ((body_0 - (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0) (rhss_1 rhss_0)) - (values ids_1 rhss_1 body_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((ids_0 rhss_0 body_0) - (xify-let_0 'letrec ids_0 rhss_0 body_0 env_0)) - (args - (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'letrec* hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 - v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ids_0 rhss_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((ids_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) - (case-lambda - ((ids5_0 - rhss6_0) - (values - (cons - ids5_0 - ids_0) - (cons - rhss6_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 - rhss_1) - (values - ids_1 - rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 - rhss_1) - (for-loop_0 - ids_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - ids_0 - rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((ids_0 rhss_0) - (let ((app_0 (reverse$1 ids_0))) - (values - app_0 - (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) + args))))) + (case-lambda + ((ids_1 rhss_1) + (for-loop_0 + ids_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values ids_0 rhss_0))))))) + (for-loop_0 null null a_0)))) (case-lambda ((ids_0 rhss_0) - (let ((body_0 - (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0) (rhss_1 rhss_0)) - (values ids_1 rhss_1 body_0)))) + (let ((app_0 (reverse$1 ids_0))) + (values app_0 (reverse$1 rhss_0)))) (args (raise-binding-result-arity-error 2 - args))))))) - (case-lambda - ((ids_0 rhss_0 body_0) - (xify-let_0 - 'letrec* - ids_0 - rhss_0 - body_0 - env_0)) - (args - (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'quote hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_1))))) - #f))) - #f) - (let ((v_0 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((a_0 (car (unwrap d_0)))) - a_0)))) - e_0) - (if (if (eq? 'begin hd_0) #t #f) - (let ((body_0 - (let ((d_0 (cdr (unwrap e_0)))) d_0))) - (list* 'begin (xify-body_0 body_0 env_0))) - (if (if (eq? 'if hd_0) - (let ((a_0 (cdr (unwrap e_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((tst_0 - (let ((a_0 (car p_0))) a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((thn_0 - (let ((a_0 - (car p_1))) - a_0))) - (let ((els_0 - (let ((d_2 - (cdr p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((thn_1 thn_0)) - (values - thn_1 - els_0))))))) - (case-lambda - ((thn_0 els_0) - (let ((tst_1 tst_0)) - (values tst_1 thn_0 els_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((tst_0 thn_0 els_0) - (let ((app_0 (xify_0 tst_0 env_0))) - (let ((app_1 (xify_0 thn_0 env_0))) - (list - 'if - app_0 - app_1 - (xify_0 els_0 env_0))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? 'with-continuation-mark* hd_0) - (let ((a_0 (cdr (unwrap e_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))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? p_3) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((mode_0 - (let ((a_0 (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((key_0 - (let ((a_0 - (car p_1))) - a_0))) - (call-with-values - (lambda () - (let ((d_2 - (cdr p_1))) - (let ((p_2 - (unwrap - d_2))) - (let ((val_0 - (let ((a_0 - (car - p_2))) - a_0))) - (let ((body_0 - (let ((d_3 - (cdr - p_2))) - (let ((a_0 - (car - (unwrap - d_3)))) - a_0)))) - (let ((val_1 - val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 body_0) - (let ((key_1 key_0)) - (values - key_1 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((key_0 val_0 body_0) - (let ((mode_1 mode_0)) - (values - mode_1 - key_0 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (case-lambda - ((mode_0 key_0 val_0 body_0) - (let ((app_0 (xify_0 key_0 env_0))) - (let ((app_1 (xify_0 val_0 env_0))) - (list - 'with-continuation-mark* - mode_0 - app_0 - app_1 - (xify_0 body_0 env_0))))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (if (if (eq? 'set! hd_0) - (let ((a_0 (cdr (unwrap e_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap a_2))))) - #f))) - #f))) - #f) + args)))))) + (case-lambda + ((ids_0 rhss_0) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((ids_1 ids_0) (rhss_1 rhss_0)) + (values ids_1 rhss_1 body_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((ids_0 rhss_0 body_0) + (xify-let_0 'letrec* ids_0 rhss_0 body_0 env_0)) + (args (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'quote hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) + #f))) + #f) + (let ((v_0 + (let ((d_0 (cdr (unwrap e_1)))) + (let ((a_0 (car (unwrap d_0)))) a_0)))) + e_1) + (if (if (eq? 'begin hd_0) #t #f) + (let ((body_0 + (let ((d_0 (cdr (unwrap e_1)))) d_0))) + (list* 'begin (xify-body_0 body_0 env_0))) + (if (if (eq? 'if hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (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_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) + (let ((tst_0 + (let ((a_0 (car p_0))) a_0))) (call-with-values (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 - (let ((a_0 (car p_0))) + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((thn_0 + (let ((a_0 (car p_1))) a_0))) - (let ((rhs_0 - (let ((d_1 (cdr p_0))) + (let ((els_0 + (let ((d_2 (cdr p_1))) (let ((a_0 (car (unwrap - d_1)))) + d_2)))) a_0)))) - (let ((id_1 id_0)) - (values id_1 rhs_0))))))) + (let ((thn_1 thn_0)) + (values thn_1 els_0))))))) (case-lambda - ((id_0 rhs_0) - (let ((app_0 (xify_0 id_0 env_0))) - (list - 'set! - app_0 - (xify_0 rhs_0 env_0)))) + ((thn_0 els_0) + (let ((tst_1 tst_0)) + (values tst_1 thn_0 els_0))) (args (raise-binding-result-arity-error 2 - args)))) - (if (let ((p_0 (unwrap e_0))) - (if (pair? p_0) #t #f)) - (xify-body_0 e_0 env_0) - (let ((u-v_0 (unwrap e_0))) - (if (symbol? u-v_0) - (let ((x_0 - (hash-ref - env_0 - u-v_0 - #f))) - (if x_0 - (reannotate e_0 x_0) - e_0)) - e_0)))))))))))))))))))) - (lambda (e_0) (xify_0 e_0 hash2610)))) + args)))))))) + (case-lambda + ((tst_0 thn_0 els_0) + (let ((app_0 (xify_0 tst_0 env_0))) + (let ((app_1 (xify_0 thn_0 env_0))) + (list + 'if + app_0 + app_1 + (xify_0 els_0 env_0))))) + (args + (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'with-continuation-mark* hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (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))) + (let ((p_3 + (unwrap a_3))) + (if (pair? p_3) + (let ((a_4 + (cdr p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) + (let ((mode_0 + (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((key_0 + (let ((a_0 (car p_1))) + a_0))) + (call-with-values + (lambda () + (let ((d_2 (cdr p_1))) + (let ((p_2 + (unwrap d_2))) + (let ((val_0 + (let ((a_0 + (car + p_2))) + a_0))) + (let ((body_0 + (let ((d_3 + (cdr + p_2))) + (let ((a_0 + (car + (unwrap + d_3)))) + a_0)))) + (let ((val_1 + val_0)) + (values + val_1 + body_0))))))) + (case-lambda + ((val_0 body_0) + (let ((key_1 key_0)) + (values + key_1 + val_0 + body_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((key_0 val_0 body_0) + (let ((mode_1 mode_0)) + (values + mode_1 + key_0 + val_0 + body_0))) + (args + (raise-binding-result-arity-error + 3 + args)))))))) + (case-lambda + ((mode_0 key_0 val_0 body_0) + (let ((app_0 (xify_0 key_0 env_0))) + (let ((app_1 (xify_0 val_0 env_0))) + (list + 'with-continuation-mark* + mode_0 + app_0 + app_1 + (xify_0 body_0 env_0))))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (if (if (eq? 'set! hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) + (let ((id_0 + (let ((a_0 (car p_0))) a_0))) + (let ((rhs_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car + (unwrap d_1)))) + a_0)))) + (let ((id_1 id_0)) + (values id_1 rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (let ((app_0 (xify_0 id_0 env_0))) + (list + 'set! + app_0 + (xify_0 rhs_0 env_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (let ((p_0 (unwrap e_1))) + (if (pair? p_0) #t #f)) + (xify-body_0 e_1 env_0) + (let ((u-v_0 (unwrap e_1))) + (if (symbol? u-v_0) + (let ((x_0 (hash-ref env_0 u-v_0 #f))) + (if x_0 (reannotate e_1 x_0) e_1)) + e_1))))))))))))))))))) + (xify-body_0 + (|#%name| + xify-body + (lambda (es_0 env_0) + (begin + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (not (begin-unsafe (null? (unwrap lst_0)))) + (let ((e_1 + (if (begin-unsafe (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((e_2 e_1)) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (xify_0 e_2 env_0) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 fold-var_1 rest_0))))) + fold-var_0)))))) + (for-loop_0 null es_0)))))))) + (xify-let_0 + (|#%name| + xify-let + (lambda (form_0 ids_0 rhss_0 body_0 env_0) + (begin + (call-with-values + (lambda () (xify-ids_0 ids_0 env_0)) + (case-lambda + ((new-ids_0 new-env_0) + (let ((app_0 + (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 ((new-id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((rhs_0 (unsafe-car lst_1))) + (let ((rest_1 (unsafe-cdr lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (list + new-id_0 + (xify_0 + rhs_0 + (if (eq? + form_0 + 'let) + env_0 + new-env_0))) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 null new-ids_0 rhss_0)))))) + (list* form_0 app_0 (xify-body_0 body_0 new-env_0)))) + (args (raise-binding-result-arity-error 2 args)))))))) + (xify-ids_0 + (|#%name| + xify-ids + (lambda (ids_0 env_0) + (begin + (if (pair? ids_0) + (let ((u-id_0 (unwrap (car ids_0)))) + (let ((x_0 + (let ((or-part_0 (hash-ref env_0 u-id_0 #f))) + (if or-part_0 + or-part_0 + (string->symbol + (string-append + "x" + (number->string (hash-count env_0)))))))) + (call-with-values + (lambda () + (let ((app_0 (cdr ids_0))) + (xify-ids_0 app_0 (hash-set env_0 u-id_0 x_0)))) + (case-lambda + ((rest-xs_0 rest-env_0) + (values (cons x_0 rest-xs_0) rest-env_0)) + (args (raise-binding-result-arity-error 2 args)))))) + (if (null? ids_0) + (values '() env_0) + (call-with-values + (lambda () (xify-ids_0 (list ids_0) env_0)) + (case-lambda + ((xs_0 new-env_0) (values (car xs_0) new-env_0)) + (args (raise-binding-result-arity-error 2 args))))))))))) + (xify_0 e_0 hash2610)))) (define kernel (primitive-table '|#%kernel|)) (define 1/syntax? (hash-ref kernel 'syntax?)) (define 1/syntax-e (hash-ref kernel 'syntax-e)) @@ -47183,301 +36363,331 @@ (define correlated-position (lambda (s_0) (|#%app| 1/syntax-position s_0))) (define correlated-span (lambda (s_0) (|#%app| 1/syntax-span s_0))) (define make-path->relative-path-elements.1 - (letrec ((procz1 (lambda (v_0) #f)) - (loop_0 - (|#%name| - loop - (lambda (exploded-wrt-rel-dir_0 rel_0) - (begin - (if (null? exploded-wrt-rel-dir_0) - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((p_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if (path? p_0) - (path-element->bytes p_0) - p_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null rel_0)))) - (if (if (pair? rel_0) - (let ((app_0 (car rel_0))) - (equal? app_0 (car exploded-wrt-rel-dir_0))) - #f) - (let ((app_0 (cdr exploded-wrt-rel-dir_0))) - (loop_0 app_0 (cdr rel_0))) - (let ((app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((p_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (cons 'up fold-var_0))) - (let ((fold-var_2 - (values fold-var_1))) - (for-loop_0 - fold-var_2 - rest_0))))) - fold-var_0)))))) - (for-loop_0 null exploded-wrt-rel-dir_0)))))) - (append - app_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((p_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if (path? p_0) - (path-element->bytes - p_0) - p_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null rel_0))))))))))))) - (|#%name| - make-path->relative-path-elements - (lambda (who1_0 wr-dir3_0) - (begin - (let ((wr-dir_0 - (if (eq? wr-dir3_0 unsafe-undefined) - (current-write-relative-directory) - wr-dir3_0))) - (begin - (if who1_0 - (if (let ((or-part_0 (not wr-dir_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (if (path-string? wr-dir_0) - (complete-path? wr-dir_0) - #f))) - (if or-part_1 - or-part_1 - (if (pair? wr-dir_0) - (if (path-string? (car wr-dir_0)) - (if (complete-path? (car wr-dir_0)) - (if (path-string? (cdr wr-dir_0)) - (complete-path? (cdr wr-dir_0)) - #f) + (|#%name| + make-path->relative-path-elements + (lambda (who1_0 wr-dir3_0) + (begin + (let ((wr-dir_0 + (if (eq? wr-dir3_0 unsafe-undefined) + (current-write-relative-directory) + wr-dir3_0))) + (begin + (if who1_0 + (if (let ((or-part_0 (not wr-dir_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (if (path-string? wr-dir_0) + (complete-path? wr-dir_0) + #f))) + (if or-part_1 + or-part_1 + (if (pair? wr-dir_0) + (if (path-string? (car wr-dir_0)) + (if (complete-path? (car wr-dir_0)) + (if (path-string? (cdr wr-dir_0)) + (complete-path? (cdr wr-dir_0)) #f) #f) - #f))))) - (void) - (raise-argument-error - who1_0 - (string-append - "(or/c (and/c path-string? complete-path?)\n" - " (cons/c (and/c path-string? complete-path?)\n" - " (and/c path-string? complete-path?))\n" - " #f)") - wr-dir_0)) - (void)) - (if (not wr-dir_0) - procz1 - (let ((exploded-base-dir_0 'not-ready)) - (let ((exploded-wrt-rel-dir_0 'not-ready)) - (lambda (v_0) - (begin - (if (if (eq? exploded-base-dir_0 'not-ready) - (path? v_0) #f) - (let ((wrt-dir_0 - (if wr-dir_0 - (if (pair? wr-dir_0) (car wr-dir_0) wr-dir_0) - #f))) - (let ((exploded-wrt-dir_0 (explode-path wrt-dir_0))) - (let ((base-dir_0 - (if wr-dir_0 - (if (pair? wr-dir_0) - (cdr wr-dir_0) - wr-dir_0) - #f))) - (begin - (set! exploded-base-dir_0 - (if base-dir_0 - (explode-path base-dir_0) - #f)) - (set! exploded-wrt-rel-dir_0 - (if (eq? base-dir_0 wrt-dir_0) - '() - (let ((exploded-wrt-dir_1 - (explode-path wrt-dir_0))) - (let ((base-len_0 - (length exploded-base-dir_0))) - (begin - (if who1_0 - (if (if (>= - (length - exploded-wrt-dir_1) - base-len_0) - (let ((lst_0 - exploded-base-dir_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - lst_1 + #f))))) + (void) + (raise-argument-error + who1_0 + (string-append + "(or/c (and/c path-string? complete-path?)\n" + " (cons/c (and/c path-string? complete-path?)\n" + " (and/c path-string? complete-path?))\n" + " #f)") + wr-dir_0)) + (void)) + (if (not wr-dir_0) + (lambda (v_0) #f) + (let ((exploded-base-dir_0 'not-ready)) + (let ((exploded-wrt-rel-dir_0 'not-ready)) + (lambda (v_0) + (begin + (if (if (eq? exploded-base-dir_0 'not-ready) + (path? v_0) + #f) + (let ((wrt-dir_0 + (if wr-dir_0 + (if (pair? wr-dir_0) (car wr-dir_0) wr-dir_0) + #f))) + (let ((exploded-wrt-dir_0 (explode-path wrt-dir_0))) + (let ((base-dir_0 + (if wr-dir_0 + (if (pair? wr-dir_0) + (cdr wr-dir_0) + wr-dir_0) + #f))) + (begin + (set! exploded-base-dir_0 + (if base-dir_0 (explode-path base-dir_0) #f)) + (set! exploded-wrt-rel-dir_0 + (if (eq? base-dir_0 wrt-dir_0) + '() + (let ((exploded-wrt-dir_1 + (explode-path wrt-dir_0))) + (let ((base-len_0 + (length exploded-base-dir_0))) + (begin + (if who1_0 + (if (if (>= + (length exploded-wrt-dir_1) + base-len_0) + (let ((lst_0 + exploded-base-dir_0)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_1 + lst_2) + (begin + (if (if (pair? + lst_1) + (pair? lst_2) - (begin - (if (if (pair? - lst_1) - (pair? - lst_2) - #f) - (let ((a_0 - (unsafe-car + #f) + (let ((a_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((b_0 - (unsafe-car + (let ((b_0 + (unsafe-car + lst_2))) + (let ((rest_1 + (unsafe-cdr lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((result_1 - (let ((result_1 - (equal? - a_0 - b_0))) - (values - result_1)))) - (if (if (not + (let ((result_1 + (let ((result_1 + (equal? + a_0 + b_0))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + a_0))) + (not + result_1))) + (if (not (let ((x_0 (list - a_0))) + b_0))) (not result_1))) - (if (not - (let ((x_0 - (list - b_0))) - (not - result_1))) - #t - #f) + #t #f) - (for-loop_0 - result_1 - rest_0 - rest_1) - result_1)))))) - result_0)))))) - (for-loop_0 - #t - exploded-wrt-dir_1 - lst_0)))) - #f) - (void) - (raise-arguments-error - who1_0 - "relative-directory pair's first path does not extend second path" - "first path" - wrt-dir_0 - "second path" - base-dir_0)) - (void)) - (list-tail - exploded-wrt-dir_1 - base-len_0)))))))))) - (void)) - (if exploded-base-dir_0 - (if (path? v_0) - (let ((exploded_0 (explode-path v_0))) - (if (let ((lst_0 exploded-base-dir_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_1 lst_2) - (begin - (if (if (pair? lst_1) - (pair? lst_2) - #f) - (let ((base-p_0 - (unsafe-car lst_1))) - (let ((rest_0 - (unsafe-cdr lst_1))) - (let ((p_0 - (unsafe-car lst_2))) - (let ((rest_1 - (unsafe-cdr - lst_2))) - (let ((result_1 - (let ((result_1 - (equal? - base-p_0 - p_0))) - (values - result_1)))) - (if (if (not + #f) + (for-loop_0 + result_1 + rest_0 + rest_1) + result_1)))))) + result_0)))))) + (for-loop_0 + #t + exploded-wrt-dir_1 + lst_0)))) + #f) + (void) + (raise-arguments-error + who1_0 + "relative-directory pair's first path does not extend second path" + "first path" + wrt-dir_0 + "second path" + base-dir_0)) + (void)) + (list-tail + exploded-wrt-dir_1 + base-len_0)))))))))) + (void)) + (if exploded-base-dir_0 + (if (path? v_0) + (let ((exploded_0 (explode-path v_0))) + (if (let ((lst_0 exploded-base-dir_0)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_1 lst_2) + (begin + (if (if (pair? lst_1) + (pair? lst_2) + #f) + (let ((base-p_0 + (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) + (let ((p_0 + (unsafe-car lst_2))) + (let ((rest_1 + (unsafe-cdr lst_2))) + (let ((result_1 + (let ((result_1 + (equal? + base-p_0 + p_0))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + base-p_0))) + (not + result_1))) + (if (not (let ((x_0 (list - base-p_0))) + p_0))) (not result_1))) - (if (not - (let ((x_0 - (list - p_0))) - (not - result_1))) - #t - #f) + #t #f) - (for-loop_0 - result_1 - rest_0 - rest_1) - result_1)))))) - result_0)))))) - (for-loop_0 #t lst_0 exploded_0)))) - (if (let ((app_0 (length exploded_0))) - (>= app_0 (length exploded-base-dir_0))) - (let ((app_0 exploded-wrt-rel-dir_0)) - (loop_0 - app_0 - (list-tail - exploded_0 - (length exploded-base-dir_0)))) - #f) - #f)) - #f) - #f))))))))))))) + #f) + (for-loop_0 + result_1 + rest_0 + rest_1) + result_1)))))) + result_0)))))) + (for-loop_0 #t lst_0 exploded_0)))) + (if (let ((app_0 (length exploded_0))) + (>= app_0 (length exploded-base-dir_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (exploded-wrt-rel-dir_1 rel_0) + (begin + (if (null? exploded-wrt-rel-dir_1) + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((p_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if (path? + p_0) + (path-element->bytes + p_0) + p_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 null rel_0)))) + (if (if (pair? rel_0) + (let ((app_0 (car rel_0))) + (equal? + app_0 + (car + exploded-wrt-rel-dir_1))) + #f) + (let ((app_0 + (cdr + exploded-wrt-rel-dir_1))) + (loop_0 app_0 (cdr rel_0))) + (let ((app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? lst_0) + (let ((p_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (cons + 'up + fold-var_0))) + (let ((fold-var_2 + (values + fold-var_1))) + (for-loop_0 + fold-var_2 + rest_0))))) + fold-var_0)))))) + (for-loop_0 + null + exploded-wrt-rel-dir_1)))))) + (append + app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((p_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if (path? + p_0) + (path-element->bytes + p_0) + p_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + rel_0))))))))))))) + (let ((app_0 exploded-wrt-rel-dir_0)) + (loop_0 + app_0 + (list-tail + exploded_0 + (length exploded-base-dir_0))))) + #f) + #f)) + #f) + #f)))))))))))) (define 1/write-byte (|#%name| write-byte @@ -47551,1084 +36761,261 @@ (define fasl-hash-equal-variant 1) (define fasl-hash-eqv-variant 2) (define s-exp->fasl.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - v_0) - (begin - (if (if external-lift_0 (hash-ref external-lift_0 v_0 #f) #f) - (void) - (if (if external-lift?7_0 - (|#%app| external-lift?7_0 v_0) - #f) - (begin - (hash-set! external-lift_0 v_0 #t) - (unsafe-set-box*! - shared-counter_0 - (add1 (unsafe-unbox* shared-counter_0))) - (hash-set! - shared_0 - v_0 - (- (unsafe-unbox* shared-counter_0)))) - (if (let ((or-part_0 (symbol? v_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (keyword? v_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 (string? v_0))) - (if or-part_2 - or-part_2 - (let ((or-part_3 (bytes? v_0))) - (if or-part_3 - or-part_3 - (path? v_0))))))))) - (begin-unsafe - (do-hash-update - 'hash-update! - #t - hash-set! - shared_0 - v_0 - add1 - 0)) - (if (pair? v_0) - (begin - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (car v_0)) - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (cdr v_0))) - (if (vector? v_0) - (begin - (call-with-values - (lambda () - (begin - (check-vector v_0) - (values v_0 (unsafe-vector-length v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (unsafe-fx< pos_0 len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - e_0) - (for-loop_0 - (unsafe-fx+ 1 pos_0)))) - (values))))))) - (for-loop_0 0)))) - (args - (raise-binding-result-arity-error 2 args)))) - (void)) - (if (hash? v_0) - (hash-for-each - v_0 - (lambda (k_0 v_1) - (begin - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - k_0) - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - v_1))) - #t) - (if (box? v_0) - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (unbox v_0)) - (let ((c1_0 (prefab-struct-key v_0))) - (if c1_0 - (begin - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - c1_0) - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - (struct->vector v_0) - 1 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (begin - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - e_0) - (for-loop_0 - (unsafe-fx+ - idx_0 - 1)))) - (values))))))) - (for-loop_0 start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (void)) - (if (srcloc? v_0) - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (srcloc-source v_0)) - (if (begin-unsafe (|#%app| 1/syntax? v_0)) - (begin - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (begin-unsafe - (|#%app| 1/syntax-e v_0))) - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (begin-unsafe - (|#%app| 1/syntax-source v_0))) - (let ((lst_0 - (begin-unsafe - (|#%app| - 1/syntax-property-symbol-keys - v_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((k_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (begin - (begin - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - k_0) - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - (begin-unsafe - (|#%app| - 1/syntax-property - v_0 - k_0)))) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void)) - (void)))))))))))))))) - (loop_1 - (|#%name| - loop - (lambda (handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - v_0) - (begin - (if (not (eq? (hash-ref shared_0 v_0 1) 1)) - (let ((c_0 (hash-ref shared_0 v_0))) - (if (negative? c_0) - (begin - (begin-unsafe (write-byte 2 o_0)) - (write-fasl-integer (sub1 (- c_0)) o_0)) - (let ((pos_0 (unsafe-unbox* shared-counter_0))) - (begin - (unsafe-set-box*! - shared-counter_0 - (add1 (unsafe-unbox* shared-counter_0))) - (begin-unsafe (write-byte 1 o_0)) - (write-fasl-integer pos_0 o_0) - (hash-remove! shared_0 v_0) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - v_0) - (hash-set! shared_0 v_0 (- (add1 pos_0))))))) - (if (not v_0) - (begin-unsafe (write-byte 3 o_0)) - (if (eq? v_0 #t) - (begin-unsafe (write-byte 4 o_0)) - (if (null? v_0) - (begin-unsafe (write-byte 5 o_0)) - (if (void? v_0) - (begin-unsafe (write-byte 6 o_0)) - (if (eof-object? v_0) - (begin-unsafe (write-byte 7 o_0)) - (if (exact-integer? v_0) - (if (<= -10 v_0 144) - (let ((byte_0 (+ 100 (- v_0 -10)))) - (begin-unsafe (write-byte byte_0 o_0))) - (begin - (begin-unsafe (write-byte 8 o_0)) - (write-fasl-integer v_0 o_0))) - (if (flonum? v_0) - (begin - (begin-unsafe (write-byte 9 o_0)) - (1/write-bytes - (if (eqv? v_0 +nan.0) - #vu8(0 0 0 0 0 0 248 127) - (real->floating-point-bytes v_0 8 #f)) - o_0)) - (if (single-flonum? v_0) - (begin - (begin-unsafe (write-byte 10 o_0)) - (1/write-bytes - (if (eqv? - v_0 - (real->single-flonum +nan.0)) - #vu8(0 0 192 127) - (real->floating-point-bytes v_0 4 #f)) - o_0)) - (if (extflonum? v_0) - (begin - (begin-unsafe (write-byte 39 o_0)) - (let ((bstr_0 - (string->bytes/utf-8 - (format "~a" v_0)))) - (begin - (write-fasl-integer - (unsafe-bytes-length bstr_0) - o_0) - (1/write-bytes bstr_0 o_0)))) - (if (rational? v_0) - (begin - (begin-unsafe (write-byte 11 o_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (numerator v_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (denominator v_0))) - (if (complex? v_0) - (begin - (begin-unsafe (write-byte 12 o_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (real-part v_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (imag-part v_0))) - (if (char? v_0) - (begin - (begin-unsafe (write-byte 13 o_0)) - (write-fasl-integer - (char->integer v_0) - o_0)) - (if (symbol? v_0) - (begin - (if (symbol-interned? v_0) - (begin-unsafe - (write-byte 14 o_0)) - (if (symbol-unreadable? v_0) - (begin-unsafe - (write-byte 15 o_0)) - (begin-unsafe - (write-byte 16 o_0)))) - (let ((bstr_0 - (string->bytes/utf-8 - (symbol->string v_0)))) - (begin - (write-fasl-integer - (unsafe-bytes-length - bstr_0) - o_0) - (1/write-bytes - bstr_0 - o_0)))) - (if (keyword? v_0) - (begin - (begin-unsafe - (write-byte 17 o_0)) - (let ((bstr_0 - (string->bytes/utf-8 - (keyword->string - v_0)))) - (begin - (write-fasl-integer - (unsafe-bytes-length - bstr_0) - o_0) - (1/write-bytes - bstr_0 - o_0)))) - (if (string? v_0) - (begin - (write-fasl-integer - (if (treat-immutable?_0 - keep-mutable?5_0 - v_0) - 19 - 18) - o_0) - (write-fasl-string v_0 o_0)) - (if (bytes? v_0) - (begin - (write-fasl-integer - (if (treat-immutable?_0 - keep-mutable?5_0 - v_0) - 21 - 20) - o_0) - (write-fasl-bytes - v_0 - o_0)) - (if (path-for-some-system? - v_0) - (let ((rel-elems_0 - (|#%app| - path->relative-path-elements_0 - v_0))) - (if rel-elems_0 - (begin - (begin-unsafe - (write-byte - 23 - o_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - rel-elems_0)) - (begin - (begin-unsafe - (write-byte - 22 - o_0)) - (write-fasl-bytes - (path->bytes v_0) - o_0) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (path-convention-type - v_0))))) - (if (if (srcloc? v_0) - (let ((src_0 - (srcloc-source - v_0))) - (let ((or-part_0 - (not - src_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (path-for-some-system? - src_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (string? - src_0))) - (if or-part_2 - or-part_2 - (let ((or-part_3 - (bytes? - src_0))) - (if or-part_3 - or-part_3 - (symbol? - src_0)))))))))) - #f) - (let ((src_0 - (srcloc-source - v_0))) - (let ((new-src_0 - (if (if (path? - src_0) - (not - (|#%app| - path->relative-path-elements_0 - src_0)) - #f) - (truncate-path - src_0) - src_0))) - (begin - (write-fasl-integer - 38 - o_0) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - new-src_0) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (srcloc-line - v_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (srcloc-column - v_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (srcloc-position - v_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (srcloc-span - v_0))))) - (if (pair? v_0) - (if (pair? (cdr v_0)) - (call-with-values - (lambda () - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (v_1 - len_0) - (begin - (if (null? - v_1) - (values - len_0 - #t) - (if (pair? - v_1) - (let ((app_0 - (cdr - v_1))) - (loop_2 - app_0 - (add1 - len_0))) - (values - len_0 - #f)))))))) - (loop_2 v_0 0))) - (case-lambda - ((n_0 - normal-list?_0) - (begin - (let ((byte_0 - (if normal-list?_0 - 28 - 29))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (write-fasl-integer - n_0 - o_0) - (letrec* - ((ploop_0 - (|#%name| - ploop - (lambda (v_1) - (begin - (if (pair? - v_1) - (begin - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (car - v_1)) - (ploop_0 - (cdr - v_1))) - (if normal-list?_0 - (void) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - v_1)))))))) - (ploop_0 - v_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (begin - (begin-unsafe - (write-byte - 30 - o_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (car v_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (cdr v_0)))) - (if (vector? v_0) - (begin - (let ((byte_0 - (if (treat-immutable?_0 - keep-mutable?5_0 - v_0) - 32 - 31))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (write-fasl-integer - (vector-length - v_0) - o_0) - (call-with-values - (lambda () - (begin - (check-vector - v_0) - (values - v_0 - (unsafe-vector-length - v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - e_0) - (for-loop_0 - (unsafe-fx+ - 1 - pos_0)))) - (values))))))) - (for-loop_0 - 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (void)) - (if (box? v_0) - (begin - (let ((byte_0 - (if (treat-immutable?_0 - keep-mutable?5_0 - v_0) - 34 - 33))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (unbox v_0))) - (let ((c2_0 - (prefab-struct-key - v_0))) - (if c2_0 - (begin - (begin-unsafe - (write-byte - 35 - o_0)) - (begin - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - c2_0) - (let ((vec_0 - (struct->vector - v_0))) - (begin - (write-fasl-integer - (sub1 - (vector-length - vec_0)) - o_0) - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - vec_0 - 1 - #f - 1)) - (case-lambda - ((v*_0 - start*_0 - stop*_0 - step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (begin - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - e_0) - (for-loop_0 - (unsafe-fx+ - idx_0 - 1)))) - (values))))))) - (for-loop_0 - start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (void))))) - (if (hash? - v_0) - (begin - (let ((byte_0 - (if (treat-immutable?_0 - keep-mutable?5_0 - v_0) - 37 - 36))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (let ((byte_0 - (if (hash-eq? - v_0) - 0 - (if (hash-eqv? - v_0) - 2 - 1)))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (write-fasl-integer - (hash-count - v_0) - o_0) - (hash-for-each - v_0 - (lambda (k_0 - v_1) - (begin - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - k_0) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - v_1))) - #t)) - (if (regexp? - v_0) - (begin - (let ((byte_0 - (if (pregexp? - v_0) - 24 - 25))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (write-fasl-string - (object-name - v_0) - o_0)) - (if (byte-regexp? - v_0) - (begin - (let ((byte_0 - (if (byte-pregexp? - v_0) - 26 - 27))) - (begin-unsafe - (write-byte - byte_0 - o_0))) - (write-fasl-bytes - (object-name - v_0) - o_0)) - (if (begin-unsafe - (|#%app| - 1/syntax? - v_0)) - (begin - (begin-unsafe - (write-byte - 40 - o_0)) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (begin-unsafe - (|#%app| - 1/syntax-e - v_0))) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (let ((app_0 - (begin-unsafe - (|#%app| - 1/syntax-source - v_0)))) - (let ((app_1 - (begin-unsafe - (|#%app| - 1/syntax-line - v_0)))) - (let ((app_2 - (begin-unsafe - (|#%app| - 1/syntax-column - v_0)))) - (let ((app_3 - (begin-unsafe - (|#%app| - 1/syntax-position - v_0)))) - (unsafe-make-srcloc - app_0 - app_1 - app_2 - app_3 - (begin-unsafe - (|#%app| - 1/syntax-span - v_0)))))))) - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (reverse$1 - (let ((lst_0 - (begin-unsafe - (|#%app| - 1/syntax-property-symbol-keys - v_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((k_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (cons - k_0 - (begin-unsafe - (|#%app| - 1/syntax-property - v_0 - k_0))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - lst_0))))))) - (if (eq? - v_0 - unsafe-undefined) - (begin-unsafe - (write-byte - 41 - o_0)) - (if handle-fail6_0 - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_0 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - (|#%app| - handle-fail6_0 - v_0)) - (raise-arguments-error - 's-exp->fasl - "cannot write value" - "value" - v_0))))))))))))))))))))))))))))))))))) - (treat-immutable?_0 - (|#%name| - treat-immutable? - (lambda (keep-mutable?5_0 v_0) - (begin - (let ((or-part_0 (not keep-mutable?5_0))) - (if or-part_0 or-part_0 (immutable? v_0)))))))) - (|#%name| - s-exp->fasl - (lambda (external-lift?7_0 - handle-fail6_0 - keep-mutable?5_0 - skip-prefix?8_0 - v14_0 - orig-o13_0) + (|#%name| + s-exp->fasl + (lambda (external-lift?7_0 + handle-fail6_0 + keep-mutable?5_0 + skip-prefix?8_0 + v14_0 + orig-o13_0) + (begin (begin + (if orig-o13_0 + (if (output-port? orig-o13_0) + (void) + (raise-argument-error + 's-exp->fasl + "(or/c output-port? #f)" + orig-o13_0)) + (void)) (begin - (if orig-o13_0 - (if (output-port? orig-o13_0) + (if handle-fail6_0 + (if (if (procedure? handle-fail6_0) + (procedure-arity-includes? handle-fail6_0 1) + #f) (void) (raise-argument-error 's-exp->fasl - "(or/c output-port? #f)" - orig-o13_0)) + "(or/c (procedure-arity-includes/c 1) #f)" + handle-fail6_0)) (void)) (begin - (if handle-fail6_0 - (if (if (procedure? handle-fail6_0) - (procedure-arity-includes? handle-fail6_0 1) + (if external-lift?7_0 + (if (if (procedure? external-lift?7_0) + (procedure-arity-includes? external-lift?7_0 1) #f) (void) (raise-argument-error 's-exp->fasl "(or/c (procedure-arity-includes/c 1) #f)" - handle-fail6_0)) + external-lift?7_0)) (void)) - (begin - (if external-lift?7_0 - (if (if (procedure? external-lift?7_0) - (procedure-arity-includes? external-lift?7_0 1) - #f) - (void) - (raise-argument-error - 's-exp->fasl - "(or/c (procedure-arity-includes/c 1) #f)" - external-lift?7_0)) - (void)) - (let ((o_0 (if orig-o13_0 orig-o13_0 (open-output-bytes)))) - (let ((shared_0 (make-hasheq))) - (let ((external-lift_0 - (if external-lift?7_0 (make-hasheq) #f))) - (let ((shared-counter_0 (box 0))) - (begin - (loop_0 - external-lift?7_0 - external-lift_0 - shared-counter_0 - shared_0 - v14_0) + (let ((o_0 (if orig-o13_0 orig-o13_0 (open-output-bytes)))) + (let ((shared_0 (make-hasheq))) + (let ((external-lift_0 + (if external-lift?7_0 (make-hasheq) #f))) + (let ((shared-counter_0 0)) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_0) + (begin + (if (if external-lift_0 + (hash-ref external-lift_0 v_0 #f) + #f) + (void) + (if (if external-lift?7_0 + (|#%app| external-lift?7_0 v_0) + #f) + (begin + (hash-set! external-lift_0 v_0 #t) + (set! shared-counter_0 + (add1 shared-counter_0)) + (hash-set! + shared_0 + v_0 + (- shared-counter_0))) + (if (let ((or-part_0 (symbol? v_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (keyword? v_0))) + (if or-part_1 + or-part_1 + (let ((or-part_2 (string? v_0))) + (if or-part_2 + or-part_2 + (let ((or-part_3 + (bytes? v_0))) + (if or-part_3 + or-part_3 + (path? v_0))))))))) + (begin-unsafe + (do-hash-update + 'hash-update! + #t + hash-set! + shared_0 + v_0 + add1 + 0)) + (if (pair? v_0) + (begin + (loop_0 (car v_0)) + (loop_0 (cdr v_0))) + (if (vector? v_0) + (begin + (call-with-values + (lambda () + (begin + (check-vector v_0) + (values + v_0 + (unsafe-vector-length v_0)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (loop_0 e_0) + (for-loop_0 + (unsafe-fx+ + 1 + pos_0)))) + (values))))))) + (for-loop_0 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (void)) + (if (hash? v_0) + (hash-for-each + v_0 + (lambda (k_0 v_1) + (begin + (loop_0 k_0) + (loop_0 v_1))) + #t) + (if (box? v_0) + (loop_0 (unbox v_0)) + (let ((c1_0 + (prefab-struct-key v_0))) + (if c1_0 + (begin + (loop_0 c1_0) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + (struct->vector v_0) + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + idx_0 + 1)))) + (values))))))) + (for-loop_0 + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (void)) + (if (srcloc? v_0) + (loop_0 (srcloc-source v_0)) + (if (begin-unsafe + (|#%app| + 1/syntax? + v_0)) + (begin + (loop_0 + (begin-unsafe + (|#%app| + 1/syntax-e + v_0))) + (loop_0 + (begin-unsafe + (|#%app| + 1/syntax-source + v_0))) + (let ((lst_0 + (begin-unsafe + (|#%app| + 1/syntax-property-symbol-keys + v_0)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? + lst_1) + (let ((k_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (begin + (begin + (loop_0 + k_0) + (loop_0 + (begin-unsafe + (|#%app| + 1/syntax-property + v_0 + k_0)))) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + lst_0)))) + (void)) + (void))))))))))))))))) + (loop_0 v14_0)) + (let ((treat-immutable?_0 + (|#%name| + treat-immutable? + (lambda (v_0) + (begin + (let ((or-part_0 (not keep-mutable?5_0))) + (if or-part_0 + or-part_0 + (immutable? v_0)))))))) (let ((path->relative-path-elements_0 (make-path->relative-path-elements.1 #f @@ -48640,19 +37027,739 @@ (let ((bstr_0 (let ((o_1 (open-output-bytes))) (begin - (loop_1 - handle-fail6_0 - keep-mutable?5_0 - o_1 - path->relative-path-elements_0 - shared-counter_0 - shared_0 - v14_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_0) + (begin + (if (not + (eq? + (hash-ref shared_0 v_0 1) + 1)) + (let ((c_0 + (hash-ref + shared_0 + v_0))) + (if (negative? c_0) + (begin + (begin-unsafe + (write-byte 2 o_1)) + (write-fasl-integer + (sub1 (- c_0)) + o_1)) + (let ((pos_0 + shared-counter_0)) + (begin + (set! shared-counter_0 + (add1 + shared-counter_0)) + (begin-unsafe + (write-byte 1 o_1)) + (write-fasl-integer + pos_0 + o_1) + (hash-remove! + shared_0 + v_0) + (loop_0 v_0) + (hash-set! + shared_0 + v_0 + (- + (add1 pos_0))))))) + (if (not v_0) + (begin-unsafe + (write-byte 3 o_1)) + (if (eq? v_0 #t) + (begin-unsafe + (write-byte 4 o_1)) + (if (null? v_0) + (begin-unsafe + (write-byte 5 o_1)) + (if (void? v_0) + (begin-unsafe + (write-byte 6 o_1)) + (if (eof-object? v_0) + (begin-unsafe + (write-byte + 7 + o_1)) + (if (exact-integer? + v_0) + (if (<= + -10 + v_0 + 144) + (let ((byte_0 + (+ + 100 + (- + v_0 + -10)))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (begin + (begin-unsafe + (write-byte + 8 + o_1)) + (write-fasl-integer + v_0 + o_1))) + (if (flonum? v_0) + (begin + (begin-unsafe + (write-byte + 9 + o_1)) + (1/write-bytes + (if (eqv? + v_0 + +nan.0) + #vu8(0 0 0 0 0 0 248 127) + (real->floating-point-bytes + v_0 + 8 + #f)) + o_1)) + (if (single-flonum? + v_0) + (begin + (begin-unsafe + (write-byte + 10 + o_1)) + (1/write-bytes + (if (eqv? + v_0 + (real->single-flonum + +nan.0)) + #vu8(0 0 192 127) + (real->floating-point-bytes + v_0 + 4 + #f)) + o_1)) + (if (extflonum? + v_0) + (begin + (begin-unsafe + (write-byte + 39 + o_1)) + (let ((bstr_0 + (string->bytes/utf-8 + (format + "~a" + v_0)))) + (begin + (write-fasl-integer + (unsafe-bytes-length + bstr_0) + o_1) + (1/write-bytes + bstr_0 + o_1)))) + (if (rational? + v_0) + (begin + (begin-unsafe + (write-byte + 11 + o_1)) + (loop_0 + (numerator + v_0)) + (loop_0 + (denominator + v_0))) + (if (complex? + v_0) + (begin + (begin-unsafe + (write-byte + 12 + o_1)) + (loop_0 + (real-part + v_0)) + (loop_0 + (imag-part + v_0))) + (if (char? + v_0) + (begin + (begin-unsafe + (write-byte + 13 + o_1)) + (write-fasl-integer + (char->integer + v_0) + o_1)) + (if (symbol? + v_0) + (begin + (if (symbol-interned? + v_0) + (begin-unsafe + (write-byte + 14 + o_1)) + (if (symbol-unreadable? + v_0) + (begin-unsafe + (write-byte + 15 + o_1)) + (begin-unsafe + (write-byte + 16 + o_1)))) + (let ((bstr_0 + (string->bytes/utf-8 + (symbol->string + v_0)))) + (begin + (write-fasl-integer + (unsafe-bytes-length + bstr_0) + o_1) + (1/write-bytes + bstr_0 + o_1)))) + (if (keyword? + v_0) + (begin + (begin-unsafe + (write-byte + 17 + o_1)) + (let ((bstr_0 + (string->bytes/utf-8 + (keyword->string + v_0)))) + (begin + (write-fasl-integer + (unsafe-bytes-length + bstr_0) + o_1) + (1/write-bytes + bstr_0 + o_1)))) + (if (string? + v_0) + (begin + (write-fasl-integer + (if (treat-immutable?_0 + v_0) + 19 + 18) + o_1) + (write-fasl-string + v_0 + o_1)) + (if (bytes? + v_0) + (begin + (write-fasl-integer + (if (treat-immutable?_0 + v_0) + 21 + 20) + o_1) + (write-fasl-bytes + v_0 + o_1)) + (if (path-for-some-system? + v_0) + (let ((rel-elems_0 + (|#%app| + path->relative-path-elements_0 + v_0))) + (if rel-elems_0 + (begin + (begin-unsafe + (write-byte + 23 + o_1)) + (loop_0 + rel-elems_0)) + (begin + (begin-unsafe + (write-byte + 22 + o_1)) + (write-fasl-bytes + (path->bytes + v_0) + o_1) + (loop_0 + (path-convention-type + v_0))))) + (if (if (srcloc? + v_0) + (let ((src_0 + (srcloc-source + v_0))) + (let ((or-part_0 + (not + src_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (path-for-some-system? + src_0))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (string? + src_0))) + (if or-part_2 + or-part_2 + (let ((or-part_3 + (bytes? + src_0))) + (if or-part_3 + or-part_3 + (symbol? + src_0)))))))))) + #f) + (let ((src_0 + (srcloc-source + v_0))) + (let ((new-src_0 + (if (if (path? + src_0) + (not + (|#%app| + path->relative-path-elements_0 + src_0)) + #f) + (truncate-path + src_0) + src_0))) + (begin + (write-fasl-integer + 38 + o_1) + (loop_0 + new-src_0) + (loop_0 + (srcloc-line + v_0)) + (loop_0 + (srcloc-column + v_0)) + (loop_0 + (srcloc-position + v_0)) + (loop_0 + (srcloc-span + v_0))))) + (if (pair? + v_0) + (if (pair? + (cdr + v_0)) + (call-with-values + (lambda () + (letrec* + ((loop_1 + (|#%name| + loop + (lambda (v_1 + len_0) + (begin + (if (null? + v_1) + (values + len_0 + #t) + (if (pair? + v_1) + (let ((app_0 + (cdr + v_1))) + (loop_1 + app_0 + (add1 + len_0))) + (values + len_0 + #f)))))))) + (loop_1 + v_0 + 0))) + (case-lambda + ((n_0 + normal-list?_0) + (begin + (let ((byte_0 + (if normal-list?_0 + 28 + 29))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (write-fasl-integer + n_0 + o_1) + (letrec* + ((ploop_0 + (|#%name| + ploop + (lambda (v_1) + (begin + (if (pair? + v_1) + (begin + (loop_0 + (car + v_1)) + (ploop_0 + (cdr + v_1))) + (if normal-list?_0 + (void) + (loop_0 + v_1)))))))) + (ploop_0 + v_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (begin + (begin-unsafe + (write-byte + 30 + o_1)) + (loop_0 + (car + v_0)) + (loop_0 + (cdr + v_0)))) + (if (vector? + v_0) + (begin + (let ((byte_0 + (if (treat-immutable?_0 + v_0) + 32 + 31))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (write-fasl-integer + (vector-length + v_0) + o_1) + (call-with-values + (lambda () + (begin + (check-vector + v_0) + (values + v_0 + (unsafe-vector-length + v_0)))) + (case-lambda + ((vec_0 + len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + 1 + pos_0)))) + (values))))))) + (for-loop_0 + 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (void)) + (if (box? + v_0) + (begin + (let ((byte_0 + (if (treat-immutable?_0 + v_0) + 34 + 33))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (loop_0 + (unbox + v_0))) + (let ((c2_0 + (prefab-struct-key + v_0))) + (if c2_0 + (begin + (begin-unsafe + (write-byte + 35 + o_1)) + (begin + (loop_0 + c2_0) + (let ((vec_0 + (struct->vector + v_0))) + (begin + (write-fasl-integer + (sub1 + (vector-length + vec_0)) + o_1) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + vec_0 + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (begin + (loop_0 + e_0) + (for-loop_0 + (unsafe-fx+ + idx_0 + 1)))) + (values))))))) + (for-loop_0 + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (void))))) + (if (hash? + v_0) + (begin + (let ((byte_0 + (if (treat-immutable?_0 + v_0) + 37 + 36))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (let ((byte_0 + (if (hash-eq? + v_0) + 0 + (if (hash-eqv? + v_0) + 2 + 1)))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (write-fasl-integer + (hash-count + v_0) + o_1) + (hash-for-each + v_0 + (lambda (k_0 + v_1) + (begin + (loop_0 + k_0) + (loop_0 + v_1))) + #t)) + (if (regexp? + v_0) + (begin + (let ((byte_0 + (if (pregexp? + v_0) + 24 + 25))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (write-fasl-string + (object-name + v_0) + o_1)) + (if (byte-regexp? + v_0) + (begin + (let ((byte_0 + (if (byte-pregexp? + v_0) + 26 + 27))) + (begin-unsafe + (write-byte + byte_0 + o_1))) + (write-fasl-bytes + (object-name + v_0) + o_1)) + (if (begin-unsafe + (|#%app| + 1/syntax? + v_0)) + (begin + (begin-unsafe + (write-byte + 40 + o_1)) + (loop_0 + (begin-unsafe + (|#%app| + 1/syntax-e + v_0))) + (loop_0 + (let ((app_0 + (begin-unsafe + (|#%app| + 1/syntax-source + v_0)))) + (let ((app_1 + (begin-unsafe + (|#%app| + 1/syntax-line + v_0)))) + (let ((app_2 + (begin-unsafe + (|#%app| + 1/syntax-column + v_0)))) + (let ((app_3 + (begin-unsafe + (|#%app| + 1/syntax-position + v_0)))) + (unsafe-make-srcloc + app_0 + app_1 + app_2 + app_3 + (begin-unsafe + (|#%app| + 1/syntax-span + v_0)))))))) + (loop_0 + (reverse$1 + (let ((lst_0 + (begin-unsafe + (|#%app| + 1/syntax-property-symbol-keys + v_0)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((k_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (cons + k_0 + (begin-unsafe + (|#%app| + 1/syntax-property + v_0 + k_0))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + lst_0))))))) + (if (eq? + v_0 + unsafe-undefined) + (begin-unsafe + (write-byte + 41 + o_1)) + (if handle-fail6_0 + (loop_0 + (|#%app| + handle-fail6_0 + v_0)) + (raise-arguments-error + 's-exp->fasl + "cannot write value" + "value" + v_0)))))))))))))))))))))))))))))))))))) + (loop_0 v14_0)) (get-output-bytes o_1 #t))))) (begin - (write-fasl-integer - (unsafe-unbox* shared-counter_0) - o_0) + (write-fasl-integer shared-counter_0 o_0) (write-fasl-integer (unsafe-bytes-length bstr_0) o_0) @@ -48661,711 +37768,690 @@ (void) (get-output-bytes o_0))))))))))))))))))) (define fasl->s-exp.1 - (letrec ((intern_0 - (|#%name| - intern - (lambda (datum-intern?16_0 v_0) - (begin (if datum-intern?16_0 (datum-intern-literal v_0) v_0))))) - (loop_0 - (|#%name| - loop - (lambda (datum-intern?16_0 i_0 shared-count_0 shared_0) - (begin - (let ((type_0 (read-byte/no-eof i_0))) - (let ((index_0 - (if (fixnum? type_0) - (if (if (unsafe-fx>= type_0 1) - (unsafe-fx< type_0 42) - #f) - (let ((tbl_0 - '#(1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 12 - 13 - 14 - 15 - 16 - 17 - 18 - 19 - 20 - 21 - 22 - 23 - 24 - 25 - 26 - 27 - 28 - 29 - 31 - 30 - 32 - 32 - 33 - 34 - 35 - 36 - 37 - 38 - 11 - 39 - 40))) - (unsafe-vector*-ref - tbl_0 - (unsafe-fx- type_0 1))) - 0) - 0))) - (if (unsafe-fx< index_0 20) - (if (unsafe-fx< index_0 9) - (if (unsafe-fx< index_0 4) - (if (unsafe-fx< index_0 1) - (if (>= type_0 100) - (+ (- type_0 100) -10) - (read-error - "unrecognized fasl tag" - "tag" - type_0)) - (if (unsafe-fx< index_0 2) - (let ((pos_0 (|#%app| read-fasl-integer i_0))) - (let ((v_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (begin - (if (< pos_0 shared-count_0) - (void) - (read-error "bad graph index")) - (vector-set! shared_0 pos_0 v_0) - v_0))) - (if (unsafe-fx< index_0 3) - (let ((pos_0 (|#%app| read-fasl-integer i_0))) - (begin - (if (< pos_0 shared-count_0) - (void) - (read-error "bad graph index")) - (vector-ref shared_0 pos_0))) - #f))) - (if (unsafe-fx< index_0 6) - (if (unsafe-fx< index_0 5) #t null) - (if (unsafe-fx< index_0 7) - (void) - (if (unsafe-fx< index_0 8) - eof - (intern_0 - datum-intern?16_0 - (|#%app| read-fasl-integer i_0)))))) - (if (unsafe-fx< index_0 14) - (if (unsafe-fx< index_0 11) - (if (unsafe-fx< index_0 10) - (floating-point-bytes->real - (read-bytes/exactly 8 i_0) - #f) - (real->single-flonum - (floating-point-bytes->real - (read-bytes/exactly 4 i_0) - #f))) - (if (unsafe-fx< index_0 12) - (let ((bstr_0 - (read-bytes/exactly - (|#%app| read-fasl-integer i_0) - i_0))) - (string->number - (bytes->string/utf-8 bstr_0) - 10 - 'read)) - (if (unsafe-fx< index_0 13) - (intern_0 - datum-intern?16_0 - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (/ - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0)))) - (intern_0 - datum-intern?16_0 - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (make-rectangular - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))))))) - (if (unsafe-fx< index_0 16) - (if (unsafe-fx< index_0 15) - (intern_0 - datum-intern?16_0 - (integer->char - (|#%app| read-fasl-integer i_0))) - (string->symbol (|#%app| read-fasl-string i_0))) - (if (unsafe-fx< index_0 17) - (string->unreadable-symbol - (|#%app| read-fasl-string i_0)) - (if (unsafe-fx< index_0 18) - (string->uninterned-symbol - (|#%app| read-fasl-string i_0)) - (if (unsafe-fx< index_0 19) - (string->keyword - (|#%app| read-fasl-string i_0)) - (|#%app| read-fasl-string i_0))))))) - (if (unsafe-fx< index_0 30) - (if (unsafe-fx< index_0 24) - (if (unsafe-fx< index_0 21) - (intern_0 - datum-intern?16_0 - (string->immutable-string - (|#%app| read-fasl-string i_0))) - (if (unsafe-fx< index_0 22) - (read-fasl-bytes i_0) - (if (unsafe-fx< index_0 23) - (intern_0 - datum-intern?16_0 - (bytes->immutable-bytes - (read-fasl-bytes i_0))) - (let ((app_0 (read-fasl-bytes i_0))) - (bytes->path - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0)))))) - (if (unsafe-fx< index_0 26) - (if (unsafe-fx< index_0 25) - (let ((wrt-dir_0 - (current-load-relative-directory))) - (let ((rel-elems_0 - (reverse$1 - (let ((lst_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_1) - (begin - (if (pair? lst_1) - (let ((p_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if (bytes? - p_0) - (bytes->path-element - p_0) - p_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null lst_0))))))) - (if wrt-dir_0 - (apply build-path wrt-dir_0 rel-elems_0) - (if (null? rel-elems_0) - (build-path 'same) - (apply build-path rel-elems_0))))) - (intern_0 - datum-intern?16_0 - (pregexp (|#%app| read-fasl-string i_0)))) - (if (unsafe-fx< index_0 27) - (intern_0 - datum-intern?16_0 - (regexp (|#%app| read-fasl-string i_0))) - (if (unsafe-fx< index_0 28) - (intern_0 - datum-intern?16_0 - (byte-pregexp (read-fasl-bytes i_0))) - (if (unsafe-fx< index_0 29) - (intern_0 - datum-intern?16_0 - (byte-regexp (read-fasl-bytes i_0))) - (let ((len_0 - (|#%app| read-fasl-integer i_0))) - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 pos_0) - (begin - (if (< pos_0 len_0) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - (+ pos_0 1))) - fold-var_0)))))) - (for-loop_0 null 0)))))))))) - (if (unsafe-fx< index_0 35) - (if (unsafe-fx< index_0 32) - (if (unsafe-fx< index_0 31) - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (cons - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((len_0 (|#%app| read-fasl-integer i_0))) - (ploop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0 - len_0))) - (if (unsafe-fx< index_0 33) - (let ((len_0 (|#%app| read-fasl-integer i_0))) - (let ((vec_0 - (begin - (if (exact-nonnegative-integer? - len_0) - (void) - (raise-argument-error - 'for/vector - "exact-nonnegative-integer?" - len_0)) - (let ((v_0 (make-vector len_0 0))) - (begin - (if (zero? len_0) - (void) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_1 pos_0) - (begin - (if (< pos_0 len_0) - (let ((i_2 - (let ((i_2 - (begin - (unsafe-vector*-set! - v_0 - i_1 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0)) - (unsafe-fx+ - 1 - i_1)))) - (values - i_2)))) - (if (if (not - (let ((x_0 - (list - pos_0))) - (unsafe-fx= - i_2 - len_0))) - #t - #f) - (for-loop_0 - i_2 - (+ pos_0 1)) - i_2)) - i_1)))))) - (for-loop_0 0 0)))) - v_0))))) - (if (eqv? type_0 32) - (vector->immutable-vector vec_0) - vec_0))) - (if (unsafe-fx< index_0 34) - (box - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0)) - (box-immutable - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))))) - (if (unsafe-fx< index_0 37) - (if (unsafe-fx< index_0 36) - (let ((key_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((len_0 (|#%app| read-fasl-integer i_0))) - (apply - make-prefab-struct - key_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 pos_0) - (begin - (if (< pos_0 len_0) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - (+ pos_0 1))) - fold-var_0)))))) - (for-loop_0 null 0))))))) - (let ((ht_0 - (let ((tmp_0 (read-byte/no-eof i_0))) - (if (eq? tmp_0 0) - (make-hasheq) - (if (eq? tmp_0 2) - (make-hasheqv) - (make-hash)))))) - (let ((len_0 (|#%app| read-fasl-integer i_0))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (< pos_0 len_0) - (begin - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (hash-set! - ht_0 - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (for-loop_0 (+ pos_0 1))) - (values))))))) - (for-loop_0 0))) - (void) - ht_0)))) - (if (unsafe-fx< index_0 38) - (let ((ht_0 - (let ((tmp_0 (read-byte/no-eof i_0))) - (if (eq? tmp_0 0) - hash2610 - (if (eq? tmp_0 2) - hash2589 - hash2725))))) - (let ((len_0 (|#%app| read-fasl-integer i_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ht_1 pos_0) - (begin - (if (< pos_0 len_0) - (let ((ht_2 - (let ((ht_2 - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (hash-set - ht_1 - app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))))) - (values ht_2)))) - (for-loop_0 ht_2 (+ pos_0 1))) - ht_1)))))) - (for-loop_0 ht_0 0))))) - (if (unsafe-fx< index_0 39) - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((app_1 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((app_2 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((app_3 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (unsafe-make-srcloc - app_0 - app_1 - app_2 - app_3 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0)))))) - (if (unsafe-fx< index_0 40) - (let ((e_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((s_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (let ((c_0 - (datum->correlated - e_0 - (let ((app_0 - (srcloc-source s_0))) - (let ((app_1 - (srcloc-line s_0))) - (let ((app_2 - (srcloc-column s_0))) - (let ((app_3 - (srcloc-position - s_0))) - (vector - app_0 - app_1 - app_2 - app_3 - (srcloc-span - s_0))))))))) - (let ((lst_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (c_1 lst_1) - (begin - (if (pair? lst_1) - (let ((p_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) - (let ((c_2 - (let ((c_2 - (let ((k_0 - (car - p_0))) - (let ((v_0 - (cdr - p_0))) - (let ((k_1 - k_0)) - (begin-unsafe - (|#%app| - 1/syntax-property - c_1 - k_1 - v_0))))))) - (values - c_2)))) - (for-loop_0 - c_2 - rest_0)))) - c_1)))))) - (for-loop_0 c_0 lst_0))))))) - unsafe-undefined))))))))))))) - (ploop_0 - (|#%name| - ploop - (lambda (datum-intern?16_0 i_0 shared-count_0 shared_0 len_0) - (begin - (if (zero? len_0) - (loop_0 datum-intern?16_0 i_0 shared-count_0 shared_0) - (let ((app_0 - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))) - (cons - app_0 - (ploop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0 - (sub1 len_0)))))))))) - (|#%name| - fasl->s-exp - (lambda (datum-intern?16_0 external-lifts17_0 skip-prefix?18_0 orig-i22_0) - (begin - (let ((external-lifts_0 - (if (eq? external-lifts17_0 unsafe-undefined) - '#() - external-lifts17_0))) - (let ((init-i_0 - (if (bytes? orig-i22_0) - (mcons orig-i22_0 0) - (if (input-port? orig-i22_0) - orig-i22_0 - (raise-argument-error - 'fasl->s-exp - "(or/c bytes? input-port?)" - orig-i22_0))))) - (begin - (if skip-prefix?18_0 + (|#%name| + fasl->s-exp + (lambda (datum-intern?16_0 external-lifts17_0 skip-prefix?18_0 orig-i22_0) + (begin + (let ((external-lifts_0 + (if (eq? external-lifts17_0 unsafe-undefined) + '#() + external-lifts17_0))) + (let ((init-i_0 + (if (bytes? orig-i22_0) + (mcons orig-i22_0 0) + (if (input-port? orig-i22_0) + orig-i22_0 + (raise-argument-error + 'fasl->s-exp + "(or/c bytes? input-port?)" + orig-i22_0))))) + (begin + (if skip-prefix?18_0 + (void) + (if (bytes=? + (read-bytes/exactly* fasl-prefix-length init-i_0) + fasl-prefix) (void) - (if (bytes=? - (read-bytes/exactly* fasl-prefix-length init-i_0) - fasl-prefix) - (void) - (read-error "unrecognized prefix"))) - (let ((shared-count_0 (read-fasl-integer* init-i_0))) - (let ((shared_0 (make-vector shared-count_0))) + (read-error "unrecognized prefix"))) + (let ((shared-count_0 (read-fasl-integer* init-i_0))) + (let ((shared_0 (make-vector shared-count_0))) + (begin + (if (if (vector? external-lifts_0) + (<= (vector-length external-lifts_0) shared-count_0) + #f) + (void) + (error + 'fasl->s-exp + "external-lift vector does not match expected size")) (begin - (if (if (vector? external-lifts_0) - (<= (vector-length external-lifts_0) shared-count_0) - #f) - (void) - (error - 'fasl->s-exp - "external-lift vector does not match expected size")) - (begin - (call-with-values - (lambda () - (begin - (check-vector external-lifts_0) - (values - external-lifts_0 - (unsafe-vector-length external-lifts_0)))) - (case-lambda - ((vec_0 len_0) - (let ((start_0 0)) - (let ((vec_1 vec_0) (len_1 len_0)) - (begin - #f - (void) - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0 pos_1) - (begin - (if (if (unsafe-fx< pos_0 len_1) #t #f) - (let ((v_0 - (unsafe-vector-ref - vec_1 - pos_0))) - (begin - (vector-set! - shared_0 - pos_1 - (vector-ref - external-lifts_0 - pos_1)) - (for-loop_0 - (unsafe-fx+ 1 pos_0) - (+ pos_1 1)))) - (values))))))) - (for-loop_0 0 start_0)))))) - (args (raise-binding-result-arity-error 2 args)))) - (let ((len_0 (read-fasl-integer* init-i_0))) - (let ((i_0 - (if (mpair? init-i_0) - init-i_0 - (let ((bstr_0 - (read-bytes/exactly* len_0 init-i_0))) - (mcons bstr_0 0))))) - (loop_0 - datum-intern?16_0 - i_0 - shared-count_0 - shared_0))))))))))))))) + (call-with-values + (lambda () + (begin + (check-vector external-lifts_0) + (values + external-lifts_0 + (unsafe-vector-length external-lifts_0)))) + (case-lambda + ((vec_0 len_0) + (let ((start_0 0)) + (let ((vec_1 vec_0) (len_1 len_0)) + (begin + #f + (void) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0 pos_1) + (begin + (if (if (unsafe-fx< pos_0 len_1) #t #f) + (let ((v_0 + (unsafe-vector-ref + vec_1 + pos_0))) + (begin + (vector-set! + shared_0 + pos_1 + (vector-ref + external-lifts_0 + pos_1)) + (for-loop_0 + (unsafe-fx+ 1 pos_0) + (+ pos_1 1)))) + (values))))))) + (for-loop_0 0 start_0)))))) + (args (raise-binding-result-arity-error 2 args)))) + (let ((len_0 (read-fasl-integer* init-i_0))) + (let ((i_0 + (if (mpair? init-i_0) + init-i_0 + (let ((bstr_0 + (read-bytes/exactly* len_0 init-i_0))) + (mcons bstr_0 0))))) + (let ((intern_0 + (|#%name| + intern + (lambda (v_0) + (begin + (if datum-intern?16_0 + (datum-intern-literal v_0) + v_0)))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda () + (begin + (let ((type_0 (read-byte/no-eof i_0))) + (let ((index_0 + (if (fixnum? type_0) + (if (if (unsafe-fx>= type_0 1) + (unsafe-fx< type_0 42) + #f) + (let ((tbl_0 + '#(1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 12 + 13 + 14 + 15 + 16 + 17 + 18 + 19 + 20 + 21 + 22 + 23 + 24 + 25 + 26 + 27 + 28 + 29 + 31 + 30 + 32 + 32 + 33 + 34 + 35 + 36 + 37 + 38 + 11 + 39 + 40))) + (unsafe-vector*-ref + tbl_0 + (unsafe-fx- type_0 1))) + 0) + 0))) + (if (unsafe-fx< index_0 20) + (if (unsafe-fx< index_0 9) + (if (unsafe-fx< index_0 4) + (if (unsafe-fx< index_0 1) + (if (>= type_0 100) + (+ (- type_0 100) -10) + (read-error + "unrecognized fasl tag" + "tag" + type_0)) + (if (unsafe-fx< index_0 2) + (let ((pos_0 + (|#%app| + read-fasl-integer + i_0))) + (let ((v_0 (loop_0))) + (begin + (if (< + pos_0 + shared-count_0) + (void) + (read-error + "bad graph index")) + (vector-set! + shared_0 + pos_0 + v_0) + v_0))) + (if (unsafe-fx< index_0 3) + (let ((pos_0 + (|#%app| + read-fasl-integer + i_0))) + (begin + (if (< + pos_0 + shared-count_0) + (void) + (read-error + "bad graph index")) + (vector-ref + shared_0 + pos_0))) + #f))) + (if (unsafe-fx< index_0 6) + (if (unsafe-fx< index_0 5) + #t + null) + (if (unsafe-fx< index_0 7) + (void) + (if (unsafe-fx< index_0 8) + eof + (intern_0 + (|#%app| + read-fasl-integer + i_0)))))) + (if (unsafe-fx< index_0 14) + (if (unsafe-fx< index_0 11) + (if (unsafe-fx< index_0 10) + (floating-point-bytes->real + (read-bytes/exactly 8 i_0) + #f) + (real->single-flonum + (floating-point-bytes->real + (read-bytes/exactly 4 i_0) + #f))) + (if (unsafe-fx< index_0 12) + (let ((bstr_0 + (read-bytes/exactly + (|#%app| + read-fasl-integer + i_0) + i_0))) + (string->number + (bytes->string/utf-8 + bstr_0) + 10 + 'read)) + (if (unsafe-fx< index_0 13) + (intern_0 + (let ((app_0 (loop_0))) + (/ app_0 (loop_0)))) + (intern_0 + (let ((app_0 (loop_0))) + (make-rectangular + app_0 + (loop_0))))))) + (if (unsafe-fx< index_0 16) + (if (unsafe-fx< index_0 15) + (intern_0 + (integer->char + (|#%app| + read-fasl-integer + i_0))) + (string->symbol + (|#%app| + read-fasl-string + i_0))) + (if (unsafe-fx< index_0 17) + (string->unreadable-symbol + (|#%app| + read-fasl-string + i_0)) + (if (unsafe-fx< index_0 18) + (string->uninterned-symbol + (|#%app| + read-fasl-string + i_0)) + (if (unsafe-fx< index_0 19) + (string->keyword + (|#%app| + read-fasl-string + i_0)) + (|#%app| + read-fasl-string + i_0))))))) + (if (unsafe-fx< index_0 30) + (if (unsafe-fx< index_0 24) + (if (unsafe-fx< index_0 21) + (intern_0 + (string->immutable-string + (|#%app| + read-fasl-string + i_0))) + (if (unsafe-fx< index_0 22) + (read-fasl-bytes i_0) + (if (unsafe-fx< index_0 23) + (intern_0 + (bytes->immutable-bytes + (read-fasl-bytes i_0))) + (let ((app_0 + (read-fasl-bytes + i_0))) + (bytes->path + app_0 + (loop_0)))))) + (if (unsafe-fx< index_0 26) + (if (unsafe-fx< index_0 25) + (let ((wrt-dir_0 + (current-load-relative-directory))) + (let ((rel-elems_0 + (reverse$1 + (let ((lst_0 + (loop_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((p_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if (bytes? + p_0) + (bytes->path-element + p_0) + p_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + lst_0))))))) + (if wrt-dir_0 + (apply + build-path + wrt-dir_0 + rel-elems_0) + (if (null? rel-elems_0) + (build-path 'same) + (apply + build-path + rel-elems_0))))) + (intern_0 + (pregexp + (|#%app| + read-fasl-string + i_0)))) + (if (unsafe-fx< index_0 27) + (intern_0 + (regexp + (|#%app| + read-fasl-string + i_0))) + (if (unsafe-fx< index_0 28) + (intern_0 + (byte-pregexp + (read-fasl-bytes i_0))) + (if (unsafe-fx< index_0 29) + (intern_0 + (byte-regexp + (read-fasl-bytes i_0))) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + pos_0) + (begin + (if (< + pos_0 + len_1) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (loop_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + (+ + pos_0 + 1))) + fold-var_0)))))) + (for-loop_0 + null + 0)))))))))) + (if (unsafe-fx< index_0 35) + (if (unsafe-fx< index_0 32) + (if (unsafe-fx< index_0 31) + (let ((app_0 (loop_0))) + (cons app_0 (loop_0))) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (letrec* + ((ploop_0 + (|#%name| + ploop + (lambda (len_2) + (begin + (if (zero? len_2) + (loop_0) + (let ((app_0 + (loop_0))) + (cons + app_0 + (ploop_0 + (sub1 + len_2)))))))))) + (ploop_0 len_1)))) + (if (unsafe-fx< index_0 33) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (let ((vec_0 + (begin + (if (exact-nonnegative-integer? + len_1) + (void) + (raise-argument-error + 'for/vector + "exact-nonnegative-integer?" + len_1)) + (let ((v_0 + (make-vector + len_1 + 0))) + (begin + (if (zero? + len_1) + (void) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_1 + pos_0) + (begin + (if (< + pos_0 + len_1) + (let ((i_2 + (let ((i_2 + (begin + (unsafe-vector*-set! + v_0 + i_1 + (loop_0)) + (unsafe-fx+ + 1 + i_1)))) + (values + i_2)))) + (if (if (not + (let ((x_0 + (list + pos_0))) + (unsafe-fx= + i_2 + len_1))) + #t + #f) + (for-loop_0 + i_2 + (+ + pos_0 + 1)) + i_2)) + i_1)))))) + (for-loop_0 + 0 + 0)))) + v_0))))) + (if (eqv? type_0 32) + (vector->immutable-vector + vec_0) + vec_0))) + (if (unsafe-fx< index_0 34) + (box (loop_0)) + (box-immutable (loop_0))))) + (if (unsafe-fx< index_0 37) + (if (unsafe-fx< index_0 36) + (let ((key_0 (loop_0))) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (apply + make-prefab-struct + key_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + pos_0) + (begin + (if (< + pos_0 + len_1) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (loop_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + (+ + pos_0 + 1))) + fold-var_0)))))) + (for-loop_0 + null + 0))))))) + (let ((ht_0 + (let ((tmp_0 + (read-byte/no-eof + i_0))) + (if (eq? tmp_0 0) + (make-hasheq) + (if (eq? tmp_0 2) + (make-hasheqv) + (make-hash)))))) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) + (begin + (if (< + pos_0 + len_1) + (begin + (let ((app_0 + (loop_0))) + (hash-set! + ht_0 + app_0 + (loop_0))) + (for-loop_0 + (+ + pos_0 + 1))) + (values))))))) + (for-loop_0 0))) + (void) + ht_0)))) + (if (unsafe-fx< index_0 38) + (let ((ht_0 + (let ((tmp_0 + (read-byte/no-eof + i_0))) + (if (eq? tmp_0 0) + hash2610 + (if (eq? tmp_0 2) + hash2589 + hash2725))))) + (let ((len_1 + (|#%app| + read-fasl-integer + i_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ht_1 pos_0) + (begin + (if (< + pos_0 + len_1) + (let ((ht_2 + (let ((ht_2 + (let ((app_0 + (loop_0))) + (hash-set + ht_1 + app_0 + (loop_0))))) + (values + ht_2)))) + (for-loop_0 + ht_2 + (+ + pos_0 + 1))) + ht_1)))))) + (for-loop_0 ht_0 0))))) + (if (unsafe-fx< index_0 39) + (let ((app_0 (loop_0))) + (let ((app_1 (loop_0))) + (let ((app_2 (loop_0))) + (let ((app_3 + (loop_0))) + (unsafe-make-srcloc + app_0 + app_1 + app_2 + app_3 + (loop_0)))))) + (if (unsafe-fx< index_0 40) + (let ((e_0 (loop_0))) + (let ((s_0 (loop_0))) + (let ((c_0 + (datum->correlated + e_0 + (let ((app_0 + (srcloc-source + s_0))) + (let ((app_1 + (srcloc-line + s_0))) + (let ((app_2 + (srcloc-column + s_0))) + (let ((app_3 + (srcloc-position + s_0))) + (vector + app_0 + app_1 + app_2 + app_3 + (srcloc-span + s_0))))))))) + (let ((lst_0 + (loop_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (c_1 + lst_1) + (begin + (if (pair? + lst_1) + (let ((p_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (let ((c_2 + (let ((c_2 + (let ((k_0 + (car + p_0))) + (let ((v_0 + (cdr + p_0))) + (let ((k_1 + k_0)) + (begin-unsafe + (|#%app| + 1/syntax-property + c_1 + k_1 + v_0))))))) + (values + c_2)))) + (for-loop_0 + c_2 + rest_0)))) + c_1)))))) + (for-loop_0 + c_0 + lst_0))))))) + unsafe-undefined)))))))))))))) + (loop_0)))))))))))))))) (define write-fasl-integer (lambda (i_0 o_0) (if (<= -124 i_0 127) @@ -50477,7 +39563,7 @@ 'indirect 'element)))))) (define struct:boxed (make-record-type-descriptor* 'boxed #f #f #f #f 1 0)) -(define effect_2559 +(define effect_2558 (struct-type-install-properties! struct:boxed 'boxed @@ -50573,3584 +39659,3602 @@ (set! 1/variable-set!/define var-set!/def_0) (set! make-interp-procedure* make-proc_0)))) (define interpretable-jitified-linklet - (letrec ((add-boxes/remove-unused_0 - (|#%name| - add-boxes/remove-unused - (lambda (e_0 ids_0 mutated_0 env_0 stk-i_0) - (begin - (if (null? ids_0) - e_0 - (if (pair? ids_0) - (let ((app_0 - (add-boxes/remove-unused_0 - e_0 - (car ids_0) - mutated_0 - env_0 - stk-i_0))) - (add-boxes/remove-unused_0 - app_0 - (cdr ids_0) - mutated_0 - env_0 - stk-i_0)) - (let ((u_0 (unwrap ids_0))) - (let ((var_0 (hash-ref env_0 u_0 #f))) - (let ((pos_0 - (let ((temp61_0 - (if (boxed? var_0) - (boxed-pos var_0) - var_0))) - (stack->pos.1 #f temp61_0 stk-i_0)))) - (if (box? pos_0) - (if (if (vector? e_0) - (eq? 'clear (vector-ref e_0 0)) - #f) - (let ((app_0 - (let ((app_0 (unbox pos_0))) - (cons app_0 (vector-ref e_0 1))))) - (vector 'clear app_0 (vector-ref e_0 2))) - (vector 'clear (list (unbox pos_0)) e_0)) - (if (not (hash-ref mutated_0 u_0 #f)) - e_0 - (vector 'enbox pos_0 e_0)))))))))))) - (add-clears_0 - (|#%name| - add-clears - (lambda (e_0 stk-i_0 all-clear_0) - (begin - (if (begin-unsafe (stack-info-non-tail-call-later? stk-i_0)) - (let ((local-use-map_0 (stack-info-local-use-map stk-i_0))) - (let ((clears_0 + (lambda (linklet-e_0 serializable?_0) + (letrec* + ((start_0 + (|#%name| + start + (lambda (linklet-e_1) + (begin + (call-with-values + (lambda () (compile-linklet-body_0 linklet-e_1 hash2610 0)) + (case-lambda + ((compiled-body_0 num-body-vars_0) + (vector num-body-vars_0 compiled-body_0)) + (args (raise-binding-result-arity-error 2 args)))))))) + (compile-linklet-body_0 + (|#%name| + compile-linklet-body + (lambda (v_0 env_0 stack-depth_0) + (begin + (let ((hd_0 + (let ((p_0 (unwrap v_0))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap v_0)))) + (let ((p_0 (unwrap d_0))) + (let ((args_0 (let ((a_0 (car p_0))) a_0))) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((args_1 args_0)) (values args_1 body_0))))))) + (case-lambda + ((args_0 body_0) + (let ((mutated_0 + (extract-list-mutated_0 body_0 hash2610))) + (let ((num-args_0 (length args_0))) + (let ((args-env_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (env_1 lst_0 pos_0) + (begin + (if (if (pair? lst_0) #t #f) + (let ((arg_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((env_2 + (let ((env_2 + (hash-set + env_1 + arg_0 + (+ + stack-depth_0 + pos_0)))) + (values env_2)))) + (for-loop_0 + env_2 + rest_0 + (+ pos_0 1))))) + env_1)))))) + (for-loop_0 env_0 args_0 0))))) + (let ((body-vars-index_0 + (+ num-args_0 stack-depth_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (env_1 num-body-vars_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((e_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((e_1 e_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (e_2 + env_2 + num-body-vars_1) + (begin + (let ((hd_1 + (let ((p_0 + (unwrap + e_2))) + (if (pair? + p_0) + (unwrap + (car + p_0)) + #f)))) + (if (if (eq? + 'define + hd_1) + (let ((a_0 + (cdr + (unwrap + e_2)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + #t + #f))) + #f) + (let ((id_0 + (let ((d_0 + (cdr + (unwrap + e_2)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (let ((app_0 + (let ((app_0 + (unwrap + id_0))) + (hash-set + env_2 + app_0 + (boxed2.1 + (+ + body-vars-index_0 + num-body-vars_1)))))) + (values + app_0 + (add1 + num-body-vars_1)))) + (if (if (eq? + 'define-values + hd_1) + (let ((a_0 + (cdr + (unwrap + e_2)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + #t + #f))) + #f) + (let ((ids_0 + (let ((d_0 + (cdr + (unwrap + e_2)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (env_3 + num-body-vars_2 + lst_1) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_1)))) + (let ((id_0 + (if (begin-unsafe + (pair? + (unwrap + lst_1))) + (wrap-car + lst_1) + lst_1))) + (let ((rest_1 + (if (begin-unsafe + (pair? + (unwrap + lst_1))) + (wrap-cdr + lst_1) + null))) + (let ((id_1 + id_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((app_0 + (let ((app_0 + (unwrap + id_1))) + (hash-set + env_3 + app_0 + (boxed2.1 + (+ + body-vars-index_0 + num-body-vars_2)))))) + (values + app_0 + (add1 + num-body-vars_2)))) + (case-lambda + ((env_4 + num-body-vars_3) + (values + env_4 + num-body-vars_3)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((env_4 + num-body-vars_3) + (for-loop_1 + env_4 + num-body-vars_3 + rest_1)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values + env_3 + num-body-vars_2))))))) + (for-loop_1 + env_2 + num-body-vars_1 + ids_0)))) + (if (if (eq? + 'begin + hd_1) + #t + #f) + (let ((body_1 + (let ((d_0 + (cdr + (unwrap + e_2)))) + d_0))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (env_3 + num-body-vars_2 + lst_1) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_1)))) + (let ((e_3 + (if (begin-unsafe + (pair? + (unwrap + lst_1))) + (wrap-car + lst_1) + lst_1))) + (let ((rest_1 + (if (begin-unsafe + (pair? + (unwrap + lst_1))) + (wrap-cdr + lst_1) + null))) + (let ((e_4 + e_3)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (loop_0 + e_4 + env_3 + num-body-vars_2)) + (case-lambda + ((env_4 + num-body-vars_3) + (values + env_4 + num-body-vars_3)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((env_4 + num-body-vars_3) + (for-loop_1 + env_4 + num-body-vars_3 + rest_1)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values + env_3 + num-body-vars_2))))))) + (for-loop_1 + env_2 + num-body-vars_1 + body_1)))) + (values + env_2 + num-body-vars_1)))))))))) + (loop_0 + e_1 + env_1 + num-body-vars_0))) + (case-lambda + ((env_2 num-body-vars_1) + (values + env_2 + num-body-vars_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((env_2 num-body-vars_1) + (for-loop_0 + env_2 + num-body-vars_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values env_1 num-body-vars_0))))))) + (for-loop_0 args-env_0 0 body_0)))) + (case-lambda + ((body-env_0 num-body-vars_0) + (let ((body-stack-depth_0 + (+ + num-body-vars_0 + num-args_0 + stack-depth_0))) + (let ((stk-i_0 + (make-stack-info.1 #f hash2610 #t))) + (let ((new-body_0 + (compile-top-body_0 + body_0 + body-env_0 + body-stack-depth_0 + stk-i_0 + mutated_0))) + (values new-body_0 num-body-vars_0))))) + (args + (raise-binding-result-arity-error 2 args))))))))) + (args (raise-binding-result-arity-error 2 args)))) + (error 'match "failed ~e" v_0))))))) + (compile-top-body_0 + (|#%name| + compile-top-body + (lambda (body_0 env_0 stack-depth_0 stk-i_0 mutated_0) + (begin + (let ((bs_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (body_1) + (begin + (if (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap body_1)))) + '() + (if (let ((p_0 (unwrap body_1))) + (if (pair? p_0) + (if (let ((a_0 (car p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 (car p_1))) + (begin-unsafe + (let ((app_0 + (unwrap 'begin))) + (eq? + app_0 + (unwrap a_1))))) + (let ((a_1 (cdr p_1))) + (wrap-list? a_1)) + #f) + #f))) + #t + #f) + #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap body_1))) + (let ((subs_0 + (let ((a_0 (car p_0))) + (let ((d_0 (cdr (unwrap a_0)))) + (unwrap-list d_0))))) + (let ((rest_0 + (let ((d_0 (cdr p_0))) d_0))) + (let ((subs_1 subs_0)) + (values subs_1 rest_0)))))) + (case-lambda + ((subs_0 rest_0) + (loop_0 (append subs_0 rest_0))) + (args + (raise-binding-result-arity-error 2 args)))) + (if (let ((p_0 (unwrap body_1))) + (if (pair? p_0) #t #f)) + (call-with-values + (lambda () + (let ((p_0 (unwrap body_1))) + (let ((e_0 (let ((a_0 (car p_0))) a_0))) + (let ((rest_0 + (let ((d_0 (cdr p_0))) d_0))) + (let ((e_1 e_0)) + (values e_1 rest_0)))))) + (case-lambda + ((e_0 rest_0) + (let ((new-rest_0 (loop_0 rest_0))) + (cons + (compile-expr_0 + e_0 + env_0 + stack-depth_0 + stk-i_0 + #t + mutated_0) + new-rest_0))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (error 'match "failed ~e" body_1))))))))) + (loop_0 body_0)))) + (if (null? bs_0) + '#(void) + (if (if (pair? bs_0) (null? (cdr bs_0)) #f) + (car bs_0) + (list->vector (cons 'begin bs_0))))))))) + (compile-body_0 + (|#%name| + compile-body + (lambda (body_0 env_0 stack-depth_0 stk-i_0 tail?_0 mutated_0) + (begin + (if (let ((p_0 (unwrap body_0))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) (eq? app_0 (unwrap a_0))))) + #f)) + (let ((e_0 (let ((a_0 (car (unwrap body_0)))) a_0))) + (compile-expr_0 + e_0 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0)) + (list->vector + (cons + 'begin + (compile-list_0 + body_0 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0)))))))) + (compile-list_0 + (|#%name| + compile-list + (lambda (body_0 env_0 stack-depth_0 stk-i_0 tail?_0 mutated_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (body_1) + (begin + (if (null? body_1) + '() + (let ((rest-body_0 (wrap-cdr body_1))) + (let ((new-rest_0 (loop_0 rest-body_0))) + (cons + (let ((app_0 (wrap-car body_1))) + (compile-expr_0 + app_0 + env_0 + stack-depth_0 + stk-i_0 + (if tail?_0 (null? rest-body_0) #f) + mutated_0)) + new-rest_0))))))))) + (loop_0 body_0)))))) + (compile-expr_0 + (|#%name| + compile-expr + (lambda (e_0 env_0 stack-depth_0 stk-i_0 tail?_0 mutated_0) + (begin + (let ((hd_0 + (let ((p_0 (unwrap e_0))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((ids_0 (let ((a_0 (car p_0))) a_0))) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((ids_1 ids_0)) (values ids_1 body_0))))))) + (case-lambda + ((ids_0 body_0) + (call-with-values + (lambda () + (args->env_0 ids_0 env_0 stack-depth_0 mutated_0)) + (case-lambda + ((body-env_0 count_0 rest?_0) + (let ((cmap_0 (make-hasheq))) + (let ((body-stack-depth_0 (+ stack-depth_0 count_0))) + (let ((body-stk-i_0 + (make-stack-info.1 stack-depth_0 cmap_0 #t))) + (let ((new-body_0 + (compile-body_0 + body_0 + body-env_0 + body-stack-depth_0 + body-stk-i_0 + #t + mutated_0))) + (let ((rev-cmap_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + cmap_0 + i_0)) + (case-lambda + ((i_1 pos_0) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (values + (- + -1 + pos_0) + i_1)) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + cmap_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2610 + (hash-iterate-first cmap_0)))))) + (let ((app_0 (count->mask count_0 rest?_0))) + (let ((app_1 + (extract-procedure-wrap-data_0 e_0))) + (let ((app_2 + (let ((len_0 (hash-count cmap_0))) + (begin + (if (exact-nonnegative-integer? + len_0) + (void) + (raise-argument-error + 'for/vector + "exact-nonnegative-integer?" + len_0)) + (let ((v_0 + (make-vector len_0 0))) + (begin + (if (zero? len_0) + (void) + (let ((end_0 + (hash-count + cmap_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0 + pos_0) + (begin + (if (< + pos_0 + end_0) + (let ((i_1 + (let ((i_1 + (begin + (unsafe-vector*-set! + v_0 + i_0 + (let ((temp11_0 + (hash-ref + rev-cmap_0 + pos_0))) + (stack->pos.1 + #f + temp11_0 + stk-i_0))) + (unsafe-fx+ + 1 + i_0)))) + (values + i_1)))) + (if (if (not + (let ((x_0 + (list + pos_0))) + (unsafe-fx= + i_1 + len_0))) + #t + #f) + (for-loop_0 + i_1 + (+ + pos_0 + 1)) + i_1)) + i_0)))))) + (for-loop_0 0 0))))) + v_0)))))) + (vector + 'lambda + app_0 + app_1 + app_2 + (add-boxes/remove-unused_0 + new-body_0 + ids_0 + mutated_0 + body-env_0 + body-stk-i_0))))))))))) + (args (raise-binding-result-arity-error 3 args))))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'case-lambda hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (if (wrap-list? a_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_0 + (unwrap v_1))) + (if (pair? p_0) + #t + #f)))) + (values result_1)))) + (if (if (not + (let ((x_0 (list v_1))) + (not result_1))) + #t + #f) + (for-loop_0 result_1 rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_0))) + #f)) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idss_0 bodys_0 lst_0) + (begin + (if (not + (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_0 (unwrap v_1))) + (let ((idss_1 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((bodys_1 + (let ((d_1 + (cdr + p_0))) + d_1))) + (let ((idss_2 + idss_1)) + (values + idss_2 + bodys_1)))))) + (case-lambda + ((idss13_0 bodys14_0) + (values + (cons idss13_0 idss_0) + (cons + bodys14_0 + bodys_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((idss_1 bodys_1) + (values idss_1 bodys_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((idss_1 bodys_1) + (for-loop_0 + idss_1 + bodys_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values idss_0 bodys_0))))))) + (for-loop_0 null null d_0)))) + (case-lambda + ((idss_0 bodys_0) + (let ((app_0 (reverse$1 idss_0))) + (values app_0 (reverse$1 bodys_0)))) + (args (raise-binding-result-arity-error 2 args)))))) + (case-lambda + ((idss_0 bodys_0) + (let ((lams_0 (reverse$1 (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (fold-var_0 i_0) + (lambda (fold-var_0 lst_0 lst_1) (begin - (if i_0 - (let ((pos_0 - (hash-iterate-key - all-clear_0 - i_0))) - (let ((fold-var_1 - (if (hash-ref - local-use-map_0 - pos_0 - #f) - fold-var_0 - (let ((fold-var_1 - (cons - pos_0 - fold-var_0))) - (values fold-var_1))))) - (for-loop_0 - fold-var_1 - (hash-iterate-next - all-clear_0 - i_0)))) - fold-var_0)))))) - (for-loop_0 - null - (hash-iterate-first all-clear_0))))))) - (if (null? clears_0) - e_0 - (vector 'clear (sort.1 #f #f clears_0 <) e_0)))) - e_0))))) - (args->env_0 - (|#%name| - args->env - (lambda (ids_0 env_0 stack-depth_0 mutated_0) - (begin - (letrec* - ((loop_4 - (|#%name| - loop - (lambda (ids_1 env_1 count_0) - (begin - (if (begin-unsafe (null? (unwrap ids_1))) - (values env_1 count_0 #f) - (if (begin-unsafe (pair? (unwrap ids_1))) - (let ((app_0 (wrap-cdr ids_1))) - (let ((app_1 - (let ((app_1 (unwrap (wrap-car ids_1)))) - (env-set_0 - env_1 - app_1 - (+ stack-depth_0 count_0) - mutated_0)))) - (loop_4 app_0 app_1 (add1 count_0)))) - (let ((app_0 - (let ((app_0 (unwrap ids_1))) - (env-set_0 - env_1 - app_0 - (+ stack-depth_0 count_0) - mutated_0)))) - (values app_0 (add1 count_0) #t))))))))) - (loop_4 ids_0 env_0 0)))))) - (begins->list_0 - (|#%name| - begins->list - (lambda (e_0) - (begin - (if (vector? e_0) - (if (if (eq? 'beginl (unsafe-vector*-ref e_0 0)) #t #f) - (let ((es_0 (unsafe-vector*-ref e_0 1))) es_0) - (if (eq? 'begin (unsafe-vector*-ref e_0 0)) - (let ((len_0 (sub1 (unsafe-vector*-length e_0)))) - (if (< len_0 4) (loop_3 e_0 len_0 1) (list e_0))) - (list e_0))) - (list e_0)))))) - (compile-apply_0 - (|#%name| - compile-apply - (lambda (serializable?_0 - es_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - (begin - (begin - (if tail?_0 - (void) - (begin-unsafe - (set-stack-info-non-tail-call-later?! stk-i_0 #t))) - (let ((new-es_0 - (compile-list_0 - serializable?_0 - es_0 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0))) - (list->vector (cons 'app new-es_0)))))))) - (compile-assignment_0 - (|#%name| - compile-assignment - (lambda (serializable?_0 - id_0 - rhs_0 - env_0 - stack-depth_0 - stk-i_0 - mutated_0) - (begin - (let ((compiled-rhs_0 - (compile-expr_0 - serializable?_0 - rhs_0 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0))) - (let ((u_0 (unwrap id_0))) - (let ((var_0 (hash-ref env_0 u_0))) - (if (indirect? var_0) - (let ((s_0 - (let ((temp47_0 (indirect-pos var_0))) - (stack->pos.1 #f temp47_0 stk-i_0)))) - (let ((e_0 (indirect-element var_0))) - (vector 'set!-indirect s_0 e_0 compiled-rhs_0))) - (if (boxed? var_0) - (let ((s_0 - (let ((temp49_0 (boxed-pos var_0))) - (stack->pos.1 #f temp49_0 stk-i_0)))) - (if (boxed/check? var_0) - (vector - 'set!-boxed/checked - s_0 - compiled-rhs_0 - u_0) - (vector 'set!-boxed s_0 compiled-rhs_0 u_0))) - (error - 'compile - "unexpected set! ~s -> ~v" - u_0 - var_0)))))))))) - (compile-body_0 - (|#%name| - compile-body - (lambda (serializable?_0 - body_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - (begin - (if (let ((p_0 (unwrap body_0))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_0))))) - #f)) - (let ((e_0 (let ((a_0 (car (unwrap body_0)))) a_0))) - (compile-expr_0 - serializable?_0 - e_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0)) - (list->vector - (cons - 'begin - (compile-list_0 - serializable?_0 - body_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0)))))))) - (compile-expr_0 - (|#%name| - compile-expr - (lambda (serializable?_0 - e_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap e_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((ids_0 (let ((a_0 (car p_0))) a_0))) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0)) - (values ids_1 body_0))))))) - (case-lambda - ((ids_0 body_0) - (call-with-values - (lambda () - (args->env_0 ids_0 env_0 stack-depth_0 mutated_0)) - (case-lambda - ((body-env_0 count_0 rest?_0) - (let ((cmap_0 (make-hasheq))) - (let ((body-stack-depth_0 - (+ stack-depth_0 count_0))) - (let ((body-stk-i_0 - (make-stack-info.1 - stack-depth_0 - cmap_0 - #t))) - (let ((new-body_0 - (compile-body_0 - serializable?_0 - body_0 - body-env_0 - body-stack-depth_0 - body-stk-i_0 - #t - mutated_0))) - (let ((rev-cmap_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - cmap_0 - i_0)) - (case-lambda - ((i_1 pos_0) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (values - (- - -1 - pos_0) - i_1)) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - cmap_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2610 - (hash-iterate-first cmap_0)))))) - (let ((app_0 - (count->mask count_0 rest?_0))) - (let ((app_1 - (extract-procedure-wrap-data_0 - e_0))) - (let ((app_2 - (let ((len_0 - (hash-count cmap_0))) - (begin - (if (exact-nonnegative-integer? - len_0) - (void) - (raise-argument-error - 'for/vector - "exact-nonnegative-integer?" - len_0)) - (let ((v_0 - (make-vector - len_0 - 0))) - (begin - (if (zero? len_0) - (void) - (let ((end_0 - (hash-count - cmap_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0 - pos_0) - (begin - (if (< - pos_0 - end_0) - (let ((i_1 - (let ((i_1 - (begin - (unsafe-vector*-set! - v_0 - i_0 - (let ((temp11_0 - (hash-ref - rev-cmap_0 - pos_0))) - (stack->pos.1 - #f - temp11_0 - stk-i_0))) - (unsafe-fx+ - 1 - i_0)))) - (values - i_1)))) - (if (if (not - (let ((x_0 - (list - pos_0))) - (unsafe-fx= - i_1 - len_0))) - #t - #f) - (for-loop_0 - i_1 - (+ - pos_0 - 1)) - i_1)) - i_0)))))) - (for-loop_0 - 0 - 0))))) - v_0)))))) - (vector - 'lambda - app_0 - app_1 - app_2 - (add-boxes/remove-unused_0 - new-body_0 - ids_0 - mutated_0 - body-env_0 - body-stk-i_0))))))))))) - (args (raise-binding-result-arity-error 3 args))))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_1))) - (if (pair? - p_0) - #t - #f)))) - (values result_1)))) - (if (if (not - (let ((x_0 - (list v_1))) - (not result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_0))) - #f)) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idss_0 bodys_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_1 v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_0 - (unwrap v_1))) - (let ((idss_1 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((bodys_1 - (let ((d_1 - (cdr - p_0))) - d_1))) - (let ((idss_2 - idss_1)) - (values - idss_2 - bodys_1)))))) - (case-lambda - ((idss13_0 bodys14_0) + (if (if (pair? lst_0) (pair? lst_1) #f) + (let ((ids_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((body_0 (unsafe-car lst_1))) + (let ((rest_1 + (unsafe-cdr lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (compile-expr_0 + (list* + 'lambda + ids_0 + body_0) + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0) + fold-var_0))) (values - (cons - idss13_0 - idss_0) - (cons - bodys14_0 - bodys_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 bodys_1) - (values idss_1 bodys_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 bodys_1) - (for-loop_0 - idss_1 - bodys_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values idss_0 bodys_0))))))) - (for-loop_0 null null d_0)))) - (case-lambda - ((idss_0 bodys_0) - (let ((app_0 (reverse$1 idss_0))) - (values app_0 (reverse$1 bodys_0)))) - (args - (raise-binding-result-arity-error 2 args)))))) - (case-lambda - ((idss_0 bodys_0) - (let ((lams_0 - (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 ((ids_0 (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((body_0 - (unsafe-car lst_1))) - (let ((rest_1 - (unsafe-cdr lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (compile-expr_0 - serializable?_0 - (list* - 'lambda - ids_0 - body_0) - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 null idss_0 bodys_0)))))) - (let ((mask_0 + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 null idss_0 bodys_0)))))) + (let ((mask_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (mask_0 lst_0) + (begin + (if (pair? lst_0) + (let ((lam_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((mask_1 + (let ((mask_1 + (bitwise-ior + mask_0 + (if (if (eq? + 'lambda + (unsafe-vector*-ref + lam_0 + 0)) + #t + #f) + (let ((mask_1 + (unsafe-vector*-ref + lam_0 + 1))) + mask_1) + (error + 'interp-match + "no matching clause"))))) + (values mask_1)))) + (for-loop_0 mask_1 rest_0)))) + mask_0)))))) + (for-loop_0 0 lams_0))))) + (list->vector + (list* + 'case-lambda + mask_0 + (extract-procedure-wrap-data_0 e_0) + lams_0))))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'let hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (call-with-values + (lambda () (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (mask_0 lst_0) + (lambda (ids_0 rhss_0 lst_0) (begin - (if (pair? lst_0) - (let ((lam_0 - (unsafe-car lst_0))) + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((mask_1 - (let ((mask_1 - (bitwise-ior - mask_0 - (if (if (eq? - 'lambda - (unsafe-vector*-ref - lam_0 - 0)) - #t - #f) - (let ((mask_1 - (unsafe-vector*-ref - lam_0 - 1))) - mask_1) - (error - 'interp-match - "no matching clause"))))) - (values mask_1)))) - (for-loop_0 - mask_1 - rest_0)))) - mask_0)))))) - (for-loop_0 0 lams_0))))) - (list->vector - (list* - 'case-lambda - mask_0 - (extract-procedure-wrap-data_0 e_0) - lams_0))))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'let hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_1))) + (let ((ids_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ids_0 rhss_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_1 v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((ids_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) - (case-lambda - ((ids15_0 - rhss16_0) - (values - (cons - ids15_0 - ids_0) - (cons - rhss16_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 rhss_1) - (values - ids_1 - rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 rhss_1) - (for-loop_0 - ids_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values ids_0 rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((ids_0 rhss_0) - (let ((app_0 (reverse$1 ids_0))) - (values app_0 (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) + ids_2 + rhss_1)))))) + (case-lambda + ((ids15_0 + rhss16_0) + (values + (cons + ids15_0 + ids_0) + (cons + rhss16_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 rhss_1) + (values + ids_1 + rhss_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 rhss_1) + (for-loop_0 + ids_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values ids_0 rhss_0))))))) + (for-loop_0 null null a_0)))) (case-lambda ((ids_0 rhss_0) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0) (rhss_1 rhss_0)) - (values ids_1 rhss_1 body_0)))) + (let ((app_0 (reverse$1 ids_0))) + (values app_0 (reverse$1 rhss_0)))) (args (raise-binding-result-arity-error 2 - args))))))) - (case-lambda - ((ids_0 rhss_0 body_0) - (let ((len_0 (length ids_0))) - (let ((body-env_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (env_1 lst_0 pos_0) - (begin - (if (if (pair? lst_0) #t #f) - (let ((id_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((env_2 - (let ((env_2 - (let ((u_0 - (unwrap - id_0))) - (let ((pos_1 - (+ - stack-depth_0 - pos_0))) - (hash-set - env_1 - u_0 - (if (hash-ref - mutated_0 - u_0 - #f) - (boxed2.1 - pos_1) - pos_1)))))) - (values env_2)))) - (for-loop_0 - env_2 - rest_0 - (+ pos_0 1))))) - env_1)))))) - (for-loop_0 env_0 ids_0 0))))) - (let ((body-stack-depth_0 - (+ stack-depth_0 len_0))) - (let ((c-body_0 - (compile-body_0 - serializable?_0 - body_0 - body-env_0 - body-stack-depth_0 - stk-i_0 - tail?_0 - mutated_0))) - (let ((new-body_0 - (add-boxes/remove-unused_0 - c-body_0 - ids_0 - mutated_0 - body-env_0 - stk-i_0))) - (let ((pos_0 - (stack->pos.1 - #t - stack-depth_0 - stk-i_0))) + args)))))) + (case-lambda + ((ids_0 rhss_0) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((ids_1 ids_0) (rhss_1 rhss_0)) + (values ids_1 rhss_1 body_0)))) + (args + (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((ids_0 rhss_0 body_0) + (let ((len_0 (length ids_0))) + (let ((body-env_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (env_1 lst_0 pos_0) (begin - (stack-info-forget! - stk-i_0 - stack-depth_0 - pos_0 - len_0) - (let ((new-rhss_0 - (compile-list_0 - serializable?_0 - rhss_0 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0))) - (let ((or-part_0 - (if (null? new-rhss_0) - new-body_0 - (if (vector? new-body_0) - (if (if (eq? - 'let - (unsafe-vector*-ref - new-body_0 - 0)) - #t - #f) - (let ((pos2_0 - (unsafe-vector*-ref - new-body_0 - 1))) - (let ((rhss2_0 - (unsafe-vector*-ref - new-body_0 - 2))) - (let ((b_0 - (unsafe-vector*-ref - new-body_0 - 3))) - (let ((rhss2_1 - rhss2_0) - (pos2_1 - pos2_0)) - (vector - 'let* - (list - pos_0 - pos2_1) - (list - (list->vector - new-rhss_0) - rhss2_1) - b_0))))) - (if (if (eq? - 'let* - (unsafe-vector*-ref - new-body_0 - 0)) - #t - #f) - (let ((poss_0 - (unsafe-vector*-ref - new-body_0 - 1))) - (let ((rhsss_0 - (unsafe-vector*-ref - new-body_0 - 2))) - (let ((b_0 - (unsafe-vector*-ref - new-body_0 - 3))) - (let ((rhsss_1 - rhsss_0) - (poss_1 - poss_0)) - (vector - 'let* - (cons - pos_0 - poss_1) - (cons - (list->vector - new-rhss_0) - rhsss_1) - b_0))))) - (if (if (eq? - 'clear - (unsafe-vector*-ref - new-body_0 - 0)) - #t - #f) - (let ((poss_0 - (unsafe-vector*-ref - new-body_0 - 1))) - (let ((e_1 - (unsafe-vector*-ref - new-body_0 - 2))) - (let ((poss_1 - poss_0)) - (letrec* - ((loop_4 - (|#%name| - loop - (lambda (pos_1 - poss_2 - rhss_1) - (begin - (if (null? - rhss_1) - (let ((e_2 - (if (null? - poss_2) - e_1 - (vector - 'clear - poss_2 - e_1)))) - (vector - 'beginl - (append - new-rhss_0 - (begins->list_0 - e_2)))) - (if (null? - poss_2) - #f - (if (eqv? - pos_1 - (car - poss_2)) - (let ((app_0 - (add1 - pos_1))) - (let ((app_1 - (cdr - poss_2))) - (loop_4 - app_0 - app_1 - (cdr - rhss_1)))) - #f)))))))) - (loop_4 - pos_0 - poss_1 - new-rhss_0))))) - #f))) - #f)))) - (if or-part_0 - or-part_0 - (vector - 'let - pos_0 - (list->vector new-rhss_0) - new-body_0)))))))))))) - (args (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'letrec hd_0) #t #f) - (compile-letrec_0 - serializable?_0 - e_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - (if (if (eq? 'letrec* hd_0) #t #f) - (compile-letrec_0 - serializable?_0 - e_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - (if (if (eq? 'begin hd_0) #t #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap e_0)))) d_0))) - (compile-body_0 - serializable?_0 - vs_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0)) - (if (if (eq? 'begin-unsafe hd_0) #t #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap e_0)))) d_0))) - (compile-body_0 - serializable?_0 - vs_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0)) - (if (if (eq? 'begin0 hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_1))))) - #f))) - #f) - (let ((e_1 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((a_0 (car (unwrap d_0)))) - a_0)))) - (compile-expr_0 - serializable?_0 - e_1 - env_0 - stack-depth_0 + (if (if (pair? lst_0) #t #f) + (let ((id_0 (unsafe-car lst_0))) + (let ((rest_0 + (unsafe-cdr lst_0))) + (let ((env_2 + (let ((env_2 + (let ((u_0 + (unwrap + id_0))) + (let ((pos_1 + (+ + stack-depth_0 + pos_0))) + (hash-set + env_1 + u_0 + (if (hash-ref + mutated_0 + u_0 + #f) + (boxed2.1 + pos_1) + pos_1)))))) + (values env_2)))) + (for-loop_0 + env_2 + rest_0 + (+ pos_0 1))))) + env_1)))))) + (for-loop_0 env_0 ids_0 0))))) + (let ((body-stack-depth_0 (+ stack-depth_0 len_0))) + (let ((c-body_0 + (compile-body_0 + body_0 + body-env_0 + body-stack-depth_0 + stk-i_0 + tail?_0 + mutated_0))) + (let ((new-body_0 + (add-boxes/remove-unused_0 + c-body_0 + ids_0 + mutated_0 + body-env_0 + stk-i_0))) + (let ((pos_0 + (stack->pos.1 + #t + stack-depth_0 + stk-i_0))) + (begin + (stack-info-forget! stk-i_0 - tail?_0 - mutated_0)) - (if (if (eq? 'begin0 hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) #t #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((e_1 - (let ((a_0 (car p_0))) - a_0))) - (let ((vs_0 - (let ((d_1 (cdr p_0))) - d_1))) - (let ((e_2 e_1)) - (values e_2 vs_0))))))) - (case-lambda - ((e_1 vs_0) - (let ((new-body_0 - (compile-body_0 - serializable?_0 - vs_0 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0))) - (vector - 'begin0 - (compile-expr_0 - serializable?_0 - e_1 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0) - new-body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? '$value hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? - app_0 - (unwrap a_1))))) - #f))) - #f) - (let ((e_1 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((a_0 (car (unwrap d_0)))) - a_0)))) - (vector - '$value - (compile-expr_0 - serializable?_0 - e_1 + stack-depth_0 + pos_0 + len_0) + (let ((new-rhss_0 + (compile-list_0 + rhss_0 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0))) + (let ((or-part_0 + (if (null? new-rhss_0) + new-body_0 + (if (vector? new-body_0) + (if (if (eq? + 'let + (unsafe-vector*-ref + new-body_0 + 0)) + #t + #f) + (let ((pos2_0 + (unsafe-vector*-ref + new-body_0 + 1))) + (let ((rhss2_0 + (unsafe-vector*-ref + new-body_0 + 2))) + (let ((b_0 + (unsafe-vector*-ref + new-body_0 + 3))) + (let ((rhss2_1 + rhss2_0) + (pos2_1 + pos2_0)) + (vector + 'let* + (list + pos_0 + pos2_1) + (list + (list->vector + new-rhss_0) + rhss2_1) + b_0))))) + (if (if (eq? + 'let* + (unsafe-vector*-ref + new-body_0 + 0)) + #t + #f) + (let ((poss_0 + (unsafe-vector*-ref + new-body_0 + 1))) + (let ((rhsss_0 + (unsafe-vector*-ref + new-body_0 + 2))) + (let ((b_0 + (unsafe-vector*-ref + new-body_0 + 3))) + (let ((rhsss_1 + rhsss_0) + (poss_1 + poss_0)) + (vector + 'let* + (cons + pos_0 + poss_1) + (cons + (list->vector + new-rhss_0) + rhsss_1) + b_0))))) + (if (if (eq? + 'clear + (unsafe-vector*-ref + new-body_0 + 0)) + #t + #f) + (let ((poss_0 + (unsafe-vector*-ref + new-body_0 + 1))) + (let ((e_1 + (unsafe-vector*-ref + new-body_0 + 2))) + (let ((poss_1 + poss_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_1 + poss_2 + rhss_1) + (begin + (if (null? + rhss_1) + (let ((e_2 + (if (null? + poss_2) + e_1 + (vector + 'clear + poss_2 + e_1)))) + (vector + 'beginl + (append + new-rhss_0 + (begins->list_0 + e_2)))) + (if (null? + poss_2) + #f + (if (eqv? + pos_1 + (car + poss_2)) + (let ((app_0 + (add1 + pos_1))) + (let ((app_1 + (cdr + poss_2))) + (loop_0 + app_0 + app_1 + (cdr + rhss_1)))) + #f)))))))) + (loop_0 + pos_0 + poss_1 + new-rhss_0))))) + #f))) + #f)))) + (if or-part_0 + or-part_0 + (vector + 'let + pos_0 + (list->vector new-rhss_0) + new-body_0)))))))))))) + (args (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'letrec hd_0) #t #f) + (compile-letrec_0 + e_0 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0) + (if (if (eq? 'letrec* hd_0) #t #f) + (compile-letrec_0 + e_0 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0) + (if (if (eq? 'begin hd_0) #t #f) + (let ((vs_0 (let ((d_0 (cdr (unwrap e_0)))) d_0))) + (compile-body_0 + vs_0 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0)) + (if (if (eq? 'begin-unsafe hd_0) #t #f) + (let ((vs_0 (let ((d_0 (cdr (unwrap e_0)))) d_0))) + (compile-body_0 + vs_0 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0)) + (if (if (eq? 'begin0 hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) + #f))) + #f) + (let ((e_1 + (let ((d_0 (cdr (unwrap e_0)))) + (let ((a_0 (car (unwrap d_0)))) a_0)))) + (compile-expr_0 + e_1 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0)) + (if (if (eq? 'begin0 hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) #t #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((e_1 (let ((a_0 (car p_0))) a_0))) + (let ((vs_0 + (let ((d_1 (cdr p_0))) d_1))) + (let ((e_2 e_1)) + (values e_2 vs_0))))))) + (case-lambda + ((e_1 vs_0) + (let ((new-body_0 + (compile-body_0 + vs_0 env_0 stack-depth_0 stk-i_0 #f mutated_0))) - (if (if (eq? 'if hd_0) - (let ((a_0 (cdr (unwrap e_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((tst_0 - (let ((a_0 (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 - (unwrap d_1))) - (let ((thn_0 - (let ((a_0 - (car - p_1))) - a_0))) - (let ((els_0 - (let ((d_2 - (cdr - p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((thn_1 - thn_0)) - (values - thn_1 - els_0))))))) - (case-lambda - ((thn_0 els_0) - (let ((tst_1 tst_0)) - (values - tst_1 - thn_0 - els_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((tst_0 thn_0 els_0) - (let ((then-stk-i_0 - (stack-info-branch - stk-i_0))) - (let ((else-stk-i_0 - (stack-info-branch - stk-i_0))) - (let ((new-then_0 - (compile-expr_0 - serializable?_0 - thn_0 - env_0 - stack-depth_0 + (vector + 'begin0 + (compile-expr_0 + e_1 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0) + new-body_0))) + (args + (raise-binding-result-arity-error 2 args)))) + (if (if (eq? '$value hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) + #f))) + #f) + (let ((e_1 + (let ((d_0 (cdr (unwrap e_0)))) + (let ((a_0 (car (unwrap d_0)))) + a_0)))) + (vector + '$value + (compile-expr_0 + e_1 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0))) + (if (if (eq? 'if hd_0) + (let ((a_0 (cdr (unwrap e_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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((tst_0 + (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((thn_0 + (let ((a_0 + (car p_1))) + a_0))) + (let ((els_0 + (let ((d_2 + (cdr p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + a_0)))) + (let ((thn_1 thn_0)) + (values + thn_1 + els_0))))))) + (case-lambda + ((thn_0 els_0) + (let ((tst_1 tst_0)) + (values tst_1 thn_0 els_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((tst_0 thn_0 els_0) + (let ((then-stk-i_0 + (stack-info-branch stk-i_0))) + (let ((else-stk-i_0 + (stack-info-branch stk-i_0))) + (let ((new-then_0 + (compile-expr_0 + thn_0 + env_0 + stack-depth_0 + then-stk-i_0 + tail?_0 + mutated_0))) + (let ((new-else_0 + (compile-expr_0 + els_0 + env_0 + stack-depth_0 + else-stk-i_0 + tail?_0 + mutated_0))) + (let ((all-clear_0 + (stack-info-merge! + stk-i_0 + (list then-stk-i_0 - tail?_0 - mutated_0))) - (let ((new-else_0 - (compile-expr_0 - serializable?_0 - els_0 - env_0 - stack-depth_0 - else-stk-i_0 - tail?_0 - mutated_0))) - (let ((all-clear_0 - (stack-info-merge! - stk-i_0 - (list - then-stk-i_0 - else-stk-i_0)))) - (let ((app_0 - (compile-expr_0 - serializable?_0 - tst_0 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0))) - (let ((app_1 - (add-clears_0 - new-then_0 - then-stk-i_0 - all-clear_0))) - (vector - 'if - app_0 - app_1 - (add-clears_0 - new-else_0 - else-stk-i_0 - all-clear_0)))))))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'with-continuation-mark* - hd_0) - (let ((a_0 (cdr (unwrap e_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 + else-stk-i_0)))) + (let ((app_0 + (compile-expr_0 + tst_0 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0))) + (let ((app_1 + (add-clears_0 + new-then_0 + then-stk-i_0 + all-clear_0))) + (vector + 'if + app_0 + app_1 + (add-clears_0 + new-else_0 + else-stk-i_0 + all-clear_0)))))))))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? 'with-continuation-mark* hd_0) + (let ((a_0 (cdr (unwrap e_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))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? p_3) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((mode_0 + (let ((a_0 (car p_0))) + a_0))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((key_0 + (let ((a_0 + (car p_1))) + a_0))) + (call-with-values + (lambda () + (let ((d_2 (cdr p_1))) (let ((p_2 (unwrap - a_2))) - (if (pair? p_2) - (let ((a_3 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((mode_0 - (let ((a_0 (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 - (unwrap d_1))) - (let ((key_0 - (let ((a_0 - (car - p_1))) - a_0))) - (call-with-values - (lambda () - (let ((d_2 - (cdr - p_1))) - (let ((p_2 - (unwrap - d_2))) - (let ((val_0 - (let ((a_0 - (car - p_2))) - a_0))) - (let ((body_0 - (let ((d_3 - (cdr - p_2))) - (let ((a_0 - (car - (unwrap - d_3)))) - a_0)))) - (let ((val_1 - val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 body_0) - (let ((key_1 - key_0)) - (values - key_1 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((key_0 val_0 body_0) - (let ((mode_1 mode_0)) - (values - mode_1 - key_0 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (case-lambda - ((mode_0 key_0 val_0 body_0) - (let ((new-body_0 - (compile-expr_0 - serializable?_0 - body_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0))) - (let ((new-val_0 - (compile-expr_0 - serializable?_0 - val_0 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0))) - (vector - 'wcm - (compile-expr_0 - serializable?_0 - key_0 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0) - new-val_0 - new-body_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (if (if (eq? 'quote hd_0) - (let ((a_0 - (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_1))))) - #f))) - #f) - (let ((v_0 - (let ((d_0 - (cdr (unwrap e_0)))) - (let ((a_0 - (car - (unwrap d_0)))) - a_0)))) - (let ((v_1 - (|#%app| - strip-annotations - v_0))) - (if (let ((or-part_0 - (vector? v_1))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (pair? v_1))) - (if or-part_1 - or-part_1 - (let ((or-part_2 - (symbol? - v_1))) - (if or-part_2 - or-part_2 - (let ((or-part_3 - (number? - v_1))) - (if or-part_3 - or-part_3 - (box? - v_1))))))))) - (vector 'quote v_1) - v_1))) - (if (if (eq? 'set! hd_0) - (let ((a_0 - (cdr (unwrap e_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 - (let ((a_0 - (car p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((id_1 id_0)) - (values - id_1 - rhs_0))))))) + d_2))) + (let ((val_0 + (let ((a_0 + (car + p_2))) + a_0))) + (let ((body_0 + (let ((d_3 + (cdr + p_2))) + (let ((a_0 + (car + (unwrap + d_3)))) + a_0)))) + (let ((val_1 + val_0)) + (values + val_1 + body_0))))))) + (case-lambda + ((val_0 body_0) + (let ((key_1 key_0)) + (values + key_1 + val_0 + body_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) (case-lambda - ((id_0 rhs_0) - (compile-assignment_0 - serializable?_0 - id_0 - rhs_0 + ((key_0 val_0 body_0) + (let ((mode_1 mode_0)) + (values + mode_1 + key_0 + val_0 + body_0))) + (args + (raise-binding-result-arity-error + 3 + args)))))))) + (case-lambda + ((mode_0 key_0 val_0 body_0) + (let ((new-body_0 + (compile-expr_0 + body_0 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0))) + (let ((new-val_0 + (compile-expr_0 + val_0 env_0 stack-depth_0 stk-i_0 - mutated_0)) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? 'define hd_0) - (let ((a_0 - (cdr - (unwrap e_0)))) - (let ((p_0 - (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 - (cdr p_0))) - (let ((p_1 + #f + mutated_0))) + (vector + 'wcm + (compile-expr_0 + key_0 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0) + new-val_0 + new-body_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (if (if (eq? 'quote hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_1))))) + #f))) + #f) + (let ((v_0 + (let ((d_0 (cdr (unwrap e_0)))) + (let ((a_0 + (car (unwrap d_0)))) + a_0)))) + (let ((v_1 + (|#%app| + strip-annotations + v_0))) + (if (let ((or-part_0 + (vector? v_1))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (pair? v_1))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (symbol? v_1))) + (if or-part_2 + or-part_2 + (let ((or-part_3 + (number? + v_1))) + (if or-part_3 + or-part_3 + (box? + v_1))))))))) + (vector 'quote v_1) + v_1))) + (if (if (eq? 'set! hd_0) + (let ((a_0 (cdr (unwrap e_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))) + (begin-unsafe + (let ((app_0 (unwrap - a_1))) - (if (pair? p_1) - (let ((a_2 - (cdr - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((id_1 id_0)) - (values - id_1 - rhs_0))))))) - (case-lambda - ((id_0 rhs_0) - (compile-assignment_0 - serializable?_0 - id_0 - rhs_0 - env_0 - stack-depth_0 - stk-i_0 - mutated_0)) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'define-values - hd_0) - (let ((a_0 - (cdr - (unwrap e_0)))) - (let ((p_0 - (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 - (cdr p_0))) - (let ((p_1 + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((id_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_1 id_0)) + (values + id_1 + rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (compile-assignment_0 + id_0 + rhs_0 + env_0 + stack-depth_0 + stk-i_0 + mutated_0)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? 'define hd_0) + (let ((a_0 (cdr (unwrap e_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))) + (begin-unsafe + (let ((app_0 (unwrap - a_1))) - (if (pair? - p_1) - (let ((a_2 - (cdr - p_1))) - (begin-unsafe - (let ((app_0 + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((id_0 + (let ((a_0 + (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_1 id_0)) + (values + id_1 + rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (compile-assignment_0 + id_0 + rhs_0 + env_0 + stack-depth_0 + stk-i_0 + mutated_0)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? 'define-values hd_0) + (let ((a_0 + (cdr (unwrap e_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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((ids_0 + (let ((a_0 + (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((ids_1 ids_0)) + (values + ids_1 + rhs_0))))))) + (case-lambda + ((ids_0 rhs_0) + (let ((gen-ids_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (deterministic-gensym + (unwrap + id_0)) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + ids_0)))))) + (compile-expr_0 + (list + 'call-with-values + (list 'lambda '() rhs_0) + (list* + 'lambda + gen-ids_0 + (if (null? ids_0) + (list (void)) + (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 ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((gen-id_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (cons + (list + 'set! + id_0 + gen-id_0) + fold-var_0))) + (let ((fold-var_2 + (values + fold-var_1))) + (for-loop_0 + fold-var_2 + rest_0 + rest_1))))))) + fold-var_0)))))) + (for-loop_0 + null + ids_0 + gen-ids_0))))))) + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'call-with-values + hd_0) + (let ((a_0 + (cdr (unwrap e_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) + (if (let ((a_2 + (car + p_1))) + (let ((p_2 (unwrap - '()))) - (eq? - app_0 + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + 'lambda))) + (eq? + app_0 + (unwrap + a_3))))) + (let ((a_3 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? + p_3) + #t + #f))) + #f) + #f))) + (let ((a_2 + (cdr + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((proc1_0 + (let ((a_0 + (car + p_0))) + a_0))) + (call-with-values + (lambda () + (let ((d_1 + (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + (let ((d_2 + (cdr + (unwrap + a_0)))) + (let ((p_1 (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 + d_2))) + (let ((ids_0 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((body_0 + (let ((d_3 + (cdr + p_1))) + d_3))) + (let ((ids_1 + ids_0)) + (values + ids_1 + body_0))))))))) + (case-lambda + ((ids_0 body_0) + (let ((proc1_1 + proc1_0)) + (values + proc1_1 + ids_0 + body_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((proc1_0 ids_0 body_0) + (compile-expr_0 + (list + 'call-with-values + proc1_0 + (list + 'case-lambda + (list* ids_0 body_0))) + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0)) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? + 'call-with-values + hd_0) + (let ((a_0 (cdr (unwrap e_0)))) (let ((p_0 - (unwrap d_0))) - (let ((ids_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((ids_1 - ids_0)) - (values - ids_1 - rhs_0))))))) - (case-lambda - ((ids_0 rhs_0) - (let ((gen-ids_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (deterministic-gensym - (unwrap - id_0)) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - ids_0)))))) - (compile-expr_0 - serializable?_0 - (list - 'call-with-values - (list - 'lambda - '() - rhs_0) - (list* - 'lambda - gen-ids_0 - (if (null? ids_0) - (list (void)) - (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 ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((gen-id_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (cons - (list - 'set! - id_0 - gen-id_0) - fold-var_0))) - (let ((fold-var_2 - (values - fold-var_1))) - (for-loop_0 - fold-var_2 - rest_0 - rest_1))))))) - fold-var_0)))))) - (for-loop_0 - null - ids_0 - gen-ids_0))))))) - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'call-with-values - hd_0) - (let ((a_0 - (cdr - (unwrap - e_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) - (if (let ((a_2 - (car - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (if (let ((a_3 - (car - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - 'lambda))) - (eq? - app_0 - (unwrap - a_3))))) - (let ((a_3 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - #t - #f))) - #f) - #f))) - (let ((a_2 - (cdr - p_1))) - (begin-unsafe - (let ((app_0 + (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car + p_0))) + (let ((p_1 + (unwrap + a_1))) + (if (pair? + p_1) + (if (let ((a_2 + (car + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + 'lambda))) + (eq? + app_0 + (unwrap + a_2))))) + (let ((a_2 + (cdr + p_1))) + (let ((p_2 (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #t + #f) + #f))) + #f) + #f))) + (let ((a_1 + (cdr + p_0))) + (let ((p_1 + (unwrap + a_1))) + (if (pair? + p_1) + (if (let ((a_2 + (car + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + 'case-lambda))) + (eq? + app_0 + (unwrap + a_3))))) + (let ((a_3 + (cdr + p_2))) + (if (wrap-list? + a_3) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_1 + v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_3 + (unwrap + v_1))) + (if (pair? + p_3) + #t + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 + #t + a_3))) + #f)) + #f) + #f))) + (let ((a_2 + (cdr + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f) + #f))) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap e_0)))) + (let ((p_0 + (unwrap d_0))) + (let ((body_0 + (let ((a_0 + (car + p_0))) + (let ((d_1 + (cdr + (unwrap + a_0)))) + (let ((d_2 + (cdr + (unwrap + d_1)))) + d_2))))) + (call-with-values + (lambda () + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + (let ((d_2 + (cdr + (unwrap + a_0)))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idss_0 + bodys_0 + lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_1 + v_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_1))) + (let ((idss_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((bodys_1 + (let ((d_3 + (cdr + p_1))) + d_3))) + (let ((idss_2 + idss_1)) + (values + idss_2 + bodys_1)))))) + (case-lambda + ((idss20_0 + bodys21_0) + (values + (cons + idss20_0 + idss_0) + (cons + bodys21_0 + bodys_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((idss_1 + bodys_1) + (values + idss_1 + bodys_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((idss_1 + bodys_1) + (for-loop_0 + idss_1 + bodys_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values + idss_0 + bodys_0))))))) + (for-loop_0 + null + null + d_2)))) + (case-lambda + ((idss_0 + bodys_0) + (let ((app_0 + (reverse$1 + idss_0))) + (values + app_0 + (reverse$1 + bodys_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((idss_0 bodys_0) + (let ((body_1 + body_0)) + (values + body_1 + idss_0 + bodys_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((body_0 idss_0 bodys_0) + (let ((body-stk-is_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((body_1 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (stack-info-branch + stk-i_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + bodys_0)))))) + (let ((initial-new-clauses_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0 + lst_1 + lst_2) + (begin + (if (if (pair? + lst_0) + (if (pair? + lst_1) + (pair? + lst_2) + #f) + #f) + (let ((ids_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((body_1 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((body-stk-i_0 + (unsafe-car + lst_2))) + (let ((rest_2 + (unsafe-cdr + lst_2))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (call-with-values + (lambda () + (args->env_0 + ids_0 + env_0 + stack-depth_0 + mutated_0)) + (case-lambda + ((new-env_0 + count_0 + rest?_0) + (let ((new-stack-depth_0 + (+ + stack-depth_0 + count_0))) + (let ((c-body_0 + (compile-body_0 + body_1 + new-env_0 + new-stack-depth_0 + body-stk-i_0 + tail?_0 + mutated_0))) + (let ((new-body_0 + (add-boxes/remove-unused_0 + c-body_0 + ids_0 + mutated_0 + new-env_0 + body-stk-i_0))) + (let ((pos_0 + (stack->pos.1 + #t + stack-depth_0 + body-stk-i_0))) + (begin + (stack-info-forget! + body-stk-i_0 + stack-depth_0 + pos_0 + count_0) + (vector + (count->mask + count_0 + rest?_0) + new-body_0))))))) + (args + (raise-binding-result-arity-error + 3 + args)))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1 + rest_2)))))))) + fold-var_0)))))) + (for-loop_0 + null + idss_0 + bodys_0 + body-stk-is_0)))))) + (let ((all-clear_0 + (stack-info-merge! + stk-i_0 + body-stk-is_0))) + (let ((app_0 + (compile-body_0 + body_0 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0))) + (let ((app_1 + (stack->pos.1 + #t + stack-depth_0 + stk-i_0))) + (let ((app_2 + (if (let ((p_0 + (unwrap + e_0))) + (if (pair? + p_0) + (let ((a_0 + (cdr + p_0))) + (let ((p_1 + (unwrap + a_0))) + (if (pair? + p_1) + (let ((a_1 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_1))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (begin-unsafe + (let ((app_2 + (unwrap + '()))) + (eq? + app_2 + (unwrap + a_2))))) + #f))) + #f))) + #f)) + (let ((receiver_0 + (let ((d_0 + (cdr + (unwrap + e_0)))) + (let ((d_1 + (cdr + (unwrap + d_0)))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0))))) + (wrap-property + receiver_0 + 'inferred-name)) + (error + 'match + "failed ~e" + e_0)))) + (vector + 'cwv + app_0 + app_1 + app_2 + (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 ((initial-new-clause_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((body-stk-i_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((body_1 + (vector-ref + initial-new-clause_0 + 1))) + (let ((app_3 + (vector-ref + initial-new-clause_0 + 0))) + (vector + app_3 + (add-clears_0 + body_1 + body-stk-i_0 + all-clear_0)))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 + null + initial-new-clauses_0 + body-stk-is_0)))))))))))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? + 'call-with-module-prompt + hd_0) + (let ((a_0 (cdr (unwrap e_0)))) (let ((p_0 - (unwrap d_0))) - (let ((proc1_0 - (let ((a_0 - (car - p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car + (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car + p_0))) + (let ((p_1 (unwrap - d_1)))) - (let ((d_2 - (cdr - (unwrap - a_0)))) - (let ((p_1 - (unwrap - d_2))) - (let ((ids_0 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((body_0 - (let ((d_3 - (cdr - p_1))) - d_3))) - (let ((ids_1 - ids_0)) - (values - ids_1 - body_0))))))))) - (case-lambda - ((ids_0 body_0) - (let ((proc1_1 - proc1_0)) - (values - proc1_1 - ids_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((proc1_0 ids_0 body_0) - (compile-expr_0 - serializable?_0 - (list - 'call-with-values - proc1_0 - (list - 'case-lambda - (list* - ids_0 - body_0))) - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0)) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'call-with-values - hd_0) - (let ((a_0 + a_1))) + (if (pair? + p_1) + (if (let ((a_2 + (car + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + 'lambda))) + (eq? + app_0 + (unwrap + a_2))))) + (let ((a_2 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #t + #f) + #f))) + #f) + #f))) + (let ((a_1 + (cdr + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f) + #f))) + #f) + (let ((body_0 + (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? p_0) - (if (let ((a_1 - (car - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - 'lambda))) - (eq? - app_0 - (unwrap - a_2))))) - (let ((a_2 - (cdr - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (if (let ((a_3 - (car - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #t - #f) - #f))) - #f) - #f))) - (let ((a_1 - (cdr - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (if (let ((a_3 - (car - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - 'case-lambda))) - (eq? - app_0 - (unwrap - a_3))))) - (let ((a_3 - (cdr - p_2))) - (if (wrap-list? - a_3) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 - v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_3 - (unwrap - v_1))) - (if (pair? - p_3) - #t - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 - #t - a_3))) - #f)) - #f) - #f))) - (let ((a_2 - (cdr - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f) - #f))) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 + (let ((a_0 + (car + (unwrap + d_0)))) + (let ((d_1 + (cdr + (unwrap + a_0)))) + (let ((d_2 + (cdr + (unwrap + d_1)))) + d_2)))))) + (vector + 'cwmp0 + (compile-body_0 + body_0 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0))) + (if (if (eq? + 'call-with-module-prompt + hd_0) + (let ((a_0 (cdr (unwrap e_0)))) (let ((p_0 (unwrap - d_0))) - (let ((body_0 - (let ((a_0 - (car - p_0))) - (let ((d_1 - (cdr - (unwrap - a_0)))) - (let ((d_2 - (cdr - (unwrap - d_1)))) - d_2))))) - (call-with-values - (lambda () - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car + a_0))) + (if (pair? p_0) + (if (let ((a_1 + (car + p_0))) + (let ((p_1 (unwrap - d_1)))) - (let ((d_2 - (cdr - (unwrap - a_0)))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idss_0 - bodys_0 - lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 - v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((idss_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((bodys_1 - (let ((d_3 - (cdr - p_1))) - d_3))) - (let ((idss_2 - idss_1)) - (values - idss_2 - bodys_1)))))) - (case-lambda - ((idss20_0 - bodys21_0) - (values - (cons - idss20_0 - idss_0) - (cons - bodys21_0 - bodys_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 - bodys_1) - (values - idss_1 - bodys_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 - bodys_1) - (for-loop_0 - idss_1 - bodys_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - idss_0 - bodys_0))))))) - (for-loop_0 - null - null - d_2)))) - (case-lambda - ((idss_0 - bodys_0) - (let ((app_0 - (reverse$1 - idss_0))) - (values - app_0 - (reverse$1 - bodys_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((idss_0 - bodys_0) - (let ((body_1 - body_0)) - (values - body_1 - idss_0 - bodys_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((body_0 - idss_0 - bodys_0) - (let ((body-stk-is_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((body_1 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (stack-info-branch - stk-i_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - bodys_0)))))) - (let ((initial-new-clauses_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0 - lst_1 - lst_2) - (begin - (if (if (pair? - lst_0) - (if (pair? - lst_1) - (pair? - lst_2) - #f) - #f) - (let ((ids_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((body_1 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((body-stk-i_0 - (unsafe-car - lst_2))) - (let ((rest_2 - (unsafe-cdr - lst_2))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (call-with-values - (lambda () - (args->env_0 - ids_0 - env_0 - stack-depth_0 - mutated_0)) - (case-lambda - ((new-env_0 - count_0 - rest?_0) - (let ((new-stack-depth_0 - (+ - stack-depth_0 - count_0))) - (let ((c-body_0 - (compile-body_0 - serializable?_0 - body_1 - new-env_0 - new-stack-depth_0 - body-stk-i_0 - tail?_0 - mutated_0))) - (let ((new-body_0 - (add-boxes/remove-unused_0 - c-body_0 - ids_0 - mutated_0 - new-env_0 - body-stk-i_0))) - (let ((pos_0 - (stack->pos.1 - #t - stack-depth_0 - body-stk-i_0))) - (begin - (stack-info-forget! - body-stk-i_0 - stack-depth_0 - pos_0 - count_0) - (vector - (count->mask - count_0 - rest?_0) - new-body_0))))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1 - rest_2)))))))) - fold-var_0)))))) - (for-loop_0 - null - idss_0 - bodys_0 - body-stk-is_0)))))) - (let ((all-clear_0 - (stack-info-merge! - stk-i_0 - body-stk-is_0))) - (let ((app_0 - (compile-body_0 - serializable?_0 - body_0 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0))) - (let ((app_1 - (stack->pos.1 - #t - stack-depth_0 - stk-i_0))) - (let ((app_2 - (if (let ((p_0 - (unwrap - e_0))) - (if (pair? - p_0) - (let ((a_0 - (cdr - p_0))) - (let ((p_1 - (unwrap - a_0))) - (if (pair? - p_1) - (let ((a_1 - (cdr - p_1))) - (let ((p_2 - (unwrap - a_1))) - (if (pair? - p_2) - (let ((a_2 - (cdr - p_2))) - (begin-unsafe - (let ((app_2 - (unwrap - '()))) - (eq? - app_2 - (unwrap - a_2))))) - #f))) - #f))) - #f)) - (let ((receiver_0 - (let ((d_0 - (cdr - (unwrap - e_0)))) - (let ((d_1 - (cdr - (unwrap - d_0)))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0))))) - (wrap-property - receiver_0 - 'inferred-name)) - (error - 'match - "failed ~e" - e_0)))) - (vector - 'cwv - app_0 - app_1 - app_2 - (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 ((initial-new-clause_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((body-stk-i_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((body_1 - (vector-ref - initial-new-clause_0 - 1))) - (let ((app_3 - (vector-ref - initial-new-clause_0 - 0))) - (vector - app_3 - (add-clears_0 - body_1 - body-stk-i_0 - all-clear_0)))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 - null - initial-new-clauses_0 - body-stk-is_0)))))))))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'call-with-module-prompt - hd_0) - (let ((a_0 - (cdr - (unwrap - e_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (if (let ((a_1 - (car - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - 'lambda))) - (eq? - app_0 - (unwrap - a_2))))) - (let ((a_2 - (cdr - p_1))) - (let ((p_2 + a_1))) + (if (pair? + p_1) + (if (let ((a_2 + (car + p_1))) + (begin-unsafe + (let ((app_0 (unwrap - a_2))) - (if (pair? - p_2) - (if (let ((a_3 - (car - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #t - #f) - #f))) - #f) - #f))) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 + 'lambda))) + (eq? + app_0 + (unwrap + a_2))))) + (let ((a_2 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #t + #f) + #f))) + #f) + #f))) + (let ((a_1 + (cdr + p_0))) + (let ((p_1 (unwrap - a_1))))) - #f) - #f))) - #f) - (let ((body_0 - (let ((d_0 - (cdr - (unwrap - e_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - (let ((d_1 - (cdr - (unwrap - a_0)))) - (let ((d_2 + a_1))) + (if (pair? + p_1) + (if (let ((a_2 + (car + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (if (let ((a_3 + (car + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + 'quote))) + (eq? + app_0 + (unwrap + a_3))))) + (let ((a_3 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? + p_3) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f))) + #f) + #f))) + (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_0 + (unwrap + 'quote))) + (eq? + app_0 + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_5))))) + #f))) + #f) + #f))) + (let ((a_3 + (cdr + p_2))) + (wrap-list? + a_3)) + #f) + #f))) + #f) + #f))) + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + e_0)))) + (let ((p_0 + (unwrap + d_0))) + (let ((body_0 + (let ((a_0 + (car + p_0))) + (let ((d_1 (cdr (unwrap - d_1)))) - d_2)))))) - (vector - 'cwmp0 - (compile-body_0 - serializable?_0 - body_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0))) - (if (if (eq? - 'call-with-module-prompt - hd_0) - (let ((a_0 - (cdr - (unwrap - e_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (if (let ((a_1 - (car - p_0))) - (let ((p_1 - (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (begin-unsafe - (let ((app_0 - (unwrap - 'lambda))) - (eq? - app_0 - (unwrap - a_2))))) - (let ((a_2 - (cdr - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (if (let ((a_3 - (car - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #t - #f) - #f))) - #f) - #f))) - (let ((a_1 - (cdr - p_0))) - (let ((p_1 + a_0)))) + (let ((d_2 + (cdr (unwrap - a_1))) - (if (pair? - p_1) - (if (let ((a_2 - (car - p_1))) - (let ((p_2 - (unwrap - a_2))) - (if (pair? - p_2) - (if (let ((a_3 - (car - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - 'quote))) - (eq? - app_0 - (unwrap - a_3))))) - (let ((a_3 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f))) - #f) - #f))) - (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_0 - (unwrap - 'quote))) - (eq? - app_0 - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f))) - #f) - #f))) - (let ((a_3 - (cdr - p_2))) - (wrap-list? - a_3)) - #f) - #f))) - #f) - #f))) - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - e_0)))) - (let ((p_0 - (unwrap - d_0))) - (let ((body_0 - (let ((a_0 - (car - p_0))) - (let ((d_1 - (cdr - (unwrap - a_0)))) - (let ((d_2 - (cdr - (unwrap - d_1)))) - d_2))))) - (call-with-values - (lambda () - (let ((d_1 - (cdr - p_0))) - (let ((p_1 - (unwrap - d_1))) - (let ((ids_0 - (let ((a_0 - (car - p_1))) - (let ((d_2 - (cdr - (unwrap - a_0)))) - (let ((a_1 - (car - (unwrap - d_2)))) - a_1))))) - (call-with-values - (lambda () - (let ((d_2 - (cdr - p_1))) - (let ((p_2 - (unwrap - d_2))) - (let ((constances_0 - (let ((a_0 - (car - p_2))) - (let ((d_3 - (cdr - (unwrap - a_0)))) - (let ((a_1 - (car - (unwrap - d_3)))) - a_1))))) - (let ((vars_0 - (let ((d_3 - (cdr - p_2))) - (unwrap-list - d_3)))) - (let ((constances_1 - constances_0)) - (values - constances_1 - vars_0))))))) - (case-lambda - ((constances_0 - vars_0) - (let ((ids_1 - ids_0)) - (values - ids_1 - constances_0 - vars_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((ids_0 - constances_0 - vars_0) - (let ((body_1 - body_0)) - (values - body_1 - ids_0 - constances_0 - vars_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (case-lambda - ((body_0 - ids_0 - constances_0 - vars_0) - (let ((app_0 - (compile-body_0 - serializable?_0 - body_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0))) - (vector - 'cwmp - app_0 - ids_0 - constances_0 - (compile-list_0 - serializable?_0 - vars_0 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (if (if (eq? - 'variable-set! - hd_0) - (let ((a_0 - (cdr - (unwrap - e_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap - e_0)))) - (let ((p_0 - (unwrap - d_0))) - (let ((dest-id_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((e_1 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((dest-id_1 - dest-id_0)) - (values - dest-id_1 - e_1))))))) - (case-lambda - ((dest-id_0 e_1) - (let ((dest-var_0 - (hash-ref - env_0 - (unwrap - dest-id_0)))) - (let ((new-expr_0 - (compile-expr_0 - serializable?_0 - e_1 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0))) - (vector - 'set-variable! - (stack->pos.1 - #f - dest-var_0 - stk-i_0) - new-expr_0 - #f - #f)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'variable-set!/define - hd_0) - (let ((a_0 - (cdr - (unwrap - e_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_0 - (unwrap - 'quote))) - (eq? - app_0 - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f))) - #f) - #f))) - (let ((a_3 - (cdr - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f) - #f))) - #f))) - #f))) - #f) + d_1)))) + d_2))))) (call-with-values (lambda () - (let ((d_0 + (let ((d_1 (cdr - (unwrap - e_0)))) - (let ((p_0 + p_0))) + (let ((p_1 (unwrap - d_0))) - (let ((dest-id_0 + d_1))) + (let ((ids_0 (let ((a_0 (car - p_0))) - a_0))) + p_1))) + (let ((d_2 + (cdr + (unwrap + a_0)))) + (let ((a_1 + (car + (unwrap + d_2)))) + a_1))))) (call-with-values (lambda () - (let ((d_1 + (let ((d_2 (cdr - p_0))) - (let ((p_1 + p_1))) + (let ((p_2 (unwrap - d_1))) - (let ((e_1 + d_2))) + (let ((constances_0 (let ((a_0 (car - p_1))) - a_0))) - (let ((constance_0 - (let ((d_2 + p_2))) + (let ((d_3 (cdr - p_1))) - (let ((a_0 + (unwrap + a_0)))) + (let ((a_1 (car (unwrap - d_2)))) - (let ((d_3 - (cdr - (unwrap - a_0)))) - (let ((a_1 - (car - (unwrap - d_3)))) - a_1)))))) - (let ((e_2 - e_1)) + d_3)))) + a_1))))) + (let ((vars_0 + (let ((d_3 + (cdr + p_2))) + (unwrap-list + d_3)))) + (let ((constances_1 + constances_0)) (values - e_2 - constance_0))))))) + constances_1 + vars_0))))))) (case-lambda - ((e_1 - constance_0) - (let ((dest-id_1 - dest-id_0)) + ((constances_0 + vars_0) + (let ((ids_1 + ids_0)) (values - dest-id_1 - e_1 - constance_0))) + ids_1 + constances_0 + vars_0))) (args (raise-binding-result-arity-error 2 args)))))))) (case-lambda - ((dest-id_0 - e_1 - constance_0) - (let ((dest-var_0 - (hash-ref - env_0 - (unwrap - dest-id_0)))) - (let ((new-expr_0 - (compile-expr_0 - serializable?_0 - e_1 - env_0 - stack-depth_0 - stk-i_0 - #f - mutated_0))) - (vector - 'set-variable! - (stack->pos.1 - #f - dest-var_0 - stk-i_0) - new-expr_0 - constance_0 - #t)))) + ((ids_0 + constances_0 + vars_0) + (let ((body_1 + body_0)) + (values + body_1 + ids_0 + constances_0 + vars_0))) (args (raise-binding-result-arity-error 3 - args)))) - (if (if (eq? - 'variable-ref - hd_0) - (let ((a_0 - (cdr - (unwrap - e_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - (let ((id_0 - (let ((d_0 + args)))))))) + (case-lambda + ((body_0 + ids_0 + constances_0 + vars_0) + (let ((app_0 + (compile-body_0 + body_0 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0))) + (vector + 'cwmp + app_0 + ids_0 + constances_0 + (compile-list_0 + vars_0 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (if (if (eq? + 'variable-set! + hd_0) + (let ((a_0 + (cdr + (unwrap + e_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 - (unwrap - e_0)))) + p_1))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + e_0)))) + (let ((p_0 + (unwrap + d_0))) + (let ((dest-id_0 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((e_1 + (let ((d_1 + (cdr + p_0))) (let ((a_0 (car (unwrap - d_0)))) + d_1)))) a_0)))) - (let ((var_0 - (hash-ref - env_0 - (unwrap - id_0)))) - (vector - 'ref-variable/checked - (stack->pos.1 - #f - var_0 - stk-i_0)))) - (if (if (eq? - 'variable-ref/no-check - hd_0) - (let ((a_0 - (cdr - (unwrap - e_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - (let ((id_0 - (let ((d_0 - (cdr - (unwrap - e_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_0)))) - (let ((var_0 - (hash-ref - env_0 + (let ((dest-id_1 + dest-id_0)) + (values + dest-id_1 + e_1))))))) + (case-lambda + ((dest-id_0 e_1) + (let ((dest-var_0 + (hash-ref + env_0 + (unwrap + dest-id_0)))) + (let ((new-expr_0 + (compile-expr_0 + e_1 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0))) + (vector + 'set-variable! + (stack->pos.1 + #f + dest-var_0 + stk-i_0) + new-expr_0 + #f + #f)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'variable-set!/define + hd_0) + (let ((a_0 + (cdr + (unwrap + e_0)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (let ((p_1 (unwrap - id_0)))) - (vector - 'ref-variable - (stack->pos.1 - #f - var_0 - stk-i_0)))) - (if (if (eq? - '|#%app| - hd_0) - (let ((a_0 - (cdr - (unwrap - e_0)))) - (wrap-list? - a_0)) - #f) - (compile-apply_0 - serializable?_0 - (wrap-cdr - e_0) - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - (if (if (eq? - '|#%app/value| - hd_0) - (let ((a_0 - (cdr + a_1))) + (if (pair? + p_1) + (let ((a_2 + (cdr + p_1))) + (let ((p_2 (unwrap - e_0)))) - (wrap-list? - a_0)) - #f) - (compile-apply_0 - serializable?_0 - (wrap-cdr - e_0) + 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_0 + (unwrap + 'quote))) + (eq? + app_0 + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_5))))) + #f))) + #f) + #f))) + (let ((a_3 + (cdr + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + e_0)))) + (let ((p_0 + (unwrap + d_0))) + (let ((dest-id_0 + (let ((a_0 + (car + p_0))) + a_0))) + (call-with-values + (lambda () + (let ((d_1 + (cdr + p_0))) + (let ((p_1 + (unwrap + d_1))) + (let ((e_1 + (let ((a_0 + (car + p_1))) + a_0))) + (let ((constance_0 + (let ((d_2 + (cdr + p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + (let ((d_3 + (cdr + (unwrap + a_0)))) + (let ((a_1 + (car + (unwrap + d_3)))) + a_1)))))) + (let ((e_2 + e_1)) + (values + e_2 + constance_0))))))) + (case-lambda + ((e_1 + constance_0) + (let ((dest-id_1 + dest-id_0)) + (values + dest-id_1 + e_1 + constance_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((dest-id_0 + e_1 + constance_0) + (let ((dest-var_0 + (hash-ref + env_0 + (unwrap + dest-id_0)))) + (let ((new-expr_0 + (compile-expr_0 + e_1 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0))) + (vector + 'set-variable! + (stack->pos.1 + #f + dest-var_0 + stk-i_0) + new-expr_0 + constance_0 + #t)))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? + 'variable-ref + hd_0) + (let ((a_0 + (cdr + (unwrap + e_0)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + (let ((id_0 + (let ((d_0 + (cdr + (unwrap + e_0)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (let ((var_0 + (hash-ref + env_0 + (unwrap + id_0)))) + (vector + 'ref-variable/checked + (stack->pos.1 + #f + var_0 + stk-i_0)))) + (if (if (eq? + 'variable-ref/no-check + hd_0) + (let ((a_0 + (cdr + (unwrap + e_0)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + (let ((id_0 + (let ((d_0 + (cdr + (unwrap + e_0)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + (let ((var_0 + (hash-ref env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - (if (if (eq? - '|#%app/no-return| - hd_0) + (unwrap + id_0)))) + (vector + 'ref-variable + (stack->pos.1 + #f + var_0 + stk-i_0)))) + (if (if (eq? + '|#%app| + hd_0) + (let ((a_0 + (cdr + (unwrap + e_0)))) + (wrap-list? + a_0)) + #f) + (compile-apply_0 + (wrap-cdr e_0) + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0) + (if (if (eq? + '|#%app/value| + hd_0) + (let ((a_0 + (cdr + (unwrap + e_0)))) + (wrap-list? + a_0)) + #f) + (compile-apply_0 + (wrap-cdr + e_0) + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0) + (if (if (eq? + '|#%app/no-return| + hd_0) + (let ((a_0 + (cdr + (unwrap + e_0)))) + (wrap-list? + a_0)) + #f) + (compile-apply_0 + (wrap-cdr + e_0) + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0) + (if (let ((p_0 + (unwrap + e_0))) + (if (pair? + p_0) + (let ((a_0 + (cdr + p_0))) + (wrap-list? + a_0)) + #f)) + (let ((rator_0 (let ((a_0 - (cdr + (car (unwrap e_0)))) - (wrap-list? - a_0)) - #f) - (compile-apply_0 - serializable?_0 - (wrap-cdr - e_0) - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - (if (let ((p_0 - (unwrap - e_0))) - (if (pair? - p_0) - (let ((a_0 - (cdr - p_0))) - (wrap-list? - a_0)) - #f)) - (let ((rator_0 - (let ((a_0 - (car - (unwrap - e_0)))) - a_0))) - (compile-apply_0 - serializable?_0 - e_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0)) - (let ((u_0 - (unwrap - e_0))) - (let ((var_0 - (hash-ref - env_0 - u_0 - #f))) - (if (not - var_0) - (if (number? - u_0) - (vector - 'quote - u_0) - (let ((c1_0 - (if (symbol? - u_0) - (if (not - serializable?_0) - (hash-ref - primitives - u_0 - #f) - #f) - #f))) - (if c1_0 - (if (procedure? - c1_0) - c1_0 - (vector - 'quote - c1_0)) - u_0))) - (if (indirect? - var_0) - (let ((pos_0 - (let ((temp36_0 - (indirect-pos - var_0))) - (stack->pos.1 - #f - temp36_0 - stk-i_0)))) - (let ((elem_0 - (indirect-element - var_0))) - (cons - pos_0 - elem_0))) - (if (boxed? - var_0) - (let ((pos_0 - (let ((temp38_0 - (boxed-pos - var_0))) - (stack->pos.1 - #f - temp38_0 - stk-i_0)))) - (if (boxed/check? - var_0) - (vector - 'unbox/checked - pos_0 + a_0))) + (compile-apply_0 + e_0 + env_0 + stack-depth_0 + stk-i_0 + tail?_0 + mutated_0)) + (let ((u_0 + (unwrap + e_0))) + (let ((var_0 + (hash-ref + env_0 + u_0 + #f))) + (if (not + var_0) + (if (number? + u_0) + (vector + 'quote + u_0) + (let ((c1_0 + (if (symbol? u_0) - (vector - 'unbox - pos_0))) - (stack->pos.1 - #f - var_0 - stk-i_0))))))))))))))))))))))))))))))))))))))) - (compile-letrec_0 - (|#%name| - compile-letrec - (lambda (serializable?_0 - e_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - (begin - (if (let ((p_0 (unwrap e_0))) - (if (pair? p_0) - (let ((a_0 (cdr p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_2 - (unwrap - v_1))) - (if (pair? - p_2) - (let ((a_2 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_2))) - (if (pair? - p_3) - (let ((a_3 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f)) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () + (if (not + serializable?_0) + (hash-ref + primitives + u_0 + #f) + #f) + #f))) + (if c1_0 + (if (procedure? + c1_0) + c1_0 + (vector + 'quote + c1_0)) + u_0))) + (if (indirect? + var_0) + (let ((pos_0 + (let ((temp36_0 + (indirect-pos + var_0))) + (stack->pos.1 + #f + temp36_0 + stk-i_0)))) + (let ((elem_0 + (indirect-element + var_0))) + (cons + pos_0 + elem_0))) + (if (boxed? + var_0) + (let ((pos_0 + (let ((temp38_0 + (boxed-pos + var_0))) + (stack->pos.1 + #f + temp38_0 + stk-i_0)))) + (if (boxed/check? + var_0) + (vector + 'unbox/checked + pos_0 + u_0) + (vector + 'unbox + pos_0))) + (stack->pos.1 + #f + var_0 + stk-i_0))))))))))))))))))))))))))))))))))))))) + (compile-letrec_0 + (|#%name| + compile-letrec + (lambda (e_0 env_0 stack-depth_0 stk-i_0 tail?_0 mutated_0) + (begin + (if (let ((p_0 (unwrap e_0))) + (if (pair? p_0) + (let ((a_0 (cdr p_0))) + (let ((p_1 (unwrap a_0))) + (if (pair? p_1) + (if (let ((a_1 (car p_1))) + (if (wrap-list? a_1) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (ids_0 rhss_0 lst_0) + (lambda (result_0 lst_0) (begin (if (not (begin-unsafe @@ -54168,201 +43272,546 @@ (wrap-cdr lst_0) null))) (let ((v_1 v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((ids_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car + (let ((result_1 + (let ((result_1 + (let ((p_2 + (unwrap + v_1))) + (if (pair? + p_2) + (let ((a_2 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_2))) + (if (pair? + p_3) + (let ((a_3 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) - (case-lambda - ((ids42_0 rhss43_0) + a_3))))) + #f))) + #f)))) (values - (cons - ids42_0 - ids_0) - (cons - rhss43_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 rhss_1) - (values - ids_1 - rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 rhss_1) - (for-loop_0 - ids_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values ids_0 rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((ids_0 rhss_0) - (let ((app_0 (reverse$1 ids_0))) - (values app_0 (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((ids_0 rhss_0) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0) (rhss_1 rhss_0)) - (values ids_1 rhss_1 body_0)))) - (args - (raise-binding-result-arity-error 2 args))))))) - (case-lambda - ((ids_0 rhss_0 body_0) - (let ((count_0 (length ids_0))) - (let ((rhs-env_0 - (make-env_0 - count_0 - env_0 - ids_0 - stack-depth_0 - boxed/check3.1))) - (let ((body-env_0 - (make-env_0 - count_0 - env_0 - ids_0 - stack-depth_0 - boxed2.1))) - (let ((body-stack-depth_0 - (+ stack-depth_0 count_0))) - (let ((c-body_0 - (compile-body_0 - serializable?_0 - body_0 - body-env_0 - body-stack-depth_0 - stk-i_0 - tail?_0 - mutated_0))) - (let ((new-rhss_0 - (list->vector - (compile-list_0 - serializable?_0 - rhss_0 - rhs-env_0 - body-stack-depth_0 - stk-i_0 - #f - mutated_0)))) - (let ((new-body_0 - (add-boxes/remove-unused_0 - c-body_0 - ids_0 - hash2610 - body-env_0 - stk-i_0))) - (let ((pos_0 - (stack->pos.1 - #t - stack-depth_0 - stk-i_0))) - (begin - (stack-info-forget! - stk-i_0 - stack-depth_0 - pos_0 - count_0) - (vector - 'letrec - pos_0 - new-rhss_0 - new-body_0))))))))))) - (args (raise-binding-result-arity-error 3 args)))) - (error 'match "failed ~e" e_0)))))) - (compile-linklet-body_0 - (|#%name| - compile-linklet-body - (lambda (serializable?_0 v_0 env_0 stack-depth_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap v_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) - #f) + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f)) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) (call-with-values (lambda () - (let ((d_0 (cdr (unwrap v_0)))) - (let ((p_0 (unwrap d_0))) - (let ((args_0 (let ((a_0 (car p_0))) a_0))) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((args_1 args_0)) - (values args_1 body_0))))))) + (let ((a_0 (car p_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ids_0 rhss_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_1 + (unwrap v_1))) + (let ((ids_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) + (case-lambda + ((ids42_0 rhss43_0) + (values + (cons ids42_0 ids_0) + (cons + rhss43_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 rhss_1) + (values ids_1 rhss_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ids_1 rhss_1) + (for-loop_0 + ids_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values ids_0 rhss_0))))))) + (for-loop_0 null null a_0)))) + (case-lambda + ((ids_0 rhss_0) + (let ((app_0 (reverse$1 ids_0))) + (values app_0 (reverse$1 rhss_0)))) + (args + (raise-binding-result-arity-error 2 args)))))) (case-lambda - ((args_0 body_0) - (let ((mutated_0 - (extract-list-mutated_0 body_0 hash2610))) - (let ((num-args_0 (length args_0))) - (let ((args-env_0 + ((ids_0 rhss_0) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((ids_1 ids_0) (rhss_1 rhss_0)) + (values ids_1 rhss_1 body_0)))) + (args (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((ids_0 rhss_0 body_0) + (let ((count_0 (length ids_0))) + (let ((make-env_0 + (|#%name| + make-env + (lambda (boxed_0) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (env_1 lst_0 pos_0) + (begin + (if (if (pair? lst_0) #t #f) + (let ((id_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((env_2 + (let ((env_2 + (let ((app_0 + (unwrap + id_0))) + (hash-set + env_1 + app_0 + (|#%app| + boxed_0 + (+ + (- + count_0 + pos_0 + 1) + stack-depth_0)))))) + (values env_2)))) + (for-loop_0 + env_2 + rest_0 + (+ pos_0 1))))) + env_1)))))) + (for-loop_0 env_0 ids_0 0)))))))) + (let ((rhs-env_0 (make-env_0 boxed/check3.1))) + (let ((body-env_0 (make-env_0 boxed2.1))) + (let ((body-stack-depth_0 (+ stack-depth_0 count_0))) + (let ((c-body_0 + (compile-body_0 + body_0 + body-env_0 + body-stack-depth_0 + stk-i_0 + tail?_0 + mutated_0))) + (let ((new-rhss_0 + (list->vector + (compile-list_0 + rhss_0 + rhs-env_0 + body-stack-depth_0 + stk-i_0 + #f + mutated_0)))) + (let ((new-body_0 + (add-boxes/remove-unused_0 + c-body_0 + ids_0 + hash2610 + body-env_0 + stk-i_0))) + (let ((pos_0 + (stack->pos.1 + #t + stack-depth_0 + stk-i_0))) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (env_1 lst_0 pos_0) - (begin - (if (if (pair? lst_0) #t #f) - (let ((arg_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((env_2 - (let ((env_2 - (hash-set - env_1 - arg_0 - (+ - stack-depth_0 - pos_0)))) - (values env_2)))) - (for-loop_0 - env_2 - rest_0 - (+ pos_0 1))))) - env_1)))))) - (for-loop_0 env_0 args_0 0))))) - (let ((body-vars-index_0 - (+ num-args_0 stack-depth_0))) + (stack-info-forget! + stk-i_0 + stack-depth_0 + pos_0 + count_0) + (vector + 'letrec + pos_0 + new-rhss_0 + new-body_0)))))))))))) + (args (raise-binding-result-arity-error 3 args)))) + (error 'match "failed ~e" e_0)))))) + (compile-apply_0 + (|#%name| + compile-apply + (lambda (es_0 env_0 stack-depth_0 stk-i_0 tail?_0 mutated_0) + (begin + (begin + (if tail?_0 + (void) + (begin-unsafe + (set-stack-info-non-tail-call-later?! stk-i_0 #t))) + (let ((new-es_0 + (compile-list_0 + es_0 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0))) + (list->vector (cons 'app new-es_0)))))))) + (compile-assignment_0 + (|#%name| + compile-assignment + (lambda (id_0 rhs_0 env_0 stack-depth_0 stk-i_0 mutated_0) + (begin + (let ((compiled-rhs_0 + (compile-expr_0 + rhs_0 + env_0 + stack-depth_0 + stk-i_0 + #f + mutated_0))) + (let ((u_0 (unwrap id_0))) + (let ((var_0 (hash-ref env_0 u_0))) + (if (indirect? var_0) + (let ((s_0 + (let ((temp47_0 (indirect-pos var_0))) + (stack->pos.1 #f temp47_0 stk-i_0)))) + (let ((e_0 (indirect-element var_0))) + (vector 'set!-indirect s_0 e_0 compiled-rhs_0))) + (if (boxed? var_0) + (let ((s_0 + (let ((temp49_0 (boxed-pos var_0))) + (stack->pos.1 #f temp49_0 stk-i_0)))) + (if (boxed/check? var_0) + (vector 'set!-boxed/checked s_0 compiled-rhs_0 u_0) + (vector 'set!-boxed s_0 compiled-rhs_0 u_0))) + (error + 'compile + "unexpected set! ~s -> ~v" + u_0 + var_0)))))))))) + (extract-expr-mutated_0 + (|#%name| + extract-expr-mutated + (lambda (e_0 mutated_0) + (begin + (let ((hd_0 + (let ((p_0 (unwrap e_0))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((ids_0 (let ((a_0 (car p_0))) a_0))) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((ids_1 ids_0)) (values ids_1 body_0))))))) + (case-lambda + ((ids_0 body_0) (extract-list-mutated_0 body_0 mutated_0)) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'case-lambda hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (if (wrap-list? a_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_0 + (unwrap v_1))) + (if (pair? p_0) + #t + #f)))) + (values result_1)))) + (if (if (not + (let ((x_0 (list v_1))) + (not result_1))) + #t + #f) + (for-loop_0 result_1 rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_0))) + #f)) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idss_0 bodys_0 lst_0) + (begin + (if (not + (begin-unsafe (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((p_0 (unwrap v_1))) + (let ((idss_1 + (let ((a_0 + (car + p_0))) + a_0))) + (let ((bodys_1 + (let ((d_1 + (cdr + p_0))) + d_1))) + (let ((idss_2 + idss_1)) + (values + idss_2 + bodys_1)))))) + (case-lambda + ((idss51_0 bodys52_0) + (values + (cons idss51_0 idss_0) + (cons + bodys52_0 + bodys_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((idss_1 bodys_1) + (values idss_1 bodys_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((idss_1 bodys_1) + (for-loop_0 + idss_1 + bodys_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values idss_0 bodys_0))))))) + (for-loop_0 null null d_0)))) + (case-lambda + ((idss_0 bodys_0) + (let ((app_0 (reverse$1 idss_0))) + (values app_0 (reverse$1 bodys_0)))) + (args (raise-binding-result-arity-error 2 args)))))) + (case-lambda + ((idss_0 bodys_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (mutated_1 lst_0) + (begin + (if (pair? lst_0) + (let ((body_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((mutated_2 + (let ((mutated_2 + (extract-list-mutated_0 + body_0 + mutated_1))) + (values mutated_2)))) + (for-loop_0 mutated_2 rest_0)))) + mutated_1)))))) + (for-loop_0 mutated_0 bodys_0)))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'let hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) (call-with-values (lambda () (begin @@ -54370,12 +43819,12 @@ ((for-loop_0 (|#%name| for-loop - (lambda (env_1 num-body-vars_0 lst_0) + (lambda (ids_0 rhss_0 lst_0) (begin (if (not (begin-unsafe (null? (unwrap lst_0)))) - (let ((e_0 + (let ((v_0 (if (begin-unsafe (pair? (unwrap lst_0))) @@ -54387,401 +43836,103 @@ (unwrap lst_0))) (wrap-cdr lst_0) null))) - (let ((e_1 e_0)) + (let ((v_1 v_0)) (call-with-values (lambda () (call-with-values (lambda () - (loop_1 - body-vars-index_0 - e_1 - env_1 - num-body-vars_0)) + (call-with-values + (lambda () + (let ((p_1 + (unwrap + v_1))) + (let ((ids_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) + (case-lambda + ((ids53_0 + rhss54_0) + (values + (cons + ids53_0 + ids_0) + (cons + rhss54_0 + rhss_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) (case-lambda - ((env_2 - num-body-vars_1) + ((ids_1 rhss_1) (values - env_2 - num-body-vars_1)) + ids_1 + rhss_1)) (args (raise-binding-result-arity-error 2 args))))) (case-lambda - ((env_2 num-body-vars_1) + ((ids_1 rhss_1) (for-loop_0 - env_2 - num-body-vars_1 + ids_1 + rhss_1 rest_0)) (args (raise-binding-result-arity-error 2 args))))))) - (values - env_1 - num-body-vars_0))))))) - (for-loop_0 args-env_0 0 body_0)))) + (values ids_0 rhss_0))))))) + (for-loop_0 null null a_0)))) (case-lambda - ((body-env_0 num-body-vars_0) - (let ((body-stack-depth_0 - (+ - num-body-vars_0 - num-args_0 - stack-depth_0))) - (let ((stk-i_0 - (make-stack-info.1 - #f - hash2610 - #t))) - (let ((new-body_0 - (compile-top-body_0 - serializable?_0 - body_0 - body-env_0 - body-stack-depth_0 - stk-i_0 - mutated_0))) - (values - new-body_0 - num-body-vars_0))))) + ((ids_0 rhss_0) + (let ((app_0 (reverse$1 ids_0))) + (values app_0 (reverse$1 rhss_0)))) (args (raise-binding-result-arity-error 2 - args))))))))) - (args (raise-binding-result-arity-error 2 args)))) - (error 'match "failed ~e" v_0))))))) - (compile-list_0 - (|#%name| - compile-list - (lambda (serializable?_0 - body_0 - env_0 - stack-depth_0 - stk-i_0 - tail?_0 - mutated_0) - (begin - (loop_2 - env_0 - mutated_0 - serializable?_0 - stack-depth_0 - stk-i_0 - tail?_0 - body_0))))) - (compile-top-body_0 - (|#%name| - compile-top-body - (lambda (serializable?_0 - body_0 - env_0 - stack-depth_0 - stk-i_0 - mutated_0) - (begin - (let ((bs_0 - (loop_0 - env_0 - mutated_0 - serializable?_0 - stack-depth_0 - stk-i_0 - body_0))) - (if (null? bs_0) - '#(void) - (if (if (pair? bs_0) (null? (cdr bs_0)) #f) - (car bs_0) - (list->vector (cons 'begin bs_0))))))))) - (env-set_0 - (|#%name| - env-set - (lambda (env_0 u_0 pos_0 mutated_0) - (begin - (hash-set - env_0 - u_0 - (if (hash-ref mutated_0 u_0 #f) (boxed2.1 pos_0) pos_0)))))) - (extract-expr-mutated_0 - (|#%name| - extract-expr-mutated - (lambda (e_0 mutated_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap e_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((ids_0 (let ((a_0 (car p_0))) a_0))) + args)))))) + (case-lambda + ((ids_0 rhss_0) (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0)) - (values ids_1 body_0))))))) - (case-lambda - ((ids_0 body_0) - (extract-list-mutated_0 body_0 mutated_0)) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_1))) - (if (pair? - p_0) - #t - #f)))) - (values result_1)))) - (if (if (not - (let ((x_0 - (list v_1))) - (not result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_0))) - #f)) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idss_0 bodys_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_1 v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_0 - (unwrap v_1))) - (let ((idss_1 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((bodys_1 - (let ((d_1 - (cdr - p_0))) - d_1))) - (let ((idss_2 - idss_1)) - (values - idss_2 - bodys_1)))))) - (case-lambda - ((idss51_0 bodys52_0) - (values - (cons - idss51_0 - idss_0) - (cons - bodys52_0 - bodys_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 bodys_1) - (values idss_1 bodys_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((idss_1 bodys_1) - (for-loop_0 - idss_1 - bodys_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values idss_0 bodys_0))))))) - (for-loop_0 null null d_0)))) - (case-lambda - ((idss_0 bodys_0) - (let ((app_0 (reverse$1 idss_0))) - (values app_0 (reverse$1 bodys_0)))) - (args - (raise-binding-result-arity-error 2 args)))))) - (case-lambda - ((idss_0 bodys_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (mutated_1 lst_0) - (begin - (if (pair? lst_0) - (let ((body_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((mutated_2 - (let ((mutated_2 - (extract-list-mutated_0 - body_0 - mutated_1))) - (values mutated_2)))) - (for-loop_0 mutated_2 rest_0)))) - mutated_1)))))) - (for-loop_0 mutated_0 bodys_0)))) - (args (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'let hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () + (let ((ids_1 ids_0) (rhss_1 rhss_0)) + (values ids_1 rhss_1 body_0)))) + (args + (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((ids_0 rhss_0 body_0) + (extract-list-mutated_0 + body_0 + (extract-list-mutated_0 rhss_0 mutated_0))) + (args (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'letrec hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (ids_0 rhss_0 lst_0) + (lambda (result_0 lst_0) (begin (if (not (begin-unsafe @@ -54802,190 +43953,184 @@ (wrap-cdr lst_0) null))) (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ids_0 rhss_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (call-with-values + (lambda () (call-with-values (lambda () (call-with-values (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((ids_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) - (case-lambda - ((ids53_0 - rhss54_0) - (values - (cons - ids53_0 - ids_0) - (cons - rhss54_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) + (let ((p_1 + (unwrap + v_1))) + (let ((ids_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) (case-lambda - ((ids_1 rhss_1) + ((ids55_0 + rhss56_0) (values - ids_1 - rhss_1)) + (cons + ids55_0 + ids_0) + (cons + rhss56_0 + rhss_0))) (args (raise-binding-result-arity-error 2 args))))) (case-lambda ((ids_1 rhss_1) - (for-loop_0 + (values ids_1 - rhss_1 - rest_0)) + rhss_1)) (args (raise-binding-result-arity-error 2 - args))))))) - (values ids_0 rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((ids_0 rhss_0) - (let ((app_0 (reverse$1 ids_0))) - (values app_0 (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((ids_0 rhss_0) - (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0) (rhss_1 rhss_0)) - (values ids_1 rhss_1 body_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((ids_0 rhss_0 body_0) - (extract-list-mutated_0 - body_0 - (extract-list-mutated_0 rhss_0 mutated_0))) - (args (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'letrec hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () + args))))) + (case-lambda + ((ids_1 rhss_1) + (for-loop_0 + ids_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values ids_0 rhss_0))))))) + (for-loop_0 null null a_0)))) + (case-lambda + ((ids_0 rhss_0) + (let ((app_0 (reverse$1 ids_0))) + (values app_0 (reverse$1 rhss_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (case-lambda + ((ids_0 rhss_0) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((ids_1 ids_0) (rhss_1 rhss_0)) + (values ids_1 rhss_1 body_0)))) + (args + (raise-binding-result-arity-error 2 args))))))) + (case-lambda + ((ids_0 rhss_0 body_0) + (extract-list-mutated_0 + body_0 + (extract-list-mutated_0 rhss_0 mutated_0))) + (args (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'letrec* hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) (begin (letrec* ((for-loop_0 (|#%name| for-loop - (lambda (ids_0 rhss_0 lst_0) + (lambda (result_0 lst_0) (begin (if (not (begin-unsafe @@ -55007,1481 +44152,1091 @@ lst_0) null))) (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (call-with-values + (lambda () + (let ((a_0 (car p_0))) + (call-with-values + (lambda () + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (ids_0 rhss_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (call-with-values + (lambda () (call-with-values (lambda () (call-with-values (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((ids_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) - (case-lambda - ((ids55_0 - rhss56_0) - (values - (cons - ids55_0 - ids_0) - (cons - rhss56_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) + (let ((p_1 + (unwrap + v_1))) + (let ((ids_1 + (let ((a_1 + (car + p_1))) + a_1))) + (let ((rhss_1 + (let ((d_1 + (cdr + p_1))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (let ((ids_2 + ids_1)) + (values + ids_2 + rhss_1)))))) (case-lambda - ((ids_1 - rhss_1) + ((ids57_0 + rhss58_0) (values - ids_1 - rhss_1)) + (cons + ids57_0 + ids_0) + (cons + rhss58_0 + rhss_0))) (args (raise-binding-result-arity-error 2 args))))) (case-lambda ((ids_1 rhss_1) - (for-loop_0 + (values ids_1 - rhss_1 - rest_0)) + rhss_1)) (args (raise-binding-result-arity-error 2 - args))))))) - (values - ids_0 - rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((ids_0 rhss_0) - (let ((app_0 (reverse$1 ids_0))) - (values app_0 (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (case-lambda - ((ids_0 rhss_0) - (let ((body_0 - (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0) (rhss_1 rhss_0)) - (values ids_1 rhss_1 body_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (case-lambda - ((ids_0 rhss_0 body_0) - (extract-list-mutated_0 - body_0 - (extract-list-mutated_0 rhss_0 mutated_0))) - (args (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'letrec* hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_0 #t a_1))) - #f)) - #t - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (call-with-values - (lambda () - (let ((a_0 (car p_0))) - (call-with-values - (lambda () - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (ids_0 rhss_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (call-with-values - (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((p_1 - (unwrap - v_1))) - (let ((ids_1 - (let ((a_1 - (car - p_1))) - a_1))) - (let ((rhss_1 - (let ((d_1 - (cdr - p_1))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (let ((ids_2 - ids_1)) - (values - ids_2 - rhss_1)))))) - (case-lambda - ((ids57_0 - rhss58_0) - (values - (cons - ids57_0 - ids_0) - (cons - rhss58_0 - rhss_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 - rhss_1) - (values - ids_1 - rhss_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ids_1 rhss_1) - (for-loop_0 - ids_1 - rhss_1 - rest_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (values - ids_0 - rhss_0))))))) - (for-loop_0 null null a_0)))) - (case-lambda - ((ids_0 rhss_0) - (let ((app_0 (reverse$1 ids_0))) - (values - app_0 - (reverse$1 rhss_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))) + args))))) + (case-lambda + ((ids_1 rhss_1) + (for-loop_0 + ids_1 + rhss_1 + rest_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (values ids_0 rhss_0))))))) + (for-loop_0 null null a_0)))) (case-lambda ((ids_0 rhss_0) - (let ((body_0 - (let ((d_1 (cdr p_0))) d_1))) - (let ((ids_1 ids_0) (rhss_1 rhss_0)) - (values ids_1 rhss_1 body_0)))) + (let ((app_0 (reverse$1 ids_0))) + (values app_0 (reverse$1 rhss_0)))) (args (raise-binding-result-arity-error 2 - args))))))) - (case-lambda - ((ids_0 rhss_0 body_0) - (extract-list-mutated_0 - body_0 - (extract-list-mutated_0 rhss_0 mutated_0))) - (args - (raise-binding-result-arity-error 3 args)))) - (if (if (eq? 'begin hd_0) #t #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap e_0)))) d_0))) - (extract-list-mutated_0 vs_0 mutated_0)) - (if (if (eq? 'begin0 hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_1))))) - #f))) - #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((a_0 (car (unwrap d_0)))) - a_0)))) - (extract-list-mutated_0 vs_0 mutated_0)) - (if (if (eq? 'begin-unsafe hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_1))))) - #f))) - #f) - (let ((vs_0 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((a_0 (car (unwrap d_0)))) - a_0)))) - (extract-list-mutated_0 vs_0 mutated_0)) - (if (if (eq? '$value hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_1))))) - #f))) - #f) - (let ((e_1 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((a_0 (car (unwrap d_0)))) - a_0)))) - (extract-expr-mutated_0 e_1 mutated_0)) - (if (if (eq? 'if hd_0) - (let ((a_0 (cdr (unwrap e_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((tst_0 - (let ((a_0 (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((thn_0 - (let ((a_0 - (car - p_1))) - a_0))) - (let ((els_0 - (let ((d_2 - (cdr - p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - a_0)))) - (let ((thn_1 thn_0)) - (values - thn_1 - els_0))))))) - (case-lambda - ((thn_0 els_0) - (let ((tst_1 tst_0)) - (values - tst_1 - thn_0 - els_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((tst_0 thn_0 els_0) - (let ((tst-mutated_0 - (extract-expr-mutated_0 - tst_0 - mutated_0))) - (let ((thn-mutated_0 - (extract-expr-mutated_0 - thn_0 - tst-mutated_0))) - (extract-expr-mutated_0 - els_0 - thn-mutated_0)))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'with-continuation-mark* - hd_0) - (let ((a_0 (cdr (unwrap e_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 + args)))))) + (case-lambda + ((ids_0 rhss_0) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((ids_1 ids_0) (rhss_1 rhss_0)) + (values ids_1 rhss_1 body_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (case-lambda + ((ids_0 rhss_0 body_0) + (extract-list-mutated_0 + body_0 + (extract-list-mutated_0 rhss_0 mutated_0))) + (args (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'begin hd_0) #t #f) + (let ((vs_0 (let ((d_0 (cdr (unwrap e_0)))) d_0))) + (extract-list-mutated_0 vs_0 mutated_0)) + (if (if (eq? 'begin0 hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) + #f))) + #f) + (let ((vs_0 + (let ((d_0 (cdr (unwrap e_0)))) + (let ((a_0 (car (unwrap d_0)))) a_0)))) + (extract-list-mutated_0 vs_0 mutated_0)) + (if (if (eq? 'begin-unsafe hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) + #f))) + #f) + (let ((vs_0 + (let ((d_0 (cdr (unwrap e_0)))) + (let ((a_0 (car (unwrap d_0)))) a_0)))) + (extract-list-mutated_0 vs_0 mutated_0)) + (if (if (eq? '$value hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) + #f))) + #f) + (let ((e_1 + (let ((d_0 (cdr (unwrap e_0)))) + (let ((a_0 (car (unwrap d_0)))) + a_0)))) + (extract-expr-mutated_0 e_1 mutated_0)) + (if (if (eq? 'if hd_0) + (let ((a_0 (cdr (unwrap e_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_0 (unwrap - a_2))) - (if (pair? p_2) - (let ((a_3 - (cdr - p_2))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? - p_3) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((mode_0 - (let ((a_0 (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 - (unwrap d_1))) - (let ((key_0 - (let ((a_0 - (car - p_1))) - a_0))) - (call-with-values - (lambda () - (let ((d_2 - (cdr - p_1))) - (let ((p_2 - (unwrap - d_2))) - (let ((val_0 - (let ((a_0 - (car - p_2))) - a_0))) - (let ((body_0 - (let ((d_3 - (cdr - p_2))) - (let ((a_0 - (car - (unwrap - d_3)))) - a_0)))) - (let ((val_1 - val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 body_0) - (let ((key_1 - key_0)) - (values - key_1 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((key_0 val_0 body_0) - (let ((mode_1 mode_0)) - (values - mode_1 - key_0 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))))) - (case-lambda - ((mode_0 key_0 val_0 body_0) - (let ((key-mutated_0 - (extract-expr-mutated_0 - key_0 - mutated_0))) - (let ((val-mutated_0 - (extract-expr-mutated_0 - val_0 - key-mutated_0))) - (extract-expr-mutated_0 - body_0 - val-mutated_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (if (if (eq? 'quote hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_1))))) - #f))) - #f) - (let ((v_0 - (let ((d_0 - (cdr (unwrap e_0)))) - (let ((a_0 - (car (unwrap d_0)))) - a_0)))) - mutated_0) - (if (if (eq? 'set! hd_0) - (let ((a_0 - (cdr (unwrap e_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 - (let ((a_0 - (car p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((id_1 id_0)) - (values - id_1 - rhs_0))))))) - (case-lambda - ((id_0 rhs_0) - (let ((new-mutated_0 - (hash-set - mutated_0 - (unwrap id_0) - #t))) - (extract-expr-mutated_0 - rhs_0 - new-mutated_0))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? 'define hd_0) - (let ((a_0 - (cdr (unwrap e_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 - (let ((a_0 - (car p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((id_1 id_0)) - (values - id_1 - rhs_0))))))) - (case-lambda - ((id_0 rhs_0) - (extract-expr-mutated_0 - rhs_0 - mutated_0)) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'define-values - hd_0) - (let ((a_0 - (cdr - (unwrap e_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((ids_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((ids_1 - ids_0)) - (values - ids_1 - rhs_0))))))) - (case-lambda - ((ids_0 rhs_0) - (extract-expr-mutated_0 - rhs_0 - mutated_0)) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'variable-set! - hd_0) - (let ((a_0 - (cdr - (unwrap e_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap e_0)))) - (let ((p_0 - (unwrap d_0))) - (let ((dest-id_0 - (let ((a_0 - (car - p_0))) - a_0))) - (let ((e_1 - (let ((d_1 - (cdr - p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((dest-id_1 - dest-id_0)) - (values - dest-id_1 - e_1))))))) - (case-lambda - ((dest-id_0 e_1) - (extract-expr-mutated_0 - e_1 - mutated_0)) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - 'variable-set!/define - hd_0) - (let ((a_0 - (cdr - (unwrap - e_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_0 - (unwrap - 'quote))) - (eq? - app_0 - (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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_5))))) - #f))) - #f) - #f))) - (let ((a_3 - (cdr - p_2))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 - (cdr - (unwrap e_0)))) - (let ((p_0 - (unwrap d_0))) - (let ((dest-id_0 - (let ((a_0 - (car - p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_1 - (cdr - p_0))) - (let ((p_1 - (unwrap - d_1))) - (let ((e_1 - (let ((a_0 - (car - p_1))) - a_0))) - (let ((constance_0 - (let ((d_2 - (cdr - p_1))) - (let ((a_0 - (car - (unwrap - d_2)))) - (let ((d_3 - (cdr - (unwrap - a_0)))) - (let ((a_1 - (car - (unwrap - d_3)))) - a_1)))))) - (let ((e_2 - e_1)) - (values - e_2 - constance_0))))))) - (case-lambda - ((e_1 - constance_0) - (let ((dest-id_1 - dest-id_0)) - (values - dest-id_1 - e_1 - constance_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((dest-id_0 - e_1 - constance_0) - (extract-expr-mutated_0 - e_1 - mutated_0)) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? - 'variable-ref - hd_0) - (let ((a_0 - (cdr - (unwrap - e_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? p_0) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - (let ((id_0 - (let ((d_0 - (cdr - (unwrap - e_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_0)))) - mutated_0) - (if (if (eq? - 'variable-ref/no-check - hd_0) - (let ((a_0 - (cdr - (unwrap - e_0)))) - (let ((p_0 - (unwrap - a_0))) - (if (pair? - p_0) - (let ((a_1 - (cdr - p_0))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_1))))) - #f))) - #f) - (let ((id_0 - (let ((d_0 - (cdr - (unwrap - e_0)))) - (let ((a_0 - (car - (unwrap - d_0)))) - a_0)))) - mutated_0) - (if (if (eq? - '|#%app| - hd_0) - (let ((a_0 - (cdr - (unwrap - e_0)))) - (wrap-list? - a_0)) - #f) - (let ((es_0 - (let ((d_0 - (cdr - (unwrap - e_0)))) - (unwrap-list - d_0)))) - (extract-list-mutated_0 - es_0 - mutated_0)) - (if (if (eq? - '|#%app/value| - hd_0) - (let ((a_0 - (cdr - (unwrap - e_0)))) - (wrap-list? - a_0)) - #f) - (let ((es_0 - (let ((d_0 - (cdr - (unwrap - e_0)))) - (unwrap-list - d_0)))) - (extract-list-mutated_0 - es_0 - mutated_0)) - (if (if (eq? - '|#%app/no-return| - hd_0) - (let ((a_0 - (cdr - (unwrap - e_0)))) - (wrap-list? - a_0)) - #f) - (let ((es_0 - (let ((d_0 - (cdr - (unwrap - e_0)))) - (unwrap-list - d_0)))) - (extract-list-mutated_0 - es_0 - mutated_0)) - (if (wrap-list? - e_0) - (let ((es_0 - (unwrap-list - e_0))) - (extract-list-mutated_0 - es_0 - mutated_0)) - mutated_0)))))))))))))))))))))))))))) - (extract-list-mutated_0 - (|#%name| - extract-list-mutated - (lambda (body_0 mutated_0) - (begin - (letrec* - ((loop_4 - (|#%name| - loop - (lambda (body_1 mutated_1) - (begin - (if (null? body_1) - mutated_1 - (let ((app_0 (wrap-cdr body_1))) - (loop_4 - app_0 - (extract-expr-mutated_0 - (wrap-car body_1) - mutated_1))))))))) - (loop_4 body_0 mutated_0)))))) - (extract-procedure-wrap-data_0 - (|#%name| - extract-procedure-wrap-data - (lambda (e_0) - (begin - (let ((encoded-name_0 (wrap-property e_0 'inferred-name))) - (let ((name_0 - (if (eq? encoded-name_0 '|[|) - #f - (if (symbol? encoded-name_0) - (let ((s_0 - (symbol->immutable-string - encoded-name_0))) - (if (fx= 0 (string-length s_0)) - encoded-name_0 - (let ((ch_0 (string-ref s_0 0))) - (if (let ((or-part_0 (char=? '#\x5b ch_0))) - (if or-part_0 - or-part_0 - (char=? '#\x5d ch_0))) - (string->symbol - (substring s_0 1 (string-length s_0))) - encoded-name_0)))) - encoded-name_0)))) - (if (wrap-property e_0 'method-arity-error) - (box name_0) - name_0))))))) - (loop_0 - (|#%name| - loop - (lambda (env_0 - mutated_0 - serializable?_0 - stack-depth_0 - stk-i_0 - body_0) - (begin - (if (begin-unsafe - (let ((app_0 (unwrap '()))) (eq? app_0 (unwrap body_0)))) - '() - (if (let ((p_0 (unwrap body_0))) - (if (pair? p_0) - (if (let ((a_0 (car p_0))) - (let ((p_1 (unwrap a_0))) - (if (pair? p_1) - (if (let ((a_1 (car p_1))) - (begin-unsafe - (let ((app_0 (unwrap 'begin))) - (eq? app_0 (unwrap a_1))))) - (let ((a_1 (cdr p_1))) (wrap-list? a_1)) - #f) - #f))) - #t - #f) - #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap body_0))) - (let ((subs_0 - (let ((a_0 (car p_0))) - (let ((d_0 (cdr (unwrap a_0)))) - (unwrap-list d_0))))) - (let ((rest_0 (let ((d_0 (cdr p_0))) d_0))) - (let ((subs_1 subs_0)) - (values subs_1 rest_0)))))) - (case-lambda - ((subs_0 rest_0) - (loop_0 - env_0 - mutated_0 - serializable?_0 - stack-depth_0 - stk-i_0 - (append subs_0 rest_0))) - (args (raise-binding-result-arity-error 2 args)))) - (if (let ((p_0 (unwrap body_0))) (if (pair? p_0) #t #f)) - (call-with-values - (lambda () - (let ((p_0 (unwrap body_0))) - (let ((e_0 (let ((a_0 (car p_0))) a_0))) - (let ((rest_0 (let ((d_0 (cdr p_0))) d_0))) - (let ((e_1 e_0)) (values e_1 rest_0)))))) - (case-lambda - ((e_0 rest_0) - (let ((new-rest_0 - (loop_0 - env_0 - mutated_0 - serializable?_0 - stack-depth_0 - stk-i_0 - rest_0))) - (cons - (compile-expr_0 - serializable?_0 - e_0 - env_0 - stack-depth_0 - stk-i_0 - #t - mutated_0) - new-rest_0))) - (args (raise-binding-result-arity-error 2 args)))) - (error 'match "failed ~e" body_0)))))))) - (loop_1 - (|#%name| - loop - (lambda (body-vars-index_0 e_0 env_0 num-body-vars_0) - (begin - (let ((hd_0 - (let ((p_0 (unwrap e_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'define hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) - #f) - (let ((id_0 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((a_0 (car (unwrap d_0)))) a_0)))) - (let ((app_0 - (let ((app_0 (unwrap id_0))) - (hash-set - env_0 - app_0 - (boxed2.1 - (+ body-vars-index_0 num-body-vars_0)))))) - (values app_0 (add1 num-body-vars_0)))) - (if (if (eq? 'define-values hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) - #f) - (let ((ids_0 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((a_0 (car (unwrap d_0)))) a_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (env_1 num-body-vars_1 lst_0) - (begin - (if (not - (begin-unsafe (null? (unwrap lst_0)))) - (let ((id_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((id_1 id_0)) + '()))) + (eq? + app_0 + (unwrap a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((tst_0 + (let ((a_0 (car p_0))) a_0))) (call-with-values (lambda () - (call-with-values - (lambda () - (let ((app_0 - (let ((app_0 - (unwrap id_1))) - (hash-set - env_1 - app_0 - (boxed2.1 - (+ - body-vars-index_0 - num-body-vars_1)))))) - (values - app_0 - (add1 num-body-vars_1)))) - (case-lambda - ((env_2 num-body-vars_2) - (values - env_2 - num-body-vars_2)) - (args - (raise-binding-result-arity-error - 2 - args))))) + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((thn_0 + (let ((a_0 (car p_1))) + a_0))) + (let ((els_0 + (let ((d_2 + (cdr p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + a_0)))) + (let ((thn_1 thn_0)) + (values + thn_1 + els_0))))))) (case-lambda - ((env_2 num-body-vars_2) - (for-loop_0 - env_2 - num-body-vars_2 - rest_0)) + ((thn_0 els_0) + (let ((tst_1 tst_0)) + (values tst_1 thn_0 els_0))) (args (raise-binding-result-arity-error 2 - args))))))) - (values env_1 num-body-vars_1))))))) - (for-loop_0 env_0 num-body-vars_0 ids_0)))) - (if (if (eq? 'begin hd_0) #t #f) - (let ((body_0 (let ((d_0 (cdr (unwrap e_0)))) d_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (env_1 num-body-vars_1 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((e_1 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((e_2 e_1)) + args)))))))) + (case-lambda + ((tst_0 thn_0 els_0) + (let ((tst-mutated_0 + (extract-expr-mutated_0 + tst_0 + mutated_0))) + (let ((thn-mutated_0 + (extract-expr-mutated_0 + thn_0 + tst-mutated_0))) + (extract-expr-mutated_0 + els_0 + thn-mutated_0)))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? 'with-continuation-mark* hd_0) + (let ((a_0 (cdr (unwrap e_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))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? p_3) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((mode_0 + (let ((a_0 (car p_0))) a_0))) (call-with-values (lambda () - (call-with-values - (lambda () - (loop_1 - body-vars-index_0 - e_2 - env_1 - num-body-vars_1)) - (case-lambda - ((env_2 num-body-vars_2) - (values - env_2 - num-body-vars_2)) - (args - (raise-binding-result-arity-error - 2 - args))))) + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((key_0 + (let ((a_0 + (car p_1))) + a_0))) + (call-with-values + (lambda () + (let ((d_2 (cdr p_1))) + (let ((p_2 + (unwrap + d_2))) + (let ((val_0 + (let ((a_0 + (car + p_2))) + a_0))) + (let ((body_0 + (let ((d_3 + (cdr + p_2))) + (let ((a_0 + (car + (unwrap + d_3)))) + a_0)))) + (let ((val_1 + val_0)) + (values + val_1 + body_0))))))) + (case-lambda + ((val_0 body_0) + (let ((key_1 key_0)) + (values + key_1 + val_0 + body_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) (case-lambda - ((env_2 num-body-vars_2) - (for-loop_0 - env_2 - num-body-vars_2 - rest_0)) + ((key_0 val_0 body_0) + (let ((mode_1 mode_0)) + (values + mode_1 + key_0 + val_0 + body_0))) (args (raise-binding-result-arity-error - 2 - args))))))) - (values env_1 num-body-vars_1))))))) - (for-loop_0 env_0 num-body-vars_0 body_0)))) - (values env_0 num-body-vars_0))))))))) - (loop_2 - (|#%name| - loop - (lambda (env_0 - mutated_0 - serializable?_0 - stack-depth_0 - stk-i_0 - tail?_0 - body_0) - (begin - (if (null? body_0) - '() - (let ((rest-body_0 (wrap-cdr body_0))) - (let ((new-rest_0 - (loop_2 - env_0 - mutated_0 - serializable?_0 - stack-depth_0 - stk-i_0 - tail?_0 - rest-body_0))) - (cons - (let ((app_0 (wrap-car body_0))) - (compile-expr_0 - serializable?_0 - app_0 - env_0 - stack-depth_0 - stk-i_0 - (if tail?_0 (null? rest-body_0) #f) - mutated_0)) - new-rest_0)))))))) - (loop_3 - (|#%name| - loop - (lambda (e_0 len_0 i_0) - (begin - (if (= i_0 len_0) - (begins->list_0 (unsafe-vector*-ref e_0 i_0)) - (let ((app_0 (unsafe-vector*-ref e_0 i_0))) - (cons app_0 (loop_3 e_0 len_0 (add1 i_0))))))))) - (make-env_0 - (|#%name| - make-env - (lambda (count_0 env_0 ids_0 stack-depth_0 boxed_0) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (env_1 lst_0 pos_0) - (begin - (if (if (pair? lst_0) #t #f) - (let ((id_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((env_2 - (let ((env_2 - (let ((app_0 (unwrap id_0))) - (hash-set - env_1 - app_0 - (|#%app| - boxed_0 - (+ - (- count_0 pos_0 1) - stack-depth_0)))))) - (values env_2)))) - (for-loop_0 env_2 rest_0 (+ pos_0 1))))) - env_1)))))) - (for-loop_0 env_0 ids_0 0))))))) - (start_0 - (|#%name| - start - (lambda (serializable?_0 linklet-e_0) - (begin - (call-with-values - (lambda () - (compile-linklet-body_0 - serializable?_0 - linklet-e_0 - hash2610 - 0)) - (case-lambda - ((compiled-body_0 num-body-vars_0) - (vector num-body-vars_0 compiled-body_0)) - (args (raise-binding-result-arity-error 2 args))))))))) - (lambda (linklet-e_0 serializable?_0) - (with-continuation-mark* - authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - gensym-counter - (box 0)) - (start_0 serializable?_0 linklet-e_0))))) + 3 + args)))))))) + (case-lambda + ((mode_0 key_0 val_0 body_0) + (let ((key-mutated_0 + (extract-expr-mutated_0 + key_0 + mutated_0))) + (let ((val-mutated_0 + (extract-expr-mutated_0 + val_0 + key-mutated_0))) + (extract-expr-mutated_0 + body_0 + val-mutated_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (if (if (eq? 'quote hd_0) + (let ((a_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? + app_0 + (unwrap a_1))))) + #f))) + #f) + (let ((v_0 + (let ((d_0 (cdr (unwrap e_0)))) + (let ((a_0 (car (unwrap d_0)))) + a_0)))) + mutated_0) + (if (if (eq? 'set! hd_0) + (let ((a_0 (cdr (unwrap e_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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((id_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_1 id_0)) + (values id_1 rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (let ((new-mutated_0 + (hash-set + mutated_0 + (unwrap id_0) + #t))) + (extract-expr-mutated_0 + rhs_0 + new-mutated_0))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? 'define hd_0) + (let ((a_0 (cdr (unwrap e_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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((id_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_1 id_0)) + (values + id_1 + rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (extract-expr-mutated_0 + rhs_0 + mutated_0)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? 'define-values hd_0) + (let ((a_0 (cdr (unwrap e_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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((ids_0 + (let ((a_0 + (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 + (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((ids_1 ids_0)) + (values + ids_1 + rhs_0))))))) + (case-lambda + ((ids_0 rhs_0) + (extract-expr-mutated_0 + rhs_0 + mutated_0)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? 'variable-set! hd_0) + (let ((a_0 + (cdr (unwrap e_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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((dest-id_0 + (let ((a_0 + (car p_0))) + a_0))) + (let ((e_1 + (let ((d_1 + (cdr + p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((dest-id_1 + dest-id_0)) + (values + dest-id_1 + e_1))))))) + (case-lambda + ((dest-id_0 e_1) + (extract-expr-mutated_0 + e_1 + mutated_0)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + 'variable-set!/define + hd_0) + (let ((a_0 + (cdr (unwrap e_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_0 + (unwrap + 'quote))) + (eq? + app_0 + (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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_5))))) + #f))) + #f) + #f))) + (let ((a_3 + (cdr + p_2))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr (unwrap e_0)))) + (let ((p_0 (unwrap d_0))) + (let ((dest-id_0 + (let ((a_0 + (car + p_0))) + a_0))) + (call-with-values + (lambda () + (let ((d_1 + (cdr p_0))) + (let ((p_1 + (unwrap + d_1))) + (let ((e_1 + (let ((a_0 + (car + p_1))) + a_0))) + (let ((constance_0 + (let ((d_2 + (cdr + p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + (let ((d_3 + (cdr + (unwrap + a_0)))) + (let ((a_1 + (car + (unwrap + d_3)))) + a_1)))))) + (let ((e_2 + e_1)) + (values + e_2 + constance_0))))))) + (case-lambda + ((e_1 constance_0) + (let ((dest-id_1 + dest-id_0)) + (values + dest-id_1 + e_1 + constance_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((dest-id_0 e_1 constance_0) + (extract-expr-mutated_0 + e_1 + mutated_0)) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (if (eq? + 'variable-ref + hd_0) + (let ((a_0 + (cdr + (unwrap e_0)))) + (let ((p_0 + (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 + (cdr p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + (let ((id_0 + (let ((d_0 + (cdr + (unwrap + e_0)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + mutated_0) + (if (if (eq? + 'variable-ref/no-check + hd_0) + (let ((a_0 + (cdr + (unwrap e_0)))) + (let ((p_0 + (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 + (cdr + p_0))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_1))))) + #f))) + #f) + (let ((id_0 + (let ((d_0 + (cdr + (unwrap + e_0)))) + (let ((a_0 + (car + (unwrap + d_0)))) + a_0)))) + mutated_0) + (if (if (eq? '|#%app| hd_0) + (let ((a_0 + (cdr + (unwrap + e_0)))) + (wrap-list? a_0)) + #f) + (let ((es_0 + (let ((d_0 + (cdr + (unwrap + e_0)))) + (unwrap-list + d_0)))) + (extract-list-mutated_0 + es_0 + mutated_0)) + (if (if (eq? + '|#%app/value| + hd_0) + (let ((a_0 + (cdr + (unwrap + e_0)))) + (wrap-list? a_0)) + #f) + (let ((es_0 + (let ((d_0 + (cdr + (unwrap + e_0)))) + (unwrap-list + d_0)))) + (extract-list-mutated_0 + es_0 + mutated_0)) + (if (if (eq? + '|#%app/no-return| + hd_0) + (let ((a_0 + (cdr + (unwrap + e_0)))) + (wrap-list? + a_0)) + #f) + (let ((es_0 + (let ((d_0 + (cdr + (unwrap + e_0)))) + (unwrap-list + d_0)))) + (extract-list-mutated_0 + es_0 + mutated_0)) + (if (wrap-list? e_0) + (let ((es_0 + (unwrap-list + e_0))) + (extract-list-mutated_0 + es_0 + mutated_0)) + mutated_0)))))))))))))))))))))))))))) + (extract-list-mutated_0 + (|#%name| + extract-list-mutated + (lambda (body_0 mutated_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (body_1 mutated_1) + (begin + (if (null? body_1) + mutated_1 + (let ((app_0 (wrap-cdr body_1))) + (loop_0 + app_0 + (extract-expr-mutated_0 + (wrap-car body_1) + mutated_1))))))))) + (loop_0 body_0 mutated_0)))))) + (args->env_0 + (|#%name| + args->env + (lambda (ids_0 env_0 stack-depth_0 mutated_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ids_1 env_1 count_0) + (begin + (if (begin-unsafe (null? (unwrap ids_1))) + (values env_1 count_0 #f) + (if (begin-unsafe (pair? (unwrap ids_1))) + (let ((app_0 (wrap-cdr ids_1))) + (let ((app_1 + (let ((app_1 (unwrap (wrap-car ids_1)))) + (env-set_0 + env_1 + app_1 + (+ stack-depth_0 count_0) + mutated_0)))) + (loop_0 app_0 app_1 (add1 count_0)))) + (let ((app_0 + (let ((app_0 (unwrap ids_1))) + (env-set_0 + env_1 + app_0 + (+ stack-depth_0 count_0) + mutated_0)))) + (values app_0 (add1 count_0) #t))))))))) + (loop_0 ids_0 env_0 0)))))) + (env-set_0 + (|#%name| + env-set + (lambda (env_0 u_0 pos_0 mutated_0) + (begin + (hash-set + env_0 + u_0 + (if (hash-ref mutated_0 u_0 #f) (boxed2.1 pos_0) pos_0)))))) + (add-clears_0 + (|#%name| + add-clears + (lambda (e_0 stk-i_0 all-clear_0) + (begin + (if (begin-unsafe (stack-info-non-tail-call-later? stk-i_0)) + (let ((local-use-map_0 (stack-info-local-use-map stk-i_0))) + (let ((clears_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 i_0) + (begin + (if i_0 + (let ((pos_0 + (hash-iterate-key all-clear_0 i_0))) + (let ((fold-var_1 + (if (hash-ref + local-use-map_0 + pos_0 + #f) + fold-var_0 + (let ((fold-var_1 + (cons pos_0 fold-var_0))) + (values fold-var_1))))) + (for-loop_0 + fold-var_1 + (hash-iterate-next all-clear_0 i_0)))) + fold-var_0)))))) + (for-loop_0 + null + (hash-iterate-first all-clear_0))))))) + (if (null? clears_0) + e_0 + (vector 'clear (sort.1 #f #f clears_0 <) e_0)))) + e_0))))) + (add-boxes/remove-unused_0 + (|#%name| + add-boxes/remove-unused + (lambda (e_0 ids_0 mutated_0 env_0 stk-i_0) + (begin + (if (null? ids_0) + e_0 + (if (pair? ids_0) + (let ((app_0 + (add-boxes/remove-unused_0 + e_0 + (car ids_0) + mutated_0 + env_0 + stk-i_0))) + (add-boxes/remove-unused_0 + app_0 + (cdr ids_0) + mutated_0 + env_0 + stk-i_0)) + (let ((u_0 (unwrap ids_0))) + (let ((var_0 (hash-ref env_0 u_0 #f))) + (let ((pos_0 + (let ((temp61_0 + (if (boxed? var_0) (boxed-pos var_0) var_0))) + (stack->pos.1 #f temp61_0 stk-i_0)))) + (if (box? pos_0) + (if (if (vector? e_0) + (eq? 'clear (vector-ref e_0 0)) + #f) + (let ((app_0 + (let ((app_0 (unbox pos_0))) + (cons app_0 (vector-ref e_0 1))))) + (vector 'clear app_0 (vector-ref e_0 2))) + (vector 'clear (list (unbox pos_0)) e_0)) + (if (not (hash-ref mutated_0 u_0 #f)) + e_0 + (vector 'enbox pos_0 e_0)))))))))))) + (extract-procedure-wrap-data_0 + (|#%name| + extract-procedure-wrap-data + (lambda (e_0) + (begin + (let ((encoded-name_0 (wrap-property e_0 'inferred-name))) + (let ((name_0 + (if (eq? encoded-name_0 '|[|) + #f + (if (symbol? encoded-name_0) + (let ((s_0 (symbol->immutable-string encoded-name_0))) + (if (fx= 0 (string-length s_0)) + encoded-name_0 + (let ((ch_0 (string-ref s_0 0))) + (if (let ((or-part_0 (char=? '#\x5b ch_0))) + (if or-part_0 + or-part_0 + (char=? '#\x5d ch_0))) + (string->symbol + (substring s_0 1 (string-length s_0))) + encoded-name_0)))) + encoded-name_0)))) + (if (wrap-property e_0 'method-arity-error) + (box name_0) + name_0))))))) + (begins->list_0 + (|#%name| + begins->list + (lambda (e_0) + (begin + (if (vector? e_0) + (if (if (eq? 'beginl (unsafe-vector*-ref e_0 0)) #t #f) + (let ((es_0 (unsafe-vector*-ref e_0 1))) es_0) + (if (eq? 'begin (unsafe-vector*-ref e_0 0)) + (let ((len_0 (sub1 (unsafe-vector*-length e_0)))) + (if (< len_0 4) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0) + (begin + (if (= i_0 len_0) + (begins->list_0 (unsafe-vector*-ref e_0 i_0)) + (let ((app_0 (unsafe-vector*-ref e_0 i_0))) + (cons app_0 (loop_0 (add1 i_0)))))))))) + (loop_0 1)) + (list e_0))) + (list e_0))) + (list e_0))))))) + (with-continuation-mark* + authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first #f parameterization-key) + gensym-counter + (box 0)) + (start_0 linklet-e_0))))) (define interpret-linklet (lambda (b_0) (let ((num-body-vars_0 (unsafe-vector*-ref b_0 0))) @@ -56532,119 +45287,119 @@ (for-loop_0 args-stack_0 0))))) (interpret-expr b_1 stack_0)))))))))) (define interpret-expr - (letrec ((apply-function_0 - (|#%name| - apply-function - (lambda (b_0 captured_0 args_0) - (begin - (if (if (eq? 'lambda (unsafe-vector*-ref b_0 0)) #t #f) - (let ((mask_0 (unsafe-vector*-ref b_0 1))) - (let ((name_0 (unsafe-vector*-ref b_0 2))) - (let ((close-vec_0 (unsafe-vector*-ref b_0 3))) - (let ((b_1 (unsafe-vector*-ref b_0 4))) - (let ((close-vec_1 close-vec_0) - (name_1 name_0) - (mask_1 mask_0)) - (interpret_0 - b_1 - (push-stack captured_0 0 args_0 mask_1) - #f)))))) - (error 'interp-match "no matching clause")))))) - (capture-closure_0 - (|#%name| - capture-closure - (lambda (close-vec_0 stack_0) - (begin - (let ((len_0 (unsafe-vector*-length close-vec_0))) - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (i_0 stack_1 captured_0) - (begin - (if (= i_0 len_0) - (values stack_1 captured_0) - (call-with-values - (lambda () - (stack-ref - stack_1 - (unsafe-vector*-ref close-vec_0 i_0))) - (case-lambda - ((val-stack_0 val_0) - (let ((app_0 (add1 i_0))) - (loop_3 - app_0 - val-stack_0 - (stack-set captured_0 (- -1 i_0) val_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))) - (loop_3 0 stack_0 #f))))))) - (interpret_0 - (|#%name| - interpret - (case-lambda - ((b_0 stack_0) (begin (interpret_1 b_0 stack_0 'values))) - ((b_0 stack_0 return-mode63_0) - (interpret_1 b_0 stack_0 return-mode63_0))))) - (interpret_1 - (|#%name| - interpret - (lambda (b64_0 stack65_0 return-mode63_0) - (begin - (if (integer? b64_0) - (stack-ref stack65_0 b64_0 (not return-mode63_0)) - (if (box? b64_0) - (stack-ref stack65_0 b64_0 (not return-mode63_0)) - (if (pair? b64_0) - (call-with-values - (lambda () (stack-ref stack65_0 (car b64_0))) - (case-lambda - ((new-stack_0 vec_0) - (let ((val_0 (unsafe-vector*-ref vec_0 (cdr b64_0)))) - (if return-mode63_0 - (values new-stack_0 val_0) - val_0))) - (args (raise-binding-result-arity-error 2 args)))) - (if (symbol? b64_0) - (let ((val_0 (hash-ref primitives b64_0))) - (if return-mode63_0 (values stack65_0 val_0) val_0)) - (if (vector? b64_0) - (if (if (eq? 'app (unsafe-vector*-ref b64_0 0)) - #t - #f) - (let ((rator-b_0 (unsafe-vector*-ref b64_0 1))) - (let ((len_0 (unsafe-vector*-length b64_0))) - (call-with-values - (lambda () (interpret_0 rator-b_0 stack65_0)) - (case-lambda - ((rand-stack_0 rator_0) - (if (eq? len_0 2) + (lambda (b_0 stack_0) + (letrec* + ((interpret_0 + (|#%name| + interpret + (lambda (b64_0 stack65_0 return-mode63_0) + (begin + (if (integer? b64_0) + (stack-ref stack65_0 b64_0 (not return-mode63_0)) + (if (box? b64_0) + (stack-ref stack65_0 b64_0 (not return-mode63_0)) + (if (pair? b64_0) + (call-with-values + (lambda () (stack-ref stack65_0 (car b64_0))) + (case-lambda + ((new-stack_0 vec_0) + (let ((val_0 (unsafe-vector*-ref vec_0 (cdr b64_0)))) + (if return-mode63_0 (values new-stack_0 val_0) val_0))) + (args (raise-binding-result-arity-error 2 args)))) + (if (symbol? b64_0) + (let ((val_0 (hash-ref primitives b64_0))) + (if return-mode63_0 (values stack65_0 val_0) val_0)) + (if (vector? b64_0) + (if (if (eq? 'app (unsafe-vector*-ref b64_0 0)) #t #f) + (let ((rator-b_0 (unsafe-vector*-ref b64_0 1))) + (let ((len_0 (unsafe-vector*-length b64_0))) + (call-with-values + (lambda () (interpret_1 rator-b_0 stack65_0)) + (case-lambda + ((rand-stack_0 rator_0) + (if (eq? len_0 2) + (if return-mode63_0 + (if (eq? return-mode63_0 'values) + (call-with-values + (lambda () (|#%app| rator_0)) + (case-lambda + ((v_0) (values rand-stack_0 v_0)) + (vs_0 + (apply values rand-stack_0 vs_0)))) + (values + 'trampoline + (lambda () + (call-with-values + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0) + (begin + (if (not i_0) + (|#%app| rator_0) + (call-with-values + (lambda () + (hash-iterate-key+value + return-mode63_0 + i_0)) + (case-lambda + ((k_0 v_0) + (with-continuation-mark* + general + k_0 + v_0 + (loop_0 + (hash-iterate-next + return-mode63_0 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))))))) + (loop_0 + (hash-iterate-first + return-mode63_0)))) + (case-lambda + ((v_0) (values rand-stack_0 v_0)) + (vs_0 + (apply + values + rand-stack_0 + vs_0))))))) + (|#%app| rator_0)) + (if (eq? len_0 3) + (call-with-values + (lambda () + (interpret_1 + (unsafe-vector*-ref b64_0 2) + rand-stack_0)) + (case-lambda + ((stack_1 rand_0) (if return-mode63_0 (if (eq? return-mode63_0 'values) (call-with-values - (lambda () (|#%app| rator_0)) + (lambda () (|#%app| rator_0 rand_0)) (case-lambda - ((v_0) (values rand-stack_0 v_0)) + ((v_0) (values stack_1 v_0)) (vs_0 - (apply - values - rand-stack_0 - vs_0)))) + (apply values stack_1 vs_0)))) (values 'trampoline (lambda () (call-with-values (lambda () (letrec* - ((loop_3 + ((loop_0 (|#%name| loop (lambda (i_0) (begin (if (not i_0) - (|#%app| rator_0) + (|#%app| + rator_0 + rand_0) (call-with-values (lambda () (hash-iterate-key+value @@ -56656,7 +45411,7 @@ general k_0 v_0 - (loop_3 + (loop_0 (hash-iterate-next return-mode63_0 i_0)))) @@ -56664,37 +45419,50 @@ (raise-binding-result-arity-error 2 args)))))))))) - (loop_3 + (loop_0 (hash-iterate-first return-mode63_0)))) (case-lambda - ((v_0) - (values rand-stack_0 v_0)) + ((v_0) (values stack_1 v_0)) (vs_0 (apply values - rand-stack_0 + stack_1 vs_0))))))) - (|#%app| rator_0)) - (if (eq? len_0 3) + (|#%app| rator_0 rand_0))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (eq? len_0 4) + (call-with-values + (lambda () + (interpret_1 + (unsafe-vector*-ref b64_0 2) + rand-stack_0)) + (case-lambda + ((stack1_0 rand1_0) (call-with-values (lambda () - (interpret_0 - (unsafe-vector*-ref b64_0 2) - rand-stack_0)) + (interpret_1 + (unsafe-vector*-ref b64_0 3) + stack1_0)) (case-lambda - ((stack_0 rand_0) + ((stack2_0 rand2_0) (if return-mode63_0 (if (eq? return-mode63_0 'values) (call-with-values (lambda () - (|#%app| rator_0 rand_0)) + (|#%app| + rator_0 + rand1_0 + rand2_0)) (case-lambda - ((v_0) (values stack_0 v_0)) + ((v_0) (values stack2_0 v_0)) (vs_0 (apply values - stack_0 + stack2_0 vs_0)))) (values 'trampoline @@ -56702,7 +45470,7 @@ (call-with-values (lambda () (letrec* - ((loop_3 + ((loop_0 (|#%name| loop (lambda (i_0) @@ -56710,7 +45478,8 @@ (if (not i_0) (|#%app| rator_0 - rand_0) + rand1_0 + rand2_0) (call-with-values (lambda () (hash-iterate-key+value @@ -56722,7 +45491,7 @@ general k_0 v_0 - (loop_3 + (loop_0 (hash-iterate-next return-mode63_0 i_0)))) @@ -56730,1596 +45499,1268 @@ (raise-binding-result-arity-error 2 args)))))))))) - (loop_3 + (loop_0 (hash-iterate-first return-mode63_0)))) (case-lambda ((v_0) - (values stack_0 v_0)) + (values stack2_0 v_0)) (vs_0 (apply values - stack_0 + stack2_0 vs_0))))))) - (|#%app| rator_0 rand_0))) + (|#%app| + rator_0 + rand1_0 + rand2_0))) (args (raise-binding-result-arity-error 2 - args)))) - (if (eq? len_0 4) - (call-with-values - (lambda () - (interpret_0 - (unsafe-vector*-ref b64_0 2) - rand-stack_0)) - (case-lambda - ((stack1_0 rand1_0) - (call-with-values - (lambda () - (interpret_0 - (unsafe-vector*-ref b64_0 3) - stack1_0)) - (case-lambda - ((stack2_0 rand2_0) - (if return-mode63_0 - (if (eq? - return-mode63_0 - 'values) - (call-with-values - (lambda () - (|#%app| - rator_0 - rand1_0 - rand2_0)) - (case-lambda - ((v_0) - (values stack2_0 v_0)) - (vs_0 - (apply - values - stack2_0 - vs_0)))) - (values - 'trampoline - (lambda () - (call-with-values - (lambda () - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (i_0) - (begin - (if (not i_0) - (|#%app| - rator_0 - rand1_0 - rand2_0) - (call-with-values - (lambda () - (hash-iterate-key+value - return-mode63_0 - i_0)) - (case-lambda - ((k_0 - v_0) - (with-continuation-mark* - general - k_0 - v_0 - (loop_3 - (hash-iterate-next - return-mode63_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))) - (loop_3 - (hash-iterate-first - return-mode63_0)))) - (case-lambda - ((v_0) - (values - stack2_0 - v_0)) - (vs_0 - (apply - values - stack2_0 - vs_0))))))) - (|#%app| - rator_0 - rand1_0 - rand2_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - b64_0 - 2 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (stack_0 - rev-rands_0 - idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((b_0 - (unsafe-vector-ref - v*_0 - idx_0))) + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + b64_0 + 2 + #f + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (stack_1 + rev-rands_0 + idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((b_1 + (unsafe-vector-ref + v*_0 + idx_0))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (call-with-values + (lambda () + (interpret_1 + b_1 + stack_1)) + (case-lambda + ((new-stack_0 + v_0) + (values + new-stack_0 + (cons + v_0 + rev-rands_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((stack_2 + rev-rands_1) + (values + stack_2 + rev-rands_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((stack_2 + rev-rands_1) + (for-loop_0 + stack_2 + rev-rands_1 + (unsafe-fx+ + idx_0 + 1))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (values + stack_1 + rev-rands_0))))))) + (for-loop_0 + rand-stack_0 + null + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args))))) + (case-lambda + ((stack_1 rev-rands_0) + (let ((rands_0 + (reverse$1 rev-rands_0))) + (if return-mode63_0 + (if (eq? return-mode63_0 'values) + (call-with-values + (lambda () + (apply rator_0 rands_0)) + (case-lambda + ((v_0) (values stack_1 v_0)) + (vs_0 + (apply values stack_1 vs_0)))) + (values + 'trampoline + (lambda () + (call-with-values + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0) + (begin + (if (not i_0) + (apply + rator_0 + rands_0) (call-with-values (lambda () - (call-with-values - (lambda () - (call-with-values - (lambda () - (interpret_0 - b_0 - stack_0)) - (case-lambda - ((new-stack_0 - v_0) - (values - new-stack_0 - (cons - v_0 - rev-rands_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((stack_1 - rev-rands_1) - (values - stack_1 - rev-rands_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) + (hash-iterate-key+value + return-mode63_0 + i_0)) (case-lambda - ((stack_1 - rev-rands_1) - (for-loop_0 - stack_1 - rev-rands_1 - (unsafe-fx+ - idx_0 - 1))) + ((k_0 v_0) + (with-continuation-mark* + general + k_0 + v_0 + (loop_0 + (hash-iterate-next + return-mode63_0 + i_0)))) (args (raise-binding-result-arity-error 2 - args))))) - (values - stack_0 - rev-rands_0))))))) - (for-loop_0 - rand-stack_0 - null - start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args))))) - (case-lambda - ((stack_0 rev-rands_0) - (let ((rands_0 - (reverse$1 rev-rands_0))) - (if return-mode63_0 - (if (eq? - return-mode63_0 - 'values) - (call-with-values - (lambda () - (apply rator_0 rands_0)) - (case-lambda - ((v_0) - (values stack_0 v_0)) - (vs_0 - (apply - values - stack_0 - vs_0)))) - (values - 'trampoline - (lambda () + args)))))))))) + (loop_0 + (hash-iterate-first + return-mode63_0)))) + (case-lambda + ((v_0) (values stack_1 v_0)) + (vs_0 + (apply + values + stack_1 + vs_0))))))) + (apply rator_0 rands_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (args + (raise-binding-result-arity-error 2 args)))))) + (if (if (eq? 'quote (unsafe-vector*-ref b64_0 0)) + #t + #f) + (let ((v_0 (unsafe-vector*-ref b64_0 1))) + (if return-mode63_0 (values stack65_0 v_0) v_0)) + (if (if (eq? 'unbox (unsafe-vector*-ref b64_0 0)) + #t + #f) + (let ((s_0 (unsafe-vector*-ref b64_0 1))) + (call-with-values + (lambda () (stack-ref stack65_0 s_0)) + (case-lambda + ((new-stack_0 bx_0) + (let ((val_0 (unsafe-unbox* bx_0))) + (if return-mode63_0 + (values new-stack_0 val_0) + val_0))) + (args + (raise-binding-result-arity-error 2 args))))) + (if (if (eq? + 'unbox/checked + (unsafe-vector*-ref b64_0 0)) + #t + #f) + (let ((s_0 (unsafe-vector*-ref b64_0 1))) + (let ((name_0 (unsafe-vector*-ref b64_0 2))) + (let ((s_1 s_0)) + (call-with-values + (lambda () (stack-ref stack65_0 s_1)) + (case-lambda + ((new-stack_0 bx_0) + (let ((v_0 (unsafe-unbox* bx_0))) + (let ((val_0 + (check-not-unsafe-undefined + v_0 + name_0))) + (if return-mode63_0 + (values new-stack_0 val_0) + val_0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (if (if (eq? + 'ref-variable + (unsafe-vector*-ref b64_0 0)) + #t + #f) + (let ((s_0 (unsafe-vector*-ref b64_0 1))) + (call-with-values + (lambda () (stack-ref stack65_0 s_0)) + (case-lambda + ((new-stack_0 var_0) + (let ((val_0 + (|#%app| + 1/variable-ref/no-check + var_0))) + (if return-mode63_0 + (values new-stack_0 val_0) + val_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (if (if (eq? + 'ref-variable/checked + (unsafe-vector*-ref b64_0 0)) + #t + #f) + (let ((s_0 (unsafe-vector*-ref b64_0 1))) + (call-with-values + (lambda () (stack-ref stack65_0 s_0)) + (case-lambda + ((new-stack_0 var_0) + (let ((val_0 + (|#%app| 1/variable-ref var_0))) + (if return-mode63_0 + (values new-stack_0 val_0) + val_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (if (if (eq? + 'let + (unsafe-vector*-ref b64_0 0)) + #t + #f) + (let ((pos_0 (unsafe-vector*-ref b64_0 1))) + (let ((rhss_0 + (unsafe-vector*-ref b64_0 2))) + (let ((b_1 + (unsafe-vector*-ref b64_0 3))) + (let ((rhss_1 rhss_0) (pos_1 pos_0)) + (let ((len_0 + (unsafe-vector*-length + rhss_1))) + (let ((body-stack_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 stack_1) + (begin + (if (fx= + i_0 + len_0) + stack_1 + (call-with-values + (lambda () + (interpret_1 + (unsafe-vector*-ref + rhss_1 + i_0) + stack_1)) + (case-lambda + ((new-stack_0 + val_0) + (let ((app_0 + (loop_0 + (fx+ + i_0 + 1) + new-stack_0))) + (stack-set + app_0 + (fx+ + i_0 + pos_1) + val_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))))) + (loop_0 0 stack65_0)))) + (interpret_1 + b_1 + body-stack_0 + return-mode63_0))))))) + (if (if (eq? + 'let* + (unsafe-vector*-ref b64_0 0)) + #t + #f) + (let ((poss_0 + (unsafe-vector*-ref b64_0 1))) + (let ((rhsss_0 + (unsafe-vector*-ref b64_0 2))) + (let ((b_1 + (unsafe-vector*-ref b64_0 3))) + (let ((rhsss_1 rhsss_0) + (poss_1 poss_0)) + (let ((body-stack_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (stack_1 + lst_0 + lst_1) + (begin + (if (if (pair? + lst_0) + (pair? + lst_1) + #f) + (let ((pos_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((rhss_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((len_0 + (unsafe-vector*-length + rhss_0))) + (let ((stack_2 + (let ((stack_2 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 + stack_2) + (begin + (if (fx= + i_0 + len_0) + stack_2 + (call-with-values + (lambda () + (interpret_1 + (unsafe-vector*-ref + rhss_0 + i_0) + stack_2)) + (case-lambda + ((new-stack_0 + val_0) + (let ((app_0 + (fx+ + i_0 + 1))) + (loop_0 + app_0 + (stack-set + new-stack_0 + (fx+ + i_0 + pos_0) + val_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))))))))) + (loop_0 + 0 + stack_1)))) + (values + stack_2)))) + (for-loop_0 + stack_2 + rest_0 + rest_1))))))) + stack_1)))))) + (for-loop_0 + stack65_0 + poss_1 + rhsss_1))))) + (interpret_1 + b_1 + body-stack_0 + return-mode63_0)))))) + (if (if (eq? + 'letrec + (unsafe-vector*-ref b64_0 0)) + #t + #f) + (let ((pos_0 + (unsafe-vector*-ref b64_0 1))) + (let ((rhss_0 + (unsafe-vector*-ref b64_0 2))) + (let ((b_1 + (unsafe-vector*-ref + b64_0 + 3))) + (let ((rhss_1 rhss_0) + (pos_1 pos_0)) + (let ((len_0 + (unsafe-vector*-length + rhss_1))) + (call-with-values + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (stack_1 i_0) + (begin + (if (= i_0 len_0) + (values + stack_1 + null) + (let ((bx_0 + (box + unsafe-undefined))) + (call-with-values + (lambda () + (let ((app_0 + (stack-set + stack_1 + (fx+ + (fx- + len_0 + i_0 + 1) + pos_1) + bx_0))) + (loop_0 + app_0 + (add1 + i_0)))) + (case-lambda + ((new-stack_0 + boxes_0) + (values + new-stack_0 + (cons + bx_0 + boxes_0))) + (args + (raise-binding-result-arity-error + 2 + args))))))))))) + (loop_0 stack65_0 0))) + (case-lambda + ((body-stack_0 boxes_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 + stack_1 + boxes_1) + (begin + (if (fx= + i_0 + len_0) + (interpret_1 + b_1 + stack_1 + return-mode63_0) + (call-with-values + (lambda () + (interpret_1 + (unsafe-vector*-ref + rhss_1 + i_0) + stack_1)) + (case-lambda + ((new-stack_0 + val_0) + (begin + (set-box! + (car + boxes_1) + val_0) + (let ((app_0 + (fx+ + i_0 + 1))) + (loop_0 + app_0 + new-stack_0 + (cdr + boxes_1))))) + (args + (raise-binding-result-arity-error + 2 + args)))))))))) + (loop_0 + 0 + body-stack_0 + boxes_0))) + (args + (raise-binding-result-arity-error + 2 + args))))))))) + (if (eq? + 'begin + (unsafe-vector*-ref b64_0 0)) + (let ((last_0 + (fx- + (unsafe-vector*-length b64_0) + 1))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 stack_1) + (begin + (if (fx= i_0 last_0) + (interpret_1 + (unsafe-vector*-ref + b64_0 + i_0) + stack_1 + return-mode63_0) (call-with-values (lambda () - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (i_0) - (begin - (if (not i_0) - (apply - rator_0 - rands_0) - (call-with-values - (lambda () - (hash-iterate-key+value - return-mode63_0 - i_0)) - (case-lambda - ((k_0 v_0) - (with-continuation-mark* - general - k_0 - v_0 - (loop_3 - (hash-iterate-next - return-mode63_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))) - (loop_3 - (hash-iterate-first - return-mode63_0)))) + (interpret_1 + (unsafe-vector*-ref + b64_0 + i_0) + stack_1)) (case-lambda - ((v_0) - (values stack_0 v_0)) - (vs_0 - (apply - values - stack_0 - vs_0))))))) - (apply rator_0 rands_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (if (if (eq? 'quote (unsafe-vector*-ref b64_0 0)) - #t - #f) - (let ((v_0 (unsafe-vector*-ref b64_0 1))) - (if return-mode63_0 - (values stack65_0 v_0) - v_0)) - (if (if (eq? - 'unbox - (unsafe-vector*-ref b64_0 0)) - #t - #f) - (let ((s_0 (unsafe-vector*-ref b64_0 1))) - (call-with-values - (lambda () (stack-ref stack65_0 s_0)) - (case-lambda - ((new-stack_0 bx_0) - (let ((val_0 (unsafe-unbox* bx_0))) - (if return-mode63_0 - (values new-stack_0 val_0) - val_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (if (if (eq? - 'unbox/checked - (unsafe-vector*-ref b64_0 0)) - #t - #f) - (let ((s_0 (unsafe-vector*-ref b64_0 1))) - (let ((name_0 - (unsafe-vector*-ref b64_0 2))) - (let ((s_1 s_0)) - (call-with-values - (lambda () (stack-ref stack65_0 s_1)) - (case-lambda - ((new-stack_0 bx_0) - (let ((v_0 (unsafe-unbox* bx_0))) - (let ((val_0 - (check-not-unsafe-undefined - v_0 - name_0))) - (if return-mode63_0 - (values new-stack_0 val_0) - val_0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (if (if (eq? - 'ref-variable - (unsafe-vector*-ref b64_0 0)) - #t - #f) - (let ((s_0 (unsafe-vector*-ref b64_0 1))) - (call-with-values - (lambda () (stack-ref stack65_0 s_0)) - (case-lambda - ((new-stack_0 var_0) - (let ((val_0 - (|#%app| - 1/variable-ref/no-check - var_0))) - (if return-mode63_0 - (values new-stack_0 val_0) - val_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (if (if (eq? - 'ref-variable/checked - (unsafe-vector*-ref b64_0 0)) - #t - #f) - (let ((s_0 - (unsafe-vector*-ref b64_0 1))) - (call-with-values - (lambda () (stack-ref stack65_0 s_0)) - (case-lambda - ((new-stack_0 var_0) - (let ((val_0 - (|#%app| - 1/variable-ref - var_0))) - (if return-mode63_0 - (values new-stack_0 val_0) - val_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (if (if (eq? - 'let - (unsafe-vector*-ref b64_0 0)) - #t - #f) - (let ((pos_0 - (unsafe-vector*-ref b64_0 1))) - (let ((rhss_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((b_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((rhss_1 rhss_0) - (pos_1 pos_0)) - (let ((len_0 + ((new-stack_0 val_0) + (loop_0 + (fx+ i_0 1) + new-stack_0)) + ((new-stack_0 . vals_0) + (loop_0 + (fx+ i_0 1) + new-stack_0)))))))))) + (loop_0 1 stack65_0))) + (if (if (eq? + 'beginl + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((bs_0 + (unsafe-vector*-ref + b64_0 + 1))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (bs_1 stack_1) + (begin + (if (null? (cdr bs_1)) + (interpret_1 + (car bs_1) + stack_1 + return-mode63_0) + (call-with-values + (lambda () + (interpret_1 + (car bs_1) + stack_1)) + (case-lambda + ((new-stack_0 val_0) + (loop_0 + (cdr bs_1) + new-stack_0)) + ((new-stack_0 + . + vals_0) + (loop_0 + (cdr bs_1) + new-stack_0)))))))))) + (loop_0 bs_0 stack65_0))) + (if (if (eq? + 'begin0 + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((b0_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((last_0 + (fx- (unsafe-vector*-length - rhss_1))) - (let ((body-stack_0 - (loop_0 - len_0 - pos_1 - rhss_1 - 0 - stack65_0))) - (interpret_0 - b_0 - body-stack_0 - return-mode63_0))))))) - (if (if (eq? - 'let* - (unsafe-vector*-ref b64_0 0)) - #t - #f) - (let ((poss_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((rhsss_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((b_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((rhsss_1 rhsss_0) - (poss_1 poss_0)) - (let ((body-stack_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (stack_0 - lst_0 - lst_1) - (begin - (if (if (pair? - lst_0) - (pair? - lst_1) - #f) - (let ((pos_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((rhss_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((len_0 - (unsafe-vector*-length - rhss_0))) - (let ((stack_1 - (let ((stack_1 - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (i_0 - stack_1) - (begin - (if (fx= - i_0 - len_0) - stack_1 - (call-with-values - (lambda () - (interpret_0 - (unsafe-vector*-ref - rhss_0 - i_0) - stack_1)) - (case-lambda - ((new-stack_0 - val_0) - (let ((app_0 - (fx+ - i_0 - 1))) - (loop_3 - app_0 - (stack-set - new-stack_0 - (fx+ - i_0 - pos_0) - val_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))) - (loop_3 - 0 - stack_0)))) - (values - stack_1)))) - (for-loop_0 - stack_1 - rest_0 - rest_1))))))) - stack_0)))))) - (for-loop_0 - stack65_0 - poss_1 - rhsss_1))))) - (interpret_0 - b_0 - body-stack_0 - return-mode63_0)))))) - (if (if (eq? - 'letrec - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((pos_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((rhss_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((b_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((rhss_1 rhss_0) - (pos_1 pos_0)) - (let ((len_0 - (unsafe-vector*-length - rhss_1))) - (call-with-values - (lambda () - (loop_1 - len_0 - pos_1 - stack65_0 - 0)) - (case-lambda - ((body-stack_0 - boxes_0) - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (i_0 - stack_0 - boxes_1) - (begin - (if (fx= - i_0 - len_0) - (interpret_0 - b_0 - stack_0 - return-mode63_0) + b64_0) + 1))) + (call-with-values + (lambda () + (interpret_1 + b0_0 + stack65_0)) + (lambda (stack_1 . vals_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 stack_2) + (begin + (let ((new-stack_0 (call-with-values (lambda () - (interpret_0 + (interpret_1 (unsafe-vector*-ref - rhss_1 + b64_0 i_0) - stack_0)) + stack_2)) (case-lambda ((new-stack_0 val_0) - (begin - (set-box! - (car - boxes_1) - val_0) - (let ((app_0 - (fx+ - i_0 - 1))) - (loop_3 - app_0 - new-stack_0 - (cdr - boxes_1))))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))) - (loop_3 - 0 - body-stack_0 - boxes_0))) - (args - (raise-binding-result-arity-error - 2 - args))))))))) - (if (eq? - 'begin - (unsafe-vector*-ref b64_0 0)) - (let ((last_0 - (fx- - (unsafe-vector*-length - b64_0) - 1))) - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (i_0 stack_0) - (begin - (if (fx= i_0 last_0) - (interpret_0 - (unsafe-vector*-ref - b64_0 - i_0) - stack_0 - return-mode63_0) - (call-with-values - (lambda () - (interpret_0 + new-stack_0) + ((new-stack_0 + . + vals_1) + new-stack_0))))) + (if (fx= + i_0 + last_0) + (if return-mode63_0 + (apply + values + new-stack_0 + vals_0) + (apply + values + vals_0)) + (loop_0 + (fx+ i_0 1) + new-stack_0)))))))) + (loop_0 2 stack_1)))))) + (if (if (eq? + '$value + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((e_0 + (unsafe-vector*-ref + b64_0 + 1))) + (call-with-values + (lambda () + (interpret_1 + e_0 + stack65_0)) + (case-lambda + ((new-stack_0 v_0) + (if return-mode63_0 + (values new-stack_0 v_0) + v_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (if (if (eq? + 'clear + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((clears_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((e_0 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((clears_1 + clears_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (clears_2 + stack_1) + (begin + (if (null? + clears_2) + (interpret_1 + e_0 + stack_1 + return-mode63_0) + (let ((app_0 + (cdr + clears_2))) + (loop_0 + app_0 + (let ((i_0 + (car + clears_2))) + (begin-unsafe + (begin-unsafe + (delete + stack_1 + i_0)))))))))))) + (loop_0 + clears_1 + stack65_0))))) + (if (if (eq? + 'enbox + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((pos_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((e_0 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((pos_1 pos_0)) + (let ((new-stack_0 + (stack-set + stack65_0 + pos_1 + (box + (stack-ref + stack65_0 + pos_1 + #t))))) + (interpret_1 + e_0 + new-stack_0 + return-mode63_0))))) + (if (if (eq? + 'if + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((tst_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((thn_0 (unsafe-vector*-ref b64_0 - i_0) - stack_0)) - (case-lambda - ((new-stack_0 - val_0) - (loop_3 - (fx+ i_0 1) - new-stack_0)) - ((new-stack_0 - . - vals_0) - (loop_3 - (fx+ i_0 1) - new-stack_0)))))))))) - (loop_3 1 stack65_0))) - (if (if (eq? - 'beginl - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((bs_0 - (unsafe-vector*-ref - b64_0 - 1))) - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (bs_1 stack_0) - (begin - (if (null? - (cdr bs_1)) - (interpret_0 - (car bs_1) - stack_0 - return-mode63_0) - (call-with-values - (lambda () - (interpret_0 - (car bs_1) - stack_0)) - (case-lambda - ((new-stack_0 - val_0) - (loop_3 - (cdr bs_1) - new-stack_0)) - ((new-stack_0 - . - vals_0) - (loop_3 - (cdr bs_1) - new-stack_0)))))))))) - (loop_3 bs_0 stack65_0))) - (if (if (eq? - 'begin0 - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((b0_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((last_0 - (fx- - (unsafe-vector*-length - b64_0) - 1))) - (call-with-values - (lambda () - (interpret_0 - b0_0 - stack65_0)) - (lambda (stack_0 - . - vals_0) - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (i_0 - stack_1) - (begin - (let ((new-stack_0 - (call-with-values - (lambda () - (interpret_0 - (unsafe-vector*-ref - b64_0 - i_0) - stack_1)) - (case-lambda - ((new-stack_0 - val_0) - new-stack_0) - ((new-stack_0 - . - vals_1) - new-stack_0))))) - (if (fx= - i_0 - last_0) - (if return-mode63_0 - (apply - values - new-stack_0 - vals_0) - (apply - values - vals_0)) - (loop_3 - (fx+ - i_0 - 1) - new-stack_0)))))))) - (loop_3 - 2 - stack_0)))))) - (if (if (eq? - '$value - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((e_0 - (unsafe-vector*-ref - b64_0 - 1))) - (call-with-values - (lambda () - (interpret_0 - e_0 - stack65_0)) - (case-lambda - ((new-stack_0 v_0) - (if return-mode63_0 - (values - new-stack_0 - v_0) - v_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (if (if (eq? - 'clear - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((clears_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((e_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((clears_1 - clears_0)) - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (clears_2 - stack_0) - (begin - (if (null? - clears_2) - (interpret_0 - e_0 - stack_0 - return-mode63_0) - (let ((app_0 - (cdr - clears_2))) - (loop_3 - app_0 - (let ((i_0 - (car - clears_2))) - (begin-unsafe - (begin-unsafe - (delete - stack_0 - i_0)))))))))))) - (loop_3 - clears_1 - stack65_0))))) - (if (if (eq? - 'enbox - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((pos_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((e_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((pos_1 - pos_0)) - (let ((new-stack_0 - (stack-set - stack65_0 - pos_1 - (box - (stack-ref - stack65_0 - pos_1 - #t))))) - (interpret_0 - e_0 - new-stack_0 - return-mode63_0))))) - (if (if (eq? - 'if - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((tst_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((thn_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((els_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((thn_1 - thn_0) - (tst_1 - tst_0)) + 2))) + (let ((els_0 + (unsafe-vector*-ref + b64_0 + 3))) + (let ((thn_1 thn_0) + (tst_1 + tst_0)) + (call-with-values + (lambda () + (interpret_1 + tst_1 + stack65_0)) + (case-lambda + ((new-stack_0 + val_0) + (if val_0 + (interpret_1 + thn_1 + new-stack_0 + return-mode63_0) + (interpret_1 + els_0 + new-stack_0 + return-mode63_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (if (if (eq? + 'wcm + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((key_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((val_0 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((body_0 + (unsafe-vector*-ref + b64_0 + 3))) + (let ((val_1 + val_0) + (key_1 + key_0)) + (call-with-values + (lambda () + (interpret_1 + key_1 + stack65_0)) + (case-lambda + ((k-stack_0 + k-val_0) (call-with-values (lambda () - (interpret_0 - tst_1 - stack65_0)) + (interpret_1 + val_1 + k-stack_0)) (case-lambda - ((new-stack_0 - val_0) - (if val_0 - (interpret_0 - thn_1 - new-stack_0 - return-mode63_0) - (interpret_0 - els_0 - new-stack_0 - return-mode63_0))) + ((v-stack_0 + v-val_0) + (if (not + return-mode63_0) + (with-continuation-mark* + general + k-val_0 + v-val_0 + (interpret_1 + body_0 + v-stack_0 + #f)) + (if (eq? + return-mode63_0 + 'values) + (|#%app| + (call-with-values + (lambda () + (with-continuation-mark* + general + k-val_0 + v-val_0 + (interpret_1 + body_0 + v-stack_0 + (hasheq + k-val_0 + v-val_0)))) + (case-lambda + ((stack_1 + v_0) + (if (eq? + stack_1 + 'trampoline) + v_0 + (lambda () + (values + stack_1 + v_0)))) + ((stack_1 + . + vs_0) + (lambda () + (apply + values + stack_1 + vs_0)))))) + (with-continuation-mark* + general + k-val_0 + v-val_0 + (interpret_1 + body_0 + v-stack_0 + (hash-set + return-mode63_0 + k-val_0 + v-val_0)))))) (args (raise-binding-result-arity-error 2 - args)))))))) - (if (if (eq? - 'wcm - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((key_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((val_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((body_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((val_1 - val_0) - (key_1 - key_0)) - (call-with-values - (lambda () - (interpret_0 - key_1 - stack65_0)) - (case-lambda - ((k-stack_0 - k-val_0) - (call-with-values - (lambda () - (interpret_0 - val_1 - k-stack_0)) - (case-lambda - ((v-stack_0 - v-val_0) - (if (not - return-mode63_0) - (with-continuation-mark* - general - k-val_0 - v-val_0 - (interpret_0 - body_0 - v-stack_0 - #f)) - (if (eq? - return-mode63_0 - 'values) - (|#%app| - (call-with-values - (lambda () - (with-continuation-mark* - general - k-val_0 - v-val_0 - (interpret_0 - body_0 - v-stack_0 - (hasheq - k-val_0 - v-val_0)))) - (case-lambda - ((stack_0 - v_0) - (if (eq? - stack_0 - 'trampoline) - v_0 - (lambda () - (values - stack_0 - v_0)))) - ((stack_0 - . + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (if (if (eq? + 'cwv + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((b_1 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((pos_0 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((name_0 + (unsafe-vector*-ref + b64_0 + 3))) + (let ((clauses_0 + (unsafe-vector*-ref + b64_0 + 4))) + (let ((name_1 + name_0) + (pos_1 + pos_0) + (b_2 + b_1)) + (call-with-values + (lambda () + (call-with-values + (lambda () + (interpret_1 + b_2 + stack65_0)) + (lambda (stack_1 + . + vals_0) + (values + stack_1 + vals_0)))) + (case-lambda + ((new-stack_0 + vs_0) + (let ((len_0 + (length + vs_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (clauses_1 + full-mask_0) + (begin + (if (null? + clauses_1) + (apply + raise-arity-mask-error + (if name_1 + name_1 + '|#|) + full-mask_0 vs_0) - (lambda () - (apply - values - stack_0 - vs_0)))))) - (with-continuation-mark* - general - k-val_0 - v-val_0 - (interpret_0 - body_0 - v-stack_0 - (hash-set - return-mode63_0 - k-val_0 - v-val_0)))))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (if (if (eq? - 'cwv - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((b_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((pos_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((name_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((clauses_0 - (unsafe-vector*-ref - b64_0 - 4))) - (let ((name_1 - name_0) - (pos_1 - pos_0) - (b_1 - b_0)) - (call-with-values - (lambda () - (call-with-values + (let ((v_0 + (car + clauses_1))) + (let ((mask_0 + (unsafe-vector*-ref + v_0 + 0))) + (let ((b_3 + (unsafe-vector*-ref + v_0 + 1))) + (let ((mask_1 + mask_0)) + (if (begin-unsafe + (bitwise-bit-set? + mask_1 + len_0)) + (interpret_1 + b_3 + (push-stack + new-stack_0 + pos_1 + vs_0 + mask_1) + return-mode63_0) + (let ((app_0 + (cdr + clauses_1))) + (loop_0 + app_0 + (fxior + mask_1 + full-mask_0)))))))))))))) + (loop_0 + clauses_0 + 0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))))) + (if (if (eq? + 'cwmp0 + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((b_1 + (unsafe-vector*-ref + b64_0 + 1))) + (begin + (if return-mode63_0 + (error + 'interpret + "expect call-with-module-prompt in tail position") + (void)) + (|#%app| + (hash-ref + primitives + 'call-with-module-prompt) + (lambda () + (interpret_1 + b_1 + stack65_0 + #f))))) + (if (if (eq? + 'cwmp + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((b_1 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((ids_0 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((constances_0 + (unsafe-vector*-ref + b64_0 + 3))) + (let ((var-es_0 + (unsafe-vector*-ref + b64_0 + 4))) + (let ((constances_1 + constances_0) + (ids_1 + ids_0) + (b_2 + b_1)) + (begin + (if return-mode63_0 + (error + 'interpret + "expect call-with-module-prompt in tail position") + (void)) + (let ((app_0 + (hash-ref + primitives + 'call-with-module-prompt))) + (apply + app_0 (lambda () - (interpret_0 - b_1 - stack65_0)) - (lambda (stack_0 - . - vals_0) - (values - stack_0 - vals_0)))) - (case-lambda - ((new-stack_0 - vs_0) - (let ((len_0 - (length - vs_0))) - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (clauses_1 - full-mask_0) - (begin - (if (null? - clauses_1) - (apply - raise-arity-mask-error - (if name_1 - name_1 - '|#|) - full-mask_0 - vs_0) - (let ((v_0 - (car - clauses_1))) - (let ((mask_0 - (unsafe-vector*-ref - v_0 - 0))) - (let ((b_2 - (unsafe-vector*-ref - v_0 - 1))) - (let ((mask_1 - mask_0)) - (if (begin-unsafe - (bitwise-bit-set? - mask_1 - len_0)) - (interpret_0 - b_2 - (push-stack - new-stack_0 - pos_1 - vs_0 - mask_1) - return-mode63_0) - (let ((app_0 - (cdr - clauses_1))) - (loop_3 - app_0 - (fxior - mask_1 - full-mask_0)))))))))))))) - (loop_3 - clauses_0 - 0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))))) - (if (if (eq? - 'cwmp0 - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((b_0 - (unsafe-vector*-ref - b64_0 - 1))) - (begin - (if return-mode63_0 - (error - 'interpret - "expect call-with-module-prompt in tail position") - (void)) - (|#%app| - (hash-ref - primitives - 'call-with-module-prompt) - (lambda () - (interpret_0 - b_0 - stack65_0 - #f))))) - (if (if (eq? - 'cwmp - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((b_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((ids_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((constances_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((var-es_0 - (unsafe-vector*-ref - b64_0 - 4))) - (let ((constances_1 - constances_0) - (ids_1 - ids_0) - (b_1 - b_0)) - (begin + (interpret_1 + b_2 + stack65_0 + #f)) + ids_1 + constances_1 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((e_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (interpret_1 + e_0 + stack65_0 + #f) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + var-es_0)))))))))))) + (if (if (eq? + 'lambda + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((mask_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((wrap-data_0 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((close-vec_0 + (unsafe-vector*-ref + b64_0 + 3))) + (let ((__0 + (unsafe-vector*-ref + b64_0 + 4))) + (let ((close-vec_1 + close-vec_0) + (wrap-data_1 + wrap-data_0) + (mask_1 + mask_0)) + (call-with-values + (lambda () + (capture-closure_0 + close-vec_1 + stack65_0)) + (case-lambda + ((new-stack_0 + captured_0) + (let ((val_0 + (|#%app| + make-interp-procedure* + (lambda args_0 + (apply-function_0 + b64_0 + captured_0 + args_0)) + mask_1 + wrap-data_1))) (if return-mode63_0 - (error - 'interpret - "expect call-with-module-prompt in tail position") - (void)) - (let ((app_0 - (hash-ref - primitives - 'call-with-module-prompt))) - (apply - app_0 - (lambda () - (interpret_0 - b_1 - stack65_0 - #f)) - ids_1 - constances_1 - (reverse$1 + (values + new-stack_0 + val_0) + val_0))) + (args + (raise-binding-result-arity-error + 2 + args))))))))) + (if (if (eq? + 'case-lambda + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((mask_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((wrap-data_0 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((mask_1 + mask_0)) + (let ((n_0 + (unsafe-vector*-length + b64_0))) + (call-with-values + (lambda () + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 + stack_1) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((e_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (interpret_0 - e_0 - stack65_0 - #f) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - var-es_0)))))))))))) - (if (if (eq? - 'lambda - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((mask_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((wrap-data_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((close-vec_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((__0 - (unsafe-vector*-ref - b64_0 - 4))) - (let ((close-vec_1 - close-vec_0) - (wrap-data_1 - wrap-data_0) - (mask_1 - mask_0)) - (call-with-values - (lambda () - (capture-closure_0 - close-vec_1 - stack65_0)) - (case-lambda - ((new-stack_0 - captured_0) - (let ((val_0 - (|#%app| - make-interp-procedure* - (lambda args_0 - (apply-function_0 - b64_0 - captured_0 - args_0)) - mask_1 - wrap-data_1))) - (if return-mode63_0 - (values - new-stack_0 - val_0) - val_0))) - (args - (raise-binding-result-arity-error - 2 - args))))))))) - (if (if (eq? - 'case-lambda - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((mask_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((wrap-data_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((mask_1 - mask_0)) - (let ((n_0 - (unsafe-vector*-length - b64_0))) - (call-with-values - (lambda () - (loop_2 - b64_0 - n_0 - 3 - stack65_0)) - (case-lambda - ((new-stack_0 - captureds_0) - (let ((val_0 - (|#%app| - make-interp-procedure* - (lambda args_0 - (let ((len_0 - (length - args_0))) - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (i_0 - captureds_1 - full-mask_0) - (begin - (if (fx= - i_0 - n_0) - (apply - raise-arity-mask-error - '|#| - full-mask_0 - args_0) - (let ((one-b_0 - (unsafe-vector*-ref - b64_0 - i_0))) - (if (if (eq? - 'lambda - (unsafe-vector*-ref - one-b_0 - 0)) - #t - #f) - (let ((mask_2 - (unsafe-vector*-ref - one-b_0 - 1))) - (if (begin-unsafe - (bitwise-bit-set? - mask_2 - len_0)) - (apply-function_0 - one-b_0 - (car - captureds_1) - args_0) - (let ((app_0 - (fx+ - i_0 - 1))) - (let ((app_1 - (cdr - captureds_1))) - (loop_3 - app_0 - app_1 - (fxior - full-mask_0 - mask_2)))))) - (error - 'interp-match - "no matching clause"))))))))) - (loop_3 - 3 - captureds_0 - 0)))) - mask_1 - wrap-data_0))) - (if return-mode63_0 - (values - new-stack_0 - val_0) - val_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (if (if (eq? - 'set-variable! - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((s_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((b_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((c_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((defn?_0 - (unsafe-vector*-ref - b64_0 - 4))) - (let ((c_1 - c_0) - (b_1 - b_0) - (s_1 - s_0)) - (call-with-values - (lambda () - (stack-ref - stack65_0 - s_1)) - (case-lambda - ((var-stack_0 - var_0) - (call-with-values - (lambda () - (interpret_0 - b_1 - var-stack_0)) - (case-lambda - ((val-stack_0 - val_0) - (begin - (if defn?_0 - (|#%app| - 1/variable-set!/define - var_0 - val_0 - c_1) - (|#%app| - 1/variable-set! - var_0 - val_0)) - (if return-mode63_0 - (values - val-stack_0 - (void)) - (void)))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args))))))))) - (if (if (eq? - 'set!-indirect - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((s_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((e_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((b_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((e_1 - e_0) - (s_1 - s_0)) - (call-with-values - (lambda () - (stack-ref - stack65_0 - s_1)) - (case-lambda - ((vec-stack_0 - vec_0) - (call-with-values - (lambda () - (interpret_0 - b_0 - vec-stack_0)) - (case-lambda - ((val-stack_0 - val_0) - (begin - (unsafe-vector*-set! - vec_0 - e_1 - val_0) - (if return-mode63_0 - (values - val-stack_0 - (void)) - (void)))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (if (if (eq? - 'set!-boxed - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((s_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((b_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((name_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((b_1 - b_0) - (s_1 - s_0)) - (call-with-values - (lambda () - (stack-ref - stack65_0 - s_1)) - (case-lambda - ((bx-stack_0 - bx_0) - (call-with-values - (lambda () - (interpret_0 - b_1 - bx-stack_0)) - (case-lambda - ((v-stack_0 - v_0) - (begin - (unsafe-set-box*! - bx_0 - v_0) - (if return-mode63_0 - (values - v-stack_0 - (void)) - (void)))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (if (if (eq? - 'set!-boxed/checked - (unsafe-vector*-ref - b64_0 - 0)) - #t - #f) - (let ((s_0 - (unsafe-vector*-ref - b64_0 - 1))) - (let ((b_0 - (unsafe-vector*-ref - b64_0 - 2))) - (let ((name_0 - (unsafe-vector*-ref - b64_0 - 3))) - (let ((b_1 - b_0) - (s_1 - s_0)) + (if (fx= + i_0 + n_0) + (values + stack_1 + '()) (call-with-values (lambda () - (stack-ref - stack65_0 - s_1)) + (loop_0 + (fx+ + i_0 + 1) + stack_1)) (case-lambda - ((bx-stack_0 - bx_0) + ((rest-stack_0 + rest-captureds_0) (call-with-values (lambda () - (interpret_0 - b_1 - bx-stack_0)) + (let ((v_0 + (unsafe-vector*-ref + b64_0 + i_0))) + (if (if (eq? + 'lambda + (unsafe-vector*-ref + v_0 + 0)) + #t + #f) + (let ((mask_2 + (unsafe-vector*-ref + v_0 + 1))) + (let ((__0 + (unsafe-vector*-ref + v_0 + 2))) + (let ((close-vec_0 + (unsafe-vector*-ref + v_0 + 3))) + (let ((__1 + __0) + (mask_3 + mask_2)) + (capture-closure_0 + close-vec_0 + rest-stack_0))))) + (error + 'interp-match + "no matching clause")))) (case-lambda - ((v-stack_0 - v_0) - (begin - (check-not-unsafe-undefined/assign - (unsafe-unbox* - bx_0) - name_0) - (unsafe-set-box*! - bx_0 - v_0) - (if return-mode63_0 - (values - v-stack_0 - (void)) - (void)))) + ((new-stack_0 + captured_0) + (values + new-stack_0 + (cons + captured_0 + rest-captureds_0))) (args (raise-binding-result-arity-error 2 @@ -58327,106 +46768,411 @@ (args (raise-binding-result-arity-error 2 - args)))))))) - (error - 'interp-match - "no matching clause"))))))))))))))))))))))))))) - (if return-mode63_0 - (values stack65_0 b64_0) - b64_0)))))))))) - (loop_0 - (|#%name| - loop - (lambda (len_0 pos_0 rhss_0 i_0 stack_0) - (begin - (if (fx= i_0 len_0) - stack_0 - (call-with-values - (lambda () - (interpret_0 (unsafe-vector*-ref rhss_0 i_0) stack_0)) - (case-lambda - ((new-stack_0 val_0) - (let ((app_0 + args)))))))))) + (loop_0 + 3 + stack65_0))) + (case-lambda + ((new-stack_0 + captureds_0) + (let ((val_0 + (|#%app| + make-interp-procedure* + (lambda args_0 + (let ((len_0 + (length + args_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 + captureds_1 + full-mask_0) + (begin + (if (fx= + i_0 + n_0) + (apply + raise-arity-mask-error + '|#| + full-mask_0 + args_0) + (let ((one-b_0 + (unsafe-vector*-ref + b64_0 + i_0))) + (if (if (eq? + 'lambda + (unsafe-vector*-ref + one-b_0 + 0)) + #t + #f) + (let ((mask_2 + (unsafe-vector*-ref + one-b_0 + 1))) + (if (begin-unsafe + (bitwise-bit-set? + mask_2 + len_0)) + (apply-function_0 + one-b_0 + (car + captureds_1) + args_0) + (let ((app_0 + (fx+ + i_0 + 1))) + (let ((app_1 + (cdr + captureds_1))) + (loop_0 + app_0 + app_1 + (fxior + full-mask_0 + mask_2)))))) + (error + 'interp-match + "no matching clause"))))))))) + (loop_0 + 3 + captureds_0 + 0)))) + mask_1 + wrap-data_0))) + (if return-mode63_0 + (values + new-stack_0 + val_0) + val_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (if (if (eq? + 'set-variable! + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((s_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((b_1 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((c_0 + (unsafe-vector*-ref + b64_0 + 3))) + (let ((defn?_0 + (unsafe-vector*-ref + b64_0 + 4))) + (let ((c_1 + c_0) + (b_2 + b_1) + (s_1 + s_0)) + (call-with-values + (lambda () + (stack-ref + stack65_0 + s_1)) + (case-lambda + ((var-stack_0 + var_0) + (call-with-values + (lambda () + (interpret_1 + b_2 + var-stack_0)) + (case-lambda + ((val-stack_0 + val_0) + (begin + (if defn?_0 + (|#%app| + 1/variable-set!/define + var_0 + val_0 + c_1) + (|#%app| + 1/variable-set! + var_0 + val_0)) + (if return-mode63_0 + (values + val-stack_0 + (void)) + (void)))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args))))))))) + (if (if (eq? + 'set!-indirect + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((s_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((e_0 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((b_1 + (unsafe-vector*-ref + b64_0 + 3))) + (let ((e_1 + e_0) + (s_1 + s_0)) + (call-with-values + (lambda () + (stack-ref + stack65_0 + s_1)) + (case-lambda + ((vec-stack_0 + vec_0) + (call-with-values + (lambda () + (interpret_1 + b_1 + vec-stack_0)) + (case-lambda + ((val-stack_0 + val_0) + (begin + (unsafe-vector*-set! + vec_0 + e_1 + val_0) + (if return-mode63_0 + (values + val-stack_0 + (void)) + (void)))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (if (if (eq? + 'set!-boxed + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((s_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((b_1 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((name_0 + (unsafe-vector*-ref + b64_0 + 3))) + (let ((b_2 + b_1) + (s_1 + s_0)) + (call-with-values + (lambda () + (stack-ref + stack65_0 + s_1)) + (case-lambda + ((bx-stack_0 + bx_0) + (call-with-values + (lambda () + (interpret_1 + b_2 + bx-stack_0)) + (case-lambda + ((v-stack_0 + v_0) + (begin + (unsafe-set-box*! + bx_0 + v_0) + (if return-mode63_0 + (values + v-stack_0 + (void)) + (void)))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (if (if (eq? + 'set!-boxed/checked + (unsafe-vector*-ref + b64_0 + 0)) + #t + #f) + (let ((s_0 + (unsafe-vector*-ref + b64_0 + 1))) + (let ((b_1 + (unsafe-vector*-ref + b64_0 + 2))) + (let ((name_0 + (unsafe-vector*-ref + b64_0 + 3))) + (let ((b_2 + b_1) + (s_1 + s_0)) + (call-with-values + (lambda () + (stack-ref + stack65_0 + s_1)) + (case-lambda + ((bx-stack_0 + bx_0) + (call-with-values + (lambda () + (interpret_1 + b_2 + bx-stack_0)) + (case-lambda + ((v-stack_0 + v_0) + (begin + (check-not-unsafe-undefined/assign + (unsafe-unbox* + bx_0) + name_0) + (unsafe-set-box*! + bx_0 + v_0) + (if return-mode63_0 + (values + v-stack_0 + (void)) + (void)))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (error + 'interp-match + "no matching clause"))))))))))))))))))))))))))) + (if return-mode63_0 + (values stack65_0 b64_0) + b64_0)))))))))) + (interpret_1 + (|#%name| + interpret + (case-lambda + ((b_1 stack_1) (begin (interpret_0 b_1 stack_1 'values))) + ((b_1 stack_1 return-mode63_0) + (interpret_0 b_1 stack_1 return-mode63_0))))) + (capture-closure_0 + (|#%name| + capture-closure + (lambda (close-vec_0 stack_1) + (begin + (let ((len_0 (unsafe-vector*-length close-vec_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 stack_2 captured_0) + (begin + (if (= i_0 len_0) + (values stack_2 captured_0) + (call-with-values + (lambda () + (stack-ref + stack_2 + (unsafe-vector*-ref close-vec_0 i_0))) + (case-lambda + ((val-stack_0 val_0) + (let ((app_0 (add1 i_0))) (loop_0 - len_0 - pos_0 - rhss_0 - (fx+ i_0 1) - new-stack_0))) - (stack-set app_0 (fx+ i_0 pos_0) val_0))) - (args (raise-binding-result-arity-error 2 args))))))))) - (loop_1 - (|#%name| - loop - (lambda (len_0 pos_0 stack_0 i_0) - (begin - (if (= i_0 len_0) - (values stack_0 null) - (let ((bx_0 (box unsafe-undefined))) - (call-with-values - (lambda () - (let ((app_0 - (stack-set - stack_0 - (fx+ (fx- len_0 i_0 1) pos_0) - bx_0))) - (loop_1 len_0 pos_0 app_0 (add1 i_0)))) - (case-lambda - ((new-stack_0 boxes_0) - (values new-stack_0 (cons bx_0 boxes_0))) - (args (raise-binding-result-arity-error 2 args)))))))))) - (loop_2 - (|#%name| - loop - (lambda (b64_0 n_0 i_0 stack_0) - (begin - (if (fx= i_0 n_0) - (values stack_0 '()) - (call-with-values - (lambda () (loop_2 b64_0 n_0 (fx+ i_0 1) stack_0)) - (case-lambda - ((rest-stack_0 rest-captureds_0) - (call-with-values - (lambda () - (let ((v_0 (unsafe-vector*-ref b64_0 i_0))) - (if (if (eq? 'lambda (unsafe-vector*-ref v_0 0)) - #t - #f) - (let ((mask_0 (unsafe-vector*-ref v_0 1))) - (let ((__0 (unsafe-vector*-ref v_0 2))) - (let ((close-vec_0 - (unsafe-vector*-ref v_0 3))) - (let ((__1 __0) (mask_1 mask_0)) - (capture-closure_0 - close-vec_0 - rest-stack_0))))) - (error 'interp-match "no matching clause")))) - (case-lambda - ((new-stack_0 captured_0) - (values - new-stack_0 - (cons captured_0 rest-captureds_0))) - (args (raise-binding-result-arity-error 2 args))))) - (args (raise-binding-result-arity-error 2 args)))))))))) - (lambda (b_0 stack_0) - (if (vector? b_0) - (if (eq? 'begin (unsafe-vector*-ref b_0 0)) - (let ((last_0 (sub1 (unsafe-vector*-length b_0)))) - (letrec* - ((loop_3 - (|#%name| - loop - (lambda (i_0) - (begin - (let ((e_0 (unsafe-vector*-ref b_0 i_0))) - (if (= i_0 last_0) - (interpret_0 e_0 stack_0 #f) - (begin - (interpret_0 e_0 stack_0 #f) - (loop_3 (add1 i_0)))))))))) - (loop_3 1))) - (interpret_0 b_0 stack_0 #f)) - (interpret_0 b_0 stack_0 #f))))) + app_0 + val-stack_0 + (stack-set captured_0 (- -1 i_0) val_0)))) + (args + (raise-binding-result-arity-error 2 args)))))))))) + (loop_0 0 stack_1 #f))))))) + (apply-function_0 + (|#%name| + apply-function + (lambda (b_1 captured_0 args_0) + (begin + (if (if (eq? 'lambda (unsafe-vector*-ref b_1 0)) #t #f) + (let ((mask_0 (unsafe-vector*-ref b_1 1))) + (let ((name_0 (unsafe-vector*-ref b_1 2))) + (let ((close-vec_0 (unsafe-vector*-ref b_1 3))) + (let ((b_2 (unsafe-vector*-ref b_1 4))) + (let ((close-vec_1 close-vec_0) + (name_1 name_0) + (mask_1 mask_0)) + (interpret_1 + b_2 + (push-stack captured_0 0 args_0 mask_1) + #f)))))) + (error 'interp-match "no matching clause"))))))) + (if (vector? b_0) + (if (eq? 'begin (unsafe-vector*-ref b_0 0)) + (let ((last_0 (sub1 (unsafe-vector*-length b_0)))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0) + (begin + (let ((e_0 (unsafe-vector*-ref b_0 i_0))) + (if (= i_0 last_0) + (interpret_1 e_0 stack_0 #f) + (begin + (interpret_1 e_0 stack_0 #f) + (loop_0 (add1 i_0)))))))))) + (loop_0 1))) + (interpret_1 b_0 stack_0 #f)) + (interpret_1 b_0 stack_0 #f))))) (define count->mask (lambda (count_0 rest?_0) (if rest?_0 @@ -58435,221 +47181,243 @@ (define matching-argument-count? (lambda (mask_0 len_0) (bitwise-bit-set? mask_0 len_0))) (define linklet-bigger-than? - (letrec ((body-leftover-size_0 - (|#%name| - body-leftover-size - (lambda (body_0 size_0) - (begin (begin (for-loop_2 size_0 body_0)))))) - (for-loop_0 - (|#%name| - for-loop - (lambda (len_0 vec_0 size_0 pos_0) - (begin - (if (unsafe-fx< pos_0 len_0) - (let ((v_0 (unsafe-vector-ref vec_0 pos_0))) - (if (<= size_0 0) - size_0 - (let ((size_1 (s-expr-leftover-size_0 v_0 size_0))) - (next-k-proc_1 len_0 pos_0 vec_0 size_1)))) - size_0))))) - (for-loop_1 - (|#%name| - for-loop - (lambda (v_0 size_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () (hash-iterate-key+value v_0 i_0)) - (case-lambda - ((k_0 v_1) - (if (<= size_0 0) - size_0 - (let ((size_1 - (s-expr-leftover-size_0 - v_1 - (s-expr-leftover-size_0 k_0 size_0)))) - (next-k-proc_2 i_0 v_0 size_1)))) - (args (raise-binding-result-arity-error 2 args)))) - size_0))))) - (for-loop_2 - (|#%name| - for-loop - (lambda (size_0 lst_0) - (begin - (if (not (begin-unsafe (null? (unwrap lst_0)))) - (let ((e_0 - (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe (pair? (unwrap lst_0))) - (wrap-cdr lst_0) - null))) - (let ((e_1 e_0)) - (if (<= size_0 0) - size_0 - (let ((size_1 (leftover-size_0 e_1 size_0))) - (begin-unsafe - (begin (for-loop_2 size_1 rest_0)))))))) - size_0))))) - (leftover-size_0 - (|#%name| - leftover-size - (lambda (e_0 size_0) - (begin - (if (<= size_0 0) - 0 - (let ((hd_0 - (let ((p_0 (unwrap e_0))) - (if (pair? p_0) (unwrap (car p_0)) #f)))) - (if (if (eq? 'begin hd_0) #t #f) - (let ((body_0 (let ((d_0 (cdr (unwrap e_0)))) d_0))) - (body-leftover-size_0 body_0 (sub1 size_0))) - (if (if (eq? 'define-values hd_0) - (let ((a_0 (cdr (unwrap e_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))) - (begin-unsafe - (let ((app_0 (unwrap '()))) - (eq? app_0 (unwrap a_2))))) - #f))) - #f))) - #f) - (let ((rhs_0 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((d_1 (cdr (unwrap d_0)))) - (let ((a_0 (car (unwrap d_1)))) a_0))))) - (leftover-size_0 rhs_0 (sub1 size_0))) - (if (if (eq? 'lambda hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) #t #f))) - #f) - (let ((body_0 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((d_1 (cdr (unwrap d_0)))) d_1)))) - (body-leftover-size_0 body_0 (sub1 size_0))) - (if (if (eq? 'case-lambda hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (if (wrap-list? a_0) - (begin - (letrec* - ((for-loop_3 - (|#%name| - for-loop - (lambda (result_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap lst_0))) - (wrap-car lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr lst_0) - null))) - (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_0 - (unwrap - v_1))) - (if (pair? - p_0) - #t - #f)))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_3 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_3 #t a_0))) - #f)) - #f) - (let ((bodys_0 - (let ((d_0 (cdr (unwrap e_0)))) - (let ((bodys_0 - (begin - (letrec* - ((for-loop_3 - (|#%name| - for-loop - (lambda (bodys_0 lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) + (lambda (e_0 size_0 serializable?_0) + (letrec* + ((leftover-size_0 + (|#%name| + leftover-size + (lambda (e_1 size_1) + (begin + (if (<= size_1 0) + 0 + (let ((hd_0 + (let ((p_0 (unwrap e_1))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'begin hd_0) #t #f) + (let ((body_0 (let ((d_0 (cdr (unwrap e_1)))) d_0))) + (body-leftover-size_0 body_0 (sub1 size_1))) + (if (if (eq? 'define-values hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (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))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_2))))) + #f))) + #f))) + #f) + (let ((rhs_0 + (let ((d_0 (cdr (unwrap e_1)))) + (let ((d_1 (cdr (unwrap d_0)))) + (let ((a_0 (car (unwrap d_1)))) a_0))))) + (leftover-size_0 rhs_0 (sub1 size_1))) + (if (if (eq? 'lambda hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap a_0))) (if (pair? p_0) #t #f))) + #f) + (let ((body_0 + (let ((d_0 (cdr (unwrap e_1)))) + (let ((d_1 (cdr (unwrap d_0)))) d_1)))) + (body-leftover-size_0 body_0 (sub1 size_1))) + (if (if (eq? 'case-lambda hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (if (wrap-list? a_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_0 + (unwrap + v_1))) + (if (pair? + p_0) + #t + #f)))) + (values result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_0))) + #f)) + #f) + (let ((bodys_0 + (let ((d_0 (cdr (unwrap e_1)))) + (let ((bodys_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (bodys_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 v_0)) - (let ((bodys_1 - (let ((bodys_1 - (let ((bodys1_0 - (let ((d_1 - (cdr + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr lst_0) + null))) + (let ((v_1 v_0)) + (let ((bodys_1 + (let ((bodys_1 + (let ((bodys1_0 + (let ((d_1 + (cdr + (unwrap + v_1)))) + d_1))) + (cons + bodys1_0 + bodys_0)))) + (values + bodys_1)))) + (for-loop_0 + bodys_1 + rest_0))))) + bodys_0)))))) + (for-loop_0 null d_0))))) + (reverse$1 bodys_0))))) + (body-leftover-size_0 bodys_0 (sub1 size_1))) + (if (if (eq? 'let-values hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) + (begin + (if (not + (begin-unsafe + (null? + (unwrap lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_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_0 + (unwrap + '()))) + (eq? + app_0 (unwrap - v_1)))) - d_1))) - (cons - bodys1_0 - bodys_0)))) - (values - bodys_1)))) - (for-loop_3 - bodys_1 - rest_0))))) - bodys_0)))))) - (for-loop_3 null d_0))))) - (reverse$1 bodys_0))))) - (body-leftover-size_0 bodys_0 (sub1 size_0))) - (if (if (eq? 'let-values hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) + (let ((rhss_0 + (let ((a_0 (car p_0))) + (let ((rhss_0 (begin (letrec* - ((for-loop_3 + ((for-loop_0 (|#%name| for-loop - (lambda (result_0 lst_0) + (lambda (rhss_0 lst_0) (begin (if (not (begin-unsafe @@ -58674,142 +47442,135 @@ null))) (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) + (let ((rhss_1 + (let ((rhss_1 + (let ((rhss2_0 + (let ((d_1 + (cdr + (unwrap + v_1)))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (cons + rhss2_0 + rhss_0)))) (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_3 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_3 #t a_1))) - #f)) - #t - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((rhss_0 - (let ((a_0 (car p_0))) - (let ((rhss_0 + rhss_1)))) + (for-loop_0 + rhss_1 + rest_0))))) + rhss_0)))))) + (for-loop_0 null a_0))))) + (reverse$1 rhss_0))))) + (let ((body_0 (let ((d_1 (cdr p_0))) d_1))) + (let ((rhss_1 rhss_0)) + (values rhss_1 body_0))))))) + (case-lambda + ((rhss_0 body_0) + (body-leftover-size_0 + (cons rhss_0 body_0) + (sub1 size_1))) + (args (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'letrec-values hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (if (let ((a_1 (car p_0))) + (if (wrap-list? a_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 lst_0) (begin - (letrec* - ((for-loop_3 - (|#%name| - for-loop - (lambda (rhss_0 - lst_0) - (begin - (if (not - (begin-unsafe - (null? + (if (not + (begin-unsafe + (null? + (unwrap + lst_0)))) + (let ((v_0 + (if (begin-unsafe + (pair? (unwrap - lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 - v_0)) - (let ((rhss_1 - (let ((rhss_1 - (let ((rhss2_0 - (let ((d_1 - (cdr - (unwrap - v_1)))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (cons - rhss2_0 - rhss_0)))) - (values - rhss_1)))) - (for-loop_3 - rhss_1 - rest_0))))) - rhss_0)))))) - (for-loop_3 - null - a_0))))) - (reverse$1 rhss_0))))) - (let ((body_0 - (let ((d_1 (cdr p_0))) d_1))) - (let ((rhss_1 rhss_0)) - (values rhss_1 body_0))))))) - (case-lambda - ((rhss_0 body_0) - (body-leftover-size_0 - (cons rhss_0 body_0) - (sub1 size_0))) - (args - (raise-binding-result-arity-error 2 args)))) - (if (if (eq? 'letrec-values hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (if (let ((a_1 (car p_0))) - (if (wrap-list? a_1) + lst_0))) + (wrap-car + lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe + (pair? + (unwrap + lst_0))) + (wrap-cdr + lst_0) + null))) + (let ((v_1 v_0)) + (let ((result_1 + (let ((result_1 + (let ((p_1 + (unwrap + v_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_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_3))))) + #f))) + #f)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + rest_0) + result_1))))) + result_0)))))) + (for-loop_0 #t a_1))) + #f)) + #t + #f) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) + (let ((rhss_0 + (let ((a_0 (car p_0))) + (let ((rhss_0 (begin (letrec* - ((for-loop_3 + ((for-loop_0 (|#%name| for-loop - (lambda (result_0 - lst_0) + (lambda (rhss_0 lst_0) (begin (if (not (begin-unsafe @@ -58834,438 +47595,385 @@ null))) (let ((v_1 v_0)) - (let ((result_1 - (let ((result_1 - (let ((p_1 - (unwrap - v_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_3))))) - #f))) - #f)))) + (let ((rhss_1 + (let ((rhss_1 + (let ((rhss3_0 + (let ((d_1 + (cdr + (unwrap + v_1)))) + (let ((a_1 + (car + (unwrap + d_1)))) + a_1)))) + (cons + rhss3_0 + rhss_0)))) (values - result_1)))) - (if (if (not - (let ((x_0 - (list - v_1))) - (not - result_1))) - #t - #f) - (for-loop_3 - result_1 - rest_0) - result_1))))) - result_0)))))) - (for-loop_3 #t a_1))) - #f)) - #t - #f) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((rhss_0 - (let ((a_0 (car p_0))) - (let ((rhss_0 - (begin - (letrec* - ((for-loop_3 - (|#%name| - for-loop - (lambda (rhss_0 - lst_0) - (begin - (if (not - (begin-unsafe - (null? - (unwrap - lst_0)))) - (let ((v_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-car - lst_0) - lst_0))) - (let ((rest_0 - (if (begin-unsafe - (pair? - (unwrap - lst_0))) - (wrap-cdr - lst_0) - null))) - (let ((v_1 - v_0)) - (let ((rhss_1 - (let ((rhss_1 - (let ((rhss3_0 - (let ((d_1 - (cdr - (unwrap - v_1)))) - (let ((a_1 - (car - (unwrap - d_1)))) - a_1)))) - (cons - rhss3_0 - rhss_0)))) - (values - rhss_1)))) - (for-loop_3 - rhss_1 - rest_0))))) - rhss_0)))))) - (for-loop_3 - null - a_0))))) - (reverse$1 rhss_0))))) - (let ((body_0 - (let ((d_1 (cdr p_0))) d_1))) - (let ((rhss_1 rhss_0)) - (values rhss_1 body_0))))))) - (case-lambda - ((rhss_0 body_0) - (body-leftover-size_0 - (cons rhss_0 body_0) - (sub1 size_0))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? 'if hd_0) - (let ((a_0 (cdr (unwrap e_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_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap a_3))))) - #f))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((tst_0 - (let ((a_0 (car p_0))) a_0))) - (call-with-values - (lambda () - (let ((d_1 (cdr p_0))) - (let ((p_1 (unwrap d_1))) - (let ((thn_0 - (let ((a_0 - (car p_1))) - a_0))) - (let ((els_0 - (let ((d_2 - (cdr p_1))) - (let ((a_0 - (car + rhss_1)))) + (for-loop_0 + rhss_1 + rest_0))))) + rhss_0)))))) + (for-loop_0 null a_0))))) + (reverse$1 rhss_0))))) + (let ((body_0 + (let ((d_1 (cdr p_0))) d_1))) + (let ((rhss_1 rhss_0)) + (values rhss_1 body_0))))))) + (case-lambda + ((rhss_0 body_0) + (body-leftover-size_0 + (cons rhss_0 body_0) + (sub1 size_1))) + (args + (raise-binding-result-arity-error 2 args)))) + (if (if (eq? 'if hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (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_0 + (unwrap '()))) + (eq? + app_0 + (unwrap a_3))))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) + (let ((tst_0 (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_1 (cdr p_0))) + (let ((p_1 (unwrap d_1))) + (let ((thn_0 + (let ((a_0 (car p_1))) + a_0))) + (let ((els_0 + (let ((d_2 (cdr p_1))) + (let ((a_0 + (car + (unwrap + d_2)))) + a_0)))) + (let ((thn_1 thn_0)) + (values thn_1 els_0))))))) + (case-lambda + ((thn_0 els_0) + (let ((tst_1 tst_0)) + (values tst_1 thn_0 els_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((tst_0 thn_0 els_0) + (leftover-size_0 + els_0 + (leftover-size_0 + thn_0 + (leftover-size_0 tst_0 (sub1 size_1))))) + (args + (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'with-continuation-mark* hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (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))) + (let ((p_3 + (unwrap a_3))) + (if (pair? p_3) + (let ((a_4 + (cdr p_3))) + (begin-unsafe + (let ((app_0 (unwrap - d_2)))) - a_0)))) - (let ((thn_1 thn_0)) - (values - thn_1 - els_0))))))) - (case-lambda - ((thn_0 els_0) - (let ((tst_1 tst_0)) - (values tst_1 thn_0 els_0))) - (args - (raise-binding-result-arity-error - 2 - args)))))))) - (case-lambda - ((tst_0 thn_0 els_0) - (leftover-size_0 - els_0 - (leftover-size_0 - thn_0 - (leftover-size_0 - tst_0 - (sub1 size_0))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (if (eq? 'with-continuation-mark* hd_0) - (let ((a_0 (cdr (unwrap e_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))) - (let ((p_3 - (unwrap - a_3))) - (if (pair? p_3) - (let ((a_4 - (cdr - p_3))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_4))))) - #f))) - #f))) - #f))) - #f))) - #f) + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((d_1 (cdr (unwrap d_0)))) + (let ((p_0 (unwrap d_1))) + (let ((key_0 + (let ((a_0 (car p_0))) a_0))) + (call-with-values + (lambda () + (let ((d_2 (cdr p_0))) + (let ((p_1 (unwrap d_2))) + (let ((val_0 + (let ((a_0 (car p_1))) + a_0))) + (let ((body_0 + (let ((d_3 + (cdr p_1))) + (let ((a_0 + (car + (unwrap + d_3)))) + a_0)))) + (let ((val_1 val_0)) + (values + val_1 + body_0))))))) + (case-lambda + ((val_0 body_0) + (let ((key_1 key_0)) + (values key_1 val_0 body_0))) + (args + (raise-binding-result-arity-error + 2 + args))))))))) + (case-lambda + ((key_0 val_0 body_0) + (leftover-size_0 + body_0 + (leftover-size_0 + val_0 + (leftover-size_0 key_0 (sub1 size_1))))) + (args + (raise-binding-result-arity-error 3 args)))) + (if (if (eq? 'begin-unsafe hd_0) #t #f) + (let ((body_0 + (let ((d_0 (cdr (unwrap e_1)))) d_0))) + (body-leftover-size_0 + body_0 + (sub1 size_1))) + (if (if (eq? 'begin0 hd_0) #t #f) + (let ((body_0 + (let ((d_0 (cdr (unwrap e_1)))) + d_0))) + (body-leftover-size_0 + body_0 + (sub1 size_1))) + (if (if (eq? 'quote hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? + app_0 + (unwrap a_1))))) + #f))) + #f) + (let ((v_0 + (let ((d_0 (cdr (unwrap e_1)))) + (let ((a_0 (car (unwrap d_0)))) + a_0)))) + (sub1 size_1)) + (if (if (eq? 'set! hd_0) + (let ((a_0 (cdr (unwrap e_1)))) + (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))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap a_2))))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 (cdr (unwrap e_1)))) + (let ((p_0 (unwrap d_0))) + (let ((id_0 + (let ((a_0 (car p_0))) + a_0))) + (let ((rhs_0 + (let ((d_1 (cdr p_0))) + (let ((a_0 + (car + (unwrap + d_1)))) + a_0)))) + (let ((id_1 id_0)) + (values id_1 rhs_0))))))) + (case-lambda + ((id_0 rhs_0) + (leftover-size_0 + rhs_0 + (sub1 size_1))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (if (eq? + '|#%variable-reference| + hd_0) + #t + #f) + (sub1 size_1) + (if (let ((p_0 (unwrap e_1))) + (if (pair? p_0) #t #f)) + (body-leftover-size_0 e_1 size_1) + (sub1 size_1))))))))))))))))))))) + (body-leftover-size_0 + (|#%name| + body-leftover-size + (lambda (body_0 size_1) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (size_2 lst_0) + (begin + (if (not (begin-unsafe (null? (unwrap lst_0)))) + (let ((e_1 + (if (begin-unsafe (pair? (unwrap lst_0))) + (wrap-car lst_0) + lst_0))) + (let ((rest_0 + (if (begin-unsafe (pair? (unwrap lst_0))) + (wrap-cdr lst_0) + null))) + (let ((e_2 e_1)) + (let ((next-k-proc_0 + (|#%name| + next-k-proc + (lambda (size_3) + (begin (for-loop_0 size_3 rest_0)))))) + (if (<= size_2 0) + size_2 + (let ((size_3 (leftover-size_0 e_2 size_2))) + (begin-unsafe + (begin (for-loop_0 size_3 rest_0))))))))) + size_2)))))) + (for-loop_0 size_1 body_0)))))))) + (letrec* + ((s-expr-leftover-size_0 + (|#%name| + s-expr-leftover-size + (lambda (v_0 size_1) + (begin + (if (<= size_1 0) + 0 + (if (pair? v_0) + (let ((app_0 (cdr v_0))) + (s-expr-leftover-size_0 + app_0 + (let ((app_1 (car v_0))) + (s-expr-leftover-size_0 app_1 (sub1 size_1))))) + (if (box? v_0) + (let ((app_0 (unbox v_0))) + (s-expr-leftover-size_0 app_0 (sub1 size_1))) + (if (vector? v_0) + (call-with-values + (lambda () + (begin + (check-vector v_0) + (values v_0 (unsafe-vector-length v_0)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (size_2 pos_0) + (begin + (if (unsafe-fx< pos_0 len_0) + (let ((v_1 + (unsafe-vector-ref vec_0 pos_0))) + (let ((next-k-proc_0 + (|#%name| + next-k-proc + (lambda (size_3) + (begin + (for-loop_0 + size_3 + (unsafe-fx+ 1 pos_0))))))) + (if (<= size_2 0) + size_2 + (let ((size_3 + (s-expr-leftover-size_0 + v_1 + size_2))) + (next-k-proc_0 size_3))))) + size_2)))))) + (for-loop_0 (sub1 size_1) 0)))) + (args (raise-binding-result-arity-error 2 args)))) + (if (prefab-struct-key v_0) + (s-expr-leftover-size_0 (struct->vector v_0) size_1) + (if (hash? v_0) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (size_2 i_0) + (begin + (if i_0 (call-with-values (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((d_1 (cdr (unwrap d_0)))) - (let ((p_0 (unwrap d_1))) - (let ((key_0 - (let ((a_0 (car p_0))) - a_0))) - (call-with-values - (lambda () - (let ((d_2 (cdr p_0))) - (let ((p_1 (unwrap d_2))) - (let ((val_0 - (let ((a_0 - (car - p_1))) - a_0))) - (let ((body_0 - (let ((d_3 - (cdr - p_1))) - (let ((a_0 - (car - (unwrap - d_3)))) - a_0)))) - (let ((val_1 val_0)) - (values - val_1 - body_0))))))) - (case-lambda - ((val_0 body_0) - (let ((key_1 key_0)) - (values - key_1 - val_0 - body_0))) - (args - (raise-binding-result-arity-error - 2 - args))))))))) + (hash-iterate-key+value v_0 i_0)) (case-lambda - ((key_0 val_0 body_0) - (leftover-size_0 - body_0 - (leftover-size_0 - val_0 - (leftover-size_0 - key_0 - (sub1 size_0))))) + ((k_0 v_1) + (let ((next-k-proc_0 + (|#%name| + next-k-proc + (lambda (size_3) + (begin + (for-loop_0 + size_3 + (hash-iterate-next + v_0 + i_0))))))) + (if (<= size_2 0) + size_2 + (let ((size_3 + (s-expr-leftover-size_0 + v_1 + (s-expr-leftover-size_0 + k_0 + size_2)))) + (next-k-proc_0 size_3))))) (args (raise-binding-result-arity-error - 3 + 2 args)))) - (if (if (eq? 'begin-unsafe hd_0) #t #f) - (let ((body_0 - (let ((d_0 (cdr (unwrap e_0)))) - d_0))) - (body-leftover-size_0 - body_0 - (sub1 size_0))) - (if (if (eq? 'begin0 hd_0) #t #f) - (let ((body_0 - (let ((d_0 (cdr (unwrap e_0)))) - d_0))) - (body-leftover-size_0 - body_0 - (sub1 size_0))) - (if (if (eq? 'quote hd_0) - (let ((a_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap a_0))) - (if (pair? p_0) - (let ((a_1 (cdr p_0))) - (begin-unsafe - (let ((app_0 - (unwrap '()))) - (eq? - app_0 - (unwrap a_1))))) - #f))) - #f) - (let ((v_0 - (let ((d_0 - (cdr (unwrap e_0)))) - (let ((a_0 - (car (unwrap d_0)))) - a_0)))) - (sub1 size_0)) - (if (if (eq? 'set! hd_0) - (let ((a_0 - (cdr (unwrap e_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))) - (begin-unsafe - (let ((app_0 - (unwrap - '()))) - (eq? - app_0 - (unwrap - a_2))))) - #f))) - #f))) - #f) - (call-with-values - (lambda () - (let ((d_0 (cdr (unwrap e_0)))) - (let ((p_0 (unwrap d_0))) - (let ((id_0 - (let ((a_0 - (car p_0))) - a_0))) - (let ((rhs_0 - (let ((d_1 - (cdr p_0))) - (let ((a_0 - (car - (unwrap - d_1)))) - a_0)))) - (let ((id_1 id_0)) - (values - id_1 - rhs_0))))))) - (case-lambda - ((id_0 rhs_0) - (leftover-size_0 - rhs_0 - (sub1 size_0))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (if (eq? - '|#%variable-reference| - hd_0) - #t - #f) - (sub1 size_0) - (if (let ((p_0 (unwrap e_0))) - (if (pair? p_0) #t #f)) - (body-leftover-size_0 - e_0 - size_0) - (sub1 - size_0))))))))))))))))))))) - (next-k-proc_0 - (|#%name| - next-k-proc - (lambda (rest_0 size_0) (begin (for-loop_2 size_0 rest_0))))) - (next-k-proc_1 - (|#%name| - next-k-proc - (lambda (len_0 pos_0 vec_0 size_0) - (begin (for-loop_0 len_0 vec_0 size_0 (unsafe-fx+ 1 pos_0)))))) - (next-k-proc_2 - (|#%name| - next-k-proc - (lambda (i_0 v_0 size_0) - (begin (for-loop_1 v_0 size_0 (hash-iterate-next v_0 i_0)))))) - (s-expr-leftover-size_0 - (|#%name| - s-expr-leftover-size - (lambda (v_0 size_0) - (begin - (if (<= size_0 0) - 0 - (if (pair? v_0) - (let ((app_0 (cdr v_0))) - (s-expr-leftover-size_0 - app_0 - (let ((app_1 (car v_0))) - (s-expr-leftover-size_0 app_1 (sub1 size_0))))) - (if (box? v_0) - (let ((app_0 (unbox v_0))) - (s-expr-leftover-size_0 app_0 (sub1 size_0))) - (if (vector? v_0) - (call-with-values - (lambda () - (begin - (check-vector v_0) - (values v_0 (unsafe-vector-length v_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (for-loop_0 len_0 vec_0 (sub1 size_0) 0))) - (args (raise-binding-result-arity-error 2 args)))) - (if (prefab-struct-key v_0) - (s-expr-leftover-size_0 (struct->vector v_0) size_0) - (if (hash? v_0) - (begin - (let ((app_0 (sub1 size_0))) - (for-loop_1 - v_0 - app_0 - (hash-iterate-first v_0)))) - (sub1 size_0)))))))))))) - (lambda (e_0 size_0 serializable?_0) + size_2)))))) + (let ((app_0 (sub1 size_1))) + (for-loop_0 app_0 (hash-iterate-first v_0))))) + (sub1 size_1)))))))))))) (let ((hd_0 (let ((p_0 (unwrap e_0))) (if (pair? p_0) (unwrap (car p_0)) #f)))) @@ -59282,7 +47990,7 @@ (let ((d_1 (cdr (unwrap d_0)))) (let ((d_2 (cdr (unwrap d_1)))) d_2))))) (<= (body-leftover-size_0 body_0 size_0) 0)) - (error 'match "failed ~e" e_0)))))) + (error 'match "failed ~e" e_0))))))) (define ->fasl (let ((->fasl_0 (|#%name| diff --git a/racket/src/cs/schemified/thread.scm b/racket/src/cs/schemified/thread.scm index 759e643da4..95c2624c4a 100644 --- a/racket/src/cs/schemified/thread.scm +++ b/racket/src/cs/schemified/thread.scm @@ -296,31 +296,26 @@ (define false-thread-cell (make-thread-cell #f)) (define handler-prompt-key (make-continuation-prompt-tag 'handler-prompt-tag)) (define call-handled-body - (letrec ((procz2 - (lambda (bpz_0 body-thunk_0) - (with-continuation-mark* - authentic - break-enabled-key - bpz_0 - (with-continuation-mark* - authentic - exception-handler-key - procz1 - (|#%app| body-thunk_0))))) - (procz1 - (lambda (e_0) - (abort-current-continuation handler-prompt-key e_0)))) - (lambda (bpz_0 handle-proc_0 body-thunk_0) - (with-continuation-mark* - authentic - break-enabled-key - false-thread-cell - (call-with-continuation-prompt - procz2 - handler-prompt-key - handle-proc_0 - bpz_0 - body-thunk_0))))) + (lambda (bpz_0 handle-proc_0 body-thunk_0) + (with-continuation-mark* + authentic + break-enabled-key + false-thread-cell + (call-with-continuation-prompt + (lambda (bpz_1 body-thunk_1) + (with-continuation-mark* + authentic + break-enabled-key + bpz_1 + (with-continuation-mark* + authentic + exception-handler-key + (lambda (e_0) (abort-current-continuation handler-prompt-key e_0)) + (|#%app| body-thunk_1)))) + handler-prompt-key + handle-proc_0 + bpz_0 + body-thunk_0)))) (define-values (prop:keyword-impersonator keyword-impersonator? keyword-impersonator-ref) (make-struct-type-property 'keyword-impersonator)) @@ -614,37 +609,42 @@ (lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 1))) (lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 2)))))))) (define empty-stream (make-do-stream (lambda () #t) void void)) -(define map_2960 +(define map_1346 (|#%name| map - (letrec ((loop_0 - (|#%name| - loop - (lambda (f_0 l1_0 l2_0) - (begin - (if (null? l1_0) - null - (let ((r1_0 (cdr l1_0))) - (let ((r2_0 (cdr l2_0))) - (let ((r1_1 r1_0)) - (let ((app_0 - (let ((app_0 (car l1_0))) - (|#%app| f_0 app_0 (car l2_0))))) - (cons app_0 (loop_0 f_0 r1_1 r2_0))))))))))) - (loop_1 - (|#%name| - loop - (lambda (f_0 l_0) - (begin - (if (null? l_0) - null - (let ((r_0 (cdr l_0))) - (let ((app_0 (|#%app| f_0 (car l_0)))) - (cons app_0 (loop_1 f_0 r_0)))))))))) - (case-lambda - ((f_0 l_0) (begin (loop_1 f_0 l_0))) - ((f_0 l1_0 l2_0) (loop_0 f_0 l1_0 l2_0)) - ((f_0 l_0 . args_0) (gen-map f_0 (cons l_0 args_0))))))) + (case-lambda + ((f_0 l_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1) + (begin + (if (null? l_1) + null + (let ((r_0 (cdr l_1))) + (let ((app_0 (|#%app| f_0 (car l_1)))) + (cons app_0 (loop_0 r_0)))))))))) + (loop_0 l_0)))) + ((f_0 l1_0 l2_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l1_1 l2_1) + (begin + (if (null? l1_1) + null + (let ((r1_0 (cdr l1_1))) + (let ((r2_0 (cdr l2_1))) + (let ((r1_1 r1_0)) + (let ((app_0 + (let ((app_0 (car l1_1))) + (|#%app| f_0 app_0 (car l2_1))))) + (cons app_0 (loop_0 r1_1 r2_0)))))))))))) + (loop_0 l1_0 l2_0))) + ((f_0 l_0 . args_0) (gen-map f_0 (cons l_0 args_0)))))) (define for-each_2380 (|#%name| for-each @@ -681,144 +681,165 @@ (loop_0 l1_0 l2_0))) ((f_0 l_0 . args_0) (gen-for-each f_0 (cons l_0 args_0)))))) (define check-args - (letrec ((loop_0 - (|#%name| - loop - (lambda (kws_0) - (begin - (if (null? kws_0) - null - (let ((app_0 - (string-append "#:" (keyword->string (car kws_0))))) - (list* " " app_0 (loop_0 (cdr kws_0))))))))) - (loop_1 - (|#%name| - loop - (lambda (w_0 ls_0) - (begin - (if (null? ls_0) - null - (let ((app_0 - (string-append - "\n " - (let ((app_0 (error-value->string-handler))) - (|#%app| app_0 (car ls_0) w_0))))) - (cons app_0 (loop_1 w_0 (cdr ls_0)))))))))) - (lambda (who_0 f_0 ls_0) - (begin - (if (procedure? f_0) - (void) - (raise-argument-error who_0 "procedure?" f_0)) - (letrec* - ((loop_2 - (|#%name| - loop - (lambda (prev-len_0 ls_1 i_0) - (begin - (if (null? ls_1) - (void) - (let ((l_0 (car ls_1))) - (begin - (if (list? l_0) - (void) - (raise-argument-error who_0 "list?" l_0)) - (let ((len_0 (length l_0))) - (begin - (if (if prev-len_0 (not (= len_0 prev-len_0)) #f) - (raise-arguments-error - who_0 - "all lists must have same size" - "first list length" - prev-len_0 - "other list length" - len_0 - "procedure" - f_0) - (void)) - (let ((app_0 (cdr ls_1))) - (loop_2 len_0 app_0 (add1 i_0))))))))))))) - (loop_2 #f ls_0 1)) - (if (procedure-arity-includes? f_0 (length ls_0)) - (void) - (call-with-values - (lambda () (procedure-keywords f_0)) - (case-lambda - ((required-keywords_0 optional-keywords_0) - (let ((app_0 - (if (pair? required-keywords_0) - (string-append - "argument mismatch;\n" - " the given procedure expects keyword arguments") - (string-append - "argument mismatch;\n" - " the given procedure's expected number of arguments does not match" - " the given number of lists")))) - (let ((app_1 - (unquoted-printing-string - (let ((or-part_0 - (let ((n_0 (object-name f_0))) - (if (symbol? n_0) (symbol->string n_0) #f)))) - (if or-part_0 or-part_0 "#"))))) - (apply - raise-arguments-error - who_0 - app_0 - "given procedure" - app_1 - (let ((app_2 - (let ((a_0 (procedure-arity f_0))) - (if (pair? required-keywords_0) - null - (if (integer? a_0) - (list "expected" a_0) - (if (arity-at-least? a_0) - (list - "expected" - (unquoted-printing-string - (string-append - "at least " - (number->string - (arity-at-least-value a_0))))) - null)))))) - (let ((app_3 - (if (pair? required-keywords_0) - null - (list "given" (length ls_0))))) - (let ((app_4 - (if (pair? required-keywords_0) + (lambda (who_0 f_0 ls_0) + (begin + (if (procedure? f_0) + (void) + (raise-argument-error who_0 "procedure?" f_0)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (prev-len_0 ls_1 i_0) + (begin + (if (null? ls_1) + (void) + (let ((l_0 (car ls_1))) + (begin + (if (list? l_0) + (void) + (raise-argument-error who_0 "list?" l_0)) + (let ((len_0 (length l_0))) + (begin + (if (if prev-len_0 (not (= len_0 prev-len_0)) #f) + (raise-arguments-error + who_0 + "all lists must have same size" + "first list length" + prev-len_0 + "other list length" + len_0 + "procedure" + f_0) + (void)) + (let ((app_0 (cdr ls_1))) + (loop_0 len_0 app_0 (add1 i_0))))))))))))) + (loop_0 #f ls_0 1)) + (if (procedure-arity-includes? f_0 (length ls_0)) + (void) + (call-with-values + (lambda () (procedure-keywords f_0)) + (case-lambda + ((required-keywords_0 optional-keywords_0) + (let ((app_0 + (if (pair? required-keywords_0) + (string-append + "argument mismatch;\n" + " the given procedure expects keyword arguments") + (string-append + "argument mismatch;\n" + " the given procedure's expected number of arguments does not match" + " the given number of lists")))) + (let ((app_1 + (unquoted-printing-string + (let ((or-part_0 + (let ((n_0 (object-name f_0))) + (if (symbol? n_0) (symbol->string n_0) #f)))) + (if or-part_0 or-part_0 "#"))))) + (apply + raise-arguments-error + who_0 + app_0 + "given procedure" + app_1 + (let ((app_2 + (let ((a_0 (procedure-arity f_0))) + (if (pair? required-keywords_0) + null + (if (integer? a_0) + (list "expected" a_0) + (if (arity-at-least? a_0) (list - "required keywords" + "expected" (unquoted-printing-string - (apply - string-append - (cdr (loop_0 required-keywords_0))))) - null))) - (append - app_2 - app_3 - app_4 - (let ((w_0 - (let ((app_5 (error-print-width))) - (quotient app_5 (length ls_0))))) - (if (> w_0 10) + (string-append + "at least " + (number->string + (arity-at-least-value a_0))))) + null)))))) + (let ((app_3 + (if (pair? required-keywords_0) + null + (list "given" (length ls_0))))) + (let ((app_4 + (if (pair? required-keywords_0) (list - "argument lists..." + "required keywords" (unquoted-printing-string - (apply string-append (loop_1 w_0 ls_0)))) - null)))))))))) - (args (raise-binding-result-arity-error 2 args))))))))) + (apply + string-append + (cdr + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (kws_0) + (begin + (if (null? kws_0) + null + (let ((app_4 + (string-append + "#:" + (keyword->string + (car kws_0))))) + (list* + " " + app_4 + (loop_0 (cdr kws_0)))))))))) + (loop_0 required-keywords_0)))))) + null))) + (append + app_2 + app_3 + app_4 + (let ((w_0 + (let ((app_5 (error-print-width))) + (quotient app_5 (length ls_0))))) + (if (> w_0 10) + (list + "argument lists..." + (unquoted-printing-string + (apply + string-append + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ls_1) + (begin + (if (null? ls_1) + null + (let ((app_5 + (string-append + "\n " + (let ((app_5 + (error-value->string-handler))) + (|#%app| + app_5 + (car ls_1) + w_0))))) + (cons + app_5 + (loop_0 (cdr ls_1)))))))))) + (loop_0 ls_0))))) + null)))))))))) + (args (raise-binding-result-arity-error 2 args)))))))) (define gen-map - (letrec ((loop_0 - (|#%name| - loop - (lambda (f_0 ls_0) - (begin - (if (null? (car ls_0)) - null - (let ((next-ls_0 (map_2960 cdr ls_0))) - (let ((app_0 (apply f_0 (map_2960 car ls_0)))) - (cons app_0 (loop_0 f_0 next-ls_0)))))))))) - (lambda (f_0 ls_0) (begin #t (loop_0 f_0 ls_0))))) + (lambda (f_0 ls_0) + (begin + #t + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (ls_1) + (begin + (if (null? (car ls_1)) + null + (let ((next-ls_0 (map_1346 cdr ls_1))) + (let ((app_0 (apply f_0 (map_1346 car ls_1)))) + (cons app_0 (loop_0 next-ls_0)))))))))) + (loop_0 ls_0))))) (define gen-for-each (lambda (f_0 ls_0) (begin @@ -831,9 +852,9 @@ (begin (if (null? (car ls_1)) (void) - (let ((next-ls_0 (map_2960 cdr ls_1))) + (let ((next-ls_0 (map_1346 cdr ls_1))) (begin - (apply f_0 (map_2960 car ls_1)) + (apply f_0 (map_1346 car ls_1)) (loop_0 next-ls_0))))))))) (loop_0 ls_0))))) (define -random @@ -930,16 +951,18 @@ prng_0)) (+ min_0 (random d_0 prng_0))))))))) (define hash-keys - (letrec ((loop_0 - (|#%name| - loop - (lambda (h_0 pos_0) - (begin - (if pos_0 - (let ((app_0 (hash-iterate-key h_0 pos_0))) - (cons app_0 (loop_0 h_0 (hash-iterate-next h_0 pos_0)))) - null)))))) - (lambda (h_0) (loop_0 h_0 (hash-iterate-first h_0))))) + (lambda (h_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_0) + (begin + (if pos_0 + (let ((app_0 (hash-iterate-key h_0 pos_0))) + (cons app_0 (loop_0 (hash-iterate-next h_0 pos_0)))) + null)))))) + (loop_0 (hash-iterate-first h_0))))) (define hash-empty? (lambda (table_0) (begin @@ -2795,98 +2818,177 @@ (define message-ized-unmessage (|#%name| message-ized-unmessage (record-accessor struct:message-ized 0))) (define allowed?.1 - (letrec ((loop_0 - (|#%name| - loop - (lambda (direct?2_0 v_0 graph_0) - (begin - (let ((or-part_0 (number? v_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (char? v_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 (boolean? v_0))) - (if or-part_2 - or-part_2 - (let ((or-part_3 (keyword? v_0))) - (if or-part_3 - or-part_3 - (let ((or-part_4 (void? v_0))) - (if or-part_4 - or-part_4 - (let ((or-part_5 (symbol? v_0))) - (if or-part_5 - or-part_5 - (let ((or-part_6 - (if (let ((or-part_6 - (string? v_0))) - (if or-part_6 - or-part_6 - (bytes? v_0))) - (let ((or-part_6 - (not direct?2_0))) + (|#%name| + allowed? + (lambda (direct?2_0 v4_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_0 graph_0) + (begin + (let ((or-part_0 (number? v_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (char? v_0))) + (if or-part_1 + or-part_1 + (let ((or-part_2 (boolean? v_0))) + (if or-part_2 + or-part_2 + (let ((or-part_3 (keyword? v_0))) + (if or-part_3 + or-part_3 + (let ((or-part_4 (void? v_0))) + (if or-part_4 + or-part_4 + (let ((or-part_5 (symbol? v_0))) + (if or-part_5 + or-part_5 + (let ((or-part_6 + (if (let ((or-part_6 + (string? v_0))) (if or-part_6 or-part_6 - (let ((or-part_7 - (immutable? v_0))) - (if or-part_7 - or-part_7 - (if (bytes? v_0) - (place-shared? v_0) - #f))))) - #f))) - (if or-part_6 - or-part_6 - (let ((or-part_7 (null? v_0))) - (if or-part_7 - or-part_7 - (let ((or-part_8 - (if (pair? v_0) - (let ((or-part_8 - (hash-ref - graph_0 - v_0 - #f))) - (if or-part_8 - or-part_8 - (let ((graph_1 - (hash-set + (bytes? v_0))) + (let ((or-part_6 + (not direct?2_0))) + (if or-part_6 + or-part_6 + (let ((or-part_7 + (immutable? v_0))) + (if or-part_7 + or-part_7 + (if (bytes? v_0) + (place-shared? v_0) + #f))))) + #f))) + (if or-part_6 + or-part_6 + (let ((or-part_7 (null? v_0))) + (if or-part_7 + or-part_7 + (let ((or-part_8 + (if (pair? v_0) + (let ((or-part_8 + (hash-ref + graph_0 + v_0 + #f))) + (if or-part_8 + or-part_8 + (let ((graph_1 + (hash-set + graph_0 + v_0 + #t))) + (if (loop_0 + (car v_0) + graph_1) + (loop_0 + (cdr v_0) + graph_1) + #f)))) + #f))) + (if or-part_8 + or-part_8 + (let ((or-part_9 + (if (vector? v_0) + (if (let ((or-part_9 + (not + direct?2_0))) + (if or-part_9 + or-part_9 + (if (immutable? + v_0) + (not + (impersonator? + v_0)) + #f))) + (let ((or-part_9 + (hash-ref graph_0 v_0 - #t))) - (if (loop_0 - direct?2_0 - (car v_0) - graph_1) - (loop_0 - direct?2_0 - (cdr v_0) - graph_1) - #f)))) - #f))) - (if or-part_8 - or-part_8 - (let ((or-part_9 - (if (vector? v_0) - (if (let ((or-part_9 - (not - direct?2_0))) - (if or-part_9 - or-part_9 - (if (immutable? - v_0) - (not - (impersonator? - v_0)) - #f))) - (let ((or-part_9 + #f))) + (if or-part_9 + or-part_9 + (let ((graph_1 + (hash-set + graph_0 + v_0 + #t))) + (call-with-values + (lambda () + (begin + (check-vector + v_0) + (values + v_0 + (unsafe-vector-length + v_0)))) + (case-lambda + ((vec_0 + len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (let ((result_1 + (let ((result_1 + (loop_0 + e_0 + graph_1))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + e_0))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + (unsafe-fx+ + 1 + pos_0)) + result_1))) + result_0)))))) + (for-loop_0 + #t + 0)))) + (args + (raise-binding-result-arity-error + 2 + args))))))) + #f) + #f))) + (if or-part_9 + or-part_9 + (let ((or-part_10 + (if (immutable-prefab-struct-key + v_0) + (let ((or-part_10 (hash-ref graph_0 v_0 #f))) - (if or-part_9 - or-part_9 + (if or-part_10 + or-part_10 (let ((graph_1 (hash-set graph_0 @@ -2894,13 +2996,16 @@ #t))) (call-with-values (lambda () - (begin - (check-vector - v_0) - (values - v_0 - (unsafe-vector-length - v_0)))) + (let ((vec_0 + (struct->vector + v_0))) + (begin + (check-vector + vec_0) + (values + vec_0 + (unsafe-vector-length + vec_0))))) (case-lambda ((vec_0 len_0) @@ -2923,7 +3028,6 @@ (let ((result_1 (let ((result_1 (loop_0 - direct?2_0 e_0 graph_1))) (values @@ -2950,659 +3054,550 @@ (raise-binding-result-arity-error 2 args))))))) - #f) - #f))) - (if or-part_9 - or-part_9 - (let ((or-part_10 - (if (immutable-prefab-struct-key - v_0) - (let ((or-part_10 - (hash-ref - graph_0 - v_0 - #f))) - (if or-part_10 - or-part_10 - (let ((graph_1 - (hash-set - graph_0 - v_0 - #t))) - (call-with-values - (lambda () - (let ((vec_0 - (struct->vector - v_0))) - (begin - (check-vector - vec_0) - (values - vec_0 - (unsafe-vector-length - vec_0))))) - (case-lambda - ((vec_0 - len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (let ((result_1 - (let ((result_1 - (loop_0 - direct?2_0 - e_0 - graph_1))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - e_0))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - (unsafe-fx+ - 1 - pos_0)) - result_1))) - result_0)))))) - (for-loop_0 - #t - 0)))) - (args - (raise-binding-result-arity-error - 2 - args))))))) - #f))) - (if or-part_10 - or-part_10 - (let ((or-part_11 - (if (hash? - v_0) - (if (let ((or-part_11 - (not - direct?2_0))) - (if or-part_11 - or-part_11 - (if (immutable? - v_0) - (not - (impersonator? - v_0)) - #f))) - (let ((or-part_11 - (hash-ref - graph_0 - v_0 - #f))) + #f))) + (if or-part_10 + or-part_10 + (let ((or-part_11 + (if (hash? + v_0) + (if (let ((or-part_11 + (not + direct?2_0))) (if or-part_11 or-part_11 - (let ((graph_1 - (hash-set - graph_0 - v_0 - #t))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 - i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - v_0 - i_0)) - (case-lambda - ((k_0 - v_1) - (let ((result_1 - (let ((result_1 - (if (loop_0 - direct?2_0 - k_0 - graph_1) - (loop_0 - direct?2_0 - v_1 - graph_1) - #f))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - k_0 - v_1))) - (not - result_1))) - #t - #f) - (for-loop_0 - result_1 - (hash-iterate-next - v_0 - i_0)) - result_1))) - (args - (raise-binding-result-arity-error - 2 - args)))) - result_0)))))) - (for-loop_0 - #t - (hash-iterate-first - v_0))))))) - #f) - #f))) - (if or-part_11 - or-part_11 - (if (not - direct?2_0) - (let ((or-part_12 - (cpointer? - v_0))) - (if or-part_12 - or-part_12 - (let ((or-part_13 - (if (let ((or-part_13 - (fxvector? - v_0))) - (if or-part_13 - or-part_13 - (let ((or-part_14 - (flvector? - v_0))) - (if or-part_14 - or-part_14 - (bytes? - v_0))))) - (place-shared? + (if (immutable? + v_0) + (not + (impersonator? + v_0)) + #f))) + (let ((or-part_11 + (hash-ref + graph_0 + v_0 + #f))) + (if or-part_11 + or-part_11 + (let ((graph_1 + (hash-set + graph_0 + v_0 + #t))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 + i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + v_0 + i_0)) + (case-lambda + ((k_0 + v_1) + (let ((result_1 + (let ((result_1 + (if (loop_0 + k_0 + graph_1) + (loop_0 + v_1 + graph_1) + #f))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + k_0 + v_1))) + (not + result_1))) + #t + #f) + (for-loop_0 + result_1 + (hash-iterate-next + v_0 + i_0)) + result_1))) + (args + (raise-binding-result-arity-error + 2 + args)))) + result_0)))))) + (for-loop_0 + #t + (hash-iterate-first + v_0))))))) + #f) + #f))) + (if or-part_11 + or-part_11 + (if (not + direct?2_0) + (let ((or-part_12 + (cpointer? + v_0))) + (if or-part_12 + or-part_12 + (let ((or-part_13 + (if (let ((or-part_13 + (fxvector? + v_0))) + (if or-part_13 + or-part_13 + (let ((or-part_14 + (flvector? + v_0))) + (if or-part_14 + or-part_14 + (bytes? + v_0))))) + (place-shared? + v_0) + #f))) + (if or-part_13 + or-part_13 + (if (place-message? + v_0) + (if (|#%app| + (place-message-ref v_0) - #f))) - (if or-part_13 - or-part_13 - (if (place-message? v_0) - (if (|#%app| - (place-message-ref - v_0) - v_0) - #t - #f) - #f))))) - #f)))))))))))))))))))))))))))))) - (|#%name| - allowed? - (lambda (direct?2_0 v4_0) (begin (loop_0 direct?2_0 v4_0 hash2610)))))) + #t + #f) + #f))))) + #f)))))))))))))))))))))))))))))) + (loop_0 v4_0 hash2610)))))) (define place-message-allowed-direct? (lambda (v_0) (allowed?.1 #t v_0))) (define 1/place-message-allowed? (|#%name| place-message-allowed? (lambda (v_0) (begin (allowed?.1 #f v_0))))) (define message-ize - (letrec ((loop_0 - (|#%name| - loop - (lambda (fail_0 graph_0 used_0 v_0) - (begin - (if (let ((or-part_0 (number? v_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (char? v_0))) - (if or-part_1 - or-part_1 - (let ((or-part_2 (boolean? v_0))) - (if or-part_2 - or-part_2 - (let ((or-part_3 (keyword? v_0))) - (if or-part_3 - or-part_3 - (let ((or-part_4 (void? v_0))) - (if or-part_4 - or-part_4 - (let ((or-part_5 (symbol? v_0))) - (if or-part_5 - or-part_5 - (null? v_0))))))))))))) - v_0 - (if (string? v_0) - (string->immutable-string v_0) - (if (bytes? v_0) - (if (place-shared? v_0) - v_0 - (bytes->immutable-bytes v_0)) + (lambda (v_0 fail_0) + (let ((graph_0 #f)) + (let ((used_0 #f)) + (let ((maybe-ph_0 + (|#%name| + maybe-ph + (lambda (ph_0 v_1 new-v_0) + (begin + (if (if used_0 (hash-ref used_0 ph_0 #f) #f) + (begin (placeholder-set! ph_0 new-v_0) ph_0) + (begin (hash-remove! graph_0 v_1) new-v_0))))))) + (let ((new-v_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_1) (begin - (if (unsafe-unbox* graph_0) - (void) - (unsafe-set-box*! graph_0 (make-hasheq))) - (let ((c2_0 - (hash-ref (unsafe-unbox* graph_0) v_0 #f))) - (if c2_0 - (begin - (if (unsafe-unbox* used_0) - (void) - (unsafe-set-box*! used_0 (make-hasheq))) - (hash-set! (unsafe-unbox* used_0) c2_0 #t) - c2_0) - (if (pair? v_0) - (let ((ph_0 (make-placeholder #f))) - (begin - (hash-set! (unsafe-unbox* graph_0) v_0 ph_0) - (maybe-ph_0 - graph_0 - used_0 - ph_0 - v_0 - (let ((app_0 - (loop_0 - fail_0 - graph_0 - used_0 - (car v_0)))) - (cons - app_0 - (loop_0 - fail_0 - graph_0 - used_0 - (cdr v_0))))))) - (if (vector? v_0) - (let ((ph_0 (make-placeholder #f))) - (begin - (hash-set! - (unsafe-unbox* graph_0) - v_0 - ph_0) - (maybe-ph_0 - graph_0 - used_0 - ph_0 - v_0 - (let ((len_0 (vector-length v_0))) - (begin - (if (exact-nonnegative-integer? - len_0) - (void) - (raise-argument-error - 'for/vector - "exact-nonnegative-integer?" - len_0)) - (let ((v_1 (make-vector len_0 0))) - (begin - (if (zero? len_0) - (void) - (call-with-values - (lambda () - (begin - (check-vector v_0) - (values - v_0 - (unsafe-vector-length - v_0)))) - (case-lambda - ((vec_0 len_1) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0 pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_1) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (let ((i_1 - (let ((i_1 - (begin - (unsafe-vector*-set! - v_1 - i_0 - (loop_0 - fail_0 - graph_0 - used_0 - e_0)) - (unsafe-fx+ - 1 - i_0)))) - (values - i_1)))) - (if (if (not - (let ((x_0 - (list - e_0))) - (unsafe-fx= - i_1 - len_0))) - #t - #f) - (for-loop_0 - i_1 - (unsafe-fx+ - 1 - pos_0)) - i_1))) - i_0)))))) - (for-loop_0 0 0)))) - (args - (raise-binding-result-arity-error - 2 - args))))) - v_1))))))) - (let ((c1_0 - (immutable-prefab-struct-key v_0))) - (if c1_0 - (let ((ph_0 (make-placeholder #f))) - (begin - (hash-set! - (unsafe-unbox* graph_0) - v_0 - ph_0) - (maybe-ph_0 - graph_0 - used_0 - ph_0 - v_0 - (apply - make-prefab-struct - c1_0 - (reverse$1 - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - (struct->vector v_0) - 1 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 idx_0) - (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (loop_0 - fail_0 - graph_0 - used_0 - e_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - (unsafe-fx+ - idx_0 - 1)))) - fold-var_0)))))) - (for-loop_0 null start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args))))))))) - (if (hash? v_0) + (if (let ((or-part_0 (number? v_1))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (char? v_1))) + (if or-part_1 + or-part_1 + (let ((or-part_2 (boolean? v_1))) + (if or-part_2 + or-part_2 + (let ((or-part_3 (keyword? v_1))) + (if or-part_3 + or-part_3 + (let ((or-part_4 (void? v_1))) + (if or-part_4 + or-part_4 + (let ((or-part_5 + (symbol? v_1))) + (if or-part_5 + or-part_5 + (null? v_1))))))))))))) + v_1 + (if (string? v_1) + (string->immutable-string v_1) + (if (bytes? v_1) + (if (place-shared? v_1) + v_1 + (bytes->immutable-bytes v_1)) + (begin + (if graph_0 + (void) + (set! graph_0 (make-hasheq))) + (let ((c2_0 (hash-ref graph_0 v_1 #f))) + (if c2_0 + (begin + (if used_0 + (void) + (set! used_0 (make-hasheq))) + (hash-set! used_0 c2_0 #t) + c2_0) + (if (pair? v_1) (let ((ph_0 (make-placeholder #f))) (begin - (hash-set! - (unsafe-unbox* graph_0) - v_0 - ph_0) + (hash-set! graph_0 v_1 ph_0) (maybe-ph_0 - graph_0 - used_0 ph_0 - v_0 - (if (hash-eq? v_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) + v_1 + (let ((app_0 (loop_0 (car v_1)))) + (cons + app_0 + (loop_0 (cdr v_1))))))) + (if (vector? v_1) + (let ((ph_0 (make-placeholder #f))) + (begin + (hash-set! graph_0 v_1 ph_0) + (maybe-ph_0 + ph_0 + v_1 + (let ((len_0 + (vector-length v_1))) + (begin + (if (exact-nonnegative-integer? + len_0) + (void) + (raise-argument-error + 'for/vector + "exact-nonnegative-integer?" + len_0)) + (let ((v_2 + (make-vector + len_0 + 0))) + (begin + (if (zero? len_0) + (void) + (call-with-values + (lambda () + (begin + (check-vector v_1) + (values + v_1 + (unsafe-vector-length + v_1)))) + (case-lambda + ((vec_0 len_1) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0 + pos_0) + (begin + (if (unsafe-fx< + pos_0 + len_1) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (let ((i_1 + (let ((i_1 + (begin + (unsafe-vector*-set! + v_2 + i_0 + (loop_0 + e_0)) + (unsafe-fx+ + 1 + i_0)))) + (values + i_1)))) + (if (if (not + (let ((x_0 + (list + e_0))) + (unsafe-fx= + i_1 + len_0))) + #t + #f) + (for-loop_0 + i_1 + (unsafe-fx+ + 1 + pos_0)) + i_1))) + i_0)))))) + (for-loop_0 + 0 + 0)))) + (args + (raise-binding-result-arity-error + 2 + args))))) + v_2))))))) + (let ((c1_0 + (immutable-prefab-struct-key + v_1))) + (if c1_0 + (let ((ph_0 + (make-placeholder #f))) + (begin + (hash-set! graph_0 v_1 ph_0) + (maybe-ph_0 + ph_0 + v_1 + (apply + make-prefab-struct + c1_0 + (reverse$1 + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + (struct->vector v_1) + 1 + #f + 1)) + (case-lambda + ((v*_0 + start*_0 + stop*_0 + step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (loop_0 + e_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + (unsafe-fx+ + idx_0 + 1)))) + fold-var_0)))))) + (for-loop_0 + null + start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args))))))))) + (if (hash? v_1) + (let ((ph_0 + (make-placeholder #f))) + (begin + (hash-set! graph_0 v_1 ph_0) + (maybe-ph_0 + ph_0 + v_1 + (if (hash-eq? v_1) (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - v_0 - i_0)) - (case-lambda - ((k_0 v_1) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (let ((app_0 - (loop_0 - fail_0 - graph_0 - used_0 - k_0))) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 + i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + v_1 + i_0)) + (case-lambda + ((k_0 v_2) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (let ((app_0 + (loop_0 + k_0))) + (values + app_0 + (loop_0 + v_2)))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + v_1 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2610 + (hash-iterate-first + v_1)))) + (if (hash-eqv? v_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 + i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + v_1 + i_0)) + (case-lambda + ((k_0 + v_2) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (let ((app_0 + (loop_0 + k_0))) + (values + app_0 + (loop_0 + v_2)))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) (values - app_0 - (loop_0 - fail_0 - graph_0 - used_0 - v_1)))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - v_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2610 - (hash-iterate-first v_0)))) - (if (hash-eqv? v_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + v_1 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2589 + (hash-iterate-first + v_1)))) (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - v_0 - i_0)) - (case-lambda - ((k_0 v_1) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (let ((app_0 - (loop_0 - fail_0 - graph_0 - used_0 - k_0))) - (values - app_0 - (loop_0 - fail_0 - graph_0 - used_0 - v_1)))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - v_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2589 - (hash-iterate-first v_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - v_0 - i_0)) - (case-lambda - ((k_0 v_1) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (let ((app_0 - (loop_0 - fail_0 - graph_0 - used_0 - k_0))) - (values - app_0 - (loop_0 - fail_0 - graph_0 - used_0 - v_1)))) - (case-lambda - ((key_0 - val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values - table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - v_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2725 - (hash-iterate-first - v_0))))))))) - (if (cpointer? v_0) - (ptr-add v_0 0) - (if (if (let ((or-part_0 - (fxvector? v_0))) - (if or-part_0 - or-part_0 - (flvector? v_0))) - (place-shared? v_0) - #f) - v_0 - (if (place-message? v_0) - (let ((make-unmessager_0 - (|#%app| - (place-message-ref v_0) - v_0))) - (if make-unmessager_0 - (message-ized1.1 - (|#%app| make-unmessager_0)) - (|#%app| fail_0))) - (|#%app| fail_0))))))))))))))))))) - (maybe-ph_0 - (|#%name| - maybe-ph - (lambda (graph_0 used_0 ph_0 v_0 new-v_0) - (begin - (if (if (unsafe-unbox* used_0) - (hash-ref (unsafe-unbox* used_0) ph_0 #f) - #f) - (begin (placeholder-set! ph_0 new-v_0) ph_0) - (begin - (hash-remove! (unsafe-unbox* graph_0) v_0) - new-v_0))))))) - (lambda (v_0 fail_0) - (let ((graph_0 (box #f))) - (let ((used_0 (box #f))) - (let ((new-v_0 (loop_0 fail_0 graph_0 used_0 v_0))) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 + i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + v_1 + i_0)) + (case-lambda + ((k_0 + v_2) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (let ((app_0 + (loop_0 + k_0))) + (values + app_0 + (loop_0 + v_2)))) + (case-lambda + ((key_0 + val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values + table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next + v_1 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2725 + (hash-iterate-first + v_1))))))))) + (if (cpointer? v_1) + (ptr-add v_1 0) + (if (if (let ((or-part_0 + (fxvector? + v_1))) + (if or-part_0 + or-part_0 + (flvector? v_1))) + (place-shared? v_1) + #f) + v_1 + (if (place-message? v_1) + (let ((make-unmessager_0 + (|#%app| + (place-message-ref + v_1) + v_1))) + (if make-unmessager_0 + (message-ized1.1 + (|#%app| + make-unmessager_0)) + (|#%app| fail_0))) + (|#%app| + fail_0)))))))))))))))))))) + (loop_0 v_0)))) (message-ized1.1 new-v_0))))))) (define un-message-ize (lambda (v_0) @@ -3610,305 +3605,282 @@ (make-reader-graph (do-un-message-ize (message-ized-unmessage v_0))) v_0))) (define do-un-message-ize - (letrec ((loop_0 - (|#%name| - loop - (lambda (graph_0 v_0) - (begin - (if (placeholder? v_0) - (let ((ph_0 (make-placeholder #f))) - (begin - (if (unsafe-unbox* graph_0) - (void) - (unsafe-set-box*! graph_0 (make-hasheq))) - (let ((c4_0 (hash-ref (unsafe-unbox* graph_0) v_0 #f))) - (if c4_0 - c4_0 + (lambda (v_0) + (let ((graph_0 #f)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_1) + (begin + (if (placeholder? v_1) + (let ((ph_0 (make-placeholder #f))) + (begin + (if graph_0 (void) (set! graph_0 (make-hasheq))) + (let ((c4_0 (hash-ref graph_0 v_1 #f))) + (if c4_0 + c4_0 + (begin + (hash-set! graph_0 v_1 ph_0) + (placeholder-set! + ph_0 + (loop_0 (placeholder-get v_1))) + ph_0))))) + (if (pair? v_1) + (let ((app_0 (loop_0 (car v_1)))) + (cons app_0 (loop_0 (cdr v_1)))) + (if (vector? v_1) + (vector->immutable-vector + (let ((len_0 (vector-length v_1))) + (begin + (if (exact-nonnegative-integer? len_0) + (void) + (raise-argument-error + 'for/vector + "exact-nonnegative-integer?" + len_0)) + (let ((v_2 (make-vector len_0 0))) (begin - (hash-set! (unsafe-unbox* graph_0) v_0 ph_0) - (placeholder-set! - ph_0 - (loop_0 graph_0 (placeholder-get v_0))) - ph_0))))) - (if (pair? v_0) - (let ((app_0 (loop_0 graph_0 (car v_0)))) - (cons app_0 (loop_0 graph_0 (cdr v_0)))) - (if (vector? v_0) - (vector->immutable-vector - (let ((len_0 (vector-length v_0))) - (begin - (if (exact-nonnegative-integer? len_0) - (void) - (raise-argument-error - 'for/vector - "exact-nonnegative-integer?" - len_0)) - (let ((v_1 (make-vector len_0 0))) + (if (zero? len_0) + (void) + (call-with-values + (lambda () + (begin + (check-vector v_1) + (values v_1 (unsafe-vector-length v_1)))) + (case-lambda + ((vec_0 len_1) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0 pos_0) + (begin + (if (unsafe-fx< pos_0 len_1) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (let ((i_1 + (let ((i_1 + (begin + (unsafe-vector*-set! + v_2 + i_0 + (loop_0 e_0)) + (unsafe-fx+ + 1 + i_0)))) + (values i_1)))) + (if (if (not + (let ((x_0 + (list e_0))) + (unsafe-fx= + i_1 + len_0))) + #t + #f) + (for-loop_0 + i_1 + (unsafe-fx+ 1 pos_0)) + i_1))) + i_0)))))) + (for-loop_0 0 0)))) + (args + (raise-binding-result-arity-error 2 args))))) + v_2))))) + (let ((c3_0 (immutable-prefab-struct-key v_1))) + (if c3_0 + (apply + make-prefab-struct + c3_0 + (reverse$1 + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + (struct->vector v_1) + 1 + #f + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 idx_0) + (begin + (if (unsafe-fx< idx_0 stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (loop_0 e_0) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 + fold-var_1 + (unsafe-fx+ idx_0 1)))) + fold-var_0)))))) + (for-loop_0 null start*_0)))) + (args + (raise-binding-result-arity-error 4 args)))))) + (if (hash? v_1) + (if (hash-eq? v_1) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value v_1 i_0)) + (case-lambda + ((k_0 v_2) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (let ((app_0 + (loop_0 + k_0))) + (values + app_0 + (loop_0 v_2)))) + (case-lambda + ((key_0 val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next v_1 i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2610 + (hash-iterate-first v_1)))) + (if (hash-eqv? v_1) (begin - (if (zero? len_0) - (void) - (call-with-values - (lambda () - (begin - (check-vector v_0) - (values - v_0 - (unsafe-vector-length v_0)))) - (case-lambda - ((vec_0 len_1) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0 pos_0) - (begin - (if (unsafe-fx< pos_0 len_1) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (let ((i_1 - (let ((i_1 - (begin - (unsafe-vector*-set! - v_1 - i_0 - (loop_0 - graph_0 - e_0)) - (unsafe-fx+ - 1 - i_0)))) - (values i_1)))) - (if (if (not - (let ((x_0 - (list - e_0))) - (unsafe-fx= - i_1 - len_0))) - #t - #f) - (for-loop_0 - i_1 - (unsafe-fx+ 1 pos_0)) - i_1))) - i_0)))))) - (for-loop_0 0 0)))) - (args - (raise-binding-result-arity-error - 2 - args))))) - v_1))))) - (let ((c3_0 (immutable-prefab-struct-key v_0))) - (if c3_0 - (apply - make-prefab-struct - c3_0 - (reverse$1 - (call-with-values - (lambda () - (unsafe-normalise-inputs - unsafe-vector-length - (struct->vector v_0) - 1 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 idx_0) - (begin - (if (unsafe-fx< idx_0 stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (loop_0 - graph_0 - e_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - (unsafe-fx+ idx_0 1)))) - fold-var_0)))))) - (for-loop_0 null start*_0)))) - (args - (raise-binding-result-arity-error 4 args)))))) - (if (hash? v_0) - (if (hash-eq? v_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value v_0 i_0)) - (case-lambda - ((k_0 v_1) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (let ((app_0 - (loop_0 - graph_0 - k_0))) - (values - app_0 - (loop_0 - graph_0 - v_1)))) - (case-lambda - ((key_0 val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next v_0 i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2610 - (hash-iterate-first v_0)))) - (if (hash-eqv? v_0) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - v_0 - i_0)) - (case-lambda - ((k_0 v_1) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (let ((app_0 - (loop_0 - graph_0 - k_0))) - (values - app_0 - (loop_0 - graph_0 - v_1)))) - (case-lambda - ((key_0 val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - v_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2589 - (hash-iterate-first v_0)))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (table_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - v_0 - i_0)) - (case-lambda - ((k_0 v_1) - (let ((table_1 - (let ((table_1 - (call-with-values - (lambda () - (let ((app_0 - (loop_0 - graph_0 - k_0))) - (values - app_0 - (loop_0 - graph_0 - v_1)))) - (case-lambda - ((key_0 val_0) - (hash-set - table_0 - key_0 - val_0)) - (args - (raise-binding-result-arity-error - 2 - args)))))) - (values table_1)))) - (for-loop_0 - table_1 - (hash-iterate-next - v_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - table_0)))))) - (for-loop_0 - hash2725 - (hash-iterate-first v_0)))))) - (if (if (cpointer? v_0) - (if v_0 (not (bytes? v_0)) #f) - #f) - (ptr-add v_0 0) - (if (message-ized? v_0) - (|#%app| (message-ized-unmessage v_0)) - v_0))))))))))))) - (lambda (v_0) (let ((graph_0 (box #f))) (loop_0 graph_0 v_0))))) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value v_1 i_0)) + (case-lambda + ((k_0 v_2) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (let ((app_0 + (loop_0 + k_0))) + (values + app_0 + (loop_0 + v_2)))) + (case-lambda + ((key_0 val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next v_1 i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2589 + (hash-iterate-first v_1)))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (table_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value v_1 i_0)) + (case-lambda + ((k_0 v_2) + (let ((table_1 + (let ((table_1 + (call-with-values + (lambda () + (let ((app_0 + (loop_0 + k_0))) + (values + app_0 + (loop_0 + v_2)))) + (case-lambda + ((key_0 val_0) + (hash-set + table_0 + key_0 + val_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))) + (values table_1)))) + (for-loop_0 + table_1 + (hash-iterate-next v_1 i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + table_0)))))) + (for-loop_0 + hash2725 + (hash-iterate-first v_1)))))) + (if (if (cpointer? v_1) + (if v_1 (not (bytes? v_1)) #f) + #f) + (ptr-add v_1 0) + (if (message-ized? v_1) + (|#%app| (message-ized-unmessage v_1)) + v_1))))))))))))) + (loop_0 v_0))))) (define struct:place (make-record-type-descriptor* 'place #f #f #f #f 19 491440)) (define effect_3085 @@ -4848,16 +4820,17 @@ ((p_0 proc_0) (begin (plumber-add-flush!_0 p_0 proc_0 #f))) ((p_0 proc_0 weak?3_0) (plumber-add-flush!_0 p_0 proc_0 weak?3_0)))))) (define 1/plumber-flush-all - (letrec ((procz1 (lambda (proc_0 h_0) (|#%app| proc_0 h_0)))) - (|#%name| - plumber-flush-all - (lambda (p_0) + (|#%name| + plumber-flush-all + (lambda (p_0) + (begin (begin - (begin - (if (1/plumber? p_0) - (void) - (raise-argument-error 'plumber-flush-all "plumber?" p_0)) - (plumber-flush-all/wrap p_0 procz1))))))) + (if (1/plumber? p_0) + (void) + (raise-argument-error 'plumber-flush-all "plumber?" p_0)) + (plumber-flush-all/wrap + p_0 + (lambda (proc_0 h_0) (|#%app| proc_0 h_0)))))))) (define plumber-flush-all/wrap (lambda (p_0 app_0) (let ((hs_0 @@ -5884,31 +5857,30 @@ (void)) (check-limit-custodian c_0)))) (define 1/make-custodian-box - (letrec ((procz1 - (|#%name| - temp76 - (lambda (b_0) (begin (set-custodian-box-v! b_0 #f)))))) - (|#%name| - make-custodian-box - (lambda (c_0 v_0) + (|#%name| + make-custodian-box + (lambda (c_0 v_0) + (begin (begin - (begin - (if (1/custodian? c_0) - (void) - (raise-argument-error 'make-custodian-box "custodian?" c_0)) - (let ((b_0 - (custodian-box1.1 v_0 (custodian-get-shutdown-sema c_0)))) - (begin - (if (let ((temp76_0 procz1)) - (do-custodian-register.1 #f #t #f #t c_0 b_0 temp76_0)) - (void) - (begin-unsafe - (raise-arguments-error - 'make-custodian-box - "the custodian has been shut down" - "custodian" - c_0))) - b_0)))))))) + (if (1/custodian? c_0) + (void) + (raise-argument-error 'make-custodian-box "custodian?" c_0)) + (let ((b_0 (custodian-box1.1 v_0 (custodian-get-shutdown-sema c_0)))) + (begin + (if (let ((temp76_0 + (|#%name| + temp76 + (lambda (b_1) + (begin (set-custodian-box-v! b_1 #f)))))) + (do-custodian-register.1 #f #t #f #t c_0 b_0 temp76_0)) + (void) + (begin-unsafe + (raise-arguments-error + 'make-custodian-box + "the custodian has been shut down" + "custodian" + c_0))) + b_0))))))) (define 1/custodian-box-value (|#%name| custodian-box-value @@ -5941,386 +5913,399 @@ (define memory-limit-lock (|#%app| host:make-mutex)) (define compute-memory-sizes 0) (define computed-memory-sizes? #f) -(define effect_2552 +(define effect_2497 (begin (void (|#%app| set-reachable-size-increments-callback! - (letrec ((procz1 (lambda (sizes_0 custs_0) (void))) - (c-loop_0 - (|#%name| - c-loop - (lambda (custodian-future-threads_0 - k-roots_0 - c_0 - pl_0 - accum-roots_0 - accum-custs_0) - (begin - (begin - (set-custodian-memory-use! c_0 0) - (let ((gc-roots_0 (custodian-gc-roots c_0))) - (let ((roots_0 - (if gc-roots_0 (hash-keys gc-roots_0) null))) - (let ((host-regs_0 - (let ((pl_1 (custodian-place c_0))) - (if (eq? (place-custodian pl_1) c_0) - (list pl_1) - null)))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (roots_1 - local-accum-roots_0 - accum-roots_1 - accum-custs_1) - (begin - (if (null? roots_1) - (let ((local-custs_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((root_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (cons - c_0 - fold-var_0))) - (let ((fold-var_2 - (values - fold-var_1))) - (for-loop_0 - fold-var_2 - rest_0))))) - fold-var_0)))))) - (for-loop_0 - null - local-accum-roots_0)))))) - (let ((app_0 - (append - (reverse$1 - local-accum-roots_0) - accum-roots_1))) - (values - app_0 - (append - local-custs_0 - accum-custs_1)))) - (if (1/custodian? (car roots_1)) - (call-with-values - (lambda () - (c-loop_0 - custodian-future-threads_0 - k-roots_0 - (car roots_1) - pl_0 - accum-roots_1 - accum-custs_1)) - (case-lambda - ((new-roots_0 new-custs_0) - (loop_0 - (cdr roots_1) - local-accum-roots_0 - new-roots_0 - new-custs_0)) - (args - (raise-binding-result-arity-error - 2 - args)))) - (if (1/place? (car roots_1)) - (let ((pl_1 (car roots_1))) - (let ((c_1 - (place-custodian pl_1))) - (begin - (let ((app_0 - future-scheduler-add-thread-custodian-mapping!)) - (|#%app| - app_0 - (place-future-scheduler - pl_1) - custodian-future-threads_0)) - (call-with-values - (lambda () - (c-loop_0 - custodian-future-threads_0 - k-roots_0 - c_1 - pl_1 - accum-roots_1 - accum-custs_1)) - (case-lambda - ((new-roots_0 new-custs_0) - (loop_0 - (cdr roots_1) - local-accum-roots_0 - new-roots_0 - new-custs_0)) - (args - (raise-binding-result-arity-error - 2 - args))))))) - (let ((root_0 (car roots_1))) - (let ((new-local-roots_0 - (cons - root_0 - local-accum-roots_0))) - (let ((more-local-roots_0 - (if (eq? - root_0 - (place-current-thread - pl_0)) - (let ((more-local-roots_0 - (cons - (place-host-thread - pl_0) - new-local-roots_0))) - (if (eq? - pl_0 - (unsafe-place-local-ref - cell.1$2)) - (append - k-roots_0 - more-local-roots_0) - more-local-roots_0)) - new-local-roots_0))) - (let ((even-more-local-roots_0 - (let ((c2_0 - (|#%app| - thread-engine-for-roots - root_0))) - (if c2_0 - (append - (|#%app| - engine-roots - c2_0) - more-local-roots_0) - more-local-roots_0)))) + (lambda (call-with-size-increments_0) + (if (zero? compute-memory-sizes) + (|#%app| + call-with-size-increments_0 + null + null + (lambda (sizes_0 custs_0) (void))) + (|#%app| + host:call-with-current-continuation-roots + (lambda (k-roots_0) + (let ((custodian-future-threads_0 (make-hasheq))) + (begin + (let ((app_0 future-scheduler-add-thread-custodian-mapping!)) + (|#%app| + app_0 + (place-future-scheduler initial-place) + custodian-future-threads_0)) + (call-with-values + (lambda () + (letrec* + ((c-loop_0 + (|#%name| + c-loop + (lambda (c_0 pl_0 accum-roots_0 accum-custs_0) + (begin + (begin + (set-custodian-memory-use! c_0 0) + (let ((gc-roots_0 (custodian-gc-roots c_0))) + (let ((roots_0 + (if gc-roots_0 + (hash-keys gc-roots_0) + null))) + (let ((host-regs_0 + (let ((pl_1 (custodian-place c_0))) + (if (eq? (place-custodian pl_1) c_0) + (list pl_1) + null)))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (roots_1 + local-accum-roots_0 + accum-roots_1 + accum-custs_1) + (begin + (if (null? roots_1) + (let ((local-custs_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((root_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (cons + c_0 + fold-var_0))) + (let ((fold-var_2 + (values + fold-var_1))) + (for-loop_0 + fold-var_2 + rest_0))))) + fold-var_0)))))) + (for-loop_0 + null + local-accum-roots_0)))))) + (let ((app_0 + (append + (reverse$1 + local-accum-roots_0) + accum-roots_1))) + (values + app_0 + (append + local-custs_0 + accum-custs_1)))) + (if (1/custodian? (car roots_1)) + (call-with-values + (lambda () + (c-loop_0 + (car roots_1) + pl_0 + accum-roots_1 + accum-custs_1)) + (case-lambda + ((new-roots_0 new-custs_0) (loop_0 (cdr roots_1) - even-more-local-roots_0 - accum-roots_1 - accum-custs_1))))))))))))) - (loop_0 - roots_0 - (cons c_0 host-regs_0) - accum-roots_0 - accum-custs_0)))))))))) - (c-loop_1 - (|#%name| - c-loop - (lambda (custodian-future-threads_0 c_0) - (begin - (let ((gc-roots_0 (custodian-gc-roots c_0))) - (let ((roots_0 - (let ((app_0 - (hash-ref - custodian-future-threads_0 - c_0 - null))) - (append - app_0 - (if gc-roots_0 - (hash-keys gc-roots_0) - null))))) - (let ((any-limits?_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (any-limits?_0 lst_0) - (begin - (if (pair? lst_0) - (let ((root_0 (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((any-limits?_1 - (if (let ((or-part_0 - (1/custodian? - root_0))) - (if or-part_0 - or-part_0 - (1/place? - root_0))) - (let ((any-limits?_1 - (let ((next-c_0 - (if (1/custodian? - root_0) - root_0 - (place-custodian - root_0)))) - (let ((root-any-limits?_0 - (c-loop_1 - custodian-future-threads_0 - next-c_0))) - (begin - (set-custodian-memory-use! - c_0 - (let ((app_0 - (custodian-memory-use - next-c_0))) - (+ - app_0 - (custodian-memory-use - c_0)))) - (if root-any-limits?_0 - root-any-limits?_0 - any-limits?_0)))))) - (values - any-limits?_1)) - any-limits?_0))) - (for-loop_0 - any-limits?_1 - rest_0)))) - any-limits?_0)))))) - (for-loop_0 #f roots_0))))) - (let ((use_0 (custodian-memory-use c_0))) - (let ((old-limits_0 - (custodian-memory-limits c_0))) - (let ((new-limits_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((limit_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (if (if (<= - (car - limit_0) - use_0) - (begin - (queue-custodian-shutdown! - (let ((or-part_0 - (cdr - limit_0))) - (if or-part_0 - or-part_0 - c_0))) - #f) - #t) - (let ((fold-var_1 - (cons - limit_0 - fold-var_0))) - (values - fold-var_1)) - fold-var_0))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 null old-limits_0)))))) - (begin - (set-custodian-memory-limits! - c_0 - new-limits_0) - (if (if (pair? old-limits_0) - (let ((or-part_0 - (null? new-limits_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (not - (custodian-gc-roots - c_0)))) - (if or-part_1 - or-part_1 - (zero? - (hash-count - (custodian-gc-roots - c_0))))))) - #f) - (hash-remove! custodians-with-limits c_0) - (void)) - (if any-limits?_0 - any-limits?_0 - (pair? new-limits_0)))))))))))))) - (lambda (call-with-size-increments_0) - (if (zero? compute-memory-sizes) - (|#%app| call-with-size-increments_0 null null procz1) - (|#%app| - host:call-with-current-continuation-roots - (lambda (k-roots_0) - (let ((custodian-future-threads_0 (make-hasheq))) - (begin - (let ((app_0 - future-scheduler-add-thread-custodian-mapping!)) - (|#%app| - app_0 - (place-future-scheduler initial-place) - custodian-future-threads_0)) - (call-with-values - (lambda () - (c-loop_0 - custodian-future-threads_0 - k-roots_0 - initial-place-root-custodian - initial-place - null - null)) - (case-lambda - ((roots_0 custs_0) - (|#%app| - call-with-size-increments_0 - roots_0 - custs_0 - (lambda (sizes_0 custs_1) + local-accum-roots_0 + new-roots_0 + new-custs_0)) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if (1/place? (car roots_1)) + (let ((pl_1 (car roots_1))) + (let ((c_1 + (place-custodian + pl_1))) + (begin + (let ((app_0 + future-scheduler-add-thread-custodian-mapping!)) + (|#%app| + app_0 + (place-future-scheduler + pl_1) + custodian-future-threads_0)) + (call-with-values + (lambda () + (c-loop_0 + c_1 + pl_1 + accum-roots_1 + accum-custs_1)) + (case-lambda + ((new-roots_0 + new-custs_0) + (loop_0 + (cdr roots_1) + local-accum-roots_0 + new-roots_0 + new-custs_0)) + (args + (raise-binding-result-arity-error + 2 + args))))))) + (let ((root_0 (car roots_1))) + (let ((new-local-roots_0 + (cons + root_0 + local-accum-roots_0))) + (let ((more-local-roots_0 + (if (eq? + root_0 + (place-current-thread + pl_0)) + (let ((more-local-roots_0 + (cons + (place-host-thread + pl_0) + new-local-roots_0))) + (if (eq? + pl_0 + (unsafe-place-local-ref + cell.1$2)) + (append + k-roots_0 + more-local-roots_0) + more-local-roots_0)) + new-local-roots_0))) + (let ((even-more-local-roots_0 + (let ((c2_0 + (|#%app| + thread-engine-for-roots + root_0))) + (if c2_0 + (append + (|#%app| + engine-roots + c2_0) + more-local-roots_0) + more-local-roots_0)))) + (loop_0 + (cdr roots_1) + even-more-local-roots_0 + accum-roots_1 + accum-custs_1))))))))))))) + (loop_0 + roots_0 + (cons c_0 host-regs_0) + accum-roots_0 + accum-custs_0))))))))))) + (c-loop_0 + initial-place-root-custodian + initial-place + null + null))) + (case-lambda + ((roots_0 custs_0) + (|#%app| + call-with-size-increments_0 + roots_0 + custs_0 + (lambda (sizes_0 custs_1) + (begin (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0 lst_1) + (begin + (if (if (pair? lst_0) (pair? lst_1) #f) + (let ((size_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((c_0 (unsafe-car lst_1))) + (let ((rest_1 (unsafe-cdr lst_1))) + (begin + (set-custodian-memory-use! + c_0 + (+ + size_0 + (custodian-memory-use c_0))) + (for-loop_0 rest_0 rest_1)))))) + (values))))))) + (for-loop_0 sizes_0 custs_1))) + (let ((any-limits?_0 + (letrec* + ((c-loop_0 + (|#%name| + c-loop + (lambda (c_0) + (begin + (let ((gc-roots_0 + (custodian-gc-roots c_0))) + (let ((roots_1 + (let ((app_0 + (hash-ref + custodian-future-threads_0 + c_0 + null))) + (append + app_0 + (if gc-roots_0 + (hash-keys gc-roots_0) + null))))) + (let ((any-limits?_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (any-limits?_0 + lst_0) + (begin + (if (pair? lst_0) + (let ((root_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((any-limits?_1 + (if (let ((or-part_0 + (1/custodian? + root_0))) + (if or-part_0 + or-part_0 + (1/place? + root_0))) + (let ((any-limits?_1 + (let ((next-c_0 + (if (1/custodian? + root_0) + root_0 + (place-custodian + root_0)))) + (let ((root-any-limits?_0 + (c-loop_0 + next-c_0))) + (begin + (set-custodian-memory-use! + c_0 + (let ((app_0 + (custodian-memory-use + next-c_0))) + (+ + app_0 + (custodian-memory-use + c_0)))) + (if root-any-limits?_0 + root-any-limits?_0 + any-limits?_0)))))) + (values + any-limits?_1)) + any-limits?_0))) + (for-loop_0 + any-limits?_1 + rest_0)))) + any-limits?_0)))))) + (for-loop_0 + #f + roots_1))))) + (let ((use_0 + (custodian-memory-use + c_0))) + (let ((old-limits_0 + (custodian-memory-limits + c_0))) + (let ((new-limits_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((limit_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (if (if (<= + (car + limit_0) + use_0) + (begin + (queue-custodian-shutdown! + (let ((or-part_0 + (cdr + limit_0))) + (if or-part_0 + or-part_0 + c_0))) + #f) + #t) + (let ((fold-var_1 + (cons + limit_0 + fold-var_0))) + (values + fold-var_1)) + fold-var_0))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + old-limits_0)))))) + (begin + (set-custodian-memory-limits! + c_0 + new-limits_0) + (if (if (pair? + old-limits_0) + (let ((or-part_0 + (null? + new-limits_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (not + (custodian-gc-roots + c_0)))) + (if or-part_1 + or-part_1 + (zero? + (hash-count + (custodian-gc-roots + c_0))))))) + #f) + (hash-remove! + custodians-with-limits + c_0) + (void)) + (if any-limits?_0 + any-limits?_0 + (pair? + new-limits_0)))))))))))))) + (c-loop_0 initial-place-root-custodian)))) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0 lst_1) - (begin - (if (if (pair? lst_0) (pair? lst_1) #f) - (let ((size_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((c_0 (unsafe-car lst_1))) - (let ((rest_1 (unsafe-cdr lst_1))) - (begin - (set-custodian-memory-use! - c_0 - (+ - size_0 - (custodian-memory-use c_0))) - (for-loop_0 - rest_0 - rest_1)))))) - (values))))))) - (for-loop_0 sizes_0 custs_1))) - (let ((any-limits?_0 - (c-loop_1 - custodian-future-threads_0 - initial-place-root-custodian))) - (begin - (if any-limits?_0 - (void) - (set! compute-memory-sizes - (sub1 compute-memory-sizes))) - (set! computed-memory-sizes? #t))))))) - (args - (raise-binding-result-arity-error 2 args))))))))))))) + (if any-limits?_0 + (void) + (set! compute-memory-sizes + (sub1 compute-memory-sizes))) + (set! computed-memory-sizes? #t))))))) + (args (raise-binding-result-arity-error 2 args)))))))))))) (void))) (define effect_3119 (begin @@ -7229,32 +7214,34 @@ transitive-resume-box (record-accessor struct:transitive-resume 1))) (define add-transitive-resume-to-thread! - (letrec ((loop_0 - (|#%name| - loop - (lambda (b-t_0 l_0) - (begin - (if (null? l_0) - (begin - (set-thread-suspended?! b-t_0 (thread-suspended? b-t_0)) - (list - (transitive-resume16.1 - (make-weak-box b-t_0) - (thread-suspended-box b-t_0)))) - (let ((o-t_0 - (weak-box-value - (transitive-resume-weak-box (car l_0))))) - (if (not o-t_0) - (loop_0 b-t_0 (cdr l_0)) - (if (1/thread-dead? o-t_0) - (loop_0 b-t_0 (cdr l_0)) - (if (eq? b-t_0 o-t_0) - l_0 - (let ((app_0 (car l_0))) - (cons app_0 (loop_0 b-t_0 (cdr l_0)))))))))))))) - (lambda (t_0 b-t_0) - (let ((new-l_0 (loop_0 b-t_0 (thread-transitive-resumes t_0)))) - (set-thread-transitive-resumes! t_0 new-l_0))))) + (lambda (t_0 b-t_0) + (let ((new-l_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_0) + (begin + (if (null? l_0) + (begin + (set-thread-suspended?! b-t_0 (thread-suspended? b-t_0)) + (list + (transitive-resume16.1 + (make-weak-box b-t_0) + (thread-suspended-box b-t_0)))) + (let ((o-t_0 + (weak-box-value + (transitive-resume-weak-box (car l_0))))) + (if (not o-t_0) + (loop_0 (cdr l_0)) + (if (1/thread-dead? o-t_0) + (loop_0 (cdr l_0)) + (if (eq? b-t_0 o-t_0) + l_0 + (let ((app_0 (car l_0))) + (cons app_0 (loop_0 (cdr l_0)))))))))))))) + (loop_0 (thread-transitive-resumes t_0))))) + (set-thread-transitive-resumes! t_0 new-l_0)))) (define do-resume-transitive-resumes (lambda (t_0 c_0) (begin @@ -7545,30 +7532,31 @@ (engine-block)))) (define 1/sleep (let ((sleep_0 - (letrec ((loop_0 - (|#%name| - loop - (lambda (until-msecs_0) - (begin - (|#%app| - (thread-deschedule! - (1/current-thread) - until-msecs_0 - (lambda () (lambda () (loop_0 until-msecs_0)))))))))) - (|#%name| - sleep - (lambda (secs20_0) + (|#%name| + sleep + (lambda (secs20_0) + (begin (begin - (begin - (if (if (real? secs20_0) (>= secs20_0 0) #f) - (void) - (raise-argument-error 'sleep "(>=/c 0)" secs20_0)) - (if (if (zero? secs20_0) (zero? (current-atomic)) #f) - (thread-yield #f) - (let ((until-msecs_0 - (let ((app_0 (* secs20_0 1000.0))) - (+ app_0 (current-inexact-milliseconds))))) - (loop_0 until-msecs_0)))))))))) + (if (if (real? secs20_0) (>= secs20_0 0) #f) + (void) + (raise-argument-error 'sleep "(>=/c 0)" secs20_0)) + (if (if (zero? secs20_0) (zero? (current-atomic)) #f) + (thread-yield #f) + (let ((until-msecs_0 + (let ((app_0 (* secs20_0 1000.0))) + (+ app_0 (current-inexact-milliseconds))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda () + (begin + (|#%app| + (thread-deschedule! + (1/current-thread) + until-msecs_0 + (lambda () (lambda () (loop_0)))))))))) + (loop_0)))))))))) (|#%name| sleep (case-lambda (() (begin (sleep_0 0))) ((secs20_0) (sleep_0 secs20_0)))))) @@ -7780,53 +7768,50 @@ (lambda (thd_0 v_0) (queue-add-front! (thread-mailbox thd_0) v_0))) (define 1/thread-send (let ((thread-send_0 - (letrec ((procz2 (lambda () #f)) - (procz1 - (|#%name| - fail-thunk - (lambda () - (begin - (raise-arguments-error - 'thread-send - "target thread is not running")))))) - (|#%name| - thread-send - (lambda (thd24_0 v25_0 fail-thunk23_0) - (begin - (let ((fail-thunk_0 - (if (eq? fail-thunk23_0 unsafe-undefined) - procz1 - fail-thunk23_0))) - (begin - (if (1/thread? thd24_0) - (void) - (raise-argument-error 'thread-send "thread?" thd24_0)) - (if (let ((or-part_0 (not fail-thunk_0))) - (if or-part_0 - or-part_0 - (if (procedure? fail-thunk_0) - (procedure-arity-includes? fail-thunk_0 0) - #f))) - (void) - (raise-argument-error - 'thread-send - "(or/c (procedure-arity-includes/c 0) #f)" - fail-thunk_0)) - (|#%app| - (begin - (start-atomic) - (begin0 - (if (not (1/thread-dead? thd24_0)) - (begin - (begin-unsafe - (queue-add! (thread-mailbox thd24_0) v25_0)) - (let ((wakeup_0 (thread-mailbox-wakeup thd24_0))) - (begin - (set-thread-mailbox-wakeup! thd24_0 void) - (|#%app| wakeup_0) - void))) - (if fail-thunk_0 fail-thunk_0 procz2)) - (end-atomic)))))))))))) + (|#%name| + thread-send + (lambda (thd24_0 v25_0 fail-thunk23_0) + (begin + (let ((fail-thunk_0 + (if (eq? fail-thunk23_0 unsafe-undefined) + (|#%name| + fail-thunk + (lambda () + (begin + (raise-arguments-error + 'thread-send + "target thread is not running")))) + fail-thunk23_0))) + (begin + (if (1/thread? thd24_0) + (void) + (raise-argument-error 'thread-send "thread?" thd24_0)) + (if (let ((or-part_0 (not fail-thunk_0))) + (if or-part_0 + or-part_0 + (if (procedure? fail-thunk_0) + (procedure-arity-includes? fail-thunk_0 0) + #f))) + (void) + (raise-argument-error + 'thread-send + "(or/c (procedure-arity-includes/c 0) #f)" + fail-thunk_0)) + (|#%app| + (begin + (start-atomic) + (begin0 + (if (not (1/thread-dead? thd24_0)) + (begin + (begin-unsafe + (queue-add! (thread-mailbox thd24_0) v25_0)) + (let ((wakeup_0 (thread-mailbox-wakeup thd24_0))) + (begin + (set-thread-mailbox-wakeup! thd24_0 void) + (|#%app| wakeup_0) + void))) + (if fail-thunk_0 fail-thunk_0 (lambda () #f))) + (end-atomic))))))))))) (|#%name| thread-send (case-lambda @@ -7889,7 +7874,7 @@ (end-atomic))))))) (define struct:thread-receiver-evt (make-record-type-descriptor* 'thread-receive-evt #f #f #f #f 0 0)) -(define effect_2530 +(define effect_2473 (struct-type-install-properties! struct:thread-receiver-evt 'thread-receive-evt @@ -7900,46 +7885,43 @@ (cons 1/prop:evt (poller2.1 - (letrec ((add-wakeup-callback!_0 - (|#%name| - add-wakeup-callback! - (lambda (receive_0 t_0) - (begin - (let ((wakeup_0 (thread-mailbox-wakeup t_0))) - (set-thread-mailbox-wakeup! - t_0 + (lambda (self_0 poll-ctx_0) + (let ((t_0 (current-thread/in-atomic))) + (if (is-mail? t_0) + (values (list self_0) #f) + (if (poll-ctx-poll? poll-ctx_0) + (values #f self_0) + (let ((receive_0 + (let ((select-proc_0 (poll-ctx-select-proc poll-ctx_0))) + (|#%name| + receive (lambda () (begin - (|#%app| wakeup_0) - (|#%app| (unsafe-unbox* receive_0))))))))))) - (lambda (self_0 poll-ctx_0) - (let ((t_0 (current-thread/in-atomic))) - (if (is-mail? t_0) - (values (list self_0) #f) - (if (poll-ctx-poll? poll-ctx_0) - (values #f self_0) - (let ((receive_0 - (box - (let ((select-proc_0 - (poll-ctx-select-proc poll-ctx_0))) - (|#%name| - receive - (lambda () - (begin - (if (is-mail? t_0) - (|#%app| select-proc_0) - (void))))))))) + (if (is-mail? t_0) + (|#%app| select-proc_0) + (void)))))))) + (let ((add-wakeup-callback!_0 + (|#%name| + add-wakeup-callback! + (lambda () + (begin + (let ((wakeup_0 (thread-mailbox-wakeup t_0))) + (set-thread-mailbox-wakeup! + t_0 + (lambda () + (begin + (|#%app| wakeup_0) + (|#%app| receive_0)))))))))) (begin - (add-wakeup-callback!_0 receive_0 t_0) + (add-wakeup-callback!_0) (values #f (control-state-evt9.1 the-async-evt (lambda (v_0) self_0) (lambda () (set-thread-mailbox-wakeup! t_0 void)) - (lambda () (unsafe-set-box*! receive_0 void)) - (lambda () - (add-wakeup-callback!_0 receive_0 t_0)))))))))))))) + (lambda () (set! receive_0 void)) + (lambda () (add-wakeup-callback!_0)))))))))))))) (current-inspector) #f '() @@ -8194,48 +8176,54 @@ (lambda () (begin (let ((app_0 (make-queue))) (channel1.1 app_0 (make-queue))))))) (define channel-get - (letrec ((receive_0 - (|#%name| - receive - (lambda (b_0 ch_0) - (begin - (|#%app| + (lambda (ch_0) + (begin + (if (1/channel? ch_0) + (void) + (raise-argument-error 'channel-get "channel?" ch_0)) + (if (|#%app| evt-impersonator? ch_0) + (|#%app| sync-on-channel ch_0) + (let ((b_0 (box #f))) + (begin + (letrec* + ((receive_0 + (|#%name| + receive + (lambda () (begin - (start-atomic) - (begin0 - (let ((pw+v_0 (queue-remove! (channel-put-queue ch_0)))) - (let ((gw_0 (current-thread/in-atomic))) - (if (not pw+v_0) - (let ((gq_0 (channel-get-queue ch_0))) - (let ((n_0 (queue-add! gq_0 (cons gw_0 b_0)))) - (let ((interrupt-cb_0 - (lambda () - (begin - (queue-remove-node! gq_0 n_0) - (lambda () (receive_0 b_0 ch_0)))))) - (begin-unsafe - (|#%app| - (waiter-methods-suspend (waiter-ref gw_0)) - gw_0 - interrupt-cb_0))))) - (begin - (set-box! b_0 (cdr pw+v_0)) - (let ((w_0 (car pw+v_0))) - (begin-unsafe - (|#%app| - (waiter-methods-resume (waiter-ref w_0)) - w_0 - (void)))) - void)))) - (end-atomic))))))))) - (lambda (ch_0) - (begin - (if (1/channel? ch_0) - (void) - (raise-argument-error 'channel-get "channel?" ch_0)) - (if (|#%app| evt-impersonator? ch_0) - (|#%app| sync-on-channel ch_0) - (let ((b_0 (box #f))) (begin (receive_0 b_0 ch_0) (unbox b_0)))))))) + (|#%app| + (begin + (start-atomic) + (begin0 + (let ((pw+v_0 + (queue-remove! (channel-put-queue ch_0)))) + (let ((gw_0 (current-thread/in-atomic))) + (if (not pw+v_0) + (let ((gq_0 (channel-get-queue ch_0))) + (let ((n_0 (queue-add! gq_0 (cons gw_0 b_0)))) + (let ((interrupt-cb_0 + (lambda () + (begin + (queue-remove-node! gq_0 n_0) + (lambda () (receive_0)))))) + (begin-unsafe + (|#%app| + (waiter-methods-suspend + (waiter-ref gw_0)) + gw_0 + interrupt-cb_0))))) + (begin + (set-box! b_0 (cdr pw+v_0)) + (let ((w_0 (car pw+v_0))) + (begin-unsafe + (|#%app| + (waiter-methods-resume (waiter-ref w_0)) + w_0 + (void)))) + void)))) + (end-atomic))))))))) + (receive_0)) + (unbox b_0))))))) (define channel-get/poll (lambda (ch_0 poll-ctx_0) (let ((pq_0 (channel-put-queue ch_0))) @@ -8402,144 +8390,136 @@ channel-put-impersonator-ref) (make-impersonator-property 'channel-put-impersonator)) (define 1/chaperone-evt - (letrec ((procz1 - (lambda (v_0) - (if (1/evt? v_0) - (void) - (raise-result-error 'chaperone-evt "evt?" v_0))))) - (|#%name| - chaperone-evt - (lambda (evt_0 proc_0 . args_0) + (|#%name| + chaperone-evt + (lambda (evt_0 proc_0 . args_0) + (begin (begin - (begin - (if (1/evt? evt_0) - (void) - (raise-argument-error 'chaperone-evt "evt?" evt_0)) - (if (if (procedure? proc_0) (procedure-arity-includes? proc_0 1) #f) - (void) - (raise-argument-error - proc_0 - "(procedure-arity-includes/c 1)" - proc_0)) - (do-chaperone-evt - 'chaperone-evt - "evt" - #t - evt_0 + (if (1/evt? evt_0) + (void) + (raise-argument-error 'chaperone-evt "evt?" evt_0)) + (if (if (procedure? proc_0) (procedure-arity-includes? proc_0 1) #f) + (void) + (raise-argument-error proc_0 - args_0 - procz1))))))) + "(procedure-arity-includes/c 1)" + proc_0)) + (do-chaperone-evt + 'chaperone-evt + "evt" + #t + evt_0 + proc_0 + args_0 + (lambda (v_0) + (if (1/evt? v_0) + (void) + (raise-result-error 'chaperone-evt "evt?" v_0))))))))) (define do-chaperone-evt - (letrec ((procz1 (lambda (evt_0 v_0) v_0))) - (lambda (who_0 what_0 chaperone?_0 evt_0 proc_0 args_0 check-evt_0) - (begin - (check-impersonator-properties who_0 args_0) - (apply - chaperone-struct - evt_0 - (if (primary-evt? evt_0) - primary-evt-ref - (if (secondary-evt? evt_0) - secondary-evt-ref - (internal-error "unrecognized evt to impersonate"))) - procz1 - impersonator-prop:evt - (lambda (also-evt_0) - (call-with-values - (lambda () (|#%app| proc_0 evt_0)) - (case-lambda - ((new-evt_0 wrap_0) - (begin - (if chaperone?_0 - (check-chaperone-of what_0 new-evt_0 evt_0) - (void)) - (|#%app| check-evt_0 new-evt_0) - (if (if (procedure? wrap_0) - (procedure-arity-includes? wrap_0 1) - #f) - (void) - (raise-result-error - who_0 - "(procedure-arity-includes/c 1)" - wrap_0)) - (handle-evt8.1 - new-evt_0 - (lambda rs_0 - (call-with-values - (lambda () (apply wrap_0 rs_0)) - (lambda new-rs_0 - (begin - (if (let ((app_0 (length rs_0))) - (= app_0 (length new-rs_0))) - (void) - (raise - (let ((app_0 - (let ((app_0 - (if chaperone?_0 - "chaperone" - "impersonator"))) - (let ((app_1 - (number->string (length rs_0)))) - (string-append - what_0 - " " - app_0 - ": result wrapper returned wrong number of values\n" - " expected count: " - app_1 - "\n" - " returned count: " - (number->string (length new-rs_0))))))) - (|#%app| - exn:fail:contract:arity - app_0 - (current-continuation-marks))))) - (if chaperone?_0 + (lambda (who_0 what_0 chaperone?_0 evt_0 proc_0 args_0 check-evt_0) + (begin + (check-impersonator-properties who_0 args_0) + (apply + chaperone-struct + evt_0 + (if (primary-evt? evt_0) + primary-evt-ref + (if (secondary-evt? evt_0) + secondary-evt-ref + (internal-error "unrecognized evt to impersonate"))) + (lambda (evt_1 v_0) v_0) + impersonator-prop:evt + (lambda (also-evt_0) + (call-with-values + (lambda () (|#%app| proc_0 evt_0)) + (case-lambda + ((new-evt_0 wrap_0) + (begin + (if chaperone?_0 + (check-chaperone-of what_0 new-evt_0 evt_0) + (void)) + (|#%app| check-evt_0 new-evt_0) + (if (if (procedure? wrap_0) + (procedure-arity-includes? wrap_0 1) + #f) + (void) + (raise-result-error + who_0 + "(procedure-arity-includes/c 1)" + wrap_0)) + (handle-evt8.1 + new-evt_0 + (lambda rs_0 + (call-with-values + (lambda () (apply wrap_0 rs_0)) + (lambda new-rs_0 + (begin + (if (let ((app_0 (length rs_0))) + (= app_0 (length new-rs_0))) + (void) + (raise + (let ((app_0 + (let ((app_0 + (if chaperone?_0 + "chaperone" + "impersonator"))) + (let ((app_1 (number->string (length rs_0)))) + (string-append + what_0 + " " + app_0 + ": result wrapper returned wrong number of values\n" + " expected count: " + app_1 + "\n" + " returned count: " + (number->string (length new-rs_0))))))) + (|#%app| + exn:fail:contract:arity + app_0 + (current-continuation-marks))))) + (if chaperone?_0 + (begin (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0 lst_1) - (begin - (if (if (pair? lst_0) (pair? lst_1) #f) - (let ((r_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((new-r_0 (unsafe-car lst_1))) - (let ((rest_1 - (unsafe-cdr lst_1))) - (begin - (check-chaperone-of - what_0 - new-r_0 - r_0) - (for-loop_0 - rest_0 - rest_1)))))) - (values))))))) - (for-loop_0 rs_0 new-rs_0))) - (void)) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0 lst_1) + (begin + (if (if (pair? lst_0) (pair? lst_1) #f) + (let ((r_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((new-r_0 (unsafe-car lst_1))) + (let ((rest_1 (unsafe-cdr lst_1))) + (begin + (check-chaperone-of + what_0 + new-r_0 + r_0) + (for-loop_0 rest_0 rest_1)))))) + (values))))))) + (for-loop_0 rs_0 new-rs_0))) (void)) - (apply values new-rs_0)))))))) - (args_1 - (raise - (let ((app_0 - (let ((app_0 - (if chaperone?_0 "chaperone" "impersonator"))) - (string-append - what_0 - " " - app_0 - ": returned wrong number of values\n" - " expected count: 2\n" - " returned count: " - (number->string (length args_1)))))) - (|#%app| - exn:fail:contract:arity - app_0 - (current-continuation-marks)))))))) - args_0))))) + (void)) + (apply values new-rs_0)))))))) + (args_1 + (raise + (let ((app_0 + (let ((app_0 (if chaperone?_0 "chaperone" "impersonator"))) + (string-append + what_0 + " " + app_0 + ": returned wrong number of values\n" + " expected count: 2\n" + " returned count: " + (number->string (length args_1)))))) + (|#%app| + exn:fail:contract:arity + app_0 + (current-continuation-marks)))))))) + args_0)))) (define 1/chaperone-channel (|#%name| chaperone-channel @@ -9191,214 +9171,229 @@ or-part_4 (eq? the-never-evt evt_0))))))))))))) (define do-sync.1 - (letrec ((procz4 (lambda () #f)) - (procz3 (|#%name| temp44 (lambda (thunk_0) (begin thunk_0)))) - (procz2 (|#%name| temp48 (lambda (thunk_0) (begin thunk_0)))) - (procz1 (lambda () #f)) - (go_0 - (|#%name| - go - (lambda (enable-break?7_0 s_0 timeout10_0 thunk-result?38_0) - (begin - (dynamic-wind - (lambda () - (begin - (start-atomic) - (thread-push-kill-callback! - (lambda () (|#%app| syncing-abandon! s_0))) - (thread-push-suspend+resume-callbacks! - (lambda () (|#%app| syncing-interrupt! s_0)) - (lambda () (|#%app| syncing-queue-retry! s_0))) - (end-atomic))) - (lambda () - (begin - (if enable-break?7_0 (1/check-for-break) (void)) - (if (let ((or-part_0 - (if (real? timeout10_0) - (zero? timeout10_0) - #f))) - (if or-part_0 or-part_0 (procedure? timeout10_0))) - (poll-loop_0 s_0 thunk-result?38_0 timeout10_0) - (let ((timeout-at_0 - (if timeout10_0 - (let ((app_0 (* timeout10_0 1000))) - (+ app_0 (current-inexact-milliseconds))) - #f))) - (loop_0 - s_0 - thunk-result?38_0 - timeout-at_0 - timeout10_0 - #t - #f))))) - (lambda () - (begin - (start-atomic) - (thread-pop-suspend+resume-callbacks!) - (thread-pop-kill-callback!) - (|#%app| syncing-abandon! s_0) - (end-atomic)))))))) - (loop_0 - (|#%name| - loop - (lambda (s_0 - thunk-result?38_0 - timeout-at_0 - timeout10_0 - did-work?_0 - polled-all?_0) - (begin - (if (if polled-all?_0 - (if timeout10_0 - (<= timeout-at_0 (current-inexact-milliseconds)) - #f) - #f) - (begin - (start-atomic) - (if (syncing-selected s_0) - (begin - (end-atomic) - (loop_0 - s_0 - thunk-result?38_0 - timeout-at_0 - timeout10_0 - #f - #f)) - (begin - (|#%app| syncing-done! s_0 none-syncer) - (end-atomic) - (if thunk-result?38_0 procz1 #f)))) - (if (if (|#%app| all-asynchronous? s_0) - (if (not (syncing-selected s_0)) - (not (syncing-need-retry? s_0)) - #f) - #f) - (begin - (|#%app| suspend-syncing-thread s_0 timeout-at_0) - (set-syncing-wakeup! s_0 void) - (loop_0 - s_0 - thunk-result?38_0 - timeout-at_0 - timeout10_0 - #f - #t)) - (let ((temp48_0 (if thunk-result?38_0 procz2 #f))) - (let ((temp50_0 - (lambda (sched-info_0 - now-polled-all?_0 - no-wrappers?_0) - (begin - (if timeout-at_0 - (schedule-info-add-timeout-at! - sched-info_0 - timeout-at_0) - (void)) - (thread-yield sched-info_0) - (loop_0 - s_0 - thunk-result?38_0 - timeout-at_0 - timeout10_0 - #f - (if polled-all?_0 - polled-all?_0 - now-polled-all?_0)))))) - (let ((temp48_1 temp48_0)) - (|#%app| - sync-poll.1 - did-work?_0 - #t - temp50_0 - #f - #f - unsafe-undefined - temp48_1 - s_0)))))))))) - (poll-loop_0 - (|#%name| - poll-loop - (lambda (s_0 thunk-result?38_0 timeout10_0) - (begin - (let ((temp44_0 (if thunk-result?38_0 procz3 #f))) - (let ((temp45_0 - (lambda (sched-info_0 polled-all?_0 no-wrappers?_0) - (if (not polled-all?_0) - (poll-loop_0 s_0 thunk-result?38_0 timeout10_0) - (if (procedure? timeout10_0) - (if thunk-result?38_0 - timeout10_0 - (|#%app| timeout10_0)) - (if thunk-result?38_0 procz4 #f)))))) - (let ((temp44_1 temp44_0)) - (|#%app| - sync-poll.1 - #f - #t - temp45_0 - #f - #t - unsafe-undefined - temp44_1 - s_0))))))))) - (|#%name| - do-sync - (lambda (enable-break?7_0 who9_0 timeout10_0 args11_0) + (|#%name| + do-sync + (lambda (enable-break?7_0 who9_0 timeout10_0 args11_0) + (begin (begin - (begin - (if (let ((or-part_0 (not timeout10_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (if (real? timeout10_0) (>= timeout10_0 0) #f))) - (if or-part_1 - or-part_1 - (if (procedure? timeout10_0) - (procedure-arity-includes? timeout10_0 0) - #f))))) - (void) - (raise-argument-error - who9_0 - "(or/c #f (and/c real? (not/c negative?)) (-> any))" - timeout10_0)) - (let ((local-break-cell_0 - (if enable-break?7_0 (make-thread-cell #t) #f))) - (let ((s_0 - (let ((temp41_0 - (let ((app_0 random-rotate)) - (|#%app| - app_0 - (|#%app| evts->syncers who9_0 args11_0))))) - (let ((temp42_0 - (if local-break-cell_0 - (let ((t_0 (1/current-thread))) - (|#%name| - temp42 - (lambda () - (begin - (thread-ignore-break-cell! - t_0 - local-break-cell_0))))) - #f))) - (let ((temp41_1 temp41_0)) - (make-syncing.1 temp42_0 temp41_1)))))) - (begin - (if (let ((or-part_0 - (if (real? timeout10_0) (zero? timeout10_0) #f))) - (if or-part_0 or-part_0 (procedure? timeout10_0))) - (begin - (start-atomic) - (call-pre-poll-external-callbacks) - (end-atomic)) - (void)) + (if (let ((or-part_0 (not timeout10_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (if (real? timeout10_0) (>= timeout10_0 0) #f))) + (if or-part_1 + or-part_1 + (if (procedure? timeout10_0) + (procedure-arity-includes? timeout10_0 0) + #f))))) + (void) + (raise-argument-error + who9_0 + "(or/c #f (and/c real? (not/c negative?)) (-> any))" + timeout10_0)) + (let ((local-break-cell_0 + (if enable-break?7_0 (make-thread-cell #t) #f))) + (let ((s_0 + (let ((temp41_0 + (let ((app_0 random-rotate)) + (|#%app| + app_0 + (|#%app| evts->syncers who9_0 args11_0))))) + (let ((temp42_0 + (if local-break-cell_0 + (let ((t_0 (1/current-thread))) + (|#%name| + temp42 + (lambda () + (begin + (thread-ignore-break-cell! + t_0 + local-break-cell_0))))) + #f))) + (let ((temp41_1 temp41_0)) + (make-syncing.1 temp42_0 temp41_1)))))) + (begin + (if (let ((or-part_0 + (if (real? timeout10_0) (zero? timeout10_0) #f))) + (if or-part_0 or-part_0 (procedure? timeout10_0))) + (begin + (start-atomic) + (call-pre-poll-external-callbacks) + (end-atomic)) + (void)) + (let ((go_0 + (|#%name| + go + (lambda (thunk-result?38_0) + (begin + (dynamic-wind + (lambda () + (begin + (start-atomic) + (thread-push-kill-callback! + (lambda () (|#%app| syncing-abandon! s_0))) + (thread-push-suspend+resume-callbacks! + (lambda () (|#%app| syncing-interrupt! s_0)) + (lambda () + (|#%app| syncing-queue-retry! s_0))) + (end-atomic))) + (lambda () + (begin + (if enable-break?7_0 + (1/check-for-break) + (void)) + (if (let ((or-part_0 + (if (real? timeout10_0) + (zero? timeout10_0) + #f))) + (if or-part_0 + or-part_0 + (procedure? timeout10_0))) + (letrec* + ((poll-loop_0 + (|#%name| + poll-loop + (lambda () + (begin + (let ((temp44_0 + (if thunk-result?38_0 + (|#%name| + temp44 + (lambda (thunk_0) + (begin thunk_0))) + #f))) + (let ((temp45_0 + (lambda (sched-info_0 + polled-all?_0 + no-wrappers?_0) + (if (not polled-all?_0) + (poll-loop_0) + (if (procedure? + timeout10_0) + (if thunk-result?38_0 + timeout10_0 + (|#%app| + timeout10_0)) + (if thunk-result?38_0 + (lambda () #f) + #f)))))) + (let ((temp44_1 temp44_0)) + (|#%app| + sync-poll.1 + #f + #t + temp45_0 + #f + #t + unsafe-undefined + temp44_1 + s_0))))))))) + (poll-loop_0)) + (let ((timeout-at_0 + (if timeout10_0 + (let ((app_0 (* timeout10_0 1000))) + (+ + app_0 + (current-inexact-milliseconds))) + #f))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (did-work?_0 polled-all?_0) + (begin + (if (if polled-all?_0 + (if timeout10_0 + (<= + timeout-at_0 + (current-inexact-milliseconds)) + #f) + #f) + (begin + (start-atomic) + (if (syncing-selected s_0) + (begin + (end-atomic) + (loop_0 #f #f)) + (begin + (|#%app| + syncing-done! + s_0 + none-syncer) + (end-atomic) + (if thunk-result?38_0 + (lambda () #f) + #f)))) + (if (if (|#%app| + all-asynchronous? + s_0) + (if (not + (syncing-selected + s_0)) + (not + (syncing-need-retry? + s_0)) + #f) + #f) + (begin + (|#%app| + suspend-syncing-thread + s_0 + timeout-at_0) + (set-syncing-wakeup! + s_0 + void) + (loop_0 #f #t)) + (let ((temp48_0 + (if thunk-result?38_0 + (|#%name| + temp48 + (lambda (thunk_0) + (begin thunk_0))) + #f))) + (let ((temp50_0 + (lambda (sched-info_0 + now-polled-all?_0 + no-wrappers?_0) + (begin + (if timeout-at_0 + (schedule-info-add-timeout-at! + sched-info_0 + timeout-at_0) + (void)) + (thread-yield + sched-info_0) + (loop_0 + #f + (if polled-all?_0 + polled-all?_0 + now-polled-all?_0)))))) + (let ((temp48_1 temp48_0)) + (|#%app| + sync-poll.1 + did-work?_0 + #t + temp50_0 + #f + #f + unsafe-undefined + temp48_1 + s_0))))))))))) + (loop_0 #t #f)))))) + (lambda () + (begin + (start-atomic) + (thread-pop-suspend+resume-callbacks!) + (thread-pop-kill-callback!) + (|#%app| syncing-abandon! s_0) + (end-atomic))))))))) (if enable-break?7_0 (let ((thunk_0 (with-continuation-mark* push-authentic break-enabled-key local-break-cell_0 - (go_0 enable-break?7_0 s_0 timeout10_0 #t)))) + (go_0 #t)))) (begin (thread-remove-ignored-break-cell! (current-thread/in-atomic) @@ -9415,15 +9410,9 @@ (if (procedure? timeout10_0) (|#%app| timeout10_0) (if no-wrappers?_0 - (go_0 enable-break?7_0 s_0 timeout10_0 #f) - (|#%app| - (go_0 - enable-break?7_0 - s_0 - timeout10_0 - #t))))) - (|#%app| - (go_0 enable-break?7_0 s_0 timeout10_0 #t)))))) + (go_0 #f) + (|#%app| (go_0 #t))))) + (|#%app| (go_0 #t)))))) (|#%app| sync-poll.1 #f @@ -10264,33 +10253,39 @@ (loop_0 (syncing-syncers s_0))) (end-atomic))))) (define nested-syncings - (letrec ((loop_0 - (|#%name| - loop - (lambda (orig-s_0 sr_0) - (begin - (if (not sr_0) - null - (let ((e_0 (syncer-evt sr_0))) - (if (|#%app| nested-sync-evt? e_0) - (let ((s_0 (|#%app| nested-sync-evt-s e_0))) - (begin - (set-syncing-wakeup! - s_0 - (lambda () (|#%app| (syncing-wakeup orig-s_0)))) - (let ((app_0 (nested-syncings s_0 orig-s_0))) - (append - app_0 - (cons - s_0 - (loop_0 orig-s_0 (syncer-next sr_0))))))) - (loop_0 orig-s_0 (syncer-next sr_0)))))))))) - (lambda (s_0 orig-s_0) (loop_0 orig-s_0 (syncing-syncers s_0))))) + (lambda (s_0 orig-s_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (sr_0) + (begin + (if (not sr_0) + null + (let ((e_0 (syncer-evt sr_0))) + (if (|#%app| nested-sync-evt? e_0) + (let ((s_1 (|#%app| nested-sync-evt-s e_0))) + (begin + (set-syncing-wakeup! + s_1 + (lambda () (|#%app| (syncing-wakeup orig-s_0)))) + (let ((app_0 (nested-syncings s_1 orig-s_0))) + (append + app_0 + (cons s_1 (loop_0 (syncer-next sr_0))))))) + (loop_0 (syncer-next sr_0)))))))))) + (loop_0 (syncing-syncers s_0))))) (define suspend-syncing-thread - (letrec ((retry_0 + (lambda (s_0 timeout-at_0) + (|#%app| + (begin + (start-atomic) + (begin0 + (letrec* + ((retry_0 (|#%name| retry - (lambda (s_0 timeout-at_0) + (lambda () (begin (let ((nss_0 (nested-syncings s_0 s_0))) (if (let ((or-part_0 (syncing-selected s_0))) @@ -10349,13 +10344,10 @@ (if (syncing-selected s_0) (void) (syncing-retry! s_0)) - (retry_0 s_0 timeout-at_0)) + (retry_0)) (end-atomic))))))))))))))))) - (lambda (s_0 timeout-at_0) - (|#%app| - (begin - (start-atomic) - (begin0 (retry_0 s_0 timeout-at_0) (end-atomic))))))) + (retry_0)) + (end-atomic)))))) (define struct:replacing-evt (make-record-type-descriptor* 'evt #f #f #f #f 1 0)) (define effect_2634 @@ -11155,65 +11147,66 @@ future-scheduler-prompt-tag (internal-error "not running in a future")))) (define run-future.1 - (letrec ((procz2 (lambda () (void))) - (procz1 (lambda args_0 (void))) - (finish!_0 - (|#%name| - finish! - (lambda (f4_0 results_0 state_0) - (begin - (begin - (start-future-uninterrupted) - (begin - (lock-acquire (future*-lock f4_0)) - (begin - (set-future*-results! f4_0 results_0) - (begin - (set-future*-state! f4_0 state_0) - (let ((deps_0 (future*-dependents f4_0))) - (begin - (set-future*-dependents! f4_0 hash2610) - (lock-release (future*-lock f4_0)) - (future-notify-dependents deps_0) - (end-future-uninterrupted) - (let ((temp24_0 (future*-id f4_0))) - (log-future.1 - #f - #f - 'complete - temp24_0))))))))))))) - (|#%name| - run-future - (lambda (was-blocked?2_0 f4_0) + (|#%name| + run-future + (lambda (was-blocked?2_0 f4_0) + (begin (begin - (begin - (set-future*-state! f4_0 'running) - (let ((thunk_0 (future*-thunk f4_0))) + (set-future*-state! f4_0 'running) + (let ((thunk_0 (future*-thunk f4_0))) + (begin + (set-future*-thunk! f4_0 #f) (begin - (set-future*-thunk! f4_0 #f) + (lock-release (future*-lock f4_0)) (begin - (lock-release (future*-lock f4_0)) - (begin - (if was-blocked?2_0 - (if (begin-unsafe (|#%app| logging-future-events?)) - (begin - (let ((temp17_0 (future*-id f4_0))) - (let ((temp18_0 - (|#%app| - continuation-current-primitive - thunk_0 - '(unsafe-start-atomic)))) - (let ((temp17_1 temp17_0)) - (log-future.1 #f temp18_0 'block temp17_1)))) - (let ((temp20_0 (future*-id f4_0))) - (log-future.1 #f #f 'result temp20_0))) - (void)) + (if was-blocked?2_0 + (if (begin-unsafe (|#%app| logging-future-events?)) + (begin + (let ((temp17_0 (future*-id f4_0))) + (let ((temp18_0 + (|#%app| + continuation-current-primitive + thunk_0 + '(unsafe-start-atomic)))) + (let ((temp17_1 temp17_0)) + (log-future.1 #f temp18_0 'block temp17_1)))) + (let ((temp20_0 (future*-id f4_0))) + (log-future.1 #f #f 'result temp20_0))) (void)) - (begin - (if (eq? (future*-would-be? f4_0) 'blocked) - (void) - (let ((temp22_0 (future*-id f4_0))) - (log-future.1 #f #f 'start-work temp22_0))) + (void)) + (begin + (if (eq? (future*-would-be? f4_0) 'blocked) + (void) + (let ((temp22_0 (future*-id f4_0))) + (log-future.1 #f #f 'start-work temp22_0))) + (let ((finish!_0 + (|#%name| + finish! + (lambda (results_0 state_0) + (begin + (begin + (start-future-uninterrupted) + (begin + (lock-acquire (future*-lock f4_0)) + (begin + (set-future*-results! f4_0 results_0) + (begin + (set-future*-state! f4_0 state_0) + (let ((deps_0 + (future*-dependents f4_0))) + (begin + (set-future*-dependents! + f4_0 + hash2610) + (lock-release (future*-lock f4_0)) + (future-notify-dependents deps_0) + (end-future-uninterrupted) + (let ((temp24_0 (future*-id f4_0))) + (log-future.1 + #f + #f + 'complete + temp24_0))))))))))))) (if (current-future$1) (call-with-values (lambda () @@ -11223,8 +11216,8 @@ (current-atomic (sub1 (current-atomic))) (|#%app| thunk_0))) future-start-prompt-tag - procz1)) - (lambda results_0 (finish!_0 f4_0 results_0 'done))) + (lambda args_0 (void)))) + (lambda results_0 (finish!_0 results_0 'done))) (if (eq? (future*-would-be? f4_0) #t) (call-with-values (lambda () @@ -11243,12 +11236,12 @@ (lambda results_0 (if (eq? (future*-state f4_0) 'running) (begin - (finish!_0 f4_0 results_0 'done) + (finish!_0 results_0 'done) (let ((temp26_0 (future*-id f4_0))) (log-future.1 #f #f 'end-work temp26_0))) (void)))) (dynamic-wind - procz2 + (lambda () (void)) (lambda () (with-continuation-mark* general @@ -11256,13 +11249,12 @@ f4_0 (|#%call-with-values| thunk_0 - (lambda results_0 - (finish!_0 f4_0 results_0 'done))))) + (lambda results_0 (finish!_0 results_0 'done))))) (lambda () (begin (if (eq? (future*-state f4_0) 'done) (void) - (finish!_0 f4_0 #f 'aborted)) + (finish!_0 #f 'aborted)) (let ((temp28_0 (future*-id f4_0))) (log-future.1 #f @@ -11809,64 +11801,68 @@ (lock-release (future*-lock f_0))) (run-future-in-worker f_0 w_0)))) (define run-future-in-worker - (letrec ((loop_0 - (|#%name| - loop - (lambda (done_0 f_0 w_0 e_0) - (begin - (|#%app| - e_0 - TICKS - (lambda () - (begin - (if (if (zero? (current-atomic)) (worker-pinged? w_0) #f) - (begin - (|#%app| - host:mutex-acquire - (scheduler-mutex (current-scheduler))) - (check-in w_0) - (|#%app| - host:mutex-release - (scheduler-mutex (current-scheduler)))) - (void)) - (if (if (let ((or-part_0 - (custodian-shut-down?/other-pthread - (future*-custodian f_0)))) - (if or-part_0 or-part_0 (worker-die? w_0))) - (zero? (current-atomic)) - #f) - (begin - (lock-acquire (future*-lock f_0)) - (set-future*-state! f_0 #f) - (on-transition-to-unfinished) - (future-suspend)) - (void)))) - (lambda (e_1 results_0 leftover-ticks_0) - (if e_1 - (loop_0 done_0 f_0 w_0 e_1) - (|#%app| done_0 (void)))))))))) - (lambda (f_0 w_0) + (lambda (f_0 w_0) + (begin + (current-future$1 f_0) (begin - (current-future$1 f_0) - (begin - (set-box! (worker-current-future-box w_0) f_0) - (let ((e_0 - (|#%app| - make-engine - (lambda () (run-future.1 #f f_0)) - future-scheduler-prompt-tag - void - break-enabled-default-cell - #t))) - (begin - (current-atomic (add1 (current-atomic))) - (|#%app| - call-with-engine-completion - (lambda (done_0) (loop_0 done_0 f_0 w_0 e_0))) - (let ((temp67_0 (future*-id f_0))) - (log-future.1 #f #f 'end-work temp67_0)) - (current-future$1 'worker) - (set-box! (worker-current-future-box w_0) #f)))))))) + (set-box! (worker-current-future-box w_0) f_0) + (let ((e_0 + (|#%app| + make-engine + (lambda () (run-future.1 #f f_0)) + future-scheduler-prompt-tag + void + break-enabled-default-cell + #t))) + (begin + (current-atomic (add1 (current-atomic))) + (|#%app| + call-with-engine-completion + (lambda (done_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (e_1) + (begin + (|#%app| + e_1 + TICKS + (lambda () + (begin + (if (if (zero? (current-atomic)) + (worker-pinged? w_0) + #f) + (begin + (|#%app| + host:mutex-acquire + (scheduler-mutex (current-scheduler))) + (check-in w_0) + (|#%app| + host:mutex-release + (scheduler-mutex (current-scheduler)))) + (void)) + (if (if (let ((or-part_0 + (custodian-shut-down?/other-pthread + (future*-custodian f_0)))) + (if or-part_0 + or-part_0 + (worker-die? w_0))) + (zero? (current-atomic)) + #f) + (begin + (lock-acquire (future*-lock f_0)) + (set-future*-state! f_0 #f) + (on-transition-to-unfinished) + (future-suspend)) + (void)))) + (lambda (e_2 results_0 leftover-ticks_0) + (if e_2 (loop_0 e_2) (|#%app| done_0 (void)))))))))) + (loop_0 e_0)))) + (let ((temp67_0 (future*-id f_0))) + (log-future.1 #f #f 'end-work temp67_0)) + (current-future$1 'worker) + (set-box! (worker-current-future-box w_0) #f))))))) (define futures-sync-for-shutdown (lambda () (let ((s_0 (current-scheduler))) @@ -12066,11 +12062,12 @@ (init-sync-place!) (call-in-new-main-thread thunk_0)))) (define call-in-new-main-thread - (letrec ((procz1 (lambda (done_0) (poll-and-select-thread! 0)))) - (lambda (thunk_0) - (begin - (make-initial-thread thunk_0) - (|#%app| call-with-engine-completion procz1))))) + (lambda (thunk_0) + (begin + (make-initial-thread thunk_0) + (|#%app| + call-with-engine-completion + (lambda (done_0) (poll-and-select-thread! 0)))))) (define cell.1$3 (unsafe-make-place-local 0)) (define cell.2$2 (unsafe-make-place-local 0)) (define cell.3 (unsafe-make-place-local 0)) @@ -12082,81 +12079,67 @@ (unsafe-place-local-set! cell.3 0)))) (define poll-and-select-thread! (let ((poll-and-select-thread!_0 - (letrec ((procz1 (|#%name| temp4 (lambda () (begin (void)))))) - (|#%name| - poll-and-select-thread! - (lambda (leftover-ticks2_0 pending-callbacks1_0) - (begin - (let ((callbacks_0 - (if (null? pending-callbacks1_0) - (|#%app| host:poll-async-callbacks) - pending-callbacks1_0))) - (let ((poll-now?_0 (<= leftover-ticks2_0 0))) - (begin - (|#%app| host:poll-will-executors) - (poll-custodian-will-executor) - (if poll-now?_0 (check-external-events) (void)) - (call-pre-poll-external-callbacks) - (|#%app| check-place-activity callbacks_0) - (if (check-queued-custodian-shutdown) - (if (1/thread-dead? (unsafe-place-local-ref cell.1$1)) - (force-exit 0) - (void)) + (|#%name| + poll-and-select-thread! + (lambda (leftover-ticks2_0 pending-callbacks1_0) + (begin + (let ((callbacks_0 + (if (null? pending-callbacks1_0) + (|#%app| host:poll-async-callbacks) + pending-callbacks1_0))) + (let ((poll-now?_0 (<= leftover-ticks2_0 0))) + (begin + (|#%app| host:poll-will-executors) + (poll-custodian-will-executor) + (if poll-now?_0 (check-external-events) (void)) + (call-pre-poll-external-callbacks) + (|#%app| check-place-activity callbacks_0) + (if (check-queued-custodian-shutdown) + (if (1/thread-dead? (unsafe-place-local-ref cell.1$1)) + (force-exit 0) (void)) - (flush-future-log) - (if (all-threads-poll-done?) - (if (not (null? callbacks_0)) - (begin - (let ((temp4_0 procz1)) - (do-make-thread.1 - #t - #f - #f - #f - 'callbacks - temp4_0)) - (poll-and-select-thread! TICKS callbacks_0)) - (if (if (not poll-now?_0) (check-external-events) #f) - (poll-and-select-thread! TICKS callbacks_0) - (if (try-post-idle) - (select-thread! leftover-ticks2_0 callbacks_0) - (begin - (process-sleep) - (poll-and-select-thread! 0 callbacks_0))))) - (select-thread! - (if poll-now?_0 TICKS leftover-ticks2_0) - callbacks_0))))))))))) + (void)) + (flush-future-log) + (if (all-threads-poll-done?) + (if (not (null? callbacks_0)) + (begin + (let ((temp4_0 + (|#%name| temp4 (lambda () (begin (void)))))) + (do-make-thread.1 #t #f #f #f 'callbacks temp4_0)) + (poll-and-select-thread! TICKS callbacks_0)) + (if (if (not poll-now?_0) (check-external-events) #f) + (poll-and-select-thread! TICKS callbacks_0) + (if (try-post-idle) + (select-thread! leftover-ticks2_0 callbacks_0) + (begin + (process-sleep) + (poll-and-select-thread! 0 callbacks_0))))) + (select-thread! + (if poll-now?_0 TICKS leftover-ticks2_0) + callbacks_0)))))))))) (case-lambda ((leftover-ticks_0) (poll-and-select-thread!_0 leftover-ticks_0 null)) ((leftover-ticks_0 pending-callbacks1_0) (poll-and-select-thread!_0 leftover-ticks_0 pending-callbacks1_0))))) (define select-thread! - (letrec ((loop_0 - (|#%name| - loop - (lambda (leftover-ticks_0 g_0 callbacks_0 none-k_0) - (begin - (let ((child_0 (thread-group-next! g_0))) - (if (not child_0) - (|#%app| none-k_0 callbacks_0) - (if (1/thread? child_0) - (swap-in-thread child_0 leftover-ticks_0 callbacks_0) - (loop_0 - leftover-ticks_0 - child_0 - callbacks_0 - (lambda (callbacks_1) - (loop_0 - leftover-ticks_0 - g_0 - none-k_0 - callbacks_1))))))))))) - (lambda (leftover-ticks_0 callbacks_0) - (loop_0 - leftover-ticks_0 - (unsafe-place-local-ref cell.1) - callbacks_0 - maybe-done)))) + (lambda (leftover-ticks_0 callbacks_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (g_0 callbacks_1 none-k_0) + (begin + (let ((child_0 (thread-group-next! g_0))) + (if (not child_0) + (|#%app| none-k_0 callbacks_1) + (if (1/thread? child_0) + (swap-in-thread child_0 leftover-ticks_0 callbacks_1) + (loop_0 + child_0 + callbacks_1 + (lambda (callbacks_2) + (loop_0 g_0 none-k_0 callbacks_2))))))))))) + (loop_0 (unsafe-place-local-ref cell.1) callbacks_0 maybe-done)))) (define swap-in-thread (lambda (t_0 leftover-ticks_0 callbacks_0) (begin @@ -12173,62 +12156,60 @@ (define current-thread-now-running! (lambda () (set-thread-engine! (current-thread/in-atomic) 'running))) (define swap-in-engine - (letrec ((loop_0 - (|#%name| - loop - (lambda (leftover-ticks_0 t_0 e_0 prefix_0) - (begin - (|#%app| - e_0 - TICKS - prefix_0 - (lambda (e_1 results_0 remaining-ticks_0) - (if (not e_1) - (begin - (accum-cpu-time! t_0 #t) - (set-thread-future! t_0 #f) - (current-thread/in-atomic #f) - (set-place-current-thread! - (unsafe-place-local-ref cell.1$2) - #f) - (current-future$1 #f) - (if (zero? (current-atomic)) - (void) - (internal-error "terminated in atomic mode!")) - (thread-dead! t_0) - (if (eq? (unsafe-place-local-ref cell.1$1) t_0) - (force-exit 0) - (void)) - (thread-did-work!) - (poll-and-select-thread! - (- leftover-ticks_0 (- TICKS remaining-ticks_0)))) - (if (zero? (current-atomic)) - (begin - (if (1/thread-dead? - (unsafe-place-local-ref cell.1$1)) - (force-exit 0) - (void)) - (let ((new-leftover-ticks_0 - (- - leftover-ticks_0 - (- TICKS remaining-ticks_0)))) - (begin - (accum-cpu-time! t_0 (<= new-leftover-ticks_0 0)) - (set-thread-future! t_0 (current-future$1)) - (current-future$1 #f) - (set-place-current-thread! - (unsafe-place-local-ref cell.1$2) - #f) - (if (eq? (thread-engine t_0) 'done) - (void) - (set-thread-engine! t_0 e_1)) - (current-thread/in-atomic #f) - (poll-and-select-thread! new-leftover-ticks_0)))) - (begin - (add-end-atomic-callback! engine-timeout) - (loop_0 leftover-ticks_0 t_0 e_1 void))))))))))) - (lambda (e_0 t_0 leftover-ticks_0) - (loop_0 leftover-ticks_0 t_0 e_0 check-break-prefix)))) + (lambda (e_0 t_0 leftover-ticks_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (e_1 prefix_0) + (begin + (|#%app| + e_1 + TICKS + prefix_0 + (lambda (e_2 results_0 remaining-ticks_0) + (if (not e_2) + (begin + (accum-cpu-time! t_0 #t) + (set-thread-future! t_0 #f) + (current-thread/in-atomic #f) + (set-place-current-thread! + (unsafe-place-local-ref cell.1$2) + #f) + (current-future$1 #f) + (if (zero? (current-atomic)) + (void) + (internal-error "terminated in atomic mode!")) + (thread-dead! t_0) + (if (eq? (unsafe-place-local-ref cell.1$1) t_0) + (force-exit 0) + (void)) + (thread-did-work!) + (poll-and-select-thread! + (- leftover-ticks_0 (- TICKS remaining-ticks_0)))) + (if (zero? (current-atomic)) + (begin + (if (1/thread-dead? (unsafe-place-local-ref cell.1$1)) + (force-exit 0) + (void)) + (let ((new-leftover-ticks_0 + (- leftover-ticks_0 (- TICKS remaining-ticks_0)))) + (begin + (accum-cpu-time! t_0 (<= new-leftover-ticks_0 0)) + (set-thread-future! t_0 (current-future$1)) + (current-future$1 #f) + (set-place-current-thread! + (unsafe-place-local-ref cell.1$2) + #f) + (if (eq? (thread-engine t_0) 'done) + (void) + (set-thread-engine! t_0 e_2)) + (current-thread/in-atomic #f) + (poll-and-select-thread! new-leftover-ticks_0)))) + (begin + (add-end-atomic-callback! engine-timeout) + (loop_0 e_2 void))))))))))) + (loop_0 e_0 check-break-prefix)))) (define check-break-prefix (lambda () (begin @@ -12264,42 +12245,38 @@ (if did?_0 (thread-did-work!) (void)) did?_0)))) (define run-callbacks-in-engine - (letrec ((loop_0 - (|#%name| - loop - (lambda (done?_0 leftover-ticks_0 t_0 e_0 callbacks_0) - (begin - (let ((app_0 TICKS)) - (|#%app| - e_0 - app_0 - (if (pair? callbacks_0) - (lambda () - (begin - (current-thread-now-running!) - (run-callbacks callbacks_0) - (unsafe-set-box*! done?_0 #t) - (engine-block))) - void) - (lambda (e_1 result_0 remaining_0) - (begin - (if e_1 - (void) - (internal-error - "thread ended while it should run callbacks atomically")) - (if (unsafe-unbox* done?_0) - (swap-in-engine e_1 t_0 leftover-ticks_0) - (loop_0 - done?_0 - leftover-ticks_0 - t_0 - e_1 - null))))))))))) - (lambda (e_0 callbacks_0 t_0 leftover-ticks_0) - (if (null? callbacks_0) - (swap-in-engine e_0 t_0 leftover-ticks_0) - (let ((done?_0 (box #f))) - (loop_0 done?_0 leftover-ticks_0 t_0 e_0 callbacks_0)))))) + (lambda (e_0 callbacks_0 t_0 leftover-ticks_0) + (if (null? callbacks_0) + (swap-in-engine e_0 t_0 leftover-ticks_0) + (let ((done?_0 #f)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (e_1 callbacks_1) + (begin + (let ((app_0 TICKS)) + (|#%app| + e_1 + app_0 + (if (pair? callbacks_1) + (lambda () + (begin + (current-thread-now-running!) + (run-callbacks callbacks_1) + (set! done?_0 #t) + (engine-block))) + void) + (lambda (e_2 result_0 remaining_0) + (begin + (if e_2 + (void) + (internal-error + "thread ended while it should run callbacks atomically")) + (if done?_0 + (swap-in-engine e_2 t_0 leftover-ticks_0) + (loop_0 e_2 null))))))))))) + (loop_0 e_0 callbacks_0)))))) (define run-callbacks (lambda (callbacks_0) (begin @@ -12466,189 +12443,182 @@ (alarm-evt1.1 msecs_0)))) (define 1/call-in-nested-thread (let ((call-in-nested-thread_0 - (letrec ((procz2 - (lambda (thunk_0) - (abort-current-continuation - (default-continuation-prompt-tag) - thunk_0))) - (procz1 - (|#%name| - with-handlers-predicate7 - (lambda (x_0) (begin #t))))) - (|#%name| - call-in-nested-thread - (lambda (thunk2_0 cust1_0) - (begin - (let ((cust_0 - (if (eq? cust1_0 unsafe-undefined) - (1/current-custodian) - cust1_0))) + (|#%name| + call-in-nested-thread + (lambda (thunk2_0 cust1_0) + (begin + (let ((cust_0 + (if (eq? cust1_0 unsafe-undefined) + (1/current-custodian) + cust1_0))) + (begin + (if (if (procedure? thunk2_0) + (procedure-arity-includes? thunk2_0 0) + #f) + (void) + (raise-argument-error + 'call-in-nested-thread + "(procedure-arity-includes/c 0)" + thunk2_0)) (begin - (if (if (procedure? thunk2_0) - (procedure-arity-includes? thunk2_0 0) - #f) + (if (1/custodian? cust_0) (void) (raise-argument-error 'call-in-nested-thread - "(procedure-arity-includes/c 0)" - thunk2_0)) - (begin - (if (1/custodian? cust_0) - (void) - (raise-argument-error - 'call-in-nested-thread - "custodian?" - cust_0)) - (let ((init-break-cell_0 (current-break-enabled-cell))) - (let ((result_0 #f)) - (let ((result-kind_0 #f)) - (let ((ready-sema_0 (1/make-semaphore))) - (let ((t_0 unsafe-undefined)) - (set! t_0 - (with-continuation-mark* - push-authentic - break-enabled-key - (make-thread-cell #f) - (let ((temp5_0 - (|#%name| - temp5 - (lambda () + "custodian?" + cust_0)) + (let ((init-break-cell_0 (current-break-enabled-cell))) + (let ((result_0 #f)) + (let ((result-kind_0 #f)) + (let ((ready-sema_0 (1/make-semaphore))) + (let ((t_0 unsafe-undefined)) + (set! t_0 + (with-continuation-mark* + push-authentic + break-enabled-key + (make-thread-cell #f) + (let ((temp5_0 + (|#%name| + temp5 + (lambda () + (begin (begin - (begin - (1/semaphore-wait - ready-sema_0) - (let ((with-handlers-predicate7_0 - procz1)) - (let ((with-handlers-handler8_0 - (|#%name| - with-handlers-handler8 - (lambda (x_0) + (1/semaphore-wait ready-sema_0) + (let ((with-handlers-predicate7_0 + (|#%name| + with-handlers-predicate7 + (lambda (x_0) + (begin #t))))) + (let ((with-handlers-handler8_0 + (|#%name| + with-handlers-handler8 + (lambda (x_0) + (begin (begin + (set! result-kind_0 + 'exn) + (set! result_0 + x_0))))))) + (let ((bpz_0 + (continuation-mark-set-first + #f + break-enabled-key))) + (call-handled-body + bpz_0 + (lambda (e_0) + (select-handler/no-breaks + e_0 + bpz_0 + (list + (cons + with-handlers-predicate7_0 + with-handlers-handler8_0)))) + (lambda () + (with-continuation-mark* + authentic + break-enabled-key + init-break-cell_0 + (begin + (set! result_0 + (call-with-continuation-barrier + (lambda () + (call-with-values + (lambda () + (call-with-continuation-prompt + thunk2_0 + (default-continuation-prompt-tag) + (lambda (thunk_0) + (abort-current-continuation + (default-continuation-prompt-tag) + thunk_0)))) + list)))) + (begin + (start-atomic) + (begin0 (begin (set! result-kind_0 - 'exn) - (set! result_0 - x_0))))))) - (let ((bpz_0 - (continuation-mark-set-first - #f - break-enabled-key))) - (call-handled-body - bpz_0 - (lambda (e_0) - (select-handler/no-breaks - e_0 - bpz_0 - (list - (cons - with-handlers-predicate7_0 - with-handlers-handler8_0)))) - (lambda () - (with-continuation-mark* - authentic - break-enabled-key - init-break-cell_0 - (begin - (set! result_0 - (call-with-continuation-barrier - (lambda () - (call-with-values - (lambda () - (call-with-continuation-prompt - thunk2_0 - (default-continuation-prompt-tag) - procz2)) - list)))) - (begin - (start-atomic) - (begin0 - (begin - (set! result-kind_0 - 'value) - (thread-dead! - (check-not-unsafe-undefined - t_0 - 't_79))) - (end-atomic))) - (engine-block)))))))))))))) - (do-make-thread.1 - #f - cust_0 - #f - #f - 'call-in-nested-thread - temp5_0)))) + 'value) + (thread-dead! + (check-not-unsafe-undefined + t_0 + 't_79))) + (end-atomic))) + (engine-block)))))))))))))) + (do-make-thread.1 + #f + cust_0 + #f + #f + 'call-in-nested-thread + temp5_0)))) + (begin + (start-atomic) (begin - (start-atomic) + (begin0 + (let ((app_0 (current-thread/in-atomic))) + (set-thread-forward-break-to! app_0 t_0)) + (end-atomic)) (begin - (begin0 - (let ((app_0 (current-thread/in-atomic))) - (set-thread-forward-break-to! - app_0 - t_0)) - (end-atomic)) - (begin - (1/semaphore-post ready-sema_0) - (let ((pending-break_0 - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (t_1 pending-break_0) + (1/semaphore-post ready-sema_0) + (let ((pending-break_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (t_1 pending-break_0) + (begin (begin - (begin - (1/thread-wait t_1) - (let ((next-pending-break_0 - (break-max - pending-break_0 - (thread-pending-break - t_1)))) - (let ((sub-t_0 - (thread-forward-break-to - t_1))) - (if sub-t_0 - (loop_0 - sub-t_0 - next-pending-break_0) - next-pending-break_0))))))))) - (loop_0 t_0 #f)))) - (begin - (start-atomic) - (begin0 - (set-thread-forward-break-to! - (current-thread/in-atomic) - #f) - (end-atomic)) - (with-continuation-mark* - push-authentic - break-enabled-key - (make-thread-cell #f) - (begin - (if pending-break_0 - (let ((app_0 - (1/current-thread))) - (1/break-thread - app_0 - (if (eq? - pending-break_0 - 'break) - #f - pending-break_0))) - (void)) - (if (eq? result-kind_0 'exn) - (raise result_0) - (void)) - (if (eq? result-kind_0 'value) - (void) - (raise - (|#%app| - exn:fail - "call-in-nested-thread: the thread was killed, or it exited via the default error escape handler" - (current-continuation-marks)))))) - (1/check-for-break) - (apply - values - result_0)))))))))))))))))))) + (1/thread-wait t_1) + (let ((next-pending-break_0 + (break-max + pending-break_0 + (thread-pending-break + t_1)))) + (let ((sub-t_0 + (thread-forward-break-to + t_1))) + (if sub-t_0 + (loop_0 + sub-t_0 + next-pending-break_0) + next-pending-break_0))))))))) + (loop_0 t_0 #f)))) + (begin + (start-atomic) + (begin0 + (set-thread-forward-break-to! + (current-thread/in-atomic) + #f) + (end-atomic)) + (with-continuation-mark* + push-authentic + break-enabled-key + (make-thread-cell #f) + (begin + (if pending-break_0 + (let ((app_0 (1/current-thread))) + (1/break-thread + app_0 + (if (eq? + pending-break_0 + 'break) + #f + pending-break_0))) + (void)) + (if (eq? result-kind_0 'exn) + (raise result_0) + (void)) + (if (eq? result-kind_0 'value) + (void) + (raise + (|#%app| + exn:fail + "call-in-nested-thread: the thread was killed, or it exited via the default error escape handler" + (current-continuation-marks)))))) + (1/check-for-break) + (apply + values + result_0))))))))))))))))))) (|#%name| call-in-nested-thread (case-lambda @@ -12753,16 +12723,25 @@ (raise-argument-error 'handle-evt "procedure?" proc_0)) (handle-evt8.1 evt_0 proc_0)))))) (define 1/handle-evt? - (letrec ((loop_0 + (|#%name| + handle-evt? + (lambda (evt_0) + (begin + (begin + (if (1/evt? evt_0) + (void) + (raise-argument-error 'handle-evt? "evt?" evt_0)) + (letrec* + ((loop_0 (|#%name| loop - (lambda (evt_0) + (lambda (evt_1) (begin - (let ((or-part_0 (handle-evt?$1 evt_0))) + (let ((or-part_0 (handle-evt?$1 evt_1))) (if or-part_0 or-part_0 - (if (choice-evt? evt_0) - (let ((lst_0 (choice-evt-evts evt_0))) + (if (choice-evt? evt_1) + (let ((lst_0 (choice-evt-evts evt_1))) (begin (letrec* ((for-loop_0 @@ -12771,14 +12750,14 @@ (lambda (result_0 lst_1) (begin (if (pair? lst_1) - (let ((evt_1 (unsafe-car lst_1))) + (let ((evt_2 (unsafe-car lst_1))) (let ((rest_0 (unsafe-cdr lst_1))) (let ((result_1 (let ((result_1 - (loop_0 evt_1))) + (loop_0 evt_2))) (values result_1)))) (if (if (not - (let ((x_0 (list evt_1))) + (let ((x_0 (list evt_2))) result_1)) #t #f) @@ -12787,15 +12766,7 @@ result_0)))))) (for-loop_0 #f lst_0)))) #f)))))))) - (|#%name| - handle-evt? - (lambda (evt_0) - (begin - (begin - (if (1/evt? evt_0) - (void) - (raise-argument-error 'handle-evt? "evt?" evt_0)) - (loop_0 evt_0))))))) + (loop_0 evt_0))))))) (define guard-evt (lambda (proc_0) (begin @@ -13233,56 +13204,53 @@ prop:place-message)) (define 1/vector-set-performance-stats! (let ((vector-set-performance-stats!_0 - (letrec ((maybe-set!_0 - (|#%name| - maybe-set! - (lambda (vec2_0 i_0 v_0) - (begin - (if (< i_0 (vector-length vec2_0)) - (vector-set! vec2_0 i_0 v_0) - (void))))))) - (|#%name| - vector-set-performance-stats! - (lambda (vec2_0 thd1_0) + (|#%name| + vector-set-performance-stats! + (lambda (vec2_0 thd1_0) + (begin (begin + (if (if (vector? vec2_0) (not (immutable? vec2_0)) #f) + (void) + (raise-argument-error + 'vector-set-performance-stats! + "(and/c vector? (not/c immutable?))" + vec2_0)) (begin - (if (if (vector? vec2_0) (not (immutable? vec2_0)) #f) + (if (let ((or-part_0 (not thd1_0))) + (if or-part_0 or-part_0 (1/thread? thd1_0))) (void) (raise-argument-error 'vector-set-performance-stats! - "(and/c vector? (not/c immutable?))" - vec2_0)) - (begin - (if (let ((or-part_0 (not thd1_0))) - (if or-part_0 or-part_0 (1/thread? thd1_0))) - (void) - (raise-argument-error - 'vector-set-performance-stats! - "(or/c thread? #f)" - thd1_0)) + "(or/c thread? #f)" + thd1_0)) + (let ((maybe-set!_0 + (|#%name| + maybe-set! + (lambda (i_0 v_0) + (begin + (if (< i_0 (vector-length vec2_0)) + (vector-set! vec2_0 i_0 v_0) + (void))))))) (if (not thd1_0) (begin - (maybe-set!_0 - vec2_0 - 0 - (1/current-process-milliseconds)) - (maybe-set!_0 vec2_0 1 (current-milliseconds)) - (maybe-set!_0 vec2_0 2 (current-gc-milliseconds)) - (maybe-set!_0 vec2_0 3 0) - (maybe-set!_0 vec2_0 4 (unsafe-place-local-ref cell.3)) - (maybe-set!_0 vec2_0 5 0) - (maybe-set!_0 vec2_0 6 0) - (maybe-set!_0 vec2_0 7 0) - (maybe-set!_0 vec2_0 8 0) - (maybe-set!_0 vec2_0 9 0) - (maybe-set!_0 vec2_0 10 0) - (maybe-set!_0 vec2_0 11 0) + (maybe-set!_0 0 (1/current-process-milliseconds)) + (maybe-set!_0 1 (current-milliseconds)) + (maybe-set!_0 2 (current-gc-milliseconds)) + (maybe-set!_0 3 0) + (maybe-set!_0 4 (unsafe-place-local-ref cell.3)) + (maybe-set!_0 5 0) + (maybe-set!_0 6 0) + (maybe-set!_0 7 0) + (maybe-set!_0 8 0) + (maybe-set!_0 9 0) + (maybe-set!_0 10 0) + (maybe-set!_0 11 0) (void)) (begin - (maybe-set!_0 vec2_0 0 (1/thread-running? thd1_0)) - (maybe-set!_0 vec2_0 1 (1/thread-dead? thd1_0)) - (maybe-set!_0 vec2_0 2 #f) - (maybe-set!_0 vec2_0 3 #f) + (maybe-set!_0 0 (1/thread-running? thd1_0)) + (maybe-set!_0 1 (1/thread-dead? thd1_0)) + (maybe-set!_0 2 #f) + (maybe-set!_0 3 #f) (void))))))))))) (|#%name| vector-set-performance-stats! @@ -13442,68 +13410,80 @@ (set! logging-place-events? logging?_0) (set! log-place-event log_0)))) (define 1/dynamic-place - (letrec ((default-exit_0 - (|#%name| - default-exit - (lambda (lock_0 new-place_0 orig-plumber_0 explicit?7_0 v9_0) - (begin - (begin - (let ((temp17_0 - (if explicit?7_0 "exit (via `exit`)" "exit"))) - (log-place.1 unsafe-undefined #f temp17_0)) - (let ((flush-failed?_0 #f)) - (begin - (plumber-flush-all/wrap - orig-plumber_0 - (lambda (proc_0 h_0) - (call-with-continuation-prompt - (lambda () (|#%app| proc_0 h_0)) - (default-continuation-prompt-tag) - (lambda (thunk_0) - (begin - (set! flush-failed?_0 #t) - (call-with-continuation-prompt thunk_0)))))) - (start-atomic) - (begin0 - (begin - (|#%app| host:mutex-acquire lock_0) - (set-place-queued-result! - new-place_0 - (if flush-failed?_0 1 (if (byte? v9_0) v9_0 0))) - (place-has-activity! new-place_0) - (|#%app| host:mutex-release lock_0)) - (end-atomic)) - (engine-block))))))))) - (|#%name| - dynamic-place - (lambda (path_0 sym_0 in_0 out_0 err_0) + (|#%name| + dynamic-place + (lambda (path_0 sym_0 in_0 out_0 err_0) + (begin (begin - (begin - (if (eq? initial-place (unsafe-place-local-ref cell.1$2)) - (begin - (start-atomic) - (begin0 (ensure-wakeup-handle!) (end-atomic))) - (void)) - (let ((orig-cust_0 (create-custodian #f))) - (let ((lock_0 (|#%app| host:make-mutex))) - (let ((started_0 (|#%app| host:make-condition))) - (call-with-values - (lambda () (1/place-channel)) - (case-lambda - ((place-pch_0 child-pch_0) - (let ((orig-plumber_0 (1/make-plumber))) - (let ((current-place15_0 - (unsafe-place-local-ref cell.1$2))) - (let ((new-place_0 - (make-place.1 - current-place15_0 - place-pch_0 - lock_0 - orig-cust_0))) - (begin - (set-custodian-place! orig-cust_0 new-place_0) - (let ((done-waiting_0 - (place-done-waiting new-place_0))) + (if (eq? initial-place (unsafe-place-local-ref cell.1$2)) + (begin (start-atomic) (begin0 (ensure-wakeup-handle!) (end-atomic))) + (void)) + (let ((orig-cust_0 (create-custodian #f))) + (let ((lock_0 (|#%app| host:make-mutex))) + (let ((started_0 (|#%app| host:make-condition))) + (call-with-values + (lambda () (1/place-channel)) + (case-lambda + ((place-pch_0 child-pch_0) + (let ((orig-plumber_0 (1/make-plumber))) + (let ((current-place15_0 + (unsafe-place-local-ref cell.1$2))) + (let ((new-place_0 + (make-place.1 + current-place15_0 + place-pch_0 + lock_0 + orig-cust_0))) + (begin + (set-custodian-place! orig-cust_0 new-place_0) + (let ((done-waiting_0 + (place-done-waiting new-place_0))) + (let ((default-exit_0 + (|#%name| + default-exit + (lambda (explicit?7_0 v9_0) + (begin + (begin + (let ((temp17_0 + (if explicit?7_0 + "exit (via `exit`)" + "exit"))) + (log-place.1 + unsafe-undefined + #f + temp17_0)) + (let ((flush-failed?_0 #f)) + (begin + (plumber-flush-all/wrap + orig-plumber_0 + (lambda (proc_0 h_0) + (call-with-continuation-prompt + (lambda () + (|#%app| proc_0 h_0)) + (default-continuation-prompt-tag) + (lambda (thunk_0) + (begin + (set! flush-failed?_0 #t) + (call-with-continuation-prompt + thunk_0)))))) + (start-atomic) + (begin0 + (begin + (|#%app| + host:mutex-acquire + lock_0) + (set-place-queued-result! + new-place_0 + (if flush-failed?_0 + 1 + (if (byte? v9_0) v9_0 0))) + (place-has-activity! + new-place_0) + (|#%app| + host:mutex-release + lock_0)) + (end-atomic)) + (engine-block))))))))) (begin (start-atomic) (let ((cref_0 @@ -13578,9 +13558,6 @@ (1/exit-handler (lambda (v_0) (default-exit_0 - lock_0 - new-place_0 - orig-plumber_0 #t v_0))) (begin @@ -13624,9 +13601,6 @@ (|#%app| finish_0) (default-exit_0 - lock_0 - new-place_0 - orig-plumber_0 #f 0))) (default-continuation-prompt-tag) @@ -13635,9 +13609,6 @@ (call-with-continuation-prompt thunk_0) (default-exit_0 - lock_0 - new-place_0 - orig-plumber_0 #f 1))))))))))))))))) (lambda (result_0) @@ -13736,8 +13707,8 @@ (args (raise-binding-result-arity-error 6 - args)))))))))))))) - (args (raise-binding-result-arity-error 2 args))))))))))))) + args))))))))))))))) + (args (raise-binding-result-arity-error 2 args)))))))))))) (define 1/place-break (let ((place-break_0 (|#%name| @@ -14237,7 +14208,7 @@ (|#%app| success-k_0 (car q_0)))))))))))) (define struct:pchannel (make-record-type-descriptor* 'place-channel #f #f #f #f 6 0)) -(define effect_3146 +(define effect_2712 (struct-type-install-properties! struct:pchannel 'place-channel @@ -14249,23 +14220,21 @@ (cons 1/prop:evt (poller2.1 - (letrec ((procz1 - (lambda (v_0) - (values - #f - (wrap-evt7.1 - the-always-evt - (lambda (a_0) (un-message-ize v_0))))))) - (lambda (self_0 poll-ctx_0) - (let ((in-mq_0 (ephemeron-value (pchannel-in-mq-e self_0)))) - (if in-mq_0 - (dequeue! - in-mq_0 - (pchannel-reader-key self_0) - procz1 - (lambda (sema_0) - (values #f (1/replace-evt sema_0 (lambda (s_0) self_0))))) - (values #f the-never-evt)))))))) + (lambda (self_0 poll-ctx_0) + (let ((in-mq_0 (ephemeron-value (pchannel-in-mq-e self_0)))) + (if in-mq_0 + (dequeue! + in-mq_0 + (pchannel-reader-key self_0) + (lambda (v_0) + (values + #f + (wrap-evt7.1 + the-always-evt + (lambda (a_0) (un-message-ize v_0))))) + (lambda (sema_0) + (values #f (1/replace-evt sema_0 (lambda (s_0) self_0))))) + (values #f the-never-evt))))))) (current-inspector) #f '(0 1 2 3 4 5) @@ -14422,38 +14391,34 @@ app_1 (message-queue-in-key-box mq1_0))))))))))))))) (define 1/place-channel-get - (letrec ((procz1 - (lambda (v_0) - (begin - (end-atomic) - (let ((temp33_0 "get message")) (log-place.1 'get #f temp33_0)) - (un-message-ize v_0))))) - (|#%name| - place-channel-get - (lambda (in-pch_0) + (|#%name| + place-channel-get + (lambda (in-pch_0) + (begin (begin - (begin - (if (1/place-channel? in-pch_0) - (void) - (raise-argument-error - 'place-channel-get - "place-channel?" - in-pch_0)) - (let ((pch_0 (unwrap-place-channel in-pch_0))) - (let ((in-mq_0 (ephemeron-value (pchannel-in-mq-e pch_0)))) - (if in-mq_0 - (begin - (start-atomic) - (dequeue! - in-mq_0 - (pchannel-reader-key pch_0) - procz1 - (lambda (sema_0) - (begin - (end-atomic) - (1/semaphore-wait sema_0) - (1/place-channel-get pch_0))))) - (1/sync the-never-evt)))))))))) + (if (1/place-channel? in-pch_0) + (void) + (raise-argument-error 'place-channel-get "place-channel?" in-pch_0)) + (let ((pch_0 (unwrap-place-channel in-pch_0))) + (let ((in-mq_0 (ephemeron-value (pchannel-in-mq-e pch_0)))) + (if in-mq_0 + (begin + (start-atomic) + (dequeue! + in-mq_0 + (pchannel-reader-key pch_0) + (lambda (v_0) + (begin + (end-atomic) + (let ((temp33_0 "get message")) + (log-place.1 'get #f temp33_0)) + (un-message-ize v_0))) + (lambda (sema_0) + (begin + (end-atomic) + (1/semaphore-wait sema_0) + (1/place-channel-get pch_0))))) + (1/sync the-never-evt))))))))) (define 1/place-channel-put (|#%name| place-channel-put diff --git a/racket/src/cs/schemify.sls b/racket/src/cs/schemify.sls index 1b0c649747..5d30882784 100644 --- a/racket/src/cs/schemify.sls +++ b/racket/src/cs/schemify.sls @@ -1,6 +1,5 @@ (library (schemify) (export schemify-linklet - lift-in-schemified-linklet jitify-schemified-linklet xify interpreter-link! diff --git a/racket/src/schemify/lift.rkt b/racket/src/schemify/lift.rkt index 9ae1f9f145..1f3efc3b7f 100644 --- a/racket/src/schemify/lift.rkt +++ b/racket/src/schemify/lift.rkt @@ -520,7 +520,7 @@ (find-loops rand lifts #hasheq() loops))]) (cond [(not (hash-ref loops u-id #f)) - (find-loops rhs #hasheq() loops)] + (find-loops rhs lifts #hasheq() loops)] [else (define new-loop-if-tail (hash-set (for/hasheq ([(id bx) (in-hash loop-if-tail)]) diff --git a/racket/src/schemify/main.rkt b/racket/src/schemify/main.rkt index 9c696aa3a2..998404c83e 100644 --- a/racket/src/schemify/main.rkt +++ b/racket/src/schemify/main.rkt @@ -1,7 +1,6 @@ #lang racket/base (require "schemify.rkt" "known.rkt" - "lift.rkt" "jitify.rkt" "xify.rkt" "fasl-literal.rkt" @@ -14,9 +13,6 @@ (all-from-out "known.rkt") - lift-in-schemified-linklet - lift-in-schemified-body - jitify-schemified-linklet xify diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index e526abef60..e82dd44f71 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -898,28 +898,22 @@ (cdr e) #f target prim-knowns knowns imports mutated simples))] - [(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))) + ;; Struct procedures are only inlined for imported values, which implies + ;; a non-cify, non-system target; for non-imported values, we expect a + ;; later pass to be able to handle things + [(and im (known-struct-constructor? k) (inline-struct-constructor k s-rator im args)) => (lambda (e) e)] - [(and (not (or (aim? target 'cify) - (aim? target 'system))) + [(and im (known-struct-predicate? k) (inline-struct-predicate k s-rator im args)) => (lambda (e) e)] - [(and (not (or (aim? target 'cify) - (aim? target 'system))) + [(and im (known-field-accessor? k) (inline-field-access k s-rator im args)) => (lambda (e) e)] - [(and (not (or (aim? target 'cify) - (aim? target 'system))) + [(and im (known-field-mutator? k) (inline-field-mutate k s-rator im args)) => (lambda (e) e)] diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index f27fb327a0..9143bd8294 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 14 +#define MZSCHEME_VERSION_W 15 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x