(define (provided? feature)
(and (memq feature *features*) #t))
+\f
+
+;;; {and-map and or-map}
+;;;
+;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
+;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...)
+;;;
+
+;; and-map f l
+;;
+;; Apply f to successive elements of l until exhaustion or f returns #f.
+;; If returning early, return #f. Otherwise, return the last value returned
+;; by f. If f has never been called because l is empty, return #t.
+;;
+(define (and-map f lst)
+ (let loop ((result #t)
+ (l lst))
+ (and result
+ (or (and (null? l)
+ result)
+ (loop (f (car l)) (cdr l))))))
+
+;; or-map f l
+;;
+;; Apply f to successive elements of l until exhaustion or while f returns #f.
+;; If returning early, return the return value of f.
+;;
+(define (or-map f lst)
+ (let loop ((result #f)
+ (l lst))
+ (or result
+ (and (not (null? l))
+ (loop (f (car l)) (cdr l))))))
+
+\f
+
;; let format alias simple-format until the more complete version is loaded
(define format simple-format)
;;; Useless crap I'd like to get rid of
(define (annotation? x) #f)
-
-(define andmap
- (lambda (f first . rest)
- (or (null? first)
- (if (null? rest)
- (let andmap ((first first))
- (let ((x (car first)) (first (cdr first)))
- (if (null? first)
- (f x)
- (and (f x) (andmap first)))))
- (let andmap ((first first) (rest rest))
- (let ((x (car first))
- (xr (map car rest))
- (first (cdr first))
- (rest (map cdr rest)))
- (if (null? first)
- (apply f (cons x xr))
- (and (apply f (cons x xr)) (andmap first rest)))))))))
-
(primitive-load-path "ice-9/psyntax-pp")
;; Until the module system is booted, this will be the current expander.
\f
-;;; {and-map and or-map}
-;;;
-;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
-;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...)
-;;;
-
-;; and-map f l
-;;
-;; Apply f to successive elements of l until exhaustion or f returns #f.
-;; If returning early, return #f. Otherwise, return the last value returned
-;; by f. If f has never been called because l is empty, return #t.
-;;
-(define (and-map f lst)
- (let loop ((result #t)
- (l lst))
- (and result
- (or (and (null? l)
- result)
- (loop (f (car l)) (cdr l))))))
-
-;; or-map f l
-;;
-;; Apply f to successive elements of l until exhaustion or while f returns #f.
-;; If returning early, return the return value of f.
-;;
-(define (or-map f lst)
- (let loop ((result #f)
- (l lst))
- (or result
- (and (not (null? l))
- (loop (f (car l)) (cdr l))))))
-
-\f
-
(if (provided? 'posix)
(primitive-load-path "ice-9/posix"))
-(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
-(void)
-(letrec ((lambda-var-list1261 (lambda (vars1466) (let lvl1467 ((vars1468 vars1466) (ls1469 (quote ())) (w1470 (quote (())))) (cond ((pair? vars1468) (lvl1467 (cdr vars1468) (cons (wrap1240 (car vars1468) w1470 #f) ls1469) w1470)) ((id?1212 vars1468) (cons (wrap1240 vars1468 w1470 #f) ls1469)) ((null? vars1468) ls1469) ((syntax-object?1196 vars1468) (lvl1467 (syntax-object-expression1197 vars1468) ls1469 (join-wraps1231 w1470 (syntax-object-wrap1198 vars1468)))) ((annotation? vars1468) (lvl1467 (annotation-expression vars1468) ls1469 w1470)) (else (cons vars1468 ls1469)))))) (gen-var1260 (lambda (id1471) (let ((id1472 (if (syntax-object?1196 id1471) (syntax-object-expression1197 id1471) id1471))) (if (annotation? id1472) (build-annotated1189 (annotation-source id1472) (gensym (symbol->string (annotation-expression id1472)))) (build-annotated1189 #f (gensym (symbol->string id1472))))))) (strip1259 (lambda (x1473 w1474) (if (memq (quote top) (wrap-marks1215 w1474)) (if (or (annotation? x1473) (and (pair? x1473) (annotation? (car x1473)))) (strip-annotation1258 x1473 #f) x1473) (let f1475 ((x1476 x1473)) (cond ((syntax-object?1196 x1476) (strip1259 (syntax-object-expression1197 x1476) (syntax-object-wrap1198 x1476))) ((pair? x1476) (let ((a1477 (f1475 (car x1476))) (d1478 (f1475 (cdr x1476)))) (if (and (eq? a1477 (car x1476)) (eq? d1478 (cdr x1476))) x1476 (cons a1477 d1478)))) ((vector? x1476) (let ((old1479 (vector->list x1476))) (let ((new1480 (map f1475 old1479))) (if (andmap eq? old1479 new1480) x1476 (list->vector new1480))))) (else x1476)))))) (strip-annotation1258 (lambda (x1481 parent1482) (cond ((pair? x1481) (let ((new1483 (cons #f #f))) (begin (if parent1482 (set-annotation-stripped! parent1482 new1483)) (set-car! new1483 (strip-annotation1258 (car x1481) #f)) (set-cdr! new1483 (strip-annotation1258 (cdr x1481) #f)) new1483))) ((annotation? x1481) (or (annotation-stripped x1481) (strip-annotation1258 (annotation-expression x1481) x1481))) ((vector? x1481) (let ((new1484 (make-vector (vector-length x1481)))) (begin (if parent1482 (set-annotation-stripped! parent1482 new1484)) (let loop1485 ((i1486 (- (vector-length x1481) 1))) (unless (fx<1183 i1486 0) (vector-set! new1484 i1486 (strip-annotation1258 (vector-ref x1481 i1486) #f)) (loop1485 (fx-1181 i1486 1)))) new1484))) (else x1481)))) (ellipsis?1257 (lambda (x1487) (and (nonsymbol-id?1211 x1487) (free-id=?1235 x1487 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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-void1256 (lambda () (build-annotated1189 #f (list (build-annotated1189 #f (quote void)))))) (eval-local-transformer1255 (lambda (expanded1488 mod1489) (let ((p1490 (local-eval-hook1185 expanded1488 mod1489))) (if (procedure? p1490) p1490 (syntax-violation #f "nonprocedure transformer" p1490))))) (chi-local-syntax1254 (lambda (rec?1491 e1492 r1493 w1494 s1495 mod1496 k1497) ((lambda (tmp1498) ((lambda (tmp1499) (if tmp1499 (apply (lambda (_1500 id1501 val1502 e11503 e21504) (let ((ids1505 id1501)) (if (not (valid-bound-ids?1237 ids1505)) (syntax-violation #f "duplicate bound keyword" e1492) (let ((labels1507 (gen-labels1218 ids1505))) (let ((new-w1508 (make-binding-wrap1229 ids1505 labels1507 w1494))) (k1497 (cons e11503 e21504) (extend-env1206 labels1507 (let ((w1510 (if rec?1491 new-w1508 w1494)) (trans-r1511 (macros-only-env1208 r1493))) (map (lambda (x1512) (cons (quote macro) (eval-local-transformer1255 (chi1248 x1512 trans-r1511 w1510 mod1496) mod1496))) val1502)) r1493) new-w1508 s1495 mod1496)))))) tmp1499) ((lambda (_1514) (syntax-violation #f "bad local syntax definition" (source-wrap1241 e1492 w1494 s1495 mod1496))) tmp1498))) ($sc-dispatch tmp1498 (quote (any #(each (any any)) any . each-any))))) e1492))) (chi-lambda-clause1253 (lambda (e1515 docstring1516 c1517 r1518 w1519 mod1520 k1521) ((lambda (tmp1522) ((lambda (tmp1523) (if (if tmp1523 (apply (lambda (args1524 doc1525 e11526 e21527) (and (string? (syntax->datum doc1525)) (not docstring1516))) tmp1523) #f) (apply (lambda (args1528 doc1529 e11530 e21531) (chi-lambda-clause1253 e1515 doc1529 (cons args1528 (cons e11530 e21531)) r1518 w1519 mod1520 k1521)) tmp1523) ((lambda (tmp1533) (if tmp1533 (apply (lambda (id1534 e11535 e21536) (let ((ids1537 id1534)) (if (not (valid-bound-ids?1237 ids1537)) (syntax-violation (quote lambda) "invalid parameter list" e1515) (let ((labels1539 (gen-labels1218 ids1537)) (new-vars1540 (map gen-var1260 ids1537))) (k1521 new-vars1540 docstring1516 (chi-body1252 (cons e11535 e21536) e1515 (extend-var-env1207 labels1539 new-vars1540 r1518) (make-binding-wrap1229 ids1537 labels1539 w1519) mod1520)))))) tmp1533) ((lambda (tmp1542) (if tmp1542 (apply (lambda (ids1543 e11544 e21545) (let ((old-ids1546 (lambda-var-list1261 ids1543))) (if (not (valid-bound-ids?1237 old-ids1546)) (syntax-violation (quote lambda) "invalid parameter list" e1515) (let ((labels1547 (gen-labels1218 old-ids1546)) (new-vars1548 (map gen-var1260 old-ids1546))) (k1521 (let f1549 ((ls11550 (cdr new-vars1548)) (ls21551 (car new-vars1548))) (if (null? ls11550) ls21551 (f1549 (cdr ls11550) (cons (car ls11550) ls21551)))) docstring1516 (chi-body1252 (cons e11544 e21545) e1515 (extend-var-env1207 labels1547 new-vars1548 r1518) (make-binding-wrap1229 old-ids1546 labels1547 w1519) mod1520)))))) tmp1542) ((lambda (_1553) (syntax-violation (quote lambda) "bad lambda" e1515)) tmp1522))) ($sc-dispatch tmp1522 (quote (any any . each-any)))))) ($sc-dispatch tmp1522 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1522 (quote (any any any . each-any))))) c1517))) (chi-body1252 (lambda (body1554 outer-form1555 r1556 w1557 mod1558) (let ((r1559 (cons (quote ("placeholder" placeholder)) r1556))) (let ((ribcage1560 (make-ribcage1219 (quote ()) (quote ()) (quote ())))) (let ((w1561 (make-wrap1214 (wrap-marks1215 w1557) (cons ribcage1560 (wrap-subst1216 w1557))))) (let parse1562 ((body1563 (map (lambda (x1569) (cons r1559 (wrap1240 x1569 w1561 mod1558))) body1554)) (ids1564 (quote ())) (labels1565 (quote ())) (vars1566 (quote ())) (vals1567 (quote ())) (bindings1568 (quote ()))) (if (null? body1563) (syntax-violation #f "no expressions in body" outer-form1555) (let ((e1570 (cdar body1563)) (er1571 (caar body1563))) (call-with-values (lambda () (syntax-type1246 e1570 er1571 (quote (())) #f ribcage1560 mod1558)) (lambda (type1572 value1573 e1574 w1575 s1576 mod1577) (let ((t1578 type1572)) (if (memv t1578 (quote (define-form))) (let ((id1579 (wrap1240 value1573 w1575 mod1577)) (label1580 (gen-label1217))) (let ((var1581 (gen-var1260 id1579))) (begin (extend-ribcage!1228 ribcage1560 id1579 label1580) (parse1562 (cdr body1563) (cons id1579 ids1564) (cons label1580 labels1565) (cons var1581 vars1566) (cons (cons er1571 (wrap1240 e1574 w1575 mod1577)) vals1567) (cons (cons (quote lexical) var1581) bindings1568))))) (if (memv t1578 (quote (define-syntax-form))) (let ((id1582 (wrap1240 value1573 w1575 mod1577)) (label1583 (gen-label1217))) (begin (extend-ribcage!1228 ribcage1560 id1582 label1583) (parse1562 (cdr body1563) (cons id1582 ids1564) (cons label1583 labels1565) vars1566 vals1567 (cons (cons (quote macro) (cons er1571 (wrap1240 e1574 w1575 mod1577))) bindings1568)))) (if (memv t1578 (quote (begin-form))) ((lambda (tmp1584) ((lambda (tmp1585) (if tmp1585 (apply (lambda (_1586 e11587) (parse1562 (let f1588 ((forms1589 e11587)) (if (null? forms1589) (cdr body1563) (cons (cons er1571 (wrap1240 (car forms1589) w1575 mod1577)) (f1588 (cdr forms1589))))) ids1564 labels1565 vars1566 vals1567 bindings1568)) tmp1585) (syntax-violation #f "source expression failed to match any pattern" tmp1584))) ($sc-dispatch tmp1584 (quote (any . each-any))))) e1574) (if (memv t1578 (quote (local-syntax-form))) (chi-local-syntax1254 value1573 e1574 er1571 w1575 s1576 mod1577 (lambda (forms1591 er1592 w1593 s1594 mod1595) (parse1562 (let f1596 ((forms1597 forms1591)) (if (null? forms1597) (cdr body1563) (cons (cons er1592 (wrap1240 (car forms1597) w1593 mod1595)) (f1596 (cdr forms1597))))) ids1564 labels1565 vars1566 vals1567 bindings1568))) (if (null? ids1564) (build-sequence1191 #f (map (lambda (x1598) (chi1248 (cdr x1598) (car x1598) (quote (())) mod1577)) (cons (cons er1571 (source-wrap1241 e1574 w1575 s1576 mod1577)) (cdr body1563)))) (begin (if (not (valid-bound-ids?1237 ids1564)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1555)) (let loop1599 ((bs1600 bindings1568) (er-cache1601 #f) (r-cache1602 #f)) (if (not (null? bs1600)) (let ((b1603 (car bs1600))) (if (eq? (car b1603) (quote macro)) (let ((er1604 (cadr b1603))) (let ((r-cache1605 (if (eq? er1604 er-cache1601) r-cache1602 (macros-only-env1208 er1604)))) (begin (set-cdr! b1603 (eval-local-transformer1255 (chi1248 (cddr b1603) r-cache1605 (quote (())) mod1577) mod1577)) (loop1599 (cdr bs1600) er1604 r-cache1605)))) (loop1599 (cdr bs1600) er-cache1601 r-cache1602))))) (set-cdr! r1559 (extend-env1206 labels1565 bindings1568 (cdr r1559))) (build-letrec1194 #f vars1566 (map (lambda (x1606) (chi1248 (cdr x1606) (car x1606) (quote (())) mod1577)) vals1567) (build-sequence1191 #f (map (lambda (x1607) (chi1248 (cdr x1607) (car x1607) (quote (())) mod1577)) (cons (cons er1571 (source-wrap1241 e1574 w1575 s1576 mod1577)) (cdr body1563)))))))))))))))))))))) (chi-macro1251 (lambda (p1608 e1609 r1610 w1611 rib1612 mod1613) (letrec ((rebuild-macro-output1614 (lambda (x1615 m1616) (cond ((pair? x1615) (cons (rebuild-macro-output1614 (car x1615) m1616) (rebuild-macro-output1614 (cdr x1615) m1616))) ((syntax-object?1196 x1615) (let ((w1617 (syntax-object-wrap1198 x1615))) (let ((ms1618 (wrap-marks1215 w1617)) (s1619 (wrap-subst1216 w1617))) (if (and (pair? ms1618) (eq? (car ms1618) #f)) (make-syntax-object1195 (syntax-object-expression1197 x1615) (make-wrap1214 (cdr ms1618) (if rib1612 (cons rib1612 (cdr s1619)) (cdr s1619))) (syntax-object-module1199 x1615)) (make-syntax-object1195 (syntax-object-expression1197 x1615) (make-wrap1214 (cons m1616 ms1618) (if rib1612 (cons rib1612 (cons (quote shift) s1619)) (cons (quote shift) s1619))) (let ((pmod1620 (procedure-module p1608))) (if pmod1620 (cons (quote hygiene) (module-name pmod1620)) (quote (hygiene guile))))))))) ((vector? x1615) (let ((n1621 (vector-length x1615))) (let ((v1622 (make-vector n1621))) (let doloop1623 ((i1624 0)) (if (fx=1182 i1624 n1621) v1622 (begin (vector-set! v1622 i1624 (rebuild-macro-output1614 (vector-ref x1615 i1624) m1616)) (doloop1623 (fx+1180 i1624 1)))))))) ((symbol? x1615) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1241 e1609 w1611 s mod1613) x1615)) (else x1615))))) (rebuild-macro-output1614 (p1608 (wrap1240 e1609 (anti-mark1227 w1611) mod1613)) (string #\m))))) (chi-application1250 (lambda (x1625 e1626 r1627 w1628 s1629 mod1630) ((lambda (tmp1631) ((lambda (tmp1632) (if tmp1632 (apply (lambda (e01633 e11634) (build-annotated1189 s1629 (cons x1625 (map (lambda (e1635) (chi1248 e1635 r1627 w1628 mod1630)) e11634)))) tmp1632) (syntax-violation #f "source expression failed to match any pattern" tmp1631))) ($sc-dispatch tmp1631 (quote (any . each-any))))) e1626))) (chi-expr1249 (lambda (type1637 value1638 e1639 r1640 w1641 s1642 mod1643) (let ((t1644 type1637)) (if (memv t1644 (quote (lexical))) (build-annotated1189 s1642 value1638) (if (memv t1644 (quote (core external-macro))) (value1638 e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (module-ref))) (call-with-values (lambda () (value1638 e1639)) (lambda (id1645 mod1646) (build-annotated1189 s1642 (if mod1646 (make-module-ref (cdr mod1646) id1645 (car mod1646)) (make-module-ref mod1646 id1645 (quote bare)))))) (if (memv t1644 (quote (lexical-call))) (chi-application1250 (build-annotated1189 (source-annotation1203 (car e1639)) value1638) e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (global-call))) (chi-application1250 (build-annotated1189 (source-annotation1203 (car e1639)) (if (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643) (make-module-ref (cdr (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643)) value1638 (car (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643))) (make-module-ref (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643) value1638 (quote bare)))) e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (constant))) (build-data1190 s1642 (strip1259 (source-wrap1241 e1639 w1641 s1642 mod1643) (quote (())))) (if (memv t1644 (quote (global))) (build-annotated1189 s1642 (if mod1643 (make-module-ref (cdr mod1643) value1638 (car mod1643)) (make-module-ref mod1643 value1638 (quote bare)))) (if (memv t1644 (quote (call))) (chi-application1250 (chi1248 (car e1639) r1640 w1641 mod1643) e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (begin-form))) ((lambda (tmp1647) ((lambda (tmp1648) (if tmp1648 (apply (lambda (_1649 e11650 e21651) (chi-sequence1242 (cons e11650 e21651) r1640 w1641 s1642 mod1643)) tmp1648) (syntax-violation #f "source expression failed to match any pattern" tmp1647))) ($sc-dispatch tmp1647 (quote (any any . each-any))))) e1639) (if (memv t1644 (quote (local-syntax-form))) (chi-local-syntax1254 value1638 e1639 r1640 w1641 s1642 mod1643 chi-sequence1242) (if (memv t1644 (quote (eval-when-form))) ((lambda (tmp1653) ((lambda (tmp1654) (if tmp1654 (apply (lambda (_1655 x1656 e11657 e21658) (let ((when-list1659 (chi-when-list1245 e1639 x1656 w1641))) (if (memq (quote eval) when-list1659) (chi-sequence1242 (cons e11657 e21658) r1640 w1641 s1642 mod1643) (chi-void1256)))) tmp1654) (syntax-violation #f "source expression failed to match any pattern" tmp1653))) ($sc-dispatch tmp1653 (quote (any each-any any . each-any))))) e1639) (if (memv t1644 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1639 (wrap1240 value1638 w1641 mod1643)) (if (memv t1644 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1241 e1639 w1641 s1642 mod1643)) (if (memv t1644 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1241 e1639 w1641 s1642 mod1643)) (syntax-violation #f "unexpected syntax" (source-wrap1241 e1639 w1641 s1642 mod1643))))))))))))))))))) (chi1248 (lambda (e1662 r1663 w1664 mod1665) (call-with-values (lambda () (syntax-type1246 e1662 r1663 w1664 #f #f mod1665)) (lambda (type1666 value1667 e1668 w1669 s1670 mod1671) (chi-expr1249 type1666 value1667 e1668 r1663 w1669 s1670 mod1671))))) (chi-top1247 (lambda (e1672 r1673 w1674 m1675 esew1676 mod1677) (call-with-values (lambda () (syntax-type1246 e1672 r1673 w1674 #f #f mod1677)) (lambda (type1685 value1686 e1687 w1688 s1689 mod1690) (let ((t1691 type1685)) (if (memv t1691 (quote (begin-form))) ((lambda (tmp1692) ((lambda (tmp1693) (if tmp1693 (apply (lambda (_1694) (chi-void1256)) tmp1693) ((lambda (tmp1695) (if tmp1695 (apply (lambda (_1696 e11697 e21698) (chi-top-sequence1243 (cons e11697 e21698) r1673 w1688 s1689 m1675 esew1676 mod1690)) tmp1695) (syntax-violation #f "source expression failed to match any pattern" tmp1692))) ($sc-dispatch tmp1692 (quote (any any . each-any)))))) ($sc-dispatch tmp1692 (quote (any))))) e1687) (if (memv t1691 (quote (local-syntax-form))) (chi-local-syntax1254 value1686 e1687 r1673 w1688 s1689 mod1690 (lambda (body1700 r1701 w1702 s1703 mod1704) (chi-top-sequence1243 body1700 r1701 w1702 s1703 m1675 esew1676 mod1704))) (if (memv t1691 (quote (eval-when-form))) ((lambda (tmp1705) ((lambda (tmp1706) (if tmp1706 (apply (lambda (_1707 x1708 e11709 e21710) (let ((when-list1711 (chi-when-list1245 e1687 x1708 w1688)) (body1712 (cons e11709 e21710))) (cond ((eq? m1675 (quote e)) (if (memq (quote eval) when-list1711) (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote e) (quote (eval)) mod1690) (chi-void1256))) ((memq (quote load) when-list1711) (if (or (memq (quote compile) when-list1711) (and (eq? m1675 (quote c&e)) (memq (quote eval) when-list1711))) (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote c&e) (quote (compile load)) mod1690) (if (memq m1675 (quote (c c&e))) (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote c) (quote (load)) mod1690) (chi-void1256)))) ((or (memq (quote compile) when-list1711) (and (eq? m1675 (quote c&e)) (memq (quote eval) when-list1711))) (top-level-eval-hook1184 (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote e) (quote (eval)) mod1690) mod1690) (chi-void1256)) (else (chi-void1256))))) tmp1706) (syntax-violation #f "source expression failed to match any pattern" tmp1705))) ($sc-dispatch tmp1705 (quote (any each-any any . each-any))))) e1687) (if (memv t1691 (quote (define-syntax-form))) (let ((n1715 (id-var-name1234 value1686 w1688)) (r1716 (macros-only-env1208 r1673))) (let ((t1717 m1675)) (if (memv t1717 (quote (c))) (if (memq (quote compile) esew1676) (let ((e1718 (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)))) (begin (top-level-eval-hook1184 e1718 mod1690) (if (memq (quote load) esew1676) e1718 (chi-void1256)))) (if (memq (quote load) esew1676) (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)) (chi-void1256))) (if (memv t1717 (quote (c&e))) (let ((e1719 (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)))) (begin (top-level-eval-hook1184 e1719 mod1690) e1719)) (begin (if (memq (quote eval) esew1676) (top-level-eval-hook1184 (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)) mod1690)) (chi-void1256)))))) (if (memv t1691 (quote (define-form))) (let ((n1720 (id-var-name1234 value1686 w1688))) (let ((type1721 (binding-type1204 (lookup1209 n1720 r1673 mod1690)))) (let ((t1722 type1721)) (if (memv t1722 (quote (global core macro module-ref))) (let ((x1723 (build-annotated1189 s1689 (list (quote define) n1720 (chi1248 e1687 r1673 w1688 mod1690))))) (begin (if (eq? m1675 (quote c&e)) (top-level-eval-hook1184 x1723 mod1690)) x1723)) (if (memv t1722 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1687 (wrap1240 value1686 w1688 mod1690)) (syntax-violation #f "cannot define keyword at top level" e1687 (wrap1240 value1686 w1688 mod1690))))))) (let ((x1724 (chi-expr1249 type1685 value1686 e1687 r1673 w1688 s1689 mod1690))) (begin (if (eq? m1675 (quote c&e)) (top-level-eval-hook1184 x1724 mod1690)) x1724)))))))))))) (syntax-type1246 (lambda (e1725 r1726 w1727 s1728 rib1729 mod1730) (cond ((symbol? e1725) (let ((n1731 (id-var-name1234 e1725 w1727))) (let ((b1732 (lookup1209 n1731 r1726 mod1730))) (let ((type1733 (binding-type1204 b1732))) (let ((t1734 type1733)) (if (memv t1734 (quote (lexical))) (values type1733 (binding-value1205 b1732) e1725 w1727 s1728 mod1730) (if (memv t1734 (quote (global))) (values type1733 n1731 e1725 w1727 s1728 mod1730) (if (memv t1734 (quote (macro))) (syntax-type1246 (chi-macro1251 (binding-value1205 b1732) e1725 r1726 w1727 rib1729 mod1730) r1726 (quote (())) s1728 rib1729 mod1730) (values type1733 (binding-value1205 b1732) e1725 w1727 s1728 mod1730))))))))) ((pair? e1725) (let ((first1735 (car e1725))) (if (id?1212 first1735) (let ((n1736 (id-var-name1234 first1735 w1727))) (let ((b1737 (lookup1209 n1736 r1726 (or (and (syntax-object?1196 first1735) (syntax-object-module1199 first1735)) mod1730)))) (let ((type1738 (binding-type1204 b1737))) (let ((t1739 type1738)) (if (memv t1739 (quote (lexical))) (values (quote lexical-call) (binding-value1205 b1737) e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (global))) (values (quote global-call) n1736 e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (macro))) (syntax-type1246 (chi-macro1251 (binding-value1205 b1737) e1725 r1726 w1727 rib1729 mod1730) r1726 (quote (())) s1728 rib1729 mod1730) (if (memv t1739 (quote (core external-macro module-ref))) (values type1738 (binding-value1205 b1737) e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1205 b1737) e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (begin))) (values (quote begin-form) #f e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (eval-when))) (values (quote eval-when-form) #f e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (define))) ((lambda (tmp1740) ((lambda (tmp1741) (if (if tmp1741 (apply (lambda (_1742 name1743 val1744) (id?1212 name1743)) tmp1741) #f) (apply (lambda (_1745 name1746 val1747) (values (quote define-form) name1746 val1747 w1727 s1728 mod1730)) tmp1741) ((lambda (tmp1748) (if (if tmp1748 (apply (lambda (_1749 name1750 args1751 e11752 e21753) (and (id?1212 name1750) (valid-bound-ids?1237 (lambda-var-list1261 args1751)))) tmp1748) #f) (apply (lambda (_1754 name1755 args1756 e11757 e21758) (values (quote define-form) (wrap1240 name1755 w1727 mod1730) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) (wrap1240 (cons args1756 (cons e11757 e21758)) w1727 mod1730)) (quote (())) s1728 mod1730)) tmp1748) ((lambda (tmp1760) (if (if tmp1760 (apply (lambda (_1761 name1762) (id?1212 name1762)) tmp1760) #f) (apply (lambda (_1763 name1764) (values (quote define-form) (wrap1240 name1764 w1727 mod1730) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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 (())) s1728 mod1730)) tmp1760) (syntax-violation #f "source expression failed to match any pattern" tmp1740))) ($sc-dispatch tmp1740 (quote (any any)))))) ($sc-dispatch tmp1740 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1740 (quote (any any any))))) e1725) (if (memv t1739 (quote (define-syntax))) ((lambda (tmp1765) ((lambda (tmp1766) (if (if tmp1766 (apply (lambda (_1767 name1768 val1769) (id?1212 name1768)) tmp1766) #f) (apply (lambda (_1770 name1771 val1772) (values (quote define-syntax-form) name1771 val1772 w1727 s1728 mod1730)) tmp1766) (syntax-violation #f "source expression failed to match any pattern" tmp1765))) ($sc-dispatch tmp1765 (quote (any any any))))) e1725) (values (quote call) #f e1725 w1727 s1728 mod1730)))))))))))))) (values (quote call) #f e1725 w1727 s1728 mod1730)))) ((syntax-object?1196 e1725) (syntax-type1246 (syntax-object-expression1197 e1725) r1726 (join-wraps1231 w1727 (syntax-object-wrap1198 e1725)) #f rib1729 (or (syntax-object-module1199 e1725) mod1730))) ((annotation? e1725) (syntax-type1246 (annotation-expression e1725) r1726 w1727 (annotation-source e1725) rib1729 mod1730)) ((self-evaluating? e1725) (values (quote constant) #f e1725 w1727 s1728 mod1730)) (else (values (quote other) #f e1725 w1727 s1728 mod1730))))) (chi-when-list1245 (lambda (e1773 when-list1774 w1775) (let f1776 ((when-list1777 when-list1774) (situations1778 (quote ()))) (if (null? when-list1777) situations1778 (f1776 (cdr when-list1777) (cons (let ((x1779 (car when-list1777))) (cond ((free-id=?1235 x1779 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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=?1235 x1779 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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=?1235 x1779 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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" e1773 (wrap1240 x1779 w1775 #f))))) situations1778)))))) (chi-install-global1244 (lambda (name1780 e1781) (build-annotated1189 #f (list (build-annotated1189 #f (quote define)) name1780 (if (let ((v1782 (module-variable (current-module) name1780))) (and v1782 (variable-bound? v1782) (macro? (variable-ref v1782)) (not (eq? (macro-type (variable-ref v1782)) (quote syncase-macro))))) (build-annotated1189 #f (list (build-annotated1189 #f (quote make-extended-syncase-macro)) (build-annotated1189 #f (list (build-annotated1189 #f (quote module-ref)) (build-annotated1189 #f (quote (current-module))) (build-data1190 #f name1780))) (build-data1190 #f (quote macro)) e1781)) (build-annotated1189 #f (list (build-annotated1189 #f (quote make-syncase-macro)) (build-data1190 #f (quote macro)) e1781))))))) (chi-top-sequence1243 (lambda (body1783 r1784 w1785 s1786 m1787 esew1788 mod1789) (build-sequence1191 s1786 (let dobody1790 ((body1791 body1783) (r1792 r1784) (w1793 w1785) (m1794 m1787) (esew1795 esew1788) (mod1796 mod1789)) (if (null? body1791) (quote ()) (let ((first1797 (chi-top1247 (car body1791) r1792 w1793 m1794 esew1795 mod1796))) (cons first1797 (dobody1790 (cdr body1791) r1792 w1793 m1794 esew1795 mod1796)))))))) (chi-sequence1242 (lambda (body1798 r1799 w1800 s1801 mod1802) (build-sequence1191 s1801 (let dobody1803 ((body1804 body1798) (r1805 r1799) (w1806 w1800) (mod1807 mod1802)) (if (null? body1804) (quote ()) (let ((first1808 (chi1248 (car body1804) r1805 w1806 mod1807))) (cons first1808 (dobody1803 (cdr body1804) r1805 w1806 mod1807)))))))) (source-wrap1241 (lambda (x1809 w1810 s1811 defmod1812) (wrap1240 (if s1811 (make-annotation x1809 s1811 #f) x1809) w1810 defmod1812))) (wrap1240 (lambda (x1813 w1814 defmod1815) (cond ((and (null? (wrap-marks1215 w1814)) (null? (wrap-subst1216 w1814))) x1813) ((syntax-object?1196 x1813) (make-syntax-object1195 (syntax-object-expression1197 x1813) (join-wraps1231 w1814 (syntax-object-wrap1198 x1813)) (syntax-object-module1199 x1813))) ((null? x1813) x1813) (else (make-syntax-object1195 x1813 w1814 defmod1815))))) (bound-id-member?1239 (lambda (x1816 list1817) (and (not (null? list1817)) (or (bound-id=?1236 x1816 (car list1817)) (bound-id-member?1239 x1816 (cdr list1817)))))) (distinct-bound-ids?1238 (lambda (ids1818) (let distinct?1819 ((ids1820 ids1818)) (or (null? ids1820) (and (not (bound-id-member?1239 (car ids1820) (cdr ids1820))) (distinct?1819 (cdr ids1820))))))) (valid-bound-ids?1237 (lambda (ids1821) (and (let all-ids?1822 ((ids1823 ids1821)) (or (null? ids1823) (and (id?1212 (car ids1823)) (all-ids?1822 (cdr ids1823))))) (distinct-bound-ids?1238 ids1821)))) (bound-id=?1236 (lambda (i1824 j1825) (if (and (syntax-object?1196 i1824) (syntax-object?1196 j1825)) (and (eq? (let ((e1826 (syntax-object-expression1197 i1824))) (if (annotation? e1826) (annotation-expression e1826) e1826)) (let ((e1827 (syntax-object-expression1197 j1825))) (if (annotation? e1827) (annotation-expression e1827) e1827))) (same-marks?1233 (wrap-marks1215 (syntax-object-wrap1198 i1824)) (wrap-marks1215 (syntax-object-wrap1198 j1825)))) (eq? (let ((e1828 i1824)) (if (annotation? e1828) (annotation-expression e1828) e1828)) (let ((e1829 j1825)) (if (annotation? e1829) (annotation-expression e1829) e1829)))))) (free-id=?1235 (lambda (i1830 j1831) (and (eq? (let ((x1832 i1830)) (let ((e1833 (if (syntax-object?1196 x1832) (syntax-object-expression1197 x1832) x1832))) (if (annotation? e1833) (annotation-expression e1833) e1833))) (let ((x1834 j1831)) (let ((e1835 (if (syntax-object?1196 x1834) (syntax-object-expression1197 x1834) x1834))) (if (annotation? e1835) (annotation-expression e1835) e1835)))) (eq? (id-var-name1234 i1830 (quote (()))) (id-var-name1234 j1831 (quote (()))))))) (id-var-name1234 (lambda (id1836 w1837) (letrec ((search-vector-rib1840 (lambda (sym1846 subst1847 marks1848 symnames1849 ribcage1850) (let ((n1851 (vector-length symnames1849))) (let f1852 ((i1853 0)) (cond ((fx=1182 i1853 n1851) (search1838 sym1846 (cdr subst1847) marks1848)) ((and (eq? (vector-ref symnames1849 i1853) sym1846) (same-marks?1233 marks1848 (vector-ref (ribcage-marks1222 ribcage1850) i1853))) (values (vector-ref (ribcage-labels1223 ribcage1850) i1853) marks1848)) (else (f1852 (fx+1180 i1853 1)))))))) (search-list-rib1839 (lambda (sym1854 subst1855 marks1856 symnames1857 ribcage1858) (let f1859 ((symnames1860 symnames1857) (i1861 0)) (cond ((null? symnames1860) (search1838 sym1854 (cdr subst1855) marks1856)) ((and (eq? (car symnames1860) sym1854) (same-marks?1233 marks1856 (list-ref (ribcage-marks1222 ribcage1858) i1861))) (values (list-ref (ribcage-labels1223 ribcage1858) i1861) marks1856)) (else (f1859 (cdr symnames1860) (fx+1180 i1861 1))))))) (search1838 (lambda (sym1862 subst1863 marks1864) (if (null? subst1863) (values #f marks1864) (let ((fst1865 (car subst1863))) (if (eq? fst1865 (quote shift)) (search1838 sym1862 (cdr subst1863) (cdr marks1864)) (let ((symnames1866 (ribcage-symnames1221 fst1865))) (if (vector? symnames1866) (search-vector-rib1840 sym1862 subst1863 marks1864 symnames1866 fst1865) (search-list-rib1839 sym1862 subst1863 marks1864 symnames1866 fst1865))))))))) (cond ((symbol? id1836) (or (call-with-values (lambda () (search1838 id1836 (wrap-subst1216 w1837) (wrap-marks1215 w1837))) (lambda (x1868 . ignore1867) x1868)) id1836)) ((syntax-object?1196 id1836) (let ((id1869 (let ((e1871 (syntax-object-expression1197 id1836))) (if (annotation? e1871) (annotation-expression e1871) e1871))) (w11870 (syntax-object-wrap1198 id1836))) (let ((marks1872 (join-marks1232 (wrap-marks1215 w1837) (wrap-marks1215 w11870)))) (call-with-values (lambda () (search1838 id1869 (wrap-subst1216 w1837) marks1872)) (lambda (new-id1873 marks1874) (or new-id1873 (call-with-values (lambda () (search1838 id1869 (wrap-subst1216 w11870) marks1874)) (lambda (x1876 . ignore1875) x1876)) id1869)))))) ((annotation? id1836) (let ((id1877 (let ((e1878 id1836)) (if (annotation? e1878) (annotation-expression e1878) e1878)))) (or (call-with-values (lambda () (search1838 id1877 (wrap-subst1216 w1837) (wrap-marks1215 w1837))) (lambda (x1880 . ignore1879) x1880)) id1877))) (else (error-hook1186 (quote id-var-name) "invalid id" id1836)))))) (same-marks?1233 (lambda (x1881 y1882) (or (eq? x1881 y1882) (and (not (null? x1881)) (not (null? y1882)) (eq? (car x1881) (car y1882)) (same-marks?1233 (cdr x1881) (cdr y1882)))))) (join-marks1232 (lambda (m11883 m21884) (smart-append1230 m11883 m21884))) (join-wraps1231 (lambda (w11885 w21886) (let ((m11887 (wrap-marks1215 w11885)) (s11888 (wrap-subst1216 w11885))) (if (null? m11887) (if (null? s11888) w21886 (make-wrap1214 (wrap-marks1215 w21886) (smart-append1230 s11888 (wrap-subst1216 w21886)))) (make-wrap1214 (smart-append1230 m11887 (wrap-marks1215 w21886)) (smart-append1230 s11888 (wrap-subst1216 w21886))))))) (smart-append1230 (lambda (m11889 m21890) (if (null? m21890) m11889 (append m11889 m21890)))) (make-binding-wrap1229 (lambda (ids1891 labels1892 w1893) (if (null? ids1891) w1893 (make-wrap1214 (wrap-marks1215 w1893) (cons (let ((labelvec1894 (list->vector labels1892))) (let ((n1895 (vector-length labelvec1894))) (let ((symnamevec1896 (make-vector n1895)) (marksvec1897 (make-vector n1895))) (begin (let f1898 ((ids1899 ids1891) (i1900 0)) (if (not (null? ids1899)) (call-with-values (lambda () (id-sym-name&marks1213 (car ids1899) w1893)) (lambda (symname1901 marks1902) (begin (vector-set! symnamevec1896 i1900 symname1901) (vector-set! marksvec1897 i1900 marks1902) (f1898 (cdr ids1899) (fx+1180 i1900 1))))))) (make-ribcage1219 symnamevec1896 marksvec1897 labelvec1894))))) (wrap-subst1216 w1893)))))) (extend-ribcage!1228 (lambda (ribcage1903 id1904 label1905) (begin (set-ribcage-symnames!1224 ribcage1903 (cons (let ((e1906 (syntax-object-expression1197 id1904))) (if (annotation? e1906) (annotation-expression e1906) e1906)) (ribcage-symnames1221 ribcage1903))) (set-ribcage-marks!1225 ribcage1903 (cons (wrap-marks1215 (syntax-object-wrap1198 id1904)) (ribcage-marks1222 ribcage1903))) (set-ribcage-labels!1226 ribcage1903 (cons label1905 (ribcage-labels1223 ribcage1903)))))) (anti-mark1227 (lambda (w1907) (make-wrap1214 (cons #f (wrap-marks1215 w1907)) (cons (quote shift) (wrap-subst1216 w1907))))) (set-ribcage-labels!1226 (lambda (x1908 update1909) (vector-set! x1908 3 update1909))) (set-ribcage-marks!1225 (lambda (x1910 update1911) (vector-set! x1910 2 update1911))) (set-ribcage-symnames!1224 (lambda (x1912 update1913) (vector-set! x1912 1 update1913))) (ribcage-labels1223 (lambda (x1914) (vector-ref x1914 3))) (ribcage-marks1222 (lambda (x1915) (vector-ref x1915 2))) (ribcage-symnames1221 (lambda (x1916) (vector-ref x1916 1))) (ribcage?1220 (lambda (x1917) (and (vector? x1917) (= (vector-length x1917) 4) (eq? (vector-ref x1917 0) (quote ribcage))))) (make-ribcage1219 (lambda (symnames1918 marks1919 labels1920) (vector (quote ribcage) symnames1918 marks1919 labels1920))) (gen-labels1218 (lambda (ls1921) (if (null? ls1921) (quote ()) (cons (gen-label1217) (gen-labels1218 (cdr ls1921)))))) (gen-label1217 (lambda () (string #\i))) (wrap-subst1216 cdr) (wrap-marks1215 car) (make-wrap1214 cons) (id-sym-name&marks1213 (lambda (x1922 w1923) (if (syntax-object?1196 x1922) (values (let ((e1924 (syntax-object-expression1197 x1922))) (if (annotation? e1924) (annotation-expression e1924) e1924)) (join-marks1232 (wrap-marks1215 w1923) (wrap-marks1215 (syntax-object-wrap1198 x1922)))) (values (let ((e1925 x1922)) (if (annotation? e1925) (annotation-expression e1925) e1925)) (wrap-marks1215 w1923))))) (id?1212 (lambda (x1926) (cond ((symbol? x1926) #t) ((syntax-object?1196 x1926) (symbol? (let ((e1927 (syntax-object-expression1197 x1926))) (if (annotation? e1927) (annotation-expression e1927) e1927)))) ((annotation? x1926) (symbol? (annotation-expression x1926))) (else #f)))) (nonsymbol-id?1211 (lambda (x1928) (and (syntax-object?1196 x1928) (symbol? (let ((e1929 (syntax-object-expression1197 x1928))) (if (annotation? e1929) (annotation-expression e1929) e1929)))))) (global-extend1210 (lambda (type1930 sym1931 val1932) (put-global-definition-hook1187 sym1931 type1930 val1932))) (lookup1209 (lambda (x1933 r1934 mod1935) (cond ((assq x1933 r1934) => cdr) ((symbol? x1933) (or (get-global-definition-hook1188 x1933 mod1935) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1208 (lambda (r1936) (if (null? r1936) (quote ()) (let ((a1937 (car r1936))) (if (eq? (cadr a1937) (quote macro)) (cons a1937 (macros-only-env1208 (cdr r1936))) (macros-only-env1208 (cdr r1936))))))) (extend-var-env1207 (lambda (labels1938 vars1939 r1940) (if (null? labels1938) r1940 (extend-var-env1207 (cdr labels1938) (cdr vars1939) (cons (cons (car labels1938) (cons (quote lexical) (car vars1939))) r1940))))) (extend-env1206 (lambda (labels1941 bindings1942 r1943) (if (null? labels1941) r1943 (extend-env1206 (cdr labels1941) (cdr bindings1942) (cons (cons (car labels1941) (car bindings1942)) r1943))))) (binding-value1205 cdr) (binding-type1204 car) (source-annotation1203 (lambda (x1944) (cond ((annotation? x1944) (annotation-source x1944)) ((syntax-object?1196 x1944) (source-annotation1203 (syntax-object-expression1197 x1944))) (else #f)))) (set-syntax-object-module!1202 (lambda (x1945 update1946) (vector-set! x1945 3 update1946))) (set-syntax-object-wrap!1201 (lambda (x1947 update1948) (vector-set! x1947 2 update1948))) (set-syntax-object-expression!1200 (lambda (x1949 update1950) (vector-set! x1949 1 update1950))) (syntax-object-module1199 (lambda (x1951) (vector-ref x1951 3))) (syntax-object-wrap1198 (lambda (x1952) (vector-ref x1952 2))) (syntax-object-expression1197 (lambda (x1953) (vector-ref x1953 1))) (syntax-object?1196 (lambda (x1954) (and (vector? x1954) (= (vector-length x1954) 4) (eq? (vector-ref x1954 0) (quote syntax-object))))) (make-syntax-object1195 (lambda (expression1955 wrap1956 module1957) (vector (quote syntax-object) expression1955 wrap1956 module1957))) (build-letrec1194 (lambda (src1958 vars1959 val-exps1960 body-exp1961) (if (null? vars1959) (build-annotated1189 src1958 body-exp1961) (build-annotated1189 src1958 (list (quote letrec) (map list vars1959 val-exps1960) body-exp1961))))) (build-named-let1193 (lambda (src1962 vars1963 val-exps1964 body-exp1965) (if (null? vars1963) (build-annotated1189 src1962 body-exp1965) (build-annotated1189 src1962 (list (quote let) (car vars1963) (map list (cdr vars1963) val-exps1964) body-exp1965))))) (build-let1192 (lambda (src1966 vars1967 val-exps1968 body-exp1969) (if (null? vars1967) (build-annotated1189 src1966 body-exp1969) (build-annotated1189 src1966 (list (quote let) (map list vars1967 val-exps1968) body-exp1969))))) (build-sequence1191 (lambda (src1970 exps1971) (if (null? (cdr exps1971)) (build-annotated1189 src1970 (car exps1971)) (build-annotated1189 src1970 (cons (quote begin) exps1971))))) (build-data1190 (lambda (src1972 exp1973) (if (and (self-evaluating? exp1973) (not (vector? exp1973))) (build-annotated1189 src1972 exp1973) (build-annotated1189 src1972 (list (quote quote) exp1973))))) (build-annotated1189 (lambda (src1974 exp1975) (if (and src1974 (not (annotation? exp1975))) (make-annotation exp1975 src1974 #t) exp1975))) (get-global-definition-hook1188 (lambda (symbol1976 module1977) (begin (if (and (not module1977) (current-module)) (warn "module system is booted, we should have a module" symbol1976)) (let ((v1978 (module-variable (if module1977 (resolve-module (cdr module1977)) (current-module)) symbol1976))) (and v1978 (variable-bound? v1978) (let ((val1979 (variable-ref v1978))) (and (macro? val1979) (syncase-macro-type val1979) (cons (syncase-macro-type val1979) (syncase-macro-binding val1979))))))))) (put-global-definition-hook1187 (lambda (symbol1980 type1981 val1982) (let ((existing1983 (let ((v1984 (module-variable (current-module) symbol1980))) (and v1984 (variable-bound? v1984) (let ((val1985 (variable-ref v1984))) (and (macro? val1985) (not (syncase-macro-type val1985)) val1985)))))) (module-define! (current-module) symbol1980 (if existing1983 (make-extended-syncase-macro existing1983 type1981 val1982) (make-syncase-macro type1981 val1982)))))) (error-hook1186 (lambda (who1986 why1987 what1988) (error who1986 "~a ~s" why1987 what1988))) (local-eval-hook1185 (lambda (x1989 mod1990) (primitive-eval (list noexpand1179 x1989)))) (top-level-eval-hook1184 (lambda (x1991 mod1992) (primitive-eval (list noexpand1179 x1991)))) (fx<1183 <) (fx=1182 =) (fx-1181 -) (fx+1180 +) (noexpand1179 "noexpand")) (begin (global-extend1210 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1210 (quote local-syntax) (quote let-syntax) #f) (global-extend1210 (quote core) (quote fluid-let-syntax) (lambda (e1993 r1994 w1995 s1996 mod1997) ((lambda (tmp1998) ((lambda (tmp1999) (if (if tmp1999 (apply (lambda (_2000 var2001 val2002 e12003 e22004) (valid-bound-ids?1237 var2001)) tmp1999) #f) (apply (lambda (_2006 var2007 val2008 e12009 e22010) (let ((names2011 (map (lambda (x2012) (id-var-name1234 x2012 w1995)) var2007))) (begin (for-each (lambda (id2014 n2015) (let ((t2016 (binding-type1204 (lookup1209 n2015 r1994 mod1997)))) (if (memv t2016 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1993 (source-wrap1241 id2014 w1995 s1996 mod1997))))) var2007 names2011) (chi-body1252 (cons e12009 e22010) (source-wrap1241 e1993 w1995 s1996 mod1997) (extend-env1206 names2011 (let ((trans-r2019 (macros-only-env1208 r1994))) (map (lambda (x2020) (cons (quote macro) (eval-local-transformer1255 (chi1248 x2020 trans-r2019 w1995 mod1997) mod1997))) val2008)) r1994) w1995 mod1997)))) tmp1999) ((lambda (_2022) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1241 e1993 w1995 s1996 mod1997))) tmp1998))) ($sc-dispatch tmp1998 (quote (any #(each (any any)) any . each-any))))) e1993))) (global-extend1210 (quote core) (quote quote) (lambda (e2023 r2024 w2025 s2026 mod2027) ((lambda (tmp2028) ((lambda (tmp2029) (if tmp2029 (apply (lambda (_2030 e2031) (build-data1190 s2026 (strip1259 e2031 w2025))) tmp2029) ((lambda (_2032) (syntax-violation (quote quote) "bad syntax" (source-wrap1241 e2023 w2025 s2026 mod2027))) tmp2028))) ($sc-dispatch tmp2028 (quote (any any))))) e2023))) (global-extend1210 (quote core) (quote syntax) (letrec ((regen2040 (lambda (x2041) (let ((t2042 (car x2041))) (if (memv t2042 (quote (ref))) (build-annotated1189 #f (cadr x2041)) (if (memv t2042 (quote (primitive))) (build-annotated1189 #f (cadr x2041)) (if (memv t2042 (quote (quote))) (build-data1190 #f (cadr x2041)) (if (memv t2042 (quote (lambda))) (build-annotated1189 #f (list (quote lambda) (cadr x2041) (regen2040 (caddr x2041)))) (if (memv t2042 (quote (map))) (let ((ls2043 (map regen2040 (cdr x2041)))) (build-annotated1189 #f (cons (if (fx=1182 (length ls2043) 2) (build-annotated1189 #f (quote map)) (build-annotated1189 #f (quote map))) ls2043))) (build-annotated1189 #f (cons (build-annotated1189 #f (car x2041)) (map regen2040 (cdr x2041)))))))))))) (gen-vector2039 (lambda (x2044) (cond ((eq? (car x2044) (quote list)) (cons (quote vector) (cdr x2044))) ((eq? (car x2044) (quote quote)) (list (quote quote) (list->vector (cadr x2044)))) (else (list (quote list->vector) x2044))))) (gen-append2038 (lambda (x2045 y2046) (if (equal? y2046 (quote (quote ()))) x2045 (list (quote append) x2045 y2046)))) (gen-cons2037 (lambda (x2047 y2048) (let ((t2049 (car y2048))) (if (memv t2049 (quote (quote))) (if (eq? (car x2047) (quote quote)) (list (quote quote) (cons (cadr x2047) (cadr y2048))) (if (eq? (cadr y2048) (quote ())) (list (quote list) x2047) (list (quote cons) x2047 y2048))) (if (memv t2049 (quote (list))) (cons (quote list) (cons x2047 (cdr y2048))) (list (quote cons) x2047 y2048)))))) (gen-map2036 (lambda (e2050 map-env2051) (let ((formals2052 (map cdr map-env2051)) (actuals2053 (map (lambda (x2054) (list (quote ref) (car x2054))) map-env2051))) (cond ((eq? (car e2050) (quote ref)) (car actuals2053)) ((andmap (lambda (x2055) (and (eq? (car x2055) (quote ref)) (memq (cadr x2055) formals2052))) (cdr e2050)) (cons (quote map) (cons (list (quote primitive) (car e2050)) (map (let ((r2056 (map cons formals2052 actuals2053))) (lambda (x2057) (cdr (assq (cadr x2057) r2056)))) (cdr e2050))))) (else (cons (quote map) (cons (list (quote lambda) formals2052 e2050) actuals2053))))))) (gen-mappend2035 (lambda (e2058 map-env2059) (list (quote apply) (quote (primitive append)) (gen-map2036 e2058 map-env2059)))) (gen-ref2034 (lambda (src2060 var2061 level2062 maps2063) (if (fx=1182 level2062 0) (values var2061 maps2063) (if (null? maps2063) (syntax-violation (quote syntax) "missing ellipsis" src2060) (call-with-values (lambda () (gen-ref2034 src2060 var2061 (fx-1181 level2062 1) (cdr maps2063))) (lambda (outer-var2064 outer-maps2065) (let ((b2066 (assq outer-var2064 (car maps2063)))) (if b2066 (values (cdr b2066) maps2063) (let ((inner-var2067 (gen-var1260 (quote tmp)))) (values inner-var2067 (cons (cons (cons outer-var2064 inner-var2067) (car maps2063)) outer-maps2065))))))))))) (gen-syntax2033 (lambda (src2068 e2069 r2070 maps2071 ellipsis?2072 mod2073) (if (id?1212 e2069) (let ((label2074 (id-var-name1234 e2069 (quote (()))))) (let ((b2075 (lookup1209 label2074 r2070 mod2073))) (if (eq? (binding-type1204 b2075) (quote syntax)) (call-with-values (lambda () (let ((var.lev2076 (binding-value1205 b2075))) (gen-ref2034 src2068 (car var.lev2076) (cdr var.lev2076) maps2071))) (lambda (var2077 maps2078) (values (list (quote ref) var2077) maps2078))) (if (ellipsis?2072 e2069) (syntax-violation (quote syntax) "misplaced ellipsis" src2068) (values (list (quote quote) e2069) maps2071))))) ((lambda (tmp2079) ((lambda (tmp2080) (if (if tmp2080 (apply (lambda (dots2081 e2082) (ellipsis?2072 dots2081)) tmp2080) #f) (apply (lambda (dots2083 e2084) (gen-syntax2033 src2068 e2084 r2070 maps2071 (lambda (x2085) #f) mod2073)) tmp2080) ((lambda (tmp2086) (if (if tmp2086 (apply (lambda (x2087 dots2088 y2089) (ellipsis?2072 dots2088)) tmp2086) #f) (apply (lambda (x2090 dots2091 y2092) (let f2093 ((y2094 y2092) (k2095 (lambda (maps2096) (call-with-values (lambda () (gen-syntax2033 src2068 x2090 r2070 (cons (quote ()) maps2096) ellipsis?2072 mod2073)) (lambda (x2097 maps2098) (if (null? (car maps2098)) (syntax-violation (quote syntax) "extra ellipsis" src2068) (values (gen-map2036 x2097 (car maps2098)) (cdr maps2098)))))))) ((lambda (tmp2099) ((lambda (tmp2100) (if (if tmp2100 (apply (lambda (dots2101 y2102) (ellipsis?2072 dots2101)) tmp2100) #f) (apply (lambda (dots2103 y2104) (f2093 y2104 (lambda (maps2105) (call-with-values (lambda () (k2095 (cons (quote ()) maps2105))) (lambda (x2106 maps2107) (if (null? (car maps2107)) (syntax-violation (quote syntax) "extra ellipsis" src2068) (values (gen-mappend2035 x2106 (car maps2107)) (cdr maps2107)))))))) tmp2100) ((lambda (_2108) (call-with-values (lambda () (gen-syntax2033 src2068 y2094 r2070 maps2071 ellipsis?2072 mod2073)) (lambda (y2109 maps2110) (call-with-values (lambda () (k2095 maps2110)) (lambda (x2111 maps2112) (values (gen-append2038 x2111 y2109) maps2112)))))) tmp2099))) ($sc-dispatch tmp2099 (quote (any . any))))) y2094))) tmp2086) ((lambda (tmp2113) (if tmp2113 (apply (lambda (x2114 y2115) (call-with-values (lambda () (gen-syntax2033 src2068 x2114 r2070 maps2071 ellipsis?2072 mod2073)) (lambda (x2116 maps2117) (call-with-values (lambda () (gen-syntax2033 src2068 y2115 r2070 maps2117 ellipsis?2072 mod2073)) (lambda (y2118 maps2119) (values (gen-cons2037 x2116 y2118) maps2119)))))) tmp2113) ((lambda (tmp2120) (if tmp2120 (apply (lambda (e12121 e22122) (call-with-values (lambda () (gen-syntax2033 src2068 (cons e12121 e22122) r2070 maps2071 ellipsis?2072 mod2073)) (lambda (e2124 maps2125) (values (gen-vector2039 e2124) maps2125)))) tmp2120) ((lambda (_2126) (values (list (quote quote) e2069) maps2071)) tmp2079))) ($sc-dispatch tmp2079 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp2079 (quote (any . any)))))) ($sc-dispatch tmp2079 (quote (any any . any)))))) ($sc-dispatch tmp2079 (quote (any any))))) e2069))))) (lambda (e2127 r2128 w2129 s2130 mod2131) (let ((e2132 (source-wrap1241 e2127 w2129 s2130 mod2131))) ((lambda (tmp2133) ((lambda (tmp2134) (if tmp2134 (apply (lambda (_2135 x2136) (call-with-values (lambda () (gen-syntax2033 e2132 x2136 r2128 (quote ()) ellipsis?1257 mod2131)) (lambda (e2137 maps2138) (regen2040 e2137)))) tmp2134) ((lambda (_2139) (syntax-violation (quote syntax) "bad `syntax' form" e2132)) tmp2133))) ($sc-dispatch tmp2133 (quote (any any))))) e2132))))) (global-extend1210 (quote core) (quote lambda) (lambda (e2140 r2141 w2142 s2143 mod2144) ((lambda (tmp2145) ((lambda (tmp2146) (if tmp2146 (apply (lambda (_2147 c2148) (chi-lambda-clause1253 (source-wrap1241 e2140 w2142 s2143 mod2144) #f c2148 r2141 w2142 mod2144 (lambda (vars2149 docstring2150 body2151) (build-annotated1189 s2143 (cons (quote lambda) (cons vars2149 (append (if docstring2150 (list docstring2150) (quote ())) (list body2151)))))))) tmp2146) (syntax-violation #f "source expression failed to match any pattern" tmp2145))) ($sc-dispatch tmp2145 (quote (any . any))))) e2140))) (global-extend1210 (quote core) (quote let) (letrec ((chi-let2152 (lambda (e2153 r2154 w2155 s2156 mod2157 constructor2158 ids2159 vals2160 exps2161) (if (not (valid-bound-ids?1237 ids2159)) (syntax-violation (quote let) "duplicate bound variable" e2153) (let ((labels2162 (gen-labels1218 ids2159)) (new-vars2163 (map gen-var1260 ids2159))) (let ((nw2164 (make-binding-wrap1229 ids2159 labels2162 w2155)) (nr2165 (extend-var-env1207 labels2162 new-vars2163 r2154))) (constructor2158 s2156 new-vars2163 (map (lambda (x2166) (chi1248 x2166 r2154 w2155 mod2157)) vals2160) (chi-body1252 exps2161 (source-wrap1241 e2153 nw2164 s2156 mod2157) nr2165 nw2164 mod2157)))))))) (lambda (e2167 r2168 w2169 s2170 mod2171) ((lambda (tmp2172) ((lambda (tmp2173) (if tmp2173 (apply (lambda (_2174 id2175 val2176 e12177 e22178) (chi-let2152 e2167 r2168 w2169 s2170 mod2171 build-let1192 id2175 val2176 (cons e12177 e22178))) tmp2173) ((lambda (tmp2182) (if (if tmp2182 (apply (lambda (_2183 f2184 id2185 val2186 e12187 e22188) (id?1212 f2184)) tmp2182) #f) (apply (lambda (_2189 f2190 id2191 val2192 e12193 e22194) (chi-let2152 e2167 r2168 w2169 s2170 mod2171 build-named-let1193 (cons f2190 id2191) val2192 (cons e12193 e22194))) tmp2182) ((lambda (_2198) (syntax-violation (quote let) "bad let" (source-wrap1241 e2167 w2169 s2170 mod2171))) tmp2172))) ($sc-dispatch tmp2172 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2172 (quote (any #(each (any any)) any . each-any))))) e2167)))) (global-extend1210 (quote core) (quote letrec) (lambda (e2199 r2200 w2201 s2202 mod2203) ((lambda (tmp2204) ((lambda (tmp2205) (if tmp2205 (apply (lambda (_2206 id2207 val2208 e12209 e22210) (let ((ids2211 id2207)) (if (not (valid-bound-ids?1237 ids2211)) (syntax-violation (quote letrec) "duplicate bound variable" e2199) (let ((labels2213 (gen-labels1218 ids2211)) (new-vars2214 (map gen-var1260 ids2211))) (let ((w2215 (make-binding-wrap1229 ids2211 labels2213 w2201)) (r2216 (extend-var-env1207 labels2213 new-vars2214 r2200))) (build-letrec1194 s2202 new-vars2214 (map (lambda (x2217) (chi1248 x2217 r2216 w2215 mod2203)) val2208) (chi-body1252 (cons e12209 e22210) (source-wrap1241 e2199 w2215 s2202 mod2203) r2216 w2215 mod2203))))))) tmp2205) ((lambda (_2220) (syntax-violation (quote letrec) "bad letrec" (source-wrap1241 e2199 w2201 s2202 mod2203))) tmp2204))) ($sc-dispatch tmp2204 (quote (any #(each (any any)) any . each-any))))) e2199))) (global-extend1210 (quote core) (quote set!) (lambda (e2221 r2222 w2223 s2224 mod2225) ((lambda (tmp2226) ((lambda (tmp2227) (if (if tmp2227 (apply (lambda (_2228 id2229 val2230) (id?1212 id2229)) tmp2227) #f) (apply (lambda (_2231 id2232 val2233) (let ((val2234 (chi1248 val2233 r2222 w2223 mod2225)) (n2235 (id-var-name1234 id2232 w2223))) (let ((b2236 (lookup1209 n2235 r2222 mod2225))) (let ((t2237 (binding-type1204 b2236))) (if (memv t2237 (quote (lexical))) (build-annotated1189 s2224 (list (quote set!) (binding-value1205 b2236) val2234)) (if (memv t2237 (quote (global))) (build-annotated1189 s2224 (list (quote set!) (if mod2225 (make-module-ref (cdr mod2225) n2235 (car mod2225)) (make-module-ref mod2225 n2235 (quote bare))) val2234)) (if (memv t2237 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1240 id2232 w2223 mod2225)) (syntax-violation (quote set!) "bad set!" (source-wrap1241 e2221 w2223 s2224 mod2225))))))))) tmp2227) ((lambda (tmp2238) (if tmp2238 (apply (lambda (_2239 head2240 tail2241 val2242) (call-with-values (lambda () (syntax-type1246 head2240 r2222 (quote (())) #f #f mod2225)) (lambda (type2243 value2244 ee2245 ww2246 ss2247 modmod2248) (let ((t2249 type2243)) (if (memv t2249 (quote (module-ref))) (let ((val2250 (chi1248 val2242 r2222 w2223 mod2225))) (call-with-values (lambda () (value2244 (cons head2240 tail2241))) (lambda (id2252 mod2253) (build-annotated1189 s2224 (list (quote set!) (if mod2253 (make-module-ref (cdr mod2253) id2252 (car mod2253)) (make-module-ref mod2253 id2252 (quote bare))) val2250))))) (build-annotated1189 s2224 (cons (chi1248 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) head2240) r2222 w2223 mod2225) (map (lambda (e2254) (chi1248 e2254 r2222 w2223 mod2225)) (append tail2241 (list val2242)))))))))) tmp2238) ((lambda (_2256) (syntax-violation (quote set!) "bad set!" (source-wrap1241 e2221 w2223 s2224 mod2225))) tmp2226))) ($sc-dispatch tmp2226 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2226 (quote (any any any))))) e2221))) (global-extend1210 (quote module-ref) (quote @) (lambda (e2257) ((lambda (tmp2258) ((lambda (tmp2259) (if (if tmp2259 (apply (lambda (_2260 mod2261 id2262) (and (andmap id?1212 mod2261) (id?1212 id2262))) tmp2259) #f) (apply (lambda (_2264 mod2265 id2266) (values (syntax->datum id2266) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) mod2265)))) tmp2259) (syntax-violation #f "source expression failed to match any pattern" tmp2258))) ($sc-dispatch tmp2258 (quote (any each-any any))))) e2257))) (global-extend1210 (quote module-ref) (quote @@) (lambda (e2268) ((lambda (tmp2269) ((lambda (tmp2270) (if (if tmp2270 (apply (lambda (_2271 mod2272 id2273) (and (andmap id?1212 mod2272) (id?1212 id2273))) tmp2270) #f) (apply (lambda (_2275 mod2276 id2277) (values (syntax->datum id2277) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) mod2276)))) tmp2270) (syntax-violation #f "source expression failed to match any pattern" tmp2269))) ($sc-dispatch tmp2269 (quote (any each-any any))))) e2268))) (global-extend1210 (quote begin) (quote begin) (quote ())) (global-extend1210 (quote define) (quote define) (quote ())) (global-extend1210 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1210 (quote eval-when) (quote eval-when) (quote ())) (global-extend1210 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2282 (lambda (x2283 keys2284 clauses2285 r2286 mod2287) (if (null? clauses2285) (build-annotated1189 #f (list (build-annotated1189 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2283)) ((lambda (tmp2288) ((lambda (tmp2289) (if tmp2289 (apply (lambda (pat2290 exp2291) (if (and (id?1212 pat2290) (andmap (lambda (x2292) (not (free-id=?1235 pat2290 x2292))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "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))) keys2284))) (let ((labels2293 (list (gen-label1217))) (var2294 (gen-var1260 pat2290))) (build-annotated1189 #f (list (build-annotated1189 #f (list (quote lambda) (list var2294) (chi1248 exp2291 (extend-env1206 labels2293 (list (cons (quote syntax) (cons var2294 0))) r2286) (make-binding-wrap1229 (list pat2290) labels2293 (quote (()))) mod2287))) x2283))) (gen-clause2281 x2283 keys2284 (cdr clauses2285) r2286 pat2290 #t exp2291 mod2287))) tmp2289) ((lambda (tmp2295) (if tmp2295 (apply (lambda (pat2296 fender2297 exp2298) (gen-clause2281 x2283 keys2284 (cdr clauses2285) r2286 pat2296 fender2297 exp2298 mod2287)) tmp2295) ((lambda (_2299) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2285))) tmp2288))) ($sc-dispatch tmp2288 (quote (any any any)))))) ($sc-dispatch tmp2288 (quote (any any))))) (car clauses2285))))) (gen-clause2281 (lambda (x2300 keys2301 clauses2302 r2303 pat2304 fender2305 exp2306 mod2307) (call-with-values (lambda () (convert-pattern2279 pat2304 keys2301)) (lambda (p2308 pvars2309) (cond ((not (distinct-bound-ids?1238 (map car pvars2309))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2304)) ((not (andmap (lambda (x2310) (not (ellipsis?1257 (car x2310)))) pvars2309)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2304)) (else (let ((y2311 (gen-var1260 (quote tmp)))) (build-annotated1189 #f (list (build-annotated1189 #f (list (quote lambda) (list y2311) (let ((y2312 (build-annotated1189 #f y2311))) (build-annotated1189 #f (list (quote if) ((lambda (tmp2313) ((lambda (tmp2314) (if tmp2314 (apply (lambda () y2312) tmp2314) ((lambda (_2315) (build-annotated1189 #f (list (quote if) y2312 (build-dispatch-call2280 pvars2309 fender2305 y2312 r2303 mod2307) (build-data1190 #f #f)))) tmp2313))) ($sc-dispatch tmp2313 (quote #(atom #t))))) fender2305) (build-dispatch-call2280 pvars2309 exp2306 y2312 r2303 mod2307) (gen-syntax-case2282 x2300 keys2301 clauses2302 r2303 mod2307)))))) (if (eq? p2308 (quote any)) (build-annotated1189 #f (list (build-annotated1189 #f (quote list)) x2300)) (build-annotated1189 #f (list (build-annotated1189 #f (quote $sc-dispatch)) x2300 (build-data1190 #f p2308))))))))))))) (build-dispatch-call2280 (lambda (pvars2316 exp2317 y2318 r2319 mod2320) (let ((ids2321 (map car pvars2316)) (levels2322 (map cdr pvars2316))) (let ((labels2323 (gen-labels1218 ids2321)) (new-vars2324 (map gen-var1260 ids2321))) (build-annotated1189 #f (list (build-annotated1189 #f (quote apply)) (build-annotated1189 #f (list (quote lambda) new-vars2324 (chi1248 exp2317 (extend-env1206 labels2323 (map (lambda (var2325 level2326) (cons (quote syntax) (cons var2325 level2326))) new-vars2324 (map cdr pvars2316)) r2319) (make-binding-wrap1229 ids2321 labels2323 (quote (()))) mod2320))) y2318)))))) (convert-pattern2279 (lambda (pattern2327 keys2328) (let cvt2329 ((p2330 pattern2327) (n2331 0) (ids2332 (quote ()))) (if (id?1212 p2330) (if (bound-id-member?1239 p2330 keys2328) (values (vector (quote free-id) p2330) ids2332) (values (quote any) (cons (cons p2330 n2331) ids2332))) ((lambda (tmp2333) ((lambda (tmp2334) (if (if tmp2334 (apply (lambda (x2335 dots2336) (ellipsis?1257 dots2336)) tmp2334) #f) (apply (lambda (x2337 dots2338) (call-with-values (lambda () (cvt2329 x2337 (fx+1180 n2331 1) ids2332)) (lambda (p2339 ids2340) (values (if (eq? p2339 (quote any)) (quote each-any) (vector (quote each) p2339)) ids2340)))) tmp2334) ((lambda (tmp2341) (if tmp2341 (apply (lambda (x2342 y2343) (call-with-values (lambda () (cvt2329 y2343 n2331 ids2332)) (lambda (y2344 ids2345) (call-with-values (lambda () (cvt2329 x2342 n2331 ids2345)) (lambda (x2346 ids2347) (values (cons x2346 y2344) ids2347)))))) tmp2341) ((lambda (tmp2348) (if tmp2348 (apply (lambda () (values (quote ()) ids2332)) tmp2348) ((lambda (tmp2349) (if tmp2349 (apply (lambda (x2350) (call-with-values (lambda () (cvt2329 x2350 n2331 ids2332)) (lambda (p2352 ids2353) (values (vector (quote vector) p2352) ids2353)))) tmp2349) ((lambda (x2354) (values (vector (quote atom) (strip1259 p2330 (quote (())))) ids2332)) tmp2333))) ($sc-dispatch tmp2333 (quote #(vector each-any)))))) ($sc-dispatch tmp2333 (quote ()))))) ($sc-dispatch tmp2333 (quote (any . any)))))) ($sc-dispatch tmp2333 (quote (any any))))) p2330)))))) (lambda (e2355 r2356 w2357 s2358 mod2359) (let ((e2360 (source-wrap1241 e2355 w2357 s2358 mod2359))) ((lambda (tmp2361) ((lambda (tmp2362) (if tmp2362 (apply (lambda (_2363 val2364 key2365 m2366) (if (andmap (lambda (x2367) (and (id?1212 x2367) (not (ellipsis?1257 x2367)))) key2365) (let ((x2369 (gen-var1260 (quote tmp)))) (build-annotated1189 s2358 (list (build-annotated1189 #f (list (quote lambda) (list x2369) (gen-syntax-case2282 (build-annotated1189 #f x2369) key2365 m2366 r2356 mod2359))) (chi1248 val2364 r2356 (quote (())) mod2359)))) (syntax-violation (quote syntax-case) "invalid literals list" e2360))) tmp2362) (syntax-violation #f "source expression failed to match any pattern" tmp2361))) ($sc-dispatch tmp2361 (quote (any any each-any . each-any))))) e2360))))) (set! sc-expand (let ((m2372 (quote e)) (esew2373 (quote (eval)))) (lambda (x2374) (if (and (pair? x2374) (equal? (car x2374) noexpand1179)) (cadr x2374) (chi-top1247 x2374 (quote ()) (quote ((top))) m2372 esew2373 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2375 (quote e)) (esew2376 (quote (eval)))) (lambda (x2378 . rest2377) (if (and (pair? x2378) (equal? (car x2378) noexpand1179)) (cadr x2378) (chi-top1247 x2378 (quote ()) (quote ((top))) (if (null? rest2377) m2375 (car rest2377)) (if (or (null? rest2377) (null? (cdr rest2377))) esew2376 (cadr rest2377)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2379) (nonsymbol-id?1211 x2379))) (set! datum->syntax (lambda (id2380 datum2381) (make-syntax-object1195 datum2381 (syntax-object-wrap1198 id2380) #f))) (set! syntax->datum (lambda (x2382) (strip1259 x2382 (quote (()))))) (set! generate-temporaries (lambda (ls2383) (begin (let ((x2384 ls2383)) (if (not (list? x2384)) (error-hook1186 (quote generate-temporaries) "invalid argument" x2384))) (map (lambda (x2385) (wrap1240 (gensym) (quote ((top))) #f)) ls2383)))) (set! free-identifier=? (lambda (x2386 y2387) (begin (let ((x2388 x2386)) (if (not (nonsymbol-id?1211 x2388)) (error-hook1186 (quote free-identifier=?) "invalid argument" x2388))) (let ((x2389 y2387)) (if (not (nonsymbol-id?1211 x2389)) (error-hook1186 (quote free-identifier=?) "invalid argument" x2389))) (free-id=?1235 x2386 y2387)))) (set! bound-identifier=? (lambda (x2390 y2391) (begin (let ((x2392 x2390)) (if (not (nonsymbol-id?1211 x2392)) (error-hook1186 (quote bound-identifier=?) "invalid argument" x2392))) (let ((x2393 y2391)) (if (not (nonsymbol-id?1211 x2393)) (error-hook1186 (quote bound-identifier=?) "invalid argument" x2393))) (bound-id=?1236 x2390 y2391)))) (set! syntax-violation (lambda (who2397 message2396 form2395 . subform2394) (begin (let ((x2398 who2397)) (if (not ((lambda (x2399) (or (not x2399) (string? x2399) (symbol? x2399))) x2398)) (error-hook1186 (quote syntax-violation) "invalid argument" x2398))) (let ((x2400 message2396)) (if (not (string? x2400)) (error-hook1186 (quote syntax-violation) "invalid argument" x2400))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2397 "~a: " "") "~a " (if (null? subform2394) "in ~a" "in subform `~s' of `~s'")) (let ((tail2401 (cons message2396 (map (lambda (x2402) (strip1259 x2402 (quote (())))) (append subform2394 (list form2395)))))) (if who2397 (cons who2397 tail2401) tail2401)) #f)))) (letrec ((match2407 (lambda (e2408 p2409 w2410 r2411 mod2412) (cond ((not r2411) #f) ((eq? p2409 (quote any)) (cons (wrap1240 e2408 w2410 mod2412) r2411)) ((syntax-object?1196 e2408) (match*2406 (let ((e2413 (syntax-object-expression1197 e2408))) (if (annotation? e2413) (annotation-expression e2413) e2413)) p2409 (join-wraps1231 w2410 (syntax-object-wrap1198 e2408)) r2411 (syntax-object-module1199 e2408))) (else (match*2406 (let ((e2414 e2408)) (if (annotation? e2414) (annotation-expression e2414) e2414)) p2409 w2410 r2411 mod2412))))) (match*2406 (lambda (e2415 p2416 w2417 r2418 mod2419) (cond ((null? p2416) (and (null? e2415) r2418)) ((pair? p2416) (and (pair? e2415) (match2407 (car e2415) (car p2416) w2417 (match2407 (cdr e2415) (cdr p2416) w2417 r2418 mod2419) mod2419))) ((eq? p2416 (quote each-any)) (let ((l2420 (match-each-any2404 e2415 w2417 mod2419))) (and l2420 (cons l2420 r2418)))) (else (let ((t2421 (vector-ref p2416 0))) (if (memv t2421 (quote (each))) (if (null? e2415) (match-empty2405 (vector-ref p2416 1) r2418) (let ((l2422 (match-each2403 e2415 (vector-ref p2416 1) w2417 mod2419))) (and l2422 (let collect2423 ((l2424 l2422)) (if (null? (car l2424)) r2418 (cons (map car l2424) (collect2423 (map cdr l2424)))))))) (if (memv t2421 (quote (free-id))) (and (id?1212 e2415) (free-id=?1235 (wrap1240 e2415 w2417 mod2419) (vector-ref p2416 1)) r2418) (if (memv t2421 (quote (atom))) (and (equal? (vector-ref p2416 1) (strip1259 e2415 w2417)) r2418) (if (memv t2421 (quote (vector))) (and (vector? e2415) (match2407 (vector->list e2415) (vector-ref p2416 1) w2417 r2418 mod2419))))))))))) (match-empty2405 (lambda (p2425 r2426) (cond ((null? p2425) r2426) ((eq? p2425 (quote any)) (cons (quote ()) r2426)) ((pair? p2425) (match-empty2405 (car p2425) (match-empty2405 (cdr p2425) r2426))) ((eq? p2425 (quote each-any)) (cons (quote ()) r2426)) (else (let ((t2427 (vector-ref p2425 0))) (if (memv t2427 (quote (each))) (match-empty2405 (vector-ref p2425 1) r2426) (if (memv t2427 (quote (free-id atom))) r2426 (if (memv t2427 (quote (vector))) (match-empty2405 (vector-ref p2425 1) r2426))))))))) (match-each-any2404 (lambda (e2428 w2429 mod2430) (cond ((annotation? e2428) (match-each-any2404 (annotation-expression e2428) w2429 mod2430)) ((pair? e2428) (let ((l2431 (match-each-any2404 (cdr e2428) w2429 mod2430))) (and l2431 (cons (wrap1240 (car e2428) w2429 mod2430) l2431)))) ((null? e2428) (quote ())) ((syntax-object?1196 e2428) (match-each-any2404 (syntax-object-expression1197 e2428) (join-wraps1231 w2429 (syntax-object-wrap1198 e2428)) mod2430)) (else #f)))) (match-each2403 (lambda (e2432 p2433 w2434 mod2435) (cond ((annotation? e2432) (match-each2403 (annotation-expression e2432) p2433 w2434 mod2435)) ((pair? e2432) (let ((first2436 (match2407 (car e2432) p2433 w2434 (quote ()) mod2435))) (and first2436 (let ((rest2437 (match-each2403 (cdr e2432) p2433 w2434 mod2435))) (and rest2437 (cons first2436 rest2437)))))) ((null? e2432) (quote ())) ((syntax-object?1196 e2432) (match-each2403 (syntax-object-expression1197 e2432) p2433 (join-wraps1231 w2434 (syntax-object-wrap1198 e2432)) (syntax-object-module1199 e2432))) (else #f))))) (set! $sc-dispatch (lambda (e2438 p2439) (cond ((eq? p2439 (quote any)) (list e2438)) ((syntax-object?1196 e2438) (match*2406 (let ((e2440 (syntax-object-expression1197 e2438))) (if (annotation? e2440) (annotation-expression e2440) e2440)) p2439 (syntax-object-wrap1198 e2438) (quote ()) (syntax-object-module1199 e2438))) (else (match*2406 (let ((e2441 e2438)) (if (annotation? e2441) (annotation-expression e2441) e2441)) p2439 (quote (())) (quote ()) #f))))))))
-(define with-syntax (make-syncase-macro (quote macro) (lambda (x2442) ((lambda (tmp2443) ((lambda (tmp2444) (if tmp2444 (apply (lambda (_2445 e12446 e22447) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12446 e22447))) tmp2444) ((lambda (tmp2449) (if tmp2449 (apply (lambda (_2450 out2451 in2452 e12453 e22454) (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))) in2452 (quote ()) (list out2451 (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 e12453 e22454))))) tmp2449) ((lambda (tmp2456) (if tmp2456 (apply (lambda (_2457 out2458 in2459 e12460 e22461) (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))) in2459) (quote ()) (list out2458 (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 e12460 e22461))))) tmp2456) (syntax-violation #f "source expression failed to match any pattern" tmp2443))) ($sc-dispatch tmp2443 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2443 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2443 (quote (any () any . each-any))))) x2442))))
-(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2465) ((lambda (tmp2466) ((lambda (tmp2467) (if tmp2467 (apply (lambda (_2468 k2469 keyword2470 pattern2471 template2472) (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 k2469 (map (lambda (tmp2475 tmp2474) (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))) tmp2474) (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))) tmp2475))) template2472 pattern2471)))))) tmp2467) (syntax-violation #f "source expression failed to match any pattern" tmp2466))) ($sc-dispatch tmp2466 (quote (any each-any . #(each ((any . any) any))))))) x2465))))
-(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2476) ((lambda (tmp2477) ((lambda (tmp2478) (if (if tmp2478 (apply (lambda (let*2479 x2480 v2481 e12482 e22483) (andmap identifier? x2480)) tmp2478) #f) (apply (lambda (let*2485 x2486 v2487 e12488 e22489) (let f2490 ((bindings2491 (map list x2486 v2487))) (if (null? bindings2491) (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 e12488 e22489))) ((lambda (tmp2495) ((lambda (tmp2496) (if tmp2496 (apply (lambda (body2497 binding2498) (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 binding2498) body2497)) tmp2496) (syntax-violation #f "source expression failed to match any pattern" tmp2495))) ($sc-dispatch tmp2495 (quote (any any))))) (list (f2490 (cdr bindings2491)) (car bindings2491)))))) tmp2478) (syntax-violation #f "source expression failed to match any pattern" tmp2477))) ($sc-dispatch tmp2477 (quote (any #(each (any any)) any . each-any))))) x2476))))
-(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2499) ((lambda (tmp2500) ((lambda (tmp2501) (if tmp2501 (apply (lambda (_2502 var2503 init2504 step2505 e02506 e12507 c2508) ((lambda (tmp2509) ((lambda (tmp2510) (if tmp2510 (apply (lambda (step2511) ((lambda (tmp2512) ((lambda (tmp2513) (if tmp2513 (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 var2503 init2504) (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))) e02506) (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 c2508 (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))) step2511))))))) tmp2513) ((lambda (tmp2518) (if tmp2518 (apply (lambda (e12519 e22520) (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 var2503 init2504) (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))) e02506 (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 e12519 e22520)) (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 c2508 (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))) step2511))))))) tmp2518) (syntax-violation #f "source expression failed to match any pattern" tmp2512))) ($sc-dispatch tmp2512 (quote (any . each-any)))))) ($sc-dispatch tmp2512 (quote ())))) e12507)) tmp2510) (syntax-violation #f "source expression failed to match any pattern" tmp2509))) ($sc-dispatch tmp2509 (quote each-any)))) (map (lambda (v2527 s2528) ((lambda (tmp2529) ((lambda (tmp2530) (if tmp2530 (apply (lambda () v2527) tmp2530) ((lambda (tmp2531) (if tmp2531 (apply (lambda (e2532) e2532) tmp2531) ((lambda (_2533) (syntax-violation (quote do) "bad step expression" orig-x2499 s2528)) tmp2529))) ($sc-dispatch tmp2529 (quote (any)))))) ($sc-dispatch tmp2529 (quote ())))) s2528)) var2503 step2505))) tmp2501) (syntax-violation #f "source expression failed to match any pattern" tmp2500))) ($sc-dispatch tmp2500 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2499))))
-(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2536 (lambda (x2540 y2541) ((lambda (tmp2542) ((lambda (tmp2543) (if tmp2543 (apply (lambda (x2544 y2545) ((lambda (tmp2546) ((lambda (tmp2547) (if tmp2547 (apply (lambda (dy2548) ((lambda (tmp2549) ((lambda (tmp2550) (if tmp2550 (apply (lambda (dx2551) (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 dx2551 dy2548))) tmp2550) ((lambda (_2552) (if (null? dy2548) (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))) x2544) (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))) x2544 y2545))) tmp2549))) ($sc-dispatch tmp2549 (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))))) x2544)) tmp2547) ((lambda (tmp2553) (if tmp2553 (apply (lambda (stuff2554) (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 x2544 stuff2554))) tmp2553) ((lambda (else2555) (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))) x2544 y2545)) tmp2546))) ($sc-dispatch tmp2546 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp2546 (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))))) y2545)) tmp2543) (syntax-violation #f "source expression failed to match any pattern" tmp2542))) ($sc-dispatch tmp2542 (quote (any any))))) (list x2540 y2541)))) (quasiappend2537 (lambda (x2556 y2557) ((lambda (tmp2558) ((lambda (tmp2559) (if tmp2559 (apply (lambda (x2560 y2561) ((lambda (tmp2562) ((lambda (tmp2563) (if tmp2563 (apply (lambda () x2560) tmp2563) ((lambda (_2564) (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))) x2560 y2561)) tmp2562))) ($sc-dispatch tmp2562 (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))) ()))))) y2561)) tmp2559) (syntax-violation #f "source expression failed to match any pattern" tmp2558))) ($sc-dispatch tmp2558 (quote (any any))))) (list x2556 y2557)))) (quasivector2538 (lambda (x2565) ((lambda (tmp2566) ((lambda (x2567) ((lambda (tmp2568) ((lambda (tmp2569) (if tmp2569 (apply (lambda (x2570) (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 x2570))) tmp2569) ((lambda (tmp2572) (if tmp2572 (apply (lambda (x2573) (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))) x2573)) tmp2572) ((lambda (_2575) (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))) x2567)) tmp2568))) ($sc-dispatch tmp2568 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp2568 (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))))) x2567)) tmp2566)) x2565))) (quasi2539 (lambda (p2576 lev2577) ((lambda (tmp2578) ((lambda (tmp2579) (if tmp2579 (apply (lambda (p2580) (if (= lev2577 0) p2580 (quasicons2536 (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)))) (quasi2539 (list p2580) (- lev2577 1))))) tmp2579) ((lambda (tmp2581) (if tmp2581 (apply (lambda (p2582 q2583) (if (= lev2577 0) (quasiappend2537 p2582 (quasi2539 q2583 lev2577)) (quasicons2536 (quasicons2536 (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)))) (quasi2539 (list p2582) (- lev2577 1))) (quasi2539 q2583 lev2577)))) tmp2581) ((lambda (tmp2584) (if tmp2584 (apply (lambda (p2585) (quasicons2536 (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)))) (quasi2539 (list p2585) (+ lev2577 1)))) tmp2584) ((lambda (tmp2586) (if tmp2586 (apply (lambda (p2587 q2588) (quasicons2536 (quasi2539 p2587 lev2577) (quasi2539 q2588 lev2577))) tmp2586) ((lambda (tmp2589) (if tmp2589 (apply (lambda (x2590) (quasivector2538 (quasi2539 x2590 lev2577))) tmp2589) ((lambda (p2592) (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))) p2592)) tmp2578))) ($sc-dispatch tmp2578 (quote #(vector each-any)))))) ($sc-dispatch tmp2578 (quote (any . any)))))) ($sc-dispatch tmp2578 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp2578 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp2578 (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))))) p2576)))) (lambda (x2593) ((lambda (tmp2594) ((lambda (tmp2595) (if tmp2595 (apply (lambda (_2596 e2597) (quasi2539 e2597 0)) tmp2595) (syntax-violation #f "source expression failed to match any pattern" tmp2594))) ($sc-dispatch tmp2594 (quote (any any))))) x2593)))))
-(define include (make-syncase-macro (quote macro) (lambda (x2598) (letrec ((read-file2599 (lambda (fn2600 k2601) (let ((p2602 (open-input-file fn2600))) (let f2603 ((x2604 (read p2602))) (if (eof-object? x2604) (begin (close-input-port p2602) (quote ())) (cons (datum->syntax k2601 x2604) (f2603 (read p2602))))))))) ((lambda (tmp2605) ((lambda (tmp2606) (if tmp2606 (apply (lambda (k2607 filename2608) (let ((fn2609 (syntax->datum filename2608))) ((lambda (tmp2610) ((lambda (tmp2611) (if tmp2611 (apply (lambda (exp2612) (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))) exp2612)) tmp2611) (syntax-violation #f "source expression failed to match any pattern" tmp2610))) ($sc-dispatch tmp2610 (quote each-any)))) (read-file2599 fn2609 k2607)))) tmp2606) (syntax-violation #f "source expression failed to match any pattern" tmp2605))) ($sc-dispatch tmp2605 (quote (any any))))) x2598)))))
-(define unquote (make-syncase-macro (quote macro) (lambda (x2614) ((lambda (tmp2615) ((lambda (tmp2616) (if tmp2616 (apply (lambda (_2617 e2618) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum e2618))) tmp2616) (syntax-violation #f "source expression failed to match any pattern" tmp2615))) ($sc-dispatch tmp2615 (quote (any any))))) x2614))))
-(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2619) ((lambda (tmp2620) ((lambda (tmp2621) (if tmp2621 (apply (lambda (_2622 e2623) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax->datum e2623))) tmp2621) (syntax-violation #f "source expression failed to match any pattern" tmp2620))) ($sc-dispatch tmp2620 (quote (any any))))) x2619))))
-(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2624) ((lambda (tmp2625) ((lambda (tmp2626) (if tmp2626 (apply (lambda (_2627 e2628 m12629 m22630) ((lambda (tmp2631) ((lambda (body2632) (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))) e2628)) body2632)) tmp2631)) (let f2633 ((clause2634 m12629) (clauses2635 m22630)) (if (null? clauses2635) ((lambda (tmp2637) ((lambda (tmp2638) (if tmp2638 (apply (lambda (e12639 e22640) (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 e12639 e22640))) tmp2638) ((lambda (tmp2642) (if tmp2642 (apply (lambda (k2643 e12644 e22645) (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))) k2643)) (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 e12644 e22645)))) tmp2642) ((lambda (_2648) (syntax-violation (quote case) "bad clause" x2624 clause2634)) tmp2637))) ($sc-dispatch tmp2637 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2637 (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))))) clause2634) ((lambda (tmp2649) ((lambda (rest2650) ((lambda (tmp2651) ((lambda (tmp2652) (if tmp2652 (apply (lambda (k2653 e12654 e22655) (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))) k2653)) (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 e12654 e22655)) rest2650)) tmp2652) ((lambda (_2658) (syntax-violation (quote case) "bad clause" x2624 clause2634)) tmp2651))) ($sc-dispatch tmp2651 (quote (each-any any . each-any))))) clause2634)) tmp2649)) (f2633 (car clauses2635) (cdr clauses2635))))))) tmp2626) (syntax-violation #f "source expression failed to match any pattern" tmp2625))) ($sc-dispatch tmp2625 (quote (any any any . each-any))))) x2624))))
-(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2659) ((lambda (tmp2660) ((lambda (tmp2661) (if tmp2661 (apply (lambda (_2662 e2663) (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))) e2663)) (list (cons _2662 (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 e2663 (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)))))))))) tmp2661) (syntax-violation #f "source expression failed to match any pattern" tmp2660))) ($sc-dispatch tmp2660 (quote (any any))))) x2659))))
+(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
+(void)
+(letrec ((and-map*1002 (lambda (f1042 first1041 . rest1040) (or (null? first1041) (if (null? rest1040) (let andmap1043 ((first1044 first1041)) (let ((x1045 (car first1044)) (first1046 (cdr first1044))) (if (null? first1046) (f1042 x1045) (and (f1042 x1045) (andmap1043 first1046))))) (let andmap1047 ((first1048 first1041) (rest1049 rest1040)) (let ((x1050 (car first1048)) (xr1051 (map car rest1049)) (first1052 (cdr first1048)) (rest1053 (map cdr rest1049))) (if (null? first1052) (apply f1042 (cons x1050 xr1051)) (and (apply f1042 (cons x1050 xr1051)) (andmap1047 first1052 rest1053)))))))))) (letrec ((lambda-var-list1136 (lambda (vars1341) (let lvl1342 ((vars1343 vars1341) (ls1344 (quote ())) (w1345 (quote (())))) (cond ((pair? vars1343) (lvl1342 (cdr vars1343) (cons (wrap1115 (car vars1343) w1345 #f) ls1344) w1345)) ((id?1087 vars1343) (cons (wrap1115 vars1343 w1345 #f) ls1344)) ((null? vars1343) ls1344) ((syntax-object?1071 vars1343) (lvl1342 (syntax-object-expression1072 vars1343) ls1344 (join-wraps1106 w1345 (syntax-object-wrap1073 vars1343)))) ((annotation? vars1343) (lvl1342 (annotation-expression vars1343) ls1344 w1345)) (else (cons vars1343 ls1344)))))) (gen-var1135 (lambda (id1346) (let ((id1347 (if (syntax-object?1071 id1346) (syntax-object-expression1072 id1346) id1346))) (if (annotation? id1347) (build-annotated1064 (annotation-source id1347) (gensym (symbol->string (annotation-expression id1347)))) (build-annotated1064 #f (gensym (symbol->string id1347))))))) (strip1134 (lambda (x1348 w1349) (if (memq (quote top) (wrap-marks1090 w1349)) (if (or (annotation? x1348) (and (pair? x1348) (annotation? (car x1348)))) (strip-annotation1133 x1348 #f) x1348) (let f1350 ((x1351 x1348)) (cond ((syntax-object?1071 x1351) (strip1134 (syntax-object-expression1072 x1351) (syntax-object-wrap1073 x1351))) ((pair? x1351) (let ((a1352 (f1350 (car x1351))) (d1353 (f1350 (cdr x1351)))) (if (and (eq? a1352 (car x1351)) (eq? d1353 (cdr x1351))) x1351 (cons a1352 d1353)))) ((vector? x1351) (let ((old1354 (vector->list x1351))) (let ((new1355 (map f1350 old1354))) (if (and-map*1002 eq? old1354 new1355) x1351 (list->vector new1355))))) (else x1351)))))) (strip-annotation1133 (lambda (x1356 parent1357) (cond ((pair? x1356) (let ((new1358 (cons #f #f))) (begin (if parent1357 (set-annotation-stripped! parent1357 new1358)) (set-car! new1358 (strip-annotation1133 (car x1356) #f)) (set-cdr! new1358 (strip-annotation1133 (cdr x1356) #f)) new1358))) ((annotation? x1356) (or (annotation-stripped x1356) (strip-annotation1133 (annotation-expression x1356) x1356))) ((vector? x1356) (let ((new1359 (make-vector (vector-length x1356)))) (begin (if parent1357 (set-annotation-stripped! parent1357 new1359)) (let loop1360 ((i1361 (- (vector-length x1356) 1))) (unless (fx<1058 i1361 0) (vector-set! new1359 i1361 (strip-annotation1133 (vector-ref x1356 i1361) #f)) (loop1360 (fx-1056 i1361 1)))) new1359))) (else x1356)))) (ellipsis?1132 (lambda (x1362) (and (nonsymbol-id?1086 x1362) (free-id=?1110 x1362 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))))))) (chi-void1131 (lambda () (build-annotated1064 #f (list (build-annotated1064 #f (quote void)))))) (eval-local-transformer1130 (lambda (expanded1363 mod1364) (let ((p1365 (local-eval-hook1060 expanded1363 mod1364))) (if (procedure? p1365) p1365 (syntax-violation #f "nonprocedure transformer" p1365))))) (chi-local-syntax1129 (lambda (rec?1366 e1367 r1368 w1369 s1370 mod1371 k1372) ((lambda (tmp1373) ((lambda (tmp1374) (if tmp1374 (apply (lambda (_1375 id1376 val1377 e11378 e21379) (let ((ids1380 id1376)) (if (not (valid-bound-ids?1112 ids1380)) (syntax-violation #f "duplicate bound keyword" e1367) (let ((labels1382 (gen-labels1093 ids1380))) (let ((new-w1383 (make-binding-wrap1104 ids1380 labels1382 w1369))) (k1372 (cons e11378 e21379) (extend-env1081 labels1382 (let ((w1385 (if rec?1366 new-w1383 w1369)) (trans-r1386 (macros-only-env1083 r1368))) (map (lambda (x1387) (cons (quote macro) (eval-local-transformer1130 (chi1123 x1387 trans-r1386 w1385 mod1371) mod1371))) val1377)) r1368) new-w1383 s1370 mod1371)))))) tmp1374) ((lambda (_1389) (syntax-violation #f "bad local syntax definition" (source-wrap1116 e1367 w1369 s1370 mod1371))) tmp1373))) ($sc-dispatch tmp1373 (quote (any #(each (any any)) any . each-any))))) e1367))) (chi-lambda-clause1128 (lambda (e1390 docstring1391 c1392 r1393 w1394 mod1395 k1396) ((lambda (tmp1397) ((lambda (tmp1398) (if (if tmp1398 (apply (lambda (args1399 doc1400 e11401 e21402) (and (string? (syntax->datum doc1400)) (not docstring1391))) tmp1398) #f) (apply (lambda (args1403 doc1404 e11405 e21406) (chi-lambda-clause1128 e1390 doc1404 (cons args1403 (cons e11405 e21406)) r1393 w1394 mod1395 k1396)) tmp1398) ((lambda (tmp1408) (if tmp1408 (apply (lambda (id1409 e11410 e21411) (let ((ids1412 id1409)) (if (not (valid-bound-ids?1112 ids1412)) (syntax-violation (quote lambda) "invalid parameter list" e1390) (let ((labels1414 (gen-labels1093 ids1412)) (new-vars1415 (map gen-var1135 ids1412))) (k1396 new-vars1415 docstring1391 (chi-body1127 (cons e11410 e21411) e1390 (extend-var-env1082 labels1414 new-vars1415 r1393) (make-binding-wrap1104 ids1412 labels1414 w1394) mod1395)))))) tmp1408) ((lambda (tmp1417) (if tmp1417 (apply (lambda (ids1418 e11419 e21420) (let ((old-ids1421 (lambda-var-list1136 ids1418))) (if (not (valid-bound-ids?1112 old-ids1421)) (syntax-violation (quote lambda) "invalid parameter list" e1390) (let ((labels1422 (gen-labels1093 old-ids1421)) (new-vars1423 (map gen-var1135 old-ids1421))) (k1396 (let f1424 ((ls11425 (cdr new-vars1423)) (ls21426 (car new-vars1423))) (if (null? ls11425) ls21426 (f1424 (cdr ls11425) (cons (car ls11425) ls21426)))) docstring1391 (chi-body1127 (cons e11419 e21420) e1390 (extend-var-env1082 labels1422 new-vars1423 r1393) (make-binding-wrap1104 old-ids1421 labels1422 w1394) mod1395)))))) tmp1417) ((lambda (_1428) (syntax-violation (quote lambda) "bad lambda" e1390)) tmp1397))) ($sc-dispatch tmp1397 (quote (any any . each-any)))))) ($sc-dispatch tmp1397 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1397 (quote (any any any . each-any))))) c1392))) (chi-body1127 (lambda (body1429 outer-form1430 r1431 w1432 mod1433) (let ((r1434 (cons (quote ("placeholder" placeholder)) r1431))) (let ((ribcage1435 (make-ribcage1094 (quote ()) (quote ()) (quote ())))) (let ((w1436 (make-wrap1089 (wrap-marks1090 w1432) (cons ribcage1435 (wrap-subst1091 w1432))))) (let parse1437 ((body1438 (map (lambda (x1444) (cons r1434 (wrap1115 x1444 w1436 mod1433))) body1429)) (ids1439 (quote ())) (labels1440 (quote ())) (vars1441 (quote ())) (vals1442 (quote ())) (bindings1443 (quote ()))) (if (null? body1438) (syntax-violation #f "no expressions in body" outer-form1430) (let ((e1445 (cdar body1438)) (er1446 (caar body1438))) (call-with-values (lambda () (syntax-type1121 e1445 er1446 (quote (())) #f ribcage1435 mod1433)) (lambda (type1447 value1448 e1449 w1450 s1451 mod1452) (let ((t1453 type1447)) (if (memv t1453 (quote (define-form))) (let ((id1454 (wrap1115 value1448 w1450 mod1452)) (label1455 (gen-label1092))) (let ((var1456 (gen-var1135 id1454))) (begin (extend-ribcage!1103 ribcage1435 id1454 label1455) (parse1437 (cdr body1438) (cons id1454 ids1439) (cons label1455 labels1440) (cons var1456 vars1441) (cons (cons er1446 (wrap1115 e1449 w1450 mod1452)) vals1442) (cons (cons (quote lexical) var1456) bindings1443))))) (if (memv t1453 (quote (define-syntax-form))) (let ((id1457 (wrap1115 value1448 w1450 mod1452)) (label1458 (gen-label1092))) (begin (extend-ribcage!1103 ribcage1435 id1457 label1458) (parse1437 (cdr body1438) (cons id1457 ids1439) (cons label1458 labels1440) vars1441 vals1442 (cons (cons (quote macro) (cons er1446 (wrap1115 e1449 w1450 mod1452))) bindings1443)))) (if (memv t1453 (quote (begin-form))) ((lambda (tmp1459) ((lambda (tmp1460) (if tmp1460 (apply (lambda (_1461 e11462) (parse1437 (let f1463 ((forms1464 e11462)) (if (null? forms1464) (cdr body1438) (cons (cons er1446 (wrap1115 (car forms1464) w1450 mod1452)) (f1463 (cdr forms1464))))) ids1439 labels1440 vars1441 vals1442 bindings1443)) tmp1460) (syntax-violation #f "source expression failed to match any pattern" tmp1459))) ($sc-dispatch tmp1459 (quote (any . each-any))))) e1449) (if (memv t1453 (quote (local-syntax-form))) (chi-local-syntax1129 value1448 e1449 er1446 w1450 s1451 mod1452 (lambda (forms1466 er1467 w1468 s1469 mod1470) (parse1437 (let f1471 ((forms1472 forms1466)) (if (null? forms1472) (cdr body1438) (cons (cons er1467 (wrap1115 (car forms1472) w1468 mod1470)) (f1471 (cdr forms1472))))) ids1439 labels1440 vars1441 vals1442 bindings1443))) (if (null? ids1439) (build-sequence1066 #f (map (lambda (x1473) (chi1123 (cdr x1473) (car x1473) (quote (())) mod1452)) (cons (cons er1446 (source-wrap1116 e1449 w1450 s1451 mod1452)) (cdr body1438)))) (begin (if (not (valid-bound-ids?1112 ids1439)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1430)) (let loop1474 ((bs1475 bindings1443) (er-cache1476 #f) (r-cache1477 #f)) (if (not (null? bs1475)) (let ((b1478 (car bs1475))) (if (eq? (car b1478) (quote macro)) (let ((er1479 (cadr b1478))) (let ((r-cache1480 (if (eq? er1479 er-cache1476) r-cache1477 (macros-only-env1083 er1479)))) (begin (set-cdr! b1478 (eval-local-transformer1130 (chi1123 (cddr b1478) r-cache1480 (quote (())) mod1452) mod1452)) (loop1474 (cdr bs1475) er1479 r-cache1480)))) (loop1474 (cdr bs1475) er-cache1476 r-cache1477))))) (set-cdr! r1434 (extend-env1081 labels1440 bindings1443 (cdr r1434))) (build-letrec1069 #f vars1441 (map (lambda (x1481) (chi1123 (cdr x1481) (car x1481) (quote (())) mod1452)) vals1442) (build-sequence1066 #f (map (lambda (x1482) (chi1123 (cdr x1482) (car x1482) (quote (())) mod1452)) (cons (cons er1446 (source-wrap1116 e1449 w1450 s1451 mod1452)) (cdr body1438)))))))))))))))))))))) (chi-macro1126 (lambda (p1483 e1484 r1485 w1486 rib1487 mod1488) (letrec ((rebuild-macro-output1489 (lambda (x1490 m1491) (cond ((pair? x1490) (cons (rebuild-macro-output1489 (car x1490) m1491) (rebuild-macro-output1489 (cdr x1490) m1491))) ((syntax-object?1071 x1490) (let ((w1492 (syntax-object-wrap1073 x1490))) (let ((ms1493 (wrap-marks1090 w1492)) (s1494 (wrap-subst1091 w1492))) (if (and (pair? ms1493) (eq? (car ms1493) #f)) (make-syntax-object1070 (syntax-object-expression1072 x1490) (make-wrap1089 (cdr ms1493) (if rib1487 (cons rib1487 (cdr s1494)) (cdr s1494))) (syntax-object-module1074 x1490)) (make-syntax-object1070 (syntax-object-expression1072 x1490) (make-wrap1089 (cons m1491 ms1493) (if rib1487 (cons rib1487 (cons (quote shift) s1494)) (cons (quote shift) s1494))) (let ((pmod1495 (procedure-module p1483))) (if pmod1495 (cons (quote hygiene) (module-name pmod1495)) (quote (hygiene guile))))))))) ((vector? x1490) (let ((n1496 (vector-length x1490))) (let ((v1497 (make-vector n1496))) (let doloop1498 ((i1499 0)) (if (fx=1057 i1499 n1496) v1497 (begin (vector-set! v1497 i1499 (rebuild-macro-output1489 (vector-ref x1490 i1499) m1491)) (doloop1498 (fx+1055 i1499 1)))))))) ((symbol? x1490) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1116 e1484 w1486 s mod1488) x1490)) (else x1490))))) (rebuild-macro-output1489 (p1483 (wrap1115 e1484 (anti-mark1102 w1486) mod1488)) (string #\m))))) (chi-application1125 (lambda (x1500 e1501 r1502 w1503 s1504 mod1505) ((lambda (tmp1506) ((lambda (tmp1507) (if tmp1507 (apply (lambda (e01508 e11509) (build-annotated1064 s1504 (cons x1500 (map (lambda (e1510) (chi1123 e1510 r1502 w1503 mod1505)) e11509)))) tmp1507) (syntax-violation #f "source expression failed to match any pattern" tmp1506))) ($sc-dispatch tmp1506 (quote (any . each-any))))) e1501))) (chi-expr1124 (lambda (type1512 value1513 e1514 r1515 w1516 s1517 mod1518) (let ((t1519 type1512)) (if (memv t1519 (quote (lexical))) (build-annotated1064 s1517 value1513) (if (memv t1519 (quote (core external-macro))) (value1513 e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (module-ref))) (call-with-values (lambda () (value1513 e1514)) (lambda (id1520 mod1521) (build-annotated1064 s1517 (if mod1521 (make-module-ref (cdr mod1521) id1520 (car mod1521)) (make-module-ref mod1521 id1520 (quote bare)))))) (if (memv t1519 (quote (lexical-call))) (chi-application1125 (build-annotated1064 (source-annotation1078 (car e1514)) value1513) e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (global-call))) (chi-application1125 (build-annotated1064 (source-annotation1078 (car e1514)) (if (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518) (make-module-ref (cdr (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518)) value1513 (car (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518))) (make-module-ref (if (syntax-object?1071 (car e1514)) (syntax-object-module1074 (car e1514)) mod1518) value1513 (quote bare)))) e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (constant))) (build-data1065 s1517 (strip1134 (source-wrap1116 e1514 w1516 s1517 mod1518) (quote (())))) (if (memv t1519 (quote (global))) (build-annotated1064 s1517 (if mod1518 (make-module-ref (cdr mod1518) value1513 (car mod1518)) (make-module-ref mod1518 value1513 (quote bare)))) (if (memv t1519 (quote (call))) (chi-application1125 (chi1123 (car e1514) r1515 w1516 mod1518) e1514 r1515 w1516 s1517 mod1518) (if (memv t1519 (quote (begin-form))) ((lambda (tmp1522) ((lambda (tmp1523) (if tmp1523 (apply (lambda (_1524 e11525 e21526) (chi-sequence1117 (cons e11525 e21526) r1515 w1516 s1517 mod1518)) tmp1523) (syntax-violation #f "source expression failed to match any pattern" tmp1522))) ($sc-dispatch tmp1522 (quote (any any . each-any))))) e1514) (if (memv t1519 (quote (local-syntax-form))) (chi-local-syntax1129 value1513 e1514 r1515 w1516 s1517 mod1518 chi-sequence1117) (if (memv t1519 (quote (eval-when-form))) ((lambda (tmp1528) ((lambda (tmp1529) (if tmp1529 (apply (lambda (_1530 x1531 e11532 e21533) (let ((when-list1534 (chi-when-list1120 e1514 x1531 w1516))) (if (memq (quote eval) when-list1534) (chi-sequence1117 (cons e11532 e21533) r1515 w1516 s1517 mod1518) (chi-void1131)))) tmp1529) (syntax-violation #f "source expression failed to match any pattern" tmp1528))) ($sc-dispatch tmp1528 (quote (any each-any any . each-any))))) e1514) (if (memv t1519 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1514 (wrap1115 value1513 w1516 mod1518)) (if (memv t1519 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1116 e1514 w1516 s1517 mod1518)) (if (memv t1519 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1116 e1514 w1516 s1517 mod1518)) (syntax-violation #f "unexpected syntax" (source-wrap1116 e1514 w1516 s1517 mod1518))))))))))))))))))) (chi1123 (lambda (e1537 r1538 w1539 mod1540) (call-with-values (lambda () (syntax-type1121 e1537 r1538 w1539 #f #f mod1540)) (lambda (type1541 value1542 e1543 w1544 s1545 mod1546) (chi-expr1124 type1541 value1542 e1543 r1538 w1544 s1545 mod1546))))) (chi-top1122 (lambda (e1547 r1548 w1549 m1550 esew1551 mod1552) (call-with-values (lambda () (syntax-type1121 e1547 r1548 w1549 #f #f mod1552)) (lambda (type1560 value1561 e1562 w1563 s1564 mod1565) (let ((t1566 type1560)) (if (memv t1566 (quote (begin-form))) ((lambda (tmp1567) ((lambda (tmp1568) (if tmp1568 (apply (lambda (_1569) (chi-void1131)) tmp1568) ((lambda (tmp1570) (if tmp1570 (apply (lambda (_1571 e11572 e21573) (chi-top-sequence1118 (cons e11572 e21573) r1548 w1563 s1564 m1550 esew1551 mod1565)) tmp1570) (syntax-violation #f "source expression failed to match any pattern" tmp1567))) ($sc-dispatch tmp1567 (quote (any any . each-any)))))) ($sc-dispatch tmp1567 (quote (any))))) e1562) (if (memv t1566 (quote (local-syntax-form))) (chi-local-syntax1129 value1561 e1562 r1548 w1563 s1564 mod1565 (lambda (body1575 r1576 w1577 s1578 mod1579) (chi-top-sequence1118 body1575 r1576 w1577 s1578 m1550 esew1551 mod1579))) (if (memv t1566 (quote (eval-when-form))) ((lambda (tmp1580) ((lambda (tmp1581) (if tmp1581 (apply (lambda (_1582 x1583 e11584 e21585) (let ((when-list1586 (chi-when-list1120 e1562 x1583 w1563)) (body1587 (cons e11584 e21585))) (cond ((eq? m1550 (quote e)) (if (memq (quote eval) when-list1586) (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote e) (quote (eval)) mod1565) (chi-void1131))) ((memq (quote load) when-list1586) (if (or (memq (quote compile) when-list1586) (and (eq? m1550 (quote c&e)) (memq (quote eval) when-list1586))) (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote c&e) (quote (compile load)) mod1565) (if (memq m1550 (quote (c c&e))) (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote c) (quote (load)) mod1565) (chi-void1131)))) ((or (memq (quote compile) when-list1586) (and (eq? m1550 (quote c&e)) (memq (quote eval) when-list1586))) (top-level-eval-hook1059 (chi-top-sequence1118 body1587 r1548 w1563 s1564 (quote e) (quote (eval)) mod1565) mod1565) (chi-void1131)) (else (chi-void1131))))) tmp1581) (syntax-violation #f "source expression failed to match any pattern" tmp1580))) ($sc-dispatch tmp1580 (quote (any each-any any . each-any))))) e1562) (if (memv t1566 (quote (define-syntax-form))) (let ((n1590 (id-var-name1109 value1561 w1563)) (r1591 (macros-only-env1083 r1548))) (let ((t1592 m1550)) (if (memv t1592 (quote (c))) (if (memq (quote compile) esew1551) (let ((e1593 (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)))) (begin (top-level-eval-hook1059 e1593 mod1565) (if (memq (quote load) esew1551) e1593 (chi-void1131)))) (if (memq (quote load) esew1551) (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)) (chi-void1131))) (if (memv t1592 (quote (c&e))) (let ((e1594 (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)))) (begin (top-level-eval-hook1059 e1594 mod1565) e1594)) (begin (if (memq (quote eval) esew1551) (top-level-eval-hook1059 (chi-install-global1119 n1590 (chi1123 e1562 r1591 w1563 mod1565)) mod1565)) (chi-void1131)))))) (if (memv t1566 (quote (define-form))) (let ((n1595 (id-var-name1109 value1561 w1563))) (let ((type1596 (binding-type1079 (lookup1084 n1595 r1548 mod1565)))) (let ((t1597 type1596)) (if (memv t1597 (quote (global core macro module-ref))) (let ((x1598 (build-annotated1064 s1564 (list (quote define) n1595 (chi1123 e1562 r1548 w1563 mod1565))))) (begin (if (eq? m1550 (quote c&e)) (top-level-eval-hook1059 x1598 mod1565)) x1598)) (if (memv t1597 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1562 (wrap1115 value1561 w1563 mod1565)) (syntax-violation #f "cannot define keyword at top level" e1562 (wrap1115 value1561 w1563 mod1565))))))) (let ((x1599 (chi-expr1124 type1560 value1561 e1562 r1548 w1563 s1564 mod1565))) (begin (if (eq? m1550 (quote c&e)) (top-level-eval-hook1059 x1599 mod1565)) x1599)))))))))))) (syntax-type1121 (lambda (e1600 r1601 w1602 s1603 rib1604 mod1605) (cond ((symbol? e1600) (let ((n1606 (id-var-name1109 e1600 w1602))) (let ((b1607 (lookup1084 n1606 r1601 mod1605))) (let ((type1608 (binding-type1079 b1607))) (let ((t1609 type1608)) (if (memv t1609 (quote (lexical))) (values type1608 (binding-value1080 b1607) e1600 w1602 s1603 mod1605) (if (memv t1609 (quote (global))) (values type1608 n1606 e1600 w1602 s1603 mod1605) (if (memv t1609 (quote (macro))) (syntax-type1121 (chi-macro1126 (binding-value1080 b1607) e1600 r1601 w1602 rib1604 mod1605) r1601 (quote (())) s1603 rib1604 mod1605) (values type1608 (binding-value1080 b1607) e1600 w1602 s1603 mod1605))))))))) ((pair? e1600) (let ((first1610 (car e1600))) (if (id?1087 first1610) (let ((n1611 (id-var-name1109 first1610 w1602))) (let ((b1612 (lookup1084 n1611 r1601 (or (and (syntax-object?1071 first1610) (syntax-object-module1074 first1610)) mod1605)))) (let ((type1613 (binding-type1079 b1612))) (let ((t1614 type1613)) (if (memv t1614 (quote (lexical))) (values (quote lexical-call) (binding-value1080 b1612) e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (global))) (values (quote global-call) n1611 e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (macro))) (syntax-type1121 (chi-macro1126 (binding-value1080 b1612) e1600 r1601 w1602 rib1604 mod1605) r1601 (quote (())) s1603 rib1604 mod1605) (if (memv t1614 (quote (core external-macro module-ref))) (values type1613 (binding-value1080 b1612) e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1080 b1612) e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (begin))) (values (quote begin-form) #f e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (eval-when))) (values (quote eval-when-form) #f e1600 w1602 s1603 mod1605) (if (memv t1614 (quote (define))) ((lambda (tmp1615) ((lambda (tmp1616) (if (if tmp1616 (apply (lambda (_1617 name1618 val1619) (id?1087 name1618)) tmp1616) #f) (apply (lambda (_1620 name1621 val1622) (values (quote define-form) name1621 val1622 w1602 s1603 mod1605)) tmp1616) ((lambda (tmp1623) (if (if tmp1623 (apply (lambda (_1624 name1625 args1626 e11627 e21628) (and (id?1087 name1625) (valid-bound-ids?1112 (lambda-var-list1136 args1626)))) tmp1623) #f) (apply (lambda (_1629 name1630 args1631 e11632 e21633) (values (quote define-form) (wrap1115 name1630 w1602 mod1605) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap1115 (cons args1631 (cons e11632 e21633)) w1602 mod1605)) (quote (())) s1603 mod1605)) tmp1623) ((lambda (tmp1635) (if (if tmp1635 (apply (lambda (_1636 name1637) (id?1087 name1637)) tmp1635) #f) (apply (lambda (_1638 name1639) (values (quote define-form) (wrap1115 name1639 w1602 mod1605) (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 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s1603 mod1605)) tmp1635) (syntax-violation #f "source expression failed to match any pattern" tmp1615))) ($sc-dispatch tmp1615 (quote (any any)))))) ($sc-dispatch tmp1615 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1615 (quote (any any any))))) e1600) (if (memv t1614 (quote (define-syntax))) ((lambda (tmp1640) ((lambda (tmp1641) (if (if tmp1641 (apply (lambda (_1642 name1643 val1644) (id?1087 name1643)) tmp1641) #f) (apply (lambda (_1645 name1646 val1647) (values (quote define-syntax-form) name1646 val1647 w1602 s1603 mod1605)) tmp1641) (syntax-violation #f "source expression failed to match any pattern" tmp1640))) ($sc-dispatch tmp1640 (quote (any any any))))) e1600) (values (quote call) #f e1600 w1602 s1603 mod1605)))))))))))))) (values (quote call) #f e1600 w1602 s1603 mod1605)))) ((syntax-object?1071 e1600) (syntax-type1121 (syntax-object-expression1072 e1600) r1601 (join-wraps1106 w1602 (syntax-object-wrap1073 e1600)) #f rib1604 (or (syntax-object-module1074 e1600) mod1605))) ((annotation? e1600) (syntax-type1121 (annotation-expression e1600) r1601 w1602 (annotation-source e1600) rib1604 mod1605)) ((self-evaluating? e1600) (values (quote constant) #f e1600 w1602 s1603 mod1605)) (else (values (quote other) #f e1600 w1602 s1603 mod1605))))) (chi-when-list1120 (lambda (e1648 when-list1649 w1650) (let f1651 ((when-list1652 when-list1649) (situations1653 (quote ()))) (if (null? when-list1652) situations1653 (f1651 (cdr when-list1652) (cons (let ((x1654 (car when-list1652))) (cond ((free-id=?1110 x1654 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile)) ((free-id=?1110 x1654 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load)) ((free-id=?1110 x1654 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e1648 (wrap1115 x1654 w1650 #f))))) situations1653)))))) (chi-install-global1119 (lambda (name1655 e1656) (build-annotated1064 #f (list (build-annotated1064 #f (quote define)) name1655 (if (let ((v1657 (module-variable (current-module) name1655))) (and v1657 (variable-bound? v1657) (macro? (variable-ref v1657)) (not (eq? (macro-type (variable-ref v1657)) (quote syncase-macro))))) (build-annotated1064 #f (list (build-annotated1064 #f (quote make-extended-syncase-macro)) (build-annotated1064 #f (list (build-annotated1064 #f (quote module-ref)) (build-annotated1064 #f (quote (current-module))) (build-data1065 #f name1655))) (build-data1065 #f (quote macro)) e1656)) (build-annotated1064 #f (list (build-annotated1064 #f (quote make-syncase-macro)) (build-data1065 #f (quote macro)) e1656))))))) (chi-top-sequence1118 (lambda (body1658 r1659 w1660 s1661 m1662 esew1663 mod1664) (build-sequence1066 s1661 (let dobody1665 ((body1666 body1658) (r1667 r1659) (w1668 w1660) (m1669 m1662) (esew1670 esew1663) (mod1671 mod1664)) (if (null? body1666) (quote ()) (let ((first1672 (chi-top1122 (car body1666) r1667 w1668 m1669 esew1670 mod1671))) (cons first1672 (dobody1665 (cdr body1666) r1667 w1668 m1669 esew1670 mod1671)))))))) (chi-sequence1117 (lambda (body1673 r1674 w1675 s1676 mod1677) (build-sequence1066 s1676 (let dobody1678 ((body1679 body1673) (r1680 r1674) (w1681 w1675) (mod1682 mod1677)) (if (null? body1679) (quote ()) (let ((first1683 (chi1123 (car body1679) r1680 w1681 mod1682))) (cons first1683 (dobody1678 (cdr body1679) r1680 w1681 mod1682)))))))) (source-wrap1116 (lambda (x1684 w1685 s1686 defmod1687) (wrap1115 (if s1686 (make-annotation x1684 s1686 #f) x1684) w1685 defmod1687))) (wrap1115 (lambda (x1688 w1689 defmod1690) (cond ((and (null? (wrap-marks1090 w1689)) (null? (wrap-subst1091 w1689))) x1688) ((syntax-object?1071 x1688) (make-syntax-object1070 (syntax-object-expression1072 x1688) (join-wraps1106 w1689 (syntax-object-wrap1073 x1688)) (syntax-object-module1074 x1688))) ((null? x1688) x1688) (else (make-syntax-object1070 x1688 w1689 defmod1690))))) (bound-id-member?1114 (lambda (x1691 list1692) (and (not (null? list1692)) (or (bound-id=?1111 x1691 (car list1692)) (bound-id-member?1114 x1691 (cdr list1692)))))) (distinct-bound-ids?1113 (lambda (ids1693) (let distinct?1694 ((ids1695 ids1693)) (or (null? ids1695) (and (not (bound-id-member?1114 (car ids1695) (cdr ids1695))) (distinct?1694 (cdr ids1695))))))) (valid-bound-ids?1112 (lambda (ids1696) (and (let all-ids?1697 ((ids1698 ids1696)) (or (null? ids1698) (and (id?1087 (car ids1698)) (all-ids?1697 (cdr ids1698))))) (distinct-bound-ids?1113 ids1696)))) (bound-id=?1111 (lambda (i1699 j1700) (if (and (syntax-object?1071 i1699) (syntax-object?1071 j1700)) (and (eq? (let ((e1701 (syntax-object-expression1072 i1699))) (if (annotation? e1701) (annotation-expression e1701) e1701)) (let ((e1702 (syntax-object-expression1072 j1700))) (if (annotation? e1702) (annotation-expression e1702) e1702))) (same-marks?1108 (wrap-marks1090 (syntax-object-wrap1073 i1699)) (wrap-marks1090 (syntax-object-wrap1073 j1700)))) (eq? (let ((e1703 i1699)) (if (annotation? e1703) (annotation-expression e1703) e1703)) (let ((e1704 j1700)) (if (annotation? e1704) (annotation-expression e1704) e1704)))))) (free-id=?1110 (lambda (i1705 j1706) (and (eq? (let ((x1707 i1705)) (let ((e1708 (if (syntax-object?1071 x1707) (syntax-object-expression1072 x1707) x1707))) (if (annotation? e1708) (annotation-expression e1708) e1708))) (let ((x1709 j1706)) (let ((e1710 (if (syntax-object?1071 x1709) (syntax-object-expression1072 x1709) x1709))) (if (annotation? e1710) (annotation-expression e1710) e1710)))) (eq? (id-var-name1109 i1705 (quote (()))) (id-var-name1109 j1706 (quote (()))))))) (id-var-name1109 (lambda (id1711 w1712) (letrec ((search-vector-rib1715 (lambda (sym1721 subst1722 marks1723 symnames1724 ribcage1725) (let ((n1726 (vector-length symnames1724))) (let f1727 ((i1728 0)) (cond ((fx=1057 i1728 n1726) (search1713 sym1721 (cdr subst1722) marks1723)) ((and (eq? (vector-ref symnames1724 i1728) sym1721) (same-marks?1108 marks1723 (vector-ref (ribcage-marks1097 ribcage1725) i1728))) (values (vector-ref (ribcage-labels1098 ribcage1725) i1728) marks1723)) (else (f1727 (fx+1055 i1728 1)))))))) (search-list-rib1714 (lambda (sym1729 subst1730 marks1731 symnames1732 ribcage1733) (let f1734 ((symnames1735 symnames1732) (i1736 0)) (cond ((null? symnames1735) (search1713 sym1729 (cdr subst1730) marks1731)) ((and (eq? (car symnames1735) sym1729) (same-marks?1108 marks1731 (list-ref (ribcage-marks1097 ribcage1733) i1736))) (values (list-ref (ribcage-labels1098 ribcage1733) i1736) marks1731)) (else (f1734 (cdr symnames1735) (fx+1055 i1736 1))))))) (search1713 (lambda (sym1737 subst1738 marks1739) (if (null? subst1738) (values #f marks1739) (let ((fst1740 (car subst1738))) (if (eq? fst1740 (quote shift)) (search1713 sym1737 (cdr subst1738) (cdr marks1739)) (let ((symnames1741 (ribcage-symnames1096 fst1740))) (if (vector? symnames1741) (search-vector-rib1715 sym1737 subst1738 marks1739 symnames1741 fst1740) (search-list-rib1714 sym1737 subst1738 marks1739 symnames1741 fst1740))))))))) (cond ((symbol? id1711) (or (call-with-values (lambda () (search1713 id1711 (wrap-subst1091 w1712) (wrap-marks1090 w1712))) (lambda (x1743 . ignore1742) x1743)) id1711)) ((syntax-object?1071 id1711) (let ((id1744 (let ((e1746 (syntax-object-expression1072 id1711))) (if (annotation? e1746) (annotation-expression e1746) e1746))) (w11745 (syntax-object-wrap1073 id1711))) (let ((marks1747 (join-marks1107 (wrap-marks1090 w1712) (wrap-marks1090 w11745)))) (call-with-values (lambda () (search1713 id1744 (wrap-subst1091 w1712) marks1747)) (lambda (new-id1748 marks1749) (or new-id1748 (call-with-values (lambda () (search1713 id1744 (wrap-subst1091 w11745) marks1749)) (lambda (x1751 . ignore1750) x1751)) id1744)))))) ((annotation? id1711) (let ((id1752 (let ((e1753 id1711)) (if (annotation? e1753) (annotation-expression e1753) e1753)))) (or (call-with-values (lambda () (search1713 id1752 (wrap-subst1091 w1712) (wrap-marks1090 w1712))) (lambda (x1755 . ignore1754) x1755)) id1752))) (else (error-hook1061 (quote id-var-name) "invalid id" id1711)))))) (same-marks?1108 (lambda (x1756 y1757) (or (eq? x1756 y1757) (and (not (null? x1756)) (not (null? y1757)) (eq? (car x1756) (car y1757)) (same-marks?1108 (cdr x1756) (cdr y1757)))))) (join-marks1107 (lambda (m11758 m21759) (smart-append1105 m11758 m21759))) (join-wraps1106 (lambda (w11760 w21761) (let ((m11762 (wrap-marks1090 w11760)) (s11763 (wrap-subst1091 w11760))) (if (null? m11762) (if (null? s11763) w21761 (make-wrap1089 (wrap-marks1090 w21761) (smart-append1105 s11763 (wrap-subst1091 w21761)))) (make-wrap1089 (smart-append1105 m11762 (wrap-marks1090 w21761)) (smart-append1105 s11763 (wrap-subst1091 w21761))))))) (smart-append1105 (lambda (m11764 m21765) (if (null? m21765) m11764 (append m11764 m21765)))) (make-binding-wrap1104 (lambda (ids1766 labels1767 w1768) (if (null? ids1766) w1768 (make-wrap1089 (wrap-marks1090 w1768) (cons (let ((labelvec1769 (list->vector labels1767))) (let ((n1770 (vector-length labelvec1769))) (let ((symnamevec1771 (make-vector n1770)) (marksvec1772 (make-vector n1770))) (begin (let f1773 ((ids1774 ids1766) (i1775 0)) (if (not (null? ids1774)) (call-with-values (lambda () (id-sym-name&marks1088 (car ids1774) w1768)) (lambda (symname1776 marks1777) (begin (vector-set! symnamevec1771 i1775 symname1776) (vector-set! marksvec1772 i1775 marks1777) (f1773 (cdr ids1774) (fx+1055 i1775 1))))))) (make-ribcage1094 symnamevec1771 marksvec1772 labelvec1769))))) (wrap-subst1091 w1768)))))) (extend-ribcage!1103 (lambda (ribcage1778 id1779 label1780) (begin (set-ribcage-symnames!1099 ribcage1778 (cons (let ((e1781 (syntax-object-expression1072 id1779))) (if (annotation? e1781) (annotation-expression e1781) e1781)) (ribcage-symnames1096 ribcage1778))) (set-ribcage-marks!1100 ribcage1778 (cons (wrap-marks1090 (syntax-object-wrap1073 id1779)) (ribcage-marks1097 ribcage1778))) (set-ribcage-labels!1101 ribcage1778 (cons label1780 (ribcage-labels1098 ribcage1778)))))) (anti-mark1102 (lambda (w1782) (make-wrap1089 (cons #f (wrap-marks1090 w1782)) (cons (quote shift) (wrap-subst1091 w1782))))) (set-ribcage-labels!1101 (lambda (x1783 update1784) (vector-set! x1783 3 update1784))) (set-ribcage-marks!1100 (lambda (x1785 update1786) (vector-set! x1785 2 update1786))) (set-ribcage-symnames!1099 (lambda (x1787 update1788) (vector-set! x1787 1 update1788))) (ribcage-labels1098 (lambda (x1789) (vector-ref x1789 3))) (ribcage-marks1097 (lambda (x1790) (vector-ref x1790 2))) (ribcage-symnames1096 (lambda (x1791) (vector-ref x1791 1))) (ribcage?1095 (lambda (x1792) (and (vector? x1792) (= (vector-length x1792) 4) (eq? (vector-ref x1792 0) (quote ribcage))))) (make-ribcage1094 (lambda (symnames1793 marks1794 labels1795) (vector (quote ribcage) symnames1793 marks1794 labels1795))) (gen-labels1093 (lambda (ls1796) (if (null? ls1796) (quote ()) (cons (gen-label1092) (gen-labels1093 (cdr ls1796)))))) (gen-label1092 (lambda () (string #\i))) (wrap-subst1091 cdr) (wrap-marks1090 car) (make-wrap1089 cons) (id-sym-name&marks1088 (lambda (x1797 w1798) (if (syntax-object?1071 x1797) (values (let ((e1799 (syntax-object-expression1072 x1797))) (if (annotation? e1799) (annotation-expression e1799) e1799)) (join-marks1107 (wrap-marks1090 w1798) (wrap-marks1090 (syntax-object-wrap1073 x1797)))) (values (let ((e1800 x1797)) (if (annotation? e1800) (annotation-expression e1800) e1800)) (wrap-marks1090 w1798))))) (id?1087 (lambda (x1801) (cond ((symbol? x1801) #t) ((syntax-object?1071 x1801) (symbol? (let ((e1802 (syntax-object-expression1072 x1801))) (if (annotation? e1802) (annotation-expression e1802) e1802)))) ((annotation? x1801) (symbol? (annotation-expression x1801))) (else #f)))) (nonsymbol-id?1086 (lambda (x1803) (and (syntax-object?1071 x1803) (symbol? (let ((e1804 (syntax-object-expression1072 x1803))) (if (annotation? e1804) (annotation-expression e1804) e1804)))))) (global-extend1085 (lambda (type1805 sym1806 val1807) (put-global-definition-hook1062 sym1806 type1805 val1807))) (lookup1084 (lambda (x1808 r1809 mod1810) (cond ((assq x1808 r1809) => cdr) ((symbol? x1808) (or (get-global-definition-hook1063 x1808 mod1810) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1083 (lambda (r1811) (if (null? r1811) (quote ()) (let ((a1812 (car r1811))) (if (eq? (cadr a1812) (quote macro)) (cons a1812 (macros-only-env1083 (cdr r1811))) (macros-only-env1083 (cdr r1811))))))) (extend-var-env1082 (lambda (labels1813 vars1814 r1815) (if (null? labels1813) r1815 (extend-var-env1082 (cdr labels1813) (cdr vars1814) (cons (cons (car labels1813) (cons (quote lexical) (car vars1814))) r1815))))) (extend-env1081 (lambda (labels1816 bindings1817 r1818) (if (null? labels1816) r1818 (extend-env1081 (cdr labels1816) (cdr bindings1817) (cons (cons (car labels1816) (car bindings1817)) r1818))))) (binding-value1080 cdr) (binding-type1079 car) (source-annotation1078 (lambda (x1819) (cond ((annotation? x1819) (annotation-source x1819)) ((syntax-object?1071 x1819) (source-annotation1078 (syntax-object-expression1072 x1819))) (else #f)))) (set-syntax-object-module!1077 (lambda (x1820 update1821) (vector-set! x1820 3 update1821))) (set-syntax-object-wrap!1076 (lambda (x1822 update1823) (vector-set! x1822 2 update1823))) (set-syntax-object-expression!1075 (lambda (x1824 update1825) (vector-set! x1824 1 update1825))) (syntax-object-module1074 (lambda (x1826) (vector-ref x1826 3))) (syntax-object-wrap1073 (lambda (x1827) (vector-ref x1827 2))) (syntax-object-expression1072 (lambda (x1828) (vector-ref x1828 1))) (syntax-object?1071 (lambda (x1829) (and (vector? x1829) (= (vector-length x1829) 4) (eq? (vector-ref x1829 0) (quote syntax-object))))) (make-syntax-object1070 (lambda (expression1830 wrap1831 module1832) (vector (quote syntax-object) expression1830 wrap1831 module1832))) (build-letrec1069 (lambda (src1833 vars1834 val-exps1835 body-exp1836) (if (null? vars1834) (build-annotated1064 src1833 body-exp1836) (build-annotated1064 src1833 (list (quote letrec) (map list vars1834 val-exps1835) body-exp1836))))) (build-named-let1068 (lambda (src1837 vars1838 val-exps1839 body-exp1840) (if (null? vars1838) (build-annotated1064 src1837 body-exp1840) (build-annotated1064 src1837 (list (quote let) (car vars1838) (map list (cdr vars1838) val-exps1839) body-exp1840))))) (build-let1067 (lambda (src1841 vars1842 val-exps1843 body-exp1844) (if (null? vars1842) (build-annotated1064 src1841 body-exp1844) (build-annotated1064 src1841 (list (quote let) (map list vars1842 val-exps1843) body-exp1844))))) (build-sequence1066 (lambda (src1845 exps1846) (if (null? (cdr exps1846)) (build-annotated1064 src1845 (car exps1846)) (build-annotated1064 src1845 (cons (quote begin) exps1846))))) (build-data1065 (lambda (src1847 exp1848) (if (and (self-evaluating? exp1848) (not (vector? exp1848))) (build-annotated1064 src1847 exp1848) (build-annotated1064 src1847 (list (quote quote) exp1848))))) (build-annotated1064 (lambda (src1849 exp1850) (if (and src1849 (not (annotation? exp1850))) (make-annotation exp1850 src1849 #t) exp1850))) (get-global-definition-hook1063 (lambda (symbol1851 module1852) (begin (if (and (not module1852) (current-module)) (warn "module system is booted, we should have a module" symbol1851)) (let ((v1853 (module-variable (if module1852 (resolve-module (cdr module1852)) (current-module)) symbol1851))) (and v1853 (variable-bound? v1853) (let ((val1854 (variable-ref v1853))) (and (macro? val1854) (syncase-macro-type val1854) (cons (syncase-macro-type val1854) (syncase-macro-binding val1854))))))))) (put-global-definition-hook1062 (lambda (symbol1855 type1856 val1857) (let ((existing1858 (let ((v1859 (module-variable (current-module) symbol1855))) (and v1859 (variable-bound? v1859) (let ((val1860 (variable-ref v1859))) (and (macro? val1860) (not (syncase-macro-type val1860)) val1860)))))) (module-define! (current-module) symbol1855 (if existing1858 (make-extended-syncase-macro existing1858 type1856 val1857) (make-syncase-macro type1856 val1857)))))) (error-hook1061 (lambda (who1861 why1862 what1863) (error who1861 "~a ~s" why1862 what1863))) (local-eval-hook1060 (lambda (x1864 mod1865) (primitive-eval (list noexpand1054 x1864)))) (top-level-eval-hook1059 (lambda (x1866 mod1867) (primitive-eval (list noexpand1054 x1866)))) (fx<1058 <) (fx=1057 =) (fx-1056 -) (fx+1055 +) (noexpand1054 "noexpand")) (begin (global-extend1085 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1085 (quote local-syntax) (quote let-syntax) #f) (global-extend1085 (quote core) (quote fluid-let-syntax) (lambda (e1868 r1869 w1870 s1871 mod1872) ((lambda (tmp1873) ((lambda (tmp1874) (if (if tmp1874 (apply (lambda (_1875 var1876 val1877 e11878 e21879) (valid-bound-ids?1112 var1876)) tmp1874) #f) (apply (lambda (_1881 var1882 val1883 e11884 e21885) (let ((names1886 (map (lambda (x1887) (id-var-name1109 x1887 w1870)) var1882))) (begin (for-each (lambda (id1889 n1890) (let ((t1891 (binding-type1079 (lookup1084 n1890 r1869 mod1872)))) (if (memv t1891 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1868 (source-wrap1116 id1889 w1870 s1871 mod1872))))) var1882 names1886) (chi-body1127 (cons e11884 e21885) (source-wrap1116 e1868 w1870 s1871 mod1872) (extend-env1081 names1886 (let ((trans-r1894 (macros-only-env1083 r1869))) (map (lambda (x1895) (cons (quote macro) (eval-local-transformer1130 (chi1123 x1895 trans-r1894 w1870 mod1872) mod1872))) val1883)) r1869) w1870 mod1872)))) tmp1874) ((lambda (_1897) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1116 e1868 w1870 s1871 mod1872))) tmp1873))) ($sc-dispatch tmp1873 (quote (any #(each (any any)) any . each-any))))) e1868))) (global-extend1085 (quote core) (quote quote) (lambda (e1898 r1899 w1900 s1901 mod1902) ((lambda (tmp1903) ((lambda (tmp1904) (if tmp1904 (apply (lambda (_1905 e1906) (build-data1065 s1901 (strip1134 e1906 w1900))) tmp1904) ((lambda (_1907) (syntax-violation (quote quote) "bad syntax" (source-wrap1116 e1898 w1900 s1901 mod1902))) tmp1903))) ($sc-dispatch tmp1903 (quote (any any))))) e1898))) (global-extend1085 (quote core) (quote syntax) (letrec ((regen1915 (lambda (x1916) (let ((t1917 (car x1916))) (if (memv t1917 (quote (ref))) (build-annotated1064 #f (cadr x1916)) (if (memv t1917 (quote (primitive))) (build-annotated1064 #f (cadr x1916)) (if (memv t1917 (quote (quote))) (build-data1065 #f (cadr x1916)) (if (memv t1917 (quote (lambda))) (build-annotated1064 #f (list (quote lambda) (cadr x1916) (regen1915 (caddr x1916)))) (if (memv t1917 (quote (map))) (let ((ls1918 (map regen1915 (cdr x1916)))) (build-annotated1064 #f (cons (if (fx=1057 (length ls1918) 2) (build-annotated1064 #f (quote map)) (build-annotated1064 #f (quote map))) ls1918))) (build-annotated1064 #f (cons (build-annotated1064 #f (car x1916)) (map regen1915 (cdr x1916)))))))))))) (gen-vector1914 (lambda (x1919) (cond ((eq? (car x1919) (quote list)) (cons (quote vector) (cdr x1919))) ((eq? (car x1919) (quote quote)) (list (quote quote) (list->vector (cadr x1919)))) (else (list (quote list->vector) x1919))))) (gen-append1913 (lambda (x1920 y1921) (if (equal? y1921 (quote (quote ()))) x1920 (list (quote append) x1920 y1921)))) (gen-cons1912 (lambda (x1922 y1923) (let ((t1924 (car y1923))) (if (memv t1924 (quote (quote))) (if (eq? (car x1922) (quote quote)) (list (quote quote) (cons (cadr x1922) (cadr y1923))) (if (eq? (cadr y1923) (quote ())) (list (quote list) x1922) (list (quote cons) x1922 y1923))) (if (memv t1924 (quote (list))) (cons (quote list) (cons x1922 (cdr y1923))) (list (quote cons) x1922 y1923)))))) (gen-map1911 (lambda (e1925 map-env1926) (let ((formals1927 (map cdr map-env1926)) (actuals1928 (map (lambda (x1929) (list (quote ref) (car x1929))) map-env1926))) (cond ((eq? (car e1925) (quote ref)) (car actuals1928)) ((and-map (lambda (x1930) (and (eq? (car x1930) (quote ref)) (memq (cadr x1930) formals1927))) (cdr e1925)) (cons (quote map) (cons (list (quote primitive) (car e1925)) (map (let ((r1931 (map cons formals1927 actuals1928))) (lambda (x1932) (cdr (assq (cadr x1932) r1931)))) (cdr e1925))))) (else (cons (quote map) (cons (list (quote lambda) formals1927 e1925) actuals1928))))))) (gen-mappend1910 (lambda (e1933 map-env1934) (list (quote apply) (quote (primitive append)) (gen-map1911 e1933 map-env1934)))) (gen-ref1909 (lambda (src1935 var1936 level1937 maps1938) (if (fx=1057 level1937 0) (values var1936 maps1938) (if (null? maps1938) (syntax-violation (quote syntax) "missing ellipsis" src1935) (call-with-values (lambda () (gen-ref1909 src1935 var1936 (fx-1056 level1937 1) (cdr maps1938))) (lambda (outer-var1939 outer-maps1940) (let ((b1941 (assq outer-var1939 (car maps1938)))) (if b1941 (values (cdr b1941) maps1938) (let ((inner-var1942 (gen-var1135 (quote tmp)))) (values inner-var1942 (cons (cons (cons outer-var1939 inner-var1942) (car maps1938)) outer-maps1940))))))))))) (gen-syntax1908 (lambda (src1943 e1944 r1945 maps1946 ellipsis?1947 mod1948) (if (id?1087 e1944) (let ((label1949 (id-var-name1109 e1944 (quote (()))))) (let ((b1950 (lookup1084 label1949 r1945 mod1948))) (if (eq? (binding-type1079 b1950) (quote syntax)) (call-with-values (lambda () (let ((var.lev1951 (binding-value1080 b1950))) (gen-ref1909 src1943 (car var.lev1951) (cdr var.lev1951) maps1946))) (lambda (var1952 maps1953) (values (list (quote ref) var1952) maps1953))) (if (ellipsis?1947 e1944) (syntax-violation (quote syntax) "misplaced ellipsis" src1943) (values (list (quote quote) e1944) maps1946))))) ((lambda (tmp1954) ((lambda (tmp1955) (if (if tmp1955 (apply (lambda (dots1956 e1957) (ellipsis?1947 dots1956)) tmp1955) #f) (apply (lambda (dots1958 e1959) (gen-syntax1908 src1943 e1959 r1945 maps1946 (lambda (x1960) #f) mod1948)) tmp1955) ((lambda (tmp1961) (if (if tmp1961 (apply (lambda (x1962 dots1963 y1964) (ellipsis?1947 dots1963)) tmp1961) #f) (apply (lambda (x1965 dots1966 y1967) (let f1968 ((y1969 y1967) (k1970 (lambda (maps1971) (call-with-values (lambda () (gen-syntax1908 src1943 x1965 r1945 (cons (quote ()) maps1971) ellipsis?1947 mod1948)) (lambda (x1972 maps1973) (if (null? (car maps1973)) (syntax-violation (quote syntax) "extra ellipsis" src1943) (values (gen-map1911 x1972 (car maps1973)) (cdr maps1973)))))))) ((lambda (tmp1974) ((lambda (tmp1975) (if (if tmp1975 (apply (lambda (dots1976 y1977) (ellipsis?1947 dots1976)) tmp1975) #f) (apply (lambda (dots1978 y1979) (f1968 y1979 (lambda (maps1980) (call-with-values (lambda () (k1970 (cons (quote ()) maps1980))) (lambda (x1981 maps1982) (if (null? (car maps1982)) (syntax-violation (quote syntax) "extra ellipsis" src1943) (values (gen-mappend1910 x1981 (car maps1982)) (cdr maps1982)))))))) tmp1975) ((lambda (_1983) (call-with-values (lambda () (gen-syntax1908 src1943 y1969 r1945 maps1946 ellipsis?1947 mod1948)) (lambda (y1984 maps1985) (call-with-values (lambda () (k1970 maps1985)) (lambda (x1986 maps1987) (values (gen-append1913 x1986 y1984) maps1987)))))) tmp1974))) ($sc-dispatch tmp1974 (quote (any . any))))) y1969))) tmp1961) ((lambda (tmp1988) (if tmp1988 (apply (lambda (x1989 y1990) (call-with-values (lambda () (gen-syntax1908 src1943 x1989 r1945 maps1946 ellipsis?1947 mod1948)) (lambda (x1991 maps1992) (call-with-values (lambda () (gen-syntax1908 src1943 y1990 r1945 maps1992 ellipsis?1947 mod1948)) (lambda (y1993 maps1994) (values (gen-cons1912 x1991 y1993) maps1994)))))) tmp1988) ((lambda (tmp1995) (if tmp1995 (apply (lambda (e11996 e21997) (call-with-values (lambda () (gen-syntax1908 src1943 (cons e11996 e21997) r1945 maps1946 ellipsis?1947 mod1948)) (lambda (e1999 maps2000) (values (gen-vector1914 e1999) maps2000)))) tmp1995) ((lambda (_2001) (values (list (quote quote) e1944) maps1946)) tmp1954))) ($sc-dispatch tmp1954 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp1954 (quote (any . any)))))) ($sc-dispatch tmp1954 (quote (any any . any)))))) ($sc-dispatch tmp1954 (quote (any any))))) e1944))))) (lambda (e2002 r2003 w2004 s2005 mod2006) (let ((e2007 (source-wrap1116 e2002 w2004 s2005 mod2006))) ((lambda (tmp2008) ((lambda (tmp2009) (if tmp2009 (apply (lambda (_2010 x2011) (call-with-values (lambda () (gen-syntax1908 e2007 x2011 r2003 (quote ()) ellipsis?1132 mod2006)) (lambda (e2012 maps2013) (regen1915 e2012)))) tmp2009) ((lambda (_2014) (syntax-violation (quote syntax) "bad `syntax' form" e2007)) tmp2008))) ($sc-dispatch tmp2008 (quote (any any))))) e2007))))) (global-extend1085 (quote core) (quote lambda) (lambda (e2015 r2016 w2017 s2018 mod2019) ((lambda (tmp2020) ((lambda (tmp2021) (if tmp2021 (apply (lambda (_2022 c2023) (chi-lambda-clause1128 (source-wrap1116 e2015 w2017 s2018 mod2019) #f c2023 r2016 w2017 mod2019 (lambda (vars2024 docstring2025 body2026) (build-annotated1064 s2018 (cons (quote lambda) (cons vars2024 (append (if docstring2025 (list docstring2025) (quote ())) (list body2026)))))))) tmp2021) (syntax-violation #f "source expression failed to match any pattern" tmp2020))) ($sc-dispatch tmp2020 (quote (any . any))))) e2015))) (global-extend1085 (quote core) (quote let) (letrec ((chi-let2027 (lambda (e2028 r2029 w2030 s2031 mod2032 constructor2033 ids2034 vals2035 exps2036) (if (not (valid-bound-ids?1112 ids2034)) (syntax-violation (quote let) "duplicate bound variable" e2028) (let ((labels2037 (gen-labels1093 ids2034)) (new-vars2038 (map gen-var1135 ids2034))) (let ((nw2039 (make-binding-wrap1104 ids2034 labels2037 w2030)) (nr2040 (extend-var-env1082 labels2037 new-vars2038 r2029))) (constructor2033 s2031 new-vars2038 (map (lambda (x2041) (chi1123 x2041 r2029 w2030 mod2032)) vals2035) (chi-body1127 exps2036 (source-wrap1116 e2028 nw2039 s2031 mod2032) nr2040 nw2039 mod2032)))))))) (lambda (e2042 r2043 w2044 s2045 mod2046) ((lambda (tmp2047) ((lambda (tmp2048) (if tmp2048 (apply (lambda (_2049 id2050 val2051 e12052 e22053) (chi-let2027 e2042 r2043 w2044 s2045 mod2046 build-let1067 id2050 val2051 (cons e12052 e22053))) tmp2048) ((lambda (tmp2057) (if (if tmp2057 (apply (lambda (_2058 f2059 id2060 val2061 e12062 e22063) (id?1087 f2059)) tmp2057) #f) (apply (lambda (_2064 f2065 id2066 val2067 e12068 e22069) (chi-let2027 e2042 r2043 w2044 s2045 mod2046 build-named-let1068 (cons f2065 id2066) val2067 (cons e12068 e22069))) tmp2057) ((lambda (_2073) (syntax-violation (quote let) "bad let" (source-wrap1116 e2042 w2044 s2045 mod2046))) tmp2047))) ($sc-dispatch tmp2047 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2047 (quote (any #(each (any any)) any . each-any))))) e2042)))) (global-extend1085 (quote core) (quote letrec) (lambda (e2074 r2075 w2076 s2077 mod2078) ((lambda (tmp2079) ((lambda (tmp2080) (if tmp2080 (apply (lambda (_2081 id2082 val2083 e12084 e22085) (let ((ids2086 id2082)) (if (not (valid-bound-ids?1112 ids2086)) (syntax-violation (quote letrec) "duplicate bound variable" e2074) (let ((labels2088 (gen-labels1093 ids2086)) (new-vars2089 (map gen-var1135 ids2086))) (let ((w2090 (make-binding-wrap1104 ids2086 labels2088 w2076)) (r2091 (extend-var-env1082 labels2088 new-vars2089 r2075))) (build-letrec1069 s2077 new-vars2089 (map (lambda (x2092) (chi1123 x2092 r2091 w2090 mod2078)) val2083) (chi-body1127 (cons e12084 e22085) (source-wrap1116 e2074 w2090 s2077 mod2078) r2091 w2090 mod2078))))))) tmp2080) ((lambda (_2095) (syntax-violation (quote letrec) "bad letrec" (source-wrap1116 e2074 w2076 s2077 mod2078))) tmp2079))) ($sc-dispatch tmp2079 (quote (any #(each (any any)) any . each-any))))) e2074))) (global-extend1085 (quote core) (quote set!) (lambda (e2096 r2097 w2098 s2099 mod2100) ((lambda (tmp2101) ((lambda (tmp2102) (if (if tmp2102 (apply (lambda (_2103 id2104 val2105) (id?1087 id2104)) tmp2102) #f) (apply (lambda (_2106 id2107 val2108) (let ((val2109 (chi1123 val2108 r2097 w2098 mod2100)) (n2110 (id-var-name1109 id2107 w2098))) (let ((b2111 (lookup1084 n2110 r2097 mod2100))) (let ((t2112 (binding-type1079 b2111))) (if (memv t2112 (quote (lexical))) (build-annotated1064 s2099 (list (quote set!) (binding-value1080 b2111) val2109)) (if (memv t2112 (quote (global))) (build-annotated1064 s2099 (list (quote set!) (if mod2100 (make-module-ref (cdr mod2100) n2110 (car mod2100)) (make-module-ref mod2100 n2110 (quote bare))) val2109)) (if (memv t2112 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1115 id2107 w2098 mod2100)) (syntax-violation (quote set!) "bad set!" (source-wrap1116 e2096 w2098 s2099 mod2100))))))))) tmp2102) ((lambda (tmp2113) (if tmp2113 (apply (lambda (_2114 head2115 tail2116 val2117) (call-with-values (lambda () (syntax-type1121 head2115 r2097 (quote (())) #f #f mod2100)) (lambda (type2118 value2119 ee2120 ww2121 ss2122 modmod2123) (let ((t2124 type2118)) (if (memv t2124 (quote (module-ref))) (let ((val2125 (chi1123 val2117 r2097 w2098 mod2100))) (call-with-values (lambda () (value2119 (cons head2115 tail2116))) (lambda (id2127 mod2128) (build-annotated1064 s2099 (list (quote set!) (if mod2128 (make-module-ref (cdr mod2128) id2127 (car mod2128)) (make-module-ref mod2128 id2127 (quote bare))) val2125))))) (build-annotated1064 s2099 (cons (chi1123 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head2115) r2097 w2098 mod2100) (map (lambda (e2129) (chi1123 e2129 r2097 w2098 mod2100)) (append tail2116 (list val2117)))))))))) tmp2113) ((lambda (_2131) (syntax-violation (quote set!) "bad set!" (source-wrap1116 e2096 w2098 s2099 mod2100))) tmp2101))) ($sc-dispatch tmp2101 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2101 (quote (any any any))))) e2096))) (global-extend1085 (quote module-ref) (quote @) (lambda (e2132) ((lambda (tmp2133) ((lambda (tmp2134) (if (if tmp2134 (apply (lambda (_2135 mod2136 id2137) (and (and-map id?1087 mod2136) (id?1087 id2137))) tmp2134) #f) (apply (lambda (_2139 mod2140 id2141) (values (syntax->datum id2141) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2140)))) tmp2134) (syntax-violation #f "source expression failed to match any pattern" tmp2133))) ($sc-dispatch tmp2133 (quote (any each-any any))))) e2132))) (global-extend1085 (quote module-ref) (quote @@) (lambda (e2143) ((lambda (tmp2144) ((lambda (tmp2145) (if (if tmp2145 (apply (lambda (_2146 mod2147 id2148) (and (and-map id?1087 mod2147) (id?1087 id2148))) tmp2145) #f) (apply (lambda (_2150 mod2151 id2152) (values (syntax->datum id2152) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2151)))) tmp2145) (syntax-violation #f "source expression failed to match any pattern" tmp2144))) ($sc-dispatch tmp2144 (quote (any each-any any))))) e2143))) (global-extend1085 (quote begin) (quote begin) (quote ())) (global-extend1085 (quote define) (quote define) (quote ())) (global-extend1085 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1085 (quote eval-when) (quote eval-when) (quote ())) (global-extend1085 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2157 (lambda (x2158 keys2159 clauses2160 r2161 mod2162) (if (null? clauses2160) (build-annotated1064 #f (list (build-annotated1064 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2158)) ((lambda (tmp2163) ((lambda (tmp2164) (if tmp2164 (apply (lambda (pat2165 exp2166) (if (and (id?1087 pat2165) (and-map (lambda (x2167) (not (free-id=?1110 pat2165 x2167))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook 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)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys2159))) (let ((labels2168 (list (gen-label1092))) (var2169 (gen-var1135 pat2165))) (build-annotated1064 #f (list (build-annotated1064 #f (list (quote lambda) (list var2169) (chi1123 exp2166 (extend-env1081 labels2168 (list (cons (quote syntax) (cons var2169 0))) r2161) (make-binding-wrap1104 (list pat2165) labels2168 (quote (()))) mod2162))) x2158))) (gen-clause2156 x2158 keys2159 (cdr clauses2160) r2161 pat2165 #t exp2166 mod2162))) tmp2164) ((lambda (tmp2170) (if tmp2170 (apply (lambda (pat2171 fender2172 exp2173) (gen-clause2156 x2158 keys2159 (cdr clauses2160) r2161 pat2171 fender2172 exp2173 mod2162)) tmp2170) ((lambda (_2174) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2160))) tmp2163))) ($sc-dispatch tmp2163 (quote (any any any)))))) ($sc-dispatch tmp2163 (quote (any any))))) (car clauses2160))))) (gen-clause2156 (lambda (x2175 keys2176 clauses2177 r2178 pat2179 fender2180 exp2181 mod2182) (call-with-values (lambda () (convert-pattern2154 pat2179 keys2176)) (lambda (p2183 pvars2184) (cond ((not (distinct-bound-ids?1113 (map car pvars2184))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2179)) ((not (and-map (lambda (x2185) (not (ellipsis?1132 (car x2185)))) pvars2184)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2179)) (else (let ((y2186 (gen-var1135 (quote tmp)))) (build-annotated1064 #f (list (build-annotated1064 #f (list (quote lambda) (list y2186) (let ((y2187 (build-annotated1064 #f y2186))) (build-annotated1064 #f (list (quote if) ((lambda (tmp2188) ((lambda (tmp2189) (if tmp2189 (apply (lambda () y2187) tmp2189) ((lambda (_2190) (build-annotated1064 #f (list (quote if) y2187 (build-dispatch-call2155 pvars2184 fender2180 y2187 r2178 mod2182) (build-data1065 #f #f)))) tmp2188))) ($sc-dispatch tmp2188 (quote #(atom #t))))) fender2180) (build-dispatch-call2155 pvars2184 exp2181 y2187 r2178 mod2182) (gen-syntax-case2157 x2175 keys2176 clauses2177 r2178 mod2182)))))) (if (eq? p2183 (quote any)) (build-annotated1064 #f (list (build-annotated1064 #f (quote list)) x2175)) (build-annotated1064 #f (list (build-annotated1064 #f (quote $sc-dispatch)) x2175 (build-data1065 #f p2183))))))))))))) (build-dispatch-call2155 (lambda (pvars2191 exp2192 y2193 r2194 mod2195) (let ((ids2196 (map car pvars2191)) (levels2197 (map cdr pvars2191))) (let ((labels2198 (gen-labels1093 ids2196)) (new-vars2199 (map gen-var1135 ids2196))) (build-annotated1064 #f (list (build-annotated1064 #f (quote apply)) (build-annotated1064 #f (list (quote lambda) new-vars2199 (chi1123 exp2192 (extend-env1081 labels2198 (map (lambda (var2200 level2201) (cons (quote syntax) (cons var2200 level2201))) new-vars2199 (map cdr pvars2191)) r2194) (make-binding-wrap1104 ids2196 labels2198 (quote (()))) mod2195))) y2193)))))) (convert-pattern2154 (lambda (pattern2202 keys2203) (let cvt2204 ((p2205 pattern2202) (n2206 0) (ids2207 (quote ()))) (if (id?1087 p2205) (if (bound-id-member?1114 p2205 keys2203) (values (vector (quote free-id) p2205) ids2207) (values (quote any) (cons (cons p2205 n2206) ids2207))) ((lambda (tmp2208) ((lambda (tmp2209) (if (if tmp2209 (apply (lambda (x2210 dots2211) (ellipsis?1132 dots2211)) tmp2209) #f) (apply (lambda (x2212 dots2213) (call-with-values (lambda () (cvt2204 x2212 (fx+1055 n2206 1) ids2207)) (lambda (p2214 ids2215) (values (if (eq? p2214 (quote any)) (quote each-any) (vector (quote each) p2214)) ids2215)))) tmp2209) ((lambda (tmp2216) (if tmp2216 (apply (lambda (x2217 y2218) (call-with-values (lambda () (cvt2204 y2218 n2206 ids2207)) (lambda (y2219 ids2220) (call-with-values (lambda () (cvt2204 x2217 n2206 ids2220)) (lambda (x2221 ids2222) (values (cons x2221 y2219) ids2222)))))) tmp2216) ((lambda (tmp2223) (if tmp2223 (apply (lambda () (values (quote ()) ids2207)) tmp2223) ((lambda (tmp2224) (if tmp2224 (apply (lambda (x2225) (call-with-values (lambda () (cvt2204 x2225 n2206 ids2207)) (lambda (p2227 ids2228) (values (vector (quote vector) p2227) ids2228)))) tmp2224) ((lambda (x2229) (values (vector (quote atom) (strip1134 p2205 (quote (())))) ids2207)) tmp2208))) ($sc-dispatch tmp2208 (quote #(vector each-any)))))) ($sc-dispatch tmp2208 (quote ()))))) ($sc-dispatch tmp2208 (quote (any . any)))))) ($sc-dispatch tmp2208 (quote (any any))))) p2205)))))) (lambda (e2230 r2231 w2232 s2233 mod2234) (let ((e2235 (source-wrap1116 e2230 w2232 s2233 mod2234))) ((lambda (tmp2236) ((lambda (tmp2237) (if tmp2237 (apply (lambda (_2238 val2239 key2240 m2241) (if (and-map (lambda (x2242) (and (id?1087 x2242) (not (ellipsis?1132 x2242)))) key2240) (let ((x2244 (gen-var1135 (quote tmp)))) (build-annotated1064 s2233 (list (build-annotated1064 #f (list (quote lambda) (list x2244) (gen-syntax-case2157 (build-annotated1064 #f x2244) key2240 m2241 r2231 mod2234))) (chi1123 val2239 r2231 (quote (())) mod2234)))) (syntax-violation (quote syntax-case) "invalid literals list" e2235))) tmp2237) (syntax-violation #f "source expression failed to match any pattern" tmp2236))) ($sc-dispatch tmp2236 (quote (any any each-any . each-any))))) e2235))))) (set! sc-expand (let ((m2247 (quote e)) (esew2248 (quote (eval)))) (lambda (x2249) (if (and (pair? x2249) (equal? (car x2249) noexpand1054)) (cadr x2249) (chi-top1122 x2249 (quote ()) (quote ((top))) m2247 esew2248 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2250 (quote e)) (esew2251 (quote (eval)))) (lambda (x2253 . rest2252) (if (and (pair? x2253) (equal? (car x2253) noexpand1054)) (cadr x2253) (chi-top1122 x2253 (quote ()) (quote ((top))) (if (null? rest2252) m2250 (car rest2252)) (if (or (null? rest2252) (null? (cdr rest2252))) esew2251 (cadr rest2252)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2254) (nonsymbol-id?1086 x2254))) (set! datum->syntax (lambda (id2255 datum2256) (make-syntax-object1070 datum2256 (syntax-object-wrap1073 id2255) #f))) (set! syntax->datum (lambda (x2257) (strip1134 x2257 (quote (()))))) (set! generate-temporaries (lambda (ls2258) (begin (let ((x2259 ls2258)) (if (not (list? x2259)) (error-hook1061 (quote generate-temporaries) "invalid argument" x2259))) (map (lambda (x2260) (wrap1115 (gensym) (quote ((top))) #f)) ls2258)))) (set! free-identifier=? (lambda (x2261 y2262) (begin (let ((x2263 x2261)) (if (not (nonsymbol-id?1086 x2263)) (error-hook1061 (quote free-identifier=?) "invalid argument" x2263))) (let ((x2264 y2262)) (if (not (nonsymbol-id?1086 x2264)) (error-hook1061 (quote free-identifier=?) "invalid argument" x2264))) (free-id=?1110 x2261 y2262)))) (set! bound-identifier=? (lambda (x2265 y2266) (begin (let ((x2267 x2265)) (if (not (nonsymbol-id?1086 x2267)) (error-hook1061 (quote bound-identifier=?) "invalid argument" x2267))) (let ((x2268 y2266)) (if (not (nonsymbol-id?1086 x2268)) (error-hook1061 (quote bound-identifier=?) "invalid argument" x2268))) (bound-id=?1111 x2265 y2266)))) (set! syntax-violation (lambda (who2272 message2271 form2270 . subform2269) (begin (let ((x2273 who2272)) (if (not ((lambda (x2274) (or (not x2274) (string? x2274) (symbol? x2274))) x2273)) (error-hook1061 (quote syntax-violation) "invalid argument" x2273))) (let ((x2275 message2271)) (if (not (string? x2275)) (error-hook1061 (quote syntax-violation) "invalid argument" x2275))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2272 "~a: " "") "~a " (if (null? subform2269) "in ~a" "in subform `~s' of `~s'")) (let ((tail2276 (cons message2271 (map (lambda (x2277) (strip1134 x2277 (quote (())))) (append subform2269 (list form2270)))))) (if who2272 (cons who2272 tail2276) tail2276)) #f)))) (letrec ((match2282 (lambda (e2283 p2284 w2285 r2286 mod2287) (cond ((not r2286) #f) ((eq? p2284 (quote any)) (cons (wrap1115 e2283 w2285 mod2287) r2286)) ((syntax-object?1071 e2283) (match*2281 (let ((e2288 (syntax-object-expression1072 e2283))) (if (annotation? e2288) (annotation-expression e2288) e2288)) p2284 (join-wraps1106 w2285 (syntax-object-wrap1073 e2283)) r2286 (syntax-object-module1074 e2283))) (else (match*2281 (let ((e2289 e2283)) (if (annotation? e2289) (annotation-expression e2289) e2289)) p2284 w2285 r2286 mod2287))))) (match*2281 (lambda (e2290 p2291 w2292 r2293 mod2294) (cond ((null? p2291) (and (null? e2290) r2293)) ((pair? p2291) (and (pair? e2290) (match2282 (car e2290) (car p2291) w2292 (match2282 (cdr e2290) (cdr p2291) w2292 r2293 mod2294) mod2294))) ((eq? p2291 (quote each-any)) (let ((l2295 (match-each-any2279 e2290 w2292 mod2294))) (and l2295 (cons l2295 r2293)))) (else (let ((t2296 (vector-ref p2291 0))) (if (memv t2296 (quote (each))) (if (null? e2290) (match-empty2280 (vector-ref p2291 1) r2293) (let ((l2297 (match-each2278 e2290 (vector-ref p2291 1) w2292 mod2294))) (and l2297 (let collect2298 ((l2299 l2297)) (if (null? (car l2299)) r2293 (cons (map car l2299) (collect2298 (map cdr l2299)))))))) (if (memv t2296 (quote (free-id))) (and (id?1087 e2290) (free-id=?1110 (wrap1115 e2290 w2292 mod2294) (vector-ref p2291 1)) r2293) (if (memv t2296 (quote (atom))) (and (equal? (vector-ref p2291 1) (strip1134 e2290 w2292)) r2293) (if (memv t2296 (quote (vector))) (and (vector? e2290) (match2282 (vector->list e2290) (vector-ref p2291 1) w2292 r2293 mod2294))))))))))) (match-empty2280 (lambda (p2300 r2301) (cond ((null? p2300) r2301) ((eq? p2300 (quote any)) (cons (quote ()) r2301)) ((pair? p2300) (match-empty2280 (car p2300) (match-empty2280 (cdr p2300) r2301))) ((eq? p2300 (quote each-any)) (cons (quote ()) r2301)) (else (let ((t2302 (vector-ref p2300 0))) (if (memv t2302 (quote (each))) (match-empty2280 (vector-ref p2300 1) r2301) (if (memv t2302 (quote (free-id atom))) r2301 (if (memv t2302 (quote (vector))) (match-empty2280 (vector-ref p2300 1) r2301))))))))) (match-each-any2279 (lambda (e2303 w2304 mod2305) (cond ((annotation? e2303) (match-each-any2279 (annotation-expression e2303) w2304 mod2305)) ((pair? e2303) (let ((l2306 (match-each-any2279 (cdr e2303) w2304 mod2305))) (and l2306 (cons (wrap1115 (car e2303) w2304 mod2305) l2306)))) ((null? e2303) (quote ())) ((syntax-object?1071 e2303) (match-each-any2279 (syntax-object-expression1072 e2303) (join-wraps1106 w2304 (syntax-object-wrap1073 e2303)) mod2305)) (else #f)))) (match-each2278 (lambda (e2307 p2308 w2309 mod2310) (cond ((annotation? e2307) (match-each2278 (annotation-expression e2307) p2308 w2309 mod2310)) ((pair? e2307) (let ((first2311 (match2282 (car e2307) p2308 w2309 (quote ()) mod2310))) (and first2311 (let ((rest2312 (match-each2278 (cdr e2307) p2308 w2309 mod2310))) (and rest2312 (cons first2311 rest2312)))))) ((null? e2307) (quote ())) ((syntax-object?1071 e2307) (match-each2278 (syntax-object-expression1072 e2307) p2308 (join-wraps1106 w2309 (syntax-object-wrap1073 e2307)) (syntax-object-module1074 e2307))) (else #f))))) (set! $sc-dispatch (lambda (e2313 p2314) (cond ((eq? p2314 (quote any)) (list e2313)) ((syntax-object?1071 e2313) (match*2281 (let ((e2315 (syntax-object-expression1072 e2313))) (if (annotation? e2315) (annotation-expression e2315) e2315)) p2314 (syntax-object-wrap1073 e2313) (quote ()) (syntax-object-module1074 e2313))) (else (match*2281 (let ((e2316 e2313)) (if (annotation? e2316) (annotation-expression e2316) e2316)) p2314 (quote (())) (quote ()) #f)))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x2317) ((lambda (tmp2318) ((lambda (tmp2319) (if tmp2319 (apply (lambda (_2320 e12321 e22322) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12321 e22322))) tmp2319) ((lambda (tmp2324) (if tmp2324 (apply (lambda (_2325 out2326 in2327 e12328 e22329) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2327 (quote ()) (list out2326 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12328 e22329))))) tmp2324) ((lambda (tmp2331) (if tmp2331 (apply (lambda (_2332 out2333 in2334 e12335 e22336) (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))) in2334) (quote ()) (list out2333 (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 e12335 e22336))))) tmp2331) (syntax-violation #f "source expression failed to match any pattern" tmp2318))) ($sc-dispatch tmp2318 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2318 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2318 (quote (any () any . each-any))))) x2317))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2340) ((lambda (tmp2341) ((lambda (tmp2342) (if tmp2342 (apply (lambda (_2343 k2344 keyword2345 pattern2346 template2347) (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 k2344 (map (lambda (tmp2350 tmp2349) (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))) tmp2349) (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))) tmp2350))) template2347 pattern2346)))))) tmp2342) (syntax-violation #f "source expression failed to match any pattern" tmp2341))) ($sc-dispatch tmp2341 (quote (any each-any . #(each ((any . any) any))))))) x2340))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2351) ((lambda (tmp2352) ((lambda (tmp2353) (if (if tmp2353 (apply (lambda (let*2354 x2355 v2356 e12357 e22358) (and-map identifier? x2355)) tmp2353) #f) (apply (lambda (let*2360 x2361 v2362 e12363 e22364) (let f2365 ((bindings2366 (map list x2361 v2362))) (if (null? bindings2366) (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 e12363 e22364))) ((lambda (tmp2370) ((lambda (tmp2371) (if tmp2371 (apply (lambda (body2372 binding2373) (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 binding2373) body2372)) tmp2371) (syntax-violation #f "source expression failed to match any pattern" tmp2370))) ($sc-dispatch tmp2370 (quote (any any))))) (list (f2365 (cdr bindings2366)) (car bindings2366)))))) tmp2353) (syntax-violation #f "source expression failed to match any pattern" tmp2352))) ($sc-dispatch tmp2352 (quote (any #(each (any any)) any . each-any))))) x2351))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2374) ((lambda (tmp2375) ((lambda (tmp2376) (if tmp2376 (apply (lambda (_2377 var2378 init2379 step2380 e02381 e12382 c2383) ((lambda (tmp2384) ((lambda (tmp2385) (if tmp2385 (apply (lambda (step2386) ((lambda (tmp2387) ((lambda (tmp2388) (if tmp2388 (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 var2378 init2379) (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))) e02381) (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 c2383 (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))) step2386))))))) tmp2388) ((lambda (tmp2393) (if tmp2393 (apply (lambda (e12394 e22395) (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 var2378 init2379) (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))) e02381 (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 e12394 e22395)) (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 c2383 (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))) step2386))))))) tmp2393) (syntax-violation #f "source expression failed to match any pattern" tmp2387))) ($sc-dispatch tmp2387 (quote (any . each-any)))))) ($sc-dispatch tmp2387 (quote ())))) e12382)) tmp2385) (syntax-violation #f "source expression failed to match any pattern" tmp2384))) ($sc-dispatch tmp2384 (quote each-any)))) (map (lambda (v2402 s2403) ((lambda (tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda () v2402) tmp2405) ((lambda (tmp2406) (if tmp2406 (apply (lambda (e2407) e2407) tmp2406) ((lambda (_2408) (syntax-violation (quote do) "bad step expression" orig-x2374 s2403)) tmp2404))) ($sc-dispatch tmp2404 (quote (any)))))) ($sc-dispatch tmp2404 (quote ())))) s2403)) var2378 step2380))) tmp2376) (syntax-violation #f "source expression failed to match any pattern" tmp2375))) ($sc-dispatch tmp2375 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2374))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2411 (lambda (x2415 y2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (apply (lambda (x2419 y2420) ((lambda (tmp2421) ((lambda (tmp2422) (if tmp2422 (apply (lambda (dy2423) ((lambda (tmp2424) ((lambda (tmp2425) (if tmp2425 (apply (lambda (dx2426) (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 dx2426 dy2423))) tmp2425) ((lambda (_2427) (if (null? dy2423) (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))) x2419) (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))) x2419 y2420))) tmp2424))) ($sc-dispatch tmp2424 (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))))) x2419)) tmp2422) ((lambda (tmp2428) (if tmp2428 (apply (lambda (stuff2429) (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 x2419 stuff2429))) tmp2428) ((lambda (else2430) (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))) x2419 y2420)) tmp2421))) ($sc-dispatch tmp2421 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp2421 (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))))) y2420)) tmp2418) (syntax-violation #f "source expression failed to match any pattern" tmp2417))) ($sc-dispatch tmp2417 (quote (any any))))) (list x2415 y2416)))) (quasiappend2412 (lambda (x2431 y2432) ((lambda (tmp2433) ((lambda (tmp2434) (if tmp2434 (apply (lambda (x2435 y2436) ((lambda (tmp2437) ((lambda (tmp2438) (if tmp2438 (apply (lambda () x2435) tmp2438) ((lambda (_2439) (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))) x2435 y2436)) tmp2437))) ($sc-dispatch tmp2437 (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))) ()))))) y2436)) tmp2434) (syntax-violation #f "source expression failed to match any pattern" tmp2433))) ($sc-dispatch tmp2433 (quote (any any))))) (list x2431 y2432)))) (quasivector2413 (lambda (x2440) ((lambda (tmp2441) ((lambda (x2442) ((lambda (tmp2443) ((lambda (tmp2444) (if tmp2444 (apply (lambda (x2445) (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 x2445))) tmp2444) ((lambda (tmp2447) (if tmp2447 (apply (lambda (x2448) (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))) x2448)) tmp2447) ((lambda (_2450) (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))) x2442)) tmp2443))) ($sc-dispatch tmp2443 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp2443 (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))))) x2442)) tmp2441)) x2440))) (quasi2414 (lambda (p2451 lev2452) ((lambda (tmp2453) ((lambda (tmp2454) (if tmp2454 (apply (lambda (p2455) (if (= lev2452 0) p2455 (quasicons2411 (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)))) (quasi2414 (list p2455) (- lev2452 1))))) tmp2454) ((lambda (tmp2456) (if tmp2456 (apply (lambda (p2457 q2458) (if (= lev2452 0) (quasiappend2412 p2457 (quasi2414 q2458 lev2452)) (quasicons2411 (quasicons2411 (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)))) (quasi2414 (list p2457) (- lev2452 1))) (quasi2414 q2458 lev2452)))) tmp2456) ((lambda (tmp2459) (if tmp2459 (apply (lambda (p2460) (quasicons2411 (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)))) (quasi2414 (list p2460) (+ lev2452 1)))) tmp2459) ((lambda (tmp2461) (if tmp2461 (apply (lambda (p2462 q2463) (quasicons2411 (quasi2414 p2462 lev2452) (quasi2414 q2463 lev2452))) tmp2461) ((lambda (tmp2464) (if tmp2464 (apply (lambda (x2465) (quasivector2413 (quasi2414 x2465 lev2452))) tmp2464) ((lambda (p2467) (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))) p2467)) tmp2453))) ($sc-dispatch tmp2453 (quote #(vector each-any)))))) ($sc-dispatch tmp2453 (quote (any . any)))))) ($sc-dispatch tmp2453 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp2453 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp2453 (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))))) p2451)))) (lambda (x2468) ((lambda (tmp2469) ((lambda (tmp2470) (if tmp2470 (apply (lambda (_2471 e2472) (quasi2414 e2472 0)) tmp2470) (syntax-violation #f "source expression failed to match any pattern" tmp2469))) ($sc-dispatch tmp2469 (quote (any any))))) x2468)))))
+(define include (make-syncase-macro (quote macro) (lambda (x2473) (letrec ((read-file2474 (lambda (fn2475 k2476) (let ((p2477 (open-input-file fn2475))) (let f2478 ((x2479 (read p2477))) (if (eof-object? x2479) (begin (close-input-port p2477) (quote ())) (cons (datum->syntax k2476 x2479) (f2478 (read p2477))))))))) ((lambda (tmp2480) ((lambda (tmp2481) (if tmp2481 (apply (lambda (k2482 filename2483) (let ((fn2484 (syntax->datum filename2483))) ((lambda (tmp2485) ((lambda (tmp2486) (if tmp2486 (apply (lambda (exp2487) (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))) exp2487)) tmp2486) (syntax-violation #f "source expression failed to match any pattern" tmp2485))) ($sc-dispatch tmp2485 (quote each-any)))) (read-file2474 fn2484 k2482)))) tmp2481) (syntax-violation #f "source expression failed to match any pattern" tmp2480))) ($sc-dispatch tmp2480 (quote (any any))))) x2473)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x2489) ((lambda (tmp2490) ((lambda (tmp2491) (if tmp2491 (apply (lambda (_2492 e2493) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum e2493))) tmp2491) (syntax-violation #f "source expression failed to match any pattern" tmp2490))) ($sc-dispatch tmp2490 (quote (any any))))) x2489))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2494) ((lambda (tmp2495) ((lambda (tmp2496) (if tmp2496 (apply (lambda (_2497 e2498) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax->datum e2498))) tmp2496) (syntax-violation #f "source expression failed to match any pattern" tmp2495))) ($sc-dispatch tmp2495 (quote (any any))))) x2494))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2499) ((lambda (tmp2500) ((lambda (tmp2501) (if tmp2501 (apply (lambda (_2502 e2503 m12504 m22505) ((lambda (tmp2506) ((lambda (body2507) (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))) e2503)) body2507)) tmp2506)) (let f2508 ((clause2509 m12504) (clauses2510 m22505)) (if (null? clauses2510) ((lambda (tmp2512) ((lambda (tmp2513) (if tmp2513 (apply (lambda (e12514 e22515) (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 e12514 e22515))) tmp2513) ((lambda (tmp2517) (if tmp2517 (apply (lambda (k2518 e12519 e22520) (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))) k2518)) (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 e12519 e22520)))) tmp2517) ((lambda (_2523) (syntax-violation (quote case) "bad clause" x2499 clause2509)) tmp2512))) ($sc-dispatch tmp2512 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2512 (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))))) clause2509) ((lambda (tmp2524) ((lambda (rest2525) ((lambda (tmp2526) ((lambda (tmp2527) (if tmp2527 (apply (lambda (k2528 e12529 e22530) (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))) k2528)) (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 e12529 e22530)) rest2525)) tmp2527) ((lambda (_2533) (syntax-violation (quote case) "bad clause" x2499 clause2509)) tmp2526))) ($sc-dispatch tmp2526 (quote (each-any any . each-any))))) clause2509)) tmp2524)) (f2508 (car clauses2510) (cdr clauses2510))))))) tmp2501) (syntax-violation #f "source expression failed to match any pattern" tmp2500))) ($sc-dispatch tmp2500 (quote (any any any . each-any))))) x2499))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2534) ((lambda (tmp2535) ((lambda (tmp2536) (if tmp2536 (apply (lambda (_2537 e2538) (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))) e2538)) (list (cons _2537 (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 e2538 (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)))))))))) tmp2536) (syntax-violation #f "source expression failed to match any pattern" tmp2535))) ($sc-dispatch tmp2535 (quote (any any))))) x2534))))
;;; returns the implementation's cannonical "unspecified value". This
;;; usually works: (define void (lambda () (if #f #f))).
;;;
-;;; (andmap proc list1 list2 ...)
-;;; returns true if proc returns true when applied to each element of list1
-;;; along with the corresponding elements of list2 ....
-;;; The following definition works but does no error checking:
-;;;
-;;; (define andmap
-;;; (lambda (f first . rest)
-;;; (or (null? first)
-;;; (if (null? rest)
-;;; (let andmap ((first first))
-;;; (let ((x (car first)) (first (cdr first)))
-;;; (if (null? first)
-;;; (f x)
-;;; (and (f x) (andmap first)))))
-;;; (let andmap ((first first) (rest rest))
-;;; (let ((x (car first))
-;;; (xr (map car rest))
-;;; (first (cdr first))
-;;; (rest (map cdr rest)))
-;;; (if (null? first)
-;;; (apply f (cons x xr))
-;;; (and (apply f (cons x xr)) (andmap first rest)))))))))
-;;;
;;; The following nonstandard procedures must also be provided by the
;;; implementation for this code to run using the standard portable
;;; hooks and output constructors. They are not used by expanded code,
(set-current-module (resolve-module '(guile))))
(let ()
+;;; Private version of and-map that handles multiple lists.
+(define and-map*
+ (lambda (f first . rest)
+ (or (null? first)
+ (if (null? rest)
+ (let andmap ((first first))
+ (let ((x (car first)) (first (cdr first)))
+ (if (null? first)
+ (f x)
+ (and (f x) (andmap first)))))
+ (let andmap ((first first) (rest rest))
+ (let ((x (car first))
+ (xr (map car rest))
+ (first (cdr first))
+ (rest (map cdr rest)))
+ (if (null? first)
+ (apply f (cons x xr))
+ (and (apply f (cons x xr)) (andmap first rest)))))))))
+
(define-syntax define-structure
(lambda (x)
(define construct-name
args))))))
(syntax-case x ()
((_ (name id1 ...))
- (andmap identifier? (syntax (name id1 ...)))
+ ;; But here we use and-map, because andmap isn't yet in scope for
+ ;; syntax.
+ (and-map identifier? (syntax (name id1 ...)))
(with-syntax
((constructor (construct-name (syntax name) "make-" (syntax name)))
(predicate (construct-name (syntax name) (syntax name) "?"))
((vector? x)
(let ((old (vector->list x)))
(let ((new (map f old)))
- (if (andmap eq? old new) x (list->vector new)))))
+ (if (and-map* eq? old new) x (list->vector new)))))
(else x))))))
;;; lexical variables
; identity map equivalence:
; (map (lambda (x) x) y) == y
(car actuals))
- ((andmap
+ ((and-map
(lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals)))
(cdr e))
; eta map equivalence:
(lambda (e)
(syntax-case e ()
((_ (mod ...) id)
- (and (andmap id? (syntax (mod ...))) (id? (syntax id)))
+ (and (and-map id? (syntax (mod ...))) (id? (syntax id)))
(values (syntax->datum (syntax id))
(syntax->datum
(syntax (public mod ...))))))))
(lambda (e)
(syntax-case e ()
((_ (mod ...) id)
- (and (andmap id? (syntax (mod ...))) (id? (syntax id)))
+ (and (and-map id? (syntax (mod ...))) (id? (syntax id)))
(values (syntax->datum (syntax id))
(syntax->datum
(syntax (private mod ...))))))))
(cond
((not (distinct-bound-ids? (map car pvars)))
(syntax-violation 'syntax-case "duplicate pattern variable" pat))
- ((not (andmap (lambda (x) (not (ellipsis? (car x)))) pvars))
+ ((not (and-map (lambda (x) (not (ellipsis? (car x)))) pvars))
(syntax-violation 'syntax-case "misplaced ellipsis" pat))
(else
(let ((y (gen-var 'tmp)))
(syntax-case (car clauses) ()
((pat exp)
(if (and (id? (syntax pat))
- (andmap (lambda (x) (not (free-id=? (syntax pat) x)))
- (cons (syntax (... ...)) keys)))
+ (and-map (lambda (x) (not (free-id=? (syntax pat) x)))
+ (cons (syntax (... ...)) keys)))
(let ((labels (list (gen-label)))
(var (gen-var (syntax pat))))
(build-application no-source
(let ((e (source-wrap e w s mod)))
(syntax-case e ()
((_ val (key ...) m ...)
- (if (andmap (lambda (x) (and (id? x) (not (ellipsis? x))))
- (syntax (key ...)))
+ (if (and-map (lambda (x) (and (id? x) (not (ellipsis? x))))
+ (syntax (key ...)))
(let ((x (gen-var 'tmp)))
; fat finger binding and references to temp variable x
(build-application s
(lambda (x)
(syntax-case x ()
((let* ((x v) ...) e1 e2 ...)
- (andmap identifier? (syntax (x ...)))
+ (and-map identifier? (syntax (x ...)))
(let f ((bindings (syntax ((x v) ...))))
(if (null? bindings)
(syntax (let () e1 e2 ...))
HCoop / bpt / guile.git / commitdiff