[bpt/guile.git] / module / ice-9 / psyntax-pp.scm

(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(if #f #f)
(letrec ((and-map*1132 (lambda (f1172 first1171 . rest1170) (or (null? first1171) (if (null? rest1170) (let andmap1173 ((first1174 first1171)) (let ((x1175 (car first1174)) (first1176 (cdr first1174))) (if (null? first1176) (f1172 x1175) (and (f1172 x1175) (andmap1173 first1176))))) (let andmap1177 ((first1178 first1171) (rest1179 rest1170)) (let ((x1180 (car first1178)) (xr1181 (map car rest1179)) (first1182 (cdr first1178)) (rest1183 (map cdr rest1179))) (if (null? first1182) (apply f1172 (cons x1180 xr1181)) (and (apply f1172 (cons x1180 xr1181)) (andmap1177 first1182 rest1183)))))))))) (letrec ((lambda-var-list1265 (lambda (vars1470) (let lvl1471 ((vars1472 vars1470) (ls1473 (quote ())) (w1474 (quote (())))) (cond ((pair? vars1472) (lvl1471 (cdr vars1472) (cons (wrap1244 (car vars1472) w1474 #f) ls1473) w1474)) ((id?1216 vars1472) (cons (wrap1244 vars1472 w1474 #f) ls1473)) ((null? vars1472) ls1473) ((syntax-object?1200 vars1472) (lvl1471 (syntax-object-expression1201 vars1472) ls1473 (join-wraps1235 w1474 (syntax-object-wrap1202 vars1472)))) ((annotation? vars1472) (lvl1471 (annotation-expression vars1472) ls1473 w1474)) (else (cons vars1472 ls1473)))))) (gen-var1264 (lambda (id1475) (let ((id1476 (if (syntax-object?1200 id1475) (syntax-object-expression1201 id1475) id1475))) (if (annotation? id1476) (build-annotated1193 (annotation-source id1476) (gensym (symbol->string (annotation-expression id1476)))) (build-annotated1193 #f (gensym (symbol->string id1476))))))) (strip1263 (lambda (x1477 w1478) (if (memq (quote top) (wrap-marks1219 w1478)) (if (or (annotation? x1477) (and (pair? x1477) (annotation? (car x1477)))) (strip-annotation1262 x1477 #f) x1477) (let f1479 ((x1480 x1477)) (cond ((syntax-object?1200 x1480) (strip1263 (syntax-object-expression1201 x1480) (syntax-object-wrap1202 x1480))) ((pair? x1480) (let ((a1481 (f1479 (car x1480))) (d1482 (f1479 (cdr x1480)))) (if (and (eq? a1481 (car x1480)) (eq? d1482 (cdr x1480))) x1480 (cons a1481 d1482)))) ((vector? x1480) (let ((old1483 (vector->list x1480))) (let ((new1484 (map f1479 old1483))) (if (and-map*1132 eq? old1483 new1484) x1480 (list->vector new1484))))) (else x1480)))))) (strip-annotation1262 (lambda (x1485 parent1486) (cond ((pair? x1485) (let ((new1487 (cons #f #f))) (begin (if parent1486 (set-annotation-stripped! parent1486 new1487)) (set-car! new1487 (strip-annotation1262 (car x1485) #f)) (set-cdr! new1487 (strip-annotation1262 (cdr x1485) #f)) new1487))) ((annotation? x1485) (or (annotation-stripped x1485) (strip-annotation1262 (annotation-expression x1485) x1485))) ((vector? x1485) (let ((new1488 (make-vector (vector-length x1485)))) (begin (if parent1486 (set-annotation-stripped! parent1486 new1488)) (let loop1489 ((i1490 (- (vector-length x1485) 1))) (unless (fx<1188 i1490 0) (vector-set! new1488 i1490 (strip-annotation1262 (vector-ref x1485 i1490) #f)) (loop1489 (fx-1186 i1490 1)))) new1488))) (else x1485)))) (ellipsis?1261 (lambda (x1491) (and (nonsymbol-id?1215 x1491) (free-id=?1239 x1491 (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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-void1260 (lambda () (build-annotated1193 #f (cons (build-annotated1193 #f (quote if)) (quote (#f #f)))))) (eval-local-transformer1259 (lambda (expanded1492 mod1493) (let ((p1494 (local-eval-hook1190 expanded1492 mod1493))) (if (procedure? p1494) p1494 (syntax-violation #f "nonprocedure transformer" p1494))))) (chi-local-syntax1258 (lambda (rec?1495 e1496 r1497 w1498 s1499 mod1500 k1501) ((lambda (tmp1502) ((lambda (tmp1503) (if tmp1503 (apply (lambda (_1504 id1505 val1506 e11507 e21508) (let ((ids1509 id1505)) (if (not (valid-bound-ids?1241 ids1509)) (syntax-violation #f "duplicate bound keyword" e1496) (let ((labels1511 (gen-labels1222 ids1509))) (let ((new-w1512 (make-binding-wrap1233 ids1509 labels1511 w1498))) (k1501 (cons e11507 e21508) (extend-env1210 labels1511 (let ((w1514 (if rec?1495 new-w1512 w1498)) (trans-r1515 (macros-only-env1212 r1497))) (map (lambda (x1516) (cons (quote macro) (eval-local-transformer1259 (chi1252 x1516 trans-r1515 w1514 mod1500) mod1500))) val1506)) r1497) new-w1512 s1499 mod1500)))))) tmp1503) ((lambda (_1518) (syntax-violation #f "bad local syntax definition" (source-wrap1245 e1496 w1498 s1499 mod1500))) tmp1502))) ($sc-dispatch tmp1502 (quote (any #(each (any any)) any . each-any))))) e1496))) (chi-lambda-clause1257 (lambda (e1519 docstring1520 c1521 r1522 w1523 mod1524 k1525) ((lambda (tmp1526) ((lambda (tmp1527) (if (if tmp1527 (apply (lambda (args1528 doc1529 e11530 e21531) (and (string? (syntax->datum doc1529)) (not docstring1520))) tmp1527) #f) (apply (lambda (args1532 doc1533 e11534 e21535) (chi-lambda-clause1257 e1519 doc1533 (cons args1532 (cons e11534 e21535)) r1522 w1523 mod1524 k1525)) tmp1527) ((lambda (tmp1537) (if tmp1537 (apply (lambda (id1538 e11539 e21540) (let ((ids1541 id1538)) (if (not (valid-bound-ids?1241 ids1541)) (syntax-violation (quote lambda) "invalid parameter list" e1519) (let ((labels1543 (gen-labels1222 ids1541)) (new-vars1544 (map gen-var1264 ids1541))) (k1525 new-vars1544 docstring1520 (chi-body1256 (cons e11539 e21540) e1519 (extend-var-env1211 labels1543 new-vars1544 r1522) (make-binding-wrap1233 ids1541 labels1543 w1523) mod1524)))))) tmp1537) ((lambda (tmp1546) (if tmp1546 (apply (lambda (ids1547 e11548 e21549) (let ((old-ids1550 (lambda-var-list1265 ids1547))) (if (not (valid-bound-ids?1241 old-ids1550)) (syntax-violation (quote lambda) "invalid parameter list" e1519) (let ((labels1551 (gen-labels1222 old-ids1550)) (new-vars1552 (map gen-var1264 old-ids1550))) (k1525 (let f1553 ((ls11554 (cdr new-vars1552)) (ls21555 (car new-vars1552))) (if (null? ls11554) ls21555 (f1553 (cdr ls11554) (cons (car ls11554) ls21555)))) docstring1520 (chi-body1256 (cons e11548 e21549) e1519 (extend-var-env1211 labels1551 new-vars1552 r1522) (make-binding-wrap1233 old-ids1550 labels1551 w1523) mod1524)))))) tmp1546) ((lambda (_1557) (syntax-violation (quote lambda) "bad lambda" e1519)) tmp1526))) ($sc-dispatch tmp1526 (quote (any any . each-any)))))) ($sc-dispatch tmp1526 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1526 (quote (any any any . each-any))))) c1521))) (chi-body1256 (lambda (body1558 outer-form1559 r1560 w1561 mod1562) (let ((r1563 (cons (quote ("placeholder" placeholder)) r1560))) (let ((ribcage1564 (make-ribcage1223 (quote ()) (quote ()) (quote ())))) (let ((w1565 (make-wrap1218 (wrap-marks1219 w1561) (cons ribcage1564 (wrap-subst1220 w1561))))) (let parse1566 ((body1567 (map (lambda (x1573) (cons r1563 (wrap1244 x1573 w1565 mod1562))) body1558)) (ids1568 (quote ())) (labels1569 (quote ())) (vars1570 (quote ())) (vals1571 (quote ())) (bindings1572 (quote ()))) (if (null? body1567) (syntax-violation #f "no expressions in body" outer-form1559) (let ((e1574 (cdar body1567)) (er1575 (caar body1567))) (call-with-values (lambda () (syntax-type1250 e1574 er1575 (quote (())) #f ribcage1564 mod1562)) (lambda (type1576 value1577 e1578 w1579 s1580 mod1581) (let ((t1582 type1576)) (if (memv t1582 (quote (define-form))) (let ((id1583 (wrap1244 value1577 w1579 mod1581)) (label1584 (gen-label1221))) (let ((var1585 (gen-var1264 id1583))) (begin (extend-ribcage!1232 ribcage1564 id1583 label1584) (parse1566 (cdr body1567) (cons id1583 ids1568) (cons label1584 labels1569) (cons var1585 vars1570) (cons (cons er1575 (wrap1244 e1578 w1579 mod1581)) vals1571) (cons (cons (quote lexical) var1585) bindings1572))))) (if (memv t1582 (quote (define-syntax-form))) (let ((id1586 (wrap1244 value1577 w1579 mod1581)) (label1587 (gen-label1221))) (begin (extend-ribcage!1232 ribcage1564 id1586 label1587) (parse1566 (cdr body1567) (cons id1586 ids1568) (cons label1587 labels1569) vars1570 vals1571 (cons (cons (quote macro) (cons er1575 (wrap1244 e1578 w1579 mod1581))) bindings1572)))) (if (memv t1582 (quote (begin-form))) ((lambda (tmp1588) ((lambda (tmp1589) (if tmp1589 (apply (lambda (_1590 e11591) (parse1566 (let f1592 ((forms1593 e11591)) (if (null? forms1593) (cdr body1567) (cons (cons er1575 (wrap1244 (car forms1593) w1579 mod1581)) (f1592 (cdr forms1593))))) ids1568 labels1569 vars1570 vals1571 bindings1572)) tmp1589) (syntax-violation #f "source expression failed to match any pattern" tmp1588))) ($sc-dispatch tmp1588 (quote (any . each-any))))) e1578) (if (memv t1582 (quote (local-syntax-form))) (chi-local-syntax1258 value1577 e1578 er1575 w1579 s1580 mod1581 (lambda (forms1595 er1596 w1597 s1598 mod1599) (parse1566 (let f1600 ((forms1601 forms1595)) (if (null? forms1601) (cdr body1567) (cons (cons er1596 (wrap1244 (car forms1601) w1597 mod1599)) (f1600 (cdr forms1601))))) ids1568 labels1569 vars1570 vals1571 bindings1572))) (if (null? ids1568) (build-sequence1195 #f (map (lambda (x1602) (chi1252 (cdr x1602) (car x1602) (quote (())) mod1581)) (cons (cons er1575 (source-wrap1245 e1578 w1579 s1580 mod1581)) (cdr body1567)))) (begin (if (not (valid-bound-ids?1241 ids1568)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1559)) (let loop1603 ((bs1604 bindings1572) (er-cache1605 #f) (r-cache1606 #f)) (if (not (null? bs1604)) (let ((b1607 (car bs1604))) (if (eq? (car b1607) (quote macro)) (let ((er1608 (cadr b1607))) (let ((r-cache1609 (if (eq? er1608 er-cache1605) r-cache1606 (macros-only-env1212 er1608)))) (begin (set-cdr! b1607 (eval-local-transformer1259 (chi1252 (cddr b1607) r-cache1609 (quote (())) mod1581) mod1581)) (loop1603 (cdr bs1604) er1608 r-cache1609)))) (loop1603 (cdr bs1604) er-cache1605 r-cache1606))))) (set-cdr! r1563 (extend-env1210 labels1569 bindings1572 (cdr r1563))) (build-letrec1198 #f vars1570 (map (lambda (x1610) (chi1252 (cdr x1610) (car x1610) (quote (())) mod1581)) vals1571) (build-sequence1195 #f (map (lambda (x1611) (chi1252 (cdr x1611) (car x1611) (quote (())) mod1581)) (cons (cons er1575 (source-wrap1245 e1578 w1579 s1580 mod1581)) (cdr body1567)))))))))))))))))))))) (chi-macro1255 (lambda (p1612 e1613 r1614 w1615 rib1616 mod1617) (letrec ((rebuild-macro-output1618 (lambda (x1619 m1620) (cond ((pair? x1619) (cons (rebuild-macro-output1618 (car x1619) m1620) (rebuild-macro-output1618 (cdr x1619) m1620))) ((syntax-object?1200 x1619) (let ((w1621 (syntax-object-wrap1202 x1619))) (let ((ms1622 (wrap-marks1219 w1621)) (s1623 (wrap-subst1220 w1621))) (if (and (pair? ms1622) (eq? (car ms1622) #f)) (make-syntax-object1199 (syntax-object-expression1201 x1619) (make-wrap1218 (cdr ms1622) (if rib1616 (cons rib1616 (cdr s1623)) (cdr s1623))) (syntax-object-module1203 x1619)) (make-syntax-object1199 (syntax-object-expression1201 x1619) (make-wrap1218 (cons m1620 ms1622) (if rib1616 (cons rib1616 (cons (quote shift) s1623)) (cons (quote shift) s1623))) (let ((pmod1624 (procedure-module p1612))) (if pmod1624 (cons (quote hygiene) (module-name pmod1624)) (quote (hygiene guile))))))))) ((vector? x1619) (let ((n1625 (vector-length x1619))) (let ((v1626 (make-vector n1625))) (let doloop1627 ((i1628 0)) (if (fx=1187 i1628 n1625) v1626 (begin (vector-set! v1626 i1628 (rebuild-macro-output1618 (vector-ref x1619 i1628) m1620)) (doloop1627 (fx+1185 i1628 1)))))))) ((symbol? x1619) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1245 e1613 w1615 s mod1617) x1619)) (else x1619))))) (rebuild-macro-output1618 (p1612 (wrap1244 e1613 (anti-mark1231 w1615) mod1617)) (string #\m))))) (chi-application1254 (lambda (x1629 e1630 r1631 w1632 s1633 mod1634) ((lambda (tmp1635) ((lambda (tmp1636) (if tmp1636 (apply (lambda (e01637 e11638) (build-annotated1193 s1633 (cons x1629 (map (lambda (e1639) (chi1252 e1639 r1631 w1632 mod1634)) e11638)))) tmp1636) (syntax-violation #f "source expression failed to match any pattern" tmp1635))) ($sc-dispatch tmp1635 (quote (any . each-any))))) e1630))) (chi-expr1253 (lambda (type1641 value1642 e1643 r1644 w1645 s1646 mod1647) (let ((t1648 type1641)) (if (memv t1648 (quote (lexical))) (build-annotated1193 s1646 value1642) (if (memv t1648 (quote (core external-macro))) (value1642 e1643 r1644 w1645 s1646 mod1647) (if (memv t1648 (quote (module-ref))) (call-with-values (lambda () (value1642 e1643)) (lambda (id1649 mod1650) (build-annotated1193 s1646 (if mod1650 (make-module-ref (cdr mod1650) id1649 (car mod1650)) (make-module-ref mod1650 id1649 (quote bare)))))) (if (memv t1648 (quote (lexical-call))) (chi-application1254 (build-annotated1193 (source-annotation1207 (car e1643)) value1642) e1643 r1644 w1645 s1646 mod1647) (if (memv t1648 (quote (global-call))) (chi-application1254 (build-annotated1193 (source-annotation1207 (car e1643)) (if (if (syntax-object?1200 (car e1643)) (syntax-object-module1203 (car e1643)) mod1647) (make-module-ref (cdr (if (syntax-object?1200 (car e1643)) (syntax-object-module1203 (car e1643)) mod1647)) value1642 (car (if (syntax-object?1200 (car e1643)) (syntax-object-module1203 (car e1643)) mod1647))) (make-module-ref (if (syntax-object?1200 (car e1643)) (syntax-object-module1203 (car e1643)) mod1647) value1642 (quote bare)))) e1643 r1644 w1645 s1646 mod1647) (if (memv t1648 (quote (constant))) (build-data1194 s1646 (strip1263 (source-wrap1245 e1643 w1645 s1646 mod1647) (quote (())))) (if (memv t1648 (quote (global))) (build-annotated1193 s1646 (if mod1647 (make-module-ref (cdr mod1647) value1642 (car mod1647)) (make-module-ref mod1647 value1642 (quote bare)))) (if (memv t1648 (quote (call))) (chi-application1254 (chi1252 (car e1643) r1644 w1645 mod1647) e1643 r1644 w1645 s1646 mod1647) (if (memv t1648 (quote (begin-form))) ((lambda (tmp1651) ((lambda (tmp1652) (if tmp1652 (apply (lambda (_1653 e11654 e21655) (chi-sequence1246 (cons e11654 e21655) r1644 w1645 s1646 mod1647)) tmp1652) (syntax-violation #f "source expression failed to match any pattern" tmp1651))) ($sc-dispatch tmp1651 (quote (any any . each-any))))) e1643) (if (memv t1648 (quote (local-syntax-form))) (chi-local-syntax1258 value1642 e1643 r1644 w1645 s1646 mod1647 chi-sequence1246) (if (memv t1648 (quote (eval-when-form))) ((lambda (tmp1657) ((lambda (tmp1658) (if tmp1658 (apply (lambda (_1659 x1660 e11661 e21662) (let ((when-list1663 (chi-when-list1249 e1643 x1660 w1645))) (if (memq (quote eval) when-list1663) (chi-sequence1246 (cons e11661 e21662) r1644 w1645 s1646 mod1647) (chi-void1260)))) tmp1658) (syntax-violation #f "source expression failed to match any pattern" tmp1657))) ($sc-dispatch tmp1657 (quote (any each-any any . each-any))))) e1643) (if (memv t1648 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1643 (wrap1244 value1642 w1645 mod1647)) (if (memv t1648 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1245 e1643 w1645 s1646 mod1647)) (if (memv t1648 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1245 e1643 w1645 s1646 mod1647)) (syntax-violation #f "unexpected syntax" (source-wrap1245 e1643 w1645 s1646 mod1647))))))))))))))))))) (chi1252 (lambda (e1666 r1667 w1668 mod1669) (call-with-values (lambda () (syntax-type1250 e1666 r1667 w1668 #f #f mod1669)) (lambda (type1670 value1671 e1672 w1673 s1674 mod1675) (chi-expr1253 type1670 value1671 e1672 r1667 w1673 s1674 mod1675))))) (chi-top1251 (lambda (e1676 r1677 w1678 m1679 esew1680 mod1681) (call-with-values (lambda () (syntax-type1250 e1676 r1677 w1678 #f #f mod1681)) (lambda (type1689 value1690 e1691 w1692 s1693 mod1694) (let ((t1695 type1689)) (if (memv t1695 (quote (begin-form))) ((lambda (tmp1696) ((lambda (tmp1697) (if tmp1697 (apply (lambda (_1698) (chi-void1260)) tmp1697) ((lambda (tmp1699) (if tmp1699 (apply (lambda (_1700 e11701 e21702) (chi-top-sequence1247 (cons e11701 e21702) r1677 w1692 s1693 m1679 esew1680 mod1694)) tmp1699) (syntax-violation #f "source expression failed to match any pattern" tmp1696))) ($sc-dispatch tmp1696 (quote (any any . each-any)))))) ($sc-dispatch tmp1696 (quote (any))))) e1691) (if (memv t1695 (quote (local-syntax-form))) (chi-local-syntax1258 value1690 e1691 r1677 w1692 s1693 mod1694 (lambda (body1704 r1705 w1706 s1707 mod1708) (chi-top-sequence1247 body1704 r1705 w1706 s1707 m1679 esew1680 mod1708))) (if (memv t1695 (quote (eval-when-form))) ((lambda (tmp1709) ((lambda (tmp1710) (if tmp1710 (apply (lambda (_1711 x1712 e11713 e21714) (let ((when-list1715 (chi-when-list1249 e1691 x1712 w1692)) (body1716 (cons e11713 e21714))) (cond ((eq? m1679 (quote e)) (if (memq (quote eval) when-list1715) (chi-top-sequence1247 body1716 r1677 w1692 s1693 (quote e) (quote (eval)) mod1694) (chi-void1260))) ((memq (quote load) when-list1715) (if (or (memq (quote compile) when-list1715) (and (eq? m1679 (quote c&e)) (memq (quote eval) when-list1715))) (chi-top-sequence1247 body1716 r1677 w1692 s1693 (quote c&e) (quote (compile load)) mod1694) (if (memq m1679 (quote (c c&e))) (chi-top-sequence1247 body1716 r1677 w1692 s1693 (quote c) (quote (load)) mod1694) (chi-void1260)))) ((or (memq (quote compile) when-list1715) (and (eq? m1679 (quote c&e)) (memq (quote eval) when-list1715))) (top-level-eval-hook1189 (chi-top-sequence1247 body1716 r1677 w1692 s1693 (quote e) (quote (eval)) mod1694) mod1694) (chi-void1260)) (else (chi-void1260))))) tmp1710) (syntax-violation #f "source expression failed to match any pattern" tmp1709))) ($sc-dispatch tmp1709 (quote (any each-any any . each-any))))) e1691) (if (memv t1695 (quote (define-syntax-form))) (let ((n1719 (id-var-name1238 value1690 w1692)) (r1720 (macros-only-env1212 r1677))) (let ((t1721 m1679)) (if (memv t1721 (quote (c))) (if (memq (quote compile) esew1680) (let ((e1722 (chi-install-global1248 n1719 (chi1252 e1691 r1720 w1692 mod1694)))) (begin (top-level-eval-hook1189 e1722 mod1694) (if (memq (quote load) esew1680) e1722 (chi-void1260)))) (if (memq (quote load) esew1680) (chi-install-global1248 n1719 (chi1252 e1691 r1720 w1692 mod1694)) (chi-void1260))) (if (memv t1721 (quote (c&e))) (let ((e1723 (chi-install-global1248 n1719 (chi1252 e1691 r1720 w1692 mod1694)))) (begin (top-level-eval-hook1189 e1723 mod1694) e1723)) (begin (if (memq (quote eval) esew1680) (top-level-eval-hook1189 (chi-install-global1248 n1719 (chi1252 e1691 r1720 w1692 mod1694)) mod1694)) (chi-void1260)))))) (if (memv t1695 (quote (define-form))) (let ((n1724 (id-var-name1238 value1690 w1692))) (let ((type1725 (binding-type1208 (lookup1213 n1724 r1677 mod1694)))) (let ((t1726 type1725)) (if (memv t1726 (quote (global core macro module-ref))) (let ((x1727 (build-annotated1193 s1693 (list (quote define) n1724 (chi1252 e1691 r1677 w1692 mod1694))))) (begin (if (eq? m1679 (quote c&e)) (top-level-eval-hook1189 x1727 mod1694)) x1727)) (if (memv t1726 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1691 (wrap1244 value1690 w1692 mod1694)) (syntax-violation #f "cannot define keyword at top level" e1691 (wrap1244 value1690 w1692 mod1694))))))) (let ((x1728 (chi-expr1253 type1689 value1690 e1691 r1677 w1692 s1693 mod1694))) (begin (if (eq? m1679 (quote c&e)) (top-level-eval-hook1189 x1728 mod1694)) x1728)))))))))))) (syntax-type1250 (lambda (e1729 r1730 w1731 s1732 rib1733 mod1734) (cond ((symbol? e1729) (let ((n1735 (id-var-name1238 e1729 w1731))) (let ((b1736 (lookup1213 n1735 r1730 mod1734))) (let ((type1737 (binding-type1208 b1736))) (let ((t1738 type1737)) (if (memv t1738 (quote (lexical))) (values type1737 (binding-value1209 b1736) e1729 w1731 s1732 mod1734) (if (memv t1738 (quote (global))) (values type1737 n1735 e1729 w1731 s1732 mod1734) (if (memv t1738 (quote (macro))) (syntax-type1250 (chi-macro1255 (binding-value1209 b1736) e1729 r1730 w1731 rib1733 mod1734) r1730 (quote (())) s1732 rib1733 mod1734) (values type1737 (binding-value1209 b1736) e1729 w1731 s1732 mod1734))))))))) ((pair? e1729) (let ((first1739 (car e1729))) (if (id?1216 first1739) (let ((n1740 (id-var-name1238 first1739 w1731))) (let ((b1741 (lookup1213 n1740 r1730 (or (and (syntax-object?1200 first1739) (syntax-object-module1203 first1739)) mod1734)))) (let ((type1742 (binding-type1208 b1741))) (let ((t1743 type1742)) (if (memv t1743 (quote (lexical))) (values (quote lexical-call) (binding-value1209 b1741) e1729 w1731 s1732 mod1734) (if (memv t1743 (quote (global))) (values (quote global-call) n1740 e1729 w1731 s1732 mod1734) (if (memv t1743 (quote (macro))) (syntax-type1250 (chi-macro1255 (binding-value1209 b1741) e1729 r1730 w1731 rib1733 mod1734) r1730 (quote (())) s1732 rib1733 mod1734) (if (memv t1743 (quote (core external-macro module-ref))) (values type1742 (binding-value1209 b1741) e1729 w1731 s1732 mod1734) (if (memv t1743 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1209 b1741) e1729 w1731 s1732 mod1734) (if (memv t1743 (quote (begin))) (values (quote begin-form) #f e1729 w1731 s1732 mod1734) (if (memv t1743 (quote (eval-when))) (values (quote eval-when-form) #f e1729 w1731 s1732 mod1734) (if (memv t1743 (quote (define))) ((lambda (tmp1744) ((lambda (tmp1745) (if (if tmp1745 (apply (lambda (_1746 name1747 val1748) (id?1216 name1747)) tmp1745) #f) (apply (lambda (_1749 name1750 val1751) (values (quote define-form) name1750 val1751 w1731 s1732 mod1734)) tmp1745) ((lambda (tmp1752) (if (if tmp1752 (apply (lambda (_1753 name1754 args1755 e11756 e21757) (and (id?1216 name1754) (valid-bound-ids?1241 (lambda-var-list1265 args1755)))) tmp1752) #f) (apply (lambda (_1758 name1759 args1760 e11761 e21762) (values (quote define-form) (wrap1244 name1759 w1731 mod1734) (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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) (wrap1244 (cons args1760 (cons e11761 e21762)) w1731 mod1734)) (quote (())) s1732 mod1734)) tmp1752) ((lambda (tmp1764) (if (if tmp1764 (apply (lambda (_1765 name1766) (id?1216 name1766)) tmp1764) #f) (apply (lambda (_1767 name1768) (values (quote define-form) (wrap1244 name1768 w1731 mod1734) (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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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 (())) s1732 mod1734)) tmp1764) (syntax-violation #f "source expression failed to match any pattern" tmp1744))) ($sc-dispatch tmp1744 (quote (any any)))))) ($sc-dispatch tmp1744 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1744 (quote (any any any))))) e1729) (if (memv t1743 (quote (define-syntax))) ((lambda (tmp1769) ((lambda (tmp1770) (if (if tmp1770 (apply (lambda (_1771 name1772 val1773) (id?1216 name1772)) tmp1770) #f) (apply (lambda (_1774 name1775 val1776) (values (quote define-syntax-form) name1775 val1776 w1731 s1732 mod1734)) tmp1770) (syntax-violation #f "source expression failed to match any pattern" tmp1769))) ($sc-dispatch tmp1769 (quote (any any any))))) e1729) (values (quote call) #f e1729 w1731 s1732 mod1734)))))))))))))) (values (quote call) #f e1729 w1731 s1732 mod1734)))) ((syntax-object?1200 e1729) (syntax-type1250 (syntax-object-expression1201 e1729) r1730 (join-wraps1235 w1731 (syntax-object-wrap1202 e1729)) #f rib1733 (or (syntax-object-module1203 e1729) mod1734))) ((annotation? e1729) (syntax-type1250 (annotation-expression e1729) r1730 w1731 (annotation-source e1729) rib1733 mod1734)) ((self-evaluating? e1729) (values (quote constant) #f e1729 w1731 s1732 mod1734)) (else (values (quote other) #f e1729 w1731 s1732 mod1734))))) (chi-when-list1249 (lambda (e1777 when-list1778 w1779) (let f1780 ((when-list1781 when-list1778) (situations1782 (quote ()))) (if (null? when-list1781) situations1782 (f1780 (cdr when-list1781) (cons (let ((x1783 (car when-list1781))) (cond ((free-id=?1239 x1783 (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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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=?1239 x1783 (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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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=?1239 x1783 (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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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" e1777 (wrap1244 x1783 w1779 #f))))) situations1782)))))) (chi-install-global1248 (lambda (name1784 e1785) (build-annotated1193 #f (list (build-annotated1193 #f (quote define)) name1784 (if (let ((v1786 (module-variable (current-module) name1784))) (and v1786 (variable-bound? v1786) (macro? (variable-ref v1786)) (not (eq? (macro-type (variable-ref v1786)) (quote syncase-macro))))) (build-annotated1193 #f (list (build-annotated1193 #f (quote make-extended-syncase-macro)) (build-annotated1193 #f (list (build-annotated1193 #f (quote module-ref)) (build-annotated1193 #f (quote (current-module))) (build-data1194 #f name1784))) (build-data1194 #f (quote macro)) e1785)) (build-annotated1193 #f (list (build-annotated1193 #f (quote make-syncase-macro)) (build-data1194 #f (quote macro)) e1785))))))) (chi-top-sequence1247 (lambda (body1787 r1788 w1789 s1790 m1791 esew1792 mod1793) (build-sequence1195 s1790 (let dobody1794 ((body1795 body1787) (r1796 r1788) (w1797 w1789) (m1798 m1791) (esew1799 esew1792) (mod1800 mod1793)) (if (null? body1795) (quote ()) (let ((first1801 (chi-top1251 (car body1795) r1796 w1797 m1798 esew1799 mod1800))) (cons first1801 (dobody1794 (cdr body1795) r1796 w1797 m1798 esew1799 mod1800)))))))) (chi-sequence1246 (lambda (body1802 r1803 w1804 s1805 mod1806) (build-sequence1195 s1805 (let dobody1807 ((body1808 body1802) (r1809 r1803) (w1810 w1804) (mod1811 mod1806)) (if (null? body1808) (quote ()) (let ((first1812 (chi1252 (car body1808) r1809 w1810 mod1811))) (cons first1812 (dobody1807 (cdr body1808) r1809 w1810 mod1811)))))))) (source-wrap1245 (lambda (x1813 w1814 s1815 defmod1816) (wrap1244 (if s1815 (make-annotation x1813 s1815 #f) x1813) w1814 defmod1816))) (wrap1244 (lambda (x1817 w1818 defmod1819) (cond ((and (null? (wrap-marks1219 w1818)) (null? (wrap-subst1220 w1818))) x1817) ((syntax-object?1200 x1817) (make-syntax-object1199 (syntax-object-expression1201 x1817) (join-wraps1235 w1818 (syntax-object-wrap1202 x1817)) (syntax-object-module1203 x1817))) ((null? x1817) x1817) (else (make-syntax-object1199 x1817 w1818 defmod1819))))) (bound-id-member?1243 (lambda (x1820 list1821) (and (not (null? list1821)) (or (bound-id=?1240 x1820 (car list1821)) (bound-id-member?1243 x1820 (cdr list1821)))))) (distinct-bound-ids?1242 (lambda (ids1822) (let distinct?1823 ((ids1824 ids1822)) (or (null? ids1824) (and (not (bound-id-member?1243 (car ids1824) (cdr ids1824))) (distinct?1823 (cdr ids1824))))))) (valid-bound-ids?1241 (lambda (ids1825) (and (let all-ids?1826 ((ids1827 ids1825)) (or (null? ids1827) (and (id?1216 (car ids1827)) (all-ids?1826 (cdr ids1827))))) (distinct-bound-ids?1242 ids1825)))) (bound-id=?1240 (lambda (i1828 j1829) (if (and (syntax-object?1200 i1828) (syntax-object?1200 j1829)) (and (eq? (let ((e1830 (syntax-object-expression1201 i1828))) (if (annotation? e1830) (annotation-expression e1830) e1830)) (let ((e1831 (syntax-object-expression1201 j1829))) (if (annotation? e1831) (annotation-expression e1831) e1831))) (same-marks?1237 (wrap-marks1219 (syntax-object-wrap1202 i1828)) (wrap-marks1219 (syntax-object-wrap1202 j1829)))) (eq? (let ((e1832 i1828)) (if (annotation? e1832) (annotation-expression e1832) e1832)) (let ((e1833 j1829)) (if (annotation? e1833) (annotation-expression e1833) e1833)))))) (free-id=?1239 (lambda (i1834 j1835) (and (eq? (let ((x1836 i1834)) (let ((e1837 (if (syntax-object?1200 x1836) (syntax-object-expression1201 x1836) x1836))) (if (annotation? e1837) (annotation-expression e1837) e1837))) (let ((x1838 j1835)) (let ((e1839 (if (syntax-object?1200 x1838) (syntax-object-expression1201 x1838) x1838))) (if (annotation? e1839) (annotation-expression e1839) e1839)))) (eq? (id-var-name1238 i1834 (quote (()))) (id-var-name1238 j1835 (quote (()))))))) (id-var-name1238 (lambda (id1840 w1841) (letrec ((search-vector-rib1844 (lambda (sym1850 subst1851 marks1852 symnames1853 ribcage1854) (let ((n1855 (vector-length symnames1853))) (let f1856 ((i1857 0)) (cond ((fx=1187 i1857 n1855) (search1842 sym1850 (cdr subst1851) marks1852)) ((and (eq? (vector-ref symnames1853 i1857) sym1850) (same-marks?1237 marks1852 (vector-ref (ribcage-marks1226 ribcage1854) i1857))) (values (vector-ref (ribcage-labels1227 ribcage1854) i1857) marks1852)) (else (f1856 (fx+1185 i1857 1)))))))) (search-list-rib1843 (lambda (sym1858 subst1859 marks1860 symnames1861 ribcage1862) (let f1863 ((symnames1864 symnames1861) (i1865 0)) (cond ((null? symnames1864) (search1842 sym1858 (cdr subst1859) marks1860)) ((and (eq? (car symnames1864) sym1858) (same-marks?1237 marks1860 (list-ref (ribcage-marks1226 ribcage1862) i1865))) (values (list-ref (ribcage-labels1227 ribcage1862) i1865) marks1860)) (else (f1863 (cdr symnames1864) (fx+1185 i1865 1))))))) (search1842 (lambda (sym1866 subst1867 marks1868) (if (null? subst1867) (values #f marks1868) (let ((fst1869 (car subst1867))) (if (eq? fst1869 (quote shift)) (search1842 sym1866 (cdr subst1867) (cdr marks1868)) (let ((symnames1870 (ribcage-symnames1225 fst1869))) (if (vector? symnames1870) (search-vector-rib1844 sym1866 subst1867 marks1868 symnames1870 fst1869) (search-list-rib1843 sym1866 subst1867 marks1868 symnames1870 fst1869))))))))) (cond ((symbol? id1840) (or (call-with-values (lambda () (search1842 id1840 (wrap-subst1220 w1841) (wrap-marks1219 w1841))) (lambda (x1872 . ignore1871) x1872)) id1840)) ((syntax-object?1200 id1840) (let ((id1873 (let ((e1875 (syntax-object-expression1201 id1840))) (if (annotation? e1875) (annotation-expression e1875) e1875))) (w11874 (syntax-object-wrap1202 id1840))) (let ((marks1876 (join-marks1236 (wrap-marks1219 w1841) (wrap-marks1219 w11874)))) (call-with-values (lambda () (search1842 id1873 (wrap-subst1220 w1841) marks1876)) (lambda (new-id1877 marks1878) (or new-id1877 (call-with-values (lambda () (search1842 id1873 (wrap-subst1220 w11874) marks1878)) (lambda (x1880 . ignore1879) x1880)) id1873)))))) ((annotation? id1840) (let ((id1881 (let ((e1882 id1840)) (if (annotation? e1882) (annotation-expression e1882) e1882)))) (or (call-with-values (lambda () (search1842 id1881 (wrap-subst1220 w1841) (wrap-marks1219 w1841))) (lambda (x1884 . ignore1883) x1884)) id1881))) (else (syntax-violation (quote id-var-name) "invalid id" id1840)))))) (same-marks?1237 (lambda (x1885 y1886) (or (eq? x1885 y1886) (and (not (null? x1885)) (not (null? y1886)) (eq? (car x1885) (car y1886)) (same-marks?1237 (cdr x1885) (cdr y1886)))))) (join-marks1236 (lambda (m11887 m21888) (smart-append1234 m11887 m21888))) (join-wraps1235 (lambda (w11889 w21890) (let ((m11891 (wrap-marks1219 w11889)) (s11892 (wrap-subst1220 w11889))) (if (null? m11891) (if (null? s11892) w21890 (make-wrap1218 (wrap-marks1219 w21890) (smart-append1234 s11892 (wrap-subst1220 w21890)))) (make-wrap1218 (smart-append1234 m11891 (wrap-marks1219 w21890)) (smart-append1234 s11892 (wrap-subst1220 w21890))))))) (smart-append1234 (lambda (m11893 m21894) (if (null? m21894) m11893 (append m11893 m21894)))) (make-binding-wrap1233 (lambda (ids1895 labels1896 w1897) (if (null? ids1895) w1897 (make-wrap1218 (wrap-marks1219 w1897) (cons (let ((labelvec1898 (list->vector labels1896))) (let ((n1899 (vector-length labelvec1898))) (let ((symnamevec1900 (make-vector n1899)) (marksvec1901 (make-vector n1899))) (begin (let f1902 ((ids1903 ids1895) (i1904 0)) (if (not (null? ids1903)) (call-with-values (lambda () (id-sym-name&marks1217 (car ids1903) w1897)) (lambda (symname1905 marks1906) (begin (vector-set! symnamevec1900 i1904 symname1905) (vector-set! marksvec1901 i1904 marks1906) (f1902 (cdr ids1903) (fx+1185 i1904 1))))))) (make-ribcage1223 symnamevec1900 marksvec1901 labelvec1898))))) (wrap-subst1220 w1897)))))) (extend-ribcage!1232 (lambda (ribcage1907 id1908 label1909) (begin (set-ribcage-symnames!1228 ribcage1907 (cons (let ((e1910 (syntax-object-expression1201 id1908))) (if (annotation? e1910) (annotation-expression e1910) e1910)) (ribcage-symnames1225 ribcage1907))) (set-ribcage-marks!1229 ribcage1907 (cons (wrap-marks1219 (syntax-object-wrap1202 id1908)) (ribcage-marks1226 ribcage1907))) (set-ribcage-labels!1230 ribcage1907 (cons label1909 (ribcage-labels1227 ribcage1907)))))) (anti-mark1231 (lambda (w1911) (make-wrap1218 (cons #f (wrap-marks1219 w1911)) (cons (quote shift) (wrap-subst1220 w1911))))) (set-ribcage-labels!1230 (lambda (x1912 update1913) (vector-set! x1912 3 update1913))) (set-ribcage-marks!1229 (lambda (x1914 update1915) (vector-set! x1914 2 update1915))) (set-ribcage-symnames!1228 (lambda (x1916 update1917) (vector-set! x1916 1 update1917))) (ribcage-labels1227 (lambda (x1918) (vector-ref x1918 3))) (ribcage-marks1226 (lambda (x1919) (vector-ref x1919 2))) (ribcage-symnames1225 (lambda (x1920) (vector-ref x1920 1))) (ribcage?1224 (lambda (x1921) (and (vector? x1921) (= (vector-length x1921) 4) (eq? (vector-ref x1921 0) (quote ribcage))))) (make-ribcage1223 (lambda (symnames1922 marks1923 labels1924) (vector (quote ribcage) symnames1922 marks1923 labels1924))) (gen-labels1222 (lambda (ls1925) (if (null? ls1925) (quote ()) (cons (gen-label1221) (gen-labels1222 (cdr ls1925)))))) (gen-label1221 (lambda () (string #\i))) (wrap-subst1220 cdr) (wrap-marks1219 car) (make-wrap1218 cons) (id-sym-name&marks1217 (lambda (x1926 w1927) (if (syntax-object?1200 x1926) (values (let ((e1928 (syntax-object-expression1201 x1926))) (if (annotation? e1928) (annotation-expression e1928) e1928)) (join-marks1236 (wrap-marks1219 w1927) (wrap-marks1219 (syntax-object-wrap1202 x1926)))) (values (let ((e1929 x1926)) (if (annotation? e1929) (annotation-expression e1929) e1929)) (wrap-marks1219 w1927))))) (id?1216 (lambda (x1930) (cond ((symbol? x1930) #t) ((syntax-object?1200 x1930) (symbol? (let ((e1931 (syntax-object-expression1201 x1930))) (if (annotation? e1931) (annotation-expression e1931) e1931)))) ((annotation? x1930) (symbol? (annotation-expression x1930))) (else #f)))) (nonsymbol-id?1215 (lambda (x1932) (and (syntax-object?1200 x1932) (symbol? (let ((e1933 (syntax-object-expression1201 x1932))) (if (annotation? e1933) (annotation-expression e1933) e1933)))))) (global-extend1214 (lambda (type1934 sym1935 val1936) (put-global-definition-hook1191 sym1935 type1934 val1936))) (lookup1213 (lambda (x1937 r1938 mod1939) (cond ((assq x1937 r1938) => cdr) ((symbol? x1937) (or (get-global-definition-hook1192 x1937 mod1939) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1212 (lambda (r1940) (if (null? r1940) (quote ()) (let ((a1941 (car r1940))) (if (eq? (cadr a1941) (quote macro)) (cons a1941 (macros-only-env1212 (cdr r1940))) (macros-only-env1212 (cdr r1940))))))) (extend-var-env1211 (lambda (labels1942 vars1943 r1944) (if (null? labels1942) r1944 (extend-var-env1211 (cdr labels1942) (cdr vars1943) (cons (cons (car labels1942) (cons (quote lexical) (car vars1943))) r1944))))) (extend-env1210 (lambda (labels1945 bindings1946 r1947) (if (null? labels1945) r1947 (extend-env1210 (cdr labels1945) (cdr bindings1946) (cons (cons (car labels1945) (car bindings1946)) r1947))))) (binding-value1209 cdr) (binding-type1208 car) (source-annotation1207 (lambda (x1948) (cond ((annotation? x1948) (annotation-source x1948)) ((syntax-object?1200 x1948) (source-annotation1207 (syntax-object-expression1201 x1948))) (else #f)))) (set-syntax-object-module!1206 (lambda (x1949 update1950) (vector-set! x1949 3 update1950))) (set-syntax-object-wrap!1205 (lambda (x1951 update1952) (vector-set! x1951 2 update1952))) (set-syntax-object-expression!1204 (lambda (x1953 update1954) (vector-set! x1953 1 update1954))) (syntax-object-module1203 (lambda (x1955) (vector-ref x1955 3))) (syntax-object-wrap1202 (lambda (x1956) (vector-ref x1956 2))) (syntax-object-expression1201 (lambda (x1957) (vector-ref x1957 1))) (syntax-object?1200 (lambda (x1958) (and (vector? x1958) (= (vector-length x1958) 4) (eq? (vector-ref x1958 0) (quote syntax-object))))) (make-syntax-object1199 (lambda (expression1959 wrap1960 module1961) (vector (quote syntax-object) expression1959 wrap1960 module1961))) (build-letrec1198 (lambda (src1962 vars1963 val-exps1964 body-exp1965) (if (null? vars1963) (build-annotated1193 src1962 body-exp1965) (build-annotated1193 src1962 (list (quote letrec) (map list vars1963 val-exps1964) body-exp1965))))) (build-named-let1197 (lambda (src1966 vars1967 val-exps1968 body-exp1969) (if (null? vars1967) (build-annotated1193 src1966 body-exp1969) (build-annotated1193 src1966 (list (quote let) (car vars1967) (map list (cdr vars1967) val-exps1968) body-exp1969))))) (build-let1196 (lambda (src1970 vars1971 val-exps1972 body-exp1973) (if (null? vars1971) (build-annotated1193 src1970 body-exp1973) (build-annotated1193 src1970 (list (quote let) (map list vars1971 val-exps1972) body-exp1973))))) (build-sequence1195 (lambda (src1974 exps1975) (if (null? (cdr exps1975)) (build-annotated1193 src1974 (car exps1975)) (build-annotated1193 src1974 (cons (quote begin) exps1975))))) (build-data1194 (lambda (src1976 exp1977) (if (and (self-evaluating? exp1977) (not (vector? exp1977))) (build-annotated1193 src1976 exp1977) (build-annotated1193 src1976 (list (quote quote) exp1977))))) (build-annotated1193 (lambda (src1978 exp1979) (if (and src1978 (not (annotation? exp1979))) (make-annotation exp1979 src1978 #t) exp1979))) (get-global-definition-hook1192 (lambda (symbol1980 module1981) (begin (if (and (not module1981) (current-module)) (warn "module system is booted, we should have a module" symbol1980)) (let ((v1982 (module-variable (if module1981 (resolve-module (cdr module1981)) (current-module)) symbol1980))) (and v1982 (variable-bound? v1982) (let ((val1983 (variable-ref v1982))) (and (macro? val1983) (syncase-macro-type val1983) (cons (syncase-macro-type val1983) (syncase-macro-binding val1983))))))))) (put-global-definition-hook1191 (lambda (symbol1984 type1985 val1986) (let ((existing1987 (let ((v1988 (module-variable (current-module) symbol1984))) (and v1988 (variable-bound? v1988) (let ((val1989 (variable-ref v1988))) (and (macro? val1989) (not (syncase-macro-type val1989)) val1989)))))) (module-define! (current-module) symbol1984 (if existing1987 (make-extended-syncase-macro existing1987 type1985 val1986) (make-syncase-macro type1985 val1986)))))) (local-eval-hook1190 (lambda (x1990 mod1991) (primitive-eval (list noexpand1184 x1990)))) (top-level-eval-hook1189 (lambda (x1992 mod1993) (primitive-eval (list noexpand1184 x1992)))) (fx<1188 <) (fx=1187 =) (fx-1186 -) (fx+1185 +) (noexpand1184 "noexpand")) (begin (global-extend1214 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1214 (quote local-syntax) (quote let-syntax) #f) (global-extend1214 (quote core) (quote fluid-let-syntax) (lambda (e1994 r1995 w1996 s1997 mod1998) ((lambda (tmp1999) ((lambda (tmp2000) (if (if tmp2000 (apply (lambda (_2001 var2002 val2003 e12004 e22005) (valid-bound-ids?1241 var2002)) tmp2000) #f) (apply (lambda (_2007 var2008 val2009 e12010 e22011) (let ((names2012 (map (lambda (x2013) (id-var-name1238 x2013 w1996)) var2008))) (begin (for-each (lambda (id2015 n2016) (let ((t2017 (binding-type1208 (lookup1213 n2016 r1995 mod1998)))) (if (memv t2017 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1994 (source-wrap1245 id2015 w1996 s1997 mod1998))))) var2008 names2012) (chi-body1256 (cons e12010 e22011) (source-wrap1245 e1994 w1996 s1997 mod1998) (extend-env1210 names2012 (let ((trans-r2020 (macros-only-env1212 r1995))) (map (lambda (x2021) (cons (quote macro) (eval-local-transformer1259 (chi1252 x2021 trans-r2020 w1996 mod1998) mod1998))) val2009)) r1995) w1996 mod1998)))) tmp2000) ((lambda (_2023) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1245 e1994 w1996 s1997 mod1998))) tmp1999))) ($sc-dispatch tmp1999 (quote (any #(each (any any)) any . each-any))))) e1994))) (global-extend1214 (quote core) (quote quote) (lambda (e2024 r2025 w2026 s2027 mod2028) ((lambda (tmp2029) ((lambda (tmp2030) (if tmp2030 (apply (lambda (_2031 e2032) (build-data1194 s2027 (strip1263 e2032 w2026))) tmp2030) ((lambda (_2033) (syntax-violation (quote quote) "bad syntax" (source-wrap1245 e2024 w2026 s2027 mod2028))) tmp2029))) ($sc-dispatch tmp2029 (quote (any any))))) e2024))) (global-extend1214 (quote core) (quote syntax) (letrec ((regen2041 (lambda (x2042) (let ((t2043 (car x2042))) (if (memv t2043 (quote (ref))) (build-annotated1193 #f (cadr x2042)) (if (memv t2043 (quote (primitive))) (build-annotated1193 #f (cadr x2042)) (if (memv t2043 (quote (quote))) (build-data1194 #f (cadr x2042)) (if (memv t2043 (quote (lambda))) (build-annotated1193 #f (list (quote lambda) (cadr x2042) (regen2041 (caddr x2042)))) (if (memv t2043 (quote (map))) (let ((ls2044 (map regen2041 (cdr x2042)))) (build-annotated1193 #f (cons (if (fx=1187 (length ls2044) 2) (build-annotated1193 #f (quote map)) (build-annotated1193 #f (quote map))) ls2044))) (build-annotated1193 #f (cons (build-annotated1193 #f (car x2042)) (map regen2041 (cdr x2042)))))))))))) (gen-vector2040 (lambda (x2045) (cond ((eq? (car x2045) (quote list)) (cons (quote vector) (cdr x2045))) ((eq? (car x2045) (quote quote)) (list (quote quote) (list->vector (cadr x2045)))) (else (list (quote list->vector) x2045))))) (gen-append2039 (lambda (x2046 y2047) (if (equal? y2047 (quote (quote ()))) x2046 (list (quote append) x2046 y2047)))) (gen-cons2038 (lambda (x2048 y2049) (let ((t2050 (car y2049))) (if (memv t2050 (quote (quote))) (if (eq? (car x2048) (quote quote)) (list (quote quote) (cons (cadr x2048) (cadr y2049))) (if (eq? (cadr y2049) (quote ())) (list (quote list) x2048) (list (quote cons) x2048 y2049))) (if (memv t2050 (quote (list))) (cons (quote list) (cons x2048 (cdr y2049))) (list (quote cons) x2048 y2049)))))) (gen-map2037 (lambda (e2051 map-env2052) (let ((formals2053 (map cdr map-env2052)) (actuals2054 (map (lambda (x2055) (list (quote ref) (car x2055))) map-env2052))) (cond ((eq? (car e2051) (quote ref)) (car actuals2054)) ((and-map (lambda (x2056) (and (eq? (car x2056) (quote ref)) (memq (cadr x2056) formals2053))) (cdr e2051)) (cons (quote map) (cons (list (quote primitive) (car e2051)) (map (let ((r2057 (map cons formals2053 actuals2054))) (lambda (x2058) (cdr (assq (cadr x2058) r2057)))) (cdr e2051))))) (else (cons (quote map) (cons (list (quote lambda) formals2053 e2051) actuals2054))))))) (gen-mappend2036 (lambda (e2059 map-env2060) (list (quote apply) (quote (primitive append)) (gen-map2037 e2059 map-env2060)))) (gen-ref2035 (lambda (src2061 var2062 level2063 maps2064) (if (fx=1187 level2063 0) (values var2062 maps2064) (if (null? maps2064) (syntax-violation (quote syntax) "missing ellipsis" src2061) (call-with-values (lambda () (gen-ref2035 src2061 var2062 (fx-1186 level2063 1) (cdr maps2064))) (lambda (outer-var2065 outer-maps2066) (let ((b2067 (assq outer-var2065 (car maps2064)))) (if b2067 (values (cdr b2067) maps2064) (let ((inner-var2068 (gen-var1264 (quote tmp)))) (values inner-var2068 (cons (cons (cons outer-var2065 inner-var2068) (car maps2064)) outer-maps2066))))))))))) (gen-syntax2034 (lambda (src2069 e2070 r2071 maps2072 ellipsis?2073 mod2074) (if (id?1216 e2070) (let ((label2075 (id-var-name1238 e2070 (quote (()))))) (let ((b2076 (lookup1213 label2075 r2071 mod2074))) (if (eq? (binding-type1208 b2076) (quote syntax)) (call-with-values (lambda () (let ((var.lev2077 (binding-value1209 b2076))) (gen-ref2035 src2069 (car var.lev2077) (cdr var.lev2077) maps2072))) (lambda (var2078 maps2079) (values (list (quote ref) var2078) maps2079))) (if (ellipsis?2073 e2070) (syntax-violation (quote syntax) "misplaced ellipsis" src2069) (values (list (quote quote) e2070) maps2072))))) ((lambda (tmp2080) ((lambda (tmp2081) (if (if tmp2081 (apply (lambda (dots2082 e2083) (ellipsis?2073 dots2082)) tmp2081) #f) (apply (lambda (dots2084 e2085) (gen-syntax2034 src2069 e2085 r2071 maps2072 (lambda (x2086) #f) mod2074)) tmp2081) ((lambda (tmp2087) (if (if tmp2087 (apply (lambda (x2088 dots2089 y2090) (ellipsis?2073 dots2089)) tmp2087) #f) (apply (lambda (x2091 dots2092 y2093) (let f2094 ((y2095 y2093) (k2096 (lambda (maps2097) (call-with-values (lambda () (gen-syntax2034 src2069 x2091 r2071 (cons (quote ()) maps2097) ellipsis?2073 mod2074)) (lambda (x2098 maps2099) (if (null? (car maps2099)) (syntax-violation (quote syntax) "extra ellipsis" src2069) (values (gen-map2037 x2098 (car maps2099)) (cdr maps2099)))))))) ((lambda (tmp2100) ((lambda (tmp2101) (if (if tmp2101 (apply (lambda (dots2102 y2103) (ellipsis?2073 dots2102)) tmp2101) #f) (apply (lambda (dots2104 y2105) (f2094 y2105 (lambda (maps2106) (call-with-values (lambda () (k2096 (cons (quote ()) maps2106))) (lambda (x2107 maps2108) (if (null? (car maps2108)) (syntax-violation (quote syntax) "extra ellipsis" src2069) (values (gen-mappend2036 x2107 (car maps2108)) (cdr maps2108)))))))) tmp2101) ((lambda (_2109) (call-with-values (lambda () (gen-syntax2034 src2069 y2095 r2071 maps2072 ellipsis?2073 mod2074)) (lambda (y2110 maps2111) (call-with-values (lambda () (k2096 maps2111)) (lambda (x2112 maps2113) (values (gen-append2039 x2112 y2110) maps2113)))))) tmp2100))) ($sc-dispatch tmp2100 (quote (any . any))))) y2095))) tmp2087) ((lambda (tmp2114) (if tmp2114 (apply (lambda (x2115 y2116) (call-with-values (lambda () (gen-syntax2034 src2069 x2115 r2071 maps2072 ellipsis?2073 mod2074)) (lambda (x2117 maps2118) (call-with-values (lambda () (gen-syntax2034 src2069 y2116 r2071 maps2118 ellipsis?2073 mod2074)) (lambda (y2119 maps2120) (values (gen-cons2038 x2117 y2119) maps2120)))))) tmp2114) ((lambda (tmp2121) (if tmp2121 (apply (lambda (e12122 e22123) (call-with-values (lambda () (gen-syntax2034 src2069 (cons e12122 e22123) r2071 maps2072 ellipsis?2073 mod2074)) (lambda (e2125 maps2126) (values (gen-vector2040 e2125) maps2126)))) tmp2121) ((lambda (_2127) (values (list (quote quote) e2070) maps2072)) tmp2080))) ($sc-dispatch tmp2080 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp2080 (quote (any . any)))))) ($sc-dispatch tmp2080 (quote (any any . any)))))) ($sc-dispatch tmp2080 (quote (any any))))) e2070))))) (lambda (e2128 r2129 w2130 s2131 mod2132) (let ((e2133 (source-wrap1245 e2128 w2130 s2131 mod2132))) ((lambda (tmp2134) ((lambda (tmp2135) (if tmp2135 (apply (lambda (_2136 x2137) (call-with-values (lambda () (gen-syntax2034 e2133 x2137 r2129 (quote ()) ellipsis?1261 mod2132)) (lambda (e2138 maps2139) (regen2041 e2138)))) tmp2135) ((lambda (_2140) (syntax-violation (quote syntax) "bad `syntax' form" e2133)) tmp2134))) ($sc-dispatch tmp2134 (quote (any any))))) e2133))))) (global-extend1214 (quote core) (quote lambda) (lambda (e2141 r2142 w2143 s2144 mod2145) ((lambda (tmp2146) ((lambda (tmp2147) (if tmp2147 (apply (lambda (_2148 c2149) (chi-lambda-clause1257 (source-wrap1245 e2141 w2143 s2144 mod2145) #f c2149 r2142 w2143 mod2145 (lambda (vars2150 docstring2151 body2152) (build-annotated1193 s2144 (cons (quote lambda) (cons vars2150 (append (if docstring2151 (list docstring2151) (quote ())) (list body2152)))))))) tmp2147) (syntax-violation #f "source expression failed to match any pattern" tmp2146))) ($sc-dispatch tmp2146 (quote (any . any))))) e2141))) (global-extend1214 (quote core) (quote let) (letrec ((chi-let2153 (lambda (e2154 r2155 w2156 s2157 mod2158 constructor2159 ids2160 vals2161 exps2162) (if (not (valid-bound-ids?1241 ids2160)) (syntax-violation (quote let) "duplicate bound variable" e2154) (let ((labels2163 (gen-labels1222 ids2160)) (new-vars2164 (map gen-var1264 ids2160))) (let ((nw2165 (make-binding-wrap1233 ids2160 labels2163 w2156)) (nr2166 (extend-var-env1211 labels2163 new-vars2164 r2155))) (constructor2159 s2157 new-vars2164 (map (lambda (x2167) (chi1252 x2167 r2155 w2156 mod2158)) vals2161) (chi-body1256 exps2162 (source-wrap1245 e2154 nw2165 s2157 mod2158) nr2166 nw2165 mod2158)))))))) (lambda (e2168 r2169 w2170 s2171 mod2172) ((lambda (tmp2173) ((lambda (tmp2174) (if tmp2174 (apply (lambda (_2175 id2176 val2177 e12178 e22179) (chi-let2153 e2168 r2169 w2170 s2171 mod2172 build-let1196 id2176 val2177 (cons e12178 e22179))) tmp2174) ((lambda (tmp2183) (if (if tmp2183 (apply (lambda (_2184 f2185 id2186 val2187 e12188 e22189) (id?1216 f2185)) tmp2183) #f) (apply (lambda (_2190 f2191 id2192 val2193 e12194 e22195) (chi-let2153 e2168 r2169 w2170 s2171 mod2172 build-named-let1197 (cons f2191 id2192) val2193 (cons e12194 e22195))) tmp2183) ((lambda (_2199) (syntax-violation (quote let) "bad let" (source-wrap1245 e2168 w2170 s2171 mod2172))) tmp2173))) ($sc-dispatch tmp2173 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2173 (quote (any #(each (any any)) any . each-any))))) e2168)))) (global-extend1214 (quote core) (quote letrec) (lambda (e2200 r2201 w2202 s2203 mod2204) ((lambda (tmp2205) ((lambda (tmp2206) (if tmp2206 (apply (lambda (_2207 id2208 val2209 e12210 e22211) (let ((ids2212 id2208)) (if (not (valid-bound-ids?1241 ids2212)) (syntax-violation (quote letrec) "duplicate bound variable" e2200) (let ((labels2214 (gen-labels1222 ids2212)) (new-vars2215 (map gen-var1264 ids2212))) (let ((w2216 (make-binding-wrap1233 ids2212 labels2214 w2202)) (r2217 (extend-var-env1211 labels2214 new-vars2215 r2201))) (build-letrec1198 s2203 new-vars2215 (map (lambda (x2218) (chi1252 x2218 r2217 w2216 mod2204)) val2209) (chi-body1256 (cons e12210 e22211) (source-wrap1245 e2200 w2216 s2203 mod2204) r2217 w2216 mod2204))))))) tmp2206) ((lambda (_2221) (syntax-violation (quote letrec) "bad letrec" (source-wrap1245 e2200 w2202 s2203 mod2204))) tmp2205))) ($sc-dispatch tmp2205 (quote (any #(each (any any)) any . each-any))))) e2200))) (global-extend1214 (quote core) (quote set!) (lambda (e2222 r2223 w2224 s2225 mod2226) ((lambda (tmp2227) ((lambda (tmp2228) (if (if tmp2228 (apply (lambda (_2229 id2230 val2231) (id?1216 id2230)) tmp2228) #f) (apply (lambda (_2232 id2233 val2234) (let ((val2235 (chi1252 val2234 r2223 w2224 mod2226)) (n2236 (id-var-name1238 id2233 w2224))) (let ((b2237 (lookup1213 n2236 r2223 mod2226))) (let ((t2238 (binding-type1208 b2237))) (if (memv t2238 (quote (lexical))) (build-annotated1193 s2225 (list (quote set!) (binding-value1209 b2237) val2235)) (if (memv t2238 (quote (global))) (build-annotated1193 s2225 (list (quote set!) (if mod2226 (make-module-ref (cdr mod2226) n2236 (car mod2226)) (make-module-ref mod2226 n2236 (quote bare))) val2235)) (if (memv t2238 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1244 id2233 w2224 mod2226)) (syntax-violation (quote set!) "bad set!" (source-wrap1245 e2222 w2224 s2225 mod2226))))))))) tmp2228) ((lambda (tmp2239) (if tmp2239 (apply (lambda (_2240 head2241 tail2242 val2243) (call-with-values (lambda () (syntax-type1250 head2241 r2223 (quote (())) #f #f mod2226)) (lambda (type2244 value2245 ee2246 ww2247 ss2248 modmod2249) (let ((t2250 type2244)) (if (memv t2250 (quote (module-ref))) (let ((val2251 (chi1252 val2243 r2223 w2224 mod2226))) (call-with-values (lambda () (value2245 (cons head2241 tail2242))) (lambda (id2253 mod2254) (build-annotated1193 s2225 (list (quote set!) (if mod2254 (make-module-ref (cdr mod2254) id2253 (car mod2254)) (make-module-ref mod2254 id2253 (quote bare))) val2251))))) (build-annotated1193 s2225 (cons (chi1252 (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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) head2241) r2223 w2224 mod2226) (map (lambda (e2255) (chi1252 e2255 r2223 w2224 mod2226)) (append tail2242 (list val2243)))))))))) tmp2239) ((lambda (_2257) (syntax-violation (quote set!) "bad set!" (source-wrap1245 e2222 w2224 s2225 mod2226))) tmp2227))) ($sc-dispatch tmp2227 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2227 (quote (any any any))))) e2222))) (global-extend1214 (quote module-ref) (quote @) (lambda (e2258) ((lambda (tmp2259) ((lambda (tmp2260) (if (if tmp2260 (apply (lambda (_2261 mod2262 id2263) (and (and-map id?1216 mod2262) (id?1216 id2263))) tmp2260) #f) (apply (lambda (_2265 mod2266 id2267) (values (syntax->datum id2267) (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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) mod2266)))) tmp2260) (syntax-violation #f "source expression failed to match any pattern" tmp2259))) ($sc-dispatch tmp2259 (quote (any each-any any))))) e2258))) (global-extend1214 (quote module-ref) (quote @@) (lambda (e2269) ((lambda (tmp2270) ((lambda (tmp2271) (if (if tmp2271 (apply (lambda (_2272 mod2273 id2274) (and (and-map id?1216 mod2273) (id?1216 id2274))) tmp2271) #f) (apply (lambda (_2276 mod2277 id2278) (values (syntax->datum id2278) (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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) mod2277)))) tmp2271) (syntax-violation #f "source expression failed to match any pattern" tmp2270))) ($sc-dispatch tmp2270 (quote (any each-any any))))) e2269))) (global-extend1214 (quote begin) (quote begin) (quote ())) (global-extend1214 (quote define) (quote define) (quote ())) (global-extend1214 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1214 (quote eval-when) (quote eval-when) (quote ())) (global-extend1214 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2283 (lambda (x2284 keys2285 clauses2286 r2287 mod2288) (if (null? clauses2286) (build-annotated1193 #f (list (build-annotated1193 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2284)) ((lambda (tmp2289) ((lambda (tmp2290) (if tmp2290 (apply (lambda (pat2291 exp2292) (if (and (id?1216 pat2291) (and-map (lambda (x2293) (not (free-id=?1239 pat2291 x2293))) (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+ 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) keys2285))) (let ((labels2294 (list (gen-label1221))) (var2295 (gen-var1264 pat2291))) (build-annotated1193 #f (list (build-annotated1193 #f (list (quote lambda) (list var2295) (chi1252 exp2292 (extend-env1210 labels2294 (list (cons (quote syntax) (cons var2295 0))) r2287) (make-binding-wrap1233 (list pat2291) labels2294 (quote (()))) mod2288))) x2284))) (gen-clause2282 x2284 keys2285 (cdr clauses2286) r2287 pat2291 #t exp2292 mod2288))) tmp2290) ((lambda (tmp2296) (if tmp2296 (apply (lambda (pat2297 fender2298 exp2299) (gen-clause2282 x2284 keys2285 (cdr clauses2286) r2287 pat2297 fender2298 exp2299 mod2288)) tmp2296) ((lambda (_2300) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2286))) tmp2289))) ($sc-dispatch tmp2289 (quote (any any any)))))) ($sc-dispatch tmp2289 (quote (any any))))) (car clauses2286))))) (gen-clause2282 (lambda (x2301 keys2302 clauses2303 r2304 pat2305 fender2306 exp2307 mod2308) (call-with-values (lambda () (convert-pattern2280 pat2305 keys2302)) (lambda (p2309 pvars2310) (cond ((not (distinct-bound-ids?1242 (map car pvars2310))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2305)) ((not (and-map (lambda (x2311) (not (ellipsis?1261 (car x2311)))) pvars2310)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2305)) (else (let ((y2312 (gen-var1264 (quote tmp)))) (build-annotated1193 #f (list (build-annotated1193 #f (list (quote lambda) (list y2312) (let ((y2313 (build-annotated1193 #f y2312))) (build-annotated1193 #f (list (quote if) ((lambda (tmp2314) ((lambda (tmp2315) (if tmp2315 (apply (lambda () y2313) tmp2315) ((lambda (_2316) (build-annotated1193 #f (list (quote if) y2313 (build-dispatch-call2281 pvars2310 fender2306 y2313 r2304 mod2308) (build-data1194 #f #f)))) tmp2314))) ($sc-dispatch tmp2314 (quote #(atom #t))))) fender2306) (build-dispatch-call2281 pvars2310 exp2307 y2313 r2304 mod2308) (gen-syntax-case2283 x2301 keys2302 clauses2303 r2304 mod2308)))))) (if (eq? p2309 (quote any)) (build-annotated1193 #f (list (build-annotated1193 #f (quote list)) x2301)) (build-annotated1193 #f (list (build-annotated1193 #f (quote $sc-dispatch)) x2301 (build-data1194 #f p2309))))))))))))) (build-dispatch-call2281 (lambda (pvars2317 exp2318 y2319 r2320 mod2321) (let ((ids2322 (map car pvars2317)) (levels2323 (map cdr pvars2317))) (let ((labels2324 (gen-labels1222 ids2322)) (new-vars2325 (map gen-var1264 ids2322))) (build-annotated1193 #f (list (build-annotated1193 #f (quote apply)) (build-annotated1193 #f (list (quote lambda) new-vars2325 (chi1252 exp2318 (extend-env1210 labels2324 (map (lambda (var2326 level2327) (cons (quote syntax) (cons var2326 level2327))) new-vars2325 (map cdr pvars2317)) r2320) (make-binding-wrap1233 ids2322 labels2324 (quote (()))) mod2321))) y2319)))))) (convert-pattern2280 (lambda (pattern2328 keys2329) (let cvt2330 ((p2331 pattern2328) (n2332 0) (ids2333 (quote ()))) (if (id?1216 p2331) (if (bound-id-member?1243 p2331 keys2329) (values (vector (quote free-id) p2331) ids2333) (values (quote any) (cons (cons p2331 n2332) ids2333))) ((lambda (tmp2334) ((lambda (tmp2335) (if (if tmp2335 (apply (lambda (x2336 dots2337) (ellipsis?1261 dots2337)) tmp2335) #f) (apply (lambda (x2338 dots2339) (call-with-values (lambda () (cvt2330 x2338 (fx+1185 n2332 1) ids2333)) (lambda (p2340 ids2341) (values (if (eq? p2340 (quote any)) (quote each-any) (vector (quote each) p2340)) ids2341)))) tmp2335) ((lambda (tmp2342) (if tmp2342 (apply (lambda (x2343 y2344) (call-with-values (lambda () (cvt2330 y2344 n2332 ids2333)) (lambda (y2345 ids2346) (call-with-values (lambda () (cvt2330 x2343 n2332 ids2346)) (lambda (x2347 ids2348) (values (cons x2347 y2345) ids2348)))))) tmp2342) ((lambda (tmp2349) (if tmp2349 (apply (lambda () (values (quote ()) ids2333)) tmp2349) ((lambda (tmp2350) (if tmp2350 (apply (lambda (x2351) (call-with-values (lambda () (cvt2330 x2351 n2332 ids2333)) (lambda (p2353 ids2354) (values (vector (quote vector) p2353) ids2354)))) tmp2350) ((lambda (x2355) (values (vector (quote atom) (strip1263 p2331 (quote (())))) ids2333)) tmp2334))) ($sc-dispatch tmp2334 (quote #(vector each-any)))))) ($sc-dispatch tmp2334 (quote ()))))) ($sc-dispatch tmp2334 (quote (any . any)))))) ($sc-dispatch tmp2334 (quote (any any))))) p2331)))))) (lambda (e2356 r2357 w2358 s2359 mod2360) (let ((e2361 (source-wrap1245 e2356 w2358 s2359 mod2360))) ((lambda (tmp2362) ((lambda (tmp2363) (if tmp2363 (apply (lambda (_2364 val2365 key2366 m2367) (if (and-map (lambda (x2368) (and (id?1216 x2368) (not (ellipsis?1261 x2368)))) key2366) (let ((x2370 (gen-var1264 (quote tmp)))) (build-annotated1193 s2359 (list (build-annotated1193 #f (list (quote lambda) (list x2370) (gen-syntax-case2283 (build-annotated1193 #f x2370) key2366 m2367 r2357 mod2360))) (chi1252 val2365 r2357 (quote (())) mod2360)))) (syntax-violation (quote syntax-case) "invalid literals list" e2361))) tmp2363) (syntax-violation #f "source expression failed to match any pattern" tmp2362))) ($sc-dispatch tmp2362 (quote (any any each-any . each-any))))) e2361))))) (set! sc-expand (let ((m2373 (quote e)) (esew2374 (quote (eval)))) (lambda (x2375) (if (and (pair? x2375) (equal? (car x2375) noexpand1184)) (cadr x2375) (chi-top1251 x2375 (quote ()) (quote ((top))) m2373 esew2374 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2376 (quote e)) (esew2377 (quote (eval)))) (lambda (x2379 . rest2378) (if (and (pair? x2379) (equal? (car x2379) noexpand1184)) (cadr x2379) (chi-top1251 x2379 (quote ()) (quote ((top))) (if (null? rest2378) m2376 (car rest2378)) (if (or (null? rest2378) (null? (cdr rest2378))) esew2377 (cadr rest2378)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2380) (nonsymbol-id?1215 x2380))) (set! datum->syntax (lambda (id2381 datum2382) (make-syntax-object1199 datum2382 (syntax-object-wrap1202 id2381) #f))) (set! syntax->datum (lambda (x2383) (strip1263 x2383 (quote (()))))) (set! generate-temporaries (lambda (ls2384) (begin (let ((x2385 ls2384)) (if (not (list? x2385)) (syntax-violation (quote generate-temporaries) "invalid argument" x2385))) (map (lambda (x2386) (wrap1244 (gensym) (quote ((top))) #f)) ls2384)))) (set! free-identifier=? (lambda (x2387 y2388) (begin (let ((x2389 x2387)) (if (not (nonsymbol-id?1215 x2389)) (syntax-violation (quote free-identifier=?) "invalid argument" x2389))) (let ((x2390 y2388)) (if (not (nonsymbol-id?1215 x2390)) (syntax-violation (quote free-identifier=?) "invalid argument" x2390))) (free-id=?1239 x2387 y2388)))) (set! bound-identifier=? (lambda (x2391 y2392) (begin (let ((x2393 x2391)) (if (not (nonsymbol-id?1215 x2393)) (syntax-violation (quote bound-identifier=?) "invalid argument" x2393))) (let ((x2394 y2392)) (if (not (nonsymbol-id?1215 x2394)) (syntax-violation (quote bound-identifier=?) "invalid argument" x2394))) (bound-id=?1240 x2391 y2392)))) (set! syntax-violation (lambda (who2398 message2397 form2396 . subform2395) (begin (let ((x2399 who2398)) (if (not ((lambda (x2400) (or (not x2400) (string? x2400) (symbol? x2400))) x2399)) (syntax-violation (quote syntax-violation) "invalid argument" x2399))) (let ((x2401 message2397)) (if (not (string? x2401)) (syntax-violation (quote syntax-violation) "invalid argument" x2401))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2398 "~a: " "") "~a " (if (null? subform2395) "in ~a" "in subform `~s' of `~s'")) (let ((tail2402 (cons message2397 (map (lambda (x2403) (strip1263 x2403 (quote (())))) (append subform2395 (list form2396)))))) (if who2398 (cons who2398 tail2402) tail2402)) #f)))) (letrec ((match2408 (lambda (e2409 p2410 w2411 r2412 mod2413) (cond ((not r2412) #f) ((eq? p2410 (quote any)) (cons (wrap1244 e2409 w2411 mod2413) r2412)) ((syntax-object?1200 e2409) (match*2407 (let ((e2414 (syntax-object-expression1201 e2409))) (if (annotation? e2414) (annotation-expression e2414) e2414)) p2410 (join-wraps1235 w2411 (syntax-object-wrap1202 e2409)) r2412 (syntax-object-module1203 e2409))) (else (match*2407 (let ((e2415 e2409)) (if (annotation? e2415) (annotation-expression e2415) e2415)) p2410 w2411 r2412 mod2413))))) (match*2407 (lambda (e2416 p2417 w2418 r2419 mod2420) (cond ((null? p2417) (and (null? e2416) r2419)) ((pair? p2417) (and (pair? e2416) (match2408 (car e2416) (car p2417) w2418 (match2408 (cdr e2416) (cdr p2417) w2418 r2419 mod2420) mod2420))) ((eq? p2417 (quote each-any)) (let ((l2421 (match-each-any2405 e2416 w2418 mod2420))) (and l2421 (cons l2421 r2419)))) (else (let ((t2422 (vector-ref p2417 0))) (if (memv t2422 (quote (each))) (if (null? e2416) (match-empty2406 (vector-ref p2417 1) r2419) (let ((l2423 (match-each2404 e2416 (vector-ref p2417 1) w2418 mod2420))) (and l2423 (let collect2424 ((l2425 l2423)) (if (null? (car l2425)) r2419 (cons (map car l2425) (collect2424 (map cdr l2425)))))))) (if (memv t2422 (quote (free-id))) (and (id?1216 e2416) (free-id=?1239 (wrap1244 e2416 w2418 mod2420) (vector-ref p2417 1)) r2419) (if (memv t2422 (quote (atom))) (and (equal? (vector-ref p2417 1) (strip1263 e2416 w2418)) r2419) (if (memv t2422 (quote (vector))) (and (vector? e2416) (match2408 (vector->list e2416) (vector-ref p2417 1) w2418 r2419 mod2420))))))))))) (match-empty2406 (lambda (p2426 r2427) (cond ((null? p2426) r2427) ((eq? p2426 (quote any)) (cons (quote ()) r2427)) ((pair? p2426) (match-empty2406 (car p2426) (match-empty2406 (cdr p2426) r2427))) ((eq? p2426 (quote each-any)) (cons (quote ()) r2427)) (else (let ((t2428 (vector-ref p2426 0))) (if (memv t2428 (quote (each))) (match-empty2406 (vector-ref p2426 1) r2427) (if (memv t2428 (quote (free-id atom))) r2427 (if (memv t2428 (quote (vector))) (match-empty2406 (vector-ref p2426 1) r2427))))))))) (match-each-any2405 (lambda (e2429 w2430 mod2431) (cond ((annotation? e2429) (match-each-any2405 (annotation-expression e2429) w2430 mod2431)) ((pair? e2429) (let ((l2432 (match-each-any2405 (cdr e2429) w2430 mod2431))) (and l2432 (cons (wrap1244 (car e2429) w2430 mod2431) l2432)))) ((null? e2429) (quote ())) ((syntax-object?1200 e2429) (match-each-any2405 (syntax-object-expression1201 e2429) (join-wraps1235 w2430 (syntax-object-wrap1202 e2429)) mod2431)) (else #f)))) (match-each2404 (lambda (e2433 p2434 w2435 mod2436) (cond ((annotation? e2433) (match-each2404 (annotation-expression e2433) p2434 w2435 mod2436)) ((pair? e2433) (let ((first2437 (match2408 (car e2433) p2434 w2435 (quote ()) mod2436))) (and first2437 (let ((rest2438 (match-each2404 (cdr e2433) p2434 w2435 mod2436))) (and rest2438 (cons first2437 rest2438)))))) ((null? e2433) (quote ())) ((syntax-object?1200 e2433) (match-each2404 (syntax-object-expression1201 e2433) p2434 (join-wraps1235 w2435 (syntax-object-wrap1202 e2433)) (syntax-object-module1203 e2433))) (else #f))))) (set! $sc-dispatch (lambda (e2439 p2440) (cond ((eq? p2440 (quote any)) (list e2439)) ((syntax-object?1200 e2439) (match*2407 (let ((e2441 (syntax-object-expression1201 e2439))) (if (annotation? e2441) (annotation-expression e2441) e2441)) p2440 (syntax-object-wrap1202 e2439) (quote ()) (syntax-object-module1203 e2439))) (else (match*2407 (let ((e2442 e2439)) (if (annotation? e2442) (annotation-expression e2442) e2442)) p2440 (quote (())) (quote ()) #f)))))))))
(define with-syntax (make-syncase-macro (quote macro) (lambda (x2443) ((lambda (tmp2444) ((lambda (tmp2445) (if tmp2445 (apply (lambda (_2446 e12447 e22448) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12447 e22448))) tmp2445) ((lambda (tmp2450) (if tmp2450 (apply (lambda (_2451 out2452 in2453 e12454 e22455) (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))) in2453 (quote ()) (list out2452 (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 e12454 e22455))))) tmp2450) ((lambda (tmp2457) (if tmp2457 (apply (lambda (_2458 out2459 in2460 e12461 e22462) (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))) in2460) (quote ()) (list out2459 (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 e12461 e22462))))) tmp2457) (syntax-violation #f "source expression failed to match any pattern" tmp2444))) ($sc-dispatch tmp2444 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2444 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2444 (quote (any () any . each-any))))) x2443))))
(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2466) ((lambda (tmp2467) ((lambda (tmp2468) (if tmp2468 (apply (lambda (_2469 k2470 keyword2471 pattern2472 template2473) (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 k2470 (map (lambda (tmp2476 tmp2475) (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))) tmp2475) (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))) tmp2476))) template2473 pattern2472)))))) tmp2468) (syntax-violation #f "source expression failed to match any pattern" tmp2467))) ($sc-dispatch tmp2467 (quote (any each-any . #(each ((any . any) any))))))) x2466))))
(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2477) ((lambda (tmp2478) ((lambda (tmp2479) (if (if tmp2479 (apply (lambda (let*2480 x2481 v2482 e12483 e22484) (and-map identifier? x2481)) tmp2479) #f) (apply (lambda (let*2486 x2487 v2488 e12489 e22490) (let f2491 ((bindings2492 (map list x2487 v2488))) (if (null? bindings2492) (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 e12489 e22490))) ((lambda (tmp2496) ((lambda (tmp2497) (if tmp2497 (apply (lambda (body2498 binding2499) (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 binding2499) body2498)) tmp2497) (syntax-violation #f "source expression failed to match any pattern" tmp2496))) ($sc-dispatch tmp2496 (quote (any any))))) (list (f2491 (cdr bindings2492)) (car bindings2492)))))) tmp2479) (syntax-violation #f "source expression failed to match any pattern" tmp2478))) ($sc-dispatch tmp2478 (quote (any #(each (any any)) any . each-any))))) x2477))))
(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2500) ((lambda (tmp2501) ((lambda (tmp2502) (if tmp2502 (apply (lambda (_2503 var2504 init2505 step2506 e02507 e12508 c2509) ((lambda (tmp2510) ((lambda (tmp2511) (if tmp2511 (apply (lambda (step2512) ((lambda (tmp2513) ((lambda (tmp2514) (if tmp2514 (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 var2504 init2505) (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))) e02507) (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 c2509 (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))) step2512))))))) tmp2514) ((lambda (tmp2519) (if tmp2519 (apply (lambda (e12520 e22521) (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 var2504 init2505) (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))) e02507 (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 e12520 e22521)) (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 c2509 (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))) step2512))))))) tmp2519) (syntax-violation #f "source expression failed to match any pattern" tmp2513))) ($sc-dispatch tmp2513 (quote (any . each-any)))))) ($sc-dispatch tmp2513 (quote ())))) e12508)) tmp2511) (syntax-violation #f "source expression failed to match any pattern" tmp2510))) ($sc-dispatch tmp2510 (quote each-any)))) (map (lambda (v2528 s2529) ((lambda (tmp2530) ((lambda (tmp2531) (if tmp2531 (apply (lambda () v2528) tmp2531) ((lambda (tmp2532) (if tmp2532 (apply (lambda (e2533) e2533) tmp2532) ((lambda (_2534) (syntax-violation (quote do) "bad step expression" orig-x2500 s2529)) tmp2530))) ($sc-dispatch tmp2530 (quote (any)))))) ($sc-dispatch tmp2530 (quote ())))) s2529)) var2504 step2506))) tmp2502) (syntax-violation #f "source expression failed to match any pattern" tmp2501))) ($sc-dispatch tmp2501 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2500))))
(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2537 (lambda (x2541 y2542) ((lambda (tmp2543) ((lambda (tmp2544) (if tmp2544 (apply (lambda (x2545 y2546) ((lambda (tmp2547) ((lambda (tmp2548) (if tmp2548 (apply (lambda (dy2549) ((lambda (tmp2550) ((lambda (tmp2551) (if tmp2551 (apply (lambda (dx2552) (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 dx2552 dy2549))) tmp2551) ((lambda (_2553) (if (null? dy2549) (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))) x2545) (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))) x2545 y2546))) tmp2550))) ($sc-dispatch tmp2550 (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))))) x2545)) tmp2548) ((lambda (tmp2554) (if tmp2554 (apply (lambda (stuff2555) (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 x2545 stuff2555))) tmp2554) ((lambda (else2556) (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))) x2545 y2546)) tmp2547))) ($sc-dispatch tmp2547 (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 tmp2547 (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))))) y2546)) tmp2544) (syntax-violation #f "source expression failed to match any pattern" tmp2543))) ($sc-dispatch tmp2543 (quote (any any))))) (list x2541 y2542)))) (quasiappend2538 (lambda (x2557 y2558) ((lambda (tmp2559) ((lambda (tmp2560) (if tmp2560 (apply (lambda (x2561 y2562) ((lambda (tmp2563) ((lambda (tmp2564) (if tmp2564 (apply (lambda () x2561) tmp2564) ((lambda (_2565) (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))) x2561 y2562)) tmp2563))) ($sc-dispatch tmp2563 (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))) ()))))) y2562)) tmp2560) (syntax-violation #f "source expression failed to match any pattern" tmp2559))) ($sc-dispatch tmp2559 (quote (any any))))) (list x2557 y2558)))) (quasivector2539 (lambda (x2566) ((lambda (tmp2567) ((lambda (x2568) ((lambda (tmp2569) ((lambda (tmp2570) (if tmp2570 (apply (lambda (x2571) (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 x2571))) tmp2570) ((lambda (tmp2573) (if tmp2573 (apply (lambda (x2574) (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))) x2574)) tmp2573) ((lambda (_2576) (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))) x2568)) tmp2569))) ($sc-dispatch tmp2569 (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 tmp2569 (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))))) x2568)) tmp2567)) x2566))) (quasi2540 (lambda (p2577 lev2578) ((lambda (tmp2579) ((lambda (tmp2580) (if tmp2580 (apply (lambda (p2581) (if (= lev2578 0) p2581 (quasicons2537 (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)))) (quasi2540 (list p2581) (- lev2578 1))))) tmp2580) ((lambda (tmp2582) (if tmp2582 (apply (lambda (p2583 q2584) (if (= lev2578 0) (quasiappend2538 p2583 (quasi2540 q2584 lev2578)) (quasicons2537 (quasicons2537 (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)))) (quasi2540 (list p2583) (- lev2578 1))) (quasi2540 q2584 lev2578)))) tmp2582) ((lambda (tmp2585) (if tmp2585 (apply (lambda (p2586) (quasicons2537 (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)))) (quasi2540 (list p2586) (+ lev2578 1)))) tmp2585) ((lambda (tmp2587) (if tmp2587 (apply (lambda (p2588 q2589) (quasicons2537 (quasi2540 p2588 lev2578) (quasi2540 q2589 lev2578))) tmp2587) ((lambda (tmp2590) (if tmp2590 (apply (lambda (x2591) (quasivector2539 (quasi2540 x2591 lev2578))) tmp2590) ((lambda (p2593) (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))) p2593)) tmp2579))) ($sc-dispatch tmp2579 (quote #(vector each-any)))))) ($sc-dispatch tmp2579 (quote (any . any)))))) ($sc-dispatch tmp2579 (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 tmp2579 (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 tmp2579 (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))))) p2577)))) (lambda (x2594) ((lambda (tmp2595) ((lambda (tmp2596) (if tmp2596 (apply (lambda (_2597 e2598) (quasi2540 e2598 0)) tmp2596) (syntax-violation #f "source expression failed to match any pattern" tmp2595))) ($sc-dispatch tmp2595 (quote (any any))))) x2594)))))
(define include (make-syncase-macro (quote macro) (lambda (x2599) (letrec ((read-file2600 (lambda (fn2601 k2602) (let ((p2603 (open-input-file fn2601))) (let f2604 ((x2605 (read p2603))) (if (eof-object? x2605) (begin (close-input-port p2603) (quote ())) (cons (datum->syntax k2602 x2605) (f2604 (read p2603))))))))) ((lambda (tmp2606) ((lambda (tmp2607) (if tmp2607 (apply (lambda (k2608 filename2609) (let ((fn2610 (syntax->datum filename2609))) ((lambda (tmp2611) ((lambda (tmp2612) (if tmp2612 (apply (lambda (exp2613) (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))) exp2613)) tmp2612) (syntax-violation #f "source expression failed to match any pattern" tmp2611))) ($sc-dispatch tmp2611 (quote each-any)))) (read-file2600 fn2610 k2608)))) tmp2607) (syntax-violation #f "source expression failed to match any pattern" tmp2606))) ($sc-dispatch tmp2606 (quote (any any))))) x2599)))))
(define unquote (make-syncase-macro (quote macro) (lambda (x2615) ((lambda (tmp2616) ((lambda (tmp2617) (if tmp2617 (apply (lambda (_2618 e2619) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x2615)) tmp2617) (syntax-violation #f "source expression failed to match any pattern" tmp2616))) ($sc-dispatch tmp2616 (quote (any any))))) x2615))))
(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2620) ((lambda (tmp2621) ((lambda (tmp2622) (if tmp2622 (apply (lambda (_2623 e2624) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x2620)) tmp2622) (syntax-violation #f "source expression failed to match any pattern" tmp2621))) ($sc-dispatch tmp2621 (quote (any any))))) x2620))))
(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2625) ((lambda (tmp2626) ((lambda (tmp2627) (if tmp2627 (apply (lambda (_2628 e2629 m12630 m22631) ((lambda (tmp2632) ((lambda (body2633) (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))) e2629)) body2633)) tmp2632)) (let f2634 ((clause2635 m12630) (clauses2636 m22631)) (if (null? clauses2636) ((lambda (tmp2638) ((lambda (tmp2639) (if tmp2639 (apply (lambda (e12640 e22641) (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 e12640 e22641))) tmp2639) ((lambda (tmp2643) (if tmp2643 (apply (lambda (k2644 e12645 e22646) (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))) k2644)) (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 e12645 e22646)))) tmp2643) ((lambda (_2649) (syntax-violation (quote case) "bad clause" x2625 clause2635)) tmp2638))) ($sc-dispatch tmp2638 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2638 (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))))) clause2635) ((lambda (tmp2650) ((lambda (rest2651) ((lambda (tmp2652) ((lambda (tmp2653) (if tmp2653 (apply (lambda (k2654 e12655 e22656) (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))) k2654)) (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 e12655 e22656)) rest2651)) tmp2653) ((lambda (_2659) (syntax-violation (quote case) "bad clause" x2625 clause2635)) tmp2652))) ($sc-dispatch tmp2652 (quote (each-any any . each-any))))) clause2635)) tmp2650)) (f2634 (car clauses2636) (cdr clauses2636))))))) tmp2627) (syntax-violation #f "source expression failed to match any pattern" tmp2626))) ($sc-dispatch tmp2626 (quote (any any any . each-any))))) x2625))))
(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2660) ((lambda (tmp2661) ((lambda (tmp2662) (if tmp2662 (apply (lambda (_2663 e2664) (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))) e2664)) (list (cons _2663 (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 e2664 (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)))))))))) tmp2662) (syntax-violation #f "source expression failed to match any pattern" tmp2661))) ($sc-dispatch tmp2661 (quote (any any))))) x2660))))