[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. a23c940b717413139d294
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. a23c940b717413139d294d4f5c443b8d165f42a9 |
|
Date: |
Fri, 05 Jun 2009 22:31:44 +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=a23c940b717413139d294d4f5c443b8d165f42a9
The branch, master has been updated
via a23c940b717413139d294d4f5c443b8d165f42a9 (commit)
from 8a8d0ca2fdc202ffef620fd7d8961a4d43ea9c95 (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 a23c940b717413139d294d4f5c443b8d165f42a9
Author: Andy Wingo <address@hidden>
Date: Sat Jun 6 00:29:05 2009 +0200
support ((@ ...) ...) where the car is a macro
* module/ice-9/psyntax.scm (syntax-type): Remove `external-macro', not
used any more. Take an extra arg, `for-car?', indicating that we're
checking on the type of a form in the car position. In the case that
the expression is a pair, do a full recursion on the car, which allows
us to catch the fact that the car of the following form is a macro:
((@ (ice-9 optargs) let-optional) ...)
and thus the form itself should be macroexpanded.
But, since we want to distingush `lambda' from `(lambda ...)', just as
we have global and global-call, we have core to the new `core-form'.
(chi-top, chi, chi-expr, chi-body, set!): Adapt to changes to
syntax-type.
-----------------------------------------------------------------------
Summary of changes:
module/ice-9/psyntax-pp.scm | 22 ++++----
module/ice-9/psyntax.scm | 136 +++++++++++++++++++++++--------------------
2 files changed, 83 insertions(+), 75 deletions(-)
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index f33f492..0043cbb 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*151 (lambda (f191 first190 . rest189) (let ((t192 (null?
first190))) (if t192 t192 (if (null? rest189) (letrec ((andmap193 (lambda
(first194) (let ((x195 (car first194)) (first196 (cdr first194))) (if (null?
first196) (f191 x195) (if (f191 x195) (andmap193 first196) #f)))))) (andmap193
first190)) (letrec ((andmap197 (lambda (first198 rest199) (let ((x200 (car
first198)) (xr201 (map car rest199)) (first202 (cdr first198)) (rest203 (map
cdr rest199))) (if (null? first202) (apply f191 (cons x200 xr201)) (if (apply
f191 (cons x200 xr201)) (andmap197 first202 rest203) #f)))))) (andmap197
first190 rest189)))))))) (letrec ((lambda-var-list296 (lambda (vars420) (letrec
((lvl421 (lambda (vars422 ls423 w424) (if (pair? vars422) (lvl421 (cdr vars422)
(cons (wrap276 (car vars422) w424 #f) ls423) w424) (if (id?248 vars422) (cons
(wrap276 vars422 w424 #f) ls423) (if (null? vars422) ls423 (if
(syntax-object?232 vars422) (lvl421 (syntax-object-expression233 vars422) ls423
(join-wraps267 w424 (syntax-object-wrap234 vars422))) (cons vars422
ls423)))))))) (lvl421 vars420 (quote ()) (quote (())))))) (gen-var295 (lambda
(id425) (let ((id426 (if (syntax-object?232 id425) (syntax-object-expression233
id425) id425))) (gensym (symbol->string id426))))) (strip294 (lambda (x427
w428) (if (memq (quote top) (wrap-marks251 w428)) x427 (letrec ((f429 (lambda
(x430) (if (syntax-object?232 x430) (strip294 (syntax-object-expression233
x430) (syntax-object-wrap234 x430)) (if (pair? x430) (let ((a431 (f429 (car
x430))) (d432 (f429 (cdr x430)))) (if (if (eq? a431 (car x430)) (eq? d432 (cdr
x430)) #f) x430 (cons a431 d432))) (if (vector? x430) (let ((old433
(vector->list x430))) (let ((new434 (map f429 old433))) (if (and-map*151 eq?
old433 new434) x430 (list->vector new434)))) x430)))))) (f429 x427)))))
(ellipsis?293 (lambda (x435) (if (nonsymbol-id?247 x435) (free-id=?271 x435
(quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip
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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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)))) #f))) (chi-void292 (lambda ()
(build-void214 #f))) (eval-local-transformer291 (lambda (expanded436 mod437)
(let ((p438 (local-eval-hook211 expanded436 mod437))) (if (procedure? p438)
p438 (syntax-violation #f "nonprocedure transformer" p438)))))
(chi-local-syntax290 (lambda (rec?439 e440 r441 w442 s443 mod444 k445) ((lambda
(tmp446) ((lambda (tmp447) (if tmp447 (apply (lambda (_448 id449 val450 e1451
e2452) (let ((ids453 id449)) (if (not (valid-bound-ids?273 ids453))
(syntax-violation #f "duplicate bound keyword" e440) (let ((labels455
(gen-labels254 ids453))) (let ((new-w456 (make-binding-wrap265 ids453 labels455
w442))) (k445 (cons e1451 e2452) (extend-env242 labels455 (let ((w458 (if
rec?439 new-w456 w442)) (trans-r459 (macros-only-env244 r441))) (map (lambda
(x460) (cons (quote macro) (eval-local-transformer291 (chi284 x460 trans-r459
w458 mod444) mod444))) val450)) r441) new-w456 s443 mod444)))))) tmp447)
((lambda (_462) (syntax-violation #f "bad local syntax definition"
(source-wrap277 e440 w442 s443 mod444))) tmp446))) ($sc-dispatch tmp446 (quote
(any #(each (any any)) any . each-any))))) e440))) (chi-lambda-clause289
(lambda (e463 docstring464 c465 r466 w467 mod468 k469) ((lambda (tmp470)
((lambda (tmp471) (if (if tmp471 (apply (lambda (args472 doc473 e1474 e2475)
(if (string? (syntax->datum doc473)) (not docstring464) #f)) tmp471) #f) (apply
(lambda (args476 doc477 e1478 e2479) (chi-lambda-clause289 e463 doc477 (cons
args476 (cons e1478 e2479)) r466 w467 mod468 k469)) tmp471) ((lambda (tmp481)
(if tmp481 (apply (lambda (id482 e1483 e2484) (let ((ids485 id482)) (if (not
(valid-bound-ids?273 ids485)) (syntax-violation (quote lambda) "invalid
parameter list" e463) (let ((labels487 (gen-labels254 ids485)) (new-vars488
(map gen-var295 ids485))) (k469 (map syntax->datum ids485) new-vars488 (if
docstring464 (syntax->datum docstring464) #f) (chi-body288 (cons e1483 e2484)
e463 (extend-var-env243 labels487 new-vars488 r466) (make-binding-wrap265
ids485 labels487 w467) mod468)))))) tmp481) ((lambda (tmp490) (if tmp490 (apply
(lambda (ids491 e1492 e2493) (let ((old-ids494 (lambda-var-list296 ids491)))
(if (not (valid-bound-ids?273 old-ids494)) (syntax-violation (quote lambda)
"invalid parameter list" e463) (let ((labels495 (gen-labels254 old-ids494))
(new-vars496 (map gen-var295 old-ids494))) (k469 (letrec ((f497 (lambda (ls1498
ls2499) (if (null? ls1498) (syntax->datum ls2499) (f497 (cdr ls1498) (cons
(syntax->datum (car ls1498)) ls2499)))))) (f497 (cdr old-ids494) (car
old-ids494))) (letrec ((f500 (lambda (ls1501 ls2502) (if (null? ls1501) ls2502
(f500 (cdr ls1501) (cons (car ls1501) ls2502)))))) (f500 (cdr new-vars496) (car
new-vars496))) (if docstring464 (syntax->datum docstring464) #f) (chi-body288
(cons e1492 e2493) e463 (extend-var-env243 labels495 new-vars496 r466)
(make-binding-wrap265 old-ids494 labels495 w467) mod468)))))) tmp490) ((lambda
(_504) (syntax-violation (quote lambda) "bad lambda" e463)) tmp470)))
($sc-dispatch tmp470 (quote (any any . each-any)))))) ($sc-dispatch tmp470
(quote (each-any any . each-any)))))) ($sc-dispatch tmp470 (quote (any any any
. each-any))))) c465))) (chi-body288 (lambda (body505 outer-form506 r507 w508
mod509) (let ((r510 (cons (quote ("placeholder" placeholder)) r507))) (let
((ribcage511 (make-ribcage255 (quote ()) (quote ()) (quote ())))) (let ((w512
(make-wrap250 (wrap-marks251 w508) (cons ribcage511 (wrap-subst252 w508)))))
(letrec ((parse513 (lambda (body514 ids515 labels516 var-ids517 vars518 vals519
bindings520) (if (null? body514) (syntax-violation #f "no expressions in body"
outer-form506) (let ((e522 (cdar body514)) (er523 (caar body514)))
(call-with-values (lambda () (syntax-type282 e522 er523 (quote (()))
(source-annotation239 er523) ribcage511 mod509)) (lambda (type524 value525 e526
w527 s528 mod529) (if (memv type524 (quote (define-form))) (let ((id530
(wrap276 value525 w527 mod529)) (label531 (gen-label253))) (let ((var532
(gen-var295 id530))) (begin (extend-ribcage!264 ribcage511 id530 label531)
(parse513 (cdr body514) (cons id530 ids515) (cons label531 labels516) (cons
id530 var-ids517) (cons var532 vars518) (cons (cons er523 (wrap276 e526 w527
mod529)) vals519) (cons (cons (quote lexical) var532) bindings520))))) (if
(memv type524 (quote (define-syntax-form))) (let ((id533 (wrap276 value525 w527
mod529)) (label534 (gen-label253))) (begin (extend-ribcage!264 ribcage511 id533
label534) (parse513 (cdr body514) (cons id533 ids515) (cons label534 labels516)
var-ids517 vars518 vals519 (cons (cons (quote macro) (cons er523 (wrap276 e526
w527 mod529))) bindings520)))) (if (memv type524 (quote (begin-form))) ((lambda
(tmp535) ((lambda (tmp536) (if tmp536 (apply (lambda (_537 e1538) (parse513
(letrec ((f539 (lambda (forms540) (if (null? forms540) (cdr body514) (cons
(cons er523 (wrap276 (car forms540) w527 mod529)) (f539 (cdr forms540)))))))
(f539 e1538)) ids515 labels516 var-ids517 vars518 vals519 bindings520)) tmp536)
(syntax-violation #f "source expression failed to match any pattern" tmp535)))
($sc-dispatch tmp535 (quote (any . each-any))))) e526) (if (memv type524 (quote
(local-syntax-form))) (chi-local-syntax290 value525 e526 er523 w527 s528 mod529
(lambda (forms542 er543 w544 s545 mod546) (parse513 (letrec ((f547 (lambda
(forms548) (if (null? forms548) (cdr body514) (cons (cons er543 (wrap276 (car
forms548) w544 mod546)) (f547 (cdr forms548))))))) (f547 forms542)) ids515
labels516 var-ids517 vars518 vals519 bindings520))) (if (null? ids515)
(build-sequence227 #f (map (lambda (x549) (chi284 (cdr x549) (car x549) (quote
(())) mod529)) (cons (cons er523 (source-wrap277 e526 w527 s528 mod529)) (cdr
body514)))) (begin (if (not (valid-bound-ids?273 ids515)) (syntax-violation #f
"invalid or duplicate identifier in definition" outer-form506)) (letrec
((loop550 (lambda (bs551 er-cache552 r-cache553) (if (not (null? bs551)) (let
((b554 (car bs551))) (if (eq? (car b554) (quote macro)) (let ((er555 (cadr
b554))) (let ((r-cache556 (if (eq? er555 er-cache552) r-cache553
(macros-only-env244 er555)))) (begin (set-cdr! b554 (eval-local-transformer291
(chi284 (cddr b554) r-cache556 (quote (())) mod529) mod529)) (loop550 (cdr
bs551) er555 r-cache556)))) (loop550 (cdr bs551) er-cache552 r-cache553)))))))
(loop550 bindings520 #f #f)) (set-cdr! r510 (extend-env242 labels516
bindings520 (cdr r510))) (build-letrec230 #f (map syntax->datum var-ids517)
vars518 (map (lambda (x557) (chi284 (cdr x557) (car x557) (quote (())) mod529))
vals519) (build-sequence227 #f (map (lambda (x558) (chi284 (cdr x558) (car
x558) (quote (())) mod529)) (cons (cons er523 (source-wrap277 e526 w527 s528
mod529)) (cdr body514)))))))))))))))))) (parse513 (map (lambda (x521) (cons
r510 (wrap276 x521 w512 mod509))) body505) (quote ()) (quote ()) (quote ())
(quote ()) (quote ()) (quote ())))))))) (chi-macro287 (lambda (p559 e560 r561
w562 rib563 mod564) (letrec ((rebuild-macro-output565 (lambda (x566 m567) (if
(pair? x566) (cons (rebuild-macro-output565 (car x566) m567)
(rebuild-macro-output565 (cdr x566) m567)) (if (syntax-object?232 x566) (let
((w568 (syntax-object-wrap234 x566))) (let ((ms569 (wrap-marks251 w568)) (s570
(wrap-subst252 w568))) (if (if (pair? ms569) (eq? (car ms569) #f) #f)
(make-syntax-object231 (syntax-object-expression233 x566) (make-wrap250 (cdr
ms569) (if rib563 (cons rib563 (cdr s570)) (cdr s570)))
(syntax-object-module235 x566)) (make-syntax-object231
(syntax-object-expression233 x566) (make-wrap250 (cons m567 ms569) (if rib563
(cons rib563 (cons (quote shift) s570)) (cons (quote shift) s570))) (let
((pmod571 (procedure-module p559))) (if pmod571 (cons (quote hygiene)
(module-name pmod571)) (quote (hygiene guile)))))))) (if (vector? x566) (let
((n572 (vector-length x566))) (let ((v573 (make-vector n572))) (letrec
((loop574 (lambda (i575) (if (fx=208 i575 n572) (begin (if #f #f) v573) (begin
(vector-set! v573 i575 (rebuild-macro-output565 (vector-ref x566 i575) m567))
(loop574 (fx+206 i575 1))))))) (loop574 0)))) (if (symbol? x566)
(syntax-violation #f "encountered raw symbol in macro output" (source-wrap277
e560 w562 s mod564) x566) x566))))))) (rebuild-macro-output565 (p559 (wrap276
e560 (anti-mark263 w562) mod564)) (string #\m))))) (chi-application286 (lambda
(x576 e577 r578 w579 s580 mod581) ((lambda (tmp582) ((lambda (tmp583) (if
tmp583 (apply (lambda (e0584 e1585) (build-application215 s580 x576 (map
(lambda (e586) (chi284 e586 r578 w579 mod581)) e1585))) tmp583)
(syntax-violation #f "source expression failed to match any pattern" tmp582)))
($sc-dispatch tmp582 (quote (any . each-any))))) e577))) (chi-expr285 (lambda
(type588 value589 e590 r591 w592 s593 mod594) (if (memv type588 (quote
(lexical))) (build-lexical-reference217 (quote value) s593 e590 value589) (if
(memv type588 (quote (core external-macro))) (value589 e590 r591 w592 s593
mod594) (if (memv type588 (quote (module-ref))) (call-with-values (lambda ()
(value589 e590)) (lambda (id595 mod596) (build-global-reference220 s593 id595
mod596))) (if (memv type588 (quote (lexical-call))) (chi-application286
(build-lexical-reference217 (quote fun) (source-annotation239 (car e590)) (car
e590) value589) e590 r591 w592 s593 mod594) (if (memv type588 (quote
(global-call))) (chi-application286 (build-global-reference220
(source-annotation239 (car e590)) value589 (if (syntax-object?232 (car e590))
(syntax-object-module235 (car e590)) mod594)) e590 r591 w592 s593 mod594) (if
(memv type588 (quote (constant))) (build-data226 s593 (strip294 (source-wrap277
e590 w592 s593 mod594) (quote (())))) (if (memv type588 (quote (global)))
(build-global-reference220 s593 value589 mod594) (if (memv type588 (quote
(call))) (chi-application286 (chi284 (car e590) r591 w592 mod594) e590 r591
w592 s593 mod594) (if (memv type588 (quote (begin-form))) ((lambda (tmp597)
((lambda (tmp598) (if tmp598 (apply (lambda (_599 e1600 e2601) (chi-sequence278
(cons e1600 e2601) r591 w592 s593 mod594)) tmp598) (syntax-violation #f "source
expression failed to match any pattern" tmp597))) ($sc-dispatch tmp597 (quote
(any any . each-any))))) e590) (if (memv type588 (quote (local-syntax-form)))
(chi-local-syntax290 value589 e590 r591 w592 s593 mod594 chi-sequence278) (if
(memv type588 (quote (eval-when-form))) ((lambda (tmp603) ((lambda (tmp604) (if
tmp604 (apply (lambda (_605 x606 e1607 e2608) (let ((when-list609
(chi-when-list281 e590 x606 w592))) (if (memq (quote eval) when-list609)
(chi-sequence278 (cons e1607 e2608) r591 w592 s593 mod594) (chi-void292))))
tmp604) (syntax-violation #f "source expression failed to match any pattern"
tmp603))) ($sc-dispatch tmp603 (quote (any each-any any . each-any))))) e590)
(if (memv type588 (quote (define-form define-syntax-form))) (syntax-violation
#f "definition in expression context" e590 (wrap276 value589 w592 mod594)) (if
(memv type588 (quote (syntax))) (syntax-violation #f "reference to pattern
variable outside syntax form" (source-wrap277 e590 w592 s593 mod594)) (if (memv
type588 (quote (displaced-lexical))) (syntax-violation #f "reference to
identifier outside its scope" (source-wrap277 e590 w592 s593 mod594))
(syntax-violation #f "unexpected syntax" (source-wrap277 e590 w592 s593
mod594)))))))))))))))))) (chi284 (lambda (e612 r613 w614 mod615)
(call-with-values (lambda () (syntax-type282 e612 r613 w614
(source-annotation239 e612) #f mod615)) (lambda (type616 value617 e618 w619
s620 mod621) (chi-expr285 type616 value617 e618 r613 w619 s620 mod621)))))
(chi-top283 (lambda (e622 r623 w624 m625 esew626 mod627) (call-with-values
(lambda () (syntax-type282 e622 r623 w624 (source-annotation239 e622) #f
mod627)) (lambda (type635 value636 e637 w638 s639 mod640) (if (memv type635
(quote (begin-form))) ((lambda (tmp641) ((lambda (tmp642) (if tmp642 (apply
(lambda (_643) (chi-void292)) tmp642) ((lambda (tmp644) (if tmp644 (apply
(lambda (_645 e1646 e2647) (chi-top-sequence279 (cons e1646 e2647) r623 w638
s639 m625 esew626 mod640)) tmp644) (syntax-violation #f "source expression
failed to match any pattern" tmp641))) ($sc-dispatch tmp641 (quote (any any .
each-any)))))) ($sc-dispatch tmp641 (quote (any))))) e637) (if (memv type635
(quote (local-syntax-form))) (chi-local-syntax290 value636 e637 r623 w638 s639
mod640 (lambda (body649 r650 w651 s652 mod653) (chi-top-sequence279 body649
r650 w651 s652 m625 esew626 mod653))) (if (memv type635 (quote
(eval-when-form))) ((lambda (tmp654) ((lambda (tmp655) (if tmp655 (apply
(lambda (_656 x657 e1658 e2659) (let ((when-list660 (chi-when-list281 e637 x657
w638)) (body661 (cons e1658 e2659))) (if (eq? m625 (quote e)) (if (memq (quote
eval) when-list660) (chi-top-sequence279 body661 r623 w638 s639 (quote e)
(quote (eval)) mod640) (chi-void292)) (if (memq (quote load) when-list660) (if
(let ((t664 (memq (quote compile) when-list660))) (if t664 t664 (if (eq? m625
(quote c&e)) (memq (quote eval) when-list660) #f))) (chi-top-sequence279
body661 r623 w638 s639 (quote c&e) (quote (compile load)) mod640) (if (memq
m625 (quote (c c&e))) (chi-top-sequence279 body661 r623 w638 s639 (quote c)
(quote (load)) mod640) (chi-void292))) (if (let ((t665 (memq (quote compile)
when-list660))) (if t665 t665 (if (eq? m625 (quote c&e)) (memq (quote eval)
when-list660) #f))) (begin (top-level-eval-hook210 (chi-top-sequence279 body661
r623 w638 s639 (quote e) (quote (eval)) mod640) mod640) (chi-void292))
(chi-void292)))))) tmp655) (syntax-violation #f "source expression failed to
match any pattern" tmp654))) ($sc-dispatch tmp654 (quote (any each-any any .
each-any))))) e637) (if (memv type635 (quote (define-syntax-form))) (let ((n666
(id-var-name270 value636 w638)) (r667 (macros-only-env244 r623))) (if (memv
m625 (quote (c))) (if (memq (quote compile) esew626) (let ((e668
(chi-install-global280 n666 (chi284 e637 r667 w638 mod640)))) (begin
(top-level-eval-hook210 e668 mod640) (if (memq (quote load) esew626) e668
(chi-void292)))) (if (memq (quote load) esew626) (chi-install-global280 n666
(chi284 e637 r667 w638 mod640)) (chi-void292))) (if (memv m625 (quote (c&e)))
(let ((e669 (chi-install-global280 n666 (chi284 e637 r667 w638 mod640))))
(begin (top-level-eval-hook210 e669 mod640) e669)) (begin (if (memq (quote
eval) esew626) (top-level-eval-hook210 (chi-install-global280 n666 (chi284 e637
r667 w638 mod640)) mod640)) (chi-void292))))) (if (memv type635 (quote
(define-form))) (let ((n670 (id-var-name270 value636 w638))) (let ((type671
(binding-type240 (lookup245 n670 r623 mod640)))) (if (memv type671 (quote
(global core macro module-ref))) (let ((x672 (build-global-definition223 s639
n670 (chi284 e637 r623 w638 mod640)))) (begin (if (eq? m625 (quote c&e))
(top-level-eval-hook210 x672 mod640)) x672)) (if (memv type671 (quote
(displaced-lexical))) (syntax-violation #f "identifier out of context" e637
(wrap276 value636 w638 mod640)) (syntax-violation #f "cannot define keyword at
top level" e637 (wrap276 value636 w638 mod640)))))) (let ((x673 (chi-expr285
type635 value636 e637 r623 w638 s639 mod640))) (begin (if (eq? m625 (quote
c&e)) (top-level-eval-hook210 x673 mod640)) x673))))))))))) (syntax-type282
(lambda (e674 r675 w676 s677 rib678 mod679) (if (symbol? e674) (let ((n680
(id-var-name270 e674 w676))) (let ((b681 (lookup245 n680 r675 mod679))) (let
((type682 (binding-type240 b681))) (if (memv type682 (quote (lexical))) (values
type682 (binding-value241 b681) e674 w676 s677 mod679) (if (memv type682 (quote
(global))) (values type682 n680 e674 w676 s677 mod679) (if (memv type682 (quote
(macro))) (syntax-type282 (chi-macro287 (binding-value241 b681) e674 r675 w676
rib678 mod679) r675 (quote (())) s677 rib678 mod679) (values type682
(binding-value241 b681) e674 w676 s677 mod679))))))) (if (pair? e674) (let
((first683 (car e674))) (if (id?248 first683) (let ((n684 (id-var-name270
first683 w676))) (let ((b685 (lookup245 n684 r675 (let ((t686 (if
(syntax-object?232 first683) (syntax-object-module235 first683) #f))) (if t686
t686 mod679))))) (let ((type687 (binding-type240 b685))) (if (memv type687
(quote (lexical))) (values (quote lexical-call) (binding-value241 b685) e674
w676 s677 mod679) (if (memv type687 (quote (global))) (values (quote
global-call) n684 e674 w676 s677 mod679) (if (memv type687 (quote (macro)))
(syntax-type282 (chi-macro287 (binding-value241 b685) e674 r675 w676 rib678
mod679) r675 (quote (())) s677 rib678 mod679) (if (memv type687 (quote (core
external-macro module-ref))) (values type687 (binding-value241 b685) e674 w676
s677 mod679) (if (memv type687 (quote (local-syntax))) (values (quote
local-syntax-form) (binding-value241 b685) e674 w676 s677 mod679) (if (memv
type687 (quote (begin))) (values (quote begin-form) #f e674 w676 s677 mod679)
(if (memv type687 (quote (eval-when))) (values (quote eval-when-form) #f e674
w676 s677 mod679) (if (memv type687 (quote (define))) ((lambda (tmp688)
((lambda (tmp689) (if (if tmp689 (apply (lambda (_690 name691 val692) (id?248
name691)) tmp689) #f) (apply (lambda (_693 name694 val695) (values (quote
define-form) name694 val695 w676 s677 mod679)) tmp689) ((lambda (tmp696) (if
(if tmp696 (apply (lambda (_697 name698 args699 e1700 e2701) (if (id?248
name698) (valid-bound-ids?273 (lambda-var-list296 args699)) #f)) tmp696) #f)
(apply (lambda (_702 name703 args704 e1705 e2706) (values (quote define-form)
(wrap276 name703 w676 mod679) (cons (quote #(syntax-object lambda ((top)
#(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i"
"i" "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 () () ())
#(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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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))) (wrap276 (cons args704 (cons e1705
e2706)) w676 mod679)) (quote (())) s677 mod679)) tmp696) ((lambda (tmp708) (if
(if tmp708 (apply (lambda (_709 name710) (id?248 name710)) tmp708) #f) (apply
(lambda (_711 name712) (values (quote define-form) (wrap276 name712 w676
mod679) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top))
#("i" "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 () () ())
#(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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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 () () ())
#(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(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 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
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
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void 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 () () ())
#(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(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 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
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
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void 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 (())) s677 mod679)) tmp708)
(syntax-violation #f "source expression failed to match any pattern" tmp688)))
($sc-dispatch tmp688 (quote (any any)))))) ($sc-dispatch tmp688 (quote (any
(any . any) any . each-any)))))) ($sc-dispatch tmp688 (quote (any any any)))))
e674) (if (memv type687 (quote (define-syntax))) ((lambda (tmp713) ((lambda
(tmp714) (if (if tmp714 (apply (lambda (_715 name716 val717) (id?248 name716))
tmp714) #f) (apply (lambda (_718 name719 val720) (values (quote
define-syntax-form) name719 val720 w676 s677 mod679)) tmp714) (syntax-violation
#f "source expression failed to match any pattern" tmp713))) ($sc-dispatch
tmp713 (quote (any any any))))) e674) (values (quote call) #f e674 w676 s677
mod679))))))))))))) (values (quote call) #f e674 w676 s677 mod679))) (if
(syntax-object?232 e674) (syntax-type282 (syntax-object-expression233 e674)
r675 (join-wraps267 w676 (syntax-object-wrap234 e674)) s677 rib678 (let ((t721
(syntax-object-module235 e674))) (if t721 t721 mod679))) (if (self-evaluating?
e674) (values (quote constant) #f e674 w676 s677 mod679) (values (quote other)
#f e674 w676 s677 mod679))))))) (chi-when-list281 (lambda (e722 when-list723
w724) (letrec ((f725 (lambda (when-list726 situations727) (if (null?
when-list726) situations727 (f725 (cdr when-list726) (cons (let ((x728 (car
when-list726))) (if (free-id=?271 x728 (quote #(syntax-object compile ((top)
#(ribcage () () ()) #(ribcage () () ()) #(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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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) (if (free-id=?271
x728 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ())
#(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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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) (if (free-id=?271
x728 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ())
#(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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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) (syntax-violation
(quote eval-when) "invalid situation" e722 (wrap276 x728 w724 #f))))))
situations727)))))) (f725 when-list723 (quote ()))))) (chi-install-global280
(lambda (name729 e730) (build-global-definition223 #f name729 (if (let ((v731
(module-variable (current-module) name729))) (if v731 (if (variable-bound?
v731) (if (macro? (variable-ref v731)) (not (eq? (macro-type (variable-ref
v731)) (quote syncase-macro))) #f) #f) #f)) (build-application215 #f
(build-primref225 #f (quote make-extended-syncase-macro)) (list
(build-application215 #f (build-primref225 #f (quote module-ref)) (list
(build-application215 #f (build-primref225 #f (quote current-module)) (quote
())) (build-data226 #f name729))) (build-data226 #f (quote macro)) e730))
(build-application215 #f (build-primref225 #f (quote make-syncase-macro)) (list
(build-data226 #f (quote macro)) e730)))))) (chi-top-sequence279 (lambda
(body732 r733 w734 s735 m736 esew737 mod738) (build-sequence227 s735 (letrec
((dobody739 (lambda (body740 r741 w742 m743 esew744 mod745) (if (null? body740)
(quote ()) (let ((first746 (chi-top283 (car body740) r741 w742 m743 esew744
mod745))) (cons first746 (dobody739 (cdr body740) r741 w742 m743 esew744
mod745))))))) (dobody739 body732 r733 w734 m736 esew737 mod738)))))
(chi-sequence278 (lambda (body747 r748 w749 s750 mod751) (build-sequence227
s750 (letrec ((dobody752 (lambda (body753 r754 w755 mod756) (if (null? body753)
(quote ()) (let ((first757 (chi284 (car body753) r754 w755 mod756))) (cons
first757 (dobody752 (cdr body753) r754 w755 mod756))))))) (dobody752 body747
r748 w749 mod751))))) (source-wrap277 (lambda (x758 w759 s760 defmod761) (begin
(if (if s760 (pair? x758) #f) (set-source-properties! x758 s760)) (wrap276 x758
w759 defmod761)))) (wrap276 (lambda (x762 w763 defmod764) (if (if (null?
(wrap-marks251 w763)) (null? (wrap-subst252 w763)) #f) x762 (if
(syntax-object?232 x762) (make-syntax-object231 (syntax-object-expression233
x762) (join-wraps267 w763 (syntax-object-wrap234 x762))
(syntax-object-module235 x762)) (if (null? x762) x762 (make-syntax-object231
x762 w763 defmod764)))))) (bound-id-member?275 (lambda (x765 list766) (if (not
(null? list766)) (let ((t767 (bound-id=?272 x765 (car list766)))) (if t767 t767
(bound-id-member?275 x765 (cdr list766)))) #f))) (distinct-bound-ids?274
(lambda (ids768) (letrec ((distinct?769 (lambda (ids770) (let ((t771 (null?
ids770))) (if t771 t771 (if (not (bound-id-member?275 (car ids770) (cdr
ids770))) (distinct?769 (cdr ids770)) #f)))))) (distinct?769 ids768))))
(valid-bound-ids?273 (lambda (ids772) (if (letrec ((all-ids?773 (lambda
(ids774) (let ((t775 (null? ids774))) (if t775 t775 (if (id?248 (car ids774))
(all-ids?773 (cdr ids774)) #f)))))) (all-ids?773 ids772))
(distinct-bound-ids?274 ids772) #f))) (bound-id=?272 (lambda (i776 j777) (if
(if (syntax-object?232 i776) (syntax-object?232 j777) #f) (if (eq?
(syntax-object-expression233 i776) (syntax-object-expression233 j777))
(same-marks?269 (wrap-marks251 (syntax-object-wrap234 i776)) (wrap-marks251
(syntax-object-wrap234 j777))) #f) (eq? i776 j777)))) (free-id=?271 (lambda
(i778 j779) (if (eq? (let ((x780 i778)) (if (syntax-object?232 x780)
(syntax-object-expression233 x780) x780)) (let ((x781 j779)) (if
(syntax-object?232 x781) (syntax-object-expression233 x781) x781))) (eq?
(id-var-name270 i778 (quote (()))) (id-var-name270 j779 (quote (())))) #f)))
(id-var-name270 (lambda (id782 w783) (letrec ((search-vector-rib786 (lambda
(sym792 subst793 marks794 symnames795 ribcage796) (let ((n797 (vector-length
symnames795))) (letrec ((f798 (lambda (i799) (if (fx=208 i799 n797) (search784
sym792 (cdr subst793) marks794) (if (if (eq? (vector-ref symnames795 i799)
sym792) (same-marks?269 marks794 (vector-ref (ribcage-marks258 ribcage796)
i799)) #f) (values (vector-ref (ribcage-labels259 ribcage796) i799) marks794)
(f798 (fx+206 i799 1))))))) (f798 0))))) (search-list-rib785 (lambda (sym800
subst801 marks802 symnames803 ribcage804) (letrec ((f805 (lambda (symnames806
i807) (if (null? symnames806) (search784 sym800 (cdr subst801) marks802) (if
(if (eq? (car symnames806) sym800) (same-marks?269 marks802 (list-ref
(ribcage-marks258 ribcage804) i807)) #f) (values (list-ref (ribcage-labels259
ribcage804) i807) marks802) (f805 (cdr symnames806) (fx+206 i807 1))))))) (f805
symnames803 0)))) (search784 (lambda (sym808 subst809 marks810) (if (null?
subst809) (values #f marks810) (let ((fst811 (car subst809))) (if (eq? fst811
(quote shift)) (search784 sym808 (cdr subst809) (cdr marks810)) (let
((symnames812 (ribcage-symnames257 fst811))) (if (vector? symnames812)
(search-vector-rib786 sym808 subst809 marks810 symnames812 fst811)
(search-list-rib785 sym808 subst809 marks810 symnames812 fst811))))))))) (if
(symbol? id782) (let ((t813 (call-with-values (lambda () (search784 id782
(wrap-subst252 w783) (wrap-marks251 w783))) (lambda (x815 . ignore814) x815))))
(if t813 t813 id782)) (if (syntax-object?232 id782) (let ((id816
(syntax-object-expression233 id782)) (w1817 (syntax-object-wrap234 id782)))
(let ((marks818 (join-marks268 (wrap-marks251 w783) (wrap-marks251 w1817))))
(call-with-values (lambda () (search784 id816 (wrap-subst252 w783) marks818))
(lambda (new-id819 marks820) (let ((t821 new-id819)) (if t821 t821 (let ((t822
(call-with-values (lambda () (search784 id816 (wrap-subst252 w1817) marks820))
(lambda (x824 . ignore823) x824)))) (if t822 t822 id816))))))))
(syntax-violation (quote id-var-name) "invalid id" id782)))))) (same-marks?269
(lambda (x825 y826) (let ((t827 (eq? x825 y826))) (if t827 t827 (if (not (null?
x825)) (if (not (null? y826)) (if (eq? (car x825) (car y826)) (same-marks?269
(cdr x825) (cdr y826)) #f) #f) #f))))) (join-marks268 (lambda (m1828 m2829)
(smart-append266 m1828 m2829))) (join-wraps267 (lambda (w1830 w2831) (let
((m1832 (wrap-marks251 w1830)) (s1833 (wrap-subst252 w1830))) (if (null? m1832)
(if (null? s1833) w2831 (make-wrap250 (wrap-marks251 w2831) (smart-append266
s1833 (wrap-subst252 w2831)))) (make-wrap250 (smart-append266 m1832
(wrap-marks251 w2831)) (smart-append266 s1833 (wrap-subst252 w2831)))))))
(smart-append266 (lambda (m1834 m2835) (if (null? m2835) m1834 (append m1834
m2835)))) (make-binding-wrap265 (lambda (ids836 labels837 w838) (if (null?
ids836) w838 (make-wrap250 (wrap-marks251 w838) (cons (let ((labelvec839
(list->vector labels837))) (let ((n840 (vector-length labelvec839))) (let
((symnamevec841 (make-vector n840)) (marksvec842 (make-vector n840))) (begin
(letrec ((f843 (lambda (ids844 i845) (if (not (null? ids844)) (call-with-values
(lambda () (id-sym-name&marks249 (car ids844) w838)) (lambda (symname846
marks847) (begin (vector-set! symnamevec841 i845 symname846) (vector-set!
marksvec842 i845 marks847) (f843 (cdr ids844) (fx+206 i845 1))))))))) (f843
ids836 0)) (make-ribcage255 symnamevec841 marksvec842 labelvec839)))))
(wrap-subst252 w838)))))) (extend-ribcage!264 (lambda (ribcage848 id849
label850) (begin (set-ribcage-symnames!260 ribcage848 (cons
(syntax-object-expression233 id849) (ribcage-symnames257 ribcage848)))
(set-ribcage-marks!261 ribcage848 (cons (wrap-marks251 (syntax-object-wrap234
id849)) (ribcage-marks258 ribcage848))) (set-ribcage-labels!262 ribcage848
(cons label850 (ribcage-labels259 ribcage848)))))) (anti-mark263 (lambda (w851)
(make-wrap250 (cons #f (wrap-marks251 w851)) (cons (quote shift) (wrap-subst252
w851))))) (set-ribcage-labels!262 (lambda (x852 update853) (vector-set! x852 3
update853))) (set-ribcage-marks!261 (lambda (x854 update855) (vector-set! x854
2 update855))) (set-ribcage-symnames!260 (lambda (x856 update857) (vector-set!
x856 1 update857))) (ribcage-labels259 (lambda (x858) (vector-ref x858 3)))
(ribcage-marks258 (lambda (x859) (vector-ref x859 2))) (ribcage-symnames257
(lambda (x860) (vector-ref x860 1))) (ribcage?256 (lambda (x861) (if (vector?
x861) (if (= (vector-length x861) 4) (eq? (vector-ref x861 0) (quote ribcage))
#f) #f))) (make-ribcage255 (lambda (symnames862 marks863 labels864) (vector
(quote ribcage) symnames862 marks863 labels864))) (gen-labels254 (lambda
(ls865) (if (null? ls865) (quote ()) (cons (gen-label253) (gen-labels254 (cdr
ls865)))))) (gen-label253 (lambda () (string #\i))) (wrap-subst252 cdr)
(wrap-marks251 car) (make-wrap250 cons) (id-sym-name&marks249 (lambda (x866
w867) (if (syntax-object?232 x866) (values (syntax-object-expression233 x866)
(join-marks268 (wrap-marks251 w867) (wrap-marks251 (syntax-object-wrap234
x866)))) (values x866 (wrap-marks251 w867))))) (id?248 (lambda (x868) (if
(symbol? x868) #t (if (syntax-object?232 x868) (symbol?
(syntax-object-expression233 x868)) #f)))) (nonsymbol-id?247 (lambda (x869) (if
(syntax-object?232 x869) (symbol? (syntax-object-expression233 x869)) #f)))
(global-extend246 (lambda (type870 sym871 val872)
(put-global-definition-hook212 sym871 type870 val872))) (lookup245 (lambda
(x873 r874 mod875) (let ((t876 (assq x873 r874))) (if t876 (cdr t876) (if
(symbol? x873) (let ((t877 (get-global-definition-hook213 x873 mod875))) (if
t877 t877 (quote (global)))) (quote (displaced-lexical)))))))
(macros-only-env244 (lambda (r878) (if (null? r878) (quote ()) (let ((a879 (car
r878))) (if (eq? (cadr a879) (quote macro)) (cons a879 (macros-only-env244 (cdr
r878))) (macros-only-env244 (cdr r878))))))) (extend-var-env243 (lambda
(labels880 vars881 r882) (if (null? labels880) r882 (extend-var-env243 (cdr
labels880) (cdr vars881) (cons (cons (car labels880) (cons (quote lexical) (car
vars881))) r882))))) (extend-env242 (lambda (labels883 bindings884 r885) (if
(null? labels883) r885 (extend-env242 (cdr labels883) (cdr bindings884) (cons
(cons (car labels883) (car bindings884)) r885))))) (binding-value241 cdr)
(binding-type240 car) (source-annotation239 (lambda (x886) (if
(syntax-object?232 x886) (source-annotation239 (syntax-object-expression233
x886)) (if (pair? x886) (let ((props887 (source-properties x886))) (if (pair?
props887) props887 #f)) #f)))) (set-syntax-object-module!238 (lambda (x888
update889) (vector-set! x888 3 update889))) (set-syntax-object-wrap!237 (lambda
(x890 update891) (vector-set! x890 2 update891)))
(set-syntax-object-expression!236 (lambda (x892 update893) (vector-set! x892 1
update893))) (syntax-object-module235 (lambda (x894) (vector-ref x894 3)))
(syntax-object-wrap234 (lambda (x895) (vector-ref x895 2)))
(syntax-object-expression233 (lambda (x896) (vector-ref x896 1)))
(syntax-object?232 (lambda (x897) (if (vector? x897) (if (= (vector-length
x897) 4) (eq? (vector-ref x897 0) (quote syntax-object)) #f) #f)))
(make-syntax-object231 (lambda (expression898 wrap899 module900) (vector (quote
syntax-object) expression898 wrap899 module900))) (build-letrec230 (lambda
(src901 ids902 vars903 val-exps904 body-exp905) (if (null? vars903) body-exp905
(let ((atom-key906 (fluid-ref *mode*205))) (if (memv atom-key906 (quote (c)))
(begin (for-each maybe-name-value!222 ids902 val-exps904) ((@ (language
tree-il) make-letrec) src901 ids902 vars903 val-exps904 body-exp905)) (list
(quote letrec) (map list vars903 val-exps904) body-exp905))))))
(build-named-let229 (lambda (src907 ids908 vars909 val-exps910 body-exp911)
(let ((f912 (car vars909)) (f-name913 (car ids908)) (vars914 (cdr vars909))
(ids915 (cdr ids908))) (let ((atom-key916 (fluid-ref *mode*205))) (if (memv
atom-key916 (quote (c))) (let ((proc917 (build-lambda224 src907 ids915 vars914
#f body-exp911))) (begin (maybe-name-value!222 f-name913 proc917) (for-each
maybe-name-value!222 ids915 val-exps910) ((@ (language tree-il) make-letrec)
src907 (list f-name913) (list f912) (list proc917) (build-application215 src907
(build-lexical-reference217 (quote fun) src907 f-name913 f912) val-exps910))))
(list (quote let) f912 (map list vars914 val-exps910) body-exp911))))))
(build-let228 (lambda (src918 ids919 vars920 val-exps921 body-exp922) (if
(null? vars920) body-exp922 (let ((atom-key923 (fluid-ref *mode*205))) (if
(memv atom-key923 (quote (c))) (begin (for-each maybe-name-value!222 ids919
val-exps921) ((@ (language tree-il) make-let) src918 ids919 vars920 val-exps921
body-exp922)) (list (quote let) (map list vars920 val-exps921)
body-exp922)))))) (build-sequence227 (lambda (src924 exps925) (if (null? (cdr
exps925)) (car exps925) (let ((atom-key926 (fluid-ref *mode*205))) (if (memv
atom-key926 (quote (c))) ((@ (language tree-il) make-sequence) src924 exps925)
(cons (quote begin) exps925)))))) (build-data226 (lambda (src927 exp928) (let
((atom-key929 (fluid-ref *mode*205))) (if (memv atom-key929 (quote (c))) ((@
(language tree-il) make-const) src927 exp928) (if (if (self-evaluating? exp928)
(not (vector? exp928)) #f) exp928 (list (quote quote) exp928))))))
(build-primref225 (lambda (src930 name931) (if (equal? (module-name
(current-module)) (quote (guile))) (let ((atom-key932 (fluid-ref *mode*205)))
(if (memv atom-key932 (quote (c))) ((@ (language tree-il) make-toplevel-ref)
src930 name931) name931)) (let ((atom-key933 (fluid-ref *mode*205))) (if (memv
atom-key933 (quote (c))) ((@ (language tree-il) make-module-ref) src930 (quote
(guile)) name931 #f) (list (quote @@) (quote (guile)) name931))))))
(build-lambda224 (lambda (src934 ids935 vars936 docstring937 exp938) (let
((atom-key939 (fluid-ref *mode*205))) (if (memv atom-key939 (quote (c))) ((@
(language tree-il) make-lambda) src934 ids935 vars936 (if docstring937 (list
(cons (quote documentation) docstring937)) (quote ())) exp938) (cons (quote
lambda) (cons vars936 (append (if docstring937 (list docstring937) (quote ()))
(list exp938)))))))) (build-global-definition223 (lambda (source940 var941
exp942) (let ((atom-key943 (fluid-ref *mode*205))) (if (memv atom-key943 (quote
(c))) (begin (maybe-name-value!222 var941 exp942) ((@ (language tree-il)
make-toplevel-define) source940 var941 exp942)) (list (quote define) var941
exp942))))) (maybe-name-value!222 (lambda (name944 val945) (if ((@ (language
tree-il) lambda?) val945) (let ((meta946 ((@ (language tree-il) lambda-meta)
val945))) (if (not (assq (quote name) meta946)) ((setter (@ (language tree-il)
lambda-meta)) val945 (acons (quote name) name944 meta946)))))))
(build-global-assignment221 (lambda (source947 var948 exp949 mod950)
(analyze-variable219 mod950 var948 (lambda (mod951 var952 public?953) (let
((atom-key954 (fluid-ref *mode*205))) (if (memv atom-key954 (quote (c))) ((@
(language tree-il) make-module-set) source947 mod951 var952 public?953 exp949)
(list (quote set!) (list (if public?953 (quote @) (quote @@)) mod951 var952)
exp949)))) (lambda (var955) (let ((atom-key956 (fluid-ref *mode*205))) (if
(memv atom-key956 (quote (c))) ((@ (language tree-il) make-toplevel-set)
source947 var955 exp949) (list (quote set!) var955 exp949)))))))
(build-global-reference220 (lambda (source957 var958 mod959)
(analyze-variable219 mod959 var958 (lambda (mod960 var961 public?962) (let
((atom-key963 (fluid-ref *mode*205))) (if (memv atom-key963 (quote (c))) ((@
(language tree-il) make-module-ref) source957 mod960 var961 public?962) (list
(if public?962 (quote @) (quote @@)) mod960 var961)))) (lambda (var964) (let
((atom-key965 (fluid-ref *mode*205))) (if (memv atom-key965 (quote (c))) ((@
(language tree-il) make-toplevel-ref) source957 var964) var964))))))
(analyze-variable219 (lambda (mod966 var967 modref-cont968 bare-cont969) (if
(not mod966) (bare-cont969 var967) (let ((kind970 (car mod966)) (mod971 (cdr
mod966))) (if (memv kind970 (quote (public))) (modref-cont968 mod971 var967 #t)
(if (memv kind970 (quote (private))) (if (not (equal? mod971 (module-name
(current-module)))) (modref-cont968 mod971 var967 #f) (bare-cont969 var967))
(if (memv kind970 (quote (bare))) (bare-cont969 var967) (if (memv kind970
(quote (hygiene))) (if (if (not (equal? mod971 (module-name (current-module))))
(module-variable (resolve-module mod971) var967) #f) (modref-cont968 mod971
var967 #f) (bare-cont969 var967)) (syntax-violation #f "bad module kind" var967
mod971))))))))) (build-lexical-assignment218 (lambda (source972 name973 var974
exp975) (let ((atom-key976 (fluid-ref *mode*205))) (if (memv atom-key976 (quote
(c))) ((@ (language tree-il) make-lexical-set) source972 name973 var974 exp975)
(list (quote set!) var974 exp975))))) (build-lexical-reference217 (lambda
(type977 source978 name979 var980) (let ((atom-key981 (fluid-ref *mode*205)))
(if (memv atom-key981 (quote (c))) ((@ (language tree-il) make-lexical-ref)
source978 name979 var980) var980)))) (build-conditional216 (lambda (source982
test-exp983 then-exp984 else-exp985) (let ((atom-key986 (fluid-ref *mode*205)))
(if (memv atom-key986 (quote (c))) ((@ (language tree-il) make-conditional)
source982 test-exp983 then-exp984 else-exp985) (if (equal? else-exp985 (quote
(if #f #f))) (list (quote if) test-exp983 then-exp984) (list (quote if)
test-exp983 then-exp984 else-exp985)))))) (build-application215 (lambda
(source987 fun-exp988 arg-exps989) (let ((atom-key990 (fluid-ref *mode*205)))
(if (memv atom-key990 (quote (c))) ((@ (language tree-il) make-application)
source987 fun-exp988 arg-exps989) (cons fun-exp988 arg-exps989)))))
(build-void214 (lambda (source991) (let ((atom-key992 (fluid-ref *mode*205)))
(if (memv atom-key992 (quote (c))) ((@ (language tree-il) make-void) source991)
(quote (if #f #f)))))) (get-global-definition-hook213 (lambda (symbol993
module994) (begin (if (if (not module994) (current-module) #f) (warn "module
system is booted, we should have a module" symbol993)) (let ((v995
(module-variable (if module994 (resolve-module (cdr module994))
(current-module)) symbol993))) (if v995 (if (variable-bound? v995) (let
((val996 (variable-ref v995))) (if (macro? val996) (if (syncase-macro-type
val996) (cons (syncase-macro-type val996) (syncase-macro-binding val996)) #f)
#f)) #f) #f))))) (put-global-definition-hook212 (lambda (symbol997 type998
val999) (let ((existing1000 (let ((v1001 (module-variable (current-module)
symbol997))) (if v1001 (if (variable-bound? v1001) (let ((val1002 (variable-ref
v1001))) (if (macro? val1002) (if (not (syncase-macro-type val1002)) val1002
#f) #f)) #f) #f)))) (module-define! (current-module) symbol997 (if existing1000
(make-extended-syncase-macro existing1000 type998 val999) (make-syncase-macro
type998 val999)))))) (local-eval-hook211 (lambda (x1003 mod1004)
(primitive-eval (list noexpand204 (let ((atom-key1005 (fluid-ref *mode*205)))
(if (memv atom-key1005 (quote (c))) ((@ (language tree-il) tree-il->scheme)
x1003) x1003)))))) (top-level-eval-hook210 (lambda (x1006 mod1007)
(primitive-eval (list noexpand204 (let ((atom-key1008 (fluid-ref *mode*205)))
(if (memv atom-key1008 (quote (c))) ((@ (language tree-il) tree-il->scheme)
x1006) x1006)))))) (fx<209 <) (fx=208 =) (fx-207 -) (fx+206 +) (*mode*205
(make-fluid)) (noexpand204 "noexpand")) (begin (global-extend246 (quote
local-syntax) (quote letrec-syntax) #t) (global-extend246 (quote local-syntax)
(quote let-syntax) #f) (global-extend246 (quote core) (quote fluid-let-syntax)
(lambda (e1009 r1010 w1011 s1012 mod1013) ((lambda (tmp1014) ((lambda (tmp1015)
(if (if tmp1015 (apply (lambda (_1016 var1017 val1018 e11019 e21020)
(valid-bound-ids?273 var1017)) tmp1015) #f) (apply (lambda (_1022 var1023
val1024 e11025 e21026) (let ((names1027 (map (lambda (x1028) (id-var-name270
x1028 w1011)) var1023))) (begin (for-each (lambda (id1030 n1031) (let
((atom-key1032 (binding-type240 (lookup245 n1031 r1010 mod1013)))) (if (memv
atom-key1032 (quote (displaced-lexical))) (syntax-violation (quote
fluid-let-syntax) "identifier out of context" e1009 (source-wrap277 id1030
w1011 s1012 mod1013))))) var1023 names1027) (chi-body288 (cons e11025 e21026)
(source-wrap277 e1009 w1011 s1012 mod1013) (extend-env242 names1027 (let
((trans-r1035 (macros-only-env244 r1010))) (map (lambda (x1036) (cons (quote
macro) (eval-local-transformer291 (chi284 x1036 trans-r1035 w1011 mod1013)
mod1013))) val1024)) r1010) w1011 mod1013)))) tmp1015) ((lambda (_1038)
(syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap277 e1009
w1011 s1012 mod1013))) tmp1014))) ($sc-dispatch tmp1014 (quote (any #(each (any
any)) any . each-any))))) e1009))) (global-extend246 (quote core) (quote quote)
(lambda (e1039 r1040 w1041 s1042 mod1043) ((lambda (tmp1044) ((lambda (tmp1045)
(if tmp1045 (apply (lambda (_1046 e1047) (build-data226 s1042 (strip294 e1047
w1041))) tmp1045) ((lambda (_1048) (syntax-violation (quote quote) "bad syntax"
(source-wrap277 e1039 w1041 s1042 mod1043))) tmp1044))) ($sc-dispatch tmp1044
(quote (any any))))) e1039))) (global-extend246 (quote core) (quote syntax)
(letrec ((regen1056 (lambda (x1057) (let ((atom-key1058 (car x1057))) (if (memv
atom-key1058 (quote (ref))) (build-lexical-reference217 (quote value) #f (cadr
x1057) (cadr x1057)) (if (memv atom-key1058 (quote (primitive)))
(build-primref225 #f (cadr x1057)) (if (memv atom-key1058 (quote (quote)))
(build-data226 #f (cadr x1057)) (if (memv atom-key1058 (quote (lambda)))
(build-lambda224 #f (cadr x1057) (cadr x1057) #f (regen1056 (caddr x1057)))
(build-application215 #f (build-primref225 #f (car x1057)) (map regen1056 (cdr
x1057)))))))))) (gen-vector1055 (lambda (x1059) (if (eq? (car x1059) (quote
list)) (cons (quote vector) (cdr x1059)) (if (eq? (car x1059) (quote quote))
(list (quote quote) (list->vector (cadr x1059))) (list (quote list->vector)
x1059))))) (gen-append1054 (lambda (x1060 y1061) (if (equal? y1061 (quote
(quote ()))) x1060 (list (quote append) x1060 y1061)))) (gen-cons1053 (lambda
(x1062 y1063) (let ((atom-key1064 (car y1063))) (if (memv atom-key1064 (quote
(quote))) (if (eq? (car x1062) (quote quote)) (list (quote quote) (cons (cadr
x1062) (cadr y1063))) (if (eq? (cadr y1063) (quote ())) (list (quote list)
x1062) (list (quote cons) x1062 y1063))) (if (memv atom-key1064 (quote (list)))
(cons (quote list) (cons x1062 (cdr y1063))) (list (quote cons) x1062
y1063)))))) (gen-map1052 (lambda (e1065 map-env1066) (let ((formals1067 (map
cdr map-env1066)) (actuals1068 (map (lambda (x1069) (list (quote ref) (car
x1069))) map-env1066))) (if (eq? (car e1065) (quote ref)) (car actuals1068) (if
(and-map (lambda (x1070) (if (eq? (car x1070) (quote ref)) (memq (cadr x1070)
formals1067) #f)) (cdr e1065)) (cons (quote map) (cons (list (quote primitive)
(car e1065)) (map (let ((r1071 (map cons formals1067 actuals1068))) (lambda
(x1072) (cdr (assq (cadr x1072) r1071)))) (cdr e1065)))) (cons (quote map)
(cons (list (quote lambda) formals1067 e1065) actuals1068)))))))
(gen-mappend1051 (lambda (e1073 map-env1074) (list (quote apply) (quote
(primitive append)) (gen-map1052 e1073 map-env1074)))) (gen-ref1050 (lambda
(src1075 var1076 level1077 maps1078) (if (fx=208 level1077 0) (values var1076
maps1078) (if (null? maps1078) (syntax-violation (quote syntax) "missing
ellipsis" src1075) (call-with-values (lambda () (gen-ref1050 src1075 var1076
(fx-207 level1077 1) (cdr maps1078))) (lambda (outer-var1079 outer-maps1080)
(let ((b1081 (assq outer-var1079 (car maps1078)))) (if b1081 (values (cdr
b1081) maps1078) (let ((inner-var1082 (gen-var295 (quote tmp)))) (values
inner-var1082 (cons (cons (cons outer-var1079 inner-var1082) (car maps1078))
outer-maps1080))))))))))) (gen-syntax1049 (lambda (src1083 e1084 r1085 maps1086
ellipsis?1087 mod1088) (if (id?248 e1084) (let ((label1089 (id-var-name270
e1084 (quote (()))))) (let ((b1090 (lookup245 label1089 r1085 mod1088))) (if
(eq? (binding-type240 b1090) (quote syntax)) (call-with-values (lambda () (let
((var.lev1091 (binding-value241 b1090))) (gen-ref1050 src1083 (car var.lev1091)
(cdr var.lev1091) maps1086))) (lambda (var1092 maps1093) (values (list (quote
ref) var1092) maps1093))) (if (ellipsis?1087 e1084) (syntax-violation (quote
syntax) "misplaced ellipsis" src1083) (values (list (quote quote) e1084)
maps1086))))) ((lambda (tmp1094) ((lambda (tmp1095) (if (if tmp1095 (apply
(lambda (dots1096 e1097) (ellipsis?1087 dots1096)) tmp1095) #f) (apply (lambda
(dots1098 e1099) (gen-syntax1049 src1083 e1099 r1085 maps1086 (lambda (x1100)
#f) mod1088)) tmp1095) ((lambda (tmp1101) (if (if tmp1101 (apply (lambda (x1102
dots1103 y1104) (ellipsis?1087 dots1103)) tmp1101) #f) (apply (lambda (x1105
dots1106 y1107) (letrec ((f1108 (lambda (y1109 k1110) ((lambda (tmp1114)
((lambda (tmp1115) (if (if tmp1115 (apply (lambda (dots1116 y1117)
(ellipsis?1087 dots1116)) tmp1115) #f) (apply (lambda (dots1118 y1119) (f1108
y1119 (lambda (maps1120) (call-with-values (lambda () (k1110 (cons (quote ())
maps1120))) (lambda (x1121 maps1122) (if (null? (car maps1122))
(syntax-violation (quote syntax) "extra ellipsis" src1083) (values
(gen-mappend1051 x1121 (car maps1122)) (cdr maps1122)))))))) tmp1115) ((lambda
(_1123) (call-with-values (lambda () (gen-syntax1049 src1083 y1109 r1085
maps1086 ellipsis?1087 mod1088)) (lambda (y1124 maps1125) (call-with-values
(lambda () (k1110 maps1125)) (lambda (x1126 maps1127) (values (gen-append1054
x1126 y1124) maps1127)))))) tmp1114))) ($sc-dispatch tmp1114 (quote (any .
any))))) y1109)))) (f1108 y1107 (lambda (maps1111) (call-with-values (lambda ()
(gen-syntax1049 src1083 x1105 r1085 (cons (quote ()) maps1111) ellipsis?1087
mod1088)) (lambda (x1112 maps1113) (if (null? (car maps1113)) (syntax-violation
(quote syntax) "extra ellipsis" src1083) (values (gen-map1052 x1112 (car
maps1113)) (cdr maps1113))))))))) tmp1101) ((lambda (tmp1128) (if tmp1128
(apply (lambda (x1129 y1130) (call-with-values (lambda () (gen-syntax1049
src1083 x1129 r1085 maps1086 ellipsis?1087 mod1088)) (lambda (x1131 maps1132)
(call-with-values (lambda () (gen-syntax1049 src1083 y1130 r1085 maps1132
ellipsis?1087 mod1088)) (lambda (y1133 maps1134) (values (gen-cons1053 x1131
y1133) maps1134)))))) tmp1128) ((lambda (tmp1135) (if tmp1135 (apply (lambda
(e11136 e21137) (call-with-values (lambda () (gen-syntax1049 src1083 (cons
e11136 e21137) r1085 maps1086 ellipsis?1087 mod1088)) (lambda (e1139 maps1140)
(values (gen-vector1055 e1139) maps1140)))) tmp1135) ((lambda (_1141) (values
(list (quote quote) e1084) maps1086)) tmp1094))) ($sc-dispatch tmp1094 (quote
#(vector (any . each-any))))))) ($sc-dispatch tmp1094 (quote (any . any))))))
($sc-dispatch tmp1094 (quote (any any . any)))))) ($sc-dispatch tmp1094 (quote
(any any))))) e1084))))) (lambda (e1142 r1143 w1144 s1145 mod1146) (let ((e1147
(source-wrap277 e1142 w1144 s1145 mod1146))) ((lambda (tmp1148) ((lambda
(tmp1149) (if tmp1149 (apply (lambda (_1150 x1151) (call-with-values (lambda ()
(gen-syntax1049 e1147 x1151 r1143 (quote ()) ellipsis?293 mod1146)) (lambda
(e1152 maps1153) (regen1056 e1152)))) tmp1149) ((lambda (_1154)
(syntax-violation (quote syntax) "bad `syntax' form" e1147)) tmp1148)))
($sc-dispatch tmp1148 (quote (any any))))) e1147))))) (global-extend246 (quote
core) (quote lambda) (lambda (e1155 r1156 w1157 s1158 mod1159) ((lambda
(tmp1160) ((lambda (tmp1161) (if tmp1161 (apply (lambda (_1162 c1163)
(chi-lambda-clause289 (source-wrap277 e1155 w1157 s1158 mod1159) #f c1163 r1156
w1157 mod1159 (lambda (names1164 vars1165 docstring1166 body1167)
(build-lambda224 s1158 names1164 vars1165 docstring1166 body1167)))) tmp1161)
(syntax-violation #f "source expression failed to match any pattern" tmp1160)))
($sc-dispatch tmp1160 (quote (any . any))))) e1155))) (global-extend246 (quote
core) (quote let) (letrec ((chi-let1168 (lambda (e1169 r1170 w1171 s1172
mod1173 constructor1174 ids1175 vals1176 exps1177) (if (not
(valid-bound-ids?273 ids1175)) (syntax-violation (quote let) "duplicate bound
variable" e1169) (let ((labels1178 (gen-labels254 ids1175)) (new-vars1179 (map
gen-var295 ids1175))) (let ((nw1180 (make-binding-wrap265 ids1175 labels1178
w1171)) (nr1181 (extend-var-env243 labels1178 new-vars1179 r1170)))
(constructor1174 s1172 (map syntax->datum ids1175) new-vars1179 (map (lambda
(x1182) (chi284 x1182 r1170 w1171 mod1173)) vals1176) (chi-body288 exps1177
(source-wrap277 e1169 nw1180 s1172 mod1173) nr1181 nw1180 mod1173))))))))
(lambda (e1183 r1184 w1185 s1186 mod1187) ((lambda (tmp1188) ((lambda (tmp1189)
(if (if tmp1189 (apply (lambda (_1190 id1191 val1192 e11193 e21194) (and-map
id?248 id1191)) tmp1189) #f) (apply (lambda (_1196 id1197 val1198 e11199
e21200) (chi-let1168 e1183 r1184 w1185 s1186 mod1187 build-let228 id1197
val1198 (cons e11199 e21200))) tmp1189) ((lambda (tmp1204) (if (if tmp1204
(apply (lambda (_1205 f1206 id1207 val1208 e11209 e21210) (if (id?248 f1206)
(and-map id?248 id1207) #f)) tmp1204) #f) (apply (lambda (_1212 f1213 id1214
val1215 e11216 e21217) (chi-let1168 e1183 r1184 w1185 s1186 mod1187
build-named-let229 (cons f1213 id1214) val1215 (cons e11216 e21217))) tmp1204)
((lambda (_1221) (syntax-violation (quote let) "bad let" (source-wrap277 e1183
w1185 s1186 mod1187))) tmp1188))) ($sc-dispatch tmp1188 (quote (any any #(each
(any any)) any . each-any)))))) ($sc-dispatch tmp1188 (quote (any #(each (any
any)) any . each-any))))) e1183)))) (global-extend246 (quote core) (quote
letrec) (lambda (e1222 r1223 w1224 s1225 mod1226) ((lambda (tmp1227) ((lambda
(tmp1228) (if (if tmp1228 (apply (lambda (_1229 id1230 val1231 e11232 e21233)
(and-map id?248 id1230)) tmp1228) #f) (apply (lambda (_1235 id1236 val1237
e11238 e21239) (let ((ids1240 id1236)) (if (not (valid-bound-ids?273 ids1240))
(syntax-violation (quote letrec) "duplicate bound variable" e1222) (let
((labels1242 (gen-labels254 ids1240)) (new-vars1243 (map gen-var295 ids1240)))
(let ((w1244 (make-binding-wrap265 ids1240 labels1242 w1224)) (r1245
(extend-var-env243 labels1242 new-vars1243 r1223))) (build-letrec230 s1225 (map
syntax->datum ids1240) new-vars1243 (map (lambda (x1246) (chi284 x1246 r1245
w1244 mod1226)) val1237) (chi-body288 (cons e11238 e21239) (source-wrap277
e1222 w1244 s1225 mod1226) r1245 w1244 mod1226))))))) tmp1228) ((lambda (_1249)
(syntax-violation (quote letrec) "bad letrec" (source-wrap277 e1222 w1224 s1225
mod1226))) tmp1227))) ($sc-dispatch tmp1227 (quote (any #(each (any any)) any .
each-any))))) e1222))) (global-extend246 (quote core) (quote set!) (lambda
(e1250 r1251 w1252 s1253 mod1254) ((lambda (tmp1255) ((lambda (tmp1256) (if (if
tmp1256 (apply (lambda (_1257 id1258 val1259) (id?248 id1258)) tmp1256) #f)
(apply (lambda (_1260 id1261 val1262) (let ((val1263 (chi284 val1262 r1251
w1252 mod1254)) (n1264 (id-var-name270 id1261 w1252))) (let ((b1265 (lookup245
n1264 r1251 mod1254))) (let ((atom-key1266 (binding-type240 b1265))) (if (memv
atom-key1266 (quote (lexical))) (build-lexical-assignment218 s1253
(syntax->datum id1261) (binding-value241 b1265) val1263) (if (memv atom-key1266
(quote (global))) (build-global-assignment221 s1253 n1264 val1263 mod1254) (if
(memv atom-key1266 (quote (displaced-lexical))) (syntax-violation (quote set!)
"identifier out of context" (wrap276 id1261 w1252 mod1254)) (syntax-violation
(quote set!) "bad set!" (source-wrap277 e1250 w1252 s1253 mod1254)))))))))
tmp1256) ((lambda (tmp1267) (if tmp1267 (apply (lambda (_1268 head1269 tail1270
val1271) (call-with-values (lambda () (syntax-type282 head1269 r1251 (quote
(())) #f #f mod1254)) (lambda (type1272 value1273 ee1274 ww1275 ss1276
modmod1277) (if (memv type1272 (quote (module-ref))) (let ((val1278 (chi284
val1271 r1251 w1252 mod1254))) (call-with-values (lambda () (value1273 (cons
head1269 tail1270))) (lambda (id1280 mod1281) (build-global-assignment221 s1253
id1280 val1278 mod1281)))) (build-application215 s1253 (chi284 (list (quote
#(syntax-object setter ((top) #(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
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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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))) head1269) r1251 w1252 mod1254) (map
(lambda (e1282) (chi284 e1282 r1251 w1252 mod1254)) (append tail1270 (list
val1271)))))))) tmp1267) ((lambda (_1284) (syntax-violation (quote set!) "bad
set!" (source-wrap277 e1250 w1252 s1253 mod1254))) tmp1255))) ($sc-dispatch
tmp1255 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1255 (quote
(any any any))))) e1250))) (global-extend246 (quote module-ref) (quote @)
(lambda (e1285) ((lambda (tmp1286) ((lambda (tmp1287) (if (if tmp1287 (apply
(lambda (_1288 mod1289 id1290) (if (and-map id?248 mod1289) (id?248 id1290)
#f)) tmp1287) #f) (apply (lambda (_1292 mod1293 id1294) (values (syntax->datum
id1294) (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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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))) mod1293)))) tmp1287)
(syntax-violation #f "source expression failed to match any pattern" tmp1286)))
($sc-dispatch tmp1286 (quote (any each-any any))))) e1285))) (global-extend246
(quote module-ref) (quote @@) (lambda (e1296) ((lambda (tmp1297) ((lambda
(tmp1298) (if (if tmp1298 (apply (lambda (_1299 mod1300 id1301) (if (and-map
id?248 mod1300) (id?248 id1301) #f)) tmp1298) #f) (apply (lambda (_1303 mod1304
id1305) (values (syntax->datum id1305) (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 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
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
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void 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))) mod1304)))) tmp1298)
(syntax-violation #f "source expression failed to match any pattern" tmp1297)))
($sc-dispatch tmp1297 (quote (any each-any any))))) e1296))) (global-extend246
(quote core) (quote if) (lambda (e1307 r1308 w1309 s1310 mod1311) ((lambda
(tmp1312) ((lambda (tmp1313) (if tmp1313 (apply (lambda (_1314 test1315
then1316) (build-conditional216 s1310 (chi284 test1315 r1308 w1309 mod1311)
(chi284 then1316 r1308 w1309 mod1311) (build-void214 #f))) tmp1313) ((lambda
(tmp1317) (if tmp1317 (apply (lambda (_1318 test1319 then1320 else1321)
(build-conditional216 s1310 (chi284 test1319 r1308 w1309 mod1311) (chi284
then1320 r1308 w1309 mod1311) (chi284 else1321 r1308 w1309 mod1311))) tmp1317)
(syntax-violation #f "source expression failed to match any pattern" tmp1312)))
($sc-dispatch tmp1312 (quote (any any any any)))))) ($sc-dispatch tmp1312
(quote (any any any))))) e1307))) (global-extend246 (quote begin) (quote begin)
(quote ())) (global-extend246 (quote define) (quote define) (quote ()))
(global-extend246 (quote define-syntax) (quote define-syntax) (quote ()))
(global-extend246 (quote eval-when) (quote eval-when) (quote ()))
(global-extend246 (quote core) (quote syntax-case) (letrec
((gen-syntax-case1325 (lambda (x1326 keys1327 clauses1328 r1329 mod1330) (if
(null? clauses1328) (build-application215 #f (build-primref225 #f (quote
syntax-violation)) (list (build-data226 #f #f) (build-data226 #f "source
expression failed to match any pattern") x1326)) ((lambda (tmp1331) ((lambda
(tmp1332) (if tmp1332 (apply (lambda (pat1333 exp1334) (if (if (id?248 pat1333)
(and-map (lambda (x1335) (not (free-id=?271 pat1333 x1335))) (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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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))) keys1327)) #f) (let ((labels1336
(list (gen-label253))) (var1337 (gen-var295 pat1333))) (build-application215 #f
(build-lambda224 #f (list (syntax->datum pat1333)) (list var1337) #f (chi284
exp1334 (extend-env242 labels1336 (list (cons (quote syntax) (cons var1337 0)))
r1329) (make-binding-wrap265 (list pat1333) labels1336 (quote (()))) mod1330))
(list x1326))) (gen-clause1324 x1326 keys1327 (cdr clauses1328) r1329 pat1333
#t exp1334 mod1330))) tmp1332) ((lambda (tmp1338) (if tmp1338 (apply (lambda
(pat1339 fender1340 exp1341) (gen-clause1324 x1326 keys1327 (cdr clauses1328)
r1329 pat1339 fender1340 exp1341 mod1330)) tmp1338) ((lambda (_1342)
(syntax-violation (quote syntax-case) "invalid clause" (car clauses1328)))
tmp1331))) ($sc-dispatch tmp1331 (quote (any any any)))))) ($sc-dispatch
tmp1331 (quote (any any))))) (car clauses1328))))) (gen-clause1324 (lambda
(x1343 keys1344 clauses1345 r1346 pat1347 fender1348 exp1349 mod1350)
(call-with-values (lambda () (convert-pattern1322 pat1347 keys1344)) (lambda
(p1351 pvars1352) (if (not (distinct-bound-ids?274 (map car pvars1352)))
(syntax-violation (quote syntax-case) "duplicate pattern variable" pat1347) (if
(not (and-map (lambda (x1353) (not (ellipsis?293 (car x1353)))) pvars1352))
(syntax-violation (quote syntax-case) "misplaced ellipsis" pat1347) (let
((y1354 (gen-var295 (quote tmp)))) (build-application215 #f (build-lambda224 #f
(list (quote tmp)) (list y1354) #f (let ((y1355 (build-lexical-reference217
(quote value) #f (quote tmp) y1354))) (build-conditional216 #f ((lambda
(tmp1356) ((lambda (tmp1357) (if tmp1357 (apply (lambda () y1355) tmp1357)
((lambda (_1358) (build-conditional216 #f y1355 (build-dispatch-call1323
pvars1352 fender1348 y1355 r1346 mod1350) (build-data226 #f #f))) tmp1356)))
($sc-dispatch tmp1356 (quote #(atom #t))))) fender1348)
(build-dispatch-call1323 pvars1352 exp1349 y1355 r1346 mod1350)
(gen-syntax-case1325 x1343 keys1344 clauses1345 r1346 mod1350)))) (list (if
(eq? p1351 (quote any)) (build-application215 #f (build-primref225 #f (quote
list)) (list x1343)) (build-application215 #f (build-primref225 #f (quote
$sc-dispatch)) (list x1343 (build-data226 #f p1351)))))))))))))
(build-dispatch-call1323 (lambda (pvars1359 exp1360 y1361 r1362 mod1363) (let
((ids1364 (map car pvars1359)) (levels1365 (map cdr pvars1359))) (let
((labels1366 (gen-labels254 ids1364)) (new-vars1367 (map gen-var295 ids1364)))
(build-application215 #f (build-primref225 #f (quote apply)) (list
(build-lambda224 #f (map syntax->datum ids1364) new-vars1367 #f (chi284 exp1360
(extend-env242 labels1366 (map (lambda (var1368 level1369) (cons (quote syntax)
(cons var1368 level1369))) new-vars1367 (map cdr pvars1359)) r1362)
(make-binding-wrap265 ids1364 labels1366 (quote (()))) mod1363)) y1361))))))
(convert-pattern1322 (lambda (pattern1370 keys1371) (letrec ((cvt1372 (lambda
(p1373 n1374 ids1375) (if (id?248 p1373) (if (bound-id-member?275 p1373
keys1371) (values (vector (quote free-id) p1373) ids1375) (values (quote any)
(cons (cons p1373 n1374) ids1375))) ((lambda (tmp1376) ((lambda (tmp1377) (if
(if tmp1377 (apply (lambda (x1378 dots1379) (ellipsis?293 dots1379)) tmp1377)
#f) (apply (lambda (x1380 dots1381) (call-with-values (lambda () (cvt1372 x1380
(fx+206 n1374 1) ids1375)) (lambda (p1382 ids1383) (values (if (eq? p1382
(quote any)) (quote each-any) (vector (quote each) p1382)) ids1383)))) tmp1377)
((lambda (tmp1384) (if tmp1384 (apply (lambda (x1385 y1386) (call-with-values
(lambda () (cvt1372 y1386 n1374 ids1375)) (lambda (y1387 ids1388)
(call-with-values (lambda () (cvt1372 x1385 n1374 ids1388)) (lambda (x1389
ids1390) (values (cons x1389 y1387) ids1390)))))) tmp1384) ((lambda (tmp1391)
(if tmp1391 (apply (lambda () (values (quote ()) ids1375)) tmp1391) ((lambda
(tmp1392) (if tmp1392 (apply (lambda (x1393) (call-with-values (lambda ()
(cvt1372 x1393 n1374 ids1375)) (lambda (p1395 ids1396) (values (vector (quote
vector) p1395) ids1396)))) tmp1392) ((lambda (x1397) (values (vector (quote
atom) (strip294 p1373 (quote (())))) ids1375)) tmp1376))) ($sc-dispatch tmp1376
(quote #(vector each-any)))))) ($sc-dispatch tmp1376 (quote ())))))
($sc-dispatch tmp1376 (quote (any . any)))))) ($sc-dispatch tmp1376 (quote (any
any))))) p1373))))) (cvt1372 pattern1370 0 (quote ())))))) (lambda (e1398 r1399
w1400 s1401 mod1402) (let ((e1403 (source-wrap277 e1398 w1400 s1401 mod1402)))
((lambda (tmp1404) ((lambda (tmp1405) (if tmp1405 (apply (lambda (_1406 val1407
key1408 m1409) (if (and-map (lambda (x1410) (if (id?248 x1410) (not
(ellipsis?293 x1410)) #f)) key1408) (let ((x1412 (gen-var295 (quote tmp))))
(build-application215 s1401 (build-lambda224 #f (list (quote tmp)) (list x1412)
#f (gen-syntax-case1325 (build-lexical-reference217 (quote value) #f (quote
tmp) x1412) key1408 m1409 r1399 mod1402)) (list (chi284 val1407 r1399 (quote
(())) mod1402)))) (syntax-violation (quote syntax-case) "invalid literals list"
e1403))) tmp1405) (syntax-violation #f "source expression failed to match any
pattern" tmp1404))) ($sc-dispatch tmp1404 (quote (any any each-any .
each-any))))) e1403))))) (set! sc-expand (lambda (x1416 . rest1415) (if (if
(pair? x1416) (equal? (car x1416) noexpand204) #f) (cadr x1416) (let ((m1417
(if (null? rest1415) (quote e) (car rest1415))) (esew1418 (if (let ((t1419
(null? rest1415))) (if t1419 t1419 (null? (cdr rest1415)))) (quote (eval))
(cadr rest1415)))) (with-fluid* *mode*205 m1417 (lambda () (chi-top283 x1416
(quote ()) (quote ((top))) m1417 esew1418 (cons (quote hygiene) (module-name
(current-module)))))))))) (set! identifier? (lambda (x1420) (nonsymbol-id?247
x1420))) (set! datum->syntax (lambda (id1421 datum1422) (make-syntax-object231
datum1422 (syntax-object-wrap234 id1421) #f))) (set! syntax->datum (lambda
(x1423) (strip294 x1423 (quote (()))))) (set! generate-temporaries (lambda
(ls1424) (begin (let ((x1425 ls1424)) (if (not (list? x1425)) (syntax-violation
(quote generate-temporaries) "invalid argument" x1425))) (map (lambda (x1426)
(wrap276 (gensym) (quote ((top))) #f)) ls1424)))) (set! free-identifier=?
(lambda (x1427 y1428) (begin (let ((x1429 x1427)) (if (not (nonsymbol-id?247
x1429)) (syntax-violation (quote free-identifier=?) "invalid argument" x1429)))
(let ((x1430 y1428)) (if (not (nonsymbol-id?247 x1430)) (syntax-violation
(quote free-identifier=?) "invalid argument" x1430))) (free-id=?271 x1427
y1428)))) (set! bound-identifier=? (lambda (x1431 y1432) (begin (let ((x1433
x1431)) (if (not (nonsymbol-id?247 x1433)) (syntax-violation (quote
bound-identifier=?) "invalid argument" x1433))) (let ((x1434 y1432)) (if (not
(nonsymbol-id?247 x1434)) (syntax-violation (quote bound-identifier=?) "invalid
argument" x1434))) (bound-id=?272 x1431 y1432)))) (set! syntax-violation
(lambda (who1438 message1437 form1436 . subform1435) (begin (let ((x1439
who1438)) (if (not ((lambda (x1440) (let ((t1441 (not x1440))) (if t1441 t1441
(let ((t1442 (string? x1440))) (if t1442 t1442 (symbol? x1440)))))) x1439))
(syntax-violation (quote syntax-violation) "invalid argument" x1439))) (let
((x1443 message1437)) (if (not (string? x1443)) (syntax-violation (quote
syntax-violation) "invalid argument" x1443))) (scm-error (quote syntax-error)
(quote sc-expand) (string-append (if who1438 "~a: " "") "~a " (if (null?
subform1435) "in ~a" "in subform `~s' of `~s'")) (let ((tail1444 (cons
message1437 (map (lambda (x1445) (strip294 x1445 (quote (())))) (append
subform1435 (list form1436)))))) (if who1438 (cons who1438 tail1444) tail1444))
#f)))) (letrec ((match1450 (lambda (e1451 p1452 w1453 r1454 mod1455) (if (not
r1454) #f (if (eq? p1452 (quote any)) (cons (wrap276 e1451 w1453 mod1455)
r1454) (if (syntax-object?232 e1451) (match*1449 (syntax-object-expression233
e1451) p1452 (join-wraps267 w1453 (syntax-object-wrap234 e1451)) r1454
(syntax-object-module235 e1451)) (match*1449 e1451 p1452 w1453 r1454
mod1455)))))) (match*1449 (lambda (e1456 p1457 w1458 r1459 mod1460) (if (null?
p1457) (if (null? e1456) r1459 #f) (if (pair? p1457) (if (pair? e1456)
(match1450 (car e1456) (car p1457) w1458 (match1450 (cdr e1456) (cdr p1457)
w1458 r1459 mod1460) mod1460) #f) (if (eq? p1457 (quote each-any)) (let ((l1461
(match-each-any1447 e1456 w1458 mod1460))) (if l1461 (cons l1461 r1459) #f))
(let ((atom-key1462 (vector-ref p1457 0))) (if (memv atom-key1462 (quote
(each))) (if (null? e1456) (match-empty1448 (vector-ref p1457 1) r1459) (let
((l1463 (match-each1446 e1456 (vector-ref p1457 1) w1458 mod1460))) (if l1463
(letrec ((collect1464 (lambda (l1465) (if (null? (car l1465)) r1459 (cons (map
car l1465) (collect1464 (map cdr l1465))))))) (collect1464 l1463)) #f))) (if
(memv atom-key1462 (quote (free-id))) (if (id?248 e1456) (if (free-id=?271
(wrap276 e1456 w1458 mod1460) (vector-ref p1457 1)) r1459 #f) #f) (if (memv
atom-key1462 (quote (atom))) (if (equal? (vector-ref p1457 1) (strip294 e1456
w1458)) r1459 #f) (if (memv atom-key1462 (quote (vector))) (if (vector? e1456)
(match1450 (vector->list e1456) (vector-ref p1457 1) w1458 r1459 mod1460)
#f))))))))))) (match-empty1448 (lambda (p1466 r1467) (if (null? p1466) r1467
(if (eq? p1466 (quote any)) (cons (quote ()) r1467) (if (pair? p1466)
(match-empty1448 (car p1466) (match-empty1448 (cdr p1466) r1467)) (if (eq?
p1466 (quote each-any)) (cons (quote ()) r1467) (let ((atom-key1468 (vector-ref
p1466 0))) (if (memv atom-key1468 (quote (each))) (match-empty1448 (vector-ref
p1466 1) r1467) (if (memv atom-key1468 (quote (free-id atom))) r1467 (if (memv
atom-key1468 (quote (vector))) (match-empty1448 (vector-ref p1466 1)
r1467))))))))))) (match-each-any1447 (lambda (e1469 w1470 mod1471) (if (pair?
e1469) (let ((l1472 (match-each-any1447 (cdr e1469) w1470 mod1471))) (if l1472
(cons (wrap276 (car e1469) w1470 mod1471) l1472) #f)) (if (null? e1469) (quote
()) (if (syntax-object?232 e1469) (match-each-any1447
(syntax-object-expression233 e1469) (join-wraps267 w1470 (syntax-object-wrap234
e1469)) mod1471) #f))))) (match-each1446 (lambda (e1473 p1474 w1475 mod1476)
(if (pair? e1473) (let ((first1477 (match1450 (car e1473) p1474 w1475 (quote
()) mod1476))) (if first1477 (let ((rest1478 (match-each1446 (cdr e1473) p1474
w1475 mod1476))) (if rest1478 (cons first1477 rest1478) #f)) #f)) (if (null?
e1473) (quote ()) (if (syntax-object?232 e1473) (match-each1446
(syntax-object-expression233 e1473) p1474 (join-wraps267 w1475
(syntax-object-wrap234 e1473)) (syntax-object-module235 e1473)) #f)))))) (set!
$sc-dispatch (lambda (e1479 p1480) (if (eq? p1480 (quote any)) (list e1479) (if
(syntax-object?232 e1479) (match*1449 (syntax-object-expression233 e1479) p1480
(syntax-object-wrap234 e1479) (quote ()) (syntax-object-module235 e1479))
(match*1449 e1479 p1480 (quote (())) (quote ()) #f)))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x1481) ((lambda
(tmp1482) ((lambda (tmp1483) (if tmp1483 (apply (lambda (_1484 e11485 e21486)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11485 e21486))) tmp1483) ((lambda (tmp1488) (if
tmp1488 (apply (lambda (_1489 out1490 in1491 e11492 e21493) (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))) in1491 (quote ()) (list out1490 (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 e11492 e21493))))) tmp1488) ((lambda
(tmp1495) (if tmp1495 (apply (lambda (_1496 out1497 in1498 e11499 e21500) (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))) in1498) (quote ()) (list out1497 (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 e11499 e21500))))) tmp1495) (syntax-violation #f "source
expression failed to match any pattern" tmp1482))) ($sc-dispatch tmp1482 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1482 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp1482 (quote (any () any .
each-any))))) x1481))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1504)
((lambda (tmp1505) ((lambda (tmp1506) (if tmp1506 (apply (lambda (_1507 k1508
keyword1509 pattern1510 template1511) (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 k1508 (map (lambda (tmp1514
tmp1513) (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)))
tmp1513) (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)))
tmp1514))) template1511 pattern1510)))))) tmp1506) (syntax-violation #f "source
expression failed to match any pattern" tmp1505))) ($sc-dispatch tmp1505 (quote
(any each-any . #(each ((any . any) any))))))) x1504))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x1515) ((lambda (tmp1516) ((lambda (tmp1517) (if
(if tmp1517 (apply (lambda (let*1518 x1519 v1520 e11521 e21522) (and-map
identifier? x1519)) tmp1517) #f) (apply (lambda (let*1524 x1525 v1526 e11527
e21528) (letrec ((f1529 (lambda (bindings1530) (if (null? bindings1530) (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 e11527 e21528)))
((lambda (tmp1534) ((lambda (tmp1535) (if tmp1535 (apply (lambda (body1536
binding1537) (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 binding1537) body1536)) tmp1535) (syntax-violation #f
"source expression failed to match any pattern" tmp1534))) ($sc-dispatch
tmp1534 (quote (any any))))) (list (f1529 (cdr bindings1530)) (car
bindings1530))))))) (f1529 (map list x1525 v1526)))) tmp1517) (syntax-violation
#f "source expression failed to match any pattern" tmp1516))) ($sc-dispatch
tmp1516 (quote (any #(each (any any)) any . each-any))))) x1515))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x1538) ((lambda (tmp1539) ((lambda (tmp1540)
(if tmp1540 (apply (lambda (_1541 var1542 init1543 step1544 e01545 e11546
c1547) ((lambda (tmp1548) ((lambda (tmp1549) (if tmp1549 (apply (lambda
(step1550) ((lambda (tmp1551) ((lambda (tmp1552) (if tmp1552 (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
var1542 init1543) (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))) e01545) (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 c1547 (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))) step1550))))))) tmp1552) ((lambda (tmp1557)
(if tmp1557 (apply (lambda (e11558 e21559) (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 var1542 init1543) (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))) e01545 (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 e11558 e21559)) (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 c1547 (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))) step1550))))))) tmp1557)
(syntax-violation #f "source expression failed to match any pattern" tmp1551)))
($sc-dispatch tmp1551 (quote (any . each-any)))))) ($sc-dispatch tmp1551 (quote
())))) e11546)) tmp1549) (syntax-violation #f "source expression failed to
match any pattern" tmp1548))) ($sc-dispatch tmp1548 (quote each-any)))) (map
(lambda (v1566 s1567) ((lambda (tmp1568) ((lambda (tmp1569) (if tmp1569 (apply
(lambda () v1566) tmp1569) ((lambda (tmp1570) (if tmp1570 (apply (lambda
(e1571) e1571) tmp1570) ((lambda (_1572) (syntax-violation (quote do) "bad step
expression" orig-x1538 s1567)) tmp1568))) ($sc-dispatch tmp1568 (quote
(any)))))) ($sc-dispatch tmp1568 (quote ())))) s1567)) var1542 step1544)))
tmp1540) (syntax-violation #f "source expression failed to match any pattern"
tmp1539))) ($sc-dispatch tmp1539 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x1538))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons1575 (lambda (x1579 y1580)
((lambda (tmp1581) ((lambda (tmp1582) (if tmp1582 (apply (lambda (x1583 y1584)
((lambda (tmp1585) ((lambda (tmp1586) (if tmp1586 (apply (lambda (dy1587)
((lambda (tmp1588) ((lambda (tmp1589) (if tmp1589 (apply (lambda (dx1590) (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 dx1590 dy1587))) tmp1589) ((lambda
(_1591) (if (null? dy1587) (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))) x1583) (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))) x1583 y1584))) tmp1588))) ($sc-dispatch
tmp1588 (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))))) x1583)) tmp1586) ((lambda (tmp1592) (if
tmp1592 (apply (lambda (stuff1593) (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 x1583 stuff1593))) tmp1592)
((lambda (else1594) (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))) x1583 y1584)) tmp1585))) ($sc-dispatch tmp1585
(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 tmp1585 (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))))) y1584)) tmp1582) (syntax-violation #f "source expression
failed to match any pattern" tmp1581))) ($sc-dispatch tmp1581 (quote (any
any))))) (list x1579 y1580)))) (quasiappend1576 (lambda (x1595 y1596) ((lambda
(tmp1597) ((lambda (tmp1598) (if tmp1598 (apply (lambda (x1599 y1600) ((lambda
(tmp1601) ((lambda (tmp1602) (if tmp1602 (apply (lambda () x1599) tmp1602)
((lambda (_1603) (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))) x1599 y1600)) tmp1601))) ($sc-dispatch tmp1601
(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))) ()))))) y1600))
tmp1598) (syntax-violation #f "source expression failed to match any pattern"
tmp1597))) ($sc-dispatch tmp1597 (quote (any any))))) (list x1595 y1596))))
(quasivector1577 (lambda (x1604) ((lambda (tmp1605) ((lambda (x1606) ((lambda
(tmp1607) ((lambda (tmp1608) (if tmp1608 (apply (lambda (x1609) (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
x1609))) tmp1608) ((lambda (tmp1611) (if tmp1611 (apply (lambda (x1612) (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))) x1612)) tmp1611)
((lambda (_1614) (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))) x1606)) tmp1607))) ($sc-dispatch tmp1607 (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 tmp1607 (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))))) x1606)) tmp1605)) x1604))) (quasi1578 (lambda
(p1615 lev1616) ((lambda (tmp1617) ((lambda (tmp1618) (if tmp1618 (apply
(lambda (p1619) (if (= lev1616 0) p1619 (quasicons1575 (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)))) (quasi1578 (list p1619) (- lev1616 1))))) tmp1618) ((lambda
(tmp1620) (if (if tmp1620 (apply (lambda (args1621) (= lev1616 0)) tmp1620) #f)
(apply (lambda (args1622) (syntax-violation (quote unquote) "unquote takes
exactly one argument" p1615 (cons (quote #(syntax-object unquote ((top)
#(ribcage #(args) #((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))) args1622)))
tmp1620) ((lambda (tmp1623) (if tmp1623 (apply (lambda (p1624 q1625) (if (=
lev1616 0) (quasiappend1576 p1624 (quasi1578 q1625 lev1616)) (quasicons1575
(quasicons1575 (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)))) (quasi1578 (list p1624) (- lev1616 1))) (quasi1578 q1625 lev1616))))
tmp1623) ((lambda (tmp1626) (if (if tmp1626 (apply (lambda (args1627 q1628) (=
lev1616 0)) tmp1626) #f) (apply (lambda (args1629 q1630) (syntax-violation
(quote unquote-splicing) "unquote-splicing takes exactly one argument" p1615
(cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args 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))) args1629))) tmp1626)
((lambda (tmp1631) (if tmp1631 (apply (lambda (p1632) (quasicons1575 (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)))) (quasi1578 (list p1632) (+ lev1616
1)))) tmp1631) ((lambda (tmp1633) (if tmp1633 (apply (lambda (p1634 q1635)
(quasicons1575 (quasi1578 p1634 lev1616) (quasi1578 q1635 lev1616))) tmp1633)
((lambda (tmp1636) (if tmp1636 (apply (lambda (x1637) (quasivector1577
(quasi1578 x1637 lev1616))) tmp1636) ((lambda (p1639) (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))) p1639)) tmp1617))) ($sc-dispatch tmp1617 (quote #(vector
each-any)))))) ($sc-dispatch tmp1617 (quote (any . any)))))) ($sc-dispatch
tmp1617 (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 tmp1617 (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 tmp1617 (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 tmp1617
(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)))))) ($sc-dispatch tmp1617 (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))))) p1615)))) (lambda
(x1640) ((lambda (tmp1641) ((lambda (tmp1642) (if tmp1642 (apply (lambda (_1643
e1644) (quasi1578 e1644 0)) tmp1642) (syntax-violation #f "source expression
failed to match any pattern" tmp1641))) ($sc-dispatch tmp1641 (quote (any
any))))) x1640)))))
-(define include (make-syncase-macro (quote macro) (lambda (x1645) (letrec
((read-file1646 (lambda (fn1647 k1648) (let ((p1649 (open-input-file fn1647)))
(letrec ((f1650 (lambda (x1651) (if (eof-object? x1651) (begin
(close-input-port p1649) (quote ())) (cons (datum->syntax k1648 x1651) (f1650
(read p1649))))))) (f1650 (read p1649))))))) ((lambda (tmp1652) ((lambda
(tmp1653) (if tmp1653 (apply (lambda (k1654 filename1655) (let ((fn1656
(syntax->datum filename1655))) ((lambda (tmp1657) ((lambda (tmp1658) (if
tmp1658 (apply (lambda (exp1659) (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))) exp1659)) tmp1658) (syntax-violation #f "source expression
failed to match any pattern" tmp1657))) ($sc-dispatch tmp1657 (quote
each-any)))) (read-file1646 fn1656 k1654)))) tmp1653) (syntax-violation #f
"source expression failed to match any pattern" tmp1652))) ($sc-dispatch
tmp1652 (quote (any any))))) x1645)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x1661) ((lambda
(tmp1662) ((lambda (tmp1663) (if tmp1663 (apply (lambda (_1664 e1665)
(syntax-violation (quote unquote) "expression not valid outside of quasiquote"
x1661)) tmp1663) (syntax-violation #f "source expression failed to match any
pattern" tmp1662))) ($sc-dispatch tmp1662 (quote (any any))))) x1661))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1666)
((lambda (tmp1667) ((lambda (tmp1668) (if tmp1668 (apply (lambda (_1669 e1670)
(syntax-violation (quote unquote-splicing) "expression not valid outside of
quasiquote" x1666)) tmp1668) (syntax-violation #f "source expression failed to
match any pattern" tmp1667))) ($sc-dispatch tmp1667 (quote (any any)))))
x1666))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x1671) ((lambda (tmp1672) ((lambda (tmp1673) (if
tmp1673 (apply (lambda (_1674 e1675 m11676 m21677) ((lambda (tmp1678) ((lambda
(body1679) (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))) e1675)) body1679))
tmp1678)) (letrec ((f1680 (lambda (clause1681 clauses1682) (if (null?
clauses1682) ((lambda (tmp1684) ((lambda (tmp1685) (if tmp1685 (apply (lambda
(e11686 e21687) (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 e11686 e21687))) tmp1685) ((lambda (tmp1689) (if
tmp1689 (apply (lambda (k1690 e11691 e21692) (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))) k1690)) (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 e11691 e21692)))) tmp1689)
((lambda (_1695) (syntax-violation (quote case) "bad clause" x1671 clause1681))
tmp1684))) ($sc-dispatch tmp1684 (quote (each-any any . each-any))))))
($sc-dispatch tmp1684 (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))))) clause1681) ((lambda (tmp1696) ((lambda (rest1697) ((lambda
(tmp1698) ((lambda (tmp1699) (if tmp1699 (apply (lambda (k1700 e11701 e21702)
(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))) k1700)) (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 e11701 e21702)) rest1697)) tmp1699)
((lambda (_1705) (syntax-violation (quote case) "bad clause" x1671 clause1681))
tmp1698))) ($sc-dispatch tmp1698 (quote (each-any any . each-any)))))
clause1681)) tmp1696)) (f1680 (car clauses1682) (cdr clauses1682))))))) (f1680
m11676 m21677)))) tmp1673) (syntax-violation #f "source expression failed to
match any pattern" tmp1672))) ($sc-dispatch tmp1672 (quote (any any any .
each-any))))) x1671))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1706)
((lambda (tmp1707) ((lambda (tmp1708) (if tmp1708 (apply (lambda (_1709 e1710)
(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)))
e1710)) (list (cons _1709 (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 e1710 (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)))))))))) tmp1708) (syntax-violation #f "source expression failed to
match any pattern" tmp1707))) ($sc-dispatch tmp1707 (quote (any any)))))
x1706))))
+(letrec ((and-map*17 (lambda (f57 first56 . rest55) (let ((t58 (null?
first56))) (if t58 t58 (if (null? rest55) (letrec ((andmap59 (lambda (first60)
(let ((x61 (car first60)) (first62 (cdr first60))) (if (null? first62) (f57
x61) (if (f57 x61) (andmap59 first62) #f)))))) (andmap59 first56)) (letrec
((andmap63 (lambda (first64 rest65) (let ((x66 (car first64)) (xr67 (map car
rest65)) (first68 (cdr first64)) (rest69 (map cdr rest65))) (if (null? first68)
(apply f57 (cons x66 xr67)) (if (apply f57 (cons x66 xr67)) (andmap63 first68
rest69) #f)))))) (andmap63 first56 rest55)))))))) (letrec ((lambda-var-list162
(lambda (vars286) (letrec ((lvl287 (lambda (vars288 ls289 w290) (if (pair?
vars288) (lvl287 (cdr vars288) (cons (wrap142 (car vars288) w290 #f) ls289)
w290) (if (id?114 vars288) (cons (wrap142 vars288 w290 #f) ls289) (if (null?
vars288) ls289 (if (syntax-object?98 vars288) (lvl287
(syntax-object-expression99 vars288) ls289 (join-wraps133 w290
(syntax-object-wrap100 vars288))) (cons vars288 ls289)))))))) (lvl287 vars286
(quote ()) (quote (())))))) (gen-var161 (lambda (id291) (let ((id292 (if
(syntax-object?98 id291) (syntax-object-expression99 id291) id291))) (gensym
(symbol->string id292))))) (strip160 (lambda (x293 w294) (if (memq (quote top)
(wrap-marks117 w294)) x293 (letrec ((f295 (lambda (x296) (if (syntax-object?98
x296) (strip160 (syntax-object-expression99 x296) (syntax-object-wrap100 x296))
(if (pair? x296) (let ((a297 (f295 (car x296))) (d298 (f295 (cdr x296)))) (if
(if (eq? a297 (car x296)) (eq? d298 (cdr x296)) #f) x296 (cons a297 d298))) (if
(vector? x296) (let ((old299 (vector->list x296))) (let ((new300 (map f295
old299))) (if (and-map*17 eq? old299 new300) x296 (list->vector new300))))
x296)))))) (f295 x293))))) (ellipsis?159 (lambda (x301) (if (nonsymbol-id?113
x301) (free-id=?137 x301 (quote #(syntax-object ... ((top) #(ribcage () () ())
#(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list
gen-var strip 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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)))) #f))) (chi-void158 (lambda ()
(build-void80 #f))) (eval-local-transformer157 (lambda (expanded302 mod303)
(let ((p304 (local-eval-hook77 expanded302 mod303))) (if (procedure? p304) p304
(syntax-violation #f "nonprocedure transformer" p304))))) (chi-local-syntax156
(lambda (rec?305 e306 r307 w308 s309 mod310 k311) ((lambda (tmp312) ((lambda
(tmp313) (if tmp313 (apply (lambda (_314 id315 val316 e1317 e2318) (let
((ids319 id315)) (if (not (valid-bound-ids?139 ids319)) (syntax-violation #f
"duplicate bound keyword" e306) (let ((labels321 (gen-labels120 ids319))) (let
((new-w322 (make-binding-wrap131 ids319 labels321 w308))) (k311 (cons e1317
e2318) (extend-env108 labels321 (let ((w324 (if rec?305 new-w322 w308))
(trans-r325 (macros-only-env110 r307))) (map (lambda (x326) (cons (quote macro)
(eval-local-transformer157 (chi150 x326 trans-r325 w324 mod310) mod310)))
val316)) r307) new-w322 s309 mod310)))))) tmp313) ((lambda (_328)
(syntax-violation #f "bad local syntax definition" (source-wrap143 e306 w308
s309 mod310))) tmp312))) ($sc-dispatch tmp312 (quote (any #(each (any any)) any
. each-any))))) e306))) (chi-lambda-clause155 (lambda (e329 docstring330 c331
r332 w333 mod334 k335) ((lambda (tmp336) ((lambda (tmp337) (if (if tmp337
(apply (lambda (args338 doc339 e1340 e2341) (if (string? (syntax->datum
doc339)) (not docstring330) #f)) tmp337) #f) (apply (lambda (args342 doc343
e1344 e2345) (chi-lambda-clause155 e329 doc343 (cons args342 (cons e1344
e2345)) r332 w333 mod334 k335)) tmp337) ((lambda (tmp347) (if tmp347 (apply
(lambda (id348 e1349 e2350) (let ((ids351 id348)) (if (not (valid-bound-ids?139
ids351)) (syntax-violation (quote lambda) "invalid parameter list" e329) (let
((labels353 (gen-labels120 ids351)) (new-vars354 (map gen-var161 ids351)))
(k335 (map syntax->datum ids351) new-vars354 (if docstring330 (syntax->datum
docstring330) #f) (chi-body154 (cons e1349 e2350) e329 (extend-var-env109
labels353 new-vars354 r332) (make-binding-wrap131 ids351 labels353 w333)
mod334)))))) tmp347) ((lambda (tmp356) (if tmp356 (apply (lambda (ids357 e1358
e2359) (let ((old-ids360 (lambda-var-list162 ids357))) (if (not
(valid-bound-ids?139 old-ids360)) (syntax-violation (quote lambda) "invalid
parameter list" e329) (let ((labels361 (gen-labels120 old-ids360)) (new-vars362
(map gen-var161 old-ids360))) (k335 (letrec ((f363 (lambda (ls1364 ls2365) (if
(null? ls1364) (syntax->datum ls2365) (f363 (cdr ls1364) (cons (syntax->datum
(car ls1364)) ls2365)))))) (f363 (cdr old-ids360) (car old-ids360))) (letrec
((f366 (lambda (ls1367 ls2368) (if (null? ls1367) ls2368 (f366 (cdr ls1367)
(cons (car ls1367) ls2368)))))) (f366 (cdr new-vars362) (car new-vars362))) (if
docstring330 (syntax->datum docstring330) #f) (chi-body154 (cons e1358 e2359)
e329 (extend-var-env109 labels361 new-vars362 r332) (make-binding-wrap131
old-ids360 labels361 w333) mod334)))))) tmp356) ((lambda (_370)
(syntax-violation (quote lambda) "bad lambda" e329)) tmp336))) ($sc-dispatch
tmp336 (quote (any any . each-any)))))) ($sc-dispatch tmp336 (quote (each-any
any . each-any)))))) ($sc-dispatch tmp336 (quote (any any any . each-any)))))
c331))) (chi-body154 (lambda (body371 outer-form372 r373 w374 mod375) (let
((r376 (cons (quote ("placeholder" placeholder)) r373))) (let ((ribcage377
(make-ribcage121 (quote ()) (quote ()) (quote ())))) (let ((w378 (make-wrap116
(wrap-marks117 w374) (cons ribcage377 (wrap-subst118 w374))))) (letrec
((parse379 (lambda (body380 ids381 labels382 var-ids383 vars384 vals385
bindings386) (if (null? body380) (syntax-violation #f "no expressions in body"
outer-form372) (let ((e388 (cdar body380)) (er389 (caar body380)))
(call-with-values (lambda () (syntax-type148 e388 er389 (quote (()))
(source-annotation105 er389) ribcage377 mod375 #f)) (lambda (type390 value391
e392 w393 s394 mod395) (if (memv type390 (quote (define-form))) (let ((id396
(wrap142 value391 w393 mod395)) (label397 (gen-label119))) (let ((var398
(gen-var161 id396))) (begin (extend-ribcage!130 ribcage377 id396 label397)
(parse379 (cdr body380) (cons id396 ids381) (cons label397 labels382) (cons
id396 var-ids383) (cons var398 vars384) (cons (cons er389 (wrap142 e392 w393
mod395)) vals385) (cons (cons (quote lexical) var398) bindings386))))) (if
(memv type390 (quote (define-syntax-form))) (let ((id399 (wrap142 value391 w393
mod395)) (label400 (gen-label119))) (begin (extend-ribcage!130 ribcage377 id399
label400) (parse379 (cdr body380) (cons id399 ids381) (cons label400 labels382)
var-ids383 vars384 vals385 (cons (cons (quote macro) (cons er389 (wrap142 e392
w393 mod395))) bindings386)))) (if (memv type390 (quote (begin-form))) ((lambda
(tmp401) ((lambda (tmp402) (if tmp402 (apply (lambda (_403 e1404) (parse379
(letrec ((f405 (lambda (forms406) (if (null? forms406) (cdr body380) (cons
(cons er389 (wrap142 (car forms406) w393 mod395)) (f405 (cdr forms406)))))))
(f405 e1404)) ids381 labels382 var-ids383 vars384 vals385 bindings386)) tmp402)
(syntax-violation #f "source expression failed to match any pattern" tmp401)))
($sc-dispatch tmp401 (quote (any . each-any))))) e392) (if (memv type390 (quote
(local-syntax-form))) (chi-local-syntax156 value391 e392 er389 w393 s394 mod395
(lambda (forms408 er409 w410 s411 mod412) (parse379 (letrec ((f413 (lambda
(forms414) (if (null? forms414) (cdr body380) (cons (cons er409 (wrap142 (car
forms414) w410 mod412)) (f413 (cdr forms414))))))) (f413 forms408)) ids381
labels382 var-ids383 vars384 vals385 bindings386))) (if (null? ids381)
(build-sequence93 #f (map (lambda (x415) (chi150 (cdr x415) (car x415) (quote
(())) mod395)) (cons (cons er389 (source-wrap143 e392 w393 s394 mod395)) (cdr
body380)))) (begin (if (not (valid-bound-ids?139 ids381)) (syntax-violation #f
"invalid or duplicate identifier in definition" outer-form372)) (letrec
((loop416 (lambda (bs417 er-cache418 r-cache419) (if (not (null? bs417)) (let
((b420 (car bs417))) (if (eq? (car b420) (quote macro)) (let ((er421 (cadr
b420))) (let ((r-cache422 (if (eq? er421 er-cache418) r-cache419
(macros-only-env110 er421)))) (begin (set-cdr! b420 (eval-local-transformer157
(chi150 (cddr b420) r-cache422 (quote (())) mod395) mod395)) (loop416 (cdr
bs417) er421 r-cache422)))) (loop416 (cdr bs417) er-cache418 r-cache419)))))))
(loop416 bindings386 #f #f)) (set-cdr! r376 (extend-env108 labels382
bindings386 (cdr r376))) (build-letrec96 #f (map syntax->datum var-ids383)
vars384 (map (lambda (x423) (chi150 (cdr x423) (car x423) (quote (())) mod395))
vals385) (build-sequence93 #f (map (lambda (x424) (chi150 (cdr x424) (car x424)
(quote (())) mod395)) (cons (cons er389 (source-wrap143 e392 w393 s394 mod395))
(cdr body380)))))))))))))))))) (parse379 (map (lambda (x387) (cons r376
(wrap142 x387 w378 mod375))) body371) (quote ()) (quote ()) (quote ()) (quote
()) (quote ()) (quote ())))))))) (chi-macro153 (lambda (p425 e426 r427 w428
rib429 mod430) (letrec ((rebuild-macro-output431 (lambda (x432 m433) (if (pair?
x432) (cons (rebuild-macro-output431 (car x432) m433) (rebuild-macro-output431
(cdr x432) m433)) (if (syntax-object?98 x432) (let ((w434
(syntax-object-wrap100 x432))) (let ((ms435 (wrap-marks117 w434)) (s436
(wrap-subst118 w434))) (if (if (pair? ms435) (eq? (car ms435) #f) #f)
(make-syntax-object97 (syntax-object-expression99 x432) (make-wrap116 (cdr
ms435) (if rib429 (cons rib429 (cdr s436)) (cdr s436)))
(syntax-object-module101 x432)) (make-syntax-object97
(syntax-object-expression99 x432) (make-wrap116 (cons m433 ms435) (if rib429
(cons rib429 (cons (quote shift) s436)) (cons (quote shift) s436))) (let
((pmod437 (procedure-module p425))) (if pmod437 (cons (quote hygiene)
(module-name pmod437)) (quote (hygiene guile)))))))) (if (vector? x432) (let
((n438 (vector-length x432))) (let ((v439 (make-vector n438))) (letrec
((loop440 (lambda (i441) (if (fx=74 i441 n438) (begin (if #f #f) v439) (begin
(vector-set! v439 i441 (rebuild-macro-output431 (vector-ref x432 i441) m433))
(loop440 (fx+72 i441 1))))))) (loop440 0)))) (if (symbol? x432)
(syntax-violation #f "encountered raw symbol in macro output" (source-wrap143
e426 w428 s mod430) x432) x432))))))) (rebuild-macro-output431 (p425 (wrap142
e426 (anti-mark129 w428) mod430)) (string #\m))))) (chi-application152 (lambda
(x442 e443 r444 w445 s446 mod447) ((lambda (tmp448) ((lambda (tmp449) (if
tmp449 (apply (lambda (e0450 e1451) (build-application81 s446 x442 (map (lambda
(e452) (chi150 e452 r444 w445 mod447)) e1451))) tmp449) (syntax-violation #f
"source expression failed to match any pattern" tmp448))) ($sc-dispatch tmp448
(quote (any . each-any))))) e443))) (chi-expr151 (lambda (type454 value455 e456
r457 w458 s459 mod460) (if (memv type454 (quote (lexical)))
(build-lexical-reference83 (quote value) s459 e456 value455) (if (memv type454
(quote (core core-form))) (value455 e456 r457 w458 s459 mod460) (if (memv
type454 (quote (module-ref))) (call-with-values (lambda () (value455 e456))
(lambda (id461 mod462) (build-global-reference86 s459 id461 mod462))) (if (memv
type454 (quote (lexical-call))) (chi-application152 (build-lexical-reference83
(quote fun) (source-annotation105 (car e456)) (car e456) value455) e456 r457
w458 s459 mod460) (if (memv type454 (quote (global-call))) (chi-application152
(build-global-reference86 (source-annotation105 (car e456)) (if
(syntax-object?98 value455) (syntax-object-expression99 value455) value455) (if
(syntax-object?98 value455) (syntax-object-module101 value455) mod460)) e456
r457 w458 s459 mod460) (if (memv type454 (quote (constant))) (build-data92 s459
(strip160 (source-wrap143 e456 w458 s459 mod460) (quote (())))) (if (memv
type454 (quote (global))) (build-global-reference86 s459 value455 mod460) (if
(memv type454 (quote (call))) (chi-application152 (chi150 (car e456) r457 w458
mod460) e456 r457 w458 s459 mod460) (if (memv type454 (quote (begin-form)))
((lambda (tmp463) ((lambda (tmp464) (if tmp464 (apply (lambda (_465 e1466
e2467) (chi-sequence144 (cons e1466 e2467) r457 w458 s459 mod460)) tmp464)
(syntax-violation #f "source expression failed to match any pattern" tmp463)))
($sc-dispatch tmp463 (quote (any any . each-any))))) e456) (if (memv type454
(quote (local-syntax-form))) (chi-local-syntax156 value455 e456 r457 w458 s459
mod460 chi-sequence144) (if (memv type454 (quote (eval-when-form))) ((lambda
(tmp469) ((lambda (tmp470) (if tmp470 (apply (lambda (_471 x472 e1473 e2474)
(let ((when-list475 (chi-when-list147 e456 x472 w458))) (if (memq (quote eval)
when-list475) (chi-sequence144 (cons e1473 e2474) r457 w458 s459 mod460)
(chi-void158)))) tmp470) (syntax-violation #f "source expression failed to
match any pattern" tmp469))) ($sc-dispatch tmp469 (quote (any each-any any .
each-any))))) e456) (if (memv type454 (quote (define-form define-syntax-form)))
(syntax-violation #f "definition in expression context" e456 (wrap142 value455
w458 mod460)) (if (memv type454 (quote (syntax))) (syntax-violation #f
"reference to pattern variable outside syntax form" (source-wrap143 e456 w458
s459 mod460)) (if (memv type454 (quote (displaced-lexical))) (syntax-violation
#f "reference to identifier outside its scope" (source-wrap143 e456 w458 s459
mod460)) (syntax-violation #f "unexpected syntax" (source-wrap143 e456 w458
s459 mod460)))))))))))))))))) (chi150 (lambda (e478 r479 w480 mod481)
(call-with-values (lambda () (syntax-type148 e478 r479 w480
(source-annotation105 e478) #f mod481 #f)) (lambda (type482 value483 e484 w485
s486 mod487) (chi-expr151 type482 value483 e484 r479 w485 s486 mod487)))))
(chi-top149 (lambda (e488 r489 w490 m491 esew492 mod493) (call-with-values
(lambda () (syntax-type148 e488 r489 w490 (source-annotation105 e488) #f mod493
#f)) (lambda (type501 value502 e503 w504 s505 mod506) (if (memv type501 (quote
(begin-form))) ((lambda (tmp507) ((lambda (tmp508) (if tmp508 (apply (lambda
(_509) (chi-void158)) tmp508) ((lambda (tmp510) (if tmp510 (apply (lambda (_511
e1512 e2513) (chi-top-sequence145 (cons e1512 e2513) r489 w504 s505 m491
esew492 mod506)) tmp510) (syntax-violation #f "source expression failed to
match any pattern" tmp507))) ($sc-dispatch tmp507 (quote (any any .
each-any)))))) ($sc-dispatch tmp507 (quote (any))))) e503) (if (memv type501
(quote (local-syntax-form))) (chi-local-syntax156 value502 e503 r489 w504 s505
mod506 (lambda (body515 r516 w517 s518 mod519) (chi-top-sequence145 body515
r516 w517 s518 m491 esew492 mod519))) (if (memv type501 (quote
(eval-when-form))) ((lambda (tmp520) ((lambda (tmp521) (if tmp521 (apply
(lambda (_522 x523 e1524 e2525) (let ((when-list526 (chi-when-list147 e503 x523
w504)) (body527 (cons e1524 e2525))) (if (eq? m491 (quote e)) (if (memq (quote
eval) when-list526) (chi-top-sequence145 body527 r489 w504 s505 (quote e)
(quote (eval)) mod506) (chi-void158)) (if (memq (quote load) when-list526) (if
(let ((t530 (memq (quote compile) when-list526))) (if t530 t530 (if (eq? m491
(quote c&e)) (memq (quote eval) when-list526) #f))) (chi-top-sequence145
body527 r489 w504 s505 (quote c&e) (quote (compile load)) mod506) (if (memq
m491 (quote (c c&e))) (chi-top-sequence145 body527 r489 w504 s505 (quote c)
(quote (load)) mod506) (chi-void158))) (if (let ((t531 (memq (quote compile)
when-list526))) (if t531 t531 (if (eq? m491 (quote c&e)) (memq (quote eval)
when-list526) #f))) (begin (top-level-eval-hook76 (chi-top-sequence145 body527
r489 w504 s505 (quote e) (quote (eval)) mod506) mod506) (chi-void158))
(chi-void158)))))) tmp521) (syntax-violation #f "source expression failed to
match any pattern" tmp520))) ($sc-dispatch tmp520 (quote (any each-any any .
each-any))))) e503) (if (memv type501 (quote (define-syntax-form))) (let ((n532
(id-var-name136 value502 w504)) (r533 (macros-only-env110 r489))) (if (memv
m491 (quote (c))) (if (memq (quote compile) esew492) (let ((e534
(chi-install-global146 n532 (chi150 e503 r533 w504 mod506)))) (begin
(top-level-eval-hook76 e534 mod506) (if (memq (quote load) esew492) e534
(chi-void158)))) (if (memq (quote load) esew492) (chi-install-global146 n532
(chi150 e503 r533 w504 mod506)) (chi-void158))) (if (memv m491 (quote (c&e)))
(let ((e535 (chi-install-global146 n532 (chi150 e503 r533 w504 mod506))))
(begin (top-level-eval-hook76 e535 mod506) e535)) (begin (if (memq (quote eval)
esew492) (top-level-eval-hook76 (chi-install-global146 n532 (chi150 e503 r533
w504 mod506)) mod506)) (chi-void158))))) (if (memv type501 (quote
(define-form))) (let ((n536 (id-var-name136 value502 w504))) (let ((type537
(binding-type106 (lookup111 n536 r489 mod506)))) (if (memv type537 (quote
(global core macro module-ref))) (let ((x538 (build-global-definition89 s505
n536 (chi150 e503 r489 w504 mod506)))) (begin (if (eq? m491 (quote c&e))
(top-level-eval-hook76 x538 mod506)) x538)) (if (memv type537 (quote
(displaced-lexical))) (syntax-violation #f "identifier out of context" e503
(wrap142 value502 w504 mod506)) (syntax-violation #f "cannot define keyword at
top level" e503 (wrap142 value502 w504 mod506)))))) (let ((x539 (chi-expr151
type501 value502 e503 r489 w504 s505 mod506))) (begin (if (eq? m491 (quote
c&e)) (top-level-eval-hook76 x539 mod506)) x539))))))))))) (syntax-type148
(lambda (e540 r541 w542 s543 rib544 mod545 for-car?546) (if (symbol? e540) (let
((n547 (id-var-name136 e540 w542))) (let ((b548 (lookup111 n547 r541 mod545)))
(let ((type549 (binding-type106 b548))) (if (memv type549 (quote (lexical)))
(values type549 (binding-value107 b548) e540 w542 s543 mod545) (if (memv
type549 (quote (global))) (values type549 n547 e540 w542 s543 mod545) (if (memv
type549 (quote (macro))) (if for-car?546 (values type549 (binding-value107
b548) e540 w542 s543 mod545) (syntax-type148 (chi-macro153 (binding-value107
b548) e540 r541 w542 rib544 mod545) r541 (quote (())) s543 rib544 mod545 #f))
(values type549 (binding-value107 b548) e540 w542 s543 mod545))))))) (if (pair?
e540) (let ((first550 (car e540))) (call-with-values (lambda () (syntax-type148
first550 r541 w542 s543 rib544 mod545 #t)) (lambda (ftype551 fval552 fe553
fw554 fs555 fmod556) (if (memv ftype551 (quote (lexical))) (values (quote
lexical-call) fval552 e540 w542 s543 mod545) (if (memv ftype551 (quote
(global))) (values (quote global-call) (make-syntax-object97 fval552 w542
fmod556) e540 w542 s543 mod545) (if (memv ftype551 (quote (macro)))
(syntax-type148 (chi-macro153 fval552 e540 r541 w542 rib544 mod545) r541 (quote
(())) s543 rib544 mod545 for-car?546) (if (memv ftype551 (quote (module-ref)))
(call-with-values (lambda () (fval552 e540)) (lambda (sym557 mod558)
(syntax-type148 sym557 r541 w542 s543 rib544 mod558 for-car?546))) (if (memv
ftype551 (quote (core))) (values (quote core-form) fval552 e540 w542 s543
mod545) (if (memv ftype551 (quote (local-syntax))) (values (quote
local-syntax-form) fval552 e540 w542 s543 mod545) (if (memv ftype551 (quote
(begin))) (values (quote begin-form) #f e540 w542 s543 mod545) (if (memv
ftype551 (quote (eval-when))) (values (quote eval-when-form) #f e540 w542 s543
mod545) (if (memv ftype551 (quote (define))) ((lambda (tmp559) ((lambda
(tmp560) (if (if tmp560 (apply (lambda (_561 name562 val563) (id?114 name562))
tmp560) #f) (apply (lambda (_564 name565 val566) (values (quote define-form)
name565 val566 w542 s543 mod545)) tmp560) ((lambda (tmp567) (if (if tmp567
(apply (lambda (_568 name569 args570 e1571 e2572) (if (id?114 name569)
(valid-bound-ids?139 (lambda-var-list162 args570)) #f)) tmp567) #f) (apply
(lambda (_573 name574 args575 e1576 e2577) (values (quote define-form) (wrap142
name574 w542 mod545) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_
name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ftype fval fe fw fs fmod)
#((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(e r w s rib mod for-car?) #((top) (top)
(top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip 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
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
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void 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))) (wrap142 (cons args575 (cons e1576
e2577)) w542 mod545)) (quote (())) s543 mod545)) tmp567) ((lambda (tmp579) (if
(if tmp579 (apply (lambda (_580 name581) (id?114 name581)) tmp579) #f) (apply
(lambda (_582 name583) (values (quote define-form) (wrap142 name583 w542
mod545) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top))
#("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(ftype fval fe
fw fs fmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i"))
#(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage () () ()) #(ribcage #(e r w s rib mod for-car?)
#((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i"))
#(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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 () () ())
#(ribcage #(ftype fval fe fw fs fmod) #((top) (top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(first) #((top))
#("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage
#(e r w s rib mod for-car?) #((top) (top) (top) (top) (top) (top) (top)) #("i"
"i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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 () () ())
#(ribcage #(ftype fval fe fw fs fmod) #((top) (top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(first) #((top))
#("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage
#(e r w s rib mod for-car?) #((top) (top) (top) (top) (top) (top) (top)) #("i"
"i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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 (())) s543 mod545)) tmp579)
(syntax-violation #f "source expression failed to match any pattern" tmp559)))
($sc-dispatch tmp559 (quote (any any)))))) ($sc-dispatch tmp559 (quote (any
(any . any) any . each-any)))))) ($sc-dispatch tmp559 (quote (any any any)))))
e540) (if (memv ftype551 (quote (define-syntax))) ((lambda (tmp584) ((lambda
(tmp585) (if (if tmp585 (apply (lambda (_586 name587 val588) (id?114 name587))
tmp585) #f) (apply (lambda (_589 name590 val591) (values (quote
define-syntax-form) name590 val591 w542 s543 mod545)) tmp585) (syntax-violation
#f "source expression failed to match any pattern" tmp584))) ($sc-dispatch
tmp584 (quote (any any any))))) e540) (values (quote call) #f e540 w542 s543
mod545)))))))))))))) (if (syntax-object?98 e540) (syntax-type148
(syntax-object-expression99 e540) r541 (join-wraps133 w542
(syntax-object-wrap100 e540)) s543 rib544 (let ((t592 (syntax-object-module101
e540))) (if t592 t592 mod545)) for-car?546) (if (self-evaluating? e540) (values
(quote constant) #f e540 w542 s543 mod545) (values (quote other) #f e540 w542
s543 mod545))))))) (chi-when-list147 (lambda (e593 when-list594 w595) (letrec
((f596 (lambda (when-list597 situations598) (if (null? when-list597)
situations598 (f596 (cdr when-list597) (cons (let ((x599 (car when-list597)))
(if (free-id=?137 x599 (quote #(syntax-object compile ((top) #(ribcage () ()
()) #(ribcage () () ()) #(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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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) (if (free-id=?137
x599 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage () () ())
#(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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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) (if (free-id=?137
x599 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage () () ())
#(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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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) (syntax-violation
(quote eval-when) "invalid situation" e593 (wrap142 x599 w595 #f))))))
situations598)))))) (f596 when-list594 (quote ()))))) (chi-install-global146
(lambda (name600 e601) (build-global-definition89 #f name600 (if (let ((v602
(module-variable (current-module) name600))) (if v602 (if (variable-bound?
v602) (if (macro? (variable-ref v602)) (not (eq? (macro-type (variable-ref
v602)) (quote syncase-macro))) #f) #f) #f)) (build-application81 #f
(build-primref91 #f (quote make-extended-syncase-macro)) (list
(build-application81 #f (build-primref91 #f (quote module-ref)) (list
(build-application81 #f (build-primref91 #f (quote current-module)) (quote ()))
(build-data92 #f name600))) (build-data92 #f (quote macro)) e601))
(build-application81 #f (build-primref91 #f (quote make-syncase-macro)) (list
(build-data92 #f (quote macro)) e601)))))) (chi-top-sequence145 (lambda
(body603 r604 w605 s606 m607 esew608 mod609) (build-sequence93 s606 (letrec
((dobody610 (lambda (body611 r612 w613 m614 esew615 mod616) (if (null? body611)
(quote ()) (let ((first617 (chi-top149 (car body611) r612 w613 m614 esew615
mod616))) (cons first617 (dobody610 (cdr body611) r612 w613 m614 esew615
mod616))))))) (dobody610 body603 r604 w605 m607 esew608 mod609)))))
(chi-sequence144 (lambda (body618 r619 w620 s621 mod622) (build-sequence93 s621
(letrec ((dobody623 (lambda (body624 r625 w626 mod627) (if (null? body624)
(quote ()) (let ((first628 (chi150 (car body624) r625 w626 mod627))) (cons
first628 (dobody623 (cdr body624) r625 w626 mod627))))))) (dobody623 body618
r619 w620 mod622))))) (source-wrap143 (lambda (x629 w630 s631 defmod632) (begin
(if (if s631 (pair? x629) #f) (set-source-properties! x629 s631)) (wrap142 x629
w630 defmod632)))) (wrap142 (lambda (x633 w634 defmod635) (if (if (null?
(wrap-marks117 w634)) (null? (wrap-subst118 w634)) #f) x633 (if
(syntax-object?98 x633) (make-syntax-object97 (syntax-object-expression99 x633)
(join-wraps133 w634 (syntax-object-wrap100 x633)) (syntax-object-module101
x633)) (if (null? x633) x633 (make-syntax-object97 x633 w634 defmod635))))))
(bound-id-member?141 (lambda (x636 list637) (if (not (null? list637)) (let
((t638 (bound-id=?138 x636 (car list637)))) (if t638 t638 (bound-id-member?141
x636 (cdr list637)))) #f))) (distinct-bound-ids?140 (lambda (ids639) (letrec
((distinct?640 (lambda (ids641) (let ((t642 (null? ids641))) (if t642 t642 (if
(not (bound-id-member?141 (car ids641) (cdr ids641))) (distinct?640 (cdr
ids641)) #f)))))) (distinct?640 ids639)))) (valid-bound-ids?139 (lambda
(ids643) (if (letrec ((all-ids?644 (lambda (ids645) (let ((t646 (null?
ids645))) (if t646 t646 (if (id?114 (car ids645)) (all-ids?644 (cdr ids645))
#f)))))) (all-ids?644 ids643)) (distinct-bound-ids?140 ids643) #f)))
(bound-id=?138 (lambda (i647 j648) (if (if (syntax-object?98 i647)
(syntax-object?98 j648) #f) (if (eq? (syntax-object-expression99 i647)
(syntax-object-expression99 j648)) (same-marks?135 (wrap-marks117
(syntax-object-wrap100 i647)) (wrap-marks117 (syntax-object-wrap100 j648))) #f)
(eq? i647 j648)))) (free-id=?137 (lambda (i649 j650) (if (eq? (let ((x651
i649)) (if (syntax-object?98 x651) (syntax-object-expression99 x651) x651))
(let ((x652 j650)) (if (syntax-object?98 x652) (syntax-object-expression99
x652) x652))) (eq? (id-var-name136 i649 (quote (()))) (id-var-name136 j650
(quote (())))) #f))) (id-var-name136 (lambda (id653 w654) (letrec
((search-vector-rib657 (lambda (sym663 subst664 marks665 symnames666
ribcage667) (let ((n668 (vector-length symnames666))) (letrec ((f669 (lambda
(i670) (if (fx=74 i670 n668) (search655 sym663 (cdr subst664) marks665) (if (if
(eq? (vector-ref symnames666 i670) sym663) (same-marks?135 marks665 (vector-ref
(ribcage-marks124 ribcage667) i670)) #f) (values (vector-ref (ribcage-labels125
ribcage667) i670) marks665) (f669 (fx+72 i670 1))))))) (f669 0)))))
(search-list-rib656 (lambda (sym671 subst672 marks673 symnames674 ribcage675)
(letrec ((f676 (lambda (symnames677 i678) (if (null? symnames677) (search655
sym671 (cdr subst672) marks673) (if (if (eq? (car symnames677) sym671)
(same-marks?135 marks673 (list-ref (ribcage-marks124 ribcage675) i678)) #f)
(values (list-ref (ribcage-labels125 ribcage675) i678) marks673) (f676 (cdr
symnames677) (fx+72 i678 1))))))) (f676 symnames674 0)))) (search655 (lambda
(sym679 subst680 marks681) (if (null? subst680) (values #f marks681) (let
((fst682 (car subst680))) (if (eq? fst682 (quote shift)) (search655 sym679 (cdr
subst680) (cdr marks681)) (let ((symnames683 (ribcage-symnames123 fst682))) (if
(vector? symnames683) (search-vector-rib657 sym679 subst680 marks681
symnames683 fst682) (search-list-rib656 sym679 subst680 marks681 symnames683
fst682))))))))) (if (symbol? id653) (let ((t684 (call-with-values (lambda ()
(search655 id653 (wrap-subst118 w654) (wrap-marks117 w654))) (lambda (x686 .
ignore685) x686)))) (if t684 t684 id653)) (if (syntax-object?98 id653) (let
((id687 (syntax-object-expression99 id653)) (w1688 (syntax-object-wrap100
id653))) (let ((marks689 (join-marks134 (wrap-marks117 w654) (wrap-marks117
w1688)))) (call-with-values (lambda () (search655 id687 (wrap-subst118 w654)
marks689)) (lambda (new-id690 marks691) (let ((t692 new-id690)) (if t692 t692
(let ((t693 (call-with-values (lambda () (search655 id687 (wrap-subst118 w1688)
marks691)) (lambda (x695 . ignore694) x695)))) (if t693 t693 id687))))))))
(syntax-violation (quote id-var-name) "invalid id" id653)))))) (same-marks?135
(lambda (x696 y697) (let ((t698 (eq? x696 y697))) (if t698 t698 (if (not (null?
x696)) (if (not (null? y697)) (if (eq? (car x696) (car y697)) (same-marks?135
(cdr x696) (cdr y697)) #f) #f) #f))))) (join-marks134 (lambda (m1699 m2700)
(smart-append132 m1699 m2700))) (join-wraps133 (lambda (w1701 w2702) (let
((m1703 (wrap-marks117 w1701)) (s1704 (wrap-subst118 w1701))) (if (null? m1703)
(if (null? s1704) w2702 (make-wrap116 (wrap-marks117 w2702) (smart-append132
s1704 (wrap-subst118 w2702)))) (make-wrap116 (smart-append132 m1703
(wrap-marks117 w2702)) (smart-append132 s1704 (wrap-subst118 w2702)))))))
(smart-append132 (lambda (m1705 m2706) (if (null? m2706) m1705 (append m1705
m2706)))) (make-binding-wrap131 (lambda (ids707 labels708 w709) (if (null?
ids707) w709 (make-wrap116 (wrap-marks117 w709) (cons (let ((labelvec710
(list->vector labels708))) (let ((n711 (vector-length labelvec710))) (let
((symnamevec712 (make-vector n711)) (marksvec713 (make-vector n711))) (begin
(letrec ((f714 (lambda (ids715 i716) (if (not (null? ids715)) (call-with-values
(lambda () (id-sym-name&marks115 (car ids715) w709)) (lambda (symname717
marks718) (begin (vector-set! symnamevec712 i716 symname717) (vector-set!
marksvec713 i716 marks718) (f714 (cdr ids715) (fx+72 i716 1))))))))) (f714
ids707 0)) (make-ribcage121 symnamevec712 marksvec713 labelvec710)))))
(wrap-subst118 w709)))))) (extend-ribcage!130 (lambda (ribcage719 id720
label721) (begin (set-ribcage-symnames!126 ribcage719 (cons
(syntax-object-expression99 id720) (ribcage-symnames123 ribcage719)))
(set-ribcage-marks!127 ribcage719 (cons (wrap-marks117 (syntax-object-wrap100
id720)) (ribcage-marks124 ribcage719))) (set-ribcage-labels!128 ribcage719
(cons label721 (ribcage-labels125 ribcage719)))))) (anti-mark129 (lambda (w722)
(make-wrap116 (cons #f (wrap-marks117 w722)) (cons (quote shift) (wrap-subst118
w722))))) (set-ribcage-labels!128 (lambda (x723 update724) (vector-set! x723 3
update724))) (set-ribcage-marks!127 (lambda (x725 update726) (vector-set! x725
2 update726))) (set-ribcage-symnames!126 (lambda (x727 update728) (vector-set!
x727 1 update728))) (ribcage-labels125 (lambda (x729) (vector-ref x729 3)))
(ribcage-marks124 (lambda (x730) (vector-ref x730 2))) (ribcage-symnames123
(lambda (x731) (vector-ref x731 1))) (ribcage?122 (lambda (x732) (if (vector?
x732) (if (= (vector-length x732) 4) (eq? (vector-ref x732 0) (quote ribcage))
#f) #f))) (make-ribcage121 (lambda (symnames733 marks734 labels735) (vector
(quote ribcage) symnames733 marks734 labels735))) (gen-labels120 (lambda
(ls736) (if (null? ls736) (quote ()) (cons (gen-label119) (gen-labels120 (cdr
ls736)))))) (gen-label119 (lambda () (string #\i))) (wrap-subst118 cdr)
(wrap-marks117 car) (make-wrap116 cons) (id-sym-name&marks115 (lambda (x737
w738) (if (syntax-object?98 x737) (values (syntax-object-expression99 x737)
(join-marks134 (wrap-marks117 w738) (wrap-marks117 (syntax-object-wrap100
x737)))) (values x737 (wrap-marks117 w738))))) (id?114 (lambda (x739) (if
(symbol? x739) #t (if (syntax-object?98 x739) (symbol?
(syntax-object-expression99 x739)) #f)))) (nonsymbol-id?113 (lambda (x740) (if
(syntax-object?98 x740) (symbol? (syntax-object-expression99 x740)) #f)))
(global-extend112 (lambda (type741 sym742 val743) (put-global-definition-hook78
sym742 type741 val743))) (lookup111 (lambda (x744 r745 mod746) (let ((t747
(assq x744 r745))) (if t747 (cdr t747) (if (symbol? x744) (let ((t748
(get-global-definition-hook79 x744 mod746))) (if t748 t748 (quote (global))))
(quote (displaced-lexical))))))) (macros-only-env110 (lambda (r749) (if (null?
r749) (quote ()) (let ((a750 (car r749))) (if (eq? (cadr a750) (quote macro))
(cons a750 (macros-only-env110 (cdr r749))) (macros-only-env110 (cdr
r749))))))) (extend-var-env109 (lambda (labels751 vars752 r753) (if (null?
labels751) r753 (extend-var-env109 (cdr labels751) (cdr vars752) (cons (cons
(car labels751) (cons (quote lexical) (car vars752))) r753))))) (extend-env108
(lambda (labels754 bindings755 r756) (if (null? labels754) r756 (extend-env108
(cdr labels754) (cdr bindings755) (cons (cons (car labels754) (car
bindings755)) r756))))) (binding-value107 cdr) (binding-type106 car)
(source-annotation105 (lambda (x757) (if (syntax-object?98 x757)
(source-annotation105 (syntax-object-expression99 x757)) (if (pair? x757) (let
((props758 (source-properties x757))) (if (pair? props758) props758 #f)) #f))))
(set-syntax-object-module!104 (lambda (x759 update760) (vector-set! x759 3
update760))) (set-syntax-object-wrap!103 (lambda (x761 update762) (vector-set!
x761 2 update762))) (set-syntax-object-expression!102 (lambda (x763 update764)
(vector-set! x763 1 update764))) (syntax-object-module101 (lambda (x765)
(vector-ref x765 3))) (syntax-object-wrap100 (lambda (x766) (vector-ref x766
2))) (syntax-object-expression99 (lambda (x767) (vector-ref x767 1)))
(syntax-object?98 (lambda (x768) (if (vector? x768) (if (= (vector-length x768)
4) (eq? (vector-ref x768 0) (quote syntax-object)) #f) #f)))
(make-syntax-object97 (lambda (expression769 wrap770 module771) (vector (quote
syntax-object) expression769 wrap770 module771))) (build-letrec96 (lambda
(src772 ids773 vars774 val-exps775 body-exp776) (if (null? vars774) body-exp776
(let ((atom-key777 (fluid-ref *mode*71))) (if (memv atom-key777 (quote (c)))
(begin (for-each maybe-name-value!88 ids773 val-exps775) ((@ (language tree-il)
make-letrec) src772 ids773 vars774 val-exps775 body-exp776)) (list (quote
letrec) (map list vars774 val-exps775) body-exp776)))))) (build-named-let95
(lambda (src778 ids779 vars780 val-exps781 body-exp782) (let ((f783 (car
vars780)) (f-name784 (car ids779)) (vars785 (cdr vars780)) (ids786 (cdr
ids779))) (let ((atom-key787 (fluid-ref *mode*71))) (if (memv atom-key787
(quote (c))) (let ((proc788 (build-lambda90 src778 ids786 vars785 #f
body-exp782))) (begin (maybe-name-value!88 f-name784 proc788) (for-each
maybe-name-value!88 ids786 val-exps781) ((@ (language tree-il) make-letrec)
src778 (list f-name784) (list f783) (list proc788) (build-application81 src778
(build-lexical-reference83 (quote fun) src778 f-name784 f783) val-exps781))))
(list (quote let) f783 (map list vars785 val-exps781) body-exp782))))))
(build-let94 (lambda (src789 ids790 vars791 val-exps792 body-exp793) (if (null?
vars791) body-exp793 (let ((atom-key794 (fluid-ref *mode*71))) (if (memv
atom-key794 (quote (c))) (begin (for-each maybe-name-value!88 ids790
val-exps792) ((@ (language tree-il) make-let) src789 ids790 vars791 val-exps792
body-exp793)) (list (quote let) (map list vars791 val-exps792)
body-exp793)))))) (build-sequence93 (lambda (src795 exps796) (if (null? (cdr
exps796)) (car exps796) (let ((atom-key797 (fluid-ref *mode*71))) (if (memv
atom-key797 (quote (c))) ((@ (language tree-il) make-sequence) src795 exps796)
(cons (quote begin) exps796)))))) (build-data92 (lambda (src798 exp799) (let
((atom-key800 (fluid-ref *mode*71))) (if (memv atom-key800 (quote (c))) ((@
(language tree-il) make-const) src798 exp799) (if (if (self-evaluating? exp799)
(not (vector? exp799)) #f) exp799 (list (quote quote) exp799))))))
(build-primref91 (lambda (src801 name802) (if (equal? (module-name
(current-module)) (quote (guile))) (let ((atom-key803 (fluid-ref *mode*71)))
(if (memv atom-key803 (quote (c))) ((@ (language tree-il) make-toplevel-ref)
src801 name802) name802)) (let ((atom-key804 (fluid-ref *mode*71))) (if (memv
atom-key804 (quote (c))) ((@ (language tree-il) make-module-ref) src801 (quote
(guile)) name802 #f) (list (quote @@) (quote (guile)) name802))))))
(build-lambda90 (lambda (src805 ids806 vars807 docstring808 exp809) (let
((atom-key810 (fluid-ref *mode*71))) (if (memv atom-key810 (quote (c))) ((@
(language tree-il) make-lambda) src805 ids806 vars807 (if docstring808 (list
(cons (quote documentation) docstring808)) (quote ())) exp809) (cons (quote
lambda) (cons vars807 (append (if docstring808 (list docstring808) (quote ()))
(list exp809)))))))) (build-global-definition89 (lambda (source811 var812
exp813) (let ((atom-key814 (fluid-ref *mode*71))) (if (memv atom-key814 (quote
(c))) (begin (maybe-name-value!88 var812 exp813) ((@ (language tree-il)
make-toplevel-define) source811 var812 exp813)) (list (quote define) var812
exp813))))) (maybe-name-value!88 (lambda (name815 val816) (if ((@ (language
tree-il) lambda?) val816) (let ((meta817 ((@ (language tree-il) lambda-meta)
val816))) (if (not (assq (quote name) meta817)) ((setter (@ (language tree-il)
lambda-meta)) val816 (acons (quote name) name815 meta817)))))))
(build-global-assignment87 (lambda (source818 var819 exp820 mod821)
(analyze-variable85 mod821 var819 (lambda (mod822 var823 public?824) (let
((atom-key825 (fluid-ref *mode*71))) (if (memv atom-key825 (quote (c))) ((@
(language tree-il) make-module-set) source818 mod822 var823 public?824 exp820)
(list (quote set!) (list (if public?824 (quote @) (quote @@)) mod822 var823)
exp820)))) (lambda (var826) (let ((atom-key827 (fluid-ref *mode*71))) (if (memv
atom-key827 (quote (c))) ((@ (language tree-il) make-toplevel-set) source818
var826 exp820) (list (quote set!) var826 exp820)))))))
(build-global-reference86 (lambda (source828 var829 mod830) (analyze-variable85
mod830 var829 (lambda (mod831 var832 public?833) (let ((atom-key834 (fluid-ref
*mode*71))) (if (memv atom-key834 (quote (c))) ((@ (language tree-il)
make-module-ref) source828 mod831 var832 public?833) (list (if public?833
(quote @) (quote @@)) mod831 var832)))) (lambda (var835) (let ((atom-key836
(fluid-ref *mode*71))) (if (memv atom-key836 (quote (c))) ((@ (language
tree-il) make-toplevel-ref) source828 var835) var835)))))) (analyze-variable85
(lambda (mod837 var838 modref-cont839 bare-cont840) (if (not mod837)
(bare-cont840 var838) (let ((kind841 (car mod837)) (mod842 (cdr mod837))) (if
(memv kind841 (quote (public))) (modref-cont839 mod842 var838 #t) (if (memv
kind841 (quote (private))) (if (not (equal? mod842 (module-name
(current-module)))) (modref-cont839 mod842 var838 #f) (bare-cont840 var838))
(if (memv kind841 (quote (bare))) (bare-cont840 var838) (if (memv kind841
(quote (hygiene))) (if (if (not (equal? mod842 (module-name (current-module))))
(module-variable (resolve-module mod842) var838) #f) (modref-cont839 mod842
var838 #f) (bare-cont840 var838)) (syntax-violation #f "bad module kind" var838
mod842))))))))) (build-lexical-assignment84 (lambda (source843 name844 var845
exp846) (let ((atom-key847 (fluid-ref *mode*71))) (if (memv atom-key847 (quote
(c))) ((@ (language tree-il) make-lexical-set) source843 name844 var845 exp846)
(list (quote set!) var845 exp846))))) (build-lexical-reference83 (lambda
(type848 source849 name850 var851) (let ((atom-key852 (fluid-ref *mode*71)))
(if (memv atom-key852 (quote (c))) ((@ (language tree-il) make-lexical-ref)
source849 name850 var851) var851)))) (build-conditional82 (lambda (source853
test-exp854 then-exp855 else-exp856) (let ((atom-key857 (fluid-ref *mode*71)))
(if (memv atom-key857 (quote (c))) ((@ (language tree-il) make-conditional)
source853 test-exp854 then-exp855 else-exp856) (if (equal? else-exp856 (quote
(if #f #f))) (list (quote if) test-exp854 then-exp855) (list (quote if)
test-exp854 then-exp855 else-exp856)))))) (build-application81 (lambda
(source858 fun-exp859 arg-exps860) (let ((atom-key861 (fluid-ref *mode*71)))
(if (memv atom-key861 (quote (c))) ((@ (language tree-il) make-application)
source858 fun-exp859 arg-exps860) (cons fun-exp859 arg-exps860)))))
(build-void80 (lambda (source862) (let ((atom-key863 (fluid-ref *mode*71))) (if
(memv atom-key863 (quote (c))) ((@ (language tree-il) make-void) source862)
(quote (if #f #f)))))) (get-global-definition-hook79 (lambda (symbol864
module865) (begin (if (if (not module865) (current-module) #f) (warn "module
system is booted, we should have a module" symbol864)) (let ((v866
(module-variable (if module865 (resolve-module (cdr module865))
(current-module)) symbol864))) (if v866 (if (variable-bound? v866) (let
((val867 (variable-ref v866))) (if (macro? val867) (if (syncase-macro-type
val867) (cons (syncase-macro-type val867) (syncase-macro-binding val867)) #f)
#f)) #f) #f))))) (put-global-definition-hook78 (lambda (symbol868 type869
val870) (let ((existing871 (let ((v872 (module-variable (current-module)
symbol868))) (if v872 (if (variable-bound? v872) (let ((val873 (variable-ref
v872))) (if (macro? val873) (if (not (syncase-macro-type val873)) val873 #f)
#f)) #f) #f)))) (module-define! (current-module) symbol868 (if existing871
(make-extended-syncase-macro existing871 type869 val870) (make-syncase-macro
type869 val870)))))) (local-eval-hook77 (lambda (x874 mod875) (primitive-eval
(list noexpand70 (let ((atom-key876 (fluid-ref *mode*71))) (if (memv
atom-key876 (quote (c))) ((@ (language tree-il) tree-il->scheme) x874)
x874)))))) (top-level-eval-hook76 (lambda (x877 mod878) (primitive-eval (list
noexpand70 (let ((atom-key879 (fluid-ref *mode*71))) (if (memv atom-key879
(quote (c))) ((@ (language tree-il) tree-il->scheme) x877) x877)))))) (fx<75 <)
(fx=74 =) (fx-73 -) (fx+72 +) (*mode*71 (make-fluid)) (noexpand70 "noexpand"))
(begin (global-extend112 (quote local-syntax) (quote letrec-syntax) #t)
(global-extend112 (quote local-syntax) (quote let-syntax) #f) (global-extend112
(quote core) (quote fluid-let-syntax) (lambda (e880 r881 w882 s883 mod884)
((lambda (tmp885) ((lambda (tmp886) (if (if tmp886 (apply (lambda (_887 var888
val889 e1890 e2891) (valid-bound-ids?139 var888)) tmp886) #f) (apply (lambda
(_893 var894 val895 e1896 e2897) (let ((names898 (map (lambda (x899)
(id-var-name136 x899 w882)) var894))) (begin (for-each (lambda (id901 n902)
(let ((atom-key903 (binding-type106 (lookup111 n902 r881 mod884)))) (if (memv
atom-key903 (quote (displaced-lexical))) (syntax-violation (quote
fluid-let-syntax) "identifier out of context" e880 (source-wrap143 id901 w882
s883 mod884))))) var894 names898) (chi-body154 (cons e1896 e2897)
(source-wrap143 e880 w882 s883 mod884) (extend-env108 names898 (let
((trans-r906 (macros-only-env110 r881))) (map (lambda (x907) (cons (quote
macro) (eval-local-transformer157 (chi150 x907 trans-r906 w882 mod884)
mod884))) val895)) r881) w882 mod884)))) tmp886) ((lambda (_909)
(syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap143 e880
w882 s883 mod884))) tmp885))) ($sc-dispatch tmp885 (quote (any #(each (any
any)) any . each-any))))) e880))) (global-extend112 (quote core) (quote quote)
(lambda (e910 r911 w912 s913 mod914) ((lambda (tmp915) ((lambda (tmp916) (if
tmp916 (apply (lambda (_917 e918) (build-data92 s913 (strip160 e918 w912)))
tmp916) ((lambda (_919) (syntax-violation (quote quote) "bad syntax"
(source-wrap143 e910 w912 s913 mod914))) tmp915))) ($sc-dispatch tmp915 (quote
(any any))))) e910))) (global-extend112 (quote core) (quote syntax) (letrec
((regen927 (lambda (x928) (let ((atom-key929 (car x928))) (if (memv atom-key929
(quote (ref))) (build-lexical-reference83 (quote value) #f (cadr x928) (cadr
x928)) (if (memv atom-key929 (quote (primitive))) (build-primref91 #f (cadr
x928)) (if (memv atom-key929 (quote (quote))) (build-data92 #f (cadr x928)) (if
(memv atom-key929 (quote (lambda))) (build-lambda90 #f (cadr x928) (cadr x928)
#f (regen927 (caddr x928))) (build-application81 #f (build-primref91 #f (car
x928)) (map regen927 (cdr x928)))))))))) (gen-vector926 (lambda (x930) (if (eq?
(car x930) (quote list)) (cons (quote vector) (cdr x930)) (if (eq? (car x930)
(quote quote)) (list (quote quote) (list->vector (cadr x930))) (list (quote
list->vector) x930))))) (gen-append925 (lambda (x931 y932) (if (equal? y932
(quote (quote ()))) x931 (list (quote append) x931 y932)))) (gen-cons924
(lambda (x933 y934) (let ((atom-key935 (car y934))) (if (memv atom-key935
(quote (quote))) (if (eq? (car x933) (quote quote)) (list (quote quote) (cons
(cadr x933) (cadr y934))) (if (eq? (cadr y934) (quote ())) (list (quote list)
x933) (list (quote cons) x933 y934))) (if (memv atom-key935 (quote (list)))
(cons (quote list) (cons x933 (cdr y934))) (list (quote cons) x933 y934))))))
(gen-map923 (lambda (e936 map-env937) (let ((formals938 (map cdr map-env937))
(actuals939 (map (lambda (x940) (list (quote ref) (car x940))) map-env937)))
(if (eq? (car e936) (quote ref)) (car actuals939) (if (and-map (lambda (x941)
(if (eq? (car x941) (quote ref)) (memq (cadr x941) formals938) #f)) (cdr e936))
(cons (quote map) (cons (list (quote primitive) (car e936)) (map (let ((r942
(map cons formals938 actuals939))) (lambda (x943) (cdr (assq (cadr x943)
r942)))) (cdr e936)))) (cons (quote map) (cons (list (quote lambda) formals938
e936) actuals939))))))) (gen-mappend922 (lambda (e944 map-env945) (list (quote
apply) (quote (primitive append)) (gen-map923 e944 map-env945)))) (gen-ref921
(lambda (src946 var947 level948 maps949) (if (fx=74 level948 0) (values var947
maps949) (if (null? maps949) (syntax-violation (quote syntax) "missing
ellipsis" src946) (call-with-values (lambda () (gen-ref921 src946 var947 (fx-73
level948 1) (cdr maps949))) (lambda (outer-var950 outer-maps951) (let ((b952
(assq outer-var950 (car maps949)))) (if b952 (values (cdr b952) maps949) (let
((inner-var953 (gen-var161 (quote tmp)))) (values inner-var953 (cons (cons
(cons outer-var950 inner-var953) (car maps949)) outer-maps951)))))))))))
(gen-syntax920 (lambda (src954 e955 r956 maps957 ellipsis?958 mod959) (if
(id?114 e955) (let ((label960 (id-var-name136 e955 (quote (()))))) (let ((b961
(lookup111 label960 r956 mod959))) (if (eq? (binding-type106 b961) (quote
syntax)) (call-with-values (lambda () (let ((var.lev962 (binding-value107
b961))) (gen-ref921 src954 (car var.lev962) (cdr var.lev962) maps957))) (lambda
(var963 maps964) (values (list (quote ref) var963) maps964))) (if (ellipsis?958
e955) (syntax-violation (quote syntax) "misplaced ellipsis" src954) (values
(list (quote quote) e955) maps957))))) ((lambda (tmp965) ((lambda (tmp966) (if
(if tmp966 (apply (lambda (dots967 e968) (ellipsis?958 dots967)) tmp966) #f)
(apply (lambda (dots969 e970) (gen-syntax920 src954 e970 r956 maps957 (lambda
(x971) #f) mod959)) tmp966) ((lambda (tmp972) (if (if tmp972 (apply (lambda
(x973 dots974 y975) (ellipsis?958 dots974)) tmp972) #f) (apply (lambda (x976
dots977 y978) (letrec ((f979 (lambda (y980 k981) ((lambda (tmp985) ((lambda
(tmp986) (if (if tmp986 (apply (lambda (dots987 y988) (ellipsis?958 dots987))
tmp986) #f) (apply (lambda (dots989 y990) (f979 y990 (lambda (maps991)
(call-with-values (lambda () (k981 (cons (quote ()) maps991))) (lambda (x992
maps993) (if (null? (car maps993)) (syntax-violation (quote syntax) "extra
ellipsis" src954) (values (gen-mappend922 x992 (car maps993)) (cdr
maps993)))))))) tmp986) ((lambda (_994) (call-with-values (lambda ()
(gen-syntax920 src954 y980 r956 maps957 ellipsis?958 mod959)) (lambda (y995
maps996) (call-with-values (lambda () (k981 maps996)) (lambda (x997 maps998)
(values (gen-append925 x997 y995) maps998)))))) tmp985))) ($sc-dispatch tmp985
(quote (any . any))))) y980)))) (f979 y978 (lambda (maps982) (call-with-values
(lambda () (gen-syntax920 src954 x976 r956 (cons (quote ()) maps982)
ellipsis?958 mod959)) (lambda (x983 maps984) (if (null? (car maps984))
(syntax-violation (quote syntax) "extra ellipsis" src954) (values (gen-map923
x983 (car maps984)) (cdr maps984))))))))) tmp972) ((lambda (tmp999) (if tmp999
(apply (lambda (x1000 y1001) (call-with-values (lambda () (gen-syntax920 src954
x1000 r956 maps957 ellipsis?958 mod959)) (lambda (x1002 maps1003)
(call-with-values (lambda () (gen-syntax920 src954 y1001 r956 maps1003
ellipsis?958 mod959)) (lambda (y1004 maps1005) (values (gen-cons924 x1002
y1004) maps1005)))))) tmp999) ((lambda (tmp1006) (if tmp1006 (apply (lambda
(e11007 e21008) (call-with-values (lambda () (gen-syntax920 src954 (cons e11007
e21008) r956 maps957 ellipsis?958 mod959)) (lambda (e1010 maps1011) (values
(gen-vector926 e1010) maps1011)))) tmp1006) ((lambda (_1012) (values (list
(quote quote) e955) maps957)) tmp965))) ($sc-dispatch tmp965 (quote #(vector
(any . each-any))))))) ($sc-dispatch tmp965 (quote (any . any))))))
($sc-dispatch tmp965 (quote (any any . any)))))) ($sc-dispatch tmp965 (quote
(any any))))) e955))))) (lambda (e1013 r1014 w1015 s1016 mod1017) (let ((e1018
(source-wrap143 e1013 w1015 s1016 mod1017))) ((lambda (tmp1019) ((lambda
(tmp1020) (if tmp1020 (apply (lambda (_1021 x1022) (call-with-values (lambda ()
(gen-syntax920 e1018 x1022 r1014 (quote ()) ellipsis?159 mod1017)) (lambda
(e1023 maps1024) (regen927 e1023)))) tmp1020) ((lambda (_1025)
(syntax-violation (quote syntax) "bad `syntax' form" e1018)) tmp1019)))
($sc-dispatch tmp1019 (quote (any any))))) e1018))))) (global-extend112 (quote
core) (quote lambda) (lambda (e1026 r1027 w1028 s1029 mod1030) ((lambda
(tmp1031) ((lambda (tmp1032) (if tmp1032 (apply (lambda (_1033 c1034)
(chi-lambda-clause155 (source-wrap143 e1026 w1028 s1029 mod1030) #f c1034 r1027
w1028 mod1030 (lambda (names1035 vars1036 docstring1037 body1038)
(build-lambda90 s1029 names1035 vars1036 docstring1037 body1038)))) tmp1032)
(syntax-violation #f "source expression failed to match any pattern" tmp1031)))
($sc-dispatch tmp1031 (quote (any . any))))) e1026))) (global-extend112 (quote
core) (quote let) (letrec ((chi-let1039 (lambda (e1040 r1041 w1042 s1043
mod1044 constructor1045 ids1046 vals1047 exps1048) (if (not
(valid-bound-ids?139 ids1046)) (syntax-violation (quote let) "duplicate bound
variable" e1040) (let ((labels1049 (gen-labels120 ids1046)) (new-vars1050 (map
gen-var161 ids1046))) (let ((nw1051 (make-binding-wrap131 ids1046 labels1049
w1042)) (nr1052 (extend-var-env109 labels1049 new-vars1050 r1041)))
(constructor1045 s1043 (map syntax->datum ids1046) new-vars1050 (map (lambda
(x1053) (chi150 x1053 r1041 w1042 mod1044)) vals1047) (chi-body154 exps1048
(source-wrap143 e1040 nw1051 s1043 mod1044) nr1052 nw1051 mod1044))))))))
(lambda (e1054 r1055 w1056 s1057 mod1058) ((lambda (tmp1059) ((lambda (tmp1060)
(if (if tmp1060 (apply (lambda (_1061 id1062 val1063 e11064 e21065) (and-map
id?114 id1062)) tmp1060) #f) (apply (lambda (_1067 id1068 val1069 e11070
e21071) (chi-let1039 e1054 r1055 w1056 s1057 mod1058 build-let94 id1068 val1069
(cons e11070 e21071))) tmp1060) ((lambda (tmp1075) (if (if tmp1075 (apply
(lambda (_1076 f1077 id1078 val1079 e11080 e21081) (if (id?114 f1077) (and-map
id?114 id1078) #f)) tmp1075) #f) (apply (lambda (_1083 f1084 id1085 val1086
e11087 e21088) (chi-let1039 e1054 r1055 w1056 s1057 mod1058 build-named-let95
(cons f1084 id1085) val1086 (cons e11087 e21088))) tmp1075) ((lambda (_1092)
(syntax-violation (quote let) "bad let" (source-wrap143 e1054 w1056 s1057
mod1058))) tmp1059))) ($sc-dispatch tmp1059 (quote (any any #(each (any any))
any . each-any)))))) ($sc-dispatch tmp1059 (quote (any #(each (any any)) any .
each-any))))) e1054)))) (global-extend112 (quote core) (quote letrec) (lambda
(e1093 r1094 w1095 s1096 mod1097) ((lambda (tmp1098) ((lambda (tmp1099) (if (if
tmp1099 (apply (lambda (_1100 id1101 val1102 e11103 e21104) (and-map id?114
id1101)) tmp1099) #f) (apply (lambda (_1106 id1107 val1108 e11109 e21110) (let
((ids1111 id1107)) (if (not (valid-bound-ids?139 ids1111)) (syntax-violation
(quote letrec) "duplicate bound variable" e1093) (let ((labels1113
(gen-labels120 ids1111)) (new-vars1114 (map gen-var161 ids1111))) (let ((w1115
(make-binding-wrap131 ids1111 labels1113 w1095)) (r1116 (extend-var-env109
labels1113 new-vars1114 r1094))) (build-letrec96 s1096 (map syntax->datum
ids1111) new-vars1114 (map (lambda (x1117) (chi150 x1117 r1116 w1115 mod1097))
val1108) (chi-body154 (cons e11109 e21110) (source-wrap143 e1093 w1115 s1096
mod1097) r1116 w1115 mod1097))))))) tmp1099) ((lambda (_1120) (syntax-violation
(quote letrec) "bad letrec" (source-wrap143 e1093 w1095 s1096 mod1097)))
tmp1098))) ($sc-dispatch tmp1098 (quote (any #(each (any any)) any .
each-any))))) e1093))) (global-extend112 (quote core) (quote set!) (lambda
(e1121 r1122 w1123 s1124 mod1125) ((lambda (tmp1126) ((lambda (tmp1127) (if (if
tmp1127 (apply (lambda (_1128 id1129 val1130) (id?114 id1129)) tmp1127) #f)
(apply (lambda (_1131 id1132 val1133) (let ((val1134 (chi150 val1133 r1122
w1123 mod1125)) (n1135 (id-var-name136 id1132 w1123))) (let ((b1136 (lookup111
n1135 r1122 mod1125))) (let ((atom-key1137 (binding-type106 b1136))) (if (memv
atom-key1137 (quote (lexical))) (build-lexical-assignment84 s1124
(syntax->datum id1132) (binding-value107 b1136) val1134) (if (memv atom-key1137
(quote (global))) (build-global-assignment87 s1124 n1135 val1134 mod1125) (if
(memv atom-key1137 (quote (displaced-lexical))) (syntax-violation (quote set!)
"identifier out of context" (wrap142 id1132 w1123 mod1125)) (syntax-violation
(quote set!) "bad set!" (source-wrap143 e1121 w1123 s1124 mod1125)))))))))
tmp1127) ((lambda (tmp1138) (if tmp1138 (apply (lambda (_1139 head1140 tail1141
val1142) (call-with-values (lambda () (syntax-type148 head1140 r1122 (quote
(())) #f #f mod1125 #t)) (lambda (type1143 value1144 ee1145 ww1146 ss1147
modmod1148) (if (memv type1143 (quote (module-ref))) (let ((val1149 (chi150
val1142 r1122 w1123 mod1125))) (call-with-values (lambda () (value1144 (cons
head1140 tail1141))) (lambda (id1151 mod1152) (build-global-assignment87 s1124
id1151 val1149 mod1152)))) (build-application81 s1124 (chi150 (list (quote
#(syntax-object setter ((top) #(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
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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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))) head1140) r1122 w1123 mod1125) (map
(lambda (e1153) (chi150 e1153 r1122 w1123 mod1125)) (append tail1141 (list
val1142)))))))) tmp1138) ((lambda (_1155) (syntax-violation (quote set!) "bad
set!" (source-wrap143 e1121 w1123 s1124 mod1125))) tmp1126))) ($sc-dispatch
tmp1126 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1126 (quote
(any any any))))) e1121))) (global-extend112 (quote module-ref) (quote @)
(lambda (e1156) ((lambda (tmp1157) ((lambda (tmp1158) (if (if tmp1158 (apply
(lambda (_1159 mod1160 id1161) (if (and-map id?114 mod1160) (id?114 id1161)
#f)) tmp1158) #f) (apply (lambda (_1163 mod1164 id1165) (values (syntax->datum
id1165) (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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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))) mod1164)))) tmp1158)
(syntax-violation #f "source expression failed to match any pattern" tmp1157)))
($sc-dispatch tmp1157 (quote (any each-any any))))) e1156))) (global-extend112
(quote module-ref) (quote @@) (lambda (e1167) ((lambda (tmp1168) ((lambda
(tmp1169) (if (if tmp1169 (apply (lambda (_1170 mod1171 id1172) (if (and-map
id?114 mod1171) (id?114 id1172) #f)) tmp1169) #f) (apply (lambda (_1174 mod1175
id1176) (values (syntax->datum id1176) (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 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
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
maybe-name-value! build-global-assignment build-global-reference
analyze-variable build-lexical-assignment build-lexical-reference
build-conditional build-application build-void 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))) mod1175)))) tmp1169)
(syntax-violation #f "source expression failed to match any pattern" tmp1168)))
($sc-dispatch tmp1168 (quote (any each-any any))))) e1167))) (global-extend112
(quote core) (quote if) (lambda (e1178 r1179 w1180 s1181 mod1182) ((lambda
(tmp1183) ((lambda (tmp1184) (if tmp1184 (apply (lambda (_1185 test1186
then1187) (build-conditional82 s1181 (chi150 test1186 r1179 w1180 mod1182)
(chi150 then1187 r1179 w1180 mod1182) (build-void80 #f))) tmp1184) ((lambda
(tmp1188) (if tmp1188 (apply (lambda (_1189 test1190 then1191 else1192)
(build-conditional82 s1181 (chi150 test1190 r1179 w1180 mod1182) (chi150
then1191 r1179 w1180 mod1182) (chi150 else1192 r1179 w1180 mod1182))) tmp1188)
(syntax-violation #f "source expression failed to match any pattern" tmp1183)))
($sc-dispatch tmp1183 (quote (any any any any)))))) ($sc-dispatch tmp1183
(quote (any any any))))) e1178))) (global-extend112 (quote begin) (quote begin)
(quote ())) (global-extend112 (quote define) (quote define) (quote ()))
(global-extend112 (quote define-syntax) (quote define-syntax) (quote ()))
(global-extend112 (quote eval-when) (quote eval-when) (quote ()))
(global-extend112 (quote core) (quote syntax-case) (letrec
((gen-syntax-case1196 (lambda (x1197 keys1198 clauses1199 r1200 mod1201) (if
(null? clauses1199) (build-application81 #f (build-primref91 #f (quote
syntax-violation)) (list (build-data92 #f #f) (build-data92 #f "source
expression failed to match any pattern") x1197)) ((lambda (tmp1202) ((lambda
(tmp1203) (if tmp1203 (apply (lambda (pat1204 exp1205) (if (if (id?114 pat1204)
(and-map (lambda (x1206) (not (free-id=?137 pat1204 x1206))) (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 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 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 maybe-name-value!
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application build-void 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))) keys1198)) #f) (let ((labels1207
(list (gen-label119))) (var1208 (gen-var161 pat1204))) (build-application81 #f
(build-lambda90 #f (list (syntax->datum pat1204)) (list var1208) #f (chi150
exp1205 (extend-env108 labels1207 (list (cons (quote syntax) (cons var1208 0)))
r1200) (make-binding-wrap131 (list pat1204) labels1207 (quote (()))) mod1201))
(list x1197))) (gen-clause1195 x1197 keys1198 (cdr clauses1199) r1200 pat1204
#t exp1205 mod1201))) tmp1203) ((lambda (tmp1209) (if tmp1209 (apply (lambda
(pat1210 fender1211 exp1212) (gen-clause1195 x1197 keys1198 (cdr clauses1199)
r1200 pat1210 fender1211 exp1212 mod1201)) tmp1209) ((lambda (_1213)
(syntax-violation (quote syntax-case) "invalid clause" (car clauses1199)))
tmp1202))) ($sc-dispatch tmp1202 (quote (any any any)))))) ($sc-dispatch
tmp1202 (quote (any any))))) (car clauses1199))))) (gen-clause1195 (lambda
(x1214 keys1215 clauses1216 r1217 pat1218 fender1219 exp1220 mod1221)
(call-with-values (lambda () (convert-pattern1193 pat1218 keys1215)) (lambda
(p1222 pvars1223) (if (not (distinct-bound-ids?140 (map car pvars1223)))
(syntax-violation (quote syntax-case) "duplicate pattern variable" pat1218) (if
(not (and-map (lambda (x1224) (not (ellipsis?159 (car x1224)))) pvars1223))
(syntax-violation (quote syntax-case) "misplaced ellipsis" pat1218) (let
((y1225 (gen-var161 (quote tmp)))) (build-application81 #f (build-lambda90 #f
(list (quote tmp)) (list y1225) #f (let ((y1226 (build-lexical-reference83
(quote value) #f (quote tmp) y1225))) (build-conditional82 #f ((lambda
(tmp1227) ((lambda (tmp1228) (if tmp1228 (apply (lambda () y1226) tmp1228)
((lambda (_1229) (build-conditional82 #f y1226 (build-dispatch-call1194
pvars1223 fender1219 y1226 r1217 mod1221) (build-data92 #f #f))) tmp1227)))
($sc-dispatch tmp1227 (quote #(atom #t))))) fender1219)
(build-dispatch-call1194 pvars1223 exp1220 y1226 r1217 mod1221)
(gen-syntax-case1196 x1214 keys1215 clauses1216 r1217 mod1221)))) (list (if
(eq? p1222 (quote any)) (build-application81 #f (build-primref91 #f (quote
list)) (list x1214)) (build-application81 #f (build-primref91 #f (quote
$sc-dispatch)) (list x1214 (build-data92 #f p1222)))))))))))))
(build-dispatch-call1194 (lambda (pvars1230 exp1231 y1232 r1233 mod1234) (let
((ids1235 (map car pvars1230)) (levels1236 (map cdr pvars1230))) (let
((labels1237 (gen-labels120 ids1235)) (new-vars1238 (map gen-var161 ids1235)))
(build-application81 #f (build-primref91 #f (quote apply)) (list
(build-lambda90 #f (map syntax->datum ids1235) new-vars1238 #f (chi150 exp1231
(extend-env108 labels1237 (map (lambda (var1239 level1240) (cons (quote syntax)
(cons var1239 level1240))) new-vars1238 (map cdr pvars1230)) r1233)
(make-binding-wrap131 ids1235 labels1237 (quote (()))) mod1234)) y1232))))))
(convert-pattern1193 (lambda (pattern1241 keys1242) (letrec ((cvt1243 (lambda
(p1244 n1245 ids1246) (if (id?114 p1244) (if (bound-id-member?141 p1244
keys1242) (values (vector (quote free-id) p1244) ids1246) (values (quote any)
(cons (cons p1244 n1245) ids1246))) ((lambda (tmp1247) ((lambda (tmp1248) (if
(if tmp1248 (apply (lambda (x1249 dots1250) (ellipsis?159 dots1250)) tmp1248)
#f) (apply (lambda (x1251 dots1252) (call-with-values (lambda () (cvt1243 x1251
(fx+72 n1245 1) ids1246)) (lambda (p1253 ids1254) (values (if (eq? p1253 (quote
any)) (quote each-any) (vector (quote each) p1253)) ids1254)))) tmp1248)
((lambda (tmp1255) (if tmp1255 (apply (lambda (x1256 y1257) (call-with-values
(lambda () (cvt1243 y1257 n1245 ids1246)) (lambda (y1258 ids1259)
(call-with-values (lambda () (cvt1243 x1256 n1245 ids1259)) (lambda (x1260
ids1261) (values (cons x1260 y1258) ids1261)))))) tmp1255) ((lambda (tmp1262)
(if tmp1262 (apply (lambda () (values (quote ()) ids1246)) tmp1262) ((lambda
(tmp1263) (if tmp1263 (apply (lambda (x1264) (call-with-values (lambda ()
(cvt1243 x1264 n1245 ids1246)) (lambda (p1266 ids1267) (values (vector (quote
vector) p1266) ids1267)))) tmp1263) ((lambda (x1268) (values (vector (quote
atom) (strip160 p1244 (quote (())))) ids1246)) tmp1247))) ($sc-dispatch tmp1247
(quote #(vector each-any)))))) ($sc-dispatch tmp1247 (quote ())))))
($sc-dispatch tmp1247 (quote (any . any)))))) ($sc-dispatch tmp1247 (quote (any
any))))) p1244))))) (cvt1243 pattern1241 0 (quote ())))))) (lambda (e1269 r1270
w1271 s1272 mod1273) (let ((e1274 (source-wrap143 e1269 w1271 s1272 mod1273)))
((lambda (tmp1275) ((lambda (tmp1276) (if tmp1276 (apply (lambda (_1277 val1278
key1279 m1280) (if (and-map (lambda (x1281) (if (id?114 x1281) (not
(ellipsis?159 x1281)) #f)) key1279) (let ((x1283 (gen-var161 (quote tmp))))
(build-application81 s1272 (build-lambda90 #f (list (quote tmp)) (list x1283)
#f (gen-syntax-case1196 (build-lexical-reference83 (quote value) #f (quote tmp)
x1283) key1279 m1280 r1270 mod1273)) (list (chi150 val1278 r1270 (quote (()))
mod1273)))) (syntax-violation (quote syntax-case) "invalid literals list"
e1274))) tmp1276) (syntax-violation #f "source expression failed to match any
pattern" tmp1275))) ($sc-dispatch tmp1275 (quote (any any each-any .
each-any))))) e1274))))) (set! sc-expand (lambda (x1287 . rest1286) (if (if
(pair? x1287) (equal? (car x1287) noexpand70) #f) (cadr x1287) (let ((m1288 (if
(null? rest1286) (quote e) (car rest1286))) (esew1289 (if (let ((t1290 (null?
rest1286))) (if t1290 t1290 (null? (cdr rest1286)))) (quote (eval)) (cadr
rest1286)))) (with-fluid* *mode*71 m1288 (lambda () (chi-top149 x1287 (quote
()) (quote ((top))) m1288 esew1289 (cons (quote hygiene) (module-name
(current-module)))))))))) (set! identifier? (lambda (x1291) (nonsymbol-id?113
x1291))) (set! datum->syntax (lambda (id1292 datum1293) (make-syntax-object97
datum1293 (syntax-object-wrap100 id1292) #f))) (set! syntax->datum (lambda
(x1294) (strip160 x1294 (quote (()))))) (set! generate-temporaries (lambda
(ls1295) (begin (let ((x1296 ls1295)) (if (not (list? x1296)) (syntax-violation
(quote generate-temporaries) "invalid argument" x1296))) (map (lambda (x1297)
(wrap142 (gensym) (quote ((top))) #f)) ls1295)))) (set! free-identifier=?
(lambda (x1298 y1299) (begin (let ((x1300 x1298)) (if (not (nonsymbol-id?113
x1300)) (syntax-violation (quote free-identifier=?) "invalid argument" x1300)))
(let ((x1301 y1299)) (if (not (nonsymbol-id?113 x1301)) (syntax-violation
(quote free-identifier=?) "invalid argument" x1301))) (free-id=?137 x1298
y1299)))) (set! bound-identifier=? (lambda (x1302 y1303) (begin (let ((x1304
x1302)) (if (not (nonsymbol-id?113 x1304)) (syntax-violation (quote
bound-identifier=?) "invalid argument" x1304))) (let ((x1305 y1303)) (if (not
(nonsymbol-id?113 x1305)) (syntax-violation (quote bound-identifier=?) "invalid
argument" x1305))) (bound-id=?138 x1302 y1303)))) (set! syntax-violation
(lambda (who1309 message1308 form1307 . subform1306) (begin (let ((x1310
who1309)) (if (not ((lambda (x1311) (let ((t1312 (not x1311))) (if t1312 t1312
(let ((t1313 (string? x1311))) (if t1313 t1313 (symbol? x1311)))))) x1310))
(syntax-violation (quote syntax-violation) "invalid argument" x1310))) (let
((x1314 message1308)) (if (not (string? x1314)) (syntax-violation (quote
syntax-violation) "invalid argument" x1314))) (scm-error (quote syntax-error)
(quote sc-expand) (string-append (if who1309 "~a: " "") "~a " (if (null?
subform1306) "in ~a" "in subform `~s' of `~s'")) (let ((tail1315 (cons
message1308 (map (lambda (x1316) (strip160 x1316 (quote (())))) (append
subform1306 (list form1307)))))) (if who1309 (cons who1309 tail1315) tail1315))
#f)))) (letrec ((match1321 (lambda (e1322 p1323 w1324 r1325 mod1326) (if (not
r1325) #f (if (eq? p1323 (quote any)) (cons (wrap142 e1322 w1324 mod1326)
r1325) (if (syntax-object?98 e1322) (match*1320 (syntax-object-expression99
e1322) p1323 (join-wraps133 w1324 (syntax-object-wrap100 e1322)) r1325
(syntax-object-module101 e1322)) (match*1320 e1322 p1323 w1324 r1325
mod1326)))))) (match*1320 (lambda (e1327 p1328 w1329 r1330 mod1331) (if (null?
p1328) (if (null? e1327) r1330 #f) (if (pair? p1328) (if (pair? e1327)
(match1321 (car e1327) (car p1328) w1329 (match1321 (cdr e1327) (cdr p1328)
w1329 r1330 mod1331) mod1331) #f) (if (eq? p1328 (quote each-any)) (let ((l1332
(match-each-any1318 e1327 w1329 mod1331))) (if l1332 (cons l1332 r1330) #f))
(let ((atom-key1333 (vector-ref p1328 0))) (if (memv atom-key1333 (quote
(each))) (if (null? e1327) (match-empty1319 (vector-ref p1328 1) r1330) (let
((l1334 (match-each1317 e1327 (vector-ref p1328 1) w1329 mod1331))) (if l1334
(letrec ((collect1335 (lambda (l1336) (if (null? (car l1336)) r1330 (cons (map
car l1336) (collect1335 (map cdr l1336))))))) (collect1335 l1334)) #f))) (if
(memv atom-key1333 (quote (free-id))) (if (id?114 e1327) (if (free-id=?137
(wrap142 e1327 w1329 mod1331) (vector-ref p1328 1)) r1330 #f) #f) (if (memv
atom-key1333 (quote (atom))) (if (equal? (vector-ref p1328 1) (strip160 e1327
w1329)) r1330 #f) (if (memv atom-key1333 (quote (vector))) (if (vector? e1327)
(match1321 (vector->list e1327) (vector-ref p1328 1) w1329 r1330 mod1331)
#f))))))))))) (match-empty1319 (lambda (p1337 r1338) (if (null? p1337) r1338
(if (eq? p1337 (quote any)) (cons (quote ()) r1338) (if (pair? p1337)
(match-empty1319 (car p1337) (match-empty1319 (cdr p1337) r1338)) (if (eq?
p1337 (quote each-any)) (cons (quote ()) r1338) (let ((atom-key1339 (vector-ref
p1337 0))) (if (memv atom-key1339 (quote (each))) (match-empty1319 (vector-ref
p1337 1) r1338) (if (memv atom-key1339 (quote (free-id atom))) r1338 (if (memv
atom-key1339 (quote (vector))) (match-empty1319 (vector-ref p1337 1)
r1338))))))))))) (match-each-any1318 (lambda (e1340 w1341 mod1342) (if (pair?
e1340) (let ((l1343 (match-each-any1318 (cdr e1340) w1341 mod1342))) (if l1343
(cons (wrap142 (car e1340) w1341 mod1342) l1343) #f)) (if (null? e1340) (quote
()) (if (syntax-object?98 e1340) (match-each-any1318
(syntax-object-expression99 e1340) (join-wraps133 w1341 (syntax-object-wrap100
e1340)) mod1342) #f))))) (match-each1317 (lambda (e1344 p1345 w1346 mod1347)
(if (pair? e1344) (let ((first1348 (match1321 (car e1344) p1345 w1346 (quote
()) mod1347))) (if first1348 (let ((rest1349 (match-each1317 (cdr e1344) p1345
w1346 mod1347))) (if rest1349 (cons first1348 rest1349) #f)) #f)) (if (null?
e1344) (quote ()) (if (syntax-object?98 e1344) (match-each1317
(syntax-object-expression99 e1344) p1345 (join-wraps133 w1346
(syntax-object-wrap100 e1344)) (syntax-object-module101 e1344)) #f)))))) (set!
$sc-dispatch (lambda (e1350 p1351) (if (eq? p1351 (quote any)) (list e1350) (if
(syntax-object?98 e1350) (match*1320 (syntax-object-expression99 e1350) p1351
(syntax-object-wrap100 e1350) (quote ()) (syntax-object-module101 e1350))
(match*1320 e1350 p1351 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x1352) ((lambda
(tmp1353) ((lambda (tmp1354) (if tmp1354 (apply (lambda (_1355 e11356 e21357)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e11356 e21357))) tmp1354) ((lambda (tmp1359) (if
tmp1359 (apply (lambda (_1360 out1361 in1362 e11363 e21364) (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))) in1362 (quote ()) (list out1361 (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 e11363 e21364))))) tmp1359) ((lambda
(tmp1366) (if tmp1366 (apply (lambda (_1367 out1368 in1369 e11370 e21371) (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))) in1369) (quote ()) (list out1368 (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 e11370 e21371))))) tmp1366) (syntax-violation #f "source
expression failed to match any pattern" tmp1353))) ($sc-dispatch tmp1353 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1353 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp1353 (quote (any () any .
each-any))))) x1352))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1375)
((lambda (tmp1376) ((lambda (tmp1377) (if tmp1377 (apply (lambda (_1378 k1379
keyword1380 pattern1381 template1382) (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 k1379 (map (lambda (tmp1385
tmp1384) (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)))
tmp1384) (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)))
tmp1385))) template1382 pattern1381)))))) tmp1377) (syntax-violation #f "source
expression failed to match any pattern" tmp1376))) ($sc-dispatch tmp1376 (quote
(any each-any . #(each ((any . any) any))))))) x1375))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x1386) ((lambda (tmp1387) ((lambda (tmp1388) (if
(if tmp1388 (apply (lambda (let*1389 x1390 v1391 e11392 e21393) (and-map
identifier? x1390)) tmp1388) #f) (apply (lambda (let*1395 x1396 v1397 e11398
e21399) (letrec ((f1400 (lambda (bindings1401) (if (null? bindings1401) (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 e11398 e21399)))
((lambda (tmp1405) ((lambda (tmp1406) (if tmp1406 (apply (lambda (body1407
binding1408) (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 binding1408) body1407)) tmp1406) (syntax-violation #f
"source expression failed to match any pattern" tmp1405))) ($sc-dispatch
tmp1405 (quote (any any))))) (list (f1400 (cdr bindings1401)) (car
bindings1401))))))) (f1400 (map list x1396 v1397)))) tmp1388) (syntax-violation
#f "source expression failed to match any pattern" tmp1387))) ($sc-dispatch
tmp1387 (quote (any #(each (any any)) any . each-any))))) x1386))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x1409) ((lambda (tmp1410) ((lambda (tmp1411)
(if tmp1411 (apply (lambda (_1412 var1413 init1414 step1415 e01416 e11417
c1418) ((lambda (tmp1419) ((lambda (tmp1420) (if tmp1420 (apply (lambda
(step1421) ((lambda (tmp1422) ((lambda (tmp1423) (if tmp1423 (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
var1413 init1414) (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))) e01416) (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 c1418 (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))) step1421))))))) tmp1423) ((lambda (tmp1428)
(if tmp1428 (apply (lambda (e11429 e21430) (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 var1413 init1414) (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))) e01416 (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 e11429 e21430)) (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 c1418 (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))) step1421))))))) tmp1428)
(syntax-violation #f "source expression failed to match any pattern" tmp1422)))
($sc-dispatch tmp1422 (quote (any . each-any)))))) ($sc-dispatch tmp1422 (quote
())))) e11417)) tmp1420) (syntax-violation #f "source expression failed to
match any pattern" tmp1419))) ($sc-dispatch tmp1419 (quote each-any)))) (map
(lambda (v1437 s1438) ((lambda (tmp1439) ((lambda (tmp1440) (if tmp1440 (apply
(lambda () v1437) tmp1440) ((lambda (tmp1441) (if tmp1441 (apply (lambda
(e1442) e1442) tmp1441) ((lambda (_1443) (syntax-violation (quote do) "bad step
expression" orig-x1409 s1438)) tmp1439))) ($sc-dispatch tmp1439 (quote
(any)))))) ($sc-dispatch tmp1439 (quote ())))) s1438)) var1413 step1415)))
tmp1411) (syntax-violation #f "source expression failed to match any pattern"
tmp1410))) ($sc-dispatch tmp1410 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x1409))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons1446 (lambda (x1450 y1451)
((lambda (tmp1452) ((lambda (tmp1453) (if tmp1453 (apply (lambda (x1454 y1455)
((lambda (tmp1456) ((lambda (tmp1457) (if tmp1457 (apply (lambda (dy1458)
((lambda (tmp1459) ((lambda (tmp1460) (if tmp1460 (apply (lambda (dx1461) (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 dx1461 dy1458))) tmp1460) ((lambda
(_1462) (if (null? dy1458) (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))) x1454) (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))) x1454 y1455))) tmp1459))) ($sc-dispatch
tmp1459 (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))))) x1454)) tmp1457) ((lambda (tmp1463) (if
tmp1463 (apply (lambda (stuff1464) (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 x1454 stuff1464))) tmp1463)
((lambda (else1465) (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))) x1454 y1455)) tmp1456))) ($sc-dispatch tmp1456
(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 tmp1456 (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))))) y1455)) tmp1453) (syntax-violation #f "source expression
failed to match any pattern" tmp1452))) ($sc-dispatch tmp1452 (quote (any
any))))) (list x1450 y1451)))) (quasiappend1447 (lambda (x1466 y1467) ((lambda
(tmp1468) ((lambda (tmp1469) (if tmp1469 (apply (lambda (x1470 y1471) ((lambda
(tmp1472) ((lambda (tmp1473) (if tmp1473 (apply (lambda () x1470) tmp1473)
((lambda (_1474) (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))) x1470 y1471)) tmp1472))) ($sc-dispatch tmp1472
(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))) ()))))) y1471))
tmp1469) (syntax-violation #f "source expression failed to match any pattern"
tmp1468))) ($sc-dispatch tmp1468 (quote (any any))))) (list x1466 y1467))))
(quasivector1448 (lambda (x1475) ((lambda (tmp1476) ((lambda (x1477) ((lambda
(tmp1478) ((lambda (tmp1479) (if tmp1479 (apply (lambda (x1480) (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
x1480))) tmp1479) ((lambda (tmp1482) (if tmp1482 (apply (lambda (x1483) (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))) x1483)) tmp1482)
((lambda (_1485) (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))) x1477)) tmp1478))) ($sc-dispatch tmp1478 (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 tmp1478 (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))))) x1477)) tmp1476)) x1475))) (quasi1449 (lambda
(p1486 lev1487) ((lambda (tmp1488) ((lambda (tmp1489) (if tmp1489 (apply
(lambda (p1490) (if (= lev1487 0) p1490 (quasicons1446 (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)))) (quasi1449 (list p1490) (- lev1487 1))))) tmp1489) ((lambda
(tmp1491) (if (if tmp1491 (apply (lambda (args1492) (= lev1487 0)) tmp1491) #f)
(apply (lambda (args1493) (syntax-violation (quote unquote) "unquote takes
exactly one argument" p1486 (cons (quote #(syntax-object unquote ((top)
#(ribcage #(args) #((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))) args1493)))
tmp1491) ((lambda (tmp1494) (if tmp1494 (apply (lambda (p1495 q1496) (if (=
lev1487 0) (quasiappend1447 p1495 (quasi1449 q1496 lev1487)) (quasicons1446
(quasicons1446 (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)))) (quasi1449 (list p1495) (- lev1487 1))) (quasi1449 q1496 lev1487))))
tmp1494) ((lambda (tmp1497) (if (if tmp1497 (apply (lambda (args1498 q1499) (=
lev1487 0)) tmp1497) #f) (apply (lambda (args1500 q1501) (syntax-violation
(quote unquote-splicing) "unquote-splicing takes exactly one argument" p1486
(cons (quote #(syntax-object unquote-splicing ((top) #(ribcage #(args 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))) args1500))) tmp1497)
((lambda (tmp1502) (if tmp1502 (apply (lambda (p1503) (quasicons1446 (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)))) (quasi1449 (list p1503) (+ lev1487
1)))) tmp1502) ((lambda (tmp1504) (if tmp1504 (apply (lambda (p1505 q1506)
(quasicons1446 (quasi1449 p1505 lev1487) (quasi1449 q1506 lev1487))) tmp1504)
((lambda (tmp1507) (if tmp1507 (apply (lambda (x1508) (quasivector1448
(quasi1449 x1508 lev1487))) tmp1507) ((lambda (p1510) (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))) p1510)) tmp1488))) ($sc-dispatch tmp1488 (quote #(vector
each-any)))))) ($sc-dispatch tmp1488 (quote (any . any)))))) ($sc-dispatch
tmp1488 (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 tmp1488 (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 tmp1488 (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 tmp1488
(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)))))) ($sc-dispatch tmp1488 (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))))) p1486)))) (lambda
(x1511) ((lambda (tmp1512) ((lambda (tmp1513) (if tmp1513 (apply (lambda (_1514
e1515) (quasi1449 e1515 0)) tmp1513) (syntax-violation #f "source expression
failed to match any pattern" tmp1512))) ($sc-dispatch tmp1512 (quote (any
any))))) x1511)))))
+(define include (make-syncase-macro (quote macro) (lambda (x1516) (letrec
((read-file1517 (lambda (fn1518 k1519) (let ((p1520 (open-input-file fn1518)))
(letrec ((f1521 (lambda (x1522) (if (eof-object? x1522) (begin
(close-input-port p1520) (quote ())) (cons (datum->syntax k1519 x1522) (f1521
(read p1520))))))) (f1521 (read p1520))))))) ((lambda (tmp1523) ((lambda
(tmp1524) (if tmp1524 (apply (lambda (k1525 filename1526) (let ((fn1527
(syntax->datum filename1526))) ((lambda (tmp1528) ((lambda (tmp1529) (if
tmp1529 (apply (lambda (exp1530) (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))) exp1530)) tmp1529) (syntax-violation #f "source expression
failed to match any pattern" tmp1528))) ($sc-dispatch tmp1528 (quote
each-any)))) (read-file1517 fn1527 k1525)))) tmp1524) (syntax-violation #f
"source expression failed to match any pattern" tmp1523))) ($sc-dispatch
tmp1523 (quote (any any))))) x1516)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x1532) ((lambda
(tmp1533) ((lambda (tmp1534) (if tmp1534 (apply (lambda (_1535 e1536)
(syntax-violation (quote unquote) "expression not valid outside of quasiquote"
x1532)) tmp1534) (syntax-violation #f "source expression failed to match any
pattern" tmp1533))) ($sc-dispatch tmp1533 (quote (any any))))) x1532))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1537)
((lambda (tmp1538) ((lambda (tmp1539) (if tmp1539 (apply (lambda (_1540 e1541)
(syntax-violation (quote unquote-splicing) "expression not valid outside of
quasiquote" x1537)) tmp1539) (syntax-violation #f "source expression failed to
match any pattern" tmp1538))) ($sc-dispatch tmp1538 (quote (any any)))))
x1537))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x1542) ((lambda (tmp1543) ((lambda (tmp1544) (if
tmp1544 (apply (lambda (_1545 e1546 m11547 m21548) ((lambda (tmp1549) ((lambda
(body1550) (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))) e1546)) body1550))
tmp1549)) (letrec ((f1551 (lambda (clause1552 clauses1553) (if (null?
clauses1553) ((lambda (tmp1555) ((lambda (tmp1556) (if tmp1556 (apply (lambda
(e11557 e21558) (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 e11557 e21558))) tmp1556) ((lambda (tmp1560) (if
tmp1560 (apply (lambda (k1561 e11562 e21563) (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))) k1561)) (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 e11562 e21563)))) tmp1560)
((lambda (_1566) (syntax-violation (quote case) "bad clause" x1542 clause1552))
tmp1555))) ($sc-dispatch tmp1555 (quote (each-any any . each-any))))))
($sc-dispatch tmp1555 (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))))) clause1552) ((lambda (tmp1567) ((lambda (rest1568) ((lambda
(tmp1569) ((lambda (tmp1570) (if tmp1570 (apply (lambda (k1571 e11572 e21573)
(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))) k1571)) (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 e11572 e21573)) rest1568)) tmp1570)
((lambda (_1576) (syntax-violation (quote case) "bad clause" x1542 clause1552))
tmp1569))) ($sc-dispatch tmp1569 (quote (each-any any . each-any)))))
clause1552)) tmp1567)) (f1551 (car clauses1553) (cdr clauses1553))))))) (f1551
m11547 m21548)))) tmp1544) (syntax-violation #f "source expression failed to
match any pattern" tmp1543))) ($sc-dispatch tmp1543 (quote (any any any .
each-any))))) x1542))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1577)
((lambda (tmp1578) ((lambda (tmp1579) (if tmp1579 (apply (lambda (_1580 e1581)
(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)))
e1581)) (list (cons _1580 (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 e1581 (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)))))))))) tmp1579) (syntax-violation #f "source expression failed to
match any pattern" tmp1578))) ($sc-dispatch tmp1578 (quote (any any)))))
x1577))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index c2668c0..f18b626 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -560,7 +560,6 @@
;;; <binding> ::= (macro . <procedure>) macros
;;; (core . <procedure>) core forms
-;;; (external-macro . <procedure>) external-macro
;;; (module-ref . <procedure>) @ or @@
;;; (begin) begin
;;; (define) define
@@ -999,9 +998,9 @@
;;;
;;; type value explanation
;;; -------------------------------------------------------------------
-;;; core procedure core form (including singleton)
-;;; external-macro procedure external macro
-;;; module-ref procedure @ or @@ form
+;;; core procedure core singleton
+;;; core-form procedure core form
+;;; module-ref procedure @ or @@ singleton
;;; lexical name lexical variable reference
;;; global name global variable reference
;;; begin none begin keyword
@@ -1031,7 +1030,7 @@
;;; forms, although perhaps this should be done by the consumer.
(define syntax-type
- (lambda (e r w s rib mod)
+ (lambda (e r w s rib mod for-car?)
(cond
((symbol? e)
(let* ((n (id-var-name e w))
@@ -1041,64 +1040,70 @@
((lexical) (values type (binding-value b) e w s mod))
((global) (values type n e w s mod))
((macro)
- (syntax-type (chi-macro (binding-value b) e r w rib mod)
- r empty-wrap s rib mod))
+ (if for-car?
+ (values type (binding-value b) e w s mod)
+ (syntax-type (chi-macro (binding-value b) e r w rib mod)
+ r empty-wrap s rib mod #f)))
(else (values type (binding-value b) e w s mod)))))
((pair? e)
(let ((first (car e)))
- (if (id? first)
- (let* ((n (id-var-name first w))
- (b (lookup n r (or (and (syntax-object? first)
- (syntax-object-module first))
- mod)))
- (type (binding-type b)))
- (case type
- ((lexical)
- (values 'lexical-call (binding-value b) e w s mod))
- ((global)
- (values 'global-call n e w s mod))
- ((macro)
- (syntax-type (chi-macro (binding-value b) e r w rib mod)
- r empty-wrap s rib mod))
- ((core external-macro module-ref)
- (values type (binding-value b) e w s mod))
- ((local-syntax)
- (values 'local-syntax-form (binding-value b) e w s mod))
- ((begin)
- (values 'begin-form #f e w s mod))
- ((eval-when)
- (values 'eval-when-form #f e w s mod))
- ((define)
- (syntax-case e ()
- ((_ name val)
- (id? (syntax name))
- (values 'define-form (syntax name) (syntax val) w s mod))
- ((_ (name . args) e1 e2 ...)
- (and (id? (syntax name))
- (valid-bound-ids? (lambda-var-list (syntax args))))
- ; need lambda here...
- (values 'define-form (wrap (syntax name) w mod)
- (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w
mod))
- empty-wrap s mod))
- ((_ name)
- (id? (syntax name))
- (values 'define-form (wrap (syntax name) w mod)
- (syntax (if #f #f))
- empty-wrap s mod))))
- ((define-syntax)
- (syntax-case e ()
- ((_ name val)
- (id? (syntax name))
- (values 'define-syntax-form (syntax name)
- (syntax val) w s mod))))
- (else
- (values 'call #f e w s mod))))
- (values 'call #f e w s mod))))
+ (call-with-values
+ (lambda () (syntax-type first r w s rib mod #t))
+ (lambda (ftype fval fe fw fs fmod)
+ (case ftype
+ ((lexical)
+ (values 'lexical-call fval e w s mod))
+ ((global)
+ ;; If we got here via an (@@ ...) expansion, we need to
+ ;; make sure the fmod information is propagated back
+ ;; correctly -- hence this consing.
+ (values 'global-call (make-syntax-object fval w fmod)
+ e w s mod))
+ ((macro)
+ (syntax-type (chi-macro fval e r w rib mod)
+ r empty-wrap s rib mod for-car?))
+ ((module-ref)
+ (call-with-values (lambda () (fval e))
+ (lambda (sym mod)
+ (syntax-type sym r w s rib mod for-car?))))
+ ((core)
+ (values 'core-form fval e w s mod))
+ ((local-syntax)
+ (values 'local-syntax-form fval e w s mod))
+ ((begin)
+ (values 'begin-form #f e w s mod))
+ ((eval-when)
+ (values 'eval-when-form #f e w s mod))
+ ((define)
+ (syntax-case e ()
+ ((_ name val)
+ (id? (syntax name))
+ (values 'define-form (syntax name) (syntax val) w s mod))
+ ((_ (name . args) e1 e2 ...)
+ (and (id? (syntax name))
+ (valid-bound-ids? (lambda-var-list (syntax args))))
+ ; need lambda here...
+ (values 'define-form (wrap (syntax name) w mod)
+ (cons (syntax lambda) (wrap (syntax (args e1 e2
...)) w mod))
+ empty-wrap s mod))
+ ((_ name)
+ (id? (syntax name))
+ (values 'define-form (wrap (syntax name) w mod)
+ (syntax (if #f #f))
+ empty-wrap s mod))))
+ ((define-syntax)
+ (syntax-case e ()
+ ((_ name val)
+ (id? (syntax name))
+ (values 'define-syntax-form (syntax name)
+ (syntax val) w s mod))))
+ (else
+ (values 'call #f e w s mod)))))))
((syntax-object? e)
(syntax-type (syntax-object-expression e)
r
(join-wraps w (syntax-object-wrap e))
- s rib (or (syntax-object-module e) mod)))
+ s rib (or (syntax-object-module e) mod) for-car?))
((self-evaluating? e) (values 'constant #f e w s mod))
(else (values 'other #f e w s mod)))))
@@ -1111,7 +1116,7 @@
(if (eq? m 'c&e) (top-level-eval-hook x mod))
x))))
(call-with-values
- (lambda () (syntax-type e r w (source-annotation e) #f mod))
+ (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
(lambda (type value e w s mod)
(case type
((begin-form)
@@ -1187,7 +1192,7 @@
(define chi
(lambda (e r w mod)
(call-with-values
- (lambda () (syntax-type e r w (source-annotation e) #f mod))
+ (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
(lambda (type value e w s mod)
(chi-expr type value e r w s mod)))))
@@ -1196,7 +1201,7 @@
(case type
((lexical)
(build-lexical-reference 'value s e value))
- ((core external-macro)
+ ((core core-form)
;; apply transformer
(value e r w s mod))
((module-ref)
@@ -1210,9 +1215,12 @@
e r w s mod))
((global-call)
(chi-application
- (build-global-reference (source-annotation (car e)) value
- (if (syntax-object? (car e))
- (syntax-object-module (car e))
+ (build-global-reference (source-annotation (car e))
+ (if (syntax-object? value)
+ (syntax-object-expression value)
+ value)
+ (if (syntax-object? value)
+ (syntax-object-module value)
mod))
e r w s mod))
((constant) (build-data s (strip (source-wrap e w s mod) empty-wrap)))
@@ -1342,7 +1350,7 @@
(syntax-violation #f "no expressions in body" outer-form)
(let ((e (cdar body)) (er (caar body)))
(call-with-values
- (lambda () (syntax-type e er empty-wrap (source-annotation er)
ribcage mod))
+ (lambda () (syntax-type e er empty-wrap (source-annotation er)
ribcage mod #f))
(lambda (type value e w s mod)
(case type
((define-form)
@@ -1843,7 +1851,7 @@
(source-wrap e w s mod)))))))
((_ (head tail ...) val)
(call-with-values
- (lambda () (syntax-type (syntax head) r empty-wrap no-source #f
mod))
+ (lambda () (syntax-type (syntax head) r empty-wrap no-source #f mod
#t))
(lambda (type value ee ww ss modmod)
(case type
((module-ref)
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. a23c940b717413139d294d4f5c443b8d165f42a9,
Andy Wingo <=