handle pre-module macro procedures correctly

* module/ice-9/psyntax.scm (chi-macro): It's possible for a macro
  procedure to have no module, if the procedure was made before modules
  were booted.

* module/ice-9/psyntax-pp.scm: Regenerated.

diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
dissimilarity index 67%
index 901574c..743197f 100644 (file)
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,11 +1,11 @@
-(letrec ((lambda-var-list1180 (lambda (vars1379) (let lvl1380 ((vars1381 vars1379) (ls1382 (quote ())) (w1383 (quote (())))) (cond ((pair? vars1381) (lvl1380 (cdr vars1381) (cons (wrap1159 (car vars1381) w1383 #f) ls1382) w1383)) ((id?1131 vars1381) (cons (wrap1159 vars1381 w1383 #f) ls1382)) ((null? vars1381) ls1382) ((syntax-object?1115 vars1381) (lvl1380 (syntax-object-expression1116 vars1381) ls1382 (join-wraps1150 w1383 (syntax-object-wrap1117 vars1381)))) ((annotation? vars1381) (lvl1380 (annotation-expression vars1381) ls1382 w1383)) (else (cons vars1381 ls1382)))))) (gen-var1179 (lambda (id1384) (let ((id1385 (if (syntax-object?1115 id1384) (syntax-object-expression1116 id1384) id1384))) (if (annotation? id1385) (build-annotated1108 (annotation-source id1385) (gensym (symbol->string (annotation-expression id1385)))) (build-annotated1108 #f (gensym (symbol->string id1385))))))) (strip1178 (lambda (x1386 w1387) (if (memq (quote top) (wrap-marks1134 w1387)) (if (or (annotation? x1386) (and (pair? x1386) (annotation? (car x1386)))) (strip-annotation1177 x1386 #f) x1386) (let f1388 ((x1389 x1386)) (cond ((syntax-object?1115 x1389) (strip1178 (syntax-object-expression1116 x1389) (syntax-object-wrap1117 x1389))) ((pair? x1389) (let ((a1390 (f1388 (car x1389))) (d1391 (f1388 (cdr x1389)))) (if (and (eq? a1390 (car x1389)) (eq? d1391 (cdr x1389))) x1389 (cons a1390 d1391)))) ((vector? x1389) (let ((old1392 (vector->list x1389))) (let ((new1393 (map f1388 old1392))) (if (andmap eq? old1392 new1393) x1389 (list->vector new1393))))) (else x1389)))))) (strip-annotation1177 (lambda (x1394 parent1395) (cond ((pair? x1394) (let ((new1396 (cons #f #f))) (begin (if parent1395 (set-annotation-stripped! parent1395 new1396)) (set-car! new1396 (strip-annotation1177 (car x1394) #f)) (set-cdr! new1396 (strip-annotation1177 (cdr x1394) #f)) new1396))) ((annotation? x1394) (or (annotation-stripped x1394) (strip-annotation1177 (annotation-expression x1394) x1394))) ((vector? x1394) (let ((new1397 (make-vector (vector-length x1394)))) (begin (if parent1395 (set-annotation-stripped! parent1395 new1397)) (let loop1398 ((i1399 (- (vector-length x1394) 1))) (unless (fx<1101 i1399 0) (vector-set! new1397 i1399 (strip-annotation1177 (vector-ref x1394 i1399) #f)) (loop1398 (fx-1099 i1399 1)))) new1397))) (else x1394)))) (ellipsis?1176 (lambda (x1400) (and (nonsymbol-id?1130 x1400) (free-id=?1154 x1400 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void1175 (lambda () (build-annotated1108 #f (list (build-annotated1108 #f (quote void)))))) (eval-local-transformer1174 (lambda (expanded1401 mod1402) (let ((p1403 (local-eval-hook1103 expanded1401 mod1402))) (if (procedure? p1403) p1403 (syntax-error p1403 "nonprocedure transformer"))))) (chi-local-syntax1173 (lambda (rec?1404 e1405 r1406 w1407 s1408 mod1409 k1410) ((lambda (tmp1411) ((lambda (tmp1412) (if tmp1412 (apply (lambda (_1413 id1414 val1415 e11416 e21417) (let ((ids1418 id1414)) (if (not (valid-bound-ids?1156 ids1418)) (syntax-error e1405 "duplicate bound keyword in") (let ((labels1420 (gen-labels1137 ids1418))) (let ((new-w1421 (make-binding-wrap1148 ids1418 labels1420 w1407))) (k1410 (cons e11416 e21417) (extend-env1125 labels1420 (let ((w1423 (if rec?1404 new-w1421 w1407)) (trans-r1424 (macros-only-env1127 r1406))) (map (lambda (x1425) (cons (quote macro) (eval-local-transformer1174 (chi1167 x1425 trans-r1424 w1423 mod1409) mod1409))) val1415)) r1406) new-w1421 s1408 mod1409)))))) tmp1412) ((lambda (_1427) (syntax-error (source-wrap1160 e1405 w1407 s1408 mod1409))) tmp1411))) (syntax-dispatch tmp1411 (quote (any #(each (any any)) any . each-any))))) e1405))) (chi-lambda-clause1172 (lambda (e1428 c1429 r1430 w1431 mod1432 k1433) ((lambda (tmp1434) ((lambda (tmp1435) (if tmp1435 (apply (lambda (id1436 e11437 e21438) (let ((ids1439 id1436)) (if (not (valid-bound-ids?1156 ids1439)) (syntax-error e1428 "invalid parameter list in") (let ((labels1441 (gen-labels1137 ids1439)) (new-vars1442 (map gen-var1179 ids1439))) (k1433 new-vars1442 (chi-body1171 (cons e11437 e21438) e1428 (extend-var-env1126 labels1441 new-vars1442 r1430) (make-binding-wrap1148 ids1439 labels1441 w1431) mod1432)))))) tmp1435) ((lambda (tmp1444) (if tmp1444 (apply (lambda (ids1445 e11446 e21447) (let ((old-ids1448 (lambda-var-list1180 ids1445))) (if (not (valid-bound-ids?1156 old-ids1448)) (syntax-error e1428 "invalid parameter list in") (let ((labels1449 (gen-labels1137 old-ids1448)) (new-vars1450 (map gen-var1179 old-ids1448))) (k1433 (let f1451 ((ls11452 (cdr new-vars1450)) (ls21453 (car new-vars1450))) (if (null? ls11452) ls21453 (f1451 (cdr ls11452) (cons (car ls11452) ls21453)))) (chi-body1171 (cons e11446 e21447) e1428 (extend-var-env1126 labels1449 new-vars1450 r1430) (make-binding-wrap1148 old-ids1448 labels1449 w1431) mod1432)))))) tmp1444) ((lambda (_1455) (syntax-error e1428)) tmp1434))) (syntax-dispatch tmp1434 (quote (any any . each-any)))))) (syntax-dispatch tmp1434 (quote (each-any any . each-any))))) c1429))) (chi-body1171 (lambda (body1456 outer-form1457 r1458 w1459 mod1460) (let ((r1461 (cons (quote ("placeholder" placeholder)) r1458))) (let ((ribcage1462 (make-ribcage1138 (quote ()) (quote ()) (quote ())))) (let ((w1463 (make-wrap1133 (wrap-marks1134 w1459) (cons ribcage1462 (wrap-subst1135 w1459))))) (let parse1464 ((body1465 (map (lambda (x1471) (cons r1461 (wrap1159 x1471 w1463 mod1460))) body1456)) (ids1466 (quote ())) (labels1467 (quote ())) (vars1468 (quote ())) (vals1469 (quote ())) (bindings1470 (quote ()))) (if (null? body1465) (syntax-error outer-form1457 "no expressions in body") (let ((e1472 (cdar body1465)) (er1473 (caar body1465))) (call-with-values (lambda () (syntax-type1165 e1472 er1473 (quote (())) #f ribcage1462 mod1460)) (lambda (type1474 value1475 e1476 w1477 s1478 mod1479) (let ((t1480 type1474)) (if (memv t1480 (quote (define-form))) (let ((id1481 (wrap1159 value1475 w1477 mod1479)) (label1482 (gen-label1136))) (let ((var1483 (gen-var1179 id1481))) (begin (extend-ribcage!1147 ribcage1462 id1481 label1482) (parse1464 (cdr body1465) (cons id1481 ids1466) (cons label1482 labels1467) (cons var1483 vars1468) (cons (cons er1473 (wrap1159 e1476 w1477 mod1479)) vals1469) (cons (cons (quote lexical) var1483) bindings1470))))) (if (memv t1480 (quote (define-syntax-form))) (let ((id1484 (wrap1159 value1475 w1477 mod1479)) (label1485 (gen-label1136))) (begin (extend-ribcage!1147 ribcage1462 id1484 label1485) (parse1464 (cdr body1465) (cons id1484 ids1466) (cons label1485 labels1467) vars1468 vals1469 (cons (cons (quote macro) (cons er1473 (wrap1159 e1476 w1477 mod1479))) bindings1470)))) (if (memv t1480 (quote (begin-form))) ((lambda (tmp1486) ((lambda (tmp1487) (if tmp1487 (apply (lambda (_1488 e11489) (parse1464 (let f1490 ((forms1491 e11489)) (if (null? forms1491) (cdr body1465) (cons (cons er1473 (wrap1159 (car forms1491) w1477 mod1479)) (f1490 (cdr forms1491))))) ids1466 labels1467 vars1468 vals1469 bindings1470)) tmp1487) (syntax-error tmp1486))) (syntax-dispatch tmp1486 (quote (any . each-any))))) e1476) (if (memv t1480 (quote (local-syntax-form))) (chi-local-syntax1173 value1475 e1476 er1473 w1477 s1478 mod1479 (lambda (forms1493 er1494 w1495 s1496 mod1497) (parse1464 (let f1498 ((forms1499 forms1493)) (if (null? forms1499) (cdr body1465) (cons (cons er1494 (wrap1159 (car forms1499) w1495 mod1497)) (f1498 (cdr forms1499))))) ids1466 labels1467 vars1468 vals1469 bindings1470))) (if (null? ids1466) (build-sequence1110 #f (map (lambda (x1500) (chi1167 (cdr x1500) (car x1500) (quote (())) mod1479)) (cons (cons er1473 (source-wrap1160 e1476 w1477 s1478 mod1479)) (cdr body1465)))) (begin (if (not (valid-bound-ids?1156 ids1466)) (syntax-error outer-form1457 "invalid or duplicate identifier in definition")) (let loop1501 ((bs1502 bindings1470) (er-cache1503 #f) (r-cache1504 #f)) (if (not (null? bs1502)) (let ((b1505 (car bs1502))) (if (eq? (car b1505) (quote macro)) (let ((er1506 (cadr b1505))) (let ((r-cache1507 (if (eq? er1506 er-cache1503) r-cache1504 (macros-only-env1127 er1506)))) (begin (set-cdr! b1505 (eval-local-transformer1174 (chi1167 (cddr b1505) r-cache1507 (quote (())) mod1479) mod1479)) (loop1501 (cdr bs1502) er1506 r-cache1507)))) (loop1501 (cdr bs1502) er-cache1503 r-cache1504))))) (set-cdr! r1461 (extend-env1125 labels1467 bindings1470 (cdr r1461))) (build-letrec1113 #f vars1468 (map (lambda (x1508) (chi1167 (cdr x1508) (car x1508) (quote (())) mod1479)) vals1469) (build-sequence1110 #f (map (lambda (x1509) (chi1167 (cdr x1509) (car x1509) (quote (())) mod1479)) (cons (cons er1473 (source-wrap1160 e1476 w1477 s1478 mod1479)) (cdr body1465)))))))))))))))))))))) (chi-macro1170 (lambda (p1510 e1511 r1512 w1513 rib1514 mod1515) (letrec ((rebuild-macro-output1516 (lambda (x1517 m1518) (cond ((pair? x1517) (cons (rebuild-macro-output1516 (car x1517) m1518) (rebuild-macro-output1516 (cdr x1517) m1518))) ((syntax-object?1115 x1517) (let ((w1519 (syntax-object-wrap1117 x1517))) (let ((ms1520 (wrap-marks1134 w1519)) (s1521 (wrap-subst1135 w1519))) (if (and (pair? ms1520) (eq? (car ms1520) #f)) (make-syntax-object1114 (syntax-object-expression1116 x1517) (make-wrap1133 (cdr ms1520) (if rib1514 (cons rib1514 (cdr s1521)) (cdr s1521))) (syntax-object-module1118 x1517)) (make-syntax-object1114 (syntax-object-expression1116 x1517) (make-wrap1133 (cons m1518 ms1520) (if rib1514 (cons rib1514 (cons (quote shift) s1521)) (cons (quote shift) s1521))) (cons (quote hygiene) (module-name (procedure-module p1510)))))))) ((vector? x1517) (let ((n1522 (vector-length x1517))) (let ((v1523 (make-vector n1522))) (let doloop1524 ((i1525 0)) (if (fx=1100 i1525 n1522) v1523 (begin (vector-set! v1523 i1525 (rebuild-macro-output1516 (vector-ref x1517 i1525) m1518)) (doloop1524 (fx+1098 i1525 1)))))))) ((symbol? x1517) (syntax-error x1517 "encountered raw symbol in macro output")) (else x1517))))) (rebuild-macro-output1516 (p1510 (wrap1159 e1511 (anti-mark1146 w1513) mod1515)) (string #\m))))) (chi-application1169 (lambda (x1526 e1527 r1528 w1529 s1530 mod1531) ((lambda (tmp1532) ((lambda (tmp1533) (if tmp1533 (apply (lambda (e01534 e11535) (build-annotated1108 s1530 (cons x1526 (map (lambda (e1536) (chi1167 e1536 r1528 w1529 mod1531)) e11535)))) tmp1533) (syntax-error tmp1532))) (syntax-dispatch tmp1532 (quote (any . each-any))))) e1527))) (chi-expr1168 (lambda (type1538 value1539 e1540 r1541 w1542 s1543 mod1544) (let ((t1545 type1538)) (if (memv t1545 (quote (lexical))) (build-annotated1108 s1543 value1539) (if (memv t1545 (quote (core external-macro))) (value1539 e1540 r1541 w1542 s1543 mod1544) (if (memv t1545 (quote (module-ref))) (call-with-values (lambda () (value1539 e1540)) (lambda (id1546 mod1547) (build-annotated1108 s1543 (if mod1547 (make-module-ref (cdr mod1547) id1546 (car mod1547)) (make-module-ref mod1547 id1546 (quote bare)))))) (if (memv t1545 (quote (lexical-call))) (chi-application1169 (build-annotated1108 (source-annotation1122 (car e1540)) value1539) e1540 r1541 w1542 s1543 mod1544) (if (memv t1545 (quote (global-call))) (chi-application1169 (build-annotated1108 (source-annotation1122 (car e1540)) (if (if (syntax-object?1115 (car e1540)) (syntax-object-module1118 (car e1540)) mod1544) (make-module-ref (cdr (if (syntax-object?1115 (car e1540)) (syntax-object-module1118 (car e1540)) mod1544)) value1539 (car (if (syntax-object?1115 (car e1540)) (syntax-object-module1118 (car e1540)) mod1544))) (make-module-ref (if (syntax-object?1115 (car e1540)) (syntax-object-module1118 (car e1540)) mod1544) value1539 (quote bare)))) e1540 r1541 w1542 s1543 mod1544) (if (memv t1545 (quote (constant))) (build-data1109 s1543 (strip1178 (source-wrap1160 e1540 w1542 s1543 mod1544) (quote (())))) (if (memv t1545 (quote (global))) (build-annotated1108 s1543 (if mod1544 (make-module-ref (cdr mod1544) value1539 (car mod1544)) (make-module-ref mod1544 value1539 (quote bare)))) (if (memv t1545 (quote (call))) (chi-application1169 (chi1167 (car e1540) r1541 w1542 mod1544) e1540 r1541 w1542 s1543 mod1544) (if (memv t1545 (quote (begin-form))) ((lambda (tmp1548) ((lambda (tmp1549) (if tmp1549 (apply (lambda (_1550 e11551 e21552) (chi-sequence1161 (cons e11551 e21552) r1541 w1542 s1543 mod1544)) tmp1549) (syntax-error tmp1548))) (syntax-dispatch tmp1548 (quote (any any . each-any))))) e1540) (if (memv t1545 (quote (local-syntax-form))) (chi-local-syntax1173 value1539 e1540 r1541 w1542 s1543 mod1544 chi-sequence1161) (if (memv t1545 (quote (eval-when-form))) ((lambda (tmp1554) ((lambda (tmp1555) (if tmp1555 (apply (lambda (_1556 x1557 e11558 e21559) (let ((when-list1560 (chi-when-list1164 e1540 x1557 w1542))) (if (memq (quote eval) when-list1560) (chi-sequence1161 (cons e11558 e21559) r1541 w1542 s1543 mod1544) (chi-void1175)))) tmp1555) (syntax-error tmp1554))) (syntax-dispatch tmp1554 (quote (any each-any any . each-any))))) e1540) (if (memv t1545 (quote (define-form define-syntax-form))) (syntax-error (wrap1159 value1539 w1542 mod1544) "invalid context for definition of") (if (memv t1545 (quote (syntax))) (syntax-error (source-wrap1160 e1540 w1542 s1543 mod1544) "reference to pattern variable outside syntax form") (if (memv t1545 (quote (displaced-lexical))) (syntax-error (source-wrap1160 e1540 w1542 s1543 mod1544) "reference to identifier outside its scope") (syntax-error (source-wrap1160 e1540 w1542 s1543 mod1544))))))))))))))))))) (chi1167 (lambda (e1563 r1564 w1565 mod1566) (call-with-values (lambda () (syntax-type1165 e1563 r1564 w1565 #f #f mod1566)) (lambda (type1567 value1568 e1569 w1570 s1571 mod1572) (chi-expr1168 type1567 value1568 e1569 r1564 w1570 s1571 mod1572))))) (chi-top1166 (lambda (e1573 r1574 w1575 m1576 esew1577 mod1578) (call-with-values (lambda () (syntax-type1165 e1573 r1574 w1575 #f #f mod1578)) (lambda (type1586 value1587 e1588 w1589 s1590 mod1591) (let ((t1592 type1586)) (if (memv t1592 (quote (begin-form))) ((lambda (tmp1593) ((lambda (tmp1594) (if tmp1594 (apply (lambda (_1595) (chi-void1175)) tmp1594) ((lambda (tmp1596) (if tmp1596 (apply (lambda (_1597 e11598 e21599) (chi-top-sequence1162 (cons e11598 e21599) r1574 w1589 s1590 m1576 esew1577 mod1591)) tmp1596) (syntax-error tmp1593))) (syntax-dispatch tmp1593 (quote (any any . each-any)))))) (syntax-dispatch tmp1593 (quote (any))))) e1588) (if (memv t1592 (quote (local-syntax-form))) (chi-local-syntax1173 value1587 e1588 r1574 w1589 s1590 mod1591 (lambda (body1601 r1602 w1603 s1604 mod1605) (chi-top-sequence1162 body1601 r1602 w1603 s1604 m1576 esew1577 mod1605))) (if (memv t1592 (quote (eval-when-form))) ((lambda (tmp1606) ((lambda (tmp1607) (if tmp1607 (apply (lambda (_1608 x1609 e11610 e21611) (let ((when-list1612 (chi-when-list1164 e1588 x1609 w1589)) (body1613 (cons e11610 e21611))) (cond ((eq? m1576 (quote e)) (if (memq (quote eval) when-list1612) (chi-top-sequence1162 body1613 r1574 w1589 s1590 (quote e) (quote (eval)) mod1591) (chi-void1175))) ((memq (quote load) when-list1612) (if (or (memq (quote compile) when-list1612) (and (eq? m1576 (quote c&e)) (memq (quote eval) when-list1612))) (chi-top-sequence1162 body1613 r1574 w1589 s1590 (quote c&e) (quote (compile load)) mod1591) (if (memq m1576 (quote (c c&e))) (chi-top-sequence1162 body1613 r1574 w1589 s1590 (quote c) (quote (load)) mod1591) (chi-void1175)))) ((or (memq (quote compile) when-list1612) (and (eq? m1576 (quote c&e)) (memq (quote eval) when-list1612))) (top-level-eval-hook1102 (chi-top-sequence1162 body1613 r1574 w1589 s1590 (quote e) (quote (eval)) mod1591) mod1591) (chi-void1175)) (else (chi-void1175))))) tmp1607) (syntax-error tmp1606))) (syntax-dispatch tmp1606 (quote (any each-any any . each-any))))) e1588) (if (memv t1592 (quote (define-syntax-form))) (let ((n1616 (id-var-name1153 value1587 w1589)) (r1617 (macros-only-env1127 r1574))) (let ((t1618 m1576)) (if (memv t1618 (quote (c))) (if (memq (quote compile) esew1577) (let ((e1619 (chi-install-global1163 n1616 (chi1167 e1588 r1617 w1589 mod1591)))) (begin (top-level-eval-hook1102 e1619 mod1591) (if (memq (quote load) esew1577) e1619 (chi-void1175)))) (if (memq (quote load) esew1577) (chi-install-global1163 n1616 (chi1167 e1588 r1617 w1589 mod1591)) (chi-void1175))) (if (memv t1618 (quote (c&e))) (let ((e1620 (chi-install-global1163 n1616 (chi1167 e1588 r1617 w1589 mod1591)))) (begin (top-level-eval-hook1102 e1620 mod1591) e1620)) (begin (if (memq (quote eval) esew1577) (top-level-eval-hook1102 (chi-install-global1163 n1616 (chi1167 e1588 r1617 w1589 mod1591)) mod1591)) (chi-void1175)))))) (if (memv t1592 (quote (define-form))) (let ((n1621 (id-var-name1153 value1587 w1589))) (let ((type1622 (binding-type1123 (lookup1128 n1621 r1574 mod1591)))) (let ((t1623 type1622)) (if (memv t1623 (quote (global))) (let ((x1624 (build-annotated1108 s1590 (list (quote define) n1621 (chi1167 e1588 r1574 w1589 mod1591))))) (begin (if (eq? m1576 (quote c&e)) (top-level-eval-hook1102 x1624 mod1591)) x1624)) (if (memv t1623 (quote (displaced-lexical))) (syntax-error (wrap1159 value1587 w1589 mod1591) "identifier out of context") (if (memv t1623 (quote (core macro module-ref))) (begin (remove-global-definition-hook1106 n1621) (let ((x1625 (build-annotated1108 s1590 (list (quote define) n1621 (chi1167 e1588 r1574 w1589 mod1591))))) (begin (if (eq? m1576 (quote c&e)) (top-level-eval-hook1102 x1625 mod1591)) x1625))) (syntax-error (wrap1159 value1587 w1589 mod1591) "cannot define keyword at top level"))))))) (let ((x1626 (chi-expr1168 type1586 value1587 e1588 r1574 w1589 s1590 mod1591))) (begin (if (eq? m1576 (quote c&e)) (top-level-eval-hook1102 x1626 mod1591)) x1626)))))))))))) (syntax-type1165 (lambda (e1627 r1628 w1629 s1630 rib1631 mod1632) (cond ((symbol? e1627) (let ((n1633 (id-var-name1153 e1627 w1629))) (let ((b1634 (lookup1128 n1633 r1628 mod1632))) (let ((type1635 (binding-type1123 b1634))) (let ((t1636 type1635)) (if (memv t1636 (quote (lexical))) (values type1635 (binding-value1124 b1634) e1627 w1629 s1630 mod1632) (if (memv t1636 (quote (global))) (values type1635 n1633 e1627 w1629 s1630 mod1632) (if (memv t1636 (quote (macro))) (syntax-type1165 (chi-macro1170 (binding-value1124 b1634) e1627 r1628 w1629 rib1631 mod1632) r1628 (quote (())) s1630 rib1631 mod1632) (values type1635 (binding-value1124 b1634) e1627 w1629 s1630 mod1632))))))))) ((pair? e1627) (let ((first1637 (car e1627))) (if (id?1131 first1637) (let ((n1638 (id-var-name1153 first1637 w1629))) (let ((b1639 (lookup1128 n1638 r1628 (or (and (syntax-object?1115 first1637) (syntax-object-module1118 first1637)) mod1632)))) (let ((type1640 (binding-type1123 b1639))) (let ((t1641 type1640)) (if (memv t1641 (quote (lexical))) (values (quote lexical-call) (binding-value1124 b1639) e1627 w1629 s1630 mod1632) (if (memv t1641 (quote (global))) (values (quote global-call) n1638 e1627 w1629 s1630 mod1632) (if (memv t1641 (quote (macro))) (syntax-type1165 (chi-macro1170 (binding-value1124 b1639) e1627 r1628 w1629 rib1631 mod1632) r1628 (quote (())) s1630 rib1631 mod1632) (if (memv t1641 (quote (core external-macro module-ref))) (values type1640 (binding-value1124 b1639) e1627 w1629 s1630 mod1632) (if (memv t1641 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1124 b1639) e1627 w1629 s1630 mod1632) (if (memv t1641 (quote (begin))) (values (quote begin-form) #f e1627 w1629 s1630 mod1632) (if (memv t1641 (quote (eval-when))) (values (quote eval-when-form) #f e1627 w1629 s1630 mod1632) (if (memv t1641 (quote (define))) ((lambda (tmp1642) ((lambda (tmp1643) (if (if tmp1643 (apply (lambda (_1644 name1645 val1646) (id?1131 name1645)) tmp1643) #f) (apply (lambda (_1647 name1648 val1649) (values (quote define-form) name1648 val1649 w1629 s1630 mod1632)) tmp1643) ((lambda (tmp1650) (if (if tmp1650 (apply (lambda (_1651 name1652 args1653 e11654 e21655) (and (id?1131 name1652) (valid-bound-ids?1156 (lambda-var-list1180 args1653)))) tmp1650) #f) (apply (lambda (_1656 name1657 args1658 e11659 e21660) (values (quote define-form) (wrap1159 name1657 w1629 mod1632) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1159 (cons args1658 (cons e11659 e21660)) w1629 mod1632)) (quote (())) s1630 mod1632)) tmp1650) ((lambda (tmp1662) (if (if tmp1662 (apply (lambda (_1663 name1664) (id?1131 name1664)) tmp1662) #f) (apply (lambda (_1665 name1666) (values (quote define-form) (wrap1159 name1666 w1629 mod1632) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1630 mod1632)) tmp1662) (syntax-error tmp1642))) (syntax-dispatch tmp1642 (quote (any any)))))) (syntax-dispatch tmp1642 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1642 (quote (any any any))))) e1627) (if (memv t1641 (quote (define-syntax))) ((lambda (tmp1667) ((lambda (tmp1668) (if (if tmp1668 (apply (lambda (_1669 name1670 val1671) (id?1131 name1670)) tmp1668) #f) (apply (lambda (_1672 name1673 val1674) (values (quote define-syntax-form) name1673 val1674 w1629 s1630 mod1632)) tmp1668) (syntax-error tmp1667))) (syntax-dispatch tmp1667 (quote (any any any))))) e1627) (values (quote call) #f e1627 w1629 s1630 mod1632)))))))))))))) (values (quote call) #f e1627 w1629 s1630 mod1632)))) ((syntax-object?1115 e1627) (syntax-type1165 (syntax-object-expression1116 e1627) r1628 (join-wraps1150 w1629 (syntax-object-wrap1117 e1627)) #f rib1631 (or (syntax-object-module1118 e1627) mod1632))) ((annotation? e1627) (syntax-type1165 (annotation-expression e1627) r1628 w1629 (annotation-source e1627) rib1631 mod1632)) ((self-evaluating? e1627) (values (quote constant) #f e1627 w1629 s1630 mod1632)) (else (values (quote other) #f e1627 w1629 s1630 mod1632))))) (chi-when-list1164 (lambda (e1675 when-list1676 w1677) (let f1678 ((when-list1679 when-list1676) (situations1680 (quote ()))) (if (null? when-list1679) situations1680 (f1678 (cdr when-list1679) (cons (let ((x1681 (car when-list1679))) (cond ((free-id=?1154 x1681 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?1154 x1681 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?1154 x1681 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-error (wrap1159 x1681 w1677 #f) "invalid eval-when situation")))) situations1680)))))) (chi-install-global1163 (lambda (name1682 e1683) (build-annotated1108 #f (list (build-annotated1108 #f (quote install-global-transformer)) (build-data1109 #f name1682) e1683)))) (chi-top-sequence1162 (lambda (body1684 r1685 w1686 s1687 m1688 esew1689 mod1690) (build-sequence1110 s1687 (let dobody1691 ((body1692 body1684) (r1693 r1685) (w1694 w1686) (m1695 m1688) (esew1696 esew1689) (mod1697 mod1690)) (if (null? body1692) (quote ()) (let ((first1698 (chi-top1166 (car body1692) r1693 w1694 m1695 esew1696 mod1697))) (cons first1698 (dobody1691 (cdr body1692) r1693 w1694 m1695 esew1696 mod1697)))))))) (chi-sequence1161 (lambda (body1699 r1700 w1701 s1702 mod1703) (build-sequence1110 s1702 (let dobody1704 ((body1705 body1699) (r1706 r1700) (w1707 w1701) (mod1708 mod1703)) (if (null? body1705) (quote ()) (let ((first1709 (chi1167 (car body1705) r1706 w1707 mod1708))) (cons first1709 (dobody1704 (cdr body1705) r1706 w1707 mod1708)))))))) (source-wrap1160 (lambda (x1710 w1711 s1712 defmod1713) (wrap1159 (if s1712 (make-annotation x1710 s1712 #f) x1710) w1711 defmod1713))) (wrap1159 (lambda (x1714 w1715 defmod1716) (cond ((and (null? (wrap-marks1134 w1715)) (null? (wrap-subst1135 w1715))) x1714) ((syntax-object?1115 x1714) (make-syntax-object1114 (syntax-object-expression1116 x1714) (join-wraps1150 w1715 (syntax-object-wrap1117 x1714)) (syntax-object-module1118 x1714))) ((null? x1714) x1714) (else (make-syntax-object1114 x1714 w1715 defmod1716))))) (bound-id-member?1158 (lambda (x1717 list1718) (and (not (null? list1718)) (or (bound-id=?1155 x1717 (car list1718)) (bound-id-member?1158 x1717 (cdr list1718)))))) (distinct-bound-ids?1157 (lambda (ids1719) (let distinct?1720 ((ids1721 ids1719)) (or (null? ids1721) (and (not (bound-id-member?1158 (car ids1721) (cdr ids1721))) (distinct?1720 (cdr ids1721))))))) (valid-bound-ids?1156 (lambda (ids1722) (and (let all-ids?1723 ((ids1724 ids1722)) (or (null? ids1724) (and (id?1131 (car ids1724)) (all-ids?1723 (cdr ids1724))))) (distinct-bound-ids?1157 ids1722)))) (bound-id=?1155 (lambda (i1725 j1726) (if (and (syntax-object?1115 i1725) (syntax-object?1115 j1726)) (and (eq? (let ((e1727 (syntax-object-expression1116 i1725))) (if (annotation? e1727) (annotation-expression e1727) e1727)) (let ((e1728 (syntax-object-expression1116 j1726))) (if (annotation? e1728) (annotation-expression e1728) e1728))) (same-marks?1152 (wrap-marks1134 (syntax-object-wrap1117 i1725)) (wrap-marks1134 (syntax-object-wrap1117 j1726)))) (eq? (let ((e1729 i1725)) (if (annotation? e1729) (annotation-expression e1729) e1729)) (let ((e1730 j1726)) (if (annotation? e1730) (annotation-expression e1730) e1730)))))) (free-id=?1154 (lambda (i1731 j1732) (and (eq? (let ((x1733 i1731)) (let ((e1734 (if (syntax-object?1115 x1733) (syntax-object-expression1116 x1733) x1733))) (if (annotation? e1734) (annotation-expression e1734) e1734))) (let ((x1735 j1732)) (let ((e1736 (if (syntax-object?1115 x1735) (syntax-object-expression1116 x1735) x1735))) (if (annotation? e1736) (annotation-expression e1736) e1736)))) (eq? (id-var-name1153 i1731 (quote (()))) (id-var-name1153 j1732 (quote (()))))))) (id-var-name1153 (lambda (id1737 w1738) (letrec ((search-vector-rib1741 (lambda (sym1747 subst1748 marks1749 symnames1750 ribcage1751) (let ((n1752 (vector-length symnames1750))) (let f1753 ((i1754 0)) (cond ((fx=1100 i1754 n1752) (search1739 sym1747 (cdr subst1748) marks1749)) ((and (eq? (vector-ref symnames1750 i1754) sym1747) (same-marks?1152 marks1749 (vector-ref (ribcage-marks1141 ribcage1751) i1754))) (values (vector-ref (ribcage-labels1142 ribcage1751) i1754) marks1749)) (else (f1753 (fx+1098 i1754 1)))))))) (search-list-rib1740 (lambda (sym1755 subst1756 marks1757 symnames1758 ribcage1759) (let f1760 ((symnames1761 symnames1758) (i1762 0)) (cond ((null? symnames1761) (search1739 sym1755 (cdr subst1756) marks1757)) ((and (eq? (car symnames1761) sym1755) (same-marks?1152 marks1757 (list-ref (ribcage-marks1141 ribcage1759) i1762))) (values (list-ref (ribcage-labels1142 ribcage1759) i1762) marks1757)) (else (f1760 (cdr symnames1761) (fx+1098 i1762 1))))))) (search1739 (lambda (sym1763 subst1764 marks1765) (if (null? subst1764) (values #f marks1765) (let ((fst1766 (car subst1764))) (if (eq? fst1766 (quote shift)) (search1739 sym1763 (cdr subst1764) (cdr marks1765)) (let ((symnames1767 (ribcage-symnames1140 fst1766))) (if (vector? symnames1767) (search-vector-rib1741 sym1763 subst1764 marks1765 symnames1767 fst1766) (search-list-rib1740 sym1763 subst1764 marks1765 symnames1767 fst1766))))))))) (cond ((symbol? id1737) (or (call-with-values (lambda () (search1739 id1737 (wrap-subst1135 w1738) (wrap-marks1134 w1738))) (lambda (x1769 . ignore1768) x1769)) id1737)) ((syntax-object?1115 id1737) (let ((id1770 (let ((e1772 (syntax-object-expression1116 id1737))) (if (annotation? e1772) (annotation-expression e1772) e1772))) (w11771 (syntax-object-wrap1117 id1737))) (let ((marks1773 (join-marks1151 (wrap-marks1134 w1738) (wrap-marks1134 w11771)))) (call-with-values (lambda () (search1739 id1770 (wrap-subst1135 w1738) marks1773)) (lambda (new-id1774 marks1775) (or new-id1774 (call-with-values (lambda () (search1739 id1770 (wrap-subst1135 w11771) marks1775)) (lambda (x1777 . ignore1776) x1777)) id1770)))))) ((annotation? id1737) (let ((id1778 (let ((e1779 id1737)) (if (annotation? e1779) (annotation-expression e1779) e1779)))) (or (call-with-values (lambda () (search1739 id1778 (wrap-subst1135 w1738) (wrap-marks1134 w1738))) (lambda (x1781 . ignore1780) x1781)) id1778))) (else (error-hook1104 (quote id-var-name) "invalid id" id1737)))))) (same-marks?1152 (lambda (x1782 y1783) (or (eq? x1782 y1783) (and (not (null? x1782)) (not (null? y1783)) (eq? (car x1782) (car y1783)) (same-marks?1152 (cdr x1782) (cdr y1783)))))) (join-marks1151 (lambda (m11784 m21785) (smart-append1149 m11784 m21785))) (join-wraps1150 (lambda (w11786 w21787) (let ((m11788 (wrap-marks1134 w11786)) (s11789 (wrap-subst1135 w11786))) (if (null? m11788) (if (null? s11789) w21787 (make-wrap1133 (wrap-marks1134 w21787) (smart-append1149 s11789 (wrap-subst1135 w21787)))) (make-wrap1133 (smart-append1149 m11788 (wrap-marks1134 w21787)) (smart-append1149 s11789 (wrap-subst1135 w21787))))))) (smart-append1149 (lambda (m11790 m21791) (if (null? m21791) m11790 (append m11790 m21791)))) (make-binding-wrap1148 (lambda (ids1792 labels1793 w1794) (if (null? ids1792) w1794 (make-wrap1133 (wrap-marks1134 w1794) (cons (let ((labelvec1795 (list->vector labels1793))) (let ((n1796 (vector-length labelvec1795))) (let ((symnamevec1797 (make-vector n1796)) (marksvec1798 (make-vector n1796))) (begin (let f1799 ((ids1800 ids1792) (i1801 0)) (if (not (null? ids1800)) (call-with-values (lambda () (id-sym-name&marks1132 (car ids1800) w1794)) (lambda (symname1802 marks1803) (begin (vector-set! symnamevec1797 i1801 symname1802) (vector-set! marksvec1798 i1801 marks1803) (f1799 (cdr ids1800) (fx+1098 i1801 1))))))) (make-ribcage1138 symnamevec1797 marksvec1798 labelvec1795))))) (wrap-subst1135 w1794)))))) (extend-ribcage!1147 (lambda (ribcage1804 id1805 label1806) (begin (set-ribcage-symnames!1143 ribcage1804 (cons (let ((e1807 (syntax-object-expression1116 id1805))) (if (annotation? e1807) (annotation-expression e1807) e1807)) (ribcage-symnames1140 ribcage1804))) (set-ribcage-marks!1144 ribcage1804 (cons (wrap-marks1134 (syntax-object-wrap1117 id1805)) (ribcage-marks1141 ribcage1804))) (set-ribcage-labels!1145 ribcage1804 (cons label1806 (ribcage-labels1142 ribcage1804)))))) (anti-mark1146 (lambda (w1808) (make-wrap1133 (cons #f (wrap-marks1134 w1808)) (cons (quote shift) (wrap-subst1135 w1808))))) (set-ribcage-labels!1145 (lambda (x1809 update1810) (vector-set! x1809 3 update1810))) (set-ribcage-marks!1144 (lambda (x1811 update1812) (vector-set! x1811 2 update1812))) (set-ribcage-symnames!1143 (lambda (x1813 update1814) (vector-set! x1813 1 update1814))) (ribcage-labels1142 (lambda (x1815) (vector-ref x1815 3))) (ribcage-marks1141 (lambda (x1816) (vector-ref x1816 2))) (ribcage-symnames1140 (lambda (x1817) (vector-ref x1817 1))) (ribcage?1139 (lambda (x1818) (and (vector? x1818) (= (vector-length x1818) 4) (eq? (vector-ref x1818 0) (quote ribcage))))) (make-ribcage1138 (lambda (symnames1819 marks1820 labels1821) (vector (quote ribcage) symnames1819 marks1820 labels1821))) (gen-labels1137 (lambda (ls1822) (if (null? ls1822) (quote ()) (cons (gen-label1136) (gen-labels1137 (cdr ls1822)))))) (gen-label1136 (lambda () (string #\i))) (wrap-subst1135 cdr) (wrap-marks1134 car) (make-wrap1133 cons) (id-sym-name&marks1132 (lambda (x1823 w1824) (if (syntax-object?1115 x1823) (values (let ((e1825 (syntax-object-expression1116 x1823))) (if (annotation? e1825) (annotation-expression e1825) e1825)) (join-marks1151 (wrap-marks1134 w1824) (wrap-marks1134 (syntax-object-wrap1117 x1823)))) (values (let ((e1826 x1823)) (if (annotation? e1826) (annotation-expression e1826) e1826)) (wrap-marks1134 w1824))))) (id?1131 (lambda (x1827) (cond ((symbol? x1827) #t) ((syntax-object?1115 x1827) (symbol? (let ((e1828 (syntax-object-expression1116 x1827))) (if (annotation? e1828) (annotation-expression e1828) e1828)))) ((annotation? x1827) (symbol? (annotation-expression x1827))) (else #f)))) (nonsymbol-id?1130 (lambda (x1829) (and (syntax-object?1115 x1829) (symbol? (let ((e1830 (syntax-object-expression1116 x1829))) (if (annotation? e1830) (annotation-expression e1830) e1830)))))) (global-extend1129 (lambda (type1831 sym1832 val1833) (put-global-definition-hook1105 sym1832 (cons type1831 val1833)))) (lookup1128 (lambda (x1834 r1835 mod1836) (cond ((assq x1834 r1835) => cdr) ((symbol? x1834) (or (get-global-definition-hook1107 x1834 mod1836) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1127 (lambda (r1837) (if (null? r1837) (quote ()) (let ((a1838 (car r1837))) (if (eq? (cadr a1838) (quote macro)) (cons a1838 (macros-only-env1127 (cdr r1837))) (macros-only-env1127 (cdr r1837))))))) (extend-var-env1126 (lambda (labels1839 vars1840 r1841) (if (null? labels1839) r1841 (extend-var-env1126 (cdr labels1839) (cdr vars1840) (cons (cons (car labels1839) (cons (quote lexical) (car vars1840))) r1841))))) (extend-env1125 (lambda (labels1842 bindings1843 r1844) (if (null? labels1842) r1844 (extend-env1125 (cdr labels1842) (cdr bindings1843) (cons (cons (car labels1842) (car bindings1843)) r1844))))) (binding-value1124 cdr) (binding-type1123 car) (source-annotation1122 (lambda (x1845) (cond ((annotation? x1845) (annotation-source x1845)) ((syntax-object?1115 x1845) (source-annotation1122 (syntax-object-expression1116 x1845))) (else #f)))) (set-syntax-object-module!1121 (lambda (x1846 update1847) (vector-set! x1846 3 update1847))) (set-syntax-object-wrap!1120 (lambda (x1848 update1849) (vector-set! x1848 2 update1849))) (set-syntax-object-expression!1119 (lambda (x1850 update1851) (vector-set! x1850 1 update1851))) (syntax-object-module1118 (lambda (x1852) (vector-ref x1852 3))) (syntax-object-wrap1117 (lambda (x1853) (vector-ref x1853 2))) (syntax-object-expression1116 (lambda (x1854) (vector-ref x1854 1))) (syntax-object?1115 (lambda (x1855) (and (vector? x1855) (= (vector-length x1855) 4) (eq? (vector-ref x1855 0) (quote syntax-object))))) (make-syntax-object1114 (lambda (expression1856 wrap1857 module1858) (vector (quote syntax-object) expression1856 wrap1857 module1858))) (build-letrec1113 (lambda (src1859 vars1860 val-exps1861 body-exp1862) (if (null? vars1860) (build-annotated1108 src1859 body-exp1862) (build-annotated1108 src1859 (list (quote letrec) (map list vars1860 val-exps1861) body-exp1862))))) (build-named-let1112 (lambda (src1863 vars1864 val-exps1865 body-exp1866) (if (null? vars1864) (build-annotated1108 src1863 body-exp1866) (build-annotated1108 src1863 (list (quote let) (car vars1864) (map list (cdr vars1864) val-exps1865) body-exp1866))))) (build-let1111 (lambda (src1867 vars1868 val-exps1869 body-exp1870) (if (null? vars1868) (build-annotated1108 src1867 body-exp1870) (build-annotated1108 src1867 (list (quote let) (map list vars1868 val-exps1869) body-exp1870))))) (build-sequence1110 (lambda (src1871 exps1872) (if (null? (cdr exps1872)) (build-annotated1108 src1871 (car exps1872)) (build-annotated1108 src1871 (cons (quote begin) exps1872))))) (build-data1109 (lambda (src1873 exp1874) (if (and (self-evaluating? exp1874) (not (vector? exp1874))) (build-annotated1108 src1873 exp1874) (build-annotated1108 src1873 (list (quote quote) exp1874))))) (build-annotated1108 (lambda (src1875 exp1876) (if (and src1875 (not (annotation? exp1876))) (make-annotation exp1876 src1875 #t) exp1876))) (get-global-definition-hook1107 (lambda (symbol1877 module1878) (let ((module1879 (if module1878 (resolve-module (cdr module1878)) (let ((mod1880 (current-module))) (begin (if mod1880 (warn "wha" symbol1877)) mod1880))))) (let ((v1881 (module-variable module1879 symbol1877))) (and v1881 (object-property v1881 (quote *sc-expander*))))))) (remove-global-definition-hook1106 (lambda (symbol1882) (let ((module1883 (current-module))) (let ((v1884 (module-local-variable module1883 symbol1882))) (if v1884 (let ((p1885 (assq (quote *sc-expander*) (object-properties v1884)))) (set-object-properties! v1884 (delq p1885 (object-properties v1884))))))))) (put-global-definition-hook1105 (lambda (symbol1886 binding1887) (let ((module1888 (current-module))) (let ((v1889 (or (module-variable module1888 symbol1886) (let ((v1890 (make-variable (gensym)))) (begin (module-add! module1888 symbol1886 v1890) v1890))))) (begin (if (not (variable-bound? v1889)) (variable-set! v1889 (gensym))) (set-object-property! v1889 (quote *sc-expander*) binding1887)))))) (error-hook1104 (lambda (who1891 why1892 what1893) (error who1891 "~a ~s" why1892 what1893))) (local-eval-hook1103 (lambda (x1894 mod1895) (primitive-eval (list noexpand1097 x1894)))) (top-level-eval-hook1102 (lambda (x1896 mod1897) (primitive-eval (list noexpand1097 x1896)))) (fx<1101 <) (fx=1100 =) (fx-1099 -) (fx+1098 +) (noexpand1097 "noexpand")) (begin (global-extend1129 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1129 (quote local-syntax) (quote let-syntax) #f) (global-extend1129 (quote core) (quote fluid-let-syntax) (lambda (e1898 r1899 w1900 s1901 mod1902) ((lambda (tmp1903) ((lambda (tmp1904) (if (if tmp1904 (apply (lambda (_1905 var1906 val1907 e11908 e21909) (valid-bound-ids?1156 var1906)) tmp1904) #f) (apply (lambda (_1911 var1912 val1913 e11914 e21915) (let ((names1916 (map (lambda (x1917) (id-var-name1153 x1917 w1900)) var1912))) (begin (for-each (lambda (id1919 n1920) (let ((t1921 (binding-type1123 (lookup1128 n1920 r1899 mod1902)))) (if (memv t1921 (quote (displaced-lexical))) (syntax-error (source-wrap1160 id1919 w1900 s1901 mod1902) "identifier out of context")))) var1912 names1916) (chi-body1171 (cons e11914 e21915) (source-wrap1160 e1898 w1900 s1901 mod1902) (extend-env1125 names1916 (let ((trans-r1924 (macros-only-env1127 r1899))) (map (lambda (x1925) (cons (quote macro) (eval-local-transformer1174 (chi1167 x1925 trans-r1924 w1900 mod1902) mod1902))) val1913)) r1899) w1900 mod1902)))) tmp1904) ((lambda (_1927) (syntax-error (source-wrap1160 e1898 w1900 s1901 mod1902))) tmp1903))) (syntax-dispatch tmp1903 (quote (any #(each (any any)) any . each-any))))) e1898))) (global-extend1129 (quote core) (quote quote) (lambda (e1928 r1929 w1930 s1931 mod1932) ((lambda (tmp1933) ((lambda (tmp1934) (if tmp1934 (apply (lambda (_1935 e1936) (build-data1109 s1931 (strip1178 e1936 w1930))) tmp1934) ((lambda (_1937) (syntax-error (source-wrap1160 e1928 w1930 s1931 mod1932))) tmp1933))) (syntax-dispatch tmp1933 (quote (any any))))) e1928))) (global-extend1129 (quote core) (quote syntax) (letrec ((regen1945 (lambda (x1946) (let ((t1947 (car x1946))) (if (memv t1947 (quote (ref))) (build-annotated1108 #f (cadr x1946)) (if (memv t1947 (quote (primitive))) (build-annotated1108 #f (cadr x1946)) (if (memv t1947 (quote (quote))) (build-data1109 #f (cadr x1946)) (if (memv t1947 (quote (lambda))) (build-annotated1108 #f (list (quote lambda) (cadr x1946) (regen1945 (caddr x1946)))) (if (memv t1947 (quote (map))) (let ((ls1948 (map regen1945 (cdr x1946)))) (build-annotated1108 #f (cons (if (fx=1100 (length ls1948) 2) (build-annotated1108 #f (quote map)) (build-annotated1108 #f (quote map))) ls1948))) (build-annotated1108 #f (cons (build-annotated1108 #f (car x1946)) (map regen1945 (cdr x1946)))))))))))) (gen-vector1944 (lambda (x1949) (cond ((eq? (car x1949) (quote list)) (cons (quote vector) (cdr x1949))) ((eq? (car x1949) (quote quote)) (list (quote quote) (list->vector (cadr x1949)))) (else (list (quote list->vector) x1949))))) (gen-append1943 (lambda (x1950 y1951) (if (equal? y1951 (quote (quote ()))) x1950 (list (quote append) x1950 y1951)))) (gen-cons1942 (lambda (x1952 y1953) (let ((t1954 (car y1953))) (if (memv t1954 (quote (quote))) (if (eq? (car x1952) (quote quote)) (list (quote quote) (cons (cadr x1952) (cadr y1953))) (if (eq? (cadr y1953) (quote ())) (list (quote list) x1952) (list (quote cons) x1952 y1953))) (if (memv t1954 (quote (list))) (cons (quote list) (cons x1952 (cdr y1953))) (list (quote cons) x1952 y1953)))))) (gen-map1941 (lambda (e1955 map-env1956) (let ((formals1957 (map cdr map-env1956)) (actuals1958 (map (lambda (x1959) (list (quote ref) (car x1959))) map-env1956))) (cond ((eq? (car e1955) (quote ref)) (car actuals1958)) ((andmap (lambda (x1960) (and (eq? (car x1960) (quote ref)) (memq (cadr x1960) formals1957))) (cdr e1955)) (cons (quote map) (cons (list (quote primitive) (car e1955)) (map (let ((r1961 (map cons formals1957 actuals1958))) (lambda (x1962) (cdr (assq (cadr x1962) r1961)))) (cdr e1955))))) (else (cons (quote map) (cons (list (quote lambda) formals1957 e1955) actuals1958))))))) (gen-mappend1940 (lambda (e1963 map-env1964) (list (quote apply) (quote (primitive append)) (gen-map1941 e1963 map-env1964)))) (gen-ref1939 (lambda (src1965 var1966 level1967 maps1968) (if (fx=1100 level1967 0) (values var1966 maps1968) (if (null? maps1968) (syntax-error src1965 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1939 src1965 var1966 (fx-1099 level1967 1) (cdr maps1968))) (lambda (outer-var1969 outer-maps1970) (let ((b1971 (assq outer-var1969 (car maps1968)))) (if b1971 (values (cdr b1971) maps1968) (let ((inner-var1972 (gen-var1179 (quote tmp)))) (values inner-var1972 (cons (cons (cons outer-var1969 inner-var1972) (car maps1968)) outer-maps1970))))))))))) (gen-syntax1938 (lambda (src1973 e1974 r1975 maps1976 ellipsis?1977 mod1978) (if (id?1131 e1974) (let ((label1979 (id-var-name1153 e1974 (quote (()))))) (let ((b1980 (lookup1128 label1979 r1975 mod1978))) (if (eq? (binding-type1123 b1980) (quote syntax)) (call-with-values (lambda () (let ((var.lev1981 (binding-value1124 b1980))) (gen-ref1939 src1973 (car var.lev1981) (cdr var.lev1981) maps1976))) (lambda (var1982 maps1983) (values (list (quote ref) var1982) maps1983))) (if (ellipsis?1977 e1974) (syntax-error src1973 "misplaced ellipsis in syntax form") (values (list (quote quote) e1974) maps1976))))) ((lambda (tmp1984) ((lambda (tmp1985) (if (if tmp1985 (apply (lambda (dots1986 e1987) (ellipsis?1977 dots1986)) tmp1985) #f) (apply (lambda (dots1988 e1989) (gen-syntax1938 src1973 e1989 r1975 maps1976 (lambda (x1990) #f) mod1978)) tmp1985) ((lambda (tmp1991) (if (if tmp1991 (apply (lambda (x1992 dots1993 y1994) (ellipsis?1977 dots1993)) tmp1991) #f) (apply (lambda (x1995 dots1996 y1997) (let f1998 ((y1999 y1997) (k2000 (lambda (maps2001) (call-with-values (lambda () (gen-syntax1938 src1973 x1995 r1975 (cons (quote ()) maps2001) ellipsis?1977 mod1978)) (lambda (x2002 maps2003) (if (null? (car maps2003)) (syntax-error src1973 "extra ellipsis in syntax form") (values (gen-map1941 x2002 (car maps2003)) (cdr maps2003)))))))) ((lambda (tmp2004) ((lambda (tmp2005) (if (if tmp2005 (apply (lambda (dots2006 y2007) (ellipsis?1977 dots2006)) tmp2005) #f) (apply (lambda (dots2008 y2009) (f1998 y2009 (lambda (maps2010) (call-with-values (lambda () (k2000 (cons (quote ()) maps2010))) (lambda (x2011 maps2012) (if (null? (car maps2012)) (syntax-error src1973 "extra ellipsis in syntax form") (values (gen-mappend1940 x2011 (car maps2012)) (cdr maps2012)))))))) tmp2005) ((lambda (_2013) (call-with-values (lambda () (gen-syntax1938 src1973 y1999 r1975 maps1976 ellipsis?1977 mod1978)) (lambda (y2014 maps2015) (call-with-values (lambda () (k2000 maps2015)) (lambda (x2016 maps2017) (values (gen-append1943 x2016 y2014) maps2017)))))) tmp2004))) (syntax-dispatch tmp2004 (quote (any . any))))) y1999))) tmp1991) ((lambda (tmp2018) (if tmp2018 (apply (lambda (x2019 y2020) (call-with-values (lambda () (gen-syntax1938 src1973 x2019 r1975 maps1976 ellipsis?1977 mod1978)) (lambda (x2021 maps2022) (call-with-values (lambda () (gen-syntax1938 src1973 y2020 r1975 maps2022 ellipsis?1977 mod1978)) (lambda (y2023 maps2024) (values (gen-cons1942 x2021 y2023) maps2024)))))) tmp2018) ((lambda (tmp2025) (if tmp2025 (apply (lambda (e12026 e22027) (call-with-values (lambda () (gen-syntax1938 src1973 (cons e12026 e22027) r1975 maps1976 ellipsis?1977 mod1978)) (lambda (e2029 maps2030) (values (gen-vector1944 e2029) maps2030)))) tmp2025) ((lambda (_2031) (values (list (quote quote) e1974) maps1976)) tmp1984))) (syntax-dispatch tmp1984 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1984 (quote (any . any)))))) (syntax-dispatch tmp1984 (quote (any any . any)))))) (syntax-dispatch tmp1984 (quote (any any))))) e1974))))) (lambda (e2032 r2033 w2034 s2035 mod2036) (let ((e2037 (source-wrap1160 e2032 w2034 s2035 mod2036))) ((lambda (tmp2038) ((lambda (tmp2039) (if tmp2039 (apply (lambda (_2040 x2041) (call-with-values (lambda () (gen-syntax1938 e2037 x2041 r2033 (quote ()) ellipsis?1176 mod2036)) (lambda (e2042 maps2043) (regen1945 e2042)))) tmp2039) ((lambda (_2044) (syntax-error e2037)) tmp2038))) (syntax-dispatch tmp2038 (quote (any any))))) e2037))))) (global-extend1129 (quote core) (quote lambda) (lambda (e2045 r2046 w2047 s2048 mod2049) ((lambda (tmp2050) ((lambda (tmp2051) (if tmp2051 (apply (lambda (_2052 c2053) (chi-lambda-clause1172 (source-wrap1160 e2045 w2047 s2048 mod2049) c2053 r2046 w2047 mod2049 (lambda (vars2054 body2055) (build-annotated1108 s2048 (list (quote lambda) vars2054 body2055))))) tmp2051) (syntax-error tmp2050))) (syntax-dispatch tmp2050 (quote (any . any))))) e2045))) (global-extend1129 (quote core) (quote let) (letrec ((chi-let2056 (lambda (e2057 r2058 w2059 s2060 mod2061 constructor2062 ids2063 vals2064 exps2065) (if (not (valid-bound-ids?1156 ids2063)) (syntax-error e2057 "duplicate bound variable in") (let ((labels2066 (gen-labels1137 ids2063)) (new-vars2067 (map gen-var1179 ids2063))) (let ((nw2068 (make-binding-wrap1148 ids2063 labels2066 w2059)) (nr2069 (extend-var-env1126 labels2066 new-vars2067 r2058))) (constructor2062 s2060 new-vars2067 (map (lambda (x2070) (chi1167 x2070 r2058 w2059 mod2061)) vals2064) (chi-body1171 exps2065 (source-wrap1160 e2057 nw2068 s2060 mod2061) nr2069 nw2068 mod2061)))))))) (lambda (e2071 r2072 w2073 s2074 mod2075) ((lambda (tmp2076) ((lambda (tmp2077) (if tmp2077 (apply (lambda (_2078 id2079 val2080 e12081 e22082) (chi-let2056 e2071 r2072 w2073 s2074 mod2075 build-let1111 id2079 val2080 (cons e12081 e22082))) tmp2077) ((lambda (tmp2086) (if (if tmp2086 (apply (lambda (_2087 f2088 id2089 val2090 e12091 e22092) (id?1131 f2088)) tmp2086) #f) (apply (lambda (_2093 f2094 id2095 val2096 e12097 e22098) (chi-let2056 e2071 r2072 w2073 s2074 mod2075 build-named-let1112 (cons f2094 id2095) val2096 (cons e12097 e22098))) tmp2086) ((lambda (_2102) (syntax-error (source-wrap1160 e2071 w2073 s2074 mod2075))) tmp2076))) (syntax-dispatch tmp2076 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2076 (quote (any #(each (any any)) any . each-any))))) e2071)))) (global-extend1129 (quote core) (quote letrec) (lambda (e2103 r2104 w2105 s2106 mod2107) ((lambda (tmp2108) ((lambda (tmp2109) (if tmp2109 (apply (lambda (_2110 id2111 val2112 e12113 e22114) (let ((ids2115 id2111)) (if (not (valid-bound-ids?1156 ids2115)) (syntax-error e2103 "duplicate bound variable in") (let ((labels2117 (gen-labels1137 ids2115)) (new-vars2118 (map gen-var1179 ids2115))) (let ((w2119 (make-binding-wrap1148 ids2115 labels2117 w2105)) (r2120 (extend-var-env1126 labels2117 new-vars2118 r2104))) (build-letrec1113 s2106 new-vars2118 (map (lambda (x2121) (chi1167 x2121 r2120 w2119 mod2107)) val2112) (chi-body1171 (cons e12113 e22114) (source-wrap1160 e2103 w2119 s2106 mod2107) r2120 w2119 mod2107))))))) tmp2109) ((lambda (_2124) (syntax-error (source-wrap1160 e2103 w2105 s2106 mod2107))) tmp2108))) (syntax-dispatch tmp2108 (quote (any #(each (any any)) any . each-any))))) e2103))) (global-extend1129 (quote core) (quote set!) (lambda (e2125 r2126 w2127 s2128 mod2129) ((lambda (tmp2130) ((lambda (tmp2131) (if (if tmp2131 (apply (lambda (_2132 id2133 val2134) (id?1131 id2133)) tmp2131) #f) (apply (lambda (_2135 id2136 val2137) (let ((val2138 (chi1167 val2137 r2126 w2127 mod2129)) (n2139 (id-var-name1153 id2136 w2127))) (let ((b2140 (lookup1128 n2139 r2126 mod2129))) (let ((t2141 (binding-type1123 b2140))) (if (memv t2141 (quote (lexical))) (build-annotated1108 s2128 (list (quote set!) (binding-value1124 b2140) val2138)) (if (memv t2141 (quote (global))) (build-annotated1108 s2128 (list (quote set!) (if mod2129 (make-module-ref (cdr mod2129) n2139 (car mod2129)) (make-module-ref mod2129 n2139 (quote bare))) val2138)) (if (memv t2141 (quote (displaced-lexical))) (syntax-error (wrap1159 id2136 w2127 mod2129) "identifier out of context") (syntax-error (source-wrap1160 e2125 w2127 s2128 mod2129))))))))) tmp2131) ((lambda (tmp2142) (if tmp2142 (apply (lambda (_2143 head2144 tail2145 val2146) (call-with-values (lambda () (syntax-type1165 head2144 r2126 (quote (())) #f #f mod2129)) (lambda (type2147 value2148 ee2149 ww2150 ss2151 modmod2152) (let ((t2153 type2147)) (if (memv t2153 (quote (module-ref))) (let ((val2154 (chi1167 val2146 r2126 w2127 mod2129))) (call-with-values (lambda () (value2148 (cons head2144 tail2145))) (lambda (id2156 mod2157) (build-annotated1108 s2128 (list (quote set!) (if mod2157 (make-module-ref (cdr mod2157) id2156 (car mod2157)) (make-module-ref mod2157 id2156 (quote bare))) val2154))))) (build-annotated1108 s2128 (cons (chi1167 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2144) r2126 w2127 mod2129) (map (lambda (e2158) (chi1167 e2158 r2126 w2127 mod2129)) (append tail2145 (list val2146)))))))))) tmp2142) ((lambda (_2160) (syntax-error (source-wrap1160 e2125 w2127 s2128 mod2129))) tmp2130))) (syntax-dispatch tmp2130 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2130 (quote (any any any))))) e2125))) (global-extend1129 (quote module-ref) (quote @) (lambda (e2161) ((lambda (tmp2162) ((lambda (tmp2163) (if (if tmp2163 (apply (lambda (_2164 mod2165 id2166) (and (andmap id?1131 mod2165) (id?1131 id2166))) tmp2163) #f) (apply (lambda (_2168 mod2169 id2170) (values (syntax-object->datum id2170) (syntax-object->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2169)))) tmp2163) (syntax-error tmp2162))) (syntax-dispatch tmp2162 (quote (any each-any any))))) e2161))) (global-extend1129 (quote module-ref) (quote @@) (lambda (e2172) ((lambda (tmp2173) ((lambda (tmp2174) (if (if tmp2174 (apply (lambda (_2175 mod2176 id2177) (and (andmap id?1131 mod2176) (id?1131 id2177))) tmp2174) #f) (apply (lambda (_2179 mod2180 id2181) (values (syntax-object->datum id2181) (syntax-object->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2180)))) tmp2174) (syntax-error tmp2173))) (syntax-dispatch tmp2173 (quote (any each-any any))))) e2172))) (global-extend1129 (quote begin) (quote begin) (quote ())) (global-extend1129 (quote define) (quote define) (quote ())) (global-extend1129 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1129 (quote eval-when) (quote eval-when) (quote ())) (global-extend1129 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2186 (lambda (x2187 keys2188 clauses2189 r2190 mod2191) (if (null? clauses2189) (build-annotated1108 #f (list (build-annotated1108 #f (quote syntax-error)) x2187)) ((lambda (tmp2192) ((lambda (tmp2193) (if tmp2193 (apply (lambda (pat2194 exp2195) (if (and (id?1131 pat2194) (andmap (lambda (x2196) (not (free-id=?1154 pat2194 x2196))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2188))) (let ((labels2197 (list (gen-label1136))) (var2198 (gen-var1179 pat2194))) (build-annotated1108 #f (list (build-annotated1108 #f (list (quote lambda) (list var2198) (chi1167 exp2195 (extend-env1125 labels2197 (list (cons (quote syntax) (cons var2198 0))) r2190) (make-binding-wrap1148 (list pat2194) labels2197 (quote (()))) mod2191))) x2187))) (gen-clause2185 x2187 keys2188 (cdr clauses2189) r2190 pat2194 #t exp2195 mod2191))) tmp2193) ((lambda (tmp2199) (if tmp2199 (apply (lambda (pat2200 fender2201 exp2202) (gen-clause2185 x2187 keys2188 (cdr clauses2189) r2190 pat2200 fender2201 exp2202 mod2191)) tmp2199) ((lambda (_2203) (syntax-error (car clauses2189) "invalid syntax-case clause")) tmp2192))) (syntax-dispatch tmp2192 (quote (any any any)))))) (syntax-dispatch tmp2192 (quote (any any))))) (car clauses2189))))) (gen-clause2185 (lambda (x2204 keys2205 clauses2206 r2207 pat2208 fender2209 exp2210 mod2211) (call-with-values (lambda () (convert-pattern2183 pat2208 keys2205)) (lambda (p2212 pvars2213) (cond ((not (distinct-bound-ids?1157 (map car pvars2213))) (syntax-error pat2208 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2214) (not (ellipsis?1176 (car x2214)))) pvars2213)) (syntax-error pat2208 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2215 (gen-var1179 (quote tmp)))) (build-annotated1108 #f (list (build-annotated1108 #f (list (quote lambda) (list y2215) (let ((y2216 (build-annotated1108 #f y2215))) (build-annotated1108 #f (list (quote if) ((lambda (tmp2217) ((lambda (tmp2218) (if tmp2218 (apply (lambda () y2216) tmp2218) ((lambda (_2219) (build-annotated1108 #f (list (quote if) y2216 (build-dispatch-call2184 pvars2213 fender2209 y2216 r2207 mod2211) (build-data1109 #f #f)))) tmp2217))) (syntax-dispatch tmp2217 (quote #(atom #t))))) fender2209) (build-dispatch-call2184 pvars2213 exp2210 y2216 r2207 mod2211) (gen-syntax-case2186 x2204 keys2205 clauses2206 r2207 mod2211)))))) (if (eq? p2212 (quote any)) (build-annotated1108 #f (list (build-annotated1108 #f (quote list)) x2204)) (build-annotated1108 #f (list (build-annotated1108 #f (quote syntax-dispatch)) x2204 (build-data1109 #f p2212))))))))))))) (build-dispatch-call2184 (lambda (pvars2220 exp2221 y2222 r2223 mod2224) (let ((ids2225 (map car pvars2220)) (levels2226 (map cdr pvars2220))) (let ((labels2227 (gen-labels1137 ids2225)) (new-vars2228 (map gen-var1179 ids2225))) (build-annotated1108 #f (list (build-annotated1108 #f (quote apply)) (build-annotated1108 #f (list (quote lambda) new-vars2228 (chi1167 exp2221 (extend-env1125 labels2227 (map (lambda (var2229 level2230) (cons (quote syntax) (cons var2229 level2230))) new-vars2228 (map cdr pvars2220)) r2223) (make-binding-wrap1148 ids2225 labels2227 (quote (()))) mod2224))) y2222)))))) (convert-pattern2183 (lambda (pattern2231 keys2232) (let cvt2233 ((p2234 pattern2231) (n2235 0) (ids2236 (quote ()))) (if (id?1131 p2234) (if (bound-id-member?1158 p2234 keys2232) (values (vector (quote free-id) p2234) ids2236) (values (quote any) (cons (cons p2234 n2235) ids2236))) ((lambda (tmp2237) ((lambda (tmp2238) (if (if tmp2238 (apply (lambda (x2239 dots2240) (ellipsis?1176 dots2240)) tmp2238) #f) (apply (lambda (x2241 dots2242) (call-with-values (lambda () (cvt2233 x2241 (fx+1098 n2235 1) ids2236)) (lambda (p2243 ids2244) (values (if (eq? p2243 (quote any)) (quote each-any) (vector (quote each) p2243)) ids2244)))) tmp2238) ((lambda (tmp2245) (if tmp2245 (apply (lambda (x2246 y2247) (call-with-values (lambda () (cvt2233 y2247 n2235 ids2236)) (lambda (y2248 ids2249) (call-with-values (lambda () (cvt2233 x2246 n2235 ids2249)) (lambda (x2250 ids2251) (values (cons x2250 y2248) ids2251)))))) tmp2245) ((lambda (tmp2252) (if tmp2252 (apply (lambda () (values (quote ()) ids2236)) tmp2252) ((lambda (tmp2253) (if tmp2253 (apply (lambda (x2254) (call-with-values (lambda () (cvt2233 x2254 n2235 ids2236)) (lambda (p2256 ids2257) (values (vector (quote vector) p2256) ids2257)))) tmp2253) ((lambda (x2258) (values (vector (quote atom) (strip1178 p2234 (quote (())))) ids2236)) tmp2237))) (syntax-dispatch tmp2237 (quote #(vector each-any)))))) (syntax-dispatch tmp2237 (quote ()))))) (syntax-dispatch tmp2237 (quote (any . any)))))) (syntax-dispatch tmp2237 (quote (any any))))) p2234)))))) (lambda (e2259 r2260 w2261 s2262 mod2263) (let ((e2264 (source-wrap1160 e2259 w2261 s2262 mod2263))) ((lambda (tmp2265) ((lambda (tmp2266) (if tmp2266 (apply (lambda (_2267 val2268 key2269 m2270) (if (andmap (lambda (x2271) (and (id?1131 x2271) (not (ellipsis?1176 x2271)))) key2269) (let ((x2273 (gen-var1179 (quote tmp)))) (build-annotated1108 s2262 (list (build-annotated1108 #f (list (quote lambda) (list x2273) (gen-syntax-case2186 (build-annotated1108 #f x2273) key2269 m2270 r2260 mod2263))) (chi1167 val2268 r2260 (quote (())) mod2263)))) (syntax-error e2264 "invalid literals list in"))) tmp2266) (syntax-error tmp2265))) (syntax-dispatch tmp2265 (quote (any any each-any . each-any))))) e2264))))) (set! sc-expand (let ((m2276 (quote e)) (esew2277 (quote (eval)))) (lambda (x2278) (if (and (pair? x2278) (equal? (car x2278) noexpand1097)) (cadr x2278) (chi-top1166 x2278 (quote ()) (quote ((top))) m2276 esew2277 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2279 (quote e)) (esew2280 (quote (eval)))) (lambda (x2282 . rest2281) (if (and (pair? x2282) (equal? (car x2282) noexpand1097)) (cadr x2282) (chi-top1166 x2282 (quote ()) (quote ((top))) (if (null? rest2281) m2279 (car rest2281)) (if (or (null? rest2281) (null? (cdr rest2281))) esew2280 (cadr rest2281)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2283) (nonsymbol-id?1130 x2283))) (set! datum->syntax-object (lambda (id2284 datum2285) (make-syntax-object1114 datum2285 (syntax-object-wrap1117 id2284) #f))) (set! syntax-object->datum (lambda (x2286) (strip1178 x2286 (quote (()))))) (set! generate-temporaries (lambda (ls2287) (begin (let ((x2288 ls2287)) (if (not (list? x2288)) (error-hook1104 (quote generate-temporaries) "invalid argument" x2288))) (map (lambda (x2289) (wrap1159 (gensym) (quote ((top))) #f)) ls2287)))) (set! free-identifier=? (lambda (x2290 y2291) (begin (let ((x2292 x2290)) (if (not (nonsymbol-id?1130 x2292)) (error-hook1104 (quote free-identifier=?) "invalid argument" x2292))) (let ((x2293 y2291)) (if (not (nonsymbol-id?1130 x2293)) (error-hook1104 (quote free-identifier=?) "invalid argument" x2293))) (free-id=?1154 x2290 y2291)))) (set! bound-identifier=? (lambda (x2294 y2295) (begin (let ((x2296 x2294)) (if (not (nonsymbol-id?1130 x2296)) (error-hook1104 (quote bound-identifier=?) "invalid argument" x2296))) (let ((x2297 y2295)) (if (not (nonsymbol-id?1130 x2297)) (error-hook1104 (quote bound-identifier=?) "invalid argument" x2297))) (bound-id=?1155 x2294 y2295)))) (set! syntax-error (lambda (object2299 . messages2298) (begin (for-each (lambda (x2300) (let ((x2301 x2300)) (if (not (string? x2301)) (error-hook1104 (quote syntax-error) "invalid argument" x2301)))) messages2298) (let ((message2302 (if (null? messages2298) "invalid syntax" (apply string-append messages2298)))) (error-hook1104 #f message2302 (strip1178 object2299 (quote (())))))))) (set! install-global-transformer (lambda (sym2303 v2304) (begin (let ((x2305 sym2303)) (if (not (symbol? x2305)) (error-hook1104 (quote define-syntax) "invalid argument" x2305))) (let ((x2306 v2304)) (if (not (procedure? x2306)) (error-hook1104 (quote define-syntax) "invalid argument" x2306))) (global-extend1129 (quote macro) sym2303 v2304)))) (letrec ((match2311 (lambda (e2312 p2313 w2314 r2315 mod2316) (cond ((not r2315) #f) ((eq? p2313 (quote any)) (cons (wrap1159 e2312 w2314 mod2316) r2315)) ((syntax-object?1115 e2312) (match*2310 (let ((e2317 (syntax-object-expression1116 e2312))) (if (annotation? e2317) (annotation-expression e2317) e2317)) p2313 (join-wraps1150 w2314 (syntax-object-wrap1117 e2312)) r2315 (syntax-object-module1118 e2312))) (else (match*2310 (let ((e2318 e2312)) (if (annotation? e2318) (annotation-expression e2318) e2318)) p2313 w2314 r2315 mod2316))))) (match*2310 (lambda (e2319 p2320 w2321 r2322 mod2323) (cond ((null? p2320) (and (null? e2319) r2322)) ((pair? p2320) (and (pair? e2319) (match2311 (car e2319) (car p2320) w2321 (match2311 (cdr e2319) (cdr p2320) w2321 r2322 mod2323) mod2323))) ((eq? p2320 (quote each-any)) (let ((l2324 (match-each-any2308 e2319 w2321 mod2323))) (and l2324 (cons l2324 r2322)))) (else (let ((t2325 (vector-ref p2320 0))) (if (memv t2325 (quote (each))) (if (null? e2319) (match-empty2309 (vector-ref p2320 1) r2322) (let ((l2326 (match-each2307 e2319 (vector-ref p2320 1) w2321 mod2323))) (and l2326 (let collect2327 ((l2328 l2326)) (if (null? (car l2328)) r2322 (cons (map car l2328) (collect2327 (map cdr l2328)))))))) (if (memv t2325 (quote (free-id))) (and (id?1131 e2319) (free-id=?1154 (wrap1159 e2319 w2321 mod2323) (vector-ref p2320 1)) r2322) (if (memv t2325 (quote (atom))) (and (equal? (vector-ref p2320 1) (strip1178 e2319 w2321)) r2322) (if (memv t2325 (quote (vector))) (and (vector? e2319) (match2311 (vector->list e2319) (vector-ref p2320 1) w2321 r2322 mod2323))))))))))) (match-empty2309 (lambda (p2329 r2330) (cond ((null? p2329) r2330) ((eq? p2329 (quote any)) (cons (quote ()) r2330)) ((pair? p2329) (match-empty2309 (car p2329) (match-empty2309 (cdr p2329) r2330))) ((eq? p2329 (quote each-any)) (cons (quote ()) r2330)) (else (let ((t2331 (vector-ref p2329 0))) (if (memv t2331 (quote (each))) (match-empty2309 (vector-ref p2329 1) r2330) (if (memv t2331 (quote (free-id atom))) r2330 (if (memv t2331 (quote (vector))) (match-empty2309 (vector-ref p2329 1) r2330))))))))) (match-each-any2308 (lambda (e2332 w2333 mod2334) (cond ((annotation? e2332) (match-each-any2308 (annotation-expression e2332) w2333 mod2334)) ((pair? e2332) (let ((l2335 (match-each-any2308 (cdr e2332) w2333 mod2334))) (and l2335 (cons (wrap1159 (car e2332) w2333 mod2334) l2335)))) ((null? e2332) (quote ())) ((syntax-object?1115 e2332) (match-each-any2308 (syntax-object-expression1116 e2332) (join-wraps1150 w2333 (syntax-object-wrap1117 e2332)) mod2334)) (else #f)))) (match-each2307 (lambda (e2336 p2337 w2338 mod2339) (cond ((annotation? e2336) (match-each2307 (annotation-expression e2336) p2337 w2338 mod2339)) ((pair? e2336) (let ((first2340 (match2311 (car e2336) p2337 w2338 (quote ()) mod2339))) (and first2340 (let ((rest2341 (match-each2307 (cdr e2336) p2337 w2338 mod2339))) (and rest2341 (cons first2340 rest2341)))))) ((null? e2336) (quote ())) ((syntax-object?1115 e2336) (match-each2307 (syntax-object-expression1116 e2336) p2337 (join-wraps1150 w2338 (syntax-object-wrap1117 e2336)) (syntax-object-module1118 e2336))) (else #f))))) (begin (set! syntax-dispatch (lambda (e2342 p2343) (cond ((eq? p2343 (quote any)) (list e2342)) ((syntax-object?1115 e2342) (match*2310 (let ((e2344 (syntax-object-expression1116 e2342))) (if (annotation? e2344) (annotation-expression e2344) e2344)) p2343 (syntax-object-wrap1117 e2342) (quote ()) (syntax-object-module1118 e2342))) (else (match*2310 (let ((e2345 e2342)) (if (annotation? e2345) (annotation-expression e2345) e2345)) p2343 (quote (())) (quote ()) #f))))) (set! sc-chi chi1167)))))
-(install-global-transformer (quote with-syntax) (lambda (x2346) ((lambda (tmp2347) ((lambda (tmp2348) (if tmp2348 (apply (lambda (_2349 e12350 e22351) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12350 e22351))) tmp2348) ((lambda (tmp2353) (if tmp2353 (apply (lambda (_2354 out2355 in2356 e12357 e22358) (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))) in2356 (quote ()) (list out2355 (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 e12357 e22358))))) tmp2353) ((lambda (tmp2360) (if tmp2360 (apply (lambda (_2361 out2362 in2363 e12364 e22365) (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))) in2363) (quote ()) (list out2362 (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 e12364 e22365))))) tmp2360) (syntax-error tmp2347))) (syntax-dispatch tmp2347 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2347 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2347 (quote (any () any . each-any))))) x2346)))
-(install-global-transformer (quote syntax-rules) (lambda (x2369) ((lambda (tmp2370) ((lambda (tmp2371) (if tmp2371 (apply (lambda (_2372 k2373 keyword2374 pattern2375 template2376) (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 k2373 (map (lambda (tmp2379 tmp2378) (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))) tmp2378) (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))) tmp2379))) template2376 pattern2375)))))) tmp2371) (syntax-error tmp2370))) (syntax-dispatch tmp2370 (quote (any each-any . #(each ((any . any) any))))))) x2369)))
-(install-global-transformer (quote let*) (lambda (x2380) ((lambda (tmp2381) ((lambda (tmp2382) (if (if tmp2382 (apply (lambda (let*2383 x2384 v2385 e12386 e22387) (andmap identifier? x2384)) tmp2382) #f) (apply (lambda (let*2389 x2390 v2391 e12392 e22393) (let f2394 ((bindings2395 (map list x2390 v2391))) (if (null? bindings2395) (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 e12392 e22393))) ((lambda (tmp2399) ((lambda (tmp2400) (if tmp2400 (apply (lambda (body2401 binding2402) (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 binding2402) body2401)) tmp2400) (syntax-error tmp2399))) (syntax-dispatch tmp2399 (quote (any any))))) (list (f2394 (cdr bindings2395)) (car bindings2395)))))) tmp2382) (syntax-error tmp2381))) (syntax-dispatch tmp2381 (quote (any #(each (any any)) any . each-any))))) x2380)))
-(install-global-transformer (quote do) (lambda (orig-x2403) ((lambda (tmp2404) ((lambda (tmp2405) (if tmp2405 (apply (lambda (_2406 var2407 init2408 step2409 e02410 e12411 c2412) ((lambda (tmp2413) ((lambda (tmp2414) (if tmp2414 (apply (lambda (step2415) ((lambda (tmp2416) ((lambda (tmp2417) (if tmp2417 (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 var2407 init2408) (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))) e02410) (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 c2412 (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))) step2415))))))) tmp2417) ((lambda (tmp2422) (if tmp2422 (apply (lambda (e12423 e22424) (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 var2407 init2408) (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))) e02410 (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 e12423 e22424)) (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 c2412 (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))) step2415))))))) tmp2422) (syntax-error tmp2416))) (syntax-dispatch tmp2416 (quote (any . each-any)))))) (syntax-dispatch tmp2416 (quote ())))) e12411)) tmp2414) (syntax-error tmp2413))) (syntax-dispatch tmp2413 (quote each-any)))) (map (lambda (v2431 s2432) ((lambda (tmp2433) ((lambda (tmp2434) (if tmp2434 (apply (lambda () v2431) tmp2434) ((lambda (tmp2435) (if tmp2435 (apply (lambda (e2436) e2436) tmp2435) ((lambda (_2437) (syntax-error orig-x2403)) tmp2433))) (syntax-dispatch tmp2433 (quote (any)))))) (syntax-dispatch tmp2433 (quote ())))) s2432)) var2407 step2409))) tmp2405) (syntax-error tmp2404))) (syntax-dispatch tmp2404 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2403)))
-(install-global-transformer (quote quasiquote) (letrec ((quasicons2440 (lambda (x2444 y2445) ((lambda (tmp2446) ((lambda (tmp2447) (if tmp2447 (apply (lambda (x2448 y2449) ((lambda (tmp2450) ((lambda (tmp2451) (if tmp2451 (apply (lambda (dy2452) ((lambda (tmp2453) ((lambda (tmp2454) (if tmp2454 (apply (lambda (dx2455) (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 dx2455 dy2452))) tmp2454) ((lambda (_2456) (if (null? dy2452) (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))) x2448) (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))) x2448 y2449))) tmp2453))) (syntax-dispatch tmp2453 (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))))) x2448)) tmp2451) ((lambda (tmp2457) (if tmp2457 (apply (lambda (stuff2458) (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 x2448 stuff2458))) tmp2457) ((lambda (else2459) (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))) x2448 y2449)) tmp2450))) (syntax-dispatch tmp2450 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) (syntax-dispatch tmp2450 (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))))) y2449)) tmp2447) (syntax-error tmp2446))) (syntax-dispatch tmp2446 (quote (any any))))) (list x2444 y2445)))) (quasiappend2441 (lambda (x2460 y2461) ((lambda (tmp2462) ((lambda (tmp2463) (if tmp2463 (apply (lambda (x2464 y2465) ((lambda (tmp2466) ((lambda (tmp2467) (if tmp2467 (apply (lambda () x2464) tmp2467) ((lambda (_2468) (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))) x2464 y2465)) tmp2466))) (syntax-dispatch tmp2466 (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))) ()))))) y2465)) tmp2463) (syntax-error tmp2462))) (syntax-dispatch tmp2462 (quote (any any))))) (list x2460 y2461)))) (quasivector2442 (lambda (x2469) ((lambda (tmp2470) ((lambda (x2471) ((lambda (tmp2472) ((lambda (tmp2473) (if tmp2473 (apply (lambda (x2474) (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 x2474))) tmp2473) ((lambda (tmp2476) (if tmp2476 (apply (lambda (x2477) (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))) x2477)) tmp2476) ((lambda (_2479) (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))) x2471)) tmp2472))) (syntax-dispatch tmp2472 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) (syntax-dispatch tmp2472 (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))))) x2471)) tmp2470)) x2469))) (quasi2443 (lambda (p2480 lev2481) ((lambda (tmp2482) ((lambda (tmp2483) (if tmp2483 (apply (lambda (p2484) (if (= lev2481 0) p2484 (quasicons2440 (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)))) (quasi2443 (list p2484) (- lev2481 1))))) tmp2483) ((lambda (tmp2485) (if tmp2485 (apply (lambda (p2486 q2487) (if (= lev2481 0) (quasiappend2441 p2486 (quasi2443 q2487 lev2481)) (quasicons2440 (quasicons2440 (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)))) (quasi2443 (list p2486) (- lev2481 1))) (quasi2443 q2487 lev2481)))) tmp2485) ((lambda (tmp2488) (if tmp2488 (apply (lambda (p2489) (quasicons2440 (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)))) (quasi2443 (list p2489) (+ lev2481 1)))) tmp2488) ((lambda (tmp2490) (if tmp2490 (apply (lambda (p2491 q2492) (quasicons2440 (quasi2443 p2491 lev2481) (quasi2443 q2492 lev2481))) tmp2490) ((lambda (tmp2493) (if tmp2493 (apply (lambda (x2494) (quasivector2442 (quasi2443 x2494 lev2481))) tmp2493) ((lambda (p2496) (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))) p2496)) tmp2482))) (syntax-dispatch tmp2482 (quote #(vector each-any)))))) (syntax-dispatch tmp2482 (quote (any . any)))))) (syntax-dispatch tmp2482 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) (syntax-dispatch tmp2482 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) (syntax-dispatch tmp2482 (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))))) p2480)))) (lambda (x2497) ((lambda (tmp2498) ((lambda (tmp2499) (if tmp2499 (apply (lambda (_2500 e2501) (quasi2443 e2501 0)) tmp2499) (syntax-error tmp2498))) (syntax-dispatch tmp2498 (quote (any any))))) x2497))))
-(install-global-transformer (quote include) (lambda (x2502) (letrec ((read-file2503 (lambda (fn2504 k2505) (let ((p2506 (open-input-file fn2504))) (let f2507 ((x2508 (read p2506))) (if (eof-object? x2508) (begin (close-input-port p2506) (quote ())) (cons (datum->syntax-object k2505 x2508) (f2507 (read p2506))))))))) ((lambda (tmp2509) ((lambda (tmp2510) (if tmp2510 (apply (lambda (k2511 filename2512) (let ((fn2513 (syntax-object->datum filename2512))) ((lambda (tmp2514) ((lambda (tmp2515) (if tmp2515 (apply (lambda (exp2516) (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))) exp2516)) tmp2515) (syntax-error tmp2514))) (syntax-dispatch tmp2514 (quote each-any)))) (read-file2503 fn2513 k2511)))) tmp2510) (syntax-error tmp2509))) (syntax-dispatch tmp2509 (quote (any any))))) x2502))))
-(install-global-transformer (quote unquote) (lambda (x2518) ((lambda (tmp2519) ((lambda (tmp2520) (if tmp2520 (apply (lambda (_2521 e2522) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2522))) tmp2520) (syntax-error tmp2519))) (syntax-dispatch tmp2519 (quote (any any))))) x2518)))
-(install-global-transformer (quote unquote-splicing) (lambda (x2523) ((lambda (tmp2524) ((lambda (tmp2525) (if tmp2525 (apply (lambda (_2526 e2527) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2527))) tmp2525) (syntax-error tmp2524))) (syntax-dispatch tmp2524 (quote (any any))))) x2523)))
-(install-global-transformer (quote case) (lambda (x2528) ((lambda (tmp2529) ((lambda (tmp2530) (if tmp2530 (apply (lambda (_2531 e2532 m12533 m22534) ((lambda (tmp2535) ((lambda (body2536) (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))) e2532)) body2536)) tmp2535)) (let f2537 ((clause2538 m12533) (clauses2539 m22534)) (if (null? clauses2539) ((lambda (tmp2541) ((lambda (tmp2542) (if tmp2542 (apply (lambda (e12543 e22544) (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 e12543 e22544))) tmp2542) ((lambda (tmp2546) (if tmp2546 (apply (lambda (k2547 e12548 e22549) (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))) k2547)) (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 e12548 e22549)))) tmp2546) ((lambda (_2552) (syntax-error x2528)) tmp2541))) (syntax-dispatch tmp2541 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2541 (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))))) clause2538) ((lambda (tmp2553) ((lambda (rest2554) ((lambda (tmp2555) ((lambda (tmp2556) (if tmp2556 (apply (lambda (k2557 e12558 e22559) (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))) k2557)) (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 e12558 e22559)) rest2554)) tmp2556) ((lambda (_2562) (syntax-error x2528)) tmp2555))) (syntax-dispatch tmp2555 (quote (each-any any . each-any))))) clause2538)) tmp2553)) (f2537 (car clauses2539) (cdr clauses2539))))))) tmp2530) (syntax-error tmp2529))) (syntax-dispatch tmp2529 (quote (any any any . each-any))))) x2528)))
-(install-global-transformer (quote identifier-syntax) (lambda (x2563) ((lambda (tmp2564) ((lambda (tmp2565) (if tmp2565 (apply (lambda (_2566 e2567) (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))) e2567)) (list (cons _2566 (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 e2567 (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)))))))))) tmp2565) (syntax-error tmp2564))) (syntax-dispatch tmp2564 (quote (any any))))) x2563)))
+(letrec ((lambda-var-list1180 (lambda (vars1379) (let lvl1380 ((vars1381 vars1379) (ls1382 (quote ())) (w1383 (quote (())))) (cond ((pair? vars1381) (lvl1380 (cdr vars1381) (cons (wrap1159 (car vars1381) w1383 #f) ls1382) w1383)) ((id?1131 vars1381) (cons (wrap1159 vars1381 w1383 #f) ls1382)) ((null? vars1381) ls1382) ((syntax-object?1115 vars1381) (lvl1380 (syntax-object-expression1116 vars1381) ls1382 (join-wraps1150 w1383 (syntax-object-wrap1117 vars1381)))) ((annotation? vars1381) (lvl1380 (annotation-expression vars1381) ls1382 w1383)) (else (cons vars1381 ls1382)))))) (gen-var1179 (lambda (id1384) (let ((id1385 (if (syntax-object?1115 id1384) (syntax-object-expression1116 id1384) id1384))) (if (annotation? id1385) (build-annotated1108 (annotation-source id1385) (gensym (symbol->string (annotation-expression id1385)))) (build-annotated1108 #f (gensym (symbol->string id1385))))))) (strip1178 (lambda (x1386 w1387) (if (memq (quote top) (wrap-marks1134 w1387)) (if (or (annotation? x1386) (and (pair? x1386) (annotation? (car x1386)))) (strip-annotation1177 x1386 #f) x1386) (let f1388 ((x1389 x1386)) (cond ((syntax-object?1115 x1389) (strip1178 (syntax-object-expression1116 x1389) (syntax-object-wrap1117 x1389))) ((pair? x1389) (let ((a1390 (f1388 (car x1389))) (d1391 (f1388 (cdr x1389)))) (if (and (eq? a1390 (car x1389)) (eq? d1391 (cdr x1389))) x1389 (cons a1390 d1391)))) ((vector? x1389) (let ((old1392 (vector->list x1389))) (let ((new1393 (map f1388 old1392))) (if (andmap eq? old1392 new1393) x1389 (list->vector new1393))))) (else x1389)))))) (strip-annotation1177 (lambda (x1394 parent1395) (cond ((pair? x1394) (let ((new1396 (cons #f #f))) (begin (if parent1395 (set-annotation-stripped! parent1395 new1396)) (set-car! new1396 (strip-annotation1177 (car x1394) #f)) (set-cdr! new1396 (strip-annotation1177 (cdr x1394) #f)) new1396))) ((annotation? x1394) (or (annotation-stripped x1394) (strip-annotation1177 (annotation-expression x1394) x1394))) ((vector? x1394) (let ((new1397 (make-vector (vector-length x1394)))) (begin (if parent1395 (set-annotation-stripped! parent1395 new1397)) (let loop1398 ((i1399 (- (vector-length x1394) 1))) (unless (fx<1101 i1399 0) (vector-set! new1397 i1399 (strip-annotation1177 (vector-ref x1394 i1399) #f)) (loop1398 (fx-1099 i1399 1)))) new1397))) (else x1394)))) (ellipsis?1176 (lambda (x1400) (and (nonsymbol-id?1130 x1400) (free-id=?1154 x1400 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void1175 (lambda () (build-annotated1108 #f (list (build-annotated1108 #f (quote void)))))) (eval-local-transformer1174 (lambda (expanded1401 mod1402) (let ((p1403 (local-eval-hook1103 expanded1401 mod1402))) (if (procedure? p1403) p1403 (syntax-error p1403 "nonprocedure transformer"))))) (chi-local-syntax1173 (lambda (rec?1404 e1405 r1406 w1407 s1408 mod1409 k1410) ((lambda (tmp1411) ((lambda (tmp1412) (if tmp1412 (apply (lambda (_1413 id1414 val1415 e11416 e21417) (let ((ids1418 id1414)) (if (not (valid-bound-ids?1156 ids1418)) (syntax-error e1405 "duplicate bound keyword in") (let ((labels1420 (gen-labels1137 ids1418))) (let ((new-w1421 (make-binding-wrap1148 ids1418 labels1420 w1407))) (k1410 (cons e11416 e21417) (extend-env1125 labels1420 (let ((w1423 (if rec?1404 new-w1421 w1407)) (trans-r1424 (macros-only-env1127 r1406))) (map (lambda (x1425) (cons (quote macro) (eval-local-transformer1174 (chi1167 x1425 trans-r1424 w1423 mod1409) mod1409))) val1415)) r1406) new-w1421 s1408 mod1409)))))) tmp1412) ((lambda (_1427) (syntax-error (source-wrap1160 e1405 w1407 s1408 mod1409))) tmp1411))) (syntax-dispatch tmp1411 (quote (any #(each (any any)) any . each-any))))) e1405))) (chi-lambda-clause1172 (lambda (e1428 c1429 r1430 w1431 mod1432 k1433) ((lambda (tmp1434) ((lambda (tmp1435) (if tmp1435 (apply (lambda (id1436 e11437 e21438) (let ((ids1439 id1436)) (if (not (valid-bound-ids?1156 ids1439)) (syntax-error e1428 "invalid parameter list in") (let ((labels1441 (gen-labels1137 ids1439)) (new-vars1442 (map gen-var1179 ids1439))) (k1433 new-vars1442 (chi-body1171 (cons e11437 e21438) e1428 (extend-var-env1126 labels1441 new-vars1442 r1430) (make-binding-wrap1148 ids1439 labels1441 w1431) mod1432)))))) tmp1435) ((lambda (tmp1444) (if tmp1444 (apply (lambda (ids1445 e11446 e21447) (let ((old-ids1448 (lambda-var-list1180 ids1445))) (if (not (valid-bound-ids?1156 old-ids1448)) (syntax-error e1428 "invalid parameter list in") (let ((labels1449 (gen-labels1137 old-ids1448)) (new-vars1450 (map gen-var1179 old-ids1448))) (k1433 (let f1451 ((ls11452 (cdr new-vars1450)) (ls21453 (car new-vars1450))) (if (null? ls11452) ls21453 (f1451 (cdr ls11452) (cons (car ls11452) ls21453)))) (chi-body1171 (cons e11446 e21447) e1428 (extend-var-env1126 labels1449 new-vars1450 r1430) (make-binding-wrap1148 old-ids1448 labels1449 w1431) mod1432)))))) tmp1444) ((lambda (_1455) (syntax-error e1428)) tmp1434))) (syntax-dispatch tmp1434 (quote (any any . each-any)))))) (syntax-dispatch tmp1434 (quote (each-any any . each-any))))) c1429))) (chi-body1171 (lambda (body1456 outer-form1457 r1458 w1459 mod1460) (let ((r1461 (cons (quote ("placeholder" placeholder)) r1458))) (let ((ribcage1462 (make-ribcage1138 (quote ()) (quote ()) (quote ())))) (let ((w1463 (make-wrap1133 (wrap-marks1134 w1459) (cons ribcage1462 (wrap-subst1135 w1459))))) (let parse1464 ((body1465 (map (lambda (x1471) (cons r1461 (wrap1159 x1471 w1463 mod1460))) body1456)) (ids1466 (quote ())) (labels1467 (quote ())) (vars1468 (quote ())) (vals1469 (quote ())) (bindings1470 (quote ()))) (if (null? body1465) (syntax-error outer-form1457 "no expressions in body") (let ((e1472 (cdar body1465)) (er1473 (caar body1465))) (call-with-values (lambda () (syntax-type1165 e1472 er1473 (quote (())) #f ribcage1462 mod1460)) (lambda (type1474 value1475 e1476 w1477 s1478 mod1479) (let ((t1480 type1474)) (if (memv t1480 (quote (define-form))) (let ((id1481 (wrap1159 value1475 w1477 mod1479)) (label1482 (gen-label1136))) (let ((var1483 (gen-var1179 id1481))) (begin (extend-ribcage!1147 ribcage1462 id1481 label1482) (parse1464 (cdr body1465) (cons id1481 ids1466) (cons label1482 labels1467) (cons var1483 vars1468) (cons (cons er1473 (wrap1159 e1476 w1477 mod1479)) vals1469) (cons (cons (quote lexical) var1483) bindings1470))))) (if (memv t1480 (quote (define-syntax-form))) (let ((id1484 (wrap1159 value1475 w1477 mod1479)) (label1485 (gen-label1136))) (begin (extend-ribcage!1147 ribcage1462 id1484 label1485) (parse1464 (cdr body1465) (cons id1484 ids1466) (cons label1485 labels1467) vars1468 vals1469 (cons (cons (quote macro) (cons er1473 (wrap1159 e1476 w1477 mod1479))) bindings1470)))) (if (memv t1480 (quote (begin-form))) ((lambda (tmp1486) ((lambda (tmp1487) (if tmp1487 (apply (lambda (_1488 e11489) (parse1464 (let f1490 ((forms1491 e11489)) (if (null? forms1491) (cdr body1465) (cons (cons er1473 (wrap1159 (car forms1491) w1477 mod1479)) (f1490 (cdr forms1491))))) ids1466 labels1467 vars1468 vals1469 bindings1470)) tmp1487) (syntax-error tmp1486))) (syntax-dispatch tmp1486 (quote (any . each-any))))) e1476) (if (memv t1480 (quote (local-syntax-form))) (chi-local-syntax1173 value1475 e1476 er1473 w1477 s1478 mod1479 (lambda (forms1493 er1494 w1495 s1496 mod1497) (parse1464 (let f1498 ((forms1499 forms1493)) (if (null? forms1499) (cdr body1465) (cons (cons er1494 (wrap1159 (car forms1499) w1495 mod1497)) (f1498 (cdr forms1499))))) ids1466 labels1467 vars1468 vals1469 bindings1470))) (if (null? ids1466) (build-sequence1110 #f (map (lambda (x1500) (chi1167 (cdr x1500) (car x1500) (quote (())) mod1479)) (cons (cons er1473 (source-wrap1160 e1476 w1477 s1478 mod1479)) (cdr body1465)))) (begin (if (not (valid-bound-ids?1156 ids1466)) (syntax-error outer-form1457 "invalid or duplicate identifier in definition")) (let loop1501 ((bs1502 bindings1470) (er-cache1503 #f) (r-cache1504 #f)) (if (not (null? bs1502)) (let ((b1505 (car bs1502))) (if (eq? (car b1505) (quote macro)) (let ((er1506 (cadr b1505))) (let ((r-cache1507 (if (eq? er1506 er-cache1503) r-cache1504 (macros-only-env1127 er1506)))) (begin (set-cdr! b1505 (eval-local-transformer1174 (chi1167 (cddr b1505) r-cache1507 (quote (())) mod1479) mod1479)) (loop1501 (cdr bs1502) er1506 r-cache1507)))) (loop1501 (cdr bs1502) er-cache1503 r-cache1504))))) (set-cdr! r1461 (extend-env1125 labels1467 bindings1470 (cdr r1461))) (build-letrec1113 #f vars1468 (map (lambda (x1508) (chi1167 (cdr x1508) (car x1508) (quote (())) mod1479)) vals1469) (build-sequence1110 #f (map (lambda (x1509) (chi1167 (cdr x1509) (car x1509) (quote (())) mod1479)) (cons (cons er1473 (source-wrap1160 e1476 w1477 s1478 mod1479)) (cdr body1465)))))))))))))))))))))) (chi-macro1170 (lambda (p1510 e1511 r1512 w1513 rib1514 mod1515) (letrec ((rebuild-macro-output1516 (lambda (x1517 m1518) (cond ((pair? x1517) (cons (rebuild-macro-output1516 (car x1517) m1518) (rebuild-macro-output1516 (cdr x1517) m1518))) ((syntax-object?1115 x1517) (let ((w1519 (syntax-object-wrap1117 x1517))) (let ((ms1520 (wrap-marks1134 w1519)) (s1521 (wrap-subst1135 w1519))) (if (and (pair? ms1520) (eq? (car ms1520) #f)) (make-syntax-object1114 (syntax-object-expression1116 x1517) (make-wrap1133 (cdr ms1520) (if rib1514 (cons rib1514 (cdr s1521)) (cdr s1521))) (syntax-object-module1118 x1517)) (make-syntax-object1114 (syntax-object-expression1116 x1517) (make-wrap1133 (cons m1518 ms1520) (if rib1514 (cons rib1514 (cons (quote shift) s1521)) (cons (quote shift) s1521))) (let ((pmod1522 (procedure-module p1510))) (if pmod1522 (cons (quote hygiene) (module-name pmod1522)) (quote (hygiene guile))))))))) ((vector? x1517) (let ((n1523 (vector-length x1517))) (let ((v1524 (make-vector n1523))) (let doloop1525 ((i1526 0)) (if (fx=1100 i1526 n1523) v1524 (begin (vector-set! v1524 i1526 (rebuild-macro-output1516 (vector-ref x1517 i1526) m1518)) (doloop1525 (fx+1098 i1526 1)))))))) ((symbol? x1517) (syntax-error x1517 "encountered raw symbol in macro output")) (else x1517))))) (rebuild-macro-output1516 (p1510 (wrap1159 e1511 (anti-mark1146 w1513) mod1515)) (string #\m))))) (chi-application1169 (lambda (x1527 e1528 r1529 w1530 s1531 mod1532) ((lambda (tmp1533) ((lambda (tmp1534) (if tmp1534 (apply (lambda (e01535 e11536) (build-annotated1108 s1531 (cons x1527 (map (lambda (e1537) (chi1167 e1537 r1529 w1530 mod1532)) e11536)))) tmp1534) (syntax-error tmp1533))) (syntax-dispatch tmp1533 (quote (any . each-any))))) e1528))) (chi-expr1168 (lambda (type1539 value1540 e1541 r1542 w1543 s1544 mod1545) (let ((t1546 type1539)) (if (memv t1546 (quote (lexical))) (build-annotated1108 s1544 value1540) (if (memv t1546 (quote (core external-macro))) (value1540 e1541 r1542 w1543 s1544 mod1545) (if (memv t1546 (quote (module-ref))) (call-with-values (lambda () (value1540 e1541)) (lambda (id1547 mod1548) (build-annotated1108 s1544 (if mod1548 (make-module-ref (cdr mod1548) id1547 (car mod1548)) (make-module-ref mod1548 id1547 (quote bare)))))) (if (memv t1546 (quote (lexical-call))) (chi-application1169 (build-annotated1108 (source-annotation1122 (car e1541)) value1540) e1541 r1542 w1543 s1544 mod1545) (if (memv t1546 (quote (global-call))) (chi-application1169 (build-annotated1108 (source-annotation1122 (car e1541)) (if (if (syntax-object?1115 (car e1541)) (syntax-object-module1118 (car e1541)) mod1545) (make-module-ref (cdr (if (syntax-object?1115 (car e1541)) (syntax-object-module1118 (car e1541)) mod1545)) value1540 (car (if (syntax-object?1115 (car e1541)) (syntax-object-module1118 (car e1541)) mod1545))) (make-module-ref (if (syntax-object?1115 (car e1541)) (syntax-object-module1118 (car e1541)) mod1545) value1540 (quote bare)))) e1541 r1542 w1543 s1544 mod1545) (if (memv t1546 (quote (constant))) (build-data1109 s1544 (strip1178 (source-wrap1160 e1541 w1543 s1544 mod1545) (quote (())))) (if (memv t1546 (quote (global))) (build-annotated1108 s1544 (if mod1545 (make-module-ref (cdr mod1545) value1540 (car mod1545)) (make-module-ref mod1545 value1540 (quote bare)))) (if (memv t1546 (quote (call))) (chi-application1169 (chi1167 (car e1541) r1542 w1543 mod1545) e1541 r1542 w1543 s1544 mod1545) (if (memv t1546 (quote (begin-form))) ((lambda (tmp1549) ((lambda (tmp1550) (if tmp1550 (apply (lambda (_1551 e11552 e21553) (chi-sequence1161 (cons e11552 e21553) r1542 w1543 s1544 mod1545)) tmp1550) (syntax-error tmp1549))) (syntax-dispatch tmp1549 (quote (any any . each-any))))) e1541) (if (memv t1546 (quote (local-syntax-form))) (chi-local-syntax1173 value1540 e1541 r1542 w1543 s1544 mod1545 chi-sequence1161) (if (memv t1546 (quote (eval-when-form))) ((lambda (tmp1555) ((lambda (tmp1556) (if tmp1556 (apply (lambda (_1557 x1558 e11559 e21560) (let ((when-list1561 (chi-when-list1164 e1541 x1558 w1543))) (if (memq (quote eval) when-list1561) (chi-sequence1161 (cons e11559 e21560) r1542 w1543 s1544 mod1545) (chi-void1175)))) tmp1556) (syntax-error tmp1555))) (syntax-dispatch tmp1555 (quote (any each-any any . each-any))))) e1541) (if (memv t1546 (quote (define-form define-syntax-form))) (syntax-error (wrap1159 value1540 w1543 mod1545) "invalid context for definition of") (if (memv t1546 (quote (syntax))) (syntax-error (source-wrap1160 e1541 w1543 s1544 mod1545) "reference to pattern variable outside syntax form") (if (memv t1546 (quote (displaced-lexical))) (syntax-error (source-wrap1160 e1541 w1543 s1544 mod1545) "reference to identifier outside its scope") (syntax-error (source-wrap1160 e1541 w1543 s1544 mod1545))))))))))))))))))) (chi1167 (lambda (e1564 r1565 w1566 mod1567) (call-with-values (lambda () (syntax-type1165 e1564 r1565 w1566 #f #f mod1567)) (lambda (type1568 value1569 e1570 w1571 s1572 mod1573) (chi-expr1168 type1568 value1569 e1570 r1565 w1571 s1572 mod1573))))) (chi-top1166 (lambda (e1574 r1575 w1576 m1577 esew1578 mod1579) (call-with-values (lambda () (syntax-type1165 e1574 r1575 w1576 #f #f mod1579)) (lambda (type1587 value1588 e1589 w1590 s1591 mod1592) (let ((t1593 type1587)) (if (memv t1593 (quote (begin-form))) ((lambda (tmp1594) ((lambda (tmp1595) (if tmp1595 (apply (lambda (_1596) (chi-void1175)) tmp1595) ((lambda (tmp1597) (if tmp1597 (apply (lambda (_1598 e11599 e21600) (chi-top-sequence1162 (cons e11599 e21600) r1575 w1590 s1591 m1577 esew1578 mod1592)) tmp1597) (syntax-error tmp1594))) (syntax-dispatch tmp1594 (quote (any any . each-any)))))) (syntax-dispatch tmp1594 (quote (any))))) e1589) (if (memv t1593 (quote (local-syntax-form))) (chi-local-syntax1173 value1588 e1589 r1575 w1590 s1591 mod1592 (lambda (body1602 r1603 w1604 s1605 mod1606) (chi-top-sequence1162 body1602 r1603 w1604 s1605 m1577 esew1578 mod1606))) (if (memv t1593 (quote (eval-when-form))) ((lambda (tmp1607) ((lambda (tmp1608) (if tmp1608 (apply (lambda (_1609 x1610 e11611 e21612) (let ((when-list1613 (chi-when-list1164 e1589 x1610 w1590)) (body1614 (cons e11611 e21612))) (cond ((eq? m1577 (quote e)) (if (memq (quote eval) when-list1613) (chi-top-sequence1162 body1614 r1575 w1590 s1591 (quote e) (quote (eval)) mod1592) (chi-void1175))) ((memq (quote load) when-list1613) (if (or (memq (quote compile) when-list1613) (and (eq? m1577 (quote c&e)) (memq (quote eval) when-list1613))) (chi-top-sequence1162 body1614 r1575 w1590 s1591 (quote c&e) (quote (compile load)) mod1592) (if (memq m1577 (quote (c c&e))) (chi-top-sequence1162 body1614 r1575 w1590 s1591 (quote c) (quote (load)) mod1592) (chi-void1175)))) ((or (memq (quote compile) when-list1613) (and (eq? m1577 (quote c&e)) (memq (quote eval) when-list1613))) (top-level-eval-hook1102 (chi-top-sequence1162 body1614 r1575 w1590 s1591 (quote e) (quote (eval)) mod1592) mod1592) (chi-void1175)) (else (chi-void1175))))) tmp1608) (syntax-error tmp1607))) (syntax-dispatch tmp1607 (quote (any each-any any . each-any))))) e1589) (if (memv t1593 (quote (define-syntax-form))) (let ((n1617 (id-var-name1153 value1588 w1590)) (r1618 (macros-only-env1127 r1575))) (let ((t1619 m1577)) (if (memv t1619 (quote (c))) (if (memq (quote compile) esew1578) (let ((e1620 (chi-install-global1163 n1617 (chi1167 e1589 r1618 w1590 mod1592)))) (begin (top-level-eval-hook1102 e1620 mod1592) (if (memq (quote load) esew1578) e1620 (chi-void1175)))) (if (memq (quote load) esew1578) (chi-install-global1163 n1617 (chi1167 e1589 r1618 w1590 mod1592)) (chi-void1175))) (if (memv t1619 (quote (c&e))) (let ((e1621 (chi-install-global1163 n1617 (chi1167 e1589 r1618 w1590 mod1592)))) (begin (top-level-eval-hook1102 e1621 mod1592) e1621)) (begin (if (memq (quote eval) esew1578) (top-level-eval-hook1102 (chi-install-global1163 n1617 (chi1167 e1589 r1618 w1590 mod1592)) mod1592)) (chi-void1175)))))) (if (memv t1593 (quote (define-form))) (let ((n1622 (id-var-name1153 value1588 w1590))) (let ((type1623 (binding-type1123 (lookup1128 n1622 r1575 mod1592)))) (let ((t1624 type1623)) (if (memv t1624 (quote (global))) (let ((x1625 (build-annotated1108 s1591 (list (quote define) n1622 (chi1167 e1589 r1575 w1590 mod1592))))) (begin (if (eq? m1577 (quote c&e)) (top-level-eval-hook1102 x1625 mod1592)) x1625)) (if (memv t1624 (quote (displaced-lexical))) (syntax-error (wrap1159 value1588 w1590 mod1592) "identifier out of context") (if (memv t1624 (quote (core macro module-ref))) (begin (remove-global-definition-hook1106 n1622) (let ((x1626 (build-annotated1108 s1591 (list (quote define) n1622 (chi1167 e1589 r1575 w1590 mod1592))))) (begin (if (eq? m1577 (quote c&e)) (top-level-eval-hook1102 x1626 mod1592)) x1626))) (syntax-error (wrap1159 value1588 w1590 mod1592) "cannot define keyword at top level"))))))) (let ((x1627 (chi-expr1168 type1587 value1588 e1589 r1575 w1590 s1591 mod1592))) (begin (if (eq? m1577 (quote c&e)) (top-level-eval-hook1102 x1627 mod1592)) x1627)))))))))))) (syntax-type1165 (lambda (e1628 r1629 w1630 s1631 rib1632 mod1633) (cond ((symbol? e1628) (let ((n1634 (id-var-name1153 e1628 w1630))) (let ((b1635 (lookup1128 n1634 r1629 mod1633))) (let ((type1636 (binding-type1123 b1635))) (let ((t1637 type1636)) (if (memv t1637 (quote (lexical))) (values type1636 (binding-value1124 b1635) e1628 w1630 s1631 mod1633) (if (memv t1637 (quote (global))) (values type1636 n1634 e1628 w1630 s1631 mod1633) (if (memv t1637 (quote (macro))) (syntax-type1165 (chi-macro1170 (binding-value1124 b1635) e1628 r1629 w1630 rib1632 mod1633) r1629 (quote (())) s1631 rib1632 mod1633) (values type1636 (binding-value1124 b1635) e1628 w1630 s1631 mod1633))))))))) ((pair? e1628) (let ((first1638 (car e1628))) (if (id?1131 first1638) (let ((n1639 (id-var-name1153 first1638 w1630))) (let ((b1640 (lookup1128 n1639 r1629 (or (and (syntax-object?1115 first1638) (syntax-object-module1118 first1638)) mod1633)))) (let ((type1641 (binding-type1123 b1640))) (let ((t1642 type1641)) (if (memv t1642 (quote (lexical))) (values (quote lexical-call) (binding-value1124 b1640) e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (global))) (values (quote global-call) n1639 e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (macro))) (syntax-type1165 (chi-macro1170 (binding-value1124 b1640) e1628 r1629 w1630 rib1632 mod1633) r1629 (quote (())) s1631 rib1632 mod1633) (if (memv t1642 (quote (core external-macro module-ref))) (values type1641 (binding-value1124 b1640) e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1124 b1640) e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (begin))) (values (quote begin-form) #f e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (eval-when))) (values (quote eval-when-form) #f e1628 w1630 s1631 mod1633) (if (memv t1642 (quote (define))) ((lambda (tmp1643) ((lambda (tmp1644) (if (if tmp1644 (apply (lambda (_1645 name1646 val1647) (id?1131 name1646)) tmp1644) #f) (apply (lambda (_1648 name1649 val1650) (values (quote define-form) name1649 val1650 w1630 s1631 mod1633)) tmp1644) ((lambda (tmp1651) (if (if tmp1651 (apply (lambda (_1652 name1653 args1654 e11655 e21656) (and (id?1131 name1653) (valid-bound-ids?1156 (lambda-var-list1180 args1654)))) tmp1651) #f) (apply (lambda (_1657 name1658 args1659 e11660 e21661) (values (quote define-form) (wrap1159 name1658 w1630 mod1633) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1159 (cons args1659 (cons e11660 e21661)) w1630 mod1633)) (quote (())) s1631 mod1633)) tmp1651) ((lambda (tmp1663) (if (if tmp1663 (apply (lambda (_1664 name1665) (id?1131 name1665)) tmp1663) #f) (apply (lambda (_1666 name1667) (values (quote define-form) (wrap1159 name1667 w1630 mod1633) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1631 mod1633)) tmp1663) (syntax-error tmp1643))) (syntax-dispatch tmp1643 (quote (any any)))))) (syntax-dispatch tmp1643 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp1643 (quote (any any any))))) e1628) (if (memv t1642 (quote (define-syntax))) ((lambda (tmp1668) ((lambda (tmp1669) (if (if tmp1669 (apply (lambda (_1670 name1671 val1672) (id?1131 name1671)) tmp1669) #f) (apply (lambda (_1673 name1674 val1675) (values (quote define-syntax-form) name1674 val1675 w1630 s1631 mod1633)) tmp1669) (syntax-error tmp1668))) (syntax-dispatch tmp1668 (quote (any any any))))) e1628) (values (quote call) #f e1628 w1630 s1631 mod1633)))))))))))))) (values (quote call) #f e1628 w1630 s1631 mod1633)))) ((syntax-object?1115 e1628) (syntax-type1165 (syntax-object-expression1116 e1628) r1629 (join-wraps1150 w1630 (syntax-object-wrap1117 e1628)) #f rib1632 (or (syntax-object-module1118 e1628) mod1633))) ((annotation? e1628) (syntax-type1165 (annotation-expression e1628) r1629 w1630 (annotation-source e1628) rib1632 mod1633)) ((self-evaluating? e1628) (values (quote constant) #f e1628 w1630 s1631 mod1633)) (else (values (quote other) #f e1628 w1630 s1631 mod1633))))) (chi-when-list1164 (lambda (e1676 when-list1677 w1678) (let f1679 ((when-list1680 when-list1677) (situations1681 (quote ()))) (if (null? when-list1680) situations1681 (f1679 (cdr when-list1680) (cons (let ((x1682 (car when-list1680))) (cond ((free-id=?1154 x1682 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?1154 x1682 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?1154 x1682 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-error (wrap1159 x1682 w1678 #f) "invalid eval-when situation")))) situations1681)))))) (chi-install-global1163 (lambda (name1683 e1684) (build-annotated1108 #f (list (build-annotated1108 #f (quote install-global-transformer)) (build-data1109 #f name1683) e1684)))) (chi-top-sequence1162 (lambda (body1685 r1686 w1687 s1688 m1689 esew1690 mod1691) (build-sequence1110 s1688 (let dobody1692 ((body1693 body1685) (r1694 r1686) (w1695 w1687) (m1696 m1689) (esew1697 esew1690) (mod1698 mod1691)) (if (null? body1693) (quote ()) (let ((first1699 (chi-top1166 (car body1693) r1694 w1695 m1696 esew1697 mod1698))) (cons first1699 (dobody1692 (cdr body1693) r1694 w1695 m1696 esew1697 mod1698)))))))) (chi-sequence1161 (lambda (body1700 r1701 w1702 s1703 mod1704) (build-sequence1110 s1703 (let dobody1705 ((body1706 body1700) (r1707 r1701) (w1708 w1702) (mod1709 mod1704)) (if (null? body1706) (quote ()) (let ((first1710 (chi1167 (car body1706) r1707 w1708 mod1709))) (cons first1710 (dobody1705 (cdr body1706) r1707 w1708 mod1709)))))))) (source-wrap1160 (lambda (x1711 w1712 s1713 defmod1714) (wrap1159 (if s1713 (make-annotation x1711 s1713 #f) x1711) w1712 defmod1714))) (wrap1159 (lambda (x1715 w1716 defmod1717) (cond ((and (null? (wrap-marks1134 w1716)) (null? (wrap-subst1135 w1716))) x1715) ((syntax-object?1115 x1715) (make-syntax-object1114 (syntax-object-expression1116 x1715) (join-wraps1150 w1716 (syntax-object-wrap1117 x1715)) (syntax-object-module1118 x1715))) ((null? x1715) x1715) (else (make-syntax-object1114 x1715 w1716 defmod1717))))) (bound-id-member?1158 (lambda (x1718 list1719) (and (not (null? list1719)) (or (bound-id=?1155 x1718 (car list1719)) (bound-id-member?1158 x1718 (cdr list1719)))))) (distinct-bound-ids?1157 (lambda (ids1720) (let distinct?1721 ((ids1722 ids1720)) (or (null? ids1722) (and (not (bound-id-member?1158 (car ids1722) (cdr ids1722))) (distinct?1721 (cdr ids1722))))))) (valid-bound-ids?1156 (lambda (ids1723) (and (let all-ids?1724 ((ids1725 ids1723)) (or (null? ids1725) (and (id?1131 (car ids1725)) (all-ids?1724 (cdr ids1725))))) (distinct-bound-ids?1157 ids1723)))) (bound-id=?1155 (lambda (i1726 j1727) (if (and (syntax-object?1115 i1726) (syntax-object?1115 j1727)) (and (eq? (let ((e1728 (syntax-object-expression1116 i1726))) (if (annotation? e1728) (annotation-expression e1728) e1728)) (let ((e1729 (syntax-object-expression1116 j1727))) (if (annotation? e1729) (annotation-expression e1729) e1729))) (same-marks?1152 (wrap-marks1134 (syntax-object-wrap1117 i1726)) (wrap-marks1134 (syntax-object-wrap1117 j1727)))) (eq? (let ((e1730 i1726)) (if (annotation? e1730) (annotation-expression e1730) e1730)) (let ((e1731 j1727)) (if (annotation? e1731) (annotation-expression e1731) e1731)))))) (free-id=?1154 (lambda (i1732 j1733) (and (eq? (let ((x1734 i1732)) (let ((e1735 (if (syntax-object?1115 x1734) (syntax-object-expression1116 x1734) x1734))) (if (annotation? e1735) (annotation-expression e1735) e1735))) (let ((x1736 j1733)) (let ((e1737 (if (syntax-object?1115 x1736) (syntax-object-expression1116 x1736) x1736))) (if (annotation? e1737) (annotation-expression e1737) e1737)))) (eq? (id-var-name1153 i1732 (quote (()))) (id-var-name1153 j1733 (quote (()))))))) (id-var-name1153 (lambda (id1738 w1739) (letrec ((search-vector-rib1742 (lambda (sym1748 subst1749 marks1750 symnames1751 ribcage1752) (let ((n1753 (vector-length symnames1751))) (let f1754 ((i1755 0)) (cond ((fx=1100 i1755 n1753) (search1740 sym1748 (cdr subst1749) marks1750)) ((and (eq? (vector-ref symnames1751 i1755) sym1748) (same-marks?1152 marks1750 (vector-ref (ribcage-marks1141 ribcage1752) i1755))) (values (vector-ref (ribcage-labels1142 ribcage1752) i1755) marks1750)) (else (f1754 (fx+1098 i1755 1)))))))) (search-list-rib1741 (lambda (sym1756 subst1757 marks1758 symnames1759 ribcage1760) (let f1761 ((symnames1762 symnames1759) (i1763 0)) (cond ((null? symnames1762) (search1740 sym1756 (cdr subst1757) marks1758)) ((and (eq? (car symnames1762) sym1756) (same-marks?1152 marks1758 (list-ref (ribcage-marks1141 ribcage1760) i1763))) (values (list-ref (ribcage-labels1142 ribcage1760) i1763) marks1758)) (else (f1761 (cdr symnames1762) (fx+1098 i1763 1))))))) (search1740 (lambda (sym1764 subst1765 marks1766) (if (null? subst1765) (values #f marks1766) (let ((fst1767 (car subst1765))) (if (eq? fst1767 (quote shift)) (search1740 sym1764 (cdr subst1765) (cdr marks1766)) (let ((symnames1768 (ribcage-symnames1140 fst1767))) (if (vector? symnames1768) (search-vector-rib1742 sym1764 subst1765 marks1766 symnames1768 fst1767) (search-list-rib1741 sym1764 subst1765 marks1766 symnames1768 fst1767))))))))) (cond ((symbol? id1738) (or (call-with-values (lambda () (search1740 id1738 (wrap-subst1135 w1739) (wrap-marks1134 w1739))) (lambda (x1770 . ignore1769) x1770)) id1738)) ((syntax-object?1115 id1738) (let ((id1771 (let ((e1773 (syntax-object-expression1116 id1738))) (if (annotation? e1773) (annotation-expression e1773) e1773))) (w11772 (syntax-object-wrap1117 id1738))) (let ((marks1774 (join-marks1151 (wrap-marks1134 w1739) (wrap-marks1134 w11772)))) (call-with-values (lambda () (search1740 id1771 (wrap-subst1135 w1739) marks1774)) (lambda (new-id1775 marks1776) (or new-id1775 (call-with-values (lambda () (search1740 id1771 (wrap-subst1135 w11772) marks1776)) (lambda (x1778 . ignore1777) x1778)) id1771)))))) ((annotation? id1738) (let ((id1779 (let ((e1780 id1738)) (if (annotation? e1780) (annotation-expression e1780) e1780)))) (or (call-with-values (lambda () (search1740 id1779 (wrap-subst1135 w1739) (wrap-marks1134 w1739))) (lambda (x1782 . ignore1781) x1782)) id1779))) (else (error-hook1104 (quote id-var-name) "invalid id" id1738)))))) (same-marks?1152 (lambda (x1783 y1784) (or (eq? x1783 y1784) (and (not (null? x1783)) (not (null? y1784)) (eq? (car x1783) (car y1784)) (same-marks?1152 (cdr x1783) (cdr y1784)))))) (join-marks1151 (lambda (m11785 m21786) (smart-append1149 m11785 m21786))) (join-wraps1150 (lambda (w11787 w21788) (let ((m11789 (wrap-marks1134 w11787)) (s11790 (wrap-subst1135 w11787))) (if (null? m11789) (if (null? s11790) w21788 (make-wrap1133 (wrap-marks1134 w21788) (smart-append1149 s11790 (wrap-subst1135 w21788)))) (make-wrap1133 (smart-append1149 m11789 (wrap-marks1134 w21788)) (smart-append1149 s11790 (wrap-subst1135 w21788))))))) (smart-append1149 (lambda (m11791 m21792) (if (null? m21792) m11791 (append m11791 m21792)))) (make-binding-wrap1148 (lambda (ids1793 labels1794 w1795) (if (null? ids1793) w1795 (make-wrap1133 (wrap-marks1134 w1795) (cons (let ((labelvec1796 (list->vector labels1794))) (let ((n1797 (vector-length labelvec1796))) (let ((symnamevec1798 (make-vector n1797)) (marksvec1799 (make-vector n1797))) (begin (let f1800 ((ids1801 ids1793) (i1802 0)) (if (not (null? ids1801)) (call-with-values (lambda () (id-sym-name&marks1132 (car ids1801) w1795)) (lambda (symname1803 marks1804) (begin (vector-set! symnamevec1798 i1802 symname1803) (vector-set! marksvec1799 i1802 marks1804) (f1800 (cdr ids1801) (fx+1098 i1802 1))))))) (make-ribcage1138 symnamevec1798 marksvec1799 labelvec1796))))) (wrap-subst1135 w1795)))))) (extend-ribcage!1147 (lambda (ribcage1805 id1806 label1807) (begin (set-ribcage-symnames!1143 ribcage1805 (cons (let ((e1808 (syntax-object-expression1116 id1806))) (if (annotation? e1808) (annotation-expression e1808) e1808)) (ribcage-symnames1140 ribcage1805))) (set-ribcage-marks!1144 ribcage1805 (cons (wrap-marks1134 (syntax-object-wrap1117 id1806)) (ribcage-marks1141 ribcage1805))) (set-ribcage-labels!1145 ribcage1805 (cons label1807 (ribcage-labels1142 ribcage1805)))))) (anti-mark1146 (lambda (w1809) (make-wrap1133 (cons #f (wrap-marks1134 w1809)) (cons (quote shift) (wrap-subst1135 w1809))))) (set-ribcage-labels!1145 (lambda (x1810 update1811) (vector-set! x1810 3 update1811))) (set-ribcage-marks!1144 (lambda (x1812 update1813) (vector-set! x1812 2 update1813))) (set-ribcage-symnames!1143 (lambda (x1814 update1815) (vector-set! x1814 1 update1815))) (ribcage-labels1142 (lambda (x1816) (vector-ref x1816 3))) (ribcage-marks1141 (lambda (x1817) (vector-ref x1817 2))) (ribcage-symnames1140 (lambda (x1818) (vector-ref x1818 1))) (ribcage?1139 (lambda (x1819) (and (vector? x1819) (= (vector-length x1819) 4) (eq? (vector-ref x1819 0) (quote ribcage))))) (make-ribcage1138 (lambda (symnames1820 marks1821 labels1822) (vector (quote ribcage) symnames1820 marks1821 labels1822))) (gen-labels1137 (lambda (ls1823) (if (null? ls1823) (quote ()) (cons (gen-label1136) (gen-labels1137 (cdr ls1823)))))) (gen-label1136 (lambda () (string #\i))) (wrap-subst1135 cdr) (wrap-marks1134 car) (make-wrap1133 cons) (id-sym-name&marks1132 (lambda (x1824 w1825) (if (syntax-object?1115 x1824) (values (let ((e1826 (syntax-object-expression1116 x1824))) (if (annotation? e1826) (annotation-expression e1826) e1826)) (join-marks1151 (wrap-marks1134 w1825) (wrap-marks1134 (syntax-object-wrap1117 x1824)))) (values (let ((e1827 x1824)) (if (annotation? e1827) (annotation-expression e1827) e1827)) (wrap-marks1134 w1825))))) (id?1131 (lambda (x1828) (cond ((symbol? x1828) #t) ((syntax-object?1115 x1828) (symbol? (let ((e1829 (syntax-object-expression1116 x1828))) (if (annotation? e1829) (annotation-expression e1829) e1829)))) ((annotation? x1828) (symbol? (annotation-expression x1828))) (else #f)))) (nonsymbol-id?1130 (lambda (x1830) (and (syntax-object?1115 x1830) (symbol? (let ((e1831 (syntax-object-expression1116 x1830))) (if (annotation? e1831) (annotation-expression e1831) e1831)))))) (global-extend1129 (lambda (type1832 sym1833 val1834) (put-global-definition-hook1105 sym1833 (cons type1832 val1834)))) (lookup1128 (lambda (x1835 r1836 mod1837) (cond ((assq x1835 r1836) => cdr) ((symbol? x1835) (or (get-global-definition-hook1107 x1835 mod1837) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1127 (lambda (r1838) (if (null? r1838) (quote ()) (let ((a1839 (car r1838))) (if (eq? (cadr a1839) (quote macro)) (cons a1839 (macros-only-env1127 (cdr r1838))) (macros-only-env1127 (cdr r1838))))))) (extend-var-env1126 (lambda (labels1840 vars1841 r1842) (if (null? labels1840) r1842 (extend-var-env1126 (cdr labels1840) (cdr vars1841) (cons (cons (car labels1840) (cons (quote lexical) (car vars1841))) r1842))))) (extend-env1125 (lambda (labels1843 bindings1844 r1845) (if (null? labels1843) r1845 (extend-env1125 (cdr labels1843) (cdr bindings1844) (cons (cons (car labels1843) (car bindings1844)) r1845))))) (binding-value1124 cdr) (binding-type1123 car) (source-annotation1122 (lambda (x1846) (cond ((annotation? x1846) (annotation-source x1846)) ((syntax-object?1115 x1846) (source-annotation1122 (syntax-object-expression1116 x1846))) (else #f)))) (set-syntax-object-module!1121 (lambda (x1847 update1848) (vector-set! x1847 3 update1848))) (set-syntax-object-wrap!1120 (lambda (x1849 update1850) (vector-set! x1849 2 update1850))) (set-syntax-object-expression!1119 (lambda (x1851 update1852) (vector-set! x1851 1 update1852))) (syntax-object-module1118 (lambda (x1853) (vector-ref x1853 3))) (syntax-object-wrap1117 (lambda (x1854) (vector-ref x1854 2))) (syntax-object-expression1116 (lambda (x1855) (vector-ref x1855 1))) (syntax-object?1115 (lambda (x1856) (and (vector? x1856) (= (vector-length x1856) 4) (eq? (vector-ref x1856 0) (quote syntax-object))))) (make-syntax-object1114 (lambda (expression1857 wrap1858 module1859) (vector (quote syntax-object) expression1857 wrap1858 module1859))) (build-letrec1113 (lambda (src1860 vars1861 val-exps1862 body-exp1863) (if (null? vars1861) (build-annotated1108 src1860 body-exp1863) (build-annotated1108 src1860 (list (quote letrec) (map list vars1861 val-exps1862) body-exp1863))))) (build-named-let1112 (lambda (src1864 vars1865 val-exps1866 body-exp1867) (if (null? vars1865) (build-annotated1108 src1864 body-exp1867) (build-annotated1108 src1864 (list (quote let) (car vars1865) (map list (cdr vars1865) val-exps1866) body-exp1867))))) (build-let1111 (lambda (src1868 vars1869 val-exps1870 body-exp1871) (if (null? vars1869) (build-annotated1108 src1868 body-exp1871) (build-annotated1108 src1868 (list (quote let) (map list vars1869 val-exps1870) body-exp1871))))) (build-sequence1110 (lambda (src1872 exps1873) (if (null? (cdr exps1873)) (build-annotated1108 src1872 (car exps1873)) (build-annotated1108 src1872 (cons (quote begin) exps1873))))) (build-data1109 (lambda (src1874 exp1875) (if (and (self-evaluating? exp1875) (not (vector? exp1875))) (build-annotated1108 src1874 exp1875) (build-annotated1108 src1874 (list (quote quote) exp1875))))) (build-annotated1108 (lambda (src1876 exp1877) (if (and src1876 (not (annotation? exp1877))) (make-annotation exp1877 src1876 #t) exp1877))) (get-global-definition-hook1107 (lambda (symbol1878 module1879) (let ((module1880 (if module1879 (resolve-module (cdr module1879)) (let ((mod1881 (current-module))) (begin (if mod1881 (warn "wha" symbol1878)) mod1881))))) (let ((v1882 (module-variable module1880 symbol1878))) (and v1882 (object-property v1882 (quote *sc-expander*))))))) (remove-global-definition-hook1106 (lambda (symbol1883) (let ((module1884 (current-module))) (let ((v1885 (module-local-variable module1884 symbol1883))) (if v1885 (let ((p1886 (assq (quote *sc-expander*) (object-properties v1885)))) (set-object-properties! v1885 (delq p1886 (object-properties v1885))))))))) (put-global-definition-hook1105 (lambda (symbol1887 binding1888) (let ((module1889 (current-module))) (let ((v1890 (or (module-variable module1889 symbol1887) (let ((v1891 (make-variable (gensym)))) (begin (module-add! module1889 symbol1887 v1891) v1891))))) (begin (if (not (variable-bound? v1890)) (variable-set! v1890 (gensym))) (set-object-property! v1890 (quote *sc-expander*) binding1888)))))) (error-hook1104 (lambda (who1892 why1893 what1894) (error who1892 "~a ~s" why1893 what1894))) (local-eval-hook1103 (lambda (x1895 mod1896) (primitive-eval (list noexpand1097 x1895)))) (top-level-eval-hook1102 (lambda (x1897 mod1898) (primitive-eval (list noexpand1097 x1897)))) (fx<1101 <) (fx=1100 =) (fx-1099 -) (fx+1098 +) (noexpand1097 "noexpand")) (begin (global-extend1129 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1129 (quote local-syntax) (quote let-syntax) #f) (global-extend1129 (quote core) (quote fluid-let-syntax) (lambda (e1899 r1900 w1901 s1902 mod1903) ((lambda (tmp1904) ((lambda (tmp1905) (if (if tmp1905 (apply (lambda (_1906 var1907 val1908 e11909 e21910) (valid-bound-ids?1156 var1907)) tmp1905) #f) (apply (lambda (_1912 var1913 val1914 e11915 e21916) (let ((names1917 (map (lambda (x1918) (id-var-name1153 x1918 w1901)) var1913))) (begin (for-each (lambda (id1920 n1921) (let ((t1922 (binding-type1123 (lookup1128 n1921 r1900 mod1903)))) (if (memv t1922 (quote (displaced-lexical))) (syntax-error (source-wrap1160 id1920 w1901 s1902 mod1903) "identifier out of context")))) var1913 names1917) (chi-body1171 (cons e11915 e21916) (source-wrap1160 e1899 w1901 s1902 mod1903) (extend-env1125 names1917 (let ((trans-r1925 (macros-only-env1127 r1900))) (map (lambda (x1926) (cons (quote macro) (eval-local-transformer1174 (chi1167 x1926 trans-r1925 w1901 mod1903) mod1903))) val1914)) r1900) w1901 mod1903)))) tmp1905) ((lambda (_1928) (syntax-error (source-wrap1160 e1899 w1901 s1902 mod1903))) tmp1904))) (syntax-dispatch tmp1904 (quote (any #(each (any any)) any . each-any))))) e1899))) (global-extend1129 (quote core) (quote quote) (lambda (e1929 r1930 w1931 s1932 mod1933) ((lambda (tmp1934) ((lambda (tmp1935) (if tmp1935 (apply (lambda (_1936 e1937) (build-data1109 s1932 (strip1178 e1937 w1931))) tmp1935) ((lambda (_1938) (syntax-error (source-wrap1160 e1929 w1931 s1932 mod1933))) tmp1934))) (syntax-dispatch tmp1934 (quote (any any))))) e1929))) (global-extend1129 (quote core) (quote syntax) (letrec ((regen1946 (lambda (x1947) (let ((t1948 (car x1947))) (if (memv t1948 (quote (ref))) (build-annotated1108 #f (cadr x1947)) (if (memv t1948 (quote (primitive))) (build-annotated1108 #f (cadr x1947)) (if (memv t1948 (quote (quote))) (build-data1109 #f (cadr x1947)) (if (memv t1948 (quote (lambda))) (build-annotated1108 #f (list (quote lambda) (cadr x1947) (regen1946 (caddr x1947)))) (if (memv t1948 (quote (map))) (let ((ls1949 (map regen1946 (cdr x1947)))) (build-annotated1108 #f (cons (if (fx=1100 (length ls1949) 2) (build-annotated1108 #f (quote map)) (build-annotated1108 #f (quote map))) ls1949))) (build-annotated1108 #f (cons (build-annotated1108 #f (car x1947)) (map regen1946 (cdr x1947)))))))))))) (gen-vector1945 (lambda (x1950) (cond ((eq? (car x1950) (quote list)) (cons (quote vector) (cdr x1950))) ((eq? (car x1950) (quote quote)) (list (quote quote) (list->vector (cadr x1950)))) (else (list (quote list->vector) x1950))))) (gen-append1944 (lambda (x1951 y1952) (if (equal? y1952 (quote (quote ()))) x1951 (list (quote append) x1951 y1952)))) (gen-cons1943 (lambda (x1953 y1954) (let ((t1955 (car y1954))) (if (memv t1955 (quote (quote))) (if (eq? (car x1953) (quote quote)) (list (quote quote) (cons (cadr x1953) (cadr y1954))) (if (eq? (cadr y1954) (quote ())) (list (quote list) x1953) (list (quote cons) x1953 y1954))) (if (memv t1955 (quote (list))) (cons (quote list) (cons x1953 (cdr y1954))) (list (quote cons) x1953 y1954)))))) (gen-map1942 (lambda (e1956 map-env1957) (let ((formals1958 (map cdr map-env1957)) (actuals1959 (map (lambda (x1960) (list (quote ref) (car x1960))) map-env1957))) (cond ((eq? (car e1956) (quote ref)) (car actuals1959)) ((andmap (lambda (x1961) (and (eq? (car x1961) (quote ref)) (memq (cadr x1961) formals1958))) (cdr e1956)) (cons (quote map) (cons (list (quote primitive) (car e1956)) (map (let ((r1962 (map cons formals1958 actuals1959))) (lambda (x1963) (cdr (assq (cadr x1963) r1962)))) (cdr e1956))))) (else (cons (quote map) (cons (list (quote lambda) formals1958 e1956) actuals1959))))))) (gen-mappend1941 (lambda (e1964 map-env1965) (list (quote apply) (quote (primitive append)) (gen-map1942 e1964 map-env1965)))) (gen-ref1940 (lambda (src1966 var1967 level1968 maps1969) (if (fx=1100 level1968 0) (values var1967 maps1969) (if (null? maps1969) (syntax-error src1966 "missing ellipsis in syntax form") (call-with-values (lambda () (gen-ref1940 src1966 var1967 (fx-1099 level1968 1) (cdr maps1969))) (lambda (outer-var1970 outer-maps1971) (let ((b1972 (assq outer-var1970 (car maps1969)))) (if b1972 (values (cdr b1972) maps1969) (let ((inner-var1973 (gen-var1179 (quote tmp)))) (values inner-var1973 (cons (cons (cons outer-var1970 inner-var1973) (car maps1969)) outer-maps1971))))))))))) (gen-syntax1939 (lambda (src1974 e1975 r1976 maps1977 ellipsis?1978 mod1979) (if (id?1131 e1975) (let ((label1980 (id-var-name1153 e1975 (quote (()))))) (let ((b1981 (lookup1128 label1980 r1976 mod1979))) (if (eq? (binding-type1123 b1981) (quote syntax)) (call-with-values (lambda () (let ((var.lev1982 (binding-value1124 b1981))) (gen-ref1940 src1974 (car var.lev1982) (cdr var.lev1982) maps1977))) (lambda (var1983 maps1984) (values (list (quote ref) var1983) maps1984))) (if (ellipsis?1978 e1975) (syntax-error src1974 "misplaced ellipsis in syntax form") (values (list (quote quote) e1975) maps1977))))) ((lambda (tmp1985) ((lambda (tmp1986) (if (if tmp1986 (apply (lambda (dots1987 e1988) (ellipsis?1978 dots1987)) tmp1986) #f) (apply (lambda (dots1989 e1990) (gen-syntax1939 src1974 e1990 r1976 maps1977 (lambda (x1991) #f) mod1979)) tmp1986) ((lambda (tmp1992) (if (if tmp1992 (apply (lambda (x1993 dots1994 y1995) (ellipsis?1978 dots1994)) tmp1992) #f) (apply (lambda (x1996 dots1997 y1998) (let f1999 ((y2000 y1998) (k2001 (lambda (maps2002) (call-with-values (lambda () (gen-syntax1939 src1974 x1996 r1976 (cons (quote ()) maps2002) ellipsis?1978 mod1979)) (lambda (x2003 maps2004) (if (null? (car maps2004)) (syntax-error src1974 "extra ellipsis in syntax form") (values (gen-map1942 x2003 (car maps2004)) (cdr maps2004)))))))) ((lambda (tmp2005) ((lambda (tmp2006) (if (if tmp2006 (apply (lambda (dots2007 y2008) (ellipsis?1978 dots2007)) tmp2006) #f) (apply (lambda (dots2009 y2010) (f1999 y2010 (lambda (maps2011) (call-with-values (lambda () (k2001 (cons (quote ()) maps2011))) (lambda (x2012 maps2013) (if (null? (car maps2013)) (syntax-error src1974 "extra ellipsis in syntax form") (values (gen-mappend1941 x2012 (car maps2013)) (cdr maps2013)))))))) tmp2006) ((lambda (_2014) (call-with-values (lambda () (gen-syntax1939 src1974 y2000 r1976 maps1977 ellipsis?1978 mod1979)) (lambda (y2015 maps2016) (call-with-values (lambda () (k2001 maps2016)) (lambda (x2017 maps2018) (values (gen-append1944 x2017 y2015) maps2018)))))) tmp2005))) (syntax-dispatch tmp2005 (quote (any . any))))) y2000))) tmp1992) ((lambda (tmp2019) (if tmp2019 (apply (lambda (x2020 y2021) (call-with-values (lambda () (gen-syntax1939 src1974 x2020 r1976 maps1977 ellipsis?1978 mod1979)) (lambda (x2022 maps2023) (call-with-values (lambda () (gen-syntax1939 src1974 y2021 r1976 maps2023 ellipsis?1978 mod1979)) (lambda (y2024 maps2025) (values (gen-cons1943 x2022 y2024) maps2025)))))) tmp2019) ((lambda (tmp2026) (if tmp2026 (apply (lambda (e12027 e22028) (call-with-values (lambda () (gen-syntax1939 src1974 (cons e12027 e22028) r1976 maps1977 ellipsis?1978 mod1979)) (lambda (e2030 maps2031) (values (gen-vector1945 e2030) maps2031)))) tmp2026) ((lambda (_2032) (values (list (quote quote) e1975) maps1977)) tmp1985))) (syntax-dispatch tmp1985 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp1985 (quote (any . any)))))) (syntax-dispatch tmp1985 (quote (any any . any)))))) (syntax-dispatch tmp1985 (quote (any any))))) e1975))))) (lambda (e2033 r2034 w2035 s2036 mod2037) (let ((e2038 (source-wrap1160 e2033 w2035 s2036 mod2037))) ((lambda (tmp2039) ((lambda (tmp2040) (if tmp2040 (apply (lambda (_2041 x2042) (call-with-values (lambda () (gen-syntax1939 e2038 x2042 r2034 (quote ()) ellipsis?1176 mod2037)) (lambda (e2043 maps2044) (regen1946 e2043)))) tmp2040) ((lambda (_2045) (syntax-error e2038)) tmp2039))) (syntax-dispatch tmp2039 (quote (any any))))) e2038))))) (global-extend1129 (quote core) (quote lambda) (lambda (e2046 r2047 w2048 s2049 mod2050) ((lambda (tmp2051) ((lambda (tmp2052) (if tmp2052 (apply (lambda (_2053 c2054) (chi-lambda-clause1172 (source-wrap1160 e2046 w2048 s2049 mod2050) c2054 r2047 w2048 mod2050 (lambda (vars2055 body2056) (build-annotated1108 s2049 (list (quote lambda) vars2055 body2056))))) tmp2052) (syntax-error tmp2051))) (syntax-dispatch tmp2051 (quote (any . any))))) e2046))) (global-extend1129 (quote core) (quote let) (letrec ((chi-let2057 (lambda (e2058 r2059 w2060 s2061 mod2062 constructor2063 ids2064 vals2065 exps2066) (if (not (valid-bound-ids?1156 ids2064)) (syntax-error e2058 "duplicate bound variable in") (let ((labels2067 (gen-labels1137 ids2064)) (new-vars2068 (map gen-var1179 ids2064))) (let ((nw2069 (make-binding-wrap1148 ids2064 labels2067 w2060)) (nr2070 (extend-var-env1126 labels2067 new-vars2068 r2059))) (constructor2063 s2061 new-vars2068 (map (lambda (x2071) (chi1167 x2071 r2059 w2060 mod2062)) vals2065) (chi-body1171 exps2066 (source-wrap1160 e2058 nw2069 s2061 mod2062) nr2070 nw2069 mod2062)))))))) (lambda (e2072 r2073 w2074 s2075 mod2076) ((lambda (tmp2077) ((lambda (tmp2078) (if tmp2078 (apply (lambda (_2079 id2080 val2081 e12082 e22083) (chi-let2057 e2072 r2073 w2074 s2075 mod2076 build-let1111 id2080 val2081 (cons e12082 e22083))) tmp2078) ((lambda (tmp2087) (if (if tmp2087 (apply (lambda (_2088 f2089 id2090 val2091 e12092 e22093) (id?1131 f2089)) tmp2087) #f) (apply (lambda (_2094 f2095 id2096 val2097 e12098 e22099) (chi-let2057 e2072 r2073 w2074 s2075 mod2076 build-named-let1112 (cons f2095 id2096) val2097 (cons e12098 e22099))) tmp2087) ((lambda (_2103) (syntax-error (source-wrap1160 e2072 w2074 s2075 mod2076))) tmp2077))) (syntax-dispatch tmp2077 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2077 (quote (any #(each (any any)) any . each-any))))) e2072)))) (global-extend1129 (quote core) (quote letrec) (lambda (e2104 r2105 w2106 s2107 mod2108) ((lambda (tmp2109) ((lambda (tmp2110) (if tmp2110 (apply (lambda (_2111 id2112 val2113 e12114 e22115) (let ((ids2116 id2112)) (if (not (valid-bound-ids?1156 ids2116)) (syntax-error e2104 "duplicate bound variable in") (let ((labels2118 (gen-labels1137 ids2116)) (new-vars2119 (map gen-var1179 ids2116))) (let ((w2120 (make-binding-wrap1148 ids2116 labels2118 w2106)) (r2121 (extend-var-env1126 labels2118 new-vars2119 r2105))) (build-letrec1113 s2107 new-vars2119 (map (lambda (x2122) (chi1167 x2122 r2121 w2120 mod2108)) val2113) (chi-body1171 (cons e12114 e22115) (source-wrap1160 e2104 w2120 s2107 mod2108) r2121 w2120 mod2108))))))) tmp2110) ((lambda (_2125) (syntax-error (source-wrap1160 e2104 w2106 s2107 mod2108))) tmp2109))) (syntax-dispatch tmp2109 (quote (any #(each (any any)) any . each-any))))) e2104))) (global-extend1129 (quote core) (quote set!) (lambda (e2126 r2127 w2128 s2129 mod2130) ((lambda (tmp2131) ((lambda (tmp2132) (if (if tmp2132 (apply (lambda (_2133 id2134 val2135) (id?1131 id2134)) tmp2132) #f) (apply (lambda (_2136 id2137 val2138) (let ((val2139 (chi1167 val2138 r2127 w2128 mod2130)) (n2140 (id-var-name1153 id2137 w2128))) (let ((b2141 (lookup1128 n2140 r2127 mod2130))) (let ((t2142 (binding-type1123 b2141))) (if (memv t2142 (quote (lexical))) (build-annotated1108 s2129 (list (quote set!) (binding-value1124 b2141) val2139)) (if (memv t2142 (quote (global))) (build-annotated1108 s2129 (list (quote set!) (if mod2130 (make-module-ref (cdr mod2130) n2140 (car mod2130)) (make-module-ref mod2130 n2140 (quote bare))) val2139)) (if (memv t2142 (quote (displaced-lexical))) (syntax-error (wrap1159 id2137 w2128 mod2130) "identifier out of context") (syntax-error (source-wrap1160 e2126 w2128 s2129 mod2130))))))))) tmp2132) ((lambda (tmp2143) (if tmp2143 (apply (lambda (_2144 head2145 tail2146 val2147) (call-with-values (lambda () (syntax-type1165 head2145 r2127 (quote (())) #f #f mod2130)) (lambda (type2148 value2149 ee2150 ww2151 ss2152 modmod2153) (let ((t2154 type2148)) (if (memv t2154 (quote (module-ref))) (let ((val2155 (chi1167 val2147 r2127 w2128 mod2130))) (call-with-values (lambda () (value2149 (cons head2145 tail2146))) (lambda (id2157 mod2158) (build-annotated1108 s2129 (list (quote set!) (if mod2158 (make-module-ref (cdr mod2158) id2157 (car mod2158)) (make-module-ref mod2158 id2157 (quote bare))) val2155))))) (build-annotated1108 s2129 (cons (chi1167 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2145) r2127 w2128 mod2130) (map (lambda (e2159) (chi1167 e2159 r2127 w2128 mod2130)) (append tail2146 (list val2147)))))))))) tmp2143) ((lambda (_2161) (syntax-error (source-wrap1160 e2126 w2128 s2129 mod2130))) tmp2131))) (syntax-dispatch tmp2131 (quote (any (any . each-any) any)))))) (syntax-dispatch tmp2131 (quote (any any any))))) e2126))) (global-extend1129 (quote module-ref) (quote @) (lambda (e2162) ((lambda (tmp2163) ((lambda (tmp2164) (if (if tmp2164 (apply (lambda (_2165 mod2166 id2167) (and (andmap id?1131 mod2166) (id?1131 id2167))) tmp2164) #f) (apply (lambda (_2169 mod2170 id2171) (values (syntax-object->datum id2171) (syntax-object->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2170)))) tmp2164) (syntax-error tmp2163))) (syntax-dispatch tmp2163 (quote (any each-any any))))) e2162))) (global-extend1129 (quote module-ref) (quote @@) (lambda (e2173) ((lambda (tmp2174) ((lambda (tmp2175) (if (if tmp2175 (apply (lambda (_2176 mod2177 id2178) (and (andmap id?1131 mod2177) (id?1131 id2178))) tmp2175) #f) (apply (lambda (_2180 mod2181 id2182) (values (syntax-object->datum id2182) (syntax-object->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2181)))) tmp2175) (syntax-error tmp2174))) (syntax-dispatch tmp2174 (quote (any each-any any))))) e2173))) (global-extend1129 (quote begin) (quote begin) (quote ())) (global-extend1129 (quote define) (quote define) (quote ())) (global-extend1129 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1129 (quote eval-when) (quote eval-when) (quote ())) (global-extend1129 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2187 (lambda (x2188 keys2189 clauses2190 r2191 mod2192) (if (null? clauses2190) (build-annotated1108 #f (list (build-annotated1108 #f (quote syntax-error)) x2188)) ((lambda (tmp2193) ((lambda (tmp2194) (if tmp2194 (apply (lambda (pat2195 exp2196) (if (and (id?1131 pat2195) (andmap (lambda (x2197) (not (free-id=?1154 pat2195 x2197))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook remove-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2189))) (let ((labels2198 (list (gen-label1136))) (var2199 (gen-var1179 pat2195))) (build-annotated1108 #f (list (build-annotated1108 #f (list (quote lambda) (list var2199) (chi1167 exp2196 (extend-env1125 labels2198 (list (cons (quote syntax) (cons var2199 0))) r2191) (make-binding-wrap1148 (list pat2195) labels2198 (quote (()))) mod2192))) x2188))) (gen-clause2186 x2188 keys2189 (cdr clauses2190) r2191 pat2195 #t exp2196 mod2192))) tmp2194) ((lambda (tmp2200) (if tmp2200 (apply (lambda (pat2201 fender2202 exp2203) (gen-clause2186 x2188 keys2189 (cdr clauses2190) r2191 pat2201 fender2202 exp2203 mod2192)) tmp2200) ((lambda (_2204) (syntax-error (car clauses2190) "invalid syntax-case clause")) tmp2193))) (syntax-dispatch tmp2193 (quote (any any any)))))) (syntax-dispatch tmp2193 (quote (any any))))) (car clauses2190))))) (gen-clause2186 (lambda (x2205 keys2206 clauses2207 r2208 pat2209 fender2210 exp2211 mod2212) (call-with-values (lambda () (convert-pattern2184 pat2209 keys2206)) (lambda (p2213 pvars2214) (cond ((not (distinct-bound-ids?1157 (map car pvars2214))) (syntax-error pat2209 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (x2215) (not (ellipsis?1176 (car x2215)))) pvars2214)) (syntax-error pat2209 "misplaced ellipsis in syntax-case pattern")) (else (let ((y2216 (gen-var1179 (quote tmp)))) (build-annotated1108 #f (list (build-annotated1108 #f (list (quote lambda) (list y2216) (let ((y2217 (build-annotated1108 #f y2216))) (build-annotated1108 #f (list (quote if) ((lambda (tmp2218) ((lambda (tmp2219) (if tmp2219 (apply (lambda () y2217) tmp2219) ((lambda (_2220) (build-annotated1108 #f (list (quote if) y2217 (build-dispatch-call2185 pvars2214 fender2210 y2217 r2208 mod2212) (build-data1109 #f #f)))) tmp2218))) (syntax-dispatch tmp2218 (quote #(atom #t))))) fender2210) (build-dispatch-call2185 pvars2214 exp2211 y2217 r2208 mod2212) (gen-syntax-case2187 x2205 keys2206 clauses2207 r2208 mod2212)))))) (if (eq? p2213 (quote any)) (build-annotated1108 #f (list (build-annotated1108 #f (quote list)) x2205)) (build-annotated1108 #f (list (build-annotated1108 #f (quote syntax-dispatch)) x2205 (build-data1109 #f p2213))))))))))))) (build-dispatch-call2185 (lambda (pvars2221 exp2222 y2223 r2224 mod2225) (let ((ids2226 (map car pvars2221)) (levels2227 (map cdr pvars2221))) (let ((labels2228 (gen-labels1137 ids2226)) (new-vars2229 (map gen-var1179 ids2226))) (build-annotated1108 #f (list (build-annotated1108 #f (quote apply)) (build-annotated1108 #f (list (quote lambda) new-vars2229 (chi1167 exp2222 (extend-env1125 labels2228 (map (lambda (var2230 level2231) (cons (quote syntax) (cons var2230 level2231))) new-vars2229 (map cdr pvars2221)) r2224) (make-binding-wrap1148 ids2226 labels2228 (quote (()))) mod2225))) y2223)))))) (convert-pattern2184 (lambda (pattern2232 keys2233) (let cvt2234 ((p2235 pattern2232) (n2236 0) (ids2237 (quote ()))) (if (id?1131 p2235) (if (bound-id-member?1158 p2235 keys2233) (values (vector (quote free-id) p2235) ids2237) (values (quote any) (cons (cons p2235 n2236) ids2237))) ((lambda (tmp2238) ((lambda (tmp2239) (if (if tmp2239 (apply (lambda (x2240 dots2241) (ellipsis?1176 dots2241)) tmp2239) #f) (apply (lambda (x2242 dots2243) (call-with-values (lambda () (cvt2234 x2242 (fx+1098 n2236 1) ids2237)) (lambda (p2244 ids2245) (values (if (eq? p2244 (quote any)) (quote each-any) (vector (quote each) p2244)) ids2245)))) tmp2239) ((lambda (tmp2246) (if tmp2246 (apply (lambda (x2247 y2248) (call-with-values (lambda () (cvt2234 y2248 n2236 ids2237)) (lambda (y2249 ids2250) (call-with-values (lambda () (cvt2234 x2247 n2236 ids2250)) (lambda (x2251 ids2252) (values (cons x2251 y2249) ids2252)))))) tmp2246) ((lambda (tmp2253) (if tmp2253 (apply (lambda () (values (quote ()) ids2237)) tmp2253) ((lambda (tmp2254) (if tmp2254 (apply (lambda (x2255) (call-with-values (lambda () (cvt2234 x2255 n2236 ids2237)) (lambda (p2257 ids2258) (values (vector (quote vector) p2257) ids2258)))) tmp2254) ((lambda (x2259) (values (vector (quote atom) (strip1178 p2235 (quote (())))) ids2237)) tmp2238))) (syntax-dispatch tmp2238 (quote #(vector each-any)))))) (syntax-dispatch tmp2238 (quote ()))))) (syntax-dispatch tmp2238 (quote (any . any)))))) (syntax-dispatch tmp2238 (quote (any any))))) p2235)))))) (lambda (e2260 r2261 w2262 s2263 mod2264) (let ((e2265 (source-wrap1160 e2260 w2262 s2263 mod2264))) ((lambda (tmp2266) ((lambda (tmp2267) (if tmp2267 (apply (lambda (_2268 val2269 key2270 m2271) (if (andmap (lambda (x2272) (and (id?1131 x2272) (not (ellipsis?1176 x2272)))) key2270) (let ((x2274 (gen-var1179 (quote tmp)))) (build-annotated1108 s2263 (list (build-annotated1108 #f (list (quote lambda) (list x2274) (gen-syntax-case2187 (build-annotated1108 #f x2274) key2270 m2271 r2261 mod2264))) (chi1167 val2269 r2261 (quote (())) mod2264)))) (syntax-error e2265 "invalid literals list in"))) tmp2267) (syntax-error tmp2266))) (syntax-dispatch tmp2266 (quote (any any each-any . each-any))))) e2265))))) (set! sc-expand (let ((m2277 (quote e)) (esew2278 (quote (eval)))) (lambda (x2279) (if (and (pair? x2279) (equal? (car x2279) noexpand1097)) (cadr x2279) (chi-top1166 x2279 (quote ()) (quote ((top))) m2277 esew2278 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2280 (quote e)) (esew2281 (quote (eval)))) (lambda (x2283 . rest2282) (if (and (pair? x2283) (equal? (car x2283) noexpand1097)) (cadr x2283) (chi-top1166 x2283 (quote ()) (quote ((top))) (if (null? rest2282) m2280 (car rest2282)) (if (or (null? rest2282) (null? (cdr rest2282))) esew2281 (cadr rest2282)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2284) (nonsymbol-id?1130 x2284))) (set! datum->syntax-object (lambda (id2285 datum2286) (make-syntax-object1114 datum2286 (syntax-object-wrap1117 id2285) #f))) (set! syntax-object->datum (lambda (x2287) (strip1178 x2287 (quote (()))))) (set! generate-temporaries (lambda (ls2288) (begin (let ((x2289 ls2288)) (if (not (list? x2289)) (error-hook1104 (quote generate-temporaries) "invalid argument" x2289))) (map (lambda (x2290) (wrap1159 (gensym) (quote ((top))) #f)) ls2288)))) (set! free-identifier=? (lambda (x2291 y2292) (begin (let ((x2293 x2291)) (if (not (nonsymbol-id?1130 x2293)) (error-hook1104 (quote free-identifier=?) "invalid argument" x2293))) (let ((x2294 y2292)) (if (not (nonsymbol-id?1130 x2294)) (error-hook1104 (quote free-identifier=?) "invalid argument" x2294))) (free-id=?1154 x2291 y2292)))) (set! bound-identifier=? (lambda (x2295 y2296) (begin (let ((x2297 x2295)) (if (not (nonsymbol-id?1130 x2297)) (error-hook1104 (quote bound-identifier=?) "invalid argument" x2297))) (let ((x2298 y2296)) (if (not (nonsymbol-id?1130 x2298)) (error-hook1104 (quote bound-identifier=?) "invalid argument" x2298))) (bound-id=?1155 x2295 y2296)))) (set! syntax-error (lambda (object2300 . messages2299) (begin (for-each (lambda (x2301) (let ((x2302 x2301)) (if (not (string? x2302)) (error-hook1104 (quote syntax-error) "invalid argument" x2302)))) messages2299) (let ((message2303 (if (null? messages2299) "invalid syntax" (apply string-append messages2299)))) (error-hook1104 #f message2303 (strip1178 object2300 (quote (())))))))) (set! install-global-transformer (lambda (sym2304 v2305) (begin (let ((x2306 sym2304)) (if (not (symbol? x2306)) (error-hook1104 (quote define-syntax) "invalid argument" x2306))) (let ((x2307 v2305)) (if (not (procedure? x2307)) (error-hook1104 (quote define-syntax) "invalid argument" x2307))) (global-extend1129 (quote macro) sym2304 v2305)))) (letrec ((match2312 (lambda (e2313 p2314 w2315 r2316 mod2317) (cond ((not r2316) #f) ((eq? p2314 (quote any)) (cons (wrap1159 e2313 w2315 mod2317) r2316)) ((syntax-object?1115 e2313) (match*2311 (let ((e2318 (syntax-object-expression1116 e2313))) (if (annotation? e2318) (annotation-expression e2318) e2318)) p2314 (join-wraps1150 w2315 (syntax-object-wrap1117 e2313)) r2316 (syntax-object-module1118 e2313))) (else (match*2311 (let ((e2319 e2313)) (if (annotation? e2319) (annotation-expression e2319) e2319)) p2314 w2315 r2316 mod2317))))) (match*2311 (lambda (e2320 p2321 w2322 r2323 mod2324) (cond ((null? p2321) (and (null? e2320) r2323)) ((pair? p2321) (and (pair? e2320) (match2312 (car e2320) (car p2321) w2322 (match2312 (cdr e2320) (cdr p2321) w2322 r2323 mod2324) mod2324))) ((eq? p2321 (quote each-any)) (let ((l2325 (match-each-any2309 e2320 w2322 mod2324))) (and l2325 (cons l2325 r2323)))) (else (let ((t2326 (vector-ref p2321 0))) (if (memv t2326 (quote (each))) (if (null? e2320) (match-empty2310 (vector-ref p2321 1) r2323) (let ((l2327 (match-each2308 e2320 (vector-ref p2321 1) w2322 mod2324))) (and l2327 (let collect2328 ((l2329 l2327)) (if (null? (car l2329)) r2323 (cons (map car l2329) (collect2328 (map cdr l2329)))))))) (if (memv t2326 (quote (free-id))) (and (id?1131 e2320) (free-id=?1154 (wrap1159 e2320 w2322 mod2324) (vector-ref p2321 1)) r2323) (if (memv t2326 (quote (atom))) (and (equal? (vector-ref p2321 1) (strip1178 e2320 w2322)) r2323) (if (memv t2326 (quote (vector))) (and (vector? e2320) (match2312 (vector->list e2320) (vector-ref p2321 1) w2322 r2323 mod2324))))))))))) (match-empty2310 (lambda (p2330 r2331) (cond ((null? p2330) r2331) ((eq? p2330 (quote any)) (cons (quote ()) r2331)) ((pair? p2330) (match-empty2310 (car p2330) (match-empty2310 (cdr p2330) r2331))) ((eq? p2330 (quote each-any)) (cons (quote ()) r2331)) (else (let ((t2332 (vector-ref p2330 0))) (if (memv t2332 (quote (each))) (match-empty2310 (vector-ref p2330 1) r2331) (if (memv t2332 (quote (free-id atom))) r2331 (if (memv t2332 (quote (vector))) (match-empty2310 (vector-ref p2330 1) r2331))))))))) (match-each-any2309 (lambda (e2333 w2334 mod2335) (cond ((annotation? e2333) (match-each-any2309 (annotation-expression e2333) w2334 mod2335)) ((pair? e2333) (let ((l2336 (match-each-any2309 (cdr e2333) w2334 mod2335))) (and l2336 (cons (wrap1159 (car e2333) w2334 mod2335) l2336)))) ((null? e2333) (quote ())) ((syntax-object?1115 e2333) (match-each-any2309 (syntax-object-expression1116 e2333) (join-wraps1150 w2334 (syntax-object-wrap1117 e2333)) mod2335)) (else #f)))) (match-each2308 (lambda (e2337 p2338 w2339 mod2340) (cond ((annotation? e2337) (match-each2308 (annotation-expression e2337) p2338 w2339 mod2340)) ((pair? e2337) (let ((first2341 (match2312 (car e2337) p2338 w2339 (quote ()) mod2340))) (and first2341 (let ((rest2342 (match-each2308 (cdr e2337) p2338 w2339 mod2340))) (and rest2342 (cons first2341 rest2342)))))) ((null? e2337) (quote ())) ((syntax-object?1115 e2337) (match-each2308 (syntax-object-expression1116 e2337) p2338 (join-wraps1150 w2339 (syntax-object-wrap1117 e2337)) (syntax-object-module1118 e2337))) (else #f))))) (begin (set! syntax-dispatch (lambda (e2343 p2344) (cond ((eq? p2344 (quote any)) (list e2343)) ((syntax-object?1115 e2343) (match*2311 (let ((e2345 (syntax-object-expression1116 e2343))) (if (annotation? e2345) (annotation-expression e2345) e2345)) p2344 (syntax-object-wrap1117 e2343) (quote ()) (syntax-object-module1118 e2343))) (else (match*2311 (let ((e2346 e2343)) (if (annotation? e2346) (annotation-expression e2346) e2346)) p2344 (quote (())) (quote ()) #f))))) (set! sc-chi chi1167)))))
+(install-global-transformer (quote with-syntax) (lambda (x2347) ((lambda (tmp2348) ((lambda (tmp2349) (if tmp2349 (apply (lambda (_2350 e12351 e22352) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12351 e22352))) tmp2349) ((lambda (tmp2354) (if tmp2354 (apply (lambda (_2355 out2356 in2357 e12358 e22359) (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))) in2357 (quote ()) (list out2356 (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 e12358 e22359))))) tmp2354) ((lambda (tmp2361) (if tmp2361 (apply (lambda (_2362 out2363 in2364 e12365 e22366) (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))) in2364) (quote ()) (list out2363 (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 e12365 e22366))))) tmp2361) (syntax-error tmp2348))) (syntax-dispatch tmp2348 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp2348 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp2348 (quote (any () any . each-any))))) x2347)))
+(install-global-transformer (quote syntax-rules) (lambda (x2370) ((lambda (tmp2371) ((lambda (tmp2372) (if tmp2372 (apply (lambda (_2373 k2374 keyword2375 pattern2376 template2377) (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 k2374 (map (lambda (tmp2380 tmp2379) (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))) tmp2379) (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))) tmp2380))) template2377 pattern2376)))))) tmp2372) (syntax-error tmp2371))) (syntax-dispatch tmp2371 (quote (any each-any . #(each ((any . any) any))))))) x2370)))
+(install-global-transformer (quote let*) (lambda (x2381) ((lambda (tmp2382) ((lambda (tmp2383) (if (if tmp2383 (apply (lambda (let*2384 x2385 v2386 e12387 e22388) (andmap identifier? x2385)) tmp2383) #f) (apply (lambda (let*2390 x2391 v2392 e12393 e22394) (let f2395 ((bindings2396 (map list x2391 v2392))) (if (null? bindings2396) (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 e12393 e22394))) ((lambda (tmp2400) ((lambda (tmp2401) (if tmp2401 (apply (lambda (body2402 binding2403) (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 binding2403) body2402)) tmp2401) (syntax-error tmp2400))) (syntax-dispatch tmp2400 (quote (any any))))) (list (f2395 (cdr bindings2396)) (car bindings2396)))))) tmp2383) (syntax-error tmp2382))) (syntax-dispatch tmp2382 (quote (any #(each (any any)) any . each-any))))) x2381)))
+(install-global-transformer (quote do) (lambda (orig-x2404) ((lambda (tmp2405) ((lambda (tmp2406) (if tmp2406 (apply (lambda (_2407 var2408 init2409 step2410 e02411 e12412 c2413) ((lambda (tmp2414) ((lambda (tmp2415) (if tmp2415 (apply (lambda (step2416) ((lambda (tmp2417) ((lambda (tmp2418) (if tmp2418 (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 var2408 init2409) (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))) e02411) (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 c2413 (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))) step2416))))))) tmp2418) ((lambda (tmp2423) (if tmp2423 (apply (lambda (e12424 e22425) (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 var2408 init2409) (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))) e02411 (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 e12424 e22425)) (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 c2413 (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))) step2416))))))) tmp2423) (syntax-error tmp2417))) (syntax-dispatch tmp2417 (quote (any . each-any)))))) (syntax-dispatch tmp2417 (quote ())))) e12412)) tmp2415) (syntax-error tmp2414))) (syntax-dispatch tmp2414 (quote each-any)))) (map (lambda (v2432 s2433) ((lambda (tmp2434) ((lambda (tmp2435) (if tmp2435 (apply (lambda () v2432) tmp2435) ((lambda (tmp2436) (if tmp2436 (apply (lambda (e2437) e2437) tmp2436) ((lambda (_2438) (syntax-error orig-x2404)) tmp2434))) (syntax-dispatch tmp2434 (quote (any)))))) (syntax-dispatch tmp2434 (quote ())))) s2433)) var2408 step2410))) tmp2406) (syntax-error tmp2405))) (syntax-dispatch tmp2405 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2404)))
+(install-global-transformer (quote quasiquote) (letrec ((quasicons2441 (lambda (x2445 y2446) ((lambda (tmp2447) ((lambda (tmp2448) (if tmp2448 (apply (lambda (x2449 y2450) ((lambda (tmp2451) ((lambda (tmp2452) (if tmp2452 (apply (lambda (dy2453) ((lambda (tmp2454) ((lambda (tmp2455) (if tmp2455 (apply (lambda (dx2456) (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 dx2456 dy2453))) tmp2455) ((lambda (_2457) (if (null? dy2453) (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))) x2449) (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))) x2449 y2450))) tmp2454))) (syntax-dispatch tmp2454 (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))))) x2449)) tmp2452) ((lambda (tmp2458) (if tmp2458 (apply (lambda (stuff2459) (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 x2449 stuff2459))) tmp2458) ((lambda (else2460) (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))) x2449 y2450)) tmp2451))) (syntax-dispatch tmp2451 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) (syntax-dispatch tmp2451 (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))))) y2450)) tmp2448) (syntax-error tmp2447))) (syntax-dispatch tmp2447 (quote (any any))))) (list x2445 y2446)))) (quasiappend2442 (lambda (x2461 y2462) ((lambda (tmp2463) ((lambda (tmp2464) (if tmp2464 (apply (lambda (x2465 y2466) ((lambda (tmp2467) ((lambda (tmp2468) (if tmp2468 (apply (lambda () x2465) tmp2468) ((lambda (_2469) (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))) x2465 y2466)) tmp2467))) (syntax-dispatch tmp2467 (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))) ()))))) y2466)) tmp2464) (syntax-error tmp2463))) (syntax-dispatch tmp2463 (quote (any any))))) (list x2461 y2462)))) (quasivector2443 (lambda (x2470) ((lambda (tmp2471) ((lambda (x2472) ((lambda (tmp2473) ((lambda (tmp2474) (if tmp2474 (apply (lambda (x2475) (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 x2475))) tmp2474) ((lambda (tmp2477) (if tmp2477 (apply (lambda (x2478) (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))) x2478)) tmp2477) ((lambda (_2480) (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))) x2472)) tmp2473))) (syntax-dispatch tmp2473 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) (syntax-dispatch tmp2473 (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))))) x2472)) tmp2471)) x2470))) (quasi2444 (lambda (p2481 lev2482) ((lambda (tmp2483) ((lambda (tmp2484) (if tmp2484 (apply (lambda (p2485) (if (= lev2482 0) p2485 (quasicons2441 (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)))) (quasi2444 (list p2485) (- lev2482 1))))) tmp2484) ((lambda (tmp2486) (if tmp2486 (apply (lambda (p2487 q2488) (if (= lev2482 0) (quasiappend2442 p2487 (quasi2444 q2488 lev2482)) (quasicons2441 (quasicons2441 (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)))) (quasi2444 (list p2487) (- lev2482 1))) (quasi2444 q2488 lev2482)))) tmp2486) ((lambda (tmp2489) (if tmp2489 (apply (lambda (p2490) (quasicons2441 (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)))) (quasi2444 (list p2490) (+ lev2482 1)))) tmp2489) ((lambda (tmp2491) (if tmp2491 (apply (lambda (p2492 q2493) (quasicons2441 (quasi2444 p2492 lev2482) (quasi2444 q2493 lev2482))) tmp2491) ((lambda (tmp2494) (if tmp2494 (apply (lambda (x2495) (quasivector2443 (quasi2444 x2495 lev2482))) tmp2494) ((lambda (p2497) (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))) p2497)) tmp2483))) (syntax-dispatch tmp2483 (quote #(vector each-any)))))) (syntax-dispatch tmp2483 (quote (any . any)))))) (syntax-dispatch tmp2483 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) (syntax-dispatch tmp2483 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) (syntax-dispatch tmp2483 (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))))) p2481)))) (lambda (x2498) ((lambda (tmp2499) ((lambda (tmp2500) (if tmp2500 (apply (lambda (_2501 e2502) (quasi2444 e2502 0)) tmp2500) (syntax-error tmp2499))) (syntax-dispatch tmp2499 (quote (any any))))) x2498))))
+(install-global-transformer (quote include) (lambda (x2503) (letrec ((read-file2504 (lambda (fn2505 k2506) (let ((p2507 (open-input-file fn2505))) (let f2508 ((x2509 (read p2507))) (if (eof-object? x2509) (begin (close-input-port p2507) (quote ())) (cons (datum->syntax-object k2506 x2509) (f2508 (read p2507))))))))) ((lambda (tmp2510) ((lambda (tmp2511) (if tmp2511 (apply (lambda (k2512 filename2513) (let ((fn2514 (syntax-object->datum filename2513))) ((lambda (tmp2515) ((lambda (tmp2516) (if tmp2516 (apply (lambda (exp2517) (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))) exp2517)) tmp2516) (syntax-error tmp2515))) (syntax-dispatch tmp2515 (quote each-any)))) (read-file2504 fn2514 k2512)))) tmp2511) (syntax-error tmp2510))) (syntax-dispatch tmp2510 (quote (any any))))) x2503))))
+(install-global-transformer (quote unquote) (lambda (x2519) ((lambda (tmp2520) ((lambda (tmp2521) (if tmp2521 (apply (lambda (_2522 e2523) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum e2523))) tmp2521) (syntax-error tmp2520))) (syntax-dispatch tmp2520 (quote (any any))))) x2519)))
+(install-global-transformer (quote unquote-splicing) (lambda (x2524) ((lambda (tmp2525) ((lambda (tmp2526) (if tmp2526 (apply (lambda (_2527 e2528) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum e2528))) tmp2526) (syntax-error tmp2525))) (syntax-dispatch tmp2525 (quote (any any))))) x2524)))
+(install-global-transformer (quote case) (lambda (x2529) ((lambda (tmp2530) ((lambda (tmp2531) (if tmp2531 (apply (lambda (_2532 e2533 m12534 m22535) ((lambda (tmp2536) ((lambda (body2537) (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))) e2533)) body2537)) tmp2536)) (let f2538 ((clause2539 m12534) (clauses2540 m22535)) (if (null? clauses2540) ((lambda (tmp2542) ((lambda (tmp2543) (if tmp2543 (apply (lambda (e12544 e22545) (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 e12544 e22545))) tmp2543) ((lambda (tmp2547) (if tmp2547 (apply (lambda (k2548 e12549 e22550) (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))) k2548)) (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 e12549 e22550)))) tmp2547) ((lambda (_2553) (syntax-error x2529)) tmp2542))) (syntax-dispatch tmp2542 (quote (each-any any . each-any)))))) (syntax-dispatch tmp2542 (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))))) clause2539) ((lambda (tmp2554) ((lambda (rest2555) ((lambda (tmp2556) ((lambda (tmp2557) (if tmp2557 (apply (lambda (k2558 e12559 e22560) (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))) k2558)) (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 e12559 e22560)) rest2555)) tmp2557) ((lambda (_2563) (syntax-error x2529)) tmp2556))) (syntax-dispatch tmp2556 (quote (each-any any . each-any))))) clause2539)) tmp2554)) (f2538 (car clauses2540) (cdr clauses2540))))))) tmp2531) (syntax-error tmp2530))) (syntax-dispatch tmp2530 (quote (any any any . each-any))))) x2529)))
+(install-global-transformer (quote identifier-syntax) (lambda (x2564) ((lambda (tmp2565) ((lambda (tmp2566) (if tmp2566 (apply (lambda (_2567 e2568) (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))) e2568)) (list (cons _2567 (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 e2568 (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)))))))))) tmp2566) (syntax-error tmp2565))) (syntax-dispatch tmp2565 (quote (any any))))) x2564)))

diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 72a3c3f..e6eaf93 100644 (file)
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1206,7 +1206,14 @@
                                    (if rib
                                        (cons rib (cons 'shift s))
                                        (cons 'shift s)))
-                        (cons 'hygiene (module-name (procedure-module p)))))))) ;; hither the hygiene
+                        (let ((pmod (procedure-module p)))
+                          (if pmod
+                              ;; hither the hygiene
+                              (cons 'hygiene (module-name pmod))
+                              ;; but it's possible for the proc to have
+                              ;; no mod, if it was made before modules
+                              ;; were booted
+                              '(hygiene guile))))))))
               ((vector? x)
                (let* ((n (vector-length x)) (v (make-vector n)))
                  (do ((i 0 (fx+ i 1)))