[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 2ce77f2d95
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 2ce77f2d95271887b54d0c56d1e81d7f472ae1ae |
|
Date: |
Sun, 17 May 2009 14:46:34 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=2ce77f2d95271887b54d0c56d1e81d7f472ae1ae
The branch, syncase-in-boot-9 has been updated
via 2ce77f2d95271887b54d0c56d1e81d7f472ae1ae (commit)
via 696495f4d21fc8bc479b50588c08ea55e7c6e3a7 (commit)
via 547a602d1ef4d3622cf2d476ff311957b447eaba (commit)
from cf10678fe7014a67020c45ee02f2aabb44598adc (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 2ce77f2d95271887b54d0c56d1e81d7f472ae1ae
Author: Andy Wingo <address@hidden>
Date: Sun May 17 16:46:46 2009 +0200
and now, we residualize the original names into the metadata. yay!
* module/language/tree-il/compile-glil.scm (vars->bind-list)
(emit-bindings, flatten-lambda, flatten): Write the original names into
<glil-bind> structures. Yaaaaay!
commit 696495f4d21fc8bc479b50588c08ea55e7c6e3a7
Author: Andy Wingo <address@hidden>
Date: Sun May 17 16:39:55 2009 +0200
actually pass original ids on to tree-il data types
* module/ice-9/psyntax.scm (build-lambda, build-let, build-named-let)
(build-letrec): Actually pass along the original ids to tree-il
constructors.
* module/ice-9/psyntax-pp.scm: Regenerated.
* module/language/tree-il.scm: Add fields in <lambda>, <let>, and
<letrec> for the original variable names.
* module/language/tree-il/compile-glil.scm (compile-glil): Adapt for new
make-lambda arg.
commit 547a602d1ef4d3622cf2d476ff311957b447eaba
Author: Andy Wingo <address@hidden>
Date: Sun May 17 16:27:18 2009 +0200
preserve original var names in lets and lambdas
* module/ice-9/psyntax.scm (build-letrec, build-let, build-lambda)
(build-named-let): Take extra args for the original names of the
gensyms. Not used yet. Callers adapted.
* module/ice-9/psyntax-pp.scm: Regenerated.
-----------------------------------------------------------------------
Summary of changes:
module/ice-9/psyntax-pp.scm | 22 ++++++------
module/ice-9/psyntax.scm | 51 +++++++++++++++++++----------
module/language/tree-il.scm | 40 ++++++++++++------------
module/language/tree-il/compile-glil.scm | 43 ++++++++++++++----------
4 files changed, 89 insertions(+), 67 deletions(-)
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index dca1b30..a7f2949 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,13 +1,13 @@
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(if #f #f)
-(letrec ((and-map*17 (lambda (f57 first56 . rest55) (or (null? first56) (if
(null? rest55) (letrec ((andmap58 (lambda (first59) (let ((x60 (car first59))
(first61 (cdr first59))) (if (null? first61) (f57 x60) (and (f57 x60) (andmap58
first61))))))) (andmap58 first56)) (letrec ((andmap62 (lambda (first63 rest64)
(let ((x65 (car first63)) (xr66 (map car rest64)) (first67 (cdr first63))
(rest68 (map cdr rest64))) (if (null? first67) (apply f57 (cons x65 xr66)) (and
(apply f57 (cons x65 xr66)) (andmap62 first67 rest68))))))) (andmap62 first56
rest55))))))) (letrec ((lambda-var-list160 (lambda (vars289) (letrec ((lvl290
(lambda (vars291 ls292 w293) (cond ((pair? vars291) (lvl290 (cdr vars291) (cons
(wrap139 (car vars291) w293 #f) ls292) w293)) ((id?111 vars291) (cons (wrap139
vars291 w293 #f) ls292)) ((null? vars291) ls292) ((syntax-object?95 vars291)
(lvl290 (syntax-object-expression96 vars291) ls292 (join-wraps130 w293
(syntax-object-wrap97 vars291)))) ((annotation? vars291) (lvl290
(annotation-expression vars291) ls292 w293)) (else (cons vars291 ls292))))))
(lvl290 vars289 (quote ()) (quote (())))))) (gen-var159 (lambda (id294) (let
((id295 (if (syntax-object?95 id294) (syntax-object-expression96 id294)
id294))) (if (annotation? id295) (gensym (symbol->string (annotation-expression
id295))) (gensym (symbol->string id295)))))) (strip158 (lambda (x296 w297) (if
(memq (quote top) (wrap-marks114 w297)) (if (or (annotation? x296) (and (pair?
x296) (annotation? (car x296)))) (strip-annotation157 x296 #f) x296) (letrec
((f298 (lambda (x299) (cond ((syntax-object?95 x299) (strip158
(syntax-object-expression96 x299) (syntax-object-wrap97 x299))) ((pair? x299)
(let ((a300 (f298 (car x299))) (d301 (f298 (cdr x299)))) (if (and (eq? a300
(car x299)) (eq? d301 (cdr x299))) x299 (cons a300 d301)))) ((vector? x299)
(let ((old302 (vector->list x299))) (let ((new303 (map f298 old302))) (if
(and-map*17 eq? old302 new303) x299 (list->vector new303))))) (else x299)))))
(f298 x296))))) (strip-annotation157 (lambda (x304 parent305) (cond ((pair?
x304) (let ((new306 (cons #f #f))) (begin (if parent305
(set-annotation-stripped! parent305 new306)) (set-car! new306
(strip-annotation157 (car x304) #f)) (set-cdr! new306 (strip-annotation157 (cdr
x304) #f)) new306))) ((annotation? x304) (or (annotation-stripped x304)
(strip-annotation157 (annotation-expression x304) x304))) ((vector? x304) (let
((new307 (make-vector (vector-length x304)))) (begin (if parent305
(set-annotation-stripped! parent305 new307)) (letrec ((loop308 (lambda (i309)
(unless (fx<74 i309 0) (vector-set! new307 i309 (strip-annotation157
(vector-ref x304 i309) #f)) (loop308 (fx-72 i309 1)))))) (loop308 (-
(vector-length x304) 1))) new307))) (else x304)))) (ellipsis?156 (lambda (x310)
(and (nonsymbol-id?110 x310) (free-id=?134 x310 (quote #(syntax-object ...
((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))))))) (chi-void155 (lambda () (build-application79 #f
(build-primref88 #f (quote if)) (quote (#f #f))))) (eval-local-transformer154
(lambda (expanded311 mod312) (let ((p313 (local-eval-hook76 expanded311
mod312))) (if (procedure? p313) p313 (syntax-violation #f "nonprocedure
transformer" p313))))) (chi-local-syntax153 (lambda (rec?314 e315 r316 w317
s318 mod319 k320) ((lambda (tmp321) ((lambda (tmp322) (if tmp322 (apply (lambda
(_323 id324 val325 e1326 e2327) (let ((ids328 id324)) (if (not
(valid-bound-ids?136 ids328)) (syntax-violation #f "duplicate bound keyword"
e315) (let ((labels330 (gen-labels117 ids328))) (let ((new-w331
(make-binding-wrap128 ids328 labels330 w317))) (k320 (cons e1326 e2327)
(extend-env105 labels330 (let ((w333 (if rec?314 new-w331 w317)) (trans-r334
(macros-only-env107 r316))) (map (lambda (x335) (cons (quote macro)
(eval-local-transformer154 (chi147 x335 trans-r334 w333 mod319) mod319)))
val325)) r316) new-w331 s318 mod319)))))) tmp322) ((lambda (_337)
(syntax-violation #f "bad local syntax definition" (source-wrap140 e315 w317
s318 mod319))) tmp321))) ($sc-dispatch tmp321 (quote (any #(each (any any)) any
. each-any))))) e315))) (chi-lambda-clause152 (lambda (e338 docstring339 c340
r341 w342 mod343 k344) ((lambda (tmp345) ((lambda (tmp346) (if (if tmp346
(apply (lambda (args347 doc348 e1349 e2350) (and (string? (syntax->datum
doc348)) (not docstring339))) tmp346) #f) (apply (lambda (args351 doc352 e1353
e2354) (chi-lambda-clause152 e338 doc352 (cons args351 (cons e1353 e2354)) r341
w342 mod343 k344)) tmp346) ((lambda (tmp356) (if tmp356 (apply (lambda (id357
e1358 e2359) (let ((ids360 id357)) (if (not (valid-bound-ids?136 ids360))
(syntax-violation (quote lambda) "invalid parameter list" e338) (let
((labels362 (gen-labels117 ids360)) (new-vars363 (map gen-var159 ids360)))
(k344 new-vars363 docstring339 (chi-body151 (cons e1358 e2359) e338
(extend-var-env106 labels362 new-vars363 r341) (make-binding-wrap128 ids360
labels362 w342) mod343)))))) tmp356) ((lambda (tmp365) (if tmp365 (apply
(lambda (ids366 e1367 e2368) (let ((old-ids369 (lambda-var-list160 ids366)))
(if (not (valid-bound-ids?136 old-ids369)) (syntax-violation (quote lambda)
"invalid parameter list" e338) (let ((labels370 (gen-labels117 old-ids369))
(new-vars371 (map gen-var159 old-ids369))) (k344 (letrec ((f372 (lambda (ls1373
ls2374) (if (null? ls1373) ls2374 (f372 (cdr ls1373) (cons (car ls1373)
ls2374)))))) (f372 (cdr new-vars371) (car new-vars371))) docstring339
(chi-body151 (cons e1367 e2368) e338 (extend-var-env106 labels370 new-vars371
r341) (make-binding-wrap128 old-ids369 labels370 w342) mod343)))))) tmp365)
((lambda (_376) (syntax-violation (quote lambda) "bad lambda" e338)) tmp345)))
($sc-dispatch tmp345 (quote (any any . each-any)))))) ($sc-dispatch tmp345
(quote (each-any any . each-any)))))) ($sc-dispatch tmp345 (quote (any any any
. each-any))))) c340))) (chi-body151 (lambda (body377 outer-form378 r379 w380
mod381) (let ((r382 (cons (quote ("placeholder" placeholder)) r379))) (let
((ribcage383 (make-ribcage118 (quote ()) (quote ()) (quote ())))) (let ((w384
(make-wrap113 (wrap-marks114 w380) (cons ribcage383 (wrap-subst115 w380)))))
(letrec ((parse385 (lambda (body386 ids387 labels388 vars389 vals390
bindings391) (if (null? body386) (syntax-violation #f "no expressions in body"
outer-form378) (let ((e393 (cdar body386)) (er394 (caar body386)))
(call-with-values (lambda () (syntax-type145 e393 er394 (quote (())) #f
ribcage383 mod381)) (lambda (type395 value396 e397 w398 s399 mod400) (let
((t401 type395)) (if (memv t401 (quote (define-form))) (let ((id402 (wrap139
value396 w398 mod400)) (label403 (gen-label116))) (let ((var404 (gen-var159
id402))) (begin (extend-ribcage!127 ribcage383 id402 label403) (parse385 (cdr
body386) (cons id402 ids387) (cons label403 labels388) (cons var404 vars389)
(cons (cons er394 (wrap139 e397 w398 mod400)) vals390) (cons (cons (quote
lexical) var404) bindings391))))) (if (memv t401 (quote (define-syntax-form)))
(let ((id405 (wrap139 value396 w398 mod400)) (label406 (gen-label116))) (begin
(extend-ribcage!127 ribcage383 id405 label406) (parse385 (cdr body386) (cons
id405 ids387) (cons label406 labels388) vars389 vals390 (cons (cons (quote
macro) (cons er394 (wrap139 e397 w398 mod400))) bindings391)))) (if (memv t401
(quote (begin-form))) ((lambda (tmp407) ((lambda (tmp408) (if tmp408 (apply
(lambda (_409 e1410) (parse385 (letrec ((f411 (lambda (forms412) (if (null?
forms412) (cdr body386) (cons (cons er394 (wrap139 (car forms412) w398 mod400))
(f411 (cdr forms412))))))) (f411 e1410)) ids387 labels388 vars389 vals390
bindings391)) tmp408) (syntax-violation #f "source expression failed to match
any pattern" tmp407))) ($sc-dispatch tmp407 (quote (any . each-any))))) e397)
(if (memv t401 (quote (local-syntax-form))) (chi-local-syntax153 value396 e397
er394 w398 s399 mod400 (lambda (forms414 er415 w416 s417 mod418) (parse385
(letrec ((f419 (lambda (forms420) (if (null? forms420) (cdr body386) (cons
(cons er415 (wrap139 (car forms420) w416 mod418)) (f419 (cdr forms420)))))))
(f419 forms414)) ids387 labels388 vars389 vals390 bindings391))) (if (null?
ids387) (build-sequence90 #f (map (lambda (x421) (chi147 (cdr x421) (car x421)
(quote (())) mod400)) (cons (cons er394 (source-wrap140 e397 w398 s399 mod400))
(cdr body386)))) (begin (if (not (valid-bound-ids?136 ids387))
(syntax-violation #f "invalid or duplicate identifier in definition"
outer-form378)) (letrec ((loop422 (lambda (bs423 er-cache424 r-cache425) (if
(not (null? bs423)) (let ((b426 (car bs423))) (if (eq? (car b426) (quote
macro)) (let ((er427 (cadr b426))) (let ((r-cache428 (if (eq? er427
er-cache424) r-cache425 (macros-only-env107 er427)))) (begin (set-cdr! b426
(eval-local-transformer154 (chi147 (cddr b426) r-cache428 (quote (())) mod400)
mod400)) (loop422 (cdr bs423) er427 r-cache428)))) (loop422 (cdr bs423)
er-cache424 r-cache425))))))) (loop422 bindings391 #f #f)) (set-cdr! r382
(extend-env105 labels388 bindings391 (cdr r382))) (build-letrec93 #f vars389
(map (lambda (x429) (chi147 (cdr x429) (car x429) (quote (())) mod400))
vals390) (build-sequence90 #f (map (lambda (x430) (chi147 (cdr x430) (car x430)
(quote (())) mod400)) (cons (cons er394 (source-wrap140 e397 w398 s399 mod400))
(cdr body386))))))))))))))))))) (parse385 (map (lambda (x392) (cons r382
(wrap139 x392 w384 mod381))) body377) (quote ()) (quote ()) (quote ()) (quote
()) (quote ())))))))) (chi-macro150 (lambda (p431 e432 r433 w434 rib435 mod436)
(letrec ((rebuild-macro-output437 (lambda (x438 m439) (cond ((pair? x438) (cons
(rebuild-macro-output437 (car x438) m439) (rebuild-macro-output437 (cdr x438)
m439))) ((syntax-object?95 x438) (let ((w440 (syntax-object-wrap97 x438))) (let
((ms441 (wrap-marks114 w440)) (s442 (wrap-subst115 w440))) (if (and (pair?
ms441) (eq? (car ms441) #f)) (make-syntax-object94 (syntax-object-expression96
x438) (make-wrap113 (cdr ms441) (if rib435 (cons rib435 (cdr s442)) (cdr
s442))) (syntax-object-module98 x438)) (make-syntax-object94
(syntax-object-expression96 x438) (make-wrap113 (cons m439 ms441) (if rib435
(cons rib435 (cons (quote shift) s442)) (cons (quote shift) s442))) (let
((pmod443 (procedure-module p431))) (if pmod443 (cons (quote hygiene)
(module-name pmod443)) (quote (hygiene guile))))))))) ((vector? x438) (let
((n444 (vector-length x438))) (let ((v445 (make-vector n444))) (letrec
((doloop446 (lambda (i447) (if (fx=73 i447 n444) v445 (begin (vector-set! v445
i447 (rebuild-macro-output437 (vector-ref x438 i447) m439)) (doloop446 (fx+71
i447 1))))))) (doloop446 0))))) ((symbol? x438) (syntax-violation #f
"encountered raw symbol in macro output" (source-wrap140 e432 w434 s mod436)
x438)) (else x438))))) (rebuild-macro-output437 (p431 (wrap139 e432
(anti-mark126 w434) mod436)) (string #\m))))) (chi-application149 (lambda (x448
e449 r450 w451 s452 mod453) ((lambda (tmp454) ((lambda (tmp455) (if tmp455
(apply (lambda (e0456 e1457) (build-application79 s452 x448 (map (lambda (e458)
(chi147 e458 r450 w451 mod453)) e1457))) tmp455) (syntax-violation #f "source
expression failed to match any pattern" tmp454))) ($sc-dispatch tmp454 (quote
(any . each-any))))) e449))) (chi-expr148 (lambda (type460 value461 e462 r463
w464 s465 mod466) (let ((t467 type460)) (if (memv t467 (quote (lexical)))
(build-lexical-reference81 (quote value) s465 e462 value461) (if (memv t467
(quote (core external-macro))) (value461 e462 r463 w464 s465 mod466) (if (memv
t467 (quote (module-ref))) (call-with-values (lambda () (value461 e462))
(lambda (id468 mod469) (build-global-reference84 s465 id468 mod469))) (if (memv
t467 (quote (lexical-call))) (chi-application149 (build-lexical-reference81
(quote fun) (source-annotation102 (car e462)) (car e462) value461) e462 r463
w464 s465 mod466) (if (memv t467 (quote (global-call))) (chi-application149
(build-global-reference84 (source-annotation102 (car e462)) value461 (if
(syntax-object?95 (car e462)) (syntax-object-module98 (car e462)) mod466)) e462
r463 w464 s465 mod466) (if (memv t467 (quote (constant))) (build-data89 s465
(strip158 (source-wrap140 e462 w464 s465 mod466) (quote (())))) (if (memv t467
(quote (global))) (build-global-reference84 s465 value461 mod466) (if (memv
t467 (quote (call))) (chi-application149 (chi147 (car e462) r463 w464 mod466)
e462 r463 w464 s465 mod466) (if (memv t467 (quote (begin-form))) ((lambda
(tmp470) ((lambda (tmp471) (if tmp471 (apply (lambda (_472 e1473 e2474)
(chi-sequence141 (cons e1473 e2474) r463 w464 s465 mod466)) tmp471)
(syntax-violation #f "source expression failed to match any pattern" tmp470)))
($sc-dispatch tmp470 (quote (any any . each-any))))) e462) (if (memv t467
(quote (local-syntax-form))) (chi-local-syntax153 value461 e462 r463 w464 s465
mod466 chi-sequence141) (if (memv t467 (quote (eval-when-form))) ((lambda
(tmp476) ((lambda (tmp477) (if tmp477 (apply (lambda (_478 x479 e1480 e2481)
(let ((when-list482 (chi-when-list144 e462 x479 w464))) (if (memq (quote eval)
when-list482) (chi-sequence141 (cons e1480 e2481) r463 w464 s465 mod466)
(chi-void155)))) tmp477) (syntax-violation #f "source expression failed to
match any pattern" tmp476))) ($sc-dispatch tmp476 (quote (any each-any any .
each-any))))) e462) (if (memv t467 (quote (define-form define-syntax-form)))
(syntax-violation #f "definition in expression context" e462 (wrap139 value461
w464 mod466)) (if (memv t467 (quote (syntax))) (syntax-violation #f "reference
to pattern variable outside syntax form" (source-wrap140 e462 w464 s465
mod466)) (if (memv t467 (quote (displaced-lexical))) (syntax-violation #f
"reference to identifier outside its scope" (source-wrap140 e462 w464 s465
mod466)) (syntax-violation #f "unexpected syntax" (source-wrap140 e462 w464
s465 mod466))))))))))))))))))) (chi147 (lambda (e485 r486 w487 mod488)
(call-with-values (lambda () (syntax-type145 e485 r486 w487 #f #f mod488))
(lambda (type489 value490 e491 w492 s493 mod494) (chi-expr148 type489 value490
e491 r486 w492 s493 mod494))))) (chi-top146 (lambda (e495 r496 w497 m498
esew499 mod500) (call-with-values (lambda () (syntax-type145 e495 r496 w497 #f
#f mod500)) (lambda (type508 value509 e510 w511 s512 mod513) (let ((t514
type508)) (if (memv t514 (quote (begin-form))) ((lambda (tmp515) ((lambda
(tmp516) (if tmp516 (apply (lambda (_517) (chi-void155)) tmp516) ((lambda
(tmp518) (if tmp518 (apply (lambda (_519 e1520 e2521) (chi-top-sequence142
(cons e1520 e2521) r496 w511 s512 m498 esew499 mod513)) tmp518)
(syntax-violation #f "source expression failed to match any pattern" tmp515)))
($sc-dispatch tmp515 (quote (any any . each-any)))))) ($sc-dispatch tmp515
(quote (any))))) e510) (if (memv t514 (quote (local-syntax-form)))
(chi-local-syntax153 value509 e510 r496 w511 s512 mod513 (lambda (body523 r524
w525 s526 mod527) (chi-top-sequence142 body523 r524 w525 s526 m498 esew499
mod527))) (if (memv t514 (quote (eval-when-form))) ((lambda (tmp528) ((lambda
(tmp529) (if tmp529 (apply (lambda (_530 x531 e1532 e2533) (let ((when-list534
(chi-when-list144 e510 x531 w511)) (body535 (cons e1532 e2533))) (cond ((eq?
m498 (quote e)) (if (memq (quote eval) when-list534) (chi-top-sequence142
body535 r496 w511 s512 (quote e) (quote (eval)) mod513) (chi-void155))) ((memq
(quote load) when-list534) (if (or (memq (quote compile) when-list534) (and
(eq? m498 (quote c&e)) (memq (quote eval) when-list534))) (chi-top-sequence142
body535 r496 w511 s512 (quote c&e) (quote (compile load)) mod513) (if (memq
m498 (quote (c c&e))) (chi-top-sequence142 body535 r496 w511 s512 (quote c)
(quote (load)) mod513) (chi-void155)))) ((or (memq (quote compile)
when-list534) (and (eq? m498 (quote c&e)) (memq (quote eval) when-list534)))
(top-level-eval-hook75 (chi-top-sequence142 body535 r496 w511 s512 (quote e)
(quote (eval)) mod513) mod513) (chi-void155)) (else (chi-void155))))) tmp529)
(syntax-violation #f "source expression failed to match any pattern" tmp528)))
($sc-dispatch tmp528 (quote (any each-any any . each-any))))) e510) (if (memv
t514 (quote (define-syntax-form))) (let ((n538 (id-var-name133 value509 w511))
(r539 (macros-only-env107 r496))) (let ((t540 m498)) (if (memv t540 (quote
(c))) (if (memq (quote compile) esew499) (let ((e541 (chi-install-global143
n538 (chi147 e510 r539 w511 mod513)))) (begin (top-level-eval-hook75 e541
mod513) (if (memq (quote load) esew499) e541 (chi-void155)))) (if (memq (quote
load) esew499) (chi-install-global143 n538 (chi147 e510 r539 w511 mod513))
(chi-void155))) (if (memv t540 (quote (c&e))) (let ((e542
(chi-install-global143 n538 (chi147 e510 r539 w511 mod513)))) (begin
(top-level-eval-hook75 e542 mod513) e542)) (begin (if (memq (quote eval)
esew499) (top-level-eval-hook75 (chi-install-global143 n538 (chi147 e510 r539
w511 mod513)) mod513)) (chi-void155)))))) (if (memv t514 (quote (define-form)))
(let ((n543 (id-var-name133 value509 w511))) (let ((type544 (binding-type103
(lookup108 n543 r496 mod513)))) (let ((t545 type544)) (if (memv t545 (quote
(global core macro module-ref))) (let ((x546 (build-global-definition86 s512
n543 (chi147 e510 r496 w511 mod513)))) (begin (if (eq? m498 (quote c&e))
(top-level-eval-hook75 x546 mod513)) x546)) (if (memv t545 (quote
(displaced-lexical))) (syntax-violation #f "identifier out of context" e510
(wrap139 value509 w511 mod513)) (syntax-violation #f "cannot define keyword at
top level" e510 (wrap139 value509 w511 mod513))))))) (let ((x547 (chi-expr148
type508 value509 e510 r496 w511 s512 mod513))) (begin (if (eq? m498 (quote
c&e)) (top-level-eval-hook75 x547 mod513)) x547)))))))))))) (syntax-type145
(lambda (e548 r549 w550 s551 rib552 mod553) (cond ((symbol? e548) (let ((n554
(id-var-name133 e548 w550))) (let ((b555 (lookup108 n554 r549 mod553))) (let
((type556 (binding-type103 b555))) (let ((t557 type556)) (if (memv t557 (quote
(lexical))) (values type556 (binding-value104 b555) e548 w550 s551 mod553) (if
(memv t557 (quote (global))) (values type556 n554 e548 w550 s551 mod553) (if
(memv t557 (quote (macro))) (syntax-type145 (chi-macro150 (binding-value104
b555) e548 r549 w550 rib552 mod553) r549 (quote (())) s551 rib552 mod553)
(values type556 (binding-value104 b555) e548 w550 s551 mod553))))))))) ((pair?
e548) (let ((first558 (car e548))) (if (id?111 first558) (let ((n559
(id-var-name133 first558 w550))) (let ((b560 (lookup108 n559 r549 (or (and
(syntax-object?95 first558) (syntax-object-module98 first558)) mod553)))) (let
((type561 (binding-type103 b560))) (let ((t562 type561)) (if (memv t562 (quote
(lexical))) (values (quote lexical-call) (binding-value104 b560) e548 w550 s551
mod553) (if (memv t562 (quote (global))) (values (quote global-call) n559 e548
w550 s551 mod553) (if (memv t562 (quote (macro))) (syntax-type145 (chi-macro150
(binding-value104 b560) e548 r549 w550 rib552 mod553) r549 (quote (())) s551
rib552 mod553) (if (memv t562 (quote (core external-macro module-ref))) (values
type561 (binding-value104 b560) e548 w550 s551 mod553) (if (memv t562 (quote
(local-syntax))) (values (quote local-syntax-form) (binding-value104 b560) e548
w550 s551 mod553) (if (memv t562 (quote (begin))) (values (quote begin-form) #f
e548 w550 s551 mod553) (if (memv t562 (quote (eval-when))) (values (quote
eval-when-form) #f e548 w550 s551 mod553) (if (memv t562 (quote (define)))
((lambda (tmp563) ((lambda (tmp564) (if (if tmp564 (apply (lambda (_565 name566
val567) (id?111 name566)) tmp564) #f) (apply (lambda (_568 name569 val570)
(values (quote define-form) name569 val570 w550 s551 mod553)) tmp564) ((lambda
(tmp571) (if (if tmp571 (apply (lambda (_572 name573 args574 e1575 e2576) (and
(id?111 name573) (valid-bound-ids?136 (lambda-var-list160 args574)))) tmp571)
#f) (apply (lambda (_577 name578 args579 e1580 e2581) (values (quote
define-form) (wrap139 name578 w550 mod553) (cons (quote #(syntax-object lambda
((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i"
"i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type)
#((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage
() () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage
#(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod)
#((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) (wrap139 (cons args579 (cons e1580 e2581)) w550
mod553)) (quote (())) s551 mod553)) tmp571) ((lambda (tmp583) (if (if tmp583
(apply (lambda (_584 name585) (id?111 name585)) tmp583) #f) (apply (lambda
(_586 name587) (values (quote define-form) (wrap139 name587 w550 mod553) (quote
(#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list
gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer
chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr
chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence
chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids?
valid-bound-ids? bound-id=? free-id=? 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
unannotate 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 build-global-definition build-global-assignment
build-global-reference analyze-variable build-lexical-assignment
build-lexical-reference build-conditional build-application
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list
gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer
chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr
chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence
chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids?
valid-bound-ids? bound-id=? free-id=? 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
unannotate 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 build-global-definition build-global-assignment
build-global-reference analyze-variable build-lexical-assignment
build-lexical-reference build-conditional build-application
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list
gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer
chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr
chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence
chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids?
valid-bound-ids? bound-id=? free-id=? 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
unannotate 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 build-global-definition build-global-assignment
build-global-reference analyze-variable build-lexical-assignment
build-lexical-reference build-conditional build-application
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)))) (quote (())) s551 mod553)) tmp583) (syntax-violation #f "source
expression failed to match any pattern" tmp563))) ($sc-dispatch tmp563 (quote
(any any)))))) ($sc-dispatch tmp563 (quote (any (any . any) any .
each-any)))))) ($sc-dispatch tmp563 (quote (any any any))))) e548) (if (memv
t562 (quote (define-syntax))) ((lambda (tmp588) ((lambda (tmp589) (if (if
tmp589 (apply (lambda (_590 name591 val592) (id?111 name591)) tmp589) #f)
(apply (lambda (_593 name594 val595) (values (quote define-syntax-form) name594
val595 w550 s551 mod553)) tmp589) (syntax-violation #f "source expression
failed to match any pattern" tmp588))) ($sc-dispatch tmp588 (quote (any any
any))))) e548) (values (quote call) #f e548 w550 s551 mod553))))))))))))))
(values (quote call) #f e548 w550 s551 mod553)))) ((syntax-object?95 e548)
(syntax-type145 (syntax-object-expression96 e548) r549 (join-wraps130 w550
(syntax-object-wrap97 e548)) #f rib552 (or (syntax-object-module98 e548)
mod553))) ((annotation? e548) (syntax-type145 (annotation-expression e548) r549
w550 (annotation-source e548) rib552 mod553)) ((self-evaluating? e548) (values
(quote constant) #f e548 w550 s551 mod553)) (else (values (quote other) #f e548
w550 s551 mod553))))) (chi-when-list144 (lambda (e596 when-list597 w598)
(letrec ((f599 (lambda (when-list600 situations601) (if (null? when-list600)
situations601 (f599 (cdr when-list600) (cons (let ((x602 (car when-list600)))
(cond ((free-id=?134 x602 (quote #(syntax-object compile ((top) #(ribcage () ()
()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list
situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote compile)) ((free-id=?134 x602 (quote
#(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top))
#("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? 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 unannotate
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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote load)) ((free-id=?134 x602 (quote
#(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top))
#("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? 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 unannotate
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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote
eval-when) "invalid situation" e596 (wrap139 x602 w598 #f)))))
situations601)))))) (f599 when-list597 (quote ()))))) (chi-install-global143
(lambda (name603 e604) (build-global-definition86 #f name603 (if (let ((v605
(module-variable (current-module) name603))) (and v605 (variable-bound? v605)
(macro? (variable-ref v605)) (not (eq? (macro-type (variable-ref v605)) (quote
syncase-macro))))) (build-application79 #f (build-primref88 #f (quote
make-extended-syncase-macro)) (list (build-application79 #f (build-primref88 #f
(quote module-ref)) (list (build-application79 #f (quote current-module) (quote
())) (build-data89 #f name603))) (build-data89 #f (quote macro)) e604))
(build-application79 #f (build-primref88 #f (quote make-syncase-macro)) (list
(build-data89 #f (quote macro)) e604)))))) (chi-top-sequence142 (lambda
(body606 r607 w608 s609 m610 esew611 mod612) (build-sequence90 s609 (letrec
((dobody613 (lambda (body614 r615 w616 m617 esew618 mod619) (if (null? body614)
(quote ()) (let ((first620 (chi-top146 (car body614) r615 w616 m617 esew618
mod619))) (cons first620 (dobody613 (cdr body614) r615 w616 m617 esew618
mod619))))))) (dobody613 body606 r607 w608 m610 esew611 mod612)))))
(chi-sequence141 (lambda (body621 r622 w623 s624 mod625) (build-sequence90 s624
(letrec ((dobody626 (lambda (body627 r628 w629 mod630) (if (null? body627)
(quote ()) (let ((first631 (chi147 (car body627) r628 w629 mod630))) (cons
first631 (dobody626 (cdr body627) r628 w629 mod630))))))) (dobody626 body621
r622 w623 mod625))))) (source-wrap140 (lambda (x632 w633 s634 defmod635)
(wrap139 (if s634 (make-annotation x632 s634 #f) x632) w633 defmod635)))
(wrap139 (lambda (x636 w637 defmod638) (cond ((and (null? (wrap-marks114 w637))
(null? (wrap-subst115 w637))) x636) ((syntax-object?95 x636)
(make-syntax-object94 (syntax-object-expression96 x636) (join-wraps130 w637
(syntax-object-wrap97 x636)) (syntax-object-module98 x636))) ((null? x636)
x636) (else (make-syntax-object94 x636 w637 defmod638))))) (bound-id-member?138
(lambda (x639 list640) (and (not (null? list640)) (or (bound-id=?135 x639 (car
list640)) (bound-id-member?138 x639 (cdr list640)))))) (distinct-bound-ids?137
(lambda (ids641) (letrec ((distinct?642 (lambda (ids643) (or (null? ids643)
(and (not (bound-id-member?138 (car ids643) (cdr ids643))) (distinct?642 (cdr
ids643))))))) (distinct?642 ids641)))) (valid-bound-ids?136 (lambda (ids644)
(and (letrec ((all-ids?645 (lambda (ids646) (or (null? ids646) (and (id?111
(car ids646)) (all-ids?645 (cdr ids646))))))) (all-ids?645 ids644))
(distinct-bound-ids?137 ids644)))) (bound-id=?135 (lambda (i647 j648) (if (and
(syntax-object?95 i647) (syntax-object?95 j648)) (and (eq? (let ((e649
(syntax-object-expression96 i647))) (if (annotation? e649)
(annotation-expression e649) e649)) (let ((e650 (syntax-object-expression96
j648))) (if (annotation? e650) (annotation-expression e650) e650)))
(same-marks?132 (wrap-marks114 (syntax-object-wrap97 i647)) (wrap-marks114
(syntax-object-wrap97 j648)))) (eq? (let ((e651 i647)) (if (annotation? e651)
(annotation-expression e651) e651)) (let ((e652 j648)) (if (annotation? e652)
(annotation-expression e652) e652)))))) (free-id=?134 (lambda (i653 j654) (and
(eq? (let ((x655 i653)) (let ((e656 (if (syntax-object?95 x655)
(syntax-object-expression96 x655) x655))) (if (annotation? e656)
(annotation-expression e656) e656))) (let ((x657 j654)) (let ((e658 (if
(syntax-object?95 x657) (syntax-object-expression96 x657) x657))) (if
(annotation? e658) (annotation-expression e658) e658)))) (eq? (id-var-name133
i653 (quote (()))) (id-var-name133 j654 (quote (()))))))) (id-var-name133
(lambda (id659 w660) (letrec ((search-vector-rib663 (lambda (sym669 subst670
marks671 symnames672 ribcage673) (let ((n674 (vector-length symnames672)))
(letrec ((f675 (lambda (i676) (cond ((fx=73 i676 n674) (search661 sym669 (cdr
subst670) marks671)) ((and (eq? (vector-ref symnames672 i676) sym669)
(same-marks?132 marks671 (vector-ref (ribcage-marks121 ribcage673) i676)))
(values (vector-ref (ribcage-labels122 ribcage673) i676) marks671)) (else (f675
(fx+71 i676 1))))))) (f675 0))))) (search-list-rib662 (lambda (sym677 subst678
marks679 symnames680 ribcage681) (letrec ((f682 (lambda (symnames683 i684)
(cond ((null? symnames683) (search661 sym677 (cdr subst678) marks679)) ((and
(eq? (car symnames683) sym677) (same-marks?132 marks679 (list-ref
(ribcage-marks121 ribcage681) i684))) (values (list-ref (ribcage-labels122
ribcage681) i684) marks679)) (else (f682 (cdr symnames683) (fx+71 i684 1)))))))
(f682 symnames680 0)))) (search661 (lambda (sym685 subst686 marks687) (if
(null? subst686) (values #f marks687) (let ((fst688 (car subst686))) (if (eq?
fst688 (quote shift)) (search661 sym685 (cdr subst686) (cdr marks687)) (let
((symnames689 (ribcage-symnames120 fst688))) (if (vector? symnames689)
(search-vector-rib663 sym685 subst686 marks687 symnames689 fst688)
(search-list-rib662 sym685 subst686 marks687 symnames689 fst688))))))))) (cond
((symbol? id659) (or (call-with-values (lambda () (search661 id659
(wrap-subst115 w660) (wrap-marks114 w660))) (lambda (x691 . ignore690) x691))
id659)) ((syntax-object?95 id659) (let ((id692 (let ((e694
(syntax-object-expression96 id659))) (if (annotation? e694)
(annotation-expression e694) e694))) (w1693 (syntax-object-wrap97 id659))) (let
((marks695 (join-marks131 (wrap-marks114 w660) (wrap-marks114 w1693))))
(call-with-values (lambda () (search661 id692 (wrap-subst115 w660) marks695))
(lambda (new-id696 marks697) (or new-id696 (call-with-values (lambda ()
(search661 id692 (wrap-subst115 w1693) marks697)) (lambda (x699 . ignore698)
x699)) id692)))))) ((annotation? id659) (let ((id700 (let ((e701 id659)) (if
(annotation? e701) (annotation-expression e701) e701)))) (or (call-with-values
(lambda () (search661 id700 (wrap-subst115 w660) (wrap-marks114 w660))) (lambda
(x703 . ignore702) x703)) id700))) (else (syntax-violation (quote id-var-name)
"invalid id" id659)))))) (same-marks?132 (lambda (x704 y705) (or (eq? x704
y705) (and (not (null? x704)) (not (null? y705)) (eq? (car x704) (car y705))
(same-marks?132 (cdr x704) (cdr y705)))))) (join-marks131 (lambda (m1706 m2707)
(smart-append129 m1706 m2707))) (join-wraps130 (lambda (w1708 w2709) (let
((m1710 (wrap-marks114 w1708)) (s1711 (wrap-subst115 w1708))) (if (null? m1710)
(if (null? s1711) w2709 (make-wrap113 (wrap-marks114 w2709) (smart-append129
s1711 (wrap-subst115 w2709)))) (make-wrap113 (smart-append129 m1710
(wrap-marks114 w2709)) (smart-append129 s1711 (wrap-subst115 w2709)))))))
(smart-append129 (lambda (m1712 m2713) (if (null? m2713) m1712 (append m1712
m2713)))) (make-binding-wrap128 (lambda (ids714 labels715 w716) (if (null?
ids714) w716 (make-wrap113 (wrap-marks114 w716) (cons (let ((labelvec717
(list->vector labels715))) (let ((n718 (vector-length labelvec717))) (let
((symnamevec719 (make-vector n718)) (marksvec720 (make-vector n718))) (begin
(letrec ((f721 (lambda (ids722 i723) (if (not (null? ids722)) (call-with-values
(lambda () (id-sym-name&marks112 (car ids722) w716)) (lambda (symname724
marks725) (begin (vector-set! symnamevec719 i723 symname724) (vector-set!
marksvec720 i723 marks725) (f721 (cdr ids722) (fx+71 i723 1))))))))) (f721
ids714 0)) (make-ribcage118 symnamevec719 marksvec720 labelvec717)))))
(wrap-subst115 w716)))))) (extend-ribcage!127 (lambda (ribcage726 id727
label728) (begin (set-ribcage-symnames!123 ribcage726 (cons (let ((e729
(syntax-object-expression96 id727))) (if (annotation? e729)
(annotation-expression e729) e729)) (ribcage-symnames120 ribcage726)))
(set-ribcage-marks!124 ribcage726 (cons (wrap-marks114 (syntax-object-wrap97
id727)) (ribcage-marks121 ribcage726))) (set-ribcage-labels!125 ribcage726
(cons label728 (ribcage-labels122 ribcage726)))))) (anti-mark126 (lambda (w730)
(make-wrap113 (cons #f (wrap-marks114 w730)) (cons (quote shift) (wrap-subst115
w730))))) (set-ribcage-labels!125 (lambda (x731 update732) (vector-set! x731 3
update732))) (set-ribcage-marks!124 (lambda (x733 update734) (vector-set! x733
2 update734))) (set-ribcage-symnames!123 (lambda (x735 update736) (vector-set!
x735 1 update736))) (ribcage-labels122 (lambda (x737) (vector-ref x737 3)))
(ribcage-marks121 (lambda (x738) (vector-ref x738 2))) (ribcage-symnames120
(lambda (x739) (vector-ref x739 1))) (ribcage?119 (lambda (x740) (and (vector?
x740) (= (vector-length x740) 4) (eq? (vector-ref x740 0) (quote ribcage)))))
(make-ribcage118 (lambda (symnames741 marks742 labels743) (vector (quote
ribcage) symnames741 marks742 labels743))) (gen-labels117 (lambda (ls744) (if
(null? ls744) (quote ()) (cons (gen-label116) (gen-labels117 (cdr ls744))))))
(gen-label116 (lambda () (string #\i))) (wrap-subst115 cdr) (wrap-marks114 car)
(make-wrap113 cons) (id-sym-name&marks112 (lambda (x745 w746) (if
(syntax-object?95 x745) (values (let ((e747 (syntax-object-expression96 x745)))
(if (annotation? e747) (annotation-expression e747) e747)) (join-marks131
(wrap-marks114 w746) (wrap-marks114 (syntax-object-wrap97 x745)))) (values (let
((e748 x745)) (if (annotation? e748) (annotation-expression e748) e748))
(wrap-marks114 w746))))) (id?111 (lambda (x749) (cond ((symbol? x749) #t)
((syntax-object?95 x749) (symbol? (let ((e750 (syntax-object-expression96
x749))) (if (annotation? e750) (annotation-expression e750) e750))))
((annotation? x749) (symbol? (annotation-expression x749))) (else #f))))
(nonsymbol-id?110 (lambda (x751) (and (syntax-object?95 x751) (symbol? (let
((e752 (syntax-object-expression96 x751))) (if (annotation? e752)
(annotation-expression e752) e752)))))) (global-extend109 (lambda (type753
sym754 val755) (put-global-definition-hook77 sym754 type753 val755)))
(lookup108 (lambda (x756 r757 mod758) (cond ((assq x756 r757) => cdr) ((symbol?
x756) (or (get-global-definition-hook78 x756 mod758) (quote (global)))) (else
(quote (displaced-lexical)))))) (macros-only-env107 (lambda (r759) (if (null?
r759) (quote ()) (let ((a760 (car r759))) (if (eq? (cadr a760) (quote macro))
(cons a760 (macros-only-env107 (cdr r759))) (macros-only-env107 (cdr
r759))))))) (extend-var-env106 (lambda (labels761 vars762 r763) (if (null?
labels761) r763 (extend-var-env106 (cdr labels761) (cdr vars762) (cons (cons
(car labels761) (cons (quote lexical) (car vars762))) r763))))) (extend-env105
(lambda (labels764 bindings765 r766) (if (null? labels764) r766 (extend-env105
(cdr labels764) (cdr bindings765) (cons (cons (car labels764) (car
bindings765)) r766))))) (binding-value104 cdr) (binding-type103 car)
(source-annotation102 (lambda (x767) (cond ((annotation? x767)
(annotation-source x767)) ((syntax-object?95 x767) (source-annotation102
(syntax-object-expression96 x767))) (else #f)))) (set-syntax-object-module!101
(lambda (x768 update769) (vector-set! x768 3 update769)))
(set-syntax-object-wrap!100 (lambda (x770 update771) (vector-set! x770 2
update771))) (set-syntax-object-expression!99 (lambda (x772 update773)
(vector-set! x772 1 update773))) (syntax-object-module98 (lambda (x774)
(vector-ref x774 3))) (syntax-object-wrap97 (lambda (x775) (vector-ref x775
2))) (syntax-object-expression96 (lambda (x776) (vector-ref x776 1)))
(syntax-object?95 (lambda (x777) (and (vector? x777) (= (vector-length x777) 4)
(eq? (vector-ref x777 0) (quote syntax-object))))) (make-syntax-object94
(lambda (expression778 wrap779 module780) (vector (quote syntax-object)
expression778 wrap779 module780))) (build-letrec93 (lambda (src781 vars782
val-exps783 body-exp784) (if (null? vars782) body-exp784 (let ((t785 (fluid-ref
*mode*70))) (if (memv t785 (quote (c))) ((@ (language tree-il) make-letrec)
src781 vars782 val-exps783 body-exp784) (list (quote letrec) (map list vars782
val-exps783) body-exp784)))))) (build-named-let92 (lambda (src786 vars787
val-exps788 body-exp789) (let ((f790 (car vars787)) (vars791 (cdr vars787)))
(let ((t792 (fluid-ref *mode*70))) (if (memv t792 (quote (c))) ((@ (language
tree-il) make-letrec) src786 (list f790) (list (build-lambda87 src786 vars791
#f body-exp789)) (build-application79 src786 (build-lexical-reference81 (quote
fun) src786 f790 f790) val-exps788)) (list (quote let) f790 (map list vars791
val-exps788) body-exp789)))))) (build-let91 (lambda (src793 vars794 val-exps795
body-exp796) (if (null? vars794) body-exp796 (let ((t797 (fluid-ref *mode*70)))
(if (memv t797 (quote (c))) ((@ (language tree-il) make-let) src793 vars794
val-exps795 body-exp796) (list (quote let) (map list vars794 val-exps795)
body-exp796)))))) (build-sequence90 (lambda (src798 exps799) (if (null? (cdr
exps799)) (car exps799) (let ((t800 (fluid-ref *mode*70))) (if (memv t800
(quote (c))) ((@ (language tree-il) make-sequence) src798 exps799) (cons (quote
begin) exps799)))))) (build-data89 (lambda (src801 exp802) (let ((t803
(fluid-ref *mode*70))) (if (memv t803 (quote (c))) ((@ (language tree-il)
make-const) src801 exp802) (if (and (self-evaluating? exp802) (not (vector?
exp802))) exp802 (list (quote quote) exp802)))))) (build-primref88 (lambda
(src804 name805) (let ((t806 (fluid-ref *mode*70))) (if (memv t806 (quote (c)))
((@ (language tree-il) make-primitive-ref) src804 name805)
(build-global-reference84 src804 name805 (quote (hygiene guile)))))))
(build-lambda87 (lambda (src807 vars808 docstring809 exp810) (let ((t811
(fluid-ref *mode*70))) (if (memv t811 (quote (c))) ((@ (language tree-il)
make-lambda) src807 vars808 (if docstring809 (list (cons (quote documentation)
docstring809)) (quote ())) exp810) (cons (quote lambda) (cons vars808 (append
(if docstring809 (list docstring809) (quote ())) (list exp810))))))))
(build-global-definition86 (lambda (source812 var813 exp814) (let ((t815
(fluid-ref *mode*70))) (if (memv t815 (quote (c))) ((@ (language tree-il)
make-toplevel-define) source812 var813 exp814) (list (quote define) var813
exp814))))) (build-global-assignment85 (lambda (source816 var817 exp818 mod819)
(analyze-variable83 mod819 var817 (lambda (mod820 var821 public?822) (let
((t823 (fluid-ref *mode*70))) (if (memv t823 (quote (c))) ((@ (language
tree-il) make-module-set) source816 mod820 var821 public?822 exp818) (list
(quote set!) (list (if public?822 (quote @) (quote @@)) mod820 var821)
exp818)))) (lambda (var824) (let ((t825 (fluid-ref *mode*70))) (if (memv t825
(quote (c))) ((@ (language tree-il) make-toplevel-set) source816 var824 exp818)
(list (quote set!) var824 exp818))))))) (build-global-reference84 (lambda
(source826 var827 mod828) (analyze-variable83 mod828 var827 (lambda (mod829
var830 public?831) (let ((t832 (fluid-ref *mode*70))) (if (memv t832 (quote
(c))) ((@ (language tree-il) make-module-ref) source826 mod829 var830
public?831) (list (if public?831 (quote @) (quote @@)) mod829 var830))))
(lambda (var833) (let ((t834 (fluid-ref *mode*70))) (if (memv t834 (quote (c)))
((@ (language tree-il) make-toplevel-ref) source826 var833) var833))))))
(analyze-variable83 (lambda (mod835 var836 modref-cont837 bare-cont838) (if
(not mod835) (bare-cont838 var836) (let ((kind839 (car mod835)) (mod840 (cdr
mod835))) (let ((t841 kind839)) (if (memv t841 (quote (public)))
(modref-cont837 mod840 var836 #t) (if (memv t841 (quote (private))) (if (not
(equal? mod840 (module-name (current-module)))) (modref-cont837 mod840 var836
#f) (bare-cont838 var836)) (if (memv t841 (quote (bare))) (bare-cont838 var836)
(if (memv t841 (quote (hygiene))) (if (and (not (equal? mod840 (module-name
(current-module)))) (module-variable (resolve-module mod840) var836))
(modref-cont837 mod840 var836 #f) (bare-cont838 var836)) (syntax-violation #f
"bad module kind" var836 mod840)))))))))) (build-lexical-assignment82 (lambda
(source842 name843 var844 exp845) (let ((t846 (fluid-ref *mode*70))) (if (memv
t846 (quote (c))) ((@ (language tree-il) make-lexical-set) source842 name843
var844 exp845) (list (quote set!) var844 exp845))))) (build-lexical-reference81
(lambda (type847 source848 name849 var850) (let ((t851 (fluid-ref *mode*70)))
(if (memv t851 (quote (c))) ((@ (language tree-il) make-lexical-ref) source848
name849 var850) var850)))) (build-conditional80 (lambda (source852 test-exp853
then-exp854 else-exp855) (let ((t856 (fluid-ref *mode*70))) (if (memv t856
(quote (c))) ((@ (language tree-il) make-conditional) source852 test-exp853
then-exp854 else-exp855) (list (quote if) test-exp853 then-exp854
else-exp855))))) (build-application79 (lambda (source857 fun-exp858
arg-exps859) (let ((t860 (fluid-ref *mode*70))) (if (memv t860 (quote (c))) ((@
(language tree-il) make-application) source857 fun-exp858 arg-exps859) (cons
fun-exp858 arg-exps859))))) (get-global-definition-hook78 (lambda (symbol861
module862) (begin (if (and (not module862) (current-module)) (warn "module
system is booted, we should have a module" symbol861)) (let ((v863
(module-variable (if module862 (resolve-module (cdr module862))
(current-module)) symbol861))) (and v863 (variable-bound? v863) (let ((val864
(variable-ref v863))) (and (macro? val864) (syncase-macro-type val864) (cons
(syncase-macro-type val864) (syncase-macro-binding val864)))))))))
(put-global-definition-hook77 (lambda (symbol865 type866 val867) (let
((existing868 (let ((v869 (module-variable (current-module) symbol865))) (and
v869 (variable-bound? v869) (let ((val870 (variable-ref v869))) (and (macro?
val870) (not (syncase-macro-type val870)) val870)))))) (module-define!
(current-module) symbol865 (if existing868 (make-extended-syncase-macro
existing868 type866 val867) (make-syncase-macro type866 val867))))))
(local-eval-hook76 (lambda (x871 mod872) (primitive-eval (list noexpand69 (let
((t873 (fluid-ref *mode*70))) (if (memv t873 (quote (c))) ((@ (language
tree-il) tree-il->scheme) x871) x871)))))) (top-level-eval-hook75 (lambda (x874
mod875) (primitive-eval (list noexpand69 (let ((t876 (fluid-ref *mode*70))) (if
(memv t876 (quote (c))) ((@ (language tree-il) tree-il->scheme) x874)
x874)))))) (fx<74 <) (fx=73 =) (fx-72 -) (fx+71 +) (*mode*70 (make-fluid))
(noexpand69 "noexpand")) (begin (global-extend109 (quote local-syntax) (quote
letrec-syntax) #t) (global-extend109 (quote local-syntax) (quote let-syntax)
#f) (global-extend109 (quote core) (quote fluid-let-syntax) (lambda (e877 r878
w879 s880 mod881) ((lambda (tmp882) ((lambda (tmp883) (if (if tmp883 (apply
(lambda (_884 var885 val886 e1887 e2888) (valid-bound-ids?136 var885)) tmp883)
#f) (apply (lambda (_890 var891 val892 e1893 e2894) (let ((names895 (map
(lambda (x896) (id-var-name133 x896 w879)) var891))) (begin (for-each (lambda
(id898 n899) (let ((t900 (binding-type103 (lookup108 n899 r878 mod881)))) (if
(memv t900 (quote (displaced-lexical))) (syntax-violation (quote
fluid-let-syntax) "identifier out of context" e877 (source-wrap140 id898 w879
s880 mod881))))) var891 names895) (chi-body151 (cons e1893 e2894)
(source-wrap140 e877 w879 s880 mod881) (extend-env105 names895 (let
((trans-r903 (macros-only-env107 r878))) (map (lambda (x904) (cons (quote
macro) (eval-local-transformer154 (chi147 x904 trans-r903 w879 mod881)
mod881))) val892)) r878) w879 mod881)))) tmp883) ((lambda (_906)
(syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap140 e877
w879 s880 mod881))) tmp882))) ($sc-dispatch tmp882 (quote (any #(each (any
any)) any . each-any))))) e877))) (global-extend109 (quote core) (quote quote)
(lambda (e907 r908 w909 s910 mod911) ((lambda (tmp912) ((lambda (tmp913) (if
tmp913 (apply (lambda (_914 e915) (build-data89 s910 (strip158 e915 w909)))
tmp913) ((lambda (_916) (syntax-violation (quote quote) "bad syntax"
(source-wrap140 e907 w909 s910 mod911))) tmp912))) ($sc-dispatch tmp912 (quote
(any any))))) e907))) (global-extend109 (quote core) (quote syntax) (letrec
((regen924 (lambda (x925) (let ((t926 (car x925))) (if (memv t926 (quote
(ref))) (build-lexical-reference81 (quote value) #f (cadr x925) (cadr x925))
(if (memv t926 (quote (primitive))) (build-primref88 #f (cadr x925)) (if (memv
t926 (quote (quote))) (build-data89 #f (cadr x925)) (if (memv t926 (quote
(lambda))) (build-lambda87 #f (cadr x925) #f (regen924 (caddr x925))) (if (memv
t926 (quote (map))) (let ((ls927 (map regen924 (cdr x925))))
(build-application79 #f (build-primref88 #f (quote map)) ls927))
(build-application79 #f (build-primref88 #f (car x925)) (map regen924 (cdr
x925))))))))))) (gen-vector923 (lambda (x928) (cond ((eq? (car x928) (quote
list)) (cons (quote vector) (cdr x928))) ((eq? (car x928) (quote quote)) (list
(quote quote) (list->vector (cadr x928)))) (else (list (quote list->vector)
x928))))) (gen-append922 (lambda (x929 y930) (if (equal? y930 (quote (quote
()))) x929 (list (quote append) x929 y930)))) (gen-cons921 (lambda (x931 y932)
(let ((t933 (car y932))) (if (memv t933 (quote (quote))) (if (eq? (car x931)
(quote quote)) (list (quote quote) (cons (cadr x931) (cadr y932))) (if (eq?
(cadr y932) (quote ())) (list (quote list) x931) (list (quote cons) x931
y932))) (if (memv t933 (quote (list))) (cons (quote list) (cons x931 (cdr
y932))) (list (quote cons) x931 y932)))))) (gen-map920 (lambda (e934
map-env935) (let ((formals936 (map cdr map-env935)) (actuals937 (map (lambda
(x938) (list (quote ref) (car x938))) map-env935))) (cond ((eq? (car e934)
(quote ref)) (car actuals937)) ((and-map (lambda (x939) (and (eq? (car x939)
(quote ref)) (memq (cadr x939) formals936))) (cdr e934)) (cons (quote map)
(cons (list (quote primitive) (car e934)) (map (let ((r940 (map cons formals936
actuals937))) (lambda (x941) (cdr (assq (cadr x941) r940)))) (cdr e934)))))
(else (cons (quote map) (cons (list (quote lambda) formals936 e934)
actuals937))))))) (gen-mappend919 (lambda (e942 map-env943) (list (quote apply)
(quote (primitive append)) (gen-map920 e942 map-env943)))) (gen-ref918 (lambda
(src944 var945 level946 maps947) (if (fx=73 level946 0) (values var945 maps947)
(if (null? maps947) (syntax-violation (quote syntax) "missing ellipsis" src944)
(call-with-values (lambda () (gen-ref918 src944 var945 (fx-72 level946 1) (cdr
maps947))) (lambda (outer-var948 outer-maps949) (let ((b950 (assq outer-var948
(car maps947)))) (if b950 (values (cdr b950) maps947) (let ((inner-var951
(gen-var159 (quote tmp)))) (values inner-var951 (cons (cons (cons outer-var948
inner-var951) (car maps947)) outer-maps949))))))))))) (gen-syntax917 (lambda
(src952 e953 r954 maps955 ellipsis?956 mod957) (if (id?111 e953) (let
((label958 (id-var-name133 e953 (quote (()))))) (let ((b959 (lookup108 label958
r954 mod957))) (if (eq? (binding-type103 b959) (quote syntax))
(call-with-values (lambda () (let ((var.lev960 (binding-value104 b959)))
(gen-ref918 src952 (car var.lev960) (cdr var.lev960) maps955))) (lambda (var961
maps962) (values (list (quote ref) var961) maps962))) (if (ellipsis?956 e953)
(syntax-violation (quote syntax) "misplaced ellipsis" src952) (values (list
(quote quote) e953) maps955))))) ((lambda (tmp963) ((lambda (tmp964) (if (if
tmp964 (apply (lambda (dots965 e966) (ellipsis?956 dots965)) tmp964) #f) (apply
(lambda (dots967 e968) (gen-syntax917 src952 e968 r954 maps955 (lambda (x969)
#f) mod957)) tmp964) ((lambda (tmp970) (if (if tmp970 (apply (lambda (x971
dots972 y973) (ellipsis?956 dots972)) tmp970) #f) (apply (lambda (x974 dots975
y976) (letrec ((f977 (lambda (y978 k979) ((lambda (tmp983) ((lambda (tmp984)
(if (if tmp984 (apply (lambda (dots985 y986) (ellipsis?956 dots985)) tmp984)
#f) (apply (lambda (dots987 y988) (f977 y988 (lambda (maps989)
(call-with-values (lambda () (k979 (cons (quote ()) maps989))) (lambda (x990
maps991) (if (null? (car maps991)) (syntax-violation (quote syntax) "extra
ellipsis" src952) (values (gen-mappend919 x990 (car maps991)) (cdr
maps991)))))))) tmp984) ((lambda (_992) (call-with-values (lambda ()
(gen-syntax917 src952 y978 r954 maps955 ellipsis?956 mod957)) (lambda (y993
maps994) (call-with-values (lambda () (k979 maps994)) (lambda (x995 maps996)
(values (gen-append922 x995 y993) maps996)))))) tmp983))) ($sc-dispatch tmp983
(quote (any . any))))) y978)))) (f977 y976 (lambda (maps980) (call-with-values
(lambda () (gen-syntax917 src952 x974 r954 (cons (quote ()) maps980)
ellipsis?956 mod957)) (lambda (x981 maps982) (if (null? (car maps982))
(syntax-violation (quote syntax) "extra ellipsis" src952) (values (gen-map920
x981 (car maps982)) (cdr maps982))))))))) tmp970) ((lambda (tmp997) (if tmp997
(apply (lambda (x998 y999) (call-with-values (lambda () (gen-syntax917 src952
x998 r954 maps955 ellipsis?956 mod957)) (lambda (x1000 maps1001)
(call-with-values (lambda () (gen-syntax917 src952 y999 r954 maps1001
ellipsis?956 mod957)) (lambda (y1002 maps1003) (values (gen-cons921 x1000
y1002) maps1003)))))) tmp997) ((lambda (tmp1004) (if tmp1004 (apply (lambda
(e11005 e21006) (call-with-values (lambda () (gen-syntax917 src952 (cons e11005
e21006) r954 maps955 ellipsis?956 mod957)) (lambda (e1008 maps1009) (values
(gen-vector923 e1008) maps1009)))) tmp1004) ((lambda (_1010) (values (list
(quote quote) e953) maps955)) tmp963))) ($sc-dispatch tmp963 (quote #(vector
(any . each-any))))))) ($sc-dispatch tmp963 (quote (any . any))))))
($sc-dispatch tmp963 (quote (any any . any)))))) ($sc-dispatch tmp963 (quote
(any any))))) e953))))) (lambda (e1011 r1012 w1013 s1014 mod1015) (let ((e1016
(source-wrap140 e1011 w1013 s1014 mod1015))) ((lambda (tmp1017) ((lambda
(tmp1018) (if tmp1018 (apply (lambda (_1019 x1020) (call-with-values (lambda ()
(gen-syntax917 e1016 x1020 r1012 (quote ()) ellipsis?156 mod1015)) (lambda
(e1021 maps1022) (regen924 e1021)))) tmp1018) ((lambda (_1023)
(syntax-violation (quote syntax) "bad `syntax' form" e1016)) tmp1017)))
($sc-dispatch tmp1017 (quote (any any))))) e1016))))) (global-extend109 (quote
core) (quote lambda) (lambda (e1024 r1025 w1026 s1027 mod1028) ((lambda
(tmp1029) ((lambda (tmp1030) (if tmp1030 (apply (lambda (_1031 c1032)
(chi-lambda-clause152 (source-wrap140 e1024 w1026 s1027 mod1028) #f c1032 r1025
w1026 mod1028 (lambda (vars1033 docstring1034 body1035) (build-lambda87 s1027
vars1033 docstring1034 body1035)))) tmp1030) (syntax-violation #f "source
expression failed to match any pattern" tmp1029))) ($sc-dispatch tmp1029 (quote
(any . any))))) e1024))) (global-extend109 (quote core) (quote let) (letrec
((chi-let1036 (lambda (e1037 r1038 w1039 s1040 mod1041 constructor1042 ids1043
vals1044 exps1045) (if (not (valid-bound-ids?136 ids1043)) (syntax-violation
(quote let) "duplicate bound variable" e1037) (let ((labels1046 (gen-labels117
ids1043)) (new-vars1047 (map gen-var159 ids1043))) (let ((nw1048
(make-binding-wrap128 ids1043 labels1046 w1039)) (nr1049 (extend-var-env106
labels1046 new-vars1047 r1038))) (constructor1042 s1040 new-vars1047 (map
(lambda (x1050) (chi147 x1050 r1038 w1039 mod1041)) vals1044) (chi-body151
exps1045 (source-wrap140 e1037 nw1048 s1040 mod1041) nr1049 nw1048
mod1041)))))))) (lambda (e1051 r1052 w1053 s1054 mod1055) ((lambda (tmp1056)
((lambda (tmp1057) (if tmp1057 (apply (lambda (_1058 id1059 val1060 e11061
e21062) (chi-let1036 e1051 r1052 w1053 s1054 mod1055 build-let91 id1059 val1060
(cons e11061 e21062))) tmp1057) ((lambda (tmp1066) (if (if tmp1066 (apply
(lambda (_1067 f1068 id1069 val1070 e11071 e21072) (id?111 f1068)) tmp1066) #f)
(apply (lambda (_1073 f1074 id1075 val1076 e11077 e21078) (chi-let1036 e1051
r1052 w1053 s1054 mod1055 build-named-let92 (cons f1074 id1075) val1076 (cons
e11077 e21078))) tmp1066) ((lambda (_1082) (syntax-violation (quote let) "bad
let" (source-wrap140 e1051 w1053 s1054 mod1055))) tmp1056))) ($sc-dispatch
tmp1056 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch
tmp1056 (quote (any #(each (any any)) any . each-any))))) e1051))))
(global-extend109 (quote core) (quote letrec) (lambda (e1083 r1084 w1085 s1086
mod1087) ((lambda (tmp1088) ((lambda (tmp1089) (if tmp1089 (apply (lambda
(_1090 id1091 val1092 e11093 e21094) (let ((ids1095 id1091)) (if (not
(valid-bound-ids?136 ids1095)) (syntax-violation (quote letrec) "duplicate
bound variable" e1083) (let ((labels1097 (gen-labels117 ids1095)) (new-vars1098
(map gen-var159 ids1095))) (let ((w1099 (make-binding-wrap128 ids1095
labels1097 w1085)) (r1100 (extend-var-env106 labels1097 new-vars1098 r1084)))
(build-letrec93 s1086 new-vars1098 (map (lambda (x1101) (chi147 x1101 r1100
w1099 mod1087)) val1092) (chi-body151 (cons e11093 e21094) (source-wrap140
e1083 w1099 s1086 mod1087) r1100 w1099 mod1087))))))) tmp1089) ((lambda (_1104)
(syntax-violation (quote letrec) "bad letrec" (source-wrap140 e1083 w1085 s1086
mod1087))) tmp1088))) ($sc-dispatch tmp1088 (quote (any #(each (any any)) any .
each-any))))) e1083))) (global-extend109 (quote core) (quote set!) (lambda
(e1105 r1106 w1107 s1108 mod1109) ((lambda (tmp1110) ((lambda (tmp1111) (if (if
tmp1111 (apply (lambda (_1112 id1113 val1114) (id?111 id1113)) tmp1111) #f)
(apply (lambda (_1115 id1116 val1117) (let ((val1118 (chi147 val1117 r1106
w1107 mod1109)) (n1119 (id-var-name133 id1116 w1107))) (let ((b1120 (lookup108
n1119 r1106 mod1109))) (let ((t1121 (binding-type103 b1120))) (if (memv t1121
(quote (lexical))) (build-lexical-assignment82 s1108 (syntax->datum id1116)
(binding-value104 b1120) val1118) (if (memv t1121 (quote (global)))
(build-global-assignment85 s1108 n1119 val1118 mod1109) (if (memv t1121 (quote
(displaced-lexical))) (syntax-violation (quote set!) "identifier out of
context" (wrap139 id1116 w1107 mod1109)) (syntax-violation (quote set!) "bad
set!" (source-wrap140 e1105 w1107 s1108 mod1109))))))))) tmp1111) ((lambda
(tmp1122) (if tmp1122 (apply (lambda (_1123 head1124 tail1125 val1126)
(call-with-values (lambda () (syntax-type145 head1124 r1106 (quote (())) #f #f
mod1109)) (lambda (type1127 value1128 ee1129 ww1130 ss1131 modmod1132) (let
((t1133 type1127)) (if (memv t1133 (quote (module-ref))) (let ((val1134 (chi147
val1126 r1106 w1107 mod1109))) (call-with-values (lambda () (value1128 (cons
head1124 tail1125))) (lambda (id1136 mod1137) (build-global-assignment85 s1108
id1136 val1134 mod1137)))) (build-application79 s1108 (chi147 (list (quote
#(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top))
#("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss
modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i"))
#(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? 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 unannotate
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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) head1124) r1106 w1107 mod1109) (map (lambda (e1138)
(chi147 e1138 r1106 w1107 mod1109)) (append tail1125 (list val1126)))))))))
tmp1122) ((lambda (_1140) (syntax-violation (quote set!) "bad set!"
(source-wrap140 e1105 w1107 s1108 mod1109))) tmp1110))) ($sc-dispatch tmp1110
(quote (any (any . each-any) any)))))) ($sc-dispatch tmp1110 (quote (any any
any))))) e1105))) (global-extend109 (quote module-ref) (quote @) (lambda
(e1141) ((lambda (tmp1142) ((lambda (tmp1143) (if (if tmp1143 (apply (lambda
(_1144 mod1145 id1146) (and (and-map id?111 mod1145) (id?111 id1146))) tmp1143)
#f) (apply (lambda (_1148 mod1149 id1150) (values (syntax->datum id1150)
(syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e)
#((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation
ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause
chi-body chi-macro chi-application chi-expr chi chi-top syntax-type
chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) mod1149)))) tmp1143) (syntax-violation #f "source
expression failed to match any pattern" tmp1142))) ($sc-dispatch tmp1142 (quote
(any each-any any))))) e1141))) (global-extend109 (quote module-ref) (quote @@)
(lambda (e1152) ((lambda (tmp1153) ((lambda (tmp1154) (if (if tmp1154 (apply
(lambda (_1155 mod1156 id1157) (and (and-map id?111 mod1156) (id?111 id1157)))
tmp1154) #f) (apply (lambda (_1159 mod1160 id1161) (values (syntax->datum
id1161) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage
#(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation
ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause
chi-body chi-macro chi-application chi-expr chi chi-top syntax-type
chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) mod1160)))) tmp1154) (syntax-violation #f "source
expression failed to match any pattern" tmp1153))) ($sc-dispatch tmp1153 (quote
(any each-any any))))) e1152))) (global-extend109 (quote begin) (quote begin)
(quote ())) (global-extend109 (quote define) (quote define) (quote ()))
(global-extend109 (quote define-syntax) (quote define-syntax) (quote ()))
(global-extend109 (quote eval-when) (quote eval-when) (quote ()))
(global-extend109 (quote core) (quote syntax-case) (letrec
((gen-syntax-case1166 (lambda (x1167 keys1168 clauses1169 r1170 mod1171) (if
(null? clauses1169) (build-application79 #f (build-primref88 #f (quote
syntax-violation)) (list #f "source expression failed to match any pattern"
x1167)) ((lambda (tmp1172) ((lambda (tmp1173) (if tmp1173 (apply (lambda
(pat1174 exp1175) (if (and (id?111 pat1174) (and-map (lambda (x1176) (not
(free-id=?134 pat1174 x1176))) (cons (quote #(syntax-object ... ((top)
#(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage
#(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call
convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) keys1168))) (let ((labels1177 (list (gen-label116)))
(var1178 (gen-var159 pat1174))) (build-application79 #f (build-lambda87 #f
(list var1178) #f (chi147 exp1175 (extend-env105 labels1177 (list (cons (quote
syntax) (cons var1178 0))) r1170) (make-binding-wrap128 (list pat1174)
labels1177 (quote (()))) mod1171)) (list x1167))) (gen-clause1165 x1167
keys1168 (cdr clauses1169) r1170 pat1174 #t exp1175 mod1171))) tmp1173)
((lambda (tmp1179) (if tmp1179 (apply (lambda (pat1180 fender1181 exp1182)
(gen-clause1165 x1167 keys1168 (cdr clauses1169) r1170 pat1180 fender1181
exp1182 mod1171)) tmp1179) ((lambda (_1183) (syntax-violation (quote
syntax-case) "invalid clause" (car clauses1169))) tmp1172))) ($sc-dispatch
tmp1172 (quote (any any any)))))) ($sc-dispatch tmp1172 (quote (any any)))))
(car clauses1169))))) (gen-clause1165 (lambda (x1184 keys1185 clauses1186 r1187
pat1188 fender1189 exp1190 mod1191) (call-with-values (lambda ()
(convert-pattern1163 pat1188 keys1185)) (lambda (p1192 pvars1193) (cond ((not
(distinct-bound-ids?137 (map car pvars1193))) (syntax-violation (quote
syntax-case) "duplicate pattern variable" pat1188)) ((not (and-map (lambda
(x1194) (not (ellipsis?156 (car x1194)))) pvars1193)) (syntax-violation (quote
syntax-case) "misplaced ellipsis" pat1188)) (else (let ((y1195 (gen-var159
(quote tmp)))) (build-application79 #f (build-lambda87 #f (list y1195) #f (let
((y1196 (build-lexical-reference81 (quote value) #f (quote tmp) y1195)))
(build-conditional80 #f ((lambda (tmp1197) ((lambda (tmp1198) (if tmp1198
(apply (lambda () y1196) tmp1198) ((lambda (_1199) (build-conditional80 #f
y1196 (build-dispatch-call1164 pvars1193 fender1189 y1196 r1187 mod1191)
(build-data89 #f #f))) tmp1197))) ($sc-dispatch tmp1197 (quote #(atom #t)))))
fender1189) (build-dispatch-call1164 pvars1193 exp1190 y1196 r1187 mod1191)
(gen-syntax-case1166 x1184 keys1185 clauses1186 r1187 mod1191)))) (list (if
(eq? p1192 (quote any)) (build-application79 #f (build-primref88 #f (quote
list)) (list x1184)) (build-application79 #f (build-primref88 #f (quote
$sc-dispatch)) (list x1184 (build-data89 #f p1192)))))))))))))
(build-dispatch-call1164 (lambda (pvars1200 exp1201 y1202 r1203 mod1204) (let
((ids1205 (map car pvars1200)) (levels1206 (map cdr pvars1200))) (let
((labels1207 (gen-labels117 ids1205)) (new-vars1208 (map gen-var159 ids1205)))
(build-application79 #f (build-primref88 #f (quote apply)) (list
(build-lambda87 #f new-vars1208 #f (chi147 exp1201 (extend-env105 labels1207
(map (lambda (var1209 level1210) (cons (quote syntax) (cons var1209
level1210))) new-vars1208 (map cdr pvars1200)) r1203) (make-binding-wrap128
ids1205 labels1207 (quote (()))) mod1204)) y1202)))))) (convert-pattern1163
(lambda (pattern1211 keys1212) (letrec ((cvt1213 (lambda (p1214 n1215 ids1216)
(if (id?111 p1214) (if (bound-id-member?138 p1214 keys1212) (values (vector
(quote free-id) p1214) ids1216) (values (quote any) (cons (cons p1214 n1215)
ids1216))) ((lambda (tmp1217) ((lambda (tmp1218) (if (if tmp1218 (apply (lambda
(x1219 dots1220) (ellipsis?156 dots1220)) tmp1218) #f) (apply (lambda (x1221
dots1222) (call-with-values (lambda () (cvt1213 x1221 (fx+71 n1215 1) ids1216))
(lambda (p1223 ids1224) (values (if (eq? p1223 (quote any)) (quote each-any)
(vector (quote each) p1223)) ids1224)))) tmp1218) ((lambda (tmp1225) (if
tmp1225 (apply (lambda (x1226 y1227) (call-with-values (lambda () (cvt1213
y1227 n1215 ids1216)) (lambda (y1228 ids1229) (call-with-values (lambda ()
(cvt1213 x1226 n1215 ids1229)) (lambda (x1230 ids1231) (values (cons x1230
y1228) ids1231)))))) tmp1225) ((lambda (tmp1232) (if tmp1232 (apply (lambda ()
(values (quote ()) ids1216)) tmp1232) ((lambda (tmp1233) (if tmp1233 (apply
(lambda (x1234) (call-with-values (lambda () (cvt1213 x1234 n1215 ids1216))
(lambda (p1236 ids1237) (values (vector (quote vector) p1236) ids1237))))
tmp1233) ((lambda (x1238) (values (vector (quote atom) (strip158 p1214 (quote
(())))) ids1216)) tmp1217))) ($sc-dispatch tmp1217 (quote #(vector
each-any)))))) ($sc-dispatch tmp1217 (quote ()))))) ($sc-dispatch tmp1217
(quote (any . any)))))) ($sc-dispatch tmp1217 (quote (any any))))) p1214)))))
(cvt1213 pattern1211 0 (quote ())))))) (lambda (e1239 r1240 w1241 s1242
mod1243) (let ((e1244 (source-wrap140 e1239 w1241 s1242 mod1243))) ((lambda
(tmp1245) ((lambda (tmp1246) (if tmp1246 (apply (lambda (_1247 val1248 key1249
m1250) (if (and-map (lambda (x1251) (and (id?111 x1251) (not (ellipsis?156
x1251)))) key1249) (let ((x1253 (gen-var159 (quote tmp)))) (build-application79
s1242 (build-lambda87 #f (list x1253) #f (gen-syntax-case1166
(build-lexical-reference81 (quote value) #f (quote tmp) x1253) key1249 m1250
r1240 mod1243)) (list (chi147 val1248 r1240 (quote (())) mod1243))))
(syntax-violation (quote syntax-case) "invalid literals list" e1244))) tmp1246)
(syntax-violation #f "source expression failed to match any pattern" tmp1245)))
($sc-dispatch tmp1245 (quote (any any each-any . each-any))))) e1244))))) (set!
sc-expand (lambda (x1257 . rest1256) (if (and (pair? x1257) (equal? (car x1257)
noexpand69)) (cadr x1257) (let ((m1258 (if (null? rest1256) (quote e) (car
rest1256))) (esew1259 (if (or (null? rest1256) (null? (cdr rest1256))) (quote
(eval)) (cadr rest1256)))) (with-fluid* *mode*70 m1258 (lambda () (chi-top146
x1257 (quote ()) (quote ((top))) m1258 esew1259 (cons (quote hygiene)
(module-name (current-module)))))))))) (set! identifier? (lambda (x1260)
(nonsymbol-id?110 x1260))) (set! datum->syntax (lambda (id1261 datum1262)
(make-syntax-object94 datum1262 (syntax-object-wrap97 id1261) #f))) (set!
syntax->datum (lambda (x1263) (strip158 x1263 (quote (()))))) (set!
generate-temporaries (lambda (ls1264) (begin (let ((x1265 ls1264)) (if (not
(list? x1265)) (syntax-violation (quote generate-temporaries) "invalid
argument" x1265))) (map (lambda (x1266) (wrap139 (gensym) (quote ((top))) #f))
ls1264)))) (set! free-identifier=? (lambda (x1267 y1268) (begin (let ((x1269
x1267)) (if (not (nonsymbol-id?110 x1269)) (syntax-violation (quote
free-identifier=?) "invalid argument" x1269))) (let ((x1270 y1268)) (if (not
(nonsymbol-id?110 x1270)) (syntax-violation (quote free-identifier=?) "invalid
argument" x1270))) (free-id=?134 x1267 y1268)))) (set! bound-identifier=?
(lambda (x1271 y1272) (begin (let ((x1273 x1271)) (if (not (nonsymbol-id?110
x1273)) (syntax-violation (quote bound-identifier=?) "invalid argument"
x1273))) (let ((x1274 y1272)) (if (not (nonsymbol-id?110 x1274))
(syntax-violation (quote bound-identifier=?) "invalid argument" x1274)))
(bound-id=?135 x1271 y1272)))) (set! syntax-violation (lambda (who1278
message1277 form1276 . subform1275) (begin (let ((x1279 who1278)) (if (not
((lambda (x1280) (or (not x1280) (string? x1280) (symbol? x1280))) x1279))
(syntax-violation (quote syntax-violation) "invalid argument" x1279))) (let
((x1281 message1277)) (if (not (string? x1281)) (syntax-violation (quote
syntax-violation) "invalid argument" x1281))) (scm-error (quote syntax-error)
(quote sc-expand) (string-append (if who1278 "~a: " "") "~a " (if (null?
subform1275) "in ~a" "in subform `~s' of `~s'")) (let ((tail1282 (cons
message1277 (map (lambda (x1283) (strip158 x1283 (quote (())))) (append
subform1275 (list form1276)))))) (if who1278 (cons who1278 tail1282) tail1282))
#f)))) (letrec ((match1288 (lambda (e1289 p1290 w1291 r1292 mod1293) (cond
((not r1292) #f) ((eq? p1290 (quote any)) (cons (wrap139 e1289 w1291 mod1293)
r1292)) ((syntax-object?95 e1289) (match*1287 (let ((e1294
(syntax-object-expression96 e1289))) (if (annotation? e1294)
(annotation-expression e1294) e1294)) p1290 (join-wraps130 w1291
(syntax-object-wrap97 e1289)) r1292 (syntax-object-module98 e1289))) (else
(match*1287 (let ((e1295 e1289)) (if (annotation? e1295) (annotation-expression
e1295) e1295)) p1290 w1291 r1292 mod1293))))) (match*1287 (lambda (e1296 p1297
w1298 r1299 mod1300) (cond ((null? p1297) (and (null? e1296) r1299)) ((pair?
p1297) (and (pair? e1296) (match1288 (car e1296) (car p1297) w1298 (match1288
(cdr e1296) (cdr p1297) w1298 r1299 mod1300) mod1300))) ((eq? p1297 (quote
each-any)) (let ((l1301 (match-each-any1285 e1296 w1298 mod1300))) (and l1301
(cons l1301 r1299)))) (else (let ((t1302 (vector-ref p1297 0))) (if (memv t1302
(quote (each))) (if (null? e1296) (match-empty1286 (vector-ref p1297 1) r1299)
(let ((l1303 (match-each1284 e1296 (vector-ref p1297 1) w1298 mod1300))) (and
l1303 (letrec ((collect1304 (lambda (l1305) (if (null? (car l1305)) r1299 (cons
(map car l1305) (collect1304 (map cdr l1305))))))) (collect1304 l1303))))) (if
(memv t1302 (quote (free-id))) (and (id?111 e1296) (free-id=?134 (wrap139 e1296
w1298 mod1300) (vector-ref p1297 1)) r1299) (if (memv t1302 (quote (atom)))
(and (equal? (vector-ref p1297 1) (strip158 e1296 w1298)) r1299) (if (memv
t1302 (quote (vector))) (and (vector? e1296) (match1288 (vector->list e1296)
(vector-ref p1297 1) w1298 r1299 mod1300))))))))))) (match-empty1286 (lambda
(p1306 r1307) (cond ((null? p1306) r1307) ((eq? p1306 (quote any)) (cons (quote
()) r1307)) ((pair? p1306) (match-empty1286 (car p1306) (match-empty1286 (cdr
p1306) r1307))) ((eq? p1306 (quote each-any)) (cons (quote ()) r1307)) (else
(let ((t1308 (vector-ref p1306 0))) (if (memv t1308 (quote (each)))
(match-empty1286 (vector-ref p1306 1) r1307) (if (memv t1308 (quote (free-id
atom))) r1307 (if (memv t1308 (quote (vector))) (match-empty1286 (vector-ref
p1306 1) r1307))))))))) (match-each-any1285 (lambda (e1309 w1310 mod1311) (cond
((annotation? e1309) (match-each-any1285 (annotation-expression e1309) w1310
mod1311)) ((pair? e1309) (let ((l1312 (match-each-any1285 (cdr e1309) w1310
mod1311))) (and l1312 (cons (wrap139 (car e1309) w1310 mod1311) l1312))))
((null? e1309) (quote ())) ((syntax-object?95 e1309) (match-each-any1285
(syntax-object-expression96 e1309) (join-wraps130 w1310 (syntax-object-wrap97
e1309)) mod1311)) (else #f)))) (match-each1284 (lambda (e1313 p1314 w1315
mod1316) (cond ((annotation? e1313) (match-each1284 (annotation-expression
e1313) p1314 w1315 mod1316)) ((pair? e1313) (let ((first1317 (match1288 (car
e1313) p1314 w1315 (quote ()) mod1316))) (and first1317 (let ((rest1318
(match-each1284 (cdr e1313) p1314 w1315 mod1316))) (and rest1318 (cons
first1317 rest1318)))))) ((null? e1313) (quote ())) ((syntax-object?95 e1313)
(match-each1284 (syntax-object-expression96 e1313) p1314 (join-wraps130 w1315
(syntax-object-wrap97 e1313)) (syntax-object-module98 e1313))) (else #f)))))
(set! $sc-dispatch (lambda (e1319 p1320) (cond ((eq? p1320 (quote any)) (list
e1319)) ((syntax-object?95 e1319) (match*1287 (let ((e1321
(syntax-object-expression96 e1319))) (if (annotation? e1321)
(annotation-expression e1321) e1321)) p1320 (syntax-object-wrap97 e1319) (quote
()) (syntax-object-module98 e1319))) (else (match*1287 (let ((e1322 e1319)) (if
(annotation? e1322) (annotation-expression e1322) e1322)) p1320 (quote (()))
(quote ()) #f)))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x1323) ((lambda
(tmp1324) ((lambda (tmp1325) (if tmp1325 (apply (lambda (_1326 e11327 e21328)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11327 e21328))) tmp1325) ((lambda (tmp1330) (if
tmp1330 (apply (lambda (_1331 out1332 in1333 e11334 e21335) (list (quote
#(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) in1333 (quote ()) (list out1332 (cons
(quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons e11334 e21335))))) tmp1330) ((lambda
(tmp1337) (if tmp1337 (apply (lambda (_1338 out1339 in1340 e11341 e21342) (list
(quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top)
(top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list
((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) in1340) (quote ()) (list out1339 (cons (quote #(syntax-object begin
((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (cons e11341 e21342))))) tmp1337) (syntax-violation #f "source
expression failed to match any pattern" tmp1324))) ($sc-dispatch tmp1324 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1324 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp1324 (quote (any () any .
each-any))))) x1323))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1346)
((lambda (tmp1347) ((lambda (tmp1348) (if tmp1348 (apply (lambda (_1349 k1350
keyword1351 pattern1352 template1353) (list (quote #(syntax-object lambda
((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top))
#("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k
keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))
(cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern
template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote
#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top)
(top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons k1350 (map (lambda (tmp1356
tmp1355) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k
keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
tmp1355) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword
pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
tmp1356))) template1353 pattern1352)))))) tmp1348) (syntax-violation #f "source
expression failed to match any pattern" tmp1347))) ($sc-dispatch tmp1347 (quote
(any each-any . #(each ((any . any) any))))))) x1346))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x1357) ((lambda (tmp1358) ((lambda (tmp1359) (if
(if tmp1359 (apply (lambda (let*1360 x1361 v1362 e11363 e21364) (and-map
identifier? x1361)) tmp1359) #f) (apply (lambda (let*1366 x1367 v1368 e11369
e21370) (letrec ((f1371 (lambda (bindings1372) (if (null? bindings1372) (cons
(quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings)
#((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e11369 e21370)))
((lambda (tmp1376) ((lambda (tmp1377) (if tmp1377 (apply (lambda (body1378
binding1379) (list (quote #(syntax-object let ((top) #(ribcage #(body binding)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top)
(top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (list binding1379) body1378)) tmp1377) (syntax-violation #f
"source expression failed to match any pattern" tmp1376))) ($sc-dispatch
tmp1376 (quote (any any))))) (list (f1371 (cdr bindings1372)) (car
bindings1372))))))) (f1371 (map list x1367 v1368)))) tmp1359) (syntax-violation
#f "source expression failed to match any pattern" tmp1358))) ($sc-dispatch
tmp1358 (quote (any #(each (any any)) any . each-any))))) x1357))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x1380) ((lambda (tmp1381) ((lambda (tmp1382)
(if tmp1382 (apply (lambda (_1383 var1384 init1385 step1386 e01387 e11388
c1389) ((lambda (tmp1390) ((lambda (tmp1391) (if tmp1391 (apply (lambda
(step1392) ((lambda (tmp1393) ((lambda (tmp1394) (if tmp1394 (apply (lambda ()
(list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i"))
#(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x)
#((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top)
#(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top)
(top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list
var1384 init1385) (list (quote #(syntax-object if ((top) #(ribcage #(step)
#((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ())
#(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var
init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i"
"i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")))
(hygiene guile))) e01387) (cons (quote #(syntax-object begin ((top) #(ribcage
#(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top)
(top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () ()
()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1389 (list
(cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i"))
#(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x)
#((top)) #("i"))) (hygiene guile))) step1392))))))) tmp1394) ((lambda (tmp1399)
(if tmp1399 (apply (lambda (e11400 e21401) (list (quote #(syntax-object let
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1384 init1385) (list
(quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i"))
#(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top)
(top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01387 (cons
(quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i"
"i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c)
#((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile)))
(cons e11400 e21401)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1
e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_
var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")))
(hygiene guile))) (append c1389 (list (cons (quote #(syntax-object doloop
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) step1392))))))) tmp1399)
(syntax-violation #f "source expression failed to match any pattern" tmp1393)))
($sc-dispatch tmp1393 (quote (any . each-any)))))) ($sc-dispatch tmp1393 (quote
())))) e11388)) tmp1391) (syntax-violation #f "source expression failed to
match any pattern" tmp1390))) ($sc-dispatch tmp1390 (quote each-any)))) (map
(lambda (v1408 s1409) ((lambda (tmp1410) ((lambda (tmp1411) (if tmp1411 (apply
(lambda () v1408) tmp1411) ((lambda (tmp1412) (if tmp1412 (apply (lambda
(e1413) e1413) tmp1412) ((lambda (_1414) (syntax-violation (quote do) "bad step
expression" orig-x1380 s1409)) tmp1410))) ($sc-dispatch tmp1410 (quote
(any)))))) ($sc-dispatch tmp1410 (quote ())))) s1409)) var1384 step1386)))
tmp1382) (syntax-violation #f "source expression failed to match any pattern"
tmp1381))) ($sc-dispatch tmp1381 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x1380))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons1417 (lambda (x1421 y1422)
((lambda (tmp1423) ((lambda (tmp1424) (if tmp1424 (apply (lambda (x1425 y1426)
((lambda (tmp1427) ((lambda (tmp1428) (if tmp1428 (apply (lambda (dy1429)
((lambda (tmp1430) ((lambda (tmp1431) (if tmp1431 (apply (lambda (dx1432) (list
(quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage
#(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile))) (cons dx1432 dy1429))) tmp1431) ((lambda
(_1433) (if (null? dy1429) (list (quote #(syntax-object list ((top) #(ribcage
#(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y)
#((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi)
#((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1425) (list
(quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage
#(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile))) x1425 y1426))) tmp1430))) ($sc-dispatch
tmp1430 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top))
#("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) any))))) x1425)) tmp1428) ((lambda (tmp1434) (if
tmp1434 (apply (lambda (stuff1435) (cons (quote #(syntax-object list ((top)
#(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i"
"i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top)
(top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x1425 stuff1435))) tmp1434)
((lambda (else1436) (list (quote #(syntax-object cons ((top) #(ribcage #(else)
#((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) x1425 y1426)) tmp1427))) ($sc-dispatch tmp1427
(quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any))))))
($sc-dispatch tmp1427 (quote (#(free-id #(syntax-object quote ((top) #(ribcage
#(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) any))))) y1426)) tmp1424) (syntax-violation #f "source expression
failed to match any pattern" tmp1423))) ($sc-dispatch tmp1423 (quote (any
any))))) (list x1421 y1422)))) (quasiappend1418 (lambda (x1437 y1438) ((lambda
(tmp1439) ((lambda (tmp1440) (if tmp1440 (apply (lambda (x1441 y1442) ((lambda
(tmp1443) ((lambda (tmp1444) (if tmp1444 (apply (lambda () x1441) tmp1444)
((lambda (_1445) (list (quote #(syntax-object append ((top) #(ribcage #(_)
#((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) x1441 y1442)) tmp1443))) ($sc-dispatch tmp1443
(quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y1442))
tmp1440) (syntax-violation #f "source expression failed to match any pattern"
tmp1439))) ($sc-dispatch tmp1439 (quote (any any))))) (list x1437 y1438))))
(quasivector1419 (lambda (x1446) ((lambda (tmp1447) ((lambda (x1448) ((lambda
(tmp1449) ((lambda (tmp1450) (if tmp1450 (apply (lambda (x1451) (list (quote
#(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x)
#((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector
x1451))) tmp1450) ((lambda (tmp1453) (if tmp1453 (apply (lambda (x1454) (cons
(quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage
#(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1454)) tmp1453)
((lambda (_1456) (list (quote #(syntax-object list->vector ((top) #(ribcage
#(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) x1448)) tmp1449))) ($sc-dispatch tmp1449 (quote (#(free-id
#(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) . each-any)))))) ($sc-dispatch tmp1449 (quote (#(free-id
#(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) each-any))))) x1448)) tmp1447)) x1446))) (quasi1420 (lambda
(p1457 lev1458) ((lambda (tmp1459) ((lambda (tmp1460) (if tmp1460 (apply
(lambda (p1461) (if (= lev1458 0) p1461 (quasicons1417 (quote (#(syntax-object
quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p
lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector
quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))
#(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile)))) (quasi1420 (list p1461) (- lev1458 1))))) tmp1460) ((lambda
(tmp1462) (if tmp1462 (apply (lambda (p1463 q1464) (if (= lev1458 0)
(quasiappend1418 p1463 (quasi1420 q1464 lev1458)) (quasicons1417 (quasicons1417
(quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top)
#(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p
lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector
quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))))
(quasi1420 (list p1463) (- lev1458 1))) (quasi1420 q1464 lev1458)))) tmp1462)
((lambda (tmp1465) (if tmp1465 (apply (lambda (p1466) (quasicons1417 (quote
(#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile)))) (quasi1420 (list p1466) (+ lev1458
1)))) tmp1465) ((lambda (tmp1467) (if tmp1467 (apply (lambda (p1468 q1469)
(quasicons1417 (quasi1420 p1468 lev1458) (quasi1420 q1469 lev1458))) tmp1467)
((lambda (tmp1470) (if tmp1470 (apply (lambda (x1471) (quasivector1419
(quasi1420 x1471 lev1458))) tmp1470) ((lambda (p1473) (list (quote
#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) p1473)) tmp1459))) ($sc-dispatch tmp1459 (quote #(vector
each-any)))))) ($sc-dispatch tmp1459 (quote (any . any)))))) ($sc-dispatch
tmp1459 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ())
#(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) any)))))) ($sc-dispatch tmp1459 (quote ((#(free-id #(syntax-object
unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top))
#("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top)
(top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any))))))
($sc-dispatch tmp1459 (quote (#(free-id #(syntax-object unquote ((top)
#(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) any))))) p1457)))) (lambda (x1474) ((lambda
(tmp1475) ((lambda (tmp1476) (if tmp1476 (apply (lambda (_1477 e1478)
(quasi1420 e1478 0)) tmp1476) (syntax-violation #f "source expression failed to
match any pattern" tmp1475))) ($sc-dispatch tmp1475 (quote (any any)))))
x1474)))))
-(define include (make-syncase-macro (quote macro) (lambda (x1479) (letrec
((read-file1480 (lambda (fn1481 k1482) (let ((p1483 (open-input-file fn1481)))
(letrec ((f1484 (lambda (x1485) (if (eof-object? x1485) (begin
(close-input-port p1483) (quote ())) (cons (datum->syntax k1482 x1485) (f1484
(read p1483))))))) (f1484 (read p1483))))))) ((lambda (tmp1486) ((lambda
(tmp1487) (if tmp1487 (apply (lambda (k1488 filename1489) (let ((fn1490
(syntax->datum filename1489))) ((lambda (tmp1491) ((lambda (tmp1492) (if
tmp1492 (apply (lambda (exp1493) (cons (quote #(syntax-object begin ((top)
#(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i"
"i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) exp1493)) tmp1492) (syntax-violation #f "source expression
failed to match any pattern" tmp1491))) ($sc-dispatch tmp1491 (quote
each-any)))) (read-file1480 fn1490 k1488)))) tmp1487) (syntax-violation #f
"source expression failed to match any pattern" tmp1486))) ($sc-dispatch
tmp1486 (quote (any any))))) x1479)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x1495) ((lambda
(tmp1496) ((lambda (tmp1497) (if tmp1497 (apply (lambda (_1498 e1499)
(syntax-violation (quote unquote) "expression not valid outside of quasiquote"
x1495)) tmp1497) (syntax-violation #f "source expression failed to match any
pattern" tmp1496))) ($sc-dispatch tmp1496 (quote (any any))))) x1495))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1500)
((lambda (tmp1501) ((lambda (tmp1502) (if tmp1502 (apply (lambda (_1503 e1504)
(syntax-violation (quote unquote-splicing) "expression not valid outside of
quasiquote" x1500)) tmp1502) (syntax-violation #f "source expression failed to
match any pattern" tmp1501))) ($sc-dispatch tmp1501 (quote (any any)))))
x1500))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x1505) ((lambda (tmp1506) ((lambda (tmp1507) (if
tmp1507 (apply (lambda (_1508 e1509 m11510 m21511) ((lambda (tmp1512) ((lambda
(body1513) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top))
#("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list
(list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1509)) body1513))
tmp1512)) (letrec ((f1514 (lambda (clause1515 clauses1516) (if (null?
clauses1516) ((lambda (tmp1518) ((lambda (tmp1519) (if tmp1519 (apply (lambda
(e11520 e21521) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11520 e21521))) tmp1519) ((lambda (tmp1523) (if
tmp1523 (apply (lambda (k1524 e11525 e21526) (list (quote #(syntax-object if
((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i"
"i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top))
#("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
(quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i"
"i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top)
(top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) k1524)) (cons (quote #(syntax-object begin ((top) #(ribcage
#(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2)
#((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons e11525 e21526)))) tmp1523)
((lambda (_1529) (syntax-violation (quote case) "bad clause" x1505 clause1515))
tmp1518))) ($sc-dispatch tmp1518 (quote (each-any any . each-any))))))
($sc-dispatch tmp1518 (quote (#(free-id #(syntax-object else ((top) #(ribcage
() () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any .
each-any))))) clause1515) ((lambda (tmp1530) ((lambda (rest1531) ((lambda
(tmp1532) ((lambda (tmp1533) (if tmp1533 (apply (lambda (k1534 e11535 e21536)
(list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
#(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ())
#(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object
memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
#(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top)
(top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i"
"i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f
clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2)
#((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) k1534)) (cons (quote #(syntax-object
begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause
clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top)
(top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons e11535 e21536)) rest1531)) tmp1533)
((lambda (_1539) (syntax-violation (quote case) "bad clause" x1505 clause1515))
tmp1532))) ($sc-dispatch tmp1532 (quote (each-any any . each-any)))))
clause1515)) tmp1530)) (f1514 (car clauses1516) (cdr clauses1516))))))) (f1514
m11510 m21511)))) tmp1507) (syntax-violation #f "source expression failed to
match any pattern" tmp1506))) ($sc-dispatch tmp1506 (quote (any any any .
each-any))))) x1505))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1540)
((lambda (tmp1541) ((lambda (tmp1542) (if tmp1542 (apply (lambda (_1543 e1544)
(list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))
(list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
(quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list
(quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
e1544)) (list (cons _1543 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e1544 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)))))))))) tmp1542) (syntax-violation #f "source expression failed to
match any pattern" tmp1541))) ($sc-dispatch tmp1541 (quote (any any)))))
x1540))))
+(letrec ((and-map*475 (lambda (f515 first514 . rest513) (or (null? first514)
(if (null? rest513) (letrec ((andmap516 (lambda (first517) (let ((x518 (car
first517)) (first519 (cdr first517))) (if (null? first519) (f515 x518) (and
(f515 x518) (andmap516 first519))))))) (andmap516 first514)) (letrec
((andmap520 (lambda (first521 rest522) (let ((x523 (car first521)) (xr524 (map
car rest522)) (first525 (cdr first521)) (rest526 (map cdr rest522))) (if (null?
first525) (apply f515 (cons x523 xr524)) (and (apply f515 (cons x523 xr524))
(andmap520 first525 rest526))))))) (andmap520 first514 rest513))))))) (letrec
((lambda-var-list618 (lambda (vars747) (letrec ((lvl748 (lambda (vars749 ls750
w751) (cond ((pair? vars749) (lvl748 (cdr vars749) (cons (wrap597 (car vars749)
w751 #f) ls750) w751)) ((id?569 vars749) (cons (wrap597 vars749 w751 #f)
ls750)) ((null? vars749) ls750) ((syntax-object?553 vars749) (lvl748
(syntax-object-expression554 vars749) ls750 (join-wraps588 w751
(syntax-object-wrap555 vars749)))) ((annotation? vars749) (lvl748
(annotation-expression vars749) ls750 w751)) (else (cons vars749 ls750))))))
(lvl748 vars747 (quote ()) (quote (())))))) (gen-var617 (lambda (id752) (let
((id753 (if (syntax-object?553 id752) (syntax-object-expression554 id752)
id752))) (if (annotation? id753) (gensym (symbol->string (annotation-expression
id753))) (gensym (symbol->string id753)))))) (strip616 (lambda (x754 w755) (if
(memq (quote top) (wrap-marks572 w755)) (if (or (annotation? x754) (and (pair?
x754) (annotation? (car x754)))) (strip-annotation615 x754 #f) x754) (letrec
((f756 (lambda (x757) (cond ((syntax-object?553 x757) (strip616
(syntax-object-expression554 x757) (syntax-object-wrap555 x757))) ((pair? x757)
(let ((a758 (f756 (car x757))) (d759 (f756 (cdr x757)))) (if (and (eq? a758
(car x757)) (eq? d759 (cdr x757))) x757 (cons a758 d759)))) ((vector? x757)
(let ((old760 (vector->list x757))) (let ((new761 (map f756 old760))) (if
(and-map*475 eq? old760 new761) x757 (list->vector new761))))) (else x757)))))
(f756 x754))))) (strip-annotation615 (lambda (x762 parent763) (cond ((pair?
x762) (let ((new764 (cons #f #f))) (begin (if parent763
(set-annotation-stripped! parent763 new764)) (set-car! new764
(strip-annotation615 (car x762) #f)) (set-cdr! new764 (strip-annotation615 (cdr
x762) #f)) new764))) ((annotation? x762) (or (annotation-stripped x762)
(strip-annotation615 (annotation-expression x762) x762))) ((vector? x762) (let
((new765 (make-vector (vector-length x762)))) (begin (if parent763
(set-annotation-stripped! parent763 new765)) (letrec ((loop766 (lambda (i767)
(unless (fx<532 i767 0) (vector-set! new765 i767 (strip-annotation615
(vector-ref x762 i767) #f)) (loop766 (fx-530 i767 1)))))) (loop766 (-
(vector-length x762) 1))) new765))) (else x762)))) (ellipsis?614 (lambda (x768)
(and (nonsymbol-id?568 x768) (free-id=?592 x768 (quote #(syntax-object ...
((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))))))) (chi-void613 (lambda () (build-application537 #f
(build-primref546 #f (quote if)) (quote (#f #f))))) (eval-local-transformer612
(lambda (expanded769 mod770) (let ((p771 (local-eval-hook534 expanded769
mod770))) (if (procedure? p771) p771 (syntax-violation #f "nonprocedure
transformer" p771))))) (chi-local-syntax611 (lambda (rec?772 e773 r774 w775
s776 mod777 k778) ((lambda (tmp779) ((lambda (tmp780) (if tmp780 (apply (lambda
(_781 id782 val783 e1784 e2785) (let ((ids786 id782)) (if (not
(valid-bound-ids?594 ids786)) (syntax-violation #f "duplicate bound keyword"
e773) (let ((labels788 (gen-labels575 ids786))) (let ((new-w789
(make-binding-wrap586 ids786 labels788 w775))) (k778 (cons e1784 e2785)
(extend-env563 labels788 (let ((w791 (if rec?772 new-w789 w775)) (trans-r792
(macros-only-env565 r774))) (map (lambda (x793) (cons (quote macro)
(eval-local-transformer612 (chi605 x793 trans-r792 w791 mod777) mod777)))
val783)) r774) new-w789 s776 mod777)))))) tmp780) ((lambda (_795)
(syntax-violation #f "bad local syntax definition" (source-wrap598 e773 w775
s776 mod777))) tmp779))) ($sc-dispatch tmp779 (quote (any #(each (any any)) any
. each-any))))) e773))) (chi-lambda-clause610 (lambda (e796 docstring797 c798
r799 w800 mod801 k802) ((lambda (tmp803) ((lambda (tmp804) (if (if tmp804
(apply (lambda (args805 doc806 e1807 e2808) (and (string? (syntax->datum
doc806)) (not docstring797))) tmp804) #f) (apply (lambda (args809 doc810 e1811
e2812) (chi-lambda-clause610 e796 doc810 (cons args809 (cons e1811 e2812)) r799
w800 mod801 k802)) tmp804) ((lambda (tmp814) (if tmp814 (apply (lambda (id815
e1816 e2817) (let ((ids818 id815)) (if (not (valid-bound-ids?594 ids818))
(syntax-violation (quote lambda) "invalid parameter list" e796) (let
((labels820 (gen-labels575 ids818)) (new-vars821 (map gen-var617 ids818)))
(k802 (map syntax->datum ids818) new-vars821 docstring797 (chi-body609 (cons
e1816 e2817) e796 (extend-var-env564 labels820 new-vars821 r799)
(make-binding-wrap586 ids818 labels820 w800) mod801)))))) tmp814) ((lambda
(tmp823) (if tmp823 (apply (lambda (ids824 e1825 e2826) (let ((old-ids827
(lambda-var-list618 ids824))) (if (not (valid-bound-ids?594 old-ids827))
(syntax-violation (quote lambda) "invalid parameter list" e796) (let
((labels828 (gen-labels575 old-ids827)) (new-vars829 (map gen-var617
old-ids827))) (k802 (letrec ((f830 (lambda (ls1831 ls2832) (if (null? ls1831)
(syntax->datum ls2832) (f830 (cdr ls1831) (cons (syntax->datum (car ls1831))
ls2832)))))) (f830 (cdr old-ids827) (car old-ids827))) (letrec ((f833 (lambda
(ls1834 ls2835) (if (null? ls1834) ls2835 (f833 (cdr ls1834) (cons (car ls1834)
ls2835)))))) (f833 (cdr new-vars829) (car new-vars829))) docstring797
(chi-body609 (cons e1825 e2826) e796 (extend-var-env564 labels828 new-vars829
r799) (make-binding-wrap586 old-ids827 labels828 w800) mod801)))))) tmp823)
((lambda (_837) (syntax-violation (quote lambda) "bad lambda" e796)) tmp803)))
($sc-dispatch tmp803 (quote (any any . each-any)))))) ($sc-dispatch tmp803
(quote (each-any any . each-any)))))) ($sc-dispatch tmp803 (quote (any any any
. each-any))))) c798))) (chi-body609 (lambda (body838 outer-form839 r840 w841
mod842) (let ((r843 (cons (quote ("placeholder" placeholder)) r840))) (let
((ribcage844 (make-ribcage576 (quote ()) (quote ()) (quote ())))) (let ((w845
(make-wrap571 (wrap-marks572 w841) (cons ribcage844 (wrap-subst573 w841)))))
(letrec ((parse846 (lambda (body847 ids848 labels849 vars850 vals851
bindings852) (if (null? body847) (syntax-violation #f "no expressions in body"
outer-form839) (let ((e854 (cdar body847)) (er855 (caar body847)))
(call-with-values (lambda () (syntax-type603 e854 er855 (quote (())) #f
ribcage844 mod842)) (lambda (type856 value857 e858 w859 s860 mod861) (let
((t862 type856)) (if (memv t862 (quote (define-form))) (let ((id863 (wrap597
value857 w859 mod861)) (label864 (gen-label574))) (let ((var865 (gen-var617
id863))) (begin (extend-ribcage!585 ribcage844 id863 label864) (parse846 (cdr
body847) (cons id863 ids848) (cons label864 labels849) (cons var865 vars850)
(cons (cons er855 (wrap597 e858 w859 mod861)) vals851) (cons (cons (quote
lexical) var865) bindings852))))) (if (memv t862 (quote (define-syntax-form)))
(let ((id866 (wrap597 value857 w859 mod861)) (label867 (gen-label574))) (begin
(extend-ribcage!585 ribcage844 id866 label867) (parse846 (cdr body847) (cons
id866 ids848) (cons label867 labels849) vars850 vals851 (cons (cons (quote
macro) (cons er855 (wrap597 e858 w859 mod861))) bindings852)))) (if (memv t862
(quote (begin-form))) ((lambda (tmp868) ((lambda (tmp869) (if tmp869 (apply
(lambda (_870 e1871) (parse846 (letrec ((f872 (lambda (forms873) (if (null?
forms873) (cdr body847) (cons (cons er855 (wrap597 (car forms873) w859 mod861))
(f872 (cdr forms873))))))) (f872 e1871)) ids848 labels849 vars850 vals851
bindings852)) tmp869) (syntax-violation #f "source expression failed to match
any pattern" tmp868))) ($sc-dispatch tmp868 (quote (any . each-any))))) e858)
(if (memv t862 (quote (local-syntax-form))) (chi-local-syntax611 value857 e858
er855 w859 s860 mod861 (lambda (forms875 er876 w877 s878 mod879) (parse846
(letrec ((f880 (lambda (forms881) (if (null? forms881) (cdr body847) (cons
(cons er876 (wrap597 (car forms881) w877 mod879)) (f880 (cdr forms881)))))))
(f880 forms875)) ids848 labels849 vars850 vals851 bindings852))) (if (null?
ids848) (build-sequence548 #f (map (lambda (x882) (chi605 (cdr x882) (car x882)
(quote (())) mod861)) (cons (cons er855 (source-wrap598 e858 w859 s860 mod861))
(cdr body847)))) (begin (if (not (valid-bound-ids?594 ids848))
(syntax-violation #f "invalid or duplicate identifier in definition"
outer-form839)) (letrec ((loop883 (lambda (bs884 er-cache885 r-cache886) (if
(not (null? bs884)) (let ((b887 (car bs884))) (if (eq? (car b887) (quote
macro)) (let ((er888 (cadr b887))) (let ((r-cache889 (if (eq? er888
er-cache885) r-cache886 (macros-only-env565 er888)))) (begin (set-cdr! b887
(eval-local-transformer612 (chi605 (cddr b887) r-cache889 (quote (())) mod861)
mod861)) (loop883 (cdr bs884) er888 r-cache889)))) (loop883 (cdr bs884)
er-cache885 r-cache886))))))) (loop883 bindings852 #f #f)) (set-cdr! r843
(extend-env563 labels849 bindings852 (cdr r843))) (build-letrec551 #f (map
syntax->datum ids848) vars850 (map (lambda (x890) (chi605 (cdr x890) (car x890)
(quote (())) mod861)) vals851) (build-sequence548 #f (map (lambda (x891)
(chi605 (cdr x891) (car x891) (quote (())) mod861)) (cons (cons er855
(source-wrap598 e858 w859 s860 mod861)) (cdr body847)))))))))))))))))))
(parse846 (map (lambda (x853) (cons r843 (wrap597 x853 w845 mod842))) body838)
(quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro608
(lambda (p892 e893 r894 w895 rib896 mod897) (letrec ((rebuild-macro-output898
(lambda (x899 m900) (cond ((pair? x899) (cons (rebuild-macro-output898 (car
x899) m900) (rebuild-macro-output898 (cdr x899) m900))) ((syntax-object?553
x899) (let ((w901 (syntax-object-wrap555 x899))) (let ((ms902 (wrap-marks572
w901)) (s903 (wrap-subst573 w901))) (if (and (pair? ms902) (eq? (car ms902)
#f)) (make-syntax-object552 (syntax-object-expression554 x899) (make-wrap571
(cdr ms902) (if rib896 (cons rib896 (cdr s903)) (cdr s903)))
(syntax-object-module556 x899)) (make-syntax-object552
(syntax-object-expression554 x899) (make-wrap571 (cons m900 ms902) (if rib896
(cons rib896 (cons (quote shift) s903)) (cons (quote shift) s903))) (let
((pmod904 (procedure-module p892))) (if pmod904 (cons (quote hygiene)
(module-name pmod904)) (quote (hygiene guile))))))))) ((vector? x899) (let
((n905 (vector-length x899))) (let ((v906 (make-vector n905))) (letrec
((doloop907 (lambda (i908) (if (fx=531 i908 n905) v906 (begin (vector-set! v906
i908 (rebuild-macro-output898 (vector-ref x899 i908) m900)) (doloop907 (fx+529
i908 1))))))) (doloop907 0))))) ((symbol? x899) (syntax-violation #f
"encountered raw symbol in macro output" (source-wrap598 e893 w895 s mod897)
x899)) (else x899))))) (rebuild-macro-output898 (p892 (wrap597 e893
(anti-mark584 w895) mod897)) (string #\m))))) (chi-application607 (lambda (x909
e910 r911 w912 s913 mod914) ((lambda (tmp915) ((lambda (tmp916) (if tmp916
(apply (lambda (e0917 e1918) (build-application537 s913 x909 (map (lambda
(e919) (chi605 e919 r911 w912 mod914)) e1918))) tmp916) (syntax-violation #f
"source expression failed to match any pattern" tmp915))) ($sc-dispatch tmp915
(quote (any . each-any))))) e910))) (chi-expr606 (lambda (type921 value922 e923
r924 w925 s926 mod927) (let ((t928 type921)) (if (memv t928 (quote (lexical)))
(build-lexical-reference539 (quote value) s926 e923 value922) (if (memv t928
(quote (core external-macro))) (value922 e923 r924 w925 s926 mod927) (if (memv
t928 (quote (module-ref))) (call-with-values (lambda () (value922 e923))
(lambda (id929 mod930) (build-global-reference542 s926 id929 mod930))) (if
(memv t928 (quote (lexical-call))) (chi-application607
(build-lexical-reference539 (quote fun) (source-annotation560 (car e923)) (car
e923) value922) e923 r924 w925 s926 mod927) (if (memv t928 (quote
(global-call))) (chi-application607 (build-global-reference542
(source-annotation560 (car e923)) value922 (if (syntax-object?553 (car e923))
(syntax-object-module556 (car e923)) mod927)) e923 r924 w925 s926 mod927) (if
(memv t928 (quote (constant))) (build-data547 s926 (strip616 (source-wrap598
e923 w925 s926 mod927) (quote (())))) (if (memv t928 (quote (global)))
(build-global-reference542 s926 value922 mod927) (if (memv t928 (quote (call)))
(chi-application607 (chi605 (car e923) r924 w925 mod927) e923 r924 w925 s926
mod927) (if (memv t928 (quote (begin-form))) ((lambda (tmp931) ((lambda
(tmp932) (if tmp932 (apply (lambda (_933 e1934 e2935) (chi-sequence599 (cons
e1934 e2935) r924 w925 s926 mod927)) tmp932) (syntax-violation #f "source
expression failed to match any pattern" tmp931))) ($sc-dispatch tmp931 (quote
(any any . each-any))))) e923) (if (memv t928 (quote (local-syntax-form)))
(chi-local-syntax611 value922 e923 r924 w925 s926 mod927 chi-sequence599) (if
(memv t928 (quote (eval-when-form))) ((lambda (tmp937) ((lambda (tmp938) (if
tmp938 (apply (lambda (_939 x940 e1941 e2942) (let ((when-list943
(chi-when-list602 e923 x940 w925))) (if (memq (quote eval) when-list943)
(chi-sequence599 (cons e1941 e2942) r924 w925 s926 mod927) (chi-void613))))
tmp938) (syntax-violation #f "source expression failed to match any pattern"
tmp937))) ($sc-dispatch tmp937 (quote (any each-any any . each-any))))) e923)
(if (memv t928 (quote (define-form define-syntax-form))) (syntax-violation #f
"definition in expression context" e923 (wrap597 value922 w925 mod927)) (if
(memv t928 (quote (syntax))) (syntax-violation #f "reference to pattern
variable outside syntax form" (source-wrap598 e923 w925 s926 mod927)) (if (memv
t928 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier
outside its scope" (source-wrap598 e923 w925 s926 mod927)) (syntax-violation #f
"unexpected syntax" (source-wrap598 e923 w925 s926 mod927)))))))))))))))))))
(chi605 (lambda (e946 r947 w948 mod949) (call-with-values (lambda ()
(syntax-type603 e946 r947 w948 #f #f mod949)) (lambda (type950 value951 e952
w953 s954 mod955) (chi-expr606 type950 value951 e952 r947 w953 s954 mod955)))))
(chi-top604 (lambda (e956 r957 w958 m959 esew960 mod961) (call-with-values
(lambda () (syntax-type603 e956 r957 w958 #f #f mod961)) (lambda (type969
value970 e971 w972 s973 mod974) (let ((t975 type969)) (if (memv t975 (quote
(begin-form))) ((lambda (tmp976) ((lambda (tmp977) (if tmp977 (apply (lambda
(_978) (chi-void613)) tmp977) ((lambda (tmp979) (if tmp979 (apply (lambda (_980
e1981 e2982) (chi-top-sequence600 (cons e1981 e2982) r957 w972 s973 m959
esew960 mod974)) tmp979) (syntax-violation #f "source expression failed to
match any pattern" tmp976))) ($sc-dispatch tmp976 (quote (any any .
each-any)))))) ($sc-dispatch tmp976 (quote (any))))) e971) (if (memv t975
(quote (local-syntax-form))) (chi-local-syntax611 value970 e971 r957 w972 s973
mod974 (lambda (body984 r985 w986 s987 mod988) (chi-top-sequence600 body984
r985 w986 s987 m959 esew960 mod988))) (if (memv t975 (quote (eval-when-form)))
((lambda (tmp989) ((lambda (tmp990) (if tmp990 (apply (lambda (_991 x992 e1993
e2994) (let ((when-list995 (chi-when-list602 e971 x992 w972)) (body996 (cons
e1993 e2994))) (cond ((eq? m959 (quote e)) (if (memq (quote eval) when-list995)
(chi-top-sequence600 body996 r957 w972 s973 (quote e) (quote (eval)) mod974)
(chi-void613))) ((memq (quote load) when-list995) (if (or (memq (quote compile)
when-list995) (and (eq? m959 (quote c&e)) (memq (quote eval) when-list995)))
(chi-top-sequence600 body996 r957 w972 s973 (quote c&e) (quote (compile load))
mod974) (if (memq m959 (quote (c c&e))) (chi-top-sequence600 body996 r957 w972
s973 (quote c) (quote (load)) mod974) (chi-void613)))) ((or (memq (quote
compile) when-list995) (and (eq? m959 (quote c&e)) (memq (quote eval)
when-list995))) (top-level-eval-hook533 (chi-top-sequence600 body996 r957 w972
s973 (quote e) (quote (eval)) mod974) mod974) (chi-void613)) (else
(chi-void613))))) tmp990) (syntax-violation #f "source expression failed to
match any pattern" tmp989))) ($sc-dispatch tmp989 (quote (any each-any any .
each-any))))) e971) (if (memv t975 (quote (define-syntax-form))) (let ((n999
(id-var-name591 value970 w972)) (r1000 (macros-only-env565 r957))) (let ((t1001
m959)) (if (memv t1001 (quote (c))) (if (memq (quote compile) esew960) (let
((e1002 (chi-install-global601 n999 (chi605 e971 r1000 w972 mod974)))) (begin
(top-level-eval-hook533 e1002 mod974) (if (memq (quote load) esew960) e1002
(chi-void613)))) (if (memq (quote load) esew960) (chi-install-global601 n999
(chi605 e971 r1000 w972 mod974)) (chi-void613))) (if (memv t1001 (quote (c&e)))
(let ((e1003 (chi-install-global601 n999 (chi605 e971 r1000 w972 mod974))))
(begin (top-level-eval-hook533 e1003 mod974) e1003)) (begin (if (memq (quote
eval) esew960) (top-level-eval-hook533 (chi-install-global601 n999 (chi605 e971
r1000 w972 mod974)) mod974)) (chi-void613)))))) (if (memv t975 (quote
(define-form))) (let ((n1004 (id-var-name591 value970 w972))) (let ((type1005
(binding-type561 (lookup566 n1004 r957 mod974)))) (let ((t1006 type1005)) (if
(memv t1006 (quote (global core macro module-ref))) (let ((x1007
(build-global-definition544 s973 n1004 (chi605 e971 r957 w972 mod974)))) (begin
(if (eq? m959 (quote c&e)) (top-level-eval-hook533 x1007 mod974)) x1007)) (if
(memv t1006 (quote (displaced-lexical))) (syntax-violation #f "identifier out
of context" e971 (wrap597 value970 w972 mod974)) (syntax-violation #f "cannot
define keyword at top level" e971 (wrap597 value970 w972 mod974))))))) (let
((x1008 (chi-expr606 type969 value970 e971 r957 w972 s973 mod974))) (begin (if
(eq? m959 (quote c&e)) (top-level-eval-hook533 x1008 mod974)) x1008))))))))))))
(syntax-type603 (lambda (e1009 r1010 w1011 s1012 rib1013 mod1014) (cond
((symbol? e1009) (let ((n1015 (id-var-name591 e1009 w1011))) (let ((b1016
(lookup566 n1015 r1010 mod1014))) (let ((type1017 (binding-type561 b1016)))
(let ((t1018 type1017)) (if (memv t1018 (quote (lexical))) (values type1017
(binding-value562 b1016) e1009 w1011 s1012 mod1014) (if (memv t1018 (quote
(global))) (values type1017 n1015 e1009 w1011 s1012 mod1014) (if (memv t1018
(quote (macro))) (syntax-type603 (chi-macro608 (binding-value562 b1016) e1009
r1010 w1011 rib1013 mod1014) r1010 (quote (())) s1012 rib1013 mod1014) (values
type1017 (binding-value562 b1016) e1009 w1011 s1012 mod1014))))))))) ((pair?
e1009) (let ((first1019 (car e1009))) (if (id?569 first1019) (let ((n1020
(id-var-name591 first1019 w1011))) (let ((b1021 (lookup566 n1020 r1010 (or (and
(syntax-object?553 first1019) (syntax-object-module556 first1019)) mod1014))))
(let ((type1022 (binding-type561 b1021))) (let ((t1023 type1022)) (if (memv
t1023 (quote (lexical))) (values (quote lexical-call) (binding-value562 b1021)
e1009 w1011 s1012 mod1014) (if (memv t1023 (quote (global))) (values (quote
global-call) n1020 e1009 w1011 s1012 mod1014) (if (memv t1023 (quote (macro)))
(syntax-type603 (chi-macro608 (binding-value562 b1021) e1009 r1010 w1011
rib1013 mod1014) r1010 (quote (())) s1012 rib1013 mod1014) (if (memv t1023
(quote (core external-macro module-ref))) (values type1022 (binding-value562
b1021) e1009 w1011 s1012 mod1014) (if (memv t1023 (quote (local-syntax)))
(values (quote local-syntax-form) (binding-value562 b1021) e1009 w1011 s1012
mod1014) (if (memv t1023 (quote (begin))) (values (quote begin-form) #f e1009
w1011 s1012 mod1014) (if (memv t1023 (quote (eval-when))) (values (quote
eval-when-form) #f e1009 w1011 s1012 mod1014) (if (memv t1023 (quote (define)))
((lambda (tmp1024) ((lambda (tmp1025) (if (if tmp1025 (apply (lambda (_1026
name1027 val1028) (id?569 name1027)) tmp1025) #f) (apply (lambda (_1029
name1030 val1031) (values (quote define-form) name1030 val1031 w1011 s1012
mod1014)) tmp1025) ((lambda (tmp1032) (if (if tmp1032 (apply (lambda (_1033
name1034 args1035 e11036 e21037) (and (id?569 name1034) (valid-bound-ids?594
(lambda-var-list618 args1035)))) tmp1032) #f) (apply (lambda (_1038 name1039
args1040 e11041 e21042) (values (quote define-form) (wrap597 name1039 w1011
mod1014) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1
e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () ()
()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i"
"i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation
ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause
chi-body chi-macro chi-application chi-expr chi chi-top syntax-type
chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) (wrap597 (cons args1040 (cons e11041 e21042)) w1011
mod1014)) (quote (())) s1012 mod1014)) tmp1032) ((lambda (tmp1044) (if (if
tmp1044 (apply (lambda (_1045 name1046) (id?569 name1046)) tmp1044) #f) (apply
(lambda (_1047 name1048) (values (quote define-form) (wrap597 name1048 w1011
mod1014) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage
() () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list
gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer
chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr
chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence
chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids?
valid-bound-ids? bound-id=? free-id=? 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
unannotate 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 build-global-definition build-global-assignment
build-global-reference analyze-variable build-lexical-assignment
build-lexical-reference build-conditional build-application
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list
gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer
chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr
chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence
chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids?
valid-bound-ids? bound-id=? free-id=? 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
unannotate 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 build-global-definition build-global-assignment
build-global-reference analyze-variable build-lexical-assignment
build-lexical-reference build-conditional build-application
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list
gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer
chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr
chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence
chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids?
valid-bound-ids? bound-id=? free-id=? 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
unannotate 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 build-global-definition build-global-assignment
build-global-reference analyze-variable build-lexical-assignment
build-lexical-reference build-conditional build-application
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)))) (quote (())) s1012 mod1014)) tmp1044) (syntax-violation #f "source
expression failed to match any pattern" tmp1024))) ($sc-dispatch tmp1024 (quote
(any any)))))) ($sc-dispatch tmp1024 (quote (any (any . any) any .
each-any)))))) ($sc-dispatch tmp1024 (quote (any any any))))) e1009) (if (memv
t1023 (quote (define-syntax))) ((lambda (tmp1049) ((lambda (tmp1050) (if (if
tmp1050 (apply (lambda (_1051 name1052 val1053) (id?569 name1052)) tmp1050) #f)
(apply (lambda (_1054 name1055 val1056) (values (quote define-syntax-form)
name1055 val1056 w1011 s1012 mod1014)) tmp1050) (syntax-violation #f "source
expression failed to match any pattern" tmp1049))) ($sc-dispatch tmp1049 (quote
(any any any))))) e1009) (values (quote call) #f e1009 w1011 s1012
mod1014)))))))))))))) (values (quote call) #f e1009 w1011 s1012 mod1014))))
((syntax-object?553 e1009) (syntax-type603 (syntax-object-expression554 e1009)
r1010 (join-wraps588 w1011 (syntax-object-wrap555 e1009)) #f rib1013 (or
(syntax-object-module556 e1009) mod1014))) ((annotation? e1009) (syntax-type603
(annotation-expression e1009) r1010 w1011 (annotation-source e1009) rib1013
mod1014)) ((self-evaluating? e1009) (values (quote constant) #f e1009 w1011
s1012 mod1014)) (else (values (quote other) #f e1009 w1011 s1012 mod1014)))))
(chi-when-list602 (lambda (e1057 when-list1058 w1059) (letrec ((f1060 (lambda
(when-list1061 situations1062) (if (null? when-list1061) situations1062 (f1060
(cdr when-list1061) (cons (let ((x1063 (car when-list1061))) (cond
((free-id=?592 x1063 (quote #(syntax-object compile ((top) #(ribcage () () ())
#(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list
situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote compile)) ((free-id=?592 x1063 (quote
#(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top))
#("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? 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 unannotate
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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote load)) ((free-id=?592 x1063 (quote
#(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top))
#("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? 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 unannotate
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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote
eval-when) "invalid situation" e1057 (wrap597 x1063 w1059 #f)))))
situations1062)))))) (f1060 when-list1058 (quote ()))))) (chi-install-global601
(lambda (name1064 e1065) (build-global-definition544 #f name1064 (if (let
((v1066 (module-variable (current-module) name1064))) (and v1066
(variable-bound? v1066) (macro? (variable-ref v1066)) (not (eq? (macro-type
(variable-ref v1066)) (quote syncase-macro))))) (build-application537 #f
(build-primref546 #f (quote make-extended-syncase-macro)) (list
(build-application537 #f (build-primref546 #f (quote module-ref)) (list
(build-application537 #f (quote current-module) (quote ())) (build-data547 #f
name1064))) (build-data547 #f (quote macro)) e1065)) (build-application537 #f
(build-primref546 #f (quote make-syncase-macro)) (list (build-data547 #f (quote
macro)) e1065)))))) (chi-top-sequence600 (lambda (body1067 r1068 w1069 s1070
m1071 esew1072 mod1073) (build-sequence548 s1070 (letrec ((dobody1074 (lambda
(body1075 r1076 w1077 m1078 esew1079 mod1080) (if (null? body1075) (quote ())
(let ((first1081 (chi-top604 (car body1075) r1076 w1077 m1078 esew1079
mod1080))) (cons first1081 (dobody1074 (cdr body1075) r1076 w1077 m1078
esew1079 mod1080))))))) (dobody1074 body1067 r1068 w1069 m1071 esew1072
mod1073))))) (chi-sequence599 (lambda (body1082 r1083 w1084 s1085 mod1086)
(build-sequence548 s1085 (letrec ((dobody1087 (lambda (body1088 r1089 w1090
mod1091) (if (null? body1088) (quote ()) (let ((first1092 (chi605 (car
body1088) r1089 w1090 mod1091))) (cons first1092 (dobody1087 (cdr body1088)
r1089 w1090 mod1091))))))) (dobody1087 body1082 r1083 w1084 mod1086)))))
(source-wrap598 (lambda (x1093 w1094 s1095 defmod1096) (wrap597 (if s1095
(make-annotation x1093 s1095 #f) x1093) w1094 defmod1096))) (wrap597 (lambda
(x1097 w1098 defmod1099) (cond ((and (null? (wrap-marks572 w1098)) (null?
(wrap-subst573 w1098))) x1097) ((syntax-object?553 x1097)
(make-syntax-object552 (syntax-object-expression554 x1097) (join-wraps588 w1098
(syntax-object-wrap555 x1097)) (syntax-object-module556 x1097))) ((null? x1097)
x1097) (else (make-syntax-object552 x1097 w1098 defmod1099)))))
(bound-id-member?596 (lambda (x1100 list1101) (and (not (null? list1101)) (or
(bound-id=?593 x1100 (car list1101)) (bound-id-member?596 x1100 (cdr
list1101)))))) (distinct-bound-ids?595 (lambda (ids1102) (letrec
((distinct?1103 (lambda (ids1104) (or (null? ids1104) (and (not
(bound-id-member?596 (car ids1104) (cdr ids1104))) (distinct?1103 (cdr
ids1104))))))) (distinct?1103 ids1102)))) (valid-bound-ids?594 (lambda
(ids1105) (and (letrec ((all-ids?1106 (lambda (ids1107) (or (null? ids1107)
(and (id?569 (car ids1107)) (all-ids?1106 (cdr ids1107))))))) (all-ids?1106
ids1105)) (distinct-bound-ids?595 ids1105)))) (bound-id=?593 (lambda (i1108
j1109) (if (and (syntax-object?553 i1108) (syntax-object?553 j1109)) (and (eq?
(let ((e1110 (syntax-object-expression554 i1108))) (if (annotation? e1110)
(annotation-expression e1110) e1110)) (let ((e1111 (syntax-object-expression554
j1109))) (if (annotation? e1111) (annotation-expression e1111) e1111)))
(same-marks?590 (wrap-marks572 (syntax-object-wrap555 i1108)) (wrap-marks572
(syntax-object-wrap555 j1109)))) (eq? (let ((e1112 i1108)) (if (annotation?
e1112) (annotation-expression e1112) e1112)) (let ((e1113 j1109)) (if
(annotation? e1113) (annotation-expression e1113) e1113)))))) (free-id=?592
(lambda (i1114 j1115) (and (eq? (let ((x1116 i1114)) (let ((e1117 (if
(syntax-object?553 x1116) (syntax-object-expression554 x1116) x1116))) (if
(annotation? e1117) (annotation-expression e1117) e1117))) (let ((x1118 j1115))
(let ((e1119 (if (syntax-object?553 x1118) (syntax-object-expression554 x1118)
x1118))) (if (annotation? e1119) (annotation-expression e1119) e1119)))) (eq?
(id-var-name591 i1114 (quote (()))) (id-var-name591 j1115 (quote (())))))))
(id-var-name591 (lambda (id1120 w1121) (letrec ((search-vector-rib1124 (lambda
(sym1130 subst1131 marks1132 symnames1133 ribcage1134) (let ((n1135
(vector-length symnames1133))) (letrec ((f1136 (lambda (i1137) (cond ((fx=531
i1137 n1135) (search1122 sym1130 (cdr subst1131) marks1132)) ((and (eq?
(vector-ref symnames1133 i1137) sym1130) (same-marks?590 marks1132 (vector-ref
(ribcage-marks579 ribcage1134) i1137))) (values (vector-ref (ribcage-labels580
ribcage1134) i1137) marks1132)) (else (f1136 (fx+529 i1137 1))))))) (f1136
0))))) (search-list-rib1123 (lambda (sym1138 subst1139 marks1140 symnames1141
ribcage1142) (letrec ((f1143 (lambda (symnames1144 i1145) (cond ((null?
symnames1144) (search1122 sym1138 (cdr subst1139) marks1140)) ((and (eq? (car
symnames1144) sym1138) (same-marks?590 marks1140 (list-ref (ribcage-marks579
ribcage1142) i1145))) (values (list-ref (ribcage-labels580 ribcage1142) i1145)
marks1140)) (else (f1143 (cdr symnames1144) (fx+529 i1145 1))))))) (f1143
symnames1141 0)))) (search1122 (lambda (sym1146 subst1147 marks1148) (if (null?
subst1147) (values #f marks1148) (let ((fst1149 (car subst1147))) (if (eq?
fst1149 (quote shift)) (search1122 sym1146 (cdr subst1147) (cdr marks1148))
(let ((symnames1150 (ribcage-symnames578 fst1149))) (if (vector? symnames1150)
(search-vector-rib1124 sym1146 subst1147 marks1148 symnames1150 fst1149)
(search-list-rib1123 sym1146 subst1147 marks1148 symnames1150 fst1149)))))))))
(cond ((symbol? id1120) (or (call-with-values (lambda () (search1122 id1120
(wrap-subst573 w1121) (wrap-marks572 w1121))) (lambda (x1152 . ignore1151)
x1152)) id1120)) ((syntax-object?553 id1120) (let ((id1153 (let ((e1155
(syntax-object-expression554 id1120))) (if (annotation? e1155)
(annotation-expression e1155) e1155))) (w11154 (syntax-object-wrap555 id1120)))
(let ((marks1156 (join-marks589 (wrap-marks572 w1121) (wrap-marks572 w11154))))
(call-with-values (lambda () (search1122 id1153 (wrap-subst573 w1121)
marks1156)) (lambda (new-id1157 marks1158) (or new-id1157 (call-with-values
(lambda () (search1122 id1153 (wrap-subst573 w11154) marks1158)) (lambda (x1160
. ignore1159) x1160)) id1153)))))) ((annotation? id1120) (let ((id1161 (let
((e1162 id1120)) (if (annotation? e1162) (annotation-expression e1162)
e1162)))) (or (call-with-values (lambda () (search1122 id1161 (wrap-subst573
w1121) (wrap-marks572 w1121))) (lambda (x1164 . ignore1163) x1164)) id1161)))
(else (syntax-violation (quote id-var-name) "invalid id" id1120))))))
(same-marks?590 (lambda (x1165 y1166) (or (eq? x1165 y1166) (and (not (null?
x1165)) (not (null? y1166)) (eq? (car x1165) (car y1166)) (same-marks?590 (cdr
x1165) (cdr y1166)))))) (join-marks589 (lambda (m11167 m21168) (smart-append587
m11167 m21168))) (join-wraps588 (lambda (w11169 w21170) (let ((m11171
(wrap-marks572 w11169)) (s11172 (wrap-subst573 w11169))) (if (null? m11171) (if
(null? s11172) w21170 (make-wrap571 (wrap-marks572 w21170) (smart-append587
s11172 (wrap-subst573 w21170)))) (make-wrap571 (smart-append587 m11171
(wrap-marks572 w21170)) (smart-append587 s11172 (wrap-subst573 w21170)))))))
(smart-append587 (lambda (m11173 m21174) (if (null? m21174) m11173 (append
m11173 m21174)))) (make-binding-wrap586 (lambda (ids1175 labels1176 w1177) (if
(null? ids1175) w1177 (make-wrap571 (wrap-marks572 w1177) (cons (let
((labelvec1178 (list->vector labels1176))) (let ((n1179 (vector-length
labelvec1178))) (let ((symnamevec1180 (make-vector n1179)) (marksvec1181
(make-vector n1179))) (begin (letrec ((f1182 (lambda (ids1183 i1184) (if (not
(null? ids1183)) (call-with-values (lambda () (id-sym-name&marks570 (car
ids1183) w1177)) (lambda (symname1185 marks1186) (begin (vector-set!
symnamevec1180 i1184 symname1185) (vector-set! marksvec1181 i1184 marks1186)
(f1182 (cdr ids1183) (fx+529 i1184 1))))))))) (f1182 ids1175 0))
(make-ribcage576 symnamevec1180 marksvec1181 labelvec1178))))) (wrap-subst573
w1177)))))) (extend-ribcage!585 (lambda (ribcage1187 id1188 label1189) (begin
(set-ribcage-symnames!581 ribcage1187 (cons (let ((e1190
(syntax-object-expression554 id1188))) (if (annotation? e1190)
(annotation-expression e1190) e1190)) (ribcage-symnames578 ribcage1187)))
(set-ribcage-marks!582 ribcage1187 (cons (wrap-marks572 (syntax-object-wrap555
id1188)) (ribcage-marks579 ribcage1187))) (set-ribcage-labels!583 ribcage1187
(cons label1189 (ribcage-labels580 ribcage1187)))))) (anti-mark584 (lambda
(w1191) (make-wrap571 (cons #f (wrap-marks572 w1191)) (cons (quote shift)
(wrap-subst573 w1191))))) (set-ribcage-labels!583 (lambda (x1192 update1193)
(vector-set! x1192 3 update1193))) (set-ribcage-marks!582 (lambda (x1194
update1195) (vector-set! x1194 2 update1195))) (set-ribcage-symnames!581
(lambda (x1196 update1197) (vector-set! x1196 1 update1197)))
(ribcage-labels580 (lambda (x1198) (vector-ref x1198 3))) (ribcage-marks579
(lambda (x1199) (vector-ref x1199 2))) (ribcage-symnames578 (lambda (x1200)
(vector-ref x1200 1))) (ribcage?577 (lambda (x1201) (and (vector? x1201) (=
(vector-length x1201) 4) (eq? (vector-ref x1201 0) (quote ribcage)))))
(make-ribcage576 (lambda (symnames1202 marks1203 labels1204) (vector (quote
ribcage) symnames1202 marks1203 labels1204))) (gen-labels575 (lambda (ls1205)
(if (null? ls1205) (quote ()) (cons (gen-label574) (gen-labels575 (cdr
ls1205)))))) (gen-label574 (lambda () (string #\i))) (wrap-subst573 cdr)
(wrap-marks572 car) (make-wrap571 cons) (id-sym-name&marks570 (lambda (x1206
w1207) (if (syntax-object?553 x1206) (values (let ((e1208
(syntax-object-expression554 x1206))) (if (annotation? e1208)
(annotation-expression e1208) e1208)) (join-marks589 (wrap-marks572 w1207)
(wrap-marks572 (syntax-object-wrap555 x1206)))) (values (let ((e1209 x1206))
(if (annotation? e1209) (annotation-expression e1209) e1209)) (wrap-marks572
w1207))))) (id?569 (lambda (x1210) (cond ((symbol? x1210) #t)
((syntax-object?553 x1210) (symbol? (let ((e1211 (syntax-object-expression554
x1210))) (if (annotation? e1211) (annotation-expression e1211) e1211))))
((annotation? x1210) (symbol? (annotation-expression x1210))) (else #f))))
(nonsymbol-id?568 (lambda (x1212) (and (syntax-object?553 x1212) (symbol? (let
((e1213 (syntax-object-expression554 x1212))) (if (annotation? e1213)
(annotation-expression e1213) e1213)))))) (global-extend567 (lambda (type1214
sym1215 val1216) (put-global-definition-hook535 sym1215 type1214 val1216)))
(lookup566 (lambda (x1217 r1218 mod1219) (cond ((assq x1217 r1218) => cdr)
((symbol? x1217) (or (get-global-definition-hook536 x1217 mod1219) (quote
(global)))) (else (quote (displaced-lexical)))))) (macros-only-env565 (lambda
(r1220) (if (null? r1220) (quote ()) (let ((a1221 (car r1220))) (if (eq? (cadr
a1221) (quote macro)) (cons a1221 (macros-only-env565 (cdr r1220)))
(macros-only-env565 (cdr r1220))))))) (extend-var-env564 (lambda (labels1222
vars1223 r1224) (if (null? labels1222) r1224 (extend-var-env564 (cdr
labels1222) (cdr vars1223) (cons (cons (car labels1222) (cons (quote lexical)
(car vars1223))) r1224))))) (extend-env563 (lambda (labels1225 bindings1226
r1227) (if (null? labels1225) r1227 (extend-env563 (cdr labels1225) (cdr
bindings1226) (cons (cons (car labels1225) (car bindings1226)) r1227)))))
(binding-value562 cdr) (binding-type561 car) (source-annotation560 (lambda
(x1228) (cond ((annotation? x1228) (annotation-source x1228))
((syntax-object?553 x1228) (source-annotation560 (syntax-object-expression554
x1228))) (else #f)))) (set-syntax-object-module!559 (lambda (x1229 update1230)
(vector-set! x1229 3 update1230))) (set-syntax-object-wrap!558 (lambda (x1231
update1232) (vector-set! x1231 2 update1232)))
(set-syntax-object-expression!557 (lambda (x1233 update1234) (vector-set! x1233
1 update1234))) (syntax-object-module556 (lambda (x1235) (vector-ref x1235 3)))
(syntax-object-wrap555 (lambda (x1236) (vector-ref x1236 2)))
(syntax-object-expression554 (lambda (x1237) (vector-ref x1237 1)))
(syntax-object?553 (lambda (x1238) (and (vector? x1238) (= (vector-length
x1238) 4) (eq? (vector-ref x1238 0) (quote syntax-object)))))
(make-syntax-object552 (lambda (expression1239 wrap1240 module1241) (vector
(quote syntax-object) expression1239 wrap1240 module1241))) (build-letrec551
(lambda (src1242 ids1243 vars1244 val-exps1245 body-exp1246) (if (null?
vars1244) body-exp1246 (let ((t1247 (fluid-ref *mode*528))) (if (memv t1247
(quote (c))) ((@ (language tree-il) make-letrec) src1242 ids1243 vars1244
val-exps1245 body-exp1246) (list (quote letrec) (map list vars1244
val-exps1245) body-exp1246)))))) (build-named-let550 (lambda (src1248 ids1249
vars1250 val-exps1251 body-exp1252) (let ((f1253 (car vars1250)) (f-name1254
(car ids1249)) (vars1255 (cdr vars1250)) (ids1256 (cdr ids1249))) (let ((t1257
(fluid-ref *mode*528))) (if (memv t1257 (quote (c))) ((@ (language tree-il)
make-letrec) src1248 (list f-name1254) (list f1253) (list (build-lambda545
src1248 ids1256 vars1255 #f body-exp1252)) (build-application537 src1248
(build-lexical-reference539 (quote fun) src1248 f-name1254 f1253)
val-exps1251)) (list (quote let) f1253 (map list vars1255 val-exps1251)
body-exp1252)))))) (build-let549 (lambda (src1258 ids1259 vars1260 val-exps1261
body-exp1262) (if (null? vars1260) body-exp1262 (let ((t1263 (fluid-ref
*mode*528))) (if (memv t1263 (quote (c))) ((@ (language tree-il) make-let)
src1258 ids1259 vars1260 val-exps1261 body-exp1262) (list (quote let) (map list
vars1260 val-exps1261) body-exp1262)))))) (build-sequence548 (lambda (src1264
exps1265) (if (null? (cdr exps1265)) (car exps1265) (let ((t1266 (fluid-ref
*mode*528))) (if (memv t1266 (quote (c))) ((@ (language tree-il) make-sequence)
src1264 exps1265) (cons (quote begin) exps1265)))))) (build-data547 (lambda
(src1267 exp1268) (let ((t1269 (fluid-ref *mode*528))) (if (memv t1269 (quote
(c))) ((@ (language tree-il) make-const) src1267 exp1268) (if (and
(self-evaluating? exp1268) (not (vector? exp1268))) exp1268 (list (quote quote)
exp1268)))))) (build-primref546 (lambda (src1270 name1271) (let ((t1272
(fluid-ref *mode*528))) (if (memv t1272 (quote (c))) ((@ (language tree-il)
make-primitive-ref) src1270 name1271) (build-global-reference542 src1270
name1271 (quote (hygiene guile))))))) (build-lambda545 (lambda (src1273 ids1274
vars1275 docstring1276 exp1277) (let ((t1278 (fluid-ref *mode*528))) (if (memv
t1278 (quote (c))) ((@ (language tree-il) make-lambda) src1273 ids1274 vars1275
(if docstring1276 (list (cons (quote documentation) docstring1276)) (quote ()))
exp1277) (cons (quote lambda) (cons vars1275 (append (if docstring1276 (list
docstring1276) (quote ())) (list exp1277)))))))) (build-global-definition544
(lambda (source1279 var1280 exp1281) (let ((t1282 (fluid-ref *mode*528))) (if
(memv t1282 (quote (c))) ((@ (language tree-il) make-toplevel-define)
source1279 var1280 exp1281) (list (quote define) var1280 exp1281)))))
(build-global-assignment543 (lambda (source1283 var1284 exp1285 mod1286)
(analyze-variable541 mod1286 var1284 (lambda (mod1287 var1288 public?1289) (let
((t1290 (fluid-ref *mode*528))) (if (memv t1290 (quote (c))) ((@ (language
tree-il) make-module-set) source1283 mod1287 var1288 public?1289 exp1285) (list
(quote set!) (list (if public?1289 (quote @) (quote @@)) mod1287 var1288)
exp1285)))) (lambda (var1291) (let ((t1292 (fluid-ref *mode*528))) (if (memv
t1292 (quote (c))) ((@ (language tree-il) make-toplevel-set) source1283 var1291
exp1285) (list (quote set!) var1291 exp1285))))))) (build-global-reference542
(lambda (source1293 var1294 mod1295) (analyze-variable541 mod1295 var1294
(lambda (mod1296 var1297 public?1298) (let ((t1299 (fluid-ref *mode*528))) (if
(memv t1299 (quote (c))) ((@ (language tree-il) make-module-ref) source1293
mod1296 var1297 public?1298) (list (if public?1298 (quote @) (quote @@))
mod1296 var1297)))) (lambda (var1300) (let ((t1301 (fluid-ref *mode*528))) (if
(memv t1301 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source1293
var1300) var1300)))))) (analyze-variable541 (lambda (mod1302 var1303
modref-cont1304 bare-cont1305) (if (not mod1302) (bare-cont1305 var1303) (let
((kind1306 (car mod1302)) (mod1307 (cdr mod1302))) (let ((t1308 kind1306)) (if
(memv t1308 (quote (public))) (modref-cont1304 mod1307 var1303 #t) (if (memv
t1308 (quote (private))) (if (not (equal? mod1307 (module-name
(current-module)))) (modref-cont1304 mod1307 var1303 #f) (bare-cont1305
var1303)) (if (memv t1308 (quote (bare))) (bare-cont1305 var1303) (if (memv
t1308 (quote (hygiene))) (if (and (not (equal? mod1307 (module-name
(current-module)))) (module-variable (resolve-module mod1307) var1303))
(modref-cont1304 mod1307 var1303 #f) (bare-cont1305 var1303)) (syntax-violation
#f "bad module kind" var1303 mod1307)))))))))) (build-lexical-assignment540
(lambda (source1309 name1310 var1311 exp1312) (let ((t1313 (fluid-ref
*mode*528))) (if (memv t1313 (quote (c))) ((@ (language tree-il)
make-lexical-set) source1309 name1310 var1311 exp1312) (list (quote set!)
var1311 exp1312))))) (build-lexical-reference539 (lambda (type1314 source1315
name1316 var1317) (let ((t1318 (fluid-ref *mode*528))) (if (memv t1318 (quote
(c))) ((@ (language tree-il) make-lexical-ref) source1315 name1316 var1317)
var1317)))) (build-conditional538 (lambda (source1319 test-exp1320 then-exp1321
else-exp1322) (let ((t1323 (fluid-ref *mode*528))) (if (memv t1323 (quote (c)))
((@ (language tree-il) make-conditional) source1319 test-exp1320 then-exp1321
else-exp1322) (list (quote if) test-exp1320 then-exp1321 else-exp1322)))))
(build-application537 (lambda (source1324 fun-exp1325 arg-exps1326) (let
((t1327 (fluid-ref *mode*528))) (if (memv t1327 (quote (c))) ((@ (language
tree-il) make-application) source1324 fun-exp1325 arg-exps1326) (cons
fun-exp1325 arg-exps1326))))) (get-global-definition-hook536 (lambda
(symbol1328 module1329) (begin (if (and (not module1329) (current-module))
(warn "module system is booted, we should have a module" symbol1328)) (let
((v1330 (module-variable (if module1329 (resolve-module (cdr module1329))
(current-module)) symbol1328))) (and v1330 (variable-bound? v1330) (let
((val1331 (variable-ref v1330))) (and (macro? val1331) (syncase-macro-type
val1331) (cons (syncase-macro-type val1331) (syncase-macro-binding
val1331))))))))) (put-global-definition-hook535 (lambda (symbol1332 type1333
val1334) (let ((existing1335 (let ((v1336 (module-variable (current-module)
symbol1332))) (and v1336 (variable-bound? v1336) (let ((val1337 (variable-ref
v1336))) (and (macro? val1337) (not (syncase-macro-type val1337)) val1337))))))
(module-define! (current-module) symbol1332 (if existing1335
(make-extended-syncase-macro existing1335 type1333 val1334) (make-syncase-macro
type1333 val1334)))))) (local-eval-hook534 (lambda (x1338 mod1339)
(primitive-eval (list noexpand527 (let ((t1340 (fluid-ref *mode*528))) (if
(memv t1340 (quote (c))) ((@ (language tree-il) tree-il->scheme) x1338)
x1338)))))) (top-level-eval-hook533 (lambda (x1341 mod1342) (primitive-eval
(list noexpand527 (let ((t1343 (fluid-ref *mode*528))) (if (memv t1343 (quote
(c))) ((@ (language tree-il) tree-il->scheme) x1341) x1341)))))) (fx<532 <)
(fx=531 =) (fx-530 -) (fx+529 +) (*mode*528 (make-fluid)) (noexpand527
"noexpand")) (begin (global-extend567 (quote local-syntax) (quote
letrec-syntax) #t) (global-extend567 (quote local-syntax) (quote let-syntax)
#f) (global-extend567 (quote core) (quote fluid-let-syntax) (lambda (e1344
r1345 w1346 s1347 mod1348) ((lambda (tmp1349) ((lambda (tmp1350) (if (if
tmp1350 (apply (lambda (_1351 var1352 val1353 e11354 e21355)
(valid-bound-ids?594 var1352)) tmp1350) #f) (apply (lambda (_1357 var1358
val1359 e11360 e21361) (let ((names1362 (map (lambda (x1363) (id-var-name591
x1363 w1346)) var1358))) (begin (for-each (lambda (id1365 n1366) (let ((t1367
(binding-type561 (lookup566 n1366 r1345 mod1348)))) (if (memv t1367 (quote
(displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier
out of context" e1344 (source-wrap598 id1365 w1346 s1347 mod1348))))) var1358
names1362) (chi-body609 (cons e11360 e21361) (source-wrap598 e1344 w1346 s1347
mod1348) (extend-env563 names1362 (let ((trans-r1370 (macros-only-env565
r1345))) (map (lambda (x1371) (cons (quote macro) (eval-local-transformer612
(chi605 x1371 trans-r1370 w1346 mod1348) mod1348))) val1359)) r1345) w1346
mod1348)))) tmp1350) ((lambda (_1373) (syntax-violation (quote
fluid-let-syntax) "bad syntax" (source-wrap598 e1344 w1346 s1347 mod1348)))
tmp1349))) ($sc-dispatch tmp1349 (quote (any #(each (any any)) any .
each-any))))) e1344))) (global-extend567 (quote core) (quote quote) (lambda
(e1374 r1375 w1376 s1377 mod1378) ((lambda (tmp1379) ((lambda (tmp1380) (if
tmp1380 (apply (lambda (_1381 e1382) (build-data547 s1377 (strip616 e1382
w1376))) tmp1380) ((lambda (_1383) (syntax-violation (quote quote) "bad syntax"
(source-wrap598 e1374 w1376 s1377 mod1378))) tmp1379))) ($sc-dispatch tmp1379
(quote (any any))))) e1374))) (global-extend567 (quote core) (quote syntax)
(letrec ((regen1391 (lambda (x1392) (let ((t1393 (car x1392))) (if (memv t1393
(quote (ref))) (build-lexical-reference539 (quote value) #f (cadr x1392) (cadr
x1392)) (if (memv t1393 (quote (primitive))) (build-primref546 #f (cadr x1392))
(if (memv t1393 (quote (quote))) (build-data547 #f (cadr x1392)) (if (memv
t1393 (quote (lambda))) (build-lambda545 #f (cadr x1392) (cadr x1392) #f
(regen1391 (caddr x1392))) (if (memv t1393 (quote (map))) (let ((ls1394 (map
regen1391 (cdr x1392)))) (build-application537 #f (build-primref546 #f (quote
map)) ls1394)) (build-application537 #f (build-primref546 #f (car x1392)) (map
regen1391 (cdr x1392))))))))))) (gen-vector1390 (lambda (x1395) (cond ((eq?
(car x1395) (quote list)) (cons (quote vector) (cdr x1395))) ((eq? (car x1395)
(quote quote)) (list (quote quote) (list->vector (cadr x1395)))) (else (list
(quote list->vector) x1395))))) (gen-append1389 (lambda (x1396 y1397) (if
(equal? y1397 (quote (quote ()))) x1396 (list (quote append) x1396 y1397))))
(gen-cons1388 (lambda (x1398 y1399) (let ((t1400 (car y1399))) (if (memv t1400
(quote (quote))) (if (eq? (car x1398) (quote quote)) (list (quote quote) (cons
(cadr x1398) (cadr y1399))) (if (eq? (cadr y1399) (quote ())) (list (quote
list) x1398) (list (quote cons) x1398 y1399))) (if (memv t1400 (quote (list)))
(cons (quote list) (cons x1398 (cdr y1399))) (list (quote cons) x1398
y1399)))))) (gen-map1387 (lambda (e1401 map-env1402) (let ((formals1403 (map
cdr map-env1402)) (actuals1404 (map (lambda (x1405) (list (quote ref) (car
x1405))) map-env1402))) (cond ((eq? (car e1401) (quote ref)) (car actuals1404))
((and-map (lambda (x1406) (and (eq? (car x1406) (quote ref)) (memq (cadr x1406)
formals1403))) (cdr e1401)) (cons (quote map) (cons (list (quote primitive)
(car e1401)) (map (let ((r1407 (map cons formals1403 actuals1404))) (lambda
(x1408) (cdr (assq (cadr x1408) r1407)))) (cdr e1401))))) (else (cons (quote
map) (cons (list (quote lambda) formals1403 e1401) actuals1404)))))))
(gen-mappend1386 (lambda (e1409 map-env1410) (list (quote apply) (quote
(primitive append)) (gen-map1387 e1409 map-env1410)))) (gen-ref1385 (lambda
(src1411 var1412 level1413 maps1414) (if (fx=531 level1413 0) (values var1412
maps1414) (if (null? maps1414) (syntax-violation (quote syntax) "missing
ellipsis" src1411) (call-with-values (lambda () (gen-ref1385 src1411 var1412
(fx-530 level1413 1) (cdr maps1414))) (lambda (outer-var1415 outer-maps1416)
(let ((b1417 (assq outer-var1415 (car maps1414)))) (if b1417 (values (cdr
b1417) maps1414) (let ((inner-var1418 (gen-var617 (quote tmp)))) (values
inner-var1418 (cons (cons (cons outer-var1415 inner-var1418) (car maps1414))
outer-maps1416))))))))))) (gen-syntax1384 (lambda (src1419 e1420 r1421 maps1422
ellipsis?1423 mod1424) (if (id?569 e1420) (let ((label1425 (id-var-name591
e1420 (quote (()))))) (let ((b1426 (lookup566 label1425 r1421 mod1424))) (if
(eq? (binding-type561 b1426) (quote syntax)) (call-with-values (lambda () (let
((var.lev1427 (binding-value562 b1426))) (gen-ref1385 src1419 (car var.lev1427)
(cdr var.lev1427) maps1422))) (lambda (var1428 maps1429) (values (list (quote
ref) var1428) maps1429))) (if (ellipsis?1423 e1420) (syntax-violation (quote
syntax) "misplaced ellipsis" src1419) (values (list (quote quote) e1420)
maps1422))))) ((lambda (tmp1430) ((lambda (tmp1431) (if (if tmp1431 (apply
(lambda (dots1432 e1433) (ellipsis?1423 dots1432)) tmp1431) #f) (apply (lambda
(dots1434 e1435) (gen-syntax1384 src1419 e1435 r1421 maps1422 (lambda (x1436)
#f) mod1424)) tmp1431) ((lambda (tmp1437) (if (if tmp1437 (apply (lambda (x1438
dots1439 y1440) (ellipsis?1423 dots1439)) tmp1437) #f) (apply (lambda (x1441
dots1442 y1443) (letrec ((f1444 (lambda (y1445 k1446) ((lambda (tmp1450)
((lambda (tmp1451) (if (if tmp1451 (apply (lambda (dots1452 y1453)
(ellipsis?1423 dots1452)) tmp1451) #f) (apply (lambda (dots1454 y1455) (f1444
y1455 (lambda (maps1456) (call-with-values (lambda () (k1446 (cons (quote ())
maps1456))) (lambda (x1457 maps1458) (if (null? (car maps1458))
(syntax-violation (quote syntax) "extra ellipsis" src1419) (values
(gen-mappend1386 x1457 (car maps1458)) (cdr maps1458)))))))) tmp1451) ((lambda
(_1459) (call-with-values (lambda () (gen-syntax1384 src1419 y1445 r1421
maps1422 ellipsis?1423 mod1424)) (lambda (y1460 maps1461) (call-with-values
(lambda () (k1446 maps1461)) (lambda (x1462 maps1463) (values (gen-append1389
x1462 y1460) maps1463)))))) tmp1450))) ($sc-dispatch tmp1450 (quote (any .
any))))) y1445)))) (f1444 y1443 (lambda (maps1447) (call-with-values (lambda ()
(gen-syntax1384 src1419 x1441 r1421 (cons (quote ()) maps1447) ellipsis?1423
mod1424)) (lambda (x1448 maps1449) (if (null? (car maps1449)) (syntax-violation
(quote syntax) "extra ellipsis" src1419) (values (gen-map1387 x1448 (car
maps1449)) (cdr maps1449))))))))) tmp1437) ((lambda (tmp1464) (if tmp1464
(apply (lambda (x1465 y1466) (call-with-values (lambda () (gen-syntax1384
src1419 x1465 r1421 maps1422 ellipsis?1423 mod1424)) (lambda (x1467 maps1468)
(call-with-values (lambda () (gen-syntax1384 src1419 y1466 r1421 maps1468
ellipsis?1423 mod1424)) (lambda (y1469 maps1470) (values (gen-cons1388 x1467
y1469) maps1470)))))) tmp1464) ((lambda (tmp1471) (if tmp1471 (apply (lambda
(e11472 e21473) (call-with-values (lambda () (gen-syntax1384 src1419 (cons
e11472 e21473) r1421 maps1422 ellipsis?1423 mod1424)) (lambda (e1475 maps1476)
(values (gen-vector1390 e1475) maps1476)))) tmp1471) ((lambda (_1477) (values
(list (quote quote) e1420) maps1422)) tmp1430))) ($sc-dispatch tmp1430 (quote
#(vector (any . each-any))))))) ($sc-dispatch tmp1430 (quote (any . any))))))
($sc-dispatch tmp1430 (quote (any any . any)))))) ($sc-dispatch tmp1430 (quote
(any any))))) e1420))))) (lambda (e1478 r1479 w1480 s1481 mod1482) (let ((e1483
(source-wrap598 e1478 w1480 s1481 mod1482))) ((lambda (tmp1484) ((lambda
(tmp1485) (if tmp1485 (apply (lambda (_1486 x1487) (call-with-values (lambda ()
(gen-syntax1384 e1483 x1487 r1479 (quote ()) ellipsis?614 mod1482)) (lambda
(e1488 maps1489) (regen1391 e1488)))) tmp1485) ((lambda (_1490)
(syntax-violation (quote syntax) "bad `syntax' form" e1483)) tmp1484)))
($sc-dispatch tmp1484 (quote (any any))))) e1483))))) (global-extend567 (quote
core) (quote lambda) (lambda (e1491 r1492 w1493 s1494 mod1495) ((lambda
(tmp1496) ((lambda (tmp1497) (if tmp1497 (apply (lambda (_1498 c1499)
(chi-lambda-clause610 (source-wrap598 e1491 w1493 s1494 mod1495) #f c1499 r1492
w1493 mod1495 (lambda (names1500 vars1501 docstring1502 body1503)
(build-lambda545 s1494 names1500 vars1501 docstring1502 body1503)))) tmp1497)
(syntax-violation #f "source expression failed to match any pattern" tmp1496)))
($sc-dispatch tmp1496 (quote (any . any))))) e1491))) (global-extend567 (quote
core) (quote let) (letrec ((chi-let1504 (lambda (e1505 r1506 w1507 s1508
mod1509 constructor1510 ids1511 vals1512 exps1513) (if (not
(valid-bound-ids?594 ids1511)) (syntax-violation (quote let) "duplicate bound
variable" e1505) (let ((labels1514 (gen-labels575 ids1511)) (new-vars1515 (map
gen-var617 ids1511))) (let ((nw1516 (make-binding-wrap586 ids1511 labels1514
w1507)) (nr1517 (extend-var-env564 labels1514 new-vars1515 r1506)))
(constructor1510 s1508 (map syntax->datum ids1511) new-vars1515 (map (lambda
(x1518) (chi605 x1518 r1506 w1507 mod1509)) vals1512) (chi-body609 exps1513
(source-wrap598 e1505 nw1516 s1508 mod1509) nr1517 nw1516 mod1509))))))))
(lambda (e1519 r1520 w1521 s1522 mod1523) ((lambda (tmp1524) ((lambda (tmp1525)
(if tmp1525 (apply (lambda (_1526 id1527 val1528 e11529 e21530) (chi-let1504
e1519 r1520 w1521 s1522 mod1523 build-let549 id1527 val1528 (cons e11529
e21530))) tmp1525) ((lambda (tmp1534) (if (if tmp1534 (apply (lambda (_1535
f1536 id1537 val1538 e11539 e21540) (id?569 f1536)) tmp1534) #f) (apply (lambda
(_1541 f1542 id1543 val1544 e11545 e21546) (chi-let1504 e1519 r1520 w1521 s1522
mod1523 build-named-let550 (cons f1542 id1543) val1544 (cons e11545 e21546)))
tmp1534) ((lambda (_1550) (syntax-violation (quote let) "bad let"
(source-wrap598 e1519 w1521 s1522 mod1523))) tmp1524))) ($sc-dispatch tmp1524
(quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1524
(quote (any #(each (any any)) any . each-any))))) e1519)))) (global-extend567
(quote core) (quote letrec) (lambda (e1551 r1552 w1553 s1554 mod1555) ((lambda
(tmp1556) ((lambda (tmp1557) (if tmp1557 (apply (lambda (_1558 id1559 val1560
e11561 e21562) (let ((ids1563 id1559)) (if (not (valid-bound-ids?594 ids1563))
(syntax-violation (quote letrec) "duplicate bound variable" e1551) (let
((labels1565 (gen-labels575 ids1563)) (new-vars1566 (map gen-var617 ids1563)))
(let ((w1567 (make-binding-wrap586 ids1563 labels1565 w1553)) (r1568
(extend-var-env564 labels1565 new-vars1566 r1552))) (build-letrec551 s1554 (map
syntax->datum ids1563) new-vars1566 (map (lambda (x1569) (chi605 x1569 r1568
w1567 mod1555)) val1560) (chi-body609 (cons e11561 e21562) (source-wrap598
e1551 w1567 s1554 mod1555) r1568 w1567 mod1555))))))) tmp1557) ((lambda (_1572)
(syntax-violation (quote letrec) "bad letrec" (source-wrap598 e1551 w1553 s1554
mod1555))) tmp1556))) ($sc-dispatch tmp1556 (quote (any #(each (any any)) any .
each-any))))) e1551))) (global-extend567 (quote core) (quote set!) (lambda
(e1573 r1574 w1575 s1576 mod1577) ((lambda (tmp1578) ((lambda (tmp1579) (if (if
tmp1579 (apply (lambda (_1580 id1581 val1582) (id?569 id1581)) tmp1579) #f)
(apply (lambda (_1583 id1584 val1585) (let ((val1586 (chi605 val1585 r1574
w1575 mod1577)) (n1587 (id-var-name591 id1584 w1575))) (let ((b1588 (lookup566
n1587 r1574 mod1577))) (let ((t1589 (binding-type561 b1588))) (if (memv t1589
(quote (lexical))) (build-lexical-assignment540 s1576 (syntax->datum id1584)
(binding-value562 b1588) val1586) (if (memv t1589 (quote (global)))
(build-global-assignment543 s1576 n1587 val1586 mod1577) (if (memv t1589 (quote
(displaced-lexical))) (syntax-violation (quote set!) "identifier out of
context" (wrap597 id1584 w1575 mod1577)) (syntax-violation (quote set!) "bad
set!" (source-wrap598 e1573 w1575 s1576 mod1577))))))))) tmp1579) ((lambda
(tmp1590) (if tmp1590 (apply (lambda (_1591 head1592 tail1593 val1594)
(call-with-values (lambda () (syntax-type603 head1592 r1574 (quote (())) #f #f
mod1577)) (lambda (type1595 value1596 ee1597 ww1598 ss1599 modmod1600) (let
((t1601 type1595)) (if (memv t1601 (quote (module-ref))) (let ((val1602 (chi605
val1594 r1574 w1575 mod1577))) (call-with-values (lambda () (value1596 (cons
head1592 tail1593))) (lambda (id1604 mod1605) (build-global-assignment543 s1576
id1604 val1602 mod1605)))) (build-application537 s1576 (chi605 (list (quote
#(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top))
#("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss
modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i"))
#(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? 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 unannotate
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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) head1592) r1574 w1575 mod1577) (map (lambda (e1606)
(chi605 e1606 r1574 w1575 mod1577)) (append tail1593 (list val1594)))))))))
tmp1590) ((lambda (_1608) (syntax-violation (quote set!) "bad set!"
(source-wrap598 e1573 w1575 s1576 mod1577))) tmp1578))) ($sc-dispatch tmp1578
(quote (any (any . each-any) any)))))) ($sc-dispatch tmp1578 (quote (any any
any))))) e1573))) (global-extend567 (quote module-ref) (quote @) (lambda
(e1609) ((lambda (tmp1610) ((lambda (tmp1611) (if (if tmp1611 (apply (lambda
(_1612 mod1613 id1614) (and (and-map id?569 mod1613) (id?569 id1614))) tmp1611)
#f) (apply (lambda (_1616 mod1617 id1618) (values (syntax->datum id1618)
(syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e)
#((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation
ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause
chi-body chi-macro chi-application chi-expr chi chi-top syntax-type
chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) mod1617)))) tmp1611) (syntax-violation #f "source
expression failed to match any pattern" tmp1610))) ($sc-dispatch tmp1610 (quote
(any each-any any))))) e1609))) (global-extend567 (quote module-ref) (quote @@)
(lambda (e1620) ((lambda (tmp1621) ((lambda (tmp1622) (if (if tmp1622 (apply
(lambda (_1623 mod1624 id1625) (and (and-map id?569 mod1624) (id?569 id1625)))
tmp1622) #f) (apply (lambda (_1627 mod1628 id1629) (values (syntax->datum
id1629) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage
#(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation
ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause
chi-body chi-macro chi-application chi-expr chi chi-top syntax-type
chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) mod1628)))) tmp1622) (syntax-violation #f "source
expression failed to match any pattern" tmp1621))) ($sc-dispatch tmp1621 (quote
(any each-any any))))) e1620))) (global-extend567 (quote begin) (quote begin)
(quote ())) (global-extend567 (quote define) (quote define) (quote ()))
(global-extend567 (quote define-syntax) (quote define-syntax) (quote ()))
(global-extend567 (quote eval-when) (quote eval-when) (quote ()))
(global-extend567 (quote core) (quote syntax-case) (letrec
((gen-syntax-case1634 (lambda (x1635 keys1636 clauses1637 r1638 mod1639) (if
(null? clauses1637) (build-application537 #f (build-primref546 #f (quote
syntax-violation)) (list #f "source expression failed to match any pattern"
x1635)) ((lambda (tmp1640) ((lambda (tmp1641) (if tmp1641 (apply (lambda
(pat1642 exp1643) (if (and (id?569 pat1642) (and-map (lambda (x1644) (not
(free-id=?592 pat1642 x1644))) (cons (quote #(syntax-object ... ((top)
#(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage
#(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call
convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
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 unannotate 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 build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) keys1636))) (let ((labels1645 (list (gen-label574)))
(var1646 (gen-var617 pat1642))) (build-application537 #f (build-lambda545 #f
(list (syntax->datum pat1642)) (list var1646) #f (chi605 exp1643 (extend-env563
labels1645 (list (cons (quote syntax) (cons var1646 0))) r1638)
(make-binding-wrap586 (list pat1642) labels1645 (quote (()))) mod1639)) (list
x1635))) (gen-clause1633 x1635 keys1636 (cdr clauses1637) r1638 pat1642 #t
exp1643 mod1639))) tmp1641) ((lambda (tmp1647) (if tmp1647 (apply (lambda
(pat1648 fender1649 exp1650) (gen-clause1633 x1635 keys1636 (cdr clauses1637)
r1638 pat1648 fender1649 exp1650 mod1639)) tmp1647) ((lambda (_1651)
(syntax-violation (quote syntax-case) "invalid clause" (car clauses1637)))
tmp1640))) ($sc-dispatch tmp1640 (quote (any any any)))))) ($sc-dispatch
tmp1640 (quote (any any))))) (car clauses1637))))) (gen-clause1633 (lambda
(x1652 keys1653 clauses1654 r1655 pat1656 fender1657 exp1658 mod1659)
(call-with-values (lambda () (convert-pattern1631 pat1656 keys1653)) (lambda
(p1660 pvars1661) (cond ((not (distinct-bound-ids?595 (map car pvars1661)))
(syntax-violation (quote syntax-case) "duplicate pattern variable" pat1656))
((not (and-map (lambda (x1662) (not (ellipsis?614 (car x1662)))) pvars1661))
(syntax-violation (quote syntax-case) "misplaced ellipsis" pat1656)) (else (let
((y1663 (gen-var617 (quote tmp)))) (build-application537 #f (build-lambda545 #f
(list (quote tmp)) (list y1663) #f (let ((y1664 (build-lexical-reference539
(quote value) #f (quote tmp) y1663))) (build-conditional538 #f ((lambda
(tmp1665) ((lambda (tmp1666) (if tmp1666 (apply (lambda () y1664) tmp1666)
((lambda (_1667) (build-conditional538 #f y1664 (build-dispatch-call1632
pvars1661 fender1657 y1664 r1655 mod1659) (build-data547 #f #f))) tmp1665)))
($sc-dispatch tmp1665 (quote #(atom #t))))) fender1657)
(build-dispatch-call1632 pvars1661 exp1658 y1664 r1655 mod1659)
(gen-syntax-case1634 x1652 keys1653 clauses1654 r1655 mod1659)))) (list (if
(eq? p1660 (quote any)) (build-application537 #f (build-primref546 #f (quote
list)) (list x1652)) (build-application537 #f (build-primref546 #f (quote
$sc-dispatch)) (list x1652 (build-data547 #f p1660)))))))))))))
(build-dispatch-call1632 (lambda (pvars1668 exp1669 y1670 r1671 mod1672) (let
((ids1673 (map car pvars1668)) (levels1674 (map cdr pvars1668))) (let
((labels1675 (gen-labels575 ids1673)) (new-vars1676 (map gen-var617 ids1673)))
(build-application537 #f (build-primref546 #f (quote apply)) (list
(build-lambda545 #f (map syntax->datum ids1673) new-vars1676 #f (chi605 exp1669
(extend-env563 labels1675 (map (lambda (var1677 level1678) (cons (quote syntax)
(cons var1677 level1678))) new-vars1676 (map cdr pvars1668)) r1671)
(make-binding-wrap586 ids1673 labels1675 (quote (()))) mod1672)) y1670))))))
(convert-pattern1631 (lambda (pattern1679 keys1680) (letrec ((cvt1681 (lambda
(p1682 n1683 ids1684) (if (id?569 p1682) (if (bound-id-member?596 p1682
keys1680) (values (vector (quote free-id) p1682) ids1684) (values (quote any)
(cons (cons p1682 n1683) ids1684))) ((lambda (tmp1685) ((lambda (tmp1686) (if
(if tmp1686 (apply (lambda (x1687 dots1688) (ellipsis?614 dots1688)) tmp1686)
#f) (apply (lambda (x1689 dots1690) (call-with-values (lambda () (cvt1681 x1689
(fx+529 n1683 1) ids1684)) (lambda (p1691 ids1692) (values (if (eq? p1691
(quote any)) (quote each-any) (vector (quote each) p1691)) ids1692)))) tmp1686)
((lambda (tmp1693) (if tmp1693 (apply (lambda (x1694 y1695) (call-with-values
(lambda () (cvt1681 y1695 n1683 ids1684)) (lambda (y1696 ids1697)
(call-with-values (lambda () (cvt1681 x1694 n1683 ids1697)) (lambda (x1698
ids1699) (values (cons x1698 y1696) ids1699)))))) tmp1693) ((lambda (tmp1700)
(if tmp1700 (apply (lambda () (values (quote ()) ids1684)) tmp1700) ((lambda
(tmp1701) (if tmp1701 (apply (lambda (x1702) (call-with-values (lambda ()
(cvt1681 x1702 n1683 ids1684)) (lambda (p1704 ids1705) (values (vector (quote
vector) p1704) ids1705)))) tmp1701) ((lambda (x1706) (values (vector (quote
atom) (strip616 p1682 (quote (())))) ids1684)) tmp1685))) ($sc-dispatch tmp1685
(quote #(vector each-any)))))) ($sc-dispatch tmp1685 (quote ())))))
($sc-dispatch tmp1685 (quote (any . any)))))) ($sc-dispatch tmp1685 (quote (any
any))))) p1682))))) (cvt1681 pattern1679 0 (quote ())))))) (lambda (e1707 r1708
w1709 s1710 mod1711) (let ((e1712 (source-wrap598 e1707 w1709 s1710 mod1711)))
((lambda (tmp1713) ((lambda (tmp1714) (if tmp1714 (apply (lambda (_1715 val1716
key1717 m1718) (if (and-map (lambda (x1719) (and (id?569 x1719) (not
(ellipsis?614 x1719)))) key1717) (let ((x1721 (gen-var617 (quote tmp))))
(build-application537 s1710 (build-lambda545 #f (list (quote tmp)) (list x1721)
#f (gen-syntax-case1634 (build-lexical-reference539 (quote value) #f (quote
tmp) x1721) key1717 m1718 r1708 mod1711)) (list (chi605 val1716 r1708 (quote
(())) mod1711)))) (syntax-violation (quote syntax-case) "invalid literals list"
e1712))) tmp1714) (syntax-violation #f "source expression failed to match any
pattern" tmp1713))) ($sc-dispatch tmp1713 (quote (any any each-any .
each-any))))) e1712))))) (set! sc-expand (lambda (x1725 . rest1724) (if (and
(pair? x1725) (equal? (car x1725) noexpand527)) (cadr x1725) (let ((m1726 (if
(null? rest1724) (quote e) (car rest1724))) (esew1727 (if (or (null? rest1724)
(null? (cdr rest1724))) (quote (eval)) (cadr rest1724)))) (with-fluid*
*mode*528 m1726 (lambda () (chi-top604 x1725 (quote ()) (quote ((top))) m1726
esew1727 (cons (quote hygiene) (module-name (current-module)))))))))) (set!
identifier? (lambda (x1728) (nonsymbol-id?568 x1728))) (set! datum->syntax
(lambda (id1729 datum1730) (make-syntax-object552 datum1730
(syntax-object-wrap555 id1729) #f))) (set! syntax->datum (lambda (x1731)
(strip616 x1731 (quote (()))))) (set! generate-temporaries (lambda (ls1732)
(begin (let ((x1733 ls1732)) (if (not (list? x1733)) (syntax-violation (quote
generate-temporaries) "invalid argument" x1733))) (map (lambda (x1734) (wrap597
(gensym) (quote ((top))) #f)) ls1732)))) (set! free-identifier=? (lambda (x1735
y1736) (begin (let ((x1737 x1735)) (if (not (nonsymbol-id?568 x1737))
(syntax-violation (quote free-identifier=?) "invalid argument" x1737))) (let
((x1738 y1736)) (if (not (nonsymbol-id?568 x1738)) (syntax-violation (quote
free-identifier=?) "invalid argument" x1738))) (free-id=?592 x1735 y1736))))
(set! bound-identifier=? (lambda (x1739 y1740) (begin (let ((x1741 x1739)) (if
(not (nonsymbol-id?568 x1741)) (syntax-violation (quote bound-identifier=?)
"invalid argument" x1741))) (let ((x1742 y1740)) (if (not (nonsymbol-id?568
x1742)) (syntax-violation (quote bound-identifier=?) "invalid argument"
x1742))) (bound-id=?593 x1739 y1740)))) (set! syntax-violation (lambda (who1746
message1745 form1744 . subform1743) (begin (let ((x1747 who1746)) (if (not
((lambda (x1748) (or (not x1748) (string? x1748) (symbol? x1748))) x1747))
(syntax-violation (quote syntax-violation) "invalid argument" x1747))) (let
((x1749 message1745)) (if (not (string? x1749)) (syntax-violation (quote
syntax-violation) "invalid argument" x1749))) (scm-error (quote syntax-error)
(quote sc-expand) (string-append (if who1746 "~a: " "") "~a " (if (null?
subform1743) "in ~a" "in subform `~s' of `~s'")) (let ((tail1750 (cons
message1745 (map (lambda (x1751) (strip616 x1751 (quote (())))) (append
subform1743 (list form1744)))))) (if who1746 (cons who1746 tail1750) tail1750))
#f)))) (letrec ((match1756 (lambda (e1757 p1758 w1759 r1760 mod1761) (cond
((not r1760) #f) ((eq? p1758 (quote any)) (cons (wrap597 e1757 w1759 mod1761)
r1760)) ((syntax-object?553 e1757) (match*1755 (let ((e1762
(syntax-object-expression554 e1757))) (if (annotation? e1762)
(annotation-expression e1762) e1762)) p1758 (join-wraps588 w1759
(syntax-object-wrap555 e1757)) r1760 (syntax-object-module556 e1757))) (else
(match*1755 (let ((e1763 e1757)) (if (annotation? e1763) (annotation-expression
e1763) e1763)) p1758 w1759 r1760 mod1761))))) (match*1755 (lambda (e1764 p1765
w1766 r1767 mod1768) (cond ((null? p1765) (and (null? e1764) r1767)) ((pair?
p1765) (and (pair? e1764) (match1756 (car e1764) (car p1765) w1766 (match1756
(cdr e1764) (cdr p1765) w1766 r1767 mod1768) mod1768))) ((eq? p1765 (quote
each-any)) (let ((l1769 (match-each-any1753 e1764 w1766 mod1768))) (and l1769
(cons l1769 r1767)))) (else (let ((t1770 (vector-ref p1765 0))) (if (memv t1770
(quote (each))) (if (null? e1764) (match-empty1754 (vector-ref p1765 1) r1767)
(let ((l1771 (match-each1752 e1764 (vector-ref p1765 1) w1766 mod1768))) (and
l1771 (letrec ((collect1772 (lambda (l1773) (if (null? (car l1773)) r1767 (cons
(map car l1773) (collect1772 (map cdr l1773))))))) (collect1772 l1771))))) (if
(memv t1770 (quote (free-id))) (and (id?569 e1764) (free-id=?592 (wrap597 e1764
w1766 mod1768) (vector-ref p1765 1)) r1767) (if (memv t1770 (quote (atom)))
(and (equal? (vector-ref p1765 1) (strip616 e1764 w1766)) r1767) (if (memv
t1770 (quote (vector))) (and (vector? e1764) (match1756 (vector->list e1764)
(vector-ref p1765 1) w1766 r1767 mod1768))))))))))) (match-empty1754 (lambda
(p1774 r1775) (cond ((null? p1774) r1775) ((eq? p1774 (quote any)) (cons (quote
()) r1775)) ((pair? p1774) (match-empty1754 (car p1774) (match-empty1754 (cdr
p1774) r1775))) ((eq? p1774 (quote each-any)) (cons (quote ()) r1775)) (else
(let ((t1776 (vector-ref p1774 0))) (if (memv t1776 (quote (each)))
(match-empty1754 (vector-ref p1774 1) r1775) (if (memv t1776 (quote (free-id
atom))) r1775 (if (memv t1776 (quote (vector))) (match-empty1754 (vector-ref
p1774 1) r1775))))))))) (match-each-any1753 (lambda (e1777 w1778 mod1779) (cond
((annotation? e1777) (match-each-any1753 (annotation-expression e1777) w1778
mod1779)) ((pair? e1777) (let ((l1780 (match-each-any1753 (cdr e1777) w1778
mod1779))) (and l1780 (cons (wrap597 (car e1777) w1778 mod1779) l1780))))
((null? e1777) (quote ())) ((syntax-object?553 e1777) (match-each-any1753
(syntax-object-expression554 e1777) (join-wraps588 w1778 (syntax-object-wrap555
e1777)) mod1779)) (else #f)))) (match-each1752 (lambda (e1781 p1782 w1783
mod1784) (cond ((annotation? e1781) (match-each1752 (annotation-expression
e1781) p1782 w1783 mod1784)) ((pair? e1781) (let ((first1785 (match1756 (car
e1781) p1782 w1783 (quote ()) mod1784))) (and first1785 (let ((rest1786
(match-each1752 (cdr e1781) p1782 w1783 mod1784))) (and rest1786 (cons
first1785 rest1786)))))) ((null? e1781) (quote ())) ((syntax-object?553 e1781)
(match-each1752 (syntax-object-expression554 e1781) p1782 (join-wraps588 w1783
(syntax-object-wrap555 e1781)) (syntax-object-module556 e1781))) (else #f)))))
(set! $sc-dispatch (lambda (e1787 p1788) (cond ((eq? p1788 (quote any)) (list
e1787)) ((syntax-object?553 e1787) (match*1755 (let ((e1789
(syntax-object-expression554 e1787))) (if (annotation? e1789)
(annotation-expression e1789) e1789)) p1788 (syntax-object-wrap555 e1787)
(quote ()) (syntax-object-module556 e1787))) (else (match*1755 (let ((e1790
e1787)) (if (annotation? e1790) (annotation-expression e1790) e1790)) p1788
(quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x1791) ((lambda
(tmp1792) ((lambda (tmp1793) (if tmp1793 (apply (lambda (_1794 e11795 e21796)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11795 e21796))) tmp1793) ((lambda (tmp1798) (if
tmp1798 (apply (lambda (_1799 out1800 in1801 e11802 e21803) (list (quote
#(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) in1801 (quote ()) (list out1800 (cons
(quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons e11802 e21803))))) tmp1798) ((lambda
(tmp1805) (if tmp1805 (apply (lambda (_1806 out1807 in1808 e11809 e21810) (list
(quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top)
(top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list
((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) in1808) (quote ()) (list out1807 (cons (quote #(syntax-object begin
((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (cons e11809 e21810))))) tmp1805) (syntax-violation #f "source
expression failed to match any pattern" tmp1792))) ($sc-dispatch tmp1792 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1792 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp1792 (quote (any () any .
each-any))))) x1791))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1814)
((lambda (tmp1815) ((lambda (tmp1816) (if tmp1816 (apply (lambda (_1817 k1818
keyword1819 pattern1820 template1821) (list (quote #(syntax-object lambda
((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top))
#("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k
keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))
(cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern
template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote
#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top)
(top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons k1818 (map (lambda (tmp1824
tmp1823) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k
keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
tmp1823) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword
pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
tmp1824))) template1821 pattern1820)))))) tmp1816) (syntax-violation #f "source
expression failed to match any pattern" tmp1815))) ($sc-dispatch tmp1815 (quote
(any each-any . #(each ((any . any) any))))))) x1814))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x1825) ((lambda (tmp1826) ((lambda (tmp1827) (if
(if tmp1827 (apply (lambda (let*1828 x1829 v1830 e11831 e21832) (and-map
identifier? x1829)) tmp1827) #f) (apply (lambda (let*1834 x1835 v1836 e11837
e21838) (letrec ((f1839 (lambda (bindings1840) (if (null? bindings1840) (cons
(quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings)
#((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e11837 e21838)))
((lambda (tmp1844) ((lambda (tmp1845) (if tmp1845 (apply (lambda (body1846
binding1847) (list (quote #(syntax-object let ((top) #(ribcage #(body binding)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top)
(top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (list binding1847) body1846)) tmp1845) (syntax-violation #f
"source expression failed to match any pattern" tmp1844))) ($sc-dispatch
tmp1844 (quote (any any))))) (list (f1839 (cdr bindings1840)) (car
bindings1840))))))) (f1839 (map list x1835 v1836)))) tmp1827) (syntax-violation
#f "source expression failed to match any pattern" tmp1826))) ($sc-dispatch
tmp1826 (quote (any #(each (any any)) any . each-any))))) x1825))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x1848) ((lambda (tmp1849) ((lambda (tmp1850)
(if tmp1850 (apply (lambda (_1851 var1852 init1853 step1854 e01855 e11856
c1857) ((lambda (tmp1858) ((lambda (tmp1859) (if tmp1859 (apply (lambda
(step1860) ((lambda (tmp1861) ((lambda (tmp1862) (if tmp1862 (apply (lambda ()
(list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i"))
#(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x)
#((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top)
#(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top)
(top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list
var1852 init1853) (list (quote #(syntax-object if ((top) #(ribcage #(step)
#((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ())
#(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var
init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i"
"i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")))
(hygiene guile))) e01855) (cons (quote #(syntax-object begin ((top) #(ribcage
#(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top)
(top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () ()
()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c1857 (list
(cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i"))
#(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x)
#((top)) #("i"))) (hygiene guile))) step1860))))))) tmp1862) ((lambda (tmp1867)
(if tmp1867 (apply (lambda (e11868 e21869) (list (quote #(syntax-object let
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var1852 init1853) (list
(quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i"))
#(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top)
(top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e01855 (cons
(quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i"
"i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c)
#((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile)))
(cons e11868 e21869)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1
e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_
var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i"
"i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")))
(hygiene guile))) (append c1857 (list (cons (quote #(syntax-object doloop
((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top))
#("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top)
(top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(orig-x) #((top)) #("i"))) (hygiene guile))) step1860))))))) tmp1867)
(syntax-violation #f "source expression failed to match any pattern" tmp1861)))
($sc-dispatch tmp1861 (quote (any . each-any)))))) ($sc-dispatch tmp1861 (quote
())))) e11856)) tmp1859) (syntax-violation #f "source expression failed to
match any pattern" tmp1858))) ($sc-dispatch tmp1858 (quote each-any)))) (map
(lambda (v1876 s1877) ((lambda (tmp1878) ((lambda (tmp1879) (if tmp1879 (apply
(lambda () v1876) tmp1879) ((lambda (tmp1880) (if tmp1880 (apply (lambda
(e1881) e1881) tmp1880) ((lambda (_1882) (syntax-violation (quote do) "bad step
expression" orig-x1848 s1877)) tmp1878))) ($sc-dispatch tmp1878 (quote
(any)))))) ($sc-dispatch tmp1878 (quote ())))) s1877)) var1852 step1854)))
tmp1850) (syntax-violation #f "source expression failed to match any pattern"
tmp1849))) ($sc-dispatch tmp1849 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x1848))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons1885 (lambda (x1889 y1890)
((lambda (tmp1891) ((lambda (tmp1892) (if tmp1892 (apply (lambda (x1893 y1894)
((lambda (tmp1895) ((lambda (tmp1896) (if tmp1896 (apply (lambda (dy1897)
((lambda (tmp1898) ((lambda (tmp1899) (if tmp1899 (apply (lambda (dx1900) (list
(quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage
#(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile))) (cons dx1900 dy1897))) tmp1899) ((lambda
(_1901) (if (null? dy1897) (list (quote #(syntax-object list ((top) #(ribcage
#(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y)
#((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi)
#((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1893) (list
(quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage
#(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage ()
() ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile))) x1893 y1894))) tmp1898))) ($sc-dispatch
tmp1898 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top))
#("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) any))))) x1893)) tmp1896) ((lambda (tmp1902) (if
tmp1902 (apply (lambda (stuff1903) (cons (quote #(syntax-object list ((top)
#(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i"
"i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top)
(top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x1893 stuff1903))) tmp1902)
((lambda (else1904) (list (quote #(syntax-object cons ((top) #(ribcage #(else)
#((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) x1893 y1894)) tmp1895))) ($sc-dispatch tmp1895
(quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any))))))
($sc-dispatch tmp1895 (quote (#(free-id #(syntax-object quote ((top) #(ribcage
#(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) any))))) y1894)) tmp1892) (syntax-violation #f "source expression
failed to match any pattern" tmp1891))) ($sc-dispatch tmp1891 (quote (any
any))))) (list x1889 y1890)))) (quasiappend1886 (lambda (x1905 y1906) ((lambda
(tmp1907) ((lambda (tmp1908) (if tmp1908 (apply (lambda (x1909 y1910) ((lambda
(tmp1911) ((lambda (tmp1912) (if tmp1912 (apply (lambda () x1909) tmp1912)
((lambda (_1913) (list (quote #(syntax-object append ((top) #(ribcage #(_)
#((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) x1909 y1910)) tmp1911))) ($sc-dispatch tmp1911
(quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top)
(top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y1910))
tmp1908) (syntax-violation #f "source expression failed to match any pattern"
tmp1907))) ($sc-dispatch tmp1907 (quote (any any))))) (list x1905 y1906))))
(quasivector1887 (lambda (x1914) ((lambda (tmp1915) ((lambda (x1916) ((lambda
(tmp1917) ((lambda (tmp1918) (if tmp1918 (apply (lambda (x1919) (list (quote
#(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x)
#((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector
x1919))) tmp1918) ((lambda (tmp1921) (if tmp1921 (apply (lambda (x1922) (cons
(quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage
#(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top)
(top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x1922)) tmp1921)
((lambda (_1924) (list (quote #(syntax-object list->vector ((top) #(ribcage
#(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) x1916)) tmp1917))) ($sc-dispatch tmp1917 (quote (#(free-id
#(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) . each-any)))))) ($sc-dispatch tmp1917 (quote (#(free-id
#(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) each-any))))) x1916)) tmp1915)) x1914))) (quasi1888 (lambda
(p1925 lev1926) ((lambda (tmp1927) ((lambda (tmp1928) (if tmp1928 (apply
(lambda (p1929) (if (= lev1926 0) p1929 (quasicons1885 (quote (#(syntax-object
quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p
lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector
quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))
#(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile)))) (quasi1888 (list p1929) (- lev1926 1))))) tmp1928) ((lambda
(tmp1930) (if tmp1930 (apply (lambda (p1931 q1932) (if (= lev1926 0)
(quasiappend1886 p1931 (quasi1888 q1932 lev1926)) (quasicons1885 (quasicons1885
(quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top)
#(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p
lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector
quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))))
(quasi1888 (list p1931) (- lev1926 1))) (quasi1888 q1932 lev1926)))) tmp1930)
((lambda (tmp1933) (if tmp1933 (apply (lambda (p1934) (quasicons1885 (quote
(#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i"))
#(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top))
#("i" "i" "i" "i"))) (hygiene guile)))) (quasi1888 (list p1934) (+ lev1926
1)))) tmp1933) ((lambda (tmp1935) (if tmp1935 (apply (lambda (p1936 q1937)
(quasicons1885 (quasi1888 p1936 lev1926) (quasi1888 q1937 lev1926))) tmp1935)
((lambda (tmp1938) (if tmp1938 (apply (lambda (x1939) (quasivector1887
(quasi1888 x1939 lev1926))) tmp1938) ((lambda (p1941) (list (quote
#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons
quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))
(hygiene guile))) p1941)) tmp1927))) ($sc-dispatch tmp1927 (quote #(vector
each-any)))))) ($sc-dispatch tmp1927 (quote (any . any)))))) ($sc-dispatch
tmp1927 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ())
#(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend
quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene
guile))) any)))))) ($sc-dispatch tmp1927 (quote ((#(free-id #(syntax-object
unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top))
#("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top)
(top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any))))))
($sc-dispatch tmp1927 (quote (#(free-id #(syntax-object unquote ((top)
#(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage
#(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i"
"i" "i"))) (hygiene guile))) any))))) p1925)))) (lambda (x1942) ((lambda
(tmp1943) ((lambda (tmp1944) (if tmp1944 (apply (lambda (_1945 e1946)
(quasi1888 e1946 0)) tmp1944) (syntax-violation #f "source expression failed to
match any pattern" tmp1943))) ($sc-dispatch tmp1943 (quote (any any)))))
x1942)))))
+(define include (make-syncase-macro (quote macro) (lambda (x1947) (letrec
((read-file1948 (lambda (fn1949 k1950) (let ((p1951 (open-input-file fn1949)))
(letrec ((f1952 (lambda (x1953) (if (eof-object? x1953) (begin
(close-input-port p1951) (quote ())) (cons (datum->syntax k1950 x1953) (f1952
(read p1951))))))) (f1952 (read p1951))))))) ((lambda (tmp1954) ((lambda
(tmp1955) (if tmp1955 (apply (lambda (k1956 filename1957) (let ((fn1958
(syntax->datum filename1957))) ((lambda (tmp1959) ((lambda (tmp1960) (if
tmp1960 (apply (lambda (exp1961) (cons (quote #(syntax-object begin ((top)
#(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i"
"i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) exp1961)) tmp1960) (syntax-violation #f "source expression
failed to match any pattern" tmp1959))) ($sc-dispatch tmp1959 (quote
each-any)))) (read-file1948 fn1958 k1956)))) tmp1955) (syntax-violation #f
"source expression failed to match any pattern" tmp1954))) ($sc-dispatch
tmp1954 (quote (any any))))) x1947)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x1963) ((lambda
(tmp1964) ((lambda (tmp1965) (if tmp1965 (apply (lambda (_1966 e1967)
(syntax-violation (quote unquote) "expression not valid outside of quasiquote"
x1963)) tmp1965) (syntax-violation #f "source expression failed to match any
pattern" tmp1964))) ($sc-dispatch tmp1964 (quote (any any))))) x1963))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1968)
((lambda (tmp1969) ((lambda (tmp1970) (if tmp1970 (apply (lambda (_1971 e1972)
(syntax-violation (quote unquote-splicing) "expression not valid outside of
quasiquote" x1968)) tmp1970) (syntax-violation #f "source expression failed to
match any pattern" tmp1969))) ($sc-dispatch tmp1969 (quote (any any)))))
x1968))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x1973) ((lambda (tmp1974) ((lambda (tmp1975) (if
tmp1975 (apply (lambda (_1976 e1977 m11978 m21979) ((lambda (tmp1980) ((lambda
(body1981) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top))
#("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list
(list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e1977)) body1981))
tmp1980)) (letrec ((f1982 (lambda (clause1983 clauses1984) (if (null?
clauses1984) ((lambda (tmp1986) ((lambda (tmp1987) (if tmp1987 (apply (lambda
(e11988 e21989) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11988 e21989))) tmp1987) ((lambda (tmp1991) (if
tmp1991 (apply (lambda (k1992 e11993 e21994) (list (quote #(syntax-object if
((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i"
"i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top))
#("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
(quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i"
"i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i"
"i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top)
(top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) k1992)) (cons (quote #(syntax-object begin ((top) #(ribcage
#(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2)
#((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) (cons e11993 e21994)))) tmp1991)
((lambda (_1997) (syntax-violation (quote case) "bad clause" x1973 clause1983))
tmp1986))) ($sc-dispatch tmp1986 (quote (each-any any . each-any))))))
($sc-dispatch tmp1986 (quote (#(free-id #(syntax-object else ((top) #(ribcage
() () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any .
each-any))))) clause1983) ((lambda (tmp1998) ((lambda (rest1999) ((lambda
(tmp2000) ((lambda (tmp2001) (if tmp2001 (apply (lambda (k2002 e12003 e22004)
(list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
#(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ())
#(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object
memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
#(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses)
#((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top)
(top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top)
(top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () ()
()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage
() () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote
#(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i"
"i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f
clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2)
#((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage
#(x) #((top)) #("i"))) (hygiene guile))) k2002)) (cons (quote #(syntax-object
begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause
clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top)
(top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x)
#((top)) #("i"))) (hygiene guile))) (cons e12003 e22004)) rest1999)) tmp2001)
((lambda (_2007) (syntax-violation (quote case) "bad clause" x1973 clause1983))
tmp2000))) ($sc-dispatch tmp2000 (quote (each-any any . each-any)))))
clause1983)) tmp1998)) (f1982 (car clauses1984) (cdr clauses1984))))))) (f1982
m11978 m21979)))) tmp1975) (syntax-violation #f "source expression failed to
match any pattern" tmp1974))) ($sc-dispatch tmp1974 (quote (any any any .
each-any))))) x1973))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2008)
((lambda (tmp2009) ((lambda (tmp2010) (if tmp2010 (apply (lambda (_2011 e2012)
(list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))
(list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
(quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list
(quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))
e2012)) (list (cons _2011 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e2012 (quote (#(syntax-object x ((top) #(ribcage #(_ e)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene
guile)))))))))) tmp2010) (syntax-violation #f "source expression failed to
match any pattern" tmp2009))) ($sc-dispatch tmp2009 (quote (any any)))))
x2008))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index ebdb437..fd7ad59 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -434,9 +434,9 @@
(else `(define ,var ,exp)))))
(define build-lambda
- (lambda (src vars docstring exp)
+ (lambda (src ids vars docstring exp)
(case (fluid-ref *mode*)
- ((c) ((@ (language tree-il) make-lambda) src vars
+ ((c) ((@ (language tree-il) make-lambda) src ids vars
(if docstring `((documentation . ,docstring)) '())
exp))
(else `(lambda ,vars ,@(if docstring (list docstring) '())
@@ -465,30 +465,34 @@
(else `(begin ,@exps))))))
(define build-let
- (lambda (src vars val-exps body-exp)
+ (lambda (src ids vars val-exps body-exp)
(if (null? vars)
body-exp
(case (fluid-ref *mode*)
- ((c) ((@ (language tree-il) make-let) src vars val-exps body-exp))
+ ((c) ((@ (language tree-il) make-let) src ids vars val-exps
body-exp))
(else `(let ,(map list vars val-exps) ,body-exp))))))
(define build-named-let
- (lambda (src vars val-exps body-exp)
+ (lambda (src ids vars val-exps body-exp)
(let ((f (car vars))
- (vars (cdr vars)))
+ (f-name (car ids))
+ (vars (cdr vars))
+ (ids (cdr ids)))
(case (fluid-ref *mode*)
((c) ((@ (language tree-il) make-letrec) src
- (list f) (list (build-lambda src vars #f body-exp))
- (build-application src (build-lexical-reference 'fun src f f)
+ (list f-name)
+ (list f)
+ (list (build-lambda src ids vars #f body-exp))
+ (build-application src (build-lexical-reference 'fun src f-name
f)
val-exps)))
(else `(let ,f ,(map list vars val-exps) ,body-exp))))))
(define build-letrec
- (lambda (src vars val-exps body-exp)
+ (lambda (src ids vars val-exps body-exp)
(if (null? vars)
body-exp
(case (fluid-ref *mode*)
- ((c) ((@ (language tree-il) make-letrec) src vars val-exps body-exp))
+ ((c) ((@ (language tree-il) make-letrec) src ids vars val-exps
body-exp))
(else `(letrec ,(map list vars val-exps) ,body-exp))))))
;; FIXME: wingo: use make-lexical ?
@@ -1390,6 +1394,7 @@
(loop (cdr bs) er-cache r-cache)))))
(set-cdr! r (extend-env labels bindings (cdr r)))
(build-letrec no-source
+ (map syntax->datum ids)
vars
(map (lambda (x)
(chi (cdr x) (car x) empty-wrap mod))
@@ -1412,7 +1417,8 @@
(syntax-violation 'lambda "invalid parameter list" e)
(let ((labels (gen-labels ids))
(new-vars (map gen-var ids)))
- (k new-vars
+ (k (map syntax->datum ids)
+ new-vars
docstring
(chi-body (syntax (e1 e2 ...))
e
@@ -1425,7 +1431,11 @@
(syntax-violation 'lambda "invalid parameter list" e)
(let ((labels (gen-labels old-ids))
(new-vars (map gen-var old-ids)))
- (k (let f ((ls1 (cdr new-vars)) (ls2 (car new-vars)))
+ (k (let f ((ls1 (cdr old-ids)) (ls2 (car old-ids)))
+ (if (null? ls1)
+ (syntax->datum ls2)
+ (f (cdr ls1) (cons (syntax->datum (car ls1)) ls2))))
+ (let f ((ls1 (cdr new-vars)) (ls2 (car new-vars)))
(if (null? ls1)
ls2
(f (cdr ls1) (cons (car ls1) ls2))))
@@ -1747,7 +1757,7 @@
((ref) (build-lexical-reference 'value no-source (cadr x) (cadr x)))
((primitive) (build-primref no-source (cadr x)))
((quote) (build-data no-source (cadr x)))
- ((lambda) (build-lambda no-source (cadr x) #f (regen (caddr x))))
+ ((lambda) (build-lambda no-source (cadr x) (cadr x) #f (regen (caddr
x))))
((map) (let ((ls (map regen (cdr x))))
(build-application no-source
;; this check used to be here, not sure what for:
@@ -1773,7 +1783,8 @@
(syntax-case e ()
((_ . c)
(chi-lambda-clause (source-wrap e w s mod) #f (syntax c) r w mod
- (lambda (vars docstring body) (build-lambda s vars docstring
body)))))))
+ (lambda (names vars docstring body)
+ (build-lambda s names vars docstring body)))))))
(global-extend 'core 'let
@@ -1786,6 +1797,7 @@
(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) (chi x r w mod)) vals)
(chi-body exps (source-wrap e nw s mod)
@@ -1820,6 +1832,7 @@
(let ((w (make-binding-wrap ids labels w))
(r (extend-var-env labels new-vars r)))
(build-letrec s
+ (map syntax->datum ids)
new-vars
(map (lambda (x) (chi x r w mod)) (syntax (val ...)))
(chi-body (syntax (e1 e2 ...))
@@ -1930,7 +1943,7 @@
(let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
(build-application no-source
(build-primref no-source 'apply)
- (list (build-lambda no-source new-vars #f
+ (list (build-lambda no-source (map syntax->datum ids) new-vars #f
(chi exp
(extend-env
labels
@@ -1957,7 +1970,7 @@
(let ((y (gen-var 'tmp)))
; fat finger binding and references to temp variable y
(build-application no-source
- (build-lambda no-source (list y) #f
+ (build-lambda no-source (list 'tmp) (list y) #f
(let ((y (build-lexical-reference 'value no-source
'tmp y)))
(build-conditional no-source
@@ -1991,7 +2004,9 @@
(let ((labels (list (gen-label)))
(var (gen-var (syntax pat))))
(build-application no-source
- (build-lambda no-source (list var) #f
+ (build-lambda no-source
+ (list (syntax->datum (syntax pat))) (list
var)
+ #f
(chi (syntax exp)
(extend-env labels
(list (make-binding 'syntax `(,var . 0)))
@@ -2017,7 +2032,7 @@
(let ((x (gen-var 'tmp)))
; fat finger binding and references to temp variable x
(build-application s
- (build-lambda no-source (list x) #f
+ (build-lambda no-source (list 'tmp) (list x) #f
(gen-syntax-case (build-lexical-reference 'value no-source
'tmp x)
(syntax (key ...)) (syntax (m ...))
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index c9857ac..9b36f18 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -35,11 +35,11 @@
<toplevel-ref> toplevel-ref? make-toplevel-ref toplevel-ref-src
toplevel-ref-name
<toplevel-set> toplevel-set? make-toplevel-set toplevel-set-src
toplevel-set-name toplevel-set-exp
<toplevel-define> toplevel-define? make-toplevel-define
toplevel-define-src toplevel-define-name toplevel-define-exp
- <lambda> lambda? make-lambda lambda-src lambda-vars lambda-meta
lambda-body
+ <lambda> lambda? make-lambda lambda-src lambda-names lambda-vars
lambda-meta lambda-body
<const> const? make-const const-src const-exp
<sequence> sequence? make-sequence sequence-src sequence-exps
- <let> let? make-let let-src let-vars let-vals let-exp
- <letrec> letrec? make-letrec letrec-src letrec-vars letrec-vals
letrec-exp
+ <let> let? make-let let-src let-names let-vars let-vals let-exp
+ <letrec> letrec? make-letrec letrec-src letrec-names letrec-vars
letrec-vals letrec-exp
parse-tree-il
unparse-tree-il
@@ -60,11 +60,11 @@
(<toplevel-ref> name)
(<toplevel-set> name exp)
(<toplevel-define> name exp)
- (<lambda> vars meta body)
+ (<lambda> names vars meta body)
(<const> exp)
(<sequence> exps)
- (<let> vars vals exp)
- (<letrec> vars vals exp))
+ (<let> names vars vals exp)
+ (<letrec> names vars vals exp))
(define <lexical> <lexical-ref>)
(define lexical? lexical-ref?)
@@ -129,11 +129,11 @@
((define ,name exp) (guard (symbol? name))
(make-toplevel-define loc name (retrans exp)))
- ((lambda ,vars ,exp)
- (make-lambda loc vars '() (retrans exp)))
+ ((lambda ,names ,vars ,exp)
+ (make-lambda loc names vars '() (retrans exp)))
- ((lambda ,vars ,meta ,exp)
- (make-lambda loc vars meta (retrans exp)))
+ ((lambda ,names ,vars ,meta ,exp)
+ (make-lambda loc names vars meta (retrans exp)))
((const ,exp)
(make-const loc exp))
@@ -141,11 +141,11 @@
((begin . ,exps)
(make-sequence loc (map retrans exps)))
- ((let ,vars ,vals ,exp)
- (make-let loc vars vals (retrans exp)))
+ ((let ,names ,vars ,vals ,exp)
+ (make-let loc names vars vals (retrans exp)))
- ((letrec ,vars ,vals ,exp)
- (make-letrec loc vars vals (retrans exp)))
+ ((letrec ,names ,vars ,vals ,exp)
+ (make-letrec loc names vars vals (retrans exp)))
(else
(error "unrecognized tree-il" exp)))))
@@ -185,8 +185,8 @@
((<toplevel-define> name exp)
`(define ,name ,(unparse-tree-il exp)))
- ((<lambda> vars meta body)
- `(lambda ,vars ,meta ,(unparse-tree-il body)))
+ ((<lambda> names vars meta body)
+ `(lambda ,names ,vars ,meta ,(unparse-tree-il body)))
((<const> exp)
`(const ,exp))
@@ -194,11 +194,11 @@
((<sequence> exps)
`(begin ,@(map unparse-tree-il exps)))
- ((<let> vars vals exp)
- `(let ,vars ,(map unparse-tree-il vals) ,(unparse-tree-il exp)))
+ ((<let> names vars vals exp)
+ `(let ,names ,vars ,(map unparse-tree-il vals) ,(unparse-tree-il exp)))
- ((<letrec> vars vals exp)
- `(letrec ,vars ,(map unparse-tree-il vals) ,(unparse-tree-il exp)))))
+ ((<letrec> names vars vals exp)
+ `(letrec ,names ,vars ,(map unparse-tree-il vals) ,(unparse-tree-il
exp)))))
(define (tree-il->scheme e)
(cond ((list? e)
diff --git a/module/language/tree-il/compile-glil.scm
b/module/language/tree-il/compile-glil.scm
index 2b24100..29a9ee9 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -33,7 +33,7 @@
;; lambda -> (nlocs . nexts)
(define (compile-glil x e opts)
- (let* ((x (make-lambda (tree-il-src x) '() '() x))
+ (let* ((x (make-lambda (tree-il-src x) '() '() '() x))
(x (optimize! x e opts))
(allocation (analyze-lexicals x)))
(values (flatten-lambda x -1 allocation)
@@ -44,18 +44,20 @@
(define (make-label) (gensym ":L"))
-(define (vars->bind-list vars allocation)
- (map (lambda (v)
+(define (vars->bind-list ids vars allocation)
+ (map (lambda (id v)
(let ((loc (hashq-ref allocation v)))
(case (car loc)
- ((stack) (list v 'local (cdr loc)))
- ((heap) (list v 'external (cddr loc)))
- (else (error "badness" v loc)))))
+ ((stack) (list id 'local (cdr loc)))
+ ((heap) (list id 'external (cddr loc)))
+ (else (error "badness" id v loc)))))
+ ids
vars))
-(define (emit-bindings src vars allocation emit-code)
+(define (emit-bindings src ids vars allocation emit-code)
(if (pair? vars)
- (emit-code src (make-glil-bind (vars->bind-list vars allocation)))))
+ (emit-code src (make-glil-bind
+ (vars->bind-list ids vars allocation)))))
(define (with-output-to-code proc)
(let ((out '()))
@@ -67,11 +69,16 @@
(reverse out)))
(define (flatten-lambda x level allocation)
- (receive (vars nargs nrest)
- (let lp ((vars (lambda-vars x)) (out '()) (n 0))
- (cond ((null? vars) (values (reverse out) n 0))
- ((pair? vars) (lp (cdr vars) (cons (car vars) out) (1+ n)))
- (else (values (reverse (cons vars out)) (1+ n) 1))))
+ (receive (ids vars nargs nrest)
+ (let lp ((ids (lambda-names x)) (vars (lambda-vars x))
+ (oids '()) (ovars '()) (n 0))
+ (cond ((null? vars) (values (reverse oids) (reverse ovars) n 0))
+ ((pair? vars) (lp (cdr ids) (cdr vars)
+ (cons (car ids) oids) (cons (car vars) ovars)
+ (1+ n)))
+ (else (values (reverse (cons ids oids))
+ (reverse (cons vars ovars))
+ (1+ n) 1))))
(let ((nlocs (car (hashq-ref allocation x)))
(nexts (cdr (hashq-ref allocation x))))
(make-glil-program
@@ -79,7 +86,7 @@
(with-output-to-code
(lambda (emit-code)
;; write bindings and source debugging info
- (emit-bindings #f vars allocation emit-code)
+ (emit-bindings #f ids vars allocation emit-code)
(if (lambda-src x)
(emit-code (make-glil-src (lambda-src x))))
@@ -246,9 +253,9 @@
(emit-code #f (flatten-lambda x level allocation))
(emit-code #f (make-glil-call 'return 1)))))
- ((<let> src vars vals exp)
+ ((<let> src names vars vals exp)
(for-each comp-push vals)
- (emit-bindings src vars allocation emit-code)
+ (emit-bindings src names vars allocation emit-code)
(for-each (lambda (v)
(let ((loc (hashq-ref allocation v)))
(case (car loc)
@@ -261,9 +268,9 @@
(comp-tail exp)
(emit-code #f (make-glil-unbind)))
- ((<letrec> src vars vals exp)
+ ((<letrec> src names vars vals exp)
(for-each comp-push vals)
- (emit-bindings src vars allocation emit-code)
+ (emit-bindings src names vars allocation emit-code)
(for-each (lambda (v)
(let ((loc (hashq-ref allocation v)))
(case (car loc)
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 2ce77f2d95271887b54d0c56d1e81d7f472ae1ae,
Andy Wingo <=