[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 811d10f5a2
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 811d10f5a2297e2fe6a881d02c67c45bf4311a27 |
|
Date: |
Thu, 07 May 2009 15:32:25 +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=811d10f5a2297e2fe6a881d02c67c45bf4311a27
The branch, syncase-in-boot-9 has been updated
via 811d10f5a2297e2fe6a881d02c67c45bf4311a27 (commit)
via 1aeb082b8281eb12640d7a42c88a566418c64782 (commit)
via f27e9e11cd01eefa9eab3cfd277120ce73e3355a (commit)
from f4a644ee886903df43810f1a0e65ce2ef891999f (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 811d10f5a2297e2fe6a881d02c67c45bf4311a27
Author: Andy Wingo <address@hidden>
Date: Thu May 7 13:45:03 2009 +0200
new language: tree-il. psyntax generates it when run in compile mode.
* module/Makefile.am: Add tree-il sources.
* module/ice-9/compile-psyntax.scm: Adjust for sc-expand producing
tree-il in compile mode.
* module/ice-9/psyntax.scm: Switch from expand-support to tree-il for
generating output in compile mode. Completely generate tree-il -- the
output wasn't Scheme before, but now it's completely not Scheme.
* module/ice-9/psyntax-pp.scm: Regenerated.
* module/language/scheme/compile-ghil.scm: Strip structures using
tree-il, not expand-support.
* module/language/tree-il.scm:
* module/language/tree-il/spec.scm
* module/language/tree-il/compile-glil.scm: New language. It will compile
to GLIL, though it doesn't yet.
commit 1aeb082b8281eb12640d7a42c88a566418c64782
Author: Andy Wingo <address@hidden>
Date: Thu May 7 11:02:10 2009 +0200
make expand-support structure constructors take a source argument
* module/ice-9/expand-support.scm (make-module-ref, make-lexical): Add
source arguments to these constructors.
* module/ice-9/psyntax.scm:
* module/ice-9/psyntax-pp.scm: Adapt to match, though we don't wire
everything up yet.
commit f27e9e11cd01eefa9eab3cfd277120ce73e3355a
Author: Andy Wingo <address@hidden>
Date: Thu May 7 10:27:53 2009 +0200
fix install-global construction of `define' forms
* module/ice-9/psyntax.scm (build-global-definition): Remove mod
argument, as it does not seem we could ever define something in another
module.
(chi-install-global): Build the define as a definition, not an
application. Doesn't matter now, but it will later.
(chi-top): Fix build-global-definition call.
* module/ice-9/psyntax.scm: Regenerated.
-----------------------------------------------------------------------
Summary of changes:
module/Makefile.am | 7 +-
module/ice-9/compile-psyntax.scm | 4 +-
module/ice-9/expand-support.scm | 4 +-
module/ice-9/psyntax-pp.scm | 22 +-
module/ice-9/psyntax.scm | 260 +++++++++++---------
module/language/scheme/compile-ghil.scm | 4 +-
module/language/tree-il.scm | 248 +++++++++++++++++++
module/language/{ghil => tree-il}/compile-glil.scm | 6 +-
module/language/tree-il/spec.scm | 52 ++++
9 files changed, 465 insertions(+), 142 deletions(-)
create mode 100644 module/language/tree-il.scm
copy module/language/{ghil => tree-il}/compile-glil.scm (99%)
create mode 100644 module/language/tree-il/spec.scm
diff --git a/module/Makefile.am b/module/Makefile.am
index 9cda51a..4bc52e4 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -31,13 +31,15 @@ modpath =
# putting these core modules first.
SOURCES = \
- ice-9/psyntax-pp.scm \
+ ice-9/psyntax-pp.scm
\
system/base/pmatch.scm system/base/syntax.scm
\
system/base/compile.scm system/base/language.scm \
\
+ language/tree-il.scm \
language/ghil.scm language/glil.scm language/assembly.scm \
\
$(SCHEME_LANG_SOURCES) \
+ $(TREE_IL_LANG_SOURCES) \
$(GHIL_LANG_SOURCES) $(GLIL_LANG_SOURCES) \
$(ASSEMBLY_LANG_SOURCES) $(BYTECODE_LANG_SOURCES) \
$(OBJCODE_LANG_SOURCES) $(VALUE_LANG_SOURCES)
\
@@ -67,6 +69,9 @@ SCHEME_LANG_SOURCES =
\
language/scheme/compile-ghil.scm language/scheme/spec.scm \
language/scheme/inline.scm
+TREE_IL_LANG_SOURCES = \
+ language/tree-il/spec.scm language/tree-il/compile-glil.scm
+
GHIL_LANG_SOURCES = \
language/ghil/spec.scm language/ghil/compile-glil.scm
diff --git a/module/ice-9/compile-psyntax.scm b/module/ice-9/compile-psyntax.scm
index 853586e..2b8eec0 100644
--- a/module/ice-9/compile-psyntax.scm
+++ b/module/ice-9/compile-psyntax.scm
@@ -1,4 +1,4 @@
-(use-modules (ice-9 expand-support))
+(use-modules (language tree-il))
(let ((source (list-ref (command-line) 1))
(target (list-ref (command-line) 2)))
(let ((in (open-input-file source))
@@ -12,7 +12,7 @@
(close-port out)
(close-port in))
(begin
- (write (strip-expansion-structures
+ (write (tree-il->scheme
(sc-expand x 'c '(compile load eval)))
out)
(newline out)
diff --git a/module/ice-9/expand-support.scm b/module/ice-9/expand-support.scm
index 5215c22..33a9b3f 100644
--- a/module/ice-9/expand-support.scm
+++ b/module/ice-9/expand-support.scm
@@ -102,7 +102,7 @@
(define (module-ref? x)
(and (struct? x) (eq? (struct-vtable x) <module-ref>)))
-(define (make-module-ref modname symbol public?)
+(define (make-module-ref source modname symbol public?)
(make-struct <module-ref> 0 modname symbol public?))
(define (module-ref-modname a)
@@ -126,7 +126,7 @@
(define (lexical? x)
(and (struct? x) (eq? (struct-vtable x) <lexical>)))
-(define (make-lexical name gensym)
+(define (make-lexical source name gensym)
(make-struct <lexical> 0 name gensym))
(define (lexical-name a)
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 8b41c5e..2718a1e 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*1170 (lambda (f1210 first1209 . rest1208) (or (null?
first1209) (if (null? rest1208) (let andmap1211 ((first1212 first1209)) (let
((x1213 (car first1212)) (first1214 (cdr first1212))) (if (null? first1214)
(f1210 x1213) (and (f1210 x1213) (andmap1211 first1214))))) (let andmap1215
((first1216 first1209) (rest1217 rest1208)) (let ((x1218 (car first1216))
(xr1219 (map car rest1217)) (first1220 (cdr first1216)) (rest1221 (map cdr
rest1217))) (if (null? first1220) (apply f1210 (cons x1218 xr1219)) (and (apply
f1210 (cons x1218 xr1219)) (andmap1215 first1220 rest1221)))))))))) (letrec
((lambda-var-list1308 (lambda (vars1484) (let lvl1485 ((vars1486 vars1484)
(ls1487 (quote ())) (w1488 (quote (())))) (cond ((pair? vars1486) (lvl1485 (cdr
vars1486) (cons (wrap1287 (car vars1486) w1488 #f) ls1487) w1488)) ((id?1259
vars1486) (cons (wrap1287 vars1486 w1488 #f) ls1487)) ((null? vars1486) ls1487)
((syntax-object?1243 vars1486) (lvl1485 (syntax-object-expression1244 vars1486)
ls1487 (join-wraps1278 w1488 (syntax-object-wrap1245 vars1486)))) ((annotation?
vars1486) (lvl1485 (annotation-expression vars1486) ls1487 w1488)) (else (cons
vars1486 ls1487)))))) (gen-var1307 (lambda (id1489) (let ((id1490 (if
(syntax-object?1243 id1489) (syntax-object-expression1244 id1489) id1489))) (if
(annotation? id1490) (build-annotated1232 (annotation-source id1490) (gensym
(symbol->string (annotation-expression id1490)))) (build-annotated1232 #f
(gensym (symbol->string id1490))))))) (strip1306 (lambda (x1491 w1492) (if
(memq (quote top) (wrap-marks1262 w1492)) (if (or (annotation? x1491) (and
(pair? x1491) (annotation? (car x1491)))) (strip-annotation1305 x1491 #f)
x1491) (let f1493 ((x1494 x1491)) (cond ((syntax-object?1243 x1494) (strip1306
(syntax-object-expression1244 x1494) (syntax-object-wrap1245 x1494))) ((pair?
x1494) (let ((a1495 (f1493 (car x1494))) (d1496 (f1493 (cdr x1494)))) (if (and
(eq? a1495 (car x1494)) (eq? d1496 (cdr x1494))) x1494 (cons a1495 d1496))))
((vector? x1494) (let ((old1497 (vector->list x1494))) (let ((new1498 (map
f1493 old1497))) (if (and-map*1170 eq? old1497 new1498) x1494 (list->vector
new1498))))) (else x1494)))))) (strip-annotation1305 (lambda (x1499 parent1500)
(cond ((pair? x1499) (let ((new1501 (cons #f #f))) (begin (if parent1500
(set-annotation-stripped! parent1500 new1501)) (set-car! new1501
(strip-annotation1305 (car x1499) #f)) (set-cdr! new1501 (strip-annotation1305
(cdr x1499) #f)) new1501))) ((annotation? x1499) (or (annotation-stripped
x1499) (strip-annotation1305 (annotation-expression x1499) x1499))) ((vector?
x1499) (let ((new1502 (make-vector (vector-length x1499)))) (begin (if
parent1500 (set-annotation-stripped! parent1500 new1502)) (let loop1503 ((i1504
(- (vector-length x1499) 1))) (unless (fx<1227 i1504 0) (vector-set! new1502
i1504 (strip-annotation1305 (vector-ref x1499 i1504) #f)) (loop1503 (fx-1225
i1504 1)))) new1502))) (else x1499)))) (ellipsis?1304 (lambda (x1505) (and
(nonsymbol-id?1258 x1505) (free-id=?1282 x1505 (quote #(syntax-object ...
((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile))))))) (chi-void1303 (lambda () (build-annotated1232 #f (cons
(build-annotated1232 #f (quote if)) (quote (#f #f))))))
(eval-local-transformer1302 (lambda (expanded1506 mod1507) (let ((p1508
(local-eval-hook1229 expanded1506 mod1507))) (if (procedure? p1508) p1508
(syntax-violation #f "nonprocedure transformer" p1508)))))
(chi-local-syntax1301 (lambda (rec?1509 e1510 r1511 w1512 s1513 mod1514 k1515)
((lambda (tmp1516) ((lambda (tmp1517) (if tmp1517 (apply (lambda (_1518 id1519
val1520 e11521 e21522) (let ((ids1523 id1519)) (if (not (valid-bound-ids?1284
ids1523)) (syntax-violation #f "duplicate bound keyword" e1510) (let
((labels1525 (gen-labels1265 ids1523))) (let ((new-w1526 (make-binding-wrap1276
ids1523 labels1525 w1512))) (k1515 (cons e11521 e21522) (extend-env1253
labels1525 (let ((w1528 (if rec?1509 new-w1526 w1512)) (trans-r1529
(macros-only-env1255 r1511))) (map (lambda (x1530) (cons (quote macro)
(eval-local-transformer1302 (chi1295 x1530 trans-r1529 w1528 mod1514)
mod1514))) val1520)) r1511) new-w1526 s1513 mod1514)))))) tmp1517) ((lambda
(_1532) (syntax-violation #f "bad local syntax definition" (source-wrap1288
e1510 w1512 s1513 mod1514))) tmp1516))) ($sc-dispatch tmp1516 (quote (any
#(each (any any)) any . each-any))))) e1510))) (chi-lambda-clause1300 (lambda
(e1533 docstring1534 c1535 r1536 w1537 mod1538 k1539) ((lambda (tmp1540)
((lambda (tmp1541) (if (if tmp1541 (apply (lambda (args1542 doc1543 e11544
e21545) (and (string? (syntax->datum doc1543)) (not docstring1534))) tmp1541)
#f) (apply (lambda (args1546 doc1547 e11548 e21549) (chi-lambda-clause1300
e1533 doc1547 (cons args1546 (cons e11548 e21549)) r1536 w1537 mod1538 k1539))
tmp1541) ((lambda (tmp1551) (if tmp1551 (apply (lambda (id1552 e11553 e21554)
(let ((ids1555 id1552)) (if (not (valid-bound-ids?1284 ids1555))
(syntax-violation (quote lambda) "invalid parameter list" e1533) (let
((labels1557 (gen-labels1265 ids1555)) (new-vars1558 (map gen-var1307
ids1555))) (k1539 new-vars1558 docstring1534 (chi-body1299 (cons e11553 e21554)
e1533 (extend-var-env1254 labels1557 new-vars1558 r1536) (make-binding-wrap1276
ids1555 labels1557 w1537) mod1538)))))) tmp1551) ((lambda (tmp1560) (if tmp1560
(apply (lambda (ids1561 e11562 e21563) (let ((old-ids1564 (lambda-var-list1308
ids1561))) (if (not (valid-bound-ids?1284 old-ids1564)) (syntax-violation
(quote lambda) "invalid parameter list" e1533) (let ((labels1565
(gen-labels1265 old-ids1564)) (new-vars1566 (map gen-var1307 old-ids1564)))
(k1539 (let f1567 ((ls11568 (cdr new-vars1566)) (ls21569 (car new-vars1566)))
(if (null? ls11568) ls21569 (f1567 (cdr ls11568) (cons (car ls11568)
ls21569)))) docstring1534 (chi-body1299 (cons e11562 e21563) e1533
(extend-var-env1254 labels1565 new-vars1566 r1536) (make-binding-wrap1276
old-ids1564 labels1565 w1537) mod1538)))))) tmp1560) ((lambda (_1571)
(syntax-violation (quote lambda) "bad lambda" e1533)) tmp1540))) ($sc-dispatch
tmp1540 (quote (any any . each-any)))))) ($sc-dispatch tmp1540 (quote (each-any
any . each-any)))))) ($sc-dispatch tmp1540 (quote (any any any . each-any)))))
c1535))) (chi-body1299 (lambda (body1572 outer-form1573 r1574 w1575 mod1576)
(let ((r1577 (cons (quote ("placeholder" placeholder)) r1574))) (let
((ribcage1578 (make-ribcage1266 (quote ()) (quote ()) (quote ())))) (let
((w1579 (make-wrap1261 (wrap-marks1262 w1575) (cons ribcage1578 (wrap-subst1263
w1575))))) (let parse1580 ((body1581 (map (lambda (x1587) (cons r1577 (wrap1287
x1587 w1579 mod1576))) body1572)) (ids1582 (quote ())) (labels1583 (quote ()))
(vars1584 (quote ())) (vals1585 (quote ())) (bindings1586 (quote ()))) (if
(null? body1581) (syntax-violation #f "no expressions in body" outer-form1573)
(let ((e1588 (cdar body1581)) (er1589 (caar body1581))) (call-with-values
(lambda () (syntax-type1293 e1588 er1589 (quote (())) #f ribcage1578 mod1576))
(lambda (type1590 value1591 e1592 w1593 s1594 mod1595) (let ((t1596 type1590))
(if (memv t1596 (quote (define-form))) (let ((id1597 (wrap1287 value1591 w1593
mod1595)) (label1598 (gen-label1264))) (let ((var1599 (gen-var1307 id1597)))
(begin (extend-ribcage!1275 ribcage1578 id1597 label1598) (parse1580 (cdr
body1581) (cons id1597 ids1582) (cons label1598 labels1583) (cons var1599
vars1584) (cons (cons er1589 (wrap1287 e1592 w1593 mod1595)) vals1585) (cons
(cons (quote lexical) var1599) bindings1586))))) (if (memv t1596 (quote
(define-syntax-form))) (let ((id1600 (wrap1287 value1591 w1593 mod1595))
(label1601 (gen-label1264))) (begin (extend-ribcage!1275 ribcage1578 id1600
label1601) (parse1580 (cdr body1581) (cons id1600 ids1582) (cons label1601
labels1583) vars1584 vals1585 (cons (cons (quote macro) (cons er1589 (wrap1287
e1592 w1593 mod1595))) bindings1586)))) (if (memv t1596 (quote (begin-form)))
((lambda (tmp1602) ((lambda (tmp1603) (if tmp1603 (apply (lambda (_1604 e11605)
(parse1580 (let f1606 ((forms1607 e11605)) (if (null? forms1607) (cdr body1581)
(cons (cons er1589 (wrap1287 (car forms1607) w1593 mod1595)) (f1606 (cdr
forms1607))))) ids1582 labels1583 vars1584 vals1585 bindings1586)) tmp1603)
(syntax-violation #f "source expression failed to match any pattern" tmp1602)))
($sc-dispatch tmp1602 (quote (any . each-any))))) e1592) (if (memv t1596 (quote
(local-syntax-form))) (chi-local-syntax1301 value1591 e1592 er1589 w1593 s1594
mod1595 (lambda (forms1609 er1610 w1611 s1612 mod1613) (parse1580 (let f1614
((forms1615 forms1609)) (if (null? forms1615) (cdr body1581) (cons (cons er1610
(wrap1287 (car forms1615) w1611 mod1613)) (f1614 (cdr forms1615))))) ids1582
labels1583 vars1584 vals1585 bindings1586))) (if (null? ids1582)
(build-sequence1238 #f (map (lambda (x1616) (chi1295 (cdr x1616) (car x1616)
(quote (())) mod1595)) (cons (cons er1589 (source-wrap1288 e1592 w1593 s1594
mod1595)) (cdr body1581)))) (begin (if (not (valid-bound-ids?1284 ids1582))
(syntax-violation #f "invalid or duplicate identifier in definition"
outer-form1573)) (let loop1617 ((bs1618 bindings1586) (er-cache1619 #f)
(r-cache1620 #f)) (if (not (null? bs1618)) (let ((b1621 (car bs1618))) (if (eq?
(car b1621) (quote macro)) (let ((er1622 (cadr b1621))) (let ((r-cache1623 (if
(eq? er1622 er-cache1619) r-cache1620 (macros-only-env1255 er1622)))) (begin
(set-cdr! b1621 (eval-local-transformer1302 (chi1295 (cddr b1621) r-cache1623
(quote (())) mod1595) mod1595)) (loop1617 (cdr bs1618) er1622 r-cache1623))))
(loop1617 (cdr bs1618) er-cache1619 r-cache1620))))) (set-cdr! r1577
(extend-env1253 labels1583 bindings1586 (cdr r1577))) (build-letrec1241 #f
vars1584 (map (lambda (x1624) (chi1295 (cdr x1624) (car x1624) (quote (()))
mod1595)) vals1585) (build-sequence1238 #f (map (lambda (x1625) (chi1295 (cdr
x1625) (car x1625) (quote (())) mod1595)) (cons (cons er1589 (source-wrap1288
e1592 w1593 s1594 mod1595)) (cdr body1581)))))))))))))))))))))) (chi-macro1298
(lambda (p1626 e1627 r1628 w1629 rib1630 mod1631) (letrec
((rebuild-macro-output1632 (lambda (x1633 m1634) (cond ((pair? x1633) (cons
(rebuild-macro-output1632 (car x1633) m1634) (rebuild-macro-output1632 (cdr
x1633) m1634))) ((syntax-object?1243 x1633) (let ((w1635
(syntax-object-wrap1245 x1633))) (let ((ms1636 (wrap-marks1262 w1635)) (s1637
(wrap-subst1263 w1635))) (if (and (pair? ms1636) (eq? (car ms1636) #f))
(make-syntax-object1242 (syntax-object-expression1244 x1633) (make-wrap1261
(cdr ms1636) (if rib1630 (cons rib1630 (cdr s1637)) (cdr s1637)))
(syntax-object-module1246 x1633)) (make-syntax-object1242
(syntax-object-expression1244 x1633) (make-wrap1261 (cons m1634 ms1636) (if
rib1630 (cons rib1630 (cons (quote shift) s1637)) (cons (quote shift) s1637)))
(let ((pmod1638 (procedure-module p1626))) (if pmod1638 (cons (quote hygiene)
(module-name pmod1638)) (quote (hygiene guile))))))))) ((vector? x1633) (let
((n1639 (vector-length x1633))) (let ((v1640 (make-vector n1639))) (let
doloop1641 ((i1642 0)) (if (fx=1226 i1642 n1639) v1640 (begin (vector-set!
v1640 i1642 (rebuild-macro-output1632 (vector-ref x1633 i1642) m1634))
(doloop1641 (fx+1224 i1642 1)))))))) ((symbol? x1633) (syntax-violation #f
"encountered raw symbol in macro output" (source-wrap1288 e1627 w1629 s
mod1631) x1633)) (else x1633))))) (rebuild-macro-output1632 (p1626 (wrap1287
e1627 (anti-mark1274 w1629) mod1631)) (string #\m))))) (chi-application1297
(lambda (x1643 e1644 r1645 w1646 s1647 mod1648) ((lambda (tmp1649) ((lambda
(tmp1650) (if tmp1650 (apply (lambda (e01651 e11652) (build-annotated1232 s1647
(cons x1643 (map (lambda (e1653) (chi1295 e1653 r1645 w1646 mod1648))
e11652)))) tmp1650) (syntax-violation #f "source expression failed to match any
pattern" tmp1649))) ($sc-dispatch tmp1649 (quote (any . each-any))))) e1644)))
(chi-expr1296 (lambda (type1655 value1656 e1657 r1658 w1659 s1660 mod1661) (let
((t1662 type1655)) (if (memv t1662 (quote (lexical)))
(build-lexical-reference1233 (quote value) s1660 e1657 value1656) (if (memv
t1662 (quote (core external-macro))) (value1656 e1657 r1658 w1659 s1660
mod1661) (if (memv t1662 (quote (module-ref))) (call-with-values (lambda ()
(value1656 e1657)) (lambda (id1663 mod1664) (build-global-reference1235 s1660
id1663 mod1664))) (if (memv t1662 (quote (lexical-call))) (chi-application1297
(build-lexical-reference1233 (quote fun) (source-annotation1250 (car e1657))
(car e1657) value1656) e1657 r1658 w1659 s1660 mod1661) (if (memv t1662 (quote
(global-call))) (chi-application1297 (build-global-reference1235
(source-annotation1250 (car e1657)) value1656 (if (syntax-object?1243 (car
e1657)) (syntax-object-module1246 (car e1657)) mod1661)) e1657 r1658 w1659
s1660 mod1661) (if (memv t1662 (quote (constant))) (build-data1237 s1660
(strip1306 (source-wrap1288 e1657 w1659 s1660 mod1661) (quote (())))) (if (memv
t1662 (quote (global))) (build-global-reference1235 s1660 value1656 mod1661)
(if (memv t1662 (quote (call))) (chi-application1297 (chi1295 (car e1657) r1658
w1659 mod1661) e1657 r1658 w1659 s1660 mod1661) (if (memv t1662 (quote
(begin-form))) ((lambda (tmp1665) ((lambda (tmp1666) (if tmp1666 (apply (lambda
(_1667 e11668 e21669) (chi-sequence1289 (cons e11668 e21669) r1658 w1659 s1660
mod1661)) tmp1666) (syntax-violation #f "source expression failed to match any
pattern" tmp1665))) ($sc-dispatch tmp1665 (quote (any any . each-any)))))
e1657) (if (memv t1662 (quote (local-syntax-form))) (chi-local-syntax1301
value1656 e1657 r1658 w1659 s1660 mod1661 chi-sequence1289) (if (memv t1662
(quote (eval-when-form))) ((lambda (tmp1671) ((lambda (tmp1672) (if tmp1672
(apply (lambda (_1673 x1674 e11675 e21676) (let ((when-list1677
(chi-when-list1292 e1657 x1674 w1659))) (if (memq (quote eval) when-list1677)
(chi-sequence1289 (cons e11675 e21676) r1658 w1659 s1660 mod1661)
(chi-void1303)))) tmp1672) (syntax-violation #f "source expression failed to
match any pattern" tmp1671))) ($sc-dispatch tmp1671 (quote (any each-any any .
each-any))))) e1657) (if (memv t1662 (quote (define-form define-syntax-form)))
(syntax-violation #f "definition in expression context" e1657 (wrap1287
value1656 w1659 mod1661)) (if (memv t1662 (quote (syntax))) (syntax-violation
#f "reference to pattern variable outside syntax form" (source-wrap1288 e1657
w1659 s1660 mod1661)) (if (memv t1662 (quote (displaced-lexical)))
(syntax-violation #f "reference to identifier outside its scope"
(source-wrap1288 e1657 w1659 s1660 mod1661)) (syntax-violation #f "unexpected
syntax" (source-wrap1288 e1657 w1659 s1660 mod1661))))))))))))))))))) (chi1295
(lambda (e1680 r1681 w1682 mod1683) (call-with-values (lambda ()
(syntax-type1293 e1680 r1681 w1682 #f #f mod1683)) (lambda (type1684 value1685
e1686 w1687 s1688 mod1689) (chi-expr1296 type1684 value1685 e1686 r1681 w1687
s1688 mod1689))))) (chi-top1294 (lambda (e1690 r1691 w1692 m1693 esew1694
mod1695) (call-with-values (lambda () (syntax-type1293 e1690 r1691 w1692 #f #f
mod1695)) (lambda (type1703 value1704 e1705 w1706 s1707 mod1708) (let ((t1709
type1703)) (if (memv t1709 (quote (begin-form))) ((lambda (tmp1710) ((lambda
(tmp1711) (if tmp1711 (apply (lambda (_1712) (chi-void1303)) tmp1711) ((lambda
(tmp1713) (if tmp1713 (apply (lambda (_1714 e11715 e21716)
(chi-top-sequence1290 (cons e11715 e21716) r1691 w1706 s1707 m1693 esew1694
mod1708)) tmp1713) (syntax-violation #f "source expression failed to match any
pattern" tmp1710))) ($sc-dispatch tmp1710 (quote (any any . each-any))))))
($sc-dispatch tmp1710 (quote (any))))) e1705) (if (memv t1709 (quote
(local-syntax-form))) (chi-local-syntax1301 value1704 e1705 r1691 w1706 s1707
mod1708 (lambda (body1718 r1719 w1720 s1721 mod1722) (chi-top-sequence1290
body1718 r1719 w1720 s1721 m1693 esew1694 mod1722))) (if (memv t1709 (quote
(eval-when-form))) ((lambda (tmp1723) ((lambda (tmp1724) (if tmp1724 (apply
(lambda (_1725 x1726 e11727 e21728) (let ((when-list1729 (chi-when-list1292
e1705 x1726 w1706)) (body1730 (cons e11727 e21728))) (cond ((eq? m1693 (quote
e)) (if (memq (quote eval) when-list1729) (chi-top-sequence1290 body1730 r1691
w1706 s1707 (quote e) (quote (eval)) mod1708) (chi-void1303))) ((memq (quote
load) when-list1729) (if (or (memq (quote compile) when-list1729) (and (eq?
m1693 (quote c&e)) (memq (quote eval) when-list1729))) (chi-top-sequence1290
body1730 r1691 w1706 s1707 (quote c&e) (quote (compile load)) mod1708) (if
(memq m1693 (quote (c c&e))) (chi-top-sequence1290 body1730 r1691 w1706 s1707
(quote c) (quote (load)) mod1708) (chi-void1303)))) ((or (memq (quote compile)
when-list1729) (and (eq? m1693 (quote c&e)) (memq (quote eval) when-list1729)))
(top-level-eval-hook1228 (chi-top-sequence1290 body1730 r1691 w1706 s1707
(quote e) (quote (eval)) mod1708) mod1708) (chi-void1303)) (else
(chi-void1303))))) tmp1724) (syntax-violation #f "source expression failed to
match any pattern" tmp1723))) ($sc-dispatch tmp1723 (quote (any each-any any .
each-any))))) e1705) (if (memv t1709 (quote (define-syntax-form))) (let ((n1733
(id-var-name1281 value1704 w1706)) (r1734 (macros-only-env1255 r1691))) (let
((t1735 m1693)) (if (memv t1735 (quote (c))) (if (memq (quote compile)
esew1694) (let ((e1736 (chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706
mod1708)))) (begin (top-level-eval-hook1228 e1736 mod1708) (if (memq (quote
load) esew1694) e1736 (chi-void1303)))) (if (memq (quote load) esew1694)
(chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706 mod1708))
(chi-void1303))) (if (memv t1735 (quote (c&e))) (let ((e1737
(chi-install-global1291 n1733 (chi1295 e1705 r1734 w1706 mod1708)))) (begin
(top-level-eval-hook1228 e1737 mod1708) e1737)) (begin (if (memq (quote eval)
esew1694) (top-level-eval-hook1228 (chi-install-global1291 n1733 (chi1295 e1705
r1734 w1706 mod1708)) mod1708)) (chi-void1303)))))) (if (memv t1709 (quote
(define-form))) (let ((n1738 (id-var-name1281 value1704 w1706))) (let
((type1739 (binding-type1251 (lookup1256 n1738 r1691 mod1708)))) (let ((t1740
type1739)) (if (memv t1740 (quote (global core macro module-ref))) (let ((x1741
(build-annotated1232 s1707 (list (quote define) n1738 (chi1295 e1705 r1691
w1706 mod1708))))) (begin (if (eq? m1693 (quote c&e)) (top-level-eval-hook1228
x1741 mod1708)) x1741)) (if (memv t1740 (quote (displaced-lexical)))
(syntax-violation #f "identifier out of context" e1705 (wrap1287 value1704
w1706 mod1708)) (syntax-violation #f "cannot define keyword at top level" e1705
(wrap1287 value1704 w1706 mod1708))))))) (let ((x1742 (chi-expr1296 type1703
value1704 e1705 r1691 w1706 s1707 mod1708))) (begin (if (eq? m1693 (quote c&e))
(top-level-eval-hook1228 x1742 mod1708)) x1742)))))))))))) (syntax-type1293
(lambda (e1743 r1744 w1745 s1746 rib1747 mod1748) (cond ((symbol? e1743) (let
((n1749 (id-var-name1281 e1743 w1745))) (let ((b1750 (lookup1256 n1749 r1744
mod1748))) (let ((type1751 (binding-type1251 b1750))) (let ((t1752 type1751))
(if (memv t1752 (quote (lexical))) (values type1751 (binding-value1252 b1750)
e1743 w1745 s1746 mod1748) (if (memv t1752 (quote (global))) (values type1751
n1749 e1743 w1745 s1746 mod1748) (if (memv t1752 (quote (macro)))
(syntax-type1293 (chi-macro1298 (binding-value1252 b1750) e1743 r1744 w1745
rib1747 mod1748) r1744 (quote (())) s1746 rib1747 mod1748) (values type1751
(binding-value1252 b1750) e1743 w1745 s1746 mod1748))))))))) ((pair? e1743)
(let ((first1753 (car e1743))) (if (id?1259 first1753) (let ((n1754
(id-var-name1281 first1753 w1745))) (let ((b1755 (lookup1256 n1754 r1744 (or
(and (syntax-object?1243 first1753) (syntax-object-module1246 first1753))
mod1748)))) (let ((type1756 (binding-type1251 b1755))) (let ((t1757 type1756))
(if (memv t1757 (quote (lexical))) (values (quote lexical-call)
(binding-value1252 b1755) e1743 w1745 s1746 mod1748) (if (memv t1757 (quote
(global))) (values (quote global-call) n1754 e1743 w1745 s1746 mod1748) (if
(memv t1757 (quote (macro))) (syntax-type1293 (chi-macro1298 (binding-value1252
b1755) e1743 r1744 w1745 rib1747 mod1748) r1744 (quote (())) s1746 rib1747
mod1748) (if (memv t1757 (quote (core external-macro module-ref))) (values
type1756 (binding-value1252 b1755) e1743 w1745 s1746 mod1748) (if (memv t1757
(quote (local-syntax))) (values (quote local-syntax-form) (binding-value1252
b1755) e1743 w1745 s1746 mod1748) (if (memv t1757 (quote (begin))) (values
(quote begin-form) #f e1743 w1745 s1746 mod1748) (if (memv t1757 (quote
(eval-when))) (values (quote eval-when-form) #f e1743 w1745 s1746 mod1748) (if
(memv t1757 (quote (define))) ((lambda (tmp1758) ((lambda (tmp1759) (if (if
tmp1759 (apply (lambda (_1760 name1761 val1762) (id?1259 name1761)) tmp1759)
#f) (apply (lambda (_1763 name1764 val1765) (values (quote define-form)
name1764 val1765 w1745 s1746 mod1748)) tmp1759) ((lambda (tmp1766) (if (if
tmp1766 (apply (lambda (_1767 name1768 args1769 e11770 e21771) (and (id?1259
name1768) (valid-bound-ids?1284 (lambda-var-list1308 args1769)))) tmp1766) #f)
(apply (lambda (_1772 name1773 args1774 e11775 e21776) (values (quote
define-form) (wrap1287 name1773 w1745 mod1748) (cons (quote #(syntax-object
lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type)
#((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage
() () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage
#(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod)
#((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
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))) (wrap1287 (cons args1774 (cons e11775 e21776)) w1745 mod1748)) (quote
(())) s1746 mod1748)) tmp1766) ((lambda (tmp1778) (if (if tmp1778 (apply
(lambda (_1779 name1780) (id?1259 name1780)) tmp1778) #f) (apply (lambda (_1781
name1782) (values (quote define-form) (wrap1287 name1782 w1745 mod1748) (quote
(#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ())
#(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list
gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer
chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr
chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence
chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids?
valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks
join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage
new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap
set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels
ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label
make-rename rename-marks rename-new rename-old subst-rename? wrap-subst
wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id?
global-extend lookup macros-only-env extend-var-env extend-env null-env
binding-value binding-type make-binding arg-check source-annotation no-source
unannotate set-syntax-object-module! set-syntax-object-wrap!
set-syntax-object-expression! syntax-object-module syntax-object-wrap
syntax-object-expression syntax-object? make-syntax-object build-lexical-var
build-letrec build-named-let build-let build-sequence build-data build-primref
build-lambda build-global-definition build-global-assignment
build-global-reference build-lexical-assignment build-lexical-reference
build-conditional build-application build-annotated get-global-definition-hook
put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx<
fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*)
((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage
#(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m"
top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ())
#(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib
mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i"))
#(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i"
"i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top))
#("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top)
(top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list
gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer
chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr
chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence
chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids?
valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks
join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage
new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap
set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels
ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label
make-rename rename-marks rename-new rename-old subst-rename? wrap-subst
wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id?
global-extend lookup macros-only-env extend-var-env extend-env null-env
binding-value binding-type make-binding arg-check source-annotation no-source
unannotate set-syntax-object-module! set-syntax-object-wrap!
set-syntax-object-expression! syntax-object-module syntax-object-wrap
syntax-object-expression syntax-object? make-syntax-object build-lexical-var
build-letrec build-named-let build-let build-sequence build-data build-primref
build-lambda build-global-definition build-global-assignment
build-global-reference build-lexical-assignment build-lexical-reference
build-conditional build-application build-annotated 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 (())) s1746 mod1748))
tmp1778) (syntax-violation #f "source expression failed to match any pattern"
tmp1758))) ($sc-dispatch tmp1758 (quote (any any)))))) ($sc-dispatch tmp1758
(quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1758 (quote (any
any any))))) e1743) (if (memv t1757 (quote (define-syntax))) ((lambda (tmp1783)
((lambda (tmp1784) (if (if tmp1784 (apply (lambda (_1785 name1786 val1787)
(id?1259 name1786)) tmp1784) #f) (apply (lambda (_1788 name1789 val1790)
(values (quote define-syntax-form) name1789 val1790 w1745 s1746 mod1748))
tmp1784) (syntax-violation #f "source expression failed to match any pattern"
tmp1783))) ($sc-dispatch tmp1783 (quote (any any any))))) e1743) (values (quote
call) #f e1743 w1745 s1746 mod1748)))))))))))))) (values (quote call) #f e1743
w1745 s1746 mod1748)))) ((syntax-object?1243 e1743) (syntax-type1293
(syntax-object-expression1244 e1743) r1744 (join-wraps1278 w1745
(syntax-object-wrap1245 e1743)) #f rib1747 (or (syntax-object-module1246 e1743)
mod1748))) ((annotation? e1743) (syntax-type1293 (annotation-expression e1743)
r1744 w1745 (annotation-source e1743) rib1747 mod1748)) ((self-evaluating?
e1743) (values (quote constant) #f e1743 w1745 s1746 mod1748)) (else (values
(quote other) #f e1743 w1745 s1746 mod1748))))) (chi-when-list1292 (lambda
(e1791 when-list1792 w1793) (let f1794 ((when-list1795 when-list1792)
(situations1796 (quote ()))) (if (null? when-list1795) situations1796 (f1794
(cdr when-list1795) (cons (let ((x1797 (car when-list1795))) (cond
((free-id=?1282 x1797 (quote #(syntax-object compile ((top) #(ribcage () () ())
#(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list
situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)))) (quote compile)) ((free-id=?1282 x1797 (quote #(syntax-object load
((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)))) (quote load)) ((free-id=?1282 x1797 (quote #(syntax-object eval
((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
get-global-definition-hook put-global-definition-hook gensym-hook
local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene
guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid
situation" e1791 (wrap1287 x1797 w1793 #f))))) situations1796))))))
(chi-install-global1291 (lambda (name1798 e1799) (build-annotated1232 #f (list
(build-annotated1232 #f (quote define)) name1798 (if (let ((v1800
(module-variable (current-module) name1798))) (and v1800 (variable-bound?
v1800) (macro? (variable-ref v1800)) (not (eq? (macro-type (variable-ref
v1800)) (quote syncase-macro))))) (build-annotated1232 #f (list
(build-annotated1232 #f (quote make-extended-syncase-macro))
(build-annotated1232 #f (list (build-annotated1232 #f (quote module-ref))
(build-annotated1232 #f (quote (current-module))) (build-data1237 #f
name1798))) (build-data1237 #f (quote macro)) e1799)) (build-annotated1232 #f
(list (build-annotated1232 #f (quote make-syncase-macro)) (build-data1237 #f
(quote macro)) e1799))))))) (chi-top-sequence1290 (lambda (body1801 r1802 w1803
s1804 m1805 esew1806 mod1807) (build-sequence1238 s1804 (let dobody1808
((body1809 body1801) (r1810 r1802) (w1811 w1803) (m1812 m1805) (esew1813
esew1806) (mod1814 mod1807)) (if (null? body1809) (quote ()) (let ((first1815
(chi-top1294 (car body1809) r1810 w1811 m1812 esew1813 mod1814))) (cons
first1815 (dobody1808 (cdr body1809) r1810 w1811 m1812 esew1813 mod1814))))))))
(chi-sequence1289 (lambda (body1816 r1817 w1818 s1819 mod1820)
(build-sequence1238 s1819 (let dobody1821 ((body1822 body1816) (r1823 r1817)
(w1824 w1818) (mod1825 mod1820)) (if (null? body1822) (quote ()) (let
((first1826 (chi1295 (car body1822) r1823 w1824 mod1825))) (cons first1826
(dobody1821 (cdr body1822) r1823 w1824 mod1825)))))))) (source-wrap1288 (lambda
(x1827 w1828 s1829 defmod1830) (wrap1287 (if s1829 (make-annotation x1827 s1829
#f) x1827) w1828 defmod1830))) (wrap1287 (lambda (x1831 w1832 defmod1833) (cond
((and (null? (wrap-marks1262 w1832)) (null? (wrap-subst1263 w1832))) x1831)
((syntax-object?1243 x1831) (make-syntax-object1242
(syntax-object-expression1244 x1831) (join-wraps1278 w1832
(syntax-object-wrap1245 x1831)) (syntax-object-module1246 x1831))) ((null?
x1831) x1831) (else (make-syntax-object1242 x1831 w1832 defmod1833)))))
(bound-id-member?1286 (lambda (x1834 list1835) (and (not (null? list1835)) (or
(bound-id=?1283 x1834 (car list1835)) (bound-id-member?1286 x1834 (cdr
list1835)))))) (distinct-bound-ids?1285 (lambda (ids1836) (let distinct?1837
((ids1838 ids1836)) (or (null? ids1838) (and (not (bound-id-member?1286 (car
ids1838) (cdr ids1838))) (distinct?1837 (cdr ids1838)))))))
(valid-bound-ids?1284 (lambda (ids1839) (and (let all-ids?1840 ((ids1841
ids1839)) (or (null? ids1841) (and (id?1259 (car ids1841)) (all-ids?1840 (cdr
ids1841))))) (distinct-bound-ids?1285 ids1839)))) (bound-id=?1283 (lambda
(i1842 j1843) (if (and (syntax-object?1243 i1842) (syntax-object?1243 j1843))
(and (eq? (let ((e1844 (syntax-object-expression1244 i1842))) (if (annotation?
e1844) (annotation-expression e1844) e1844)) (let ((e1845
(syntax-object-expression1244 j1843))) (if (annotation? e1845)
(annotation-expression e1845) e1845))) (same-marks?1280 (wrap-marks1262
(syntax-object-wrap1245 i1842)) (wrap-marks1262 (syntax-object-wrap1245
j1843)))) (eq? (let ((e1846 i1842)) (if (annotation? e1846)
(annotation-expression e1846) e1846)) (let ((e1847 j1843)) (if (annotation?
e1847) (annotation-expression e1847) e1847)))))) (free-id=?1282 (lambda (i1848
j1849) (and (eq? (let ((x1850 i1848)) (let ((e1851 (if (syntax-object?1243
x1850) (syntax-object-expression1244 x1850) x1850))) (if (annotation? e1851)
(annotation-expression e1851) e1851))) (let ((x1852 j1849)) (let ((e1853 (if
(syntax-object?1243 x1852) (syntax-object-expression1244 x1852) x1852))) (if
(annotation? e1853) (annotation-expression e1853) e1853)))) (eq?
(id-var-name1281 i1848 (quote (()))) (id-var-name1281 j1849 (quote (())))))))
(id-var-name1281 (lambda (id1854 w1855) (letrec ((search-vector-rib1858 (lambda
(sym1864 subst1865 marks1866 symnames1867 ribcage1868) (let ((n1869
(vector-length symnames1867))) (let f1870 ((i1871 0)) (cond ((fx=1226 i1871
n1869) (search1856 sym1864 (cdr subst1865) marks1866)) ((and (eq? (vector-ref
symnames1867 i1871) sym1864) (same-marks?1280 marks1866 (vector-ref
(ribcage-marks1269 ribcage1868) i1871))) (values (vector-ref
(ribcage-labels1270 ribcage1868) i1871) marks1866)) (else (f1870 (fx+1224 i1871
1)))))))) (search-list-rib1857 (lambda (sym1872 subst1873 marks1874
symnames1875 ribcage1876) (let f1877 ((symnames1878 symnames1875) (i1879 0))
(cond ((null? symnames1878) (search1856 sym1872 (cdr subst1873) marks1874))
((and (eq? (car symnames1878) sym1872) (same-marks?1280 marks1874 (list-ref
(ribcage-marks1269 ribcage1876) i1879))) (values (list-ref (ribcage-labels1270
ribcage1876) i1879) marks1874)) (else (f1877 (cdr symnames1878) (fx+1224 i1879
1))))))) (search1856 (lambda (sym1880 subst1881 marks1882) (if (null?
subst1881) (values #f marks1882) (let ((fst1883 (car subst1881))) (if (eq?
fst1883 (quote shift)) (search1856 sym1880 (cdr subst1881) (cdr marks1882))
(let ((symnames1884 (ribcage-symnames1268 fst1883))) (if (vector? symnames1884)
(search-vector-rib1858 sym1880 subst1881 marks1882 symnames1884 fst1883)
(search-list-rib1857 sym1880 subst1881 marks1882 symnames1884 fst1883)))))))))
(cond ((symbol? id1854) (or (call-with-values (lambda () (search1856 id1854
(wrap-subst1263 w1855) (wrap-marks1262 w1855))) (lambda (x1886 . ignore1885)
x1886)) id1854)) ((syntax-object?1243 id1854) (let ((id1887 (let ((e1889
(syntax-object-expression1244 id1854))) (if (annotation? e1889)
(annotation-expression e1889) e1889))) (w11888 (syntax-object-wrap1245
id1854))) (let ((marks1890 (join-marks1279 (wrap-marks1262 w1855)
(wrap-marks1262 w11888)))) (call-with-values (lambda () (search1856 id1887
(wrap-subst1263 w1855) marks1890)) (lambda (new-id1891 marks1892) (or
new-id1891 (call-with-values (lambda () (search1856 id1887 (wrap-subst1263
w11888) marks1892)) (lambda (x1894 . ignore1893) x1894)) id1887))))))
((annotation? id1854) (let ((id1895 (let ((e1896 id1854)) (if (annotation?
e1896) (annotation-expression e1896) e1896)))) (or (call-with-values (lambda ()
(search1856 id1895 (wrap-subst1263 w1855) (wrap-marks1262 w1855))) (lambda
(x1898 . ignore1897) x1898)) id1895))) (else (syntax-violation (quote
id-var-name) "invalid id" id1854)))))) (same-marks?1280 (lambda (x1899 y1900)
(or (eq? x1899 y1900) (and (not (null? x1899)) (not (null? y1900)) (eq? (car
x1899) (car y1900)) (same-marks?1280 (cdr x1899) (cdr y1900))))))
(join-marks1279 (lambda (m11901 m21902) (smart-append1277 m11901 m21902)))
(join-wraps1278 (lambda (w11903 w21904) (let ((m11905 (wrap-marks1262 w11903))
(s11906 (wrap-subst1263 w11903))) (if (null? m11905) (if (null? s11906) w21904
(make-wrap1261 (wrap-marks1262 w21904) (smart-append1277 s11906 (wrap-subst1263
w21904)))) (make-wrap1261 (smart-append1277 m11905 (wrap-marks1262 w21904))
(smart-append1277 s11906 (wrap-subst1263 w21904))))))) (smart-append1277
(lambda (m11907 m21908) (if (null? m21908) m11907 (append m11907 m21908))))
(make-binding-wrap1276 (lambda (ids1909 labels1910 w1911) (if (null? ids1909)
w1911 (make-wrap1261 (wrap-marks1262 w1911) (cons (let ((labelvec1912
(list->vector labels1910))) (let ((n1913 (vector-length labelvec1912))) (let
((symnamevec1914 (make-vector n1913)) (marksvec1915 (make-vector n1913)))
(begin (let f1916 ((ids1917 ids1909) (i1918 0)) (if (not (null? ids1917))
(call-with-values (lambda () (id-sym-name&marks1260 (car ids1917) w1911))
(lambda (symname1919 marks1920) (begin (vector-set! symnamevec1914 i1918
symname1919) (vector-set! marksvec1915 i1918 marks1920) (f1916 (cdr ids1917)
(fx+1224 i1918 1))))))) (make-ribcage1266 symnamevec1914 marksvec1915
labelvec1912))))) (wrap-subst1263 w1911)))))) (extend-ribcage!1275 (lambda
(ribcage1921 id1922 label1923) (begin (set-ribcage-symnames!1271 ribcage1921
(cons (let ((e1924 (syntax-object-expression1244 id1922))) (if (annotation?
e1924) (annotation-expression e1924) e1924)) (ribcage-symnames1268
ribcage1921))) (set-ribcage-marks!1272 ribcage1921 (cons (wrap-marks1262
(syntax-object-wrap1245 id1922)) (ribcage-marks1269 ribcage1921)))
(set-ribcage-labels!1273 ribcage1921 (cons label1923 (ribcage-labels1270
ribcage1921)))))) (anti-mark1274 (lambda (w1925) (make-wrap1261 (cons #f
(wrap-marks1262 w1925)) (cons (quote shift) (wrap-subst1263 w1925)))))
(set-ribcage-labels!1273 (lambda (x1926 update1927) (vector-set! x1926 3
update1927))) (set-ribcage-marks!1272 (lambda (x1928 update1929) (vector-set!
x1928 2 update1929))) (set-ribcage-symnames!1271 (lambda (x1930 update1931)
(vector-set! x1930 1 update1931))) (ribcage-labels1270 (lambda (x1932)
(vector-ref x1932 3))) (ribcage-marks1269 (lambda (x1933) (vector-ref x1933
2))) (ribcage-symnames1268 (lambda (x1934) (vector-ref x1934 1))) (ribcage?1267
(lambda (x1935) (and (vector? x1935) (= (vector-length x1935) 4) (eq?
(vector-ref x1935 0) (quote ribcage))))) (make-ribcage1266 (lambda
(symnames1936 marks1937 labels1938) (vector (quote ribcage) symnames1936
marks1937 labels1938))) (gen-labels1265 (lambda (ls1939) (if (null? ls1939)
(quote ()) (cons (gen-label1264) (gen-labels1265 (cdr ls1939))))))
(gen-label1264 (lambda () (string #\i))) (wrap-subst1263 cdr) (wrap-marks1262
car) (make-wrap1261 cons) (id-sym-name&marks1260 (lambda (x1940 w1941) (if
(syntax-object?1243 x1940) (values (let ((e1942 (syntax-object-expression1244
x1940))) (if (annotation? e1942) (annotation-expression e1942) e1942))
(join-marks1279 (wrap-marks1262 w1941) (wrap-marks1262 (syntax-object-wrap1245
x1940)))) (values (let ((e1943 x1940)) (if (annotation? e1943)
(annotation-expression e1943) e1943)) (wrap-marks1262 w1941))))) (id?1259
(lambda (x1944) (cond ((symbol? x1944) #t) ((syntax-object?1243 x1944) (symbol?
(let ((e1945 (syntax-object-expression1244 x1944))) (if (annotation? e1945)
(annotation-expression e1945) e1945)))) ((annotation? x1944) (symbol?
(annotation-expression x1944))) (else #f)))) (nonsymbol-id?1258 (lambda (x1946)
(and (syntax-object?1243 x1946) (symbol? (let ((e1947
(syntax-object-expression1244 x1946))) (if (annotation? e1947)
(annotation-expression e1947) e1947)))))) (global-extend1257 (lambda (type1948
sym1949 val1950) (put-global-definition-hook1230 sym1949 type1948 val1950)))
(lookup1256 (lambda (x1951 r1952 mod1953) (cond ((assq x1951 r1952) => cdr)
((symbol? x1951) (or (get-global-definition-hook1231 x1951 mod1953) (quote
(global)))) (else (quote (displaced-lexical)))))) (macros-only-env1255 (lambda
(r1954) (if (null? r1954) (quote ()) (let ((a1955 (car r1954))) (if (eq? (cadr
a1955) (quote macro)) (cons a1955 (macros-only-env1255 (cdr r1954)))
(macros-only-env1255 (cdr r1954))))))) (extend-var-env1254 (lambda (labels1956
vars1957 r1958) (if (null? labels1956) r1958 (extend-var-env1254 (cdr
labels1956) (cdr vars1957) (cons (cons (car labels1956) (cons (quote lexical)
(car vars1957))) r1958))))) (extend-env1253 (lambda (labels1959 bindings1960
r1961) (if (null? labels1959) r1961 (extend-env1253 (cdr labels1959) (cdr
bindings1960) (cons (cons (car labels1959) (car bindings1960)) r1961)))))
(binding-value1252 cdr) (binding-type1251 car) (source-annotation1250 (lambda
(x1962) (cond ((annotation? x1962) (annotation-source x1962))
((syntax-object?1243 x1962) (source-annotation1250
(syntax-object-expression1244 x1962))) (else #f))))
(set-syntax-object-module!1249 (lambda (x1963 update1964) (vector-set! x1963 3
update1964))) (set-syntax-object-wrap!1248 (lambda (x1965 update1966)
(vector-set! x1965 2 update1966))) (set-syntax-object-expression!1247 (lambda
(x1967 update1968) (vector-set! x1967 1 update1968))) (syntax-object-module1246
(lambda (x1969) (vector-ref x1969 3))) (syntax-object-wrap1245 (lambda (x1970)
(vector-ref x1970 2))) (syntax-object-expression1244 (lambda (x1971)
(vector-ref x1971 1))) (syntax-object?1243 (lambda (x1972) (and (vector? x1972)
(= (vector-length x1972) 4) (eq? (vector-ref x1972 0) (quote syntax-object)))))
(make-syntax-object1242 (lambda (expression1973 wrap1974 module1975) (vector
(quote syntax-object) expression1973 wrap1974 module1975))) (build-letrec1241
(lambda (src1976 vars1977 val-exps1978 body-exp1979) (if (null? vars1977)
(build-annotated1232 src1976 body-exp1979) (build-annotated1232 src1976 (list
(quote letrec) (map list vars1977 val-exps1978) body-exp1979)))))
(build-named-let1240 (lambda (src1980 vars1981 val-exps1982 body-exp1983) (if
(null? vars1981) (build-annotated1232 src1980 body-exp1983)
(build-annotated1232 src1980 (list (quote let) (car vars1981) (map list (cdr
vars1981) val-exps1982) body-exp1983))))) (build-let1239 (lambda (src1984
vars1985 val-exps1986 body-exp1987) (if (null? vars1985) (build-annotated1232
src1984 body-exp1987) (build-annotated1232 src1984 (list (quote let) (map list
vars1985 val-exps1986) body-exp1987))))) (build-sequence1238 (lambda (src1988
exps1989) (if (null? (cdr exps1989)) (build-annotated1232 src1988 (car
exps1989)) (build-annotated1232 src1988 (cons (quote begin) exps1989)))))
(build-data1237 (lambda (src1990 exp1991) (if (and (self-evaluating? exp1991)
(not (vector? exp1991))) (build-annotated1232 src1990 exp1991)
(build-annotated1232 src1990 (list (quote quote) exp1991)))))
(build-global-assignment1236 (lambda (source1992 var1993 exp1994 mod1995) (let
((ref1996 (build-global-reference1235 source1992 var1993 mod1995)))
(build-annotated1232 source1992 (list (quote set!) ref1996 exp1994)))))
(build-global-reference1235 (lambda (source1997 var1998 mod1999)
(build-annotated1232 source1997 (if (not mod1999) var1998 (let
((make-module-ref2000 (let ((t2003 (fluid-ref *mode*1223))) (if (memv t2003
(quote (c))) (@ (ice-9 expand-support) make-module-ref) (lambda (mod2004
var2005 public?2006) (list (if public?2006 (quote @) (quote @@)) mod2004
var2005))))) (kind2001 (car mod1999)) (mod2002 (cdr mod1999))) (let ((t2007
kind2001)) (if (memv t2007 (quote (public))) (make-module-ref2000 mod2002
var1998 #t) (if (memv t2007 (quote (private))) (if (not (equal? mod2002
(module-name (current-module)))) (make-module-ref2000 mod2002 var1998 #f)
var1998) (if (memv t2007 (quote (bare))) var1998 (if (memv t2007 (quote
(hygiene))) (if (and (not (equal? mod2002 (module-name (current-module))))
(module-variable (resolve-module mod2002) var1998)) (make-module-ref2000
mod2002 var1998 #f) var1998) (syntax-violation #f "bad module kind" var1998
mod2002))))))))))) (build-lexical-assignment1234 (lambda (source2008 name2009
var2010 exp2011) (build-annotated1232 source2008 (list (quote set!)
(build-lexical-reference1233 (quote set) #f name2009 var2010) exp2011))))
(build-lexical-reference1233 (lambda (type2012 source2013 name2014 var2015)
(build-annotated1232 source2013 (let ((t2016 (fluid-ref *mode*1223))) (if (memv
t2016 (quote (c))) ((@ (ice-9 expand-support) make-lexical) name2014 var2015)
var2015))))) (build-annotated1232 (lambda (src2017 exp2018) (if (and src2017
(not (annotation? exp2018))) (make-annotation exp2018 src2017 #t) exp2018)))
(get-global-definition-hook1231 (lambda (symbol2019 module2020) (begin (if (and
(not module2020) (current-module)) (warn "module system is booted, we should
have a module" symbol2019)) (let ((v2021 (module-variable (if module2020
(resolve-module (cdr module2020)) (current-module)) symbol2019))) (and v2021
(variable-bound? v2021) (let ((val2022 (variable-ref v2021))) (and (macro?
val2022) (syncase-macro-type val2022) (cons (syncase-macro-type val2022)
(syncase-macro-binding val2022))))))))) (put-global-definition-hook1230 (lambda
(symbol2023 type2024 val2025) (let ((existing2026 (let ((v2027 (module-variable
(current-module) symbol2023))) (and v2027 (variable-bound? v2027) (let
((val2028 (variable-ref v2027))) (and (macro? val2028) (not (syncase-macro-type
val2028)) val2028)))))) (module-define! (current-module) symbol2023 (if
existing2026 (make-extended-syncase-macro existing2026 type2024 val2025)
(make-syncase-macro type2024 val2025)))))) (local-eval-hook1229 (lambda (x2029
mod2030) (primitive-eval (list noexpand1222 (let ((t2031 (fluid-ref
*mode*1223))) (if (memv t2031 (quote (c))) ((@ (ice-9 expand-support)
strip-expansion-structures) x2029) x2029)))))) (top-level-eval-hook1228 (lambda
(x2032 mod2033) (primitive-eval (list noexpand1222 (let ((t2034 (fluid-ref
*mode*1223))) (if (memv t2034 (quote (c))) ((@ (ice-9 expand-support)
strip-expansion-structures) x2032) x2032)))))) (fx<1227 <) (fx=1226 =) (fx-1225
-) (fx+1224 +) (*mode*1223 (make-fluid)) (noexpand1222 "noexpand")) (begin
(global-extend1257 (quote local-syntax) (quote letrec-syntax) #t)
(global-extend1257 (quote local-syntax) (quote let-syntax) #f)
(global-extend1257 (quote core) (quote fluid-let-syntax) (lambda (e2035 r2036
w2037 s2038 mod2039) ((lambda (tmp2040) ((lambda (tmp2041) (if (if tmp2041
(apply (lambda (_2042 var2043 val2044 e12045 e22046) (valid-bound-ids?1284
var2043)) tmp2041) #f) (apply (lambda (_2048 var2049 val2050 e12051 e22052)
(let ((names2053 (map (lambda (x2054) (id-var-name1281 x2054 w2037)) var2049)))
(begin (for-each (lambda (id2056 n2057) (let ((t2058 (binding-type1251
(lookup1256 n2057 r2036 mod2039)))) (if (memv t2058 (quote
(displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier
out of context" e2035 (source-wrap1288 id2056 w2037 s2038 mod2039))))) var2049
names2053) (chi-body1299 (cons e12051 e22052) (source-wrap1288 e2035 w2037
s2038 mod2039) (extend-env1253 names2053 (let ((trans-r2061
(macros-only-env1255 r2036))) (map (lambda (x2062) (cons (quote macro)
(eval-local-transformer1302 (chi1295 x2062 trans-r2061 w2037 mod2039)
mod2039))) val2050)) r2036) w2037 mod2039)))) tmp2041) ((lambda (_2064)
(syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1288 e2035
w2037 s2038 mod2039))) tmp2040))) ($sc-dispatch tmp2040 (quote (any #(each (any
any)) any . each-any))))) e2035))) (global-extend1257 (quote core) (quote
quote) (lambda (e2065 r2066 w2067 s2068 mod2069) ((lambda (tmp2070) ((lambda
(tmp2071) (if tmp2071 (apply (lambda (_2072 e2073) (build-data1237 s2068
(strip1306 e2073 w2067))) tmp2071) ((lambda (_2074) (syntax-violation (quote
quote) "bad syntax" (source-wrap1288 e2065 w2067 s2068 mod2069))) tmp2070)))
($sc-dispatch tmp2070 (quote (any any))))) e2065))) (global-extend1257 (quote
core) (quote syntax) (letrec ((regen2082 (lambda (x2083) (let ((t2084 (car
x2083))) (if (memv t2084 (quote (ref))) (build-lexical-reference1233 (quote
value) #f (cadr x2083) (cadr x2083)) (if (memv t2084 (quote (primitive)))
(build-annotated1232 #f (cadr x2083)) (if (memv t2084 (quote (quote)))
(build-data1237 #f (cadr x2083)) (if (memv t2084 (quote (lambda)))
(build-annotated1232 #f (list (quote lambda) (cadr x2083) (regen2082 (caddr
x2083)))) (if (memv t2084 (quote (map))) (let ((ls2085 (map regen2082 (cdr
x2083)))) (build-annotated1232 #f (cons (if (fx=1226 (length ls2085) 2)
(build-annotated1232 #f (quote map)) (build-annotated1232 #f (quote map)))
ls2085))) (build-annotated1232 #f (cons (build-annotated1232 #f (car x2083))
(map regen2082 (cdr x2083)))))))))))) (gen-vector2081 (lambda (x2086) (cond
((eq? (car x2086) (quote list)) (cons (quote vector) (cdr x2086))) ((eq? (car
x2086) (quote quote)) (list (quote quote) (list->vector (cadr x2086)))) (else
(list (quote list->vector) x2086))))) (gen-append2080 (lambda (x2087 y2088) (if
(equal? y2088 (quote (quote ()))) x2087 (list (quote append) x2087 y2088))))
(gen-cons2079 (lambda (x2089 y2090) (let ((t2091 (car y2090))) (if (memv t2091
(quote (quote))) (if (eq? (car x2089) (quote quote)) (list (quote quote) (cons
(cadr x2089) (cadr y2090))) (if (eq? (cadr y2090) (quote ())) (list (quote
list) x2089) (list (quote cons) x2089 y2090))) (if (memv t2091 (quote (list)))
(cons (quote list) (cons x2089 (cdr y2090))) (list (quote cons) x2089
y2090)))))) (gen-map2078 (lambda (e2092 map-env2093) (let ((formals2094 (map
cdr map-env2093)) (actuals2095 (map (lambda (x2096) (list (quote ref) (car
x2096))) map-env2093))) (cond ((eq? (car e2092) (quote ref)) (car actuals2095))
((and-map (lambda (x2097) (and (eq? (car x2097) (quote ref)) (memq (cadr x2097)
formals2094))) (cdr e2092)) (cons (quote map) (cons (list (quote primitive)
(car e2092)) (map (let ((r2098 (map cons formals2094 actuals2095))) (lambda
(x2099) (cdr (assq (cadr x2099) r2098)))) (cdr e2092))))) (else (cons (quote
map) (cons (list (quote lambda) formals2094 e2092) actuals2095)))))))
(gen-mappend2077 (lambda (e2100 map-env2101) (list (quote apply) (quote
(primitive append)) (gen-map2078 e2100 map-env2101)))) (gen-ref2076 (lambda
(src2102 var2103 level2104 maps2105) (if (fx=1226 level2104 0) (values var2103
maps2105) (if (null? maps2105) (syntax-violation (quote syntax) "missing
ellipsis" src2102) (call-with-values (lambda () (gen-ref2076 src2102 var2103
(fx-1225 level2104 1) (cdr maps2105))) (lambda (outer-var2106 outer-maps2107)
(let ((b2108 (assq outer-var2106 (car maps2105)))) (if b2108 (values (cdr
b2108) maps2105) (let ((inner-var2109 (gen-var1307 (quote tmp)))) (values
inner-var2109 (cons (cons (cons outer-var2106 inner-var2109) (car maps2105))
outer-maps2107))))))))))) (gen-syntax2075 (lambda (src2110 e2111 r2112 maps2113
ellipsis?2114 mod2115) (if (id?1259 e2111) (let ((label2116 (id-var-name1281
e2111 (quote (()))))) (let ((b2117 (lookup1256 label2116 r2112 mod2115))) (if
(eq? (binding-type1251 b2117) (quote syntax)) (call-with-values (lambda () (let
((var.lev2118 (binding-value1252 b2117))) (gen-ref2076 src2110 (car
var.lev2118) (cdr var.lev2118) maps2113))) (lambda (var2119 maps2120) (values
(list (quote ref) var2119) maps2120))) (if (ellipsis?2114 e2111)
(syntax-violation (quote syntax) "misplaced ellipsis" src2110) (values (list
(quote quote) e2111) maps2113))))) ((lambda (tmp2121) ((lambda (tmp2122) (if
(if tmp2122 (apply (lambda (dots2123 e2124) (ellipsis?2114 dots2123)) tmp2122)
#f) (apply (lambda (dots2125 e2126) (gen-syntax2075 src2110 e2126 r2112
maps2113 (lambda (x2127) #f) mod2115)) tmp2122) ((lambda (tmp2128) (if (if
tmp2128 (apply (lambda (x2129 dots2130 y2131) (ellipsis?2114 dots2130))
tmp2128) #f) (apply (lambda (x2132 dots2133 y2134) (let f2135 ((y2136 y2134)
(k2137 (lambda (maps2138) (call-with-values (lambda () (gen-syntax2075 src2110
x2132 r2112 (cons (quote ()) maps2138) ellipsis?2114 mod2115)) (lambda (x2139
maps2140) (if (null? (car maps2140)) (syntax-violation (quote syntax) "extra
ellipsis" src2110) (values (gen-map2078 x2139 (car maps2140)) (cdr
maps2140)))))))) ((lambda (tmp2141) ((lambda (tmp2142) (if (if tmp2142 (apply
(lambda (dots2143 y2144) (ellipsis?2114 dots2143)) tmp2142) #f) (apply (lambda
(dots2145 y2146) (f2135 y2146 (lambda (maps2147) (call-with-values (lambda ()
(k2137 (cons (quote ()) maps2147))) (lambda (x2148 maps2149) (if (null? (car
maps2149)) (syntax-violation (quote syntax) "extra ellipsis" src2110) (values
(gen-mappend2077 x2148 (car maps2149)) (cdr maps2149)))))))) tmp2142) ((lambda
(_2150) (call-with-values (lambda () (gen-syntax2075 src2110 y2136 r2112
maps2113 ellipsis?2114 mod2115)) (lambda (y2151 maps2152) (call-with-values
(lambda () (k2137 maps2152)) (lambda (x2153 maps2154) (values (gen-append2080
x2153 y2151) maps2154)))))) tmp2141))) ($sc-dispatch tmp2141 (quote (any .
any))))) y2136))) tmp2128) ((lambda (tmp2155) (if tmp2155 (apply (lambda (x2156
y2157) (call-with-values (lambda () (gen-syntax2075 src2110 x2156 r2112
maps2113 ellipsis?2114 mod2115)) (lambda (x2158 maps2159) (call-with-values
(lambda () (gen-syntax2075 src2110 y2157 r2112 maps2159 ellipsis?2114 mod2115))
(lambda (y2160 maps2161) (values (gen-cons2079 x2158 y2160) maps2161))))))
tmp2155) ((lambda (tmp2162) (if tmp2162 (apply (lambda (e12163 e22164)
(call-with-values (lambda () (gen-syntax2075 src2110 (cons e12163 e22164) r2112
maps2113 ellipsis?2114 mod2115)) (lambda (e2166 maps2167) (values
(gen-vector2081 e2166) maps2167)))) tmp2162) ((lambda (_2168) (values (list
(quote quote) e2111) maps2113)) tmp2121))) ($sc-dispatch tmp2121 (quote
#(vector (any . each-any))))))) ($sc-dispatch tmp2121 (quote (any . any))))))
($sc-dispatch tmp2121 (quote (any any . any)))))) ($sc-dispatch tmp2121 (quote
(any any))))) e2111))))) (lambda (e2169 r2170 w2171 s2172 mod2173) (let ((e2174
(source-wrap1288 e2169 w2171 s2172 mod2173))) ((lambda (tmp2175) ((lambda
(tmp2176) (if tmp2176 (apply (lambda (_2177 x2178) (call-with-values (lambda ()
(gen-syntax2075 e2174 x2178 r2170 (quote ()) ellipsis?1304 mod2173)) (lambda
(e2179 maps2180) (regen2082 e2179)))) tmp2176) ((lambda (_2181)
(syntax-violation (quote syntax) "bad `syntax' form" e2174)) tmp2175)))
($sc-dispatch tmp2175 (quote (any any))))) e2174))))) (global-extend1257 (quote
core) (quote lambda) (lambda (e2182 r2183 w2184 s2185 mod2186) ((lambda
(tmp2187) ((lambda (tmp2188) (if tmp2188 (apply (lambda (_2189 c2190)
(chi-lambda-clause1300 (source-wrap1288 e2182 w2184 s2185 mod2186) #f c2190
r2183 w2184 mod2186 (lambda (vars2191 docstring2192 body2193)
(build-annotated1232 s2185 (cons (quote lambda) (cons vars2191 (append (if
docstring2192 (list docstring2192) (quote ())) (list body2193)))))))) tmp2188)
(syntax-violation #f "source expression failed to match any pattern" tmp2187)))
($sc-dispatch tmp2187 (quote (any . any))))) e2182))) (global-extend1257 (quote
core) (quote let) (letrec ((chi-let2194 (lambda (e2195 r2196 w2197 s2198
mod2199 constructor2200 ids2201 vals2202 exps2203) (if (not
(valid-bound-ids?1284 ids2201)) (syntax-violation (quote let) "duplicate bound
variable" e2195) (let ((labels2204 (gen-labels1265 ids2201)) (new-vars2205 (map
gen-var1307 ids2201))) (let ((nw2206 (make-binding-wrap1276 ids2201 labels2204
w2197)) (nr2207 (extend-var-env1254 labels2204 new-vars2205 r2196)))
(constructor2200 s2198 new-vars2205 (map (lambda (x2208) (chi1295 x2208 r2196
w2197 mod2199)) vals2202) (chi-body1299 exps2203 (source-wrap1288 e2195 nw2206
s2198 mod2199) nr2207 nw2206 mod2199)))))))) (lambda (e2209 r2210 w2211 s2212
mod2213) ((lambda (tmp2214) ((lambda (tmp2215) (if tmp2215 (apply (lambda
(_2216 id2217 val2218 e12219 e22220) (chi-let2194 e2209 r2210 w2211 s2212
mod2213 build-let1239 id2217 val2218 (cons e12219 e22220))) tmp2215) ((lambda
(tmp2224) (if (if tmp2224 (apply (lambda (_2225 f2226 id2227 val2228 e12229
e22230) (id?1259 f2226)) tmp2224) #f) (apply (lambda (_2231 f2232 id2233
val2234 e12235 e22236) (chi-let2194 e2209 r2210 w2211 s2212 mod2213
build-named-let1240 (cons f2232 id2233) val2234 (cons e12235 e22236))) tmp2224)
((lambda (_2240) (syntax-violation (quote let) "bad let" (source-wrap1288 e2209
w2211 s2212 mod2213))) tmp2214))) ($sc-dispatch tmp2214 (quote (any any #(each
(any any)) any . each-any)))))) ($sc-dispatch tmp2214 (quote (any #(each (any
any)) any . each-any))))) e2209)))) (global-extend1257 (quote core) (quote
letrec) (lambda (e2241 r2242 w2243 s2244 mod2245) ((lambda (tmp2246) ((lambda
(tmp2247) (if tmp2247 (apply (lambda (_2248 id2249 val2250 e12251 e22252) (let
((ids2253 id2249)) (if (not (valid-bound-ids?1284 ids2253)) (syntax-violation
(quote letrec) "duplicate bound variable" e2241) (let ((labels2255
(gen-labels1265 ids2253)) (new-vars2256 (map gen-var1307 ids2253))) (let
((w2257 (make-binding-wrap1276 ids2253 labels2255 w2243)) (r2258
(extend-var-env1254 labels2255 new-vars2256 r2242))) (build-letrec1241 s2244
new-vars2256 (map (lambda (x2259) (chi1295 x2259 r2258 w2257 mod2245)) val2250)
(chi-body1299 (cons e12251 e22252) (source-wrap1288 e2241 w2257 s2244 mod2245)
r2258 w2257 mod2245))))))) tmp2247) ((lambda (_2262) (syntax-violation (quote
letrec) "bad letrec" (source-wrap1288 e2241 w2243 s2244 mod2245))) tmp2246)))
($sc-dispatch tmp2246 (quote (any #(each (any any)) any . each-any)))))
e2241))) (global-extend1257 (quote core) (quote set!) (lambda (e2263 r2264
w2265 s2266 mod2267) ((lambda (tmp2268) ((lambda (tmp2269) (if (if tmp2269
(apply (lambda (_2270 id2271 val2272) (id?1259 id2271)) tmp2269) #f) (apply
(lambda (_2273 id2274 val2275) (let ((val2276 (chi1295 val2275 r2264 w2265
mod2267)) (n2277 (id-var-name1281 id2274 w2265))) (let ((b2278 (lookup1256
n2277 r2264 mod2267))) (let ((t2279 (binding-type1251 b2278))) (if (memv t2279
(quote (lexical))) (build-lexical-assignment1234 s2266 (syntax->datum id2274)
(binding-value1252 b2278) val2276) (if (memv t2279 (quote (global)))
(build-global-assignment1236 s2266 n2277 val2276 mod2267) (if (memv t2279
(quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of
context" (wrap1287 id2274 w2265 mod2267)) (syntax-violation (quote set!) "bad
set!" (source-wrap1288 e2263 w2265 s2266 mod2267))))))))) tmp2269) ((lambda
(tmp2280) (if tmp2280 (apply (lambda (_2281 head2282 tail2283 val2284)
(call-with-values (lambda () (syntax-type1293 head2282 r2264 (quote (())) #f #f
mod2267)) (lambda (type2285 value2286 ee2287 ww2288 ss2289 modmod2290) (let
((t2291 type2285)) (if (memv t2291 (quote (module-ref))) (let ((val2292
(chi1295 val2284 r2264 w2265 mod2267))) (call-with-values (lambda () (value2286
(cons head2282 tail2283))) (lambda (id2294 mod2295)
(build-global-assignment1236 s2266 id2294 val2292 mod2295))))
(build-annotated1232 s2266 (cons (chi1295 (list (quote #(syntax-object setter
((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () ()
()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top)
(top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail
val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ())
#(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
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))) head2282) r2264 w2265 mod2267) (map (lambda (e2296) (chi1295 e2296
r2264 w2265 mod2267)) (append tail2283 (list val2284)))))))))) tmp2280)
((lambda (_2298) (syntax-violation (quote set!) "bad set!" (source-wrap1288
e2263 w2265 s2266 mod2267))) tmp2268))) ($sc-dispatch tmp2268 (quote (any (any
. each-any) any)))))) ($sc-dispatch tmp2268 (quote (any any any))))) e2263)))
(global-extend1257 (quote module-ref) (quote @) (lambda (e2299) ((lambda
(tmp2300) ((lambda (tmp2301) (if (if tmp2301 (apply (lambda (_2302 mod2303
id2304) (and (and-map id?1259 mod2303) (id?1259 id2304))) tmp2301) #f) (apply
(lambda (_2306 mod2307 id2308) (values (syntax->datum id2308) (syntax->datum
(cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i"))
#(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
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))) mod2307)))) tmp2301) (syntax-violation #f "source expression failed to
match any pattern" tmp2300))) ($sc-dispatch tmp2300 (quote (any each-any
any))))) e2299))) (global-extend1257 (quote module-ref) (quote @@) (lambda
(e2310) ((lambda (tmp2311) ((lambda (tmp2312) (if (if tmp2312 (apply (lambda
(_2313 mod2314 id2315) (and (and-map id?1259 mod2314) (id?1259 id2315)))
tmp2312) #f) (apply (lambda (_2317 mod2318 id2319) (values (syntax->datum
id2319) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage
#(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage
#(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation
ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause
chi-body chi-macro chi-application chi-expr chi chi-top syntax-type
chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
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))) mod2318)))) tmp2312) (syntax-violation #f "source expression failed to
match any pattern" tmp2311))) ($sc-dispatch tmp2311 (quote (any each-any
any))))) e2310))) (global-extend1257 (quote begin) (quote begin) (quote ()))
(global-extend1257 (quote define) (quote define) (quote ())) (global-extend1257
(quote define-syntax) (quote define-syntax) (quote ())) (global-extend1257
(quote eval-when) (quote eval-when) (quote ())) (global-extend1257 (quote core)
(quote syntax-case) (letrec ((gen-syntax-case2324 (lambda (x2325 keys2326
clauses2327 r2328 mod2329) (if (null? clauses2327) (build-annotated1232 #f
(list (build-annotated1232 #f (quote syntax-violation)) #f "source expression
failed to match any pattern" x2325)) ((lambda (tmp2330) ((lambda (tmp2331) (if
tmp2331 (apply (lambda (pat2332 exp2333) (if (and (id?1259 pat2332) (and-map
(lambda (x2334) (not (free-id=?1282 pat2332 x2334))) (cons (quote
#(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause
build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference build-lexical-assignment
build-lexical-reference build-conditional build-application build-annotated
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))) keys2326))) (let ((labels2335 (list (gen-label1264))) (var2336
(gen-var1307 pat2332))) (build-annotated1232 #f (list (build-annotated1232 #f
(list (quote lambda) (list var2336) (chi1295 exp2333 (extend-env1253 labels2335
(list (cons (quote syntax) (cons var2336 0))) r2328) (make-binding-wrap1276
(list pat2332) labels2335 (quote (()))) mod2329))) x2325))) (gen-clause2323
x2325 keys2326 (cdr clauses2327) r2328 pat2332 #t exp2333 mod2329))) tmp2331)
((lambda (tmp2337) (if tmp2337 (apply (lambda (pat2338 fender2339 exp2340)
(gen-clause2323 x2325 keys2326 (cdr clauses2327) r2328 pat2338 fender2339
exp2340 mod2329)) tmp2337) ((lambda (_2341) (syntax-violation (quote
syntax-case) "invalid clause" (car clauses2327))) tmp2330))) ($sc-dispatch
tmp2330 (quote (any any any)))))) ($sc-dispatch tmp2330 (quote (any any)))))
(car clauses2327))))) (gen-clause2323 (lambda (x2342 keys2343 clauses2344 r2345
pat2346 fender2347 exp2348 mod2349) (call-with-values (lambda ()
(convert-pattern2321 pat2346 keys2343)) (lambda (p2350 pvars2351) (cond ((not
(distinct-bound-ids?1285 (map car pvars2351))) (syntax-violation (quote
syntax-case) "duplicate pattern variable" pat2346)) ((not (and-map (lambda
(x2352) (not (ellipsis?1304 (car x2352)))) pvars2351)) (syntax-violation (quote
syntax-case) "misplaced ellipsis" pat2346)) (else (let ((y2353 (gen-var1307
(quote tmp)))) (build-annotated1232 #f (list (build-annotated1232 #f (list
(quote lambda) (list y2353) (let ((y2354 (build-lexical-reference1233 (quote
value) #f (quote tmp) y2353))) (build-annotated1232 #f (list (quote if)
((lambda (tmp2355) ((lambda (tmp2356) (if tmp2356 (apply (lambda () y2354)
tmp2356) ((lambda (_2357) (build-annotated1232 #f (list (quote if) y2354
(build-dispatch-call2322 pvars2351 fender2347 y2354 r2345 mod2349)
(build-data1237 #f #f)))) tmp2355))) ($sc-dispatch tmp2355 (quote #(atom
#t))))) fender2347) (build-dispatch-call2322 pvars2351 exp2348 y2354 r2345
mod2349) (gen-syntax-case2324 x2342 keys2343 clauses2344 r2345 mod2349))))))
(if (eq? p2350 (quote any)) (build-annotated1232 #f (list (build-annotated1232
#f (quote list)) x2342)) (build-annotated1232 #f (list (build-annotated1232 #f
(quote $sc-dispatch)) x2342 (build-data1237 #f p2350)))))))))))))
(build-dispatch-call2322 (lambda (pvars2358 exp2359 y2360 r2361 mod2362) (let
((ids2363 (map car pvars2358)) (levels2364 (map cdr pvars2358))) (let
((labels2365 (gen-labels1265 ids2363)) (new-vars2366 (map gen-var1307
ids2363))) (build-annotated1232 #f (list (build-annotated1232 #f (quote apply))
(build-annotated1232 #f (list (quote lambda) new-vars2366 (chi1295 exp2359
(extend-env1253 labels2365 (map (lambda (var2367 level2368) (cons (quote
syntax) (cons var2367 level2368))) new-vars2366 (map cdr pvars2358)) r2361)
(make-binding-wrap1276 ids2363 labels2365 (quote (()))) mod2362))) y2360))))))
(convert-pattern2321 (lambda (pattern2369 keys2370) (let cvt2371 ((p2372
pattern2369) (n2373 0) (ids2374 (quote ()))) (if (id?1259 p2372) (if
(bound-id-member?1286 p2372 keys2370) (values (vector (quote free-id) p2372)
ids2374) (values (quote any) (cons (cons p2372 n2373) ids2374))) ((lambda
(tmp2375) ((lambda (tmp2376) (if (if tmp2376 (apply (lambda (x2377 dots2378)
(ellipsis?1304 dots2378)) tmp2376) #f) (apply (lambda (x2379 dots2380)
(call-with-values (lambda () (cvt2371 x2379 (fx+1224 n2373 1) ids2374)) (lambda
(p2381 ids2382) (values (if (eq? p2381 (quote any)) (quote each-any) (vector
(quote each) p2381)) ids2382)))) tmp2376) ((lambda (tmp2383) (if tmp2383 (apply
(lambda (x2384 y2385) (call-with-values (lambda () (cvt2371 y2385 n2373
ids2374)) (lambda (y2386 ids2387) (call-with-values (lambda () (cvt2371 x2384
n2373 ids2387)) (lambda (x2388 ids2389) (values (cons x2388 y2386)
ids2389)))))) tmp2383) ((lambda (tmp2390) (if tmp2390 (apply (lambda () (values
(quote ()) ids2374)) tmp2390) ((lambda (tmp2391) (if tmp2391 (apply (lambda
(x2392) (call-with-values (lambda () (cvt2371 x2392 n2373 ids2374)) (lambda
(p2394 ids2395) (values (vector (quote vector) p2394) ids2395)))) tmp2391)
((lambda (x2396) (values (vector (quote atom) (strip1306 p2372 (quote (()))))
ids2374)) tmp2375))) ($sc-dispatch tmp2375 (quote #(vector each-any))))))
($sc-dispatch tmp2375 (quote ()))))) ($sc-dispatch tmp2375 (quote (any .
any)))))) ($sc-dispatch tmp2375 (quote (any any))))) p2372)))))) (lambda (e2397
r2398 w2399 s2400 mod2401) (let ((e2402 (source-wrap1288 e2397 w2399 s2400
mod2401))) ((lambda (tmp2403) ((lambda (tmp2404) (if tmp2404 (apply (lambda
(_2405 val2406 key2407 m2408) (if (and-map (lambda (x2409) (and (id?1259 x2409)
(not (ellipsis?1304 x2409)))) key2407) (let ((x2411 (gen-var1307 (quote tmp))))
(build-annotated1232 s2400 (list (build-annotated1232 #f (list (quote lambda)
(list x2411) (gen-syntax-case2324 (build-lexical-reference1233 (quote value) #f
(quote tmp) x2411) key2407 m2408 r2398 mod2401))) (chi1295 val2406 r2398 (quote
(())) mod2401)))) (syntax-violation (quote syntax-case) "invalid literals list"
e2402))) tmp2404) (syntax-violation #f "source expression failed to match any
pattern" tmp2403))) ($sc-dispatch tmp2403 (quote (any any each-any .
each-any))))) e2402))))) (set! sc-expand (lambda (x2415 . rest2414) (if (and
(pair? x2415) (equal? (car x2415) noexpand1222)) (cadr x2415) (let ((m2416 (if
(null? rest2414) (quote e) (car rest2414))) (esew2417 (if (or (null? rest2414)
(null? (cdr rest2414))) (quote (eval)) (cadr rest2414)))) (with-fluid*
*mode*1223 m2416 (lambda () (chi-top1294 x2415 (quote ()) (quote ((top))) m2416
esew2417 (cons (quote hygiene) (module-name (current-module)))))))))) (set!
identifier? (lambda (x2418) (nonsymbol-id?1258 x2418))) (set! datum->syntax
(lambda (id2419 datum2420) (make-syntax-object1242 datum2420
(syntax-object-wrap1245 id2419) #f))) (set! syntax->datum (lambda (x2421)
(strip1306 x2421 (quote (()))))) (set! generate-temporaries (lambda (ls2422)
(begin (let ((x2423 ls2422)) (if (not (list? x2423)) (syntax-violation (quote
generate-temporaries) "invalid argument" x2423))) (map (lambda (x2424)
(wrap1287 (gensym) (quote ((top))) #f)) ls2422)))) (set! free-identifier=?
(lambda (x2425 y2426) (begin (let ((x2427 x2425)) (if (not (nonsymbol-id?1258
x2427)) (syntax-violation (quote free-identifier=?) "invalid argument" x2427)))
(let ((x2428 y2426)) (if (not (nonsymbol-id?1258 x2428)) (syntax-violation
(quote free-identifier=?) "invalid argument" x2428))) (free-id=?1282 x2425
y2426)))) (set! bound-identifier=? (lambda (x2429 y2430) (begin (let ((x2431
x2429)) (if (not (nonsymbol-id?1258 x2431)) (syntax-violation (quote
bound-identifier=?) "invalid argument" x2431))) (let ((x2432 y2430)) (if (not
(nonsymbol-id?1258 x2432)) (syntax-violation (quote bound-identifier=?)
"invalid argument" x2432))) (bound-id=?1283 x2429 y2430)))) (set!
syntax-violation (lambda (who2436 message2435 form2434 . subform2433) (begin
(let ((x2437 who2436)) (if (not ((lambda (x2438) (or (not x2438) (string?
x2438) (symbol? x2438))) x2437)) (syntax-violation (quote syntax-violation)
"invalid argument" x2437))) (let ((x2439 message2435)) (if (not (string?
x2439)) (syntax-violation (quote syntax-violation) "invalid argument" x2439)))
(scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2436
"~a: " "") "~a " (if (null? subform2433) "in ~a" "in subform `~s' of `~s'"))
(let ((tail2440 (cons message2435 (map (lambda (x2441) (strip1306 x2441 (quote
(())))) (append subform2433 (list form2434)))))) (if who2436 (cons who2436
tail2440) tail2440)) #f)))) (letrec ((match2446 (lambda (e2447 p2448 w2449
r2450 mod2451) (cond ((not r2450) #f) ((eq? p2448 (quote any)) (cons (wrap1287
e2447 w2449 mod2451) r2450)) ((syntax-object?1243 e2447) (match*2445 (let
((e2452 (syntax-object-expression1244 e2447))) (if (annotation? e2452)
(annotation-expression e2452) e2452)) p2448 (join-wraps1278 w2449
(syntax-object-wrap1245 e2447)) r2450 (syntax-object-module1246 e2447))) (else
(match*2445 (let ((e2453 e2447)) (if (annotation? e2453) (annotation-expression
e2453) e2453)) p2448 w2449 r2450 mod2451))))) (match*2445 (lambda (e2454 p2455
w2456 r2457 mod2458) (cond ((null? p2455) (and (null? e2454) r2457)) ((pair?
p2455) (and (pair? e2454) (match2446 (car e2454) (car p2455) w2456 (match2446
(cdr e2454) (cdr p2455) w2456 r2457 mod2458) mod2458))) ((eq? p2455 (quote
each-any)) (let ((l2459 (match-each-any2443 e2454 w2456 mod2458))) (and l2459
(cons l2459 r2457)))) (else (let ((t2460 (vector-ref p2455 0))) (if (memv t2460
(quote (each))) (if (null? e2454) (match-empty2444 (vector-ref p2455 1) r2457)
(let ((l2461 (match-each2442 e2454 (vector-ref p2455 1) w2456 mod2458))) (and
l2461 (let collect2462 ((l2463 l2461)) (if (null? (car l2463)) r2457 (cons (map
car l2463) (collect2462 (map cdr l2463)))))))) (if (memv t2460 (quote
(free-id))) (and (id?1259 e2454) (free-id=?1282 (wrap1287 e2454 w2456 mod2458)
(vector-ref p2455 1)) r2457) (if (memv t2460 (quote (atom))) (and (equal?
(vector-ref p2455 1) (strip1306 e2454 w2456)) r2457) (if (memv t2460 (quote
(vector))) (and (vector? e2454) (match2446 (vector->list e2454) (vector-ref
p2455 1) w2456 r2457 mod2458))))))))))) (match-empty2444 (lambda (p2464 r2465)
(cond ((null? p2464) r2465) ((eq? p2464 (quote any)) (cons (quote ()) r2465))
((pair? p2464) (match-empty2444 (car p2464) (match-empty2444 (cdr p2464)
r2465))) ((eq? p2464 (quote each-any)) (cons (quote ()) r2465)) (else (let
((t2466 (vector-ref p2464 0))) (if (memv t2466 (quote (each))) (match-empty2444
(vector-ref p2464 1) r2465) (if (memv t2466 (quote (free-id atom))) r2465 (if
(memv t2466 (quote (vector))) (match-empty2444 (vector-ref p2464 1)
r2465))))))))) (match-each-any2443 (lambda (e2467 w2468 mod2469) (cond
((annotation? e2467) (match-each-any2443 (annotation-expression e2467) w2468
mod2469)) ((pair? e2467) (let ((l2470 (match-each-any2443 (cdr e2467) w2468
mod2469))) (and l2470 (cons (wrap1287 (car e2467) w2468 mod2469) l2470))))
((null? e2467) (quote ())) ((syntax-object?1243 e2467) (match-each-any2443
(syntax-object-expression1244 e2467) (join-wraps1278 w2468
(syntax-object-wrap1245 e2467)) mod2469)) (else #f)))) (match-each2442 (lambda
(e2471 p2472 w2473 mod2474) (cond ((annotation? e2471) (match-each2442
(annotation-expression e2471) p2472 w2473 mod2474)) ((pair? e2471) (let
((first2475 (match2446 (car e2471) p2472 w2473 (quote ()) mod2474))) (and
first2475 (let ((rest2476 (match-each2442 (cdr e2471) p2472 w2473 mod2474)))
(and rest2476 (cons first2475 rest2476)))))) ((null? e2471) (quote ()))
((syntax-object?1243 e2471) (match-each2442 (syntax-object-expression1244
e2471) p2472 (join-wraps1278 w2473 (syntax-object-wrap1245 e2471))
(syntax-object-module1246 e2471))) (else #f))))) (set! $sc-dispatch (lambda
(e2477 p2478) (cond ((eq? p2478 (quote any)) (list e2477)) ((syntax-object?1243
e2477) (match*2445 (let ((e2479 (syntax-object-expression1244 e2477))) (if
(annotation? e2479) (annotation-expression e2479) e2479)) p2478
(syntax-object-wrap1245 e2477) (quote ()) (syntax-object-module1246 e2477)))
(else (match*2445 (let ((e2480 e2477)) (if (annotation? e2480)
(annotation-expression e2480) e2480)) p2478 (quote (())) (quote ()) #f)))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x2481) ((lambda
(tmp2482) ((lambda (tmp2483) (if tmp2483 (apply (lambda (_2484 e12485 e22486)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e12485 e22486))) tmp2483) ((lambda (tmp2488) (if
tmp2488 (apply (lambda (_2489 out2490 in2491 e12492 e22493) (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))) in2491 (quote ()) (list out2490 (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 e12492 e22493))))) tmp2488) ((lambda
(tmp2495) (if tmp2495 (apply (lambda (_2496 out2497 in2498 e12499 e22500) (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))) in2498) (quote ()) (list out2497 (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 e12499 e22500))))) tmp2495) (syntax-violation #f "source
expression failed to match any pattern" tmp2482))) ($sc-dispatch tmp2482 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2482 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp2482 (quote (any () any .
each-any))))) x2481))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2504)
((lambda (tmp2505) ((lambda (tmp2506) (if tmp2506 (apply (lambda (_2507 k2508
keyword2509 pattern2510 template2511) (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 k2508 (map (lambda (tmp2514
tmp2513) (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)))
tmp2513) (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)))
tmp2514))) template2511 pattern2510)))))) tmp2506) (syntax-violation #f "source
expression failed to match any pattern" tmp2505))) ($sc-dispatch tmp2505 (quote
(any each-any . #(each ((any . any) any))))))) x2504))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x2515) ((lambda (tmp2516) ((lambda (tmp2517) (if
(if tmp2517 (apply (lambda (let*2518 x2519 v2520 e12521 e22522) (and-map
identifier? x2519)) tmp2517) #f) (apply (lambda (let*2524 x2525 v2526 e12527
e22528) (let f2529 ((bindings2530 (map list x2525 v2526))) (if (null?
bindings2530) (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
e12527 e22528))) ((lambda (tmp2534) ((lambda (tmp2535) (if tmp2535 (apply
(lambda (body2536 binding2537) (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 binding2537)
body2536)) tmp2535) (syntax-violation #f "source expression failed to match any
pattern" tmp2534))) ($sc-dispatch tmp2534 (quote (any any))))) (list (f2529
(cdr bindings2530)) (car bindings2530)))))) tmp2517) (syntax-violation #f
"source expression failed to match any pattern" tmp2516))) ($sc-dispatch
tmp2516 (quote (any #(each (any any)) any . each-any))))) x2515))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x2538) ((lambda (tmp2539) ((lambda (tmp2540)
(if tmp2540 (apply (lambda (_2541 var2542 init2543 step2544 e02545 e12546
c2547) ((lambda (tmp2548) ((lambda (tmp2549) (if tmp2549 (apply (lambda
(step2550) ((lambda (tmp2551) ((lambda (tmp2552) (if tmp2552 (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
var2542 init2543) (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))) e02545) (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 c2547 (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))) step2550))))))) tmp2552) ((lambda (tmp2557)
(if tmp2557 (apply (lambda (e12558 e22559) (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 var2542 init2543) (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))) e02545 (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 e12558 e22559)) (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 c2547 (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))) step2550))))))) tmp2557)
(syntax-violation #f "source expression failed to match any pattern" tmp2551)))
($sc-dispatch tmp2551 (quote (any . each-any)))))) ($sc-dispatch tmp2551 (quote
())))) e12546)) tmp2549) (syntax-violation #f "source expression failed to
match any pattern" tmp2548))) ($sc-dispatch tmp2548 (quote each-any)))) (map
(lambda (v2566 s2567) ((lambda (tmp2568) ((lambda (tmp2569) (if tmp2569 (apply
(lambda () v2566) tmp2569) ((lambda (tmp2570) (if tmp2570 (apply (lambda
(e2571) e2571) tmp2570) ((lambda (_2572) (syntax-violation (quote do) "bad step
expression" orig-x2538 s2567)) tmp2568))) ($sc-dispatch tmp2568 (quote
(any)))))) ($sc-dispatch tmp2568 (quote ())))) s2567)) var2542 step2544)))
tmp2540) (syntax-violation #f "source expression failed to match any pattern"
tmp2539))) ($sc-dispatch tmp2539 (quote (any #(each (any any . any)) (any .
each-any) . each-any))))) orig-x2538))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons2575 (lambda (x2579 y2580)
((lambda (tmp2581) ((lambda (tmp2582) (if tmp2582 (apply (lambda (x2583 y2584)
((lambda (tmp2585) ((lambda (tmp2586) (if tmp2586 (apply (lambda (dy2587)
((lambda (tmp2588) ((lambda (tmp2589) (if tmp2589 (apply (lambda (dx2590) (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 dx2590 dy2587))) tmp2589) ((lambda
(_2591) (if (null? dy2587) (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))) x2583) (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))) x2583 y2584))) tmp2588))) ($sc-dispatch
tmp2588 (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))))) x2583)) tmp2586) ((lambda (tmp2592) (if
tmp2592 (apply (lambda (stuff2593) (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 x2583 stuff2593))) tmp2592)
((lambda (else2594) (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))) x2583 y2584)) tmp2585))) ($sc-dispatch tmp2585
(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 tmp2585 (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))))) y2584)) tmp2582) (syntax-violation #f "source expression
failed to match any pattern" tmp2581))) ($sc-dispatch tmp2581 (quote (any
any))))) (list x2579 y2580)))) (quasiappend2576 (lambda (x2595 y2596) ((lambda
(tmp2597) ((lambda (tmp2598) (if tmp2598 (apply (lambda (x2599 y2600) ((lambda
(tmp2601) ((lambda (tmp2602) (if tmp2602 (apply (lambda () x2599) tmp2602)
((lambda (_2603) (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))) x2599 y2600)) tmp2601))) ($sc-dispatch tmp2601
(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))) ()))))) y2600))
tmp2598) (syntax-violation #f "source expression failed to match any pattern"
tmp2597))) ($sc-dispatch tmp2597 (quote (any any))))) (list x2595 y2596))))
(quasivector2577 (lambda (x2604) ((lambda (tmp2605) ((lambda (x2606) ((lambda
(tmp2607) ((lambda (tmp2608) (if tmp2608 (apply (lambda (x2609) (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
x2609))) tmp2608) ((lambda (tmp2611) (if tmp2611 (apply (lambda (x2612) (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))) x2612)) tmp2611)
((lambda (_2614) (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))) x2606)) tmp2607))) ($sc-dispatch tmp2607 (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 tmp2607 (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))))) x2606)) tmp2605)) x2604))) (quasi2578 (lambda
(p2615 lev2616) ((lambda (tmp2617) ((lambda (tmp2618) (if tmp2618 (apply
(lambda (p2619) (if (= lev2616 0) p2619 (quasicons2575 (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)))) (quasi2578 (list p2619) (- lev2616 1))))) tmp2618) ((lambda
(tmp2620) (if tmp2620 (apply (lambda (p2621 q2622) (if (= lev2616 0)
(quasiappend2576 p2621 (quasi2578 q2622 lev2616)) (quasicons2575 (quasicons2575
(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))))
(quasi2578 (list p2621) (- lev2616 1))) (quasi2578 q2622 lev2616)))) tmp2620)
((lambda (tmp2623) (if tmp2623 (apply (lambda (p2624) (quasicons2575 (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)))) (quasi2578 (list p2624) (+ lev2616
1)))) tmp2623) ((lambda (tmp2625) (if tmp2625 (apply (lambda (p2626 q2627)
(quasicons2575 (quasi2578 p2626 lev2616) (quasi2578 q2627 lev2616))) tmp2625)
((lambda (tmp2628) (if tmp2628 (apply (lambda (x2629) (quasivector2577
(quasi2578 x2629 lev2616))) tmp2628) ((lambda (p2631) (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))) p2631)) tmp2617))) ($sc-dispatch tmp2617 (quote #(vector
each-any)))))) ($sc-dispatch tmp2617 (quote (any . any)))))) ($sc-dispatch
tmp2617 (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 tmp2617 (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 tmp2617 (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))))) p2615)))) (lambda (x2632) ((lambda
(tmp2633) ((lambda (tmp2634) (if tmp2634 (apply (lambda (_2635 e2636)
(quasi2578 e2636 0)) tmp2634) (syntax-violation #f "source expression failed to
match any pattern" tmp2633))) ($sc-dispatch tmp2633 (quote (any any)))))
x2632)))))
-(define include (make-syncase-macro (quote macro) (lambda (x2637) (letrec
((read-file2638 (lambda (fn2639 k2640) (let ((p2641 (open-input-file fn2639)))
(let f2642 ((x2643 (read p2641))) (if (eof-object? x2643) (begin
(close-input-port p2641) (quote ())) (cons (datum->syntax k2640 x2643) (f2642
(read p2641))))))))) ((lambda (tmp2644) ((lambda (tmp2645) (if tmp2645 (apply
(lambda (k2646 filename2647) (let ((fn2648 (syntax->datum filename2647)))
((lambda (tmp2649) ((lambda (tmp2650) (if tmp2650 (apply (lambda (exp2651)
(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))) exp2651))
tmp2650) (syntax-violation #f "source expression failed to match any pattern"
tmp2649))) ($sc-dispatch tmp2649 (quote each-any)))) (read-file2638 fn2648
k2646)))) tmp2645) (syntax-violation #f "source expression failed to match any
pattern" tmp2644))) ($sc-dispatch tmp2644 (quote (any any))))) x2637)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x2653) ((lambda
(tmp2654) ((lambda (tmp2655) (if tmp2655 (apply (lambda (_2656 e2657)
(syntax-violation (quote unquote) "expression not valid outside of quasiquote"
x2653)) tmp2655) (syntax-violation #f "source expression failed to match any
pattern" tmp2654))) ($sc-dispatch tmp2654 (quote (any any))))) x2653))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2658)
((lambda (tmp2659) ((lambda (tmp2660) (if tmp2660 (apply (lambda (_2661 e2662)
(syntax-violation (quote unquote-splicing) "expression not valid outside of
quasiquote" x2658)) tmp2660) (syntax-violation #f "source expression failed to
match any pattern" tmp2659))) ($sc-dispatch tmp2659 (quote (any any)))))
x2658))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x2663) ((lambda (tmp2664) ((lambda (tmp2665) (if
tmp2665 (apply (lambda (_2666 e2667 m12668 m22669) ((lambda (tmp2670) ((lambda
(body2671) (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))) e2667)) body2671))
tmp2670)) (let f2672 ((clause2673 m12668) (clauses2674 m22669)) (if (null?
clauses2674) ((lambda (tmp2676) ((lambda (tmp2677) (if tmp2677 (apply (lambda
(e12678 e22679) (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 e12678 e22679))) tmp2677) ((lambda (tmp2681) (if
tmp2681 (apply (lambda (k2682 e12683 e22684) (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))) k2682)) (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 e12683 e22684)))) tmp2681)
((lambda (_2687) (syntax-violation (quote case) "bad clause" x2663 clause2673))
tmp2676))) ($sc-dispatch tmp2676 (quote (each-any any . each-any))))))
($sc-dispatch tmp2676 (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))))) clause2673) ((lambda (tmp2688) ((lambda (rest2689) ((lambda
(tmp2690) ((lambda (tmp2691) (if tmp2691 (apply (lambda (k2692 e12693 e22694)
(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))) k2692)) (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 e12693 e22694)) rest2689)) tmp2691)
((lambda (_2697) (syntax-violation (quote case) "bad clause" x2663 clause2673))
tmp2690))) ($sc-dispatch tmp2690 (quote (each-any any . each-any)))))
clause2673)) tmp2688)) (f2672 (car clauses2674) (cdr clauses2674)))))))
tmp2665) (syntax-violation #f "source expression failed to match any pattern"
tmp2664))) ($sc-dispatch tmp2664 (quote (any any any . each-any))))) x2663))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2698)
((lambda (tmp2699) ((lambda (tmp2700) (if tmp2700 (apply (lambda (_2701 e2702)
(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)))
e2702)) (list (cons _2701 (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 e2702 (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)))))))))) tmp2700) (syntax-violation #f "source expression failed to
match any pattern" tmp2699))) ($sc-dispatch tmp2699 (quote (any any)))))
x2698))))
+(letrec ((and-map*1697 (lambda (f1737 first1736 . rest1735) (or (null?
first1736) (if (null? rest1735) (letrec ((andmap1738 (lambda (first1739) (let
((x1740 (car first1739)) (first1741 (cdr first1739))) (if (null? first1741)
(f1737 x1740) (and (f1737 x1740) (andmap1738 first1741))))))) (andmap1738
first1736)) (letrec ((andmap1742 (lambda (first1743 rest1744) (let ((x1745 (car
first1743)) (xr1746 (map car rest1744)) (first1747 (cdr first1743)) (rest1748
(map cdr rest1744))) (if (null? first1747) (apply f1737 (cons x1745 xr1746))
(and (apply f1737 (cons x1745 xr1746)) (andmap1742 first1747 rest1748)))))))
(andmap1742 first1736 rest1735))))))) (letrec ((lambda-var-list1840 (lambda
(vars1969) (letrec ((lvl1970 (lambda (vars1971 ls1972 w1973) (cond ((pair?
vars1971) (lvl1970 (cdr vars1971) (cons (wrap1819 (car vars1971) w1973 (quote
#f)) ls1972) w1973)) ((id?1791 vars1971) (cons (wrap1819 vars1971 w1973 (quote
#f)) ls1972)) ((null? vars1971) ls1972) ((syntax-object?1775 vars1971) (lvl1970
(syntax-object-expression1776 vars1971) ls1972 (join-wraps1810 w1973
(syntax-object-wrap1777 vars1971)))) ((annotation? vars1971) (lvl1970
(annotation-expression vars1971) ls1972 w1973)) (else (cons vars1971
ls1972)))))) (lvl1970 vars1969 (quote ()) (quote (())))))) (gen-var1839 (lambda
(id1974) (let ((id1975 (if (syntax-object?1775 id1974)
(syntax-object-expression1776 id1974) id1974))) (if (annotation? id1975)
(gensym (symbol->string (annotation-expression id1975))) (gensym
(symbol->string id1975)))))) (strip1838 (lambda (x1976 w1977) (if (memq (quote
top) (wrap-marks1794 w1977)) (if (or (annotation? x1976) (and (pair? x1976)
(annotation? (car x1976)))) (strip-annotation1837 x1976 (quote #f)) x1976)
(letrec ((f1978 (lambda (x1979) (cond ((syntax-object?1775 x1979) (strip1838
(syntax-object-expression1776 x1979) (syntax-object-wrap1777 x1979))) ((pair?
x1979) (let ((a1980 (f1978 (car x1979))) (d1981 (f1978 (cdr x1979)))) (if (and
(eq? a1980 (car x1979)) (eq? d1981 (cdr x1979))) x1979 (cons a1980 d1981))))
((vector? x1979) (let ((old1982 (vector->list x1979))) (let ((new1983 (map
f1978 old1982))) (if (and-map*1697 eq? old1982 new1983) x1979 (list->vector
new1983))))) (else x1979))))) (f1978 x1976))))) (strip-annotation1837 (lambda
(x1984 parent1985) (cond ((pair? x1984) (let ((new1986 (cons (quote #f) (quote
#f)))) (begin (if parent1985 (set-annotation-stripped! parent1985 new1986))
(set-car! new1986 (strip-annotation1837 (car x1984) (quote #f))) (set-cdr!
new1986 (strip-annotation1837 (cdr x1984) (quote #f))) new1986))) ((annotation?
x1984) (or (annotation-stripped x1984) (strip-annotation1837
(annotation-expression x1984) x1984))) ((vector? x1984) (let ((new1987
(make-vector (vector-length x1984)))) (begin (if parent1985
(set-annotation-stripped! parent1985 new1987)) (letrec ((loop1988 (lambda
(i1989) (unless (fx<1754 i1989 (quote 0)) (vector-set! new1987 i1989
(strip-annotation1837 (vector-ref x1984 i1989) (quote #f))) (loop1988 (fx-1752
i1989 (quote 1))))))) (loop1988 (- (vector-length x1984) (quote 1))))
new1987))) (else x1984)))) (ellipsis?1836 (lambda (x1990) (and
(nonsymbol-id?1790 x1990) (free-id=?1814 x1990 (quote #(syntax-object ...
((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))))))) (chi-void1835 (lambda () (build-application1759
(quote #f) (build-primref1768 (quote #f) (quote if)) (quote (#f #f)))))
(eval-local-transformer1834 (lambda (expanded1991 mod1992) (let ((p1993
(local-eval-hook1756 expanded1991 mod1992))) (if (procedure? p1993) p1993
(syntax-violation (quote #f) (quote "nonprocedure transformer") p1993)))))
(chi-local-syntax1833 (lambda (rec?1994 e1995 r1996 w1997 s1998 mod1999 k2000)
((lambda (tmp2001) ((lambda (tmp2002) (if tmp2002 (apply (lambda (_2003 id2004
val2005 e12006 e22007) (let ((ids2008 id2004)) (if (not (valid-bound-ids?1816
ids2008)) (syntax-violation (quote #f) (quote "duplicate bound keyword") e1995)
(let ((labels2010 (gen-labels1797 ids2008))) (let ((new-w2011
(make-binding-wrap1808 ids2008 labels2010 w1997))) (k2000 (cons e12006 e22007)
(extend-env1785 labels2010 (let ((w2013 (if rec?1994 new-w2011 w1997))
(trans-r2014 (macros-only-env1787 r1996))) (map (lambda (x2015) (cons (quote
macro) (eval-local-transformer1834 (chi1827 x2015 trans-r2014 w2013 mod1999)
mod1999))) val2005)) r1996) new-w2011 s1998 mod1999)))))) tmp2002) ((lambda
(_2017) (syntax-violation (quote #f) (quote "bad local syntax definition")
(source-wrap1820 e1995 w1997 s1998 mod1999))) tmp2001))) ($sc-dispatch tmp2001
(quote (any #(each (any any)) any . each-any))))) e1995)))
(chi-lambda-clause1832 (lambda (e2018 docstring2019 c2020 r2021 w2022 mod2023
k2024) ((lambda (tmp2025) ((lambda (tmp2026) (if (if tmp2026 (apply (lambda
(args2027 doc2028 e12029 e22030) (and (string? (syntax->datum doc2028)) (not
docstring2019))) tmp2026) (quote #f)) (apply (lambda (args2031 doc2032 e12033
e22034) (chi-lambda-clause1832 e2018 doc2032 (cons args2031 (cons e12033
e22034)) r2021 w2022 mod2023 k2024)) tmp2026) ((lambda (tmp2036) (if tmp2036
(apply (lambda (id2037 e12038 e22039) (let ((ids2040 id2037)) (if (not
(valid-bound-ids?1816 ids2040)) (syntax-violation (quote lambda) (quote
"invalid parameter list") e2018) (let ((labels2042 (gen-labels1797 ids2040))
(new-vars2043 (map gen-var1839 ids2040))) (k2024 new-vars2043 docstring2019
(chi-body1831 (cons e12038 e22039) e2018 (extend-var-env1786 labels2042
new-vars2043 r2021) (make-binding-wrap1808 ids2040 labels2042 w2022)
mod2023)))))) tmp2036) ((lambda (tmp2045) (if tmp2045 (apply (lambda (ids2046
e12047 e22048) (let ((old-ids2049 (lambda-var-list1840 ids2046))) (if (not
(valid-bound-ids?1816 old-ids2049)) (syntax-violation (quote lambda) (quote
"invalid parameter list") e2018) (let ((labels2050 (gen-labels1797
old-ids2049)) (new-vars2051 (map gen-var1839 old-ids2049))) (k2024 (letrec
((f2052 (lambda (ls12053 ls22054) (if (null? ls12053) ls22054 (f2052 (cdr
ls12053) (cons (car ls12053) ls22054)))))) (f2052 (cdr new-vars2051) (car
new-vars2051))) docstring2019 (chi-body1831 (cons e12047 e22048) e2018
(extend-var-env1786 labels2050 new-vars2051 r2021) (make-binding-wrap1808
old-ids2049 labels2050 w2022) mod2023)))))) tmp2045) ((lambda (_2056)
(syntax-violation (quote lambda) (quote "bad lambda") e2018)) tmp2025)))
($sc-dispatch tmp2025 (quote (any any . each-any)))))) ($sc-dispatch tmp2025
(quote (each-any any . each-any)))))) ($sc-dispatch tmp2025 (quote (any any any
. each-any))))) c2020))) (chi-body1831 (lambda (body2057 outer-form2058 r2059
w2060 mod2061) (let ((r2062 (cons (quote ("placeholder" placeholder)) r2059)))
(let ((ribcage2063 (make-ribcage1798 (quote ()) (quote ()) (quote ())))) (let
((w2064 (make-wrap1793 (wrap-marks1794 w2060) (cons ribcage2063 (wrap-subst1795
w2060))))) (letrec ((parse2065 (lambda (body2066 ids2067 labels2068 vars2069
vals2070 bindings2071) (if (null? body2066) (syntax-violation (quote #f) (quote
"no expressions in body") outer-form2058) (let ((e2073 (cdar body2066)) (er2074
(caar body2066))) (call-with-values (lambda () (syntax-type1825 e2073 er2074
(quote (())) (quote #f) ribcage2063 mod2061)) (lambda (type2075 value2076 e2077
w2078 s2079 mod2080) (let ((t2081 type2075)) (if (memv t2081 (quote
(define-form))) (let ((id2082 (wrap1819 value2076 w2078 mod2080)) (label2083
(gen-label1796))) (let ((var2084 (gen-var1839 id2082))) (begin
(extend-ribcage!1807 ribcage2063 id2082 label2083) (parse2065 (cdr body2066)
(cons id2082 ids2067) (cons label2083 labels2068) (cons var2084 vars2069) (cons
(cons er2074 (wrap1819 e2077 w2078 mod2080)) vals2070) (cons (cons (quote
lexical) var2084) bindings2071))))) (if (memv t2081 (quote
(define-syntax-form))) (let ((id2085 (wrap1819 value2076 w2078 mod2080))
(label2086 (gen-label1796))) (begin (extend-ribcage!1807 ribcage2063 id2085
label2086) (parse2065 (cdr body2066) (cons id2085 ids2067) (cons label2086
labels2068) vars2069 vals2070 (cons (cons (quote macro) (cons er2074 (wrap1819
e2077 w2078 mod2080))) bindings2071)))) (if (memv t2081 (quote (begin-form)))
((lambda (tmp2087) ((lambda (tmp2088) (if tmp2088 (apply (lambda (_2089 e12090)
(parse2065 (letrec ((f2091 (lambda (forms2092) (if (null? forms2092) (cdr
body2066) (cons (cons er2074 (wrap1819 (car forms2092) w2078 mod2080)) (f2091
(cdr forms2092))))))) (f2091 e12090)) ids2067 labels2068 vars2069 vals2070
bindings2071)) tmp2088) (syntax-violation #f "source expression failed to match
any pattern" tmp2087))) ($sc-dispatch tmp2087 (quote (any . each-any)))))
e2077) (if (memv t2081 (quote (local-syntax-form))) (chi-local-syntax1833
value2076 e2077 er2074 w2078 s2079 mod2080 (lambda (forms2094 er2095 w2096
s2097 mod2098) (parse2065 (letrec ((f2099 (lambda (forms2100) (if (null?
forms2100) (cdr body2066) (cons (cons er2095 (wrap1819 (car forms2100) w2096
mod2098)) (f2099 (cdr forms2100))))))) (f2099 forms2094)) ids2067 labels2068
vars2069 vals2070 bindings2071))) (if (null? ids2067) (build-sequence1770
(quote #f) (map (lambda (x2101) (chi1827 (cdr x2101) (car x2101) (quote (()))
mod2080)) (cons (cons er2074 (source-wrap1820 e2077 w2078 s2079 mod2080)) (cdr
body2066)))) (begin (if (not (valid-bound-ids?1816 ids2067)) (syntax-violation
(quote #f) (quote "invalid or duplicate identifier in definition")
outer-form2058)) (letrec ((loop2102 (lambda (bs2103 er-cache2104 r-cache2105)
(if (not (null? bs2103)) (let ((b2106 (car bs2103))) (if (eq? (car b2106)
(quote macro)) (let ((er2107 (cadr b2106))) (let ((r-cache2108 (if (eq? er2107
er-cache2104) r-cache2105 (macros-only-env1787 er2107)))) (begin (set-cdr!
b2106 (eval-local-transformer1834 (chi1827 (cddr b2106) r-cache2108 (quote
(())) mod2080) mod2080)) (loop2102 (cdr bs2103) er2107 r-cache2108))))
(loop2102 (cdr bs2103) er-cache2104 r-cache2105))))))) (loop2102 bindings2071
(quote #f) (quote #f))) (set-cdr! r2062 (extend-env1785 labels2068 bindings2071
(cdr r2062))) (build-letrec1773 (quote #f) vars2069 (map (lambda (x2109)
(chi1827 (cdr x2109) (car x2109) (quote (())) mod2080)) vals2070)
(build-sequence1770 (quote #f) (map (lambda (x2110) (chi1827 (cdr x2110) (car
x2110) (quote (())) mod2080)) (cons (cons er2074 (source-wrap1820 e2077 w2078
s2079 mod2080)) (cdr body2066))))))))))))))))))) (parse2065 (map (lambda
(x2072) (cons r2062 (wrap1819 x2072 w2064 mod2061))) body2057) (quote ())
(quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro1830 (lambda
(p2111 e2112 r2113 w2114 rib2115 mod2116) (letrec ((rebuild-macro-output2117
(lambda (x2118 m2119) (cond ((pair? x2118) (cons (rebuild-macro-output2117 (car
x2118) m2119) (rebuild-macro-output2117 (cdr x2118) m2119)))
((syntax-object?1775 x2118) (let ((w2120 (syntax-object-wrap1777 x2118))) (let
((ms2121 (wrap-marks1794 w2120)) (s2122 (wrap-subst1795 w2120))) (if (and
(pair? ms2121) (eq? (car ms2121) (quote #f))) (make-syntax-object1774
(syntax-object-expression1776 x2118) (make-wrap1793 (cdr ms2121) (if rib2115
(cons rib2115 (cdr s2122)) (cdr s2122))) (syntax-object-module1778 x2118))
(make-syntax-object1774 (syntax-object-expression1776 x2118) (make-wrap1793
(cons m2119 ms2121) (if rib2115 (cons rib2115 (cons (quote shift) s2122)) (cons
(quote shift) s2122))) (let ((pmod2123 (procedure-module p2111))) (if pmod2123
(cons (quote hygiene) (module-name pmod2123)) (quote (hygiene guile)))))))))
((vector? x2118) (let ((n2124 (vector-length x2118))) (let ((v2125 (make-vector
n2124))) (letrec ((doloop2126 (lambda (i2127) (if (fx=1753 i2127 n2124) v2125
(begin (vector-set! v2125 i2127 (rebuild-macro-output2117 (vector-ref x2118
i2127) m2119)) (doloop2126 (fx+1751 i2127 (quote 1)))))))) (doloop2126 (quote
0)))))) ((symbol? x2118) (syntax-violation (quote #f) (quote "encountered raw
symbol in macro output") (source-wrap1820 e2112 w2114 s mod2116) x2118)) (else
x2118))))) (rebuild-macro-output2117 (p2111 (wrap1819 e2112 (anti-mark1806
w2114) mod2116)) (string (quote #\m)))))) (chi-application1829 (lambda (x2128
e2129 r2130 w2131 s2132 mod2133) ((lambda (tmp2134) ((lambda (tmp2135) (if
tmp2135 (apply (lambda (e02136 e12137) (build-application1759 s2132 x2128 (map
(lambda (e2138) (chi1827 e2138 r2130 w2131 mod2133)) e12137))) tmp2135)
(syntax-violation #f "source expression failed to match any pattern" tmp2134)))
($sc-dispatch tmp2134 (quote (any . each-any))))) e2129))) (chi-expr1828
(lambda (type2140 value2141 e2142 r2143 w2144 s2145 mod2146) (let ((t2147
type2140)) (if (memv t2147 (quote (lexical))) (build-lexical-reference1761
(quote value) s2145 e2142 value2141) (if (memv t2147 (quote (core
external-macro))) (value2141 e2142 r2143 w2144 s2145 mod2146) (if (memv t2147
(quote (module-ref))) (call-with-values (lambda () (value2141 e2142)) (lambda
(id2148 mod2149) (build-global-reference1764 s2145 id2148 mod2149))) (if (memv
t2147 (quote (lexical-call))) (chi-application1829 (build-lexical-reference1761
(quote fun) (source-annotation1782 (car e2142)) (car e2142) value2141) e2142
r2143 w2144 s2145 mod2146) (if (memv t2147 (quote (global-call)))
(chi-application1829 (build-global-reference1764 (source-annotation1782 (car
e2142)) value2141 (if (syntax-object?1775 (car e2142))
(syntax-object-module1778 (car e2142)) mod2146)) e2142 r2143 w2144 s2145
mod2146) (if (memv t2147 (quote (constant))) (build-data1769 s2145 (strip1838
(source-wrap1820 e2142 w2144 s2145 mod2146) (quote (())))) (if (memv t2147
(quote (global))) (build-global-reference1764 s2145 value2141 mod2146) (if
(memv t2147 (quote (call))) (chi-application1829 (chi1827 (car e2142) r2143
w2144 mod2146) e2142 r2143 w2144 s2145 mod2146) (if (memv t2147 (quote
(begin-form))) ((lambda (tmp2150) ((lambda (tmp2151) (if tmp2151 (apply (lambda
(_2152 e12153 e22154) (chi-sequence1821 (cons e12153 e22154) r2143 w2144 s2145
mod2146)) tmp2151) (syntax-violation #f "source expression failed to match any
pattern" tmp2150))) ($sc-dispatch tmp2150 (quote (any any . each-any)))))
e2142) (if (memv t2147 (quote (local-syntax-form))) (chi-local-syntax1833
value2141 e2142 r2143 w2144 s2145 mod2146 chi-sequence1821) (if (memv t2147
(quote (eval-when-form))) ((lambda (tmp2156) ((lambda (tmp2157) (if tmp2157
(apply (lambda (_2158 x2159 e12160 e22161) (let ((when-list2162
(chi-when-list1824 e2142 x2159 w2144))) (if (memq (quote eval) when-list2162)
(chi-sequence1821 (cons e12160 e22161) r2143 w2144 s2145 mod2146)
(chi-void1835)))) tmp2157) (syntax-violation #f "source expression failed to
match any pattern" tmp2156))) ($sc-dispatch tmp2156 (quote (any each-any any .
each-any))))) e2142) (if (memv t2147 (quote (define-form define-syntax-form)))
(syntax-violation (quote #f) (quote "definition in expression context") e2142
(wrap1819 value2141 w2144 mod2146)) (if (memv t2147 (quote (syntax)))
(syntax-violation (quote #f) (quote "reference to pattern variable outside
syntax form") (source-wrap1820 e2142 w2144 s2145 mod2146)) (if (memv t2147
(quote (displaced-lexical))) (syntax-violation (quote #f) (quote "reference to
identifier outside its scope") (source-wrap1820 e2142 w2144 s2145 mod2146))
(syntax-violation (quote #f) (quote "unexpected syntax") (source-wrap1820 e2142
w2144 s2145 mod2146))))))))))))))))))) (chi1827 (lambda (e2165 r2166 w2167
mod2168) (call-with-values (lambda () (syntax-type1825 e2165 r2166 w2167 (quote
#f) (quote #f) mod2168)) (lambda (type2169 value2170 e2171 w2172 s2173 mod2174)
(chi-expr1828 type2169 value2170 e2171 r2166 w2172 s2173 mod2174)))))
(chi-top1826 (lambda (e2175 r2176 w2177 m2178 esew2179 mod2180)
(call-with-values (lambda () (syntax-type1825 e2175 r2176 w2177 (quote #f)
(quote #f) mod2180)) (lambda (type2188 value2189 e2190 w2191 s2192 mod2193)
(let ((t2194 type2188)) (if (memv t2194 (quote (begin-form))) ((lambda
(tmp2195) ((lambda (tmp2196) (if tmp2196 (apply (lambda (_2197) (chi-void1835))
tmp2196) ((lambda (tmp2198) (if tmp2198 (apply (lambda (_2199 e12200 e22201)
(chi-top-sequence1822 (cons e12200 e22201) r2176 w2191 s2192 m2178 esew2179
mod2193)) tmp2198) (syntax-violation #f "source expression failed to match any
pattern" tmp2195))) ($sc-dispatch tmp2195 (quote (any any . each-any))))))
($sc-dispatch tmp2195 (quote (any))))) e2190) (if (memv t2194 (quote
(local-syntax-form))) (chi-local-syntax1833 value2189 e2190 r2176 w2191 s2192
mod2193 (lambda (body2203 r2204 w2205 s2206 mod2207) (chi-top-sequence1822
body2203 r2204 w2205 s2206 m2178 esew2179 mod2207))) (if (memv t2194 (quote
(eval-when-form))) ((lambda (tmp2208) ((lambda (tmp2209) (if tmp2209 (apply
(lambda (_2210 x2211 e12212 e22213) (let ((when-list2214 (chi-when-list1824
e2190 x2211 w2191)) (body2215 (cons e12212 e22213))) (cond ((eq? m2178 (quote
e)) (if (memq (quote eval) when-list2214) (chi-top-sequence1822 body2215 r2176
w2191 s2192 (quote e) (quote (eval)) mod2193) (chi-void1835))) ((memq (quote
load) when-list2214) (if (or (memq (quote compile) when-list2214) (and (eq?
m2178 (quote c&e)) (memq (quote eval) when-list2214))) (chi-top-sequence1822
body2215 r2176 w2191 s2192 (quote c&e) (quote (compile load)) mod2193) (if
(memq m2178 (quote (c c&e))) (chi-top-sequence1822 body2215 r2176 w2191 s2192
(quote c) (quote (load)) mod2193) (chi-void1835)))) ((or (memq (quote compile)
when-list2214) (and (eq? m2178 (quote c&e)) (memq (quote eval) when-list2214)))
(top-level-eval-hook1755 (chi-top-sequence1822 body2215 r2176 w2191 s2192
(quote e) (quote (eval)) mod2193) mod2193) (chi-void1835)) (else
(chi-void1835))))) tmp2209) (syntax-violation #f "source expression failed to
match any pattern" tmp2208))) ($sc-dispatch tmp2208 (quote (any each-any any .
each-any))))) e2190) (if (memv t2194 (quote (define-syntax-form))) (let ((n2218
(id-var-name1813 value2189 w2191)) (r2219 (macros-only-env1787 r2176))) (let
((t2220 m2178)) (if (memv t2220 (quote (c))) (if (memq (quote compile)
esew2179) (let ((e2221 (chi-install-global1823 n2218 (chi1827 e2190 r2219 w2191
mod2193)))) (begin (top-level-eval-hook1755 e2221 mod2193) (if (memq (quote
load) esew2179) e2221 (chi-void1835)))) (if (memq (quote load) esew2179)
(chi-install-global1823 n2218 (chi1827 e2190 r2219 w2191 mod2193))
(chi-void1835))) (if (memv t2220 (quote (c&e))) (let ((e2222
(chi-install-global1823 n2218 (chi1827 e2190 r2219 w2191 mod2193)))) (begin
(top-level-eval-hook1755 e2222 mod2193) e2222)) (begin (if (memq (quote eval)
esew2179) (top-level-eval-hook1755 (chi-install-global1823 n2218 (chi1827 e2190
r2219 w2191 mod2193)) mod2193)) (chi-void1835)))))) (if (memv t2194 (quote
(define-form))) (let ((n2223 (id-var-name1813 value2189 w2191))) (let
((type2224 (binding-type1783 (lookup1788 n2223 r2176 mod2193)))) (let ((t2225
type2224)) (if (memv t2225 (quote (global core macro module-ref))) (let ((x2226
(build-global-definition1766 s2192 n2223 (chi1827 e2190 r2176 w2191 mod2193))))
(begin (if (eq? m2178 (quote c&e)) (top-level-eval-hook1755 x2226 mod2193))
x2226)) (if (memv t2225 (quote (displaced-lexical))) (syntax-violation (quote
#f) (quote "identifier out of context") e2190 (wrap1819 value2189 w2191
mod2193)) (syntax-violation (quote #f) (quote "cannot define keyword at top
level") e2190 (wrap1819 value2189 w2191 mod2193))))))) (let ((x2227
(chi-expr1828 type2188 value2189 e2190 r2176 w2191 s2192 mod2193))) (begin (if
(eq? m2178 (quote c&e)) (top-level-eval-hook1755 x2227 mod2193))
x2227)))))))))))) (syntax-type1825 (lambda (e2228 r2229 w2230 s2231 rib2232
mod2233) (cond ((symbol? e2228) (let ((n2234 (id-var-name1813 e2228 w2230)))
(let ((b2235 (lookup1788 n2234 r2229 mod2233))) (let ((type2236
(binding-type1783 b2235))) (let ((t2237 type2236)) (if (memv t2237 (quote
(lexical))) (values type2236 (binding-value1784 b2235) e2228 w2230 s2231
mod2233) (if (memv t2237 (quote (global))) (values type2236 n2234 e2228 w2230
s2231 mod2233) (if (memv t2237 (quote (macro))) (syntax-type1825 (chi-macro1830
(binding-value1784 b2235) e2228 r2229 w2230 rib2232 mod2233) r2229 (quote (()))
s2231 rib2232 mod2233) (values type2236 (binding-value1784 b2235) e2228 w2230
s2231 mod2233))))))))) ((pair? e2228) (let ((first2238 (car e2228))) (if
(id?1791 first2238) (let ((n2239 (id-var-name1813 first2238 w2230))) (let
((b2240 (lookup1788 n2239 r2229 (or (and (syntax-object?1775 first2238)
(syntax-object-module1778 first2238)) mod2233)))) (let ((type2241
(binding-type1783 b2240))) (let ((t2242 type2241)) (if (memv t2242 (quote
(lexical))) (values (quote lexical-call) (binding-value1784 b2240) e2228 w2230
s2231 mod2233) (if (memv t2242 (quote (global))) (values (quote global-call)
n2239 e2228 w2230 s2231 mod2233) (if (memv t2242 (quote (macro)))
(syntax-type1825 (chi-macro1830 (binding-value1784 b2240) e2228 r2229 w2230
rib2232 mod2233) r2229 (quote (())) s2231 rib2232 mod2233) (if (memv t2242
(quote (core external-macro module-ref))) (values type2241 (binding-value1784
b2240) e2228 w2230 s2231 mod2233) (if (memv t2242 (quote (local-syntax)))
(values (quote local-syntax-form) (binding-value1784 b2240) e2228 w2230 s2231
mod2233) (if (memv t2242 (quote (begin))) (values (quote begin-form) (quote #f)
e2228 w2230 s2231 mod2233) (if (memv t2242 (quote (eval-when))) (values (quote
eval-when-form) (quote #f) e2228 w2230 s2231 mod2233) (if (memv t2242 (quote
(define))) ((lambda (tmp2243) ((lambda (tmp2244) (if (if tmp2244 (apply (lambda
(_2245 name2246 val2247) (id?1791 name2246)) tmp2244) (quote #f)) (apply
(lambda (_2248 name2249 val2250) (values (quote define-form) name2249 val2250
w2230 s2231 mod2233)) tmp2244) ((lambda (tmp2251) (if (if tmp2251 (apply
(lambda (_2252 name2253 args2254 e12255 e22256) (and (id?1791 name2253)
(valid-bound-ids?1816 (lambda-var-list1840 args2254)))) tmp2251) (quote #f))
(apply (lambda (_2257 name2258 args2259 e12260 e22261) (values (quote
define-form) (wrap1819 name2258 w2230 mod2233) (cons (quote #(syntax-object
lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top))
#("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type)
#((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage
() () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage
#(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod)
#((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) (wrap1819 (cons args2259 (cons e12260 e22261)) w2230
mod2233)) (quote (())) s2231 mod2233)) tmp2251) ((lambda (tmp2263) (if (if
tmp2263 (apply (lambda (_2264 name2265) (id?1791 name2265)) tmp2263) (quote
#f)) (apply (lambda (_2266 name2267) (values (quote define-form) (wrap1819
name2267 w2230 mod2233) (quote (#(syntax-object if ((top) #(ribcage #(_ name)
#((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top))
#("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage
#(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ())
#(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib
mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i"))
#(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type)
#((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage
() () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage
#(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod)
#((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top)
(top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i"))
#(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type)
#((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage
() () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage
#(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod)
#((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage
(lambda-var-list gen-var strip strip-annotation ellipsis? chi-void
eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro
chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote (())) s2231 mod2233)) tmp2263)
(syntax-violation #f "source expression failed to match any pattern" tmp2243)))
($sc-dispatch tmp2243 (quote (any any)))))) ($sc-dispatch tmp2243 (quote (any
(any . any) any . each-any)))))) ($sc-dispatch tmp2243 (quote (any any any)))))
e2228) (if (memv t2242 (quote (define-syntax))) ((lambda (tmp2268) ((lambda
(tmp2269) (if (if tmp2269 (apply (lambda (_2270 name2271 val2272) (id?1791
name2271)) tmp2269) (quote #f)) (apply (lambda (_2273 name2274 val2275) (values
(quote define-syntax-form) name2274 val2275 w2230 s2231 mod2233)) tmp2269)
(syntax-violation #f "source expression failed to match any pattern" tmp2268)))
($sc-dispatch tmp2268 (quote (any any any))))) e2228) (values (quote call)
(quote #f) e2228 w2230 s2231 mod2233)))))))))))))) (values (quote call) (quote
#f) e2228 w2230 s2231 mod2233)))) ((syntax-object?1775 e2228) (syntax-type1825
(syntax-object-expression1776 e2228) r2229 (join-wraps1810 w2230
(syntax-object-wrap1777 e2228)) (quote #f) rib2232 (or
(syntax-object-module1778 e2228) mod2233))) ((annotation? e2228)
(syntax-type1825 (annotation-expression e2228) r2229 w2230 (annotation-source
e2228) rib2232 mod2233)) ((self-evaluating? e2228) (values (quote constant)
(quote #f) e2228 w2230 s2231 mod2233)) (else (values (quote other) (quote #f)
e2228 w2230 s2231 mod2233))))) (chi-when-list1824 (lambda (e2276 when-list2277
w2278) (letrec ((f2279 (lambda (when-list2280 situations2281) (if (null?
when-list2280) situations2281 (f2279 (cdr when-list2280) (cons (let ((x2282
(car when-list2280))) (cond ((free-id=?1814 x2282 (quote #(syntax-object
compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage ()
() ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i"))
#(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote compile)) ((free-id=?1814 x2282 (quote
#(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top))
#("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote load)) ((free-id=?1814 x2282 (quote
#(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))
#(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top))
#("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote
eval-when) (quote "invalid situation") e2276 (wrap1819 x2282 w2278 (quote
#f)))))) situations2281)))))) (f2279 when-list2277 (quote ())))))
(chi-install-global1823 (lambda (name2283 e2284) (build-global-definition1766
(quote #f) name2283 (if (let ((v2285 (module-variable (current-module)
name2283))) (and v2285 (variable-bound? v2285) (macro? (variable-ref v2285))
(not (eq? (macro-type (variable-ref v2285)) (quote syncase-macro)))))
(build-application1759 (quote #f) (build-primref1768 (quote #f) (quote
make-extended-syncase-macro)) (list (build-application1759 (quote #f)
(build-primref1768 (quote #f) (quote module-ref)) (list (build-application1759
(quote #f) (quote current-module) (quote ())) (build-data1769 (quote #f)
name2283))) (build-data1769 (quote #f) (quote macro)) e2284))
(build-application1759 (quote #f) (build-primref1768 (quote #f) (quote
make-syncase-macro)) (list (build-data1769 (quote #f) (quote macro))
e2284)))))) (chi-top-sequence1822 (lambda (body2286 r2287 w2288 s2289 m2290
esew2291 mod2292) (build-sequence1770 s2289 (letrec ((dobody2293 (lambda
(body2294 r2295 w2296 m2297 esew2298 mod2299) (if (null? body2294) (quote ())
(let ((first2300 (chi-top1826 (car body2294) r2295 w2296 m2297 esew2298
mod2299))) (cons first2300 (dobody2293 (cdr body2294) r2295 w2296 m2297
esew2298 mod2299))))))) (dobody2293 body2286 r2287 w2288 m2290 esew2291
mod2292))))) (chi-sequence1821 (lambda (body2301 r2302 w2303 s2304 mod2305)
(build-sequence1770 s2304 (letrec ((dobody2306 (lambda (body2307 r2308 w2309
mod2310) (if (null? body2307) (quote ()) (let ((first2311 (chi1827 (car
body2307) r2308 w2309 mod2310))) (cons first2311 (dobody2306 (cdr body2307)
r2308 w2309 mod2310))))))) (dobody2306 body2301 r2302 w2303 mod2305)))))
(source-wrap1820 (lambda (x2312 w2313 s2314 defmod2315) (wrap1819 (if s2314
(make-annotation x2312 s2314 (quote #f)) x2312) w2313 defmod2315))) (wrap1819
(lambda (x2316 w2317 defmod2318) (cond ((and (null? (wrap-marks1794 w2317))
(null? (wrap-subst1795 w2317))) x2316) ((syntax-object?1775 x2316)
(make-syntax-object1774 (syntax-object-expression1776 x2316) (join-wraps1810
w2317 (syntax-object-wrap1777 x2316)) (syntax-object-module1778 x2316)))
((null? x2316) x2316) (else (make-syntax-object1774 x2316 w2317 defmod2318)))))
(bound-id-member?1818 (lambda (x2319 list2320) (and (not (null? list2320)) (or
(bound-id=?1815 x2319 (car list2320)) (bound-id-member?1818 x2319 (cdr
list2320)))))) (distinct-bound-ids?1817 (lambda (ids2321) (letrec
((distinct?2322 (lambda (ids2323) (or (null? ids2323) (and (not
(bound-id-member?1818 (car ids2323) (cdr ids2323))) (distinct?2322 (cdr
ids2323))))))) (distinct?2322 ids2321)))) (valid-bound-ids?1816 (lambda
(ids2324) (and (letrec ((all-ids?2325 (lambda (ids2326) (or (null? ids2326)
(and (id?1791 (car ids2326)) (all-ids?2325 (cdr ids2326))))))) (all-ids?2325
ids2324)) (distinct-bound-ids?1817 ids2324)))) (bound-id=?1815 (lambda (i2327
j2328) (if (and (syntax-object?1775 i2327) (syntax-object?1775 j2328)) (and
(eq? (let ((e2329 (syntax-object-expression1776 i2327))) (if (annotation?
e2329) (annotation-expression e2329) e2329)) (let ((e2330
(syntax-object-expression1776 j2328))) (if (annotation? e2330)
(annotation-expression e2330) e2330))) (same-marks?1812 (wrap-marks1794
(syntax-object-wrap1777 i2327)) (wrap-marks1794 (syntax-object-wrap1777
j2328)))) (eq? (let ((e2331 i2327)) (if (annotation? e2331)
(annotation-expression e2331) e2331)) (let ((e2332 j2328)) (if (annotation?
e2332) (annotation-expression e2332) e2332)))))) (free-id=?1814 (lambda (i2333
j2334) (and (eq? (let ((x2335 i2333)) (let ((e2336 (if (syntax-object?1775
x2335) (syntax-object-expression1776 x2335) x2335))) (if (annotation? e2336)
(annotation-expression e2336) e2336))) (let ((x2337 j2334)) (let ((e2338 (if
(syntax-object?1775 x2337) (syntax-object-expression1776 x2337) x2337))) (if
(annotation? e2338) (annotation-expression e2338) e2338)))) (eq?
(id-var-name1813 i2333 (quote (()))) (id-var-name1813 j2334 (quote (())))))))
(id-var-name1813 (lambda (id2339 w2340) (letrec ((search-vector-rib2343 (lambda
(sym2349 subst2350 marks2351 symnames2352 ribcage2353) (let ((n2354
(vector-length symnames2352))) (letrec ((f2355 (lambda (i2356) (cond ((fx=1753
i2356 n2354) (search2341 sym2349 (cdr subst2350) marks2351)) ((and (eq?
(vector-ref symnames2352 i2356) sym2349) (same-marks?1812 marks2351 (vector-ref
(ribcage-marks1801 ribcage2353) i2356))) (values (vector-ref
(ribcage-labels1802 ribcage2353) i2356) marks2351)) (else (f2355 (fx+1751 i2356
(quote 1)))))))) (f2355 (quote 0)))))) (search-list-rib2342 (lambda (sym2357
subst2358 marks2359 symnames2360 ribcage2361) (letrec ((f2362 (lambda
(symnames2363 i2364) (cond ((null? symnames2363) (search2341 sym2357 (cdr
subst2358) marks2359)) ((and (eq? (car symnames2363) sym2357) (same-marks?1812
marks2359 (list-ref (ribcage-marks1801 ribcage2361) i2364))) (values (list-ref
(ribcage-labels1802 ribcage2361) i2364) marks2359)) (else (f2362 (cdr
symnames2363) (fx+1751 i2364 (quote 1)))))))) (f2362 symnames2360 (quote 0)))))
(search2341 (lambda (sym2365 subst2366 marks2367) (if (null? subst2366) (values
(quote #f) marks2367) (let ((fst2368 (car subst2366))) (if (eq? fst2368 (quote
shift)) (search2341 sym2365 (cdr subst2366) (cdr marks2367)) (let
((symnames2369 (ribcage-symnames1800 fst2368))) (if (vector? symnames2369)
(search-vector-rib2343 sym2365 subst2366 marks2367 symnames2369 fst2368)
(search-list-rib2342 sym2365 subst2366 marks2367 symnames2369 fst2368)))))))))
(cond ((symbol? id2339) (or (call-with-values (lambda () (search2341 id2339
(wrap-subst1795 w2340) (wrap-marks1794 w2340))) (lambda (x2371 . ignore2370)
x2371)) id2339)) ((syntax-object?1775 id2339) (let ((id2372 (let ((e2374
(syntax-object-expression1776 id2339))) (if (annotation? e2374)
(annotation-expression e2374) e2374))) (w12373 (syntax-object-wrap1777
id2339))) (let ((marks2375 (join-marks1811 (wrap-marks1794 w2340)
(wrap-marks1794 w12373)))) (call-with-values (lambda () (search2341 id2372
(wrap-subst1795 w2340) marks2375)) (lambda (new-id2376 marks2377) (or
new-id2376 (call-with-values (lambda () (search2341 id2372 (wrap-subst1795
w12373) marks2377)) (lambda (x2379 . ignore2378) x2379)) id2372))))))
((annotation? id2339) (let ((id2380 (let ((e2381 id2339)) (if (annotation?
e2381) (annotation-expression e2381) e2381)))) (or (call-with-values (lambda ()
(search2341 id2380 (wrap-subst1795 w2340) (wrap-marks1794 w2340))) (lambda
(x2383 . ignore2382) x2383)) id2380))) (else (syntax-violation (quote
id-var-name) (quote "invalid id") id2339)))))) (same-marks?1812 (lambda (x2384
y2385) (or (eq? x2384 y2385) (and (not (null? x2384)) (not (null? y2385)) (eq?
(car x2384) (car y2385)) (same-marks?1812 (cdr x2384) (cdr y2385))))))
(join-marks1811 (lambda (m12386 m22387) (smart-append1809 m12386 m22387)))
(join-wraps1810 (lambda (w12388 w22389) (let ((m12390 (wrap-marks1794 w12388))
(s12391 (wrap-subst1795 w12388))) (if (null? m12390) (if (null? s12391) w22389
(make-wrap1793 (wrap-marks1794 w22389) (smart-append1809 s12391 (wrap-subst1795
w22389)))) (make-wrap1793 (smart-append1809 m12390 (wrap-marks1794 w22389))
(smart-append1809 s12391 (wrap-subst1795 w22389))))))) (smart-append1809
(lambda (m12392 m22393) (if (null? m22393) m12392 (append m12392 m22393))))
(make-binding-wrap1808 (lambda (ids2394 labels2395 w2396) (if (null? ids2394)
w2396 (make-wrap1793 (wrap-marks1794 w2396) (cons (let ((labelvec2397
(list->vector labels2395))) (let ((n2398 (vector-length labelvec2397))) (let
((symnamevec2399 (make-vector n2398)) (marksvec2400 (make-vector n2398)))
(begin (letrec ((f2401 (lambda (ids2402 i2403) (if (not (null? ids2402))
(call-with-values (lambda () (id-sym-name&marks1792 (car ids2402) w2396))
(lambda (symname2404 marks2405) (begin (vector-set! symnamevec2399 i2403
symname2404) (vector-set! marksvec2400 i2403 marks2405) (f2401 (cdr ids2402)
(fx+1751 i2403 (quote 1)))))))))) (f2401 ids2394 (quote 0))) (make-ribcage1798
symnamevec2399 marksvec2400 labelvec2397))))) (wrap-subst1795 w2396))))))
(extend-ribcage!1807 (lambda (ribcage2406 id2407 label2408) (begin
(set-ribcage-symnames!1803 ribcage2406 (cons (let ((e2409
(syntax-object-expression1776 id2407))) (if (annotation? e2409)
(annotation-expression e2409) e2409)) (ribcage-symnames1800 ribcage2406)))
(set-ribcage-marks!1804 ribcage2406 (cons (wrap-marks1794
(syntax-object-wrap1777 id2407)) (ribcage-marks1801 ribcage2406)))
(set-ribcage-labels!1805 ribcage2406 (cons label2408 (ribcage-labels1802
ribcage2406)))))) (anti-mark1806 (lambda (w2410) (make-wrap1793 (cons (quote
#f) (wrap-marks1794 w2410)) (cons (quote shift) (wrap-subst1795 w2410)))))
(set-ribcage-labels!1805 (lambda (x2411 update2412) (vector-set! x2411 (quote
3) update2412))) (set-ribcage-marks!1804 (lambda (x2413 update2414)
(vector-set! x2413 (quote 2) update2414))) (set-ribcage-symnames!1803 (lambda
(x2415 update2416) (vector-set! x2415 (quote 1) update2416)))
(ribcage-labels1802 (lambda (x2417) (vector-ref x2417 (quote 3))))
(ribcage-marks1801 (lambda (x2418) (vector-ref x2418 (quote 2))))
(ribcage-symnames1800 (lambda (x2419) (vector-ref x2419 (quote 1))))
(ribcage?1799 (lambda (x2420) (and (vector? x2420) (= (vector-length x2420)
(quote 4)) (eq? (vector-ref x2420 (quote 0)) (quote ribcage)))))
(make-ribcage1798 (lambda (symnames2421 marks2422 labels2423) (vector (quote
ribcage) symnames2421 marks2422 labels2423))) (gen-labels1797 (lambda (ls2424)
(if (null? ls2424) (quote ()) (cons (gen-label1796) (gen-labels1797 (cdr
ls2424)))))) (gen-label1796 (lambda () (string (quote #\i)))) (wrap-subst1795
cdr) (wrap-marks1794 car) (make-wrap1793 cons) (id-sym-name&marks1792 (lambda
(x2425 w2426) (if (syntax-object?1775 x2425) (values (let ((e2427
(syntax-object-expression1776 x2425))) (if (annotation? e2427)
(annotation-expression e2427) e2427)) (join-marks1811 (wrap-marks1794 w2426)
(wrap-marks1794 (syntax-object-wrap1777 x2425)))) (values (let ((e2428 x2425))
(if (annotation? e2428) (annotation-expression e2428) e2428)) (wrap-marks1794
w2426))))) (id?1791 (lambda (x2429) (cond ((symbol? x2429) (quote #t))
((syntax-object?1775 x2429) (symbol? (let ((e2430 (syntax-object-expression1776
x2429))) (if (annotation? e2430) (annotation-expression e2430) e2430))))
((annotation? x2429) (symbol? (annotation-expression x2429))) (else (quote
#f))))) (nonsymbol-id?1790 (lambda (x2431) (and (syntax-object?1775 x2431)
(symbol? (let ((e2432 (syntax-object-expression1776 x2431))) (if (annotation?
e2432) (annotation-expression e2432) e2432)))))) (global-extend1789 (lambda
(type2433 sym2434 val2435) (put-global-definition-hook1757 sym2434 type2433
val2435))) (lookup1788 (lambda (x2436 r2437 mod2438) (cond ((assq x2436 r2437)
=> cdr) ((symbol? x2436) (or (get-global-definition-hook1758 x2436 mod2438)
(quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1787
(lambda (r2439) (if (null? r2439) (quote ()) (let ((a2440 (car r2439))) (if
(eq? (cadr a2440) (quote macro)) (cons a2440 (macros-only-env1787 (cdr r2439)))
(macros-only-env1787 (cdr r2439))))))) (extend-var-env1786 (lambda (labels2441
vars2442 r2443) (if (null? labels2441) r2443 (extend-var-env1786 (cdr
labels2441) (cdr vars2442) (cons (cons (car labels2441) (cons (quote lexical)
(car vars2442))) r2443))))) (extend-env1785 (lambda (labels2444 bindings2445
r2446) (if (null? labels2444) r2446 (extend-env1785 (cdr labels2444) (cdr
bindings2445) (cons (cons (car labels2444) (car bindings2445)) r2446)))))
(binding-value1784 cdr) (binding-type1783 car) (source-annotation1782 (lambda
(x2447) (cond ((annotation? x2447) (annotation-source x2447))
((syntax-object?1775 x2447) (source-annotation1782
(syntax-object-expression1776 x2447))) (else (quote #f)))))
(set-syntax-object-module!1781 (lambda (x2448 update2449) (vector-set! x2448
(quote 3) update2449))) (set-syntax-object-wrap!1780 (lambda (x2450 update2451)
(vector-set! x2450 (quote 2) update2451))) (set-syntax-object-expression!1779
(lambda (x2452 update2453) (vector-set! x2452 (quote 1) update2453)))
(syntax-object-module1778 (lambda (x2454) (vector-ref x2454 (quote 3))))
(syntax-object-wrap1777 (lambda (x2455) (vector-ref x2455 (quote 2))))
(syntax-object-expression1776 (lambda (x2456) (vector-ref x2456 (quote 1))))
(syntax-object?1775 (lambda (x2457) (and (vector? x2457) (= (vector-length
x2457) (quote 4)) (eq? (vector-ref x2457 (quote 0)) (quote syntax-object)))))
(make-syntax-object1774 (lambda (expression2458 wrap2459 module2460) (vector
(quote syntax-object) expression2458 wrap2459 module2460))) (build-letrec1773
(lambda (src2461 vars2462 val-exps2463 body-exp2464) (if (null? vars2462)
body-exp2464 (let ((t2465 (fluid-ref *mode*1750))) (if (memv t2465 (quote (c)))
((@ (language tree-il) make-letrec) src2461 vars2462 val-exps2463 body-exp2464)
(list (quote letrec) (map list vars2462 val-exps2463) body-exp2464))))))
(build-named-let1772 (lambda (src2466 vars2467 val-exps2468 body-exp2469) (let
((f2470 (car vars2467)) (vars2471 (cdr vars2467))) (let ((t2472 (fluid-ref
*mode*1750))) (if (memv t2472 (quote (c))) ((@ (language tree-il) make-letrec)
src2466 (list f2470) (list (build-lambda1767 src2466 vars2471 (quote #f)
body-exp2469)) (build-application1759 src2466 (build-lexical-reference1761
(quote fun) src2466 f2470 f2470) val-exps2468)) (list (quote let) f2470 (map
list vars2471 val-exps2468) body-exp2469)))))) (build-let1771 (lambda (src2473
vars2474 val-exps2475 body-exp2476) (if (null? vars2474) body-exp2476 (let
((t2477 (fluid-ref *mode*1750))) (if (memv t2477 (quote (c))) ((@ (language
tree-il) make-let) src2473 vars2474 val-exps2475 body-exp2476) (list (quote
let) (map list vars2474 val-exps2475) body-exp2476)))))) (build-sequence1770
(lambda (src2478 exps2479) (if (null? (cdr exps2479)) (car exps2479) (let
((t2480 (fluid-ref *mode*1750))) (if (memv t2480 (quote (c))) ((@ (language
tree-il) make-sequence) src2478 exps2479) (cons (quote begin) exps2479))))))
(build-data1769 (lambda (src2481 exp2482) (let ((t2483 (fluid-ref *mode*1750)))
(if (memv t2483 (quote (c))) ((@ (language tree-il) make-const) src2481
exp2482) (if (and (self-evaluating? exp2482) (not (vector? exp2482))) exp2482
(list (quote quote) exp2482)))))) (build-primref1768 (lambda (src2484 name2485)
(let ((t2486 (fluid-ref *mode*1750))) (if (memv t2486 (quote (c))) ((@
(language tree-il) make-primitive-ref) src2484 name2485)
(build-global-reference1764 src2484 name2485 (quote (hygiene guile)))))))
(build-lambda1767 (lambda (src2487 vars2488 docstring2489 exp2490) (let ((t2491
(fluid-ref *mode*1750))) (if (memv t2491 (quote (c))) ((@ (language tree-il)
make-lambda) src2487 vars2488 (if docstring2489 (list (cons (quote
documentation) docstring2489)) (quote ())) exp2490) (cons (quote lambda) (cons
vars2488 (append (if docstring2489 (list docstring2489) (quote ())) (list
exp2490)))))))) (build-global-definition1766 (lambda (source2492 var2493
exp2494) (let ((t2495 (fluid-ref *mode*1750))) (if (memv t2495 (quote (c))) ((@
(language tree-il) make-toplevel-define) source2492 var2493 exp2494) (list
(quote define) var2493 exp2494))))) (build-global-assignment1765 (lambda
(source2496 var2497 exp2498 mod2499) (analyze-variable1763 mod2499 var2497
(lambda (mod2500 var2501 public?2502) (let ((t2503 (fluid-ref *mode*1750))) (if
(memv t2503 (quote (c))) ((@ (language tree-il) make-module-set) source2496
mod2500 var2501 public?2502 exp2498) (list (quote set!) (list (if public?2502
(quote @) (quote @@)) mod2500 var2501) exp2498)))) (lambda (var2504) (let
((t2505 (fluid-ref *mode*1750))) (if (memv t2505 (quote (c))) ((@ (language
tree-il) make-toplevel-set) source2496 var2504 exp2498) (list (quote set!)
var2504 exp2498))))))) (build-global-reference1764 (lambda (source2506 var2507
mod2508) (analyze-variable1763 mod2508 var2507 (lambda (mod2509 var2510
public?2511) (let ((t2512 (fluid-ref *mode*1750))) (if (memv t2512 (quote (c)))
((@ (language tree-il) make-module-ref) source2506 mod2509 var2510 public?2511)
(list (if public?2511 (quote @) (quote @@)) mod2509 var2510)))) (lambda
(var2513) (let ((t2514 (fluid-ref *mode*1750))) (if (memv t2514 (quote (c)))
((@ (language tree-il) make-toplevel-ref) source2506 var2513) var2513))))))
(analyze-variable1763 (lambda (mod2515 var2516 modref-cont2517 bare-cont2518)
(if (not mod2515) (bare-cont2518 var2516) (let ((kind2519 (car mod2515))
(mod2520 (cdr mod2515))) (let ((t2521 kind2519)) (if (memv t2521 (quote
(public))) (modref-cont2517 mod2520 var2516 (quote #t)) (if (memv t2521 (quote
(private))) (if (not (equal? mod2520 (module-name (current-module))))
(modref-cont2517 mod2520 var2516 (quote #f)) (bare-cont2518 var2516)) (if (memv
t2521 (quote (bare))) (bare-cont2518 var2516) (if (memv t2521 (quote
(hygiene))) (if (and (not (equal? mod2520 (module-name (current-module))))
(module-variable (resolve-module mod2520) var2516)) (modref-cont2517 mod2520
var2516 (quote #f)) (bare-cont2518 var2516)) (syntax-violation (quote #f)
(quote "bad module kind") var2516 mod2520))))))))))
(build-lexical-assignment1762 (lambda (source2522 name2523 var2524 exp2525)
(let ((t2526 (fluid-ref *mode*1750))) (if (memv t2526 (quote (c))) ((@
(language tree-il) make-lexical-set) source2522 name2523 var2524 exp2525) (list
(quote set!) var2524 exp2525))))) (build-lexical-reference1761 (lambda
(type2527 source2528 name2529 var2530) (let ((t2531 (fluid-ref *mode*1750)))
(if (memv t2531 (quote (c))) ((@ (language tree-il) make-lexical-ref)
source2528 name2529 var2530) var2530)))) (build-conditional1760 (lambda
(source2532 test-exp2533 then-exp2534 else-exp2535) (let ((t2536 (fluid-ref
*mode*1750))) (if (memv t2536 (quote (c))) ((@ (language tree-il)
make-conditional) source2532 test-exp2533 then-exp2534 else-exp2535) (list
(quote if) test-exp2533 then-exp2534 else-exp2535))))) (build-application1759
(lambda (source2537 fun-exp2538 arg-exps2539) (let ((t2540 (fluid-ref
*mode*1750))) (if (memv t2540 (quote (c))) ((@ (language tree-il)
make-application) source2537 fun-exp2538 arg-exps2539) (cons fun-exp2538
arg-exps2539))))) (get-global-definition-hook1758 (lambda (symbol2541
module2542) (begin (if (and (not module2542) (current-module)) (warn (quote
"module system is booted, we should have a module") symbol2541)) (let ((v2543
(module-variable (if module2542 (resolve-module (cdr module2542))
(current-module)) symbol2541))) (and v2543 (variable-bound? v2543) (let
((val2544 (variable-ref v2543))) (and (macro? val2544) (syncase-macro-type
val2544) (cons (syncase-macro-type val2544) (syncase-macro-binding
val2544))))))))) (put-global-definition-hook1757 (lambda (symbol2545 type2546
val2547) (let ((existing2548 (let ((v2549 (module-variable (current-module)
symbol2545))) (and v2549 (variable-bound? v2549) (let ((val2550 (variable-ref
v2549))) (and (macro? val2550) (not (syncase-macro-type val2550)) val2550))))))
(module-define! (current-module) symbol2545 (if existing2548
(make-extended-syncase-macro existing2548 type2546 val2547) (make-syncase-macro
type2546 val2547)))))) (local-eval-hook1756 (lambda (x2551 mod2552)
(primitive-eval (list noexpand1749 (let ((t2553 (fluid-ref *mode*1750))) (if
(memv t2553 (quote (c))) ((@ (language tree-il) tree-il->scheme) x2551)
x2551)))))) (top-level-eval-hook1755 (lambda (x2554 mod2555) (primitive-eval
(list noexpand1749 (let ((t2556 (fluid-ref *mode*1750))) (if (memv t2556 (quote
(c))) ((@ (language tree-il) tree-il->scheme) x2554) x2554)))))) (fx<1754 <)
(fx=1753 =) (fx-1752 -) (fx+1751 +) (*mode*1750 (make-fluid)) (noexpand1749
(quote "noexpand"))) (begin (global-extend1789 (quote local-syntax) (quote
letrec-syntax) (quote #t)) (global-extend1789 (quote local-syntax) (quote
let-syntax) (quote #f)) (global-extend1789 (quote core) (quote
fluid-let-syntax) (lambda (e2557 r2558 w2559 s2560 mod2561) ((lambda (tmp2562)
((lambda (tmp2563) (if (if tmp2563 (apply (lambda (_2564 var2565 val2566 e12567
e22568) (valid-bound-ids?1816 var2565)) tmp2563) (quote #f)) (apply (lambda
(_2570 var2571 val2572 e12573 e22574) (let ((names2575 (map (lambda (x2576)
(id-var-name1813 x2576 w2559)) var2571))) (begin (for-each (lambda (id2578
n2579) (let ((t2580 (binding-type1783 (lookup1788 n2579 r2558 mod2561)))) (if
(memv t2580 (quote (displaced-lexical))) (syntax-violation (quote
fluid-let-syntax) (quote "identifier out of context") e2557 (source-wrap1820
id2578 w2559 s2560 mod2561))))) var2571 names2575) (chi-body1831 (cons e12573
e22574) (source-wrap1820 e2557 w2559 s2560 mod2561) (extend-env1785 names2575
(let ((trans-r2583 (macros-only-env1787 r2558))) (map (lambda (x2584) (cons
(quote macro) (eval-local-transformer1834 (chi1827 x2584 trans-r2583 w2559
mod2561) mod2561))) val2572)) r2558) w2559 mod2561)))) tmp2563) ((lambda
(_2586) (syntax-violation (quote fluid-let-syntax) (quote "bad syntax")
(source-wrap1820 e2557 w2559 s2560 mod2561))) tmp2562))) ($sc-dispatch tmp2562
(quote (any #(each (any any)) any . each-any))))) e2557))) (global-extend1789
(quote core) (quote quote) (lambda (e2587 r2588 w2589 s2590 mod2591) ((lambda
(tmp2592) ((lambda (tmp2593) (if tmp2593 (apply (lambda (_2594 e2595)
(build-data1769 s2590 (strip1838 e2595 w2589))) tmp2593) ((lambda (_2596)
(syntax-violation (quote quote) (quote "bad syntax") (source-wrap1820 e2587
w2589 s2590 mod2591))) tmp2592))) ($sc-dispatch tmp2592 (quote (any any)))))
e2587))) (global-extend1789 (quote core) (quote syntax) (letrec ((regen2604
(lambda (x2605) (let ((t2606 (car x2605))) (if (memv t2606 (quote (ref)))
(build-lexical-reference1761 (quote value) (quote #f) (cadr x2605) (cadr
x2605)) (if (memv t2606 (quote (primitive))) (build-primref1768 (quote #f)
(cadr x2605)) (if (memv t2606 (quote (quote))) (build-data1769 (quote #f) (cadr
x2605)) (if (memv t2606 (quote (lambda))) (build-lambda1767 (quote #f) (cadr
x2605) (quote #f) (regen2604 (caddr x2605))) (if (memv t2606 (quote (map)))
(let ((ls2607 (map regen2604 (cdr x2605)))) (build-application1759 (quote #f)
(build-primref1768 (quote #f) (quote map)) ls2607)) (build-application1759
(quote #f) (build-primref1768 (quote #f) (car x2605)) (map regen2604 (cdr
x2605))))))))))) (gen-vector2603 (lambda (x2608) (cond ((eq? (car x2608) (quote
list)) (cons (quote vector) (cdr x2608))) ((eq? (car x2608) (quote quote))
(list (quote quote) (list->vector (cadr x2608)))) (else (list (quote
list->vector) x2608))))) (gen-append2602 (lambda (x2609 y2610) (if (equal?
y2610 (quote (quote ()))) x2609 (list (quote append) x2609 y2610))))
(gen-cons2601 (lambda (x2611 y2612) (let ((t2613 (car y2612))) (if (memv t2613
(quote (quote))) (if (eq? (car x2611) (quote quote)) (list (quote quote) (cons
(cadr x2611) (cadr y2612))) (if (eq? (cadr y2612) (quote ())) (list (quote
list) x2611) (list (quote cons) x2611 y2612))) (if (memv t2613 (quote (list)))
(cons (quote list) (cons x2611 (cdr y2612))) (list (quote cons) x2611
y2612)))))) (gen-map2600 (lambda (e2614 map-env2615) (let ((formals2616 (map
cdr map-env2615)) (actuals2617 (map (lambda (x2618) (list (quote ref) (car
x2618))) map-env2615))) (cond ((eq? (car e2614) (quote ref)) (car actuals2617))
((and-map (lambda (x2619) (and (eq? (car x2619) (quote ref)) (memq (cadr x2619)
formals2616))) (cdr e2614)) (cons (quote map) (cons (list (quote primitive)
(car e2614)) (map (let ((r2620 (map cons formals2616 actuals2617))) (lambda
(x2621) (cdr (assq (cadr x2621) r2620)))) (cdr e2614))))) (else (cons (quote
map) (cons (list (quote lambda) formals2616 e2614) actuals2617)))))))
(gen-mappend2599 (lambda (e2622 map-env2623) (list (quote apply) (quote
(primitive append)) (gen-map2600 e2622 map-env2623)))) (gen-ref2598 (lambda
(src2624 var2625 level2626 maps2627) (if (fx=1753 level2626 (quote 0)) (values
var2625 maps2627) (if (null? maps2627) (syntax-violation (quote syntax) (quote
"missing ellipsis") src2624) (call-with-values (lambda () (gen-ref2598 src2624
var2625 (fx-1752 level2626 (quote 1)) (cdr maps2627))) (lambda (outer-var2628
outer-maps2629) (let ((b2630 (assq outer-var2628 (car maps2627)))) (if b2630
(values (cdr b2630) maps2627) (let ((inner-var2631 (gen-var1839 (quote tmp))))
(values inner-var2631 (cons (cons (cons outer-var2628 inner-var2631) (car
maps2627)) outer-maps2629))))))))))) (gen-syntax2597 (lambda (src2632 e2633
r2634 maps2635 ellipsis?2636 mod2637) (if (id?1791 e2633) (let ((label2638
(id-var-name1813 e2633 (quote (()))))) (let ((b2639 (lookup1788 label2638 r2634
mod2637))) (if (eq? (binding-type1783 b2639) (quote syntax)) (call-with-values
(lambda () (let ((var.lev2640 (binding-value1784 b2639))) (gen-ref2598 src2632
(car var.lev2640) (cdr var.lev2640) maps2635))) (lambda (var2641 maps2642)
(values (list (quote ref) var2641) maps2642))) (if (ellipsis?2636 e2633)
(syntax-violation (quote syntax) (quote "misplaced ellipsis") src2632) (values
(list (quote quote) e2633) maps2635))))) ((lambda (tmp2643) ((lambda (tmp2644)
(if (if tmp2644 (apply (lambda (dots2645 e2646) (ellipsis?2636 dots2645))
tmp2644) (quote #f)) (apply (lambda (dots2647 e2648) (gen-syntax2597 src2632
e2648 r2634 maps2635 (lambda (x2649) (quote #f)) mod2637)) tmp2644) ((lambda
(tmp2650) (if (if tmp2650 (apply (lambda (x2651 dots2652 y2653) (ellipsis?2636
dots2652)) tmp2650) (quote #f)) (apply (lambda (x2654 dots2655 y2656) (letrec
((f2657 (lambda (y2658 k2659) ((lambda (tmp2663) ((lambda (tmp2664) (if (if
tmp2664 (apply (lambda (dots2665 y2666) (ellipsis?2636 dots2665)) tmp2664)
(quote #f)) (apply (lambda (dots2667 y2668) (f2657 y2668 (lambda (maps2669)
(call-with-values (lambda () (k2659 (cons (quote ()) maps2669))) (lambda (x2670
maps2671) (if (null? (car maps2671)) (syntax-violation (quote syntax) (quote
"extra ellipsis") src2632) (values (gen-mappend2599 x2670 (car maps2671)) (cdr
maps2671)))))))) tmp2664) ((lambda (_2672) (call-with-values (lambda ()
(gen-syntax2597 src2632 y2658 r2634 maps2635 ellipsis?2636 mod2637)) (lambda
(y2673 maps2674) (call-with-values (lambda () (k2659 maps2674)) (lambda (x2675
maps2676) (values (gen-append2602 x2675 y2673) maps2676)))))) tmp2663)))
($sc-dispatch tmp2663 (quote (any . any))))) y2658)))) (f2657 y2656 (lambda
(maps2660) (call-with-values (lambda () (gen-syntax2597 src2632 x2654 r2634
(cons (quote ()) maps2660) ellipsis?2636 mod2637)) (lambda (x2661 maps2662) (if
(null? (car maps2662)) (syntax-violation (quote syntax) (quote "extra
ellipsis") src2632) (values (gen-map2600 x2661 (car maps2662)) (cdr
maps2662))))))))) tmp2650) ((lambda (tmp2677) (if tmp2677 (apply (lambda (x2678
y2679) (call-with-values (lambda () (gen-syntax2597 src2632 x2678 r2634
maps2635 ellipsis?2636 mod2637)) (lambda (x2680 maps2681) (call-with-values
(lambda () (gen-syntax2597 src2632 y2679 r2634 maps2681 ellipsis?2636 mod2637))
(lambda (y2682 maps2683) (values (gen-cons2601 x2680 y2682) maps2683))))))
tmp2677) ((lambda (tmp2684) (if tmp2684 (apply (lambda (e12685 e22686)
(call-with-values (lambda () (gen-syntax2597 src2632 (cons e12685 e22686) r2634
maps2635 ellipsis?2636 mod2637)) (lambda (e2688 maps2689) (values
(gen-vector2603 e2688) maps2689)))) tmp2684) ((lambda (_2690) (values (list
(quote quote) e2633) maps2635)) tmp2643))) ($sc-dispatch tmp2643 (quote
#(vector (any . each-any))))))) ($sc-dispatch tmp2643 (quote (any . any))))))
($sc-dispatch tmp2643 (quote (any any . any)))))) ($sc-dispatch tmp2643 (quote
(any any))))) e2633))))) (lambda (e2691 r2692 w2693 s2694 mod2695) (let ((e2696
(source-wrap1820 e2691 w2693 s2694 mod2695))) ((lambda (tmp2697) ((lambda
(tmp2698) (if tmp2698 (apply (lambda (_2699 x2700) (call-with-values (lambda ()
(gen-syntax2597 e2696 x2700 r2692 (quote ()) ellipsis?1836 mod2695)) (lambda
(e2701 maps2702) (regen2604 e2701)))) tmp2698) ((lambda (_2703)
(syntax-violation (quote syntax) (quote "bad `syntax' form") e2696)) tmp2697)))
($sc-dispatch tmp2697 (quote (any any))))) e2696))))) (global-extend1789 (quote
core) (quote lambda) (lambda (e2704 r2705 w2706 s2707 mod2708) ((lambda
(tmp2709) ((lambda (tmp2710) (if tmp2710 (apply (lambda (_2711 c2712)
(chi-lambda-clause1832 (source-wrap1820 e2704 w2706 s2707 mod2708) (quote #f)
c2712 r2705 w2706 mod2708 (lambda (vars2713 docstring2714 body2715)
(build-lambda1767 s2707 vars2713 docstring2714 body2715)))) tmp2710)
(syntax-violation #f "source expression failed to match any pattern" tmp2709)))
($sc-dispatch tmp2709 (quote (any . any))))) e2704))) (global-extend1789 (quote
core) (quote let) (letrec ((chi-let2716 (lambda (e2717 r2718 w2719 s2720
mod2721 constructor2722 ids2723 vals2724 exps2725) (if (not
(valid-bound-ids?1816 ids2723)) (syntax-violation (quote let) (quote "duplicate
bound variable") e2717) (let ((labels2726 (gen-labels1797 ids2723))
(new-vars2727 (map gen-var1839 ids2723))) (let ((nw2728 (make-binding-wrap1808
ids2723 labels2726 w2719)) (nr2729 (extend-var-env1786 labels2726 new-vars2727
r2718))) (constructor2722 s2720 new-vars2727 (map (lambda (x2730) (chi1827
x2730 r2718 w2719 mod2721)) vals2724) (chi-body1831 exps2725 (source-wrap1820
e2717 nw2728 s2720 mod2721) nr2729 nw2728 mod2721)))))))) (lambda (e2731 r2732
w2733 s2734 mod2735) ((lambda (tmp2736) ((lambda (tmp2737) (if tmp2737 (apply
(lambda (_2738 id2739 val2740 e12741 e22742) (chi-let2716 e2731 r2732 w2733
s2734 mod2735 build-let1771 id2739 val2740 (cons e12741 e22742))) tmp2737)
((lambda (tmp2746) (if (if tmp2746 (apply (lambda (_2747 f2748 id2749 val2750
e12751 e22752) (id?1791 f2748)) tmp2746) (quote #f)) (apply (lambda (_2753
f2754 id2755 val2756 e12757 e22758) (chi-let2716 e2731 r2732 w2733 s2734
mod2735 build-named-let1772 (cons f2754 id2755) val2756 (cons e12757 e22758)))
tmp2746) ((lambda (_2762) (syntax-violation (quote let) (quote "bad let")
(source-wrap1820 e2731 w2733 s2734 mod2735))) tmp2736))) ($sc-dispatch tmp2736
(quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2736
(quote (any #(each (any any)) any . each-any))))) e2731)))) (global-extend1789
(quote core) (quote letrec) (lambda (e2763 r2764 w2765 s2766 mod2767) ((lambda
(tmp2768) ((lambda (tmp2769) (if tmp2769 (apply (lambda (_2770 id2771 val2772
e12773 e22774) (let ((ids2775 id2771)) (if (not (valid-bound-ids?1816 ids2775))
(syntax-violation (quote letrec) (quote "duplicate bound variable") e2763) (let
((labels2777 (gen-labels1797 ids2775)) (new-vars2778 (map gen-var1839
ids2775))) (let ((w2779 (make-binding-wrap1808 ids2775 labels2777 w2765))
(r2780 (extend-var-env1786 labels2777 new-vars2778 r2764))) (build-letrec1773
s2766 new-vars2778 (map (lambda (x2781) (chi1827 x2781 r2780 w2779 mod2767))
val2772) (chi-body1831 (cons e12773 e22774) (source-wrap1820 e2763 w2779 s2766
mod2767) r2780 w2779 mod2767))))))) tmp2769) ((lambda (_2784) (syntax-violation
(quote letrec) (quote "bad letrec") (source-wrap1820 e2763 w2765 s2766
mod2767))) tmp2768))) ($sc-dispatch tmp2768 (quote (any #(each (any any)) any .
each-any))))) e2763))) (global-extend1789 (quote core) (quote set!) (lambda
(e2785 r2786 w2787 s2788 mod2789) ((lambda (tmp2790) ((lambda (tmp2791) (if (if
tmp2791 (apply (lambda (_2792 id2793 val2794) (id?1791 id2793)) tmp2791) (quote
#f)) (apply (lambda (_2795 id2796 val2797) (let ((val2798 (chi1827 val2797
r2786 w2787 mod2789)) (n2799 (id-var-name1813 id2796 w2787))) (let ((b2800
(lookup1788 n2799 r2786 mod2789))) (let ((t2801 (binding-type1783 b2800))) (if
(memv t2801 (quote (lexical))) (build-lexical-assignment1762 s2788
(syntax->datum id2796) (binding-value1784 b2800) val2798) (if (memv t2801
(quote (global))) (build-global-assignment1765 s2788 n2799 val2798 mod2789) (if
(memv t2801 (quote (displaced-lexical))) (syntax-violation (quote set!) (quote
"identifier out of context") (wrap1819 id2796 w2787 mod2789)) (syntax-violation
(quote set!) (quote "bad set!") (source-wrap1820 e2785 w2787 s2788
mod2789))))))))) tmp2791) ((lambda (tmp2802) (if tmp2802 (apply (lambda (_2803
head2804 tail2805 val2806) (call-with-values (lambda () (syntax-type1825
head2804 r2786 (quote (())) (quote #f) (quote #f) mod2789)) (lambda (type2807
value2808 ee2809 ww2810 ss2811 modmod2812) (let ((t2813 type2807)) (if (memv
t2813 (quote (module-ref))) (let ((val2814 (chi1827 val2806 r2786 w2787
mod2789))) (call-with-values (lambda () (value2808 (cons head2804 tail2805)))
(lambda (id2816 mod2817) (build-global-assignment1765 s2788 id2816 val2814
mod2817)))) (build-application1759 s2788 (chi1827 (list (quote #(syntax-object
setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage
() () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top)
(top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head
tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ())
#(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) head2804) r2786 w2787 mod2789) (map (lambda (e2818)
(chi1827 e2818 r2786 w2787 mod2789)) (append tail2805 (list val2806)))))))))
tmp2802) ((lambda (_2820) (syntax-violation (quote set!) (quote "bad set!")
(source-wrap1820 e2785 w2787 s2788 mod2789))) tmp2790))) ($sc-dispatch tmp2790
(quote (any (any . each-any) any)))))) ($sc-dispatch tmp2790 (quote (any any
any))))) e2785))) (global-extend1789 (quote module-ref) (quote @) (lambda
(e2821) ((lambda (tmp2822) ((lambda (tmp2823) (if (if tmp2823 (apply (lambda
(_2824 mod2825 id2826) (and (and-map id?1791 mod2825) (id?1791 id2826)))
tmp2823) (quote #f)) (apply (lambda (_2828 mod2829 id2830) (values
(syntax->datum id2830) (syntax->datum (cons (quote #(syntax-object public
((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) mod2829)))) tmp2823) (syntax-violation #f "source
expression failed to match any pattern" tmp2822))) ($sc-dispatch tmp2822 (quote
(any each-any any))))) e2821))) (global-extend1789 (quote module-ref) (quote
@@) (lambda (e2832) ((lambda (tmp2833) ((lambda (tmp2834) (if (if tmp2834
(apply (lambda (_2835 mod2836 id2837) (and (and-map id?1791 mod2836) (id?1791
id2837))) tmp2834) (quote #f)) (apply (lambda (_2839 mod2840 id2841) (values
(syntax->datum id2841) (syntax->datum (cons (quote #(syntax-object private
((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage ()
() ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip
strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax
chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top
syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence
source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids?
bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append
make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark
the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels!
set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks
ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename
rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks
make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup
macros-only-env extend-var-env extend-env null-env binding-value binding-type
make-binding arg-check source-annotation no-source unannotate
set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression!
syntax-object-module syntax-object-wrap syntax-object-expression syntax-object?
make-syntax-object build-lexical-var build-letrec build-named-let build-let
build-sequence build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) mod2840)))) tmp2834) (syntax-violation #f "source
expression failed to match any pattern" tmp2833))) ($sc-dispatch tmp2833 (quote
(any each-any any))))) e2832))) (global-extend1789 (quote begin) (quote begin)
(quote ())) (global-extend1789 (quote define) (quote define) (quote ()))
(global-extend1789 (quote define-syntax) (quote define-syntax) (quote ()))
(global-extend1789 (quote eval-when) (quote eval-when) (quote ()))
(global-extend1789 (quote core) (quote syntax-case) (letrec
((gen-syntax-case2846 (lambda (x2847 keys2848 clauses2849 r2850 mod2851) (if
(null? clauses2849) (build-application1759 (quote #f) (build-primref1768 (quote
#f) (quote syntax-violation)) (list (quote #f) (quote "source expression failed
to match any pattern") x2847)) ((lambda (tmp2852) ((lambda (tmp2853) (if
tmp2853 (apply (lambda (pat2854 exp2855) (if (and (id?1791 pat2854) (and-map
(lambda (x2856) (not (free-id=?1814 pat2854 x2856))) (cons (quote
#(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i"))
#(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top)
(top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause
build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i"
"i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis?
chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body
chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list
chi-install-global chi-top-sequence chi-sequence source-wrap wrap
bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=?
id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap
extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked?
top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks!
set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage?
make-ribcage gen-labels gen-label make-rename rename-marks rename-new
rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks
id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env
extend-var-env extend-env null-env binding-value binding-type make-binding
arg-check source-annotation no-source unannotate set-syntax-object-module!
set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module
syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object
build-lexical-var build-letrec build-named-let build-let build-sequence
build-data build-primref build-lambda build-global-definition
build-global-assignment build-global-reference analyze-variable
build-lexical-assignment build-lexical-reference build-conditional
build-application get-global-definition-hook put-global-definition-hook
gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode*
noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)
(top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i"
"i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i"
"i"))) (hygiene guile))) keys2848))) (let ((labels2857 (list (gen-label1796)))
(var2858 (gen-var1839 pat2854))) (build-application1759 (quote #f)
(build-lambda1767 (quote #f) (list var2858) (quote #f) (chi1827 exp2855
(extend-env1785 labels2857 (list (cons (quote syntax) (cons var2858 (quote
0)))) r2850) (make-binding-wrap1808 (list pat2854) labels2857 (quote (())))
mod2851)) (list x2847))) (gen-clause2845 x2847 keys2848 (cdr clauses2849) r2850
pat2854 (quote #t) exp2855 mod2851))) tmp2853) ((lambda (tmp2859) (if tmp2859
(apply (lambda (pat2860 fender2861 exp2862) (gen-clause2845 x2847 keys2848 (cdr
clauses2849) r2850 pat2860 fender2861 exp2862 mod2851)) tmp2859) ((lambda
(_2863) (syntax-violation (quote syntax-case) (quote "invalid clause") (car
clauses2849))) tmp2852))) ($sc-dispatch tmp2852 (quote (any any any))))))
($sc-dispatch tmp2852 (quote (any any))))) (car clauses2849)))))
(gen-clause2845 (lambda (x2864 keys2865 clauses2866 r2867 pat2868 fender2869
exp2870 mod2871) (call-with-values (lambda () (convert-pattern2843 pat2868
keys2865)) (lambda (p2872 pvars2873) (cond ((not (distinct-bound-ids?1817 (map
car pvars2873))) (syntax-violation (quote syntax-case) (quote "duplicate
pattern variable") pat2868)) ((not (and-map (lambda (x2874) (not (ellipsis?1836
(car x2874)))) pvars2873)) (syntax-violation (quote syntax-case) (quote
"misplaced ellipsis") pat2868)) (else (let ((y2875 (gen-var1839 (quote tmp))))
(build-application1759 (quote #f) (build-lambda1767 (quote #f) (list y2875)
(quote #f) (let ((y2876 (build-lexical-reference1761 (quote value) (quote #f)
(quote tmp) y2875))) (build-conditional1760 (quote #f) ((lambda (tmp2877)
((lambda (tmp2878) (if tmp2878 (apply (lambda () y2876) tmp2878) ((lambda
(_2879) (build-conditional1760 (quote #f) y2876 (build-dispatch-call2844
pvars2873 fender2869 y2876 r2867 mod2871) (build-data1769 (quote #f) (quote
#f)))) tmp2877))) ($sc-dispatch tmp2877 (quote #(atom #t))))) fender2869)
(build-dispatch-call2844 pvars2873 exp2870 y2876 r2867 mod2871)
(gen-syntax-case2846 x2864 keys2865 clauses2866 r2867 mod2871)))) (list (if
(eq? p2872 (quote any)) (build-application1759 (quote #f) (build-primref1768
(quote #f) (quote list)) (list x2864)) (build-application1759 (quote #f)
(build-primref1768 (quote #f) (quote $sc-dispatch)) (list x2864 (build-data1769
(quote #f) p2872))))))))))))) (build-dispatch-call2844 (lambda (pvars2880
exp2881 y2882 r2883 mod2884) (let ((ids2885 (map car pvars2880)) (levels2886
(map cdr pvars2880))) (let ((labels2887 (gen-labels1797 ids2885)) (new-vars2888
(map gen-var1839 ids2885))) (build-application1759 (quote #f)
(build-primref1768 (quote #f) (quote apply)) (list (build-lambda1767 (quote #f)
new-vars2888 (quote #f) (chi1827 exp2881 (extend-env1785 labels2887 (map
(lambda (var2889 level2890) (cons (quote syntax) (cons var2889 level2890)))
new-vars2888 (map cdr pvars2880)) r2883) (make-binding-wrap1808 ids2885
labels2887 (quote (()))) mod2884)) y2882)))))) (convert-pattern2843 (lambda
(pattern2891 keys2892) (letrec ((cvt2893 (lambda (p2894 n2895 ids2896) (if
(id?1791 p2894) (if (bound-id-member?1818 p2894 keys2892) (values (vector
(quote free-id) p2894) ids2896) (values (quote any) (cons (cons p2894 n2895)
ids2896))) ((lambda (tmp2897) ((lambda (tmp2898) (if (if tmp2898 (apply (lambda
(x2899 dots2900) (ellipsis?1836 dots2900)) tmp2898) (quote #f)) (apply (lambda
(x2901 dots2902) (call-with-values (lambda () (cvt2893 x2901 (fx+1751 n2895
(quote 1)) ids2896)) (lambda (p2903 ids2904) (values (if (eq? p2903 (quote
any)) (quote each-any) (vector (quote each) p2903)) ids2904)))) tmp2898)
((lambda (tmp2905) (if tmp2905 (apply (lambda (x2906 y2907) (call-with-values
(lambda () (cvt2893 y2907 n2895 ids2896)) (lambda (y2908 ids2909)
(call-with-values (lambda () (cvt2893 x2906 n2895 ids2909)) (lambda (x2910
ids2911) (values (cons x2910 y2908) ids2911)))))) tmp2905) ((lambda (tmp2912)
(if tmp2912 (apply (lambda () (values (quote ()) ids2896)) tmp2912) ((lambda
(tmp2913) (if tmp2913 (apply (lambda (x2914) (call-with-values (lambda ()
(cvt2893 x2914 n2895 ids2896)) (lambda (p2916 ids2917) (values (vector (quote
vector) p2916) ids2917)))) tmp2913) ((lambda (x2918) (values (vector (quote
atom) (strip1838 p2894 (quote (())))) ids2896)) tmp2897))) ($sc-dispatch
tmp2897 (quote #(vector each-any)))))) ($sc-dispatch tmp2897 (quote ())))))
($sc-dispatch tmp2897 (quote (any . any)))))) ($sc-dispatch tmp2897 (quote (any
any))))) p2894))))) (cvt2893 pattern2891 (quote 0) (quote ())))))) (lambda
(e2919 r2920 w2921 s2922 mod2923) (let ((e2924 (source-wrap1820 e2919 w2921
s2922 mod2923))) ((lambda (tmp2925) ((lambda (tmp2926) (if tmp2926 (apply
(lambda (_2927 val2928 key2929 m2930) (if (and-map (lambda (x2931) (and
(id?1791 x2931) (not (ellipsis?1836 x2931)))) key2929) (let ((x2933
(gen-var1839 (quote tmp)))) (build-application1759 s2922 (build-lambda1767
(quote #f) (list x2933) (quote #f) (gen-syntax-case2846
(build-lexical-reference1761 (quote value) (quote #f) (quote tmp) x2933)
key2929 m2930 r2920 mod2923)) (list (chi1827 val2928 r2920 (quote (()))
mod2923)))) (syntax-violation (quote syntax-case) (quote "invalid literals
list") e2924))) tmp2926) (syntax-violation #f "source expression failed to
match any pattern" tmp2925))) ($sc-dispatch tmp2925 (quote (any any each-any .
each-any))))) e2924))))) (set! sc-expand (lambda (x2937 . rest2936) (if (and
(pair? x2937) (equal? (car x2937) noexpand1749)) (cadr x2937) (let ((m2938 (if
(null? rest2936) (quote e) (car rest2936))) (esew2939 (if (or (null? rest2936)
(null? (cdr rest2936))) (quote (eval)) (cadr rest2936)))) (with-fluid*
*mode*1750 m2938 (lambda () (chi-top1826 x2937 (quote ()) (quote ((top))) m2938
esew2939 (cons (quote hygiene) (module-name (current-module)))))))))) (set!
identifier? (lambda (x2940) (nonsymbol-id?1790 x2940))) (set! datum->syntax
(lambda (id2941 datum2942) (make-syntax-object1774 datum2942
(syntax-object-wrap1777 id2941) (quote #f)))) (set! syntax->datum (lambda
(x2943) (strip1838 x2943 (quote (()))))) (set! generate-temporaries (lambda
(ls2944) (begin (let ((x2945 ls2944)) (if (not (list? x2945)) (syntax-violation
(quote generate-temporaries) (quote "invalid argument") x2945))) (map (lambda
(x2946) (wrap1819 (gensym) (quote ((top))) (quote #f))) ls2944)))) (set!
free-identifier=? (lambda (x2947 y2948) (begin (let ((x2949 x2947)) (if (not
(nonsymbol-id?1790 x2949)) (syntax-violation (quote free-identifier=?) (quote
"invalid argument") x2949))) (let ((x2950 y2948)) (if (not (nonsymbol-id?1790
x2950)) (syntax-violation (quote free-identifier=?) (quote "invalid argument")
x2950))) (free-id=?1814 x2947 y2948)))) (set! bound-identifier=? (lambda (x2951
y2952) (begin (let ((x2953 x2951)) (if (not (nonsymbol-id?1790 x2953))
(syntax-violation (quote bound-identifier=?) (quote "invalid argument")
x2953))) (let ((x2954 y2952)) (if (not (nonsymbol-id?1790 x2954))
(syntax-violation (quote bound-identifier=?) (quote "invalid argument")
x2954))) (bound-id=?1815 x2951 y2952)))) (set! syntax-violation (lambda
(who2958 message2957 form2956 . subform2955) (begin (let ((x2959 who2958)) (if
(not ((lambda (x2960) (or (not x2960) (string? x2960) (symbol? x2960))) x2959))
(syntax-violation (quote syntax-violation) (quote "invalid argument") x2959)))
(let ((x2961 message2957)) (if (not (string? x2961)) (syntax-violation (quote
syntax-violation) (quote "invalid argument") x2961))) (scm-error (quote
syntax-error) (quote sc-expand) (string-append (if who2958 (quote "~a: ")
(quote "")) (quote "~a ") (if (null? subform2955) (quote "in ~a") (quote "in
subform `~s' of `~s'"))) (let ((tail2962 (cons message2957 (map (lambda (x2963)
(strip1838 x2963 (quote (())))) (append subform2955 (list form2956)))))) (if
who2958 (cons who2958 tail2962) tail2962)) (quote #f))))) (letrec ((match2968
(lambda (e2969 p2970 w2971 r2972 mod2973) (cond ((not r2972) (quote #f)) ((eq?
p2970 (quote any)) (cons (wrap1819 e2969 w2971 mod2973) r2972))
((syntax-object?1775 e2969) (match*2967 (let ((e2974
(syntax-object-expression1776 e2969))) (if (annotation? e2974)
(annotation-expression e2974) e2974)) p2970 (join-wraps1810 w2971
(syntax-object-wrap1777 e2969)) r2972 (syntax-object-module1778 e2969))) (else
(match*2967 (let ((e2975 e2969)) (if (annotation? e2975) (annotation-expression
e2975) e2975)) p2970 w2971 r2972 mod2973))))) (match*2967 (lambda (e2976 p2977
w2978 r2979 mod2980) (cond ((null? p2977) (and (null? e2976) r2979)) ((pair?
p2977) (and (pair? e2976) (match2968 (car e2976) (car p2977) w2978 (match2968
(cdr e2976) (cdr p2977) w2978 r2979 mod2980) mod2980))) ((eq? p2977 (quote
each-any)) (let ((l2981 (match-each-any2965 e2976 w2978 mod2980))) (and l2981
(cons l2981 r2979)))) (else (let ((t2982 (vector-ref p2977 (quote 0)))) (if
(memv t2982 (quote (each))) (if (null? e2976) (match-empty2966 (vector-ref
p2977 (quote 1)) r2979) (let ((l2983 (match-each2964 e2976 (vector-ref p2977
(quote 1)) w2978 mod2980))) (and l2983 (letrec ((collect2984 (lambda (l2985)
(if (null? (car l2985)) r2979 (cons (map car l2985) (collect2984 (map cdr
l2985))))))) (collect2984 l2983))))) (if (memv t2982 (quote (free-id))) (and
(id?1791 e2976) (free-id=?1814 (wrap1819 e2976 w2978 mod2980) (vector-ref p2977
(quote 1))) r2979) (if (memv t2982 (quote (atom))) (and (equal? (vector-ref
p2977 (quote 1)) (strip1838 e2976 w2978)) r2979) (if (memv t2982 (quote
(vector))) (and (vector? e2976) (match2968 (vector->list e2976) (vector-ref
p2977 (quote 1)) w2978 r2979 mod2980))))))))))) (match-empty2966 (lambda (p2986
r2987) (cond ((null? p2986) r2987) ((eq? p2986 (quote any)) (cons (quote ())
r2987)) ((pair? p2986) (match-empty2966 (car p2986) (match-empty2966 (cdr
p2986) r2987))) ((eq? p2986 (quote each-any)) (cons (quote ()) r2987)) (else
(let ((t2988 (vector-ref p2986 (quote 0)))) (if (memv t2988 (quote (each)))
(match-empty2966 (vector-ref p2986 (quote 1)) r2987) (if (memv t2988 (quote
(free-id atom))) r2987 (if (memv t2988 (quote (vector))) (match-empty2966
(vector-ref p2986 (quote 1)) r2987))))))))) (match-each-any2965 (lambda (e2989
w2990 mod2991) (cond ((annotation? e2989) (match-each-any2965
(annotation-expression e2989) w2990 mod2991)) ((pair? e2989) (let ((l2992
(match-each-any2965 (cdr e2989) w2990 mod2991))) (and l2992 (cons (wrap1819
(car e2989) w2990 mod2991) l2992)))) ((null? e2989) (quote ()))
((syntax-object?1775 e2989) (match-each-any2965 (syntax-object-expression1776
e2989) (join-wraps1810 w2990 (syntax-object-wrap1777 e2989)) mod2991)) (else
(quote #f))))) (match-each2964 (lambda (e2993 p2994 w2995 mod2996) (cond
((annotation? e2993) (match-each2964 (annotation-expression e2993) p2994 w2995
mod2996)) ((pair? e2993) (let ((first2997 (match2968 (car e2993) p2994 w2995
(quote ()) mod2996))) (and first2997 (let ((rest2998 (match-each2964 (cdr
e2993) p2994 w2995 mod2996))) (and rest2998 (cons first2997 rest2998))))))
((null? e2993) (quote ())) ((syntax-object?1775 e2993) (match-each2964
(syntax-object-expression1776 e2993) p2994 (join-wraps1810 w2995
(syntax-object-wrap1777 e2993)) (syntax-object-module1778 e2993))) (else (quote
#f)))))) (set! $sc-dispatch (lambda (e2999 p3000) (cond ((eq? p3000 (quote
any)) (list e2999)) ((syntax-object?1775 e2999) (match*2967 (let ((e3001
(syntax-object-expression1776 e2999))) (if (annotation? e3001)
(annotation-expression e3001) e3001)) p3000 (syntax-object-wrap1777 e2999)
(quote ()) (syntax-object-module1778 e2999))) (else (match*2967 (let ((e3002
e2999)) (if (annotation? e3002) (annotation-expression e3002) e3002)) p3000
(quote (())) (quote ()) (quote #f))))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x3003) ((lambda
(tmp3004) ((lambda (tmp3005) (if tmp3005 (apply (lambda (_3006 e13007 e23008)
(cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top)
(top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))
(hygiene guile))) (cons e13007 e23008))) tmp3005) ((lambda (tmp3010) (if
tmp3010 (apply (lambda (_3011 out3012 in3013 e13014 e23015) (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))) in3013 (quote ()) (list out3012 (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 e13014 e23015))))) tmp3010) ((lambda
(tmp3017) (if tmp3017 (apply (lambda (_3018 out3019 in3020 e13021 e23022) (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))) in3020) (quote ()) (list out3019 (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 e13021 e23022))))) tmp3017) (syntax-violation #f "source
expression failed to match any pattern" tmp3004))) ($sc-dispatch tmp3004 (quote
(any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp3004 (quote (any
((any any)) any . each-any)))))) ($sc-dispatch tmp3004 (quote (any () any .
each-any))))) x3003))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x3026)
((lambda (tmp3027) ((lambda (tmp3028) (if tmp3028 (apply (lambda (_3029 k3030
keyword3031 pattern3032 template3033) (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 k3030 (map (lambda (tmp3036
tmp3035) (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)))
tmp3035) (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)))
tmp3036))) template3033 pattern3032)))))) tmp3028) (syntax-violation #f "source
expression failed to match any pattern" tmp3027))) ($sc-dispatch tmp3027 (quote
(any each-any . #(each ((any . any) any))))))) x3026))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote
let*)) (quote macro) (lambda (x3037) ((lambda (tmp3038) ((lambda (tmp3039) (if
(if tmp3039 (apply (lambda (let*3040 x3041 v3042 e13043 e23044) (and-map
identifier? x3041)) tmp3039) (quote #f)) (apply (lambda (let*3046 x3047 v3048
e13049 e23050) (letrec ((f3051 (lambda (bindings3052) (if (null? bindings3052)
(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 e13049 e23050)))
((lambda (tmp3056) ((lambda (tmp3057) (if tmp3057 (apply (lambda (body3058
binding3059) (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 binding3059) body3058)) tmp3057) (syntax-violation #f
"source expression failed to match any pattern" tmp3056))) ($sc-dispatch
tmp3056 (quote (any any))))) (list (f3051 (cdr bindings3052)) (car
bindings3052))))))) (f3051 (map list x3047 v3048)))) tmp3039) (syntax-violation
#f "source expression failed to match any pattern" tmp3038))) ($sc-dispatch
tmp3038 (quote (any #(each (any any)) any . each-any))))) x3037))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote
do)) (quote macro) (lambda (orig-x3060) ((lambda (tmp3061) ((lambda (tmp3062)
(if tmp3062 (apply (lambda (_3063 var3064 init3065 step3066 e03067 e13068
c3069) ((lambda (tmp3070) ((lambda (tmp3071) (if tmp3071 (apply (lambda
(step3072) ((lambda (tmp3073) ((lambda (tmp3074) (if tmp3074 (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
var3064 init3065) (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))) e03067) (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 c3069 (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))) step3072))))))) tmp3074) ((lambda (tmp3079)
(if tmp3079 (apply (lambda (e13080 e23081) (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 var3064 init3065) (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))) e03067 (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 e13080 e23081)) (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 c3069 (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))) step3072))))))) tmp3079)
(syntax-violation #f "source expression failed to match any pattern" tmp3073)))
($sc-dispatch tmp3073 (quote (any . each-any)))))) ($sc-dispatch tmp3073 (quote
())))) e13068)) tmp3071) (syntax-violation #f "source expression failed to
match any pattern" tmp3070))) ($sc-dispatch tmp3070 (quote each-any)))) (map
(lambda (v3088 s3089) ((lambda (tmp3090) ((lambda (tmp3091) (if tmp3091 (apply
(lambda () v3088) tmp3091) ((lambda (tmp3092) (if tmp3092 (apply (lambda
(e3093) e3093) tmp3092) ((lambda (_3094) (syntax-violation (quote do) (quote
"bad step expression") orig-x3060 s3089)) tmp3090))) ($sc-dispatch tmp3090
(quote (any)))))) ($sc-dispatch tmp3090 (quote ())))) s3089)) var3064
step3066))) tmp3062) (syntax-violation #f "source expression failed to match
any pattern" tmp3061))) ($sc-dispatch tmp3061 (quote (any #(each (any any .
any)) (any . each-any) . each-any))))) orig-x3060))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module)
(quote quasiquote)) (quote macro) (letrec ((quasicons3097 (lambda (x3101 y3102)
((lambda (tmp3103) ((lambda (tmp3104) (if tmp3104 (apply (lambda (x3105 y3106)
((lambda (tmp3107) ((lambda (tmp3108) (if tmp3108 (apply (lambda (dy3109)
((lambda (tmp3110) ((lambda (tmp3111) (if tmp3111 (apply (lambda (dx3112) (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 dx3112 dy3109))) tmp3111) ((lambda
(_3113) (if (null? dy3109) (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))) x3105) (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))) x3105 y3106))) tmp3110))) ($sc-dispatch
tmp3110 (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))))) x3105)) tmp3108) ((lambda (tmp3114) (if
tmp3114 (apply (lambda (stuff3115) (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 x3105 stuff3115))) tmp3114)
((lambda (else3116) (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))) x3105 y3106)) tmp3107))) ($sc-dispatch tmp3107
(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 tmp3107 (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))))) y3106)) tmp3104) (syntax-violation #f "source expression
failed to match any pattern" tmp3103))) ($sc-dispatch tmp3103 (quote (any
any))))) (list x3101 y3102)))) (quasiappend3098 (lambda (x3117 y3118) ((lambda
(tmp3119) ((lambda (tmp3120) (if tmp3120 (apply (lambda (x3121 y3122) ((lambda
(tmp3123) ((lambda (tmp3124) (if tmp3124 (apply (lambda () x3121) tmp3124)
((lambda (_3125) (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))) x3121 y3122)) tmp3123))) ($sc-dispatch tmp3123
(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))) ()))))) y3122))
tmp3120) (syntax-violation #f "source expression failed to match any pattern"
tmp3119))) ($sc-dispatch tmp3119 (quote (any any))))) (list x3117 y3118))))
(quasivector3099 (lambda (x3126) ((lambda (tmp3127) ((lambda (x3128) ((lambda
(tmp3129) ((lambda (tmp3130) (if tmp3130 (apply (lambda (x3131) (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
x3131))) tmp3130) ((lambda (tmp3133) (if tmp3133 (apply (lambda (x3134) (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))) x3134)) tmp3133)
((lambda (_3136) (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))) x3128)) tmp3129))) ($sc-dispatch tmp3129 (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 tmp3129 (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))))) x3128)) tmp3127)) x3126))) (quasi3100 (lambda
(p3137 lev3138) ((lambda (tmp3139) ((lambda (tmp3140) (if tmp3140 (apply
(lambda (p3141) (if (= lev3138 (quote 0)) p3141 (quasicons3097 (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)))) (quasi3100 (list p3141) (- lev3138 (quote 1))))))
tmp3140) ((lambda (tmp3142) (if tmp3142 (apply (lambda (p3143 q3144) (if (=
lev3138 (quote 0)) (quasiappend3098 p3143 (quasi3100 q3144 lev3138))
(quasicons3097 (quasicons3097 (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)))) (quasi3100 (list p3143) (- lev3138
(quote 1)))) (quasi3100 q3144 lev3138)))) tmp3142) ((lambda (tmp3145) (if
tmp3145 (apply (lambda (p3146) (quasicons3097 (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)))) (quasi3100 (list p3146) (+ lev3138 (quote 1))))) tmp3145)
((lambda (tmp3147) (if tmp3147 (apply (lambda (p3148 q3149) (quasicons3097
(quasi3100 p3148 lev3138) (quasi3100 q3149 lev3138))) tmp3147) ((lambda
(tmp3150) (if tmp3150 (apply (lambda (x3151) (quasivector3099 (quasi3100 x3151
lev3138))) tmp3150) ((lambda (p3153) (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))) p3153)) tmp3139)))
($sc-dispatch tmp3139 (quote #(vector each-any)))))) ($sc-dispatch tmp3139
(quote (any . any)))))) ($sc-dispatch tmp3139 (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 tmp3139
(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 tmp3139 (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))))) p3137))))
(lambda (x3154) ((lambda (tmp3155) ((lambda (tmp3156) (if tmp3156 (apply
(lambda (_3157 e3158) (quasi3100 e3158 (quote 0))) tmp3156) (syntax-violation
#f "source expression failed to match any pattern" tmp3155))) ($sc-dispatch
tmp3155 (quote (any any))))) x3154)))))
+(define include (make-syncase-macro (quote macro) (lambda (x3159) (letrec
((read-file3160 (lambda (fn3161 k3162) (let ((p3163 (open-input-file fn3161)))
(letrec ((f3164 (lambda (x3165) (if (eof-object? x3165) (begin
(close-input-port p3163) (quote ())) (cons (datum->syntax k3162 x3165) (f3164
(read p3163))))))) (f3164 (read p3163))))))) ((lambda (tmp3166) ((lambda
(tmp3167) (if tmp3167 (apply (lambda (k3168 filename3169) (let ((fn3170
(syntax->datum filename3169))) ((lambda (tmp3171) ((lambda (tmp3172) (if
tmp3172 (apply (lambda (exp3173) (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))) exp3173)) tmp3172) (syntax-violation #f "source expression
failed to match any pattern" tmp3171))) ($sc-dispatch tmp3171 (quote
each-any)))) (read-file3160 fn3170 k3168)))) tmp3167) (syntax-violation #f
"source expression failed to match any pattern" tmp3166))) ($sc-dispatch
tmp3166 (quote (any any))))) x3159)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x3175) ((lambda
(tmp3176) ((lambda (tmp3177) (if tmp3177 (apply (lambda (_3178 e3179)
(syntax-violation (quote unquote) (quote "expression not valid outside of
quasiquote") x3175)) tmp3177) (syntax-violation #f "source expression failed to
match any pattern" tmp3176))) ($sc-dispatch tmp3176 (quote (any any)))))
x3175))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x3180)
((lambda (tmp3181) ((lambda (tmp3182) (if tmp3182 (apply (lambda (_3183 e3184)
(syntax-violation (quote unquote-splicing) (quote "expression not valid outside
of quasiquote") x3180)) tmp3182) (syntax-violation #f "source expression failed
to match any pattern" tmp3181))) ($sc-dispatch tmp3181 (quote (any any)))))
x3180))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote
case)) (quote macro) (lambda (x3185) ((lambda (tmp3186) ((lambda (tmp3187) (if
tmp3187 (apply (lambda (_3188 e3189 m13190 m23191) ((lambda (tmp3192) ((lambda
(body3193) (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))) e3189)) body3193))
tmp3192)) (letrec ((f3194 (lambda (clause3195 clauses3196) (if (null?
clauses3196) ((lambda (tmp3198) ((lambda (tmp3199) (if tmp3199 (apply (lambda
(e13200 e23201) (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 e13200 e23201))) tmp3199) ((lambda (tmp3203) (if
tmp3203 (apply (lambda (k3204 e13205 e23206) (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))) k3204)) (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 e13205 e23206)))) tmp3203)
((lambda (_3209) (syntax-violation (quote case) (quote "bad clause") x3185
clause3195)) tmp3198))) ($sc-dispatch tmp3198 (quote (each-any any .
each-any)))))) ($sc-dispatch tmp3198 (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))))) clause3195) ((lambda (tmp3210) ((lambda (rest3211) ((lambda
(tmp3212) ((lambda (tmp3213) (if tmp3213 (apply (lambda (k3214 e13215 e23216)
(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))) k3214)) (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 e13215 e23216)) rest3211)) tmp3213)
((lambda (_3219) (syntax-violation (quote case) (quote "bad clause") x3185
clause3195)) tmp3212))) ($sc-dispatch tmp3212 (quote (each-any any .
each-any))))) clause3195)) tmp3210)) (f3194 (car clauses3196) (cdr
clauses3196))))))) (f3194 m13190 m23191)))) tmp3187) (syntax-violation #f
"source expression failed to match any pattern" tmp3186))) ($sc-dispatch
tmp3186 (quote (any any any . each-any))))) x3185))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x3220)
((lambda (tmp3221) ((lambda (tmp3222) (if tmp3222 (apply (lambda (_3223 e3224)
(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)))
e3224)) (list (cons _3223 (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 e3224 (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)))))))))) tmp3222) (syntax-violation #f "source expression failed to
match any pattern" tmp3221))) ($sc-dispatch tmp3221 (quote (any any)))))
x3220))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index be0efb6..85ef138 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -304,7 +304,7 @@
(primitive-eval
`(,noexpand
,(case (fluid-ref *mode*)
- ((c) ((@ (ice-9 expand-support) strip-expansion-structures) x))
+ ((c) ((@ (language tree-il) tree-il->scheme) x))
(else x))))))
(define local-eval-hook
@@ -312,7 +312,7 @@
(primitive-eval
`(,noexpand
,(case (fluid-ref *mode*)
- ((c) ((@ (ice-9 expand-support) strip-expansion-structures) x))
+ ((c) ((@ (language tree-il) tree-il->scheme) x))
(else x))))))
(define-syntax gensym-hook
@@ -351,132 +351,150 @@
;;; output constructors
-(define (build-annotated src exp)
- (if (and src (not (annotation? exp)))
- (make-annotation exp src #t)
- exp))
-
-(define-syntax build-application
- (syntax-rules ()
- ((_ source fun-exp arg-exps)
- (build-annotated source `(,fun-exp . ,arg-exps)))))
-
-(define-syntax build-conditional
- (syntax-rules ()
- ((_ source test-exp then-exp else-exp)
- (build-annotated source `(if ,test-exp ,then-exp ,else-exp)))))
+(define build-application
+ (lambda (source fun-exp arg-exps)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-application) source fun-exp arg-exps))
+ (else `(,fun-exp . ,arg-exps)))))
+
+(define build-conditional
+ (lambda (source test-exp then-exp else-exp)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-conditional)
+ source test-exp then-exp else-exp))
+ (else `(if ,test-exp ,then-exp ,else-exp)))))
(define build-lexical-reference
(lambda (type source name var)
- (build-annotated
- source
- (case (fluid-ref *mode*)
- ((c) ((@ (ice-9 expand-support) make-lexical) name var))
- (else var)))))
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-lexical-ref) source name var))
+ (else var))))
(define build-lexical-assignment
(lambda (source name var exp)
- (build-annotated
- source
- `(set! ,(build-lexical-reference 'set no-source name var)
- ,exp))))
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-lexical-set) source name var exp))
+ (else `(set! ,var ,exp)))))
;; Before modules are booted, we can't expand into data structures from
-;; (ice-9 expand-support) -- we need to give the evaluator the
+;; (language tree-il) -- we need to give the evaluator the
;; s-expressions that it understands natively. Actually the real truth
;; of the matter is that the evaluator doesn't understand expand-support
;; structures at all. So until we fix the evaluator, if ever, the
-;; conflation that we should use expand-support iff we are compiling
+;; conflation that we should use tree-il iff we are compiling
;; holds true.
;;
+(define (analyze-variable mod var modref-cont bare-cont)
+ (if (not mod)
+ (bare-cont var)
+ (let ((kind (car mod))
+ (mod (cdr mod)))
+ (case kind
+ ((public) (modref-cont mod var #t))
+ ((private) (if (not (equal? mod (module-name (current-module))))
+ (modref-cont mod var #f)
+ (bare-cont var)))
+ ((bare) (bare-cont var))
+ ((hygiene) (if (and (not (equal? mod (module-name (current-module))))
+ (module-variable (resolve-module mod) var))
+ (modref-cont mod var #f)
+ (bare-cont var)))
+ (else (syntax-violation #f "bad module kind" var mod))))))
+
(define build-global-reference
(lambda (source var mod)
- (build-annotated
- source
- (if (not mod)
- var
- (let ((make-module-ref
- (case (fluid-ref *mode*)
- ((c) (@ (ice-9 expand-support) make-module-ref))
- (else (lambda (mod var public?)
- (list (if public? '@ '@@) mod var)))))
- (kind (car mod))
- (mod (cdr mod)))
- (case kind
- ((public) (make-module-ref mod var #t))
- ((private) (if (not (equal? mod (module-name (current-module))))
- (make-module-ref mod var #f)
- var))
- ((bare) var)
- ((hygiene) (if (and (not (equal? mod (module-name
(current-module))))
- (module-variable (resolve-module mod) var))
- (make-module-ref mod var #f)
- var))
- (else (syntax-violation #f "bad module kind" var mod))))))))
+ (analyze-variable
+ mod var
+ (lambda (mod var public?)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-module-ref) source mod var public?))
+ (else (list (if public? '@ '@@) mod var))))
+ (lambda (var)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-toplevel-ref) source var))
+ (else var))))))
(define build-global-assignment
(lambda (source var exp mod)
- (let ((ref (build-global-reference source var mod)))
- (build-annotated
- source
- `(set! ,ref ,exp)))))
-
-(define-syntax build-global-definition
- (syntax-rules ()
- ((_ source var exp mod)
- (build-annotated source `(define ,var ,exp)))))
-
-(define-syntax build-lambda
- (syntax-rules ()
- ((_ src vars docstring exp)
- (build-annotated src `(lambda ,vars ,@(if docstring (list docstring) '())
- ,exp)))
- ((_ src vars exp)
- (build-annotated src `(lambda ,vars ,exp)))))
-
-;; FIXME: wingo: add modules here somehow?
-(define-syntax build-primref
- (syntax-rules ()
- ((_ src name) (build-annotated src name))
- ((_ src level name) (build-annotated src name))))
+ (analyze-variable
+ mod var
+ (lambda (mod var public?)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-module-set) source mod var public?
exp))
+ (else `(set! ,(list (if public? '@ '@@) mod var) ,exp))))
+ (lambda (var)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-toplevel-set) source var exp))
+ (else `(set! ,var ,exp)))))))
+
+(define build-global-definition
+ (lambda (source var exp)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-toplevel-define) source var exp))
+ (else `(define ,var ,exp)))))
+
+(define build-lambda
+ (lambda (src vars docstring exp)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-lambda) src vars
+ (if docstring `((documentation . ,docstring)) '())
+ exp))
+ (else `(lambda ,vars ,@(if docstring (list docstring) '())
+ ,exp)))))
+
+(define build-primref
+ (lambda (src name)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-primitive-ref) src name))
+ ;; hygiene guile is a hack
+ (else (build-global-reference src name '(hygiene guile))))))
(define (build-data src exp)
- (if (and (self-evaluating? exp)
- (not (vector? exp)))
- (build-annotated src exp)
- (build-annotated src (list 'quote exp))))
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-const) src exp))
+ (else (if (and (self-evaluating? exp) (not (vector? exp)))
+ exp
+ (list 'quote exp)))))
(define build-sequence
(lambda (src exps)
(if (null? (cdr exps))
- (build-annotated src (car exps))
- (build-annotated src `(begin ,@exps)))))
+ (car exps)
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-sequence) src exps))
+ (else `(begin ,@exps))))))
(define build-let
(lambda (src vars val-exps body-exp)
(if (null? vars)
- (build-annotated src body-exp)
- (build-annotated src `(let ,(map list vars val-exps) ,body-exp)))))
+ body-exp
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-let) src vars val-exps body-exp))
+ (else `(let ,(map list vars val-exps) ,body-exp))))))
(define build-named-let
(lambda (src vars val-exps body-exp)
- (if (null? vars)
- (build-annotated src body-exp)
- (build-annotated src
- `(let ,(car vars)
- ,(map list (cdr vars) val-exps) ,body-exp)))))
+ (let ((f (car vars))
+ (vars (cdr vars)))
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-letrec) src
+ (list f) (list (build-lambda src vars #f body-exp))
+ (build-application src (build-lexical-reference 'fun src f f)
+ val-exps)))
+ (else `(let ,f ,(map list vars val-exps) ,body-exp))))))
(define build-letrec
(lambda (src vars val-exps body-exp)
(if (null? vars)
- (build-annotated src body-exp)
- (build-annotated src
- `(letrec ,(map list vars val-exps) ,body-exp)))))
+ body-exp
+ (case (fluid-ref *mode*)
+ ((c) ((@ (language tree-il) make-letrec) src vars val-exps body-exp))
+ (else `(letrec ,(map list vars val-exps) ,body-exp))))))
-;; FIXME: wingo: use make-lexical
+;; FIXME: wingo: use make-lexical ?
(define-syntax build-lexical-var
(syntax-rules ()
- ((_ src id) (build-annotated src (gensym (symbol->string id))))))
+ ((_ src id) (gensym (symbol->string id)))))
(define-structure (syntax-object expression wrap module))
@@ -914,29 +932,30 @@
(let ((first (chi-top (car body) r w m esew mod)))
(cons first (dobody (cdr body) r w m esew mod))))))))
-;; FIXME: module?
(define chi-install-global
(lambda (name e)
- (build-application no-source
- (build-primref no-source 'define)
- (list
- name
- ;; FIXME: seems nasty to call current-module here
- (if (let ((v (module-variable (current-module) name)))
- ;; FIXME use primitive-macro?
- (and v (variable-bound? v) (macro? (variable-ref v))
- (not (eq? (macro-type (variable-ref v)) 'syncase-macro))))
- (build-application no-source
- (build-primref no-source
'make-extended-syncase-macro)
- (list (build-application no-source
- (build-primref
no-source 'module-ref)
- (list
(build-application no-source 'current-module '())
- (build-data
no-source name)))
- (build-data no-source 'macro)
- e))
- (build-application no-source
- (build-primref no-source 'make-syncase-macro)
- (list (build-data no-source 'macro) e)))))))
+ (build-global-definition
+ no-source
+ name
+ ;; FIXME: seems nasty to call current-module here
+ (if (let ((v (module-variable (current-module) name)))
+ ;; FIXME use primitive-macro?
+ (and v (variable-bound? v) (macro? (variable-ref v))
+ (not (eq? (macro-type (variable-ref v)) 'syncase-macro))))
+ (build-application
+ no-source
+ (build-primref no-source 'make-extended-syncase-macro)
+ (list (build-application
+ no-source
+ (build-primref no-source 'module-ref)
+ (list (build-application no-source 'current-module '())
+ (build-data no-source name)))
+ (build-data no-source 'macro)
+ e))
+ (build-application
+ no-source
+ (build-primref no-source 'make-syncase-macro)
+ (list (build-data no-source 'macro) e))))))
(define chi-when-list
(lambda (e when-list w)
@@ -1138,7 +1157,7 @@
(case type
((global core macro module-ref)
(eval-if-c&e m
- (build-global-definition s n (chi e r w mod) mod)
+ (build-global-definition s n (chi e r w mod))
mod))
((displaced-lexical)
(syntax-violation #f "identifier out of context"
@@ -1728,13 +1747,12 @@
((ref) (build-lexical-reference 'value no-source (cadr x) (cadr x)))
((primitive) (build-primref no-source (cadr x)))
((quote) (build-data no-source (cadr x)))
- ((lambda) (build-lambda no-source (cadr x) (regen (caddr x))))
+ ((lambda) (build-lambda no-source (cadr x) #f (regen (caddr x))))
((map) (let ((ls (map regen (cdr x))))
(build-application no-source
- (if (fx= (length ls) 2)
- (build-primref no-source 'map)
- ; really need to do our own checking here
- (build-primref no-source 2 'map)) ; require error
check
+ ;; this check used to be here, not sure what for:
+ ;; (if (fx= (length ls) 2)
+ (build-primref no-source 'map)
ls)))
(else (build-application no-source
(build-primref no-source (car x))
@@ -1912,7 +1930,7 @@
(let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
(build-application no-source
(build-primref no-source 'apply)
- (list (build-lambda no-source new-vars
+ (list (build-lambda no-source new-vars #f
(chi exp
(extend-env
labels
@@ -1939,7 +1957,7 @@
(let ((y (gen-var 'tmp)))
; fat finger binding and references to temp variable y
(build-application no-source
- (build-lambda no-source (list y)
+ (build-lambda no-source (list y) #f
(let ((y (build-lexical-reference 'value no-source
'tmp y)))
(build-conditional no-source
@@ -1973,7 +1991,7 @@
(let ((labels (list (gen-label)))
(var (gen-var (syntax pat))))
(build-application no-source
- (build-lambda no-source (list var)
+ (build-lambda no-source (list var) #f
(chi (syntax exp)
(extend-env labels
(list (make-binding 'syntax `(,var . 0)))
@@ -1999,7 +2017,7 @@
(let ((x (gen-var 'tmp)))
; fat finger binding and references to temp variable x
(build-application s
- (build-lambda no-source (list x)
+ (build-lambda no-source (list x) #f
(gen-syntax-case (build-lexical-reference 'value no-source
'tmp x)
(syntax (key ...)) (syntax (m ...))
diff --git a/module/language/scheme/compile-ghil.scm
b/module/language/scheme/compile-ghil.scm
index 163b4b7..3d5b015 100644
--- a/module/language/scheme/compile-ghil.scm
+++ b/module/language/scheme/compile-ghil.scm
@@ -27,7 +27,7 @@
#:use-module (system vm objcode)
#:use-module (ice-9 receive)
#:use-module (ice-9 optargs)
- #:use-module (ice-9 expand-support)
+ #:use-module (language tree-il)
#:use-module ((system base compile) #:select (syntax-error))
#:export (compile-ghil translate-1
*translate-table* define-scheme-translator))
@@ -70,7 +70,7 @@
(and=> (cenv-module e) set-current-module)
(call-with-ghil-environment (cenv-ghil-env e) '()
(lambda (env vars)
- (let ((x (strip-expansion-structures
+ (let ((x (tree-il->scheme
(sc-expand x 'c '(compile load eval)))))
(let ((x (make-ghil-lambda env #f vars #f '()
(translate-1 env #f x)))
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
new file mode 100644
index 0000000..fa655d8
--- /dev/null
+++ b/module/language/tree-il.scm
@@ -0,0 +1,248 @@
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+;;;;
+
+
+(define-module (language tree-il)
+ #:use-module (system base pmatch)
+ #:use-module (system base syntax)
+ :export (tree-il-loc
+
+ <lexical> make-lexical
+ lexical-name lexical-gensym
+
+ <application> make-application application-loc application-proc
application-args
+ <conditional> make-conditional conditional-loc conditional-test
conditional-then conditional-else
+ <primitive-ref> make-primitive-ref primitive-ref-loc
primitive-ref-name
+ <lexical-ref> make-lexical-ref lexical-ref-loc lexical-ref-name
lexical-ref-gensym
+ <lexical-set> make-lexical-set lexical-set-loc lexical-set-name
lexical-set-gensym lexical-set-exp
+ <module-ref> make-module-ref module-ref-loc module-ref-mod
module-ref-name module-ref-public?
+ <module-set> make-module-set module-set-loc module-set-mod
module-set-name module-set-public? module-set-exp
+ <toplevel-ref> make-toplevel-ref toplevel-ref-loc toplevel-ref-name
+ <toplevel-set> make-toplevel-set toplevel-set-loc toplevel-set-name
toplevel-set-exp
+ <toplevel-define> make-toplevel-define toplevel-define-loc
toplevel-define-name toplevel-define-exp
+ <lambda> make-lambda lambda-loc lambda-vars lambda-meta lambda-body
+ <const> make-const const-loc const-exp
+ <sequence> make-sequence sequence-loc sequence-exps
+ <let> make-let let-loc let-vars let-vals let-exp
+ <letrec> make-letrec letrec-loc letrec-vars letrec-vals letrec-exp
+
+ parse-tree-il
+ unparse-tree-il
+ tree-il->scheme))
+
+(define-type (<tree-il> #:common-slots (src))
+ (<application> proc args)
+ (<conditional> test then else)
+ (<primitive-ref> name)
+ (<lexical-ref> name gensym)
+ (<lexical-set> name gensym exp)
+ (<module-ref> mod name public?)
+ (<module-set> mod name public? exp)
+ (<toplevel-ref> name)
+ (<toplevel-set> name exp)
+ (<toplevel-define> name exp)
+ (<lambda> vars meta body)
+ (<const> exp)
+ (<sequence> exps)
+ (<let> vars vals exp)
+ (<letrec> vars vals exp))
+
+(define <lexical> <lexical-ref>)
+(define lexical? lexical-ref?)
+(define make-lexical make-lexical-ref)
+(define lexical-name lexical-ref-name)
+(define lexical-gensym lexical-ref-gensym)
+
+
+
+;; FIXME: use this in psyntax
+(define (location x)
+ (and (pair? x)
+ (let ((props (source-properties x)))
+ (and (not (null? props))
+ (vector (assq-ref props 'line)
+ (assq-ref props 'column)
+ (assq-ref props 'filename))))))
+
+(define (parse-tree-il env exp)
+ (let ((loc (location exp))
+ (retrans (lambda (x) (parse-ghil env x))))
+ (pmatch exp
+ ((apply ,proc ,args)
+ (make-application loc (retrans proc) (retrans args)))
+
+ ((if ,test ,then ,else)
+ (make-conditional loc (retrans test) (retrans then) (retrans else)))
+
+ ((primitive ,name) (guard (symbol? name))
+ (make-primitive-ref loc name))
+
+ ((lexical ,name) (guard (symbol? name))
+ (make-lexical-ref loc name name))
+
+ ((lexical ,name ,sym) (guard (symbol? name) (symbol? sym))
+ (make-lexical-ref loc name sym))
+
+ ((set! (lexical ,name ,sym) ,exp) (guard (symbol? name) (symbol? sym))
+ (make-lexical-set loc name sym (retrans exp)))
+
+ ((@ ,mod ,name) (guard (and-map symbol? mod) (symbol? name))
+ (make-module-ref loc mod name #t))
+
+ ((set! (@ ,mod ,name) ,exp) (guard (and-map symbol? mod) (symbol? name))
+ (make-module-set loc mod name #t (retrans exp)))
+
+ ((@@ ,mod ,name) (guard (and-map symbol? mod) (symbol? name))
+ (make-module-ref loc mod name #f))
+
+ ((set! (@ ,mod ,name) ,exp) (guard (and-map symbol? mod) (symbol? name))
+ (make-module-set loc mod name #f (retrans exp)))
+
+ ((toplevel ,name) (guard (symbol? name))
+ (make-toplevel-ref loc name))
+
+ ((set! (toplevel ,name) exp) (guard (symbol? name))
+ (make-toplevel-set loc name (retrans exp)))
+
+ ((define ,name exp) (guard (symbol? name))
+ (make-toplevel-define loc name (retrans exp)))
+
+ ((lambda ,vars ,exp)
+ (make-lambda loc vars '() (retrans exp)))
+
+ ((lambda ,vars ,meta ,exp)
+ (make-lambda loc vars meta (retrans exp)))
+
+ ((const ,exp)
+ (make-const loc exp))
+
+ ((begin . ,exps)
+ (make-sequence loc (map retrans exps)))
+
+ ((let ,vars ,vals ,exp)
+ (make-let loc vars vals (retrans exp)))
+
+ ((letrec ,vars ,vals ,exp)
+ (make-letrec loc vars vals (retrans exp)))
+
+ (else
+ (error "unrecognized tree-il" exp)))))
+
+(define (unparse-tree-il tree-il)
+ (record-case tree-il
+ ((<application> proc args)
+ `(apply ,(unparse-tree-il proc) ,(map unparse-tree-il args)))
+
+ ((<conditional> test then else)
+ `(if ,(unparse-tree-il test) ,(unparse-tree-il then) ,(unparse-tree-il
else)))
+
+ ((<primitive-ref> name)
+ `(primitive ,name))
+
+ ((<lexical-ref> name gensym)
+ `(lexical ,name ,gensym))
+
+ ((<lexical-set> name gensym exp)
+ `(set! (lexical ,name ,gensym) ,(unparse-tree-il exp)))
+
+ ((<module-ref> mod name public?)
+ `(,(if public? '@ '@@) ,mod ,name))
+
+ ((<module-set> mod name public? exp)
+ `(set! (,(if public? '@ '@@) ,mod ,name) ,(unparse-tree-il exp)))
+
+ ((<toplevel-ref> name)
+ `(toplevel ,name))
+
+ ((<toplevel-set> name exp)
+ `(set! (toplevel ,name) ,(unparse-tree-il exp)))
+
+ ((<toplevel-define> name exp)
+ `(define ,name ,(unparse-tree-il exp)))
+
+ ((<lambda> vars meta body)
+ `(lambda ,vars ,meta ,(unparse-tree-il body)))
+
+ ((<const> exp)
+ `(const ,exp))
+
+ ((<sequence> exps)
+ `(begin ,@(map unparse-tree-il exps)))
+
+ ((<let> vars vals exp)
+ `(let ,vars ,(map unparse-tree-il vals) ,(unparse-tree-il exp)))
+
+ ((<letrec> vars vals exp)
+ `(letrec ,vars ,(map unparse-tree-il vals) ,(unparse-tree-il exp)))))
+
+(define (tree-il->scheme e)
+ (cond ((list? e)
+ (map tree-il->scheme e))
+ ((pair? e)
+ (cons (tree-il->scheme (car e))
+ (tree-il->scheme (cdr e))))
+ ((record? e)
+ (record-case e
+ ((<application> proc args)
+ `(,(tree-il->scheme proc) ,@(map tree-il->scheme args)))
+
+ ((<conditional> test then else)
+ `(if ,(tree-il->scheme test) ,(tree-il->scheme then)
,(tree-il->scheme else)))
+
+ ((<primitive-ref> name)
+ name)
+
+ ((<lexical-ref> name gensym)
+ gensym)
+
+ ((<lexical-set> name gensym exp)
+ `(set! ,gensym ,(tree-il->scheme exp)))
+
+ ((<module-ref> mod name public?)
+ `(,(if public? '@ '@@) ,mod ,name))
+
+ ((<module-set> mod name public? exp)
+ `(set! (,(if public? '@ '@@) ,mod ,name) ,(tree-il->scheme exp)))
+
+ ((<toplevel-ref> name)
+ name)
+
+ ((<toplevel-set> name exp)
+ `(set! ,name ,(tree-il->scheme exp)))
+
+ ((<toplevel-define> name exp)
+ `(define ,name ,(tree-il->scheme exp)))
+
+ ((<lambda> vars meta body)
+ `(lambda ,vars
+ ,@(cond ((assq-ref meta 'documentation) => list) (else '()))
+ ,(tree-il->scheme body)))
+
+ ((<const> exp)
+ (if (and (self-evaluating? exp) (not (vector? exp)))
+ exp
+ (list 'quote exp)))
+
+ ((<sequence> exps)
+ `(begin ,@(map tree-il->scheme exps)))
+
+ ((<let> vars vals exp)
+ `(let ,(map list vars (map tree-il->scheme vals))
,(tree-il->scheme exp)))
+
+ ((<letrec> vars vals exp)
+ `(letrec ,(map list vars (map tree-il->scheme vals))
,(tree-il->scheme exp)))))
+ (else e)))
diff --git a/module/language/ghil/compile-glil.scm
b/module/language/tree-il/compile-glil.scm
similarity index 99%
copy from module/language/ghil/compile-glil.scm
copy to module/language/tree-il/compile-glil.scm
index c813319..3a02255 100644
--- a/module/language/ghil/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -1,4 +1,4 @@
-;;; GHIL -> GLIL compiler
+;;; TREE-IL -> GLIL compiler
;; Copyright (C) 2001 Free Software Foundation, Inc.
@@ -19,10 +19,10 @@
;;; Code:
-(define-module (language ghil compile-glil)
+(define-module (language tree-il compile-glil)
#:use-module (system base syntax)
#:use-module (language glil)
- #:use-module (language ghil)
+ #:use-module (language tree-il)
#:use-module (ice-9 common-list)
#:export (compile-glil))
diff --git a/module/language/tree-il/spec.scm b/module/language/tree-il/spec.scm
new file mode 100644
index 0000000..d69a4ec
--- /dev/null
+++ b/module/language/tree-il/spec.scm
@@ -0,0 +1,52 @@
+;;; Tree Intermediate Language
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language tree-il spec)
+ #:use-module (system base language)
+ #:use-module (language glil)
+ #:use-module (language tree-il)
+ #:use-module (language tree-il compile-glil)
+ #:export (tree-il))
+
+(define (write-tree-il exp . port)
+ (apply write (unparse-tree-il exp) port))
+
+(define (parse x)
+ (make-lambda #f '() '() (parse-tree-il x)))
+
+(define (join exps env)
+ (if (or-map (lambda (x)
+ (or (not (lambda? x))
+ (not (null? (lambda-vars x)))))
+ exps)
+ (error "tree-il expressions to join must be thunks"))
+
+ (make-lambda #f '() '() (make-sequence #f (map lambda-body exps))))
+
+(define-language tree-il
+ #:title "Tree Intermediate Language"
+ #:version "1.0"
+ #:reader read
+ #:printer write-tree-il
+ #:parser parse
+ #:joiner join
+ #:compilers `((glil . ,compile-glil))
+ )
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 811d10f5a2297e2fe6a881d02c67c45bf4311a27,
Andy Wingo <=