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