(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))))
+(letrec ((and-map*1002 (lambda (f1042 first1041 . rest1040) (or (null? first1041) (if (null? rest1040) (let andmap1043 ((first1044 first1041)) (let ((x1045 (car first1044)) (first1046 (cdr first1044))) (if (null? first1046) (f1042 x1045) (and (f1042 x1045) (andmap1043 first1046))))) (let andmap1047 ((first1048 first1041) (rest1049 rest1040)) (let ((x1050 (car first1048)) (xr1051 (map car rest1049)) (first1052 (cdr first1048)) (rest1053 (map cdr rest1049))) (if (null? first1052) (apply f1042 (cons x1050 xr1051)) (and (apply f1042 (cons x1050 xr1051)) (andmap1047 first1052 rest1053)))))))))) (letrec ((lambda-var-list1135 (lambda (vars1340) (let lvl1341 ((vars1342 vars1340) (ls1343 (quote ())) (w1344 (quote (())))) (cond ((pair? vars1342) (lvl1341 (cdr vars1342) (cons (wrap1114 (car vars1342) w1344 #f) ls1343) w1344)) ((id?1086 vars1342) (cons (wrap1114 vars1342 w1344 #f) ls1343)) ((null? vars1342) ls1343) ((syntax-object?1070 vars1342) (lvl1341 (syntax-object-expression1071 vars1342) ls1343 (join-wraps1105 w1344 (syntax-object-wrap1072 vars1342)))) ((annotation? vars1342) (lvl1341 (annotation-expression vars1342) ls1343 w1344)) (else (cons vars1342 ls1343)))))) (gen-var1134 (lambda (id1345) (let ((id1346 (if (syntax-object?1070 id1345) (syntax-object-expression1071 id1345) id1345))) (if (annotation? id1346) (build-annotated1063 (annotation-source id1346) (gensym (symbol->string (annotation-expression id1346)))) (build-annotated1063 #f (gensym (symbol->string id1346))))))) (strip1133 (lambda (x1347 w1348) (if (memq (quote top) (wrap-marks1089 w1348)) (if (or (annotation? x1347) (and (pair? x1347) (annotation? (car x1347)))) (strip-annotation1132 x1347 #f) x1347) (let f1349 ((x1350 x1347)) (cond ((syntax-object?1070 x1350) (strip1133 (syntax-object-expression1071 x1350) (syntax-object-wrap1072 x1350))) ((pair? x1350) (let ((a1351 (f1349 (car x1350))) (d1352 (f1349 (cdr x1350)))) (if (and (eq? a1351 (car x1350)) (eq? d1352 (cdr x1350))) x1350 (cons a1351 d1352)))) ((vector? x1350) (let ((old1353 (vector->list x1350))) (let ((new1354 (map f1349 old1353))) (if (and-map*1002 eq? old1353 new1354) x1350 (list->vector new1354))))) (else x1350)))))) (strip-annotation1132 (lambda (x1355 parent1356) (cond ((pair? x1355) (let ((new1357 (cons #f #f))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1357)) (set-car! new1357 (strip-annotation1132 (car x1355) #f)) (set-cdr! new1357 (strip-annotation1132 (cdr x1355) #f)) new1357))) ((annotation? x1355) (or (annotation-stripped x1355) (strip-annotation1132 (annotation-expression x1355) x1355))) ((vector? x1355) (let ((new1358 (make-vector (vector-length x1355)))) (begin (if parent1356 (set-annotation-stripped! parent1356 new1358)) (let loop1359 ((i1360 (- (vector-length x1355) 1))) (unless (fx<1058 i1360 0) (vector-set! new1358 i1360 (strip-annotation1132 (vector-ref x1355 i1360) #f)) (loop1359 (fx-1056 i1360 1)))) new1358))) (else x1355)))) (ellipsis?1131 (lambda (x1361) (and (nonsymbol-id?1085 x1361) (free-id=?1109 x1361 (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-void1130 (lambda () (build-annotated1063 #f (cons (build-annotated1063 #f (quote if)) (quote (#f #f)))))) (eval-local-transformer1129 (lambda (expanded1362 mod1363) (let ((p1364 (local-eval-hook1060 expanded1362 mod1363))) (if (procedure? p1364) p1364 (syntax-violation #f "nonprocedure transformer" p1364))))) (chi-local-syntax1128 (lambda (rec?1365 e1366 r1367 w1368 s1369 mod1370 k1371) ((lambda (tmp1372) ((lambda (tmp1373) (if tmp1373 (apply (lambda (_1374 id1375 val1376 e11377 e21378) (let ((ids1379 id1375)) (if (not (valid-bound-ids?1111 ids1379)) (syntax-violation #f "duplicate bound keyword" e1366) (let ((labels1381 (gen-labels1092 ids1379))) (let ((new-w1382 (make-binding-wrap1103 ids1379 labels1381 w1368))) (k1371 (cons e11377 e21378) (extend-env1080 labels1381 (let ((w1384 (if rec?1365 new-w1382 w1368)) (trans-r1385 (macros-only-env1082 r1367))) (map (lambda (x1386) (cons (quote macro) (eval-local-transformer1129 (chi1122 x1386 trans-r1385 w1384 mod1370) mod1370))) val1376)) r1367) new-w1382 s1369 mod1370)))))) tmp1373) ((lambda (_1388) (syntax-violation #f "bad local syntax definition" (source-wrap1115 e1366 w1368 s1369 mod1370))) tmp1372))) ($sc-dispatch tmp1372 (quote (any #(each (any any)) any . each-any))))) e1366))) (chi-lambda-clause1127 (lambda (e1389 docstring1390 c1391 r1392 w1393 mod1394 k1395) ((lambda (tmp1396) ((lambda (tmp1397) (if (if tmp1397 (apply (lambda (args1398 doc1399 e11400 e21401) (and (string? (syntax->datum doc1399)) (not docstring1390))) tmp1397) #f) (apply (lambda (args1402 doc1403 e11404 e21405) (chi-lambda-clause1127 e1389 doc1403 (cons args1402 (cons e11404 e21405)) r1392 w1393 mod1394 k1395)) tmp1397) ((lambda (tmp1407) (if tmp1407 (apply (lambda (id1408 e11409 e21410) (let ((ids1411 id1408)) (if (not (valid-bound-ids?1111 ids1411)) (syntax-violation (quote lambda) "invalid parameter list" e1389) (let ((labels1413 (gen-labels1092 ids1411)) (new-vars1414 (map gen-var1134 ids1411))) (k1395 new-vars1414 docstring1390 (chi-body1126 (cons e11409 e21410) e1389 (extend-var-env1081 labels1413 new-vars1414 r1392) (make-binding-wrap1103 ids1411 labels1413 w1393) mod1394)))))) tmp1407) ((lambda (tmp1416) (if tmp1416 (apply (lambda (ids1417 e11418 e21419) (let ((old-ids1420 (lambda-var-list1135 ids1417))) (if (not (valid-bound-ids?1111 old-ids1420)) (syntax-violation (quote lambda) "invalid parameter list" e1389) (let ((labels1421 (gen-labels1092 old-ids1420)) (new-vars1422 (map gen-var1134 old-ids1420))) (k1395 (let f1423 ((ls11424 (cdr new-vars1422)) (ls21425 (car new-vars1422))) (if (null? ls11424) ls21425 (f1423 (cdr ls11424) (cons (car ls11424) ls21425)))) docstring1390 (chi-body1126 (cons e11418 e21419) e1389 (extend-var-env1081 labels1421 new-vars1422 r1392) (make-binding-wrap1103 old-ids1420 labels1421 w1393) mod1394)))))) tmp1416) ((lambda (_1427) (syntax-violation (quote lambda) "bad lambda" e1389)) tmp1396))) ($sc-dispatch tmp1396 (quote (any any . each-any)))))) ($sc-dispatch tmp1396 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1396 (quote (any any any . each-any))))) c1391))) (chi-body1126 (lambda (body1428 outer-form1429 r1430 w1431 mod1432) (let ((r1433 (cons (quote ("placeholder" placeholder)) r1430))) (let ((ribcage1434 (make-ribcage1093 (quote ()) (quote ()) (quote ())))) (let ((w1435 (make-wrap1088 (wrap-marks1089 w1431) (cons ribcage1434 (wrap-subst1090 w1431))))) (let parse1436 ((body1437 (map (lambda (x1443) (cons r1433 (wrap1114 x1443 w1435 mod1432))) body1428)) (ids1438 (quote ())) (labels1439 (quote ())) (vars1440 (quote ())) (vals1441 (quote ())) (bindings1442 (quote ()))) (if (null? body1437) (syntax-violation #f "no expressions in body" outer-form1429) (let ((e1444 (cdar body1437)) (er1445 (caar body1437))) (call-with-values (lambda () (syntax-type1120 e1444 er1445 (quote (())) #f ribcage1434 mod1432)) (lambda (type1446 value1447 e1448 w1449 s1450 mod1451) (let ((t1452 type1446)) (if (memv t1452 (quote (define-form))) (let ((id1453 (wrap1114 value1447 w1449 mod1451)) (label1454 (gen-label1091))) (let ((var1455 (gen-var1134 id1453))) (begin (extend-ribcage!1102 ribcage1434 id1453 label1454) (parse1436 (cdr body1437) (cons id1453 ids1438) (cons label1454 labels1439) (cons var1455 vars1440) (cons (cons er1445 (wrap1114 e1448 w1449 mod1451)) vals1441) (cons (cons (quote lexical) var1455) bindings1442))))) (if (memv t1452 (quote (define-syntax-form))) (let ((id1456 (wrap1114 value1447 w1449 mod1451)) (label1457 (gen-label1091))) (begin (extend-ribcage!1102 ribcage1434 id1456 label1457) (parse1436 (cdr body1437) (cons id1456 ids1438) (cons label1457 labels1439) vars1440 vals1441 (cons (cons (quote macro) (cons er1445 (wrap1114 e1448 w1449 mod1451))) bindings1442)))) (if (memv t1452 (quote (begin-form))) ((lambda (tmp1458) ((lambda (tmp1459) (if tmp1459 (apply (lambda (_1460 e11461) (parse1436 (let f1462 ((forms1463 e11461)) (if (null? forms1463) (cdr body1437) (cons (cons er1445 (wrap1114 (car forms1463) w1449 mod1451)) (f1462 (cdr forms1463))))) ids1438 labels1439 vars1440 vals1441 bindings1442)) tmp1459) (syntax-violation #f "source expression failed to match any pattern" tmp1458))) ($sc-dispatch tmp1458 (quote (any . each-any))))) e1448) (if (memv t1452 (quote (local-syntax-form))) (chi-local-syntax1128 value1447 e1448 er1445 w1449 s1450 mod1451 (lambda (forms1465 er1466 w1467 s1468 mod1469) (parse1436 (let f1470 ((forms1471 forms1465)) (if (null? forms1471) (cdr body1437) (cons (cons er1466 (wrap1114 (car forms1471) w1467 mod1469)) (f1470 (cdr forms1471))))) ids1438 labels1439 vars1440 vals1441 bindings1442))) (if (null? ids1438) (build-sequence1065 #f (map (lambda (x1472) (chi1122 (cdr x1472) (car x1472) (quote (())) mod1451)) (cons (cons er1445 (source-wrap1115 e1448 w1449 s1450 mod1451)) (cdr body1437)))) (begin (if (not (valid-bound-ids?1111 ids1438)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1429)) (let loop1473 ((bs1474 bindings1442) (er-cache1475 #f) (r-cache1476 #f)) (if (not (null? bs1474)) (let ((b1477 (car bs1474))) (if (eq? (car b1477) (quote macro)) (let ((er1478 (cadr b1477))) (let ((r-cache1479 (if (eq? er1478 er-cache1475) r-cache1476 (macros-only-env1082 er1478)))) (begin (set-cdr! b1477 (eval-local-transformer1129 (chi1122 (cddr b1477) r-cache1479 (quote (())) mod1451) mod1451)) (loop1473 (cdr bs1474) er1478 r-cache1479)))) (loop1473 (cdr bs1474) er-cache1475 r-cache1476))))) (set-cdr! r1433 (extend-env1080 labels1439 bindings1442 (cdr r1433))) (build-letrec1068 #f vars1440 (map (lambda (x1480) (chi1122 (cdr x1480) (car x1480) (quote (())) mod1451)) vals1441) (build-sequence1065 #f (map (lambda (x1481) (chi1122 (cdr x1481) (car x1481) (quote (())) mod1451)) (cons (cons er1445 (source-wrap1115 e1448 w1449 s1450 mod1451)) (cdr body1437)))))))))))))))))))))) (chi-macro1125 (lambda (p1482 e1483 r1484 w1485 rib1486 mod1487) (letrec ((rebuild-macro-output1488 (lambda (x1489 m1490) (cond ((pair? x1489) (cons (rebuild-macro-output1488 (car x1489) m1490) (rebuild-macro-output1488 (cdr x1489) m1490))) ((syntax-object?1070 x1489) (let ((w1491 (syntax-object-wrap1072 x1489))) (let ((ms1492 (wrap-marks1089 w1491)) (s1493 (wrap-subst1090 w1491))) (if (and (pair? ms1492) (eq? (car ms1492) #f)) (make-syntax-object1069 (syntax-object-expression1071 x1489) (make-wrap1088 (cdr ms1492) (if rib1486 (cons rib1486 (cdr s1493)) (cdr s1493))) (syntax-object-module1073 x1489)) (make-syntax-object1069 (syntax-object-expression1071 x1489) (make-wrap1088 (cons m1490 ms1492) (if rib1486 (cons rib1486 (cons (quote shift) s1493)) (cons (quote shift) s1493))) (let ((pmod1494 (procedure-module p1482))) (if pmod1494 (cons (quote hygiene) (module-name pmod1494)) (quote (hygiene guile))))))))) ((vector? x1489) (let ((n1495 (vector-length x1489))) (let ((v1496 (make-vector n1495))) (let doloop1497 ((i1498 0)) (if (fx=1057 i1498 n1495) v1496 (begin (vector-set! v1496 i1498 (rebuild-macro-output1488 (vector-ref x1489 i1498) m1490)) (doloop1497 (fx+1055 i1498 1)))))))) ((symbol? x1489) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1115 e1483 w1485 s mod1487) x1489)) (else x1489))))) (rebuild-macro-output1488 (p1482 (wrap1114 e1483 (anti-mark1101 w1485) mod1487)) (string #\m))))) (chi-application1124 (lambda (x1499 e1500 r1501 w1502 s1503 mod1504) ((lambda (tmp1505) ((lambda (tmp1506) (if tmp1506 (apply (lambda (e01507 e11508) (build-annotated1063 s1503 (cons x1499 (map (lambda (e1509) (chi1122 e1509 r1501 w1502 mod1504)) e11508)))) tmp1506) (syntax-violation #f "source expression failed to match any pattern" tmp1505))) ($sc-dispatch tmp1505 (quote (any . each-any))))) e1500))) (chi-expr1123 (lambda (type1511 value1512 e1513 r1514 w1515 s1516 mod1517) (let ((t1518 type1511)) (if (memv t1518 (quote (lexical))) (build-annotated1063 s1516 value1512) (if (memv t1518 (quote (core external-macro))) (value1512 e1513 r1514 w1515 s1516 mod1517) (if (memv t1518 (quote (module-ref))) (call-with-values (lambda () (value1512 e1513)) (lambda (id1519 mod1520) (build-annotated1063 s1516 (if mod1520 (make-module-ref (cdr mod1520) id1519 (car mod1520)) (make-module-ref mod1520 id1519 (quote bare)))))) (if (memv t1518 (quote (lexical-call))) (chi-application1124 (build-annotated1063 (source-annotation1077 (car e1513)) value1512) e1513 r1514 w1515 s1516 mod1517) (if (memv t1518 (quote (global-call))) (chi-application1124 (build-annotated1063 (source-annotation1077 (car e1513)) (if (if (syntax-object?1070 (car e1513)) (syntax-object-module1073 (car e1513)) mod1517) (make-module-ref (cdr (if (syntax-object?1070 (car e1513)) (syntax-object-module1073 (car e1513)) mod1517)) value1512 (car (if (syntax-object?1070 (car e1513)) (syntax-object-module1073 (car e1513)) mod1517))) (make-module-ref (if (syntax-object?1070 (car e1513)) (syntax-object-module1073 (car e1513)) mod1517) value1512 (quote bare)))) e1513 r1514 w1515 s1516 mod1517) (if (memv t1518 (quote (constant))) (build-data1064 s1516 (strip1133 (source-wrap1115 e1513 w1515 s1516 mod1517) (quote (())))) (if (memv t1518 (quote (global))) (build-annotated1063 s1516 (if mod1517 (make-module-ref (cdr mod1517) value1512 (car mod1517)) (make-module-ref mod1517 value1512 (quote bare)))) (if (memv t1518 (quote (call))) (chi-application1124 (chi1122 (car e1513) r1514 w1515 mod1517) e1513 r1514 w1515 s1516 mod1517) (if (memv t1518 (quote (begin-form))) ((lambda (tmp1521) ((lambda (tmp1522) (if tmp1522 (apply (lambda (_1523 e11524 e21525) (chi-sequence1116 (cons e11524 e21525) r1514 w1515 s1516 mod1517)) tmp1522) (syntax-violation #f "source expression failed to match any pattern" tmp1521))) ($sc-dispatch tmp1521 (quote (any any . each-any))))) e1513) (if (memv t1518 (quote (local-syntax-form))) (chi-local-syntax1128 value1512 e1513 r1514 w1515 s1516 mod1517 chi-sequence1116) (if (memv t1518 (quote (eval-when-form))) ((lambda (tmp1527) ((lambda (tmp1528) (if tmp1528 (apply (lambda (_1529 x1530 e11531 e21532) (let ((when-list1533 (chi-when-list1119 e1513 x1530 w1515))) (if (memq (quote eval) when-list1533) (chi-sequence1116 (cons e11531 e21532) r1514 w1515 s1516 mod1517) (chi-void1130)))) tmp1528) (syntax-violation #f "source expression failed to match any pattern" tmp1527))) ($sc-dispatch tmp1527 (quote (any each-any any . each-any))))) e1513) (if (memv t1518 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1513 (wrap1114 value1512 w1515 mod1517)) (if (memv t1518 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1115 e1513 w1515 s1516 mod1517)) (if (memv t1518 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1115 e1513 w1515 s1516 mod1517)) (syntax-violation #f "unexpected syntax" (source-wrap1115 e1513 w1515 s1516 mod1517))))))))))))))))))) (chi1122 (lambda (e1536 r1537 w1538 mod1539) (call-with-values (lambda () (syntax-type1120 e1536 r1537 w1538 #f #f mod1539)) (lambda (type1540 value1541 e1542 w1543 s1544 mod1545) (chi-expr1123 type1540 value1541 e1542 r1537 w1543 s1544 mod1545))))) (chi-top1121 (lambda (e1546 r1547 w1548 m1549 esew1550 mod1551) (call-with-values (lambda () (syntax-type1120 e1546 r1547 w1548 #f #f mod1551)) (lambda (type1559 value1560 e1561 w1562 s1563 mod1564) (let ((t1565 type1559)) (if (memv t1565 (quote (begin-form))) ((lambda (tmp1566) ((lambda (tmp1567) (if tmp1567 (apply (lambda (_1568) (chi-void1130)) tmp1567) ((lambda (tmp1569) (if tmp1569 (apply (lambda (_1570 e11571 e21572) (chi-top-sequence1117 (cons e11571 e21572) r1547 w1562 s1563 m1549 esew1550 mod1564)) tmp1569) (syntax-violation #f "source expression failed to match any pattern" tmp1566))) ($sc-dispatch tmp1566 (quote (any any . each-any)))))) ($sc-dispatch tmp1566 (quote (any))))) e1561) (if (memv t1565 (quote (local-syntax-form))) (chi-local-syntax1128 value1560 e1561 r1547 w1562 s1563 mod1564 (lambda (body1574 r1575 w1576 s1577 mod1578) (chi-top-sequence1117 body1574 r1575 w1576 s1577 m1549 esew1550 mod1578))) (if (memv t1565 (quote (eval-when-form))) ((lambda (tmp1579) ((lambda (tmp1580) (if tmp1580 (apply (lambda (_1581 x1582 e11583 e21584) (let ((when-list1585 (chi-when-list1119 e1561 x1582 w1562)) (body1586 (cons e11583 e21584))) (cond ((eq? m1549 (quote e)) (if (memq (quote eval) when-list1585) (chi-top-sequence1117 body1586 r1547 w1562 s1563 (quote e) (quote (eval)) mod1564) (chi-void1130))) ((memq (quote load) when-list1585) (if (or (memq (quote compile) when-list1585) (and (eq? m1549 (quote c&e)) (memq (quote eval) when-list1585))) (chi-top-sequence1117 body1586 r1547 w1562 s1563 (quote c&e) (quote (compile load)) mod1564) (if (memq m1549 (quote (c c&e))) (chi-top-sequence1117 body1586 r1547 w1562 s1563 (quote c) (quote (load)) mod1564) (chi-void1130)))) ((or (memq (quote compile) when-list1585) (and (eq? m1549 (quote c&e)) (memq (quote eval) when-list1585))) (top-level-eval-hook1059 (chi-top-sequence1117 body1586 r1547 w1562 s1563 (quote e) (quote (eval)) mod1564) mod1564) (chi-void1130)) (else (chi-void1130))))) tmp1580) (syntax-violation #f "source expression failed to match any pattern" tmp1579))) ($sc-dispatch tmp1579 (quote (any each-any any . each-any))))) e1561) (if (memv t1565 (quote (define-syntax-form))) (let ((n1589 (id-var-name1108 value1560 w1562)) (r1590 (macros-only-env1082 r1547))) (let ((t1591 m1549)) (if (memv t1591 (quote (c))) (if (memq (quote compile) esew1550) (let ((e1592 (chi-install-global1118 n1589 (chi1122 e1561 r1590 w1562 mod1564)))) (begin (top-level-eval-hook1059 e1592 mod1564) (if (memq (quote load) esew1550) e1592 (chi-void1130)))) (if (memq (quote load) esew1550) (chi-install-global1118 n1589 (chi1122 e1561 r1590 w1562 mod1564)) (chi-void1130))) (if (memv t1591 (quote (c&e))) (let ((e1593 (chi-install-global1118 n1589 (chi1122 e1561 r1590 w1562 mod1564)))) (begin (top-level-eval-hook1059 e1593 mod1564) e1593)) (begin (if (memq (quote eval) esew1550) (top-level-eval-hook1059 (chi-install-global1118 n1589 (chi1122 e1561 r1590 w1562 mod1564)) mod1564)) (chi-void1130)))))) (if (memv t1565 (quote (define-form))) (let ((n1594 (id-var-name1108 value1560 w1562))) (let ((type1595 (binding-type1078 (lookup1083 n1594 r1547 mod1564)))) (let ((t1596 type1595)) (if (memv t1596 (quote (global core macro module-ref))) (let ((x1597 (build-annotated1063 s1563 (list (quote define) n1594 (chi1122 e1561 r1547 w1562 mod1564))))) (begin (if (eq? m1549 (quote c&e)) (top-level-eval-hook1059 x1597 mod1564)) x1597)) (if (memv t1596 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1561 (wrap1114 value1560 w1562 mod1564)) (syntax-violation #f "cannot define keyword at top level" e1561 (wrap1114 value1560 w1562 mod1564))))))) (let ((x1598 (chi-expr1123 type1559 value1560 e1561 r1547 w1562 s1563 mod1564))) (begin (if (eq? m1549 (quote c&e)) (top-level-eval-hook1059 x1598 mod1564)) x1598)))))))))))) (syntax-type1120 (lambda (e1599 r1600 w1601 s1602 rib1603 mod1604) (cond ((symbol? e1599) (let ((n1605 (id-var-name1108 e1599 w1601))) (let ((b1606 (lookup1083 n1605 r1600 mod1604))) (let ((type1607 (binding-type1078 b1606))) (let ((t1608 type1607)) (if (memv t1608 (quote (lexical))) (values type1607 (binding-value1079 b1606) e1599 w1601 s1602 mod1604) (if (memv t1608 (quote (global))) (values type1607 n1605 e1599 w1601 s1602 mod1604) (if (memv t1608 (quote (macro))) (syntax-type1120 (chi-macro1125 (binding-value1079 b1606) e1599 r1600 w1601 rib1603 mod1604) r1600 (quote (())) s1602 rib1603 mod1604) (values type1607 (binding-value1079 b1606) e1599 w1601 s1602 mod1604))))))))) ((pair? e1599) (let ((first1609 (car e1599))) (if (id?1086 first1609) (let ((n1610 (id-var-name1108 first1609 w1601))) (let ((b1611 (lookup1083 n1610 r1600 (or (and (syntax-object?1070 first1609) (syntax-object-module1073 first1609)) mod1604)))) (let ((type1612 (binding-type1078 b1611))) (let ((t1613 type1612)) (if (memv t1613 (quote (lexical))) (values (quote lexical-call) (binding-value1079 b1611) e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (global))) (values (quote global-call) n1610 e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (macro))) (syntax-type1120 (chi-macro1125 (binding-value1079 b1611) e1599 r1600 w1601 rib1603 mod1604) r1600 (quote (())) s1602 rib1603 mod1604) (if (memv t1613 (quote (core external-macro module-ref))) (values type1612 (binding-value1079 b1611) e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1079 b1611) e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (begin))) (values (quote begin-form) #f e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (eval-when))) (values (quote eval-when-form) #f e1599 w1601 s1602 mod1604) (if (memv t1613 (quote (define))) ((lambda (tmp1614) ((lambda (tmp1615) (if (if tmp1615 (apply (lambda (_1616 name1617 val1618) (id?1086 name1617)) tmp1615) #f) (apply (lambda (_1619 name1620 val1621) (values (quote define-form) name1620 val1621 w1601 s1602 mod1604)) tmp1615) ((lambda (tmp1622) (if (if tmp1622 (apply (lambda (_1623 name1624 args1625 e11626 e21627) (and (id?1086 name1624) (valid-bound-ids?1111 (lambda-var-list1135 args1625)))) tmp1622) #f) (apply (lambda (_1628 name1629 args1630 e11631 e21632) (values (quote define-form) (wrap1114 name1629 w1601 mod1604) (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))) (wrap1114 (cons args1630 (cons e11631 e21632)) w1601 mod1604)) (quote (())) s1602 mod1604)) tmp1622) ((lambda (tmp1634) (if (if tmp1634 (apply (lambda (_1635 name1636) (id?1086 name1636)) tmp1634) #f) (apply (lambda (_1637 name1638) (values (quote define-form) (wrap1114 name1638 w1601 mod1604) (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 (())) s1602 mod1604)) tmp1634) (syntax-violation #f "source expression failed to match any pattern" tmp1614))) ($sc-dispatch tmp1614 (quote (any any)))))) ($sc-dispatch tmp1614 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1614 (quote (any any any))))) e1599) (if (memv t1613 (quote (define-syntax))) ((lambda (tmp1639) ((lambda (tmp1640) (if (if tmp1640 (apply (lambda (_1641 name1642 val1643) (id?1086 name1642)) tmp1640) #f) (apply (lambda (_1644 name1645 val1646) (values (quote define-syntax-form) name1645 val1646 w1601 s1602 mod1604)) tmp1640) (syntax-violation #f "source expression failed to match any pattern" tmp1639))) ($sc-dispatch tmp1639 (quote (any any any))))) e1599) (values (quote call) #f e1599 w1601 s1602 mod1604)))))))))))))) (values (quote call) #f e1599 w1601 s1602 mod1604)))) ((syntax-object?1070 e1599) (syntax-type1120 (syntax-object-expression1071 e1599) r1600 (join-wraps1105 w1601 (syntax-object-wrap1072 e1599)) #f rib1603 (or (syntax-object-module1073 e1599) mod1604))) ((annotation? e1599) (syntax-type1120 (annotation-expression e1599) r1600 w1601 (annotation-source e1599) rib1603 mod1604)) ((self-evaluating? e1599) (values (quote constant) #f e1599 w1601 s1602 mod1604)) (else (values (quote other) #f e1599 w1601 s1602 mod1604))))) (chi-when-list1119 (lambda (e1647 when-list1648 w1649) (let f1650 ((when-list1651 when-list1648) (situations1652 (quote ()))) (if (null? when-list1651) situations1652 (f1650 (cdr when-list1651) (cons (let ((x1653 (car when-list1651))) (cond ((free-id=?1109 x1653 (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=?1109 x1653 (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=?1109 x1653 (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" e1647 (wrap1114 x1653 w1649 #f))))) situations1652)))))) (chi-install-global1118 (lambda (name1654 e1655) (build-annotated1063 #f (list (build-annotated1063 #f (quote define)) name1654 (if (let ((v1656 (module-variable (current-module) name1654))) (and v1656 (variable-bound? v1656) (macro? (variable-ref v1656)) (not (eq? (macro-type (variable-ref v1656)) (quote syncase-macro))))) (build-annotated1063 #f (list (build-annotated1063 #f (quote make-extended-syncase-macro)) (build-annotated1063 #f (list (build-annotated1063 #f (quote module-ref)) (build-annotated1063 #f (quote (current-module))) (build-data1064 #f name1654))) (build-data1064 #f (quote macro)) e1655)) (build-annotated1063 #f (list (build-annotated1063 #f (quote make-syncase-macro)) (build-data1064 #f (quote macro)) e1655))))))) (chi-top-sequence1117 (lambda (body1657 r1658 w1659 s1660 m1661 esew1662 mod1663) (build-sequence1065 s1660 (let dobody1664 ((body1665 body1657) (r1666 r1658) (w1667 w1659) (m1668 m1661) (esew1669 esew1662) (mod1670 mod1663)) (if (null? body1665) (quote ()) (let ((first1671 (chi-top1121 (car body1665) r1666 w1667 m1668 esew1669 mod1670))) (cons first1671 (dobody1664 (cdr body1665) r1666 w1667 m1668 esew1669 mod1670)))))))) (chi-sequence1116 (lambda (body1672 r1673 w1674 s1675 mod1676) (build-sequence1065 s1675 (let dobody1677 ((body1678 body1672) (r1679 r1673) (w1680 w1674) (mod1681 mod1676)) (if (null? body1678) (quote ()) (let ((first1682 (chi1122 (car body1678) r1679 w1680 mod1681))) (cons first1682 (dobody1677 (cdr body1678) r1679 w1680 mod1681)))))))) (source-wrap1115 (lambda (x1683 w1684 s1685 defmod1686) (wrap1114 (if s1685 (make-annotation x1683 s1685 #f) x1683) w1684 defmod1686))) (wrap1114 (lambda (x1687 w1688 defmod1689) (cond ((and (null? (wrap-marks1089 w1688)) (null? (wrap-subst1090 w1688))) x1687) ((syntax-object?1070 x1687) (make-syntax-object1069 (syntax-object-expression1071 x1687) (join-wraps1105 w1688 (syntax-object-wrap1072 x1687)) (syntax-object-module1073 x1687))) ((null? x1687) x1687) (else (make-syntax-object1069 x1687 w1688 defmod1689))))) (bound-id-member?1113 (lambda (x1690 list1691) (and (not (null? list1691)) (or (bound-id=?1110 x1690 (car list1691)) (bound-id-member?1113 x1690 (cdr list1691)))))) (distinct-bound-ids?1112 (lambda (ids1692) (let distinct?1693 ((ids1694 ids1692)) (or (null? ids1694) (and (not (bound-id-member?1113 (car ids1694) (cdr ids1694))) (distinct?1693 (cdr ids1694))))))) (valid-bound-ids?1111 (lambda (ids1695) (and (let all-ids?1696 ((ids1697 ids1695)) (or (null? ids1697) (and (id?1086 (car ids1697)) (all-ids?1696 (cdr ids1697))))) (distinct-bound-ids?1112 ids1695)))) (bound-id=?1110 (lambda (i1698 j1699) (if (and (syntax-object?1070 i1698) (syntax-object?1070 j1699)) (and (eq? (let ((e1700 (syntax-object-expression1071 i1698))) (if (annotation? e1700) (annotation-expression e1700) e1700)) (let ((e1701 (syntax-object-expression1071 j1699))) (if (annotation? e1701) (annotation-expression e1701) e1701))) (same-marks?1107 (wrap-marks1089 (syntax-object-wrap1072 i1698)) (wrap-marks1089 (syntax-object-wrap1072 j1699)))) (eq? (let ((e1702 i1698)) (if (annotation? e1702) (annotation-expression e1702) e1702)) (let ((e1703 j1699)) (if (annotation? e1703) (annotation-expression e1703) e1703)))))) (free-id=?1109 (lambda (i1704 j1705) (and (eq? (let ((x1706 i1704)) (let ((e1707 (if (syntax-object?1070 x1706) (syntax-object-expression1071 x1706) x1706))) (if (annotation? e1707) (annotation-expression e1707) e1707))) (let ((x1708 j1705)) (let ((e1709 (if (syntax-object?1070 x1708) (syntax-object-expression1071 x1708) x1708))) (if (annotation? e1709) (annotation-expression e1709) e1709)))) (eq? (id-var-name1108 i1704 (quote (()))) (id-var-name1108 j1705 (quote (()))))))) (id-var-name1108 (lambda (id1710 w1711) (letrec ((search-vector-rib1714 (lambda (sym1720 subst1721 marks1722 symnames1723 ribcage1724) (let ((n1725 (vector-length symnames1723))) (let f1726 ((i1727 0)) (cond ((fx=1057 i1727 n1725) (search1712 sym1720 (cdr subst1721) marks1722)) ((and (eq? (vector-ref symnames1723 i1727) sym1720) (same-marks?1107 marks1722 (vector-ref (ribcage-marks1096 ribcage1724) i1727))) (values (vector-ref (ribcage-labels1097 ribcage1724) i1727) marks1722)) (else (f1726 (fx+1055 i1727 1)))))))) (search-list-rib1713 (lambda (sym1728 subst1729 marks1730 symnames1731 ribcage1732) (let f1733 ((symnames1734 symnames1731) (i1735 0)) (cond ((null? symnames1734) (search1712 sym1728 (cdr subst1729) marks1730)) ((and (eq? (car symnames1734) sym1728) (same-marks?1107 marks1730 (list-ref (ribcage-marks1096 ribcage1732) i1735))) (values (list-ref (ribcage-labels1097 ribcage1732) i1735) marks1730)) (else (f1733 (cdr symnames1734) (fx+1055 i1735 1))))))) (search1712 (lambda (sym1736 subst1737 marks1738) (if (null? subst1737) (values #f marks1738) (let ((fst1739 (car subst1737))) (if (eq? fst1739 (quote shift)) (search1712 sym1736 (cdr subst1737) (cdr marks1738)) (let ((symnames1740 (ribcage-symnames1095 fst1739))) (if (vector? symnames1740) (search-vector-rib1714 sym1736 subst1737 marks1738 symnames1740 fst1739) (search-list-rib1713 sym1736 subst1737 marks1738 symnames1740 fst1739))))))))) (cond ((symbol? id1710) (or (call-with-values (lambda () (search1712 id1710 (wrap-subst1090 w1711) (wrap-marks1089 w1711))) (lambda (x1742 . ignore1741) x1742)) id1710)) ((syntax-object?1070 id1710) (let ((id1743 (let ((e1745 (syntax-object-expression1071 id1710))) (if (annotation? e1745) (annotation-expression e1745) e1745))) (w11744 (syntax-object-wrap1072 id1710))) (let ((marks1746 (join-marks1106 (wrap-marks1089 w1711) (wrap-marks1089 w11744)))) (call-with-values (lambda () (search1712 id1743 (wrap-subst1090 w1711) marks1746)) (lambda (new-id1747 marks1748) (or new-id1747 (call-with-values (lambda () (search1712 id1743 (wrap-subst1090 w11744) marks1748)) (lambda (x1750 . ignore1749) x1750)) id1743)))))) ((annotation? id1710) (let ((id1751 (let ((e1752 id1710)) (if (annotation? e1752) (annotation-expression e1752) e1752)))) (or (call-with-values (lambda () (search1712 id1751 (wrap-subst1090 w1711) (wrap-marks1089 w1711))) (lambda (x1754 . ignore1753) x1754)) id1751))) (else (syntax-violation (quote id-var-name) "invalid id" id1710)))))) (same-marks?1107 (lambda (x1755 y1756) (or (eq? x1755 y1756) (and (not (null? x1755)) (not (null? y1756)) (eq? (car x1755) (car y1756)) (same-marks?1107 (cdr x1755) (cdr y1756)))))) (join-marks1106 (lambda (m11757 m21758) (smart-append1104 m11757 m21758))) (join-wraps1105 (lambda (w11759 w21760) (let ((m11761 (wrap-marks1089 w11759)) (s11762 (wrap-subst1090 w11759))) (if (null? m11761) (if (null? s11762) w21760 (make-wrap1088 (wrap-marks1089 w21760) (smart-append1104 s11762 (wrap-subst1090 w21760)))) (make-wrap1088 (smart-append1104 m11761 (wrap-marks1089 w21760)) (smart-append1104 s11762 (wrap-subst1090 w21760))))))) (smart-append1104 (lambda (m11763 m21764) (if (null? m21764) m11763 (append m11763 m21764)))) (make-binding-wrap1103 (lambda (ids1765 labels1766 w1767) (if (null? ids1765) w1767 (make-wrap1088 (wrap-marks1089 w1767) (cons (let ((labelvec1768 (list->vector labels1766))) (let ((n1769 (vector-length labelvec1768))) (let ((symnamevec1770 (make-vector n1769)) (marksvec1771 (make-vector n1769))) (begin (let f1772 ((ids1773 ids1765) (i1774 0)) (if (not (null? ids1773)) (call-with-values (lambda () (id-sym-name&marks1087 (car ids1773) w1767)) (lambda (symname1775 marks1776) (begin (vector-set! symnamevec1770 i1774 symname1775) (vector-set! marksvec1771 i1774 marks1776) (f1772 (cdr ids1773) (fx+1055 i1774 1))))))) (make-ribcage1093 symnamevec1770 marksvec1771 labelvec1768))))) (wrap-subst1090 w1767)))))) (extend-ribcage!1102 (lambda (ribcage1777 id1778 label1779) (begin (set-ribcage-symnames!1098 ribcage1777 (cons (let ((e1780 (syntax-object-expression1071 id1778))) (if (annotation? e1780) (annotation-expression e1780) e1780)) (ribcage-symnames1095 ribcage1777))) (set-ribcage-marks!1099 ribcage1777 (cons (wrap-marks1089 (syntax-object-wrap1072 id1778)) (ribcage-marks1096 ribcage1777))) (set-ribcage-labels!1100 ribcage1777 (cons label1779 (ribcage-labels1097 ribcage1777)))))) (anti-mark1101 (lambda (w1781) (make-wrap1088 (cons #f (wrap-marks1089 w1781)) (cons (quote shift) (wrap-subst1090 w1781))))) (set-ribcage-labels!1100 (lambda (x1782 update1783) (vector-set! x1782 3 update1783))) (set-ribcage-marks!1099 (lambda (x1784 update1785) (vector-set! x1784 2 update1785))) (set-ribcage-symnames!1098 (lambda (x1786 update1787) (vector-set! x1786 1 update1787))) (ribcage-labels1097 (lambda (x1788) (vector-ref x1788 3))) (ribcage-marks1096 (lambda (x1789) (vector-ref x1789 2))) (ribcage-symnames1095 (lambda (x1790) (vector-ref x1790 1))) (ribcage?1094 (lambda (x1791) (and (vector? x1791) (= (vector-length x1791) 4) (eq? (vector-ref x1791 0) (quote ribcage))))) (make-ribcage1093 (lambda (symnames1792 marks1793 labels1794) (vector (quote ribcage) symnames1792 marks1793 labels1794))) (gen-labels1092 (lambda (ls1795) (if (null? ls1795) (quote ()) (cons (gen-label1091) (gen-labels1092 (cdr ls1795)))))) (gen-label1091 (lambda () (string #\i))) (wrap-subst1090 cdr) (wrap-marks1089 car) (make-wrap1088 cons) (id-sym-name&marks1087 (lambda (x1796 w1797) (if (syntax-object?1070 x1796) (values (let ((e1798 (syntax-object-expression1071 x1796))) (if (annotation? e1798) (annotation-expression e1798) e1798)) (join-marks1106 (wrap-marks1089 w1797) (wrap-marks1089 (syntax-object-wrap1072 x1796)))) (values (let ((e1799 x1796)) (if (annotation? e1799) (annotation-expression e1799) e1799)) (wrap-marks1089 w1797))))) (id?1086 (lambda (x1800) (cond ((symbol? x1800) #t) ((syntax-object?1070 x1800) (symbol? (let ((e1801 (syntax-object-expression1071 x1800))) (if (annotation? e1801) (annotation-expression e1801) e1801)))) ((annotation? x1800) (symbol? (annotation-expression x1800))) (else #f)))) (nonsymbol-id?1085 (lambda (x1802) (and (syntax-object?1070 x1802) (symbol? (let ((e1803 (syntax-object-expression1071 x1802))) (if (annotation? e1803) (annotation-expression e1803) e1803)))))) (global-extend1084 (lambda (type1804 sym1805 val1806) (put-global-definition-hook1061 sym1805 type1804 val1806))) (lookup1083 (lambda (x1807 r1808 mod1809) (cond ((assq x1807 r1808) => cdr) ((symbol? x1807) (or (get-global-definition-hook1062 x1807 mod1809) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1082 (lambda (r1810) (if (null? r1810) (quote ()) (let ((a1811 (car r1810))) (if (eq? (cadr a1811) (quote macro)) (cons a1811 (macros-only-env1082 (cdr r1810))) (macros-only-env1082 (cdr r1810))))))) (extend-var-env1081 (lambda (labels1812 vars1813 r1814) (if (null? labels1812) r1814 (extend-var-env1081 (cdr labels1812) (cdr vars1813) (cons (cons (car labels1812) (cons (quote lexical) (car vars1813))) r1814))))) (extend-env1080 (lambda (labels1815 bindings1816 r1817) (if (null? labels1815) r1817 (extend-env1080 (cdr labels1815) (cdr bindings1816) (cons (cons (car labels1815) (car bindings1816)) r1817))))) (binding-value1079 cdr) (binding-type1078 car) (source-annotation1077 (lambda (x1818) (cond ((annotation? x1818) (annotation-source x1818)) ((syntax-object?1070 x1818) (source-annotation1077 (syntax-object-expression1071 x1818))) (else #f)))) (set-syntax-object-module!1076 (lambda (x1819 update1820) (vector-set! x1819 3 update1820))) (set-syntax-object-wrap!1075 (lambda (x1821 update1822) (vector-set! x1821 2 update1822))) (set-syntax-object-expression!1074 (lambda (x1823 update1824) (vector-set! x1823 1 update1824))) (syntax-object-module1073 (lambda (x1825) (vector-ref x1825 3))) (syntax-object-wrap1072 (lambda (x1826) (vector-ref x1826 2))) (syntax-object-expression1071 (lambda (x1827) (vector-ref x1827 1))) (syntax-object?1070 (lambda (x1828) (and (vector? x1828) (= (vector-length x1828) 4) (eq? (vector-ref x1828 0) (quote syntax-object))))) (make-syntax-object1069 (lambda (expression1829 wrap1830 module1831) (vector (quote syntax-object) expression1829 wrap1830 module1831))) (build-letrec1068 (lambda (src1832 vars1833 val-exps1834 body-exp1835) (if (null? vars1833) (build-annotated1063 src1832 body-exp1835) (build-annotated1063 src1832 (list (quote letrec) (map list vars1833 val-exps1834) body-exp1835))))) (build-named-let1067 (lambda (src1836 vars1837 val-exps1838 body-exp1839) (if (null? vars1837) (build-annotated1063 src1836 body-exp1839) (build-annotated1063 src1836 (list (quote let) (car vars1837) (map list (cdr vars1837) val-exps1838) body-exp1839))))) (build-let1066 (lambda (src1840 vars1841 val-exps1842 body-exp1843) (if (null? vars1841) (build-annotated1063 src1840 body-exp1843) (build-annotated1063 src1840 (list (quote let) (map list vars1841 val-exps1842) body-exp1843))))) (build-sequence1065 (lambda (src1844 exps1845) (if (null? (cdr exps1845)) (build-annotated1063 src1844 (car exps1845)) (build-annotated1063 src1844 (cons (quote begin) exps1845))))) (build-data1064 (lambda (src1846 exp1847) (if (and (self-evaluating? exp1847) (not (vector? exp1847))) (build-annotated1063 src1846 exp1847) (build-annotated1063 src1846 (list (quote quote) exp1847))))) (build-annotated1063 (lambda (src1848 exp1849) (if (and src1848 (not (annotation? exp1849))) (make-annotation exp1849 src1848 #t) exp1849))) (get-global-definition-hook1062 (lambda (symbol1850 module1851) (begin (if (and (not module1851) (current-module)) (warn "module system is booted, we should have a module" symbol1850)) (let ((v1852 (module-variable (if module1851 (resolve-module (cdr module1851)) (current-module)) symbol1850))) (and v1852 (variable-bound? v1852) (let ((val1853 (variable-ref v1852))) (and (macro? val1853) (syncase-macro-type val1853) (cons (syncase-macro-type val1853) (syncase-macro-binding val1853))))))))) (put-global-definition-hook1061 (lambda (symbol1854 type1855 val1856) (let ((existing1857 (let ((v1858 (module-variable (current-module) symbol1854))) (and v1858 (variable-bound? v1858) (let ((val1859 (variable-ref v1858))) (and (macro? val1859) (not (syncase-macro-type val1859)) val1859)))))) (module-define! (current-module) symbol1854 (if existing1857 (make-extended-syncase-macro existing1857 type1855 val1856) (make-syncase-macro type1855 val1856)))))) (local-eval-hook1060 (lambda (x1860 mod1861) (primitive-eval (list noexpand1054 x1860)))) (top-level-eval-hook1059 (lambda (x1862 mod1863) (primitive-eval (list noexpand1054 x1862)))) (fx<1058 <) (fx=1057 =) (fx-1056 -) (fx+1055 +) (noexpand1054 "noexpand")) (begin (global-extend1084 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1084 (quote local-syntax) (quote let-syntax) #f) (global-extend1084 (quote core) (quote fluid-let-syntax) (lambda (e1864 r1865 w1866 s1867 mod1868) ((lambda (tmp1869) ((lambda (tmp1870) (if (if tmp1870 (apply (lambda (_1871 var1872 val1873 e11874 e21875) (valid-bound-ids?1111 var1872)) tmp1870) #f) (apply (lambda (_1877 var1878 val1879 e11880 e21881) (let ((names1882 (map (lambda (x1883) (id-var-name1108 x1883 w1866)) var1878))) (begin (for-each (lambda (id1885 n1886) (let ((t1887 (binding-type1078 (lookup1083 n1886 r1865 mod1868)))) (if (memv t1887 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1864 (source-wrap1115 id1885 w1866 s1867 mod1868))))) var1878 names1882) (chi-body1126 (cons e11880 e21881) (source-wrap1115 e1864 w1866 s1867 mod1868) (extend-env1080 names1882 (let ((trans-r1890 (macros-only-env1082 r1865))) (map (lambda (x1891) (cons (quote macro) (eval-local-transformer1129 (chi1122 x1891 trans-r1890 w1866 mod1868) mod1868))) val1879)) r1865) w1866 mod1868)))) tmp1870) ((lambda (_1893) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1115 e1864 w1866 s1867 mod1868))) tmp1869))) ($sc-dispatch tmp1869 (quote (any #(each (any any)) any . each-any))))) e1864))) (global-extend1084 (quote core) (quote quote) (lambda (e1894 r1895 w1896 s1897 mod1898) ((lambda (tmp1899) ((lambda (tmp1900) (if tmp1900 (apply (lambda (_1901 e1902) (build-data1064 s1897 (strip1133 e1902 w1896))) tmp1900) ((lambda (_1903) (syntax-violation (quote quote) "bad syntax" (source-wrap1115 e1894 w1896 s1897 mod1898))) tmp1899))) ($sc-dispatch tmp1899 (quote (any any))))) e1894))) (global-extend1084 (quote core) (quote syntax) (letrec ((regen1911 (lambda (x1912) (let ((t1913 (car x1912))) (if (memv t1913 (quote (ref))) (build-annotated1063 #f (cadr x1912)) (if (memv t1913 (quote (primitive))) (build-annotated1063 #f (cadr x1912)) (if (memv t1913 (quote (quote))) (build-data1064 #f (cadr x1912)) (if (memv t1913 (quote (lambda))) (build-annotated1063 #f (list (quote lambda) (cadr x1912) (regen1911 (caddr x1912)))) (if (memv t1913 (quote (map))) (let ((ls1914 (map regen1911 (cdr x1912)))) (build-annotated1063 #f (cons (if (fx=1057 (length ls1914) 2) (build-annotated1063 #f (quote map)) (build-annotated1063 #f (quote map))) ls1914))) (build-annotated1063 #f (cons (build-annotated1063 #f (car x1912)) (map regen1911 (cdr x1912)))))))))))) (gen-vector1910 (lambda (x1915) (cond ((eq? (car x1915) (quote list)) (cons (quote vector) (cdr x1915))) ((eq? (car x1915) (quote quote)) (list (quote quote) (list->vector (cadr x1915)))) (else (list (quote list->vector) x1915))))) (gen-append1909 (lambda (x1916 y1917) (if (equal? y1917 (quote (quote ()))) x1916 (list (quote append) x1916 y1917)))) (gen-cons1908 (lambda (x1918 y1919) (let ((t1920 (car y1919))) (if (memv t1920 (quote (quote))) (if (eq? (car x1918) (quote quote)) (list (quote quote) (cons (cadr x1918) (cadr y1919))) (if (eq? (cadr y1919) (quote ())) (list (quote list) x1918) (list (quote cons) x1918 y1919))) (if (memv t1920 (quote (list))) (cons (quote list) (cons x1918 (cdr y1919))) (list (quote cons) x1918 y1919)))))) (gen-map1907 (lambda (e1921 map-env1922) (let ((formals1923 (map cdr map-env1922)) (actuals1924 (map (lambda (x1925) (list (quote ref) (car x1925))) map-env1922))) (cond ((eq? (car e1921) (quote ref)) (car actuals1924)) ((and-map (lambda (x1926) (and (eq? (car x1926) (quote ref)) (memq (cadr x1926) formals1923))) (cdr e1921)) (cons (quote map) (cons (list (quote primitive) (car e1921)) (map (let ((r1927 (map cons formals1923 actuals1924))) (lambda (x1928) (cdr (assq (cadr x1928) r1927)))) (cdr e1921))))) (else (cons (quote map) (cons (list (quote lambda) formals1923 e1921) actuals1924))))))) (gen-mappend1906 (lambda (e1929 map-env1930) (list (quote apply) (quote (primitive append)) (gen-map1907 e1929 map-env1930)))) (gen-ref1905 (lambda (src1931 var1932 level1933 maps1934) (if (fx=1057 level1933 0) (values var1932 maps1934) (if (null? maps1934) (syntax-violation (quote syntax) "missing ellipsis" src1931) (call-with-values (lambda () (gen-ref1905 src1931 var1932 (fx-1056 level1933 1) (cdr maps1934))) (lambda (outer-var1935 outer-maps1936) (let ((b1937 (assq outer-var1935 (car maps1934)))) (if b1937 (values (cdr b1937) maps1934) (let ((inner-var1938 (gen-var1134 (quote tmp)))) (values inner-var1938 (cons (cons (cons outer-var1935 inner-var1938) (car maps1934)) outer-maps1936))))))))))) (gen-syntax1904 (lambda (src1939 e1940 r1941 maps1942 ellipsis?1943 mod1944) (if (id?1086 e1940) (let ((label1945 (id-var-name1108 e1940 (quote (()))))) (let ((b1946 (lookup1083 label1945 r1941 mod1944))) (if (eq? (binding-type1078 b1946) (quote syntax)) (call-with-values (lambda () (let ((var.lev1947 (binding-value1079 b1946))) (gen-ref1905 src1939 (car var.lev1947) (cdr var.lev1947) maps1942))) (lambda (var1948 maps1949) (values (list (quote ref) var1948) maps1949))) (if (ellipsis?1943 e1940) (syntax-violation (quote syntax) "misplaced ellipsis" src1939) (values (list (quote quote) e1940) maps1942))))) ((lambda (tmp1950) ((lambda (tmp1951) (if (if tmp1951 (apply (lambda (dots1952 e1953) (ellipsis?1943 dots1952)) tmp1951) #f) (apply (lambda (dots1954 e1955) (gen-syntax1904 src1939 e1955 r1941 maps1942 (lambda (x1956) #f) mod1944)) tmp1951) ((lambda (tmp1957) (if (if tmp1957 (apply (lambda (x1958 dots1959 y1960) (ellipsis?1943 dots1959)) tmp1957) #f) (apply (lambda (x1961 dots1962 y1963) (let f1964 ((y1965 y1963) (k1966 (lambda (maps1967) (call-with-values (lambda () (gen-syntax1904 src1939 x1961 r1941 (cons (quote ()) maps1967) ellipsis?1943 mod1944)) (lambda (x1968 maps1969) (if (null? (car maps1969)) (syntax-violation (quote syntax) "extra ellipsis" src1939) (values (gen-map1907 x1968 (car maps1969)) (cdr maps1969)))))))) ((lambda (tmp1970) ((lambda (tmp1971) (if (if tmp1971 (apply (lambda (dots1972 y1973) (ellipsis?1943 dots1972)) tmp1971) #f) (apply (lambda (dots1974 y1975) (f1964 y1975 (lambda (maps1976) (call-with-values (lambda () (k1966 (cons (quote ()) maps1976))) (lambda (x1977 maps1978) (if (null? (car maps1978)) (syntax-violation (quote syntax) "extra ellipsis" src1939) (values (gen-mappend1906 x1977 (car maps1978)) (cdr maps1978)))))))) tmp1971) ((lambda (_1979) (call-with-values (lambda () (gen-syntax1904 src1939 y1965 r1941 maps1942 ellipsis?1943 mod1944)) (lambda (y1980 maps1981) (call-with-values (lambda () (k1966 maps1981)) (lambda (x1982 maps1983) (values (gen-append1909 x1982 y1980) maps1983)))))) tmp1970))) ($sc-dispatch tmp1970 (quote (any . any))))) y1965))) tmp1957) ((lambda (tmp1984) (if tmp1984 (apply (lambda (x1985 y1986) (call-with-values (lambda () (gen-syntax1904 src1939 x1985 r1941 maps1942 ellipsis?1943 mod1944)) (lambda (x1987 maps1988) (call-with-values (lambda () (gen-syntax1904 src1939 y1986 r1941 maps1988 ellipsis?1943 mod1944)) (lambda (y1989 maps1990) (values (gen-cons1908 x1987 y1989) maps1990)))))) tmp1984) ((lambda (tmp1991) (if tmp1991 (apply (lambda (e11992 e21993) (call-with-values (lambda () (gen-syntax1904 src1939 (cons e11992 e21993) r1941 maps1942 ellipsis?1943 mod1944)) (lambda (e1995 maps1996) (values (gen-vector1910 e1995) maps1996)))) tmp1991) ((lambda (_1997) (values (list (quote quote) e1940) maps1942)) tmp1950))) ($sc-dispatch tmp1950 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp1950 (quote (any . any)))))) ($sc-dispatch tmp1950 (quote (any any . any)))))) ($sc-dispatch tmp1950 (quote (any any))))) e1940))))) (lambda (e1998 r1999 w2000 s2001 mod2002) (let ((e2003 (source-wrap1115 e1998 w2000 s2001 mod2002))) ((lambda (tmp2004) ((lambda (tmp2005) (if tmp2005 (apply (lambda (_2006 x2007) (call-with-values (lambda () (gen-syntax1904 e2003 x2007 r1999 (quote ()) ellipsis?1131 mod2002)) (lambda (e2008 maps2009) (regen1911 e2008)))) tmp2005) ((lambda (_2010) (syntax-violation (quote syntax) "bad `syntax' form" e2003)) tmp2004))) ($sc-dispatch tmp2004 (quote (any any))))) e2003))))) (global-extend1084 (quote core) (quote lambda) (lambda (e2011 r2012 w2013 s2014 mod2015) ((lambda (tmp2016) ((lambda (tmp2017) (if tmp2017 (apply (lambda (_2018 c2019) (chi-lambda-clause1127 (source-wrap1115 e2011 w2013 s2014 mod2015) #f c2019 r2012 w2013 mod2015 (lambda (vars2020 docstring2021 body2022) (build-annotated1063 s2014 (cons (quote lambda) (cons vars2020 (append (if docstring2021 (list docstring2021) (quote ())) (list body2022)))))))) tmp2017) (syntax-violation #f "source expression failed to match any pattern" tmp2016))) ($sc-dispatch tmp2016 (quote (any . any))))) e2011))) (global-extend1084 (quote core) (quote let) (letrec ((chi-let2023 (lambda (e2024 r2025 w2026 s2027 mod2028 constructor2029 ids2030 vals2031 exps2032) (if (not (valid-bound-ids?1111 ids2030)) (syntax-violation (quote let) "duplicate bound variable" e2024) (let ((labels2033 (gen-labels1092 ids2030)) (new-vars2034 (map gen-var1134 ids2030))) (let ((nw2035 (make-binding-wrap1103 ids2030 labels2033 w2026)) (nr2036 (extend-var-env1081 labels2033 new-vars2034 r2025))) (constructor2029 s2027 new-vars2034 (map (lambda (x2037) (chi1122 x2037 r2025 w2026 mod2028)) vals2031) (chi-body1126 exps2032 (source-wrap1115 e2024 nw2035 s2027 mod2028) nr2036 nw2035 mod2028)))))))) (lambda (e2038 r2039 w2040 s2041 mod2042) ((lambda (tmp2043) ((lambda (tmp2044) (if tmp2044 (apply (lambda (_2045 id2046 val2047 e12048 e22049) (chi-let2023 e2038 r2039 w2040 s2041 mod2042 build-let1066 id2046 val2047 (cons e12048 e22049))) tmp2044) ((lambda (tmp2053) (if (if tmp2053 (apply (lambda (_2054 f2055 id2056 val2057 e12058 e22059) (id?1086 f2055)) tmp2053) #f) (apply (lambda (_2060 f2061 id2062 val2063 e12064 e22065) (chi-let2023 e2038 r2039 w2040 s2041 mod2042 build-named-let1067 (cons f2061 id2062) val2063 (cons e12064 e22065))) tmp2053) ((lambda (_2069) (syntax-violation (quote let) "bad let" (source-wrap1115 e2038 w2040 s2041 mod2042))) tmp2043))) ($sc-dispatch tmp2043 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2043 (quote (any #(each (any any)) any . each-any))))) e2038)))) (global-extend1084 (quote core) (quote letrec) (lambda (e2070 r2071 w2072 s2073 mod2074) ((lambda (tmp2075) ((lambda (tmp2076) (if tmp2076 (apply (lambda (_2077 id2078 val2079 e12080 e22081) (let ((ids2082 id2078)) (if (not (valid-bound-ids?1111 ids2082)) (syntax-violation (quote letrec) "duplicate bound variable" e2070) (let ((labels2084 (gen-labels1092 ids2082)) (new-vars2085 (map gen-var1134 ids2082))) (let ((w2086 (make-binding-wrap1103 ids2082 labels2084 w2072)) (r2087 (extend-var-env1081 labels2084 new-vars2085 r2071))) (build-letrec1068 s2073 new-vars2085 (map (lambda (x2088) (chi1122 x2088 r2087 w2086 mod2074)) val2079) (chi-body1126 (cons e12080 e22081) (source-wrap1115 e2070 w2086 s2073 mod2074) r2087 w2086 mod2074))))))) tmp2076) ((lambda (_2091) (syntax-violation (quote letrec) "bad letrec" (source-wrap1115 e2070 w2072 s2073 mod2074))) tmp2075))) ($sc-dispatch tmp2075 (quote (any #(each (any any)) any . each-any))))) e2070))) (global-extend1084 (quote core) (quote set!) (lambda (e2092 r2093 w2094 s2095 mod2096) ((lambda (tmp2097) ((lambda (tmp2098) (if (if tmp2098 (apply (lambda (_2099 id2100 val2101) (id?1086 id2100)) tmp2098) #f) (apply (lambda (_2102 id2103 val2104) (let ((val2105 (chi1122 val2104 r2093 w2094 mod2096)) (n2106 (id-var-name1108 id2103 w2094))) (let ((b2107 (lookup1083 n2106 r2093 mod2096))) (let ((t2108 (binding-type1078 b2107))) (if (memv t2108 (quote (lexical))) (build-annotated1063 s2095 (list (quote set!) (binding-value1079 b2107) val2105)) (if (memv t2108 (quote (global))) (build-annotated1063 s2095 (list (quote set!) (if mod2096 (make-module-ref (cdr mod2096) n2106 (car mod2096)) (make-module-ref mod2096 n2106 (quote bare))) val2105)) (if (memv t2108 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1114 id2103 w2094 mod2096)) (syntax-violation (quote set!) "bad set!" (source-wrap1115 e2092 w2094 s2095 mod2096))))))))) tmp2098) ((lambda (tmp2109) (if tmp2109 (apply (lambda (_2110 head2111 tail2112 val2113) (call-with-values (lambda () (syntax-type1120 head2111 r2093 (quote (())) #f #f mod2096)) (lambda (type2114 value2115 ee2116 ww2117 ss2118 modmod2119) (let ((t2120 type2114)) (if (memv t2120 (quote (module-ref))) (let ((val2121 (chi1122 val2113 r2093 w2094 mod2096))) (call-with-values (lambda () (value2115 (cons head2111 tail2112))) (lambda (id2123 mod2124) (build-annotated1063 s2095 (list (quote set!) (if mod2124 (make-module-ref (cdr mod2124) id2123 (car mod2124)) (make-module-ref mod2124 id2123 (quote bare))) val2121))))) (build-annotated1063 s2095 (cons (chi1122 (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))) head2111) r2093 w2094 mod2096) (map (lambda (e2125) (chi1122 e2125 r2093 w2094 mod2096)) (append tail2112 (list val2113)))))))))) tmp2109) ((lambda (_2127) (syntax-violation (quote set!) "bad set!" (source-wrap1115 e2092 w2094 s2095 mod2096))) tmp2097))) ($sc-dispatch tmp2097 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2097 (quote (any any any))))) e2092))) (global-extend1084 (quote module-ref) (quote @) (lambda (e2128) ((lambda (tmp2129) ((lambda (tmp2130) (if (if tmp2130 (apply (lambda (_2131 mod2132 id2133) (and (and-map id?1086 mod2132) (id?1086 id2133))) tmp2130) #f) (apply (lambda (_2135 mod2136 id2137) (values (syntax->datum id2137) (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))) mod2136)))) tmp2130) (syntax-violation #f "source expression failed to match any pattern" tmp2129))) ($sc-dispatch tmp2129 (quote (any each-any any))))) e2128))) (global-extend1084 (quote module-ref) (quote @@) (lambda (e2139) ((lambda (tmp2140) ((lambda (tmp2141) (if (if tmp2141 (apply (lambda (_2142 mod2143 id2144) (and (and-map id?1086 mod2143) (id?1086 id2144))) tmp2141) #f) (apply (lambda (_2146 mod2147 id2148) (values (syntax->datum id2148) (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))) mod2147)))) tmp2141) (syntax-violation #f "source expression failed to match any pattern" tmp2140))) ($sc-dispatch tmp2140 (quote (any each-any any))))) e2139))) (global-extend1084 (quote begin) (quote begin) (quote ())) (global-extend1084 (quote define) (quote define) (quote ())) (global-extend1084 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1084 (quote eval-when) (quote eval-when) (quote ())) (global-extend1084 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2153 (lambda (x2154 keys2155 clauses2156 r2157 mod2158) (if (null? clauses2156) (build-annotated1063 #f (list (build-annotated1063 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2154)) ((lambda (tmp2159) ((lambda (tmp2160) (if tmp2160 (apply (lambda (pat2161 exp2162) (if (and (id?1086 pat2161) (and-map (lambda (x2163) (not (free-id=?1109 pat2161 x2163))) (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))) keys2155))) (let ((labels2164 (list (gen-label1091))) (var2165 (gen-var1134 pat2161))) (build-annotated1063 #f (list (build-annotated1063 #f (list (quote lambda) (list var2165) (chi1122 exp2162 (extend-env1080 labels2164 (list (cons (quote syntax) (cons var2165 0))) r2157) (make-binding-wrap1103 (list pat2161) labels2164 (quote (()))) mod2158))) x2154))) (gen-clause2152 x2154 keys2155 (cdr clauses2156) r2157 pat2161 #t exp2162 mod2158))) tmp2160) ((lambda (tmp2166) (if tmp2166 (apply (lambda (pat2167 fender2168 exp2169) (gen-clause2152 x2154 keys2155 (cdr clauses2156) r2157 pat2167 fender2168 exp2169 mod2158)) tmp2166) ((lambda (_2170) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2156))) tmp2159))) ($sc-dispatch tmp2159 (quote (any any any)))))) ($sc-dispatch tmp2159 (quote (any any))))) (car clauses2156))))) (gen-clause2152 (lambda (x2171 keys2172 clauses2173 r2174 pat2175 fender2176 exp2177 mod2178) (call-with-values (lambda () (convert-pattern2150 pat2175 keys2172)) (lambda (p2179 pvars2180) (cond ((not (distinct-bound-ids?1112 (map car pvars2180))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2175)) ((not (and-map (lambda (x2181) (not (ellipsis?1131 (car x2181)))) pvars2180)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2175)) (else (let ((y2182 (gen-var1134 (quote tmp)))) (build-annotated1063 #f (list (build-annotated1063 #f (list (quote lambda) (list y2182) (let ((y2183 (build-annotated1063 #f y2182))) (build-annotated1063 #f (list (quote if) ((lambda (tmp2184) ((lambda (tmp2185) (if tmp2185 (apply (lambda () y2183) tmp2185) ((lambda (_2186) (build-annotated1063 #f (list (quote if) y2183 (build-dispatch-call2151 pvars2180 fender2176 y2183 r2174 mod2178) (build-data1064 #f #f)))) tmp2184))) ($sc-dispatch tmp2184 (quote #(atom #t))))) fender2176) (build-dispatch-call2151 pvars2180 exp2177 y2183 r2174 mod2178) (gen-syntax-case2153 x2171 keys2172 clauses2173 r2174 mod2178)))))) (if (eq? p2179 (quote any)) (build-annotated1063 #f (list (build-annotated1063 #f (quote list)) x2171)) (build-annotated1063 #f (list (build-annotated1063 #f (quote $sc-dispatch)) x2171 (build-data1064 #f p2179))))))))))))) (build-dispatch-call2151 (lambda (pvars2187 exp2188 y2189 r2190 mod2191) (let ((ids2192 (map car pvars2187)) (levels2193 (map cdr pvars2187))) (let ((labels2194 (gen-labels1092 ids2192)) (new-vars2195 (map gen-var1134 ids2192))) (build-annotated1063 #f (list (build-annotated1063 #f (quote apply)) (build-annotated1063 #f (list (quote lambda) new-vars2195 (chi1122 exp2188 (extend-env1080 labels2194 (map (lambda (var2196 level2197) (cons (quote syntax) (cons var2196 level2197))) new-vars2195 (map cdr pvars2187)) r2190) (make-binding-wrap1103 ids2192 labels2194 (quote (()))) mod2191))) y2189)))))) (convert-pattern2150 (lambda (pattern2198 keys2199) (let cvt2200 ((p2201 pattern2198) (n2202 0) (ids2203 (quote ()))) (if (id?1086 p2201) (if (bound-id-member?1113 p2201 keys2199) (values (vector (quote free-id) p2201) ids2203) (values (quote any) (cons (cons p2201 n2202) ids2203))) ((lambda (tmp2204) ((lambda (tmp2205) (if (if tmp2205 (apply (lambda (x2206 dots2207) (ellipsis?1131 dots2207)) tmp2205) #f) (apply (lambda (x2208 dots2209) (call-with-values (lambda () (cvt2200 x2208 (fx+1055 n2202 1) ids2203)) (lambda (p2210 ids2211) (values (if (eq? p2210 (quote any)) (quote each-any) (vector (quote each) p2210)) ids2211)))) tmp2205) ((lambda (tmp2212) (if tmp2212 (apply (lambda (x2213 y2214) (call-with-values (lambda () (cvt2200 y2214 n2202 ids2203)) (lambda (y2215 ids2216) (call-with-values (lambda () (cvt2200 x2213 n2202 ids2216)) (lambda (x2217 ids2218) (values (cons x2217 y2215) ids2218)))))) tmp2212) ((lambda (tmp2219) (if tmp2219 (apply (lambda () (values (quote ()) ids2203)) tmp2219) ((lambda (tmp2220) (if tmp2220 (apply (lambda (x2221) (call-with-values (lambda () (cvt2200 x2221 n2202 ids2203)) (lambda (p2223 ids2224) (values (vector (quote vector) p2223) ids2224)))) tmp2220) ((lambda (x2225) (values (vector (quote atom) (strip1133 p2201 (quote (())))) ids2203)) tmp2204))) ($sc-dispatch tmp2204 (quote #(vector each-any)))))) ($sc-dispatch tmp2204 (quote ()))))) ($sc-dispatch tmp2204 (quote (any . any)))))) ($sc-dispatch tmp2204 (quote (any any))))) p2201)))))) (lambda (e2226 r2227 w2228 s2229 mod2230) (let ((e2231 (source-wrap1115 e2226 w2228 s2229 mod2230))) ((lambda (tmp2232) ((lambda (tmp2233) (if tmp2233 (apply (lambda (_2234 val2235 key2236 m2237) (if (and-map (lambda (x2238) (and (id?1086 x2238) (not (ellipsis?1131 x2238)))) key2236) (let ((x2240 (gen-var1134 (quote tmp)))) (build-annotated1063 s2229 (list (build-annotated1063 #f (list (quote lambda) (list x2240) (gen-syntax-case2153 (build-annotated1063 #f x2240) key2236 m2237 r2227 mod2230))) (chi1122 val2235 r2227 (quote (())) mod2230)))) (syntax-violation (quote syntax-case) "invalid literals list" e2231))) tmp2233) (syntax-violation #f "source expression failed to match any pattern" tmp2232))) ($sc-dispatch tmp2232 (quote (any any each-any . each-any))))) e2231))))) (set! sc-expand (let ((m2243 (quote e)) (esew2244 (quote (eval)))) (lambda (x2246 . rest2245) (if (and (pair? x2246) (equal? (car x2246) noexpand1054)) (cadr x2246) (chi-top1121 x2246 (quote ()) (quote ((top))) (if (null? rest2245) m2243 (car rest2245)) (if (or (null? rest2245) (null? (cdr rest2245))) esew2244 (cadr rest2245)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2247) (nonsymbol-id?1085 x2247))) (set! datum->syntax (lambda (id2248 datum2249) (make-syntax-object1069 datum2249 (syntax-object-wrap1072 id2248) #f))) (set! syntax->datum (lambda (x2250) (strip1133 x2250 (quote (()))))) (set! generate-temporaries (lambda (ls2251) (begin (let ((x2252 ls2251)) (if (not (list? x2252)) (syntax-violation (quote generate-temporaries) "invalid argument" x2252))) (map (lambda (x2253) (wrap1114 (gensym) (quote ((top))) #f)) ls2251)))) (set! free-identifier=? (lambda (x2254 y2255) (begin (let ((x2256 x2254)) (if (not (nonsymbol-id?1085 x2256)) (syntax-violation (quote free-identifier=?) "invalid argument" x2256))) (let ((x2257 y2255)) (if (not (nonsymbol-id?1085 x2257)) (syntax-violation (quote free-identifier=?) "invalid argument" x2257))) (free-id=?1109 x2254 y2255)))) (set! bound-identifier=? (lambda (x2258 y2259) (begin (let ((x2260 x2258)) (if (not (nonsymbol-id?1085 x2260)) (syntax-violation (quote bound-identifier=?) "invalid argument" x2260))) (let ((x2261 y2259)) (if (not (nonsymbol-id?1085 x2261)) (syntax-violation (quote bound-identifier=?) "invalid argument" x2261))) (bound-id=?1110 x2258 y2259)))) (set! syntax-violation (lambda (who2265 message2264 form2263 . subform2262) (begin (let ((x2266 who2265)) (if (not ((lambda (x2267) (or (not x2267) (string? x2267) (symbol? x2267))) x2266)) (syntax-violation (quote syntax-violation) "invalid argument" x2266))) (let ((x2268 message2264)) (if (not (string? x2268)) (syntax-violation (quote syntax-violation) "invalid argument" x2268))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2265 "~a: " "") "~a " (if (null? subform2262) "in ~a" "in subform `~s' of `~s'")) (let ((tail2269 (cons message2264 (map (lambda (x2270) (strip1133 x2270 (quote (())))) (append subform2262 (list form2263)))))) (if who2265 (cons who2265 tail2269) tail2269)) #f)))) (letrec ((match2275 (lambda (e2276 p2277 w2278 r2279 mod2280) (cond ((not r2279) #f) ((eq? p2277 (quote any)) (cons (wrap1114 e2276 w2278 mod2280) r2279)) ((syntax-object?1070 e2276) (match*2274 (let ((e2281 (syntax-object-expression1071 e2276))) (if (annotation? e2281) (annotation-expression e2281) e2281)) p2277 (join-wraps1105 w2278 (syntax-object-wrap1072 e2276)) r2279 (syntax-object-module1073 e2276))) (else (match*2274 (let ((e2282 e2276)) (if (annotation? e2282) (annotation-expression e2282) e2282)) p2277 w2278 r2279 mod2280))))) (match*2274 (lambda (e2283 p2284 w2285 r2286 mod2287) (cond ((null? p2284) (and (null? e2283) r2286)) ((pair? p2284) (and (pair? e2283) (match2275 (car e2283) (car p2284) w2285 (match2275 (cdr e2283) (cdr p2284) w2285 r2286 mod2287) mod2287))) ((eq? p2284 (quote each-any)) (let ((l2288 (match-each-any2272 e2283 w2285 mod2287))) (and l2288 (cons l2288 r2286)))) (else (let ((t2289 (vector-ref p2284 0))) (if (memv t2289 (quote (each))) (if (null? e2283) (match-empty2273 (vector-ref p2284 1) r2286) (let ((l2290 (match-each2271 e2283 (vector-ref p2284 1) w2285 mod2287))) (and l2290 (let collect2291 ((l2292 l2290)) (if (null? (car l2292)) r2286 (cons (map car l2292) (collect2291 (map cdr l2292)))))))) (if (memv t2289 (quote (free-id))) (and (id?1086 e2283) (free-id=?1109 (wrap1114 e2283 w2285 mod2287) (vector-ref p2284 1)) r2286) (if (memv t2289 (quote (atom))) (and (equal? (vector-ref p2284 1) (strip1133 e2283 w2285)) r2286) (if (memv t2289 (quote (vector))) (and (vector? e2283) (match2275 (vector->list e2283) (vector-ref p2284 1) w2285 r2286 mod2287))))))))))) (match-empty2273 (lambda (p2293 r2294) (cond ((null? p2293) r2294) ((eq? p2293 (quote any)) (cons (quote ()) r2294)) ((pair? p2293) (match-empty2273 (car p2293) (match-empty2273 (cdr p2293) r2294))) ((eq? p2293 (quote each-any)) (cons (quote ()) r2294)) (else (let ((t2295 (vector-ref p2293 0))) (if (memv t2295 (quote (each))) (match-empty2273 (vector-ref p2293 1) r2294) (if (memv t2295 (quote (free-id atom))) r2294 (if (memv t2295 (quote (vector))) (match-empty2273 (vector-ref p2293 1) r2294))))))))) (match-each-any2272 (lambda (e2296 w2297 mod2298) (cond ((annotation? e2296) (match-each-any2272 (annotation-expression e2296) w2297 mod2298)) ((pair? e2296) (let ((l2299 (match-each-any2272 (cdr e2296) w2297 mod2298))) (and l2299 (cons (wrap1114 (car e2296) w2297 mod2298) l2299)))) ((null? e2296) (quote ())) ((syntax-object?1070 e2296) (match-each-any2272 (syntax-object-expression1071 e2296) (join-wraps1105 w2297 (syntax-object-wrap1072 e2296)) mod2298)) (else #f)))) (match-each2271 (lambda (e2300 p2301 w2302 mod2303) (cond ((annotation? e2300) (match-each2271 (annotation-expression e2300) p2301 w2302 mod2303)) ((pair? e2300) (let ((first2304 (match2275 (car e2300) p2301 w2302 (quote ()) mod2303))) (and first2304 (let ((rest2305 (match-each2271 (cdr e2300) p2301 w2302 mod2303))) (and rest2305 (cons first2304 rest2305)))))) ((null? e2300) (quote ())) ((syntax-object?1070 e2300) (match-each2271 (syntax-object-expression1071 e2300) p2301 (join-wraps1105 w2302 (syntax-object-wrap1072 e2300)) (syntax-object-module1073 e2300))) (else #f))))) (set! $sc-dispatch (lambda (e2306 p2307) (cond ((eq? p2307 (quote any)) (list e2306)) ((syntax-object?1070 e2306) (match*2274 (let ((e2308 (syntax-object-expression1071 e2306))) (if (annotation? e2308) (annotation-expression e2308) e2308)) p2307 (syntax-object-wrap1072 e2306) (quote ()) (syntax-object-module1073 e2306))) (else (match*2274 (let ((e2309 e2306)) (if (annotation? e2309) (annotation-expression e2309) e2309)) p2307 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x2310) ((lambda (tmp2311) ((lambda (tmp2312) (if tmp2312 (apply (lambda (_2313 e12314 e22315) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12314 e22315))) tmp2312) ((lambda (tmp2317) (if tmp2317 (apply (lambda (_2318 out2319 in2320 e12321 e22322) (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))) in2320 (quote ()) (list out2319 (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 e12321 e22322))))) tmp2317) ((lambda (tmp2324) (if tmp2324 (apply (lambda (_2325 out2326 in2327 e12328 e22329) (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))) in2327) (quote ()) (list out2326 (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 e12328 e22329))))) tmp2324) (syntax-violation #f "source expression failed to match any pattern" tmp2311))) ($sc-dispatch tmp2311 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2311 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2311 (quote (any () any . each-any))))) x2310))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2333) ((lambda (tmp2334) ((lambda (tmp2335) (if tmp2335 (apply (lambda (_2336 k2337 keyword2338 pattern2339 template2340) (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 k2337 (map (lambda (tmp2343 tmp2342) (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))) tmp2342) (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))) tmp2343))) template2340 pattern2339)))))) tmp2335) (syntax-violation #f "source expression failed to match any pattern" tmp2334))) ($sc-dispatch tmp2334 (quote (any each-any . #(each ((any . any) any))))))) x2333))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2344) ((lambda (tmp2345) ((lambda (tmp2346) (if (if tmp2346 (apply (lambda (let*2347 x2348 v2349 e12350 e22351) (and-map identifier? x2348)) tmp2346) #f) (apply (lambda (let*2353 x2354 v2355 e12356 e22357) (let f2358 ((bindings2359 (map list x2354 v2355))) (if (null? bindings2359) (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 e12356 e22357))) ((lambda (tmp2363) ((lambda (tmp2364) (if tmp2364 (apply (lambda (body2365 binding2366) (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 binding2366) body2365)) tmp2364) (syntax-violation #f "source expression failed to match any pattern" tmp2363))) ($sc-dispatch tmp2363 (quote (any any))))) (list (f2358 (cdr bindings2359)) (car bindings2359)))))) tmp2346) (syntax-violation #f "source expression failed to match any pattern" tmp2345))) ($sc-dispatch tmp2345 (quote (any #(each (any any)) any . each-any))))) x2344))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2367) ((lambda (tmp2368) ((lambda (tmp2369) (if tmp2369 (apply (lambda (_2370 var2371 init2372 step2373 e02374 e12375 c2376) ((lambda (tmp2377) ((lambda (tmp2378) (if tmp2378 (apply (lambda (step2379) ((lambda (tmp2380) ((lambda (tmp2381) (if tmp2381 (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 var2371 init2372) (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))) e02374) (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 c2376 (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))) step2379))))))) tmp2381) ((lambda (tmp2386) (if tmp2386 (apply (lambda (e12387 e22388) (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 var2371 init2372) (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))) e02374 (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 e12387 e22388)) (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 c2376 (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))) step2379))))))) tmp2386) (syntax-violation #f "source expression failed to match any pattern" tmp2380))) ($sc-dispatch tmp2380 (quote (any . each-any)))))) ($sc-dispatch tmp2380 (quote ())))) e12375)) tmp2378) (syntax-violation #f "source expression failed to match any pattern" tmp2377))) ($sc-dispatch tmp2377 (quote each-any)))) (map (lambda (v2395 s2396) ((lambda (tmp2397) ((lambda (tmp2398) (if tmp2398 (apply (lambda () v2395) tmp2398) ((lambda (tmp2399) (if tmp2399 (apply (lambda (e2400) e2400) tmp2399) ((lambda (_2401) (syntax-violation (quote do) "bad step expression" orig-x2367 s2396)) tmp2397))) ($sc-dispatch tmp2397 (quote (any)))))) ($sc-dispatch tmp2397 (quote ())))) s2396)) var2371 step2373))) tmp2369) (syntax-violation #f "source expression failed to match any pattern" tmp2368))) ($sc-dispatch tmp2368 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2367))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2404 (lambda (x2408 y2409) ((lambda (tmp2410) ((lambda (tmp2411) (if tmp2411 (apply (lambda (x2412 y2413) ((lambda (tmp2414) ((lambda (tmp2415) (if tmp2415 (apply (lambda (dy2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (apply (lambda (dx2419) (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 dx2419 dy2416))) tmp2418) ((lambda (_2420) (if (null? dy2416) (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))) x2412) (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))) x2412 y2413))) tmp2417))) ($sc-dispatch tmp2417 (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))))) x2412)) tmp2415) ((lambda (tmp2421) (if tmp2421 (apply (lambda (stuff2422) (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 x2412 stuff2422))) tmp2421) ((lambda (else2423) (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))) x2412 y2413)) tmp2414))) ($sc-dispatch tmp2414 (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 tmp2414 (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))))) y2413)) tmp2411) (syntax-violation #f "source expression failed to match any pattern" tmp2410))) ($sc-dispatch tmp2410 (quote (any any))))) (list x2408 y2409)))) (quasiappend2405 (lambda (x2424 y2425) ((lambda (tmp2426) ((lambda (tmp2427) (if tmp2427 (apply (lambda (x2428 y2429) ((lambda (tmp2430) ((lambda (tmp2431) (if tmp2431 (apply (lambda () x2428) tmp2431) ((lambda (_2432) (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))) x2428 y2429)) tmp2430))) ($sc-dispatch tmp2430 (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))) ()))))) y2429)) tmp2427) (syntax-violation #f "source expression failed to match any pattern" tmp2426))) ($sc-dispatch tmp2426 (quote (any any))))) (list x2424 y2425)))) (quasivector2406 (lambda (x2433) ((lambda (tmp2434) ((lambda (x2435) ((lambda (tmp2436) ((lambda (tmp2437) (if tmp2437 (apply (lambda (x2438) (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 x2438))) tmp2437) ((lambda (tmp2440) (if tmp2440 (apply (lambda (x2441) (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))) x2441)) tmp2440) ((lambda (_2443) (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))) x2435)) tmp2436))) ($sc-dispatch tmp2436 (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 tmp2436 (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))))) x2435)) tmp2434)) x2433))) (quasi2407 (lambda (p2444 lev2445) ((lambda (tmp2446) ((lambda (tmp2447) (if tmp2447 (apply (lambda (p2448) (if (= lev2445 0) p2448 (quasicons2404 (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)))) (quasi2407 (list p2448) (- lev2445 1))))) tmp2447) ((lambda (tmp2449) (if tmp2449 (apply (lambda (p2450 q2451) (if (= lev2445 0) (quasiappend2405 p2450 (quasi2407 q2451 lev2445)) (quasicons2404 (quasicons2404 (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)))) (quasi2407 (list p2450) (- lev2445 1))) (quasi2407 q2451 lev2445)))) tmp2449) ((lambda (tmp2452) (if tmp2452 (apply (lambda (p2453) (quasicons2404 (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)))) (quasi2407 (list p2453) (+ lev2445 1)))) tmp2452) ((lambda (tmp2454) (if tmp2454 (apply (lambda (p2455 q2456) (quasicons2404 (quasi2407 p2455 lev2445) (quasi2407 q2456 lev2445))) tmp2454) ((lambda (tmp2457) (if tmp2457 (apply (lambda (x2458) (quasivector2406 (quasi2407 x2458 lev2445))) tmp2457) ((lambda (p2460) (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))) p2460)) tmp2446))) ($sc-dispatch tmp2446 (quote #(vector each-any)))))) ($sc-dispatch tmp2446 (quote (any . any)))))) ($sc-dispatch tmp2446 (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 tmp2446 (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 tmp2446 (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))))) p2444)))) (lambda (x2461) ((lambda (tmp2462) ((lambda (tmp2463) (if tmp2463 (apply (lambda (_2464 e2465) (quasi2407 e2465 0)) tmp2463) (syntax-violation #f "source expression failed to match any pattern" tmp2462))) ($sc-dispatch tmp2462 (quote (any any))))) x2461)))))
+(define include (make-syncase-macro (quote macro) (lambda (x2466) (letrec ((read-file2467 (lambda (fn2468 k2469) (let ((p2470 (open-input-file fn2468))) (let f2471 ((x2472 (read p2470))) (if (eof-object? x2472) (begin (close-input-port p2470) (quote ())) (cons (datum->syntax k2469 x2472) (f2471 (read p2470))))))))) ((lambda (tmp2473) ((lambda (tmp2474) (if tmp2474 (apply (lambda (k2475 filename2476) (let ((fn2477 (syntax->datum filename2476))) ((lambda (tmp2478) ((lambda (tmp2479) (if tmp2479 (apply (lambda (exp2480) (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))) exp2480)) tmp2479) (syntax-violation #f "source expression failed to match any pattern" tmp2478))) ($sc-dispatch tmp2478 (quote each-any)))) (read-file2467 fn2477 k2475)))) tmp2474) (syntax-violation #f "source expression failed to match any pattern" tmp2473))) ($sc-dispatch tmp2473 (quote (any any))))) x2466)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x2482) ((lambda (tmp2483) ((lambda (tmp2484) (if tmp2484 (apply (lambda (_2485 e2486) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x2482)) tmp2484) (syntax-violation #f "source expression failed to match any pattern" tmp2483))) ($sc-dispatch tmp2483 (quote (any any))))) x2482))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2487) ((lambda (tmp2488) ((lambda (tmp2489) (if tmp2489 (apply (lambda (_2490 e2491) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x2487)) tmp2489) (syntax-violation #f "source expression failed to match any pattern" tmp2488))) ($sc-dispatch tmp2488 (quote (any any))))) x2487))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2492) ((lambda (tmp2493) ((lambda (tmp2494) (if tmp2494 (apply (lambda (_2495 e2496 m12497 m22498) ((lambda (tmp2499) ((lambda (body2500) (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))) e2496)) body2500)) tmp2499)) (let f2501 ((clause2502 m12497) (clauses2503 m22498)) (if (null? clauses2503) ((lambda (tmp2505) ((lambda (tmp2506) (if tmp2506 (apply (lambda (e12507 e22508) (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 e12507 e22508))) tmp2506) ((lambda (tmp2510) (if tmp2510 (apply (lambda (k2511 e12512 e22513) (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))) k2511)) (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 e12512 e22513)))) tmp2510) ((lambda (_2516) (syntax-violation (quote case) "bad clause" x2492 clause2502)) tmp2505))) ($sc-dispatch tmp2505 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2505 (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))))) clause2502) ((lambda (tmp2517) ((lambda (rest2518) ((lambda (tmp2519) ((lambda (tmp2520) (if tmp2520 (apply (lambda (k2521 e12522 e22523) (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))) k2521)) (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 e12522 e22523)) rest2518)) tmp2520) ((lambda (_2526) (syntax-violation (quote case) "bad clause" x2492 clause2502)) tmp2519))) ($sc-dispatch tmp2519 (quote (each-any any . each-any))))) clause2502)) tmp2517)) (f2501 (car clauses2503) (cdr clauses2503))))))) tmp2494) (syntax-violation #f "source expression failed to match any pattern" tmp2493))) ($sc-dispatch tmp2493 (quote (any any any . each-any))))) x2492))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2527) ((lambda (tmp2528) ((lambda (tmp2529) (if tmp2529 (apply (lambda (_2530 e2531) (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))) e2531)) (list (cons _2530 (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 e2531 (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)))))))))) tmp2529) (syntax-violation #f "source expression failed to match any pattern" tmp2528))) ($sc-dispatch tmp2528 (quote (any any))))) x2527))))
HCoop / bpt / guile.git / commitdiff