From 72ee0ef71b9a0514874976cdcf3ea9d5333db4b1 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 1 Mar 2012 17:56:14 -0500 Subject: [PATCH] tree-il->scheme improvements * module/language/tree-il.scm (tree-il->scheme): New implementation that simply calls 'decompile-tree-il'. * module/language/scheme/decompile-tree-il.scm (choose-output-names, do-decompile): New internal procedures. (decompile-tree-il): New and improved implementation. Print source identifiers where possible, otherwise add minimal numeric suffixes. Previously we printed the gensyms. Avoid 'begin' in contexts that provide an implicit 'begin'. Produce 'cond', 'case', 'and', 'or', 'let*', named let, and internal defines where appropriate. Recognize keyword arguments in 'opts' to disable the production of these derived syntactic forms, and to optionally strip numeric suffixes from variable names. * module/ice-9/compile-psyntax.scm: Disable partial evaluation, letrec fixing, and primitive expansion when producing psyntax-pp.scm, in order to produce output as close to the original source as practical. Disable production of derived syntactic forms as needed during bootstrap. Strip numeric suffixes from variable names. Adjust pretty-printing parameters. * module/ice-9/psyntax-pp.scm: Regenerate. It is now less than half of the original size. --- module/ice-9/compile-psyntax.scm | 16 +- module/ice-9/psyntax-pp.scm | 36899 +++++------------ module/language/scheme/decompile-tree-il.scm | 795 +- module/language/tree-il.scm | 155 +- 4 files changed, 11441 insertions(+), 26424 deletions(-) diff --git a/module/ice-9/compile-psyntax.scm b/module/ice-9/compile-psyntax.scm index 3d803e9c7..ee0bd9efd 100644 --- a/module/ice-9/compile-psyntax.scm +++ b/module/ice-9/compile-psyntax.scm @@ -17,7 +17,7 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (use-modules (language tree-il) - (language tree-il optimize) + (language tree-il primitives) (language tree-il canonicalize) (ice-9 pretty-print) (system syntax)) @@ -41,11 +41,17 @@ (begin (pretty-print (tree-il->scheme (canonicalize! - (optimize! + (resolve-primitives! (macroexpand x 'c '(compile load eval)) - (current-module) - '()))) - out) + (current-module))) + (current-module) + (list #:avoid-lambda? #f + #:use-case? #f + #:strip-numeric-suffixes? #t + #:use-derived-syntax? + (and (pair? x) + (eq? 'let (car x))))) + out #:width 120 #:max-expr-width 70) (newline out) (loop (read in)))))) (system (format #f "mv -f ~s.tmp ~s" target target))) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index d11a3f84d..a4e983203 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -1,7099 +1,7158 @@ (eval-when (compile) (set-current-module (resolve-module (quote (guile))))) (if #f #f) -(let ((session-id-4222 (if #f #f)) - (transformer-environment-4283 (if #f #f))) - (letrec* - ((top-level-eval-hook-4220 - (lambda (x-24656 mod-24657) - (primitive-eval x-24656))) - (get-global-definition-hook-4224 - (lambda (symbol-14704 module-14705) +(letrec* + ((make-void + (lambda (src) (make-struct (vector-ref %expanded-vtables 0) 0 src))) + (make-const + (lambda (src exp) + (make-struct (vector-ref %expanded-vtables 1) 0 src exp))) + (make-primitive-ref + (lambda (src name) + (make-struct (vector-ref %expanded-vtables 2) 0 src name))) + (make-lexical-ref + (lambda (src name gensym) + (make-struct (vector-ref %expanded-vtables 3) 0 src name gensym))) + (make-lexical-set + (lambda (src name gensym exp) + (make-struct (vector-ref %expanded-vtables 4) 0 src name gensym exp))) + (make-module-ref + (lambda (src mod name public?) + (make-struct (vector-ref %expanded-vtables 5) 0 src mod name public?))) + (make-module-set + (lambda (src mod name public? exp) + (make-struct + (vector-ref %expanded-vtables 6) + 0 + src + mod + name + public? + exp))) + (make-toplevel-ref + (lambda (src name) + (make-struct (vector-ref %expanded-vtables 7) 0 src name))) + (make-toplevel-set + (lambda (src name exp) + (make-struct (vector-ref %expanded-vtables 8) 0 src name exp))) + (make-toplevel-define + (lambda (src name exp) + (make-struct (vector-ref %expanded-vtables 9) 0 src name exp))) + (make-conditional + (lambda (src test consequent alternate) + (make-struct + (vector-ref %expanded-vtables 10) + 0 + src + test + consequent + alternate))) + (make-application + (lambda (src proc args) + (make-struct (vector-ref %expanded-vtables 11) 0 src proc args))) + (make-sequence + (lambda (src exps) + (make-struct (vector-ref %expanded-vtables 12) 0 src exps))) + (make-lambda + (lambda (src meta body) + (make-struct (vector-ref %expanded-vtables 13) 0 src meta body))) + (make-lambda-case + (lambda (src req opt rest kw inits gensyms body alternate) + (make-struct + (vector-ref %expanded-vtables 14) + 0 + src + req + opt + rest + kw + inits + gensyms + body + alternate))) + (make-let + (lambda (src names gensyms vals body) + (make-struct + (vector-ref %expanded-vtables 15) + 0 + src + names + gensyms + vals + body))) + (make-letrec + (lambda (src in-order? names gensyms vals body) + (make-struct + (vector-ref %expanded-vtables 16) + 0 + src + in-order? + names + gensyms + vals + body))) + (make-dynlet + (lambda (src fluids vals body) + (make-struct + (vector-ref %expanded-vtables 17) + 0 + src + fluids + vals + body))) + (lambda? + (lambda (x) + (and (struct? x) + (eq? (struct-vtable x) (vector-ref %expanded-vtables 13))))) + (lambda-meta (lambda (x) (struct-ref x 1))) + (set-lambda-meta! (lambda (x v) (struct-set! x 1 v))) + (top-level-eval-hook (lambda (x mod) (primitive-eval x))) + (local-eval-hook (lambda (x mod) (primitive-eval x))) + (session-id + (let ((v (module-variable (current-module) 'syntax-session-id))) + (lambda () ((variable-ref v))))) + (put-global-definition-hook + (lambda (symbol type val) + (module-define! + (current-module) + symbol + (make-syntax-transformer symbol type val)))) + (get-global-definition-hook + (lambda (symbol module) + (if (and (not module) (current-module)) + (warn "module system is booted, we should have a module" symbol)) + (let ((v (module-variable + (if module (resolve-module (cdr module)) (current-module)) + symbol))) + (and v + (variable-bound? v) + (let ((val (variable-ref v))) + (and (macro? val) + (macro-type val) + (cons (macro-type val) (macro-binding val)))))))) + (decorate-source + (lambda (e s) + (if (and s (supports-source-properties? e)) + (set-source-properties! e s)) + e)) + (maybe-name-value! + (lambda (name val) + (if (lambda? val) + (let ((meta (lambda-meta val))) + (if (not (assq 'name meta)) + (set-lambda-meta! val (acons 'name name meta))))))) + (build-void (lambda (source) (make-void source))) + (build-application + (lambda (source fun-exp arg-exps) + (make-application source fun-exp arg-exps))) + (build-conditional + (lambda (source test-exp then-exp else-exp) + (make-conditional source test-exp then-exp else-exp))) + (build-dynlet + (lambda (source fluids vals body) + (make-dynlet source fluids vals body))) + (build-lexical-reference + (lambda (type source name var) (make-lexical-ref source name var))) + (build-lexical-assignment + (lambda (source name var exp) + (maybe-name-value! name exp) + (make-lexical-set source name var exp))) + (analyze-variable + (lambda (mod var modref-cont bare-cont) + (if (not mod) + (bare-cont var) + (let ((kind (car mod)) (mod (cdr mod))) + (let ((key kind)) + (cond ((memv key '(public)) (modref-cont mod var #t)) + ((memv key '(private)) + (if (not (equal? mod (module-name (current-module)))) + (modref-cont mod var #f) + (bare-cont var))) + ((memv key '(bare)) (bare-cont var)) + ((memv key '(hygiene)) + (if (and (not (equal? mod (module-name (current-module)))) + (module-variable (resolve-module mod) var)) + (modref-cont mod var #f) + (bare-cont var))) + (else (syntax-violation #f "bad module kind" var mod)))))))) + (build-global-reference + (lambda (source var mod) + (analyze-variable + mod + var + (lambda (mod var public?) (make-module-ref source mod var public?)) + (lambda (var) (make-toplevel-ref source var))))) + (build-global-assignment + (lambda (source var exp mod) + (maybe-name-value! var exp) + (analyze-variable + mod + var + (lambda (mod var public?) + (make-module-set source mod var public? exp)) + (lambda (var) (make-toplevel-set source var exp))))) + (build-global-definition + (lambda (source var exp) + (maybe-name-value! var exp) + (make-toplevel-define source var exp))) + (build-simple-lambda + (lambda (src req rest vars meta exp) + (make-lambda + src + meta + (make-lambda-case src req #f rest #f '() vars exp #f)))) + (build-case-lambda + (lambda (src meta body) (make-lambda src meta body))) + (build-lambda-case + (lambda (src req opt rest kw inits vars body else-case) + (make-lambda-case src req opt rest kw inits vars body else-case))) + (build-primref + (lambda (src name) + (if (equal? (module-name (current-module)) '(guile)) + (make-toplevel-ref src name) + (make-module-ref src '(guile) name #f)))) + (build-data (lambda (src exp) (make-const src exp))) + (build-sequence + (lambda (src exps) + (if (null? (cdr exps)) (car exps) (make-sequence src exps)))) + (build-let + (lambda (src ids vars val-exps body-exp) + (for-each maybe-name-value! ids val-exps) + (if (null? vars) body-exp (make-let src ids vars val-exps body-exp)))) + (build-named-let + (lambda (src ids vars val-exps body-exp) + (let ((f (car vars)) (f-name (car ids)) (vars (cdr vars)) (ids (cdr ids))) + (let ((proc (build-simple-lambda src ids #f vars '() body-exp))) + (maybe-name-value! f-name proc) + (for-each maybe-name-value! ids val-exps) + (make-letrec + src + #f + (list f-name) + (list f) + (list proc) + (build-application + src + (build-lexical-reference 'fun src f-name f) + val-exps)))))) + (build-letrec + (lambda (src in-order? ids vars val-exps body-exp) + (if (null? vars) + body-exp (begin - (if (if (not module-14705) (current-module) #f) - (warn "module system is booted, we should have a module" - symbol-14704)) - (let ((v-14706 - (module-variable - (if module-14705 - (resolve-module (cdr module-14705)) - (current-module)) - symbol-14704))) - (if v-14706 - (if (variable-bound? v-14706) - (let ((val-14708 (variable-ref v-14706))) - (if (macro? val-14708) - (if (macro-type val-14708) - (cons (macro-type val-14708) - (macro-binding val-14708)) - #f) - #f)) - #f) - #f))))) - (maybe-name-value!-4226 - (lambda (name-21545 val-21546) - (if (if (struct? val-21546) - (eq? (struct-vtable val-21546) - (vector-ref %expanded-vtables 13)) - #f) - (let ((meta-21553 (struct-ref val-21546 1))) - (if (not (assq 'name meta-21553)) - (let ((v-21558 - (cons (cons 'name name-21545) meta-21553))) - (struct-set! val-21546 1 v-21558))))))) - (build-application-4228 - (lambda (source-14710 fun-exp-14711 arg-exps-14712) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) - source-14710 - fun-exp-14711 - arg-exps-14712))) - (analyze-variable-4233 - (lambda (mod-14718 - var-14719 - modref-cont-14720 - bare-cont-14721) - (if (not mod-14718) - (bare-cont-14721 var-14719) - (let ((kind-14722 (car mod-14718)) - (mod-14723 (cdr mod-14718))) - (if (eqv? kind-14722 'public) - (modref-cont-14720 mod-14723 var-14719 #t) - (if (eqv? kind-14722 'private) - (if (not (equal? mod-14723 (module-name (current-module)))) - (modref-cont-14720 mod-14723 var-14719 #f) - (bare-cont-14721 var-14719)) - (if (eqv? kind-14722 'bare) - (bare-cont-14721 var-14719) - (if (eqv? kind-14722 'hygiene) - (if (if (not (equal? - mod-14723 - (module-name (current-module)))) - (module-variable - (resolve-module mod-14723) - var-14719) - #f) - (modref-cont-14720 mod-14723 var-14719 #f) - (bare-cont-14721 var-14719)) - (syntax-violation - #f - "bad module kind" - var-14719 - mod-14723))))))))) - (build-simple-lambda-4237 - (lambda (src-14750 - req-14751 - rest-14752 - vars-14753 - meta-14754 - exp-14755) - (let ((body-14761 - (make-struct/no-tail - (vector-ref %expanded-vtables 14) - src-14750 - req-14751 - #f - rest-14752 - #f - '() - vars-14753 - exp-14755 - #f))) - (make-struct/no-tail - (vector-ref %expanded-vtables 13) - src-14750 - meta-14754 - body-14761)))) - (build-sequence-4242 - (lambda (src-24658 exps-24659) - (if (null? (cdr exps-24659)) - (car exps-24659) - (make-struct/no-tail - (vector-ref %expanded-vtables 12) - src-24658 - exps-24659)))) - (build-let-4243 - (lambda (src-14773 - ids-14774 - vars-14775 - val-exps-14776 - body-exp-14777) - (begin - (for-each - maybe-name-value!-4226 - ids-14774 - val-exps-14776) - (if (null? vars-14775) - body-exp-14777 - (make-struct/no-tail - (vector-ref %expanded-vtables 15) - src-14773 - ids-14774 - vars-14775 - val-exps-14776 - body-exp-14777))))) - (build-named-let-4244 - (lambda (src-14801 - ids-14802 - vars-14803 - val-exps-14804 - body-exp-14805) - (let ((f-14806 (car vars-14803)) - (f-name-14807 (car ids-14802)) - (vars-14808 (cdr vars-14803)) - (ids-14809 (cdr ids-14802))) - (let ((proc-14810 - (let ((body-14830 - (make-struct/no-tail - (vector-ref %expanded-vtables 14) - src-14801 - ids-14809 - #f - #f - #f - '() - vars-14808 - body-exp-14805 - #f))) - (make-struct/no-tail - (vector-ref %expanded-vtables 13) - src-14801 - '() - body-14830)))) - (begin - (if (if (struct? proc-14810) - (eq? (struct-vtable proc-14810) - (vector-ref %expanded-vtables 13)) - #f) - (let ((meta-14854 (struct-ref proc-14810 1))) - (if (not (assq 'name meta-14854)) - (let ((v-14861 - (cons (cons 'name f-name-14807) meta-14854))) - (struct-set! proc-14810 1 v-14861))))) - (for-each - maybe-name-value!-4226 - ids-14809 - val-exps-14804) - (let ((names-14885 (list f-name-14807)) - (gensyms-14886 (list f-14806)) - (vals-14887 (list proc-14810)) - (body-14888 - (let ((fun-exp-14892 - (make-struct/no-tail - (vector-ref %expanded-vtables 3) - src-14801 - f-name-14807 - f-14806))) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) - src-14801 - fun-exp-14892 - val-exps-14804)))) - (make-struct/no-tail - (vector-ref %expanded-vtables 16) - src-14801 - #f - names-14885 - gensyms-14886 - vals-14887 - body-14888))))))) - (build-letrec-4245 - (lambda (src-14908 - in-order?-14909 - ids-14910 - vars-14911 - val-exps-14912 - body-exp-14913) - (if (null? vars-14911) - body-exp-14913 - (begin - (for-each - maybe-name-value!-4226 - ids-14910 - val-exps-14912) - (make-struct/no-tail - (vector-ref %expanded-vtables 16) - src-14908 - in-order?-14909 - ids-14910 - vars-14911 - val-exps-14912 - body-exp-14913))))) - (extend-env-4255 - (lambda (labels-14939 bindings-14940 r-14941) - (if (null? labels-14939) - r-14941 - (extend-env-4255 - (cdr labels-14939) - (cdr bindings-14940) - (cons (cons (car labels-14939) (car bindings-14940)) - r-14941))))) - (extend-var-env-4256 - (lambda (labels-14942 vars-14943 r-14944) - (if (null? labels-14942) - r-14944 - (extend-var-env-4256 - (cdr labels-14942) - (cdr vars-14943) - (cons (cons (car labels-14942) - (cons 'lexical (car vars-14943))) - r-14944))))) - (macros-only-env-4257 - (lambda (r-14945) - (if (null? r-14945) - '() - (let ((a-14946 (car r-14945))) - (if (eq? (car (cdr a-14946)) 'macro) - (cons a-14946 - (macros-only-env-4257 (cdr r-14945))) - (macros-only-env-4257 (cdr r-14945))))))) - (global-extend-4259 - (lambda (type-14948 sym-14949 val-14950) - (module-define! - (current-module) - sym-14949 - (make-syntax-transformer - sym-14949 - type-14948 - val-14950)))) - (id?-4261 - (lambda (x-9380) - (if (symbol? x-9380) - #t - (if (if (vector? x-9380) - (if (= (vector-length x-9380) 4) - (eq? (vector-ref x-9380 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref x-9380 1)) - #f)))) - (gen-labels-4264 - (lambda (ls-14960) - (if (null? ls-14960) - '() - (cons (string-append - "l-" - (session-id-4222) - (symbol->string (gensym "-"))) - (gen-labels-4264 (cdr ls-14960)))))) - (make-binding-wrap-4275 - (lambda (ids-14964 labels-14965 w-14966) - (if (null? ids-14964) - w-14966 - (cons (car w-14966) - (cons (let ((labelvec-14967 (list->vector labels-14965))) - (let ((n-14968 (vector-length labelvec-14967))) - (let ((symnamevec-14969 (make-vector n-14968)) - (marksvec-14970 (make-vector n-14968))) - (begin - (letrec* - ((f-14971 - (lambda (ids-14974 i-14975) - (if (not (null? ids-14974)) - (call-with-values - (lambda () - (let ((x-14978 (car ids-14974))) - (if (if (vector? x-14978) - (if (= (vector-length - x-14978) - 4) - (eq? (vector-ref - x-14978 - 0) - 'syntax-object) - #f) - #f) - (values - (vector-ref x-14978 1) - (let ((m1-14994 - (car w-14966)) - (m2-14995 - (car (vector-ref - x-14978 - 2)))) - (if (null? m2-14995) - m1-14994 - (append - m1-14994 - m2-14995)))) - (values - x-14978 - (car w-14966))))) - (lambda (symname-15015 marks-15016) - (begin - (vector-set! - symnamevec-14969 - i-14975 - symname-15015) - (vector-set! - marksvec-14970 - i-14975 - marks-15016) - (f-14971 - (cdr ids-14974) - (#{1+}# i-14975))))))))) - (f-14971 ids-14964 0)) - (vector - 'ribcage - symnamevec-14969 - marksvec-14970 - labelvec-14967))))) - (cdr w-14966)))))) - (join-wraps-4277 - (lambda (w1-15025 w2-15026) - (let ((m1-15027 (car w1-15025)) - (s1-15028 (cdr w1-15025))) - (if (null? m1-15027) - (if (null? s1-15028) - w2-15026 - (cons (car w2-15026) - (let ((m2-15035 (cdr w2-15026))) - (if (null? m2-15035) - s1-15028 - (append s1-15028 m2-15035))))) - (cons (let ((m2-15044 (car w2-15026))) - (if (null? m2-15044) - m1-15027 - (append m1-15027 m2-15044))) - (let ((m2-15053 (cdr w2-15026))) - (if (null? m2-15053) - s1-15028 - (append s1-15028 m2-15053)))))))) - (same-marks?-4279 - (lambda (x-15058 y-15059) - (if (eq? x-15058 y-15059) - (eq? x-15058 y-15059) - (if (not (null? x-15058)) - (if (not (null? y-15059)) - (if (eq? (car x-15058) (car y-15059)) - (same-marks?-4279 (cdr x-15058) (cdr y-15059)) - #f) - #f) - #f)))) - (id-var-name-4280 - (lambda (id-15067 w-15068) - (letrec* - ((search-15069 - (lambda (sym-15130 subst-15131 marks-15132) - (if (null? subst-15131) - (values #f marks-15132) - (let ((fst-15133 (car subst-15131))) - (if (eq? fst-15133 'shift) - (search-15069 - sym-15130 - (cdr subst-15131) - (cdr marks-15132)) - (let ((symnames-15135 (vector-ref fst-15133 1))) - (if (vector? symnames-15135) - (let ((n-15147 (vector-length symnames-15135))) - (letrec* - ((f-15148 - (lambda (i-15150) - (if (= i-15150 n-15147) - (search-15069 - sym-15130 - (cdr subst-15131) - marks-15132) - (if (if (eq? (vector-ref - symnames-15135 - i-15150) - sym-15130) - (same-marks?-4279 - marks-15132 - (vector-ref - (vector-ref fst-15133 2) - i-15150)) - #f) - (values - (vector-ref - (vector-ref fst-15133 3) - i-15150) - marks-15132) - (f-15148 (#{1+}# i-15150))))))) - (f-15148 0))) - (letrec* - ((f-15183 - (lambda (symnames-15185 i-15186) - (if (null? symnames-15185) - (search-15069 - sym-15130 - (cdr subst-15131) - marks-15132) - (if (if (eq? (car symnames-15185) sym-15130) - (same-marks?-4279 - marks-15132 - (list-ref - (vector-ref fst-15133 2) - i-15186)) - #f) - (values - (list-ref - (vector-ref fst-15133 3) - i-15186) - marks-15132) - (f-15183 - (cdr symnames-15185) - (#{1+}# i-15186))))))) - (f-15183 symnames-15135 0)))))))))) - (if (symbol? id-15067) - (let ((t-15072 - (search-15069 - id-15067 - (cdr w-15068) - (car w-15068)))) - (if t-15072 t-15072 id-15067)) - (if (if (vector? id-15067) - (if (= (vector-length id-15067) 4) - (eq? (vector-ref id-15067 0) 'syntax-object) - #f) - #f) - (let ((id-15087 (vector-ref id-15067 1)) - (w1-15088 (vector-ref id-15067 2))) - (let ((marks-15089 - (let ((m1-15099 (car w-15068)) - (m2-15100 (car w1-15088))) - (if (null? m2-15100) - m1-15099 - (append m1-15099 m2-15100))))) - (call-with-values - (lambda () - (search-15069 id-15087 (cdr w-15068) marks-15089)) - (lambda (new-id-15116 marks-15117) - (if new-id-15116 - new-id-15116 - (let ((t-15125 - (search-15069 - id-15087 - (cdr w1-15088) - marks-15117))) - (if t-15125 t-15125 id-15087))))))) - (syntax-violation - 'id-var-name - "invalid id" - id-15067)))))) - (locally-bound-identifiers-4281 - (lambda (w-15208 mod-15209) - (letrec* - ((scan-15210 - (lambda (subst-15215 results-15216) - (if (null? subst-15215) - results-15216 - (let ((fst-15217 (car subst-15215))) - (if (eq? fst-15217 'shift) - (scan-15210 (cdr subst-15215) results-15216) - (let ((symnames-15219 (vector-ref fst-15217 1)) - (marks-15220 (vector-ref fst-15217 2))) - (if (vector? symnames-15219) - (scan-vector-rib-15212 - subst-15215 - symnames-15219 - marks-15220 - results-15216) - (scan-list-rib-15211 - subst-15215 - symnames-15219 - marks-15220 - results-15216)))))))) - (scan-list-rib-15211 - (lambda (subst-15318 - symnames-15319 - marks-15320 - results-15321) - (letrec* - ((f-15322 - (lambda (symnames-15422 marks-15423 results-15424) - (if (null? symnames-15422) - (scan-15210 (cdr subst-15318) results-15424) - (f-15322 - (cdr symnames-15422) - (cdr marks-15423) - (cons (wrap-4290 - (car symnames-15422) - (let ((w-15432 - (cons (car marks-15423) - subst-15318))) - (cons (cons #f (car w-15432)) - (cons 'shift (cdr w-15432)))) - mod-15209) - results-15424)))))) - (f-15322 - symnames-15319 - marks-15320 - results-15321)))) - (scan-vector-rib-15212 - (lambda (subst-15433 - symnames-15434 - marks-15435 - results-15436) - (let ((n-15437 (vector-length symnames-15434))) - (letrec* - ((f-15438 - (lambda (i-15521 results-15522) - (if (= i-15521 n-15437) - (scan-15210 (cdr subst-15433) results-15522) - (f-15438 - (#{1+}# i-15521) - (cons (wrap-4290 - (vector-ref symnames-15434 i-15521) - (let ((w-15530 - (cons (vector-ref - marks-15435 - i-15521) - subst-15433))) - (cons (cons #f (car w-15530)) - (cons 'shift (cdr w-15530)))) - mod-15209) - results-15522)))))) - (f-15438 0 results-15436)))))) - (scan-15210 (cdr w-15208) '())))) - (valid-bound-ids?-4287 - (lambda (ids-15531) - (if (letrec* - ((all-ids?-15532 - (lambda (ids-15694) - (if (null? ids-15694) - (null? ids-15694) - (if (let ((x-15705 (car ids-15694))) - (if (symbol? x-15705) - #t - (if (if (vector? x-15705) - (if (= (vector-length x-15705) 4) - (eq? (vector-ref x-15705 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref x-15705 1)) - #f))) - (all-ids?-15532 (cdr ids-15694)) - #f))))) - (all-ids?-15532 ids-15531)) - (distinct-bound-ids?-4288 ids-15531) - #f))) - (distinct-bound-ids?-4288 - (lambda (ids-15833) - (letrec* - ((distinct?-15834 - (lambda (ids-15946) - (if (null? ids-15946) - (null? ids-15946) - (if (not (bound-id-member?-4289 - (car ids-15946) - (cdr ids-15946))) - (distinct?-15834 (cdr ids-15946)) - #f))))) - (distinct?-15834 ids-15833)))) - (bound-id-member?-4289 - (lambda (x-16156 list-16157) - (if (not (null? list-16157)) - (let ((t-16158 - (let ((j-16239 (car list-16157))) - (if (if (if (vector? x-16156) - (if (= (vector-length x-16156) 4) - (eq? (vector-ref x-16156 0) 'syntax-object) - #f) - #f) - (if (vector? j-16239) - (if (= (vector-length j-16239) 4) - (eq? (vector-ref j-16239 0) 'syntax-object) - #f) - #f) - #f) - (if (eq? (vector-ref x-16156 1) - (vector-ref j-16239 1)) - (same-marks?-4279 - (car (vector-ref x-16156 2)) - (car (vector-ref j-16239 2))) - #f) - (eq? x-16156 j-16239))))) - (if t-16158 - t-16158 - (bound-id-member?-4289 x-16156 (cdr list-16157)))) - #f))) - (wrap-4290 - (lambda (x-16283 w-16284 defmod-16285) - (if (if (null? (car w-16284)) - (null? (cdr w-16284)) - #f) - x-16283 - (if (if (vector? x-16283) - (if (= (vector-length x-16283) 4) - (eq? (vector-ref x-16283 0) 'syntax-object) - #f) - #f) - (let ((expression-16299 (vector-ref x-16283 1)) - (wrap-16300 - (join-wraps-4277 w-16284 (vector-ref x-16283 2))) - (module-16301 (vector-ref x-16283 3))) - (vector - 'syntax-object - expression-16299 - wrap-16300 - module-16301)) - (if (null? x-16283) - x-16283 - (vector - 'syntax-object - x-16283 - w-16284 - defmod-16285)))))) - (source-wrap-4291 - (lambda (x-16318 w-16319 s-16320 defmod-16321) - (wrap-4290 - (begin - (if (if s-16320 - (supports-source-properties? x-16318) - #f) - (set-source-properties! x-16318 s-16320)) - x-16318) - w-16319 - defmod-16321))) - (expand-sequence-4292 - (lambda (body-24664 r-24665 w-24666 s-24667 mod-24668) - (build-sequence-4242 - s-24667 - (letrec* - ((dobody-24791 - (lambda (body-25066 r-25067 w-25068 mod-25069) - (if (null? body-25066) - '() - (let ((first-25070 - (let ((e-25120 (car body-25066))) - (call-with-values - (lambda () - (syntax-type-4296 - e-25120 - r-25067 - w-25068 - (let ((props-25130 - (source-properties - (if (if (vector? e-25120) - (if (= (vector-length - e-25120) - 4) - (eq? (vector-ref - e-25120 - 0) - 'syntax-object) - #f) - #f) - (vector-ref e-25120 1) - e-25120)))) - (if (pair? props-25130) props-25130 #f)) - #f - mod-25069 - #f)) - (lambda (type-25153 - value-25154 - form-25155 - e-25156 - w-25157 - s-25158 - mod-25159) - (expand-expr-4298 - type-25153 - value-25154 - form-25155 - e-25156 - r-25067 - w-25157 - s-25158 - mod-25159)))))) - (cons first-25070 - (dobody-24791 - (cdr body-25066) - r-25067 - w-25068 - mod-25069))))))) - (dobody-24791 - body-24664 - r-24665 - w-24666 - mod-24668))))) - (expand-top-sequence-4293 - (lambda (body-16339 - r-16340 - w-16341 - s-16342 - m-16343 - esew-16344 - mod-16345) - (letrec* - ((scan-16346 - (lambda (body-16477 - r-16478 - w-16479 - s-16480 - m-16481 - esew-16482 - mod-16483 - exps-16484) - (if (null? body-16477) - exps-16484 - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((e-16485 (car body-16477))) - (syntax-type-4296 - e-16485 - r-16478 - w-16479 - (let ((t-16489 - (let ((props-16521 - (source-properties - (if (if (vector? e-16485) - (if (= (vector-length - e-16485) - 4) - (eq? (vector-ref - e-16485 - 0) - 'syntax-object) - #f) - #f) - (vector-ref e-16485 1) - e-16485)))) - (if (pair? props-16521) - props-16521 - #f)))) - (if t-16489 t-16489 s-16480)) - #f - mod-16483 - #f))) - (lambda (type-16544 - value-16545 - form-16546 - e-16547 - w-16548 - s-16549 - mod-16550) - (if (eqv? type-16544 'begin-form) - (let ((tmp-16559 ($sc-dispatch e-16547 '(_)))) - (if tmp-16559 - (@apply (lambda () exps-16484) tmp-16559) - (let ((tmp-16563 - ($sc-dispatch - e-16547 - '(_ any . each-any)))) - (if tmp-16563 - (@apply - (lambda (e1-16567 e2-16568) - (scan-16346 - (cons e1-16567 e2-16568) - r-16478 - w-16548 - s-16549 - m-16481 - esew-16482 - mod-16550 - exps-16484)) - tmp-16563) - (syntax-violation - #f - "source expression failed to match any pattern" - e-16547))))) - (if (eqv? type-16544 'local-syntax-form) - (expand-local-syntax-4302 - value-16545 - e-16547 - r-16478 - w-16548 - s-16549 - mod-16550 - (lambda (body-16586 - r-16587 - w-16588 - s-16589 - mod-16590) - (scan-16346 - body-16586 - r-16587 - w-16588 - s-16589 - m-16481 - esew-16482 - mod-16590 - exps-16484))) - (if (eqv? type-16544 'eval-when-form) - (let ((tmp-16598 - ($sc-dispatch - e-16547 - '(_ each-any any . each-any)))) - (if tmp-16598 - (@apply - (lambda (x-16602 e1-16603 e2-16604) - (let ((when-list-16605 - (parse-when-list-4295 - e-16547 - x-16602)) - (body-16606 - (cons e1-16603 e2-16604))) - (if (eq? m-16481 'e) - (if (memq 'eval when-list-16605) - (scan-16346 - body-16606 - r-16478 - w-16548 - s-16549 - (if (memq 'expand - when-list-16605) - 'c&e - 'e) - '(eval) - mod-16550 - exps-16484) - (begin - (if (memq 'expand - when-list-16605) - (let ((x-16683 - (expand-top-sequence-4293 - body-16606 - r-16478 - w-16548 - s-16549 - 'e - '(eval) - mod-16550))) - (primitive-eval x-16683))) - exps-16484)) - (if (memq 'load when-list-16605) - (if (let ((t-16709 - (memq 'compile - when-list-16605))) - (if t-16709 - t-16709 - (let ((t-16758 - (memq 'expand - when-list-16605))) - (if t-16758 - t-16758 - (if (eq? m-16481 - 'c&e) - (memq 'eval - when-list-16605) - #f))))) - (scan-16346 - body-16606 - r-16478 - w-16548 - s-16549 - 'c&e - '(compile load) - mod-16550 - exps-16484) - (if (if (eq? m-16481 'c) - #t - (eq? m-16481 'c&e)) - (scan-16346 - body-16606 - r-16478 - w-16548 - s-16549 - 'c - '(load) - mod-16550 - exps-16484) - exps-16484)) - (if (let ((t-16887 - (memq 'compile - when-list-16605))) - (if t-16887 - t-16887 - (let ((t-16936 - (memq 'expand - when-list-16605))) - (if t-16936 - t-16936 - (if (eq? m-16481 - 'c&e) - (memq 'eval - when-list-16605) - #f))))) - (begin - (let ((x-17060 - (expand-top-sequence-4293 - body-16606 - r-16478 - w-16548 - s-16549 - 'e - '(eval) - mod-16550))) - (primitive-eval x-17060)) - exps-16484) - exps-16484))))) - tmp-16598) - (syntax-violation - #f - "source expression failed to match any pattern" - e-16547))) - (if (if (eqv? type-16544 'define-syntax-form) - #t - (eqv? type-16544 - 'define-syntax-parameter-form)) - (let ((n-17109 - (id-var-name-4280 - value-16545 - w-16548)) - (r-17110 - (macros-only-env-4257 r-16478))) - (if (eqv? m-16481 'c) - (if (memq 'compile esew-16482) - (let ((e-17118 - (expand-install-global-4294 - n-17109 - (call-with-values - (lambda () - (syntax-type-4296 - e-16547 - r-17110 - w-16548 - (let ((props-17391 - (source-properties - (if (if (vector? - e-16547) - (if (= (vector-length - e-16547) - 4) - (eq? (vector-ref - e-16547 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-16547 - 1) - e-16547)))) - (if (pair? props-17391) - props-17391 - #f)) - #f - mod-16550 - #f)) - (lambda (type-17424 - value-17425 - form-17426 - e-17427 - w-17428 - s-17429 - mod-17430) - (expand-expr-4298 - type-17424 - value-17425 - form-17426 - e-17427 - r-17110 - w-17428 - s-17429 - mod-17430)))))) - (begin - (top-level-eval-hook-4220 - e-17118 - mod-16550) - (if (memq 'load esew-16482) - (cons e-17118 exps-16484) - exps-16484))) - (if (memq 'load esew-16482) - (cons (expand-install-global-4294 - n-17109 - (call-with-values - (lambda () - (syntax-type-4296 - e-16547 - r-17110 - w-16548 - (let ((props-17660 - (source-properties - (if (if (vector? - e-16547) - (if (= (vector-length - e-16547) - 4) - (eq? (vector-ref - e-16547 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-16547 - 1) - e-16547)))) - (if (pair? props-17660) - props-17660 - #f)) - #f - mod-16550 - #f)) - (lambda (type-17662 - value-17663 - form-17664 - e-17665 - w-17666 - s-17667 - mod-17668) - (expand-expr-4298 - type-17662 - value-17663 - form-17664 - e-17665 - r-17110 - w-17666 - s-17667 - mod-17668)))) - exps-16484) - exps-16484)) - (if (eqv? m-16481 'c&e) - (let ((e-17677 - (expand-install-global-4294 - n-17109 - (call-with-values - (lambda () - (syntax-type-4296 - e-16547 - r-17110 - w-16548 - (let ((props-17949 - (source-properties - (if (if (vector? - e-16547) - (if (= (vector-length - e-16547) - 4) - (eq? (vector-ref - e-16547 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-16547 - 1) - e-16547)))) - (if (pair? props-17949) - props-17949 - #f)) - #f - mod-16550 - #f)) - (lambda (type-17982 - value-17983 - form-17984 - e-17985 - w-17986 - s-17987 - mod-17988) - (expand-expr-4298 - type-17982 - value-17983 - form-17984 - e-17985 - r-17110 - w-17986 - s-17987 - mod-17988)))))) - (begin - (top-level-eval-hook-4220 - e-17677 - mod-16550) - (cons e-17677 exps-16484))) - (begin - (if (memq 'eval esew-16482) - (top-level-eval-hook-4220 - (let ((e-18087 - (call-with-values - (lambda () - (syntax-type-4296 - e-16547 - r-17110 - w-16548 - (let ((props-18152 - (source-properties - (if (if (vector? - e-16547) - (if (= (vector-length - e-16547) - 4) - (eq? (vector-ref - e-16547 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-16547 - 1) - e-16547)))) - (if (pair? props-18152) - props-18152 - #f)) - #f - mod-16550 - #f)) - (lambda (type-18185 - value-18186 - form-18187 - e-18188 - w-18189 - s-18190 - mod-18191) - (expand-expr-4298 - type-18185 - value-18186 - form-18187 - e-18188 - r-17110 - w-18189 - s-18190 - mod-18191))))) - (let ((exp-18092 - (let ((fun-exp-18102 - (if (equal? - (module-name - (current-module)) - '(guile)) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 7) - #f - 'make-syntax-transformer) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 5) - #f - '(guile) - 'make-syntax-transformer - #f))) - (arg-exps-18103 - (list (make-struct/no-tail - (vector-ref - %expanded-vtables - 1) - #f - n-17109) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 1) - #f - 'macro) - e-18087))) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 11) - #f - fun-exp-18102 - arg-exps-18103)))) - (begin - (if (if (struct? exp-18092) - (eq? (struct-vtable - exp-18092) - (vector-ref - %expanded-vtables - 13)) - #f) - (let ((meta-18203 - (struct-ref - exp-18092 - 1))) - (if (not (assq 'name - meta-18203)) - (let ((v-18210 - (cons (cons 'name - n-17109) - meta-18203))) - (struct-set! - exp-18092 - 1 - v-18210))))) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 9) - #f - n-17109 - exp-18092)))) - mod-16550)) - exps-16484)))) - (if (eqv? type-16544 'define-form) - (let ((n-18293 - (id-var-name-4280 - value-16545 - w-16548))) - (let ((type-18294 - (car (let ((t-18302 - (assq n-18293 - r-16478))) - (if t-18302 - (cdr t-18302) - (if (symbol? n-18293) - (let ((t-18308 - (get-global-definition-hook-4224 - n-18293 - mod-16550))) - (if t-18308 - t-18308 - '(global))) - '(displaced-lexical))))))) - (if (if (eqv? type-18294 'global) - #t - (if (eqv? type-18294 'core) - #t - (if (eqv? type-18294 'macro) - #t - (eqv? type-18294 - 'module-ref)))) - (begin - (if (if (if (eq? m-16481 'c) - #t - (eq? m-16481 'c&e)) - (if (not (module-local-variable - (current-module) - n-18293)) - (current-module) - #f) - #f) - (let ((old-18341 - (module-variable - (current-module) - n-18293))) - (if (if (variable? old-18341) - (variable-bound? - old-18341) - #f) - (module-define! - (current-module) - n-18293 - (variable-ref old-18341)) - (module-add! - (current-module) - n-18293 - (make-undefined-variable))))) - (cons (if (eq? m-16481 'c&e) - (let ((x-18538 - (let ((exp-18567 - (call-with-values - (lambda () - (syntax-type-4296 - e-16547 - r-16478 - w-16548 - (let ((props-18570 - (source-properties - (if (if (vector? - e-16547) - (if (= (vector-length - e-16547) - 4) - (eq? (vector-ref - e-16547 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-16547 - 1) - e-16547)))) - (if (pair? props-18570) - props-18570 - #f)) - #f - mod-16550 - #f)) - (lambda (type-18571 - value-18572 - form-18573 - e-18574 - w-18575 - s-18576 - mod-18577) - (expand-expr-4298 - type-18571 - value-18572 - form-18573 - e-18574 - r-16478 - w-18575 - s-18576 - mod-18577))))) - (begin - (if (if (struct? - exp-18567) - (eq? (struct-vtable - exp-18567) - (vector-ref - %expanded-vtables - 13)) - #f) - (let ((meta-18579 - (struct-ref - exp-18567 - 1))) - (if (not (assq 'name - meta-18579)) - (let ((v-18581 - (cons (cons 'name - n-18293) - meta-18579))) - (struct-set! - exp-18567 - 1 - v-18581))))) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 9) - s-16549 - n-18293 - exp-18567))))) - (begin - (primitive-eval - x-18538) - x-18538)) - (lambda () - (let ((exp-18583 - (call-with-values - (lambda () - (syntax-type-4296 - e-16547 - r-16478 - w-16548 - (let ((props-18586 - (source-properties - (if (if (vector? - e-16547) - (if (= (vector-length - e-16547) - 4) - (eq? (vector-ref - e-16547 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-16547 - 1) - e-16547)))) - (if (pair? props-18586) - props-18586 - #f)) - #f - mod-16550 - #f)) - (lambda (type-18587 - value-18588 - form-18589 - e-18590 - w-18591 - s-18592 - mod-18593) - (expand-expr-4298 - type-18587 - value-18588 - form-18589 - e-18590 - r-16478 - w-18591 - s-18592 - mod-18593))))) - (begin - (if (if (struct? - exp-18583) - (eq? (struct-vtable - exp-18583) - (vector-ref - %expanded-vtables - 13)) - #f) - (let ((meta-18595 - (struct-ref - exp-18583 - 1))) - (if (not (assq 'name - meta-18595)) - (let ((v-18597 - (cons (cons 'name - n-18293) - meta-18595))) - (struct-set! - exp-18583 - 1 - v-18597))))) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 9) - s-16549 - n-18293 - exp-18583))))) - exps-16484)) - (if (eqv? type-18294 - 'displaced-lexical) - (syntax-violation - #f - "identifier out of context" - (wrap-4290 - (begin - (if (if s-16549 - (supports-source-properties? - form-16546) - #f) - (set-source-properties! - form-16546 - s-16549)) - form-16546) - w-16548 - mod-16550) - (wrap-4290 - value-16545 - w-16548 - mod-16550)) - (syntax-violation - #f - "cannot define keyword at top level" - (wrap-4290 - (begin - (if (if s-16549 - (supports-source-properties? - form-16546) - #f) - (set-source-properties! - form-16546 - s-16549)) - form-16546) - w-16548 - mod-16550) - (wrap-4290 - value-16545 - w-16548 - mod-16550)))))) - (cons (if (eq? m-16481 'c&e) - (let ((x-18662 - (expand-expr-4298 - type-16544 - value-16545 - form-16546 - e-16547 - r-16478 - w-16548 - s-16549 - mod-16550))) - (begin - (primitive-eval x-18662) - x-18662)) - (lambda () - (expand-expr-4298 - type-16544 - value-16545 - form-16546 - e-16547 - r-16478 - w-16548 - s-16549 - mod-16550))) - exps-16484))))))))) - (lambda (exps-18667) - (scan-16346 - (cdr body-16477) - r-16478 - w-16479 - s-16480 - m-16481 - esew-16482 - mod-16483 - exps-18667))))))) - (call-with-values - (lambda () - (scan-16346 - body-16339 - r-16340 - w-16341 - s-16342 - m-16343 - esew-16344 - mod-16345 - '())) - (lambda (exps-16349) - (if (null? exps-16349) - (make-struct/no-tail - (vector-ref %expanded-vtables 0) - s-16342) - (build-sequence-4242 - s-16342 - (letrec* - ((lp-16389 - (lambda (in-16473 out-16474) - (if (null? in-16473) - out-16474 - (let ((e-16475 (car in-16473))) - (lp-16389 - (cdr in-16473) - (cons (if (procedure? e-16475) - (e-16475) - e-16475) - out-16474))))))) - (lp-16389 exps-16349 '()))))))))) - (expand-install-global-4294 - (lambda (name-18668 e-18669) - (let ((exp-18675 - (let ((fun-exp-18685 - (if (equal? (module-name (current-module)) '(guile)) - (make-struct/no-tail - (vector-ref %expanded-vtables 7) - #f - 'make-syntax-transformer) - (make-struct/no-tail - (vector-ref %expanded-vtables 5) - #f - '(guile) - 'make-syntax-transformer - #f))) - (arg-exps-18686 - (list (make-struct/no-tail - (vector-ref %expanded-vtables 1) - #f - name-18668) - (make-struct/no-tail - (vector-ref %expanded-vtables 1) - #f - 'macro) - e-18669))) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) - #f - fun-exp-18685 - arg-exps-18686)))) - (begin - (if (if (struct? exp-18675) - (eq? (struct-vtable exp-18675) - (vector-ref %expanded-vtables 13)) - #f) - (let ((meta-18727 (struct-ref exp-18675 1))) - (if (not (assq 'name meta-18727)) - (let ((v-18734 - (cons (cons 'name name-18668) meta-18727))) - (struct-set! exp-18675 1 v-18734))))) - (make-struct/no-tail - (vector-ref %expanded-vtables 9) - #f - name-18668 - exp-18675))))) - (parse-when-list-4295 - (lambda (e-18745 when-list-18746) - (let ((result-18747 (strip-4310 when-list-18746 '(())))) - (letrec* - ((lp-18748 - (lambda (l-18802) - (if (null? l-18802) - result-18747 - (if (let ((t-18804 (car l-18802))) - (if (eq? t-18804 'compile) - #t - (if (eq? t-18804 'load) - #t - (if (eq? t-18804 'eval) - #t - (eq? t-18804 'expand))))) - (lp-18748 (cdr l-18802)) - (syntax-violation - 'eval-when - "invalid situation" - e-18745 - (car l-18802))))))) - (lp-18748 result-18747))))) - (syntax-type-4296 - (lambda (e-18806 - r-18807 - w-18808 - s-18809 - rib-18810 - mod-18811 - for-car?-18812) - (if (symbol? e-18806) - (let ((n-18813 (id-var-name-4280 e-18806 w-18808))) - (let ((b-18814 - (let ((t-18823 (assq n-18813 r-18807))) - (if t-18823 - (cdr t-18823) - (if (symbol? n-18813) - (let ((t-18829 - (get-global-definition-hook-4224 - n-18813 - mod-18811))) - (if t-18829 t-18829 '(global))) - '(displaced-lexical)))))) - (let ((type-18815 (car b-18814))) - (if (eqv? type-18815 'lexical) - (values - type-18815 - (cdr b-18814) - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811) - (if (eqv? type-18815 'global) - (values - type-18815 - n-18813 - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811) - (if (eqv? type-18815 'macro) - (if for-car?-18812 - (values - type-18815 - (cdr b-18814) - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811) - (syntax-type-4296 - (expand-macro-4300 - (cdr b-18814) - e-18806 - r-18807 - w-18808 - s-18809 - rib-18810 - mod-18811) - r-18807 - '(()) - s-18809 - rib-18810 - mod-18811 - #f)) - (values - type-18815 - (cdr b-18814) - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811))))))) - (if (pair? e-18806) - (let ((first-18857 (car e-18806))) - (call-with-values - (lambda () - (syntax-type-4296 - first-18857 - r-18807 - w-18808 - s-18809 - rib-18810 - mod-18811 - #t)) - (lambda (ftype-18859 - fval-18860 - fform-18861 - fe-18862 - fw-18863 - fs-18864 - fmod-18865) - (if (eqv? ftype-18859 'lexical) - (values - 'lexical-call - fval-18860 - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811) - (if (eqv? ftype-18859 'global) - (values - 'global-call - (vector - 'syntax-object - fval-18860 - w-18808 - fmod-18865) - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811) - (if (eqv? ftype-18859 'macro) - (syntax-type-4296 - (expand-macro-4300 - fval-18860 - e-18806 - r-18807 - w-18808 - s-18809 - rib-18810 - mod-18811) - r-18807 - '(()) - s-18809 - rib-18810 - mod-18811 - for-car?-18812) - (if (eqv? ftype-18859 'module-ref) - (call-with-values - (lambda () (fval-18860 e-18806 r-18807 w-18808)) - (lambda (e-18899 - r-18900 - w-18901 - s-18902 - mod-18903) - (syntax-type-4296 - e-18899 - r-18900 - w-18901 - s-18902 - rib-18810 - mod-18903 - for-car?-18812))) - (if (eqv? ftype-18859 'core) - (values - 'core-form - fval-18860 - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811) - (if (eqv? ftype-18859 'local-syntax) - (values - 'local-syntax-form - fval-18860 - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811) - (if (eqv? ftype-18859 'begin) - (values - 'begin-form - #f - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811) - (if (eqv? ftype-18859 'eval-when) - (values - 'eval-when-form - #f - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811) - (if (eqv? ftype-18859 'define) - (let ((tmp-18935 - ($sc-dispatch - e-18806 - '(_ any any)))) - (if (if tmp-18935 - (@apply - (lambda (name-18939 val-18940) - (if (symbol? name-18939) - #t - (if (if (vector? name-18939) - (if (= (vector-length - name-18939) - 4) - (eq? (vector-ref - name-18939 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref - name-18939 - 1)) - #f))) - tmp-18935) - #f) - (@apply - (lambda (name-18967 val-18968) - (values - 'define-form - name-18967 - e-18806 - val-18968 - w-18808 - s-18809 - mod-18811)) - tmp-18935) - (let ((tmp-18969 - ($sc-dispatch - e-18806 - '(_ (any . any) - any - . - each-any)))) - (if (if tmp-18969 - (@apply - (lambda (name-18973 - args-18974 - e1-18975 - e2-18976) - (if (if (symbol? - name-18973) - #t - (if (if (vector? - name-18973) - (if (= (vector-length - name-18973) - 4) - (eq? (vector-ref - name-18973 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref - name-18973 - 1)) - #f)) - (valid-bound-ids?-4287 - (letrec* - ((lvl-19125 - (lambda (vars-19127 - ls-19128 - w-19129) - (if (pair? vars-19127) - (lvl-19125 - (cdr vars-19127) - (cons (wrap-4290 - (car vars-19127) - w-19129 - #f) - ls-19128) - w-19129) - (if (if (symbol? - vars-19127) - #t - (if (if (vector? - vars-19127) - (if (= (vector-length - vars-19127) - 4) - (eq? (vector-ref - vars-19127 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref - vars-19127 - 1)) - #f)) - (cons (wrap-4290 - vars-19127 - w-19129 - #f) - ls-19128) - (if (null? vars-19127) - ls-19128 - (if (if (vector? - vars-19127) - (if (= (vector-length - vars-19127) - 4) - (eq? (vector-ref - vars-19127 - 0) - 'syntax-object) - #f) - #f) - (lvl-19125 - (vector-ref - vars-19127 - 1) - ls-19128 - (join-wraps-4277 - w-19129 - (vector-ref - vars-19127 - 2))) - (cons vars-19127 - ls-19128)))))))) - (lvl-19125 - args-18974 - '() - '(())))) - #f)) - tmp-18969) - #f) - (@apply - (lambda (name-19173 - args-19174 - e1-19175 - e2-19176) - (values - 'define-form - (wrap-4290 - name-19173 - w-18808 - mod-18811) - (wrap-4290 - e-18806 - w-18808 - mod-18811) - (let ((e-19184 - (cons '#(syntax-object - lambda - ((top) - #(ribcage - #(name - args - e1 - e2) - #((top) - (top) - (top) - (top)) - #("l-*-1902" - "l-*-1903" - "l-*-1904" - "l-*-1905")) - #(ribcage - () - () - ()) - #(ribcage - #(key) - #((m-*-1867 - top)) - #("l-*-1868")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(ftype - fval - fform - fe - fw - fs - fmod) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-1860" - "l-*-1861" - "l-*-1862" - "l-*-1863" - "l-*-1864" - "l-*-1865" - "l-*-1866")) - #(ribcage - () - () - ()) - #(ribcage - #(first) - #((top)) - #("l-*-1851")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(e - r - w - s - rib - mod - for-car?) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-1827" - "l-*-1828" - "l-*-1829" - "l-*-1830" - "l-*-1831" - "l-*-1832" - "l-*-1833")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) - (top) - (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene - guile)) - (wrap-4290 - (cons args-19174 - (cons e1-19175 - e2-19176)) - w-18808 - mod-18811)))) - (begin - (if (if s-18809 - (supports-source-properties? - e-19184) - #f) - (set-source-properties! - e-19184 - s-18809)) - e-19184)) - '(()) - s-18809 - mod-18811)) - tmp-18969) - (let ((tmp-19191 - ($sc-dispatch - e-18806 - '(_ any)))) - (if (if tmp-19191 - (@apply - (lambda (name-19195) - (if (symbol? - name-19195) - #t - (if (if (vector? - name-19195) - (if (= (vector-length - name-19195) - 4) - (eq? (vector-ref - name-19195 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref - name-19195 - 1)) - #f))) - tmp-19191) - #f) - (@apply - (lambda (name-19222) - (values - 'define-form - (wrap-4290 - name-19222 - w-18808 - mod-18811) - (wrap-4290 - e-18806 - w-18808 - mod-18811) - '(#(syntax-object - if - ((top) - #(ribcage - #(name) - #((top)) - #("l-*-1915")) - #(ribcage () () ()) - #(ribcage - #(key) - #((m-*-1867 top)) - #("l-*-1868")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(ftype - fval - fform - fe - fw - fs - fmod) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-1860" - "l-*-1861" - "l-*-1862" - "l-*-1863" - "l-*-1864" - "l-*-1865" - "l-*-1866")) - #(ribcage () () ()) - #(ribcage - #(first) - #((top)) - #("l-*-1851")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(e - r - w - s - rib - mod - for-car?) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-1827" - "l-*-1828" - "l-*-1829" - "l-*-1830" - "l-*-1831" - "l-*-1832" - "l-*-1833")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) - (top) - (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)) - #(syntax-object - #f - ((top) - #(ribcage - #(name) - #((top)) - #("l-*-1915")) - #(ribcage () () ()) - #(ribcage - #(key) - #((m-*-1867 top)) - #("l-*-1868")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(ftype - fval - fform - fe - fw - fs - fmod) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-1860" - "l-*-1861" - "l-*-1862" - "l-*-1863" - "l-*-1864" - "l-*-1865" - "l-*-1866")) - #(ribcage () () ()) - #(ribcage - #(first) - #((top)) - #("l-*-1851")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(e - r - w - s - rib - mod - for-car?) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-1827" - "l-*-1828" - "l-*-1829" - "l-*-1830" - "l-*-1831" - "l-*-1832" - "l-*-1833")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) - (top) - (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)) - #(syntax-object - #f - ((top) - #(ribcage - #(name) - #((top)) - #("l-*-1915")) - #(ribcage () () ()) - #(ribcage - #(key) - #((m-*-1867 top)) - #("l-*-1868")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(ftype - fval - fform - fe - fw - fs - fmod) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-1860" - "l-*-1861" - "l-*-1862" - "l-*-1863" - "l-*-1864" - "l-*-1865" - "l-*-1866")) - #(ribcage () () ()) - #(ribcage - #(first) - #((top)) - #("l-*-1851")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(e - r - w - s - rib - mod - for-car?) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-1827" - "l-*-1828" - "l-*-1829" - "l-*-1830" - "l-*-1831" - "l-*-1832" - "l-*-1833")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) - (top) - (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile))) - '(()) - s-18809 - mod-18811)) - tmp-19191) - (syntax-violation - #f - "source expression failed to match any pattern" - e-18806))))))) - (if (eqv? ftype-18859 'define-syntax) - (let ((tmp-19246 - ($sc-dispatch - e-18806 - '(_ any any)))) - (if (if tmp-19246 - (@apply - (lambda (name-19250 val-19251) - (if (symbol? name-19250) - #t - (if (if (vector? - name-19250) - (if (= (vector-length - name-19250) - 4) - (eq? (vector-ref - name-19250 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref - name-19250 - 1)) - #f))) - tmp-19246) - #f) - (@apply - (lambda (name-19278 val-19279) - (values - 'define-syntax-form - name-19278 - e-18806 - val-19279 - w-18808 - s-18809 - mod-18811)) - tmp-19246) - (syntax-violation - #f - "source expression failed to match any pattern" - e-18806))) - (if (eqv? ftype-18859 - 'define-syntax-parameter) - (let ((tmp-19293 - ($sc-dispatch - e-18806 - '(_ any any)))) - (if (if tmp-19293 - (@apply - (lambda (name-19297 - val-19298) - (if (symbol? name-19297) - #t - (if (if (vector? - name-19297) - (if (= (vector-length - name-19297) - 4) - (eq? (vector-ref - name-19297 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref - name-19297 - 1)) - #f))) - tmp-19293) - #f) - (@apply - (lambda (name-19325 val-19326) - (values - 'define-syntax-parameter-form - name-19325 - e-18806 - val-19326 - w-18808 - s-18809 - mod-18811)) - tmp-19293) + (for-each maybe-name-value! ids val-exps) + (make-letrec src in-order? ids vars val-exps body-exp))))) + (make-syntax-object + (lambda (expression wrap module) + (vector 'syntax-object expression wrap module))) + (syntax-object? + (lambda (x) + (and (vector? x) + (= (vector-length x) 4) + (eq? (vector-ref x 0) 'syntax-object)))) + (syntax-object-expression (lambda (x) (vector-ref x 1))) + (syntax-object-wrap (lambda (x) (vector-ref x 2))) + (syntax-object-module (lambda (x) (vector-ref x 3))) + (set-syntax-object-expression! + (lambda (x update) (vector-set! x 1 update))) + (set-syntax-object-wrap! + (lambda (x update) (vector-set! x 2 update))) + (set-syntax-object-module! + (lambda (x update) (vector-set! x 3 update))) + (source-annotation + (lambda (x) + (let ((props (source-properties + (if (syntax-object? x) (syntax-object-expression x) x)))) + (and (pair? props) props)))) + (extend-env + (lambda (labels bindings r) + (if (null? labels) + r + (extend-env + (cdr labels) + (cdr bindings) + (cons (cons (car labels) (car bindings)) r))))) + (extend-var-env + (lambda (labels vars r) + (if (null? labels) + r + (extend-var-env + (cdr labels) + (cdr vars) + (cons (cons (car labels) (cons 'lexical (car vars))) r))))) + (macros-only-env + (lambda (r) + (if (null? r) + '() + (let ((a (car r))) + (if (eq? (cadr a) 'macro) + (cons a (macros-only-env (cdr r))) + (macros-only-env (cdr r))))))) + (lookup + (lambda (x r mod) + (let ((t (assq x r))) + (cond (t (cdr t)) + ((symbol? x) (or (get-global-definition-hook x mod) '(global))) + (else '(displaced-lexical)))))) + (global-extend + (lambda (type sym val) (put-global-definition-hook sym type val))) + (nonsymbol-id? + (lambda (x) + (and (syntax-object? x) (symbol? (syntax-object-expression x))))) + (id? (lambda (x) + (if (symbol? x) + #t + (and (syntax-object? x) (symbol? (syntax-object-expression x)))))) + (id-sym-name&marks + (lambda (x w) + (if (syntax-object? x) + (values + (syntax-object-expression x) + (join-marks (car w) (car (syntax-object-wrap x)))) + (values x (car w))))) + (gen-label + (lambda () + (string-append "l-" (session-id) (symbol->string (gensym "-"))))) + (gen-labels + (lambda (ls) + (if (null? ls) '() (cons (gen-label) (gen-labels (cdr ls)))))) + (make-ribcage + (lambda (symnames marks labels) + (vector 'ribcage symnames marks labels))) + (ribcage? + (lambda (x) + (and (vector? x) + (= (vector-length x) 4) + (eq? (vector-ref x 0) 'ribcage)))) + (ribcage-symnames (lambda (x) (vector-ref x 1))) + (ribcage-marks (lambda (x) (vector-ref x 2))) + (ribcage-labels (lambda (x) (vector-ref x 3))) + (set-ribcage-symnames! (lambda (x update) (vector-set! x 1 update))) + (set-ribcage-marks! (lambda (x update) (vector-set! x 2 update))) + (set-ribcage-labels! (lambda (x update) (vector-set! x 3 update))) + (anti-mark + (lambda (w) (cons (cons #f (car w)) (cons 'shift (cdr w))))) + (extend-ribcage! + (lambda (ribcage id label) + (set-ribcage-symnames! + ribcage + (cons (syntax-object-expression id) (ribcage-symnames ribcage))) + (set-ribcage-marks! + ribcage + (cons (car (syntax-object-wrap id)) (ribcage-marks ribcage))) + (set-ribcage-labels! ribcage (cons label (ribcage-labels ribcage))))) + (make-binding-wrap + (lambda (ids labels w) + (if (null? ids) + w + (cons (car w) + (cons (let* ((labelvec (list->vector labels)) (n (vector-length labelvec))) + (let ((symnamevec (make-vector n)) (marksvec (make-vector n))) + (let f ((ids ids) (i 0)) + (if (not (null? ids)) + (call-with-values + (lambda () (id-sym-name&marks (car ids) w)) + (lambda (symname marks) + (vector-set! symnamevec i symname) + (vector-set! marksvec i marks) + (f (cdr ids) (+ i 1)))))) + (make-ribcage symnamevec marksvec labelvec))) + (cdr w)))))) + (smart-append (lambda (m1 m2) (if (null? m2) m1 (append m1 m2)))) + (join-wraps + (lambda (w1 w2) + (let ((m1 (car w1)) (s1 (cdr w1))) + (if (null? m1) + (if (null? s1) w2 (cons (car w2) (smart-append s1 (cdr w2)))) + (cons (smart-append m1 (car w2)) (smart-append s1 (cdr w2))))))) + (join-marks (lambda (m1 m2) (smart-append m1 m2))) + (same-marks? + (lambda (x y) + (or (eq? x y) + (and (not (null? x)) + (not (null? y)) + (eq? (car x) (car y)) + (same-marks? (cdr x) (cdr y)))))) + (id-var-name + (lambda (id w) + (letrec* + ((search + (lambda (sym subst marks) + (if (null? subst) + (values #f marks) + (let ((fst (car subst))) + (if (eq? fst 'shift) + (search sym (cdr subst) (cdr marks)) + (let ((symnames (ribcage-symnames fst))) + (if (vector? symnames) + (search-vector-rib sym subst marks symnames fst) + (search-list-rib sym subst marks symnames fst)))))))) + (search-list-rib + (lambda (sym subst marks symnames ribcage) + (let f ((symnames symnames) (i 0)) + (cond ((null? symnames) (search sym (cdr subst) marks)) + ((and (eq? (car symnames) sym) + (same-marks? marks (list-ref (ribcage-marks ribcage) i))) + (values (list-ref (ribcage-labels ribcage) i) marks)) + (else (f (cdr symnames) (+ i 1))))))) + (search-vector-rib + (lambda (sym subst marks symnames ribcage) + (let ((n (vector-length symnames))) + (let f ((i 0)) + (cond ((= i n) (search sym (cdr subst) marks)) + ((and (eq? (vector-ref symnames i) sym) + (same-marks? marks (vector-ref (ribcage-marks ribcage) i))) + (values (vector-ref (ribcage-labels ribcage) i) marks)) + (else (f (+ i 1))))))))) + (cond ((symbol? id) (or (search id (cdr w) (car w)) id)) + ((syntax-object? id) + (let ((id (syntax-object-expression id)) (w1 (syntax-object-wrap id))) + (let ((marks (join-marks (car w) (car w1)))) + (call-with-values + (lambda () (search id (cdr w) marks)) + (lambda (new-id marks) (or new-id (search id (cdr w1) marks) id)))))) + (else (syntax-violation 'id-var-name "invalid id" id)))))) + (locally-bound-identifiers + (lambda (w mod) + (letrec* + ((scan (lambda (subst results) + (if (null? subst) + results + (let ((fst (car subst))) + (if (eq? fst 'shift) + (scan (cdr subst) results) + (let ((symnames (ribcage-symnames fst)) (marks (ribcage-marks fst))) + (if (vector? symnames) + (scan-vector-rib subst symnames marks results) + (scan-list-rib subst symnames marks results)))))))) + (scan-list-rib + (lambda (subst symnames marks results) + (let f ((symnames symnames) (marks marks) (results results)) + (if (null? symnames) + (scan (cdr subst) results) + (f (cdr symnames) + (cdr marks) + (cons (wrap (car symnames) (anti-mark (cons (car marks) subst)) mod) + results)))))) + (scan-vector-rib + (lambda (subst symnames marks results) + (let ((n (vector-length symnames))) + (let f ((i 0) (results results)) + (if (= i n) + (scan (cdr subst) results) + (f (+ i 1) + (cons (wrap (vector-ref symnames i) + (anti-mark (cons (vector-ref marks i) subst)) + mod) + results)))))))) + (scan (cdr w) '())))) + (resolve-identifier + (lambda (id w r mod) + (letrec* + ((resolve-global + (lambda (var mod) + (let ((b (or (get-global-definition-hook var mod) '(global)))) + (if (eq? (car b) 'global) + (values 'global var mod) + (values (car b) (cdr b) mod))))) + (resolve-lexical + (lambda (label mod) + (let ((b (or (assq-ref r label) '(displaced-lexical)))) + (values (car b) (cdr b) mod))))) + (let ((n (id-var-name id w))) + (cond ((symbol? n) + (resolve-global + n + (if (syntax-object? id) (syntax-object-module id) mod))) + ((string? n) + (resolve-lexical + n + (if (syntax-object? id) (syntax-object-module id) mod))) + (else (error "unexpected id-var-name" id w n))))))) + (transformer-environment + (make-fluid + (lambda (k) + (error "called outside the dynamic extent of a syntax transformer")))) + (with-transformer-environment + (lambda (k) ((fluid-ref transformer-environment) k))) + (free-id=? + (lambda (i j) + (and (eq? (let ((x i)) (if (syntax-object? x) (syntax-object-expression x) x)) + (let ((x j)) (if (syntax-object? x) (syntax-object-expression x) x))) + (eq? (id-var-name i '(())) (id-var-name j '(())))))) + (bound-id=? + (lambda (i j) + (if (and (syntax-object? i) (syntax-object? j)) + (and (eq? (syntax-object-expression i) (syntax-object-expression j)) + (same-marks? + (car (syntax-object-wrap i)) + (car (syntax-object-wrap j)))) + (eq? i j)))) + (valid-bound-ids? + (lambda (ids) + (and (let all-ids? ((ids ids)) + (or (null? ids) (and (id? (car ids)) (all-ids? (cdr ids))))) + (distinct-bound-ids? ids)))) + (distinct-bound-ids? + (lambda (ids) + (let distinct? ((ids ids)) + (or (null? ids) + (and (not (bound-id-member? (car ids) (cdr ids))) + (distinct? (cdr ids))))))) + (bound-id-member? + (lambda (x list) + (and (not (null? list)) + (or (bound-id=? x (car list)) (bound-id-member? x (cdr list)))))) + (wrap (lambda (x w defmod) + (cond ((and (null? (car w)) (null? (cdr w))) x) + ((syntax-object? x) + (make-syntax-object + (syntax-object-expression x) + (join-wraps w (syntax-object-wrap x)) + (syntax-object-module x))) + ((null? x) x) + (else (make-syntax-object x w defmod))))) + (source-wrap + (lambda (x w s defmod) (wrap (decorate-source x s) w defmod))) + (expand-sequence + (lambda (body r w s mod) + (build-sequence + s + (let dobody ((body body) (r r) (w w) (mod mod)) + (if (null? body) + '() + (let ((first (expand (car body) r w mod))) + (cons first (dobody (cdr body) r w mod)))))))) + (expand-top-sequence + (lambda (body r w s m esew mod) + (letrec* + ((scan (lambda (body r w s m esew mod exps) + (if (null? body) + exps + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((e (car body))) + (syntax-type e r w (or (source-annotation e) s) #f mod #f))) + (lambda (type value form e w s mod) + (let ((key type)) + (cond ((memv key '(begin-form)) + (let* ((tmp e) (tmp-1 ($sc-dispatch tmp '(_)))) + (if tmp-1 + (apply (lambda () exps) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(_ any . each-any)))) + (if tmp-1 + (apply (lambda (e1 e2) (scan (cons e1 e2) r w s m esew mod exps)) + tmp-1) (syntax-violation #f "source expression failed to match any pattern" - e-18806))) - (values - 'call - #f - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811))))))))))))))) - (if (if (vector? e-18806) - (if (= (vector-length e-18806) 4) - (eq? (vector-ref e-18806 0) 'syntax-object) - #f) - #f) - (syntax-type-4296 - (vector-ref e-18806 1) - r-18807 - (join-wraps-4277 w-18808 (vector-ref e-18806 2)) - (let ((t-19353 - (let ((props-19385 - (source-properties - (if (if (vector? e-18806) - (if (= (vector-length e-18806) 4) - (eq? (vector-ref e-18806 0) - 'syntax-object) - #f) - #f) - (vector-ref e-18806 1) - e-18806)))) - (if (pair? props-19385) props-19385 #f)))) - (if t-19353 t-19353 s-18809)) - rib-18810 - (let ((t-19408 (vector-ref e-18806 3))) - (if t-19408 t-19408 mod-18811)) - for-car?-18812) - (if (self-evaluating? e-18806) - (values - 'constant - #f - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811) - (values - 'other - #f - e-18806 - e-18806 - w-18808 - s-18809 - mod-18811))))))) - (expand-4297 - (lambda (e-19417 r-19418 w-19419 mod-19420) - (call-with-values - (lambda () - (syntax-type-4296 - e-19417 - r-19418 - w-19419 - (let ((props-19427 - (source-properties - (if (if (vector? e-19417) - (if (= (vector-length e-19417) 4) - (eq? (vector-ref e-19417 0) 'syntax-object) - #f) - #f) - (vector-ref e-19417 1) - e-19417)))) - (if (pair? props-19427) props-19427 #f)) - #f - mod-19420 - #f)) - (lambda (type-19450 - value-19451 - form-19452 - e-19453 - w-19454 - s-19455 - mod-19456) - (expand-expr-4298 - type-19450 - value-19451 - form-19452 - e-19453 - r-19418 - w-19454 - s-19455 - mod-19456))))) - (expand-expr-4298 - (lambda (type-19459 - value-19460 - form-19461 - e-19462 - r-19463 - w-19464 - s-19465 - mod-19466) - (if (eqv? type-19459 'lexical) - (make-struct/no-tail - (vector-ref %expanded-vtables 3) - s-19465 - e-19462 - value-19460) - (if (if (eqv? type-19459 'core) - #t - (eqv? type-19459 'core-form)) - (value-19460 - e-19462 - r-19463 - w-19464 - s-19465 - mod-19466) - (if (eqv? type-19459 'module-ref) - (call-with-values - (lambda () (value-19460 e-19462 r-19463 w-19464)) - (lambda (e-19502 r-19503 w-19504 s-19505 mod-19506) - (call-with-values - (lambda () - (syntax-type-4296 - e-19502 - r-19503 - w-19504 - (let ((props-19522 - (source-properties - (if (if (vector? e-19502) - (if (= (vector-length e-19502) 4) - (eq? (vector-ref e-19502 0) - 'syntax-object) - #f) - #f) - (vector-ref e-19502 1) - e-19502)))) - (if (pair? props-19522) props-19522 #f)) - #f - mod-19506 - #f)) - (lambda (type-19555 - value-19556 - form-19557 - e-19558 - w-19559 - s-19560 - mod-19561) - (expand-expr-4298 - type-19555 - value-19556 - form-19557 - e-19558 - r-19503 - w-19559 - s-19560 - mod-19561))))) - (if (eqv? type-19459 'lexical-call) - (expand-application-4299 - (let ((id-19572 (car e-19462))) - (let ((source-19577 - (let ((props-19587 - (source-properties - (if (if (vector? id-19572) - (if (= (vector-length id-19572) 4) - (eq? (vector-ref id-19572 0) - 'syntax-object) - #f) - #f) - (vector-ref id-19572 1) - id-19572)))) - (if (pair? props-19587) props-19587 #f))) - (name-19578 - (if (if (vector? id-19572) - (if (= (vector-length id-19572) 4) - (eq? (vector-ref id-19572 0) - 'syntax-object) - #f) - #f) - (syntax->datum id-19572) - id-19572))) - (make-struct/no-tail - (vector-ref %expanded-vtables 3) - source-19577 - name-19578 - value-19460))) - e-19462 - r-19463 - w-19464 - s-19465 - mod-19466) - (if (eqv? type-19459 'global-call) - (expand-application-4299 - (let ((source-19630 - (let ((x-19669 (car e-19462))) - (let ((props-19670 - (source-properties - (if (if (vector? x-19669) - (if (= (vector-length x-19669) - 4) - (eq? (vector-ref x-19669 0) - 'syntax-object) - #f) - #f) - (vector-ref x-19669 1) - x-19669)))) - (if (pair? props-19670) props-19670 #f)))) - (var-19631 - (if (if (vector? value-19460) - (if (= (vector-length value-19460) 4) - (eq? (vector-ref value-19460 0) - 'syntax-object) - #f) - #f) - (vector-ref value-19460 1) - value-19460)) - (mod-19632 - (if (if (vector? value-19460) - (if (= (vector-length value-19460) 4) - (eq? (vector-ref value-19460 0) - 'syntax-object) - #f) - #f) - (vector-ref value-19460 3) - mod-19466))) - (analyze-variable-4233 - mod-19632 - var-19631 - (lambda (mod-19658 var-19659 public?-19660) - (make-struct/no-tail - (vector-ref %expanded-vtables 5) - source-19630 - mod-19658 - var-19659 - public?-19660)) - (lambda (var-19683) - (make-struct/no-tail - (vector-ref %expanded-vtables 7) - source-19630 - var-19683)))) - e-19462 - r-19463 - w-19464 - s-19465 - mod-19466) - (if (eqv? type-19459 'constant) - (let ((exp-19698 - (strip-4310 - (wrap-4290 - (begin - (if (if s-19465 - (supports-source-properties? e-19462) - #f) - (set-source-properties! e-19462 s-19465)) - e-19462) - w-19464 - mod-19466) - '(())))) - (make-struct/no-tail - (vector-ref %expanded-vtables 1) - s-19465 - exp-19698)) - (if (eqv? type-19459 'global) - (analyze-variable-4233 - mod-19466 - value-19460 - (lambda (mod-19737 var-19738 public?-19739) - (make-struct/no-tail - (vector-ref %expanded-vtables 5) - s-19465 - mod-19737 - var-19738 - public?-19739)) - (lambda (var-19748) - (make-struct/no-tail - (vector-ref %expanded-vtables 7) - s-19465 - var-19748))) - (if (eqv? type-19459 'call) - (expand-application-4299 - (let ((e-19766 (car e-19462))) - (call-with-values - (lambda () - (syntax-type-4296 - e-19766 - r-19463 - w-19464 - (let ((props-19776 - (source-properties - (if (if (vector? e-19766) - (if (= (vector-length - e-19766) - 4) - (eq? (vector-ref - e-19766 - 0) - 'syntax-object) - #f) - #f) - (vector-ref e-19766 1) - e-19766)))) - (if (pair? props-19776) props-19776 #f)) - #f - mod-19466 - #f)) - (lambda (type-19799 - value-19800 - form-19801 - e-19802 - w-19803 - s-19804 - mod-19805) - (expand-expr-4298 - type-19799 - value-19800 - form-19801 - e-19802 - r-19463 - w-19803 - s-19804 - mod-19805)))) - e-19462 - r-19463 - w-19464 - s-19465 - mod-19466) - (if (eqv? type-19459 'begin-form) - (let ((tmp-19815 - ($sc-dispatch e-19462 '(_ any . each-any)))) - (if tmp-19815 - (@apply - (lambda (e1-19819 e2-19820) - (expand-sequence-4292 - (cons e1-19819 e2-19820) - r-19463 - w-19464 - s-19465 - mod-19466)) - tmp-19815) - (let ((tmp-19947 ($sc-dispatch e-19462 '(_)))) - (if tmp-19947 - (@apply - (lambda () - (if (include-deprecated-features) - (begin - (issue-deprecation-warning - "Sequences of zero expressions are deprecated. Use *unspecified*.") - (make-struct/no-tail - (vector-ref %expanded-vtables 0) - #f)) + tmp)))))) + ((memv key '(local-syntax-form)) + (expand-local-syntax + value + e + r + w + s + mod + (lambda (body r w s mod) (scan body r w s m esew mod exps)))) + ((memv key '(eval-when-form)) + (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ each-any any . each-any)))) + (if tmp + (apply (lambda (x e1 e2) + (let ((when-list (parse-when-list e x)) (body (cons e1 e2))) + (cond ((eq? m 'e) + (if (memq 'eval when-list) + (scan body + r + w + s + (if (memq 'expand when-list) 'c&e 'e) + '(eval) + mod + exps) + (begin + (if (memq 'expand when-list) + (top-level-eval-hook + (expand-top-sequence body r w s 'e '(eval) mod) + mod)) + (values exps)))) + ((memq 'load when-list) + (cond ((or (memq 'compile when-list) + (memq 'expand when-list) + (and (eq? m 'c&e) (memq 'eval when-list))) + (scan body r w s 'c&e '(compile load) mod exps)) + ((memq m '(c c&e)) + (scan body r w s 'c '(load) mod exps)) + (else (values exps)))) + ((or (memq 'compile when-list) + (memq 'expand when-list) + (and (eq? m 'c&e) (memq 'eval when-list))) + (top-level-eval-hook + (expand-top-sequence body r w s 'e '(eval) mod) + mod) + (values exps)) + (else (values exps))))) + tmp) (syntax-violation #f - "sequence of zero expressions" - (wrap-4290 - (begin - (if (if s-19465 - (supports-source-properties? - e-19462) - #f) - (set-source-properties! - e-19462 - s-19465)) - e-19462) - w-19464 - mod-19466)))) - tmp-19947) - (syntax-violation - #f - "source expression failed to match any pattern" - e-19462))))) - (if (eqv? type-19459 'local-syntax-form) - (expand-local-syntax-4302 - value-19460 - e-19462 - r-19463 - w-19464 - s-19465 - mod-19466 - expand-sequence-4292) - (if (eqv? type-19459 'eval-when-form) - (let ((tmp-20059 - ($sc-dispatch - e-19462 - '(_ each-any any . each-any)))) - (if tmp-20059 - (@apply - (lambda (x-20063 e1-20064 e2-20065) - (let ((when-list-20066 - (parse-when-list-4295 - e-19462 - x-20063))) - (if (memq 'eval when-list-20066) - (expand-sequence-4292 - (cons e1-20064 e2-20065) - r-19463 - w-19464 - s-19465 - mod-19466) - (make-struct/no-tail - (vector-ref %expanded-vtables 0) - #f)))) - tmp-20059) - (syntax-violation - #f - "source expression failed to match any pattern" - e-19462))) - (if (if (eqv? type-19459 'define-form) - #t - (if (eqv? type-19459 'define-syntax-form) - #t - (eqv? type-19459 - 'define-syntax-parameter-form))) + "source expression failed to match any pattern" + tmp-1)))) + ((memv key '(define-syntax-form define-syntax-parameter-form)) + (let ((n (id-var-name value w)) (r (macros-only-env r))) + (let ((key m)) + (cond ((memv key '(c)) + (cond ((memq 'compile esew) + (let ((e (expand-install-global n (expand e r w mod)))) + (top-level-eval-hook e mod) + (if (memq 'load esew) (values (cons e exps)) (values exps)))) + ((memq 'load esew) + (values + (cons (expand-install-global n (expand e r w mod)) exps))) + (else (values exps)))) + ((memv key '(c&e)) + (let ((e (expand-install-global n (expand e r w mod)))) + (top-level-eval-hook e mod) + (values (cons e exps)))) + (else + (if (memq 'eval esew) + (top-level-eval-hook + (expand-install-global n (expand e r w mod)) + mod)) + (values exps)))))) + ((memv key '(define-form)) + (let* ((n (id-var-name value w)) (type (car (lookup n r mod))) (key type)) + (cond ((memv key '(global core macro module-ref)) + (if (and (memq m '(c c&e)) + (not (module-local-variable (current-module) n)) + (current-module)) + (let ((old (module-variable (current-module) n))) + (if (and (variable? old) (variable-bound? old)) + (module-define! (current-module) n (variable-ref old)) + (module-add! (current-module) n (make-undefined-variable))))) + (values + (cons (if (eq? m 'c&e) + (let ((x (build-global-definition s n (expand e r w mod)))) + (top-level-eval-hook x mod) + x) + (lambda () (build-global-definition s n (expand e r w mod)))) + exps))) + ((memv key '(displaced-lexical)) + (syntax-violation + #f + "identifier out of context" + (source-wrap form w s mod) + (wrap value w mod))) + (else + (syntax-violation + #f + "cannot define keyword at top level" + (source-wrap form w s mod) + (wrap value w mod)))))) + (else + (values + (cons (if (eq? m 'c&e) + (let ((x (expand-expr type value form e r w s mod))) + (top-level-eval-hook x mod) + x) + (lambda () (expand-expr type value form e r w s mod))) + exps)))))))) + (lambda (exps) (scan (cdr body) r w s m esew mod exps))))))) + (call-with-values + (lambda () (scan body r w s m esew mod '())) + (lambda (exps) + (if (null? exps) + (build-void s) + (build-sequence + s + (let lp ((in exps) (out '())) + (if (null? in) + out + (let ((e (car in))) + (lp (cdr in) (cons (if (procedure? e) (e) e) out)))))))))))) + (expand-install-global + (lambda (name e) + (build-global-definition + #f + name + (build-application + #f + (build-primref #f 'make-syntax-transformer) + (list (build-data #f name) (build-data #f 'macro) e))))) + (parse-when-list + (lambda (e when-list) + (let ((result (strip when-list '(())))) + (let lp ((l result)) + (cond ((null? l) result) + ((memq (car l) '(compile load eval expand)) (lp (cdr l))) + (else (syntax-violation 'eval-when "invalid situation" e (car l)))))))) + (syntax-type + (lambda (e r w s rib mod for-car?) + (cond ((symbol? e) + (let* ((n (id-var-name e w)) + (b (lookup n r mod)) + (type (car b)) + (key type)) + (cond ((memv key '(lexical)) (values type (cdr b) e e w s mod)) + ((memv key '(global)) (values type n e e w s mod)) + ((memv key '(macro)) + (if for-car? + (values type (cdr b) e e w s mod) + (syntax-type + (expand-macro (cdr b) e r w s rib mod) + r + '(()) + s + rib + mod + #f))) + (else (values type (cdr b) e e w s mod))))) + ((pair? e) + (let ((first (car e))) + (call-with-values + (lambda () (syntax-type first r w s rib mod #t)) + (lambda (ftype fval fform fe fw fs fmod) + (let ((key ftype)) + (cond ((memv key '(lexical)) (values 'lexical-call fval e e w s mod)) + ((memv key '(global)) + (values 'global-call (make-syntax-object fval w fmod) e e w s mod)) + ((memv key '(macro)) + (syntax-type + (expand-macro fval e r w s rib mod) + r + '(()) + s + rib + mod + for-car?)) + ((memv key '(module-ref)) + (call-with-values + (lambda () (fval e r w)) + (lambda (e r w s mod) (syntax-type e r w s rib mod for-car?)))) + ((memv key '(core)) (values 'core-form fval e e w s mod)) + ((memv key '(local-syntax)) + (values 'local-syntax-form fval e e w s mod)) + ((memv key '(begin)) (values 'begin-form #f e e w s mod)) + ((memv key '(eval-when)) (values 'eval-when-form #f e e w s mod)) + ((memv key '(define)) + (let* ((tmp e) (tmp-1 ($sc-dispatch tmp '(_ any any)))) + (if (and tmp-1 (apply (lambda (name val) (id? name)) tmp-1)) + (apply (lambda (name val) (values 'define-form name e val w s mod)) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(_ (any . any) any . each-any)))) + (if (and tmp-1 + (apply (lambda (name args e1 e2) + (and (id? name) (valid-bound-ids? (lambda-var-list args)))) + tmp-1)) + (apply (lambda (name args e1 e2) + (values + 'define-form + (wrap name w mod) + (wrap e w mod) + (decorate-source + (cons '#(syntax-object + lambda + ((top) + #(ribcage + #(name args e1 e2) + #((top) (top) (top) (top)) + #("l-*-1902" "l-*-1903" "l-*-1904" "l-*-1905")) + #(ribcage () () ()) + #(ribcage #(key) #((m-*-1867 top)) #("l-*-1868")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(ftype fval fform fe fw fs fmod) + #((top) (top) (top) (top) (top) (top) (top)) + #("l-*-1860" + "l-*-1861" + "l-*-1862" + "l-*-1863" + "l-*-1864" + "l-*-1865" + "l-*-1866")) + #(ribcage () () ()) + #(ribcage #(first) #((top)) #("l-*-1851")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(e r w s rib mod for-car?) + #((top) (top) (top) (top) (top) (top) (top)) + #("l-*-1827" + "l-*-1828" + "l-*-1829" + "l-*-1830" + "l-*-1831" + "l-*-1832" + "l-*-1833")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile)) + (wrap (cons args (cons e1 e2)) w mod)) + s) + '(()) + s + mod)) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(_ any)))) + (if (and tmp-1 (apply (lambda (name) (id? name)) tmp-1)) + (apply (lambda (name) + (values + 'define-form + (wrap name w mod) + (wrap e w mod) + '(#(syntax-object + if + ((top) + #(ribcage #(name) #((top)) #("l-*-1915")) + #(ribcage () () ()) + #(ribcage #(key) #((m-*-1867 top)) #("l-*-1868")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(ftype fval fform fe fw fs fmod) + #((top) (top) (top) (top) (top) (top) (top)) + #("l-*-1860" + "l-*-1861" + "l-*-1862" + "l-*-1863" + "l-*-1864" + "l-*-1865" + "l-*-1866")) + #(ribcage () () ()) + #(ribcage #(first) #((top)) #("l-*-1851")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(e r w s rib mod for-car?) + #((top) (top) (top) (top) (top) (top) (top)) + #("l-*-1827" + "l-*-1828" + "l-*-1829" + "l-*-1830" + "l-*-1831" + "l-*-1832" + "l-*-1833")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile)) + #(syntax-object + #f + ((top) + #(ribcage #(name) #((top)) #("l-*-1915")) + #(ribcage () () ()) + #(ribcage #(key) #((m-*-1867 top)) #("l-*-1868")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(ftype fval fform fe fw fs fmod) + #((top) (top) (top) (top) (top) (top) (top)) + #("l-*-1860" + "l-*-1861" + "l-*-1862" + "l-*-1863" + "l-*-1864" + "l-*-1865" + "l-*-1866")) + #(ribcage () () ()) + #(ribcage #(first) #((top)) #("l-*-1851")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(e r w s rib mod for-car?) + #((top) (top) (top) (top) (top) (top) (top)) + #("l-*-1827" + "l-*-1828" + "l-*-1829" + "l-*-1830" + "l-*-1831" + "l-*-1832" + "l-*-1833")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile)) + #(syntax-object + #f + ((top) + #(ribcage #(name) #((top)) #("l-*-1915")) + #(ribcage () () ()) + #(ribcage #(key) #((m-*-1867 top)) #("l-*-1868")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(ftype fval fform fe fw fs fmod) + #((top) (top) (top) (top) (top) (top) (top)) + #("l-*-1860" + "l-*-1861" + "l-*-1862" + "l-*-1863" + "l-*-1864" + "l-*-1865" + "l-*-1866")) + #(ribcage () () ()) + #(ribcage #(first) #((top)) #("l-*-1851")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(e r w s rib mod for-car?) + #((top) (top) (top) (top) (top) (top) (top)) + #("l-*-1827" + "l-*-1828" + "l-*-1829" + "l-*-1830" + "l-*-1831" + "l-*-1832" + "l-*-1833")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile))) + '(()) + s + mod)) + tmp-1) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp)))))))) + ((memv key '(define-syntax)) + (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ any any)))) + (if (and tmp (apply (lambda (name val) (id? name)) tmp)) + (apply (lambda (name val) (values 'define-syntax-form name e val w s mod)) + tmp) (syntax-violation #f - "definition in expression context, where definitions are not allowed," - (wrap-4290 - (begin - (if (if s-19465 - (supports-source-properties? - form-19461) - #f) - (set-source-properties! - form-19461 - s-19465)) - form-19461) - w-19464 - mod-19466)) - (if (eqv? type-19459 'syntax) + "source expression failed to match any pattern" + tmp-1)))) + ((memv key '(define-syntax-parameter)) + (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ any any)))) + (if (and tmp (apply (lambda (name val) (id? name)) tmp)) + (apply (lambda (name val) + (values 'define-syntax-parameter-form name e val w s mod)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))) + (else (values 'call #f e e w s mod)))))))) + ((syntax-object? e) + (syntax-type + (syntax-object-expression e) + r + (join-wraps w (syntax-object-wrap e)) + (or (source-annotation e) s) + rib + (or (syntax-object-module e) mod) + for-car?)) + ((self-evaluating? e) (values 'constant #f e e w s mod)) + (else (values 'other #f e e w s mod))))) + (expand + (lambda (e r w mod) + (call-with-values + (lambda () (syntax-type e r w (source-annotation e) #f mod #f)) + (lambda (type value form e w s mod) + (expand-expr type value form e r w s mod))))) + (expand-expr + (lambda (type value form e r w s mod) + (let ((key type)) + (cond ((memv key '(lexical)) (build-lexical-reference 'value s e value)) + ((memv key '(core core-form)) (value e r w s mod)) + ((memv key '(module-ref)) + (call-with-values + (lambda () (value e r w)) + (lambda (e r w s mod) (expand e r w mod)))) + ((memv key '(lexical-call)) + (expand-application + (let ((id (car e))) + (build-lexical-reference + 'fun + (source-annotation id) + (if (syntax-object? id) (syntax->datum id) id) + value)) + e + r + w + s + mod)) + ((memv key '(global-call)) + (expand-application + (build-global-reference + (source-annotation (car e)) + (if (syntax-object? value) (syntax-object-expression value) value) + (if (syntax-object? value) (syntax-object-module value) mod)) + e + r + w + s + mod)) + ((memv key '(constant)) + (build-data s (strip (source-wrap e w s mod) '(())))) + ((memv key '(global)) (build-global-reference s value mod)) + ((memv key '(call)) + (expand-application (expand (car e) r w mod) e r w s mod)) + ((memv key '(begin-form)) + (let* ((tmp e) (tmp-1 ($sc-dispatch tmp '(_ any . each-any)))) + (if tmp-1 + (apply (lambda (e1 e2) (expand-sequence (cons e1 e2) r w s mod)) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(_)))) + (if tmp-1 + (apply (lambda () + (if (include-deprecated-features) + (begin + (issue-deprecation-warning + "Sequences of zero expressions are deprecated. Use *unspecified*.") + (expand-void)) (syntax-violation #f - "reference to pattern variable outside syntax form" - (wrap-4290 - (begin - (if (if s-19465 - (supports-source-properties? - e-19462) - #f) - (set-source-properties! - e-19462 - s-19465)) - e-19462) - w-19464 - mod-19466)) - (if (eqv? type-19459 'displaced-lexical) - (syntax-violation - #f - "reference to identifier outside its scope" - (wrap-4290 - (begin - (if (if s-19465 - (supports-source-properties? - e-19462) - #f) - (set-source-properties! - e-19462 - s-19465)) - e-19462) - w-19464 - mod-19466)) - (syntax-violation - #f - "unexpected syntax" - (wrap-4290 - (begin - (if (if s-19465 - (supports-source-properties? - e-19462) - #f) - (set-source-properties! - e-19462 - s-19465)) - e-19462) - w-19464 - mod-19466)))))))))))))))))) - (expand-application-4299 - (lambda (x-20375 - e-20376 - r-20377 - w-20378 - s-20379 - mod-20380) - (let ((tmp-20382 - ($sc-dispatch e-20376 '(any . each-any)))) - (if tmp-20382 - (@apply - (lambda (e0-20386 e1-20387) - (let ((arg-exps-20393 - (map (lambda (e-20398) - (call-with-values - (lambda () - (syntax-type-4296 - e-20398 - r-20377 - w-20378 - (let ((props-20413 - (source-properties - (if (if (vector? e-20398) - (if (= (vector-length - e-20398) - 4) - (eq? (vector-ref - e-20398 - 0) - 'syntax-object) - #f) - #f) - (vector-ref e-20398 1) - e-20398)))) - (if (pair? props-20413) - props-20413 - #f)) - #f - mod-20380 - #f)) - (lambda (type-20446 - value-20447 - form-20448 - e-20449 - w-20450 - s-20451 - mod-20452) - (expand-expr-4298 - type-20446 - value-20447 - form-20448 - e-20449 - r-20377 - w-20450 - s-20451 - mod-20452)))) - e1-20387))) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) - s-20379 - x-20375 - arg-exps-20393))) - tmp-20382) - (syntax-violation - #f - "source expression failed to match any pattern" - e-20376))))) - (expand-macro-4300 - (lambda (p-20462 - e-20463 - r-20464 - w-20465 - s-20466 - rib-20467 - mod-20468) - (letrec* - ((rebuild-macro-output-20469 - (lambda (x-20502 m-20503) - (if (pair? x-20502) - (let ((e-20507 - (cons (rebuild-macro-output-20469 - (car x-20502) - m-20503) - (rebuild-macro-output-20469 - (cdr x-20502) - m-20503)))) - (begin - (if (if s-20466 - (supports-source-properties? e-20507) - #f) - (set-source-properties! e-20507 s-20466)) - e-20507)) - (if (if (vector? x-20502) - (if (= (vector-length x-20502) 4) - (eq? (vector-ref x-20502 0) 'syntax-object) - #f) - #f) - (let ((w-20523 (vector-ref x-20502 2))) - (let ((ms-20524 (car w-20523)) - (ss-20525 (cdr w-20523))) - (if (if (pair? ms-20524) (eq? (car ms-20524) #f) #f) - (let ((expression-20533 (vector-ref x-20502 1)) - (wrap-20534 - (cons (cdr ms-20524) - (if rib-20467 - (cons rib-20467 (cdr ss-20525)) - (cdr ss-20525)))) - (module-20535 (vector-ref x-20502 3))) - (vector - 'syntax-object - expression-20533 - wrap-20534 - module-20535)) - (let ((expression-20545 - (let ((e-20550 (vector-ref x-20502 1))) - (begin - (if (if s-20466 - (supports-source-properties? - e-20550) - #f) - (set-source-properties! - e-20550 - s-20466)) - e-20550))) - (wrap-20546 - (cons (cons m-20503 ms-20524) - (if rib-20467 - (cons rib-20467 - (cons 'shift ss-20525)) - (cons 'shift ss-20525)))) - (module-20547 (vector-ref x-20502 3))) - (vector - 'syntax-object - expression-20545 - wrap-20546 - module-20547))))) - (if (vector? x-20502) - (let ((n-20562 (vector-length x-20502))) - (let ((v-20563 - (let ((e-20571 (make-vector n-20562))) - (begin - (if (if s-20466 - (supports-source-properties? e-20571) - #f) - (set-source-properties! e-20571 s-20466)) - e-20571)))) - (letrec* - ((loop-20564 - (lambda (i-20616) - (if (= i-20616 n-20562) - v-20563 - (begin - (vector-set! - v-20563 - i-20616 - (rebuild-macro-output-20469 - (vector-ref x-20502 i-20616) - m-20503)) - (loop-20564 (#{1+}# i-20616))))))) - (loop-20564 0)))) - (if (symbol? x-20502) + "sequence of zero expressions" + (source-wrap e w s mod)))) + tmp-1) (syntax-violation #f - "encountered raw symbol in macro output" - (let ((s-20622 (cdr w-20465))) - (wrap-4290 - (begin - (if (if s-20622 - (supports-source-properties? e-20463) - #f) - (set-source-properties! e-20463 s-20622)) - e-20463) - w-20465 - mod-20468)) - x-20502) - (begin - (if (if s-20466 - (supports-source-properties? x-20502) - #f) - (set-source-properties! x-20502 s-20466)) - x-20502)))))))) - (with-fluids - ((transformer-environment-4283 - (lambda (k-20470) - (k-20470 - e-20463 - r-20464 - w-20465 - s-20466 - rib-20467 - mod-20468)))) - (rebuild-macro-output-20469 - (p-20462 - (let ((w-20477 - (cons (cons #f (car w-20465)) - (cons 'shift (cdr w-20465))))) - (wrap-4290 - (begin - (if (if s-20466 - (supports-source-properties? e-20463) - #f) - (set-source-properties! e-20463 s-20466)) - e-20463) - w-20477 - mod-20468))) - (gensym - (string-append "m-" (session-id-4222) "-"))))))) - (expand-body-4301 - (lambda (body-20654 - outer-form-20655 - r-20656 - w-20657 - mod-20658) - (let ((r-20659 - (cons '("placeholder" placeholder) r-20656))) - (let ((ribcage-20660 (vector 'ribcage '() '() '()))) - (let ((w-20661 - (cons (car w-20657) - (cons ribcage-20660 (cdr w-20657))))) - (letrec* - ((parse-20662 - (lambda (body-20675 - ids-20676 - labels-20677 - var-ids-20678 - vars-20679 - vals-20680 - bindings-20681) - (if (null? body-20675) - (syntax-violation - #f - "no expressions in body" - outer-form-20655) - (let ((e-20682 (cdr (car body-20675))) - (er-20683 (car (car body-20675)))) - (call-with-values - (lambda () - (syntax-type-4296 - e-20682 - er-20683 - '(()) - (let ((props-20692 - (source-properties - (if (if (vector? er-20683) - (if (= (vector-length er-20683) - 4) - (eq? (vector-ref er-20683 0) - 'syntax-object) - #f) - #f) - (vector-ref er-20683 1) - er-20683)))) - (if (pair? props-20692) props-20692 #f)) - ribcage-20660 - mod-20658 - #f)) - (lambda (type-20715 - value-20716 - form-20717 - e-20718 - w-20719 - s-20720 - mod-20721) - (if (eqv? type-20715 'define-form) - (let ((id-20729 - (wrap-4290 - value-20716 - w-20719 - mod-20721)) - (label-20730 - (string-append - "l-" - (session-id-4222) - (symbol->string (gensym "-"))))) - (let ((var-20731 - (let ((id-20791 - (if (if (vector? id-20729) - (if (= (vector-length - id-20729) - 4) - (eq? (vector-ref - id-20729 - 0) - 'syntax-object) - #f) - #f) - (vector-ref id-20729 1) - id-20729))) - (gensym - (string-append - (symbol->string id-20791) - "-"))))) - (begin - (let ((update-20781 - (cons (vector-ref id-20729 1) - (vector-ref - ribcage-20660 - 1)))) - (vector-set! - ribcage-20660 - 1 - update-20781)) - (let ((update-20783 - (cons (car (vector-ref - id-20729 - 2)) - (vector-ref - ribcage-20660 - 2)))) - (vector-set! - ribcage-20660 - 2 - update-20783)) - (let ((update-20785 - (cons label-20730 - (vector-ref - ribcage-20660 - 3)))) - (vector-set! - ribcage-20660 - 3 - update-20785)) - (parse-20662 - (cdr body-20675) - (cons id-20729 ids-20676) - (cons label-20730 labels-20677) - (cons id-20729 var-ids-20678) - (cons var-20731 vars-20679) - (cons (cons er-20683 - (wrap-4290 - e-20718 - w-20719 - mod-20721)) - vals-20680) - (cons (cons 'lexical var-20731) - bindings-20681))))) - (if (if (eqv? type-20715 'define-syntax-form) - #t - (eqv? type-20715 - 'define-syntax-parameter-form)) - (let ((id-20827 - (wrap-4290 - value-20716 - w-20719 - mod-20721)) - (label-20828 - (string-append - "l-" - (session-id-4222) - (symbol->string (gensym "-"))))) - (begin - (let ((update-20878 - (cons (vector-ref id-20827 1) - (vector-ref - ribcage-20660 - 1)))) - (vector-set! - ribcage-20660 - 1 - update-20878)) - (let ((update-20880 - (cons (car (vector-ref - id-20827 - 2)) - (vector-ref - ribcage-20660 - 2)))) - (vector-set! - ribcage-20660 - 2 - update-20880)) - (let ((update-20882 - (cons label-20828 - (vector-ref - ribcage-20660 - 3)))) - (vector-set! - ribcage-20660 - 3 - update-20882)) - (parse-20662 - (cdr body-20675) - (cons id-20827 ids-20676) - (cons label-20828 labels-20677) - var-ids-20678 - vars-20679 - vals-20680 - (cons (cons 'macro - (cons er-20683 - (wrap-4290 - e-20718 - w-20719 - mod-20721))) - bindings-20681)))) - (if (eqv? type-20715 'begin-form) - (let ((tmp-20893 - ($sc-dispatch - e-20718 - '(_ . each-any)))) - (if tmp-20893 - (@apply - (lambda (e1-20897) - (parse-20662 - (letrec* - ((f-20898 - (lambda (forms-20961) - (if (null? forms-20961) - (cdr body-20675) - (cons (cons er-20683 - (wrap-4290 - (car forms-20961) - w-20719 - mod-20721)) - (f-20898 - (cdr forms-20961))))))) - (f-20898 e1-20897)) - ids-20676 - labels-20677 - var-ids-20678 - vars-20679 - vals-20680 - bindings-20681)) - tmp-20893) - (syntax-violation - #f - "source expression failed to match any pattern" - e-20718))) - (if (eqv? type-20715 'local-syntax-form) - (expand-local-syntax-4302 - value-20716 - e-20718 - er-20683 - w-20719 - s-20720 - mod-20721 - (lambda (forms-20978 - er-20979 - w-20980 - s-20981 - mod-20982) - (parse-20662 - (letrec* - ((f-20983 - (lambda (forms-21046) - (if (null? forms-21046) - (cdr body-20675) - (cons (cons er-20979 - (wrap-4290 - (car forms-21046) - w-20980 - mod-20982)) - (f-20983 - (cdr forms-21046))))))) - (f-20983 forms-20978)) - ids-20676 - labels-20677 - var-ids-20678 - vars-20679 - vals-20680 - bindings-20681))) - (if (null? ids-20676) - (let ((exps-21053 - (map (lambda (x-21054) - (let ((e-21057 - (cdr x-21054)) - (r-21058 - (car x-21054))) - (call-with-values - (lambda () - (syntax-type-4296 - e-21057 - r-21058 - '(()) - (let ((props-21065 - (source-properties - (if (if (vector? - e-21057) - (if (= (vector-length - e-21057) - 4) - (eq? (vector-ref - e-21057 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-21057 - 1) - e-21057)))) - (if (pair? props-21065) - props-21065 - #f)) + "source expression failed to match any pattern" + tmp)))))) + ((memv key '(local-syntax-form)) + (expand-local-syntax value e r w s mod expand-sequence)) + ((memv key '(eval-when-form)) + (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ each-any any . each-any)))) + (if tmp + (apply (lambda (x e1 e2) + (let ((when-list (parse-when-list e x))) + (if (memq 'eval when-list) + (expand-sequence (cons e1 e2) r w s mod) + (expand-void)))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))) + ((memv key + '(define-form define-syntax-form define-syntax-parameter-form)) + (syntax-violation + #f + "definition in expression context, where definitions are not allowed," + (source-wrap form w s mod))) + ((memv key '(syntax)) + (syntax-violation + #f + "reference to pattern variable outside syntax form" + (source-wrap e w s mod))) + ((memv key '(displaced-lexical)) + (syntax-violation + #f + "reference to identifier outside its scope" + (source-wrap e w s mod))) + (else + (syntax-violation #f "unexpected syntax" (source-wrap e w s mod))))))) + (expand-application + (lambda (x e r w s mod) + (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(any . each-any)))) + (if tmp + (apply (lambda (e0 e1) + (build-application s x (map (lambda (e) (expand e r w mod)) e1))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))) + (expand-macro + (lambda (p e r w s rib mod) + (letrec* + ((rebuild-macro-output + (lambda (x m) + (cond ((pair? x) + (decorate-source + (cons (rebuild-macro-output (car x) m) + (rebuild-macro-output (cdr x) m)) + s)) + ((syntax-object? x) + (let ((w (syntax-object-wrap x))) + (let ((ms (car w)) (ss (cdr w))) + (if (and (pair? ms) (eq? (car ms) #f)) + (make-syntax-object + (syntax-object-expression x) + (cons (cdr ms) (if rib (cons rib (cdr ss)) (cdr ss))) + (syntax-object-module x)) + (make-syntax-object + (decorate-source (syntax-object-expression x) s) + (cons (cons m ms) + (if rib (cons rib (cons 'shift ss)) (cons 'shift ss))) + (syntax-object-module x)))))) + ((vector? x) + (let* ((n (vector-length x)) (v (decorate-source (make-vector n) s))) + (let loop ((i 0)) + (if (= i n) + (begin (if #f #f) v) + (begin + (vector-set! v i (rebuild-macro-output (vector-ref x i) m)) + (loop (+ i 1))))))) + ((symbol? x) + (syntax-violation + #f + "encountered raw symbol in macro output" + (source-wrap e w (cdr w) mod) + x)) + (else (decorate-source x s)))))) + (with-fluids + ((transformer-environment (lambda (k) (k e r w s rib mod)))) + (rebuild-macro-output + (p (source-wrap e (anti-mark w) s mod)) + (gensym (string-append "m-" (session-id) "-"))))))) + (expand-body + (lambda (body outer-form r w mod) + (let* ((r (cons '("placeholder" placeholder) r)) + (ribcage (make-ribcage '() '() '())) + (w (cons (car w) (cons ribcage (cdr w))))) + (let parse ((body (map (lambda (x) (cons r (wrap x w mod))) body)) + (ids '()) + (labels '()) + (var-ids '()) + (vars '()) + (vals '()) + (bindings '())) + (if (null? body) + (syntax-violation #f "no expressions in body" outer-form) + (let ((e (cdar body)) (er (caar body))) + (call-with-values + (lambda () + (syntax-type e er '(()) (source-annotation er) ribcage mod #f)) + (lambda (type value form e w s mod) + (let ((key type)) + (cond ((memv key '(define-form)) + (let ((id (wrap value w mod)) (label (gen-label))) + (let ((var (gen-var id))) + (extend-ribcage! ribcage id label) + (parse (cdr body) + (cons id ids) + (cons label labels) + (cons id var-ids) + (cons var vars) + (cons (cons er (wrap e w mod)) vals) + (cons (cons 'lexical var) bindings))))) + ((memv key '(define-syntax-form define-syntax-parameter-form)) + (let ((id (wrap value w mod)) (label (gen-label))) + (extend-ribcage! ribcage id label) + (parse (cdr body) + (cons id ids) + (cons label labels) + var-ids + vars + vals + (cons (cons 'macro (cons er (wrap e w mod))) bindings)))) + ((memv key '(begin-form)) + (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ . each-any)))) + (if tmp + (apply (lambda (e1) + (parse (let f ((forms e1)) + (if (null? forms) + (cdr body) + (cons (cons er (wrap (car forms) w mod)) (f (cdr forms))))) + ids + labels + var-ids + vars + vals + bindings)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))) + ((memv key '(local-syntax-form)) + (expand-local-syntax + value + e + er + w + s + mod + (lambda (forms er w s mod) + (parse (let f ((forms forms)) + (if (null? forms) + (cdr body) + (cons (cons er (wrap (car forms) w mod)) (f (cdr forms))))) + ids + labels + var-ids + vars + vals + bindings)))) + ((null? ids) + (build-sequence + #f + (map (lambda (x) (expand (cdr x) (car x) '(()) mod)) + (cons (cons er (source-wrap e w s mod)) (cdr body))))) + (else + (if (not (valid-bound-ids? ids)) + (syntax-violation + #f + "invalid or duplicate identifier in definition" + outer-form)) + (let loop ((bs bindings) (er-cache #f) (r-cache #f)) + (if (not (null? bs)) + (let ((b (car bs))) + (if (eq? (car b) 'macro) + (let* ((er (cadr b)) + (r-cache (if (eq? er er-cache) r-cache (macros-only-env er)))) + (set-cdr! + b + (eval-local-transformer (expand (cddr b) r-cache '(()) mod) mod)) + (loop (cdr bs) er r-cache)) + (loop (cdr bs) er-cache r-cache))))) + (set-cdr! r (extend-env labels bindings (cdr r))) + (build-letrec + #f + #t + (reverse (map syntax->datum var-ids)) + (reverse vars) + (map (lambda (x) (expand (cdr x) (car x) '(()) mod)) (reverse vals)) + (build-sequence + #f + (map (lambda (x) (expand (cdr x) (car x) '(()) mod)) + (cons (cons er (source-wrap e w s mod)) (cdr body)))))))))))))))) + (expand-local-syntax + (lambda (rec? e r w s mod k) + (let* ((tmp e) + (tmp ($sc-dispatch tmp '(_ #(each (any any)) any . each-any)))) + (if tmp + (apply (lambda (id val e1 e2) + (let ((ids id)) + (if (not (valid-bound-ids? ids)) + (syntax-violation #f "duplicate bound keyword" e) + (let* ((labels (gen-labels ids)) (new-w (make-binding-wrap ids labels w))) + (k (cons e1 e2) + (extend-env + labels + (let ((w (if rec? new-w w)) (trans-r (macros-only-env r))) + (map (lambda (x) + (cons 'macro (eval-local-transformer (expand x trans-r w mod) mod))) + val)) + r) + new-w + s + mod))))) + tmp) + (syntax-violation + #f + "bad local syntax definition" + (source-wrap e w s mod)))))) + (eval-local-transformer + (lambda (expanded mod) + (let ((p (local-eval-hook expanded mod))) + (if (procedure? p) + p + (syntax-violation #f "nonprocedure transformer" p))))) + (expand-void (lambda () (build-void #f))) + (ellipsis? + (lambda (x) + (and (nonsymbol-id? x) + (free-id=? + x + '#(syntax-object + ... + ((top) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-2265")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile)))))) + (lambda-formals + (lambda (orig-args) + (letrec* + ((req (lambda (args rreq) + (let* ((tmp args) (tmp-1 ($sc-dispatch tmp '()))) + (if tmp-1 + (apply (lambda () (check (reverse rreq) #f)) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if (and tmp-1 (apply (lambda (a b) (id? a)) tmp-1)) + (apply (lambda (a b) (req b (cons a rreq))) tmp-1) + (let ((tmp-1 (list tmp))) + (if (and tmp-1 (apply (lambda (r) (id? r)) tmp-1)) + (apply (lambda (r) (check (reverse rreq) r)) tmp-1) + (let ((else tmp)) + (syntax-violation 'lambda "invalid argument list" orig-args args)))))))))) + (check (lambda (req rest) + (if (distinct-bound-ids? (if rest (cons rest req) req)) + (values req #f rest #f) + (syntax-violation + 'lambda + "duplicate identifier in argument list" + orig-args))))) + (req orig-args '())))) + (expand-simple-lambda + (lambda (e r w s mod req rest meta body) + (let* ((ids (if rest (append req (list rest)) req)) + (vars (map gen-var ids)) + (labels (gen-labels ids))) + (build-simple-lambda + s + (map syntax->datum req) + (and rest (syntax->datum rest)) + vars + meta + (expand-body + body + (source-wrap e w s mod) + (extend-var-env labels vars r) + (make-binding-wrap ids labels w) + mod))))) + (lambda*-formals + (lambda (orig-args) + (letrec* + ((req (lambda (args rreq) + (let* ((tmp args) (tmp-1 ($sc-dispatch tmp '()))) + (if tmp-1 + (apply (lambda () (check (reverse rreq) '() #f '())) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if (and tmp-1 (apply (lambda (a b) (id? a)) tmp-1)) + (apply (lambda (a b) (req b (cons a rreq))) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if (and tmp-1 + (apply (lambda (a b) (eq? (syntax->datum a) #:optional)) tmp-1)) + (apply (lambda (a b) (opt b (reverse rreq) '())) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if (and tmp-1 + (apply (lambda (a b) (eq? (syntax->datum a) #:key)) tmp-1)) + (apply (lambda (a b) (key b (reverse rreq) '() '())) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any any)))) + (if (and tmp-1 + (apply (lambda (a b) (eq? (syntax->datum a) #:rest)) tmp-1)) + (apply (lambda (a b) (rest b (reverse rreq) '() '())) tmp-1) + (let ((tmp-1 (list tmp))) + (if (and tmp-1 (apply (lambda (r) (id? r)) tmp-1)) + (apply (lambda (r) (rest r (reverse rreq) '() '())) tmp-1) + (let ((else tmp)) + (syntax-violation + 'lambda* + "invalid argument list" + orig-args + args)))))))))))))))) + (opt (lambda (args req ropt) + (let* ((tmp args) (tmp-1 ($sc-dispatch tmp '()))) + (if tmp-1 + (apply (lambda () (check req (reverse ropt) #f '())) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if (and tmp-1 (apply (lambda (a b) (id? a)) tmp-1)) + (apply (lambda (a b) + (opt b + req + (cons (cons a + '(#(syntax-object + #f + ((top) + #(ribcage #(a b) #((top) (top)) #("l-*-2402" "l-*-2403")) + #(ribcage () () ()) + #(ribcage + #(args req ropt) + #((top) (top) (top)) + #("l-*-2392" "l-*-2393" "l-*-2394")) + #(ribcage + (check rest key opt req) + ((top) (top) (top) (top) (top)) + ("l-*-2338" "l-*-2336" "l-*-2334" "l-*-2332" "l-*-2330")) + #(ribcage #(orig-args) #((top)) #("l-*-2329")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile)))) + ropt))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '((any any) . any)))) + (if (and tmp-1 (apply (lambda (a init b) (id? a)) tmp-1)) + (apply (lambda (a init b) (opt b req (cons (list a init) ropt))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if (and tmp-1 + (apply (lambda (a b) (eq? (syntax->datum a) #:key)) tmp-1)) + (apply (lambda (a b) (key b req (reverse ropt) '())) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any any)))) + (if (and tmp-1 + (apply (lambda (a b) (eq? (syntax->datum a) #:rest)) tmp-1)) + (apply (lambda (a b) (rest b req (reverse ropt) '())) tmp-1) + (let ((tmp-1 (list tmp))) + (if (and tmp-1 (apply (lambda (r) (id? r)) tmp-1)) + (apply (lambda (r) (rest r req (reverse ropt) '())) tmp-1) + (let ((else tmp)) + (syntax-violation + 'lambda* + "invalid optional argument list" + orig-args + args)))))))))))))))) + (key (lambda (args req opt rkey) + (let* ((tmp args) (tmp-1 ($sc-dispatch tmp '()))) + (if tmp-1 + (apply (lambda () (check req opt #f (cons #f (reverse rkey)))) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if (and tmp-1 (apply (lambda (a b) (id? a)) tmp-1)) + (apply (lambda (a b) + (let* ((tmp (symbol->keyword (syntax->datum a))) (k tmp)) + (key b + req + opt + (cons (cons k + (cons a + '(#(syntax-object #f - mod-20721 - #f)) - (lambda (type-21088 - value-21089 - form-21090 - e-21091 - w-21092 - s-21093 - mod-21094) - (expand-expr-4298 - type-21088 - value-21089 - form-21090 - e-21091 - r-21058 - w-21092 - s-21093 - mod-21094))))) - (cons (cons er-20683 - (wrap-4290 - (begin - (if (if s-20720 - (supports-source-properties? - e-20718) - #f) - (set-source-properties! - e-20718 - s-20720)) - e-20718) - w-20719 - mod-20721)) - (cdr body-20675))))) - (if (null? (cdr exps-21053)) - (car exps-21053) - (make-struct/no-tail - (vector-ref %expanded-vtables 12) - #f - exps-21053))) - (begin - (if (not (valid-bound-ids?-4287 - ids-20676)) - (syntax-violation - #f - "invalid or duplicate identifier in definition" - outer-form-20655)) - (letrec* - ((loop-21197 - (lambda (bs-21200 - er-cache-21201 - r-cache-21202) - (if (not (null? bs-21200)) - (let ((b-21203 - (car bs-21200))) - (if (eq? (car b-21203) - 'macro) - (let ((er-21205 - (car (cdr b-21203)))) - (let ((r-cache-21206 - (if (eq? er-21205 - er-cache-21201) - r-cache-21202 - (macros-only-env-4257 - er-21205)))) - (begin - (set-cdr! - b-21203 - (eval-local-transformer-4303 - (let ((e-21249 - (cdr (cdr b-21203)))) - (call-with-values - (lambda () - (syntax-type-4296 - e-21249 - r-cache-21206 - '(()) - (let ((props-21259 - (source-properties - (if (if (vector? - e-21249) - (if (= (vector-length - e-21249) - 4) - (eq? (vector-ref - e-21249 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-21249 - 1) - e-21249)))) - (if (pair? props-21259) - props-21259 - #f)) - #f - mod-20721 - #f)) - (lambda (type-21282 - value-21283 - form-21284 - e-21285 - w-21286 - s-21287 - mod-21288) - (expand-expr-4298 - type-21282 - value-21283 - form-21284 - e-21285 - r-cache-21206 - w-21286 - s-21287 - mod-21288)))) - mod-20721)) - (loop-21197 - (cdr bs-21200) - er-21205 - r-cache-21206)))) - (loop-21197 - (cdr bs-21200) - er-cache-21201 - r-cache-21202))))))) - (loop-21197 bindings-20681 #f #f)) - (set-cdr! - r-20659 - (extend-env-4255 - labels-20677 - bindings-20681 - (cdr r-20659))) - (let ((ids-21471 - (reverse - (map syntax->datum - var-ids-20678))) - (vars-21472 - (reverse vars-20679)) - (val-exps-21473 - (map (lambda (x-21560) - (let ((e-21563 - (cdr x-21560)) - (r-21564 - (car x-21560))) - (call-with-values - (lambda () - (syntax-type-4296 - e-21563 - r-21564 - '(()) - (let ((props-21571 - (source-properties - (if (if (vector? - e-21563) - (if (= (vector-length - e-21563) - 4) - (eq? (vector-ref - e-21563 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-21563 - 1) - e-21563)))) - (if (pair? props-21571) - props-21571 - #f)) - #f - mod-20721 - #f)) - (lambda (type-21594 - value-21595 - form-21596 - e-21597 - w-21598 - s-21599 - mod-21600) - (expand-expr-4298 - type-21594 - value-21595 - form-21596 - e-21597 - r-21564 - w-21598 - s-21599 - mod-21600))))) - (reverse vals-20680))) - (body-exp-21474 - (let ((exps-21478 - (map (lambda (x-21479) - (let ((e-21482 - (cdr x-21479)) - (r-21483 - (car x-21479))) - (call-with-values - (lambda () - (syntax-type-4296 - e-21482 - r-21483 - '(()) - (let ((props-21490 - (source-properties - (if (if (vector? - e-21482) - (if (= (vector-length - e-21482) - 4) - (eq? (vector-ref - e-21482 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-21482 - 1) - e-21482)))) - (if (pair? props-21490) - props-21490 - #f)) - #f - mod-20721 - #f)) - (lambda (type-21513 - value-21514 - form-21515 - e-21516 - w-21517 - s-21518 - mod-21519) - (expand-expr-4298 - type-21513 - value-21514 - form-21515 - e-21516 - r-21483 - w-21517 - s-21518 - mod-21519))))) - (cons (cons er-20683 - (wrap-4290 - (begin - (if (if s-20720 - (supports-source-properties? - e-20718) - #f) - (set-source-properties! - e-20718 - s-20720)) - e-20718) - w-20719 - mod-20721)) - (cdr body-20675))))) - (if (null? (cdr exps-21478)) - (car exps-21478) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 12) - #f - exps-21478))))) - (if (null? vars-21472) - body-exp-21474 - (begin - (for-each - maybe-name-value!-4226 - ids-21471 - val-exps-21473) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 16) - #f - #t - ids-21471 - vars-21472 - val-exps-21473 - body-exp-21474))))))))))))))))) - (parse-20662 - (map (lambda (x-20665) - (cons r-20659 - (wrap-4290 x-20665 w-20661 mod-20658))) - body-20654) - '() - '() - '() - '() - '() - '()))))))) - (expand-local-syntax-4302 - (lambda (rec?-21610 - e-21611 - r-21612 - w-21613 - s-21614 - mod-21615 - k-21616) - (let ((tmp-21618 - ($sc-dispatch - e-21611 - '(_ #(each (any any)) any . each-any)))) - (if tmp-21618 - (@apply - (lambda (id-21620 val-21621 e1-21622 e2-21623) - (if (not (valid-bound-ids?-4287 id-21620)) - (syntax-violation + ((top) + #(ribcage () () ()) + #(ribcage #(k) #((top)) #("l-*-2465")) + #(ribcage + #(a b) + #((top) (top)) + #("l-*-2459" "l-*-2460")) + #(ribcage () () ()) + #(ribcage + #(args req opt rkey) + #((top) (top) (top) (top)) + #("l-*-2448" "l-*-2449" "l-*-2450" "l-*-2451")) + #(ribcage + (check rest key opt req) + ((top) (top) (top) (top) (top)) + ("l-*-2338" + "l-*-2336" + "l-*-2334" + "l-*-2332" + "l-*-2330")) + #(ribcage #(orig-args) #((top)) #("l-*-2329")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile))))) + rkey)))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '((any any) . any)))) + (if (and tmp-1 (apply (lambda (a init b) (id? a)) tmp-1)) + (apply (lambda (a init b) + (let* ((tmp (symbol->keyword (syntax->datum a))) (k tmp)) + (key b req opt (cons (list k a init) rkey)))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '((any any any) . any)))) + (if (and tmp-1 + (apply (lambda (a init k b) (and (id? a) (keyword? (syntax->datum k)))) + tmp-1)) + (apply (lambda (a init k b) (key b req opt (cons (list k a init) rkey))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any)))) + (if (and tmp-1 + (apply (lambda (aok) (eq? (syntax->datum aok) #:allow-other-keys)) + tmp-1)) + (apply (lambda (aok) (check req opt #f (cons #t (reverse rkey)))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any any any)))) + (if (and tmp-1 + (apply (lambda (aok a b) + (and (eq? (syntax->datum aok) #:allow-other-keys) + (eq? (syntax->datum a) #:rest))) + tmp-1)) + (apply (lambda (aok a b) (rest b req opt (cons #t (reverse rkey)))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if (and tmp-1 + (apply (lambda (aok r) + (and (eq? (syntax->datum aok) #:allow-other-keys) (id? r))) + tmp-1)) + (apply (lambda (aok r) (rest r req opt (cons #t (reverse rkey)))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any any)))) + (if (and tmp-1 + (apply (lambda (a b) (eq? (syntax->datum a) #:rest)) tmp-1)) + (apply (lambda (a b) (rest b req opt (cons #f (reverse rkey)))) + tmp-1) + (let ((tmp-1 (list tmp))) + (if (and tmp-1 (apply (lambda (r) (id? r)) tmp-1)) + (apply (lambda (r) (rest r req opt (cons #f (reverse rkey)))) + tmp-1) + (let ((else tmp)) + (syntax-violation + 'lambda* + "invalid keyword argument list" + orig-args + args)))))))))))))))))))))) + (rest (lambda (args req opt kw) + (let* ((tmp-1 args) (tmp (list tmp-1))) + (if (and tmp (apply (lambda (r) (id? r)) tmp)) + (apply (lambda (r) (check req opt r kw)) tmp) + (let ((else tmp-1)) + (syntax-violation 'lambda* "invalid rest argument" orig-args args)))))) + (check (lambda (req opt rest kw) + (if (distinct-bound-ids? + (append + req + (map car opt) + (if rest (list rest) '()) + (if (pair? kw) (map cadr (cdr kw)) '()))) + (values req opt rest kw) + (syntax-violation + 'lambda* + "duplicate identifier in argument list" + orig-args))))) + (req orig-args '())))) + (expand-lambda-case + (lambda (e r w s mod get-formals clauses) + (letrec* + ((parse-req + (lambda (req opt rest kw body) + (let ((vars (map gen-var req)) (labels (gen-labels req))) + (let ((r* (extend-var-env labels vars r)) + (w* (make-binding-wrap req labels w))) + (parse-opt + (map syntax->datum req) + opt + rest + kw + body + (reverse vars) + r* + w* + '() + '()))))) + (parse-opt + (lambda (req opt rest kw body vars r* w* out inits) + (cond ((pair? opt) + (let* ((tmp-1 (car opt)) (tmp ($sc-dispatch tmp-1 '(any any)))) + (if tmp + (apply (lambda (id i) + (let* ((v (gen-var id)) + (l (gen-labels (list v))) + (r** (extend-var-env l (list v) r*)) + (w** (make-binding-wrap (list id) l w*))) + (parse-opt + req + (cdr opt) + rest + kw + body + (cons v vars) + r** + w** + (cons (syntax->datum id) out) + (cons (expand i r* w* mod) inits)))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))) + (rest + (let* ((v (gen-var rest)) + (l (gen-labels (list v))) + (r* (extend-var-env l (list v) r*)) + (w* (make-binding-wrap (list rest) l w*))) + (parse-kw + req + (and (pair? out) (reverse out)) + (syntax->datum rest) + (if (pair? kw) (cdr kw) kw) + body + (cons v vars) + r* + w* + (and (pair? kw) (car kw)) + '() + inits))) + (else + (parse-kw + req + (and (pair? out) (reverse out)) + #f + (if (pair? kw) (cdr kw) kw) + body + vars + r* + w* + (and (pair? kw) (car kw)) + '() + inits))))) + (parse-kw + (lambda (req opt rest kw body vars r* w* aok out inits) + (if (pair? kw) + (let* ((tmp-1 (car kw)) (tmp ($sc-dispatch tmp-1 '(any any any)))) + (if tmp + (apply (lambda (k id i) + (let* ((v (gen-var id)) + (l (gen-labels (list v))) + (r** (extend-var-env l (list v) r*)) + (w** (make-binding-wrap (list id) l w*))) + (parse-kw + req + opt + rest + (cdr kw) + body + (cons v vars) + r** + w** + aok + (cons (list (syntax->datum k) (syntax->datum id) v) out) + (cons (expand i r* w* mod) inits)))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))) + (parse-body + req + opt + rest + (and (or aok (pair? out)) (cons aok (reverse out))) + body + (reverse vars) + r* + w* + (reverse inits) + '())))) + (parse-body + (lambda (req opt rest kw body vars r* w* inits meta) + (let* ((tmp body) (tmp-1 ($sc-dispatch tmp '(any any . each-any)))) + (if (and tmp-1 + (apply (lambda (docstring e1 e2) (string? (syntax->datum docstring))) + tmp-1)) + (apply (lambda (docstring e1 e2) + (parse-body + req + opt + rest + kw + (cons e1 e2) + vars + r* + w* + inits + (append meta (list (cons 'documentation (syntax->datum docstring)))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(#(vector #(each (any . any))) any . each-any)))) + (if tmp-1 + (apply (lambda (k v e1 e2) + (parse-body + req + opt + rest + kw + (cons e1 e2) + vars + r* + w* + inits + (append meta (syntax->datum (map cons k v))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . each-any)))) + (if tmp-1 + (apply (lambda (e1 e2) + (values + meta + req + opt + rest + kw + inits + vars + (expand-body (cons e1 e2) (source-wrap e w s mod) r* w* mod))) + tmp-1) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp)))))))))) + (let* ((tmp clauses) (tmp-1 ($sc-dispatch tmp '()))) + (if tmp-1 + (apply (lambda () (values '() #f)) tmp-1) + (let ((tmp-1 ($sc-dispatch + tmp + '((any any . each-any) . #(each (any any . each-any)))))) + (if tmp-1 + (apply (lambda (args e1 e2 args* e1* e2*) + (call-with-values + (lambda () (get-formals args)) + (lambda (req opt rest kw) + (call-with-values + (lambda () (parse-req req opt rest kw (cons e1 e2))) + (lambda (meta req opt rest kw inits vars body) + (call-with-values + (lambda () + (expand-lambda-case + e + r + w + s + mod + get-formals + (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons tmp-1 tmp-2))) + e2* + e1* + args*))) + (lambda (meta* else*) + (values + (append meta meta*) + (build-lambda-case s req opt rest kw inits vars body else*))))))))) + tmp-1) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp)))))))) + (strip (lambda (x w) + (if (memq 'top (car w)) + x + (let f ((x x)) + (cond ((syntax-object? x) + (strip (syntax-object-expression x) (syntax-object-wrap x))) + ((pair? x) + (let ((a (f (car x))) (d (f (cdr x)))) + (if (and (eq? a (car x)) (eq? d (cdr x))) x (cons a d)))) + ((vector? x) + (let* ((old (vector->list x)) (new (map f old))) + (let lp ((l1 old) (l2 new)) + (cond ((null? l1) x) + ((eq? (car l1) (car l2)) (lp (cdr l1) (cdr l2))) + (else (list->vector new)))))) + (else x)))))) + (gen-var + (lambda (id) + (let ((id (if (syntax-object? id) (syntax-object-expression id) id))) + (gensym (string-append (symbol->string id) "-"))))) + (lambda-var-list + (lambda (vars) + (let lvl ((vars vars) (ls '()) (w '(()))) + (cond ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w #f) ls) w)) + ((id? vars) (cons (wrap vars w #f) ls)) + ((null? vars) ls) + ((syntax-object? vars) + (lvl (syntax-object-expression vars) + ls + (join-wraps w (syntax-object-wrap vars)))) + (else (cons vars ls))))))) + (global-extend 'local-syntax 'letrec-syntax #t) + (global-extend 'local-syntax 'let-syntax #f) + (global-extend + 'core + 'syntax-parameterize + (lambda (e r w s mod) + (let* ((tmp e) + (tmp ($sc-dispatch tmp '(_ #(each (any any)) any . each-any)))) + (if (and tmp (apply (lambda (var val e1 e2) (valid-bound-ids? var)) tmp)) + (apply (lambda (var val e1 e2) + (let ((names (map (lambda (x) (id-var-name x w)) var))) + (for-each + (lambda (id n) + (let ((key (car (lookup n r mod)))) + (if (memv key '(displaced-lexical)) + (syntax-violation + 'syntax-parameterize + "identifier out of context" + e + (source-wrap id w s mod))))) + var + names) + (expand-body + (cons e1 e2) + (source-wrap e w s mod) + (extend-env + names + (let ((trans-r (macros-only-env r))) + (map (lambda (x) + (cons 'macro (eval-local-transformer (expand x trans-r w mod) mod))) + val)) + r) + w + mod))) + tmp) + (syntax-violation + 'syntax-parameterize + "bad syntax" + (source-wrap e w s mod)))))) + (global-extend + 'core + 'quote + (lambda (e r w s mod) + (let* ((tmp e) (tmp ($sc-dispatch tmp '(_ any)))) + (if tmp + (apply (lambda (e) (build-data s (strip e w))) tmp) + (syntax-violation 'quote "bad syntax" (source-wrap e w s mod)))))) + (global-extend + 'core + 'syntax + (letrec* + ((gen-syntax + (lambda (src e r maps ellipsis? mod) + (if (id? e) + (let* ((label (id-var-name e '(()))) (b (lookup label r mod))) + (cond ((eq? (car b) 'syntax) + (call-with-values + (lambda () + (let ((var.lev (cdr b))) + (gen-ref src (car var.lev) (cdr var.lev) maps))) + (lambda (var maps) (values (list 'ref var) maps)))) + ((ellipsis? e) (syntax-violation 'syntax "misplaced ellipsis" src)) + (else (values (list 'quote e) maps)))) + (let* ((tmp e) (tmp-1 ($sc-dispatch tmp '(any any)))) + (if (and tmp-1 (apply (lambda (dots e) (ellipsis? dots)) tmp-1)) + (apply (lambda (dots e) (gen-syntax src e r maps (lambda (x) #f) mod)) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any any . any)))) + (if (and tmp-1 (apply (lambda (x dots y) (ellipsis? dots)) tmp-1)) + (apply (lambda (x dots y) + (let f ((y y) + (k (lambda (maps) + (call-with-values + (lambda () (gen-syntax src x r (cons '() maps) ellipsis? mod)) + (lambda (x maps) + (if (null? (car maps)) + (syntax-violation 'syntax "extra ellipsis" src) + (values (gen-map x (car maps)) (cdr maps)))))))) + (let* ((tmp y) (tmp ($sc-dispatch tmp '(any . any)))) + (if (and tmp (apply (lambda (dots y) (ellipsis? dots)) tmp)) + (apply (lambda (dots y) + (f y + (lambda (maps) + (call-with-values + (lambda () (k (cons '() maps))) + (lambda (x maps) + (if (null? (car maps)) + (syntax-violation 'syntax "extra ellipsis" src) + (values (gen-mappend x (car maps)) (cdr maps)))))))) + tmp) + (call-with-values + (lambda () (gen-syntax src y r maps ellipsis? mod)) + (lambda (y maps) + (call-with-values + (lambda () (k maps)) + (lambda (x maps) (values (gen-append x y) maps))))))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if tmp-1 + (apply (lambda (x y) + (call-with-values + (lambda () (gen-syntax src x r maps ellipsis? mod)) + (lambda (x maps) + (call-with-values + (lambda () (gen-syntax src y r maps ellipsis? mod)) + (lambda (y maps) (values (gen-cons x y) maps)))))) + tmp-1) + (let ((tmp ($sc-dispatch tmp '#(vector (any . each-any))))) + (if tmp + (apply (lambda (e1 e2) + (call-with-values + (lambda () (gen-syntax src (cons e1 e2) r maps ellipsis? mod)) + (lambda (e maps) (values (gen-vector e) maps)))) + tmp) + (values (list 'quote e) maps)))))))))))) + (gen-ref + (lambda (src var level maps) + (cond ((= level 0) (values var maps)) + ((null? maps) (syntax-violation 'syntax "missing ellipsis" src)) + (else + (call-with-values + (lambda () (gen-ref src var (- level 1) (cdr maps))) + (lambda (outer-var outer-maps) + (let ((b (assq outer-var (car maps)))) + (if b + (values (cdr b) maps) + (let ((inner-var (gen-var 'tmp))) + (values + inner-var + (cons (cons (cons outer-var inner-var) (car maps)) outer-maps))))))))))) + (gen-mappend + (lambda (e map-env) + (list 'apply '(primitive append) (gen-map e map-env)))) + (gen-map + (lambda (e map-env) + (let ((formals (map cdr map-env)) + (actuals (map (lambda (x) (list 'ref (car x))) map-env))) + (cond ((eq? (car e) 'ref) (car actuals)) + ((and-map + (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals))) + (cdr e)) + (cons 'map + (cons (list 'primitive (car e)) + (map (let ((r (map cons formals actuals))) + (lambda (x) (cdr (assq (cadr x) r)))) + (cdr e))))) + (else (cons 'map (cons (list 'lambda formals e) actuals))))))) + (gen-cons + (lambda (x y) + (let ((key (car y))) + (cond ((memv key '(quote)) + (cond ((eq? (car x) 'quote) (list 'quote (cons (cadr x) (cadr y)))) + ((eq? (cadr y) '()) (list 'list x)) + (else (list 'cons x y)))) + ((memv key '(list)) (cons 'list (cons x (cdr y)))) + (else (list 'cons x y)))))) + (gen-append (lambda (x y) (if (equal? y ''()) x (list 'append x y)))) + (gen-vector + (lambda (x) + (cond ((eq? (car x) 'list) (cons 'vector (cdr x))) + ((eq? (car x) 'quote) (list 'quote (list->vector (cadr x)))) + (else (list 'list->vector x))))) + (regen (lambda (x) + (let ((key (car x))) + (cond ((memv key '(ref)) + (build-lexical-reference 'value #f (cadr x) (cadr x))) + ((memv key '(primitive)) (build-primref #f (cadr x))) + ((memv key '(quote)) (build-data #f (cadr x))) + ((memv key '(lambda)) + (if (list? (cadr x)) + (build-simple-lambda #f (cadr x) #f (cadr x) '() (regen (caddr x))) + (error "how did we get here" x))) + (else + (build-application #f (build-primref #f (car x)) (map regen (cdr x))))))))) + (lambda (e r w s mod) + (let* ((e (source-wrap e w s mod)) + (tmp e) + (tmp ($sc-dispatch tmp '(_ any)))) + (if tmp + (apply (lambda (x) + (call-with-values + (lambda () (gen-syntax e x r '() ellipsis? mod)) + (lambda (e maps) (regen e)))) + tmp) + (syntax-violation 'syntax "bad `syntax' form" e)))))) + (global-extend + 'core + 'lambda + (lambda (e r w s mod) + (let* ((tmp e) (tmp ($sc-dispatch tmp '(_ any any . each-any)))) + (if tmp + (apply (lambda (args e1 e2) + (call-with-values + (lambda () (lambda-formals args)) + (lambda (req opt rest kw) + (let lp ((body (cons e1 e2)) (meta '())) + (let* ((tmp-1 body) (tmp ($sc-dispatch tmp-1 '(any any . each-any)))) + (if (and tmp + (apply (lambda (docstring e1 e2) (string? (syntax->datum docstring))) + tmp)) + (apply (lambda (docstring e1 e2) + (lp (cons e1 e2) + (append meta (list (cons 'documentation (syntax->datum docstring)))))) + tmp) + (let ((tmp ($sc-dispatch tmp-1 '(#(vector #(each (any . any))) any . each-any)))) + (if tmp + (apply (lambda (k v e1 e2) + (lp (cons e1 e2) (append meta (syntax->datum (map cons k v))))) + tmp) + (expand-simple-lambda e r w s mod req rest meta body))))))))) + tmp) + (syntax-violation 'lambda "bad lambda" e))))) + (global-extend + 'core + 'lambda* + (lambda (e r w s mod) + (let* ((tmp e) (tmp ($sc-dispatch tmp '(_ any any . each-any)))) + (if tmp + (apply (lambda (args e1 e2) + (call-with-values + (lambda () + (expand-lambda-case + e + r + w + s + mod + lambda*-formals + (list (cons args (cons e1 e2))))) + (lambda (meta lcase) (build-case-lambda s meta lcase)))) + tmp) + (syntax-violation 'lambda "bad lambda*" e))))) + (global-extend + 'core + 'case-lambda + (lambda (e r w s mod) + (let* ((tmp e) + (tmp ($sc-dispatch + tmp + '(_ (any any . each-any) . #(each (any any . each-any)))))) + (if tmp + (apply (lambda (args e1 e2 args* e1* e2*) + (call-with-values + (lambda () + (expand-lambda-case + e + r + w + s + mod + lambda-formals + (cons (cons args (cons e1 e2)) + (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons tmp-1 tmp-2))) + e2* + e1* + args*)))) + (lambda (meta lcase) (build-case-lambda s meta lcase)))) + tmp) + (syntax-violation 'case-lambda "bad case-lambda" e))))) + (global-extend + 'core + 'case-lambda* + (lambda (e r w s mod) + (let* ((tmp e) + (tmp ($sc-dispatch + tmp + '(_ (any any . each-any) . #(each (any any . each-any)))))) + (if tmp + (apply (lambda (args e1 e2 args* e1* e2*) + (call-with-values + (lambda () + (expand-lambda-case + e + r + w + s + mod + lambda*-formals + (cons (cons args (cons e1 e2)) + (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons tmp-1 tmp-2))) + e2* + e1* + args*)))) + (lambda (meta lcase) (build-case-lambda s meta lcase)))) + tmp) + (syntax-violation 'case-lambda "bad case-lambda*" e))))) + (global-extend + 'core + 'let + (letrec* + ((expand-let + (lambda (e r w s mod constructor ids vals exps) + (if (not (valid-bound-ids? ids)) + (syntax-violation 'let "duplicate bound variable" e) + (let ((labels (gen-labels ids)) (new-vars (map gen-var ids))) + (let ((nw (make-binding-wrap ids labels w)) + (nr (extend-var-env labels new-vars r))) + (constructor + s + (map syntax->datum ids) + new-vars + (map (lambda (x) (expand x r w mod)) vals) + (expand-body exps (source-wrap e nw s mod) nr nw mod)))))))) + (lambda (e r w s mod) + (let* ((tmp-1 e) + (tmp ($sc-dispatch tmp-1 '(_ #(each (any any)) any . each-any)))) + (if (and tmp (apply (lambda (id val e1 e2) (and-map id? id)) tmp)) + (apply (lambda (id val e1 e2) + (expand-let e r w s mod build-let id val (cons e1 e2))) + tmp) + (let ((tmp ($sc-dispatch tmp-1 '(_ any #(each (any any)) any . each-any)))) + (if (and tmp + (apply (lambda (f id val e1 e2) (and (id? f) (and-map id? id))) tmp)) + (apply (lambda (f id val e1 e2) + (expand-let e r w s mod build-named-let (cons f id) val (cons e1 e2))) + tmp) + (syntax-violation 'let "bad let" (source-wrap e w s mod))))))))) + (global-extend + 'core + 'letrec + (lambda (e r w s mod) + (let* ((tmp e) + (tmp ($sc-dispatch tmp '(_ #(each (any any)) any . each-any)))) + (if (and tmp (apply (lambda (id val e1 e2) (and-map id? id)) tmp)) + (apply (lambda (id val e1 e2) + (let ((ids id)) + (if (not (valid-bound-ids? ids)) + (syntax-violation 'letrec "duplicate bound variable" e) + (let ((labels (gen-labels ids)) (new-vars (map gen-var ids))) + (let ((w (make-binding-wrap ids labels w)) + (r (extend-var-env labels new-vars r))) + (build-letrec + s + #f + (map syntax->datum ids) + new-vars + (map (lambda (x) (expand x r w mod)) val) + (expand-body (cons e1 e2) (source-wrap e w s mod) r w mod))))))) + tmp) + (syntax-violation 'letrec "bad letrec" (source-wrap e w s mod)))))) + (global-extend + 'core + 'letrec* + (lambda (e r w s mod) + (let* ((tmp e) + (tmp ($sc-dispatch tmp '(_ #(each (any any)) any . each-any)))) + (if (and tmp (apply (lambda (id val e1 e2) (and-map id? id)) tmp)) + (apply (lambda (id val e1 e2) + (let ((ids id)) + (if (not (valid-bound-ids? ids)) + (syntax-violation 'letrec* "duplicate bound variable" e) + (let ((labels (gen-labels ids)) (new-vars (map gen-var ids))) + (let ((w (make-binding-wrap ids labels w)) + (r (extend-var-env labels new-vars r))) + (build-letrec + s + #t + (map syntax->datum ids) + new-vars + (map (lambda (x) (expand x r w mod)) val) + (expand-body (cons e1 e2) (source-wrap e w s mod) r w mod))))))) + tmp) + (syntax-violation 'letrec* "bad letrec*" (source-wrap e w s mod)))))) + (global-extend + 'core + 'set! + (lambda (e r w s mod) + (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ any any)))) + (if (and tmp (apply (lambda (id val) (id? id)) tmp)) + (apply (lambda (id val) + (let ((n (id-var-name id w)) + (id-mod (if (syntax-object? id) (syntax-object-module id) mod))) + (let* ((b (lookup n r id-mod)) (key (car b))) + (cond ((memv key '(lexical)) + (build-lexical-assignment + s + (syntax->datum id) + (cdr b) + (expand val r w mod))) + ((memv key '(global)) + (build-global-assignment s n (expand val r w mod) id-mod)) + ((memv key '(macro)) + (let ((p (cdr b))) + (if (procedure-property p 'variable-transformer) + (expand (expand-macro p e r w s #f mod) r '(()) mod) + (syntax-violation + 'set! + "not a variable transformer" + (wrap e w mod) + (wrap id w id-mod))))) + ((memv key '(displaced-lexical)) + (syntax-violation 'set! "identifier out of context" (wrap id w mod))) + (else (syntax-violation 'set! "bad set!" (source-wrap e w s mod))))))) + tmp) + (let ((tmp ($sc-dispatch tmp-1 '(_ (any . each-any) any)))) + (if tmp + (apply (lambda (head tail val) + (call-with-values + (lambda () (syntax-type head r '(()) #f #f mod #t)) + (lambda (type value formform ee ww ss modmod) + (let ((key type)) + (if (memv key '(module-ref)) + (let ((val (expand val r w mod))) + (call-with-values + (lambda () (value (cons head tail) r w)) + (lambda (e r w s* mod) + (let* ((tmp-1 e) (tmp (list tmp-1))) + (if (and tmp (apply (lambda (e) (id? e)) tmp)) + (apply (lambda (e) (build-global-assignment s (syntax->datum e) val mod)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))))) + (build-application + s + (expand + (list '#(syntax-object + setter + ((top) + #(ribcage () () ()) + #(ribcage #(key) #((m-*-3526 top)) #("l-*-3527")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(type value formform ee ww ss modmod) + #((top) (top) (top) (top) (top) (top) (top)) + #("l-*-3519" + "l-*-3520" + "l-*-3521" + "l-*-3522" + "l-*-3523" + "l-*-3524" + "l-*-3525")) + #(ribcage + #(head tail val) + #((top) (top) (top)) + #("l-*-3504" "l-*-3505" "l-*-3506")) + #(ribcage () () ()) + #(ribcage + #(e r w s mod) + #((top) (top) (top) (top) (top)) + #("l-*-3473" "l-*-3474" "l-*-3475" "l-*-3476" "l-*-3477")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile)) + head) + r + w + mod) + (map (lambda (e) (expand e r w mod)) (append tail (list val))))))))) + tmp) + (syntax-violation 'set! "bad set!" (source-wrap e w s mod)))))))) + (global-extend + 'module-ref + '@ + (lambda (e r w) + (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ each-any any)))) + (if (and tmp + (apply (lambda (mod id) (and (and-map id? mod) (id? id))) tmp)) + (apply (lambda (mod id) + (values + (syntax->datum id) + r + w #f - "duplicate bound keyword" - e-21611) - (let ((labels-21713 (gen-labels-4264 id-21620))) - (let ((new-w-21714 - (make-binding-wrap-4275 - id-21620 - labels-21713 - w-21613))) - (k-21616 - (cons e1-21622 e2-21623) - (extend-env-4255 - labels-21713 - (let ((trans-r-21750 - (macros-only-env-4257 r-21612))) - (begin - (if rec?-21610 new-w-21714 w-21613) - (map (lambda (x-21751) - (cons 'macro - (eval-local-transformer-4303 - (call-with-values - (lambda () - (syntax-type-4296 - x-21751 - trans-r-21750 - (values - (if rec?-21610 - new-w-21714 - w-21613)) - (let ((props-21811 - (source-properties - (if (if (vector? - x-21751) - (if (= (vector-length - x-21751) - 4) - (eq? (vector-ref - x-21751 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - x-21751 - 1) - x-21751)))) - (if (pair? props-21811) - props-21811 - #f)) - #f - mod-21615 - #f)) - (lambda (type-21844 - value-21845 - form-21846 - e-21847 - w-21848 - s-21849 - mod-21850) - (expand-expr-4298 - type-21844 - value-21845 - form-21846 - e-21847 - trans-r-21750 - w-21848 - s-21849 - mod-21850))) - mod-21615))) - val-21621))) - r-21612) - new-w-21714 - s-21614 - mod-21615))))) - tmp-21618) - (syntax-violation - #f - "bad local syntax definition" - (wrap-4290 - (begin - (if (if s-21614 - (supports-source-properties? e-21611) - #f) - (set-source-properties! e-21611 s-21614)) - e-21611) - w-21613 - mod-21615)))))) - (eval-local-transformer-4303 - (lambda (expanded-22016 mod-22017) - (let ((p-22018 (primitive-eval expanded-22016))) - (if (procedure? p-22018) - p-22018 - (syntax-violation - #f - "nonprocedure transformer" - p-22018))))) - (ellipsis?-4305 - (lambda (x-4941) - (if (if (if (vector? x-4941) - (if (= (vector-length x-4941) 4) - (eq? (vector-ref x-4941 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref x-4941 1)) - #f) - (if (eq? (if (if (vector? x-4941) - (if (= (vector-length x-4941) 4) - (eq? (vector-ref x-4941 0) 'syntax-object) - #f) - #f) - (vector-ref x-4941 1) - x-4941) - (if (if (= (vector-length - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" "l-*-46" "l-*-45"))) - (hygiene guile))) - 4) - #t - #f) - '... - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" "l-*-46" "l-*-45"))) - (hygiene guile)))) - (eq? (id-var-name-4280 x-4941 '(())) - (id-var-name-4280 - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" "l-*-46" "l-*-45"))) - (hygiene guile)) - '(()))) - #f) - #f))) - (lambda-formals-4306 - (lambda (orig-args-22023) - (letrec* - ((req-22024 - (lambda (args-22028 rreq-22029) - (let ((tmp-22031 ($sc-dispatch args-22028 '()))) - (if tmp-22031 - (@apply - (lambda () (check-22025 (reverse rreq-22029) #f)) - tmp-22031) - (let ((tmp-22154 - ($sc-dispatch args-22028 '(any . any)))) - (if (if tmp-22154 - (@apply - (lambda (a-22158 b-22159) - (if (symbol? a-22158) - #t - (if (if (vector? a-22158) - (if (= (vector-length a-22158) 4) - (eq? (vector-ref a-22158 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref a-22158 1)) - #f))) - tmp-22154) - #f) - (@apply - (lambda (a-22186 b-22187) - (req-22024 b-22187 (cons a-22186 rreq-22029))) - tmp-22154) - (let ((tmp-22188 (list args-22028))) - (if (@apply - (lambda (r-22190) - (if (symbol? r-22190) - #t - (if (if (vector? r-22190) - (if (= (vector-length r-22190) 4) - (eq? (vector-ref r-22190 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref r-22190 1)) - #f))) - tmp-22188) - (@apply - (lambda (r-22220) - (check-22025 (reverse rreq-22029) r-22220)) - tmp-22188) - (syntax-violation - 'lambda - "invalid argument list" - orig-args-22023 - args-22028))))))))) - (check-22025 - (lambda (req-22351 rest-22352) - (if (distinct-bound-ids?-4288 - (if rest-22352 - (cons rest-22352 req-22351) - req-22351)) - (values req-22351 #f rest-22352 #f) - (syntax-violation - 'lambda - "duplicate identifier in argument list" - orig-args-22023))))) - (req-22024 orig-args-22023 '())))) - (expand-simple-lambda-4307 - (lambda (e-22468 - r-22469 - w-22470 - s-22471 - mod-22472 - req-22473 - rest-22474 - meta-22475 - body-22476) - (let ((ids-22477 - (if rest-22474 - (append req-22473 (list rest-22474)) - req-22473))) - (let ((vars-22478 (map gen-var-4311 ids-22477))) - (let ((labels-22479 (gen-labels-4264 ids-22477))) - (build-simple-lambda-4237 - s-22471 - (map syntax->datum req-22473) - (if rest-22474 (syntax->datum rest-22474) #f) - vars-22478 - meta-22475 - (expand-body-4301 - body-22476 - (wrap-4290 - (begin - (if (if s-22471 - (supports-source-properties? e-22468) - #f) - (set-source-properties! e-22468 s-22471)) - e-22468) - w-22470 - mod-22472) - (extend-var-env-4256 - labels-22479 - vars-22478 - r-22469) - (make-binding-wrap-4275 - ids-22477 - labels-22479 - w-22470) - mod-22472))))))) - (lambda*-formals-4308 - (lambda (orig-args-22759) - (letrec* - ((req-22760 - (lambda (args-22767 rreq-22768) - (let ((tmp-22770 ($sc-dispatch args-22767 '()))) - (if tmp-22770 - (@apply - (lambda () - (check-22764 (reverse rreq-22768) '() #f '())) - tmp-22770) - (let ((tmp-22776 - ($sc-dispatch args-22767 '(any . any)))) - (if (if tmp-22776 - (@apply - (lambda (a-22780 b-22781) - (if (symbol? a-22780) - #t - (if (if (vector? a-22780) - (if (= (vector-length a-22780) 4) - (eq? (vector-ref a-22780 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref a-22780 1)) - #f))) - tmp-22776) - #f) - (@apply - (lambda (a-22808 b-22809) - (req-22760 b-22809 (cons a-22808 rreq-22768))) - tmp-22776) - (let ((tmp-22810 - ($sc-dispatch args-22767 '(any . any)))) - (if (if tmp-22810 - (@apply - (lambda (a-22814 b-22815) - (eq? (syntax->datum a-22814) #:optional)) - tmp-22810) - #f) - (@apply - (lambda (a-22816 b-22817) - (opt-22761 b-22817 (reverse rreq-22768) '())) - tmp-22810) - (let ((tmp-22820 - ($sc-dispatch args-22767 '(any . any)))) - (if (if tmp-22820 - (@apply - (lambda (a-22824 b-22825) - (eq? (syntax->datum a-22824) #:key)) - tmp-22820) - #f) - (@apply - (lambda (a-22826 b-22827) - (key-22762 - b-22827 - (reverse rreq-22768) - '() - '())) - tmp-22820) - (let ((tmp-22830 - ($sc-dispatch args-22767 '(any any)))) - (if (if tmp-22830 - (@apply - (lambda (a-22834 b-22835) - (eq? (syntax->datum a-22834) - #:rest)) - tmp-22830) - #f) - (@apply - (lambda (a-22836 b-22837) - (rest-22763 - b-22837 - (reverse rreq-22768) - '() - '())) - tmp-22830) - (let ((tmp-22840 (list args-22767))) - (if (@apply - (lambda (r-22842) - (if (symbol? r-22842) - #t - (if (if (vector? r-22842) - (if (= (vector-length - r-22842) - 4) - (eq? (vector-ref - r-22842 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref r-22842 1)) - #f))) - tmp-22840) - (@apply - (lambda (r-22872) - (rest-22763 - r-22872 - (reverse rreq-22768) - '() - '())) - tmp-22840) - (syntax-violation - 'lambda* - "invalid argument list" - orig-args-22759 - args-22767))))))))))))))) - (opt-22761 - (lambda (args-22891 req-22892 ropt-22893) - (let ((tmp-22895 ($sc-dispatch args-22891 '()))) - (if tmp-22895 - (@apply - (lambda () - (check-22764 - req-22892 - (reverse ropt-22893) - #f - '())) - tmp-22895) - (let ((tmp-22901 - ($sc-dispatch args-22891 '(any . any)))) - (if (if tmp-22901 - (@apply - (lambda (a-22905 b-22906) - (if (symbol? a-22905) - #t - (if (if (vector? a-22905) - (if (= (vector-length a-22905) 4) - (eq? (vector-ref a-22905 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref a-22905 1)) - #f))) - tmp-22901) - #f) - (@apply - (lambda (a-22933 b-22934) - (opt-22761 - b-22934 - req-22892 - (cons (cons a-22933 - '(#(syntax-object - #f + (syntax->datum + (cons '#(syntax-object + public + ((top) + #(ribcage #(mod id) #((top) (top)) #("l-*-3566" "l-*-3567")) + #(ribcage () () ()) + #(ribcage + #(e r w) + #((top) (top) (top)) + #("l-*-3554" "l-*-3555" "l-*-3556")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile)) + mod)))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))) + (global-extend + 'module-ref + '@@ + (lambda (e r w) + (letrec* + ((remodulate + (lambda (x mod) + (cond ((pair? x) (cons (remodulate (car x) mod) (remodulate (cdr x) mod))) + ((syntax-object? x) + (make-syntax-object + (remodulate (syntax-object-expression x) mod) + (syntax-object-wrap x) + mod)) + ((vector? x) + (let* ((n (vector-length x)) (v (make-vector n))) + (let loop ((i 0)) + (if (= i n) + (begin (if #f #f) v) + (begin + (vector-set! v i (remodulate (vector-ref x i) mod)) + (loop (+ i 1))))))) + (else x))))) + (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ each-any any)))) + (if (and tmp (apply (lambda (mod exp) (and-map id? mod)) tmp)) + (apply (lambda (mod exp) + (let ((mod (syntax->datum + (cons '#(syntax-object + private + ((top) + #(ribcage #(mod exp) #((top) (top)) #("l-*-3604" "l-*-3605")) + #(ribcage (remodulate) ((top)) ("l-*-3577")) + #(ribcage + #(e r w) + #((top) (top) (top)) + #("l-*-3574" "l-*-3575" "l-*-3576")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) ((top) - #(ribcage - #(a b) - #((top) (top)) - #("l-*-2402" "l-*-2403")) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile)) + mod)))) + (values (remodulate exp mod) r w (source-annotation exp) mod))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))))) + (global-extend + 'core + 'if + (lambda (e r w s mod) + (let* ((tmp e) (tmp-1 ($sc-dispatch tmp '(_ any any)))) + (if tmp-1 + (apply (lambda (test then) + (build-conditional + s + (expand test r w mod) + (expand then r w mod) + (build-void #f))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(_ any any any)))) + (if tmp-1 + (apply (lambda (test then else) + (build-conditional + s + (expand test r w mod) + (expand then r w mod) + (expand else r w mod))) + tmp-1) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp))))))) + (global-extend + 'core + 'with-fluids + (lambda (e r w s mod) + (let* ((tmp-1 e) + (tmp ($sc-dispatch tmp-1 '(_ #(each (any any)) any . each-any)))) + (if tmp + (apply (lambda (fluid val b b*) + (build-dynlet + s + (map (lambda (x) (expand x r w mod)) fluid) + (map (lambda (x) (expand x r w mod)) val) + (expand-body (cons b b*) (source-wrap e w s mod) r w mod))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))) + (global-extend 'begin 'begin '()) + (global-extend 'define 'define '()) + (global-extend 'define-syntax 'define-syntax '()) + (global-extend 'define-syntax-parameter 'define-syntax-parameter '()) + (global-extend 'eval-when 'eval-when '()) + (global-extend + 'core + 'syntax-case + (letrec* + ((convert-pattern + (lambda (pattern keys) + (letrec* + ((cvt* (lambda (p* n ids) + (if (not (pair? p*)) + (cvt p* n ids) + (call-with-values + (lambda () (cvt* (cdr p*) n ids)) + (lambda (y ids) + (call-with-values + (lambda () (cvt (car p*) n ids)) + (lambda (x ids) (values (cons x y) ids)))))))) + (v-reverse + (lambda (x) + (let loop ((r '()) (x x)) + (if (not (pair? x)) (values r x) (loop (cons (car x) r) (cdr x)))))) + (cvt (lambda (p n ids) + (if (id? p) + (cond ((bound-id-member? p keys) (values (vector 'free-id p) ids)) + ((free-id=? + p + '#(syntax-object + _ + ((top) + #(ribcage () () ()) + #(ribcage + #(p n ids) + #((top) (top) (top)) + #("l-*-3705" "l-*-3706" "l-*-3707")) + #(ribcage + (cvt v-reverse cvt*) + ((top) (top) (top)) + ("l-*-3678" "l-*-3676" "l-*-3674")) + #(ribcage #(pattern keys) #((top) (top)) #("l-*-3672" "l-*-3673")) + #(ribcage + (gen-syntax-case gen-clause build-dispatch-call convert-pattern) + ((top) (top) (top) (top)) + ("l-*-3668" "l-*-3666" "l-*-3664" "l-*-3662")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile))) + (values '_ ids)) + (else (values 'any (cons (cons p n) ids)))) + (let* ((tmp p) (tmp-1 ($sc-dispatch tmp '(any any)))) + (if (and tmp-1 (apply (lambda (x dots) (ellipsis? dots)) tmp-1)) + (apply (lambda (x dots) + (call-with-values + (lambda () (cvt x (+ n 1) ids)) + (lambda (p ids) + (values (if (eq? p 'any) 'each-any (vector 'each p)) ids)))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any any . any)))) + (if (and tmp-1 (apply (lambda (x dots ys) (ellipsis? dots)) tmp-1)) + (apply (lambda (x dots ys) + (call-with-values + (lambda () (cvt* ys n ids)) + (lambda (ys ids) + (call-with-values + (lambda () (cvt x (+ n 1) ids)) + (lambda (x ids) + (call-with-values + (lambda () (v-reverse ys)) + (lambda (ys e) (values (vector 'each+ x ys e) ids)))))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if tmp-1 + (apply (lambda (x y) + (call-with-values + (lambda () (cvt y n ids)) + (lambda (y ids) + (call-with-values + (lambda () (cvt x n ids)) + (lambda (x ids) (values (cons x y) ids)))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '()))) + (if tmp-1 + (apply (lambda () (values '() ids)) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '#(vector each-any)))) + (if tmp-1 + (apply (lambda (x) + (call-with-values + (lambda () (cvt x n ids)) + (lambda (p ids) (values (vector 'vector p) ids)))) + tmp-1) + (let ((x tmp)) (values (vector 'atom (strip p '(()))) ids)))))))))))))))) + (cvt pattern 0 '())))) + (build-dispatch-call + (lambda (pvars exp y r mod) + (let ((ids (map car pvars)) (levels (map cdr pvars))) + (let ((labels (gen-labels ids)) (new-vars (map gen-var ids))) + (build-application + #f + (build-primref #f 'apply) + (list (build-simple-lambda + #f + (map syntax->datum ids) + #f + new-vars + '() + (expand + exp + (extend-env + labels + (map (lambda (var level) (cons 'syntax (cons var level))) + new-vars + (map cdr pvars)) + r) + (make-binding-wrap ids labels '(())) + mod)) + y)))))) + (gen-clause + (lambda (x keys clauses r pat fender exp mod) + (call-with-values + (lambda () (convert-pattern pat keys)) + (lambda (p pvars) + (cond ((not (distinct-bound-ids? (map car pvars))) + (syntax-violation 'syntax-case "duplicate pattern variable" pat)) + ((not (and-map (lambda (x) (not (ellipsis? (car x)))) pvars)) + (syntax-violation 'syntax-case "misplaced ellipsis" pat)) + (else + (let ((y (gen-var 'tmp))) + (build-application + #f + (build-simple-lambda + #f + (list 'tmp) + #f + (list y) + '() + (let ((y (build-lexical-reference 'value #f 'tmp y))) + (build-conditional + #f + (let* ((tmp fender) (tmp ($sc-dispatch tmp '#(atom #t)))) + (if tmp + (apply (lambda () y) tmp) + (build-conditional + #f + y + (build-dispatch-call pvars fender y r mod) + (build-data #f #f)))) + (build-dispatch-call pvars exp y r mod) + (gen-syntax-case x keys clauses r mod)))) + (list (if (eq? p 'any) + (build-application #f (build-primref #f 'list) (list x)) + (build-application + #f + (build-primref #f '$sc-dispatch) + (list x (build-data #f p))))))))))))) + (gen-syntax-case + (lambda (x keys clauses r mod) + (if (null? clauses) + (build-application + #f + (build-primref #f 'syntax-violation) + (list (build-data #f #f) + (build-data #f "source expression failed to match any pattern") + x)) + (let* ((tmp-1 (car clauses)) (tmp ($sc-dispatch tmp-1 '(any any)))) + (if tmp + (apply (lambda (pat exp) + (if (and (id? pat) + (and-map + (lambda (x) (not (free-id=? pat x))) + (cons '#(syntax-object + ... + ((top) + #(ribcage #(pat exp) #((top) (top)) #("l-*-3859" "l-*-3860")) #(ribcage () () ()) #(ribcage - #(args req ropt) - #((top) (top) (top)) - #("l-*-2392" - "l-*-2393" - "l-*-2394")) + #(x keys clauses r mod) + #((top) (top) (top) (top) (top)) + #("l-*-3848" "l-*-3849" "l-*-3850" "l-*-3851" "l-*-3852")) #(ribcage - (check rest key opt req) - ((top) - (top) - (top) - (top) - (top)) - ("l-*-2338" - "l-*-2336" - "l-*-2334" - "l-*-2332" - "l-*-2330")) - #(ribcage - #(orig-args) - #((top)) - #("l-*-2329")) + (gen-syntax-case gen-clause build-dispatch-call convert-pattern) + ((top) (top) (top) (top)) + ("l-*-3668" "l-*-3666" "l-*-3664" "l-*-3662")) #(ribcage (lambda-var-list gen-var @@ -7521,16873 +7580,1682 @@ define-expansion-constructors) ((top) (top) (top)) ("l-*-47" "l-*-46" "l-*-45"))) - (hygiene guile)))) - ropt-22893))) - tmp-22901) - (let ((tmp-22935 - ($sc-dispatch args-22891 '((any any) . any)))) - (if (if tmp-22935 - (@apply - (lambda (a-22939 init-22940 b-22941) - (if (symbol? a-22939) - #t - (if (if (vector? a-22939) - (if (= (vector-length a-22939) 4) - (eq? (vector-ref a-22939 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref a-22939 1)) - #f))) - tmp-22935) - #f) - (@apply - (lambda (a-22968 init-22969 b-22970) - (opt-22761 - b-22970 - req-22892 - (cons (list a-22968 init-22969) ropt-22893))) - tmp-22935) - (let ((tmp-22971 - ($sc-dispatch args-22891 '(any . any)))) - (if (if tmp-22971 - (@apply - (lambda (a-22975 b-22976) - (eq? (syntax->datum a-22975) #:key)) - tmp-22971) - #f) - (@apply - (lambda (a-22977 b-22978) - (key-22762 - b-22978 - req-22892 - (reverse ropt-22893) - '())) - tmp-22971) - (let ((tmp-22981 - ($sc-dispatch args-22891 '(any any)))) - (if (if tmp-22981 - (@apply - (lambda (a-22985 b-22986) - (eq? (syntax->datum a-22985) - #:rest)) - tmp-22981) - #f) - (@apply - (lambda (a-22987 b-22988) - (rest-22763 - b-22988 - req-22892 - (reverse ropt-22893) - '())) - tmp-22981) - (let ((tmp-22991 (list args-22891))) - (if (@apply - (lambda (r-22993) - (if (symbol? r-22993) - #t - (if (if (vector? r-22993) - (if (= (vector-length - r-22993) - 4) - (eq? (vector-ref - r-22993 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref r-22993 1)) - #f))) - tmp-22991) - (@apply - (lambda (r-23023) - (rest-22763 - r-23023 - req-22892 - (reverse ropt-22893) - '())) - tmp-22991) - (syntax-violation - 'lambda* - "invalid optional argument list" - orig-args-22759 - args-22891))))))))))))))) - (key-22762 - (lambda (args-23042 req-23043 opt-23044 rkey-23045) - (let ((tmp-23047 ($sc-dispatch args-23042 '()))) - (if tmp-23047 - (@apply - (lambda () - (check-22764 - req-23043 - opt-23044 - #f - (cons #f (reverse rkey-23045)))) - tmp-23047) - (let ((tmp-23053 - ($sc-dispatch args-23042 '(any . any)))) - (if (if tmp-23053 - (@apply - (lambda (a-23057 b-23058) - (if (symbol? a-23057) - #t - (if (if (vector? a-23057) - (if (= (vector-length a-23057) 4) - (eq? (vector-ref a-23057 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref a-23057 1)) - #f))) - tmp-23053) - #f) - (@apply - (lambda (a-23085 b-23086) - (let ((tmp-23087 - (symbol->keyword (syntax->datum a-23085)))) - (key-22762 - b-23086 - req-23043 - opt-23044 - (cons (cons tmp-23087 - (cons a-23085 - '(#(syntax-object - #f - ((top) - #(ribcage () () ()) - #(ribcage - #(k) - #((top)) - #("l-*-2465")) - #(ribcage - #(a b) - #((top) (top)) - #("l-*-2459" - "l-*-2460")) - #(ribcage () () ()) - #(ribcage - #(args req opt rkey) - #((top) - (top) - (top) - (top)) - #("l-*-2448" - "l-*-2449" - "l-*-2450" - "l-*-2451")) - #(ribcage - (check rest - key - opt - req) - ((top) - (top) - (top) - (top) - (top)) - ("l-*-2338" - "l-*-2336" - "l-*-2334" - "l-*-2332" - "l-*-2330")) - #(ribcage - #(orig-args) - #((top)) - #("l-*-2329")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile))))) - rkey-23045)))) - tmp-23053) - (let ((tmp-23090 - ($sc-dispatch args-23042 '((any any) . any)))) - (if (if tmp-23090 - (@apply - (lambda (a-23094 init-23095 b-23096) - (if (symbol? a-23094) - #t - (if (if (vector? a-23094) - (if (= (vector-length a-23094) 4) - (eq? (vector-ref a-23094 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref a-23094 1)) - #f))) - tmp-23090) - #f) - (@apply - (lambda (a-23123 init-23124 b-23125) - (let ((tmp-23126 - (symbol->keyword - (syntax->datum a-23123)))) - (key-22762 - b-23125 - req-23043 - opt-23044 - (cons (list tmp-23126 a-23123 init-23124) - rkey-23045)))) - tmp-23090) - (let ((tmp-23129 - ($sc-dispatch - args-23042 - '((any any any) . any)))) - (if (if tmp-23129 - (@apply - (lambda (a-23133 - init-23134 - k-23135 - b-23136) - (if (if (symbol? a-23133) - #t - (if (if (vector? a-23133) - (if (= (vector-length - a-23133) - 4) - (eq? (vector-ref - a-23133 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref a-23133 1)) - #f)) - (keyword? (syntax->datum k-23135)) - #f)) - tmp-23129) - #f) - (@apply - (lambda (a-23163 init-23164 k-23165 b-23166) - (key-22762 - b-23166 - req-23043 - opt-23044 - (cons (list k-23165 a-23163 init-23164) - rkey-23045))) - tmp-23129) - (let ((tmp-23167 - ($sc-dispatch args-23042 '(any)))) - (if (if tmp-23167 - (@apply - (lambda (aok-23171) - (eq? (syntax->datum aok-23171) - #:allow-other-keys)) - tmp-23167) - #f) - (@apply - (lambda (aok-23172) - (check-22764 - req-23043 - opt-23044 - #f - (cons #t (reverse rkey-23045)))) - tmp-23167) - (let ((tmp-23175 - ($sc-dispatch - args-23042 - '(any any any)))) - (if (if tmp-23175 - (@apply - (lambda (aok-23179 - a-23180 - b-23181) - (if (eq? (syntax->datum - aok-23179) - #:allow-other-keys) - (eq? (syntax->datum a-23180) - #:rest) - #f)) - tmp-23175) - #f) - (@apply - (lambda (aok-23182 a-23183 b-23184) - (rest-22763 - b-23184 - req-23043 - opt-23044 - (cons #t (reverse rkey-23045)))) - tmp-23175) - (let ((tmp-23187 - ($sc-dispatch - args-23042 - '(any . any)))) - (if (if tmp-23187 - (@apply - (lambda (aok-23191 r-23192) - (if (eq? (syntax->datum - aok-23191) - #:allow-other-keys) - (if (symbol? r-23192) - #t - (if (if (vector? - r-23192) - (if (= (vector-length - r-23192) - 4) - (eq? (vector-ref - r-23192 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref - r-23192 - 1)) - #f)) - #f)) - tmp-23187) - #f) - (@apply - (lambda (aok-23219 r-23220) - (rest-22763 - r-23220 - req-23043 - opt-23044 - (cons #t - (reverse rkey-23045)))) - tmp-23187) - (let ((tmp-23223 - ($sc-dispatch - args-23042 - '(any any)))) - (if (if tmp-23223 - (@apply - (lambda (a-23227 b-23228) - (eq? (syntax->datum - a-23227) - #:rest)) - tmp-23223) - #f) - (@apply - (lambda (a-23229 b-23230) - (rest-22763 - b-23230 - req-23043 - opt-23044 - (cons #f - (reverse - rkey-23045)))) - tmp-23223) - (let ((tmp-23233 - (list args-23042))) - (if (@apply - (lambda (r-23235) - (if (symbol? r-23235) - #t - (if (if (vector? - r-23235) - (if (= (vector-length - r-23235) - 4) - (eq? (vector-ref - r-23235 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref - r-23235 - 1)) - #f))) - tmp-23233) - (@apply - (lambda (r-23265) - (rest-22763 - r-23265 - req-23043 - opt-23044 - (cons #f - (reverse - rkey-23045)))) - tmp-23233) - (syntax-violation - 'lambda* - "invalid keyword argument list" - orig-args-22759 - args-23042))))))))))))))))))))) - (rest-22763 - (lambda (args-23293 req-23294 opt-23295 kw-23296) - (let ((tmp-23298 (list args-23293))) - (if (@apply - (lambda (r-23300) - (if (symbol? r-23300) - #t - (if (if (vector? r-23300) - (if (= (vector-length r-23300) 4) - (eq? (vector-ref r-23300 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref r-23300 1)) - #f))) - tmp-23298) - (@apply - (lambda (r-23330) - (check-22764 - req-23294 - opt-23295 - r-23330 - kw-23296)) - tmp-23298) - (syntax-violation - 'lambda* - "invalid rest argument" - orig-args-22759 - args-23293))))) - (check-22764 - (lambda (req-23334 opt-23335 rest-23336 kw-23337) - (if (distinct-bound-ids?-4288 - (append - req-23334 - (map car opt-23335) - (if rest-23336 (list rest-23336) '()) - (if (pair? kw-23337) - (map cadr (cdr kw-23337)) - '()))) - (values req-23334 opt-23335 rest-23336 kw-23337) - (syntax-violation - 'lambda* - "duplicate identifier in argument list" - orig-args-22759))))) - (req-22760 orig-args-22759 '())))) - (expand-lambda-case-4309 - (lambda (e-23453 - r-23454 - w-23455 - s-23456 - mod-23457 - get-formals-23458 - clauses-23459) - (letrec* - ((parse-req-23460 - (lambda (req-23591 - opt-23592 - rest-23593 - kw-23594 - body-23595) - (let ((vars-23596 (map gen-var-4311 req-23591)) - (labels-23597 (gen-labels-4264 req-23591))) - (let ((r*-23598 - (extend-var-env-4256 - labels-23597 - vars-23596 - r-23454)) - (w*-23599 - (make-binding-wrap-4275 - req-23591 - labels-23597 - w-23455))) - (parse-opt-23461 - (map syntax->datum req-23591) - opt-23592 - rest-23593 - kw-23594 - body-23595 - (reverse vars-23596) - r*-23598 - w*-23599 - '() - '()))))) - (parse-opt-23461 - (lambda (req-23785 - opt-23786 - rest-23787 - kw-23788 - body-23789 - vars-23790 - r*-23791 - w*-23792 - out-23793 - inits-23794) - (if (pair? opt-23786) - (let ((tmp-23795 (car opt-23786))) - (let ((tmp-23796 ($sc-dispatch tmp-23795 '(any any)))) - (if tmp-23796 - (@apply - (lambda (id-23798 i-23799) - (let ((v-23800 - (let ((id-23808 - (if (if (vector? id-23798) - (if (= (vector-length - id-23798) - 4) - (eq? (vector-ref - id-23798 - 0) - 'syntax-object) - #f) - #f) - (vector-ref id-23798 1) - id-23798))) - (gensym - (string-append - (symbol->string id-23808) - "-"))))) - (let ((l-23801 (gen-labels-4264 (list v-23800)))) - (let ((r**-23802 - (extend-var-env-4256 - l-23801 - (list v-23800) - r*-23791))) - (let ((w**-23803 - (make-binding-wrap-4275 - (list id-23798) - l-23801 - w*-23792))) - (parse-opt-23461 - req-23785 - (cdr opt-23786) - rest-23787 - kw-23788 - body-23789 - (cons v-23800 vars-23790) - r**-23802 - w**-23803 - (cons (syntax->datum id-23798) out-23793) - (cons (call-with-values - (lambda () - (syntax-type-4296 - i-23799 - r*-23791 - w*-23792 - (let ((props-23882 - (source-properties - (if (if (vector? - i-23799) - (if (= (vector-length - i-23799) - 4) - (eq? (vector-ref - i-23799 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - i-23799 - 1) - i-23799)))) - (if (pair? props-23882) - props-23882 - #f)) - #f - mod-23457 - #f)) - (lambda (type-23915 - value-23916 - form-23917 - e-23918 - w-23919 - s-23920 - mod-23921) - (expand-expr-4298 - type-23915 - value-23916 - form-23917 - e-23918 - r*-23791 - w-23919 - s-23920 - mod-23921))) - inits-23794))))))) - tmp-23796) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-23795)))) - (if rest-23787 - (let ((v-24035 - (let ((id-24045 - (if (if (vector? rest-23787) - (if (= (vector-length rest-23787) 4) - (eq? (vector-ref rest-23787 0) - 'syntax-object) - #f) - #f) - (vector-ref rest-23787 1) - rest-23787))) - (gensym - (string-append - (symbol->string id-24045) - "-"))))) - (let ((l-24036 (gen-labels-4264 (list v-24035)))) - (let ((r*-24037 - (extend-var-env-4256 - l-24036 - (list v-24035) - r*-23791))) - (let ((w*-24038 - (make-binding-wrap-4275 - (list rest-23787) - l-24036 - w*-23792))) - (parse-kw-23462 - req-23785 - (if (pair? out-23793) (reverse out-23793) #f) - (syntax->datum rest-23787) - (if (pair? kw-23788) (cdr kw-23788) kw-23788) - body-23789 - (cons v-24035 vars-23790) - r*-24037 - w*-24038 - (if (pair? kw-23788) (car kw-23788) #f) - '() - inits-23794))))) - (parse-kw-23462 - req-23785 - (if (pair? out-23793) (reverse out-23793) #f) - #f - (if (pair? kw-23788) (cdr kw-23788) kw-23788) - body-23789 - vars-23790 - r*-23791 - w*-23792 - (if (pair? kw-23788) (car kw-23788) #f) - '() - inits-23794))))) - (parse-kw-23462 - (lambda (req-24216 - opt-24217 - rest-24218 - kw-24219 - body-24220 - vars-24221 - r*-24222 - w*-24223 - aok-24224 - out-24225 - inits-24226) - (if (pair? kw-24219) - (let ((tmp-24227 (car kw-24219))) - (let ((tmp-24228 - ($sc-dispatch tmp-24227 '(any any any)))) - (if tmp-24228 - (@apply - (lambda (k-24230 id-24231 i-24232) - (let ((v-24233 - (let ((id-24241 - (if (if (vector? id-24231) - (if (= (vector-length - id-24231) - 4) - (eq? (vector-ref - id-24231 - 0) - 'syntax-object) - #f) - #f) - (vector-ref id-24231 1) - id-24231))) - (gensym - (string-append - (symbol->string id-24241) - "-"))))) - (let ((l-24234 (gen-labels-4264 (list v-24233)))) - (let ((r**-24235 - (extend-var-env-4256 - l-24234 - (list v-24233) - r*-24222))) - (let ((w**-24236 - (make-binding-wrap-4275 - (list id-24231) - l-24234 - w*-24223))) - (parse-kw-23462 - req-24216 - opt-24217 - rest-24218 - (cdr kw-24219) - body-24220 - (cons v-24233 vars-24221) - r**-24235 - w**-24236 - aok-24224 - (cons (list (syntax->datum k-24230) - (syntax->datum id-24231) - v-24233) - out-24225) - (cons (call-with-values - (lambda () - (syntax-type-4296 - i-24232 - r*-24222 - w*-24223 - (let ((props-24315 - (source-properties - (if (if (vector? - i-24232) - (if (= (vector-length - i-24232) - 4) - (eq? (vector-ref - i-24232 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - i-24232 - 1) - i-24232)))) - (if (pair? props-24315) - props-24315 - #f)) - #f - mod-23457 - #f)) - (lambda (type-24348 - value-24349 - form-24350 - e-24351 - w-24352 - s-24353 - mod-24354) - (expand-expr-4298 - type-24348 - value-24349 - form-24350 - e-24351 - r*-24222 - w-24352 - s-24353 - mod-24354))) - inits-24226))))))) - tmp-24228) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-24227)))) - (parse-body-23463 - req-24216 - opt-24217 - rest-24218 - (if (if aok-24224 aok-24224 (pair? out-24225)) - (cons aok-24224 (reverse out-24225)) - #f) - body-24220 - (reverse vars-24221) - r*-24222 - w*-24223 - (reverse inits-24226) - '())))) - (parse-body-23463 - (lambda (req-24477 - opt-24478 - rest-24479 - kw-24480 - body-24481 - vars-24482 - r*-24483 - w*-24484 - inits-24485 - meta-24486) - (let ((tmp-24488 - ($sc-dispatch body-24481 '(any any . each-any)))) - (if (if tmp-24488 - (@apply - (lambda (docstring-24492 e1-24493 e2-24494) - (string? (syntax->datum docstring-24492))) - tmp-24488) - #f) - (@apply - (lambda (docstring-24495 e1-24496 e2-24497) - (parse-body-23463 - req-24477 - opt-24478 - rest-24479 - kw-24480 - (cons e1-24496 e2-24497) - vars-24482 - r*-24483 - w*-24484 - inits-24485 - (append - meta-24486 - (list (cons 'documentation - (syntax->datum docstring-24495)))))) - tmp-24488) - (let ((tmp-24498 - ($sc-dispatch - body-24481 - '(#(vector #(each (any . any))) - any - . - each-any)))) - (if tmp-24498 - (@apply - (lambda (k-24502 v-24503 e1-24504 e2-24505) - (parse-body-23463 - req-24477 - opt-24478 - rest-24479 - kw-24480 - (cons e1-24504 e2-24505) - vars-24482 - r*-24483 - w*-24484 - inits-24485 - (append - meta-24486 - (syntax->datum (map cons k-24502 v-24503))))) - tmp-24498) - (let ((tmp-24506 - ($sc-dispatch body-24481 '(any . each-any)))) - (if tmp-24506 - (@apply - (lambda (e1-24510 e2-24511) - (values - meta-24486 - req-24477 - opt-24478 - rest-24479 - kw-24480 - inits-24485 - vars-24482 - (expand-body-4301 - (cons e1-24510 e2-24511) - (wrap-4290 - (begin - (if (if s-23456 - (supports-source-properties? - e-23453) - #f) - (set-source-properties! - e-23453 - s-23456)) - e-23453) - w-23455 - mod-23457) - r*-24483 - w*-24484 - mod-23457))) - tmp-24506) - (syntax-violation - #f - "source expression failed to match any pattern" - body-24481)))))))))) - (let ((tmp-23465 ($sc-dispatch clauses-23459 '()))) - (if tmp-23465 - (@apply (lambda () (values '() #f)) tmp-23465) - (let ((tmp-23469 - ($sc-dispatch - clauses-23459 - '((any any . each-any) - . - #(each (any any . each-any)))))) - (if tmp-23469 - (@apply - (lambda (args-23473 - e1-23474 - e2-23475 - args*-23476 - e1*-23477 - e2*-23478) - (call-with-values - (lambda () (get-formals-23458 args-23473)) - (lambda (req-23479 opt-23480 rest-23481 kw-23482) - (call-with-values - (lambda () - (parse-req-23460 - req-23479 - opt-23480 - rest-23481 - kw-23482 - (cons e1-23474 e2-23475))) - (lambda (meta-23547 - req-23548 - opt-23549 - rest-23550 - kw-23551 - inits-23552 - vars-23553 - body-23554) - (call-with-values - (lambda () - (expand-lambda-case-4309 - e-23453 - r-23454 - w-23455 - s-23456 - mod-23457 - get-formals-23458 - (map (lambda (tmp-2800-23555 - tmp-2799-23556 - tmp-2798-23557) - (cons tmp-2798-23557 - (cons tmp-2799-23556 - tmp-2800-23555))) - e2*-23478 - e1*-23477 - args*-23476))) - (lambda (meta*-23558 else*-23559) - (values - (append meta-23547 meta*-23558) - (make-struct/no-tail - (vector-ref %expanded-vtables 14) - s-23456 - req-23548 - opt-23549 - rest-23550 - kw-23551 - inits-23552 - vars-23553 - body-23554 - else*-23559))))))))) - tmp-23469) - (syntax-violation - #f - "source expression failed to match any pattern" - clauses-23459)))))))) - (strip-4310 - (lambda (x-24548 w-24549) - (if (memq 'top (car w-24549)) - x-24548 - (letrec* - ((f-24550 - (lambda (x-24553) - (if (if (vector? x-24553) - (if (= (vector-length x-24553) 4) - (eq? (vector-ref x-24553 0) 'syntax-object) - #f) - #f) - (strip-4310 - (vector-ref x-24553 1) - (vector-ref x-24553 2)) - (if (pair? x-24553) - (let ((a-24572 (f-24550 (car x-24553))) - (d-24573 (f-24550 (cdr x-24553)))) - (if (if (eq? a-24572 (car x-24553)) - (eq? d-24573 (cdr x-24553)) - #f) - x-24553 - (cons a-24572 d-24573))) - (if (vector? x-24553) - (let ((old-24576 (vector->list x-24553))) - (let ((new-24577 (map f-24550 old-24576))) - (letrec* - ((lp-24578 - (lambda (l1-24654 l2-24655) - (if (null? l1-24654) - x-24553 - (if (eq? (car l1-24654) (car l2-24655)) - (lp-24578 (cdr l1-24654) (cdr l2-24655)) - (list->vector new-24577)))))) - (lp-24578 old-24576 new-24577)))) - x-24553)))))) - (f-24550 x-24548))))) - (gen-var-4311 - (lambda (id-23603) - (let ((id-23604 - (if (if (vector? id-23603) - (if (= (vector-length id-23603) 4) - (eq? (vector-ref id-23603 0) 'syntax-object) - #f) - #f) - (vector-ref id-23603 1) - id-23603))) - (gensym - (string-append (symbol->string id-23604) "-")))))) - (begin - (set! session-id-4222 - (let ((v-14702 - (module-variable - (current-module) - 'syntax-session-id))) - (lambda () ((variable-ref v-14702))))) - (set! transformer-environment-4283 - (make-fluid - (lambda (k-13734) - (error "called outside the dynamic extent of a syntax transformer")))) - (module-define! - (current-module) - 'letrec-syntax - (make-syntax-transformer - 'letrec-syntax - 'local-syntax - #t)) - (module-define! - (current-module) - 'let-syntax - (make-syntax-transformer - 'let-syntax - 'local-syntax - #f)) - (global-extend-4259 - 'core - 'syntax-parameterize - (lambda (e-4430 r-4431 w-4432 s-4433 mod-4434) - (let ((tmp-4436 - ($sc-dispatch - e-4430 - '(_ #(each (any any)) any . each-any)))) - (if (if tmp-4436 - (@apply - (lambda (var-4438 val-4439 e1-4440 e2-4441) - (valid-bound-ids?-4287 var-4438)) - tmp-4436) - #f) - (@apply - (lambda (var-4519 val-4520 e1-4521 e2-4522) - (let ((names-4523 - (map (lambda (x-4573) - (id-var-name-4280 x-4573 w-4432)) - var-4519))) - (begin - (for-each - (lambda (id-4524 n-4525) - (let ((key-4526 - (car (let ((t-4533 (assq n-4525 r-4431))) - (if t-4533 - (cdr t-4533) - (if (symbol? n-4525) - (let ((t-4538 - (get-global-definition-hook-4224 - n-4525 - mod-4434))) - (if t-4538 t-4538 '(global))) - '(displaced-lexical))))))) - (if (eqv? key-4526 'displaced-lexical) - (syntax-violation - 'syntax-parameterize - "identifier out of context" - e-4430 - (wrap-4290 - (begin - (if (if s-4433 - (supports-source-properties? id-4524) - #f) - (set-source-properties! id-4524 s-4433)) - id-4524) - w-4432 - mod-4434))))) - var-4519 - names-4523) - (expand-body-4301 - (cons e1-4521 e2-4522) - (wrap-4290 - (begin - (if (if s-4433 - (supports-source-properties? e-4430) - #f) - (set-source-properties! e-4430 s-4433)) - e-4430) - w-4432 - mod-4434) - (extend-env-4255 - names-4523 - (let ((trans-r-4659 (macros-only-env-4257 r-4431))) - (map (lambda (x-4660) - (cons 'macro - (eval-local-transformer-4303 - (call-with-values - (lambda () - (syntax-type-4296 - x-4660 - trans-r-4659 - w-4432 - (let ((props-4717 - (source-properties - (if (if (vector? - x-4660) - (if (= (vector-length - x-4660) - 4) - (eq? (vector-ref - x-4660 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - x-4660 - 1) - x-4660)))) - (if (pair? props-4717) - props-4717 - #f)) - #f - mod-4434 - #f)) - (lambda (type-4750 - value-4751 - form-4752 - e-4753 - w-4754 - s-4755 - mod-4756) - (expand-expr-4298 - type-4750 - value-4751 - form-4752 - e-4753 - trans-r-4659 - w-4754 - s-4755 - mod-4756))) - mod-4434))) - val-4520)) - r-4431) - w-4432 - mod-4434)))) - tmp-4436) - (syntax-violation - 'syntax-parameterize - "bad syntax" - (wrap-4290 - (begin - (if (if s-4433 - (supports-source-properties? e-4430) - #f) - (set-source-properties! e-4430 s-4433)) - e-4430) - w-4432 - mod-4434)))))) - (module-define! - (current-module) - 'quote - (make-syntax-transformer - 'quote - 'core - (lambda (e-4855 r-4856 w-4857 s-4858 mod-4859) - (let ((tmp-4861 ($sc-dispatch e-4855 '(_ any)))) - (if tmp-4861 - (@apply - (lambda (e-4862) - (let ((exp-4866 (strip-4310 e-4862 w-4857))) - (make-struct/no-tail - (vector-ref %expanded-vtables 1) - s-4858 - exp-4866))) - tmp-4861) - (syntax-violation - 'quote - "bad syntax" - (wrap-4290 - (begin - (if (if s-4858 - (supports-source-properties? e-4855) - #f) - (set-source-properties! e-4855 s-4858)) - e-4855) - w-4857 - mod-4859))))))) - (global-extend-4259 - 'core - 'syntax - (letrec* - ((gen-syntax-5078 - (lambda (src-5175 - e-5176 - r-5177 - maps-5178 - ellipsis?-5179 - mod-5180) - (if (if (symbol? e-5176) - #t - (if (if (vector? e-5176) - (if (= (vector-length e-5176) 4) - (eq? (vector-ref e-5176 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref e-5176 1)) - #f)) - (let ((label-5207 (id-var-name-4280 e-5176 '(())))) - (let ((b-5208 - (let ((t-5215 (assq label-5207 r-5177))) - (if t-5215 - (cdr t-5215) - (if (symbol? label-5207) - (let ((t-5221 - (get-global-definition-hook-4224 - label-5207 - mod-5180))) - (if t-5221 t-5221 '(global))) - '(displaced-lexical)))))) - (if (eq? (car b-5208) 'syntax) - (call-with-values - (lambda () - (let ((var.lev-5230 (cdr b-5208))) - (gen-ref-5079 - src-5175 - (car var.lev-5230) - (cdr var.lev-5230) - maps-5178))) - (lambda (var-5234 maps-5235) - (values (list 'ref var-5234) maps-5235))) - (if (ellipsis?-5179 e-5176) - (syntax-violation - 'syntax - "misplaced ellipsis" - src-5175) - (values (list 'quote e-5176) maps-5178))))) - (let ((tmp-5237 ($sc-dispatch e-5176 '(any any)))) - (if (if tmp-5237 - (@apply - (lambda (dots-5241 e-5242) - (ellipsis?-5179 dots-5241)) - tmp-5237) - #f) - (@apply - (lambda (dots-5243 e-5244) - (gen-syntax-5078 - src-5175 - e-5244 - r-5177 - maps-5178 - (lambda (x-5245) #f) - mod-5180)) - tmp-5237) - (let ((tmp-5246 ($sc-dispatch e-5176 '(any any . any)))) - (if (if tmp-5246 - (@apply - (lambda (x-5250 dots-5251 y-5252) - (ellipsis?-5179 dots-5251)) - tmp-5246) - #f) - (@apply - (lambda (x-5253 dots-5254 y-5255) - (letrec* - ((f-5256 - (lambda (y-5264 k-5265) - (let ((tmp-5267 - ($sc-dispatch - y-5264 - '(any . any)))) - (if (if tmp-5267 - (@apply - (lambda (dots-5269 y-5270) - (ellipsis?-5179 dots-5269)) - tmp-5267) - #f) - (@apply - (lambda (dots-5271 y-5272) - (f-5256 - y-5272 - (lambda (maps-5273) - (call-with-values - (lambda () - (k-5265 - (cons '() maps-5273))) - (lambda (x-5274 maps-5275) - (if (null? (car maps-5275)) - (syntax-violation - 'syntax - "extra ellipsis" - src-5175) - (values - (let ((map-env-5279 - (car maps-5275))) - (list 'apply - '(primitive - append) - (gen-map-5081 - x-5274 - map-env-5279))) - (cdr maps-5275)))))))) - tmp-5267) - (call-with-values - (lambda () - (gen-syntax-5078 - src-5175 - y-5264 - r-5177 - maps-5178 - ellipsis?-5179 - mod-5180)) - (lambda (y-5281 maps-5282) - (call-with-values - (lambda () (k-5265 maps-5282)) - (lambda (x-5283 maps-5284) - (values - (if (equal? y-5281 ''()) - x-5283 - (list 'append - x-5283 - y-5281)) - maps-5284)))))))))) - (f-5256 - y-5255 - (lambda (maps-5259) - (call-with-values - (lambda () - (gen-syntax-5078 - src-5175 - x-5253 - r-5177 - (cons '() maps-5259) - ellipsis?-5179 - mod-5180)) - (lambda (x-5260 maps-5261) - (if (null? (car maps-5261)) - (syntax-violation - 'syntax - "extra ellipsis" - src-5175) - (values - (gen-map-5081 - x-5260 - (car maps-5261)) - (cdr maps-5261))))))))) - tmp-5246) - (let ((tmp-5298 ($sc-dispatch e-5176 '(any . any)))) - (if tmp-5298 - (@apply - (lambda (x-5302 y-5303) - (call-with-values - (lambda () - (gen-syntax-5078 - src-5175 - x-5302 - r-5177 - maps-5178 - ellipsis?-5179 - mod-5180)) - (lambda (x-5304 maps-5305) - (call-with-values - (lambda () - (gen-syntax-5078 - src-5175 - y-5303 - r-5177 - maps-5305 - ellipsis?-5179 - mod-5180)) - (lambda (y-5306 maps-5307) - (values - (let ((key-5312 (car y-5306))) - (if (eqv? key-5312 'quote) - (if (eq? (car x-5304) 'quote) - (list 'quote - (cons (car (cdr x-5304)) - (car (cdr y-5306)))) - (if (eq? (car (cdr y-5306)) - '()) - (list 'list x-5304) - (list 'cons x-5304 y-5306))) - (if (eqv? key-5312 'list) - (cons 'list - (cons x-5304 - (cdr y-5306))) - (list 'cons x-5304 y-5306)))) - maps-5307)))))) - tmp-5298) - (let ((tmp-5341 - ($sc-dispatch - e-5176 - '#(vector (any . each-any))))) - (if tmp-5341 - (@apply - (lambda (e1-5345 e2-5346) - (call-with-values - (lambda () - (gen-syntax-5078 - src-5175 - (cons e1-5345 e2-5346) - r-5177 - maps-5178 - ellipsis?-5179 - mod-5180)) - (lambda (e-5347 maps-5348) - (values - (if (eq? (car e-5347) 'list) - (cons 'vector (cdr e-5347)) - (if (eq? (car e-5347) 'quote) - (list 'quote - (list->vector - (car (cdr e-5347)))) - (list 'list->vector e-5347))) - maps-5348)))) - tmp-5341) - (values - (list 'quote e-5176) - maps-5178)))))))))))) - (gen-ref-5079 - (lambda (src-5374 var-5375 level-5376 maps-5377) - (if (= level-5376 0) - (values var-5375 maps-5377) - (if (null? maps-5377) - (syntax-violation - 'syntax - "missing ellipsis" - src-5374) - (call-with-values - (lambda () - (gen-ref-5079 - src-5374 - var-5375 - (#{1-}# level-5376) - (cdr maps-5377))) - (lambda (outer-var-5378 outer-maps-5379) - (let ((b-5380 (assq outer-var-5378 (car maps-5377)))) - (if b-5380 - (values (cdr b-5380) maps-5377) - (let ((inner-var-5382 - (gensym - (string-append - (symbol->string 'tmp) - "-")))) - (values - inner-var-5382 - (cons (cons (cons outer-var-5378 inner-var-5382) - (car maps-5377)) - outer-maps-5379))))))))))) - (gen-map-5081 - (lambda (e-5396 map-env-5397) - (let ((formals-5398 (map cdr map-env-5397)) - (actuals-5399 - (map (lambda (x-5401) (list 'ref (car x-5401))) - map-env-5397))) - (if (eq? (car e-5396) 'ref) - (car actuals-5399) - (if (and-map - (lambda (x-5402) - (if (eq? (car x-5402) 'ref) - (memq (car (cdr x-5402)) formals-5398) - #f)) - (cdr e-5396)) - (cons 'map - (cons (list 'primitive (car e-5396)) - (map (let ((r-5404 - (map cons - formals-5398 - actuals-5399))) - (lambda (x-5405) - (cdr (assq (car (cdr x-5405)) - r-5404)))) - (cdr e-5396)))) - (cons 'map - (cons (list 'lambda formals-5398 e-5396) - actuals-5399))))))) - (regen-5085 - (lambda (x-5407) - (let ((key-5408 (car x-5407))) - (if (eqv? key-5408 'ref) - (let ((name-5418 (car (cdr x-5407))) - (var-5419 (car (cdr x-5407)))) - (make-struct/no-tail - (vector-ref %expanded-vtables 3) - #f - name-5418 - var-5419)) - (if (eqv? key-5408 'primitive) - (let ((name-5431 (car (cdr x-5407)))) - (if (equal? (module-name (current-module)) '(guile)) - (make-struct/no-tail - (vector-ref %expanded-vtables 7) - #f - name-5431) - (make-struct/no-tail - (vector-ref %expanded-vtables 5) - #f - '(guile) - name-5431 - #f))) - (if (eqv? key-5408 'quote) - (let ((exp-5449 (car (cdr x-5407)))) - (make-struct/no-tail - (vector-ref %expanded-vtables 1) - #f - exp-5449)) - (if (eqv? key-5408 'lambda) - (if (list? (car (cdr x-5407))) - (let ((req-5460 (car (cdr x-5407))) - (vars-5462 (car (cdr x-5407))) - (exp-5464 - (regen-5085 (car (cdr (cdr x-5407)))))) - (let ((body-5469 - (make-struct/no-tail - (vector-ref %expanded-vtables 14) - #f - req-5460 - #f - #f - #f - '() - vars-5462 - exp-5464 - #f))) - (make-struct/no-tail - (vector-ref %expanded-vtables 13) - #f - '() - body-5469))) - (error "how did we get here" x-5407)) - (let ((fun-exp-5485 - (let ((name-5494 (car x-5407))) - (if (equal? - (module-name (current-module)) - '(guile)) - (make-struct/no-tail - (vector-ref %expanded-vtables 7) - #f - name-5494) - (make-struct/no-tail - (vector-ref %expanded-vtables 5) - #f - '(guile) - name-5494 - #f)))) - (arg-exps-5486 (map regen-5085 (cdr x-5407)))) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) + (hygiene guile)) + keys))) + (if (free-id=? + pat + '#(syntax-object + _ + ((top) + #(ribcage #(pat exp) #((top) (top)) #("l-*-3859" "l-*-3860")) + #(ribcage () () ()) + #(ribcage + #(x keys clauses r mod) + #((top) (top) (top) (top) (top)) + #("l-*-3848" "l-*-3849" "l-*-3850" "l-*-3851" "l-*-3852")) + #(ribcage + (gen-syntax-case gen-clause build-dispatch-call convert-pattern) + ((top) (top) (top) (top)) + ("l-*-3668" "l-*-3666" "l-*-3664" "l-*-3662")) + #(ribcage + (lambda-var-list + gen-var + strip + expand-lambda-case + lambda*-formals + expand-simple-lambda + lambda-formals + ellipsis? + expand-void + eval-local-transformer + expand-local-syntax + expand-body + expand-macro + expand-application + expand-expr + expand + syntax-type + parse-when-list + expand-install-global + expand-top-sequence + expand-sequence + source-wrap + wrap + bound-id-member? + distinct-bound-ids? + valid-bound-ids? + bound-id=? + free-id=? + with-transformer-environment + transformer-environment + resolve-identifier + locally-bound-identifiers + id-var-name + same-marks? + join-marks + join-wraps + smart-append + make-binding-wrap + extend-ribcage! + make-empty-ribcage + new-mark + anti-mark + the-anti-mark + top-marked? + top-wrap + empty-wrap + set-ribcage-labels! + set-ribcage-marks! + set-ribcage-symnames! + ribcage-labels + ribcage-marks + ribcage-symnames + ribcage? + make-ribcage + gen-labels + gen-label + make-rename + rename-marks + rename-new + rename-old + subst-rename? + wrap-subst + wrap-marks + make-wrap + id-sym-name&marks + id-sym-name + id? + nonsymbol-id? + global-extend + lookup + macros-only-env + extend-var-env + extend-env + null-env + binding-value + binding-type + make-binding + arg-check + source-annotation + no-source + set-syntax-object-module! + set-syntax-object-wrap! + set-syntax-object-expression! + syntax-object-module + syntax-object-wrap + syntax-object-expression + syntax-object? + make-syntax-object + build-lexical-var + build-letrec + build-named-let + build-let + build-sequence + build-data + build-primref + build-lambda-case + build-case-lambda + build-simple-lambda + build-global-definition + build-global-assignment + build-global-reference + analyze-variable + build-lexical-assignment + build-lexical-reference + build-dynlet + build-conditional + build-application + build-void + maybe-name-value! + decorate-source + get-global-definition-hook + put-global-definition-hook + session-id + local-eval-hook + top-level-eval-hook + fx< + fx= + fx- + fx+ + set-lambda-meta! + lambda-meta + lambda? + make-dynlet + make-letrec + make-let + make-lambda-case + make-lambda + make-sequence + make-application + make-conditional + make-toplevel-define + make-toplevel-set + make-toplevel-ref + make-module-set + make-module-ref + make-lexical-set + make-lexical-ref + make-primitive-ref + make-const + make-void) + ((top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-476" + "l-*-474" + "l-*-472" + "l-*-470" + "l-*-468" + "l-*-466" + "l-*-464" + "l-*-462" + "l-*-460" + "l-*-458" + "l-*-456" + "l-*-454" + "l-*-452" + "l-*-450" + "l-*-448" + "l-*-446" + "l-*-444" + "l-*-442" + "l-*-440" + "l-*-438" + "l-*-436" + "l-*-434" + "l-*-432" + "l-*-430" + "l-*-428" + "l-*-426" + "l-*-424" + "l-*-422" + "l-*-420" + "l-*-418" + "l-*-416" + "l-*-414" + "l-*-412" + "l-*-410" + "l-*-408" + "l-*-406" + "l-*-404" + "l-*-402" + "l-*-400" + "l-*-399" + "l-*-397" + "l-*-394" + "l-*-393" + "l-*-392" + "l-*-390" + "l-*-389" + "l-*-387" + "l-*-385" + "l-*-383" + "l-*-381" + "l-*-379" + "l-*-377" + "l-*-375" + "l-*-373" + "l-*-370" + "l-*-368" + "l-*-367" + "l-*-365" + "l-*-363" + "l-*-361" + "l-*-359" + "l-*-358" + "l-*-357" + "l-*-356" + "l-*-354" + "l-*-353" + "l-*-350" + "l-*-348" + "l-*-346" + "l-*-344" + "l-*-342" + "l-*-340" + "l-*-338" + "l-*-337" + "l-*-336" + "l-*-334" + "l-*-332" + "l-*-331" + "l-*-328" + "l-*-327" + "l-*-325" + "l-*-323" + "l-*-321" + "l-*-319" + "l-*-317" + "l-*-315" + "l-*-313" + "l-*-311" + "l-*-309" + "l-*-306" + "l-*-304" + "l-*-302" + "l-*-300" + "l-*-298" + "l-*-296" + "l-*-294" + "l-*-292" + "l-*-290" + "l-*-288" + "l-*-286" + "l-*-284" + "l-*-282" + "l-*-280" + "l-*-278" + "l-*-276" + "l-*-274" + "l-*-272" + "l-*-270" + "l-*-268" + "l-*-266" + "l-*-264" + "l-*-262" + "l-*-260" + "l-*-258" + "l-*-256" + "l-*-255" + "l-*-254" + "l-*-253" + "l-*-252" + "l-*-250" + "l-*-248" + "l-*-246" + "l-*-243" + "l-*-241" + "l-*-239" + "l-*-237" + "l-*-235" + "l-*-233" + "l-*-231" + "l-*-229" + "l-*-227" + "l-*-225" + "l-*-223" + "l-*-221" + "l-*-219" + "l-*-217" + "l-*-215" + "l-*-213" + "l-*-211" + "l-*-209")) + #(ribcage + (define-structure + define-expansion-accessors + define-expansion-constructors) + ((top) (top) (top)) + ("l-*-47" "l-*-46" "l-*-45"))) + (hygiene guile))) + (expand exp r '(()) mod) + (let ((labels (list (gen-label))) (var (gen-var pat))) + (build-application + #f + (build-simple-lambda + #f + (list (syntax->datum pat)) + #f + (list var) + '() + (expand + exp + (extend-env labels (list (cons 'syntax (cons var 0))) r) + (make-binding-wrap (list pat) labels '(())) + mod)) + (list x)))) + (gen-clause x keys (cdr clauses) r pat #t exp mod))) + tmp) + (let ((tmp ($sc-dispatch tmp-1 '(any any any)))) + (if tmp + (apply (lambda (pat fender exp) + (gen-clause x keys (cdr clauses) r pat fender exp mod)) + tmp) + (syntax-violation 'syntax-case "invalid clause" (car clauses)))))))))) + (lambda (e r w s mod) + (let* ((e (source-wrap e w s mod)) + (tmp-1 e) + (tmp ($sc-dispatch tmp-1 '(_ any each-any . each-any)))) + (if tmp + (apply (lambda (val key m) + (if (and-map (lambda (x) (and (id? x) (not (ellipsis? x)))) key) + (let ((x (gen-var 'tmp))) + (build-application + s + (build-simple-lambda #f - fun-exp-5485 - arg-exps-5486)))))))))) - (lambda (e-5086 r-5087 w-5088 s-5089 mod-5090) - (let ((e-5091 - (wrap-4290 - (begin - (if (if s-5089 - (supports-source-properties? e-5086) - #f) - (set-source-properties! e-5086 s-5089)) - e-5086) - w-5088 - mod-5090))) - (let ((tmp-5093 ($sc-dispatch e-5091 '(_ any)))) - (if tmp-5093 - (@apply - (lambda (x-5116) - (call-with-values - (lambda () - (gen-syntax-5078 - e-5091 - x-5116 - r-5087 - '() - ellipsis?-4305 - mod-5090)) - (lambda (e-5170 maps-5171) (regen-5085 e-5170)))) - tmp-5093) - (syntax-violation - 'syntax - "bad `syntax' form" - e-5091))))))) - (global-extend-4259 - 'core - 'lambda - (lambda (e-5679 r-5680 w-5681 s-5682 mod-5683) - (let ((tmp-5685 - ($sc-dispatch e-5679 '(_ any any . each-any)))) - (if tmp-5685 - (@apply - (lambda (args-5687 e1-5688 e2-5689) - (call-with-values - (lambda () (lambda-formals-4306 args-5687)) - (lambda (req-5692 opt-5693 rest-5694 kw-5695) - (letrec* - ((lp-5696 - (lambda (body-5699 meta-5700) - (let ((tmp-5702 - ($sc-dispatch - body-5699 - '(any any . each-any)))) - (if (if tmp-5702 - (@apply - (lambda (docstring-5706 e1-5707 e2-5708) - (string? - (syntax->datum docstring-5706))) - tmp-5702) - #f) - (@apply - (lambda (docstring-5709 e1-5710 e2-5711) - (lp-5696 - (cons e1-5710 e2-5711) - (append - meta-5700 - (list (cons 'documentation - (syntax->datum - docstring-5709)))))) - tmp-5702) - (let ((tmp-5712 - ($sc-dispatch - body-5699 - '(#(vector #(each (any . any))) - any - . - each-any)))) - (if tmp-5712 - (@apply - (lambda (k-5716 v-5717 e1-5718 e2-5719) - (lp-5696 - (cons e1-5718 e2-5719) - (append - meta-5700 - (syntax->datum - (map cons k-5716 v-5717))))) - tmp-5712) - (expand-simple-lambda-4307 - e-5679 - r-5680 - w-5681 - s-5682 - mod-5683 - req-5692 - rest-5694 - meta-5700 - body-5699)))))))) - (lp-5696 (cons e1-5688 e2-5689) '()))))) - tmp-5685) - (syntax-violation 'lambda "bad lambda" e-5679))))) - (global-extend-4259 - 'core - 'lambda* - (lambda (e-6002 r-6003 w-6004 s-6005 mod-6006) - (let ((tmp-6008 - ($sc-dispatch e-6002 '(_ any any . each-any)))) - (if tmp-6008 - (@apply - (lambda (args-6010 e1-6011 e2-6012) - (call-with-values - (lambda () - (expand-lambda-case-4309 - e-6002 - r-6003 - w-6004 - s-6005 - mod-6006 - lambda*-formals-4308 - (list (cons args-6010 (cons e1-6011 e2-6012))))) - (lambda (meta-6015 lcase-6016) - (make-struct/no-tail - (vector-ref %expanded-vtables 13) - s-6005 - meta-6015 - lcase-6016)))) - tmp-6008) - (syntax-violation 'lambda "bad lambda*" e-6002))))) - (global-extend-4259 - 'core - 'case-lambda - (lambda (e-6181 r-6182 w-6183 s-6184 mod-6185) - (let ((tmp-6187 - ($sc-dispatch - e-6181 - '(_ (any any . each-any) - . - #(each (any any . each-any)))))) - (if tmp-6187 - (@apply - (lambda (args-6189 - e1-6190 - e2-6191 - args*-6192 - e1*-6193 - e2*-6194) - (call-with-values - (lambda () - (expand-lambda-case-4309 - e-6181 - r-6182 - w-6183 - s-6184 - mod-6185 - lambda-formals-4306 - (cons (cons args-6189 (cons e1-6190 e2-6191)) - (map (lambda (tmp-3252-6197 - tmp-3251-6198 - tmp-3250-6199) - (cons tmp-3250-6199 - (cons tmp-3251-6198 tmp-3252-6197))) - e2*-6194 - e1*-6193 - args*-6192)))) - (lambda (meta-6200 lcase-6201) - (make-struct/no-tail - (vector-ref %expanded-vtables 13) - s-6184 - meta-6200 - lcase-6201)))) - tmp-6187) - (syntax-violation - 'case-lambda - "bad case-lambda" - e-6181))))) - (global-extend-4259 - 'core - 'case-lambda* - (lambda (e-6358 r-6359 w-6360 s-6361 mod-6362) - (let ((tmp-6364 - ($sc-dispatch - e-6358 - '(_ (any any . each-any) - . - #(each (any any . each-any)))))) - (if tmp-6364 - (@apply - (lambda (args-6366 - e1-6367 - e2-6368 - args*-6369 - e1*-6370 - e2*-6371) - (call-with-values - (lambda () - (expand-lambda-case-4309 - e-6358 - r-6359 - w-6360 - s-6361 - mod-6362 - lambda*-formals-4308 - (cons (cons args-6366 (cons e1-6367 e2-6368)) - (map (lambda (tmp-3285-6374 - tmp-3284-6375 - tmp-3283-6376) - (cons tmp-3283-6376 - (cons tmp-3284-6375 tmp-3285-6374))) - e2*-6371 - e1*-6370 - args*-6369)))) - (lambda (meta-6377 lcase-6378) - (make-struct/no-tail - (vector-ref %expanded-vtables 13) - s-6361 - meta-6377 - lcase-6378)))) - tmp-6364) - (syntax-violation - 'case-lambda - "bad case-lambda*" - e-6358))))) - (global-extend-4259 - 'core - 'let - (letrec* - ((expand-let-6566 - (lambda (e-6714 - r-6715 - w-6716 - s-6717 - mod-6718 - constructor-6719 - ids-6720 - vals-6721 - exps-6722) - (if (not (valid-bound-ids?-4287 ids-6720)) - (syntax-violation - 'let - "duplicate bound variable" - e-6714) - (let ((labels-6800 (gen-labels-4264 ids-6720)) - (new-vars-6801 (map gen-var-4311 ids-6720))) - (let ((nw-6802 - (make-binding-wrap-4275 - ids-6720 - labels-6800 - w-6716)) - (nr-6803 - (extend-var-env-4256 - labels-6800 - new-vars-6801 - r-6715))) - (constructor-6719 - s-6717 - (map syntax->datum ids-6720) - new-vars-6801 - (map (lambda (x-6820) - (call-with-values - (lambda () - (syntax-type-4296 - x-6820 - r-6715 - w-6716 - (let ((props-6836 - (source-properties - (if (if (vector? x-6820) - (if (= (vector-length - x-6820) - 4) - (eq? (vector-ref - x-6820 - 0) - 'syntax-object) - #f) - #f) - (vector-ref x-6820 1) - x-6820)))) - (if (pair? props-6836) props-6836 #f)) - #f - mod-6718 - #f)) - (lambda (type-6869 - value-6870 - form-6871 - e-6872 - w-6873 - s-6874 - mod-6875) - (expand-expr-4298 - type-6869 - value-6870 - form-6871 - e-6872 - r-6715 - w-6873 - s-6874 - mod-6875)))) - vals-6721) - (expand-body-4301 - exps-6722 - (source-wrap-4291 e-6714 nw-6802 s-6717 mod-6718) - nr-6803 - nw-6802 - mod-6718)))))))) - (lambda (e-6567 r-6568 w-6569 s-6570 mod-6571) - (let ((tmp-6573 - ($sc-dispatch - e-6567 - '(_ #(each (any any)) any . each-any)))) - (if (if tmp-6573 - (@apply - (lambda (id-6577 val-6578 e1-6579 e2-6580) - (and-map id?-4261 id-6577)) - tmp-6573) - #f) - (@apply - (lambda (id-6596 val-6597 e1-6598 e2-6599) - (expand-let-6566 - e-6567 - r-6568 - w-6569 - s-6570 - mod-6571 - build-let-4243 - id-6596 - val-6597 - (cons e1-6598 e2-6599))) - tmp-6573) - (let ((tmp-6629 - ($sc-dispatch - e-6567 - '(_ any #(each (any any)) any . each-any)))) - (if (if tmp-6629 - (@apply - (lambda (f-6633 id-6634 val-6635 e1-6636 e2-6637) - (if (if (symbol? f-6633) - #t - (if (if (vector? f-6633) - (if (= (vector-length f-6633) 4) - (eq? (vector-ref f-6633 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref f-6633 1)) - #f)) - (and-map id?-4261 id-6634) - #f)) - tmp-6629) - #f) - (@apply - (lambda (f-6679 id-6680 val-6681 e1-6682 e2-6683) - (expand-let-6566 - e-6567 - r-6568 - w-6569 - s-6570 - mod-6571 - build-named-let-4244 - (cons f-6679 id-6680) - val-6681 - (cons e1-6682 e2-6683))) - tmp-6629) - (syntax-violation - 'let - "bad let" - (wrap-4290 - (begin - (if (if s-6570 - (supports-source-properties? e-6567) - #f) - (set-source-properties! e-6567 s-6570)) - e-6567) - w-6569 - mod-6571))))))))) - (global-extend-4259 - 'core - 'letrec - (lambda (e-7219 r-7220 w-7221 s-7222 mod-7223) - (let ((tmp-7225 - ($sc-dispatch - e-7219 - '(_ #(each (any any)) any . each-any)))) - (if (if tmp-7225 - (@apply - (lambda (id-7227 val-7228 e1-7229 e2-7230) - (and-map id?-4261 id-7227)) - tmp-7225) - #f) - (@apply - (lambda (id-7246 val-7247 e1-7248 e2-7249) - (if (not (valid-bound-ids?-4287 id-7246)) - (syntax-violation - 'letrec - "duplicate bound variable" - e-7219) - (let ((labels-7339 (gen-labels-4264 id-7246)) - (new-vars-7340 (map gen-var-4311 id-7246))) - (let ((w-7341 - (make-binding-wrap-4275 - id-7246 - labels-7339 - w-7221)) - (r-7342 - (extend-var-env-4256 - labels-7339 - new-vars-7340 - r-7220))) - (build-letrec-4245 - s-7222 - #f - (map syntax->datum id-7246) - new-vars-7340 - (map (lambda (x-7427) - (expand-4297 x-7427 r-7342 w-7341 mod-7223)) - val-7247) - (expand-body-4301 - (cons e1-7248 e2-7249) - (wrap-4290 - (begin - (if (if s-7222 - (supports-source-properties? e-7219) - #f) - (set-source-properties! e-7219 s-7222)) - e-7219) - w-7341 - mod-7223) - r-7342 - w-7341 - mod-7223)))))) - tmp-7225) - (syntax-violation - 'letrec - "bad letrec" - (wrap-4290 - (begin - (if (if s-7222 - (supports-source-properties? e-7219) - #f) - (set-source-properties! e-7219 s-7222)) - e-7219) - w-7221 - mod-7223)))))) - (global-extend-4259 - 'core - 'letrec* - (lambda (e-7817 r-7818 w-7819 s-7820 mod-7821) - (let ((tmp-7823 - ($sc-dispatch - e-7817 - '(_ #(each (any any)) any . each-any)))) - (if (if tmp-7823 - (@apply - (lambda (id-7825 val-7826 e1-7827 e2-7828) - (and-map id?-4261 id-7825)) - tmp-7823) - #f) - (@apply - (lambda (id-7844 val-7845 e1-7846 e2-7847) - (if (not (valid-bound-ids?-4287 id-7844)) - (syntax-violation - 'letrec* - "duplicate bound variable" - e-7817) - (let ((labels-7937 (gen-labels-4264 id-7844)) - (new-vars-7938 (map gen-var-4311 id-7844))) - (let ((w-7939 - (make-binding-wrap-4275 - id-7844 - labels-7937 - w-7819)) - (r-7940 - (extend-var-env-4256 - labels-7937 - new-vars-7938 - r-7818))) - (build-letrec-4245 - s-7820 - #t - (map syntax->datum id-7844) - new-vars-7938 - (map (lambda (x-8025) - (expand-4297 x-8025 r-7940 w-7939 mod-7821)) - val-7845) - (expand-body-4301 - (cons e1-7846 e2-7847) - (wrap-4290 - (begin - (if (if s-7820 - (supports-source-properties? e-7817) - #f) - (set-source-properties! e-7817 s-7820)) - e-7817) - w-7939 - mod-7821) - r-7940 - w-7939 - mod-7821)))))) - tmp-7823) - (syntax-violation - 'letrec* - "bad letrec*" - (wrap-4290 - (begin - (if (if s-7820 - (supports-source-properties? e-7817) - #f) - (set-source-properties! e-7817 s-7820)) - e-7817) - w-7819 - mod-7821)))))) - (global-extend-4259 - 'core - 'set! - (lambda (e-8488 r-8489 w-8490 s-8491 mod-8492) - (let ((tmp-8494 ($sc-dispatch e-8488 '(_ any any)))) - (if (if tmp-8494 - (@apply - (lambda (id-8498 val-8499) - (if (symbol? id-8498) - #t - (if (if (vector? id-8498) - (if (= (vector-length id-8498) 4) - (eq? (vector-ref id-8498 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref id-8498 1)) - #f))) - tmp-8494) - #f) - (@apply - (lambda (id-8526 val-8527) - (let ((n-8528 (id-var-name-4280 id-8526 w-8490)) - (id-mod-8529 - (if (if (vector? id-8526) - (if (= (vector-length id-8526) 4) - (eq? (vector-ref id-8526 0) 'syntax-object) - #f) - #f) - (vector-ref id-8526 3) - mod-8492))) - (let ((b-8530 - (let ((t-8571 (assq n-8528 r-8489))) - (if t-8571 - (cdr t-8571) - (if (symbol? n-8528) - (let ((t-8576 - (get-global-definition-hook-4224 - n-8528 - id-mod-8529))) - (if t-8576 t-8576 '(global))) - '(displaced-lexical)))))) - (let ((key-8531 (car b-8530))) - (if (eqv? key-8531 'lexical) - (let ((name-8588 (syntax->datum id-8526)) - (var-8589 (cdr b-8530)) - (exp-8590 - (call-with-values - (lambda () - (syntax-type-4296 - val-8527 - r-8489 - w-8490 - (let ((props-8611 - (source-properties - (if (if (vector? val-8527) - (if (= (vector-length - val-8527) - 4) - (eq? (vector-ref - val-8527 - 0) - 'syntax-object) - #f) - #f) - (vector-ref val-8527 1) - val-8527)))) - (if (pair? props-8611) - props-8611 - #f)) - #f - mod-8492 - #f)) - (lambda (type-8644 - value-8645 - form-8646 - e-8647 - w-8648 - s-8649 - mod-8650) - (expand-expr-4298 - type-8644 - value-8645 - form-8646 - e-8647 - r-8489 - w-8648 - s-8649 - mod-8650))))) - (begin - (if (if (struct? exp-8590) - (eq? (struct-vtable exp-8590) - (vector-ref %expanded-vtables 13)) - #f) - (let ((meta-8662 (struct-ref exp-8590 1))) - (if (not (assq 'name meta-8662)) - (let ((v-8669 - (cons (cons 'name name-8588) - meta-8662))) - (struct-set! exp-8590 1 v-8669))))) - (make-struct/no-tail - (vector-ref %expanded-vtables 4) - s-8491 - name-8588 - var-8589 - exp-8590))) - (if (eqv? key-8531 'global) - (let ((exp-8685 - (call-with-values - (lambda () - (syntax-type-4296 - val-8527 - r-8489 - w-8490 - (let ((props-8707 - (source-properties - (if (if (vector? val-8527) - (if (= (vector-length - val-8527) - 4) - (eq? (vector-ref - val-8527 - 0) - 'syntax-object) - #f) - #f) - (vector-ref val-8527 1) - val-8527)))) - (if (pair? props-8707) - props-8707 - #f)) - #f - mod-8492 - #f)) - (lambda (type-8740 - value-8741 - form-8742 - e-8743 - w-8744 - s-8745 - mod-8746) - (expand-expr-4298 - type-8740 - value-8741 - form-8742 - e-8743 - r-8489 - w-8744 - s-8745 - mod-8746))))) - (begin - (if (if (struct? exp-8685) - (eq? (struct-vtable exp-8685) - (vector-ref %expanded-vtables 13)) - #f) - (let ((meta-8758 (struct-ref exp-8685 1))) - (if (not (assq 'name meta-8758)) - (let ((v-8765 - (cons (cons 'name n-8528) - meta-8758))) - (struct-set! exp-8685 1 v-8765))))) - (analyze-variable-4233 - id-mod-8529 - n-8528 - (lambda (mod-8773 var-8774 public?-8775) - (make-struct/no-tail - (vector-ref %expanded-vtables 6) - s-8491 - mod-8773 - var-8774 - public?-8775 - exp-8685)) - (lambda (var-8784) - (make-struct/no-tail - (vector-ref %expanded-vtables 8) - s-8491 - var-8784 - exp-8685))))) - (if (eqv? key-8531 'macro) - (let ((p-8794 (cdr b-8530))) - (if (procedure-property - p-8794 - 'variable-transformer) - (let ((e-8799 - (expand-macro-4300 - p-8794 - e-8488 - r-8489 - w-8490 - s-8491 - #f - mod-8492))) - (call-with-values - (lambda () - (syntax-type-4296 - e-8799 - r-8489 - '(()) - (let ((props-8810 - (source-properties - (if (if (vector? e-8799) - (if (= (vector-length - e-8799) - 4) - (eq? (vector-ref - e-8799 - 0) - 'syntax-object) - #f) - #f) - (vector-ref e-8799 1) - e-8799)))) - (if (pair? props-8810) - props-8810 - #f)) - #f - mod-8492 - #f)) - (lambda (type-8833 - value-8834 - form-8835 - e-8836 - w-8837 - s-8838 - mod-8839) - (expand-expr-4298 - type-8833 - value-8834 - form-8835 - e-8836 - r-8489 - w-8837 - s-8838 - mod-8839)))) - (syntax-violation - 'set! - "not a variable transformer" - (wrap-4290 e-8488 w-8490 mod-8492) - (wrap-4290 id-8526 w-8490 id-mod-8529)))) - (if (eqv? key-8531 'displaced-lexical) - (syntax-violation - 'set! - "identifier out of context" - (wrap-4290 id-8526 w-8490 mod-8492)) - (syntax-violation - 'set! - "bad set!" - (wrap-4290 - (begin - (if (if s-8491 - (supports-source-properties? - e-8488) - #f) - (set-source-properties! e-8488 s-8491)) - e-8488) - w-8490 - mod-8492)))))))))) - tmp-8494) - (let ((tmp-8874 - ($sc-dispatch e-8488 '(_ (any . each-any) any)))) - (if tmp-8874 - (@apply - (lambda (head-8878 tail-8879 val-8880) - (call-with-values - (lambda () - (syntax-type-4296 - head-8878 - r-8489 - '(()) - #f - #f - mod-8492 - #t)) - (lambda (type-8883 - value-8884 - formform-8885 - ee-8886 - ww-8887 - ss-8888 - modmod-8889) - (if (eqv? type-8883 'module-ref) - (let ((val-8895 - (call-with-values - (lambda () - (syntax-type-4296 - val-8880 - r-8489 - w-8490 - (let ((props-8962 - (source-properties - (if (if (vector? val-8880) - (if (= (vector-length - val-8880) - 4) - (eq? (vector-ref - val-8880 - 0) - 'syntax-object) - #f) - #f) - (vector-ref val-8880 1) - val-8880)))) - (if (pair? props-8962) - props-8962 - #f)) - #f - mod-8492 - #f)) - (lambda (type-8995 - value-8996 - form-8997 - e-8998 - w-8999 - s-9000 - mod-9001) - (expand-expr-4298 - type-8995 - value-8996 - form-8997 - e-8998 - r-8489 - w-8999 - s-9000 - mod-9001))))) - (call-with-values - (lambda () - (value-8884 - (cons head-8878 tail-8879) - r-8489 - w-8490)) - (lambda (e-8896 r-8897 w-8898 s*-8899 mod-8900) - (let ((tmp-8902 (list e-8896))) - (if (@apply - (lambda (e-8904) - (if (symbol? e-8904) - #t - (if (if (vector? e-8904) - (if (= (vector-length - e-8904) - 4) - (eq? (vector-ref - e-8904 - 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref e-8904 1)) - #f))) - tmp-8902) - (@apply - (lambda (e-8934) - (let ((var-8939 - (syntax->datum e-8934))) - (begin - (if (if (struct? val-8895) - (eq? (struct-vtable - val-8895) - (vector-ref - %expanded-vtables - 13)) - #f) - (let ((meta-9017 - (struct-ref - val-8895 - 1))) - (if (not (assq 'name - meta-9017)) - (let ((v-9026 - (cons (cons 'name - var-8939) - meta-9017))) - (struct-set! - val-8895 - 1 - v-9026))))) - (analyze-variable-4233 - mod-8900 - var-8939 - (lambda (mod-9032 - var-9033 - public?-9034) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 6) - s-8491 - mod-9032 - var-9033 - public?-9034 - val-8895)) - (lambda (var-9045) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 8) - s-8491 - var-9045 - val-8895)))))) - tmp-8902) - (syntax-violation - #f - "source expression failed to match any pattern" - e-8896)))))) - (let ((fun-exp-9061 - (let ((e-9069 - (list '#(syntax-object - setter - ((top) - #(ribcage () () ()) - #(ribcage - #(key) - #((m-*-3526 top)) - #("l-*-3527")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(type - value - formform - ee - ww - ss - modmod) - #((top) - (top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-3519" - "l-*-3520" - "l-*-3521" - "l-*-3522" - "l-*-3523" - "l-*-3524" - "l-*-3525")) - #(ribcage - #(head tail val) - #((top) (top) (top)) - #("l-*-3504" - "l-*-3505" - "l-*-3506")) - #(ribcage () () ()) - #(ribcage - #(e r w s mod) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-3473" - "l-*-3474" - "l-*-3475" - "l-*-3476" - "l-*-3477")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)) - head-8878))) - (call-with-values - (lambda () - (syntax-type-4296 - e-9069 - r-8489 - w-8490 - (let ((props-9079 - (source-properties - (if (if (vector? e-9069) - (if (= (vector-length - e-9069) - 4) - (eq? (vector-ref - e-9069 - 0) - 'syntax-object) - #f) - #f) - (vector-ref e-9069 1) - e-9069)))) - (if (pair? props-9079) - props-9079 - #f)) - #f - mod-8492 - #f)) - (lambda (type-9102 - value-9103 - form-9104 - e-9105 - w-9106 - s-9107 - mod-9108) - (expand-expr-4298 - type-9102 - value-9103 - form-9104 - e-9105 - r-8489 - w-9106 - s-9107 - mod-9108))))) - (arg-exps-9062 - (map (lambda (e-9112) - (call-with-values - (lambda () - (syntax-type-4296 - e-9112 - r-8489 - w-8490 - (let ((props-9127 - (source-properties - (if (if (vector? - e-9112) - (if (= (vector-length - e-9112) - 4) - (eq? (vector-ref - e-9112 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - e-9112 - 1) - e-9112)))) - (if (pair? props-9127) - props-9127 - #f)) - #f - mod-8492 - #f)) - (lambda (type-9160 - value-9161 - form-9162 - e-9163 - w-9164 - s-9165 - mod-9166) - (expand-expr-4298 - type-9160 - value-9161 - form-9162 - e-9163 - r-8489 - w-9164 - s-9165 - mod-9166)))) - (append tail-8879 (list val-8880))))) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) - s-8491 - fun-exp-9061 - arg-exps-9062)))))) - tmp-8874) - (syntax-violation - 'set! - "bad set!" - (wrap-4290 - (begin - (if (if s-8491 - (supports-source-properties? e-8488) - #f) - (set-source-properties! e-8488 s-8491)) - e-8488) - w-8490 - mod-8492)))))))) - (module-define! - (current-module) - '@ - (make-syntax-transformer - '@ - 'module-ref - (lambda (e-9208 r-9209 w-9210) - (let ((tmp-9212 - ($sc-dispatch e-9208 '(_ each-any any)))) - (if (if tmp-9212 - (@apply - (lambda (mod-9215 id-9216) - (if (and-map id?-4261 mod-9215) - (if (symbol? id-9216) - #t - (if (if (vector? id-9216) - (if (= (vector-length id-9216) 4) - (eq? (vector-ref id-9216 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref id-9216 1)) - #f)) - #f)) - tmp-9212) - #f) - (@apply - (lambda (mod-9256 id-9257) - (values - (syntax->datum id-9257) - r-9209 - w-9210 - #f - (syntax->datum - (cons '#(syntax-object - public - ((top) - #(ribcage - #(mod id) - #((top) (top)) - #("l-*-3566" "l-*-3567")) - #(ribcage () () ()) - #(ribcage - #(e r w) - #((top) (top) (top)) - #("l-*-3554" "l-*-3555" "l-*-3556")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" "l-*-46" "l-*-45"))) - (hygiene guile)) - mod-9256)))) - tmp-9212) - (syntax-violation - #f - "source expression failed to match any pattern" - e-9208)))))) - (global-extend-4259 - 'module-ref - '@@ - (lambda (e-9368 r-9369 w-9370) - (letrec* - ((remodulate-9371 - (lambda (x-9433 mod-9434) - (if (pair? x-9433) - (cons (remodulate-9371 (car x-9433) mod-9434) - (remodulate-9371 (cdr x-9433) mod-9434)) - (if (if (vector? x-9433) - (if (= (vector-length x-9433) 4) - (eq? (vector-ref x-9433 0) 'syntax-object) - #f) - #f) - (let ((expression-9448 - (remodulate-9371 (vector-ref x-9433 1) mod-9434)) - (wrap-9449 (vector-ref x-9433 2))) - (vector - 'syntax-object - expression-9448 - wrap-9449 - mod-9434)) - (if (vector? x-9433) - (let ((n-9457 (vector-length x-9433))) - (let ((v-9458 (make-vector n-9457))) - (letrec* - ((loop-9459 - (lambda (i-9506) - (if (= i-9506 n-9457) - v-9458 - (begin - (vector-set! - v-9458 - i-9506 - (remodulate-9371 - (vector-ref x-9433 i-9506) - mod-9434)) - (loop-9459 (#{1+}# i-9506))))))) - (loop-9459 0)))) - x-9433)))))) - (let ((tmp-9373 - ($sc-dispatch e-9368 '(_ each-any any)))) - (if (if tmp-9373 - (@apply - (lambda (mod-9377 exp-9378) - (and-map id?-4261 mod-9377)) - tmp-9373) - #f) - (@apply - (lambda (mod-9394 exp-9395) - (let ((mod-9396 - (syntax->datum - (cons '#(syntax-object - private - ((top) - #(ribcage - #(mod exp) - #((top) (top)) - #("l-*-3604" "l-*-3605")) - #(ribcage - (remodulate) - ((top)) - ("l-*-3577")) - #(ribcage - #(e r w) - #((top) (top) (top)) - #("l-*-3574" "l-*-3575" "l-*-3576")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" "l-*-46" "l-*-45"))) - (hygiene guile)) - mod-9394)))) - (values - (remodulate-9371 exp-9395 mod-9396) - r-9369 - w-9370 - (let ((props-9404 - (source-properties - (if (if (vector? exp-9395) - (if (= (vector-length exp-9395) 4) - (eq? (vector-ref exp-9395 0) - 'syntax-object) - #f) - #f) - (vector-ref exp-9395 1) - exp-9395)))) - (if (pair? props-9404) props-9404 #f)) - mod-9396))) - tmp-9373) - (syntax-violation - #f - "source expression failed to match any pattern" - e-9368)))))) - (global-extend-4259 - 'core - 'if - (lambda (e-9750 r-9751 w-9752 s-9753 mod-9754) - (let ((tmp-9756 ($sc-dispatch e-9750 '(_ any any)))) - (if tmp-9756 - (@apply - (lambda (test-9760 then-9761) - (let ((test-exp-9766 - (call-with-values - (lambda () - (syntax-type-4296 - test-9760 - r-9751 - w-9752 - (let ((props-9788 - (source-properties - (if (if (vector? test-9760) - (if (= (vector-length - test-9760) - 4) - (eq? (vector-ref test-9760 0) - 'syntax-object) - #f) - #f) - (vector-ref test-9760 1) - test-9760)))) - (if (pair? props-9788) props-9788 #f)) - #f - mod-9754 - #f)) - (lambda (type-9821 - value-9822 - form-9823 - e-9824 - w-9825 - s-9826 - mod-9827) - (expand-expr-4298 - type-9821 - value-9822 - form-9823 - e-9824 - r-9751 - w-9825 - s-9826 - mod-9827)))) - (then-exp-9767 - (call-with-values - (lambda () - (syntax-type-4296 - then-9761 - r-9751 - w-9752 - (let ((props-9845 - (source-properties - (if (if (vector? then-9761) - (if (= (vector-length - then-9761) - 4) - (eq? (vector-ref then-9761 0) - 'syntax-object) - #f) - #f) - (vector-ref then-9761 1) - then-9761)))) - (if (pair? props-9845) props-9845 #f)) - #f - mod-9754 - #f)) - (lambda (type-9878 - value-9879 - form-9880 - e-9881 - w-9882 - s-9883 - mod-9884) - (expand-expr-4298 - type-9878 - value-9879 - form-9880 - e-9881 - r-9751 - w-9882 - s-9883 - mod-9884)))) - (else-exp-9768 - (make-struct/no-tail - (vector-ref %expanded-vtables 0) - #f))) - (make-struct/no-tail - (vector-ref %expanded-vtables 10) - s-9753 - test-exp-9766 - then-exp-9767 - else-exp-9768))) - tmp-9756) - (let ((tmp-9893 ($sc-dispatch e-9750 '(_ any any any)))) - (if tmp-9893 - (@apply - (lambda (test-9897 then-9898 else-9899) - (let ((test-exp-9904 - (call-with-values - (lambda () - (syntax-type-4296 - test-9897 - r-9751 - w-9752 - (let ((props-9926 - (source-properties - (if (if (vector? test-9897) - (if (= (vector-length - test-9897) - 4) - (eq? (vector-ref - test-9897 - 0) - 'syntax-object) - #f) - #f) - (vector-ref test-9897 1) - test-9897)))) - (if (pair? props-9926) props-9926 #f)) - #f - mod-9754 - #f)) - (lambda (type-9959 - value-9960 - form-9961 - e-9962 - w-9963 - s-9964 - mod-9965) - (expand-expr-4298 - type-9959 - value-9960 - form-9961 - e-9962 - r-9751 - w-9963 - s-9964 - mod-9965)))) - (then-exp-9905 - (call-with-values - (lambda () - (syntax-type-4296 - then-9898 - r-9751 - w-9752 - (let ((props-9983 - (source-properties - (if (if (vector? then-9898) - (if (= (vector-length - then-9898) - 4) - (eq? (vector-ref - then-9898 - 0) - 'syntax-object) - #f) - #f) - (vector-ref then-9898 1) - then-9898)))) - (if (pair? props-9983) props-9983 #f)) - #f - mod-9754 - #f)) - (lambda (type-10016 - value-10017 - form-10018 - e-10019 - w-10020 - s-10021 - mod-10022) - (expand-expr-4298 - type-10016 - value-10017 - form-10018 - e-10019 - r-9751 - w-10020 - s-10021 - mod-10022)))) - (else-exp-9906 - (call-with-values - (lambda () - (syntax-type-4296 - else-9899 - r-9751 - w-9752 - (let ((props-10040 - (source-properties - (if (if (vector? else-9899) - (if (= (vector-length - else-9899) - 4) - (eq? (vector-ref - else-9899 - 0) - 'syntax-object) - #f) - #f) - (vector-ref else-9899 1) - else-9899)))) - (if (pair? props-10040) props-10040 #f)) - #f - mod-9754 - #f)) - (lambda (type-10073 - value-10074 - form-10075 - e-10076 - w-10077 - s-10078 - mod-10079) - (expand-expr-4298 - type-10073 - value-10074 - form-10075 - e-10076 - r-9751 - w-10077 - s-10078 - mod-10079))))) - (make-struct/no-tail - (vector-ref %expanded-vtables 10) - s-9753 - test-exp-9904 - then-exp-9905 - else-exp-9906))) - tmp-9893) - (syntax-violation - #f - "source expression failed to match any pattern" - e-9750))))))) - (module-define! - (current-module) - 'with-fluids - (make-syntax-transformer - 'with-fluids - 'core - (lambda (e-10102 r-10103 w-10104 s-10105 mod-10106) - (let ((tmp-10108 - ($sc-dispatch - e-10102 - '(_ #(each (any any)) any . each-any)))) - (if tmp-10108 - (@apply - (lambda (fluid-10111 val-10112 b-10113 b*-10114) - (let ((fluids-10117 - (map (lambda (x-10125) - (call-with-values - (lambda () - (syntax-type-4296 - x-10125 - r-10103 - w-10104 - (let ((props-10140 - (source-properties - (if (if (vector? x-10125) - (if (= (vector-length - x-10125) - 4) - (eq? (vector-ref - x-10125 - 0) - 'syntax-object) - #f) - #f) - (vector-ref x-10125 1) - x-10125)))) - (if (pair? props-10140) - props-10140 - #f)) - #f - mod-10106 - #f)) - (lambda (type-10173 - value-10174 - form-10175 - e-10176 - w-10177 - s-10178 - mod-10179) - (expand-expr-4298 - type-10173 - value-10174 - form-10175 - e-10176 - r-10103 - w-10177 - s-10178 - mod-10179)))) - fluid-10111)) - (vals-10118 - (map (lambda (x-10183) - (call-with-values - (lambda () - (syntax-type-4296 - x-10183 - r-10103 - w-10104 - (let ((props-10198 - (source-properties - (if (if (vector? x-10183) - (if (= (vector-length - x-10183) - 4) - (eq? (vector-ref - x-10183 - 0) - 'syntax-object) - #f) - #f) - (vector-ref x-10183 1) - x-10183)))) - (if (pair? props-10198) - props-10198 - #f)) - #f - mod-10106 - #f)) - (lambda (type-10231 - value-10232 - form-10233 - e-10234 - w-10235 - s-10236 - mod-10237) - (expand-expr-4298 - type-10231 - value-10232 - form-10233 - e-10234 - r-10103 - w-10235 - s-10236 - mod-10237)))) - val-10112)) - (body-10119 - (expand-body-4301 - (cons b-10113 b*-10114) - (wrap-4290 - (begin - (if (if s-10105 - (supports-source-properties? e-10102) - #f) - (set-source-properties! e-10102 s-10105)) - e-10102) - w-10104 - mod-10106) - r-10103 - w-10104 - mod-10106))) - (make-struct/no-tail - (vector-ref %expanded-vtables 17) - s-10105 - fluids-10117 - vals-10118 - body-10119))) - tmp-10108) - (syntax-violation - #f - "source expression failed to match any pattern" - e-10102)))))) - (module-define! - (current-module) - 'begin - (make-syntax-transformer 'begin 'begin '())) - (module-define! - (current-module) - 'define - (make-syntax-transformer 'define 'define '())) - (module-define! - (current-module) - 'define-syntax - (make-syntax-transformer - 'define-syntax - 'define-syntax - '())) - (module-define! - (current-module) - 'define-syntax-parameter - (make-syntax-transformer - 'define-syntax-parameter - 'define-syntax-parameter - '())) - (module-define! - (current-module) - 'eval-when - (make-syntax-transformer - 'eval-when - 'eval-when - '())) - (global-extend-4259 - 'core - 'syntax-case - (letrec* - ((convert-pattern-10535 - (lambda (pattern-12018 keys-12019) - (letrec* - ((cvt*-12020 - (lambda (p*-12644 n-12645 ids-12646) - (if (not (pair? p*-12644)) - (cvt-12022 p*-12644 n-12645 ids-12646) - (call-with-values - (lambda () - (cvt*-12020 (cdr p*-12644) n-12645 ids-12646)) - (lambda (y-12649 ids-12650) - (call-with-values - (lambda () - (cvt-12022 (car p*-12644) n-12645 ids-12650)) - (lambda (x-12653 ids-12654) - (values - (cons x-12653 y-12649) - ids-12654)))))))) - (v-reverse-12021 - (lambda (x-12655) - (letrec* - ((loop-12656 - (lambda (r-12736 x-12737) - (if (not (pair? x-12737)) - (values r-12736 x-12737) - (loop-12656 - (cons (car x-12737) r-12736) - (cdr x-12737)))))) - (loop-12656 '() x-12655)))) - (cvt-12022 - (lambda (p-12025 n-12026 ids-12027) - (if (if (symbol? p-12025) - #t - (if (if (vector? p-12025) - (if (= (vector-length p-12025) 4) - (eq? (vector-ref p-12025 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref p-12025 1)) - #f)) - (if (bound-id-member?-4289 p-12025 keys-12019) - (values (vector 'free-id p-12025) ids-12027) - (if (if (eq? (if (if (vector? p-12025) - (if (= (vector-length p-12025) 4) - (eq? (vector-ref p-12025 0) - 'syntax-object) - #f) - #f) - (vector-ref p-12025 1) - p-12025) - (if (if (= (vector-length - '#(syntax-object - _ - ((top) - #(ribcage () () ()) - #(ribcage - #(p n ids) - #((top) (top) (top)) - #("l-*-3705" - "l-*-3706" - "l-*-3707")) - #(ribcage - (cvt v-reverse cvt*) - ((top) (top) (top)) - ("l-*-3678" - "l-*-3676" - "l-*-3674")) - #(ribcage - #(pattern keys) - #((top) (top)) - #("l-*-3672" - "l-*-3673")) - #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) - (top) - (top) - (top)) - ("l-*-3668" - "l-*-3666" - "l-*-3664" - "l-*-3662")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile))) - 4) - #t - #f) - '_ - '#(syntax-object - _ - ((top) - #(ribcage () () ()) - #(ribcage - #(p n ids) - #((top) (top) (top)) - #("l-*-3705" - "l-*-3706" - "l-*-3707")) - #(ribcage - (cvt v-reverse cvt*) - ((top) (top) (top)) - ("l-*-3678" - "l-*-3676" - "l-*-3674")) - #(ribcage - #(pattern keys) - #((top) (top)) - #("l-*-3672" "l-*-3673")) - #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) (top) (top) (top)) - ("l-*-3668" - "l-*-3666" - "l-*-3664" - "l-*-3662")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" "l-*-46" "l-*-45"))) - (hygiene guile)))) - (eq? (id-var-name-4280 p-12025 '(())) - (id-var-name-4280 - '#(syntax-object - _ - ((top) - #(ribcage () () ()) - #(ribcage - #(p n ids) - #((top) (top) (top)) - #("l-*-3705" - "l-*-3706" - "l-*-3707")) - #(ribcage - (cvt v-reverse cvt*) - ((top) (top) (top)) - ("l-*-3678" - "l-*-3676" - "l-*-3674")) - #(ribcage - #(pattern keys) - #((top) (top)) - #("l-*-3672" "l-*-3673")) - #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) (top) (top) (top)) - ("l-*-3668" - "l-*-3666" - "l-*-3664" - "l-*-3662")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" "l-*-46" "l-*-45"))) - (hygiene guile)) - '(()))) - #f) - (values '_ ids-12027) - (values - 'any - (cons (cons p-12025 n-12026) ids-12027)))) - (let ((tmp-12347 ($sc-dispatch p-12025 '(any any)))) - (if (if tmp-12347 - (@apply - (lambda (x-12351 dots-12352) - (if (if (if (vector? dots-12352) - (if (= (vector-length dots-12352) - 4) - (eq? (vector-ref dots-12352 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref dots-12352 1)) - #f) - (if (eq? (if (if (vector? dots-12352) - (if (= (vector-length - dots-12352) - 4) - (eq? (vector-ref - dots-12352 - 0) - 'syntax-object) - #f) - #f) - (vector-ref dots-12352 1) - dots-12352) - (if (if (= (vector-length - '#(syntax-object - ... - ((top) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) - (top) - (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene - guile))) - 4) - #t - #f) - '... - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)))) - (eq? (id-var-name-4280 - dots-12352 - '(())) - (id-var-name-4280 - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)) - '(()))) - #f) - #f)) - tmp-12347) - #f) - (@apply - (lambda (x-12452 dots-12453) - (call-with-values - (lambda () - (cvt-12022 - x-12452 - (#{1+}# n-12026) - ids-12027)) - (lambda (p-12454 ids-12455) - (values - (if (eq? p-12454 'any) - 'each-any - (vector 'each p-12454)) - ids-12455)))) - tmp-12347) - (let ((tmp-12456 - ($sc-dispatch p-12025 '(any any . any)))) - (if (if tmp-12456 - (@apply - (lambda (x-12460 dots-12461 ys-12462) - (if (if (if (vector? dots-12461) - (if (= (vector-length - dots-12461) - 4) - (eq? (vector-ref - dots-12461 - 0) - 'syntax-object) - #f) - #f) - (symbol? - (vector-ref dots-12461 1)) - #f) - (if (eq? (if (if (vector? dots-12461) - (if (= (vector-length - dots-12461) - 4) - (eq? (vector-ref - dots-12461 - 0) - 'syntax-object) - #f) - #f) - (vector-ref dots-12461 1) - dots-12461) - (if (if (= (vector-length - '#(syntax-object - ... - ((top) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) - (top) - (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene - guile))) - 4) - #t - #f) - '... - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)))) - (eq? (id-var-name-4280 - dots-12461 - '(())) - (id-var-name-4280 - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)) - '(()))) - #f) - #f)) - tmp-12456) - #f) - (@apply - (lambda (x-12562 dots-12563 ys-12564) - (call-with-values - (lambda () - (cvt*-12020 - ys-12564 - n-12026 - ids-12027)) - (lambda (ys-12567 ids-12568) - (call-with-values - (lambda () - (cvt-12022 - x-12562 - (#{1+}# n-12026) - ids-12568)) - (lambda (x-12569 ids-12570) - (call-with-values - (lambda () - (v-reverse-12021 ys-12567)) - (lambda (ys-12603 e-12604) - (values - (vector - 'each+ - x-12569 - ys-12603 - e-12604) - ids-12570)))))))) - tmp-12456) - (let ((tmp-12605 - ($sc-dispatch p-12025 '(any . any)))) - (if tmp-12605 - (@apply - (lambda (x-12609 y-12610) - (call-with-values - (lambda () - (cvt-12022 - y-12610 - n-12026 - ids-12027)) - (lambda (y-12611 ids-12612) - (call-with-values - (lambda () - (cvt-12022 - x-12609 - n-12026 - ids-12612)) - (lambda (x-12613 ids-12614) - (values - (cons x-12613 y-12611) - ids-12614)))))) - tmp-12605) - (let ((tmp-12615 - ($sc-dispatch p-12025 '()))) - (if tmp-12615 - (@apply - (lambda () (values '() ids-12027)) - tmp-12615) - (let ((tmp-12619 - ($sc-dispatch - p-12025 - '#(vector each-any)))) - (if tmp-12619 - (@apply - (lambda (x-12623) - (call-with-values - (lambda () - (cvt-12022 - x-12623 - n-12026 - ids-12027)) - (lambda (p-12624 ids-12625) - (values - (vector 'vector p-12624) - ids-12625)))) - tmp-12619) - (values - (vector - 'atom - (strip-4310 p-12025 '(()))) - ids-12027))))))))))))))) - (cvt-12022 pattern-12018 0 '())))) - (build-dispatch-call-10536 - (lambda (pvars-12738 exp-12739 y-12740 r-12741 mod-12742) - (let ((ids-12743 (map car pvars-12738))) - (begin - (map cdr pvars-12738) - (let ((labels-12745 (gen-labels-4264 ids-12743)) - (new-vars-12746 (map gen-var-4311 ids-12743))) - (build-application-4228 - #f - (if (equal? (module-name (current-module)) '(guile)) - (make-struct/no-tail - (vector-ref %expanded-vtables 7) - #f - 'apply) - (make-struct/no-tail - (vector-ref %expanded-vtables 5) - #f - '(guile) - 'apply - #f)) - (list (build-simple-lambda-4237 - #f - (map syntax->datum ids-12743) - #f - new-vars-12746 - '() - (expand-4297 - exp-12739 - (extend-env-4255 - labels-12745 - (map (lambda (var-13069 level-13070) - (cons 'syntax - (cons var-13069 level-13070))) - new-vars-12746 - (map cdr pvars-12738)) - r-12741) - (make-binding-wrap-4275 - ids-12743 - labels-12745 - '(())) - mod-12742)) - y-12740))))))) - (gen-clause-10537 - (lambda (x-11400 - keys-11401 - clauses-11402 - r-11403 - pat-11404 - fender-11405 - exp-11406 - mod-11407) + (list 'tmp) + #f + (list x) + '() + (gen-syntax-case + (build-lexical-reference 'value #f 'tmp x) + key + m + r + mod)) + (list (expand val r '(()) mod)))) + (syntax-violation 'syntax-case "invalid literals list" e))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))))) + (set! macroexpand + (lambda* (x #:optional (m 'e) (esew '(eval))) + (expand-top-sequence + (list x) + '() + '((top)) + #f + m + esew + (cons 'hygiene (module-name (current-module)))))) + (set! identifier? (lambda (x) (nonsymbol-id? x))) + (set! datum->syntax + (lambda (id datum) + (make-syntax-object + datum + (syntax-object-wrap id) + (syntax-object-module id)))) + (set! syntax->datum (lambda (x) (strip x '(())))) + (set! syntax-source (lambda (x) (source-annotation x))) + (set! generate-temporaries + (lambda (ls) + (let ((x ls)) + (if (not (list? x)) + (syntax-violation 'generate-temporaries "invalid argument" x))) + (let ((mod (cons 'hygiene (module-name (current-module))))) + (map (lambda (x) (wrap (gensym "t-") '((top)) mod)) ls)))) + (set! free-identifier=? + (lambda (x y) + (let ((x x)) + (if (not (nonsymbol-id? x)) + (syntax-violation 'free-identifier=? "invalid argument" x))) + (let ((x y)) + (if (not (nonsymbol-id? x)) + (syntax-violation 'free-identifier=? "invalid argument" x))) + (free-id=? x y))) + (set! bound-identifier=? + (lambda (x y) + (let ((x x)) + (if (not (nonsymbol-id? x)) + (syntax-violation 'bound-identifier=? "invalid argument" x))) + (let ((x y)) + (if (not (nonsymbol-id? x)) + (syntax-violation 'bound-identifier=? "invalid argument" x))) + (bound-id=? x y))) + (set! syntax-violation + (lambda* (who message form #:optional (subform #f)) + (let ((x who)) + (if (not (let ((x x)) (or (not x) (string? x) (symbol? x)))) + (syntax-violation 'syntax-violation "invalid argument" x))) + (let ((x message)) + (if (not (string? x)) + (syntax-violation 'syntax-violation "invalid argument" x))) + (throw 'syntax-error + who + message + (or (source-annotation subform) (source-annotation form)) + (strip form '(())) + (and subform (strip subform '(())))))) + (letrec* + ((syntax-module + (lambda (id) + (let ((x id)) + (if (not (nonsymbol-id? x)) + (syntax-violation 'syntax-module "invalid argument" x))) + (cdr (syntax-object-module id)))) + (syntax-local-binding + (lambda (id) + (let ((x id)) + (if (not (nonsymbol-id? x)) + (syntax-violation 'syntax-local-binding "invalid argument" x))) + (with-transformer-environment + (lambda (e r w s rib mod) + (letrec* + ((strip-anti-mark + (lambda (w) + (let ((ms (car w)) (s (cdr w))) + (if (and (pair? ms) (eq? (car ms) #f)) + (cons (cdr ms) (if rib (cons rib (cdr s)) (cdr s))) + (cons ms (if rib (cons rib s) s))))))) (call-with-values (lambda () - (convert-pattern-10535 pat-11404 keys-11401)) - (lambda (p-11562 pvars-11563) - (if (not (distinct-bound-ids?-4288 (map car pvars-11563))) - (syntax-violation - 'syntax-case - "duplicate pattern variable" - pat-11404) - (if (not (and-map - (lambda (x-11679) - (not (let ((x-11683 (car x-11679))) - (if (if (if (vector? x-11683) - (if (= (vector-length - x-11683) - 4) - (eq? (vector-ref - x-11683 - 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref x-11683 1)) - #f) - (if (eq? (if (if (vector? x-11683) - (if (= (vector-length - x-11683) - 4) - (eq? (vector-ref - x-11683 - 0) - 'syntax-object) - #f) - #f) - (vector-ref x-11683 1) - x-11683) - (if (if (= (vector-length - '#(syntax-object - ... - ((top) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) - (top) - (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene - guile))) - 4) - #t - #f) - '... - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)))) - (eq? (id-var-name-4280 - x-11683 - '(())) - (id-var-name-4280 - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)) - '(()))) - #f) - #f)))) - pvars-11563)) - (syntax-violation - 'syntax-case - "misplaced ellipsis" - pat-11404) - (let ((y-11759 - (gensym - (string-append (symbol->string 'tmp) "-")))) - (build-application-4228 - #f - (let ((req-11897 (list 'tmp)) - (vars-11899 (list y-11759)) - (exp-11901 - (let ((y-11918 - (make-struct/no-tail - (vector-ref %expanded-vtables 3) - #f - 'tmp - y-11759))) - (let ((test-exp-11922 - (let ((tmp-11931 - ($sc-dispatch - fender-11405 - '#(atom #t)))) - (if tmp-11931 - (@apply - (lambda () y-11918) - tmp-11931) - (let ((then-exp-11946 - (build-dispatch-call-10536 - pvars-11563 - fender-11405 - y-11918 - r-11403 - mod-11407)) - (else-exp-11947 - (make-struct/no-tail - (vector-ref - %expanded-vtables - 1) - #f - #f))) - (make-struct/no-tail - (vector-ref - %expanded-vtables - 10) - #f - y-11918 - then-exp-11946 - else-exp-11947))))) - (then-exp-11923 - (build-dispatch-call-10536 - pvars-11563 - exp-11406 - y-11918 - r-11403 - mod-11407)) - (else-exp-11924 - (gen-syntax-case-10538 - x-11400 - keys-11401 - clauses-11402 - r-11403 - mod-11407))) - (make-struct/no-tail - (vector-ref %expanded-vtables 10) - #f - test-exp-11922 - then-exp-11923 - else-exp-11924))))) - (let ((body-11906 - (make-struct/no-tail - (vector-ref %expanded-vtables 14) - #f - req-11897 - #f - #f - #f - '() - vars-11899 - exp-11901 - #f))) - (make-struct/no-tail - (vector-ref %expanded-vtables 13) - #f - '() - body-11906))) - (list (if (eq? p-11562 'any) - (let ((fun-exp-11967 - (if (equal? - (module-name (current-module)) - '(guile)) - (make-struct/no-tail - (vector-ref %expanded-vtables 7) - #f - 'list) - (make-struct/no-tail - (vector-ref %expanded-vtables 5) - #f - '(guile) - 'list - #f))) - (arg-exps-11968 (list x-11400))) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) - #f - fun-exp-11967 - arg-exps-11968)) - (let ((fun-exp-11991 - (if (equal? - (module-name (current-module)) - '(guile)) - (make-struct/no-tail - (vector-ref %expanded-vtables 7) - #f - '$sc-dispatch) - (make-struct/no-tail - (vector-ref %expanded-vtables 5) - #f - '(guile) - '$sc-dispatch - #f))) - (arg-exps-11992 - (list x-11400 - (make-struct/no-tail - (vector-ref - %expanded-vtables - 1) - #f - p-11562)))) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) - #f - fun-exp-11991 - arg-exps-11992)))))))))))) - (gen-syntax-case-10538 - (lambda (x-10821 - keys-10822 - clauses-10823 - r-10824 - mod-10825) - (if (null? clauses-10823) - (let ((fun-exp-10830 - (if (equal? (module-name (current-module)) '(guile)) - (make-struct/no-tail - (vector-ref %expanded-vtables 7) - #f - 'syntax-violation) - (make-struct/no-tail - (vector-ref %expanded-vtables 5) - #f - '(guile) - 'syntax-violation - #f))) - (arg-exps-10831 - (list (make-struct/no-tail - (vector-ref %expanded-vtables 1) - #f - #f) - (make-struct/no-tail - (vector-ref %expanded-vtables 1) - #f - "source expression failed to match any pattern") - x-10821))) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) - #f - fun-exp-10830 - arg-exps-10831)) - (let ((tmp-10864 (car clauses-10823))) - (let ((tmp-10865 ($sc-dispatch tmp-10864 '(any any)))) - (if tmp-10865 - (@apply - (lambda (pat-10867 exp-10868) - (if (if (if (symbol? pat-10867) - #t - (if (if (vector? pat-10867) - (if (= (vector-length pat-10867) 4) - (eq? (vector-ref pat-10867 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref pat-10867 1)) - #f)) - (and-map - (lambda (x-10895) - (not (if (eq? (if (if (vector? pat-10867) - (if (= (vector-length - pat-10867) - 4) - (eq? (vector-ref - pat-10867 - 0) - 'syntax-object) - #f) - #f) - (vector-ref pat-10867 1) - pat-10867) - (if (if (vector? x-10895) - (if (= (vector-length - x-10895) - 4) - (eq? (vector-ref - x-10895 - 0) - 'syntax-object) - #f) - #f) - (vector-ref x-10895 1) - x-10895)) - (eq? (id-var-name-4280 - pat-10867 - '(())) - (id-var-name-4280 - x-10895 - '(()))) - #f))) - (cons '#(syntax-object - ... - ((top) - #(ribcage - #(pat exp) - #((top) (top)) - #("l-*-3859" "l-*-3860")) - #(ribcage () () ()) - #(ribcage - #(x keys clauses r mod) - #((top) (top) (top) (top) (top)) - #("l-*-3848" - "l-*-3849" - "l-*-3850" - "l-*-3851" - "l-*-3852")) - #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) (top) (top) (top)) - ("l-*-3668" - "l-*-3666" - "l-*-3664" - "l-*-3662")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" "l-*-46" "l-*-45"))) - (hygiene guile)) - keys-10822)) - #f) - (if (if (eq? (if (if (vector? pat-10867) - (if (= (vector-length - pat-10867) - 4) - (eq? (vector-ref pat-10867 0) - 'syntax-object) - #f) - #f) - (vector-ref pat-10867 1) - pat-10867) - (if (if (= (vector-length - '#(syntax-object - _ - ((top) - #(ribcage - #(pat exp) - #((top) (top)) - #("l-*-3859" - "l-*-3860")) - #(ribcage () () ()) - #(ribcage - #(x - keys - clauses - r - mod) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-3848" - "l-*-3849" - "l-*-3850" - "l-*-3851" - "l-*-3852")) - #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) - (top) - (top) - (top)) - ("l-*-3668" - "l-*-3666" - "l-*-3664" - "l-*-3662")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) - (top) - (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile))) - 4) - #t - #f) - '_ - '#(syntax-object - _ - ((top) - #(ribcage - #(pat exp) - #((top) (top)) - #("l-*-3859" "l-*-3860")) - #(ribcage () () ()) - #(ribcage - #(x keys clauses r mod) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-3848" - "l-*-3849" - "l-*-3850" - "l-*-3851" - "l-*-3852")) - #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) (top) (top) (top)) - ("l-*-3668" - "l-*-3666" - "l-*-3664" - "l-*-3662")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)))) - (eq? (id-var-name-4280 pat-10867 '(())) - (id-var-name-4280 - '#(syntax-object - _ - ((top) - #(ribcage - #(pat exp) - #((top) (top)) - #("l-*-3859" "l-*-3860")) - #(ribcage () () ()) - #(ribcage - #(x keys clauses r mod) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-3848" - "l-*-3849" - "l-*-3850" - "l-*-3851" - "l-*-3852")) - #(ribcage - (gen-syntax-case - gen-clause - build-dispatch-call - convert-pattern) - ((top) (top) (top) (top)) - ("l-*-3668" - "l-*-3666" - "l-*-3664" - "l-*-3662")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" "l-*-46" "l-*-45"))) - (hygiene guile)) - '(()))) - #f) - (call-with-values - (lambda () - (syntax-type-4296 - exp-10868 - r-10824 - '(()) - (let ((props-11041 - (source-properties - (if (if (vector? exp-10868) - (if (= (vector-length - exp-10868) - 4) - (eq? (vector-ref - exp-10868 - 0) - 'syntax-object) - #f) - #f) - (vector-ref exp-10868 1) - exp-10868)))) - (if (pair? props-11041) props-11041 #f)) - #f - mod-10825 - #f)) - (lambda (type-11074 - value-11075 - form-11076 - e-11077 - w-11078 - s-11079 - mod-11080) - (expand-expr-4298 - type-11074 - value-11075 - form-11076 - e-11077 - r-10824 - w-11078 - s-11079 - mod-11080))) - (let ((labels-11084 - (list (string-append - "l-" - (session-id-4222) - (symbol->string (gensym "-"))))) - (var-11085 - (let ((id-11123 - (if (if (vector? pat-10867) - (if (= (vector-length - pat-10867) - 4) - (eq? (vector-ref - pat-10867 - 0) - 'syntax-object) - #f) - #f) - (vector-ref pat-10867 1) - pat-10867))) - (gensym - (string-append - (symbol->string id-11123) - "-"))))) - (build-application-4228 - #f - (build-simple-lambda-4237 - #f - (list (syntax->datum pat-10867)) - #f - (list var-11085) - '() - (expand-4297 - exp-10868 - (extend-env-4255 - labels-11084 - (list (cons 'syntax - (cons var-11085 0))) - r-10824) - (make-binding-wrap-4275 - (list pat-10867) - labels-11084 - '(())) - mod-10825)) - (list x-10821)))) - (gen-clause-10537 - x-10821 - keys-10822 - (cdr clauses-10823) - r-10824 - pat-10867 - #t - exp-10868 - mod-10825))) - tmp-10865) - (let ((tmp-11393 - ($sc-dispatch tmp-10864 '(any any any)))) - (if tmp-11393 - (@apply - (lambda (pat-11395 fender-11396 exp-11397) - (gen-clause-10537 - x-10821 - keys-10822 - (cdr clauses-10823) - r-10824 - pat-11395 - fender-11396 - exp-11397 - mod-10825)) - tmp-11393) - (syntax-violation - 'syntax-case - "invalid clause" - (car clauses-10823))))))))))) - (lambda (e-10539 r-10540 w-10541 s-10542 mod-10543) - (let ((e-10544 - (wrap-4290 - (begin - (if (if s-10542 - (supports-source-properties? e-10539) - #f) - (set-source-properties! e-10539 s-10542)) - e-10539) - w-10541 - mod-10543))) - (let ((tmp-10546 - ($sc-dispatch - e-10544 - '(_ any each-any . each-any)))) - (if tmp-10546 - (@apply - (lambda (val-10571 key-10572 m-10573) - (if (and-map - (lambda (x-10574) - (if (if (symbol? x-10574) - #t - (if (if (vector? x-10574) - (if (= (vector-length x-10574) 4) - (eq? (vector-ref x-10574 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref x-10574 1)) - #f)) - (not (if (if (if (vector? x-10574) - (if (= (vector-length x-10574) - 4) - (eq? (vector-ref x-10574 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref x-10574 1)) - #f) - (if (eq? (if (if (vector? x-10574) - (if (= (vector-length - x-10574) - 4) - (eq? (vector-ref - x-10574 - 0) - 'syntax-object) - #f) - #f) - (vector-ref x-10574 1) - x-10574) - (if (if (= (vector-length - '#(syntax-object - ... - ((top) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) - (top) - (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene - guile))) - 4) - #t - #f) - '... - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)))) - (eq? (id-var-name-4280 x-10574 '(())) - (id-var-name-4280 - '#(syntax-object - ... - ((top) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-2265")) - #(ribcage - (lambda-var-list - gen-var - strip - expand-lambda-case - lambda*-formals - expand-simple-lambda - lambda-formals - ellipsis? - expand-void - eval-local-transformer - expand-local-syntax - expand-body - expand-macro - expand-application - expand-expr - expand - syntax-type - parse-when-list - expand-install-global - expand-top-sequence - expand-sequence - source-wrap - wrap - bound-id-member? - distinct-bound-ids? - valid-bound-ids? - bound-id=? - free-id=? - with-transformer-environment - transformer-environment - resolve-identifier - locally-bound-identifiers - id-var-name - same-marks? - join-marks - join-wraps - smart-append - make-binding-wrap - extend-ribcage! - make-empty-ribcage - new-mark - anti-mark - the-anti-mark - top-marked? - top-wrap - empty-wrap - set-ribcage-labels! - set-ribcage-marks! - set-ribcage-symnames! - ribcage-labels - ribcage-marks - ribcage-symnames - ribcage? - make-ribcage - gen-labels - gen-label - make-rename - rename-marks - rename-new - rename-old - subst-rename? - wrap-subst - wrap-marks - make-wrap - id-sym-name&marks - id-sym-name - id? - nonsymbol-id? - global-extend - lookup - macros-only-env - extend-var-env - extend-env - null-env - binding-value - binding-type - make-binding - arg-check - source-annotation - no-source - set-syntax-object-module! - set-syntax-object-wrap! - set-syntax-object-expression! - syntax-object-module - syntax-object-wrap - syntax-object-expression - syntax-object? - make-syntax-object - build-lexical-var - build-letrec - build-named-let - build-let - build-sequence - build-data - build-primref - build-lambda-case - build-case-lambda - build-simple-lambda - build-global-definition - build-global-assignment - build-global-reference - analyze-variable - build-lexical-assignment - build-lexical-reference - build-dynlet - build-conditional - build-application - build-void - maybe-name-value! - decorate-source - get-global-definition-hook - put-global-definition-hook - session-id - local-eval-hook - top-level-eval-hook - fx< - fx= - fx- - fx+ - set-lambda-meta! - lambda-meta - lambda? - make-dynlet - make-letrec - make-let - make-lambda-case - make-lambda - make-sequence - make-application - make-conditional - make-toplevel-define - make-toplevel-set - make-toplevel-ref - make-module-set - make-module-ref - make-lexical-set - make-lexical-ref - make-primitive-ref - make-const - make-void) - ((top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-476" - "l-*-474" - "l-*-472" - "l-*-470" - "l-*-468" - "l-*-466" - "l-*-464" - "l-*-462" - "l-*-460" - "l-*-458" - "l-*-456" - "l-*-454" - "l-*-452" - "l-*-450" - "l-*-448" - "l-*-446" - "l-*-444" - "l-*-442" - "l-*-440" - "l-*-438" - "l-*-436" - "l-*-434" - "l-*-432" - "l-*-430" - "l-*-428" - "l-*-426" - "l-*-424" - "l-*-422" - "l-*-420" - "l-*-418" - "l-*-416" - "l-*-414" - "l-*-412" - "l-*-410" - "l-*-408" - "l-*-406" - "l-*-404" - "l-*-402" - "l-*-400" - "l-*-399" - "l-*-397" - "l-*-394" - "l-*-393" - "l-*-392" - "l-*-390" - "l-*-389" - "l-*-387" - "l-*-385" - "l-*-383" - "l-*-381" - "l-*-379" - "l-*-377" - "l-*-375" - "l-*-373" - "l-*-370" - "l-*-368" - "l-*-367" - "l-*-365" - "l-*-363" - "l-*-361" - "l-*-359" - "l-*-358" - "l-*-357" - "l-*-356" - "l-*-354" - "l-*-353" - "l-*-350" - "l-*-348" - "l-*-346" - "l-*-344" - "l-*-342" - "l-*-340" - "l-*-338" - "l-*-337" - "l-*-336" - "l-*-334" - "l-*-332" - "l-*-331" - "l-*-328" - "l-*-327" - "l-*-325" - "l-*-323" - "l-*-321" - "l-*-319" - "l-*-317" - "l-*-315" - "l-*-313" - "l-*-311" - "l-*-309" - "l-*-306" - "l-*-304" - "l-*-302" - "l-*-300" - "l-*-298" - "l-*-296" - "l-*-294" - "l-*-292" - "l-*-290" - "l-*-288" - "l-*-286" - "l-*-284" - "l-*-282" - "l-*-280" - "l-*-278" - "l-*-276" - "l-*-274" - "l-*-272" - "l-*-270" - "l-*-268" - "l-*-266" - "l-*-264" - "l-*-262" - "l-*-260" - "l-*-258" - "l-*-256" - "l-*-255" - "l-*-254" - "l-*-253" - "l-*-252" - "l-*-250" - "l-*-248" - "l-*-246" - "l-*-243" - "l-*-241" - "l-*-239" - "l-*-237" - "l-*-235" - "l-*-233" - "l-*-231" - "l-*-229" - "l-*-227" - "l-*-225" - "l-*-223" - "l-*-221" - "l-*-219" - "l-*-217" - "l-*-215" - "l-*-213" - "l-*-211" - "l-*-209")) - #(ribcage - (define-structure - define-expansion-accessors - define-expansion-constructors) - ((top) (top) (top)) - ("l-*-47" - "l-*-46" - "l-*-45"))) - (hygiene guile)) - '(()))) - #f) - #f)) - #f)) - key-10572) - (let ((x-10700 - (gensym - (string-append (symbol->string 'tmp) "-")))) - (let ((fun-exp-10705 - (let ((req-10714 (list 'tmp)) - (vars-10716 (list x-10700)) - (exp-10718 - (gen-syntax-case-10538 - (make-struct/no-tail - (vector-ref %expanded-vtables 3) - #f - 'tmp - x-10700) - key-10572 - m-10573 - r-10540 - mod-10543))) - (let ((body-10723 - (make-struct/no-tail - (vector-ref %expanded-vtables 14) - #f - req-10714 - #f - #f - #f - '() - vars-10716 - exp-10718 - #f))) - (make-struct/no-tail - (vector-ref %expanded-vtables 13) - #f - '() - body-10723)))) - (arg-exps-10706 - (list (call-with-values - (lambda () - (syntax-type-4296 - val-10571 - r-10540 - '(()) - (let ((props-10772 - (source-properties - (if (if (vector? - val-10571) - (if (= (vector-length - val-10571) - 4) - (eq? (vector-ref - val-10571 - 0) - 'syntax-object) - #f) - #f) - (vector-ref - val-10571 - 1) - val-10571)))) - (if (pair? props-10772) - props-10772 - #f)) - #f - mod-10543 - #f)) - (lambda (type-10805 - value-10806 - form-10807 - e-10808 - w-10809 - s-10810 - mod-10811) - (expand-expr-4298 - type-10805 - value-10806 - form-10807 - e-10808 - r-10540 - w-10809 - s-10810 - mod-10811)))))) - (make-struct/no-tail - (vector-ref %expanded-vtables 11) - s-10542 - fun-exp-10705 - arg-exps-10706))) - (syntax-violation - 'syntax-case - "invalid literals list" - e-10544))) - tmp-10546) - (syntax-violation - #f - "source expression failed to match any pattern" - e-10544))))))) - (set! macroexpand - (lambda* - (x-13143 - #:optional - (m-13144 'e) - (esew-13145 '(eval))) - (expand-top-sequence-4293 - (list x-13143) - '() - '((top)) - #f - m-13144 - esew-13145 - (cons 'hygiene (module-name (current-module)))))) - (set! identifier? - (lambda (x-13148) - (if (if (vector? x-13148) - (if (= (vector-length x-13148) 4) - (eq? (vector-ref x-13148 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref x-13148 1)) - #f))) - (set! datum->syntax - (lambda (id-13173 datum-13174) - (let ((wrap-13179 (vector-ref id-13173 2)) - (module-13180 (vector-ref id-13173 3))) - (vector - 'syntax-object - datum-13174 - wrap-13179 - module-13180)))) - (set! syntax->datum - (lambda (x-13187) (strip-4310 x-13187 '(())))) - (set! syntax-source - (lambda (x-13190) - (let ((props-13195 - (source-properties - (if (if (vector? x-13190) - (if (= (vector-length x-13190) 4) - (eq? (vector-ref x-13190 0) 'syntax-object) - #f) - #f) - (vector-ref x-13190 1) - x-13190)))) - (if (pair? props-13195) props-13195 #f)))) - (set! generate-temporaries - (lambda (ls-13218) - (begin - (if (not (list? ls-13218)) - (syntax-violation - 'generate-temporaries - "invalid argument" - ls-13218)) - (let ((mod-13226 - (cons 'hygiene (module-name (current-module))))) - (map (lambda (x-13227) - (wrap-4290 (gensym "t-") '((top)) mod-13226)) - ls-13218))))) - (set! free-identifier=? - (lambda (x-13231 y-13232) - (begin - (if (not (if (if (vector? x-13231) - (if (= (vector-length x-13231) 4) - (eq? (vector-ref x-13231 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref x-13231 1)) - #f)) - (syntax-violation - 'free-identifier=? - "invalid argument" - x-13231)) - (if (not (if (if (vector? y-13232) - (if (= (vector-length y-13232) 4) - (eq? (vector-ref y-13232 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref y-13232 1)) - #f)) - (syntax-violation - 'free-identifier=? - "invalid argument" - y-13232)) - (if (eq? (if (if (vector? x-13231) - (if (= (vector-length x-13231) 4) - (eq? (vector-ref x-13231 0) 'syntax-object) - #f) - #f) - (vector-ref x-13231 1) - x-13231) - (if (if (vector? y-13232) - (if (= (vector-length y-13232) 4) - (eq? (vector-ref y-13232 0) 'syntax-object) - #f) - #f) - (vector-ref y-13232 1) - y-13232)) - (eq? (id-var-name-4280 x-13231 '(())) - (id-var-name-4280 y-13232 '(()))) - #f)))) - (set! bound-identifier=? - (lambda (x-13382 y-13383) - (begin - (if (not (if (if (vector? x-13382) - (if (= (vector-length x-13382) 4) - (eq? (vector-ref x-13382 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref x-13382 1)) - #f)) - (syntax-violation - 'bound-identifier=? - "invalid argument" - x-13382)) - (if (not (if (if (vector? y-13383) - (if (= (vector-length y-13383) 4) - (eq? (vector-ref y-13383 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref y-13383 1)) - #f)) - (syntax-violation - 'bound-identifier=? - "invalid argument" - y-13383)) - (if (if (if (vector? x-13382) - (if (= (vector-length x-13382) 4) - (eq? (vector-ref x-13382 0) 'syntax-object) - #f) - #f) - (if (vector? y-13383) - (if (= (vector-length y-13383) 4) - (eq? (vector-ref y-13383 0) 'syntax-object) - #f) - #f) - #f) - (if (eq? (vector-ref x-13382 1) - (vector-ref y-13383 1)) - (same-marks?-4279 - (car (vector-ref x-13382 2)) - (car (vector-ref y-13383 2))) - #f) - (eq? x-13382 y-13383))))) - (set! syntax-violation - (lambda* - (who-13516 - message-13517 - form-13518 - #:optional - (subform-13519 #f)) - (begin - (if (not (if (not who-13516) - (not who-13516) - (let ((t-13537 (string? who-13516))) - (if t-13537 t-13537 (symbol? who-13516))))) - (syntax-violation - 'syntax-violation - "invalid argument" - who-13516)) - (if (not (string? message-13517)) - (syntax-violation - 'syntax-violation - "invalid argument" - message-13517)) - (throw 'syntax-error - who-13516 - message-13517 - (let ((t-13568 - (let ((props-13627 - (source-properties - (if (if (vector? subform-13519) - (if (= (vector-length subform-13519) - 4) - (eq? (vector-ref subform-13519 0) - 'syntax-object) - #f) - #f) - (vector-ref subform-13519 1) - subform-13519)))) - (if (pair? props-13627) props-13627 #f)))) - (if t-13568 - t-13568 - (let ((props-13600 - (source-properties - (if (if (vector? form-13518) - (if (= (vector-length form-13518) 4) - (eq? (vector-ref form-13518 0) - 'syntax-object) - #f) - #f) - (vector-ref form-13518 1) - form-13518)))) - (if (pair? props-13600) props-13600 #f)))) - (strip-4310 form-13518 '(())) - (if subform-13519 - (strip-4310 subform-13519 '(())) - #f))))) - (letrec* - ((syntax-local-binding-13655 - (lambda (id-13788) - (begin - (if (not (if (if (vector? id-13788) - (if (= (vector-length id-13788) 4) - (eq? (vector-ref id-13788 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref id-13788 1)) - #f)) - (syntax-violation - 'syntax-local-binding - "invalid argument" - id-13788)) - ((fluid-ref transformer-environment-4283) - (lambda (e-13828 - r-13829 - w-13830 - s-13831 - rib-13832 - mod-13833) + (resolve-identifier + (syntax-object-expression id) + (strip-anti-mark (syntax-object-wrap id)) + r + (syntax-object-module id))) + (lambda (type value mod) + (let ((key type)) + (cond ((memv key '(lexical)) (values 'lexical value)) + ((memv key '(macro)) (values 'macro value)) + ((memv key '(syntax)) (values 'pattern-variable value)) + ((memv key '(displaced-lexical)) (values 'displaced-lexical #f)) + ((memv key '(global)) (values 'global (cons value (cdr mod)))) + (else (values 'other #f))))))))))) + (syntax-locally-bound-identifiers + (lambda (id) + (let ((x id)) + (if (not (nonsymbol-id? x)) + (syntax-violation + 'syntax-locally-bound-identifiers + "invalid argument" + x))) + (locally-bound-identifiers + (syntax-object-wrap id) + (syntax-object-module id))))) + (define! 'syntax-module syntax-module) + (define! 'syntax-local-binding syntax-local-binding) + (define! + 'syntax-locally-bound-identifiers + syntax-locally-bound-identifiers)) + (letrec* + ((match-each + (lambda (e p w mod) + (cond ((pair? e) + (let ((first (match (car e) p w '() mod))) + (and first + (let ((rest (match-each (cdr e) p w mod))) + (and rest (cons first rest)))))) + ((null? e) '()) + ((syntax-object? e) + (match-each + (syntax-object-expression e) + p + (join-wraps w (syntax-object-wrap e)) + (syntax-object-module e))) + (else #f)))) + (match-each+ + (lambda (e x-pat y-pat z-pat w r mod) + (let f ((e e) (w w)) + (cond ((pair? e) (call-with-values - (lambda () - (let ((id-13836 (vector-ref id-13788 1)) - (w-13837 - (let ((w-13848 (vector-ref id-13788 2))) - (let ((ms-13849 (car w-13848)) - (s-13850 (cdr w-13848))) - (if (if (pair? ms-13849) - (eq? (car ms-13849) #f) - #f) - (cons (cdr ms-13849) - (if rib-13832 - (cons rib-13832 (cdr s-13850)) - (cdr s-13850))) - (cons ms-13849 - (if rib-13832 - (cons rib-13832 s-13850) - s-13850)))))) - (mod-13839 (vector-ref id-13788 3))) - (let ((n-13842 (id-var-name-4280 id-13836 w-13837))) - (if (symbol? n-13842) - (let ((mod-13856 - (if (if (vector? id-13836) - (if (= (vector-length id-13836) 4) - (eq? (vector-ref id-13836 0) - 'syntax-object) - #f) - #f) - (vector-ref id-13836 3) - mod-13839))) - (let ((b-13857 - (let ((t-13858 - (get-global-definition-hook-4224 - n-13842 - mod-13856))) - (if t-13858 t-13858 '(global))))) - (if (eq? (car b-13857) 'global) - (values 'global n-13842 mod-13856) - (values - (car b-13857) - (cdr b-13857) - mod-13856)))) - (if (string? n-13842) - (let ((mod-13884 - (if (if (vector? id-13836) - (if (= (vector-length id-13836) 4) - (eq? (vector-ref id-13836 0) - 'syntax-object) - #f) - #f) - (vector-ref id-13836 3) - mod-13839))) - (let ((b-13885 - (let ((t-13886 - (assq-ref r-13829 n-13842))) - (if t-13886 - t-13886 - '(displaced-lexical))))) - (values - (car b-13885) - (cdr b-13885) - mod-13884))) - (error "unexpected id-var-name" - id-13836 - w-13837 - n-13842)))))) - (lambda (type-13899 value-13900 mod-13901) - (if (eqv? type-13899 'lexical) - (values 'lexical value-13900) - (if (eqv? type-13899 'macro) - (values 'macro value-13900) - (if (eqv? type-13899 'syntax) - (values 'pattern-variable value-13900) - (if (eqv? type-13899 'displaced-lexical) - (values 'displaced-lexical #f) - (if (eqv? type-13899 'global) - (values - 'global - (cons value-13900 (cdr mod-13901))) - (values 'other #f))))))))))))) - (syntax-locally-bound-identifiers-13656 - (lambda (id-13923) - (begin - (if (not (if (if (vector? id-13923) - (if (= (vector-length id-13923) 4) - (eq? (vector-ref id-13923 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref id-13923 1)) - #f)) - (syntax-violation - 'syntax-locally-bound-identifiers - "invalid argument" - id-13923)) - (locally-bound-identifiers-4281 - (vector-ref id-13923 2) - (vector-ref id-13923 3)))))) - (begin - (define! - 'syntax-module - (lambda (id-13658) - (begin - (if (not (if (if (vector? id-13658) - (if (= (vector-length id-13658) 4) - (eq? (vector-ref id-13658 0) 'syntax-object) - #f) - #f) - (symbol? (vector-ref id-13658 1)) - #f)) - (syntax-violation - 'syntax-module - "invalid argument" - id-13658)) - (cdr (vector-ref id-13658 3))))) - (define! - 'syntax-local-binding - syntax-local-binding-13655) - (define! - 'syntax-locally-bound-identifiers - syntax-locally-bound-identifiers-13656))) - (letrec* - ((match-each-14030 - (lambda (e-14617 p-14618 w-14619 mod-14620) - (if (pair? e-14617) - (let ((first-14621 - (match-14036 - (car e-14617) - p-14618 - w-14619 - '() - mod-14620))) - (if first-14621 - (let ((rest-14624 - (match-each-14030 - (cdr e-14617) - p-14618 - w-14619 - mod-14620))) - (if rest-14624 (cons first-14621 rest-14624) #f)) - #f)) - (if (null? e-14617) - '() - (if (if (vector? e-14617) - (if (= (vector-length e-14617) 4) - (eq? (vector-ref e-14617 0) 'syntax-object) - #f) - #f) - (match-each-14030 - (vector-ref e-14617 1) - p-14618 - (join-wraps-4277 w-14619 (vector-ref e-14617 2)) - (vector-ref e-14617 3)) - #f))))) - (match-each-any-14032 - (lambda (e-14652 w-14653 mod-14654) - (if (pair? e-14652) - (let ((l-14655 - (match-each-any-14032 - (cdr e-14652) - w-14653 - mod-14654))) - (if l-14655 - (cons (wrap-4290 (car e-14652) w-14653 mod-14654) - l-14655) - #f)) - (if (null? e-14652) - '() - (if (if (vector? e-14652) - (if (= (vector-length e-14652) 4) - (eq? (vector-ref e-14652 0) 'syntax-object) - #f) - #f) - (match-each-any-14032 - (vector-ref e-14652 1) - (join-wraps-4277 w-14653 (vector-ref e-14652 2)) - mod-14654) - #f))))) - (match-empty-14033 - (lambda (p-14679 r-14680) - (if (null? p-14679) - r-14680 - (if (eq? p-14679 '_) - r-14680 - (if (eq? p-14679 'any) - (cons '() r-14680) - (if (pair? p-14679) - (match-empty-14033 - (car p-14679) - (match-empty-14033 (cdr p-14679) r-14680)) - (if (eq? p-14679 'each-any) - (cons '() r-14680) - (let ((key-14681 (vector-ref p-14679 0))) - (if (eqv? key-14681 'each) - (match-empty-14033 - (vector-ref p-14679 1) - r-14680) - (if (eqv? key-14681 'each+) - (match-empty-14033 - (vector-ref p-14679 1) - (match-empty-14033 - (reverse (vector-ref p-14679 2)) - (match-empty-14033 - (vector-ref p-14679 3) - r-14680))) - (if (if (eqv? key-14681 'free-id) - #t - (eqv? key-14681 'atom)) - r-14680 - (if (eqv? key-14681 'vector) - (match-empty-14033 - (vector-ref p-14679 1) - r-14680))))))))))))) - (combine-14034 - (lambda (r*-14700 r-14701) - (if (null? (car r*-14700)) - r-14701 - (cons (map car r*-14700) - (combine-14034 (map cdr r*-14700) r-14701))))) - (match*-14035 - (lambda (e-14065 p-14066 w-14067 r-14068 mod-14069) - (if (null? p-14066) - (if (null? e-14065) r-14068 #f) - (if (pair? p-14066) - (if (pair? e-14065) - (match-14036 - (car e-14065) - (car p-14066) - w-14067 - (match-14036 - (cdr e-14065) - (cdr p-14066) - w-14067 - r-14068 - mod-14069) - mod-14069) - #f) - (if (eq? p-14066 'each-any) - (let ((l-14074 - (match-each-any-14032 e-14065 w-14067 mod-14069))) - (if l-14074 (cons l-14074 r-14068) #f)) - (let ((key-14079 (vector-ref p-14066 0))) - (if (eqv? key-14079 'each) - (if (null? e-14065) - (match-empty-14033 - (vector-ref p-14066 1) - r-14068) - (let ((l-14086 - (match-each-14030 - e-14065 - (vector-ref p-14066 1) - w-14067 - mod-14069))) - (if l-14086 - (letrec* - ((collect-14089 - (lambda (l-14140) - (if (null? (car l-14140)) - r-14068 - (cons (map car l-14140) - (collect-14089 - (map cdr l-14140))))))) - (collect-14089 l-14086)) - #f))) - (if (eqv? key-14079 'each+) + (lambda () (f (cdr e) w)) + (lambda (xr* y-pat r) + (if r + (if (null? y-pat) + (let ((xr (match (car e) x-pat w '() mod))) + (if xr (values (cons xr xr*) y-pat r) (values #f #f #f))) + (values '() (cdr y-pat) (match (car e) (car y-pat) w r mod))) + (values #f #f #f))))) + ((syntax-object? e) + (f (syntax-object-expression e) (join-wraps w e))) + (else (values '() y-pat (match e z-pat w r mod))))))) + (match-each-any + (lambda (e w mod) + (cond ((pair? e) + (let ((l (match-each-any (cdr e) w mod))) + (and l (cons (wrap (car e) w mod) l)))) + ((null? e) '()) + ((syntax-object? e) + (match-each-any + (syntax-object-expression e) + (join-wraps w (syntax-object-wrap e)) + mod)) + (else #f)))) + (match-empty + (lambda (p r) + (cond ((null? p) r) + ((eq? p '_) r) + ((eq? p 'any) (cons '() r)) + ((pair? p) (match-empty (car p) (match-empty (cdr p) r))) + ((eq? p 'each-any) (cons '() r)) + (else + (let ((key (vector-ref p 0))) + (cond ((memv key '(each)) (match-empty (vector-ref p 1) r)) + ((memv key '(each+)) + (match-empty + (vector-ref p 1) + (match-empty + (reverse (vector-ref p 2)) + (match-empty (vector-ref p 3) r)))) + ((memv key '(free-id atom)) r) + ((memv key '(vector)) (match-empty (vector-ref p 1) r)))))))) + (combine + (lambda (r* r) + (if (null? (car r*)) r (cons (map car r*) (combine (map cdr r*) r))))) + (match* + (lambda (e p w r mod) + (cond ((null? p) (and (null? e) r)) + ((pair? p) + (and (pair? e) + (match (car e) (car p) w (match (cdr e) (cdr p) w r mod) mod))) + ((eq? p 'each-any) + (let ((l (match-each-any e w mod))) (and l (cons l r)))) + (else + (let ((key (vector-ref p 0))) + (cond ((memv key '(each)) + (if (null? e) + (match-empty (vector-ref p 1) r) + (let ((l (match-each e (vector-ref p 1) w mod))) + (and l + (let collect ((l l)) + (if (null? (car l)) r (cons (map car l) (collect (map cdr l))))))))) + ((memv key '(each+)) (call-with-values (lambda () - (let ((x-pat-14149 (vector-ref p-14066 1)) - (y-pat-14150 (vector-ref p-14066 2)) - (z-pat-14151 (vector-ref p-14066 3))) - (letrec* - ((f-14155 - (lambda (e-14157 w-14158) - (if (pair? e-14157) - (call-with-values - (lambda () - (f-14155 (cdr e-14157) w-14158)) - (lambda (xr*-14159 - y-pat-14160 - r-14161) - (if r-14161 - (if (null? y-pat-14160) - (let ((xr-14162 - (match-14036 - (car e-14157) - x-pat-14149 - w-14158 - '() - mod-14069))) - (if xr-14162 - (values - (cons xr-14162 xr*-14159) - y-pat-14160 - r-14161) - (values #f #f #f))) - (values - '() - (cdr y-pat-14160) - (match-14036 - (car e-14157) - (car y-pat-14160) - w-14158 - r-14161 - mod-14069))) - (values #f #f #f)))) - (if (if (vector? e-14157) - (if (= (vector-length e-14157) 4) - (eq? (vector-ref e-14157 0) - 'syntax-object) - #f) - #f) - (f-14155 - (vector-ref e-14157 1) - (join-wraps-4277 w-14158 e-14157)) - (values - '() - y-pat-14150 - (match-14036 - e-14157 - z-pat-14151 - w-14158 - r-14068 - mod-14069))))))) - (f-14155 e-14065 w-14067)))) - (lambda (xr*-14188 y-pat-14189 r-14190) - (if r-14190 - (if (null? y-pat-14189) - (if (null? xr*-14188) - (match-empty-14033 - (vector-ref p-14066 1) - r-14190) - (combine-14034 xr*-14188 r-14190)) - #f) - #f))) - (if (eqv? key-14079 'free-id) - (if (if (symbol? e-14065) - #t - (if (if (vector? e-14065) - (if (= (vector-length e-14065) 4) - (eq? (vector-ref e-14065 0) - 'syntax-object) - #f) - #f) - (symbol? (vector-ref e-14065 1)) - #f)) - (if (let ((i-14521 - (wrap-4290 e-14065 w-14067 mod-14069)) - (j-14522 (vector-ref p-14066 1))) - (if (eq? (if (if (vector? i-14521) - (if (= (vector-length - i-14521) - 4) - (eq? (vector-ref i-14521 0) - 'syntax-object) - #f) - #f) - (vector-ref i-14521 1) - i-14521) - (if (if (vector? j-14522) - (if (= (vector-length - j-14522) - 4) - (eq? (vector-ref j-14522 0) - 'syntax-object) - #f) - #f) - (vector-ref j-14522 1) - j-14522)) - (eq? (id-var-name-4280 i-14521 '(())) - (id-var-name-4280 j-14522 '(()))) - #f)) - r-14068 - #f) - #f) - (if (eqv? key-14079 'atom) - (if (equal? - (vector-ref p-14066 1) - (strip-4310 e-14065 w-14067)) - r-14068 - #f) - (if (eqv? key-14079 'vector) - (if (vector? e-14065) - (match-14036 - (vector->list e-14065) - (vector-ref p-14066 1) - w-14067 - r-14068 - mod-14069) - #f)))))))))))) - (match-14036 - (lambda (e-14582 p-14583 w-14584 r-14585 mod-14586) - (if (not r-14585) - #f - (if (eq? p-14583 '_) - r-14585 - (if (eq? p-14583 'any) - (cons (wrap-4290 e-14582 w-14584 mod-14586) - r-14585) - (if (if (vector? e-14582) - (if (= (vector-length e-14582) 4) - (eq? (vector-ref e-14582 0) 'syntax-object) - #f) - #f) - (match*-14035 - (vector-ref e-14582 1) - p-14583 - (join-wraps-4277 w-14584 (vector-ref e-14582 2)) - r-14585 - (vector-ref e-14582 3)) - (match*-14035 - e-14582 - p-14583 - w-14584 - r-14585 - mod-14586)))))))) - (set! $sc-dispatch - (lambda (e-14037 p-14038) - (if (eq? p-14038 'any) - (list e-14037) - (if (eq? p-14038 '_) - '() - (if (if (vector? e-14037) - (if (= (vector-length e-14037) 4) - (eq? (vector-ref e-14037 0) 'syntax-object) - #f) - #f) - (match*-14035 - (vector-ref e-14037 1) - p-14038 - (vector-ref e-14037 2) - '() - (vector-ref e-14037 3)) - (match*-14035 e-14037 p-14038 '(()) '() #f)))))))))) + (match-each+ + e + (vector-ref p 1) + (vector-ref p 2) + (vector-ref p 3) + w + r + mod)) + (lambda (xr* y-pat r) + (and r + (null? y-pat) + (if (null? xr*) (match-empty (vector-ref p 1) r) (combine xr* r)))))) + ((memv key '(free-id)) + (and (id? e) (free-id=? (wrap e w mod) (vector-ref p 1)) r)) + ((memv key '(atom)) (and (equal? (vector-ref p 1) (strip e w)) r)) + ((memv key '(vector)) + (and (vector? e) (match (vector->list e) (vector-ref p 1) w r mod))))))))) + (match (lambda (e p w r mod) + (cond ((not r) #f) + ((eq? p '_) r) + ((eq? p 'any) (cons (wrap e w mod) r)) + ((syntax-object? e) + (match* + (syntax-object-expression e) + p + (join-wraps w (syntax-object-wrap e)) + r + (syntax-object-module e))) + (else (match* e p w r mod)))))) + (set! $sc-dispatch + (lambda (e p) + (cond ((eq? p 'any) (list e)) + ((eq? p '_) '()) + ((syntax-object? e) + (match* + (syntax-object-expression e) + p + (syntax-object-wrap e) + '() + (syntax-object-module e))) + (else (match* e p '(()) '() #f))))))) (define with-syntax (make-syntax-transformer 'with-syntax 'macro - (lambda (x-25194) - (let ((tmp-25196 - ($sc-dispatch x-25194 '(_ () any . each-any)))) - (if tmp-25196 - (@apply - (lambda (e1-25200 e2-25201) - (cons '#(syntax-object - let - ((top) - #(ribcage - #(e1 e2) - #((top) (top)) - #("l-*-25167" "l-*-25168")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25164"))) - (hygiene guile)) - (cons '() (cons e1-25200 e2-25201)))) - tmp-25196) - (let ((tmp-25202 - ($sc-dispatch - x-25194 - '(_ ((any any)) any . each-any)))) - (if tmp-25202 - (@apply - (lambda (out-25206 in-25207 e1-25208 e2-25209) - (list '#(syntax-object - syntax-case - ((top) - #(ribcage - #(out in e1 e2) - #((top) (top) (top) (top)) - #("l-*-25173" - "l-*-25174" - "l-*-25175" - "l-*-25176")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25164"))) - (hygiene guile)) - in-25207 - '() - (list out-25206 - (cons '#(syntax-object - let - ((top) - #(ribcage - #(out in e1 e2) - #((top) (top) (top) (top)) - #("l-*-25173" - "l-*-25174" - "l-*-25175" - "l-*-25176")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25164"))) - (hygiene guile)) - (cons '() (cons e1-25208 e2-25209)))))) - tmp-25202) - (let ((tmp-25210 - ($sc-dispatch - x-25194 - '(_ #(each (any any)) any . each-any)))) - (if tmp-25210 - (@apply - (lambda (out-25214 in-25215 e1-25216 e2-25217) - (list '#(syntax-object - syntax-case - ((top) - #(ribcage - #(out in e1 e2) - #((top) (top) (top) (top)) - #("l-*-25183" - "l-*-25184" - "l-*-25185" - "l-*-25186")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25164"))) - (hygiene guile)) - (cons '#(syntax-object - list - ((top) - #(ribcage - #(out in e1 e2) - #((top) (top) (top) (top)) - #("l-*-25183" - "l-*-25184" - "l-*-25185" - "l-*-25186")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25164"))) - (hygiene guile)) - in-25215) - '() - (list out-25214 - (cons '#(syntax-object - let - ((top) - #(ribcage - #(out in e1 e2) - #((top) (top) (top) (top)) - #("l-*-25183" - "l-*-25184" - "l-*-25185" - "l-*-25186")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25164"))) - (hygiene guile)) - (cons '() (cons e1-25216 e2-25217)))))) - tmp-25210) - (syntax-violation - #f - "source expression failed to match any pattern" - x-25194)))))))))) + (lambda (x) + (let ((tmp x)) + (let ((tmp-1 ($sc-dispatch tmp '(_ () any . each-any)))) + (if tmp-1 + (apply (lambda (e1 e2) + (cons '#(syntax-object + let + ((top) + #(ribcage #(e1 e2) #((top) (top)) #("l-*-4203" "l-*-4204")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4200"))) + (hygiene guile)) + (cons '() (cons e1 e2)))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(_ ((any any)) any . each-any)))) + (if tmp-1 + (apply (lambda (out in e1 e2) + (list '#(syntax-object + syntax-case + ((top) + #(ribcage + #(out in e1 e2) + #((top) (top) (top) (top)) + #("l-*-4209" "l-*-4210" "l-*-4211" "l-*-4212")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4200"))) + (hygiene guile)) + in + '() + (list out + (cons '#(syntax-object + let + ((top) + #(ribcage + #(out in e1 e2) + #((top) (top) (top) (top)) + #("l-*-4209" "l-*-4210" "l-*-4211" "l-*-4212")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4200"))) + (hygiene guile)) + (cons '() (cons e1 e2)))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(_ #(each (any any)) any . each-any)))) + (if tmp-1 + (apply (lambda (out in e1 e2) + (list '#(syntax-object + syntax-case + ((top) + #(ribcage + #(out in e1 e2) + #((top) (top) (top) (top)) + #("l-*-4219" "l-*-4220" "l-*-4221" "l-*-4222")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4200"))) + (hygiene guile)) + (cons '#(syntax-object + list + ((top) + #(ribcage + #(out in e1 e2) + #((top) (top) (top) (top)) + #("l-*-4219" "l-*-4220" "l-*-4221" "l-*-4222")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4200"))) + (hygiene guile)) + in) + '() + (list out + (cons '#(syntax-object + let + ((top) + #(ribcage + #(out in e1 e2) + #((top) (top) (top) (top)) + #("l-*-4219" "l-*-4220" "l-*-4221" "l-*-4222")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4200"))) + (hygiene guile)) + (cons '() (cons e1 e2)))))) + tmp-1) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp))))))))))) (define syntax-rules (make-syntax-transformer 'syntax-rules 'macro - (lambda (x-25271) - (let ((tmp-25273 - ($sc-dispatch - x-25271 - '(_ each-any . #(each ((any . any) any)))))) - (if tmp-25273 - (@apply - (lambda (k-25277 - keyword-25278 - pattern-25279 - template-25280) - (list '#(syntax-object - lambda - ((top) - #(ribcage - #(k keyword pattern template) - #((top) (top) (top) (top)) - #("l-*-25234" - "l-*-25235" - "l-*-25236" - "l-*-25237")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile)) - '(#(syntax-object - x - ((top) - #(ribcage - #(k keyword pattern template) - #((top) (top) (top) (top)) - #("l-*-25234" - "l-*-25235" - "l-*-25236" - "l-*-25237")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile))) - (vector - '(#(syntax-object - macro-type - ((top) - #(ribcage - #(k keyword pattern template) - #((top) (top) (top) (top)) - #("l-*-25234" - "l-*-25235" - "l-*-25236" - "l-*-25237")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile)) - . - #(syntax-object - syntax-rules - ((top) - #(ribcage - #(k keyword pattern template) - #((top) (top) (top) (top)) - #("l-*-25234" - "l-*-25235" - "l-*-25236" - "l-*-25237")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile))) - (cons '#(syntax-object - patterns + (lambda (x) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 '(_ each-any . #(each ((any . any) any)))))) + (if tmp + (apply (lambda (k keyword pattern template) + (list '#(syntax-object + lambda + ((top) + #(ribcage + #(k keyword pattern template) + #((top) (top) (top) (top)) + #("l-*-4234" "l-*-4235" "l-*-4236" "l-*-4237")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + '(#(syntax-object + x ((top) #(ribcage #(k keyword pattern template) #((top) (top) (top) (top)) - #("l-*-25234" - "l-*-25235" - "l-*-25236" - "l-*-25237")) + #("l-*-4234" "l-*-4235" "l-*-4236" "l-*-4237")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile)) - pattern-25279)) - (cons '#(syntax-object - syntax-case - ((top) - #(ribcage - #(k keyword pattern template) - #((top) (top) (top) (top)) - #("l-*-25234" - "l-*-25235" - "l-*-25236" - "l-*-25237")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile)) - (cons '#(syntax-object + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile))) + (vector + '(#(syntax-object + macro-type + ((top) + #(ribcage + #(k keyword pattern template) + #((top) (top) (top) (top)) + #("l-*-4234" "l-*-4235" "l-*-4236" "l-*-4237")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + . + #(syntax-object + syntax-rules + ((top) + #(ribcage + #(k keyword pattern template) + #((top) (top) (top) (top)) + #("l-*-4234" "l-*-4235" "l-*-4236" "l-*-4237")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile))) + (cons '#(syntax-object + patterns + ((top) + #(ribcage + #(k keyword pattern template) + #((top) (top) (top) (top)) + #("l-*-4234" "l-*-4235" "l-*-4236" "l-*-4237")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + pattern)) + (cons '#(syntax-object + syntax-case + ((top) + #(ribcage + #(k keyword pattern template) + #((top) (top) (top) (top)) + #("l-*-4234" "l-*-4235" "l-*-4236" "l-*-4237")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + (cons '#(syntax-object + x + ((top) + #(ribcage + #(k keyword pattern template) + #((top) (top) (top) (top)) + #("l-*-4234" "l-*-4235" "l-*-4236" "l-*-4237")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + (cons k + (map (lambda (tmp-1 tmp) + (list (cons '#(syntax-object + dummy + ((top) + #(ribcage + #(k keyword pattern template) + #((top) (top) (top) (top)) + #("l-*-4234" "l-*-4235" "l-*-4236" "l-*-4237")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + tmp) + (list '#(syntax-object + syntax + ((top) + #(ribcage + #(k keyword pattern template) + #((top) (top) (top) (top)) + #("l-*-4234" "l-*-4235" "l-*-4236" "l-*-4237")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + tmp-1))) + template + pattern)))))) + tmp) + (let ((tmp ($sc-dispatch tmp-1 '(_ each-any any . #(each ((any . any) any)))))) + (if (if tmp + (apply (lambda (k docstring keyword pattern template) + (string? (syntax->datum docstring))) + tmp) + #f) + (apply (lambda (k docstring keyword pattern template) + (list '#(syntax-object + lambda + ((top) + #(ribcage + #(k docstring keyword pattern template) + #((top) (top) (top) (top) (top)) + #("l-*-4257" "l-*-4258" "l-*-4259" "l-*-4260" "l-*-4261")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + '(#(syntax-object x - ((top) - #(ribcage - #(k keyword pattern template) - #((top) (top) (top) (top)) - #("l-*-25234" - "l-*-25235" - "l-*-25236" - "l-*-25237")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile)) - (cons k-25277 - (map (lambda (tmp-25245-25281 - tmp-25244-25282) - (list (cons '#(syntax-object - dummy - ((top) - #(ribcage - #(k - keyword - pattern - template) - #((top) - (top) - (top) - (top)) - #("l-*-25234" - "l-*-25235" - "l-*-25236" - "l-*-25237")) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-25231"))) - (hygiene guile)) - tmp-25244-25282) - (list '#(syntax-object - syntax - ((top) - #(ribcage - #(k - keyword - pattern - template) - #((top) - (top) - (top) - (top)) - #("l-*-25234" - "l-*-25235" - "l-*-25236" - "l-*-25237")) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-25231"))) - (hygiene guile)) - tmp-25245-25281))) - template-25280 - pattern-25279)))))) - tmp-25273) - (let ((tmp-25283 - ($sc-dispatch - x-25271 - '(_ each-any any . #(each ((any . any) any)))))) - (if (if tmp-25283 - (@apply - (lambda (k-25287 - docstring-25288 - keyword-25289 - pattern-25290 - template-25291) - (string? (syntax->datum docstring-25288))) - tmp-25283) - #f) - (@apply - (lambda (k-25292 - docstring-25293 - keyword-25294 - pattern-25295 - template-25296) - (list '#(syntax-object - lambda - ((top) - #(ribcage - #(k docstring keyword pattern template) - #((top) (top) (top) (top) (top)) - #("l-*-25257" - "l-*-25258" - "l-*-25259" - "l-*-25260" - "l-*-25261")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile)) - '(#(syntax-object - x - ((top) - #(ribcage - #(k docstring keyword pattern template) - #((top) (top) (top) (top) (top)) - #("l-*-25257" - "l-*-25258" - "l-*-25259" - "l-*-25260" - "l-*-25261")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile))) - docstring-25293 - (vector - '(#(syntax-object - macro-type - ((top) - #(ribcage - #(k docstring keyword pattern template) - #((top) (top) (top) (top) (top)) - #("l-*-25257" - "l-*-25258" - "l-*-25259" - "l-*-25260" - "l-*-25261")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile)) - . - #(syntax-object - syntax-rules - ((top) - #(ribcage - #(k docstring keyword pattern template) - #((top) (top) (top) (top) (top)) - #("l-*-25257" - "l-*-25258" - "l-*-25259" - "l-*-25260" - "l-*-25261")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile))) - (cons '#(syntax-object - patterns ((top) #(ribcage #(k docstring keyword pattern template) #((top) (top) (top) (top) (top)) - #("l-*-25257" - "l-*-25258" - "l-*-25259" - "l-*-25260" - "l-*-25261")) + #("l-*-4257" "l-*-4258" "l-*-4259" "l-*-4260" "l-*-4261")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile)) - pattern-25295)) - (cons '#(syntax-object - syntax-case - ((top) - #(ribcage - #(k docstring keyword pattern template) - #((top) (top) (top) (top) (top)) - #("l-*-25257" - "l-*-25258" - "l-*-25259" - "l-*-25260" - "l-*-25261")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25231"))) - (hygiene guile)) - (cons '#(syntax-object - x - ((top) - #(ribcage - #(k - docstring - keyword - pattern - template) - #((top) (top) (top) (top) (top)) - #("l-*-25257" - "l-*-25258" - "l-*-25259" - "l-*-25260" - "l-*-25261")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25231"))) - (hygiene guile)) - (cons k-25292 - (map (lambda (tmp-25270-25297 - tmp-25269-25298) - (list (cons '#(syntax-object - dummy - ((top) - #(ribcage - #(k - docstring - keyword - pattern - template) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-25257" - "l-*-25258" - "l-*-25259" - "l-*-25260" - "l-*-25261")) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-25231"))) - (hygiene - guile)) - tmp-25269-25298) - (list '#(syntax-object - syntax - ((top) - #(ribcage - #(k - docstring - keyword - pattern - template) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-25257" - "l-*-25258" - "l-*-25259" - "l-*-25260" - "l-*-25261")) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-25231"))) - (hygiene - guile)) - tmp-25270-25297))) - template-25296 - pattern-25295)))))) - tmp-25283) - (syntax-violation - #f - "source expression failed to match any pattern" - x-25271)))))))) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile))) + docstring + (vector + '(#(syntax-object + macro-type + ((top) + #(ribcage + #(k docstring keyword pattern template) + #((top) (top) (top) (top) (top)) + #("l-*-4257" "l-*-4258" "l-*-4259" "l-*-4260" "l-*-4261")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + . + #(syntax-object + syntax-rules + ((top) + #(ribcage + #(k docstring keyword pattern template) + #((top) (top) (top) (top) (top)) + #("l-*-4257" "l-*-4258" "l-*-4259" "l-*-4260" "l-*-4261")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile))) + (cons '#(syntax-object + patterns + ((top) + #(ribcage + #(k docstring keyword pattern template) + #((top) (top) (top) (top) (top)) + #("l-*-4257" "l-*-4258" "l-*-4259" "l-*-4260" "l-*-4261")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + pattern)) + (cons '#(syntax-object + syntax-case + ((top) + #(ribcage + #(k docstring keyword pattern template) + #((top) (top) (top) (top) (top)) + #("l-*-4257" "l-*-4258" "l-*-4259" "l-*-4260" "l-*-4261")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + (cons '#(syntax-object + x + ((top) + #(ribcage + #(k docstring keyword pattern template) + #((top) (top) (top) (top) (top)) + #("l-*-4257" "l-*-4258" "l-*-4259" "l-*-4260" "l-*-4261")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + (cons k + (map (lambda (tmp-1 tmp) + (list (cons '#(syntax-object + dummy + ((top) + #(ribcage + #(k docstring keyword pattern template) + #((top) (top) (top) (top) (top)) + #("l-*-4257" + "l-*-4258" + "l-*-4259" + "l-*-4260" + "l-*-4261")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + tmp) + (list '#(syntax-object + syntax + ((top) + #(ribcage + #(k docstring keyword pattern template) + #((top) (top) (top) (top) (top)) + #("l-*-4257" + "l-*-4258" + "l-*-4259" + "l-*-4260" + "l-*-4261")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4231"))) + (hygiene guile)) + tmp-1))) + template + pattern)))))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))))) (define define-syntax-rule (make-syntax-transformer 'define-syntax-rule 'macro - (lambda (x-25335) - (let ((tmp-25337 - ($sc-dispatch x-25335 '(_ (any . any) any)))) - (if tmp-25337 - (@apply - (lambda (name-25341 pattern-25342 template-25343) - (list '#(syntax-object - define-syntax - ((top) - #(ribcage - #(name pattern template) - #((top) (top) (top)) - #("l-*-25312" "l-*-25313" "l-*-25314")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25309"))) - (hygiene guile)) - name-25341 - (list '#(syntax-object - syntax-rules - ((top) - #(ribcage - #(name pattern template) - #((top) (top) (top)) - #("l-*-25312" "l-*-25313" "l-*-25314")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25309"))) - (hygiene guile)) - '() - (list (cons '#(syntax-object - _ - ((top) - #(ribcage - #(name pattern template) - #((top) (top) (top)) - #("l-*-25312" - "l-*-25313" - "l-*-25314")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25309"))) - (hygiene guile)) - pattern-25342) - template-25343)))) - tmp-25337) - (let ((tmp-25344 - ($sc-dispatch x-25335 '(_ (any . any) any any)))) - (if (if tmp-25344 - (@apply - (lambda (name-25348 - pattern-25349 - docstring-25350 - template-25351) - (string? (syntax->datum docstring-25350))) - tmp-25344) - #f) - (@apply - (lambda (name-25352 - pattern-25353 - docstring-25354 - template-25355) - (list '#(syntax-object - define-syntax - ((top) - #(ribcage - #(name pattern docstring template) - #((top) (top) (top) (top)) - #("l-*-25327" - "l-*-25328" - "l-*-25329" - "l-*-25330")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25309"))) - (hygiene guile)) - name-25352 - (list '#(syntax-object - syntax-rules - ((top) - #(ribcage - #(name pattern docstring template) - #((top) (top) (top) (top)) - #("l-*-25327" - "l-*-25328" - "l-*-25329" - "l-*-25330")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25309"))) - (hygiene guile)) - '() - docstring-25354 - (list (cons '#(syntax-object - _ - ((top) - #(ribcage - #(name - pattern - docstring - template) - #((top) (top) (top) (top)) - #("l-*-25327" - "l-*-25328" - "l-*-25329" - "l-*-25330")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25309"))) - (hygiene guile)) - pattern-25353) - template-25355)))) - tmp-25344) - (syntax-violation - #f - "source expression failed to match any pattern" - x-25335)))))))) + (lambda (x) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 '(_ (any . any) any)))) + (if tmp + (apply (lambda (name pattern template) + (list '#(syntax-object + define-syntax + ((top) + #(ribcage + #(name pattern template) + #((top) (top) (top)) + #("l-*-4275" "l-*-4276" "l-*-4277")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4272"))) + (hygiene guile)) + name + (list '#(syntax-object + syntax-rules + ((top) + #(ribcage + #(name pattern template) + #((top) (top) (top)) + #("l-*-4275" "l-*-4276" "l-*-4277")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4272"))) + (hygiene guile)) + '() + (list (cons '#(syntax-object + _ + ((top) + #(ribcage + #(name pattern template) + #((top) (top) (top)) + #("l-*-4275" "l-*-4276" "l-*-4277")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4272"))) + (hygiene guile)) + pattern) + template)))) + tmp) + (let ((tmp ($sc-dispatch tmp-1 '(_ (any . any) any any)))) + (if (if tmp + (apply (lambda (name pattern docstring template) + (string? (syntax->datum docstring))) + tmp) + #f) + (apply (lambda (name pattern docstring template) + (list '#(syntax-object + define-syntax + ((top) + #(ribcage + #(name pattern docstring template) + #((top) (top) (top) (top)) + #("l-*-4290" "l-*-4291" "l-*-4292" "l-*-4293")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4272"))) + (hygiene guile)) + name + (list '#(syntax-object + syntax-rules + ((top) + #(ribcage + #(name pattern docstring template) + #((top) (top) (top) (top)) + #("l-*-4290" "l-*-4291" "l-*-4292" "l-*-4293")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4272"))) + (hygiene guile)) + '() + docstring + (list (cons '#(syntax-object + _ + ((top) + #(ribcage + #(name pattern docstring template) + #((top) (top) (top) (top)) + #("l-*-4290" "l-*-4291" "l-*-4292" "l-*-4293")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4272"))) + (hygiene guile)) + pattern) + template)))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))))) (define let* (make-syntax-transformer 'let* 'macro - (lambda (x-25404) - (let ((tmp-25406 - ($sc-dispatch - x-25404 - '(any #(each (any any)) any . each-any)))) - (if (if tmp-25406 - (@apply - (lambda (let*-25410 x-25411 v-25412 e1-25413 e2-25414) - (and-map identifier? x-25411)) - tmp-25406) - #f) - (@apply - (lambda (let*-25415 x-25416 v-25417 e1-25418 e2-25419) - (letrec* - ((f-25420 - (lambda (bindings-25423) - (if (null? bindings-25423) - (cons '#(syntax-object - let - ((top) - #(ribcage () () ()) - #(ribcage - #(f bindings) - #((top) (top)) - #("l-*-25390" "l-*-25391")) - #(ribcage - #(let* x v e1 e2) - #((top) (top) (top) (top) (top)) - #("l-*-25380" - "l-*-25381" - "l-*-25382" - "l-*-25383" - "l-*-25384")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25366"))) - (hygiene guile)) - (cons '() (cons e1-25418 e2-25419))) - (let ((tmp-25424 - (list (f-25420 (cdr bindings-25423)) - (car bindings-25423)))) - (let ((tmp-25425 ($sc-dispatch tmp-25424 '(any any)))) - (if tmp-25425 - (@apply - (lambda (body-25427 binding-25428) - (list '#(syntax-object - let - ((top) - #(ribcage () () ()) - #(ribcage - #(body binding) - #((top) (top)) - #("l-*-25400" "l-*-25401")) - #(ribcage () () ()) - #(ribcage - #(f bindings) - #((top) (top)) - #("l-*-25390" "l-*-25391")) - #(ribcage - #(let* x v e1 e2) - #((top) (top) (top) (top) (top)) - #("l-*-25380" - "l-*-25381" - "l-*-25382" - "l-*-25383" - "l-*-25384")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25366"))) - (hygiene guile)) - (list binding-25428) - body-25427)) - tmp-25425) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-25424)))))))) - (f-25420 (map list x-25416 v-25417)))) - tmp-25406) - (syntax-violation - #f - "source expression failed to match any pattern" - x-25404)))))) + (lambda (x) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 '(any #(each (any any)) any . each-any)))) + (if (if tmp + (apply (lambda (let* x v e1 e2) (and-map identifier? x)) tmp) + #f) + (apply (lambda (let* x v e1 e2) + (let f ((bindings (map list x v))) + (if (null? bindings) + (cons '#(syntax-object + let + ((top) + #(ribcage () () ()) + #(ribcage #(f bindings) #((top) (top)) #("l-*-4323" "l-*-4324")) + #(ribcage + #(let* x v e1 e2) + #((top) (top) (top) (top) (top)) + #("l-*-4313" "l-*-4314" "l-*-4315" "l-*-4316" "l-*-4317")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4299"))) + (hygiene guile)) + (cons '() (cons e1 e2))) + (let ((tmp-1 (list (f (cdr bindings)) (car bindings)))) + (let ((tmp ($sc-dispatch tmp-1 '(any any)))) + (if tmp + (apply (lambda (body binding) + (list '#(syntax-object + let + ((top) + #(ribcage () () ()) + #(ribcage #(body binding) #((top) (top)) #("l-*-4333" "l-*-4334")) + #(ribcage () () ()) + #(ribcage #(f bindings) #((top) (top)) #("l-*-4323" "l-*-4324")) + #(ribcage + #(let* x v e1 e2) + #((top) (top) (top) (top) (top)) + #("l-*-4313" "l-*-4314" "l-*-4315" "l-*-4316" "l-*-4317")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4299"))) + (hygiene guile)) + (list binding) + body)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))) (define do (make-syntax-transformer 'do 'macro - (lambda (orig-x-25484) - (let ((tmp-25486 - ($sc-dispatch - orig-x-25484 - '(_ #(each (any any . any)) - (any . each-any) - . - each-any)))) - (if tmp-25486 - (@apply - (lambda (var-25490 - init-25491 - step-25492 - e0-25493 - e1-25494 - c-25495) - (let ((tmp-25496 - (map (lambda (v-25499 s-25500) - (let ((tmp-25502 ($sc-dispatch s-25500 '()))) - (if tmp-25502 - (@apply (lambda () v-25499) tmp-25502) - (let ((tmp-25505 - ($sc-dispatch s-25500 '(any)))) - (if tmp-25505 - (@apply - (lambda (e-25508) e-25508) - tmp-25505) - (syntax-violation - 'do - "bad step expression" - orig-x-25484 - s-25500)))))) - var-25490 - step-25492))) - (let ((tmp-25497 ($sc-dispatch tmp-25496 'each-any))) - (if tmp-25497 - (@apply - (lambda (step-25513) - (let ((tmp-25515 ($sc-dispatch e1-25494 '()))) - (if tmp-25515 - (@apply - (lambda () - (list '#(syntax-object - let - ((top) - #(ribcage () () ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var init step e0 e1 c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage () () ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene guile)) - '#(syntax-object - doloop - ((top) - #(ribcage () () ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var init step e0 e1 c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage () () ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene guile)) - (map list var-25490 init-25491) - (list '#(syntax-object - if - ((top) - #(ribcage () () ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var init step e0 e1 c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage () () ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene guile)) - (list '#(syntax-object - not - ((top) - #(ribcage () () ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var - init - step - e0 - e1 - c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage () () ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene guile)) - e0-25493) - (cons '#(syntax-object - begin - ((top) - #(ribcage () () ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var - init - step - e0 - e1 - c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage () () ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene guile)) - (append - c-25495 - (list (cons '#(syntax-object - doloop - ((top) - #(ribcage - () - () - ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var - init - step - e0 - e1 - c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage - () - () - ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene - guile)) - step-25513))))))) - tmp-25515) - (let ((tmp-25519 - ($sc-dispatch e1-25494 '(any . each-any)))) - (if tmp-25519 - (@apply - (lambda (e1-25523 e2-25524) - (list '#(syntax-object - let - ((top) - #(ribcage - #(e1 e2) - #((top) (top)) - #("l-*-25463" "l-*-25464")) - #(ribcage () () ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var init step e0 e1 c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage () () ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene guile)) - '#(syntax-object - doloop - ((top) - #(ribcage - #(e1 e2) - #((top) (top)) - #("l-*-25463" "l-*-25464")) - #(ribcage () () ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var init step e0 e1 c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage () () ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene guile)) - (map list var-25490 init-25491) - (list '#(syntax-object - if - ((top) - #(ribcage - #(e1 e2) - #((top) (top)) - #("l-*-25463" - "l-*-25464")) - #(ribcage () () ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var init step e0 e1 c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage () () ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene guile)) - e0-25493 - (cons '#(syntax-object - begin - ((top) - #(ribcage - #(e1 e2) - #((top) (top)) - #("l-*-25463" - "l-*-25464")) - #(ribcage () () ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var - init - step - e0 - e1 - c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage () () ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene guile)) - (cons e1-25523 e2-25524)) - (cons '#(syntax-object - begin - ((top) - #(ribcage - #(e1 e2) - #((top) (top)) - #("l-*-25463" - "l-*-25464")) - #(ribcage () () ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var - init - step - e0 - e1 - c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage () () ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene guile)) - (append - c-25495 - (list (cons '#(syntax-object - doloop - ((top) - #(ribcage - #(e1 - e2) - #((top) - (top)) - #("l-*-25463" - "l-*-25464")) - #(ribcage - () - () - ()) - #(ribcage - #(step) - #((top)) - #("l-*-25454")) - #(ribcage - #(var - init - step - e0 - e1 - c) - #((top) - (top) - (top) - (top) - (top) - (top)) - #("l-*-25439" - "l-*-25440" - "l-*-25441" - "l-*-25442" - "l-*-25443" - "l-*-25444")) - #(ribcage - () - () - ()) - #(ribcage - #(orig-x) - #((top)) - #("l-*-25436"))) - (hygiene - guile)) - step-25513))))))) - tmp-25519) - (syntax-violation - #f - "source expression failed to match any pattern" - e1-25494)))))) - tmp-25497) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-25496))))) - tmp-25486) - (syntax-violation - #f - "source expression failed to match any pattern" - orig-x-25484)))))) + (lambda (orig-x) + (let ((tmp-1 orig-x)) + (let ((tmp ($sc-dispatch + tmp-1 + '(_ #(each (any any . any)) (any . each-any) . each-any)))) + (if tmp + (apply (lambda (var init step e0 e1 c) + (let ((tmp-1 (map (lambda (v s) + (let ((tmp-1 s)) + (let ((tmp ($sc-dispatch tmp-1 '()))) + (if tmp + (apply (lambda () v) tmp) + (let ((tmp ($sc-dispatch tmp-1 '(any)))) + (if tmp + (apply (lambda (e) e) tmp) + (syntax-violation 'do "bad step expression" orig-x s))))))) + var + step))) + (let ((tmp ($sc-dispatch tmp-1 'each-any))) + (if tmp + (apply (lambda (step) + (let ((tmp e1)) + (let ((tmp-1 ($sc-dispatch tmp '()))) + (if tmp-1 + (apply (lambda () + (list '#(syntax-object + let + ((top) + #(ribcage () () ()) + #(ribcage #(step) #((top)) #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) (top) (top) (top) (top) (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage #(orig-x) #((top)) #("l-*-4338"))) + (hygiene guile)) + '#(syntax-object + doloop + ((top) + #(ribcage () () ()) + #(ribcage #(step) #((top)) #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) (top) (top) (top) (top) (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage #(orig-x) #((top)) #("l-*-4338"))) + (hygiene guile)) + (map list var init) + (list '#(syntax-object + if + ((top) + #(ribcage () () ()) + #(ribcage #(step) #((top)) #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) (top) (top) (top) (top) (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage #(orig-x) #((top)) #("l-*-4338"))) + (hygiene guile)) + (list '#(syntax-object + not + ((top) + #(ribcage () () ()) + #(ribcage #(step) #((top)) #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) (top) (top) (top) (top) (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage #(orig-x) #((top)) #("l-*-4338"))) + (hygiene guile)) + e0) + (cons '#(syntax-object + begin + ((top) + #(ribcage () () ()) + #(ribcage #(step) #((top)) #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) (top) (top) (top) (top) (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage #(orig-x) #((top)) #("l-*-4338"))) + (hygiene guile)) + (append + c + (list (cons '#(syntax-object + doloop + ((top) + #(ribcage () () ()) + #(ribcage + #(step) + #((top)) + #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) + (top) + (top) + (top) + (top) + (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage + #(orig-x) + #((top)) + #("l-*-4338"))) + (hygiene guile)) + step))))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . each-any)))) + (if tmp-1 + (apply (lambda (e1 e2) + (list '#(syntax-object + let + ((top) + #(ribcage + #(e1 e2) + #((top) (top)) + #("l-*-4365" "l-*-4366")) + #(ribcage () () ()) + #(ribcage #(step) #((top)) #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) (top) (top) (top) (top) (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage #(orig-x) #((top)) #("l-*-4338"))) + (hygiene guile)) + '#(syntax-object + doloop + ((top) + #(ribcage + #(e1 e2) + #((top) (top)) + #("l-*-4365" "l-*-4366")) + #(ribcage () () ()) + #(ribcage #(step) #((top)) #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) (top) (top) (top) (top) (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage #(orig-x) #((top)) #("l-*-4338"))) + (hygiene guile)) + (map list var init) + (list '#(syntax-object + if + ((top) + #(ribcage + #(e1 e2) + #((top) (top)) + #("l-*-4365" "l-*-4366")) + #(ribcage () () ()) + #(ribcage #(step) #((top)) #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) (top) (top) (top) (top) (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage #(orig-x) #((top)) #("l-*-4338"))) + (hygiene guile)) + e0 + (cons '#(syntax-object + begin + ((top) + #(ribcage + #(e1 e2) + #((top) (top)) + #("l-*-4365" "l-*-4366")) + #(ribcage () () ()) + #(ribcage #(step) #((top)) #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) (top) (top) (top) (top) (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage + #(orig-x) + #((top)) + #("l-*-4338"))) + (hygiene guile)) + (cons e1 e2)) + (cons '#(syntax-object + begin + ((top) + #(ribcage + #(e1 e2) + #((top) (top)) + #("l-*-4365" "l-*-4366")) + #(ribcage () () ()) + #(ribcage #(step) #((top)) #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) (top) (top) (top) (top) (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage + #(orig-x) + #((top)) + #("l-*-4338"))) + (hygiene guile)) + (append + c + (list (cons '#(syntax-object + doloop + ((top) + #(ribcage + #(e1 e2) + #((top) (top)) + #("l-*-4365" "l-*-4366")) + #(ribcage () () ()) + #(ribcage + #(step) + #((top)) + #("l-*-4356")) + #(ribcage + #(var init step e0 e1 c) + #((top) + (top) + (top) + (top) + (top) + (top)) + #("l-*-4341" + "l-*-4342" + "l-*-4343" + "l-*-4344" + "l-*-4345" + "l-*-4346")) + #(ribcage () () ()) + #(ribcage + #(orig-x) + #((top)) + #("l-*-4338"))) + (hygiene guile)) + step))))))) + tmp-1) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp))))))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))) (define quasiquote (make-syntax-transformer 'quasiquote 'macro (letrec* - ((quasi-25792 - (lambda (p-25816 lev-25817) - (let ((tmp-25819 - ($sc-dispatch - p-25816 - '(#(free-id - #(syntax-object - unquote - ((top) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) (top) (top) (top) (top) (top) (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - any)))) - (if tmp-25819 - (@apply - (lambda (p-25823) - (if (= lev-25817 0) - (list '#(syntax-object - "value" - ((top) - #(ribcage #(p) #((top)) #("l-*-25560")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) (top) (top) (top) (top) (top) (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - p-25823) - (quasicons-25794 - '(#(syntax-object - "quote" - ((top) - #(ribcage #(p) #((top)) #("l-*-25560")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) (top) (top) (top) (top) (top) (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - #(syntax-object - unquote - ((top) - #(ribcage #(p) #((top)) #("l-*-25560")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) (top) (top) (top) (top) (top) (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - (quasi-25792 (list p-25823) (#{1-}# lev-25817))))) - tmp-25819) - (let ((tmp-25826 - ($sc-dispatch - p-25816 - '(#(free-id - #(syntax-object - quasiquote - ((top) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) (top) (top) (top) (top) (top) (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - any)))) - (if tmp-25826 - (@apply - (lambda (p-25830) - (quasicons-25794 - '(#(syntax-object - "quote" - ((top) - #(ribcage #(p) #((top)) #("l-*-25563")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) (top) (top) (top) (top) (top) (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - #(syntax-object - quasiquote - ((top) - #(ribcage #(p) #((top)) #("l-*-25563")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) (top) (top) (top) (top) (top) (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - (quasi-25792 (list p-25830) (#{1+}# lev-25817)))) - tmp-25826) - (let ((tmp-25833 ($sc-dispatch p-25816 '(any . any)))) - (if tmp-25833 - (@apply - (lambda (p-25837 q-25838) - (let ((tmp-25840 - ($sc-dispatch - p-25837 + ((quasi (lambda (p lev) + (let ((tmp p)) + (let ((tmp-1 ($sc-dispatch + tmp + '(#(free-id + #(syntax-object + unquote + ((top) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + any)))) + (if tmp-1 + (apply (lambda (p) + (if (= lev 0) + (list '#(syntax-object + "value" + ((top) + #(ribcage #(p) #((top)) #("l-*-4406")) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + p) + (quasicons + '(#(syntax-object + "quote" + ((top) + #(ribcage #(p) #((top)) #("l-*-4406")) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + #(syntax-object + unquote + ((top) + #(ribcage #(p) #((top)) #("l-*-4406")) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + (quasi (list p) (- lev 1))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch + tmp '(#(free-id #(syntax-object - unquote + quasiquote ((top) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25566" "l-*-25567")) #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4402" "l-*-4403")) #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) (hygiene guile))) - . - each-any)))) - (if tmp-25840 - (@apply - (lambda (p-25844) - (if (= lev-25817 0) - (quasilist*-25796 - (map (lambda (tmp-25574-25880) - (list '#(syntax-object - "value" - ((top) - #(ribcage - #(p) - #((top)) - #("l-*-25572")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25566" - "l-*-25567")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" - "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - tmp-25574-25880)) - p-25844) - (quasi-25792 q-25838 lev-25817)) - (quasicons-25794 - (quasicons-25794 - '(#(syntax-object - "quote" - ((top) - #(ribcage - #(p) - #((top)) - #("l-*-25572")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25566" "l-*-25567")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - #(syntax-object - unquote - ((top) - #(ribcage - #(p) - #((top)) - #("l-*-25572")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25566" "l-*-25567")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - (quasi-25792 - p-25844 - (#{1-}# lev-25817))) - (quasi-25792 q-25838 lev-25817)))) - tmp-25840) - (let ((tmp-25885 - ($sc-dispatch - p-25837 - '(#(free-id - #(syntax-object - unquote-splicing - ((top) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25566" "l-*-25567")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - . - each-any)))) - (if tmp-25885 - (@apply - (lambda (p-25889) - (if (= lev-25817 0) - (quasiappend-25795 - (map (lambda (tmp-25579-25892) - (list '#(syntax-object - "value" - ((top) - #(ribcage - #(p) - #((top)) - #("l-*-25577")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25566" - "l-*-25567")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" - "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - tmp-25579-25892)) - p-25889) - (quasi-25792 q-25838 lev-25817)) - (quasicons-25794 - (quasicons-25794 - '(#(syntax-object - "quote" - ((top) - #(ribcage - #(p) - #((top)) - #("l-*-25577")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25566" "l-*-25567")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - #(syntax-object - unquote-splicing - ((top) - #(ribcage - #(p) - #((top)) - #("l-*-25577")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25566" "l-*-25567")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - (quasi-25792 - p-25889 - (#{1-}# lev-25817))) - (quasi-25792 q-25838 lev-25817)))) - tmp-25885) - (quasicons-25794 - (quasi-25792 p-25837 lev-25817) - (quasi-25792 q-25838 lev-25817))))))) - tmp-25833) - (let ((tmp-25905 - ($sc-dispatch p-25816 '#(vector each-any)))) - (if tmp-25905 - (@apply - (lambda (x-25909) - (let ((x-25912 - (vquasi-25793 x-25909 lev-25817))) - (let ((tmp-25914 - ($sc-dispatch - x-25912 - '(#(atom "quote") each-any)))) - (if tmp-25914 - (@apply - (lambda (x-25916) - (list '#(syntax-object - "quote" - ((top) - #(ribcage - #(x) - #((top)) - #("l-*-25668")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25665")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - (list->vector x-25916))) - tmp-25914) - (letrec* - ((f-25917 - (lambda (y-25929 k-25930) - (let ((tmp-25932 - ($sc-dispatch - y-25929 - '(#(atom "quote") - each-any)))) - (if tmp-25932 - (@apply - (lambda (y-25935) - (k-25930 - (map (lambda (tmp-25691-25936) - (list '#(syntax-object - "quote" - ((top) - #(ribcage - #(y) - #((top)) - #("l-*-25689")) - #(ribcage - () - () - ()) - #(ribcage - #(f - y - k) - #((top) - (top) - (top)) - #("l-*-25671" - "l-*-25672" - "l-*-25673")) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-25665")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene - guile)) - tmp-25691-25936)) - y-25935))) - tmp-25932) - (let ((tmp-25937 - ($sc-dispatch - y-25929 - '(#(atom "list") - . - each-any)))) - (if tmp-25937 - (@apply - (lambda (y-25940) - (k-25930 y-25940)) - tmp-25937) - (let ((tmp-25941 - ($sc-dispatch - y-25929 - '(#(atom "list*") - . - #(each+ - any - (any) - ()))))) - (if tmp-25941 - (@apply - (lambda (y-25944 - z-25945) - (f-25917 - z-25945 - (lambda (ls-25946) - (k-25930 - (append - y-25944 - ls-25946))))) - tmp-25941) - (list '#(syntax-object - "list->vector" - ((top) - #(ribcage - () - () - ()) - #(ribcage - #(t-25706) - #((m-*-25707 - top)) - #("l-*-25710")) - #(ribcage - #(else) - #((top)) - #("l-*-25704")) - #(ribcage - () - () - ()) - #(ribcage - #(f y k) - #((top) - (top) - (top)) - #("l-*-25671" - "l-*-25672" - "l-*-25673")) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-25665")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene - guile)) - x-25912)))))))))) - (f-25917 - x-25912 - (lambda (ls-25919) - (let ((tmp-25921 - ($sc-dispatch - ls-25919 - 'each-any))) - (if tmp-25921 - (@apply - (lambda (t-25679-25924) - (cons '#(syntax-object - "vector" + any)))) + (if tmp-1 + (apply (lambda (p) + (quasicons + '(#(syntax-object + "quote" + ((top) + #(ribcage #(p) #((top)) #("l-*-4409")) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + #(syntax-object + quasiquote + ((top) + #(ribcage #(p) #((top)) #("l-*-4409")) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + (quasi (list p) (+ lev 1)))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if tmp-1 + (apply (lambda (p q) + (let ((tmp-1 p)) + (let ((tmp ($sc-dispatch + tmp-1 + '(#(free-id + #(syntax-object + unquote ((top) - #(ribcage - () - () - ()) - #(ribcage - #(t-25679) - #((m-*-25680 - top)) - #("l-*-25684")) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - () - () - ()) - #(ribcage - #(ls) - #((top)) - #("l-*-25678")) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-25665")) + #(ribcage #(p q) #((top) (top)) #("l-*-4412" "l-*-4413")) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4402" "l-*-4403")) #(ribcage (emit quasivector quasilist* @@ -24395,1006 +9263,452 @@ quasicons vquasi quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - t-25679-25924)) - tmp-25921) - (syntax-violation - #f - "source expression failed to match any pattern" - ls-25919)))))))))) - tmp-25905) - (list '#(syntax-object - "quote" - ((top) - #(ribcage #(p) #((top)) #("l-*-25585")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25556" "l-*-25557")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - p-25816))))))))))) - (vquasi-25793 - (lambda (p-25972 lev-25973) - (let ((tmp-25975 ($sc-dispatch p-25972 '(any . any)))) - (if tmp-25975 - (@apply - (lambda (p-25979 q-25980) - (let ((tmp-25982 - ($sc-dispatch - p-25979 - '(#(free-id - #(syntax-object - unquote - ((top) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25593" "l-*-25594")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25589" "l-*-25590")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - . - each-any)))) - (if tmp-25982 - (@apply - (lambda (p-25986) - (if (= lev-25973 0) - (quasilist*-25796 - (map (lambda (tmp-25601-26022) - (list '#(syntax-object - "value" + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + . + each-any)))) + (if tmp + (apply (lambda (p) + (if (= lev 0) + (quasilist* + (map (lambda (tmp) + (list '#(syntax-object + "value" + ((top) + #(ribcage #(p) #((top)) #("l-*-4418")) + #(ribcage + #(p q) + #((top) (top)) + #("l-*-4412" "l-*-4413")) + #(ribcage () () ()) + #(ribcage + #(p lev) + #((top) (top)) + #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + tmp)) + p) + (quasi q lev)) + (quasicons + (quasicons + '(#(syntax-object + "quote" + ((top) + #(ribcage #(p) #((top)) #("l-*-4418")) + #(ribcage + #(p q) + #((top) (top)) + #("l-*-4412" "l-*-4413")) + #(ribcage () () ()) + #(ribcage + #(p lev) + #((top) (top)) + #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + #(syntax-object + unquote + ((top) + #(ribcage #(p) #((top)) #("l-*-4418")) + #(ribcage + #(p q) + #((top) (top)) + #("l-*-4412" "l-*-4413")) + #(ribcage () () ()) + #(ribcage + #(p lev) + #((top) (top)) + #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + (quasi p (- lev 1))) + (quasi q lev)))) + tmp) + (let ((tmp ($sc-dispatch + tmp-1 + '(#(free-id + #(syntax-object + unquote-splicing + ((top) + #(ribcage + #(p q) + #((top) (top)) + #("l-*-4412" "l-*-4413")) + #(ribcage () () ()) + #(ribcage + #(p lev) + #((top) (top)) + #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + . + each-any)))) + (if tmp + (apply (lambda (p) + (if (= lev 0) + (quasiappend + (map (lambda (tmp) + (list '#(syntax-object + "value" + ((top) + #(ribcage #(p) #((top)) #("l-*-4423")) + #(ribcage + #(p q) + #((top) (top)) + #("l-*-4412" "l-*-4413")) + #(ribcage () () ()) + #(ribcage + #(p lev) + #((top) (top)) + #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) + (top) + (top) + (top) + (top) + (top) + (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + tmp)) + p) + (quasi q lev)) + (quasicons + (quasicons + '(#(syntax-object + "quote" + ((top) + #(ribcage #(p) #((top)) #("l-*-4423")) + #(ribcage + #(p q) + #((top) (top)) + #("l-*-4412" "l-*-4413")) + #(ribcage () () ()) + #(ribcage + #(p lev) + #((top) (top)) + #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + #(syntax-object + unquote-splicing + ((top) + #(ribcage #(p) #((top)) #("l-*-4423")) + #(ribcage + #(p q) + #((top) (top)) + #("l-*-4412" "l-*-4413")) + #(ribcage () () ()) + #(ribcage + #(p lev) + #((top) (top)) + #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + (quasi p (- lev 1))) + (quasi q lev)))) + tmp) + (quasicons (quasi p lev) (quasi q lev)))))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '#(vector each-any)))) + (if tmp-1 + (apply (lambda (x) (quasivector (vquasi x lev))) tmp-1) + (let ((p tmp)) + (list '#(syntax-object + "quote" + ((top) + #(ribcage #(p) #((top)) #("l-*-4431")) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4402" "l-*-4403")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + p))))))))))))) + (vquasi + (lambda (p lev) + (let ((tmp p)) + (let ((tmp-1 ($sc-dispatch tmp '(any . any)))) + (if tmp-1 + (apply (lambda (p q) + (let ((tmp-1 p)) + (let ((tmp ($sc-dispatch + tmp-1 + '(#(free-id + #(syntax-object + unquote ((top) - #(ribcage - #(p) - #((top)) - #("l-*-25599")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25593" "l-*-25594")) + #(ribcage #(p q) #((top) (top)) #("l-*-4439" "l-*-4440")) #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4435" "l-*-4436")) #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25589" "l-*-25590")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - tmp-25601-26022)) - p-25986) - (vquasi-25793 q-25980 lev-25973)) - (quasicons-25794 - (quasicons-25794 - '(#(syntax-object - "quote" - ((top) - #(ribcage #(p) #((top)) #("l-*-25599")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25593" "l-*-25594")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25589" "l-*-25590")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - #(syntax-object - unquote - ((top) - #(ribcage #(p) #((top)) #("l-*-25599")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25593" "l-*-25594")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25589" "l-*-25590")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - (quasi-25792 p-25986 (#{1-}# lev-25973))) - (vquasi-25793 q-25980 lev-25973)))) - tmp-25982) - (let ((tmp-26029 - ($sc-dispatch - p-25979 - '(#(free-id - #(syntax-object - unquote-splicing - ((top) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25593" "l-*-25594")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25589" "l-*-25590")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - . - each-any)))) - (if tmp-26029 - (@apply - (lambda (p-26033) - (if (= lev-25973 0) - (quasiappend-25795 - (map (lambda (tmp-25606-26036) - (list '#(syntax-object - "value" + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + . + each-any)))) + (if tmp + (apply (lambda (p) + (if (= lev 0) + (quasilist* + (map (lambda (tmp) + (list '#(syntax-object + "value" + ((top) + #(ribcage #(p) #((top)) #("l-*-4445")) + #(ribcage #(p q) #((top) (top)) #("l-*-4439" "l-*-4440")) + #(ribcage () () ()) + #(ribcage + #(p lev) + #((top) (top)) + #("l-*-4435" "l-*-4436")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + tmp)) + p) + (vquasi q lev)) + (quasicons + (quasicons + '(#(syntax-object + "quote" ((top) - #(ribcage - #(p) - #((top)) - #("l-*-25604")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25593" - "l-*-25594")) + #(ribcage #(p) #((top)) #("l-*-4445")) + #(ribcage #(p q) #((top) (top)) #("l-*-4439" "l-*-4440")) #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4435" "l-*-4436")) #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25589" - "l-*-25590")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) (hygiene guile)) - tmp-25606-26036)) - p-26033) - (vquasi-25793 q-25980 lev-25973)) - (quasicons-25794 - (quasicons-25794 - '(#(syntax-object - "quote" - ((top) - #(ribcage - #(p) - #((top)) - #("l-*-25604")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25593" "l-*-25594")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25589" "l-*-25590")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - #(syntax-object - unquote-splicing - ((top) - #(ribcage - #(p) - #((top)) - #("l-*-25604")) - #(ribcage - #(p q) - #((top) (top)) - #("l-*-25593" "l-*-25594")) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25589" "l-*-25590")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile))) - (quasi-25792 p-26033 (#{1-}# lev-25973))) - (vquasi-25793 q-25980 lev-25973)))) - tmp-26029) - (quasicons-25794 - (quasi-25792 p-25979 lev-25973) - (vquasi-25793 q-25980 lev-25973))))))) - tmp-25975) - (let ((tmp-26053 ($sc-dispatch p-25972 '()))) - (if tmp-26053 - (@apply - (lambda () - '(#(syntax-object - "quote" - ((top) - #(ribcage () () ()) - #(ribcage - #(p lev) - #((top) (top)) - #("l-*-25589" "l-*-25590")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) (top) (top) (top) (top) (top) (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - ())) - tmp-26053) - (syntax-violation - #f - "source expression failed to match any pattern" - p-25972))))))) - (quasicons-25794 - (lambda (x-26066 y-26067) - (let ((tmp-26068 (list x-26066 y-26067))) - (let ((tmp-26069 ($sc-dispatch tmp-26068 '(any any)))) - (if tmp-26069 - (@apply - (lambda (x-26071 y-26072) - (let ((tmp-26074 - ($sc-dispatch y-26072 '(#(atom "quote") any)))) - (if tmp-26074 - (@apply - (lambda (dy-26078) - (let ((tmp-26080 - ($sc-dispatch - x-26071 - '(#(atom "quote") any)))) - (if tmp-26080 - (@apply - (lambda (dx-26082) - (list '#(syntax-object - "quote" - ((top) - #(ribcage - #(dx) - #((top)) - #("l-*-25626")) - #(ribcage - #(dy) - #((top)) - #("l-*-25622")) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25616" "l-*-25617")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25611" "l-*-25612")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - (cons dx-26082 dy-26078))) - tmp-26080) - (if (null? dy-26078) - (list '#(syntax-object - "list" - ((top) - #(ribcage - #(dy) - #((top)) - #("l-*-25622")) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25616" "l-*-25617")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25611" "l-*-25612")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - x-26071) - (list '#(syntax-object - "list*" - ((top) - #(ribcage - #(dy) - #((top)) - #("l-*-25622")) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25616" "l-*-25617")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25611" "l-*-25612")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - x-26071 - y-26072))))) - tmp-26074) - (let ((tmp-26084 - ($sc-dispatch - y-26072 - '(#(atom "list") . any)))) - (if tmp-26084 - (@apply - (lambda (stuff-26088) - (cons '#(syntax-object - "list" - ((top) - #(ribcage - #(stuff) - #((top)) - #("l-*-25629")) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25616" "l-*-25617")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25611" "l-*-25612")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - (cons x-26071 stuff-26088))) - tmp-26084) - (let ((tmp-26089 - ($sc-dispatch - y-26072 - '(#(atom "list*") . any)))) - (if tmp-26089 - (@apply - (lambda (stuff-26093) - (cons '#(syntax-object - "list*" - ((top) - #(ribcage - #(stuff) - #((top)) - #("l-*-25632")) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25616" "l-*-25617")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25611" "l-*-25612")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - (cons x-26071 stuff-26093))) - tmp-26089) - (list '#(syntax-object - "list*" - ((top) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25616" "l-*-25617")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25611" "l-*-25612")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - x-26071 - y-26072)))))))) - tmp-26069) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-26068)))))) - (quasiappend-25795 - (lambda (x-26103 y-26104) - (let ((tmp-26106 - ($sc-dispatch y-26104 '(#(atom "quote") ())))) - (if tmp-26106 - (@apply - (lambda () - (if (null? x-26103) - '(#(syntax-object - "quote" - ((top) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25636" "l-*-25637")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) (top) (top) (top) (top) (top) (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - ()) - (if (null? (cdr x-26103)) - (car x-26103) - (let ((tmp-26109 ($sc-dispatch x-26103 'each-any))) - (if tmp-26109 - (@apply - (lambda (p-26113) - (cons '#(syntax-object - "append" - ((top) - #(ribcage () () ()) - #(ribcage - #(p) - #((top)) - #("l-*-25644")) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25636" "l-*-25637")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - p-26113)) - tmp-26109) - (syntax-violation - #f - "source expression failed to match any pattern" - x-26103)))))) - tmp-26106) - (if (null? x-26103) - y-26104 - (let ((tmp-26120 (list x-26103 y-26104))) - (let ((tmp-26121 - ($sc-dispatch tmp-26120 '(each-any any)))) - (if tmp-26121 - (@apply - (lambda (p-26123 y-26124) - (cons '#(syntax-object - "append" - ((top) - #(ribcage () () ()) - #(ribcage - #(p y) - #((top) (top)) - #("l-*-25651" "l-*-25652")) - #(ribcage () () ()) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25636" "l-*-25637")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - (append p-26123 (list y-26124)))) - tmp-26121) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-26120))))))))) - (quasilist*-25796 - (lambda (x-26126 y-26127) - (letrec* - ((f-26128 - (lambda (x-26217) - (if (null? x-26217) - y-26127 - (quasicons-25794 - (car x-26217) - (f-26128 (cdr x-26217))))))) - (f-26128 x-26126)))) - (emit-25798 - (lambda (x-26220) - (let ((tmp-26222 - ($sc-dispatch x-26220 '(#(atom "quote") any)))) - (if tmp-26222 - (@apply - (lambda (x-26226) - (list '#(syntax-object - quote - ((top) - #(ribcage #(x) #((top)) #("l-*-25716")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-25713")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) (top) (top) (top) (top) (top) (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - x-26226)) - tmp-26222) - (let ((tmp-26227 - ($sc-dispatch - x-26220 - '(#(atom "list") . each-any)))) - (if tmp-26227 - (@apply - (lambda (x-26231) - (let ((tmp-26232 (map emit-25798 x-26231))) - (let ((tmp-26233 ($sc-dispatch tmp-26232 'each-any))) - (if tmp-26233 - (@apply - (lambda (t-25721-26235) - (cons '#(syntax-object - list - ((top) - #(ribcage () () ()) - #(ribcage - #(t-25721) - #((m-*-25722 top)) - #("l-*-25726")) - #(ribcage - #(x) - #((top)) - #("l-*-25719")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25713")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - t-25721-26235)) - tmp-26233) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-26232))))) - tmp-26227) - (let ((tmp-26236 - ($sc-dispatch - x-26220 - '(#(atom "list*") . #(each+ any (any) ()))))) - (if tmp-26236 - (@apply - (lambda (x-26240 y-26241) - (letrec* - ((f-26242 - (lambda (x*-26245) - (if (null? x*-26245) - (emit-25798 y-26241) - (let ((tmp-26246 - (list (emit-25798 (car x*-26245)) - (f-26242 (cdr x*-26245))))) - (let ((tmp-26247 - ($sc-dispatch - tmp-26246 - '(any any)))) - (if tmp-26247 - (@apply - (lambda (t-25741-26249 - t-25740-26250) - (list '#(syntax-object - cons + #(syntax-object + unquote + ((top) + #(ribcage #(p) #((top)) #("l-*-4445")) + #(ribcage #(p q) #((top) (top)) #("l-*-4439" "l-*-4440")) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4435" "l-*-4436")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + (quasi p (- lev 1))) + (vquasi q lev)))) + tmp) + (let ((tmp ($sc-dispatch + tmp-1 + '(#(free-id + #(syntax-object + unquote-splicing + ((top) + #(ribcage #(p q) #((top) (top)) #("l-*-4439" "l-*-4440")) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4435" "l-*-4436")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + . + each-any)))) + (if tmp + (apply (lambda (p) + (if (= lev 0) + (quasiappend + (map (lambda (tmp) + (list '#(syntax-object + "value" + ((top) + #(ribcage #(p) #((top)) #("l-*-4450")) + #(ribcage + #(p q) + #((top) (top)) + #("l-*-4439" "l-*-4440")) + #(ribcage () () ()) + #(ribcage + #(p lev) + #((top) (top)) + #("l-*-4435" "l-*-4436")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + tmp)) + p) + (vquasi q lev)) + (quasicons + (quasicons + '(#(syntax-object + "quote" ((top) + #(ribcage #(p) #((top)) #("l-*-4450")) + #(ribcage #(p q) #((top) (top)) #("l-*-4439" "l-*-4440")) #(ribcage () () ()) - #(ribcage - #(t-25741 t-25740) - #((m-*-25742 top) - (m-*-25742 top)) - #("l-*-25746" - "l-*-25747")) - #(ribcage () () ()) - #(ribcage - #(f x*) - #((top) (top)) - #("l-*-25735" - "l-*-25736")) - #(ribcage - #(x y) - #((top) (top)) - #("l-*-25731" - "l-*-25732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25713")) + #(ribcage #(p lev) #((top) (top)) #("l-*-4435" "l-*-4436")) #(ribcage (emit quasivector quasilist* @@ -25402,121 +9716,183 @@ quasicons vquasi quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) (hygiene guile)) - t-25741-26249 - t-25740-26250)) - tmp-26247) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-26246)))))))) - (f-26242 x-26240))) - tmp-26236) - (let ((tmp-26251 - ($sc-dispatch - x-26220 - '(#(atom "append") . each-any)))) - (if tmp-26251 - (@apply - (lambda (x-26255) - (let ((tmp-26256 (map emit-25798 x-26255))) - (let ((tmp-26257 - ($sc-dispatch tmp-26256 'each-any))) - (if tmp-26257 - (@apply - (lambda (t-25753-26259) - (cons '#(syntax-object - append - ((top) - #(ribcage () () ()) - #(ribcage - #(t-25753) - #((m-*-25754 top)) - #("l-*-25758")) - #(ribcage - #(x) - #((top)) - #("l-*-25751")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25713")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - t-25753-26259)) - tmp-26257) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-26256))))) - tmp-26251) - (let ((tmp-26260 - ($sc-dispatch - x-26220 - '(#(atom "vector") . each-any)))) - (if tmp-26260 - (@apply - (lambda (x-26264) - (let ((tmp-26265 (map emit-25798 x-26264))) - (let ((tmp-26266 - ($sc-dispatch - tmp-26265 - 'each-any))) - (if tmp-26266 - (@apply - (lambda (t-25765-26268) + #(syntax-object + unquote-splicing + ((top) + #(ribcage #(p) #((top)) #("l-*-4450")) + #(ribcage #(p q) #((top) (top)) #("l-*-4439" "l-*-4440")) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4435" "l-*-4436")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile))) + (quasi p (- lev 1))) + (vquasi q lev)))) + tmp) + (quasicons (quasi p lev) (vquasi q lev)))))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '()))) + (if tmp-1 + (apply (lambda () + '(#(syntax-object + "quote" + ((top) + #(ribcage () () ()) + #(ribcage #(p lev) #((top) (top)) #("l-*-4435" "l-*-4436")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + ())) + tmp-1) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp)))))))) + (quasicons + (lambda (x y) + (let ((tmp-1 (list x y))) + (let ((tmp ($sc-dispatch tmp-1 '(any any)))) + (if tmp + (apply (lambda (x y) + (let ((tmp y)) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") any)))) + (if tmp-1 + (apply (lambda (dy) + (let ((tmp x)) + (let ((tmp ($sc-dispatch tmp '(#(atom "quote") any)))) + (if tmp + (apply (lambda (dx) + (list '#(syntax-object + "quote" + ((top) + #(ribcage #(dx) #((top)) #("l-*-4472")) + #(ribcage #(dy) #((top)) #("l-*-4468")) + #(ribcage () () ()) + #(ribcage + #(x y) + #((top) (top)) + #("l-*-4462" "l-*-4463")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage + #(x y) + #((top) (top)) + #("l-*-4457" "l-*-4458")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + (cons dx dy))) + tmp) + (if (null? dy) + (list '#(syntax-object + "list" + ((top) + #(ribcage #(dy) #((top)) #("l-*-4468")) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4462" "l-*-4463")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4457" "l-*-4458")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + x) + (list '#(syntax-object + "list*" + ((top) + #(ribcage #(dy) #((top)) #("l-*-4468")) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4462" "l-*-4463")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4457" "l-*-4458")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + x + y)))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") . any)))) + (if tmp-1 + (apply (lambda (stuff) (cons '#(syntax-object - vector + "list" ((top) + #(ribcage #(stuff) #((top)) #("l-*-4475")) #(ribcage () () ()) - #(ribcage - #(t-25765) - #((m-*-25766 top)) - #("l-*-25770")) - #(ribcage - #(x) - #((top)) - #("l-*-25763")) + #(ribcage #(x y) #((top) (top)) #("l-*-4462" "l-*-4463")) #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25713")) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4457" "l-*-4458")) #(ribcage (emit quasivector quasilist* @@ -25524,1367 +9900,1358 @@ quasicons vquasi quasi) - ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) (hygiene guile)) - t-25765-26268)) - tmp-26266) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-26265))))) - tmp-26260) - (let ((tmp-26269 - ($sc-dispatch - x-26220 - '(#(atom "list->vector") any)))) - (if tmp-26269 - (@apply - (lambda (x-26273) - (let ((tmp-26274 (emit-25798 x-26273))) - (list '#(syntax-object - list->vector - ((top) - #(ribcage () () ()) - #(ribcage - #(t-25777) - #((m-*-25778 top)) - #("l-*-25781")) - #(ribcage - #(x) - #((top)) - #("l-*-25775")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-25713")) - #(ribcage - (emit quasivector - quasilist* - quasiappend - quasicons - vquasi - quasi) + (cons x stuff))) + tmp-1) + (let ((tmp ($sc-dispatch tmp '(#(atom "list*") . any)))) + (if tmp + (apply (lambda (stuff) + (cons '#(syntax-object + "list*" + ((top) + #(ribcage #(stuff) #((top)) #("l-*-4478")) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4462" "l-*-4463")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4457" "l-*-4458")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + (cons x stuff))) + tmp) + (list '#(syntax-object + "list*" + ((top) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4462" "l-*-4463")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4457" "l-*-4458")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + x + y))))))))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))))) + (quasiappend + (lambda (x y) + (let ((tmp y)) + (let ((tmp ($sc-dispatch tmp '(#(atom "quote") ())))) + (if tmp + (apply (lambda () + (if (null? x) + '(#(syntax-object + "quote" + ((top) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4482" "l-*-4483")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + ()) + (if (null? (cdr x)) + (car x) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 'each-any))) + (if tmp + (apply (lambda (p) + (cons '#(syntax-object + "append" + ((top) + #(ribcage () () ()) + #(ribcage #(p) #((top)) #("l-*-4490")) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4482" "l-*-4483")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + p)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))) + tmp) + (if (null? x) + y + (let ((tmp-1 (list x y))) + (let ((tmp ($sc-dispatch tmp-1 '(each-any any)))) + (if tmp + (apply (lambda (p y) + (cons '#(syntax-object + "append" + ((top) + #(ribcage () () ()) + #(ribcage #(p y) #((top) (top)) #("l-*-4497" "l-*-4498")) + #(ribcage () () ()) + #(ribcage #(x y) #((top) (top)) #("l-*-4482" "l-*-4483")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + (append p (list y)))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))))))))) + (quasilist* + (lambda (x y) + (let f ((x x)) (if (null? x) y (quasicons (car x) (f (cdr x))))))) + (quasivector + (lambda (x) + (let ((tmp x)) + (let ((tmp ($sc-dispatch tmp '(#(atom "quote") each-any)))) + (if tmp + (apply (lambda (x) + (list '#(syntax-object + "quote" + ((top) + #(ribcage #(x) #((top)) #("l-*-4514")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4511")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + (list->vector x))) + tmp) + (let f ((y x) + (k (lambda (ls) + (let ((tmp-1 ls)) + (let ((tmp ($sc-dispatch tmp-1 'each-any))) + (if tmp + (apply (lambda (t) + (cons '#(syntax-object + "vector" + ((top) + #(ribcage () () ()) + #(ribcage #(t-4525) #((m-*-4526 top)) #("l-*-4530")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(ls) #((top)) #("l-*-4524")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4511")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + t)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))) + (let ((tmp y)) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") each-any)))) + (if tmp-1 + (apply (lambda (y) + (k (map (lambda (tmp) + (list '#(syntax-object + "quote" ((top) - (top) - (top) - (top) - (top) - (top) - (top)) - ("l-*-25552" - "l-*-25550" - "l-*-25548" - "l-*-25546" - "l-*-25544" - "l-*-25542" - "l-*-25540"))) - (hygiene guile)) - tmp-26274))) - tmp-26269) - (let ((tmp-26277 - ($sc-dispatch - x-26220 - '(#(atom "value") any)))) - (if tmp-26277 - (@apply - (lambda (x-26281) x-26281) - tmp-26277) - (syntax-violation - #f - "source expression failed to match any pattern" - x-26220)))))))))))))))))) - (lambda (x-25799) - (let ((tmp-25801 ($sc-dispatch x-25799 '(_ any)))) - (if tmp-25801 - (@apply - (lambda (e-25805) - (emit-25798 (quasi-25792 e-25805 0))) - tmp-25801) - (syntax-violation - #f - "source expression failed to match any pattern" - x-25799))))))) + #(ribcage #(y) #((top)) #("l-*-4535")) + #(ribcage () () ()) + #(ribcage + #(f y k) + #((top) (top) (top)) + #("l-*-4517" "l-*-4518" "l-*-4519")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4511")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + tmp)) + y))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") . each-any)))) + (if tmp-1 + (apply (lambda (y) (k y)) tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list*") . #(each+ any (any) ()))))) + (if tmp-1 + (apply (lambda (y z) (f z (lambda (ls) (k (append y ls))))) tmp-1) + (let ((else tmp)) + (let ((tmp x)) + (let ((t tmp)) + (list '#(syntax-object + "list->vector" + ((top) + #(ribcage () () ()) + #(ribcage #(t-4552) #((m-*-4553 top)) #("l-*-4556")) + #(ribcage #(else) #((top)) #("l-*-4550")) + #(ribcage () () ()) + #(ribcage + #(f y k) + #((top) (top) (top)) + #("l-*-4517" "l-*-4518" "l-*-4519")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4511")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + t))))))))))))))))) + (emit (lambda (x) + (let ((tmp x)) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") any)))) + (if tmp-1 + (apply (lambda (x) + (list '#(syntax-object + quote + ((top) + #(ribcage #(x) #((top)) #("l-*-4562")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4559")) + #(ribcage + (emit quasivector quasilist* quasiappend quasicons vquasi quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + x)) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") . each-any)))) + (if tmp-1 + (apply (lambda (x) + (let ((tmp-1 (map emit x))) + (let ((tmp ($sc-dispatch tmp-1 'each-any))) + (if tmp + (apply (lambda (t) + (cons '#(syntax-object + list + ((top) + #(ribcage () () ()) + #(ribcage #(t-4567) #((m-*-4568 top)) #("l-*-4572")) + #(ribcage #(x) #((top)) #("l-*-4565")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4559")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + t)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list*") . #(each+ any (any) ()))))) + (if tmp-1 + (apply (lambda (x y) + (let f ((x* x)) + (if (null? x*) + (emit y) + (let ((tmp-1 (list (emit (car x*)) (f (cdr x*))))) + (let ((tmp ($sc-dispatch tmp-1 '(any any)))) + (if tmp + (apply (lambda (t-1 t) + (list '#(syntax-object + cons + ((top) + #(ribcage () () ()) + #(ribcage + #(t-4587 t-4586) + #((m-*-4588 top) (m-*-4588 top)) + #("l-*-4592" "l-*-4593")) + #(ribcage () () ()) + #(ribcage + #(f x*) + #((top) (top)) + #("l-*-4581" "l-*-4582")) + #(ribcage + #(x y) + #((top) (top)) + #("l-*-4577" "l-*-4578")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4559")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + t-1 + t)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "append") . each-any)))) + (if tmp-1 + (apply (lambda (x) + (let ((tmp-1 (map emit x))) + (let ((tmp ($sc-dispatch tmp-1 'each-any))) + (if tmp + (apply (lambda (t) + (cons '#(syntax-object + append + ((top) + #(ribcage () () ()) + #(ribcage #(t-4599) #((m-*-4600 top)) #("l-*-4604")) + #(ribcage #(x) #((top)) #("l-*-4597")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4559")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + t)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "vector") . each-any)))) + (if tmp-1 + (apply (lambda (x) + (let ((tmp-1 (map emit x))) + (let ((tmp ($sc-dispatch tmp-1 'each-any))) + (if tmp + (apply (lambda (t) + (cons '#(syntax-object + vector + ((top) + #(ribcage () () ()) + #(ribcage + #(t-4611) + #((m-*-4612 top)) + #("l-*-4616")) + #(ribcage #(x) #((top)) #("l-*-4609")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4559")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + t)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list->vector") any)))) + (if tmp-1 + (apply (lambda (x) + (let ((tmp (emit x))) + (let ((t tmp)) + (list '#(syntax-object + list->vector + ((top) + #(ribcage () () ()) + #(ribcage #(t-4623) #((m-*-4624 top)) #("l-*-4627")) + #(ribcage #(x) #((top)) #("l-*-4621")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4559")) + #(ribcage + (emit quasivector + quasilist* + quasiappend + quasicons + vquasi + quasi) + ((top) (top) (top) (top) (top) (top) (top)) + ("l-*-4398" + "l-*-4396" + "l-*-4394" + "l-*-4392" + "l-*-4390" + "l-*-4388" + "l-*-4386"))) + (hygiene guile)) + t)))) + tmp-1) + (let ((tmp-1 ($sc-dispatch tmp '(#(atom "value") any)))) + (if tmp-1 + (apply (lambda (x) x) tmp-1) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp))))))))))))))))))) + (lambda (x) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 '(_ any)))) + (if tmp + (apply (lambda (e) (emit (quasi e 0))) tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))))))) (define include (make-syntax-transformer 'include 'macro - (lambda (x-26336) + (lambda (x) (letrec* - ((read-file-26337 - (lambda (fn-26446 k-26447) - (let ((p-26448 (open-input-file fn-26446))) - (letrec* - ((f-26449 - (lambda (x-26503 result-26504) - (if (eof-object? x-26503) - (begin - (close-input-port p-26448) - (reverse result-26504)) - (f-26449 - (read p-26448) - (cons (datum->syntax k-26447 x-26503) - result-26504)))))) - (f-26449 (read p-26448) '())))))) - (let ((tmp-26339 ($sc-dispatch x-26336 '(any any)))) - (if tmp-26339 - (@apply - (lambda (k-26343 filename-26344) - (let ((fn-26345 (syntax->datum filename-26344))) - (let ((tmp-26346 - (read-file-26337 fn-26345 filename-26344))) - (let ((tmp-26347 ($sc-dispatch tmp-26346 'each-any))) - (if tmp-26347 - (@apply - (lambda (exp-26365) - (cons '#(syntax-object - begin - ((top) - #(ribcage () () ()) - #(ribcage #(exp) #((top)) #("l-*-26333")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage #(fn) #((top)) #("l-*-26328")) - #(ribcage - #(k filename) - #((top) (top)) - #("l-*-26324" "l-*-26325")) - #(ribcage - (read-file) - ((top)) - ("l-*-26308")) - #(ribcage #(x) #((top)) #("l-*-26307"))) - (hygiene guile)) - exp-26365)) - tmp-26347) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-26346)))))) - tmp-26339) - (syntax-violation - #f - "source expression failed to match any pattern" - x-26336))))))) + ((read-file + (lambda (fn k) + (let ((p (open-input-file fn))) + (let f ((x (read p)) (result '())) + (if (eof-object? x) + (begin (close-input-port p) (reverse result)) + (f (read p) (cons (datum->syntax k x) result)))))))) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 '(any any)))) + (if tmp + (apply (lambda (k filename) + (let ((fn (syntax->datum filename))) + (let ((tmp-1 (read-file fn filename))) + (let ((tmp ($sc-dispatch tmp-1 'each-any))) + (if tmp + (apply (lambda (exp) + (cons '#(syntax-object + begin + ((top) + #(ribcage () () ()) + #(ribcage #(exp) #((top)) #("l-*-4665")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(fn) #((top)) #("l-*-4660")) + #(ribcage #(k filename) #((top) (top)) #("l-*-4656" "l-*-4657")) + #(ribcage (read-file) ((top)) ("l-*-4640")) + #(ribcage #(x) #((top)) #("l-*-4639"))) + (hygiene guile)) + exp)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))))))) (define include-from-path (make-syntax-transformer 'include-from-path 'macro - (lambda (x-26523) - (let ((tmp-26525 ($sc-dispatch x-26523 '(any any)))) - (if tmp-26525 - (@apply - (lambda (k-26529 filename-26530) - (let ((fn-26531 (syntax->datum filename-26530))) - (let ((tmp-26532 - (datum->syntax - filename-26530 - (let ((t-26535 (%search-load-path fn-26531))) - (if t-26535 - t-26535 - (syntax-violation - 'include-from-path - "file not found in path" - x-26523 - filename-26530)))))) - (list '#(syntax-object - include - ((top) - #(ribcage () () ()) - #(ribcage #(fn) #((top)) #("l-*-26517")) - #(ribcage () () ()) - #(ribcage () () ()) - #(ribcage #(fn) #((top)) #("l-*-26513")) - #(ribcage - #(k filename) - #((top) (top)) - #("l-*-26509" "l-*-26510")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26506"))) - (hygiene guile)) - tmp-26532)))) - tmp-26525) - (syntax-violation - #f - "source expression failed to match any pattern" - x-26523)))))) + (lambda (x) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 '(any any)))) + (if tmp + (apply (lambda (k filename) + (let ((fn (syntax->datum filename))) + (let ((tmp (datum->syntax + filename + (let ((t (%search-load-path fn))) + (if t + t + (syntax-violation + 'include-from-path + "file not found in path" + x + filename)))))) + (let ((fn tmp)) + (list '#(syntax-object + include + ((top) + #(ribcage () () ()) + #(ribcage #(fn) #((top)) #("l-*-4680")) + #(ribcage () () ()) + #(ribcage () () ()) + #(ribcage #(fn) #((top)) #("l-*-4676")) + #(ribcage #(k filename) #((top) (top)) #("l-*-4672" "l-*-4673")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4669"))) + (hygiene guile)) + fn))))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))) (define unquote (make-syntax-transformer 'unquote 'macro - (lambda (x-26544) + (lambda (x) (syntax-violation 'unquote "expression not valid outside of quasiquote" - x-26544)))) + x)))) (define unquote-splicing (make-syntax-transformer 'unquote-splicing 'macro - (lambda (x-26547) + (lambda (x) (syntax-violation 'unquote-splicing "expression not valid outside of quasiquote" - x-26547)))) + x)))) (define case (make-syntax-transformer 'case 'macro - (lambda (x-26599) - (let ((tmp-26601 - ($sc-dispatch x-26599 '(_ any any . each-any)))) - (if tmp-26601 - (@apply - (lambda (e-26605 m1-26606 m2-26607) - (let ((tmp-26608 - (letrec* - ((f-26652 - (lambda (clause-26655 clauses-26656) - (if (null? clauses-26656) - (let ((tmp-26658 - ($sc-dispatch - clause-26655 - '(#(free-id - #(syntax-object - else - ((top) - #(ribcage () () ()) - #(ribcage - #(f clause clauses) - #((top) (top) (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) (top) (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile))) - any - . - each-any)))) - (if tmp-26658 - (@apply - (lambda (e1-26662 e2-26663) - (cons '#(syntax-object - begin - ((top) - #(ribcage - #(e1 e2) - #((top) (top)) - #("l-*-26571" "l-*-26572")) - #(ribcage () () ()) - #(ribcage - #(f clause clauses) - #((top) (top) (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) (top) (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) - (cons e1-26662 e2-26663))) - tmp-26658) - (let ((tmp-26664 - ($sc-dispatch - clause-26655 - '(each-any any . each-any)))) - (if tmp-26664 - (@apply - (lambda (k-26668 e1-26669 e2-26670) - (list '#(syntax-object - if - ((top) - #(ribcage - #(k e1 e2) - #((top) (top) (top)) - #("l-*-26577" - "l-*-26578" - "l-*-26579")) - #(ribcage () () ()) - #(ribcage - #(f clause clauses) - #((top) (top) (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) (top) (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) - (list '#(syntax-object - memv - ((top) - #(ribcage - #(k e1 e2) - #((top) - (top) - (top)) - #("l-*-26577" - "l-*-26578" - "l-*-26579")) - #(ribcage () () ()) - #(ribcage - #(f - clause - clauses) - #((top) - (top) - (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) - (top) - (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) - '#(syntax-object - t - ((top) - #(ribcage - #(k e1 e2) - #((top) - (top) - (top)) - #("l-*-26577" - "l-*-26578" - "l-*-26579")) - #(ribcage () () ()) - #(ribcage - #(f - clause - clauses) - #((top) - (top) - (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) - (top) - (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) + (lambda (x) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 '(_ any any . each-any)))) + (if tmp + (apply (lambda (e m1 m2) + (let ((tmp (let f ((clause m1) (clauses m2)) + (if (null? clauses) + (let ((tmp-1 clause)) + (let ((tmp ($sc-dispatch + tmp-1 + '(#(free-id + #(syntax-object + else + ((top) + #(ribcage () () ()) + #(ribcage + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile))) + any + . + each-any)))) + (if tmp + (apply (lambda (e1 e2) + (cons '#(syntax-object + begin + ((top) + #(ribcage #(e1 e2) #((top) (top)) #("l-*-4713" "l-*-4714")) + #(ribcage () () ()) + #(ribcage + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + (cons e1 e2))) + tmp) + (let ((tmp ($sc-dispatch tmp-1 '(each-any any . each-any)))) + (if tmp + (apply (lambda (k e1 e2) (list '#(syntax-object - quote + if ((top) #(ribcage #(k e1 e2) - #((top) - (top) - (top)) - #("l-*-26577" - "l-*-26578" - "l-*-26579")) + #((top) (top) (top)) + #("l-*-4719" "l-*-4720" "l-*-4721")) + #(ribcage () () ()) #(ribcage - () - () - ()) - #(ribcage - #(f - clause - clauses) - #((top) - (top) - (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) #(ribcage #(e m1 m2) - #((top) - (top) - (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + (list '#(syntax-object + memv + ((top) + #(ribcage + #(k e1 e2) + #((top) (top) (top)) + #("l-*-4719" "l-*-4720" "l-*-4721")) + #(ribcage () () ()) + #(ribcage + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + '#(syntax-object + t + ((top) + #(ribcage + #(k e1 e2) + #((top) (top) (top)) + #("l-*-4719" "l-*-4720" "l-*-4721")) + #(ribcage () () ()) + #(ribcage + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + (list '#(syntax-object + quote + ((top) + #(ribcage + #(k e1 e2) + #((top) (top) (top)) + #("l-*-4719" "l-*-4720" "l-*-4721")) + #(ribcage () () ()) + #(ribcage + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + k)) + (cons '#(syntax-object + begin + ((top) + #(ribcage + #(k e1 e2) + #((top) (top) (top)) + #("l-*-4719" "l-*-4720" "l-*-4721")) + #(ribcage () () ()) + #(ribcage + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + (cons e1 e2)))) + tmp) + (syntax-violation 'case "bad clause" x clause)))))) + (let ((tmp (f (car clauses) (cdr clauses)))) + (let ((rest tmp)) + (let ((tmp clause)) + (let ((tmp ($sc-dispatch tmp '(each-any any . each-any)))) + (if tmp + (apply (lambda (k e1 e2) + (list '#(syntax-object + if + ((top) #(ribcage - () - () - ()) + #(k e1 e2) + #((top) (top) (top)) + #("l-*-4733" "l-*-4734" "l-*-4735")) + #(ribcage () () ()) + #(ribcage #(rest) #((top)) #("l-*-4729")) + #(ribcage () () ()) #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene - guile)) - k-26668)) - (cons '#(syntax-object - begin - ((top) - #(ribcage - #(k e1 e2) - #((top) - (top) - (top)) - #("l-*-26577" - "l-*-26578" - "l-*-26579")) - #(ribcage () () ()) - #(ribcage - #(f - clause - clauses) - #((top) - (top) - (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) - (top) - (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) - (cons e1-26669 - e2-26670)))) - tmp-26664) - (syntax-violation - 'case - "bad clause" - x-26599 - clause-26655))))) - (let ((tmp-26677 - (f-26652 - (car clauses-26656) - (cdr clauses-26656)))) - (let ((tmp-26680 - ($sc-dispatch - clause-26655 - '(each-any any . each-any)))) - (if tmp-26680 - (@apply - (lambda (k-26682 e1-26683 e2-26684) - (list '#(syntax-object - if - ((top) - #(ribcage - #(k e1 e2) - #((top) (top) (top)) - #("l-*-26591" - "l-*-26592" - "l-*-26593")) - #(ribcage () () ()) - #(ribcage - #(rest) - #((top)) - #("l-*-26587")) - #(ribcage () () ()) - #(ribcage - #(f clause clauses) - #((top) (top) (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) (top) (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) - (list '#(syntax-object - memv - ((top) - #(ribcage - #(k e1 e2) - #((top) (top) (top)) - #("l-*-26591" - "l-*-26592" - "l-*-26593")) - #(ribcage () () ()) - #(ribcage - #(rest) - #((top)) - #("l-*-26587")) - #(ribcage () () ()) - #(ribcage - #(f clause clauses) - #((top) (top) (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) (top) (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) - '#(syntax-object - t - ((top) - #(ribcage - #(k e1 e2) - #((top) (top) (top)) - #("l-*-26591" - "l-*-26592" - "l-*-26593")) - #(ribcage () () ()) - #(ribcage - #(rest) - #((top)) - #("l-*-26587")) - #(ribcage () () ()) - #(ribcage - #(f clause clauses) - #((top) (top) (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) (top) (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) - (list '#(syntax-object - quote - ((top) - #(ribcage - #(k e1 e2) - #((top) - (top) - (top)) - #("l-*-26591" - "l-*-26592" - "l-*-26593")) - #(ribcage - () - () - ()) - #(ribcage - #(rest) - #((top)) - #("l-*-26587")) - #(ribcage - () - () - ()) - #(ribcage - #(f - clause - clauses) - #((top) - (top) - (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) - (top) - (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage - () - () - ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) - k-26682)) - (cons '#(syntax-object - begin - ((top) - #(ribcage - #(k e1 e2) - #((top) (top) (top)) - #("l-*-26591" - "l-*-26592" - "l-*-26593")) - #(ribcage () () ()) - #(ribcage - #(rest) - #((top)) - #("l-*-26587")) - #(ribcage () () ()) - #(ribcage - #(f clause clauses) - #((top) (top) (top)) - #("l-*-26562" - "l-*-26563" - "l-*-26564")) - #(ribcage - #(e m1 m2) - #((top) (top) (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) - (cons e1-26683 e2-26684)) - tmp-26677)) - tmp-26680) - (syntax-violation - 'case - "bad clause" - x-26599 - clause-26655)))))))) - (f-26652 m1-26606 m2-26607)))) - (let ((body-26609 tmp-26608)) - (list '#(syntax-object - let - ((top) - #(ribcage () () ()) - #(ribcage #(body) #((top)) #("l-*-26560")) - #(ribcage - #(e m1 m2) - #((top) (top) (top)) - #("l-*-26552" "l-*-26553" "l-*-26554")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26549"))) - (hygiene guile)) - (list (list '#(syntax-object - t - ((top) - #(ribcage () () ()) - #(ribcage - #(body) - #((top)) - #("l-*-26560")) - #(ribcage - #(e m1 m2) - #((top) (top) (top)) - #("l-*-26552" - "l-*-26553" - "l-*-26554")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26549"))) - (hygiene guile)) - e-26605)) - body-26609)))) - tmp-26601) - (syntax-violation - #f - "source expression failed to match any pattern" - x-26599)))))) + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + (list '#(syntax-object + memv + ((top) + #(ribcage + #(k e1 e2) + #((top) (top) (top)) + #("l-*-4733" "l-*-4734" "l-*-4735")) + #(ribcage () () ()) + #(ribcage #(rest) #((top)) #("l-*-4729")) + #(ribcage () () ()) + #(ribcage + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + '#(syntax-object + t + ((top) + #(ribcage + #(k e1 e2) + #((top) (top) (top)) + #("l-*-4733" "l-*-4734" "l-*-4735")) + #(ribcage () () ()) + #(ribcage #(rest) #((top)) #("l-*-4729")) + #(ribcage () () ()) + #(ribcage + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + (list '#(syntax-object + quote + ((top) + #(ribcage + #(k e1 e2) + #((top) (top) (top)) + #("l-*-4733" "l-*-4734" "l-*-4735")) + #(ribcage () () ()) + #(ribcage #(rest) #((top)) #("l-*-4729")) + #(ribcage () () ()) + #(ribcage + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + k)) + (cons '#(syntax-object + begin + ((top) + #(ribcage + #(k e1 e2) + #((top) (top) (top)) + #("l-*-4733" "l-*-4734" "l-*-4735")) + #(ribcage () () ()) + #(ribcage #(rest) #((top)) #("l-*-4729")) + #(ribcage () () ()) + #(ribcage + #(f clause clauses) + #((top) (top) (top)) + #("l-*-4704" "l-*-4705" "l-*-4706")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + (cons e1 e2)) + rest)) + tmp) + (syntax-violation 'case "bad clause" x clause)))))))))) + (let ((body tmp)) + (list '#(syntax-object + let + ((top) + #(ribcage () () ()) + #(ribcage #(body) #((top)) #("l-*-4702")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + (list (list '#(syntax-object + t + ((top) + #(ribcage () () ()) + #(ribcage #(body) #((top)) #("l-*-4702")) + #(ribcage + #(e m1 m2) + #((top) (top) (top)) + #("l-*-4694" "l-*-4695" "l-*-4696")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4691"))) + (hygiene guile)) + e)) + body)))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))) (define make-variable-transformer - (lambda (proc-26699) - (if (procedure? proc-26699) - (letrec* - ((trans-26700 - (lambda (x-26706) (proc-26699 x-26706)))) - (begin - (set-procedure-property! - trans-26700 - 'variable-transformer - #t) - trans-26700)) - (error "variable transformer not a procedure" - proc-26699)))) + (lambda (proc) + (if (procedure? proc) + (let ((trans (lambda (x) (proc x)))) + (set-procedure-property! trans 'variable-transformer #t) + trans) + (error "variable transformer not a procedure" proc)))) (define identifier-syntax (make-syntax-transformer 'identifier-syntax 'macro - (lambda (x-26738) - (let ((tmp-26740 ($sc-dispatch x-26738 '(_ any)))) - (if tmp-26740 - (@apply - (lambda (e-26744) - (list '#(syntax-object - lambda - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)) - '(#(syntax-object - x - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile))) - '#((#(syntax-object - macro-type - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)) - . - #(syntax-object - identifier-syntax - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)))) - (list '#(syntax-object - syntax-case - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)) - '#(syntax-object - x - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)) - '() - (list '#(syntax-object - id - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)) - '(#(syntax-object - identifier? + (lambda (x) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 '(_ any)))) + (if tmp + (apply (lambda (e) + (list '#(syntax-object + lambda + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + '(#(syntax-object + x + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile))) + '#((#(syntax-object + macro-type + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + . + #(syntax-object + identifier-syntax + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)))) + (list '#(syntax-object + syntax-case ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) + #(ribcage #(e) #((top)) #("l-*-4751")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) + #(ribcage #(x) #((top)) #("l-*-4748"))) (hygiene guile)) - (#(syntax-object - syntax - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)) - #(syntax-object - id - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)))) - (list '#(syntax-object - syntax - ((top) - #(ribcage - #(e) - #((top)) - #("l-*-26713")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - e-26744)) - (list '(#(syntax-object - _ - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)) - #(syntax-object + '#(syntax-object x ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) + #(ribcage #(e) #((top)) #("l-*-4751")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) + #(ribcage #(x) #((top)) #("l-*-4748"))) (hygiene guile)) - #(syntax-object - ... - ((top) - #(ribcage #(e) #((top)) #("l-*-26713")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile))) - (list '#(syntax-object - syntax - ((top) - #(ribcage - #(e) - #((top)) - #("l-*-26713")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - (cons e-26744 - '(#(syntax-object - x + '() + (list '#(syntax-object + id + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + '(#(syntax-object + identifier? + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + (#(syntax-object + syntax + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + #(syntax-object + id + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)))) + (list '#(syntax-object + syntax ((top) - #(ribcage - #(e) - #((top)) - #("l-*-26713")) + #(ribcage #(e) #((top)) #("l-*-4751")) #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) + #(ribcage #(x) #((top)) #("l-*-4748"))) (hygiene guile)) - #(syntax-object - ... + e)) + (list '(#(syntax-object + _ + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + #(syntax-object + x + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + #(syntax-object + ... + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile))) + (list '#(syntax-object + syntax ((top) - #(ribcage - #(e) - #((top)) - #("l-*-26713")) + #(ribcage #(e) #((top)) #("l-*-4751")) #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile))))))))) - tmp-26740) - (let ((tmp-26745 - ($sc-dispatch - x-26738 - '(_ (any any) - ((#(free-id - #(syntax-object - set! - ((top) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile))) - any - any) - any))))) - (if (if tmp-26745 - (@apply - (lambda (id-26749 - exp1-26750 - var-26751 - val-26752 - exp2-26753) - (if (identifier? id-26749) - (identifier? var-26751) - #f)) - tmp-26745) - #f) - (@apply - (lambda (id-26754 - exp1-26755 - var-26756 - val-26757 - exp2-26758) - (list '#(syntax-object - make-variable-transformer - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) (top) (top) (top) (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)) - (list '#(syntax-object - lambda - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) (top) (top) (top) (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)) - '(#(syntax-object - x + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + (cons e + '(#(syntax-object + x + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + #(syntax-object + ... + ((top) + #(ribcage #(e) #((top)) #("l-*-4751")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile))))))))) + tmp) + (let ((tmp ($sc-dispatch + tmp-1 + '(_ (any any) + ((#(free-id + #(syntax-object + set! + ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile))) + any + any) + any))))) + (if (if tmp + (apply (lambda (id exp1 var val exp2) + (if (identifier? id) (identifier? var) #f)) + tmp) + #f) + (apply (lambda (id exp1 var val exp2) + (list '#(syntax-object + make-variable-transformer ((top) #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile))) - '#((#(syntax-object - macro-type - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) (top) (top) (top) (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)) - . - #(syntax-object - variable-transformer - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) (top) (top) (top) (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26710"))) - (hygiene guile)))) - (list '#(syntax-object - syntax-case - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) (top) (top) (top) (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - '#(syntax-object - x - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) (top) (top) (top) (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - '(#(syntax-object - set! + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + (list '#(syntax-object + lambda ((top) #(ribcage #(id exp1 var val exp2) #((top) (top) (top) (top) (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile))) - (list (list '#(syntax-object - set! - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - var-26756 - val-26757) - (list '#(syntax-object - syntax - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - exp2-26758)) - (list (cons id-26754 - '(#(syntax-object - x - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - #(syntax-object - ... - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)))) - (list '#(syntax-object - syntax - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - (cons exp1-26755 - '(#(syntax-object - x + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + '(#(syntax-object + x + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile))) + '#((#(syntax-object + macro-type + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + . + #(syntax-object + variable-transformer + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)))) + (list '#(syntax-object + syntax-case + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + '#(syntax-object + x + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + '(#(syntax-object + set! + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile))) + (list (list '#(syntax-object + set! ((top) #(ribcage - #(id - exp1 - var - val - exp2) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) + #(ribcage #(x) #((top)) #("l-*-4748"))) (hygiene guile)) - #(syntax-object - ... + var + val) + (list '#(syntax-object + syntax ((top) #(ribcage - #(id - exp1 - var - val - exp2) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + exp2)) + (list (cons id + '(#(syntax-object + x + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + #(syntax-object + ... + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)))) + (list '#(syntax-object + syntax + ((top) #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)))))) - (list id-26754 - (list '#(syntax-object - identifier? - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - (list '#(syntax-object - syntax - ((top) - #(ribcage - #(id - exp1 - var - val - exp2) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - id-26754)) - (list '#(syntax-object - syntax - ((top) - #(ribcage - #(id exp1 var val exp2) - #((top) - (top) - (top) - (top) - (top)) - #("l-*-26728" - "l-*-26729" - "l-*-26730" - "l-*-26731" - "l-*-26732")) - #(ribcage () () ()) - #(ribcage - #(x) - #((top)) - #("l-*-26710"))) - (hygiene guile)) - exp1-26755)))))) - tmp-26745) - (syntax-violation - #f - "source expression failed to match any pattern" - x-26738)))))))) + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + (cons exp1 + '(#(syntax-object + x + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" + "l-*-4767" + "l-*-4768" + "l-*-4769" + "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + #(syntax-object + ... + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" + "l-*-4767" + "l-*-4768" + "l-*-4769" + "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)))))) + (list id + (list '#(syntax-object + identifier? + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + (list '#(syntax-object + syntax + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" + "l-*-4767" + "l-*-4768" + "l-*-4769" + "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + id)) + (list '#(syntax-object + syntax + ((top) + #(ribcage + #(id exp1 var val exp2) + #((top) (top) (top) (top) (top)) + #("l-*-4766" "l-*-4767" "l-*-4768" "l-*-4769" "l-*-4770")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4748"))) + (hygiene guile)) + exp1)))))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))))) (define define* (make-syntax-transformer 'define* 'macro - (lambda (x-26790) - (let ((tmp-26792 - ($sc-dispatch - x-26790 - '(_ (any . any) any . each-any)))) - (if tmp-26792 - (@apply - (lambda (id-26796 args-26797 b0-26798 b1-26799) - (list '#(syntax-object - define - ((top) - #(ribcage - #(id args b0 b1) - #((top) (top) (top) (top)) - #("l-*-26772" - "l-*-26773" - "l-*-26774" - "l-*-26775")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26769"))) - (hygiene guile)) - id-26796 - (cons '#(syntax-object - lambda* - ((top) - #(ribcage - #(id args b0 b1) - #((top) (top) (top) (top)) - #("l-*-26772" - "l-*-26773" - "l-*-26774" - "l-*-26775")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26769"))) - (hygiene guile)) - (cons args-26797 (cons b0-26798 b1-26799))))) - tmp-26792) - (let ((tmp-26800 ($sc-dispatch x-26790 '(_ any any)))) - (if (if tmp-26800 - (@apply - (lambda (id-26804 val-26805) - (identifier? id-26804)) - tmp-26800) - #f) - (@apply - (lambda (id-26806 val-26807) - (list '#(syntax-object - define - ((top) - #(ribcage - #(id val) - #((top) (top)) - #("l-*-26786" "l-*-26787")) - #(ribcage () () ()) - #(ribcage #(x) #((top)) #("l-*-26769"))) - (hygiene guile)) - id-26806 - val-26807)) - tmp-26800) - (syntax-violation - #f - "source expression failed to match any pattern" - x-26790)))))))) + (lambda (x) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 '(_ (any . any) any . each-any)))) + (if tmp + (apply (lambda (id args b0 b1) + (list '#(syntax-object + define + ((top) + #(ribcage + #(id args b0 b1) + #((top) (top) (top) (top)) + #("l-*-4780" "l-*-4781" "l-*-4782" "l-*-4783")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4777"))) + (hygiene guile)) + id + (cons '#(syntax-object + lambda* + ((top) + #(ribcage + #(id args b0 b1) + #((top) (top) (top) (top)) + #("l-*-4780" "l-*-4781" "l-*-4782" "l-*-4783")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4777"))) + (hygiene guile)) + (cons args (cons b0 b1))))) + tmp) + (let ((tmp ($sc-dispatch tmp-1 '(_ any any)))) + (if (if tmp (apply (lambda (id val) (identifier? id)) tmp) #f) + (apply (lambda (id val) + (list '#(syntax-object + define + ((top) + #(ribcage #(id val) #((top) (top)) #("l-*-4794" "l-*-4795")) + #(ribcage () () ()) + #(ribcage #(x) #((top)) #("l-*-4777"))) + (hygiene guile)) + id + val)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))))) diff --git a/module/language/scheme/decompile-tree-il.scm b/module/language/scheme/decompile-tree-il.scm index 9243f4e6a..9191b2f96 100644 --- a/module/language/scheme/decompile-tree-il.scm +++ b/module/language/scheme/decompile-tree-il.scm @@ -1,6 +1,6 @@ ;;; Guile VM code converters -;; Copyright (C) 2001,2009 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2012 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -20,7 +20,796 @@ (define-module (language scheme decompile-tree-il) #:use-module (language tree-il) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 receive) + #:use-module (ice-9 vlist) + #:use-module (ice-9 match) + #:use-module (system base syntax) #:export (decompile-tree-il)) -(define (decompile-tree-il x env opts) - (values (tree-il->scheme x) env)) +(define (decompile-tree-il e env opts) + (apply do-decompile e env opts)) + +(define* (do-decompile e env + #:key + (use-derived-syntax? #t) + (avoid-lambda? #t) + (use-case? #t) + (strip-numeric-suffixes? #f) + #:allow-other-keys) + + (receive (output-name-table occurrence-count-table) + (choose-output-names e use-derived-syntax? strip-numeric-suffixes?) + + (define (output-name s) (hashq-ref output-name-table s)) + (define (occurrence-count s) (hashq-ref occurrence-count-table s)) + + (define (const x) (lambda (_) x)) + (define (atom? x) (not (or (pair? x) (vector? x)))) + + (define (build-void) '(if #f #f)) + + (define (build-begin es) + (match es + (() (build-void)) + ((e) e) + (_ `(begin ,@es)))) + + (define (build-lambda-body e) + (match e + (('let () body ...) body) + (('begin es ...) es) + (_ (list e)))) + + (define (build-begin-body e) + (match e + (('begin es ...) es) + (_ (list e)))) + + (define (build-define name e) + (match e + ((? (const avoid-lambda?) + ('lambda formals body ...)) + `(define (,name ,@formals) ,@body)) + ((? (const avoid-lambda?) + ('lambda* formals body ...)) + `(define* (,name ,@formals) ,@body)) + (_ `(define ,name ,e)))) + + (define (build-let names vals body) + (match `(let ,(map list names vals) + ,@(build-lambda-body body)) + ((_ () e) e) + ((_ (b) ('let* (bs ...) body ...)) + `(let* (,b ,@bs) ,@body)) + ((? (const use-derived-syntax?) + (_ (b1) ('let (b2) body ...))) + `(let* (,b1 ,b2) ,@body)) + (e e))) + + (define (build-letrec in-order? names vals body) + (match `(,(if in-order? 'letrec* 'letrec) + ,(map list names vals) + ,@(build-lambda-body body)) + ((_ () e) e) + ((_ () body ...) `(let () ,@body)) + ((_ ((name ('lambda (formals ...) body ...))) + (name args ...)) + (=> failure) + (if (= (length formals) (length args)) + `(let ,name ,(map list formals args) ,@body) + (failure))) + ((? (const avoid-lambda?) + ('letrec* _ body ...)) + `(let () + ,@(map build-define names vals) + ,@body)) + (e e))) + + (define (build-if test consequent alternate) + (match alternate + (('if #f _) `(if ,test ,consequent)) + (_ `(if ,test ,consequent ,alternate)))) + + (define (build-and xs) + (match xs + (() #t) + ((x) x) + (_ `(and ,@xs)))) + + (define (build-or xs) + (match xs + (() #f) + ((x) x) + (_ `(or ,@xs)))) + + (define (case-test-var test) + (match test + (('memv (? atom? v) ('quote (datums ...))) + v) + (('eqv? (? atom? v) ('quote datum)) + v) + (_ #f))) + + (define (test->datums v test) + (match (cons v test) + ((v 'memv v ('quote (xs ...))) + xs) + ((v 'eqv? v ('quote x)) + (list x)) + (_ #f))) + + (define (build-else-tail e) + (match e + (('if #f _) '()) + (('and xs ... x) `((,(build-and xs) ,@(build-begin-body x)) + (else #f))) + (_ `((else ,@(build-begin-body e)))))) + + (define (build-cond-else-tail e) + (match e + (('cond clauses ...) clauses) + (_ (build-else-tail e)))) + + (define (build-case-else-tail v e) + (match (cons v e) + ((v 'case v clauses ...) + clauses) + ((v 'if ('memv v ('quote (xs ...))) consequent . alternate*) + `((,xs ,@(build-begin-body consequent)) + ,@(build-case-else-tail v (build-begin alternate*)))) + ((v 'if ('eqv? v ('quote x)) consequent . alternate*) + `(((,x) ,@(build-begin-body consequent)) + ,@(build-case-else-tail v (build-begin alternate*)))) + (_ (build-else-tail e)))) + + (define (clauses+tail clauses) + (match clauses + ((cs ... (and c ('else . _))) (values cs (list c))) + (_ (values clauses '())))) + + (define (build-cond tests consequents alternate) + (case (length tests) + ((0) alternate) + ((1) (build-if (car tests) (car consequents) alternate)) + (else `(cond ,@(map (lambda (test consequent) + `(,test ,@(build-begin-body consequent))) + tests consequents) + ,@(build-cond-else-tail alternate))))) + + (define (build-cond-or-case tests consequents alternate) + (if (not use-case?) + (build-cond tests consequents alternate) + (let* ((v (and (not (null? tests)) + (case-test-var (car tests)))) + (datum-lists (take-while identity + (map (cut test->datums v <>) + tests))) + (n (length datum-lists)) + (tail (build-case-else-tail v (build-cond + (drop tests n) + (drop consequents n) + alternate)))) + (receive (clauses tail) (clauses+tail tail) + (let ((n (+ n (length clauses))) + (datum-lists (append datum-lists + (map car clauses))) + (consequents (append consequents + (map build-begin + (map cdr clauses))))) + (if (< n 2) + (build-cond tests consequents alternate) + `(case ,v + ,@(map cons datum-lists (map build-begin-body + (take consequents n))) + ,@tail))))))) + + (define (recurse e) + + (define (recurse-body e) + (build-lambda-body (recurse e))) + + (record-case e + (() + (build-void)) + + (( exp) + (if (and (self-evaluating? exp) (not (vector? exp))) + exp + `(quote ,exp))) + + (( exps) + (build-begin (map recurse exps))) + + (( proc args) + (match `(,(recurse proc) ,@(map recurse args)) + ((('lambda (formals ...) body ...) args ...) + (=> failure) + (if (= (length formals) (length args)) + (build-let formals args (build-begin body)) + (failure))) + (e e))) + + (( name) + name) + + (( gensym) + (output-name gensym)) + + (( gensym exp) + `(set! ,(output-name gensym) ,(recurse exp))) + + (( mod name public?) + `(,(if public? '@ '@@) ,mod ,name)) + + (( mod name public? exp) + `(set! (,(if public? '@ '@@) ,mod ,name) ,(recurse exp))) + + (( name) + name) + + (( name exp) + `(set! ,name ,(recurse exp))) + + (( name exp) + (build-define name (recurse exp))) + + (( meta body) + (let ((body (recurse body)) + (doc (assq-ref meta 'documentation))) + (if (not doc) + body + (match body + (('lambda formals body ...) + `(lambda ,formals ,doc ,@body)) + (('lambda* formals body ...) + `(lambda* ,formals ,doc ,@body)) + (('case-lambda (formals body ...) clauses ...) + `(case-lambda (,formals ,doc ,@body) ,@clauses)) + (('case-lambda* (formals body ...) clauses ...) + `(case-lambda* (,formals ,doc ,@body) ,@clauses)) + (e e))))) + + (( req opt rest kw inits gensyms body alternate) + (let ((names (map output-name gensyms))) + (cond + ((and (not opt) (not kw) (not alternate)) + `(lambda ,(if rest (apply cons* names) names) + ,@(recurse-body body))) + ((and (not opt) (not kw)) + (let ((alt-expansion (recurse alternate)) + (formals (if rest (apply cons* names) names))) + (case (car alt-expansion) + ((lambda) + `(case-lambda (,formals ,@(recurse-body body)) + ,(cdr alt-expansion))) + ((lambda*) + `(case-lambda* (,formals ,@(recurse-body body)) + ,(cdr alt-expansion))) + ((case-lambda) + `(case-lambda (,formals ,@(recurse-body body)) + ,@(cdr alt-expansion))) + ((case-lambda*) + `(case-lambda* (,formals ,@(recurse-body body)) + ,@(cdr alt-expansion)))))) + (else + (let* ((alt-expansion (and alternate (recurse alternate))) + (nreq (length req)) + (nopt (if opt (length opt) 0)) + (restargs (if rest (list-ref names (+ nreq nopt)) '())) + (reqargs (list-head names nreq)) + (optargs (if opt + `(#:optional + ,@(map list + (list-head (list-tail names nreq) nopt) + (map recurse + (list-head inits nopt)))) + '())) + (kwargs (if kw + `(#:key + ,@(map list + (map output-name (map caddr (cdr kw))) + (map recurse + (list-tail inits nopt)) + (map car (cdr kw))) + ,@(if (car kw) + '(#:allow-other-keys) + '())) + '())) + (formals `(,@reqargs ,@optargs ,@kwargs . ,restargs))) + (if (not alt-expansion) + `(lambda* ,formals ,@(recurse-body body)) + (case (car alt-expansion) + ((lambda lambda*) + `(case-lambda* (,formals ,@(recurse-body body)) + ,(cdr alt-expansion))) + ((case-lambda case-lambda*) + `(case-lambda* (,formals ,@(recurse-body body)) + ,@(cdr alt-expansion)))))))))) + + (( test consequent alternate) + (define (simplify-test e) + (match e + (('if ('eqv? (? atom? v) ('quote a)) #t ('eqv? v ('quote b))) + `(memv ,v '(,a ,b))) + (('if ('eqv? (? atom? v) ('quote a)) #t ('memv v ('quote (bs ...)))) + `(memv ,v '(,a ,@bs))) + (('case (? atom? v) + ((datum) #t) ... + ('else ('eqv? v ('quote last-datum)))) + `(memv ,v '(,@datum ,last-datum))) + (_ e))) + (match `(if ,(simplify-test (recurse test)) + ,(recurse consequent) + ,@(if (void? alternate) '() + (list (recurse alternate)))) + (('if test ('if ('and xs ...) consequent)) + (build-if (build-and (cons test xs)) + consequent + (build-void))) + ((? (const use-derived-syntax?) + ('if test1 ('if test2 consequent))) + (build-if (build-and (list test1 test2)) + consequent + (build-void))) + (('if (? atom? x) x ('or ys ...)) + (build-or (cons x ys))) + ((? (const use-derived-syntax?) + ('if (? atom? x) x y)) + (build-or (list x y))) + (('if test consequent) + `(if ,test ,consequent)) + (('if test ('and xs ...) #f) + (build-and (cons test xs))) + ((? (const use-derived-syntax?) + ('if test consequent #f)) + (build-and (list test consequent))) + ((? (const use-derived-syntax?) + ('if test1 consequent1 + ('if test2 consequent2 . alternate*))) + (build-cond-or-case (list test1 test2) + (list consequent1 consequent2) + (build-begin alternate*))) + (('if test consequent ('cond clauses ...)) + `(cond (,test ,@(build-begin-body consequent)) + ,@clauses)) + (('if ('memv (? atom? v) ('quote (xs ...))) consequent + ('case v clauses ...)) + `(case ,v (,xs ,@(build-begin-body consequent)) + ,@clauses)) + (('if ('eqv? (? atom? v) ('quote x)) consequent + ('case v clauses ...)) + `(case ,v ((,x) ,@(build-begin-body consequent)) + ,@clauses)) + (e e))) + + (( gensyms vals body) + (match (build-let (map output-name gensyms) + (map recurse vals) + (recurse body)) + (('let ((v e)) ('or v xs ...)) + (=> failure) + (if (and (not (null? gensyms)) + (= 3 (occurrence-count (car gensyms)))) + `(or ,e ,@xs) + (failure))) + (('let ((v e)) ('case v clauses ...)) + (=> failure) + (if (and (not (null? gensyms)) + ;; FIXME: This fails if any of the 'memv's were + ;; optimized into multiple 'eqv?'s, because the + ;; occurrence count will be higher than we expect. + (= (occurrence-count (car gensyms)) + (1+ (length (clauses+tail clauses))))) + `(case ,e ,@clauses) + (failure))) + (e e))) + + (( in-order? gensyms vals body) + (build-letrec in-order? + (map output-name gensyms) + (map recurse vals) + (recurse body))) + + (( gensyms vals body) + ;; not a typo, we really do translate back to letrec. use letrec* since it + ;; doesn't matter, and the naive letrec* transformation does not require an + ;; inner let. + (build-letrec #t + (map output-name gensyms) + (map recurse vals) + (recurse body))) + + (( exp body) + `(call-with-values (lambda () ,@(recurse-body exp)) + ,(recurse (make-lambda #f '() body)))) + + (( body winder unwinder) + `(dynamic-wind ,(recurse winder) + (lambda () ,@(recurse-body body)) + ,(recurse unwinder))) + + (( fluids vals body) + `(with-fluids ,(map list + (map recurse fluids) + (map recurse vals)) + ,@(recurse-body body))) + + (( fluid) + `(fluid-ref ,(recurse fluid))) + + (( fluid exp) + `(fluid-set! ,(recurse fluid) ,(recurse exp))) + + (( tag body handler) + `(call-with-prompt + ,(recurse tag) + (lambda () ,@(recurse-body body)) + ,(recurse handler))) + + + (( tag args tail) + `(apply abort ,(recurse tag) ,@(map recurse args) + ,(recurse tail))))) + (values (recurse e) env))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Algorithm for choosing better variable names +;; ============================================ +;; +;; First we perform an analysis pass, collecting the following +;; information: +;; +;; * For each gensym: how many occurrences will occur in the output? +;; +;; * For each gensym A: which gensyms does A conflict with? Gensym A +;; and gensym B conflict if they have the same base name (usually the +;; same as the source name, but see below), and if giving them the +;; same name would cause a bad variable reference due to unintentional +;; variable capture. +;; +;; The occurrence counter is indexed by gensym and is global (within each +;; invocation of the algorithm), implemented using a hash table. We also +;; keep a global mapping from gensym to source name as provided by the +;; binding construct (we prefer not to trust the source names in the +;; lexical ref or set). +;; +;; As we recurse down into lexical binding forms, we keep track of a +;; mapping from base name to an ordered list of bindings, innermost +;; first. When we encounter a variable occurrence, we increment the +;; counter, look up the base name (preferring not to trust the 'name' in +;; the lexical ref or set), and then look up the bindings currently in +;; effect for that base name. Hopefully our gensym will be the first +;; (innermost) binding. If not, we register a conflict between the +;; referenced gensym and the other bound gensyms with the same base name +;; that shadow the binding we want. These are simply the gensyms on the +;; binding list that come before our gensym. +;; +;; Top-level bindings are treated specially. Whenever top-level +;; references are found, they conflict with every lexical binding +;; currently in effect with the same base name. They are guaranteed to +;; be assigned to their source names. For purposes of recording +;; conflicts (which are normally keyed on gensyms) top-level identifiers +;; are assigned a pseudo-gensym that is an interned pair of the form +;; (top-level . ). This allows them to be compared using 'eq?' +;; like other gensyms. +;; +;; The base name is normally just the source name. However, if the +;; source name has a suffix of the form "-N" (where N is a positive +;; integer without leading zeroes), then we strip that suffix (multiple +;; times if necessary) to form the base name. We must do this because +;; we add suffixes of that form in order to resolve conflicts, and we +;; must ensure that only identifiers with the same base name can +;; possibly conflict with each other. +;; +;; XXX FIXME: Currently, primitives are treated exactly like top-level +;; bindings. This handles conflicting lexical bindings properly, but +;; does _not_ handle the case where top-level bindings conflict with the +;; needed primitives. +;; +;; Also note that this requires that 'choose-output-names' be kept in +;; sync with 'tree-il->scheme'. Primitives that are introduced by +;; 'tree-il->scheme' must be anticipated by 'choose-output-name'. +;; +;; We also ensure that lexically-bound identifiers found in operator +;; position will never be assigned one of the standard primitive names. +;; This is needed because 'tree-il->scheme' recognizes primitive names +;; in operator position and assumes that they have the standard +;; bindings. +;; +;; +;; How we assign an output name to each gensym +;; =========================================== +;; +;; We process the gensyms in order of decreasing occurrence count, with +;; each gensym choosing the best output name possible, as long as it +;; isn't the same name as any of the previously-chosen output names of +;; conflicting gensyms. +;; + + +;; +;; 'choose-output-names' analyzes the top-level form e, chooses good +;; variable names that are as close as possible to the source names, +;; and returns two values: +;; +;; * a hash table mapping gensym to output name +;; * a hash table mapping gensym to number of occurrences +;; +(define choose-output-names + (let () + (define primitive? + ;; This is a list of primitives that 'tree-il->scheme' assumes + ;; will have the standard bindings when found in operator + ;; position. + (let* ((primitives '(if quote @ @@ set! define define* + begin let let* letrec letrec* + and or cond case + lambda lambda* case-lambda case-lambda* + apply call-with-values dynamic-wind + with-fluids fluid-ref fluid-set! + call-with-prompt abort memv eqv?)) + (table (make-hash-table (length primitives)))) + (for-each (cut hashq-set! table <> #t) primitives) + (lambda (name) (hashq-ref table name)))) + + ;; Repeatedly strip suffix of the form "-N", where N is a string + ;; that could be produced by number->string given a positive + ;; integer. In other words, the first digit of N may not be 0. + (define compute-base-name + (let ((digits (string->char-set "0123456789"))) + (define (base-name-string str) + (let ((i (string-skip-right str digits))) + (if (and i (< (1+ i) (string-length str)) + (eq? #\- (string-ref str i)) + (not (eq? #\0 (string-ref str (1+ i))))) + (base-name-string (substring str 0 i)) + str))) + (lambda (sym) + (string->symbol (base-name-string (symbol->string sym)))))) + + ;; choose-output-names + (lambda (e use-derived-syntax? strip-numeric-suffixes?) + + (define lexical-gensyms '()) + + (define top-level-intern! + (let ((table (make-hash-table))) + (lambda (name) + (let ((h (hashq-create-handle! table name #f))) + (or (cdr h) (begin (set-cdr! h (cons 'top-level name)) + (cdr h))))))) + (define (top-level? s) (pair? s)) + (define (top-level-name s) (cdr s)) + + (define occurrence-count-table (make-hash-table)) + (define (occurrence-count s) (or (hashq-ref occurrence-count-table s) 0)) + (define (increment-occurrence-count! s) + (let ((h (hashq-create-handle! occurrence-count-table s 0))) + (if (zero? (cdr h)) + (set! lexical-gensyms (cons s lexical-gensyms))) + (set-cdr! h (1+ (cdr h))))) + + (define base-name + (let ((table (make-hash-table))) + (lambda (name) + (let ((h (hashq-create-handle! table name #f))) + (or (cdr h) (begin (set-cdr! h (compute-base-name name)) + (cdr h))))))) + + (define source-name-table (make-hash-table)) + (define (set-source-name! s name) + (if (not (top-level? s)) + (let ((name (if strip-numeric-suffixes? + (base-name name) + name))) + (hashq-set! source-name-table s name)))) + (define (source-name s) + (if (top-level? s) + (top-level-name s) + (hashq-ref source-name-table s))) + + (define conflict-table (make-hash-table)) + (define (conflicts s) (or (hashq-ref conflict-table s) '())) + (define (add-conflict! a b) + (define (add! a b) + (if (not (top-level? a)) + (let ((h (hashq-create-handle! conflict-table a '()))) + (if (not (memq b (cdr h))) + (set-cdr! h (cons b (cdr h))))))) + (add! a b) + (add! b a)) + + (let recurse-with-bindings ((e e) (bindings vlist-null)) + (let recurse ((e e)) + + ;; We call this whenever we encounter a top-level ref or set + (define (top-level name) + (let ((bname (base-name name))) + (let ((s (top-level-intern! name)) + (conflicts (vhash-foldq* cons '() bname bindings))) + (for-each (cut add-conflict! s <>) conflicts)))) + + ;; We call this whenever we encounter a primitive reference. + ;; We must also call it for every primitive that might be + ;; inserted by 'tree-il->scheme'. It is okay to call this + ;; even when 'tree-il->scheme' will not insert the named + ;; primitive; the worst that will happen is for a lexical + ;; variable of the same name to be renamed unnecessarily. + (define (primitive name) (top-level name)) + + ;; We call this whenever we encounter a lexical ref or set. + (define (lexical s) + (increment-occurrence-count! s) + (let ((conflicts + (take-while + (lambda (s*) (not (eq? s s*))) + (reverse! (vhash-foldq* cons + '() + (base-name (source-name s)) + bindings))))) + (for-each (cut add-conflict! s <>) conflicts))) + + (record-case e + (() (primitive 'if)) ; (if #f #f) + (() (primitive 'quote)) + + (( proc args) + (if (lexical-ref? proc) + (let* ((gensym (lexical-ref-gensym proc)) + (name (source-name gensym))) + ;; If the operator position contains a bare variable + ;; reference with the same source name as a standard + ;; primitive, we must ensure that it will be given a + ;; different name, so that 'tree-il->scheme' will not + ;; misinterpret the resulting expression. + (if (primitive? name) + (add-conflict! gensym (top-level-intern! name))))) + (recurse proc) + (for-each recurse args)) + + (( name) (primitive name)) + + (( gensym) (lexical gensym)) + (( gensym exp) + (primitive 'set!) (lexical gensym) (recurse exp)) + + (( public?) (primitive (if public? '@ '@@))) + (( public? exp) + (primitive 'set!) (primitive (if public? '@ '@@)) (recurse exp)) + + (( name) (top-level name)) + (( name exp) + (primitive 'set!) (top-level name) (recurse exp)) + (( name exp) (top-level name) (recurse exp)) + + (( test consequent alternate) + (cond (use-derived-syntax? + (primitive 'and) (primitive 'or) + (primitive 'cond) (primitive 'case) + (primitive 'else) (primitive '=>))) + (primitive 'if) + (recurse test) (recurse consequent) (recurse alternate)) + + (( exps) (primitive 'begin) (for-each recurse exps)) + (( body) (recurse body)) + + (( req opt rest kw inits gensyms body alternate) + (primitive 'lambda) + (cond ((or opt kw alternate) + (primitive 'lambda*) + (primitive 'case-lambda) + (primitive 'case-lambda*))) + (primitive 'let) + (if use-derived-syntax? (primitive 'let*)) + (let* ((names (append req (or opt '()) (if rest (list rest) '()) + (map cadr (if kw (cdr kw) '())))) + (base-names (map base-name names)) + (body-bindings + (fold vhash-consq bindings base-names gensyms))) + (for-each increment-occurrence-count! gensyms) + (for-each set-source-name! gensyms names) + (for-each recurse inits) + (recurse-with-bindings body body-bindings) + (if alternate (recurse alternate)))) + + (( names gensyms vals body) + (primitive 'let) + (cond (use-derived-syntax? (primitive 'let*) (primitive 'or))) + (for-each increment-occurrence-count! gensyms) + (for-each set-source-name! gensyms names) + (for-each recurse vals) + (recurse-with-bindings + body (fold vhash-consq bindings (map base-name names) gensyms))) + + (( in-order? names gensyms vals body) + (primitive 'let) + (cond (use-derived-syntax? (primitive 'let*) (primitive 'or))) + (primitive (if in-order? 'letrec* 'letrec)) + (for-each increment-occurrence-count! gensyms) + (for-each set-source-name! gensyms names) + (let* ((base-names (map base-name names)) + (bindings (fold vhash-consq bindings base-names gensyms))) + (for-each (cut recurse-with-bindings <> bindings) vals) + (recurse-with-bindings body bindings))) + + (( names gensyms vals body) + (primitive 'let) + (primitive 'letrec*) + (cond (use-derived-syntax? (primitive 'let*) (primitive 'or))) + (for-each increment-occurrence-count! gensyms) + (for-each set-source-name! gensyms names) + (let* ((base-names (map base-name names)) + (bindings (fold vhash-consq bindings base-names gensyms))) + (for-each (cut recurse-with-bindings <> bindings) vals) + (recurse-with-bindings body bindings))) + + (( exp body) + (primitive 'call-with-values) + (recurse exp) (recurse body)) + + (( winder body unwinder) + (primitive 'dynamic-wind) + (recurse winder) (recurse body) (recurse unwinder)) + + (( fluids vals body) + (primitive 'with-fluids) + (for-each recurse fluids) + (for-each recurse vals) + (recurse body)) + + (( fluid) (primitive 'fluid-ref) (recurse fluid)) + (( fluid exp) + (primitive 'fluid-set!) (recurse fluid) (recurse exp)) + + (( tag body handler) + (primitive 'call-with-prompt) + (primitive 'lambda) + (recurse tag) (recurse body) (recurse handler)) + + (( tag args tail) + (primitive 'apply) + (primitive 'abort) + (recurse tag) (for-each recurse args) (recurse tail))))) + + (let () + (define output-name-table (make-hash-table)) + (define (set-output-name! s name) + (hashq-set! output-name-table s name)) + (define (output-name s) + (if (top-level? s) + (top-level-name s) + (hashq-ref output-name-table s))) + + (define sorted-lexical-gensyms + (sort-list lexical-gensyms + (lambda (a b) (> (occurrence-count a) + (occurrence-count b))))) + + (for-each (lambda (s) + (set-output-name! + s + (let ((the-conflicts (conflicts s)) + (the-source-name (source-name s))) + (define (not-yet-taken? name) + (not (any (lambda (s*) + (and=> (output-name s*) + (cut eq? name <>))) + the-conflicts))) + (if (not-yet-taken? the-source-name) + the-source-name + (let ((prefix (string-append + (symbol->string the-source-name) + "-"))) + (let loop ((i 1) (name the-source-name)) + (if (not-yet-taken? name) + name + (loop (+ i 1) + (string->symbol + (string-append + prefix + (number->string i))))))))))) + sorted-lexical-gensyms) + (values output-name-table occurrence-count-table))))) diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 1d391c4e1..3ee89fb77 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -331,155 +331,10 @@ `(abort ,(unparse-tree-il tag) ,(map unparse-tree-il args) ,(unparse-tree-il tail))))) -(define (tree-il->scheme e) - (record-case e - (() - '(if #f #f)) - - (( proc args) - `(,(tree-il->scheme proc) ,@(map tree-il->scheme args))) - - (( test consequent alternate) - (if (void? alternate) - `(if ,(tree-il->scheme test) ,(tree-il->scheme consequent)) - `(if ,(tree-il->scheme test) ,(tree-il->scheme consequent) ,(tree-il->scheme alternate)))) - - (( name) - name) - - (( gensym) - gensym) - - (( gensym exp) - `(set! ,gensym ,(tree-il->scheme exp))) - - (( mod name public?) - `(,(if public? '@ '@@) ,mod ,name)) - - (( mod name public? exp) - `(set! (,(if public? '@ '@@) ,mod ,name) ,(tree-il->scheme exp))) - - (( name) - name) - - (( name exp) - `(set! ,name ,(tree-il->scheme exp))) - - (( name exp) - `(define ,name ,(tree-il->scheme exp))) - - (( meta body) - ;; fixme: put in docstring - (tree-il->scheme body)) - - (( req opt rest kw inits gensyms body alternate) - (cond - ((and (not opt) (not kw) (not alternate)) - `(lambda ,(if rest (apply cons* gensyms) gensyms) - ,(tree-il->scheme body))) - ((and (not opt) (not kw)) - (let ((alt-expansion (tree-il->scheme alternate)) - (formals (if rest (apply cons* gensyms) gensyms))) - (case (car alt-expansion) - ((lambda) - `(case-lambda (,formals ,(tree-il->scheme body)) - ,(cdr alt-expansion))) - ((lambda*) - `(case-lambda* (,formals ,(tree-il->scheme body)) - ,(cdr alt-expansion))) - ((case-lambda) - `(case-lambda (,formals ,(tree-il->scheme body)) - ,@(cdr alt-expansion))) - ((case-lambda*) - `(case-lambda* (,formals ,(tree-il->scheme body)) - ,@(cdr alt-expansion)))))) - (else - (let* ((alt-expansion (and alternate (tree-il->scheme alternate))) - (nreq (length req)) - (nopt (if opt (length opt) 0)) - (restargs (if rest (list-ref gensyms (+ nreq nopt)) '())) - (reqargs (list-head gensyms nreq)) - (optargs (if opt - `(#:optional - ,@(map list - (list-head (list-tail gensyms nreq) nopt) - (map tree-il->scheme - (list-head inits nopt)))) - '())) - (kwargs (if kw - `(#:key - ,@(map list - (map caddr (cdr kw)) - (map tree-il->scheme - (list-tail inits nopt)) - (map car (cdr kw))) - ,@(if (car kw) - '(#:allow-other-keys) - '())) - '())) - (formals `(,@reqargs ,@optargs ,@kwargs . ,restargs))) - (if (not alt-expansion) - `(lambda* ,formals ,(tree-il->scheme body)) - (case (car alt-expansion) - ((lambda lambda*) - `(case-lambda* (,formals ,(tree-il->scheme body)) - ,(cdr alt-expansion))) - ((case-lambda case-lambda*) - `(case-lambda* (,formals ,(tree-il->scheme body)) - ,@(cdr alt-expansion))))))))) - - (( exp) - (if (and (self-evaluating? exp) (not (vector? exp))) - exp - (list 'quote exp))) - - (( exps) - `(begin ,@(map tree-il->scheme exps))) - - (( gensyms vals body) - `(let ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body))) - - (( in-order? gensyms vals body) - `(,(if in-order? 'letrec* 'letrec) - ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body))) - - (( gensyms vals body) - ;; not a typo, we really do translate back to letrec. use letrec* since it - ;; doesn't matter, and the naive letrec* transformation does not require an - ;; inner let. - `(letrec* ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body))) - - (( exp body) - `(call-with-values (lambda () ,(tree-il->scheme exp)) - ,(tree-il->scheme (make-lambda #f '() body)))) - - (( body winder unwinder) - `(dynamic-wind ,(tree-il->scheme winder) - (lambda () ,(tree-il->scheme body)) - ,(tree-il->scheme unwinder))) - - (( fluids vals body) - `(with-fluids ,(map list - (map tree-il->scheme fluids) - (map tree-il->scheme vals)) - ,(tree-il->scheme body))) - - (( fluid) - `(fluid-ref ,(tree-il->scheme fluid))) - - (( fluid exp) - `(fluid-set! ,(tree-il->scheme fluid) ,(tree-il->scheme exp))) - - (( tag body handler) - `(call-with-prompt - ,(tree-il->scheme tag) - (lambda () ,(tree-il->scheme body)) - ,(tree-il->scheme handler))) - - - (( tag args tail) - `(apply abort ,(tree-il->scheme tag) ,@(map tree-il->scheme args) - ,(tree-il->scheme tail))))) +(define* (tree-il->scheme e #:optional (env #f) (opts '())) + (values ((@ (language scheme decompile-tree-il) + decompile-tree-il) + e env opts))) (define (tree-il-fold leaf down up seed tree)