diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index f01bcf4ef..b2b1f65cd 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -187,12 +187,13 @@ (define syntax-violation #f) (define (annotation? x) #f) -(define bound-identifier=? #f) -(define datum->syntax-object #f) -(define free-identifier=? #f) -(define generate-temporaries #f) +(define datum->syntax #f) +(define syntax->datum #f) + (define identifier? #f) -(define syntax-object->datum #f) +(define generate-temporaries #f) +(define bound-identifier=? #f) +(define free-identifier=? #f) (define andmap (lambda (f first . rest) @@ -234,28 +235,28 @@ "Define a defmacro." (syntax-case x () ((_ (macro . args) doc body1 body ...) - (string? (syntax-object->datum (syntax doc))) + (string? (syntax->datum (syntax doc))) (syntax (define-macro macro doc (lambda args body1 body ...)))) ((_ (macro . args) body ...) (syntax (define-macro macro #f (lambda args body ...)))) ((_ macro doc transformer) - (or (string? (syntax-object->datum (syntax doc))) - (not (syntax-object->datum (syntax doc)))) + (or (string? (syntax->datum (syntax doc))) + (not (syntax->datum (syntax doc)))) (syntax (define-syntax macro (lambda (y) doc (syntax-case y () ((_ . args) - (let ((v (syntax-object->datum (syntax args)))) - (datum->syntax-object y (apply transformer v)))))))))))) + (let ((v (syntax->datum (syntax args)))) + (datum->syntax y (apply transformer v)))))))))))) (define-syntax defmacro (lambda (x) "Define a defmacro, with the old lispy defun syntax." (syntax-case x () ((_ macro args doc body1 body ...) - (string? (syntax-object->datum (syntax doc))) + (string? (syntax->datum (syntax doc))) (syntax (define-macro macro doc (lambda args body1 body ...)))) ((_ macro args body ...) (syntax (define-macro macro #f (lambda args body ...))))))) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 99668596d..f17823484 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -1,13 +1,13 @@ (eval-when (compile) (set-current-module (resolve-module (quote (guile))))) (void) -(letrec ((lambda-var-list1262 (lambda (vars1467) (let lvl1468 ((vars1469 vars1467) (ls1470 (quote ())) (w1471 (quote (())))) (cond ((pair? vars1469) (lvl1468 (cdr vars1469) (cons (wrap1241 (car vars1469) w1471 #f) ls1470) w1471)) ((id?1213 vars1469) (cons (wrap1241 vars1469 w1471 #f) ls1470)) ((null? vars1469) ls1470) ((syntax-object?1197 vars1469) (lvl1468 (syntax-object-expression1198 vars1469) ls1470 (join-wraps1232 w1471 (syntax-object-wrap1199 vars1469)))) ((annotation? vars1469) (lvl1468 (annotation-expression vars1469) ls1470 w1471)) (else (cons vars1469 ls1470)))))) (gen-var1261 (lambda (id1472) (let ((id1473 (if (syntax-object?1197 id1472) (syntax-object-expression1198 id1472) id1472))) (if (annotation? id1473) (build-annotated1190 (annotation-source id1473) (gensym (symbol->string (annotation-expression id1473)))) (build-annotated1190 #f (gensym (symbol->string id1473))))))) (strip1260 (lambda (x1474 w1475) (if (memq (quote top) (wrap-marks1216 w1475)) (if (or (annotation? x1474) (and (pair? x1474) (annotation? (car x1474)))) (strip-annotation1259 x1474 #f) x1474) (let f1476 ((x1477 x1474)) (cond ((syntax-object?1197 x1477) (strip1260 (syntax-object-expression1198 x1477) (syntax-object-wrap1199 x1477))) ((pair? x1477) (let ((a1478 (f1476 (car x1477))) (d1479 (f1476 (cdr x1477)))) (if (and (eq? a1478 (car x1477)) (eq? d1479 (cdr x1477))) x1477 (cons a1478 d1479)))) ((vector? x1477) (let ((old1480 (vector->list x1477))) (let ((new1481 (map f1476 old1480))) (if (andmap eq? old1480 new1481) x1477 (list->vector new1481))))) (else x1477)))))) (strip-annotation1259 (lambda (x1482 parent1483) (cond ((pair? x1482) (let ((new1484 (cons #f #f))) (begin (if parent1483 (set-annotation-stripped! parent1483 new1484)) (set-car! new1484 (strip-annotation1259 (car x1482) #f)) (set-cdr! new1484 (strip-annotation1259 (cdr x1482) #f)) new1484))) ((annotation? x1482) (or (annotation-stripped x1482) (strip-annotation1259 (annotation-expression x1482) x1482))) ((vector? x1482) (let ((new1485 (make-vector (vector-length x1482)))) (begin (if parent1483 (set-annotation-stripped! parent1483 new1485)) (let loop1486 ((i1487 (- (vector-length x1482) 1))) (unless (fx<1183 i1487 0) (vector-set! new1485 i1487 (strip-annotation1259 (vector-ref x1482 i1487) #f)) (loop1486 (fx-1181 i1487 1)))) new1485))) (else x1482)))) (ellipsis?1258 (lambda (x1488) (and (nonsymbol-id?1212 x1488) (free-id=?1236 x1488 (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void1257 (lambda () (build-annotated1190 #f (list (build-annotated1190 #f (quote void)))))) (eval-local-transformer1256 (lambda (expanded1489 mod1490) (let ((p1491 (local-eval-hook1185 expanded1489 mod1490))) (if (procedure? p1491) p1491 (syntax-violation #f "nonprocedure transformer" p1491))))) (chi-local-syntax1255 (lambda (rec?1492 e1493 r1494 w1495 s1496 mod1497 k1498) ((lambda (tmp1499) ((lambda (tmp1500) (if tmp1500 (apply (lambda (_1501 id1502 val1503 e11504 e21505) (let ((ids1506 id1502)) (if (not (valid-bound-ids?1238 ids1506)) (syntax-violation #f "duplicate bound keyword" e1493) (let ((labels1508 (gen-labels1219 ids1506))) (let ((new-w1509 (make-binding-wrap1230 ids1506 labels1508 w1495))) (k1498 (cons e11504 e21505) (extend-env1207 labels1508 (let ((w1511 (if rec?1492 new-w1509 w1495)) (trans-r1512 (macros-only-env1209 r1494))) (map (lambda (x1513) (cons (quote macro) (eval-local-transformer1256 (chi1249 x1513 trans-r1512 w1511 mod1497) mod1497))) val1503)) r1494) new-w1509 s1496 mod1497)))))) tmp1500) ((lambda (_1515) (syntax-violation #f "bad local syntax definition" (source-wrap1242 e1493 w1495 s1496 mod1497))) tmp1499))) (syntax-dispatch tmp1499 (quote (any #(each (any any)) any . each-any))))) e1493))) (chi-lambda-clause1254 (lambda (e1516 docstring1517 c1518 r1519 w1520 mod1521 k1522) ((lambda (tmp1523) ((lambda (tmp1524) (if (if tmp1524 (apply (lambda (args1525 doc1526 e11527 e21528) (and (string? (syntax-object->datum doc1526)) (not docstring1517))) tmp1524) #f) (apply (lambda (args1529 doc1530 e11531 e21532) (chi-lambda-clause1254 e1516 doc1530 (cons args1529 (cons e11531 e21532)) r1519 w1520 mod1521 k1522)) tmp1524) ((lambda (tmp1534) (if tmp1534 (apply (lambda (id1535 e11536 e21537) (let ((ids1538 id1535)) (if (not (valid-bound-ids?1238 ids1538)) (syntax-violation (quote lambda) "invalid parameter list" e1516) (let ((labels1540 (gen-labels1219 ids1538)) (new-vars1541 (map gen-var1261 ids1538))) (k1522 new-vars1541 docstring1517 (chi-body1253 (cons e11536 e21537) e1516 (extend-var-env1208 labels1540 new-vars1541 r1519) (make-binding-wrap1230 ids1538 labels1540 w1520) mod1521)))))) tmp1534) ((lambda (tmp1543) (if tmp1543 (apply (lambda (ids1544 e11545 e21546) (let ((old-ids1547 (lambda-var-list1262 ids1544))) (if (not (valid-bound-ids?1238 old-ids1547)) (syntax-violation (quote lambda) "invalid parameter list" e1516) (let ((labels1548 (gen-labels1219 old-ids1547)) (new-vars1549 (map gen-var1261 old-ids1547))) (k1522 (let f1550 ((ls11551 (cdr new-vars1549)) (ls21552 (car new-vars1549))) (if (null? ls11551) ls21552 (f1550 (cdr ls11551) (cons (car ls11551) ls21552)))) docstring1517 (chi-body1253 (cons e11545 e21546) e1516 (extend-var-env1208 labels1548 new-vars1549 r1519) (make-binding-wrap1230 old-ids1547 labels1548 w1520) mod1521)))))) tmp1543) ((lambda (_1554) (syntax-violation (quote lambda) "bad lambda" e1516)) tmp1523))) (syntax-dispatch tmp1523 (quote (any any . each-any)))))) (syntax-dispatch tmp1523 (quote (each-any any . each-any)))))) (syntax-dispatch tmp1523 (quote (any any any . each-any))))) c1518))) (chi-body1253 (lambda (body1555 outer-form1556 r1557 w1558 mod1559) (let ((r1560 (cons (quote ("placeholder" placeholder)) r1557))) (let ((ribcage1561 (make-ribcage1220 (quote ()) (quote ()) (quote ())))) (let ((w1562 (make-wrap1215 (wrap-marks1216 w1558) (cons ribcage1561 (wrap-subst1217 w1558))))) (let parse1563 ((body1564 (map (lambda (x1570) (cons r1560 (wrap1241 x1570 w1562 mod1559))) body1555)) (ids1565 (quote ())) (labels1566 (quote ())) (vars1567 (quote ())) (vals1568 (quote ())) (bindings1569 (quote ()))) (if (null? body1564) (syntax-violation #f "no expressions in body" outer-form1556) (let ((e1571 (cdar body1564)) (er1572 (caar body1564))) (call-with-values (lambda () (syntax-type1247 e1571 er1572 (quote (())) #f ribcage1561 mod1559)) (lambda (type1573 value1574 e1575 w1576 s1577 mod1578) (let ((t1579 type1573)) (if (memv t1579 (quote (define-form))) (let ((id1580 (wrap1241 value1574 w1576 mod1578)) (label1581 (gen-label1218))) (let ((var1582 (gen-var1261 id1580))) (begin (extend-ribcage!1229 ribcage1561 id1580 label1581) (parse1563 (cdr body1564) (cons id1580 ids1565) (cons label1581 labels1566) (cons var1582 vars1567) (cons (cons er1572 (wrap1241 e1575 w1576 mod1578)) vals1568) (cons (cons (quote lexical) var1582) bindings1569))))) (if (memv t1579 (quote (define-syntax-form))) (let ((id1583 (wrap1241 value1574 w1576 mod1578)) (label1584 (gen-label1218))) (begin (extend-ribcage!1229 ribcage1561 id1583 label1584) (parse1563 (cdr body1564) (cons id1583 ids1565) (cons label1584 labels1566) vars1567 vals1568 (cons (cons (quote macro) (cons er1572 (wrap1241 e1575 w1576 mod1578))) bindings1569)))) (if (memv t1579 (quote (begin-form))) ((lambda (tmp1585) ((lambda (tmp1586) (if tmp1586 (apply (lambda (_1587 e11588) (parse1563 (let f1589 ((forms1590 e11588)) (if (null? forms1590) (cdr body1564) (cons (cons er1572 (wrap1241 (car forms1590) w1576 mod1578)) (f1589 (cdr forms1590))))) ids1565 labels1566 vars1567 vals1568 bindings1569)) tmp1586) (syntax-violation #f "source expression failed to match any pattern" tmp1585))) (syntax-dispatch tmp1585 (quote (any . each-any))))) e1575) (if (memv t1579 (quote (local-syntax-form))) (chi-local-syntax1255 value1574 e1575 er1572 w1576 s1577 mod1578 (lambda (forms1592 er1593 w1594 s1595 mod1596) (parse1563 (let f1597 ((forms1598 forms1592)) (if (null? forms1598) (cdr body1564) (cons (cons er1593 (wrap1241 (car forms1598) w1594 mod1596)) (f1597 (cdr forms1598))))) ids1565 labels1566 vars1567 vals1568 bindings1569))) (if (null? ids1565) (build-sequence1192 #f (map (lambda (x1599) (chi1249 (cdr x1599) (car x1599) (quote (())) mod1578)) (cons (cons er1572 (source-wrap1242 e1575 w1576 s1577 mod1578)) (cdr body1564)))) (begin (if (not (valid-bound-ids?1238 ids1565)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1556)) (let loop1600 ((bs1601 bindings1569) (er-cache1602 #f) (r-cache1603 #f)) (if (not (null? bs1601)) (let ((b1604 (car bs1601))) (if (eq? (car b1604) (quote macro)) (let ((er1605 (cadr b1604))) (let ((r-cache1606 (if (eq? er1605 er-cache1602) r-cache1603 (macros-only-env1209 er1605)))) (begin (set-cdr! b1604 (eval-local-transformer1256 (chi1249 (cddr b1604) r-cache1606 (quote (())) mod1578) mod1578)) (loop1600 (cdr bs1601) er1605 r-cache1606)))) (loop1600 (cdr bs1601) er-cache1602 r-cache1603))))) (set-cdr! r1560 (extend-env1207 labels1566 bindings1569 (cdr r1560))) (build-letrec1195 #f vars1567 (map (lambda (x1607) (chi1249 (cdr x1607) (car x1607) (quote (())) mod1578)) vals1568) (build-sequence1192 #f (map (lambda (x1608) (chi1249 (cdr x1608) (car x1608) (quote (())) mod1578)) (cons (cons er1572 (source-wrap1242 e1575 w1576 s1577 mod1578)) (cdr body1564)))))))))))))))))))))) (chi-macro1252 (lambda (p1609 e1610 r1611 w1612 rib1613 mod1614) (letrec ((rebuild-macro-output1615 (lambda (x1616 m1617) (cond ((pair? x1616) (cons (rebuild-macro-output1615 (car x1616) m1617) (rebuild-macro-output1615 (cdr x1616) m1617))) ((syntax-object?1197 x1616) (let ((w1618 (syntax-object-wrap1199 x1616))) (let ((ms1619 (wrap-marks1216 w1618)) (s1620 (wrap-subst1217 w1618))) (if (and (pair? ms1619) (eq? (car ms1619) #f)) (make-syntax-object1196 (syntax-object-expression1198 x1616) (make-wrap1215 (cdr ms1619) (if rib1613 (cons rib1613 (cdr s1620)) (cdr s1620))) (syntax-object-module1200 x1616)) (make-syntax-object1196 (syntax-object-expression1198 x1616) (make-wrap1215 (cons m1617 ms1619) (if rib1613 (cons rib1613 (cons (quote shift) s1620)) (cons (quote shift) s1620))) (let ((pmod1621 (procedure-module p1609))) (if pmod1621 (cons (quote hygiene) (module-name pmod1621)) (quote (hygiene guile))))))))) ((vector? x1616) (let ((n1622 (vector-length x1616))) (let ((v1623 (make-vector n1622))) (let doloop1624 ((i1625 0)) (if (fx=1182 i1625 n1622) v1623 (begin (vector-set! v1623 i1625 (rebuild-macro-output1615 (vector-ref x1616 i1625) m1617)) (doloop1624 (fx+1180 i1625 1)))))))) ((symbol? x1616) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1242 e1610 w1612 s mod1614) x1616)) (else x1616))))) (rebuild-macro-output1615 (p1609 (wrap1241 e1610 (anti-mark1228 w1612) mod1614)) (string #\m))))) (chi-application1251 (lambda (x1626 e1627 r1628 w1629 s1630 mod1631) ((lambda (tmp1632) ((lambda (tmp1633) (if tmp1633 (apply (lambda (e01634 e11635) (build-annotated1190 s1630 (cons x1626 (map (lambda (e1636) (chi1249 e1636 r1628 w1629 mod1631)) e11635)))) tmp1633) (syntax-violation #f "source expression failed to match any pattern" tmp1632))) (syntax-dispatch tmp1632 (quote (any . each-any))))) e1627))) (chi-expr1250 (lambda (type1638 value1639 e1640 r1641 w1642 s1643 mod1644) (let ((t1645 type1638)) (if (memv t1645 (quote (lexical))) (build-annotated1190 s1643 value1639) (if (memv t1645 (quote (core external-macro))) (value1639 e1640 r1641 w1642 s1643 mod1644) (if (memv t1645 (quote (module-ref))) (call-with-values (lambda () (value1639 e1640)) (lambda (id1646 mod1647) (build-annotated1190 s1643 (if mod1647 (make-module-ref (cdr mod1647) id1646 (car mod1647)) (make-module-ref mod1647 id1646 (quote bare)))))) (if (memv t1645 (quote (lexical-call))) (chi-application1251 (build-annotated1190 (source-annotation1204 (car e1640)) value1639) e1640 r1641 w1642 s1643 mod1644) (if (memv t1645 (quote (global-call))) (chi-application1251 (build-annotated1190 (source-annotation1204 (car e1640)) (if (if (syntax-object?1197 (car e1640)) (syntax-object-module1200 (car e1640)) mod1644) (make-module-ref (cdr (if (syntax-object?1197 (car e1640)) (syntax-object-module1200 (car e1640)) mod1644)) value1639 (car (if (syntax-object?1197 (car e1640)) (syntax-object-module1200 (car e1640)) mod1644))) (make-module-ref (if (syntax-object?1197 (car e1640)) (syntax-object-module1200 (car e1640)) mod1644) value1639 (quote bare)))) e1640 r1641 w1642 s1643 mod1644) (if (memv t1645 (quote (constant))) (build-data1191 s1643 (strip1260 (source-wrap1242 e1640 w1642 s1643 mod1644) (quote (())))) (if (memv t1645 (quote (global))) (build-annotated1190 s1643 (if mod1644 (make-module-ref (cdr mod1644) value1639 (car mod1644)) (make-module-ref mod1644 value1639 (quote bare)))) (if (memv t1645 (quote (call))) (chi-application1251 (chi1249 (car e1640) r1641 w1642 mod1644) e1640 r1641 w1642 s1643 mod1644) (if (memv t1645 (quote (begin-form))) ((lambda (tmp1648) ((lambda (tmp1649) (if tmp1649 (apply (lambda (_1650 e11651 e21652) (chi-sequence1243 (cons e11651 e21652) r1641 w1642 s1643 mod1644)) tmp1649) (syntax-violation #f "source expression failed to match any pattern" tmp1648))) (syntax-dispatch tmp1648 (quote (any any . each-any))))) e1640) (if (memv t1645 (quote (local-syntax-form))) (chi-local-syntax1255 value1639 e1640 r1641 w1642 s1643 mod1644 chi-sequence1243) (if (memv t1645 (quote (eval-when-form))) ((lambda (tmp1654) ((lambda (tmp1655) (if tmp1655 (apply (lambda (_1656 x1657 e11658 e21659) (let ((when-list1660 (chi-when-list1246 e1640 x1657 w1642))) (if (memq (quote eval) when-list1660) (chi-sequence1243 (cons e11658 e21659) r1641 w1642 s1643 mod1644) (chi-void1257)))) tmp1655) (syntax-violation #f "source expression failed to match any pattern" tmp1654))) (syntax-dispatch tmp1654 (quote (any each-any any . each-any))))) e1640) (if (memv t1645 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1640 (wrap1241 value1639 w1642 mod1644)) (if (memv t1645 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1242 e1640 w1642 s1643 mod1644)) (if (memv t1645 (quote (displaced-lexical))) (syntax-violation #f (source-wrap1242 e1640 w1642 s1643 mod1644) "reference to identifier outside its scope") (syntax-violation #f "unexpected syntax" (source-wrap1242 e1640 w1642 s1643 mod1644))))))))))))))))))) (chi1249 (lambda (e1663 r1664 w1665 mod1666) (call-with-values (lambda () (syntax-type1247 e1663 r1664 w1665 #f #f mod1666)) (lambda (type1667 value1668 e1669 w1670 s1671 mod1672) (chi-expr1250 type1667 value1668 e1669 r1664 w1670 s1671 mod1672))))) (chi-top1248 (lambda (e1673 r1674 w1675 m1676 esew1677 mod1678) (call-with-values (lambda () (syntax-type1247 e1673 r1674 w1675 #f #f mod1678)) (lambda (type1686 value1687 e1688 w1689 s1690 mod1691) (let ((t1692 type1686)) (if (memv t1692 (quote (begin-form))) ((lambda (tmp1693) ((lambda (tmp1694) (if tmp1694 (apply (lambda (_1695) (chi-void1257)) tmp1694) ((lambda (tmp1696) (if tmp1696 (apply (lambda (_1697 e11698 e21699) (chi-top-sequence1244 (cons e11698 e21699) r1674 w1689 s1690 m1676 esew1677 mod1691)) tmp1696) (syntax-violation #f "source expression failed to match any pattern" tmp1693))) (syntax-dispatch tmp1693 (quote (any any . each-any)))))) (syntax-dispatch tmp1693 (quote (any))))) e1688) (if (memv t1692 (quote (local-syntax-form))) (chi-local-syntax1255 value1687 e1688 r1674 w1689 s1690 mod1691 (lambda (body1701 r1702 w1703 s1704 mod1705) (chi-top-sequence1244 body1701 r1702 w1703 s1704 m1676 esew1677 mod1705))) (if (memv t1692 (quote (eval-when-form))) ((lambda (tmp1706) ((lambda (tmp1707) (if tmp1707 (apply (lambda (_1708 x1709 e11710 e21711) (let ((when-list1712 (chi-when-list1246 e1688 x1709 w1689)) (body1713 (cons e11710 e21711))) (cond ((eq? m1676 (quote e)) (if (memq (quote eval) when-list1712) (chi-top-sequence1244 body1713 r1674 w1689 s1690 (quote e) (quote (eval)) mod1691) (chi-void1257))) ((memq (quote load) when-list1712) (if (or (memq (quote compile) when-list1712) (and (eq? m1676 (quote c&e)) (memq (quote eval) when-list1712))) (chi-top-sequence1244 body1713 r1674 w1689 s1690 (quote c&e) (quote (compile load)) mod1691) (if (memq m1676 (quote (c c&e))) (chi-top-sequence1244 body1713 r1674 w1689 s1690 (quote c) (quote (load)) mod1691) (chi-void1257)))) ((or (memq (quote compile) when-list1712) (and (eq? m1676 (quote c&e)) (memq (quote eval) when-list1712))) (top-level-eval-hook1184 (chi-top-sequence1244 body1713 r1674 w1689 s1690 (quote e) (quote (eval)) mod1691) mod1691) (chi-void1257)) (else (chi-void1257))))) tmp1707) (syntax-violation #f "source expression failed to match any pattern" tmp1706))) (syntax-dispatch tmp1706 (quote (any each-any any . each-any))))) e1688) (if (memv t1692 (quote (define-syntax-form))) (let ((n1716 (id-var-name1235 value1687 w1689)) (r1717 (macros-only-env1209 r1674))) (let ((t1718 m1676)) (if (memv t1718 (quote (c))) (if (memq (quote compile) esew1677) (let ((e1719 (chi-install-global1245 n1716 (chi1249 e1688 r1717 w1689 mod1691)))) (begin (top-level-eval-hook1184 e1719 mod1691) (if (memq (quote load) esew1677) e1719 (chi-void1257)))) (if (memq (quote load) esew1677) (chi-install-global1245 n1716 (chi1249 e1688 r1717 w1689 mod1691)) (chi-void1257))) (if (memv t1718 (quote (c&e))) (let ((e1720 (chi-install-global1245 n1716 (chi1249 e1688 r1717 w1689 mod1691)))) (begin (top-level-eval-hook1184 e1720 mod1691) e1720)) (begin (if (memq (quote eval) esew1677) (top-level-eval-hook1184 (chi-install-global1245 n1716 (chi1249 e1688 r1717 w1689 mod1691)) mod1691)) (chi-void1257)))))) (if (memv t1692 (quote (define-form))) (let ((n1721 (id-var-name1235 value1687 w1689))) (let ((type1722 (binding-type1205 (lookup1210 n1721 r1674 mod1691)))) (let ((t1723 type1722)) (if (memv t1723 (quote (global))) (let ((x1724 (build-annotated1190 s1690 (list (quote define) n1721 (chi1249 e1688 r1674 w1689 mod1691))))) (begin (if (eq? m1676 (quote c&e)) (top-level-eval-hook1184 x1724 mod1691)) x1724)) (if (memv t1723 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1688 (wrap1241 value1687 w1689 mod1691)) (if (memv t1723 (quote (core macro module-ref))) (begin (remove-global-definition-hook1188 n1721) (let ((x1725 (build-annotated1190 s1690 (list (quote define) n1721 (chi1249 e1688 r1674 w1689 mod1691))))) (begin (if (eq? m1676 (quote c&e)) (top-level-eval-hook1184 x1725 mod1691)) x1725))) (syntax-violation #f "cannot define keyword at top level" e1688 (wrap1241 value1687 w1689 mod1691)))))))) (let ((x1726 (chi-expr1250 type1686 value1687 e1688 r1674 w1689 s1690 mod1691))) (begin (if (eq? m1676 (quote c&e)) (top-level-eval-hook1184 x1726 mod1691)) x1726)))))))))))) (syntax-type1247 (lambda (e1727 r1728 w1729 s1730 rib1731 mod1732) (cond ((symbol? e1727) (let ((n1733 (id-var-name1235 e1727 w1729))) (let ((b1734 (lookup1210 n1733 r1728 mod1732))) (let ((type1735 (binding-type1205 b1734))) (let ((t1736 type1735)) (if (memv t1736 (quote (lexical))) (values type1735 (binding-value1206 b1734) e1727 w1729 s1730 mod1732) (if (memv t1736 (quote (global))) (values type1735 n1733 e1727 w1729 s1730 mod1732) (if (memv t1736 (quote (macro))) (syntax-type1247 (chi-macro1252 (binding-value1206 b1734) e1727 r1728 w1729 rib1731 mod1732) r1728 (quote (())) s1730 rib1731 mod1732) (values type1735 (binding-value1206 b1734) e1727 w1729 s1730 mod1732))))))))) ((pair? e1727) (let ((first1737 (car e1727))) (if (id?1213 first1737) (let ((n1738 (id-var-name1235 first1737 w1729))) (let ((b1739 (lookup1210 n1738 r1728 (or (and (syntax-object?1197 first1737) (syntax-object-module1200 first1737)) mod1732)))) (let ((type1740 (binding-type1205 b1739))) (let ((t1741 type1740)) (if (memv t1741 (quote (lexical))) (values (quote lexical-call) (binding-value1206 b1739) e1727 w1729 s1730 mod1732) (if (memv t1741 (quote (global))) (values (quote global-call) n1738 e1727 w1729 s1730 mod1732) (if (memv t1741 (quote (macro))) (syntax-type1247 (chi-macro1252 (binding-value1206 b1739) e1727 r1728 w1729 rib1731 mod1732) r1728 (quote (())) s1730 rib1731 mod1732) (if (memv t1741 (quote (core external-macro module-ref))) (values type1740 (binding-value1206 b1739) e1727 w1729 s1730 mod1732) (if (memv t1741 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1206 b1739) e1727 w1729 s1730 mod1732) (if (memv t1741 (quote (begin))) (values (quote begin-form) #f e1727 w1729 s1730 mod1732) (if (memv t1741 (quote (eval-when))) (values (quote eval-when-form) #f e1727 w1729 s1730 mod1732) (if (memv t1741 (quote (define))) ((lambda (tmp1742) ((lambda (tmp1743) (if (if tmp1743 (apply (lambda (_1744 name1745 val1746) (id?1213 name1745)) tmp1743) #f) (apply (lambda (_1747 name1748 val1749) (values (quote define-form) name1748 val1749 w1729 s1730 mod1732)) tmp1743) ((lambda (tmp1750) (if (if tmp1750 (apply (lambda (_1751 name1752 args1753 e11754 e21755) (and (id?1213 name1752) (valid-bound-ids?1238 (lambda-var-list1262 args1753)))) tmp1750) #f) (apply (lambda (_1756 name1757 args1758 e11759 e21760) (values (quote define-form) (wrap1241 name1757 w1729 mod1732) (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1241 (cons args1758 (cons e11759 e21760)) w1729 mod1732)) (quote (())) s1730 mod1732)) tmp1750) ((lambda (tmp1762) (if (if tmp1762 (apply (lambda (_1763 name1764) (id?1213 name1764)) tmp1762) #f) (apply (lambda (_1765 name1766) (values (quote define-form) (wrap1241 name1766 w1729 mod1732) (quote (#(syntax-object void ((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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1730 mod1732)) tmp1762) (syntax-violation #f "source expression failed to match any pattern" tmp1742))) (syntax-dispatch tmp1742 (quote (any any)))))) (syntax-dispatch tmp1742 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1742 (quote (any any any))))) e1727) (if (memv t1741 (quote (define-syntax))) ((lambda (tmp1767) ((lambda (tmp1768) (if (if tmp1768 (apply (lambda (_1769 name1770 val1771) (id?1213 name1770)) tmp1768) #f) (apply (lambda (_1772 name1773 val1774) (values (quote define-syntax-form) name1773 val1774 w1729 s1730 mod1732)) tmp1768) (syntax-violation #f "source expression failed to match any pattern" tmp1767))) (syntax-dispatch tmp1767 (quote (any any any))))) e1727) (values (quote call) #f e1727 w1729 s1730 mod1732)))))))))))))) (values (quote call) #f e1727 w1729 s1730 mod1732)))) ((syntax-object?1197 e1727) (syntax-type1247 (syntax-object-expression1198 e1727) r1728 (join-wraps1232 w1729 (syntax-object-wrap1199 e1727)) #f rib1731 (or (syntax-object-module1200 e1727) mod1732))) ((annotation? e1727) (syntax-type1247 (annotation-expression e1727) r1728 w1729 (annotation-source e1727) rib1731 mod1732)) ((self-evaluating? e1727) (values (quote constant) #f e1727 w1729 s1730 mod1732)) (else (values (quote other) #f e1727 w1729 s1730 mod1732))))) (chi-when-list1246 (lambda (e1775 when-list1776 w1777) (let f1778 ((when-list1779 when-list1776) (situations1780 (quote ()))) (if (null? when-list1779) situations1780 (f1778 (cdr when-list1779) (cons (let ((x1781 (car when-list1779))) (cond ((free-id=?1236 x1781 (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?1236 x1781 (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?1236 x1781 (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e1775 (wrap1241 x1781 w1777 #f))))) situations1780)))))) (chi-install-global1245 (lambda (name1782 e1783) (build-annotated1190 #f (list (build-annotated1190 #f (quote install-global-transformer)) (build-data1191 #f name1782) e1783)))) (chi-top-sequence1244 (lambda (body1784 r1785 w1786 s1787 m1788 esew1789 mod1790) (build-sequence1192 s1787 (let dobody1791 ((body1792 body1784) (r1793 r1785) (w1794 w1786) (m1795 m1788) (esew1796 esew1789) (mod1797 mod1790)) (if (null? body1792) (quote ()) (let ((first1798 (chi-top1248 (car body1792) r1793 w1794 m1795 esew1796 mod1797))) (cons first1798 (dobody1791 (cdr body1792) r1793 w1794 m1795 esew1796 mod1797)))))))) (chi-sequence1243 (lambda (body1799 r1800 w1801 s1802 mod1803) (build-sequence1192 s1802 (let dobody1804 ((body1805 body1799) (r1806 r1800) (w1807 w1801) (mod1808 mod1803)) (if (null? body1805) (quote ()) (let ((first1809 (chi1249 (car body1805) r1806 w1807 mod1808))) (cons first1809 (dobody1804 (cdr body1805) r1806 w1807 mod1808)))))))) (source-wrap1242 (lambda (x1810 w1811 s1812 defmod1813) (wrap1241 (if s1812 (make-annotation x1810 s1812 #f) x1810) w1811 defmod1813))) (wrap1241 (lambda (x1814 w1815 defmod1816) (cond ((and (null? (wrap-marks1216 w1815)) (null? (wrap-subst1217 w1815))) x1814) ((syntax-object?1197 x1814) (make-syntax-object1196 (syntax-object-expression1198 x1814) (join-wraps1232 w1815 (syntax-object-wrap1199 x1814)) (syntax-object-module1200 x1814))) ((null? x1814) x1814) (else (make-syntax-object1196 x1814 w1815 defmod1816))))) (bound-id-member?1240 (lambda (x1817 list1818) (and (not (null? list1818)) (or (bound-id=?1237 x1817 (car list1818)) (bound-id-member?1240 x1817 (cdr list1818)))))) (distinct-bound-ids?1239 (lambda (ids1819) (let distinct?1820 ((ids1821 ids1819)) (or (null? ids1821) (and (not (bound-id-member?1240 (car ids1821) (cdr ids1821))) (distinct?1820 (cdr ids1821))))))) (valid-bound-ids?1238 (lambda (ids1822) (and (let all-ids?1823 ((ids1824 ids1822)) (or (null? ids1824) (and (id?1213 (car ids1824)) (all-ids?1823 (cdr ids1824))))) (distinct-bound-ids?1239 ids1822)))) (bound-id=?1237 (lambda (i1825 j1826) (if (and (syntax-object?1197 i1825) (syntax-object?1197 j1826)) (and (eq? (let ((e1827 (syntax-object-expression1198 i1825))) (if (annotation? e1827) (annotation-expression e1827) e1827)) (let ((e1828 (syntax-object-expression1198 j1826))) (if (annotation? e1828) (annotation-expression e1828) e1828))) (same-marks?1234 (wrap-marks1216 (syntax-object-wrap1199 i1825)) (wrap-marks1216 (syntax-object-wrap1199 j1826)))) (eq? (let ((e1829 i1825)) (if (annotation? e1829) (annotation-expression e1829) e1829)) (let ((e1830 j1826)) (if (annotation? e1830) (annotation-expression e1830) e1830)))))) (free-id=?1236 (lambda (i1831 j1832) (and (eq? (let ((x1833 i1831)) (let ((e1834 (if (syntax-object?1197 x1833) (syntax-object-expression1198 x1833) x1833))) (if (annotation? e1834) (annotation-expression e1834) e1834))) (let ((x1835 j1832)) (let ((e1836 (if (syntax-object?1197 x1835) (syntax-object-expression1198 x1835) x1835))) (if (annotation? e1836) (annotation-expression e1836) e1836)))) (eq? (id-var-name1235 i1831 (quote (()))) (id-var-name1235 j1832 (quote (()))))))) (id-var-name1235 (lambda (id1837 w1838) (letrec ((search-vector-rib1841 (lambda (sym1847 subst1848 marks1849 symnames1850 ribcage1851) (let ((n1852 (vector-length symnames1850))) (let f1853 ((i1854 0)) (cond ((fx=1182 i1854 n1852) (search1839 sym1847 (cdr subst1848) marks1849)) ((and (eq? (vector-ref symnames1850 i1854) sym1847) (same-marks?1234 marks1849 (vector-ref (ribcage-marks1223 ribcage1851) i1854))) (values (vector-ref (ribcage-labels1224 ribcage1851) i1854) marks1849)) (else (f1853 (fx+1180 i1854 1)))))))) (search-list-rib1840 (lambda (sym1855 subst1856 marks1857 symnames1858 ribcage1859) (let f1860 ((symnames1861 symnames1858) (i1862 0)) (cond ((null? symnames1861) (search1839 sym1855 (cdr subst1856) marks1857)) ((and (eq? (car symnames1861) sym1855) (same-marks?1234 marks1857 (list-ref (ribcage-marks1223 ribcage1859) i1862))) (values (list-ref (ribcage-labels1224 ribcage1859) i1862) marks1857)) (else (f1860 (cdr symnames1861) (fx+1180 i1862 1))))))) (search1839 (lambda (sym1863 subst1864 marks1865) (if (null? subst1864) (values #f marks1865) (let ((fst1866 (car subst1864))) (if (eq? fst1866 (quote shift)) (search1839 sym1863 (cdr subst1864) (cdr marks1865)) (let ((symnames1867 (ribcage-symnames1222 fst1866))) (if (vector? symnames1867) (search-vector-rib1841 sym1863 subst1864 marks1865 symnames1867 fst1866) (search-list-rib1840 sym1863 subst1864 marks1865 symnames1867 fst1866))))))))) (cond ((symbol? id1837) (or (call-with-values (lambda () (search1839 id1837 (wrap-subst1217 w1838) (wrap-marks1216 w1838))) (lambda (x1869 . ignore1868) x1869)) id1837)) ((syntax-object?1197 id1837) (let ((id1870 (let ((e1872 (syntax-object-expression1198 id1837))) (if (annotation? e1872) (annotation-expression e1872) e1872))) (w11871 (syntax-object-wrap1199 id1837))) (let ((marks1873 (join-marks1233 (wrap-marks1216 w1838) (wrap-marks1216 w11871)))) (call-with-values (lambda () (search1839 id1870 (wrap-subst1217 w1838) marks1873)) (lambda (new-id1874 marks1875) (or new-id1874 (call-with-values (lambda () (search1839 id1870 (wrap-subst1217 w11871) marks1875)) (lambda (x1877 . ignore1876) x1877)) id1870)))))) ((annotation? id1837) (let ((id1878 (let ((e1879 id1837)) (if (annotation? e1879) (annotation-expression e1879) e1879)))) (or (call-with-values (lambda () (search1839 id1878 (wrap-subst1217 w1838) (wrap-marks1216 w1838))) (lambda (x1881 . ignore1880) x1881)) id1878))) (else (error-hook1186 (quote id-var-name) "invalid id" id1837)))))) (same-marks?1234 (lambda (x1882 y1883) (or (eq? x1882 y1883) (and (not (null? x1882)) (not (null? y1883)) (eq? (car x1882) (car y1883)) (same-marks?1234 (cdr x1882) (cdr y1883)))))) (join-marks1233 (lambda (m11884 m21885) (smart-append1231 m11884 m21885))) (join-wraps1232 (lambda (w11886 w21887) (let ((m11888 (wrap-marks1216 w11886)) (s11889 (wrap-subst1217 w11886))) (if (null? m11888) (if (null? s11889) w21887 (make-wrap1215 (wrap-marks1216 w21887) (smart-append1231 s11889 (wrap-subst1217 w21887)))) (make-wrap1215 (smart-append1231 m11888 (wrap-marks1216 w21887)) (smart-append1231 s11889 (wrap-subst1217 w21887))))))) (smart-append1231 (lambda (m11890 m21891) (if (null? m21891) m11890 (append m11890 m21891)))) (make-binding-wrap1230 (lambda (ids1892 labels1893 w1894) (if (null? ids1892) w1894 (make-wrap1215 (wrap-marks1216 w1894) (cons (let ((labelvec1895 (list->vector labels1893))) (let ((n1896 (vector-length labelvec1895))) (let ((symnamevec1897 (make-vector n1896)) (marksvec1898 (make-vector n1896))) (begin (let f1899 ((ids1900 ids1892) (i1901 0)) (if (not (null? ids1900)) (call-with-values (lambda () (id-sym-name&marks1214 (car ids1900) w1894)) (lambda (symname1902 marks1903) (begin (vector-set! symnamevec1897 i1901 symname1902) (vector-set! marksvec1898 i1901 marks1903) (f1899 (cdr ids1900) (fx+1180 i1901 1))))))) (make-ribcage1220 symnamevec1897 marksvec1898 labelvec1895))))) (wrap-subst1217 w1894)))))) (extend-ribcage!1229 (lambda (ribcage1904 id1905 label1906) (begin (set-ribcage-symnames!1225 ribcage1904 (cons (let ((e1907 (syntax-object-expression1198 id1905))) (if (annotation? e1907) (annotation-expression e1907) e1907)) (ribcage-symnames1222 ribcage1904))) (set-ribcage-marks!1226 ribcage1904 (cons (wrap-marks1216 (syntax-object-wrap1199 id1905)) (ribcage-marks1223 ribcage1904))) (set-ribcage-labels!1227 ribcage1904 (cons label1906 (ribcage-labels1224 ribcage1904)))))) (anti-mark1228 (lambda (w1908) (make-wrap1215 (cons #f (wrap-marks1216 w1908)) (cons (quote shift) (wrap-subst1217 w1908))))) (set-ribcage-labels!1227 (lambda (x1909 update1910) (vector-set! x1909 3 update1910))) (set-ribcage-marks!1226 (lambda (x1911 update1912) (vector-set! x1911 2 update1912))) (set-ribcage-symnames!1225 (lambda (x1913 update1914) (vector-set! x1913 1 update1914))) (ribcage-labels1224 (lambda (x1915) (vector-ref x1915 3))) (ribcage-marks1223 (lambda (x1916) (vector-ref x1916 2))) (ribcage-symnames1222 (lambda (x1917) (vector-ref x1917 1))) (ribcage?1221 (lambda (x1918) (and (vector? x1918) (= (vector-length x1918) 4) (eq? (vector-ref x1918 0) (quote ribcage))))) (make-ribcage1220 (lambda (symnames1919 marks1920 labels1921) (vector (quote ribcage) symnames1919 marks1920 labels1921))) (gen-labels1219 (lambda (ls1922) (if (null? ls1922) (quote ()) (cons (gen-label1218) (gen-labels1219 (cdr ls1922)))))) (gen-label1218 (lambda () (string #\i))) (wrap-subst1217 cdr) (wrap-marks1216 car) (make-wrap1215 cons) (id-sym-name&marks1214 (lambda (x1923 w1924) (if (syntax-object?1197 x1923) (values (let ((e1925 (syntax-object-expression1198 x1923))) (if (annotation? e1925) (annotation-expression e1925) e1925)) (join-marks1233 (wrap-marks1216 w1924) (wrap-marks1216 (syntax-object-wrap1199 x1923)))) (values (let ((e1926 x1923)) (if (annotation? e1926) (annotation-expression e1926) e1926)) (wrap-marks1216 w1924))))) (id?1213 (lambda (x1927) (cond ((symbol? x1927) #t) ((syntax-object?1197 x1927) (symbol? (let ((e1928 (syntax-object-expression1198 x1927))) (if (annotation? e1928) (annotation-expression e1928) e1928)))) ((annotation? x1927) (symbol? (annotation-expression x1927))) (else #f)))) (nonsymbol-id?1212 (lambda (x1929) (and (syntax-object?1197 x1929) (symbol? (let ((e1930 (syntax-object-expression1198 x1929))) (if (annotation? e1930) (annotation-expression e1930) e1930)))))) (global-extend1211 (lambda (type1931 sym1932 val1933) (put-global-definition-hook1187 sym1932 type1931 val1933))) (lookup1210 (lambda (x1934 r1935 mod1936) (cond ((assq x1934 r1935) => cdr) ((symbol? x1934) (or (get-global-definition-hook1189 x1934 mod1936) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1209 (lambda (r1937) (if (null? r1937) (quote ()) (let ((a1938 (car r1937))) (if (eq? (cadr a1938) (quote macro)) (cons a1938 (macros-only-env1209 (cdr r1937))) (macros-only-env1209 (cdr r1937))))))) (extend-var-env1208 (lambda (labels1939 vars1940 r1941) (if (null? labels1939) r1941 (extend-var-env1208 (cdr labels1939) (cdr vars1940) (cons (cons (car labels1939) (cons (quote lexical) (car vars1940))) r1941))))) (extend-env1207 (lambda (labels1942 bindings1943 r1944) (if (null? labels1942) r1944 (extend-env1207 (cdr labels1942) (cdr bindings1943) (cons (cons (car labels1942) (car bindings1943)) r1944))))) (binding-value1206 cdr) (binding-type1205 car) (source-annotation1204 (lambda (x1945) (cond ((annotation? x1945) (annotation-source x1945)) ((syntax-object?1197 x1945) (source-annotation1204 (syntax-object-expression1198 x1945))) (else #f)))) (set-syntax-object-module!1203 (lambda (x1946 update1947) (vector-set! x1946 3 update1947))) (set-syntax-object-wrap!1202 (lambda (x1948 update1949) (vector-set! x1948 2 update1949))) (set-syntax-object-expression!1201 (lambda (x1950 update1951) (vector-set! x1950 1 update1951))) (syntax-object-module1200 (lambda (x1952) (vector-ref x1952 3))) (syntax-object-wrap1199 (lambda (x1953) (vector-ref x1953 2))) (syntax-object-expression1198 (lambda (x1954) (vector-ref x1954 1))) (syntax-object?1197 (lambda (x1955) (and (vector? x1955) (= (vector-length x1955) 4) (eq? (vector-ref x1955 0) (quote syntax-object))))) (make-syntax-object1196 (lambda (expression1956 wrap1957 module1958) (vector (quote syntax-object) expression1956 wrap1957 module1958))) (build-letrec1195 (lambda (src1959 vars1960 val-exps1961 body-exp1962) (if (null? vars1960) (build-annotated1190 src1959 body-exp1962) (build-annotated1190 src1959 (list (quote letrec) (map list vars1960 val-exps1961) body-exp1962))))) (build-named-let1194 (lambda (src1963 vars1964 val-exps1965 body-exp1966) (if (null? vars1964) (build-annotated1190 src1963 body-exp1966) (build-annotated1190 src1963 (list (quote let) (car vars1964) (map list (cdr vars1964) val-exps1965) body-exp1966))))) (build-let1193 (lambda (src1967 vars1968 val-exps1969 body-exp1970) (if (null? vars1968) (build-annotated1190 src1967 body-exp1970) (build-annotated1190 src1967 (list (quote let) (map list vars1968 val-exps1969) body-exp1970))))) (build-sequence1192 (lambda (src1971 exps1972) (if (null? (cdr exps1972)) (build-annotated1190 src1971 (car exps1972)) (build-annotated1190 src1971 (cons (quote begin) exps1972))))) (build-data1191 (lambda (src1973 exp1974) (if (and (self-evaluating? exp1974) (not (vector? exp1974))) (build-annotated1190 src1973 exp1974) (build-annotated1190 src1973 (list (quote quote) exp1974))))) (build-annotated1190 (lambda (src1975 exp1976) (if (and src1975 (not (annotation? exp1976))) (make-annotation exp1976 src1975 #t) exp1976))) (get-global-definition-hook1189 (lambda (symbol1977 module1978) (begin (if (and (not module1978) (current-module)) (warn "module system is booted, we should have a module" symbol1977)) (module-lookup-keyword (if module1978 (resolve-module (cdr module1978)) (current-module)) symbol1977)))) (remove-global-definition-hook1188 (lambda (symbol1979) (module-undefine-keyword! (current-module) symbol1979))) (put-global-definition-hook1187 (lambda (symbol1980 type1981 val1982) (module-define-keyword! (current-module) symbol1980 type1981 val1982))) (error-hook1186 (lambda (who1983 why1984 what1985) (error who1983 "~a ~s" why1984 what1985))) (local-eval-hook1185 (lambda (x1986 mod1987) (primitive-eval (list noexpand1179 x1986)))) (top-level-eval-hook1184 (lambda (x1988 mod1989) (primitive-eval (list noexpand1179 x1988)))) (fx<1183 <) (fx=1182 =) (fx-1181 -) (fx+1180 +) (noexpand1179 "noexpand")) (begin (global-extend1211 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1211 (quote local-syntax) (quote let-syntax) #f) (global-extend1211 (quote core) (quote fluid-let-syntax) (lambda (e1990 r1991 w1992 s1993 mod1994) ((lambda (tmp1995) ((lambda (tmp1996) (if (if tmp1996 (apply (lambda (_1997 var1998 val1999 e12000 e22001) (valid-bound-ids?1238 var1998)) tmp1996) #f) (apply (lambda (_2003 var2004 val2005 e12006 e22007) (let ((names2008 (map (lambda (x2009) (id-var-name1235 x2009 w1992)) var2004))) (begin (for-each (lambda (id2011 n2012) (let ((t2013 (binding-type1205 (lookup1210 n2012 r1991 mod1994)))) (if (memv t2013 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1990 (source-wrap1242 id2011 w1992 s1993 mod1994))))) var2004 names2008) (chi-body1253 (cons e12006 e22007) (source-wrap1242 e1990 w1992 s1993 mod1994) (extend-env1207 names2008 (let ((trans-r2016 (macros-only-env1209 r1991))) (map (lambda (x2017) (cons (quote macro) (eval-local-transformer1256 (chi1249 x2017 trans-r2016 w1992 mod1994) mod1994))) val2005)) r1991) w1992 mod1994)))) tmp1996) ((lambda (_2019) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1242 e1990 w1992 s1993 mod1994))) tmp1995))) (syntax-dispatch tmp1995 (quote (any #(each (any any)) any . each-any))))) e1990))) (global-extend1211 (quote core) (quote quote) (lambda (e2020 r2021 w2022 s2023 mod2024) ((lambda (tmp2025) ((lambda (tmp2026) (if tmp2026 (apply (lambda (_2027 e2028) (build-data1191 s2023 (strip1260 e2028 w2022))) tmp2026) ((lambda (_2029) (syntax-violation (quote quote) "bad syntax" (source-wrap1242 e2020 w2022 s2023 mod2024))) tmp2025))) (syntax-dispatch tmp2025 (quote (any any))))) e2020))) (global-extend1211 (quote core) (quote syntax) (letrec ((regen2037 (lambda (x2038) (let ((t2039 (car x2038))) (if (memv t2039 (quote (ref))) (build-annotated1190 #f (cadr x2038)) (if (memv t2039 (quote (primitive))) (build-annotated1190 #f (cadr x2038)) (if (memv t2039 (quote (quote))) (build-data1191 #f (cadr x2038)) (if (memv t2039 (quote (lambda))) (build-annotated1190 #f (list (quote lambda) (cadr x2038) (regen2037 (caddr x2038)))) (if (memv t2039 (quote (map))) (let ((ls2040 (map regen2037 (cdr x2038)))) (build-annotated1190 #f (cons (if (fx=1182 (length ls2040) 2) (build-annotated1190 #f (quote map)) (build-annotated1190 #f (quote map))) ls2040))) (build-annotated1190 #f (cons (build-annotated1190 #f (car x2038)) (map regen2037 (cdr x2038)))))))))))) (gen-vector2036 (lambda (x2041) (cond ((eq? (car x2041) (quote list)) (cons (quote vector) (cdr x2041))) ((eq? (car x2041) (quote quote)) (list (quote quote) (list->vector (cadr x2041)))) (else (list (quote list->vector) x2041))))) (gen-append2035 (lambda (x2042 y2043) (if (equal? y2043 (quote (quote ()))) x2042 (list (quote append) x2042 y2043)))) (gen-cons2034 (lambda (x2044 y2045) (let ((t2046 (car y2045))) (if (memv t2046 (quote (quote))) (if (eq? (car x2044) (quote quote)) (list (quote quote) (cons (cadr x2044) (cadr y2045))) (if (eq? (cadr y2045) (quote ())) (list (quote list) x2044) (list (quote cons) x2044 y2045))) (if (memv t2046 (quote (list))) (cons (quote list) (cons x2044 (cdr y2045))) (list (quote cons) x2044 y2045)))))) (gen-map2033 (lambda (e2047 map-env2048) (let ((formals2049 (map cdr map-env2048)) (actuals2050 (map (lambda (x2051) (list (quote ref) (car x2051))) map-env2048))) (cond ((eq? (car e2047) (quote ref)) (car actuals2050)) ((andmap (lambda (x2052) (and (eq? (car x2052) (quote ref)) (memq (cadr x2052) formals2049))) (cdr e2047)) (cons (quote map) (cons (list (quote primitive) (car e2047)) (map (let ((r2053 (map cons formals2049 actuals2050))) (lambda (x2054) (cdr (assq (cadr x2054) r2053)))) (cdr e2047))))) (else (cons (quote map) (cons (list (quote lambda) formals2049 e2047) actuals2050))))))) (gen-mappend2032 (lambda (e2055 map-env2056) (list (quote apply) (quote (primitive append)) (gen-map2033 e2055 map-env2056)))) (gen-ref2031 (lambda (src2057 var2058 level2059 maps2060) (if (fx=1182 level2059 0) (values var2058 maps2060) (if (null? maps2060) (syntax-violation (quote syntax) "missing ellipsis" src2057) (call-with-values (lambda () (gen-ref2031 src2057 var2058 (fx-1181 level2059 1) (cdr maps2060))) (lambda (outer-var2061 outer-maps2062) (let ((b2063 (assq outer-var2061 (car maps2060)))) (if b2063 (values (cdr b2063) maps2060) (let ((inner-var2064 (gen-var1261 (quote tmp)))) (values inner-var2064 (cons (cons (cons outer-var2061 inner-var2064) (car maps2060)) outer-maps2062))))))))))) (gen-syntax2030 (lambda (src2065 e2066 r2067 maps2068 ellipsis?2069 mod2070) (if (id?1213 e2066) (let ((label2071 (id-var-name1235 e2066 (quote (()))))) (let ((b2072 (lookup1210 label2071 r2067 mod2070))) (if (eq? (binding-type1205 b2072) (quote syntax)) (call-with-values (lambda () (let ((var.lev2073 (binding-value1206 b2072))) (gen-ref2031 src2065 (car var.lev2073) (cdr var.lev2073) maps2068))) (lambda (var2074 maps2075) (values (list (quote ref) var2074) maps2075))) (if (ellipsis?2069 e2066) (syntax-violation (quote syntax) "misplaced ellipsis" src2065) (values (list (quote quote) e2066) maps2068))))) ((lambda (tmp2076) ((lambda (tmp2077) (if (if tmp2077 (apply (lambda (dots2078 e2079) (ellipsis?2069 dots2078)) tmp2077) #f) (apply (lambda (dots2080 e2081) (gen-syntax2030 src2065 e2081 r2067 maps2068 (lambda (x2082) #f) mod2070)) tmp2077) ((lambda (tmp2083) (if (if tmp2083 (apply (lambda (x2084 dots2085 y2086) (ellipsis?2069 dots2085)) tmp2083) #f) (apply (lambda (x2087 dots2088 y2089) (let f2090 ((y2091 y2089) (k2092 (lambda (maps2093) (call-with-values (lambda () (gen-syntax2030 src2065 x2087 r2067 (cons (quote ()) maps2093) ellipsis?2069 mod2070)) (lambda (x2094 maps2095) (if (null? (car maps2095)) (syntax-violation (quote syntax) "extra ellipsis" src2065) (values (gen-map2033 x2094 (car maps2095)) (cdr maps2095)))))))) ((lambda (tmp2096) ((lambda (tmp2097) (if (if tmp2097 (apply (lambda (dots2098 y2099) (ellipsis?2069 dots2098)) tmp2097) #f) (apply (lambda (dots2100 y2101) (f2090 y2101 (lambda (maps2102) (call-with-values (lambda () (k2092 (cons (quote ()) maps2102))) (lambda (x2103 maps2104) (if (null? (car maps2104)) (syntax-violation (quote syntax) "extra ellipsis" src2065) (values (gen-mappend2032 x2103 (car maps2104)) (cdr maps2104)))))))) tmp2097) ((lambda (_2105) (call-with-values (lambda () (gen-syntax2030 src2065 y2091 r2067 maps2068 ellipsis?2069 mod2070)) (lambda (y2106 maps2107) (call-with-values (lambda () (k2092 maps2107)) (lambda (x2108 maps2109) (values (gen-append2035 x2108 y2106) maps2109)))))) tmp2096))) (syntax-dispatch tmp2096 (quote (any . any))))) y2091))) tmp2083) ((lambda (tmp2110) (if tmp2110 (apply (lambda (x2111 y2112) (call-with-values (lambda () (gen-syntax2030 src2065 x2111 r2067 maps2068 ellipsis?2069 mod2070)) (lambda (x2113 maps2114) (call-with-values (lambda () (gen-syntax2030 src2065 y2112 r2067 maps2114 ellipsis?2069 mod2070)) (lambda (y2115 maps2116) (values (gen-cons2034 x2113 y2115) maps2116)))))) tmp2110) ((lambda (tmp2117) (if tmp2117 (apply (lambda (e12118 e22119) (call-with-values (lambda () (gen-syntax2030 src2065 (cons e12118 e22119) r2067 maps2068 ellipsis?2069 mod2070)) (lambda (e2121 maps2122) (values (gen-vector2036 e2121) maps2122)))) tmp2117) ((lambda (_2123) (values (list (quote quote) e2066) maps2068)) tmp2076))) (syntax-dispatch tmp2076 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp2076 (quote (any . any)))))) (syntax-dispatch tmp2076 (quote (any any . any)))))) (syntax-dispatch tmp2076 (quote (any any))))) e2066))))) (lambda (e2124 r2125 w2126 s2127 mod2128) (let ((e2129 (source-wrap1242 e2124 w2126 s2127 mod2128))) ((lambda (tmp2130) ((lambda (tmp2131) (if tmp2131 (apply (lambda (_2132 x2133) (call-with-values (lambda () (gen-syntax2030 e2129 x2133 r2125 (quote ()) ellipsis?1258 mod2128)) (lambda (e2134 maps2135) (regen2037 e2134)))) tmp2131) ((lambda (_2136) (syntax-violation (quote syntax) "bad `syntax' form" e2129)) tmp2130))) (syntax-dispatch tmp2130 (quote (any any))))) e2129))))) (global-extend1211 (quote core) (quote lambda) (lambda (e2137 r2138 w2139 s2140 mod2141) ((lambda (tmp2142) ((lambda (tmp2143) (if tmp2143 (apply (lambda (_2144 c2145) (chi-lambda-clause1254 (source-wrap1242 e2137 w2139 s2140 mod2141) #f c2145 r2138 w2139 mod2141 (lambda (vars2146 docstring2147 body2148) (build-annotated1190 s2140 (cons (quote lambda) (cons vars2146 (append (if docstring2147 (list docstring2147) (quote ())) (list body2148)))))))) tmp2143) (syntax-violation #f "source expression failed to match any pattern" tmp2142))) (syntax-dispatch tmp2142 (quote (any . any))))) e2137))) (global-extend1211 (quote core) (quote let) (letrec ((chi-let2149 (lambda (e2150 r2151 w2152 s2153 mod2154 constructor2155 ids2156 vals2157 exps2158) (if (not (valid-bound-ids?1238 ids2156)) (syntax-violation (quote let) "duplicate bound variable" e2150) (let ((labels2159 (gen-labels1219 ids2156)) (new-vars2160 (map gen-var1261 ids2156))) (let ((nw2161 (make-binding-wrap1230 ids2156 labels2159 w2152)) (nr2162 (extend-var-env1208 labels2159 new-vars2160 r2151))) (constructor2155 s2153 new-vars2160 (map (lambda (x2163) (chi1249 x2163 r2151 w2152 mod2154)) vals2157) (chi-body1253 exps2158 (source-wrap1242 e2150 nw2161 s2153 mod2154) nr2162 nw2161 mod2154)))))))) (lambda (e2164 r2165 w2166 s2167 mod2168) ((lambda (tmp2169) ((lambda (tmp2170) (if tmp2170 (apply (lambda (_2171 id2172 val2173 e12174 e22175) (chi-let2149 e2164 r2165 w2166 s2167 mod2168 build-let1193 id2172 val2173 (cons e12174 e22175))) tmp2170) ((lambda (tmp2179) (if (if tmp2179 (apply (lambda (_2180 f2181 id2182 val2183 e12184 e22185) (id?1213 f2181)) tmp2179) #f) (apply (lambda (_2186 f2187 id2188 val2189 e12190 e22191) (chi-let2149 e2164 r2165 w2166 s2167 mod2168 build-named-let1194 (cons f2187 id2188) val2189 (cons e12190 e22191))) tmp2179) ((lambda (_2195) (syntax-violation (quote let) "bad let" (source-wrap1242 e2164 w2166 s2167 mod2168))) tmp2169))) (syntax-dispatch tmp2169 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2169 (quote (any #(each (any any)) any . each-any))))) e2164)))) (global-extend1211 (quote core) (quote letrec) (lambda (e2196 r2197 w2198 s2199 mod2200) ((lambda (tmp2201) ((lambda (tmp2202) (if tmp2202 (apply (lambda (_2203 id2204 val2205 e12206 e22207) (let ((ids2208 id2204)) (if (not (valid-bound-ids?1238 ids2208)) (syntax-violation (quote letrec) "duplicate bound variable" e2196) (let ((labels2210 (gen-labels1219 ids2208)) (new-vars2211 (map gen-var1261 ids2208))) (let ((w2212 (make-binding-wrap1230 ids2208 labels2210 w2198)) (r2213 (extend-var-env1208 labels2210 new-vars2211 r2197))) (build-letrec1195 s2199 new-vars2211 (map (lambda (x2214) (chi1249 x2214 r2213 w2212 mod2200)) val2205) (chi-body1253 (cons e12206 e22207) (source-wrap1242 e2196 w2212 s2199 mod2200) r2213 w2212 mod2200))))))) tmp2202) ((lambda (_2217) (syntax-violation (quote letrec) "bad letrec" (source-wrap1242 e2196 w2198 s2199 mod2200))) tmp2201))) (syntax-dispatch tmp2201 (quote (any #(each (any any)) any . each-any))))) e2196))) (global-extend1211 (quote core) (quote set!) (lambda (e2218 r2219 w2220 s2221 mod2222) ((lambda (tmp2223) ((lambda (tmp2224) (if (if tmp2224 (apply (lambda (_2225 id2226 val2227) (id?1213 id2226)) tmp2224) #f) (apply (lambda (_2228 id2229 val2230) (let ((val2231 (chi1249 val2230 r2219 w2220 mod2222)) (n2232 (id-var-name1235 id2229 w2220))) (let ((b2233 (lookup1210 n2232 r2219 mod2222))) (let ((t2234 (binding-type1205 b2233))) (if (memv t2234 (quote (lexical))) (build-annotated1190 s2221 (list (quote set!) (binding-value1206 b2233) val2231)) (if (memv t2234 (quote (global))) (build-annotated1190 s2221 (list (quote set!) (if mod2222 (make-module-ref (cdr mod2222) n2232 (car mod2222)) (make-module-ref mod2222 n2232 (quote bare))) val2231)) (if (memv t2234 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1241 id2229 w2220 mod2222)) (syntax-violation (quote set!) "bad set!" (source-wrap1242 e2218 w2220 s2221 mod2222))))))))) tmp2224) ((lambda (tmp2235) (if tmp2235 (apply (lambda (_2236 head2237 tail2238 val2239) (call-with-values (lambda () (syntax-type1247 head2237 r2219 (quote (())) #f #f mod2222)) (lambda (type2240 value2241 ee2242 ww2243 ss2244 modmod2245) (let ((t2246 type2240)) (if (memv t2246 (quote (module-ref))) (let ((val2247 (chi1249 val2239 r2219 w2220 mod2222))) (call-with-values (lambda () (value2241 (cons head2237 tail2238))) (lambda (id2249 mod2250) (build-annotated1190 s2221 (list (quote set!) (if mod2250 (make-module-ref (cdr mod2250) id2249 (car mod2250)) (make-module-ref mod2250 id2249 (quote bare))) val2247))))) (build-annotated1190 s2221 (cons (chi1249 (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2237) r2219 w2220 mod2222) (map (lambda (e2251) (chi1249 e2251 r2219 w2220 mod2222)) (append tail2238 (list val2239)))))))))) tmp2235) ((lambda (_2253) (syntax-violation (quote set!) "bad set!" (source-wrap1242 e2218 w2220 s2221 mod2222))) tmp2223))) (syntax-dispatch tmp2223 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2223 (quote (any any any))))) e2218))) (global-extend1211 (quote module-ref) (quote @) (lambda (e2254) ((lambda (tmp2255) ((lambda (tmp2256) (if (if tmp2256 (apply (lambda (_2257 mod2258 id2259) (and (andmap id?1213 mod2258) (id?1213 id2259))) tmp2256) #f) (apply (lambda (_2261 mod2262 id2263) (values (syntax-object->datum id2263) (syntax-object->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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2262)))) tmp2256) (syntax-violation #f "source expression failed to match any pattern" tmp2255))) (syntax-dispatch tmp2255 (quote (any each-any any))))) e2254))) (global-extend1211 (quote module-ref) (quote @@) (lambda (e2265) ((lambda (tmp2266) ((lambda (tmp2267) (if (if tmp2267 (apply (lambda (_2268 mod2269 id2270) (and (andmap id?1213 mod2269) (id?1213 id2270))) tmp2267) #f) (apply (lambda (_2272 mod2273 id2274) (values (syntax-object->datum id2274) (syntax-object->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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2273)))) tmp2267) (syntax-violation #f "source expression failed to match any pattern" tmp2266))) (syntax-dispatch tmp2266 (quote (any each-any any))))) e2265))) (global-extend1211 (quote begin) (quote begin) (quote ())) (global-extend1211 (quote define) (quote define) (quote ())) (global-extend1211 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1211 (quote eval-when) (quote eval-when) (quote ())) (global-extend1211 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2279 (lambda (x2280 keys2281 clauses2282 r2283 mod2284) (if (null? clauses2282) (build-annotated1190 #f (list (build-annotated1190 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2280)) ((lambda (tmp2285) ((lambda (tmp2286) (if tmp2286 (apply (lambda (pat2287 exp2288) (if (and (id?1213 pat2287) (andmap (lambda (x2289) (not (free-id=?1236 pat2287 x2289))) (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2281))) (let ((labels2290 (list (gen-label1218))) (var2291 (gen-var1261 pat2287))) (build-annotated1190 #f (list (build-annotated1190 #f (list (quote lambda) (list var2291) (chi1249 exp2288 (extend-env1207 labels2290 (list (cons (quote syntax) (cons var2291 0))) r2283) (make-binding-wrap1230 (list pat2287) labels2290 (quote (()))) mod2284))) x2280))) (gen-clause2278 x2280 keys2281 (cdr clauses2282) r2283 pat2287 #t exp2288 mod2284))) tmp2286) ((lambda (tmp2292) (if tmp2292 (apply (lambda (pat2293 fender2294 exp2295) (gen-clause2278 x2280 keys2281 (cdr clauses2282) r2283 pat2293 fender2294 exp2295 mod2284)) tmp2292) ((lambda (_2296) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2282))) tmp2285))) (syntax-dispatch tmp2285 (quote (any any any)))))) (syntax-dispatch tmp2285 (quote (any any))))) (car clauses2282))))) (gen-clause2278 (lambda (x2297 keys2298 clauses2299 r2300 pat2301 fender2302 exp2303 mod2304) (call-with-values (lambda () (convert-pattern2276 pat2301 keys2298)) (lambda (p2305 pvars2306) (cond ((not (distinct-bound-ids?1239 (map car pvars2306))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2301)) ((not (andmap (lambda (x2307) (not (ellipsis?1258 (car x2307)))) pvars2306)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2301)) (else (let ((y2308 (gen-var1261 (quote tmp)))) (build-annotated1190 #f (list (build-annotated1190 #f (list (quote lambda) (list y2308) (let ((y2309 (build-annotated1190 #f y2308))) (build-annotated1190 #f (list (quote if) ((lambda (tmp2310) ((lambda (tmp2311) (if tmp2311 (apply (lambda () y2309) tmp2311) ((lambda (_2312) (build-annotated1190 #f (list (quote if) y2309 (build-dispatch-call2277 pvars2306 fender2302 y2309 r2300 mod2304) (build-data1191 #f #f)))) tmp2310))) (syntax-dispatch tmp2310 (quote #(atom #t))))) fender2302) (build-dispatch-call2277 pvars2306 exp2303 y2309 r2300 mod2304) (gen-syntax-case2279 x2297 keys2298 clauses2299 r2300 mod2304)))))) (if (eq? p2305 (quote any)) (build-annotated1190 #f (list (build-annotated1190 #f (quote list)) x2297)) (build-annotated1190 #f (list (build-annotated1190 #f (quote syntax-dispatch)) x2297 (build-data1191 #f p2305))))))))))))) (build-dispatch-call2277 (lambda (pvars2313 exp2314 y2315 r2316 mod2317) (let ((ids2318 (map car pvars2313)) (levels2319 (map cdr pvars2313))) (let ((labels2320 (gen-labels1219 ids2318)) (new-vars2321 (map gen-var1261 ids2318))) (build-annotated1190 #f (list (build-annotated1190 #f (quote apply)) (build-annotated1190 #f (list (quote lambda) new-vars2321 (chi1249 exp2314 (extend-env1207 labels2320 (map (lambda (var2322 level2323) (cons (quote syntax) (cons var2322 level2323))) new-vars2321 (map cdr pvars2313)) r2316) (make-binding-wrap1230 ids2318 labels2320 (quote (()))) mod2317))) y2315)))))) (convert-pattern2276 (lambda (pattern2324 keys2325) (let cvt2326 ((p2327 pattern2324) (n2328 0) (ids2329 (quote ()))) (if (id?1213 p2327) (if (bound-id-member?1240 p2327 keys2325) (values (vector (quote free-id) p2327) ids2329) (values (quote any) (cons (cons p2327 n2328) ids2329))) ((lambda (tmp2330) ((lambda (tmp2331) (if (if tmp2331 (apply (lambda (x2332 dots2333) (ellipsis?1258 dots2333)) tmp2331) #f) (apply (lambda (x2334 dots2335) (call-with-values (lambda () (cvt2326 x2334 (fx+1180 n2328 1) ids2329)) (lambda (p2336 ids2337) (values (if (eq? p2336 (quote any)) (quote each-any) (vector (quote each) p2336)) ids2337)))) tmp2331) ((lambda (tmp2338) (if tmp2338 (apply (lambda (x2339 y2340) (call-with-values (lambda () (cvt2326 y2340 n2328 ids2329)) (lambda (y2341 ids2342) (call-with-values (lambda () (cvt2326 x2339 n2328 ids2342)) (lambda (x2343 ids2344) (values (cons x2343 y2341) ids2344)))))) tmp2338) ((lambda (tmp2345) (if tmp2345 (apply (lambda () (values (quote ()) ids2329)) tmp2345) ((lambda (tmp2346) (if tmp2346 (apply (lambda (x2347) (call-with-values (lambda () (cvt2326 x2347 n2328 ids2329)) (lambda (p2349 ids2350) (values (vector (quote vector) p2349) ids2350)))) tmp2346) ((lambda (x2351) (values (vector (quote atom) (strip1260 p2327 (quote (())))) ids2329)) tmp2330))) (syntax-dispatch tmp2330 (quote #(vector each-any)))))) (syntax-dispatch tmp2330 (quote ()))))) (syntax-dispatch tmp2330 (quote (any . any)))))) (syntax-dispatch tmp2330 (quote (any any))))) p2327)))))) (lambda (e2352 r2353 w2354 s2355 mod2356) (let ((e2357 (source-wrap1242 e2352 w2354 s2355 mod2356))) ((lambda (tmp2358) ((lambda (tmp2359) (if tmp2359 (apply (lambda (_2360 val2361 key2362 m2363) (if (andmap (lambda (x2364) (and (id?1213 x2364) (not (ellipsis?1258 x2364)))) key2362) (let ((x2366 (gen-var1261 (quote tmp)))) (build-annotated1190 s2355 (list (build-annotated1190 #f (list (quote lambda) (list x2366) (gen-syntax-case2279 (build-annotated1190 #f x2366) key2362 m2363 r2353 mod2356))) (chi1249 val2361 r2353 (quote (())) mod2356)))) (syntax-violation (quote syntax-case) "invalid literals list" e2357))) tmp2359) (syntax-violation #f "source expression failed to match any pattern" tmp2358))) (syntax-dispatch tmp2358 (quote (any any each-any . each-any))))) e2357))))) (set! sc-expand (let ((m2369 (quote e)) (esew2370 (quote (eval)))) (lambda (x2371) (if (and (pair? x2371) (equal? (car x2371) noexpand1179)) (cadr x2371) (chi-top1248 x2371 (quote ()) (quote ((top))) m2369 esew2370 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2372 (quote e)) (esew2373 (quote (eval)))) (lambda (x2375 . rest2374) (if (and (pair? x2375) (equal? (car x2375) noexpand1179)) (cadr x2375) (chi-top1248 x2375 (quote ()) (quote ((top))) (if (null? rest2374) m2372 (car rest2374)) (if (or (null? rest2374) (null? (cdr rest2374))) esew2373 (cadr rest2374)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2376) (nonsymbol-id?1212 x2376))) (set! datum->syntax-object (lambda (id2377 datum2378) (make-syntax-object1196 datum2378 (syntax-object-wrap1199 id2377) #f))) (set! syntax-object->datum (lambda (x2379) (strip1260 x2379 (quote (()))))) (set! generate-temporaries (lambda (ls2380) (begin (let ((x2381 ls2380)) (if (not (list? x2381)) (error-hook1186 (quote generate-temporaries) "invalid argument" x2381))) (map (lambda (x2382) (wrap1241 (gensym) (quote ((top))) #f)) ls2380)))) (set! free-identifier=? (lambda (x2383 y2384) (begin (let ((x2385 x2383)) (if (not (nonsymbol-id?1212 x2385)) (error-hook1186 (quote free-identifier=?) "invalid argument" x2385))) (let ((x2386 y2384)) (if (not (nonsymbol-id?1212 x2386)) (error-hook1186 (quote free-identifier=?) "invalid argument" x2386))) (free-id=?1236 x2383 y2384)))) (set! bound-identifier=? (lambda (x2387 y2388) (begin (let ((x2389 x2387)) (if (not (nonsymbol-id?1212 x2389)) (error-hook1186 (quote bound-identifier=?) "invalid argument" x2389))) (let ((x2390 y2388)) (if (not (nonsymbol-id?1212 x2390)) (error-hook1186 (quote bound-identifier=?) "invalid argument" x2390))) (bound-id=?1237 x2387 y2388)))) (set! syntax-violation (lambda (who2394 message2393 form2392 . subform2391) (begin (let ((x2395 who2394)) (if (not ((lambda (x2396) (or (not x2396) (string? x2396) (symbol? x2396))) x2395)) (error-hook1186 (quote syntax-violation) "invalid argument" x2395))) (let ((x2397 message2393)) (if (not (string? x2397)) (error-hook1186 (quote syntax-violation) "invalid argument" x2397))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2394 "~a: " "") "~a " (if (null? subform2391) "in ~a" "in subform `~s' of `~s'")) (let ((tail2398 (cons message2393 (map (lambda (x2399) (strip1260 x2399 (quote (())))) (append subform2391 (list form2392)))))) (if who2394 (cons who2394 tail2398) tail2398)) #f)))) (set! install-global-transformer (lambda (sym2400 v2401) (begin (let ((x2402 sym2400)) (if (not (symbol? x2402)) (error-hook1186 (quote define-syntax) "invalid argument" x2402))) (let ((x2403 v2401)) (if (not (procedure? x2403)) (error-hook1186 (quote define-syntax) "invalid argument" x2403))) (global-extend1211 (quote macro) sym2400 v2401)))) (letrec ((match2408 (lambda (e2409 p2410 w2411 r2412 mod2413) (cond ((not r2412) #f) ((eq? p2410 (quote any)) (cons (wrap1241 e2409 w2411 mod2413) r2412)) ((syntax-object?1197 e2409) (match*2407 (let ((e2414 (syntax-object-expression1198 e2409))) (if (annotation? e2414) (annotation-expression e2414) e2414)) p2410 (join-wraps1232 w2411 (syntax-object-wrap1199 e2409)) r2412 (syntax-object-module1200 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?1213 e2416) (free-id=?1236 (wrap1241 e2416 w2418 mod2420) (vector-ref p2417 1)) r2419) (if (memv t2422 (quote (atom))) (and (equal? (vector-ref p2417 1) (strip1260 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 (wrap1241 (car e2429) w2430 mod2431) l2432)))) ((null? e2429) (quote ())) ((syntax-object?1197 e2429) (match-each-any2405 (syntax-object-expression1198 e2429) (join-wraps1232 w2430 (syntax-object-wrap1199 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?1197 e2433) (match-each2404 (syntax-object-expression1198 e2433) p2434 (join-wraps1232 w2435 (syntax-object-wrap1199 e2433)) (syntax-object-module1200 e2433))) (else #f))))) (set! syntax-dispatch (lambda (e2439 p2440) (cond ((eq? p2440 (quote any)) (list e2439)) ((syntax-object?1197 e2439) (match*2407 (let ((e2441 (syntax-object-expression1198 e2439))) (if (annotation? e2441) (annotation-expression e2441) e2441)) p2440 (syntax-object-wrap1199 e2439) (quote ()) (syntax-object-module1200 e2439))) (else (match*2407 (let ((e2442 e2439)) (if (annotation? e2442) (annotation-expression e2442) e2442)) p2440 (quote (())) (quote ()) #f)))))))) -(install-global-transformer (quote with-syntax) (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))) (syntax-dispatch tmp2444 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2444 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2444 (quote (any () any . each-any))))) x2443))) -(install-global-transformer (quote syntax-rules) (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))) (syntax-dispatch tmp2467 (quote (any each-any . #(each ((any . any) any))))))) x2466))) -(install-global-transformer (quote let*) (lambda (x2477) ((lambda (tmp2478) ((lambda (tmp2479) (if (if tmp2479 (apply (lambda (let*2480 x2481 v2482 e12483 e22484) (andmap 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))) (syntax-dispatch tmp2496 (quote (any any))))) (list (f2491 (cdr bindings2492)) (car bindings2492)))))) tmp2479) (syntax-violation #f "source expression failed to match any pattern" tmp2478))) (syntax-dispatch tmp2478 (quote (any #(each (any any)) any . each-any))))) x2477))) -(install-global-transformer (quote do) (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))) (syntax-dispatch tmp2513 (quote (any . each-any)))))) (syntax-dispatch tmp2513 (quote ())))) e12508)) tmp2511) (syntax-violation #f "source expression failed to match any pattern" tmp2510))) (syntax-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))) (syntax-dispatch tmp2530 (quote (any)))))) (syntax-dispatch tmp2530 (quote ())))) s2529)) var2504 step2506))) tmp2502) (syntax-violation #f "source expression failed to match any pattern" tmp2501))) (syntax-dispatch tmp2501 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2500))) -(install-global-transformer (quote quasiquote) (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))) (syntax-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))) (syntax-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)))))) (syntax-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))) (syntax-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))) (syntax-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))) (syntax-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))) (syntax-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)))))) (syntax-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))) (syntax-dispatch tmp2579 (quote #(vector each-any)))))) (syntax-dispatch tmp2579 (quote (any . any)))))) (syntax-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)))))) (syntax-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)))))) (syntax-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))) (syntax-dispatch tmp2595 (quote (any any))))) x2594)))) -(install-global-transformer (quote include) (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-object k2602 x2605) (f2604 (read p2603))))))))) ((lambda (tmp2606) ((lambda (tmp2607) (if tmp2607 (apply (lambda (k2608 filename2609) (let ((fn2610 (syntax-object->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))) (syntax-dispatch tmp2611 (quote each-any)))) (read-file2600 fn2610 k2608)))) tmp2607) (syntax-violation #f "source expression failed to match any pattern" tmp2606))) (syntax-dispatch tmp2606 (quote (any any))))) x2599)))) -(install-global-transformer (quote unquote) (lambda (x2615) ((lambda (tmp2616) ((lambda (tmp2617) (if tmp2617 (apply (lambda (_2618 e2619) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2619))) tmp2617) (syntax-violation #f "source expression failed to match any pattern" tmp2616))) (syntax-dispatch tmp2616 (quote (any any))))) x2615))) -(install-global-transformer (quote unquote-splicing) (lambda (x2620) ((lambda (tmp2621) ((lambda (tmp2622) (if tmp2622 (apply (lambda (_2623 e2624) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2624))) tmp2622) (syntax-violation #f "source expression failed to match any pattern" tmp2621))) (syntax-dispatch tmp2621 (quote (any any))))) x2620))) -(install-global-transformer (quote case) (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))) (syntax-dispatch tmp2638 (quote (each-any any . each-any)))))) (syntax-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))) (syntax-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))) (syntax-dispatch tmp2626 (quote (any any any . each-any))))) x2625))) -(install-global-transformer (quote identifier-syntax) (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))) (syntax-dispatch tmp2661 (quote (any any))))) x2660))) +(letrec ((lambda-var-list1132 (lambda (vars1337) (let lvl1338 ((vars1339 vars1337) (ls1340 (quote ())) (w1341 (quote (())))) (cond ((pair? vars1339) (lvl1338 (cdr vars1339) (cons (wrap1111 (car vars1339) w1341 #f) ls1340) w1341)) ((id?1083 vars1339) (cons (wrap1111 vars1339 w1341 #f) ls1340)) ((null? vars1339) ls1340) ((syntax-object?1067 vars1339) (lvl1338 (syntax-object-expression1068 vars1339) ls1340 (join-wraps1102 w1341 (syntax-object-wrap1069 vars1339)))) ((annotation? vars1339) (lvl1338 (annotation-expression vars1339) ls1340 w1341)) (else (cons vars1339 ls1340)))))) (gen-var1131 (lambda (id1342) (let ((id1343 (if (syntax-object?1067 id1342) (syntax-object-expression1068 id1342) id1342))) (if (annotation? id1343) (build-annotated1060 (annotation-source id1343) (gensym (symbol->string (annotation-expression id1343)))) (build-annotated1060 #f (gensym (symbol->string id1343))))))) (strip1130 (lambda (x1344 w1345) (if (memq (quote top) (wrap-marks1086 w1345)) (if (or (annotation? x1344) (and (pair? x1344) (annotation? (car x1344)))) (strip-annotation1129 x1344 #f) x1344) (let f1346 ((x1347 x1344)) (cond ((syntax-object?1067 x1347) (strip1130 (syntax-object-expression1068 x1347) (syntax-object-wrap1069 x1347))) ((pair? x1347) (let ((a1348 (f1346 (car x1347))) (d1349 (f1346 (cdr x1347)))) (if (and (eq? a1348 (car x1347)) (eq? d1349 (cdr x1347))) x1347 (cons a1348 d1349)))) ((vector? x1347) (let ((old1350 (vector->list x1347))) (let ((new1351 (map f1346 old1350))) (if (andmap eq? old1350 new1351) x1347 (list->vector new1351))))) (else x1347)))))) (strip-annotation1129 (lambda (x1352 parent1353) (cond ((pair? x1352) (let ((new1354 (cons #f #f))) (begin (if parent1353 (set-annotation-stripped! parent1353 new1354)) (set-car! new1354 (strip-annotation1129 (car x1352) #f)) (set-cdr! new1354 (strip-annotation1129 (cdr x1352) #f)) new1354))) ((annotation? x1352) (or (annotation-stripped x1352) (strip-annotation1129 (annotation-expression x1352) x1352))) ((vector? x1352) (let ((new1355 (make-vector (vector-length x1352)))) (begin (if parent1353 (set-annotation-stripped! parent1353 new1355)) (let loop1356 ((i1357 (- (vector-length x1352) 1))) (unless (fx<1053 i1357 0) (vector-set! new1355 i1357 (strip-annotation1129 (vector-ref x1352 i1357) #f)) (loop1356 (fx-1051 i1357 1)))) new1355))) (else x1352)))) (ellipsis?1128 (lambda (x1358) (and (nonsymbol-id?1082 x1358) (free-id=?1106 x1358 (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void1127 (lambda () (build-annotated1060 #f (list (build-annotated1060 #f (quote void)))))) (eval-local-transformer1126 (lambda (expanded1359 mod1360) (let ((p1361 (local-eval-hook1055 expanded1359 mod1360))) (if (procedure? p1361) p1361 (syntax-violation #f "nonprocedure transformer" p1361))))) (chi-local-syntax1125 (lambda (rec?1362 e1363 r1364 w1365 s1366 mod1367 k1368) ((lambda (tmp1369) ((lambda (tmp1370) (if tmp1370 (apply (lambda (_1371 id1372 val1373 e11374 e21375) (let ((ids1376 id1372)) (if (not (valid-bound-ids?1108 ids1376)) (syntax-violation #f "duplicate bound keyword" e1363) (let ((labels1378 (gen-labels1089 ids1376))) (let ((new-w1379 (make-binding-wrap1100 ids1376 labels1378 w1365))) (k1368 (cons e11374 e21375) (extend-env1077 labels1378 (let ((w1381 (if rec?1362 new-w1379 w1365)) (trans-r1382 (macros-only-env1079 r1364))) (map (lambda (x1383) (cons (quote macro) (eval-local-transformer1126 (chi1119 x1383 trans-r1382 w1381 mod1367) mod1367))) val1373)) r1364) new-w1379 s1366 mod1367)))))) tmp1370) ((lambda (_1385) (syntax-violation #f "bad local syntax definition" (source-wrap1112 e1363 w1365 s1366 mod1367))) tmp1369))) (syntax-dispatch tmp1369 (quote (any #(each (any any)) any . each-any))))) e1363))) (chi-lambda-clause1124 (lambda (e1386 docstring1387 c1388 r1389 w1390 mod1391 k1392) ((lambda (tmp1393) ((lambda (tmp1394) (if (if tmp1394 (apply (lambda (args1395 doc1396 e11397 e21398) (and (string? (syntax->datum doc1396)) (not docstring1387))) tmp1394) #f) (apply (lambda (args1399 doc1400 e11401 e21402) (chi-lambda-clause1124 e1386 doc1400 (cons args1399 (cons e11401 e21402)) r1389 w1390 mod1391 k1392)) tmp1394) ((lambda (tmp1404) (if tmp1404 (apply (lambda (id1405 e11406 e21407) (let ((ids1408 id1405)) (if (not (valid-bound-ids?1108 ids1408)) (syntax-violation (quote lambda) "invalid parameter list" e1386) (let ((labels1410 (gen-labels1089 ids1408)) (new-vars1411 (map gen-var1131 ids1408))) (k1392 new-vars1411 docstring1387 (chi-body1123 (cons e11406 e21407) e1386 (extend-var-env1078 labels1410 new-vars1411 r1389) (make-binding-wrap1100 ids1408 labels1410 w1390) mod1391)))))) tmp1404) ((lambda (tmp1413) (if tmp1413 (apply (lambda (ids1414 e11415 e21416) (let ((old-ids1417 (lambda-var-list1132 ids1414))) (if (not (valid-bound-ids?1108 old-ids1417)) (syntax-violation (quote lambda) "invalid parameter list" e1386) (let ((labels1418 (gen-labels1089 old-ids1417)) (new-vars1419 (map gen-var1131 old-ids1417))) (k1392 (let f1420 ((ls11421 (cdr new-vars1419)) (ls21422 (car new-vars1419))) (if (null? ls11421) ls21422 (f1420 (cdr ls11421) (cons (car ls11421) ls21422)))) docstring1387 (chi-body1123 (cons e11415 e21416) e1386 (extend-var-env1078 labels1418 new-vars1419 r1389) (make-binding-wrap1100 old-ids1417 labels1418 w1390) mod1391)))))) tmp1413) ((lambda (_1424) (syntax-violation (quote lambda) "bad lambda" e1386)) tmp1393))) (syntax-dispatch tmp1393 (quote (any any . each-any)))))) (syntax-dispatch tmp1393 (quote (each-any any . each-any)))))) (syntax-dispatch tmp1393 (quote (any any any . each-any))))) c1388))) (chi-body1123 (lambda (body1425 outer-form1426 r1427 w1428 mod1429) (let ((r1430 (cons (quote ("placeholder" placeholder)) r1427))) (let ((ribcage1431 (make-ribcage1090 (quote ()) (quote ()) (quote ())))) (let ((w1432 (make-wrap1085 (wrap-marks1086 w1428) (cons ribcage1431 (wrap-subst1087 w1428))))) (let parse1433 ((body1434 (map (lambda (x1440) (cons r1430 (wrap1111 x1440 w1432 mod1429))) body1425)) (ids1435 (quote ())) (labels1436 (quote ())) (vars1437 (quote ())) (vals1438 (quote ())) (bindings1439 (quote ()))) (if (null? body1434) (syntax-violation #f "no expressions in body" outer-form1426) (let ((e1441 (cdar body1434)) (er1442 (caar body1434))) (call-with-values (lambda () (syntax-type1117 e1441 er1442 (quote (())) #f ribcage1431 mod1429)) (lambda (type1443 value1444 e1445 w1446 s1447 mod1448) (let ((t1449 type1443)) (if (memv t1449 (quote (define-form))) (let ((id1450 (wrap1111 value1444 w1446 mod1448)) (label1451 (gen-label1088))) (let ((var1452 (gen-var1131 id1450))) (begin (extend-ribcage!1099 ribcage1431 id1450 label1451) (parse1433 (cdr body1434) (cons id1450 ids1435) (cons label1451 labels1436) (cons var1452 vars1437) (cons (cons er1442 (wrap1111 e1445 w1446 mod1448)) vals1438) (cons (cons (quote lexical) var1452) bindings1439))))) (if (memv t1449 (quote (define-syntax-form))) (let ((id1453 (wrap1111 value1444 w1446 mod1448)) (label1454 (gen-label1088))) (begin (extend-ribcage!1099 ribcage1431 id1453 label1454) (parse1433 (cdr body1434) (cons id1453 ids1435) (cons label1454 labels1436) vars1437 vals1438 (cons (cons (quote macro) (cons er1442 (wrap1111 e1445 w1446 mod1448))) bindings1439)))) (if (memv t1449 (quote (begin-form))) ((lambda (tmp1455) ((lambda (tmp1456) (if tmp1456 (apply (lambda (_1457 e11458) (parse1433 (let f1459 ((forms1460 e11458)) (if (null? forms1460) (cdr body1434) (cons (cons er1442 (wrap1111 (car forms1460) w1446 mod1448)) (f1459 (cdr forms1460))))) ids1435 labels1436 vars1437 vals1438 bindings1439)) tmp1456) (syntax-violation #f "source expression failed to match any pattern" tmp1455))) (syntax-dispatch tmp1455 (quote (any . each-any))))) e1445) (if (memv t1449 (quote (local-syntax-form))) (chi-local-syntax1125 value1444 e1445 er1442 w1446 s1447 mod1448 (lambda (forms1462 er1463 w1464 s1465 mod1466) (parse1433 (let f1467 ((forms1468 forms1462)) (if (null? forms1468) (cdr body1434) (cons (cons er1463 (wrap1111 (car forms1468) w1464 mod1466)) (f1467 (cdr forms1468))))) ids1435 labels1436 vars1437 vals1438 bindings1439))) (if (null? ids1435) (build-sequence1062 #f (map (lambda (x1469) (chi1119 (cdr x1469) (car x1469) (quote (())) mod1448)) (cons (cons er1442 (source-wrap1112 e1445 w1446 s1447 mod1448)) (cdr body1434)))) (begin (if (not (valid-bound-ids?1108 ids1435)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1426)) (let loop1470 ((bs1471 bindings1439) (er-cache1472 #f) (r-cache1473 #f)) (if (not (null? bs1471)) (let ((b1474 (car bs1471))) (if (eq? (car b1474) (quote macro)) (let ((er1475 (cadr b1474))) (let ((r-cache1476 (if (eq? er1475 er-cache1472) r-cache1473 (macros-only-env1079 er1475)))) (begin (set-cdr! b1474 (eval-local-transformer1126 (chi1119 (cddr b1474) r-cache1476 (quote (())) mod1448) mod1448)) (loop1470 (cdr bs1471) er1475 r-cache1476)))) (loop1470 (cdr bs1471) er-cache1472 r-cache1473))))) (set-cdr! r1430 (extend-env1077 labels1436 bindings1439 (cdr r1430))) (build-letrec1065 #f vars1437 (map (lambda (x1477) (chi1119 (cdr x1477) (car x1477) (quote (())) mod1448)) vals1438) (build-sequence1062 #f (map (lambda (x1478) (chi1119 (cdr x1478) (car x1478) (quote (())) mod1448)) (cons (cons er1442 (source-wrap1112 e1445 w1446 s1447 mod1448)) (cdr body1434)))))))))))))))))))))) (chi-macro1122 (lambda (p1479 e1480 r1481 w1482 rib1483 mod1484) (letrec ((rebuild-macro-output1485 (lambda (x1486 m1487) (cond ((pair? x1486) (cons (rebuild-macro-output1485 (car x1486) m1487) (rebuild-macro-output1485 (cdr x1486) m1487))) ((syntax-object?1067 x1486) (let ((w1488 (syntax-object-wrap1069 x1486))) (let ((ms1489 (wrap-marks1086 w1488)) (s1490 (wrap-subst1087 w1488))) (if (and (pair? ms1489) (eq? (car ms1489) #f)) (make-syntax-object1066 (syntax-object-expression1068 x1486) (make-wrap1085 (cdr ms1489) (if rib1483 (cons rib1483 (cdr s1490)) (cdr s1490))) (syntax-object-module1070 x1486)) (make-syntax-object1066 (syntax-object-expression1068 x1486) (make-wrap1085 (cons m1487 ms1489) (if rib1483 (cons rib1483 (cons (quote shift) s1490)) (cons (quote shift) s1490))) (let ((pmod1491 (procedure-module p1479))) (if pmod1491 (cons (quote hygiene) (module-name pmod1491)) (quote (hygiene guile))))))))) ((vector? x1486) (let ((n1492 (vector-length x1486))) (let ((v1493 (make-vector n1492))) (let doloop1494 ((i1495 0)) (if (fx=1052 i1495 n1492) v1493 (begin (vector-set! v1493 i1495 (rebuild-macro-output1485 (vector-ref x1486 i1495) m1487)) (doloop1494 (fx+1050 i1495 1)))))))) ((symbol? x1486) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1112 e1480 w1482 s mod1484) x1486)) (else x1486))))) (rebuild-macro-output1485 (p1479 (wrap1111 e1480 (anti-mark1098 w1482) mod1484)) (string #\m))))) (chi-application1121 (lambda (x1496 e1497 r1498 w1499 s1500 mod1501) ((lambda (tmp1502) ((lambda (tmp1503) (if tmp1503 (apply (lambda (e01504 e11505) (build-annotated1060 s1500 (cons x1496 (map (lambda (e1506) (chi1119 e1506 r1498 w1499 mod1501)) e11505)))) tmp1503) (syntax-violation #f "source expression failed to match any pattern" tmp1502))) (syntax-dispatch tmp1502 (quote (any . each-any))))) e1497))) (chi-expr1120 (lambda (type1508 value1509 e1510 r1511 w1512 s1513 mod1514) (let ((t1515 type1508)) (if (memv t1515 (quote (lexical))) (build-annotated1060 s1513 value1509) (if (memv t1515 (quote (core external-macro))) (value1509 e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (module-ref))) (call-with-values (lambda () (value1509 e1510)) (lambda (id1516 mod1517) (build-annotated1060 s1513 (if mod1517 (make-module-ref (cdr mod1517) id1516 (car mod1517)) (make-module-ref mod1517 id1516 (quote bare)))))) (if (memv t1515 (quote (lexical-call))) (chi-application1121 (build-annotated1060 (source-annotation1074 (car e1510)) value1509) e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (global-call))) (chi-application1121 (build-annotated1060 (source-annotation1074 (car e1510)) (if (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514) (make-module-ref (cdr (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514)) value1509 (car (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514))) (make-module-ref (if (syntax-object?1067 (car e1510)) (syntax-object-module1070 (car e1510)) mod1514) value1509 (quote bare)))) e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (constant))) (build-data1061 s1513 (strip1130 (source-wrap1112 e1510 w1512 s1513 mod1514) (quote (())))) (if (memv t1515 (quote (global))) (build-annotated1060 s1513 (if mod1514 (make-module-ref (cdr mod1514) value1509 (car mod1514)) (make-module-ref mod1514 value1509 (quote bare)))) (if (memv t1515 (quote (call))) (chi-application1121 (chi1119 (car e1510) r1511 w1512 mod1514) e1510 r1511 w1512 s1513 mod1514) (if (memv t1515 (quote (begin-form))) ((lambda (tmp1518) ((lambda (tmp1519) (if tmp1519 (apply (lambda (_1520 e11521 e21522) (chi-sequence1113 (cons e11521 e21522) r1511 w1512 s1513 mod1514)) tmp1519) (syntax-violation #f "source expression failed to match any pattern" tmp1518))) (syntax-dispatch tmp1518 (quote (any any . each-any))))) e1510) (if (memv t1515 (quote (local-syntax-form))) (chi-local-syntax1125 value1509 e1510 r1511 w1512 s1513 mod1514 chi-sequence1113) (if (memv t1515 (quote (eval-when-form))) ((lambda (tmp1524) ((lambda (tmp1525) (if tmp1525 (apply (lambda (_1526 x1527 e11528 e21529) (let ((when-list1530 (chi-when-list1116 e1510 x1527 w1512))) (if (memq (quote eval) when-list1530) (chi-sequence1113 (cons e11528 e21529) r1511 w1512 s1513 mod1514) (chi-void1127)))) tmp1525) (syntax-violation #f "source expression failed to match any pattern" tmp1524))) (syntax-dispatch tmp1524 (quote (any each-any any . each-any))))) e1510) (if (memv t1515 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1510 (wrap1111 value1509 w1512 mod1514)) (if (memv t1515 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1112 e1510 w1512 s1513 mod1514)) (if (memv t1515 (quote (displaced-lexical))) (syntax-violation #f (source-wrap1112 e1510 w1512 s1513 mod1514) "reference to identifier outside its scope") (syntax-violation #f "unexpected syntax" (source-wrap1112 e1510 w1512 s1513 mod1514))))))))))))))))))) (chi1119 (lambda (e1533 r1534 w1535 mod1536) (call-with-values (lambda () (syntax-type1117 e1533 r1534 w1535 #f #f mod1536)) (lambda (type1537 value1538 e1539 w1540 s1541 mod1542) (chi-expr1120 type1537 value1538 e1539 r1534 w1540 s1541 mod1542))))) (chi-top1118 (lambda (e1543 r1544 w1545 m1546 esew1547 mod1548) (call-with-values (lambda () (syntax-type1117 e1543 r1544 w1545 #f #f mod1548)) (lambda (type1556 value1557 e1558 w1559 s1560 mod1561) (let ((t1562 type1556)) (if (memv t1562 (quote (begin-form))) ((lambda (tmp1563) ((lambda (tmp1564) (if tmp1564 (apply (lambda (_1565) (chi-void1127)) tmp1564) ((lambda (tmp1566) (if tmp1566 (apply (lambda (_1567 e11568 e21569) (chi-top-sequence1114 (cons e11568 e21569) r1544 w1559 s1560 m1546 esew1547 mod1561)) tmp1566) (syntax-violation #f "source expression failed to match any pattern" tmp1563))) (syntax-dispatch tmp1563 (quote (any any . each-any)))))) (syntax-dispatch tmp1563 (quote (any))))) e1558) (if (memv t1562 (quote (local-syntax-form))) (chi-local-syntax1125 value1557 e1558 r1544 w1559 s1560 mod1561 (lambda (body1571 r1572 w1573 s1574 mod1575) (chi-top-sequence1114 body1571 r1572 w1573 s1574 m1546 esew1547 mod1575))) (if (memv t1562 (quote (eval-when-form))) ((lambda (tmp1576) ((lambda (tmp1577) (if tmp1577 (apply (lambda (_1578 x1579 e11580 e21581) (let ((when-list1582 (chi-when-list1116 e1558 x1579 w1559)) (body1583 (cons e11580 e21581))) (cond ((eq? m1546 (quote e)) (if (memq (quote eval) when-list1582) (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote e) (quote (eval)) mod1561) (chi-void1127))) ((memq (quote load) when-list1582) (if (or (memq (quote compile) when-list1582) (and (eq? m1546 (quote c&e)) (memq (quote eval) when-list1582))) (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote c&e) (quote (compile load)) mod1561) (if (memq m1546 (quote (c c&e))) (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote c) (quote (load)) mod1561) (chi-void1127)))) ((or (memq (quote compile) when-list1582) (and (eq? m1546 (quote c&e)) (memq (quote eval) when-list1582))) (top-level-eval-hook1054 (chi-top-sequence1114 body1583 r1544 w1559 s1560 (quote e) (quote (eval)) mod1561) mod1561) (chi-void1127)) (else (chi-void1127))))) tmp1577) (syntax-violation #f "source expression failed to match any pattern" tmp1576))) (syntax-dispatch tmp1576 (quote (any each-any any . each-any))))) e1558) (if (memv t1562 (quote (define-syntax-form))) (let ((n1586 (id-var-name1105 value1557 w1559)) (r1587 (macros-only-env1079 r1544))) (let ((t1588 m1546)) (if (memv t1588 (quote (c))) (if (memq (quote compile) esew1547) (let ((e1589 (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)))) (begin (top-level-eval-hook1054 e1589 mod1561) (if (memq (quote load) esew1547) e1589 (chi-void1127)))) (if (memq (quote load) esew1547) (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)) (chi-void1127))) (if (memv t1588 (quote (c&e))) (let ((e1590 (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)))) (begin (top-level-eval-hook1054 e1590 mod1561) e1590)) (begin (if (memq (quote eval) esew1547) (top-level-eval-hook1054 (chi-install-global1115 n1586 (chi1119 e1558 r1587 w1559 mod1561)) mod1561)) (chi-void1127)))))) (if (memv t1562 (quote (define-form))) (let ((n1591 (id-var-name1105 value1557 w1559))) (let ((type1592 (binding-type1075 (lookup1080 n1591 r1544 mod1561)))) (let ((t1593 type1592)) (if (memv t1593 (quote (global))) (let ((x1594 (build-annotated1060 s1560 (list (quote define) n1591 (chi1119 e1558 r1544 w1559 mod1561))))) (begin (if (eq? m1546 (quote c&e)) (top-level-eval-hook1054 x1594 mod1561)) x1594)) (if (memv t1593 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1558 (wrap1111 value1557 w1559 mod1561)) (if (memv t1593 (quote (core macro module-ref))) (begin (remove-global-definition-hook1058 n1591) (let ((x1595 (build-annotated1060 s1560 (list (quote define) n1591 (chi1119 e1558 r1544 w1559 mod1561))))) (begin (if (eq? m1546 (quote c&e)) (top-level-eval-hook1054 x1595 mod1561)) x1595))) (syntax-violation #f "cannot define keyword at top level" e1558 (wrap1111 value1557 w1559 mod1561)))))))) (let ((x1596 (chi-expr1120 type1556 value1557 e1558 r1544 w1559 s1560 mod1561))) (begin (if (eq? m1546 (quote c&e)) (top-level-eval-hook1054 x1596 mod1561)) x1596)))))))))))) (syntax-type1117 (lambda (e1597 r1598 w1599 s1600 rib1601 mod1602) (cond ((symbol? e1597) (let ((n1603 (id-var-name1105 e1597 w1599))) (let ((b1604 (lookup1080 n1603 r1598 mod1602))) (let ((type1605 (binding-type1075 b1604))) (let ((t1606 type1605)) (if (memv t1606 (quote (lexical))) (values type1605 (binding-value1076 b1604) e1597 w1599 s1600 mod1602) (if (memv t1606 (quote (global))) (values type1605 n1603 e1597 w1599 s1600 mod1602) (if (memv t1606 (quote (macro))) (syntax-type1117 (chi-macro1122 (binding-value1076 b1604) e1597 r1598 w1599 rib1601 mod1602) r1598 (quote (())) s1600 rib1601 mod1602) (values type1605 (binding-value1076 b1604) e1597 w1599 s1600 mod1602))))))))) ((pair? e1597) (let ((first1607 (car e1597))) (if (id?1083 first1607) (let ((n1608 (id-var-name1105 first1607 w1599))) (let ((b1609 (lookup1080 n1608 r1598 (or (and (syntax-object?1067 first1607) (syntax-object-module1070 first1607)) mod1602)))) (let ((type1610 (binding-type1075 b1609))) (let ((t1611 type1610)) (if (memv t1611 (quote (lexical))) (values (quote lexical-call) (binding-value1076 b1609) e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (global))) (values (quote global-call) n1608 e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (macro))) (syntax-type1117 (chi-macro1122 (binding-value1076 b1609) e1597 r1598 w1599 rib1601 mod1602) r1598 (quote (())) s1600 rib1601 mod1602) (if (memv t1611 (quote (core external-macro module-ref))) (values type1610 (binding-value1076 b1609) e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1076 b1609) e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (begin))) (values (quote begin-form) #f e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (eval-when))) (values (quote eval-when-form) #f e1597 w1599 s1600 mod1602) (if (memv t1611 (quote (define))) ((lambda (tmp1612) ((lambda (tmp1613) (if (if tmp1613 (apply (lambda (_1614 name1615 val1616) (id?1083 name1615)) tmp1613) #f) (apply (lambda (_1617 name1618 val1619) (values (quote define-form) name1618 val1619 w1599 s1600 mod1602)) tmp1613) ((lambda (tmp1620) (if (if tmp1620 (apply (lambda (_1621 name1622 args1623 e11624 e21625) (and (id?1083 name1622) (valid-bound-ids?1108 (lambda-var-list1132 args1623)))) tmp1620) #f) (apply (lambda (_1626 name1627 args1628 e11629 e21630) (values (quote define-form) (wrap1111 name1627 w1599 mod1602) (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1111 (cons args1628 (cons e11629 e21630)) w1599 mod1602)) (quote (())) s1600 mod1602)) tmp1620) ((lambda (tmp1632) (if (if tmp1632 (apply (lambda (_1633 name1634) (id?1083 name1634)) tmp1632) #f) (apply (lambda (_1635 name1636) (values (quote define-form) (wrap1111 name1636 w1599 mod1602) (quote (#(syntax-object void ((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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1600 mod1602)) tmp1632) (syntax-violation #f "source expression failed to match any pattern" tmp1612))) (syntax-dispatch tmp1612 (quote (any any)))))) (syntax-dispatch tmp1612 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1612 (quote (any any any))))) e1597) (if (memv t1611 (quote (define-syntax))) ((lambda (tmp1637) ((lambda (tmp1638) (if (if tmp1638 (apply (lambda (_1639 name1640 val1641) (id?1083 name1640)) tmp1638) #f) (apply (lambda (_1642 name1643 val1644) (values (quote define-syntax-form) name1643 val1644 w1599 s1600 mod1602)) tmp1638) (syntax-violation #f "source expression failed to match any pattern" tmp1637))) (syntax-dispatch tmp1637 (quote (any any any))))) e1597) (values (quote call) #f e1597 w1599 s1600 mod1602)))))))))))))) (values (quote call) #f e1597 w1599 s1600 mod1602)))) ((syntax-object?1067 e1597) (syntax-type1117 (syntax-object-expression1068 e1597) r1598 (join-wraps1102 w1599 (syntax-object-wrap1069 e1597)) #f rib1601 (or (syntax-object-module1070 e1597) mod1602))) ((annotation? e1597) (syntax-type1117 (annotation-expression e1597) r1598 w1599 (annotation-source e1597) rib1601 mod1602)) ((self-evaluating? e1597) (values (quote constant) #f e1597 w1599 s1600 mod1602)) (else (values (quote other) #f e1597 w1599 s1600 mod1602))))) (chi-when-list1116 (lambda (e1645 when-list1646 w1647) (let f1648 ((when-list1649 when-list1646) (situations1650 (quote ()))) (if (null? when-list1649) situations1650 (f1648 (cdr when-list1649) (cons (let ((x1651 (car when-list1649))) (cond ((free-id=?1106 x1651 (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?1106 x1651 (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?1106 x1651 (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e1645 (wrap1111 x1651 w1647 #f))))) situations1650)))))) (chi-install-global1115 (lambda (name1652 e1653) (build-annotated1060 #f (list (build-annotated1060 #f (quote install-global-transformer)) (build-data1061 #f name1652) e1653)))) (chi-top-sequence1114 (lambda (body1654 r1655 w1656 s1657 m1658 esew1659 mod1660) (build-sequence1062 s1657 (let dobody1661 ((body1662 body1654) (r1663 r1655) (w1664 w1656) (m1665 m1658) (esew1666 esew1659) (mod1667 mod1660)) (if (null? body1662) (quote ()) (let ((first1668 (chi-top1118 (car body1662) r1663 w1664 m1665 esew1666 mod1667))) (cons first1668 (dobody1661 (cdr body1662) r1663 w1664 m1665 esew1666 mod1667)))))))) (chi-sequence1113 (lambda (body1669 r1670 w1671 s1672 mod1673) (build-sequence1062 s1672 (let dobody1674 ((body1675 body1669) (r1676 r1670) (w1677 w1671) (mod1678 mod1673)) (if (null? body1675) (quote ()) (let ((first1679 (chi1119 (car body1675) r1676 w1677 mod1678))) (cons first1679 (dobody1674 (cdr body1675) r1676 w1677 mod1678)))))))) (source-wrap1112 (lambda (x1680 w1681 s1682 defmod1683) (wrap1111 (if s1682 (make-annotation x1680 s1682 #f) x1680) w1681 defmod1683))) (wrap1111 (lambda (x1684 w1685 defmod1686) (cond ((and (null? (wrap-marks1086 w1685)) (null? (wrap-subst1087 w1685))) x1684) ((syntax-object?1067 x1684) (make-syntax-object1066 (syntax-object-expression1068 x1684) (join-wraps1102 w1685 (syntax-object-wrap1069 x1684)) (syntax-object-module1070 x1684))) ((null? x1684) x1684) (else (make-syntax-object1066 x1684 w1685 defmod1686))))) (bound-id-member?1110 (lambda (x1687 list1688) (and (not (null? list1688)) (or (bound-id=?1107 x1687 (car list1688)) (bound-id-member?1110 x1687 (cdr list1688)))))) (distinct-bound-ids?1109 (lambda (ids1689) (let distinct?1690 ((ids1691 ids1689)) (or (null? ids1691) (and (not (bound-id-member?1110 (car ids1691) (cdr ids1691))) (distinct?1690 (cdr ids1691))))))) (valid-bound-ids?1108 (lambda (ids1692) (and (let all-ids?1693 ((ids1694 ids1692)) (or (null? ids1694) (and (id?1083 (car ids1694)) (all-ids?1693 (cdr ids1694))))) (distinct-bound-ids?1109 ids1692)))) (bound-id=?1107 (lambda (i1695 j1696) (if (and (syntax-object?1067 i1695) (syntax-object?1067 j1696)) (and (eq? (let ((e1697 (syntax-object-expression1068 i1695))) (if (annotation? e1697) (annotation-expression e1697) e1697)) (let ((e1698 (syntax-object-expression1068 j1696))) (if (annotation? e1698) (annotation-expression e1698) e1698))) (same-marks?1104 (wrap-marks1086 (syntax-object-wrap1069 i1695)) (wrap-marks1086 (syntax-object-wrap1069 j1696)))) (eq? (let ((e1699 i1695)) (if (annotation? e1699) (annotation-expression e1699) e1699)) (let ((e1700 j1696)) (if (annotation? e1700) (annotation-expression e1700) e1700)))))) (free-id=?1106 (lambda (i1701 j1702) (and (eq? (let ((x1703 i1701)) (let ((e1704 (if (syntax-object?1067 x1703) (syntax-object-expression1068 x1703) x1703))) (if (annotation? e1704) (annotation-expression e1704) e1704))) (let ((x1705 j1702)) (let ((e1706 (if (syntax-object?1067 x1705) (syntax-object-expression1068 x1705) x1705))) (if (annotation? e1706) (annotation-expression e1706) e1706)))) (eq? (id-var-name1105 i1701 (quote (()))) (id-var-name1105 j1702 (quote (()))))))) (id-var-name1105 (lambda (id1707 w1708) (letrec ((search-vector-rib1711 (lambda (sym1717 subst1718 marks1719 symnames1720 ribcage1721) (let ((n1722 (vector-length symnames1720))) (let f1723 ((i1724 0)) (cond ((fx=1052 i1724 n1722) (search1709 sym1717 (cdr subst1718) marks1719)) ((and (eq? (vector-ref symnames1720 i1724) sym1717) (same-marks?1104 marks1719 (vector-ref (ribcage-marks1093 ribcage1721) i1724))) (values (vector-ref (ribcage-labels1094 ribcage1721) i1724) marks1719)) (else (f1723 (fx+1050 i1724 1)))))))) (search-list-rib1710 (lambda (sym1725 subst1726 marks1727 symnames1728 ribcage1729) (let f1730 ((symnames1731 symnames1728) (i1732 0)) (cond ((null? symnames1731) (search1709 sym1725 (cdr subst1726) marks1727)) ((and (eq? (car symnames1731) sym1725) (same-marks?1104 marks1727 (list-ref (ribcage-marks1093 ribcage1729) i1732))) (values (list-ref (ribcage-labels1094 ribcage1729) i1732) marks1727)) (else (f1730 (cdr symnames1731) (fx+1050 i1732 1))))))) (search1709 (lambda (sym1733 subst1734 marks1735) (if (null? subst1734) (values #f marks1735) (let ((fst1736 (car subst1734))) (if (eq? fst1736 (quote shift)) (search1709 sym1733 (cdr subst1734) (cdr marks1735)) (let ((symnames1737 (ribcage-symnames1092 fst1736))) (if (vector? symnames1737) (search-vector-rib1711 sym1733 subst1734 marks1735 symnames1737 fst1736) (search-list-rib1710 sym1733 subst1734 marks1735 symnames1737 fst1736))))))))) (cond ((symbol? id1707) (or (call-with-values (lambda () (search1709 id1707 (wrap-subst1087 w1708) (wrap-marks1086 w1708))) (lambda (x1739 . ignore1738) x1739)) id1707)) ((syntax-object?1067 id1707) (let ((id1740 (let ((e1742 (syntax-object-expression1068 id1707))) (if (annotation? e1742) (annotation-expression e1742) e1742))) (w11741 (syntax-object-wrap1069 id1707))) (let ((marks1743 (join-marks1103 (wrap-marks1086 w1708) (wrap-marks1086 w11741)))) (call-with-values (lambda () (search1709 id1740 (wrap-subst1087 w1708) marks1743)) (lambda (new-id1744 marks1745) (or new-id1744 (call-with-values (lambda () (search1709 id1740 (wrap-subst1087 w11741) marks1745)) (lambda (x1747 . ignore1746) x1747)) id1740)))))) ((annotation? id1707) (let ((id1748 (let ((e1749 id1707)) (if (annotation? e1749) (annotation-expression e1749) e1749)))) (or (call-with-values (lambda () (search1709 id1748 (wrap-subst1087 w1708) (wrap-marks1086 w1708))) (lambda (x1751 . ignore1750) x1751)) id1748))) (else (error-hook1056 (quote id-var-name) "invalid id" id1707)))))) (same-marks?1104 (lambda (x1752 y1753) (or (eq? x1752 y1753) (and (not (null? x1752)) (not (null? y1753)) (eq? (car x1752) (car y1753)) (same-marks?1104 (cdr x1752) (cdr y1753)))))) (join-marks1103 (lambda (m11754 m21755) (smart-append1101 m11754 m21755))) (join-wraps1102 (lambda (w11756 w21757) (let ((m11758 (wrap-marks1086 w11756)) (s11759 (wrap-subst1087 w11756))) (if (null? m11758) (if (null? s11759) w21757 (make-wrap1085 (wrap-marks1086 w21757) (smart-append1101 s11759 (wrap-subst1087 w21757)))) (make-wrap1085 (smart-append1101 m11758 (wrap-marks1086 w21757)) (smart-append1101 s11759 (wrap-subst1087 w21757))))))) (smart-append1101 (lambda (m11760 m21761) (if (null? m21761) m11760 (append m11760 m21761)))) (make-binding-wrap1100 (lambda (ids1762 labels1763 w1764) (if (null? ids1762) w1764 (make-wrap1085 (wrap-marks1086 w1764) (cons (let ((labelvec1765 (list->vector labels1763))) (let ((n1766 (vector-length labelvec1765))) (let ((symnamevec1767 (make-vector n1766)) (marksvec1768 (make-vector n1766))) (begin (let f1769 ((ids1770 ids1762) (i1771 0)) (if (not (null? ids1770)) (call-with-values (lambda () (id-sym-name&marks1084 (car ids1770) w1764)) (lambda (symname1772 marks1773) (begin (vector-set! symnamevec1767 i1771 symname1772) (vector-set! marksvec1768 i1771 marks1773) (f1769 (cdr ids1770) (fx+1050 i1771 1))))))) (make-ribcage1090 symnamevec1767 marksvec1768 labelvec1765))))) (wrap-subst1087 w1764)))))) (extend-ribcage!1099 (lambda (ribcage1774 id1775 label1776) (begin (set-ribcage-symnames!1095 ribcage1774 (cons (let ((e1777 (syntax-object-expression1068 id1775))) (if (annotation? e1777) (annotation-expression e1777) e1777)) (ribcage-symnames1092 ribcage1774))) (set-ribcage-marks!1096 ribcage1774 (cons (wrap-marks1086 (syntax-object-wrap1069 id1775)) (ribcage-marks1093 ribcage1774))) (set-ribcage-labels!1097 ribcage1774 (cons label1776 (ribcage-labels1094 ribcage1774)))))) (anti-mark1098 (lambda (w1778) (make-wrap1085 (cons #f (wrap-marks1086 w1778)) (cons (quote shift) (wrap-subst1087 w1778))))) (set-ribcage-labels!1097 (lambda (x1779 update1780) (vector-set! x1779 3 update1780))) (set-ribcage-marks!1096 (lambda (x1781 update1782) (vector-set! x1781 2 update1782))) (set-ribcage-symnames!1095 (lambda (x1783 update1784) (vector-set! x1783 1 update1784))) (ribcage-labels1094 (lambda (x1785) (vector-ref x1785 3))) (ribcage-marks1093 (lambda (x1786) (vector-ref x1786 2))) (ribcage-symnames1092 (lambda (x1787) (vector-ref x1787 1))) (ribcage?1091 (lambda (x1788) (and (vector? x1788) (= (vector-length x1788) 4) (eq? (vector-ref x1788 0) (quote ribcage))))) (make-ribcage1090 (lambda (symnames1789 marks1790 labels1791) (vector (quote ribcage) symnames1789 marks1790 labels1791))) (gen-labels1089 (lambda (ls1792) (if (null? ls1792) (quote ()) (cons (gen-label1088) (gen-labels1089 (cdr ls1792)))))) (gen-label1088 (lambda () (string #\i))) (wrap-subst1087 cdr) (wrap-marks1086 car) (make-wrap1085 cons) (id-sym-name&marks1084 (lambda (x1793 w1794) (if (syntax-object?1067 x1793) (values (let ((e1795 (syntax-object-expression1068 x1793))) (if (annotation? e1795) (annotation-expression e1795) e1795)) (join-marks1103 (wrap-marks1086 w1794) (wrap-marks1086 (syntax-object-wrap1069 x1793)))) (values (let ((e1796 x1793)) (if (annotation? e1796) (annotation-expression e1796) e1796)) (wrap-marks1086 w1794))))) (id?1083 (lambda (x1797) (cond ((symbol? x1797) #t) ((syntax-object?1067 x1797) (symbol? (let ((e1798 (syntax-object-expression1068 x1797))) (if (annotation? e1798) (annotation-expression e1798) e1798)))) ((annotation? x1797) (symbol? (annotation-expression x1797))) (else #f)))) (nonsymbol-id?1082 (lambda (x1799) (and (syntax-object?1067 x1799) (symbol? (let ((e1800 (syntax-object-expression1068 x1799))) (if (annotation? e1800) (annotation-expression e1800) e1800)))))) (global-extend1081 (lambda (type1801 sym1802 val1803) (put-global-definition-hook1057 sym1802 type1801 val1803))) (lookup1080 (lambda (x1804 r1805 mod1806) (cond ((assq x1804 r1805) => cdr) ((symbol? x1804) (or (get-global-definition-hook1059 x1804 mod1806) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1079 (lambda (r1807) (if (null? r1807) (quote ()) (let ((a1808 (car r1807))) (if (eq? (cadr a1808) (quote macro)) (cons a1808 (macros-only-env1079 (cdr r1807))) (macros-only-env1079 (cdr r1807))))))) (extend-var-env1078 (lambda (labels1809 vars1810 r1811) (if (null? labels1809) r1811 (extend-var-env1078 (cdr labels1809) (cdr vars1810) (cons (cons (car labels1809) (cons (quote lexical) (car vars1810))) r1811))))) (extend-env1077 (lambda (labels1812 bindings1813 r1814) (if (null? labels1812) r1814 (extend-env1077 (cdr labels1812) (cdr bindings1813) (cons (cons (car labels1812) (car bindings1813)) r1814))))) (binding-value1076 cdr) (binding-type1075 car) (source-annotation1074 (lambda (x1815) (cond ((annotation? x1815) (annotation-source x1815)) ((syntax-object?1067 x1815) (source-annotation1074 (syntax-object-expression1068 x1815))) (else #f)))) (set-syntax-object-module!1073 (lambda (x1816 update1817) (vector-set! x1816 3 update1817))) (set-syntax-object-wrap!1072 (lambda (x1818 update1819) (vector-set! x1818 2 update1819))) (set-syntax-object-expression!1071 (lambda (x1820 update1821) (vector-set! x1820 1 update1821))) (syntax-object-module1070 (lambda (x1822) (vector-ref x1822 3))) (syntax-object-wrap1069 (lambda (x1823) (vector-ref x1823 2))) (syntax-object-expression1068 (lambda (x1824) (vector-ref x1824 1))) (syntax-object?1067 (lambda (x1825) (and (vector? x1825) (= (vector-length x1825) 4) (eq? (vector-ref x1825 0) (quote syntax-object))))) (make-syntax-object1066 (lambda (expression1826 wrap1827 module1828) (vector (quote syntax-object) expression1826 wrap1827 module1828))) (build-letrec1065 (lambda (src1829 vars1830 val-exps1831 body-exp1832) (if (null? vars1830) (build-annotated1060 src1829 body-exp1832) (build-annotated1060 src1829 (list (quote letrec) (map list vars1830 val-exps1831) body-exp1832))))) (build-named-let1064 (lambda (src1833 vars1834 val-exps1835 body-exp1836) (if (null? vars1834) (build-annotated1060 src1833 body-exp1836) (build-annotated1060 src1833 (list (quote let) (car vars1834) (map list (cdr vars1834) val-exps1835) body-exp1836))))) (build-let1063 (lambda (src1837 vars1838 val-exps1839 body-exp1840) (if (null? vars1838) (build-annotated1060 src1837 body-exp1840) (build-annotated1060 src1837 (list (quote let) (map list vars1838 val-exps1839) body-exp1840))))) (build-sequence1062 (lambda (src1841 exps1842) (if (null? (cdr exps1842)) (build-annotated1060 src1841 (car exps1842)) (build-annotated1060 src1841 (cons (quote begin) exps1842))))) (build-data1061 (lambda (src1843 exp1844) (if (and (self-evaluating? exp1844) (not (vector? exp1844))) (build-annotated1060 src1843 exp1844) (build-annotated1060 src1843 (list (quote quote) exp1844))))) (build-annotated1060 (lambda (src1845 exp1846) (if (and src1845 (not (annotation? exp1846))) (make-annotation exp1846 src1845 #t) exp1846))) (get-global-definition-hook1059 (lambda (symbol1847 module1848) (begin (if (and (not module1848) (current-module)) (warn "module system is booted, we should have a module" symbol1847)) (module-lookup-keyword (if module1848 (resolve-module (cdr module1848)) (current-module)) symbol1847)))) (remove-global-definition-hook1058 (lambda (symbol1849) (module-undefine-keyword! (current-module) symbol1849))) (put-global-definition-hook1057 (lambda (symbol1850 type1851 val1852) (module-define-keyword! (current-module) symbol1850 type1851 val1852))) (error-hook1056 (lambda (who1853 why1854 what1855) (error who1853 "~a ~s" why1854 what1855))) (local-eval-hook1055 (lambda (x1856 mod1857) (primitive-eval (list noexpand1049 x1856)))) (top-level-eval-hook1054 (lambda (x1858 mod1859) (primitive-eval (list noexpand1049 x1858)))) (fx<1053 <) (fx=1052 =) (fx-1051 -) (fx+1050 +) (noexpand1049 "noexpand")) (begin (global-extend1081 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1081 (quote local-syntax) (quote let-syntax) #f) (global-extend1081 (quote core) (quote fluid-let-syntax) (lambda (e1860 r1861 w1862 s1863 mod1864) ((lambda (tmp1865) ((lambda (tmp1866) (if (if tmp1866 (apply (lambda (_1867 var1868 val1869 e11870 e21871) (valid-bound-ids?1108 var1868)) tmp1866) #f) (apply (lambda (_1873 var1874 val1875 e11876 e21877) (let ((names1878 (map (lambda (x1879) (id-var-name1105 x1879 w1862)) var1874))) (begin (for-each (lambda (id1881 n1882) (let ((t1883 (binding-type1075 (lookup1080 n1882 r1861 mod1864)))) (if (memv t1883 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1860 (source-wrap1112 id1881 w1862 s1863 mod1864))))) var1874 names1878) (chi-body1123 (cons e11876 e21877) (source-wrap1112 e1860 w1862 s1863 mod1864) (extend-env1077 names1878 (let ((trans-r1886 (macros-only-env1079 r1861))) (map (lambda (x1887) (cons (quote macro) (eval-local-transformer1126 (chi1119 x1887 trans-r1886 w1862 mod1864) mod1864))) val1875)) r1861) w1862 mod1864)))) tmp1866) ((lambda (_1889) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1112 e1860 w1862 s1863 mod1864))) tmp1865))) (syntax-dispatch tmp1865 (quote (any #(each (any any)) any . each-any))))) e1860))) (global-extend1081 (quote core) (quote quote) (lambda (e1890 r1891 w1892 s1893 mod1894) ((lambda (tmp1895) ((lambda (tmp1896) (if tmp1896 (apply (lambda (_1897 e1898) (build-data1061 s1893 (strip1130 e1898 w1892))) tmp1896) ((lambda (_1899) (syntax-violation (quote quote) "bad syntax" (source-wrap1112 e1890 w1892 s1893 mod1894))) tmp1895))) (syntax-dispatch tmp1895 (quote (any any))))) e1890))) (global-extend1081 (quote core) (quote syntax) (letrec ((regen1907 (lambda (x1908) (let ((t1909 (car x1908))) (if (memv t1909 (quote (ref))) (build-annotated1060 #f (cadr x1908)) (if (memv t1909 (quote (primitive))) (build-annotated1060 #f (cadr x1908)) (if (memv t1909 (quote (quote))) (build-data1061 #f (cadr x1908)) (if (memv t1909 (quote (lambda))) (build-annotated1060 #f (list (quote lambda) (cadr x1908) (regen1907 (caddr x1908)))) (if (memv t1909 (quote (map))) (let ((ls1910 (map regen1907 (cdr x1908)))) (build-annotated1060 #f (cons (if (fx=1052 (length ls1910) 2) (build-annotated1060 #f (quote map)) (build-annotated1060 #f (quote map))) ls1910))) (build-annotated1060 #f (cons (build-annotated1060 #f (car x1908)) (map regen1907 (cdr x1908)))))))))))) (gen-vector1906 (lambda (x1911) (cond ((eq? (car x1911) (quote list)) (cons (quote vector) (cdr x1911))) ((eq? (car x1911) (quote quote)) (list (quote quote) (list->vector (cadr x1911)))) (else (list (quote list->vector) x1911))))) (gen-append1905 (lambda (x1912 y1913) (if (equal? y1913 (quote (quote ()))) x1912 (list (quote append) x1912 y1913)))) (gen-cons1904 (lambda (x1914 y1915) (let ((t1916 (car y1915))) (if (memv t1916 (quote (quote))) (if (eq? (car x1914) (quote quote)) (list (quote quote) (cons (cadr x1914) (cadr y1915))) (if (eq? (cadr y1915) (quote ())) (list (quote list) x1914) (list (quote cons) x1914 y1915))) (if (memv t1916 (quote (list))) (cons (quote list) (cons x1914 (cdr y1915))) (list (quote cons) x1914 y1915)))))) (gen-map1903 (lambda (e1917 map-env1918) (let ((formals1919 (map cdr map-env1918)) (actuals1920 (map (lambda (x1921) (list (quote ref) (car x1921))) map-env1918))) (cond ((eq? (car e1917) (quote ref)) (car actuals1920)) ((andmap (lambda (x1922) (and (eq? (car x1922) (quote ref)) (memq (cadr x1922) formals1919))) (cdr e1917)) (cons (quote map) (cons (list (quote primitive) (car e1917)) (map (let ((r1923 (map cons formals1919 actuals1920))) (lambda (x1924) (cdr (assq (cadr x1924) r1923)))) (cdr e1917))))) (else (cons (quote map) (cons (list (quote lambda) formals1919 e1917) actuals1920))))))) (gen-mappend1902 (lambda (e1925 map-env1926) (list (quote apply) (quote (primitive append)) (gen-map1903 e1925 map-env1926)))) (gen-ref1901 (lambda (src1927 var1928 level1929 maps1930) (if (fx=1052 level1929 0) (values var1928 maps1930) (if (null? maps1930) (syntax-violation (quote syntax) "missing ellipsis" src1927) (call-with-values (lambda () (gen-ref1901 src1927 var1928 (fx-1051 level1929 1) (cdr maps1930))) (lambda (outer-var1931 outer-maps1932) (let ((b1933 (assq outer-var1931 (car maps1930)))) (if b1933 (values (cdr b1933) maps1930) (let ((inner-var1934 (gen-var1131 (quote tmp)))) (values inner-var1934 (cons (cons (cons outer-var1931 inner-var1934) (car maps1930)) outer-maps1932))))))))))) (gen-syntax1900 (lambda (src1935 e1936 r1937 maps1938 ellipsis?1939 mod1940) (if (id?1083 e1936) (let ((label1941 (id-var-name1105 e1936 (quote (()))))) (let ((b1942 (lookup1080 label1941 r1937 mod1940))) (if (eq? (binding-type1075 b1942) (quote syntax)) (call-with-values (lambda () (let ((var.lev1943 (binding-value1076 b1942))) (gen-ref1901 src1935 (car var.lev1943) (cdr var.lev1943) maps1938))) (lambda (var1944 maps1945) (values (list (quote ref) var1944) maps1945))) (if (ellipsis?1939 e1936) (syntax-violation (quote syntax) "misplaced ellipsis" src1935) (values (list (quote quote) e1936) maps1938))))) ((lambda (tmp1946) ((lambda (tmp1947) (if (if tmp1947 (apply (lambda (dots1948 e1949) (ellipsis?1939 dots1948)) tmp1947) #f) (apply (lambda (dots1950 e1951) (gen-syntax1900 src1935 e1951 r1937 maps1938 (lambda (x1952) #f) mod1940)) tmp1947) ((lambda (tmp1953) (if (if tmp1953 (apply (lambda (x1954 dots1955 y1956) (ellipsis?1939 dots1955)) tmp1953) #f) (apply (lambda (x1957 dots1958 y1959) (let f1960 ((y1961 y1959) (k1962 (lambda (maps1963) (call-with-values (lambda () (gen-syntax1900 src1935 x1957 r1937 (cons (quote ()) maps1963) ellipsis?1939 mod1940)) (lambda (x1964 maps1965) (if (null? (car maps1965)) (syntax-violation (quote syntax) "extra ellipsis" src1935) (values (gen-map1903 x1964 (car maps1965)) (cdr maps1965)))))))) ((lambda (tmp1966) ((lambda (tmp1967) (if (if tmp1967 (apply (lambda (dots1968 y1969) (ellipsis?1939 dots1968)) tmp1967) #f) (apply (lambda (dots1970 y1971) (f1960 y1971 (lambda (maps1972) (call-with-values (lambda () (k1962 (cons (quote ()) maps1972))) (lambda (x1973 maps1974) (if (null? (car maps1974)) (syntax-violation (quote syntax) "extra ellipsis" src1935) (values (gen-mappend1902 x1973 (car maps1974)) (cdr maps1974)))))))) tmp1967) ((lambda (_1975) (call-with-values (lambda () (gen-syntax1900 src1935 y1961 r1937 maps1938 ellipsis?1939 mod1940)) (lambda (y1976 maps1977) (call-with-values (lambda () (k1962 maps1977)) (lambda (x1978 maps1979) (values (gen-append1905 x1978 y1976) maps1979)))))) tmp1966))) (syntax-dispatch tmp1966 (quote (any . any))))) y1961))) tmp1953) ((lambda (tmp1980) (if tmp1980 (apply (lambda (x1981 y1982) (call-with-values (lambda () (gen-syntax1900 src1935 x1981 r1937 maps1938 ellipsis?1939 mod1940)) (lambda (x1983 maps1984) (call-with-values (lambda () (gen-syntax1900 src1935 y1982 r1937 maps1984 ellipsis?1939 mod1940)) (lambda (y1985 maps1986) (values (gen-cons1904 x1983 y1985) maps1986)))))) tmp1980) ((lambda (tmp1987) (if tmp1987 (apply (lambda (e11988 e21989) (call-with-values (lambda () (gen-syntax1900 src1935 (cons e11988 e21989) r1937 maps1938 ellipsis?1939 mod1940)) (lambda (e1991 maps1992) (values (gen-vector1906 e1991) maps1992)))) tmp1987) ((lambda (_1993) (values (list (quote quote) e1936) maps1938)) tmp1946))) (syntax-dispatch tmp1946 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1946 (quote (any . any)))))) (syntax-dispatch tmp1946 (quote (any any . any)))))) (syntax-dispatch tmp1946 (quote (any any))))) e1936))))) (lambda (e1994 r1995 w1996 s1997 mod1998) (let ((e1999 (source-wrap1112 e1994 w1996 s1997 mod1998))) ((lambda (tmp2000) ((lambda (tmp2001) (if tmp2001 (apply (lambda (_2002 x2003) (call-with-values (lambda () (gen-syntax1900 e1999 x2003 r1995 (quote ()) ellipsis?1128 mod1998)) (lambda (e2004 maps2005) (regen1907 e2004)))) tmp2001) ((lambda (_2006) (syntax-violation (quote syntax) "bad `syntax' form" e1999)) tmp2000))) (syntax-dispatch tmp2000 (quote (any any))))) e1999))))) (global-extend1081 (quote core) (quote lambda) (lambda (e2007 r2008 w2009 s2010 mod2011) ((lambda (tmp2012) ((lambda (tmp2013) (if tmp2013 (apply (lambda (_2014 c2015) (chi-lambda-clause1124 (source-wrap1112 e2007 w2009 s2010 mod2011) #f c2015 r2008 w2009 mod2011 (lambda (vars2016 docstring2017 body2018) (build-annotated1060 s2010 (cons (quote lambda) (cons vars2016 (append (if docstring2017 (list docstring2017) (quote ())) (list body2018)))))))) tmp2013) (syntax-violation #f "source expression failed to match any pattern" tmp2012))) (syntax-dispatch tmp2012 (quote (any . any))))) e2007))) (global-extend1081 (quote core) (quote let) (letrec ((chi-let2019 (lambda (e2020 r2021 w2022 s2023 mod2024 constructor2025 ids2026 vals2027 exps2028) (if (not (valid-bound-ids?1108 ids2026)) (syntax-violation (quote let) "duplicate bound variable" e2020) (let ((labels2029 (gen-labels1089 ids2026)) (new-vars2030 (map gen-var1131 ids2026))) (let ((nw2031 (make-binding-wrap1100 ids2026 labels2029 w2022)) (nr2032 (extend-var-env1078 labels2029 new-vars2030 r2021))) (constructor2025 s2023 new-vars2030 (map (lambda (x2033) (chi1119 x2033 r2021 w2022 mod2024)) vals2027) (chi-body1123 exps2028 (source-wrap1112 e2020 nw2031 s2023 mod2024) nr2032 nw2031 mod2024)))))))) (lambda (e2034 r2035 w2036 s2037 mod2038) ((lambda (tmp2039) ((lambda (tmp2040) (if tmp2040 (apply (lambda (_2041 id2042 val2043 e12044 e22045) (chi-let2019 e2034 r2035 w2036 s2037 mod2038 build-let1063 id2042 val2043 (cons e12044 e22045))) tmp2040) ((lambda (tmp2049) (if (if tmp2049 (apply (lambda (_2050 f2051 id2052 val2053 e12054 e22055) (id?1083 f2051)) tmp2049) #f) (apply (lambda (_2056 f2057 id2058 val2059 e12060 e22061) (chi-let2019 e2034 r2035 w2036 s2037 mod2038 build-named-let1064 (cons f2057 id2058) val2059 (cons e12060 e22061))) tmp2049) ((lambda (_2065) (syntax-violation (quote let) "bad let" (source-wrap1112 e2034 w2036 s2037 mod2038))) tmp2039))) (syntax-dispatch tmp2039 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2039 (quote (any #(each (any any)) any . each-any))))) e2034)))) (global-extend1081 (quote core) (quote letrec) (lambda (e2066 r2067 w2068 s2069 mod2070) ((lambda (tmp2071) ((lambda (tmp2072) (if tmp2072 (apply (lambda (_2073 id2074 val2075 e12076 e22077) (let ((ids2078 id2074)) (if (not (valid-bound-ids?1108 ids2078)) (syntax-violation (quote letrec) "duplicate bound variable" e2066) (let ((labels2080 (gen-labels1089 ids2078)) (new-vars2081 (map gen-var1131 ids2078))) (let ((w2082 (make-binding-wrap1100 ids2078 labels2080 w2068)) (r2083 (extend-var-env1078 labels2080 new-vars2081 r2067))) (build-letrec1065 s2069 new-vars2081 (map (lambda (x2084) (chi1119 x2084 r2083 w2082 mod2070)) val2075) (chi-body1123 (cons e12076 e22077) (source-wrap1112 e2066 w2082 s2069 mod2070) r2083 w2082 mod2070))))))) tmp2072) ((lambda (_2087) (syntax-violation (quote letrec) "bad letrec" (source-wrap1112 e2066 w2068 s2069 mod2070))) tmp2071))) (syntax-dispatch tmp2071 (quote (any #(each (any any)) any . each-any))))) e2066))) (global-extend1081 (quote core) (quote set!) (lambda (e2088 r2089 w2090 s2091 mod2092) ((lambda (tmp2093) ((lambda (tmp2094) (if (if tmp2094 (apply (lambda (_2095 id2096 val2097) (id?1083 id2096)) tmp2094) #f) (apply (lambda (_2098 id2099 val2100) (let ((val2101 (chi1119 val2100 r2089 w2090 mod2092)) (n2102 (id-var-name1105 id2099 w2090))) (let ((b2103 (lookup1080 n2102 r2089 mod2092))) (let ((t2104 (binding-type1075 b2103))) (if (memv t2104 (quote (lexical))) (build-annotated1060 s2091 (list (quote set!) (binding-value1076 b2103) val2101)) (if (memv t2104 (quote (global))) (build-annotated1060 s2091 (list (quote set!) (if mod2092 (make-module-ref (cdr mod2092) n2102 (car mod2092)) (make-module-ref mod2092 n2102 (quote bare))) val2101)) (if (memv t2104 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1111 id2099 w2090 mod2092)) (syntax-violation (quote set!) "bad set!" (source-wrap1112 e2088 w2090 s2091 mod2092))))))))) tmp2094) ((lambda (tmp2105) (if tmp2105 (apply (lambda (_2106 head2107 tail2108 val2109) (call-with-values (lambda () (syntax-type1117 head2107 r2089 (quote (())) #f #f mod2092)) (lambda (type2110 value2111 ee2112 ww2113 ss2114 modmod2115) (let ((t2116 type2110)) (if (memv t2116 (quote (module-ref))) (let ((val2117 (chi1119 val2109 r2089 w2090 mod2092))) (call-with-values (lambda () (value2111 (cons head2107 tail2108))) (lambda (id2119 mod2120) (build-annotated1060 s2091 (list (quote set!) (if mod2120 (make-module-ref (cdr mod2120) id2119 (car mod2120)) (make-module-ref mod2120 id2119 (quote bare))) val2117))))) (build-annotated1060 s2091 (cons (chi1119 (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2107) r2089 w2090 mod2092) (map (lambda (e2121) (chi1119 e2121 r2089 w2090 mod2092)) (append tail2108 (list val2109)))))))))) tmp2105) ((lambda (_2123) (syntax-violation (quote set!) "bad set!" (source-wrap1112 e2088 w2090 s2091 mod2092))) tmp2093))) (syntax-dispatch tmp2093 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2093 (quote (any any any))))) e2088))) (global-extend1081 (quote module-ref) (quote @) (lambda (e2124) ((lambda (tmp2125) ((lambda (tmp2126) (if (if tmp2126 (apply (lambda (_2127 mod2128 id2129) (and (andmap id?1083 mod2128) (id?1083 id2129))) tmp2126) #f) (apply (lambda (_2131 mod2132 id2133) (values (syntax->datum id2133) (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2132)))) tmp2126) (syntax-violation #f "source expression failed to match any pattern" tmp2125))) (syntax-dispatch tmp2125 (quote (any each-any any))))) e2124))) (global-extend1081 (quote module-ref) (quote @@) (lambda (e2135) ((lambda (tmp2136) ((lambda (tmp2137) (if (if tmp2137 (apply (lambda (_2138 mod2139 id2140) (and (andmap id?1083 mod2139) (id?1083 id2140))) tmp2137) #f) (apply (lambda (_2142 mod2143 id2144) (values (syntax->datum id2144) (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2143)))) tmp2137) (syntax-violation #f "source expression failed to match any pattern" tmp2136))) (syntax-dispatch tmp2136 (quote (any each-any any))))) e2135))) (global-extend1081 (quote begin) (quote begin) (quote ())) (global-extend1081 (quote define) (quote define) (quote ())) (global-extend1081 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1081 (quote eval-when) (quote eval-when) (quote ())) (global-extend1081 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2149 (lambda (x2150 keys2151 clauses2152 r2153 mod2154) (if (null? clauses2152) (build-annotated1060 #f (list (build-annotated1060 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2150)) ((lambda (tmp2155) ((lambda (tmp2156) (if tmp2156 (apply (lambda (pat2157 exp2158) (if (and (id?1083 pat2157) (andmap (lambda (x2159) (not (free-id=?1106 pat2157 x2159))) (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 remove-global-definition-hook put-global-definition-hook gensym-hook error-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) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2151))) (let ((labels2160 (list (gen-label1088))) (var2161 (gen-var1131 pat2157))) (build-annotated1060 #f (list (build-annotated1060 #f (list (quote lambda) (list var2161) (chi1119 exp2158 (extend-env1077 labels2160 (list (cons (quote syntax) (cons var2161 0))) r2153) (make-binding-wrap1100 (list pat2157) labels2160 (quote (()))) mod2154))) x2150))) (gen-clause2148 x2150 keys2151 (cdr clauses2152) r2153 pat2157 #t exp2158 mod2154))) tmp2156) ((lambda (tmp2162) (if tmp2162 (apply (lambda (pat2163 fender2164 exp2165) (gen-clause2148 x2150 keys2151 (cdr clauses2152) r2153 pat2163 fender2164 exp2165 mod2154)) tmp2162) ((lambda (_2166) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2152))) tmp2155))) (syntax-dispatch tmp2155 (quote (any any any)))))) (syntax-dispatch tmp2155 (quote (any any))))) (car clauses2152))))) (gen-clause2148 (lambda (x2167 keys2168 clauses2169 r2170 pat2171 fender2172 exp2173 mod2174) (call-with-values (lambda () (convert-pattern2146 pat2171 keys2168)) (lambda (p2175 pvars2176) (cond ((not (distinct-bound-ids?1109 (map car pvars2176))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2171)) ((not (andmap (lambda (x2177) (not (ellipsis?1128 (car x2177)))) pvars2176)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2171)) (else (let ((y2178 (gen-var1131 (quote tmp)))) (build-annotated1060 #f (list (build-annotated1060 #f (list (quote lambda) (list y2178) (let ((y2179 (build-annotated1060 #f y2178))) (build-annotated1060 #f (list (quote if) ((lambda (tmp2180) ((lambda (tmp2181) (if tmp2181 (apply (lambda () y2179) tmp2181) ((lambda (_2182) (build-annotated1060 #f (list (quote if) y2179 (build-dispatch-call2147 pvars2176 fender2172 y2179 r2170 mod2174) (build-data1061 #f #f)))) tmp2180))) (syntax-dispatch tmp2180 (quote #(atom #t))))) fender2172) (build-dispatch-call2147 pvars2176 exp2173 y2179 r2170 mod2174) (gen-syntax-case2149 x2167 keys2168 clauses2169 r2170 mod2174)))))) (if (eq? p2175 (quote any)) (build-annotated1060 #f (list (build-annotated1060 #f (quote list)) x2167)) (build-annotated1060 #f (list (build-annotated1060 #f (quote syntax-dispatch)) x2167 (build-data1061 #f p2175))))))))))))) (build-dispatch-call2147 (lambda (pvars2183 exp2184 y2185 r2186 mod2187) (let ((ids2188 (map car pvars2183)) (levels2189 (map cdr pvars2183))) (let ((labels2190 (gen-labels1089 ids2188)) (new-vars2191 (map gen-var1131 ids2188))) (build-annotated1060 #f (list (build-annotated1060 #f (quote apply)) (build-annotated1060 #f (list (quote lambda) new-vars2191 (chi1119 exp2184 (extend-env1077 labels2190 (map (lambda (var2192 level2193) (cons (quote syntax) (cons var2192 level2193))) new-vars2191 (map cdr pvars2183)) r2186) (make-binding-wrap1100 ids2188 labels2190 (quote (()))) mod2187))) y2185)))))) (convert-pattern2146 (lambda (pattern2194 keys2195) (let cvt2196 ((p2197 pattern2194) (n2198 0) (ids2199 (quote ()))) (if (id?1083 p2197) (if (bound-id-member?1110 p2197 keys2195) (values (vector (quote free-id) p2197) ids2199) (values (quote any) (cons (cons p2197 n2198) ids2199))) ((lambda (tmp2200) ((lambda (tmp2201) (if (if tmp2201 (apply (lambda (x2202 dots2203) (ellipsis?1128 dots2203)) tmp2201) #f) (apply (lambda (x2204 dots2205) (call-with-values (lambda () (cvt2196 x2204 (fx+1050 n2198 1) ids2199)) (lambda (p2206 ids2207) (values (if (eq? p2206 (quote any)) (quote each-any) (vector (quote each) p2206)) ids2207)))) tmp2201) ((lambda (tmp2208) (if tmp2208 (apply (lambda (x2209 y2210) (call-with-values (lambda () (cvt2196 y2210 n2198 ids2199)) (lambda (y2211 ids2212) (call-with-values (lambda () (cvt2196 x2209 n2198 ids2212)) (lambda (x2213 ids2214) (values (cons x2213 y2211) ids2214)))))) tmp2208) ((lambda (tmp2215) (if tmp2215 (apply (lambda () (values (quote ()) ids2199)) tmp2215) ((lambda (tmp2216) (if tmp2216 (apply (lambda (x2217) (call-with-values (lambda () (cvt2196 x2217 n2198 ids2199)) (lambda (p2219 ids2220) (values (vector (quote vector) p2219) ids2220)))) tmp2216) ((lambda (x2221) (values (vector (quote atom) (strip1130 p2197 (quote (())))) ids2199)) tmp2200))) (syntax-dispatch tmp2200 (quote #(vector each-any)))))) (syntax-dispatch tmp2200 (quote ()))))) (syntax-dispatch tmp2200 (quote (any . any)))))) (syntax-dispatch tmp2200 (quote (any any))))) p2197)))))) (lambda (e2222 r2223 w2224 s2225 mod2226) (let ((e2227 (source-wrap1112 e2222 w2224 s2225 mod2226))) ((lambda (tmp2228) ((lambda (tmp2229) (if tmp2229 (apply (lambda (_2230 val2231 key2232 m2233) (if (andmap (lambda (x2234) (and (id?1083 x2234) (not (ellipsis?1128 x2234)))) key2232) (let ((x2236 (gen-var1131 (quote tmp)))) (build-annotated1060 s2225 (list (build-annotated1060 #f (list (quote lambda) (list x2236) (gen-syntax-case2149 (build-annotated1060 #f x2236) key2232 m2233 r2223 mod2226))) (chi1119 val2231 r2223 (quote (())) mod2226)))) (syntax-violation (quote syntax-case) "invalid literals list" e2227))) tmp2229) (syntax-violation #f "source expression failed to match any pattern" tmp2228))) (syntax-dispatch tmp2228 (quote (any any each-any . each-any))))) e2227))))) (set! sc-expand (let ((m2239 (quote e)) (esew2240 (quote (eval)))) (lambda (x2241) (if (and (pair? x2241) (equal? (car x2241) noexpand1049)) (cadr x2241) (chi-top1118 x2241 (quote ()) (quote ((top))) m2239 esew2240 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2242 (quote e)) (esew2243 (quote (eval)))) (lambda (x2245 . rest2244) (if (and (pair? x2245) (equal? (car x2245) noexpand1049)) (cadr x2245) (chi-top1118 x2245 (quote ()) (quote ((top))) (if (null? rest2244) m2242 (car rest2244)) (if (or (null? rest2244) (null? (cdr rest2244))) esew2243 (cadr rest2244)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2246) (nonsymbol-id?1082 x2246))) (set! datum->syntax (lambda (id2247 datum2248) (make-syntax-object1066 datum2248 (syntax-object-wrap1069 id2247) #f))) (set! syntax->datum (lambda (x2249) (strip1130 x2249 (quote (()))))) (set! generate-temporaries (lambda (ls2250) (begin (let ((x2251 ls2250)) (if (not (list? x2251)) (error-hook1056 (quote generate-temporaries) "invalid argument" x2251))) (map (lambda (x2252) (wrap1111 (gensym) (quote ((top))) #f)) ls2250)))) (set! free-identifier=? (lambda (x2253 y2254) (begin (let ((x2255 x2253)) (if (not (nonsymbol-id?1082 x2255)) (error-hook1056 (quote free-identifier=?) "invalid argument" x2255))) (let ((x2256 y2254)) (if (not (nonsymbol-id?1082 x2256)) (error-hook1056 (quote free-identifier=?) "invalid argument" x2256))) (free-id=?1106 x2253 y2254)))) (set! bound-identifier=? (lambda (x2257 y2258) (begin (let ((x2259 x2257)) (if (not (nonsymbol-id?1082 x2259)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2259))) (let ((x2260 y2258)) (if (not (nonsymbol-id?1082 x2260)) (error-hook1056 (quote bound-identifier=?) "invalid argument" x2260))) (bound-id=?1107 x2257 y2258)))) (set! syntax-violation (lambda (who2264 message2263 form2262 . subform2261) (begin (let ((x2265 who2264)) (if (not ((lambda (x2266) (or (not x2266) (string? x2266) (symbol? x2266))) x2265)) (error-hook1056 (quote syntax-violation) "invalid argument" x2265))) (let ((x2267 message2263)) (if (not (string? x2267)) (error-hook1056 (quote syntax-violation) "invalid argument" x2267))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2264 "~a: " "") "~a " (if (null? subform2261) "in ~a" "in subform `~s' of `~s'")) (let ((tail2268 (cons message2263 (map (lambda (x2269) (strip1130 x2269 (quote (())))) (append subform2261 (list form2262)))))) (if who2264 (cons who2264 tail2268) tail2268)) #f)))) (set! install-global-transformer (lambda (sym2270 v2271) (begin (let ((x2272 sym2270)) (if (not (symbol? x2272)) (error-hook1056 (quote define-syntax) "invalid argument" x2272))) (let ((x2273 v2271)) (if (not (procedure? x2273)) (error-hook1056 (quote define-syntax) "invalid argument" x2273))) (global-extend1081 (quote macro) sym2270 v2271)))) (letrec ((match2278 (lambda (e2279 p2280 w2281 r2282 mod2283) (cond ((not r2282) #f) ((eq? p2280 (quote any)) (cons (wrap1111 e2279 w2281 mod2283) r2282)) ((syntax-object?1067 e2279) (match*2277 (let ((e2284 (syntax-object-expression1068 e2279))) (if (annotation? e2284) (annotation-expression e2284) e2284)) p2280 (join-wraps1102 w2281 (syntax-object-wrap1069 e2279)) r2282 (syntax-object-module1070 e2279))) (else (match*2277 (let ((e2285 e2279)) (if (annotation? e2285) (annotation-expression e2285) e2285)) p2280 w2281 r2282 mod2283))))) (match*2277 (lambda (e2286 p2287 w2288 r2289 mod2290) (cond ((null? p2287) (and (null? e2286) r2289)) ((pair? p2287) (and (pair? e2286) (match2278 (car e2286) (car p2287) w2288 (match2278 (cdr e2286) (cdr p2287) w2288 r2289 mod2290) mod2290))) ((eq? p2287 (quote each-any)) (let ((l2291 (match-each-any2275 e2286 w2288 mod2290))) (and l2291 (cons l2291 r2289)))) (else (let ((t2292 (vector-ref p2287 0))) (if (memv t2292 (quote (each))) (if (null? e2286) (match-empty2276 (vector-ref p2287 1) r2289) (let ((l2293 (match-each2274 e2286 (vector-ref p2287 1) w2288 mod2290))) (and l2293 (let collect2294 ((l2295 l2293)) (if (null? (car l2295)) r2289 (cons (map car l2295) (collect2294 (map cdr l2295)))))))) (if (memv t2292 (quote (free-id))) (and (id?1083 e2286) (free-id=?1106 (wrap1111 e2286 w2288 mod2290) (vector-ref p2287 1)) r2289) (if (memv t2292 (quote (atom))) (and (equal? (vector-ref p2287 1) (strip1130 e2286 w2288)) r2289) (if (memv t2292 (quote (vector))) (and (vector? e2286) (match2278 (vector->list e2286) (vector-ref p2287 1) w2288 r2289 mod2290))))))))))) (match-empty2276 (lambda (p2296 r2297) (cond ((null? p2296) r2297) ((eq? p2296 (quote any)) (cons (quote ()) r2297)) ((pair? p2296) (match-empty2276 (car p2296) (match-empty2276 (cdr p2296) r2297))) ((eq? p2296 (quote each-any)) (cons (quote ()) r2297)) (else (let ((t2298 (vector-ref p2296 0))) (if (memv t2298 (quote (each))) (match-empty2276 (vector-ref p2296 1) r2297) (if (memv t2298 (quote (free-id atom))) r2297 (if (memv t2298 (quote (vector))) (match-empty2276 (vector-ref p2296 1) r2297))))))))) (match-each-any2275 (lambda (e2299 w2300 mod2301) (cond ((annotation? e2299) (match-each-any2275 (annotation-expression e2299) w2300 mod2301)) ((pair? e2299) (let ((l2302 (match-each-any2275 (cdr e2299) w2300 mod2301))) (and l2302 (cons (wrap1111 (car e2299) w2300 mod2301) l2302)))) ((null? e2299) (quote ())) ((syntax-object?1067 e2299) (match-each-any2275 (syntax-object-expression1068 e2299) (join-wraps1102 w2300 (syntax-object-wrap1069 e2299)) mod2301)) (else #f)))) (match-each2274 (lambda (e2303 p2304 w2305 mod2306) (cond ((annotation? e2303) (match-each2274 (annotation-expression e2303) p2304 w2305 mod2306)) ((pair? e2303) (let ((first2307 (match2278 (car e2303) p2304 w2305 (quote ()) mod2306))) (and first2307 (let ((rest2308 (match-each2274 (cdr e2303) p2304 w2305 mod2306))) (and rest2308 (cons first2307 rest2308)))))) ((null? e2303) (quote ())) ((syntax-object?1067 e2303) (match-each2274 (syntax-object-expression1068 e2303) p2304 (join-wraps1102 w2305 (syntax-object-wrap1069 e2303)) (syntax-object-module1070 e2303))) (else #f))))) (set! syntax-dispatch (lambda (e2309 p2310) (cond ((eq? p2310 (quote any)) (list e2309)) ((syntax-object?1067 e2309) (match*2277 (let ((e2311 (syntax-object-expression1068 e2309))) (if (annotation? e2311) (annotation-expression e2311) e2311)) p2310 (syntax-object-wrap1069 e2309) (quote ()) (syntax-object-module1070 e2309))) (else (match*2277 (let ((e2312 e2309)) (if (annotation? e2312) (annotation-expression e2312) e2312)) p2310 (quote (())) (quote ()) #f)))))))) +(install-global-transformer (quote with-syntax) (lambda (x2313) ((lambda (tmp2314) ((lambda (tmp2315) (if tmp2315 (apply (lambda (_2316 e12317 e22318) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12317 e22318))) tmp2315) ((lambda (tmp2320) (if tmp2320 (apply (lambda (_2321 out2322 in2323 e12324 e22325) (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))) in2323 (quote ()) (list out2322 (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 e12324 e22325))))) tmp2320) ((lambda (tmp2327) (if tmp2327 (apply (lambda (_2328 out2329 in2330 e12331 e22332) (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))) in2330) (quote ()) (list out2329 (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 e12331 e22332))))) tmp2327) (syntax-violation #f "source expression failed to match any pattern" tmp2314))) (syntax-dispatch tmp2314 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2314 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2314 (quote (any () any . each-any))))) x2313))) +(install-global-transformer (quote syntax-rules) (lambda (x2336) ((lambda (tmp2337) ((lambda (tmp2338) (if tmp2338 (apply (lambda (_2339 k2340 keyword2341 pattern2342 template2343) (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 k2340 (map (lambda (tmp2346 tmp2345) (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))) tmp2345) (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))) tmp2346))) template2343 pattern2342)))))) tmp2338) (syntax-violation #f "source expression failed to match any pattern" tmp2337))) (syntax-dispatch tmp2337 (quote (any each-any . #(each ((any . any) any))))))) x2336))) +(install-global-transformer (quote let*) (lambda (x2347) ((lambda (tmp2348) ((lambda (tmp2349) (if (if tmp2349 (apply (lambda (let*2350 x2351 v2352 e12353 e22354) (andmap identifier? x2351)) tmp2349) #f) (apply (lambda (let*2356 x2357 v2358 e12359 e22360) (let f2361 ((bindings2362 (map list x2357 v2358))) (if (null? bindings2362) (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 e12359 e22360))) ((lambda (tmp2366) ((lambda (tmp2367) (if tmp2367 (apply (lambda (body2368 binding2369) (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 binding2369) body2368)) tmp2367) (syntax-violation #f "source expression failed to match any pattern" tmp2366))) (syntax-dispatch tmp2366 (quote (any any))))) (list (f2361 (cdr bindings2362)) (car bindings2362)))))) tmp2349) (syntax-violation #f "source expression failed to match any pattern" tmp2348))) (syntax-dispatch tmp2348 (quote (any #(each (any any)) any . each-any))))) x2347))) +(install-global-transformer (quote do) (lambda (orig-x2370) ((lambda (tmp2371) ((lambda (tmp2372) (if tmp2372 (apply (lambda (_2373 var2374 init2375 step2376 e02377 e12378 c2379) ((lambda (tmp2380) ((lambda (tmp2381) (if tmp2381 (apply (lambda (step2382) ((lambda (tmp2383) ((lambda (tmp2384) (if tmp2384 (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 var2374 init2375) (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))) e02377) (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 c2379 (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))) step2382))))))) tmp2384) ((lambda (tmp2389) (if tmp2389 (apply (lambda (e12390 e22391) (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 var2374 init2375) (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))) e02377 (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 e12390 e22391)) (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 c2379 (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))) step2382))))))) tmp2389) (syntax-violation #f "source expression failed to match any pattern" tmp2383))) (syntax-dispatch tmp2383 (quote (any . each-any)))))) (syntax-dispatch tmp2383 (quote ())))) e12378)) tmp2381) (syntax-violation #f "source expression failed to match any pattern" tmp2380))) (syntax-dispatch tmp2380 (quote each-any)))) (map (lambda (v2398 s2399) ((lambda (tmp2400) ((lambda (tmp2401) (if tmp2401 (apply (lambda () v2398) tmp2401) ((lambda (tmp2402) (if tmp2402 (apply (lambda (e2403) e2403) tmp2402) ((lambda (_2404) (syntax-violation (quote do) "bad step expression" orig-x2370 s2399)) tmp2400))) (syntax-dispatch tmp2400 (quote (any)))))) (syntax-dispatch tmp2400 (quote ())))) s2399)) var2374 step2376))) tmp2372) (syntax-violation #f "source expression failed to match any pattern" tmp2371))) (syntax-dispatch tmp2371 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2370))) +(install-global-transformer (quote quasiquote) (letrec ((quasicons2407 (lambda (x2411 y2412) ((lambda (tmp2413) ((lambda (tmp2414) (if tmp2414 (apply (lambda (x2415 y2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (apply (lambda (dy2419) ((lambda (tmp2420) ((lambda (tmp2421) (if tmp2421 (apply (lambda (dx2422) (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 dx2422 dy2419))) tmp2421) ((lambda (_2423) (if (null? dy2419) (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))) x2415) (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))) x2415 y2416))) tmp2420))) (syntax-dispatch tmp2420 (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))))) x2415)) tmp2418) ((lambda (tmp2424) (if tmp2424 (apply (lambda (stuff2425) (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 x2415 stuff2425))) tmp2424) ((lambda (else2426) (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))) x2415 y2416)) tmp2417))) (syntax-dispatch tmp2417 (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)))))) (syntax-dispatch tmp2417 (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))))) y2416)) tmp2414) (syntax-violation #f "source expression failed to match any pattern" tmp2413))) (syntax-dispatch tmp2413 (quote (any any))))) (list x2411 y2412)))) (quasiappend2408 (lambda (x2427 y2428) ((lambda (tmp2429) ((lambda (tmp2430) (if tmp2430 (apply (lambda (x2431 y2432) ((lambda (tmp2433) ((lambda (tmp2434) (if tmp2434 (apply (lambda () x2431) tmp2434) ((lambda (_2435) (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))) x2431 y2432)) tmp2433))) (syntax-dispatch tmp2433 (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))) ()))))) y2432)) tmp2430) (syntax-violation #f "source expression failed to match any pattern" tmp2429))) (syntax-dispatch tmp2429 (quote (any any))))) (list x2427 y2428)))) (quasivector2409 (lambda (x2436) ((lambda (tmp2437) ((lambda (x2438) ((lambda (tmp2439) ((lambda (tmp2440) (if tmp2440 (apply (lambda (x2441) (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 x2441))) tmp2440) ((lambda (tmp2443) (if tmp2443 (apply (lambda (x2444) (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))) x2444)) tmp2443) ((lambda (_2446) (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))) x2438)) tmp2439))) (syntax-dispatch tmp2439 (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)))))) (syntax-dispatch tmp2439 (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))))) x2438)) tmp2437)) x2436))) (quasi2410 (lambda (p2447 lev2448) ((lambda (tmp2449) ((lambda (tmp2450) (if tmp2450 (apply (lambda (p2451) (if (= lev2448 0) p2451 (quasicons2407 (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)))) (quasi2410 (list p2451) (- lev2448 1))))) tmp2450) ((lambda (tmp2452) (if tmp2452 (apply (lambda (p2453 q2454) (if (= lev2448 0) (quasiappend2408 p2453 (quasi2410 q2454 lev2448)) (quasicons2407 (quasicons2407 (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)))) (quasi2410 (list p2453) (- lev2448 1))) (quasi2410 q2454 lev2448)))) tmp2452) ((lambda (tmp2455) (if tmp2455 (apply (lambda (p2456) (quasicons2407 (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)))) (quasi2410 (list p2456) (+ lev2448 1)))) tmp2455) ((lambda (tmp2457) (if tmp2457 (apply (lambda (p2458 q2459) (quasicons2407 (quasi2410 p2458 lev2448) (quasi2410 q2459 lev2448))) tmp2457) ((lambda (tmp2460) (if tmp2460 (apply (lambda (x2461) (quasivector2409 (quasi2410 x2461 lev2448))) tmp2460) ((lambda (p2463) (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))) p2463)) tmp2449))) (syntax-dispatch tmp2449 (quote #(vector each-any)))))) (syntax-dispatch tmp2449 (quote (any . any)))))) (syntax-dispatch tmp2449 (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)))))) (syntax-dispatch tmp2449 (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)))))) (syntax-dispatch tmp2449 (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))))) p2447)))) (lambda (x2464) ((lambda (tmp2465) ((lambda (tmp2466) (if tmp2466 (apply (lambda (_2467 e2468) (quasi2410 e2468 0)) tmp2466) (syntax-violation #f "source expression failed to match any pattern" tmp2465))) (syntax-dispatch tmp2465 (quote (any any))))) x2464)))) +(install-global-transformer (quote include) (lambda (x2469) (letrec ((read-file2470 (lambda (fn2471 k2472) (let ((p2473 (open-input-file fn2471))) (let f2474 ((x2475 (read p2473))) (if (eof-object? x2475) (begin (close-input-port p2473) (quote ())) (cons (datum->syntax k2472 x2475) (f2474 (read p2473))))))))) ((lambda (tmp2476) ((lambda (tmp2477) (if tmp2477 (apply (lambda (k2478 filename2479) (let ((fn2480 (syntax->datum filename2479))) ((lambda (tmp2481) ((lambda (tmp2482) (if tmp2482 (apply (lambda (exp2483) (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))) exp2483)) tmp2482) (syntax-violation #f "source expression failed to match any pattern" tmp2481))) (syntax-dispatch tmp2481 (quote each-any)))) (read-file2470 fn2480 k2478)))) tmp2477) (syntax-violation #f "source expression failed to match any pattern" tmp2476))) (syntax-dispatch tmp2476 (quote (any any))))) x2469)))) +(install-global-transformer (quote unquote) (lambda (x2485) ((lambda (tmp2486) ((lambda (tmp2487) (if tmp2487 (apply (lambda (_2488 e2489) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum e2489))) tmp2487) (syntax-violation #f "source expression failed to match any pattern" tmp2486))) (syntax-dispatch tmp2486 (quote (any any))))) x2485))) +(install-global-transformer (quote unquote-splicing) (lambda (x2490) ((lambda (tmp2491) ((lambda (tmp2492) (if tmp2492 (apply (lambda (_2493 e2494) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax->datum e2494))) tmp2492) (syntax-violation #f "source expression failed to match any pattern" tmp2491))) (syntax-dispatch tmp2491 (quote (any any))))) x2490))) +(install-global-transformer (quote case) (lambda (x2495) ((lambda (tmp2496) ((lambda (tmp2497) (if tmp2497 (apply (lambda (_2498 e2499 m12500 m22501) ((lambda (tmp2502) ((lambda (body2503) (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))) e2499)) body2503)) tmp2502)) (let f2504 ((clause2505 m12500) (clauses2506 m22501)) (if (null? clauses2506) ((lambda (tmp2508) ((lambda (tmp2509) (if tmp2509 (apply (lambda (e12510 e22511) (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 e12510 e22511))) tmp2509) ((lambda (tmp2513) (if tmp2513 (apply (lambda (k2514 e12515 e22516) (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))) k2514)) (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 e12515 e22516)))) tmp2513) ((lambda (_2519) (syntax-violation (quote case) "bad clause" x2495 clause2505)) tmp2508))) (syntax-dispatch tmp2508 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2508 (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))))) clause2505) ((lambda (tmp2520) ((lambda (rest2521) ((lambda (tmp2522) ((lambda (tmp2523) (if tmp2523 (apply (lambda (k2524 e12525 e22526) (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))) k2524)) (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 e12525 e22526)) rest2521)) tmp2523) ((lambda (_2529) (syntax-violation (quote case) "bad clause" x2495 clause2505)) tmp2522))) (syntax-dispatch tmp2522 (quote (each-any any . each-any))))) clause2505)) tmp2520)) (f2504 (car clauses2506) (cdr clauses2506))))))) tmp2497) (syntax-violation #f "source expression failed to match any pattern" tmp2496))) (syntax-dispatch tmp2496 (quote (any any any . each-any))))) x2495))) +(install-global-transformer (quote identifier-syntax) (lambda (x2530) ((lambda (tmp2531) ((lambda (tmp2532) (if tmp2532 (apply (lambda (_2533 e2534) (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))) e2534)) (list (cons _2533 (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 e2534 (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)))))))))) tmp2532) (syntax-violation #f "source expression failed to match any pattern" tmp2531))) (syntax-dispatch tmp2531 (quote (any any))))) x2530))) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 89701bc19..347a776ee 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -49,7 +49,7 @@ ;;; also documented in the R4RS and draft R5RS. ;;; ;;; bound-identifier=? -;;; datum->syntax-object +;;; datum->syntax ;;; define-syntax ;;; fluid-let-syntax ;;; free-identifier=? @@ -60,7 +60,7 @@ ;;; letrec-syntax ;;; syntax ;;; syntax-case -;;; syntax-object->datum +;;; syntax->datum ;;; syntax-rules ;;; with-syntax ;;; @@ -209,7 +209,7 @@ ;;; Objects with no standard print syntax, including objects containing ;;; cycles and syntax object, are allowed in quoted data as long as they -;;; are contained within a syntax form or produced by datum->syntax-object. +;;; are contained within a syntax form or produced by datum->syntax. ;;; Such objects are never copied. ;;; All identifiers that don't have macro definitions and are not bound @@ -264,14 +264,14 @@ (lambda (x) (define construct-name (lambda (template-identifier . args) - (datum->syntax-object + (datum->syntax template-identifier (string->symbol (apply string-append (map (lambda (x) (if (string? x) x - (symbol->string (syntax-object->datum x)))) + (symbol->string (syntax->datum x)))) args)))))) (syntax-case x () ((_ (name id1 ...)) @@ -1351,7 +1351,7 @@ (lambda (e docstring c r w mod k) (syntax-case c () ((args doc e1 e2 ...) - (and (string? (syntax-object->datum (syntax doc))) (not docstring)) + (and (string? (syntax->datum (syntax doc))) (not docstring)) (chi-lambda-clause e (syntax doc) (syntax (args e1 e2 ...)) r w mod k)) (((id ...) e1 e2 ...) (let ((ids (syntax (id ...)))) @@ -1814,8 +1814,8 @@ (syntax-case e () ((_ (mod ...) id) (and (andmap id? (syntax (mod ...))) (id? (syntax id))) - (values (syntax-object->datum (syntax id)) - (syntax-object->datum + (values (syntax->datum (syntax id)) + (syntax->datum (syntax (public mod ...)))))))) (global-extend 'module-ref '@@ @@ -1823,8 +1823,8 @@ (syntax-case e () ((_ (mod ...) id) (and (andmap id? (syntax (mod ...))) (id? (syntax id))) - (values (syntax-object->datum (syntax id)) - (syntax-object->datum + (values (syntax->datum (syntax id)) + (syntax->datum (syntax (private mod ...)))))))) (global-extend 'begin 'begin '()) @@ -2004,11 +2004,11 @@ (lambda (x) (nonsymbol-id? x))) -(set! datum->syntax-object +(set! datum->syntax (lambda (id datum) (make-syntax-object datum (syntax-object-wrap id) #f))) -(set! syntax-object->datum +(set! syntax->datum ; accepts any object, since syntax objects may consist partially ; or entirely of unwrapped, nonsymbolic data (lambda (x) @@ -2292,11 +2292,11 @@ (let f ((x (read p))) (if (eof-object? x) (begin (close-input-port p) '()) - (cons (datum->syntax-object k x) + (cons (datum->syntax k x) (f (read p)))))))) (syntax-case x () ((k filename) - (let ((fn (syntax-object->datum (syntax filename)))) + (let ((fn (syntax->datum (syntax filename)))) (with-syntax (((exp ...) (read-file fn (syntax k)))) (syntax (begin exp ...)))))))) @@ -2306,7 +2306,7 @@ ((_ e) (error 'unquote "expression ,~s not valid outside of quasiquote" - (syntax-object->datum (syntax e))))))) + (syntax->datum (syntax e))))))) (define-syntax unquote-splicing (lambda (x) @@ -2314,7 +2314,7 @@ ((_ e) (error 'unquote-splicing "expression ,@~s not valid outside of quasiquote" - (syntax-object->datum (syntax e))))))) + (syntax->datum (syntax e))))))) (define-syntax case (lambda (x) diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 873e4b831..f84af33fc 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -241,8 +241,8 @@ (lambda (x) (syntax-case x () ((_ (k arg rest ...) out ...) - (keyword? (syntax-object->datum (syntax k))) - (case (syntax-object->datum (syntax k)) + (keyword? (syntax->datum (syntax k))) + (case (syntax->datum (syntax k)) ((#:getter #:setter) (syntax (define-class-pre-definition (rest ...) @@ -277,7 +277,7 @@ ((_ () out ...) (syntax (begin out ...))) ((_ (slot rest ...) out ...) - (keyword? (syntax-object->datum (syntax slot))) + (keyword? (syntax->datum (syntax slot))) (syntax (begin out ...))) ((_ (slot rest ...) out ...) (identifier? (syntax slot))