-(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"))) (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 (cond ((not mod1547) (make-module-ref mod1547 id1546 (quote bare))) ((not (car mod1547)) (make-module-ref (cdr mod1547) id1546 (quote public))) ((memq (car mod1547) (quote (bare public private hygiene))) (make-module-ref (cdr mod1547) id1546 (car mod1547))) (else (make-module-ref mod1547 id1546 (quote private))))))) (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)) (cond ((not (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))) ((not (car (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 (quote public))) ((memq (car (if (syntax-object?1115 (car e1540)) (syntax-object-module1118 (car e1540)) mod1544)) (quote (bare public private hygiene))) (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)))) (else (make-module-ref (if (syntax-object?1115 (car e1540)) (syntax-object-module1118 (car e1540)) mod1544) value1539 (quote private))))) 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 (cond ((not mod1544) (make-module-ref mod1544 value1539 (quote bare))) ((not (car mod1544)) (make-module-ref (cdr mod1544) value1539 (quote public))) ((memq (car mod1544) (quote (bare public private hygiene))) (make-module-ref (cdr mod1544) value1539 (car mod1544))) (else (make-module-ref mod1544 value1539 (quote private))))) (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"))) (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"))) (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"))) (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"))) (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"))) (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 (if (memq (car module1878) (quote (#f hygiene public private bare))) (cdr module1878) module1878)) (let ((mod1880 (current-module))) (begin (if mod1880 (warn "wha" symbol1877)) mod1880))))) (let ((v1881 (module-variable module1879 symbol1877))) (and v1881 (or (object-property v1881 (quote *sc-expander*)) (and (variable-bound? v1881) (macro? (variable-ref v1881)) (macro-transformer (variable-ref v1881)) guile-macro))))))) (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!) (cond ((not mod2129) (make-module-ref mod2129 n2139 (quote bare))) ((not (car mod2129)) (make-module-ref (cdr mod2129) n2139 (quote public))) ((memq (car mod2129) (quote (bare public private hygiene))) (make-module-ref (cdr mod2129) n2139 (car mod2129))) (else (make-module-ref mod2129 n2139 (quote private)))) 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!) (cond ((not mod2157) (make-module-ref mod2157 id2156 (quote bare))) ((not (car mod2157)) (make-module-ref (cdr mod2157) id2156 (quote public))) ((memq (car mod2157) (quote (bare public private hygiene))) (make-module-ref (cdr mod2157) id2156 (car mod2157))) (else (make-module-ref mod2157 id2156 (quote private)))) 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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (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"))) (guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) e2567)) (list (cons _2566 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile))) (cons e2567 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (guile)))))))))) tmp2565) (syntax-error tmp2564))) (syntax-dispatch tmp2564 (quote (any any))))) x2563)))
+(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
+(void)
+(letrec ((lambda-var-list1261 (lambda (vars1466) (let lvl1467 ((vars1468 vars1466) (ls1469 (quote ())) (w1470 (quote (())))) (cond ((pair? vars1468) (lvl1467 (cdr vars1468) (cons (wrap1240 (car vars1468) w1470 #f) ls1469) w1470)) ((id?1212 vars1468) (cons (wrap1240 vars1468 w1470 #f) ls1469)) ((null? vars1468) ls1469) ((syntax-object?1196 vars1468) (lvl1467 (syntax-object-expression1197 vars1468) ls1469 (join-wraps1231 w1470 (syntax-object-wrap1198 vars1468)))) ((annotation? vars1468) (lvl1467 (annotation-expression vars1468) ls1469 w1470)) (else (cons vars1468 ls1469)))))) (gen-var1260 (lambda (id1471) (let ((id1472 (if (syntax-object?1196 id1471) (syntax-object-expression1197 id1471) id1471))) (if (annotation? id1472) (build-annotated1189 (annotation-source id1472) (gensym (symbol->string (annotation-expression id1472)))) (build-annotated1189 #f (gensym (symbol->string id1472))))))) (strip1259 (lambda (x1473 w1474) (if (memq (quote top) (wrap-marks1215 w1474)) (if (or (annotation? x1473) (and (pair? x1473) (annotation? (car x1473)))) (strip-annotation1258 x1473 #f) x1473) (let f1475 ((x1476 x1473)) (cond ((syntax-object?1196 x1476) (strip1259 (syntax-object-expression1197 x1476) (syntax-object-wrap1198 x1476))) ((pair? x1476) (let ((a1477 (f1475 (car x1476))) (d1478 (f1475 (cdr x1476)))) (if (and (eq? a1477 (car x1476)) (eq? d1478 (cdr x1476))) x1476 (cons a1477 d1478)))) ((vector? x1476) (let ((old1479 (vector->list x1476))) (let ((new1480 (map f1475 old1479))) (if (andmap eq? old1479 new1480) x1476 (list->vector new1480))))) (else x1476)))))) (strip-annotation1258 (lambda (x1481 parent1482) (cond ((pair? x1481) (let ((new1483 (cons #f #f))) (begin (if parent1482 (set-annotation-stripped! parent1482 new1483)) (set-car! new1483 (strip-annotation1258 (car x1481) #f)) (set-cdr! new1483 (strip-annotation1258 (cdr x1481) #f)) new1483))) ((annotation? x1481) (or (annotation-stripped x1481) (strip-annotation1258 (annotation-expression x1481) x1481))) ((vector? x1481) (let ((new1484 (make-vector (vector-length x1481)))) (begin (if parent1482 (set-annotation-stripped! parent1482 new1484)) (let loop1485 ((i1486 (- (vector-length x1481) 1))) (unless (fx<1183 i1486 0) (vector-set! new1484 i1486 (strip-annotation1258 (vector-ref x1481 i1486) #f)) (loop1485 (fx-1181 i1486 1)))) new1484))) (else x1481)))) (ellipsis?1257 (lambda (x1487) (and (nonsymbol-id?1211 x1487) (free-id=?1235 x1487 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))))))) (chi-void1256 (lambda () (build-annotated1189 #f (list (build-annotated1189 #f (quote void)))))) (eval-local-transformer1255 (lambda (expanded1488 mod1489) (let ((p1490 (local-eval-hook1185 expanded1488 mod1489))) (if (procedure? p1490) p1490 (syntax-violation #f "nonprocedure transformer" p1490))))) (chi-local-syntax1254 (lambda (rec?1491 e1492 r1493 w1494 s1495 mod1496 k1497) ((lambda (tmp1498) ((lambda (tmp1499) (if tmp1499 (apply (lambda (_1500 id1501 val1502 e11503 e21504) (let ((ids1505 id1501)) (if (not (valid-bound-ids?1237 ids1505)) (syntax-violation #f "duplicate bound keyword" e1492) (let ((labels1507 (gen-labels1218 ids1505))) (let ((new-w1508 (make-binding-wrap1229 ids1505 labels1507 w1494))) (k1497 (cons e11503 e21504) (extend-env1206 labels1507 (let ((w1510 (if rec?1491 new-w1508 w1494)) (trans-r1511 (macros-only-env1208 r1493))) (map (lambda (x1512) (cons (quote macro) (eval-local-transformer1255 (chi1248 x1512 trans-r1511 w1510 mod1496) mod1496))) val1502)) r1493) new-w1508 s1495 mod1496)))))) tmp1499) ((lambda (_1514) (syntax-violation #f "bad local syntax definition" (source-wrap1241 e1492 w1494 s1495 mod1496))) tmp1498))) ($sc-dispatch tmp1498 (quote (any #(each (any any)) any . each-any))))) e1492))) (chi-lambda-clause1253 (lambda (e1515 docstring1516 c1517 r1518 w1519 mod1520 k1521) ((lambda (tmp1522) ((lambda (tmp1523) (if (if tmp1523 (apply (lambda (args1524 doc1525 e11526 e21527) (and (string? (syntax->datum doc1525)) (not docstring1516))) tmp1523) #f) (apply (lambda (args1528 doc1529 e11530 e21531) (chi-lambda-clause1253 e1515 doc1529 (cons args1528 (cons e11530 e21531)) r1518 w1519 mod1520 k1521)) tmp1523) ((lambda (tmp1533) (if tmp1533 (apply (lambda (id1534 e11535 e21536) (let ((ids1537 id1534)) (if (not (valid-bound-ids?1237 ids1537)) (syntax-violation (quote lambda) "invalid parameter list" e1515) (let ((labels1539 (gen-labels1218 ids1537)) (new-vars1540 (map gen-var1260 ids1537))) (k1521 new-vars1540 docstring1516 (chi-body1252 (cons e11535 e21536) e1515 (extend-var-env1207 labels1539 new-vars1540 r1518) (make-binding-wrap1229 ids1537 labels1539 w1519) mod1520)))))) tmp1533) ((lambda (tmp1542) (if tmp1542 (apply (lambda (ids1543 e11544 e21545) (let ((old-ids1546 (lambda-var-list1261 ids1543))) (if (not (valid-bound-ids?1237 old-ids1546)) (syntax-violation (quote lambda) "invalid parameter list" e1515) (let ((labels1547 (gen-labels1218 old-ids1546)) (new-vars1548 (map gen-var1260 old-ids1546))) (k1521 (let f1549 ((ls11550 (cdr new-vars1548)) (ls21551 (car new-vars1548))) (if (null? ls11550) ls21551 (f1549 (cdr ls11550) (cons (car ls11550) ls21551)))) docstring1516 (chi-body1252 (cons e11544 e21545) e1515 (extend-var-env1207 labels1547 new-vars1548 r1518) (make-binding-wrap1229 old-ids1546 labels1547 w1519) mod1520)))))) tmp1542) ((lambda (_1553) (syntax-violation (quote lambda) "bad lambda" e1515)) tmp1522))) ($sc-dispatch tmp1522 (quote (any any . each-any)))))) ($sc-dispatch tmp1522 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1522 (quote (any any any . each-any))))) c1517))) (chi-body1252 (lambda (body1554 outer-form1555 r1556 w1557 mod1558) (let ((r1559 (cons (quote ("placeholder" placeholder)) r1556))) (let ((ribcage1560 (make-ribcage1219 (quote ()) (quote ()) (quote ())))) (let ((w1561 (make-wrap1214 (wrap-marks1215 w1557) (cons ribcage1560 (wrap-subst1216 w1557))))) (let parse1562 ((body1563 (map (lambda (x1569) (cons r1559 (wrap1240 x1569 w1561 mod1558))) body1554)) (ids1564 (quote ())) (labels1565 (quote ())) (vars1566 (quote ())) (vals1567 (quote ())) (bindings1568 (quote ()))) (if (null? body1563) (syntax-violation #f "no expressions in body" outer-form1555) (let ((e1570 (cdar body1563)) (er1571 (caar body1563))) (call-with-values (lambda () (syntax-type1246 e1570 er1571 (quote (())) #f ribcage1560 mod1558)) (lambda (type1572 value1573 e1574 w1575 s1576 mod1577) (let ((t1578 type1572)) (if (memv t1578 (quote (define-form))) (let ((id1579 (wrap1240 value1573 w1575 mod1577)) (label1580 (gen-label1217))) (let ((var1581 (gen-var1260 id1579))) (begin (extend-ribcage!1228 ribcage1560 id1579 label1580) (parse1562 (cdr body1563) (cons id1579 ids1564) (cons label1580 labels1565) (cons var1581 vars1566) (cons (cons er1571 (wrap1240 e1574 w1575 mod1577)) vals1567) (cons (cons (quote lexical) var1581) bindings1568))))) (if (memv t1578 (quote (define-syntax-form))) (let ((id1582 (wrap1240 value1573 w1575 mod1577)) (label1583 (gen-label1217))) (begin (extend-ribcage!1228 ribcage1560 id1582 label1583) (parse1562 (cdr body1563) (cons id1582 ids1564) (cons label1583 labels1565) vars1566 vals1567 (cons (cons (quote macro) (cons er1571 (wrap1240 e1574 w1575 mod1577))) bindings1568)))) (if (memv t1578 (quote (begin-form))) ((lambda (tmp1584) ((lambda (tmp1585) (if tmp1585 (apply (lambda (_1586 e11587) (parse1562 (let f1588 ((forms1589 e11587)) (if (null? forms1589) (cdr body1563) (cons (cons er1571 (wrap1240 (car forms1589) w1575 mod1577)) (f1588 (cdr forms1589))))) ids1564 labels1565 vars1566 vals1567 bindings1568)) tmp1585) (syntax-violation #f "source expression failed to match any pattern" tmp1584))) ($sc-dispatch tmp1584 (quote (any . each-any))))) e1574) (if (memv t1578 (quote (local-syntax-form))) (chi-local-syntax1254 value1573 e1574 er1571 w1575 s1576 mod1577 (lambda (forms1591 er1592 w1593 s1594 mod1595) (parse1562 (let f1596 ((forms1597 forms1591)) (if (null? forms1597) (cdr body1563) (cons (cons er1592 (wrap1240 (car forms1597) w1593 mod1595)) (f1596 (cdr forms1597))))) ids1564 labels1565 vars1566 vals1567 bindings1568))) (if (null? ids1564) (build-sequence1191 #f (map (lambda (x1598) (chi1248 (cdr x1598) (car x1598) (quote (())) mod1577)) (cons (cons er1571 (source-wrap1241 e1574 w1575 s1576 mod1577)) (cdr body1563)))) (begin (if (not (valid-bound-ids?1237 ids1564)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form1555)) (let loop1599 ((bs1600 bindings1568) (er-cache1601 #f) (r-cache1602 #f)) (if (not (null? bs1600)) (let ((b1603 (car bs1600))) (if (eq? (car b1603) (quote macro)) (let ((er1604 (cadr b1603))) (let ((r-cache1605 (if (eq? er1604 er-cache1601) r-cache1602 (macros-only-env1208 er1604)))) (begin (set-cdr! b1603 (eval-local-transformer1255 (chi1248 (cddr b1603) r-cache1605 (quote (())) mod1577) mod1577)) (loop1599 (cdr bs1600) er1604 r-cache1605)))) (loop1599 (cdr bs1600) er-cache1601 r-cache1602))))) (set-cdr! r1559 (extend-env1206 labels1565 bindings1568 (cdr r1559))) (build-letrec1194 #f vars1566 (map (lambda (x1606) (chi1248 (cdr x1606) (car x1606) (quote (())) mod1577)) vals1567) (build-sequence1191 #f (map (lambda (x1607) (chi1248 (cdr x1607) (car x1607) (quote (())) mod1577)) (cons (cons er1571 (source-wrap1241 e1574 w1575 s1576 mod1577)) (cdr body1563)))))))))))))))))))))) (chi-macro1251 (lambda (p1608 e1609 r1610 w1611 rib1612 mod1613) (letrec ((rebuild-macro-output1614 (lambda (x1615 m1616) (cond ((pair? x1615) (cons (rebuild-macro-output1614 (car x1615) m1616) (rebuild-macro-output1614 (cdr x1615) m1616))) ((syntax-object?1196 x1615) (let ((w1617 (syntax-object-wrap1198 x1615))) (let ((ms1618 (wrap-marks1215 w1617)) (s1619 (wrap-subst1216 w1617))) (if (and (pair? ms1618) (eq? (car ms1618) #f)) (make-syntax-object1195 (syntax-object-expression1197 x1615) (make-wrap1214 (cdr ms1618) (if rib1612 (cons rib1612 (cdr s1619)) (cdr s1619))) (syntax-object-module1199 x1615)) (make-syntax-object1195 (syntax-object-expression1197 x1615) (make-wrap1214 (cons m1616 ms1618) (if rib1612 (cons rib1612 (cons (quote shift) s1619)) (cons (quote shift) s1619))) (let ((pmod1620 (procedure-module p1608))) (if pmod1620 (cons (quote hygiene) (module-name pmod1620)) (quote (hygiene guile))))))))) ((vector? x1615) (let ((n1621 (vector-length x1615))) (let ((v1622 (make-vector n1621))) (let doloop1623 ((i1624 0)) (if (fx=1182 i1624 n1621) v1622 (begin (vector-set! v1622 i1624 (rebuild-macro-output1614 (vector-ref x1615 i1624) m1616)) (doloop1623 (fx+1180 i1624 1)))))))) ((symbol? x1615) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap1241 e1609 w1611 s mod1613) x1615)) (else x1615))))) (rebuild-macro-output1614 (p1608 (wrap1240 e1609 (anti-mark1227 w1611) mod1613)) (string #\m))))) (chi-application1250 (lambda (x1625 e1626 r1627 w1628 s1629 mod1630) ((lambda (tmp1631) ((lambda (tmp1632) (if tmp1632 (apply (lambda (e01633 e11634) (build-annotated1189 s1629 (cons x1625 (map (lambda (e1635) (chi1248 e1635 r1627 w1628 mod1630)) e11634)))) tmp1632) (syntax-violation #f "source expression failed to match any pattern" tmp1631))) ($sc-dispatch tmp1631 (quote (any . each-any))))) e1626))) (chi-expr1249 (lambda (type1637 value1638 e1639 r1640 w1641 s1642 mod1643) (let ((t1644 type1637)) (if (memv t1644 (quote (lexical))) (build-annotated1189 s1642 value1638) (if (memv t1644 (quote (core external-macro))) (value1638 e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (module-ref))) (call-with-values (lambda () (value1638 e1639)) (lambda (id1645 mod1646) (build-annotated1189 s1642 (if mod1646 (make-module-ref (cdr mod1646) id1645 (car mod1646)) (make-module-ref mod1646 id1645 (quote bare)))))) (if (memv t1644 (quote (lexical-call))) (chi-application1250 (build-annotated1189 (source-annotation1203 (car e1639)) value1638) e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (global-call))) (chi-application1250 (build-annotated1189 (source-annotation1203 (car e1639)) (if (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643) (make-module-ref (cdr (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643)) value1638 (car (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643))) (make-module-ref (if (syntax-object?1196 (car e1639)) (syntax-object-module1199 (car e1639)) mod1643) value1638 (quote bare)))) e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (constant))) (build-data1190 s1642 (strip1259 (source-wrap1241 e1639 w1641 s1642 mod1643) (quote (())))) (if (memv t1644 (quote (global))) (build-annotated1189 s1642 (if mod1643 (make-module-ref (cdr mod1643) value1638 (car mod1643)) (make-module-ref mod1643 value1638 (quote bare)))) (if (memv t1644 (quote (call))) (chi-application1250 (chi1248 (car e1639) r1640 w1641 mod1643) e1639 r1640 w1641 s1642 mod1643) (if (memv t1644 (quote (begin-form))) ((lambda (tmp1647) ((lambda (tmp1648) (if tmp1648 (apply (lambda (_1649 e11650 e21651) (chi-sequence1242 (cons e11650 e21651) r1640 w1641 s1642 mod1643)) tmp1648) (syntax-violation #f "source expression failed to match any pattern" tmp1647))) ($sc-dispatch tmp1647 (quote (any any . each-any))))) e1639) (if (memv t1644 (quote (local-syntax-form))) (chi-local-syntax1254 value1638 e1639 r1640 w1641 s1642 mod1643 chi-sequence1242) (if (memv t1644 (quote (eval-when-form))) ((lambda (tmp1653) ((lambda (tmp1654) (if tmp1654 (apply (lambda (_1655 x1656 e11657 e21658) (let ((when-list1659 (chi-when-list1245 e1639 x1656 w1641))) (if (memq (quote eval) when-list1659) (chi-sequence1242 (cons e11657 e21658) r1640 w1641 s1642 mod1643) (chi-void1256)))) tmp1654) (syntax-violation #f "source expression failed to match any pattern" tmp1653))) ($sc-dispatch tmp1653 (quote (any each-any any . each-any))))) e1639) (if (memv t1644 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e1639 (wrap1240 value1638 w1641 mod1643)) (if (memv t1644 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap1241 e1639 w1641 s1642 mod1643)) (if (memv t1644 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap1241 e1639 w1641 s1642 mod1643)) (syntax-violation #f "unexpected syntax" (source-wrap1241 e1639 w1641 s1642 mod1643))))))))))))))))))) (chi1248 (lambda (e1662 r1663 w1664 mod1665) (call-with-values (lambda () (syntax-type1246 e1662 r1663 w1664 #f #f mod1665)) (lambda (type1666 value1667 e1668 w1669 s1670 mod1671) (chi-expr1249 type1666 value1667 e1668 r1663 w1669 s1670 mod1671))))) (chi-top1247 (lambda (e1672 r1673 w1674 m1675 esew1676 mod1677) (call-with-values (lambda () (syntax-type1246 e1672 r1673 w1674 #f #f mod1677)) (lambda (type1685 value1686 e1687 w1688 s1689 mod1690) (let ((t1691 type1685)) (if (memv t1691 (quote (begin-form))) ((lambda (tmp1692) ((lambda (tmp1693) (if tmp1693 (apply (lambda (_1694) (chi-void1256)) tmp1693) ((lambda (tmp1695) (if tmp1695 (apply (lambda (_1696 e11697 e21698) (chi-top-sequence1243 (cons e11697 e21698) r1673 w1688 s1689 m1675 esew1676 mod1690)) tmp1695) (syntax-violation #f "source expression failed to match any pattern" tmp1692))) ($sc-dispatch tmp1692 (quote (any any . each-any)))))) ($sc-dispatch tmp1692 (quote (any))))) e1687) (if (memv t1691 (quote (local-syntax-form))) (chi-local-syntax1254 value1686 e1687 r1673 w1688 s1689 mod1690 (lambda (body1700 r1701 w1702 s1703 mod1704) (chi-top-sequence1243 body1700 r1701 w1702 s1703 m1675 esew1676 mod1704))) (if (memv t1691 (quote (eval-when-form))) ((lambda (tmp1705) ((lambda (tmp1706) (if tmp1706 (apply (lambda (_1707 x1708 e11709 e21710) (let ((when-list1711 (chi-when-list1245 e1687 x1708 w1688)) (body1712 (cons e11709 e21710))) (cond ((eq? m1675 (quote e)) (if (memq (quote eval) when-list1711) (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote e) (quote (eval)) mod1690) (chi-void1256))) ((memq (quote load) when-list1711) (if (or (memq (quote compile) when-list1711) (and (eq? m1675 (quote c&e)) (memq (quote eval) when-list1711))) (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote c&e) (quote (compile load)) mod1690) (if (memq m1675 (quote (c c&e))) (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote c) (quote (load)) mod1690) (chi-void1256)))) ((or (memq (quote compile) when-list1711) (and (eq? m1675 (quote c&e)) (memq (quote eval) when-list1711))) (top-level-eval-hook1184 (chi-top-sequence1243 body1712 r1673 w1688 s1689 (quote e) (quote (eval)) mod1690) mod1690) (chi-void1256)) (else (chi-void1256))))) tmp1706) (syntax-violation #f "source expression failed to match any pattern" tmp1705))) ($sc-dispatch tmp1705 (quote (any each-any any . each-any))))) e1687) (if (memv t1691 (quote (define-syntax-form))) (let ((n1715 (id-var-name1234 value1686 w1688)) (r1716 (macros-only-env1208 r1673))) (let ((t1717 m1675)) (if (memv t1717 (quote (c))) (if (memq (quote compile) esew1676) (let ((e1718 (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)))) (begin (top-level-eval-hook1184 e1718 mod1690) (if (memq (quote load) esew1676) e1718 (chi-void1256)))) (if (memq (quote load) esew1676) (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)) (chi-void1256))) (if (memv t1717 (quote (c&e))) (let ((e1719 (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)))) (begin (top-level-eval-hook1184 e1719 mod1690) e1719)) (begin (if (memq (quote eval) esew1676) (top-level-eval-hook1184 (chi-install-global1244 n1715 (chi1248 e1687 r1716 w1688 mod1690)) mod1690)) (chi-void1256)))))) (if (memv t1691 (quote (define-form))) (let ((n1720 (id-var-name1234 value1686 w1688))) (let ((type1721 (binding-type1204 (lookup1209 n1720 r1673 mod1690)))) (let ((t1722 type1721)) (if (memv t1722 (quote (global core macro module-ref))) (let ((x1723 (build-annotated1189 s1689 (list (quote define) n1720 (chi1248 e1687 r1673 w1688 mod1690))))) (begin (if (eq? m1675 (quote c&e)) (top-level-eval-hook1184 x1723 mod1690)) x1723)) (if (memv t1722 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e1687 (wrap1240 value1686 w1688 mod1690)) (syntax-violation #f "cannot define keyword at top level" e1687 (wrap1240 value1686 w1688 mod1690))))))) (let ((x1724 (chi-expr1249 type1685 value1686 e1687 r1673 w1688 s1689 mod1690))) (begin (if (eq? m1675 (quote c&e)) (top-level-eval-hook1184 x1724 mod1690)) x1724)))))))))))) (syntax-type1246 (lambda (e1725 r1726 w1727 s1728 rib1729 mod1730) (cond ((symbol? e1725) (let ((n1731 (id-var-name1234 e1725 w1727))) (let ((b1732 (lookup1209 n1731 r1726 mod1730))) (let ((type1733 (binding-type1204 b1732))) (let ((t1734 type1733)) (if (memv t1734 (quote (lexical))) (values type1733 (binding-value1205 b1732) e1725 w1727 s1728 mod1730) (if (memv t1734 (quote (global))) (values type1733 n1731 e1725 w1727 s1728 mod1730) (if (memv t1734 (quote (macro))) (syntax-type1246 (chi-macro1251 (binding-value1205 b1732) e1725 r1726 w1727 rib1729 mod1730) r1726 (quote (())) s1728 rib1729 mod1730) (values type1733 (binding-value1205 b1732) e1725 w1727 s1728 mod1730))))))))) ((pair? e1725) (let ((first1735 (car e1725))) (if (id?1212 first1735) (let ((n1736 (id-var-name1234 first1735 w1727))) (let ((b1737 (lookup1209 n1736 r1726 (or (and (syntax-object?1196 first1735) (syntax-object-module1199 first1735)) mod1730)))) (let ((type1738 (binding-type1204 b1737))) (let ((t1739 type1738)) (if (memv t1739 (quote (lexical))) (values (quote lexical-call) (binding-value1205 b1737) e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (global))) (values (quote global-call) n1736 e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (macro))) (syntax-type1246 (chi-macro1251 (binding-value1205 b1737) e1725 r1726 w1727 rib1729 mod1730) r1726 (quote (())) s1728 rib1729 mod1730) (if (memv t1739 (quote (core external-macro module-ref))) (values type1738 (binding-value1205 b1737) e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1205 b1737) e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (begin))) (values (quote begin-form) #f e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (eval-when))) (values (quote eval-when-form) #f e1725 w1727 s1728 mod1730) (if (memv t1739 (quote (define))) ((lambda (tmp1740) ((lambda (tmp1741) (if (if tmp1741 (apply (lambda (_1742 name1743 val1744) (id?1212 name1743)) tmp1741) #f) (apply (lambda (_1745 name1746 val1747) (values (quote define-form) name1746 val1747 w1727 s1728 mod1730)) tmp1741) ((lambda (tmp1748) (if (if tmp1748 (apply (lambda (_1749 name1750 args1751 e11752 e21753) (and (id?1212 name1750) (valid-bound-ids?1237 (lambda-var-list1261 args1751)))) tmp1748) #f) (apply (lambda (_1754 name1755 args1756 e11757 e21758) (values (quote define-form) (wrap1240 name1755 w1727 mod1730) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) (wrap1240 (cons args1756 (cons e11757 e21758)) w1727 mod1730)) (quote (())) s1728 mod1730)) tmp1748) ((lambda (tmp1760) (if (if tmp1760 (apply (lambda (_1761 name1762) (id?1212 name1762)) tmp1760) #f) (apply (lambda (_1763 name1764) (values (quote define-form) (wrap1240 name1764 w1727 mod1730) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote (())) s1728 mod1730)) tmp1760) (syntax-violation #f "source expression failed to match any pattern" tmp1740))) ($sc-dispatch tmp1740 (quote (any any)))))) ($sc-dispatch tmp1740 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp1740 (quote (any any any))))) e1725) (if (memv t1739 (quote (define-syntax))) ((lambda (tmp1765) ((lambda (tmp1766) (if (if tmp1766 (apply (lambda (_1767 name1768 val1769) (id?1212 name1768)) tmp1766) #f) (apply (lambda (_1770 name1771 val1772) (values (quote define-syntax-form) name1771 val1772 w1727 s1728 mod1730)) tmp1766) (syntax-violation #f "source expression failed to match any pattern" tmp1765))) ($sc-dispatch tmp1765 (quote (any any any))))) e1725) (values (quote call) #f e1725 w1727 s1728 mod1730)))))))))))))) (values (quote call) #f e1725 w1727 s1728 mod1730)))) ((syntax-object?1196 e1725) (syntax-type1246 (syntax-object-expression1197 e1725) r1726 (join-wraps1231 w1727 (syntax-object-wrap1198 e1725)) #f rib1729 (or (syntax-object-module1199 e1725) mod1730))) ((annotation? e1725) (syntax-type1246 (annotation-expression e1725) r1726 w1727 (annotation-source e1725) rib1729 mod1730)) ((self-evaluating? e1725) (values (quote constant) #f e1725 w1727 s1728 mod1730)) (else (values (quote other) #f e1725 w1727 s1728 mod1730))))) (chi-when-list1245 (lambda (e1773 when-list1774 w1775) (let f1776 ((when-list1777 when-list1774) (situations1778 (quote ()))) (if (null? when-list1777) situations1778 (f1776 (cdr when-list1777) (cons (let ((x1779 (car when-list1777))) (cond ((free-id=?1235 x1779 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote compile)) ((free-id=?1235 x1779 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote load)) ((free-id=?1235 x1779 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) "invalid situation" e1773 (wrap1240 x1779 w1775 #f))))) situations1778)))))) (chi-install-global1244 (lambda (name1780 e1781) (build-annotated1189 #f (list (build-annotated1189 #f (quote define)) name1780 (if (let ((v1782 (module-variable (current-module) name1780))) (and v1782 (variable-bound? v1782) (macro? (variable-ref v1782)) (not (eq? (macro-type (variable-ref v1782)) (quote syncase-macro))))) (build-annotated1189 #f (list (build-annotated1189 #f (quote make-extended-syncase-macro)) (build-annotated1189 #f (list (build-annotated1189 #f (quote module-ref)) (build-annotated1189 #f (quote (current-module))) (build-data1190 #f name1780))) (build-data1190 #f (quote macro)) e1781)) (build-annotated1189 #f (list (build-annotated1189 #f (quote make-syncase-macro)) (build-data1190 #f (quote macro)) e1781))))))) (chi-top-sequence1243 (lambda (body1783 r1784 w1785 s1786 m1787 esew1788 mod1789) (build-sequence1191 s1786 (let dobody1790 ((body1791 body1783) (r1792 r1784) (w1793 w1785) (m1794 m1787) (esew1795 esew1788) (mod1796 mod1789)) (if (null? body1791) (quote ()) (let ((first1797 (chi-top1247 (car body1791) r1792 w1793 m1794 esew1795 mod1796))) (cons first1797 (dobody1790 (cdr body1791) r1792 w1793 m1794 esew1795 mod1796)))))))) (chi-sequence1242 (lambda (body1798 r1799 w1800 s1801 mod1802) (build-sequence1191 s1801 (let dobody1803 ((body1804 body1798) (r1805 r1799) (w1806 w1800) (mod1807 mod1802)) (if (null? body1804) (quote ()) (let ((first1808 (chi1248 (car body1804) r1805 w1806 mod1807))) (cons first1808 (dobody1803 (cdr body1804) r1805 w1806 mod1807)))))))) (source-wrap1241 (lambda (x1809 w1810 s1811 defmod1812) (wrap1240 (if s1811 (make-annotation x1809 s1811 #f) x1809) w1810 defmod1812))) (wrap1240 (lambda (x1813 w1814 defmod1815) (cond ((and (null? (wrap-marks1215 w1814)) (null? (wrap-subst1216 w1814))) x1813) ((syntax-object?1196 x1813) (make-syntax-object1195 (syntax-object-expression1197 x1813) (join-wraps1231 w1814 (syntax-object-wrap1198 x1813)) (syntax-object-module1199 x1813))) ((null? x1813) x1813) (else (make-syntax-object1195 x1813 w1814 defmod1815))))) (bound-id-member?1239 (lambda (x1816 list1817) (and (not (null? list1817)) (or (bound-id=?1236 x1816 (car list1817)) (bound-id-member?1239 x1816 (cdr list1817)))))) (distinct-bound-ids?1238 (lambda (ids1818) (let distinct?1819 ((ids1820 ids1818)) (or (null? ids1820) (and (not (bound-id-member?1239 (car ids1820) (cdr ids1820))) (distinct?1819 (cdr ids1820))))))) (valid-bound-ids?1237 (lambda (ids1821) (and (let all-ids?1822 ((ids1823 ids1821)) (or (null? ids1823) (and (id?1212 (car ids1823)) (all-ids?1822 (cdr ids1823))))) (distinct-bound-ids?1238 ids1821)))) (bound-id=?1236 (lambda (i1824 j1825) (if (and (syntax-object?1196 i1824) (syntax-object?1196 j1825)) (and (eq? (let ((e1826 (syntax-object-expression1197 i1824))) (if (annotation? e1826) (annotation-expression e1826) e1826)) (let ((e1827 (syntax-object-expression1197 j1825))) (if (annotation? e1827) (annotation-expression e1827) e1827))) (same-marks?1233 (wrap-marks1215 (syntax-object-wrap1198 i1824)) (wrap-marks1215 (syntax-object-wrap1198 j1825)))) (eq? (let ((e1828 i1824)) (if (annotation? e1828) (annotation-expression e1828) e1828)) (let ((e1829 j1825)) (if (annotation? e1829) (annotation-expression e1829) e1829)))))) (free-id=?1235 (lambda (i1830 j1831) (and (eq? (let ((x1832 i1830)) (let ((e1833 (if (syntax-object?1196 x1832) (syntax-object-expression1197 x1832) x1832))) (if (annotation? e1833) (annotation-expression e1833) e1833))) (let ((x1834 j1831)) (let ((e1835 (if (syntax-object?1196 x1834) (syntax-object-expression1197 x1834) x1834))) (if (annotation? e1835) (annotation-expression e1835) e1835)))) (eq? (id-var-name1234 i1830 (quote (()))) (id-var-name1234 j1831 (quote (()))))))) (id-var-name1234 (lambda (id1836 w1837) (letrec ((search-vector-rib1840 (lambda (sym1846 subst1847 marks1848 symnames1849 ribcage1850) (let ((n1851 (vector-length symnames1849))) (let f1852 ((i1853 0)) (cond ((fx=1182 i1853 n1851) (search1838 sym1846 (cdr subst1847) marks1848)) ((and (eq? (vector-ref symnames1849 i1853) sym1846) (same-marks?1233 marks1848 (vector-ref (ribcage-marks1222 ribcage1850) i1853))) (values (vector-ref (ribcage-labels1223 ribcage1850) i1853) marks1848)) (else (f1852 (fx+1180 i1853 1)))))))) (search-list-rib1839 (lambda (sym1854 subst1855 marks1856 symnames1857 ribcage1858) (let f1859 ((symnames1860 symnames1857) (i1861 0)) (cond ((null? symnames1860) (search1838 sym1854 (cdr subst1855) marks1856)) ((and (eq? (car symnames1860) sym1854) (same-marks?1233 marks1856 (list-ref (ribcage-marks1222 ribcage1858) i1861))) (values (list-ref (ribcage-labels1223 ribcage1858) i1861) marks1856)) (else (f1859 (cdr symnames1860) (fx+1180 i1861 1))))))) (search1838 (lambda (sym1862 subst1863 marks1864) (if (null? subst1863) (values #f marks1864) (let ((fst1865 (car subst1863))) (if (eq? fst1865 (quote shift)) (search1838 sym1862 (cdr subst1863) (cdr marks1864)) (let ((symnames1866 (ribcage-symnames1221 fst1865))) (if (vector? symnames1866) (search-vector-rib1840 sym1862 subst1863 marks1864 symnames1866 fst1865) (search-list-rib1839 sym1862 subst1863 marks1864 symnames1866 fst1865))))))))) (cond ((symbol? id1836) (or (call-with-values (lambda () (search1838 id1836 (wrap-subst1216 w1837) (wrap-marks1215 w1837))) (lambda (x1868 . ignore1867) x1868)) id1836)) ((syntax-object?1196 id1836) (let ((id1869 (let ((e1871 (syntax-object-expression1197 id1836))) (if (annotation? e1871) (annotation-expression e1871) e1871))) (w11870 (syntax-object-wrap1198 id1836))) (let ((marks1872 (join-marks1232 (wrap-marks1215 w1837) (wrap-marks1215 w11870)))) (call-with-values (lambda () (search1838 id1869 (wrap-subst1216 w1837) marks1872)) (lambda (new-id1873 marks1874) (or new-id1873 (call-with-values (lambda () (search1838 id1869 (wrap-subst1216 w11870) marks1874)) (lambda (x1876 . ignore1875) x1876)) id1869)))))) ((annotation? id1836) (let ((id1877 (let ((e1878 id1836)) (if (annotation? e1878) (annotation-expression e1878) e1878)))) (or (call-with-values (lambda () (search1838 id1877 (wrap-subst1216 w1837) (wrap-marks1215 w1837))) (lambda (x1880 . ignore1879) x1880)) id1877))) (else (error-hook1186 (quote id-var-name) "invalid id" id1836)))))) (same-marks?1233 (lambda (x1881 y1882) (or (eq? x1881 y1882) (and (not (null? x1881)) (not (null? y1882)) (eq? (car x1881) (car y1882)) (same-marks?1233 (cdr x1881) (cdr y1882)))))) (join-marks1232 (lambda (m11883 m21884) (smart-append1230 m11883 m21884))) (join-wraps1231 (lambda (w11885 w21886) (let ((m11887 (wrap-marks1215 w11885)) (s11888 (wrap-subst1216 w11885))) (if (null? m11887) (if (null? s11888) w21886 (make-wrap1214 (wrap-marks1215 w21886) (smart-append1230 s11888 (wrap-subst1216 w21886)))) (make-wrap1214 (smart-append1230 m11887 (wrap-marks1215 w21886)) (smart-append1230 s11888 (wrap-subst1216 w21886))))))) (smart-append1230 (lambda (m11889 m21890) (if (null? m21890) m11889 (append m11889 m21890)))) (make-binding-wrap1229 (lambda (ids1891 labels1892 w1893) (if (null? ids1891) w1893 (make-wrap1214 (wrap-marks1215 w1893) (cons (let ((labelvec1894 (list->vector labels1892))) (let ((n1895 (vector-length labelvec1894))) (let ((symnamevec1896 (make-vector n1895)) (marksvec1897 (make-vector n1895))) (begin (let f1898 ((ids1899 ids1891) (i1900 0)) (if (not (null? ids1899)) (call-with-values (lambda () (id-sym-name&marks1213 (car ids1899) w1893)) (lambda (symname1901 marks1902) (begin (vector-set! symnamevec1896 i1900 symname1901) (vector-set! marksvec1897 i1900 marks1902) (f1898 (cdr ids1899) (fx+1180 i1900 1))))))) (make-ribcage1219 symnamevec1896 marksvec1897 labelvec1894))))) (wrap-subst1216 w1893)))))) (extend-ribcage!1228 (lambda (ribcage1903 id1904 label1905) (begin (set-ribcage-symnames!1224 ribcage1903 (cons (let ((e1906 (syntax-object-expression1197 id1904))) (if (annotation? e1906) (annotation-expression e1906) e1906)) (ribcage-symnames1221 ribcage1903))) (set-ribcage-marks!1225 ribcage1903 (cons (wrap-marks1215 (syntax-object-wrap1198 id1904)) (ribcage-marks1222 ribcage1903))) (set-ribcage-labels!1226 ribcage1903 (cons label1905 (ribcage-labels1223 ribcage1903)))))) (anti-mark1227 (lambda (w1907) (make-wrap1214 (cons #f (wrap-marks1215 w1907)) (cons (quote shift) (wrap-subst1216 w1907))))) (set-ribcage-labels!1226 (lambda (x1908 update1909) (vector-set! x1908 3 update1909))) (set-ribcage-marks!1225 (lambda (x1910 update1911) (vector-set! x1910 2 update1911))) (set-ribcage-symnames!1224 (lambda (x1912 update1913) (vector-set! x1912 1 update1913))) (ribcage-labels1223 (lambda (x1914) (vector-ref x1914 3))) (ribcage-marks1222 (lambda (x1915) (vector-ref x1915 2))) (ribcage-symnames1221 (lambda (x1916) (vector-ref x1916 1))) (ribcage?1220 (lambda (x1917) (and (vector? x1917) (= (vector-length x1917) 4) (eq? (vector-ref x1917 0) (quote ribcage))))) (make-ribcage1219 (lambda (symnames1918 marks1919 labels1920) (vector (quote ribcage) symnames1918 marks1919 labels1920))) (gen-labels1218 (lambda (ls1921) (if (null? ls1921) (quote ()) (cons (gen-label1217) (gen-labels1218 (cdr ls1921)))))) (gen-label1217 (lambda () (string #\i))) (wrap-subst1216 cdr) (wrap-marks1215 car) (make-wrap1214 cons) (id-sym-name&marks1213 (lambda (x1922 w1923) (if (syntax-object?1196 x1922) (values (let ((e1924 (syntax-object-expression1197 x1922))) (if (annotation? e1924) (annotation-expression e1924) e1924)) (join-marks1232 (wrap-marks1215 w1923) (wrap-marks1215 (syntax-object-wrap1198 x1922)))) (values (let ((e1925 x1922)) (if (annotation? e1925) (annotation-expression e1925) e1925)) (wrap-marks1215 w1923))))) (id?1212 (lambda (x1926) (cond ((symbol? x1926) #t) ((syntax-object?1196 x1926) (symbol? (let ((e1927 (syntax-object-expression1197 x1926))) (if (annotation? e1927) (annotation-expression e1927) e1927)))) ((annotation? x1926) (symbol? (annotation-expression x1926))) (else #f)))) (nonsymbol-id?1211 (lambda (x1928) (and (syntax-object?1196 x1928) (symbol? (let ((e1929 (syntax-object-expression1197 x1928))) (if (annotation? e1929) (annotation-expression e1929) e1929)))))) (global-extend1210 (lambda (type1930 sym1931 val1932) (put-global-definition-hook1187 sym1931 type1930 val1932))) (lookup1209 (lambda (x1933 r1934 mod1935) (cond ((assq x1933 r1934) => cdr) ((symbol? x1933) (or (get-global-definition-hook1188 x1933 mod1935) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1208 (lambda (r1936) (if (null? r1936) (quote ()) (let ((a1937 (car r1936))) (if (eq? (cadr a1937) (quote macro)) (cons a1937 (macros-only-env1208 (cdr r1936))) (macros-only-env1208 (cdr r1936))))))) (extend-var-env1207 (lambda (labels1938 vars1939 r1940) (if (null? labels1938) r1940 (extend-var-env1207 (cdr labels1938) (cdr vars1939) (cons (cons (car labels1938) (cons (quote lexical) (car vars1939))) r1940))))) (extend-env1206 (lambda (labels1941 bindings1942 r1943) (if (null? labels1941) r1943 (extend-env1206 (cdr labels1941) (cdr bindings1942) (cons (cons (car labels1941) (car bindings1942)) r1943))))) (binding-value1205 cdr) (binding-type1204 car) (source-annotation1203 (lambda (x1944) (cond ((annotation? x1944) (annotation-source x1944)) ((syntax-object?1196 x1944) (source-annotation1203 (syntax-object-expression1197 x1944))) (else #f)))) (set-syntax-object-module!1202 (lambda (x1945 update1946) (vector-set! x1945 3 update1946))) (set-syntax-object-wrap!1201 (lambda (x1947 update1948) (vector-set! x1947 2 update1948))) (set-syntax-object-expression!1200 (lambda (x1949 update1950) (vector-set! x1949 1 update1950))) (syntax-object-module1199 (lambda (x1951) (vector-ref x1951 3))) (syntax-object-wrap1198 (lambda (x1952) (vector-ref x1952 2))) (syntax-object-expression1197 (lambda (x1953) (vector-ref x1953 1))) (syntax-object?1196 (lambda (x1954) (and (vector? x1954) (= (vector-length x1954) 4) (eq? (vector-ref x1954 0) (quote syntax-object))))) (make-syntax-object1195 (lambda (expression1955 wrap1956 module1957) (vector (quote syntax-object) expression1955 wrap1956 module1957))) (build-letrec1194 (lambda (src1958 vars1959 val-exps1960 body-exp1961) (if (null? vars1959) (build-annotated1189 src1958 body-exp1961) (build-annotated1189 src1958 (list (quote letrec) (map list vars1959 val-exps1960) body-exp1961))))) (build-named-let1193 (lambda (src1962 vars1963 val-exps1964 body-exp1965) (if (null? vars1963) (build-annotated1189 src1962 body-exp1965) (build-annotated1189 src1962 (list (quote let) (car vars1963) (map list (cdr vars1963) val-exps1964) body-exp1965))))) (build-let1192 (lambda (src1966 vars1967 val-exps1968 body-exp1969) (if (null? vars1967) (build-annotated1189 src1966 body-exp1969) (build-annotated1189 src1966 (list (quote let) (map list vars1967 val-exps1968) body-exp1969))))) (build-sequence1191 (lambda (src1970 exps1971) (if (null? (cdr exps1971)) (build-annotated1189 src1970 (car exps1971)) (build-annotated1189 src1970 (cons (quote begin) exps1971))))) (build-data1190 (lambda (src1972 exp1973) (if (and (self-evaluating? exp1973) (not (vector? exp1973))) (build-annotated1189 src1972 exp1973) (build-annotated1189 src1972 (list (quote quote) exp1973))))) (build-annotated1189 (lambda (src1974 exp1975) (if (and src1974 (not (annotation? exp1975))) (make-annotation exp1975 src1974 #t) exp1975))) (get-global-definition-hook1188 (lambda (symbol1976 module1977) (begin (if (and (not module1977) (current-module)) (warn "module system is booted, we should have a module" symbol1976)) (let ((v1978 (module-variable (if module1977 (resolve-module (cdr module1977)) (current-module)) symbol1976))) (and v1978 (variable-bound? v1978) (let ((val1979 (variable-ref v1978))) (and (macro? val1979) (syncase-macro-type val1979) (cons (syncase-macro-type val1979) (syncase-macro-binding val1979))))))))) (put-global-definition-hook1187 (lambda (symbol1980 type1981 val1982) (let ((existing1983 (let ((v1984 (module-variable (current-module) symbol1980))) (and v1984 (variable-bound? v1984) (let ((val1985 (variable-ref v1984))) (and (macro? val1985) (not (syncase-macro-type val1985)) val1985)))))) (module-define! (current-module) symbol1980 (if existing1983 (make-extended-syncase-macro existing1983 type1981 val1982) (make-syncase-macro type1981 val1982)))))) (error-hook1186 (lambda (who1986 why1987 what1988) (error who1986 "~a ~s" why1987 what1988))) (local-eval-hook1185 (lambda (x1989 mod1990) (primitive-eval (list noexpand1179 x1989)))) (top-level-eval-hook1184 (lambda (x1991 mod1992) (primitive-eval (list noexpand1179 x1991)))) (fx<1183 <) (fx=1182 =) (fx-1181 -) (fx+1180 +) (noexpand1179 "noexpand")) (begin (global-extend1210 (quote local-syntax) (quote letrec-syntax) #t) (global-extend1210 (quote local-syntax) (quote let-syntax) #f) (global-extend1210 (quote core) (quote fluid-let-syntax) (lambda (e1993 r1994 w1995 s1996 mod1997) ((lambda (tmp1998) ((lambda (tmp1999) (if (if tmp1999 (apply (lambda (_2000 var2001 val2002 e12003 e22004) (valid-bound-ids?1237 var2001)) tmp1999) #f) (apply (lambda (_2006 var2007 val2008 e12009 e22010) (let ((names2011 (map (lambda (x2012) (id-var-name1234 x2012 w1995)) var2007))) (begin (for-each (lambda (id2014 n2015) (let ((t2016 (binding-type1204 (lookup1209 n2015 r1994 mod1997)))) (if (memv t2016 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e1993 (source-wrap1241 id2014 w1995 s1996 mod1997))))) var2007 names2011) (chi-body1252 (cons e12009 e22010) (source-wrap1241 e1993 w1995 s1996 mod1997) (extend-env1206 names2011 (let ((trans-r2019 (macros-only-env1208 r1994))) (map (lambda (x2020) (cons (quote macro) (eval-local-transformer1255 (chi1248 x2020 trans-r2019 w1995 mod1997) mod1997))) val2008)) r1994) w1995 mod1997)))) tmp1999) ((lambda (_2022) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap1241 e1993 w1995 s1996 mod1997))) tmp1998))) ($sc-dispatch tmp1998 (quote (any #(each (any any)) any . each-any))))) e1993))) (global-extend1210 (quote core) (quote quote) (lambda (e2023 r2024 w2025 s2026 mod2027) ((lambda (tmp2028) ((lambda (tmp2029) (if tmp2029 (apply (lambda (_2030 e2031) (build-data1190 s2026 (strip1259 e2031 w2025))) tmp2029) ((lambda (_2032) (syntax-violation (quote quote) "bad syntax" (source-wrap1241 e2023 w2025 s2026 mod2027))) tmp2028))) ($sc-dispatch tmp2028 (quote (any any))))) e2023))) (global-extend1210 (quote core) (quote syntax) (letrec ((regen2040 (lambda (x2041) (let ((t2042 (car x2041))) (if (memv t2042 (quote (ref))) (build-annotated1189 #f (cadr x2041)) (if (memv t2042 (quote (primitive))) (build-annotated1189 #f (cadr x2041)) (if (memv t2042 (quote (quote))) (build-data1190 #f (cadr x2041)) (if (memv t2042 (quote (lambda))) (build-annotated1189 #f (list (quote lambda) (cadr x2041) (regen2040 (caddr x2041)))) (if (memv t2042 (quote (map))) (let ((ls2043 (map regen2040 (cdr x2041)))) (build-annotated1189 #f (cons (if (fx=1182 (length ls2043) 2) (build-annotated1189 #f (quote map)) (build-annotated1189 #f (quote map))) ls2043))) (build-annotated1189 #f (cons (build-annotated1189 #f (car x2041)) (map regen2040 (cdr x2041)))))))))))) (gen-vector2039 (lambda (x2044) (cond ((eq? (car x2044) (quote list)) (cons (quote vector) (cdr x2044))) ((eq? (car x2044) (quote quote)) (list (quote quote) (list->vector (cadr x2044)))) (else (list (quote list->vector) x2044))))) (gen-append2038 (lambda (x2045 y2046) (if (equal? y2046 (quote (quote ()))) x2045 (list (quote append) x2045 y2046)))) (gen-cons2037 (lambda (x2047 y2048) (let ((t2049 (car y2048))) (if (memv t2049 (quote (quote))) (if (eq? (car x2047) (quote quote)) (list (quote quote) (cons (cadr x2047) (cadr y2048))) (if (eq? (cadr y2048) (quote ())) (list (quote list) x2047) (list (quote cons) x2047 y2048))) (if (memv t2049 (quote (list))) (cons (quote list) (cons x2047 (cdr y2048))) (list (quote cons) x2047 y2048)))))) (gen-map2036 (lambda (e2050 map-env2051) (let ((formals2052 (map cdr map-env2051)) (actuals2053 (map (lambda (x2054) (list (quote ref) (car x2054))) map-env2051))) (cond ((eq? (car e2050) (quote ref)) (car actuals2053)) ((andmap (lambda (x2055) (and (eq? (car x2055) (quote ref)) (memq (cadr x2055) formals2052))) (cdr e2050)) (cons (quote map) (cons (list (quote primitive) (car e2050)) (map (let ((r2056 (map cons formals2052 actuals2053))) (lambda (x2057) (cdr (assq (cadr x2057) r2056)))) (cdr e2050))))) (else (cons (quote map) (cons (list (quote lambda) formals2052 e2050) actuals2053))))))) (gen-mappend2035 (lambda (e2058 map-env2059) (list (quote apply) (quote (primitive append)) (gen-map2036 e2058 map-env2059)))) (gen-ref2034 (lambda (src2060 var2061 level2062 maps2063) (if (fx=1182 level2062 0) (values var2061 maps2063) (if (null? maps2063) (syntax-violation (quote syntax) "missing ellipsis" src2060) (call-with-values (lambda () (gen-ref2034 src2060 var2061 (fx-1181 level2062 1) (cdr maps2063))) (lambda (outer-var2064 outer-maps2065) (let ((b2066 (assq outer-var2064 (car maps2063)))) (if b2066 (values (cdr b2066) maps2063) (let ((inner-var2067 (gen-var1260 (quote tmp)))) (values inner-var2067 (cons (cons (cons outer-var2064 inner-var2067) (car maps2063)) outer-maps2065))))))))))) (gen-syntax2033 (lambda (src2068 e2069 r2070 maps2071 ellipsis?2072 mod2073) (if (id?1212 e2069) (let ((label2074 (id-var-name1234 e2069 (quote (()))))) (let ((b2075 (lookup1209 label2074 r2070 mod2073))) (if (eq? (binding-type1204 b2075) (quote syntax)) (call-with-values (lambda () (let ((var.lev2076 (binding-value1205 b2075))) (gen-ref2034 src2068 (car var.lev2076) (cdr var.lev2076) maps2071))) (lambda (var2077 maps2078) (values (list (quote ref) var2077) maps2078))) (if (ellipsis?2072 e2069) (syntax-violation (quote syntax) "misplaced ellipsis" src2068) (values (list (quote quote) e2069) maps2071))))) ((lambda (tmp2079) ((lambda (tmp2080) (if (if tmp2080 (apply (lambda (dots2081 e2082) (ellipsis?2072 dots2081)) tmp2080) #f) (apply (lambda (dots2083 e2084) (gen-syntax2033 src2068 e2084 r2070 maps2071 (lambda (x2085) #f) mod2073)) tmp2080) ((lambda (tmp2086) (if (if tmp2086 (apply (lambda (x2087 dots2088 y2089) (ellipsis?2072 dots2088)) tmp2086) #f) (apply (lambda (x2090 dots2091 y2092) (let f2093 ((y2094 y2092) (k2095 (lambda (maps2096) (call-with-values (lambda () (gen-syntax2033 src2068 x2090 r2070 (cons (quote ()) maps2096) ellipsis?2072 mod2073)) (lambda (x2097 maps2098) (if (null? (car maps2098)) (syntax-violation (quote syntax) "extra ellipsis" src2068) (values (gen-map2036 x2097 (car maps2098)) (cdr maps2098)))))))) ((lambda (tmp2099) ((lambda (tmp2100) (if (if tmp2100 (apply (lambda (dots2101 y2102) (ellipsis?2072 dots2101)) tmp2100) #f) (apply (lambda (dots2103 y2104) (f2093 y2104 (lambda (maps2105) (call-with-values (lambda () (k2095 (cons (quote ()) maps2105))) (lambda (x2106 maps2107) (if (null? (car maps2107)) (syntax-violation (quote syntax) "extra ellipsis" src2068) (values (gen-mappend2035 x2106 (car maps2107)) (cdr maps2107)))))))) tmp2100) ((lambda (_2108) (call-with-values (lambda () (gen-syntax2033 src2068 y2094 r2070 maps2071 ellipsis?2072 mod2073)) (lambda (y2109 maps2110) (call-with-values (lambda () (k2095 maps2110)) (lambda (x2111 maps2112) (values (gen-append2038 x2111 y2109) maps2112)))))) tmp2099))) ($sc-dispatch tmp2099 (quote (any . any))))) y2094))) tmp2086) ((lambda (tmp2113) (if tmp2113 (apply (lambda (x2114 y2115) (call-with-values (lambda () (gen-syntax2033 src2068 x2114 r2070 maps2071 ellipsis?2072 mod2073)) (lambda (x2116 maps2117) (call-with-values (lambda () (gen-syntax2033 src2068 y2115 r2070 maps2117 ellipsis?2072 mod2073)) (lambda (y2118 maps2119) (values (gen-cons2037 x2116 y2118) maps2119)))))) tmp2113) ((lambda (tmp2120) (if tmp2120 (apply (lambda (e12121 e22122) (call-with-values (lambda () (gen-syntax2033 src2068 (cons e12121 e22122) r2070 maps2071 ellipsis?2072 mod2073)) (lambda (e2124 maps2125) (values (gen-vector2039 e2124) maps2125)))) tmp2120) ((lambda (_2126) (values (list (quote quote) e2069) maps2071)) tmp2079))) ($sc-dispatch tmp2079 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp2079 (quote (any . any)))))) ($sc-dispatch tmp2079 (quote (any any . any)))))) ($sc-dispatch tmp2079 (quote (any any))))) e2069))))) (lambda (e2127 r2128 w2129 s2130 mod2131) (let ((e2132 (source-wrap1241 e2127 w2129 s2130 mod2131))) ((lambda (tmp2133) ((lambda (tmp2134) (if tmp2134 (apply (lambda (_2135 x2136) (call-with-values (lambda () (gen-syntax2033 e2132 x2136 r2128 (quote ()) ellipsis?1257 mod2131)) (lambda (e2137 maps2138) (regen2040 e2137)))) tmp2134) ((lambda (_2139) (syntax-violation (quote syntax) "bad `syntax' form" e2132)) tmp2133))) ($sc-dispatch tmp2133 (quote (any any))))) e2132))))) (global-extend1210 (quote core) (quote lambda) (lambda (e2140 r2141 w2142 s2143 mod2144) ((lambda (tmp2145) ((lambda (tmp2146) (if tmp2146 (apply (lambda (_2147 c2148) (chi-lambda-clause1253 (source-wrap1241 e2140 w2142 s2143 mod2144) #f c2148 r2141 w2142 mod2144 (lambda (vars2149 docstring2150 body2151) (build-annotated1189 s2143 (cons (quote lambda) (cons vars2149 (append (if docstring2150 (list docstring2150) (quote ())) (list body2151)))))))) tmp2146) (syntax-violation #f "source expression failed to match any pattern" tmp2145))) ($sc-dispatch tmp2145 (quote (any . any))))) e2140))) (global-extend1210 (quote core) (quote let) (letrec ((chi-let2152 (lambda (e2153 r2154 w2155 s2156 mod2157 constructor2158 ids2159 vals2160 exps2161) (if (not (valid-bound-ids?1237 ids2159)) (syntax-violation (quote let) "duplicate bound variable" e2153) (let ((labels2162 (gen-labels1218 ids2159)) (new-vars2163 (map gen-var1260 ids2159))) (let ((nw2164 (make-binding-wrap1229 ids2159 labels2162 w2155)) (nr2165 (extend-var-env1207 labels2162 new-vars2163 r2154))) (constructor2158 s2156 new-vars2163 (map (lambda (x2166) (chi1248 x2166 r2154 w2155 mod2157)) vals2160) (chi-body1252 exps2161 (source-wrap1241 e2153 nw2164 s2156 mod2157) nr2165 nw2164 mod2157)))))))) (lambda (e2167 r2168 w2169 s2170 mod2171) ((lambda (tmp2172) ((lambda (tmp2173) (if tmp2173 (apply (lambda (_2174 id2175 val2176 e12177 e22178) (chi-let2152 e2167 r2168 w2169 s2170 mod2171 build-let1192 id2175 val2176 (cons e12177 e22178))) tmp2173) ((lambda (tmp2182) (if (if tmp2182 (apply (lambda (_2183 f2184 id2185 val2186 e12187 e22188) (id?1212 f2184)) tmp2182) #f) (apply (lambda (_2189 f2190 id2191 val2192 e12193 e22194) (chi-let2152 e2167 r2168 w2169 s2170 mod2171 build-named-let1193 (cons f2190 id2191) val2192 (cons e12193 e22194))) tmp2182) ((lambda (_2198) (syntax-violation (quote let) "bad let" (source-wrap1241 e2167 w2169 s2170 mod2171))) tmp2172))) ($sc-dispatch tmp2172 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2172 (quote (any #(each (any any)) any . each-any))))) e2167)))) (global-extend1210 (quote core) (quote letrec) (lambda (e2199 r2200 w2201 s2202 mod2203) ((lambda (tmp2204) ((lambda (tmp2205) (if tmp2205 (apply (lambda (_2206 id2207 val2208 e12209 e22210) (let ((ids2211 id2207)) (if (not (valid-bound-ids?1237 ids2211)) (syntax-violation (quote letrec) "duplicate bound variable" e2199) (let ((labels2213 (gen-labels1218 ids2211)) (new-vars2214 (map gen-var1260 ids2211))) (let ((w2215 (make-binding-wrap1229 ids2211 labels2213 w2201)) (r2216 (extend-var-env1207 labels2213 new-vars2214 r2200))) (build-letrec1194 s2202 new-vars2214 (map (lambda (x2217) (chi1248 x2217 r2216 w2215 mod2203)) val2208) (chi-body1252 (cons e12209 e22210) (source-wrap1241 e2199 w2215 s2202 mod2203) r2216 w2215 mod2203))))))) tmp2205) ((lambda (_2220) (syntax-violation (quote letrec) "bad letrec" (source-wrap1241 e2199 w2201 s2202 mod2203))) tmp2204))) ($sc-dispatch tmp2204 (quote (any #(each (any any)) any . each-any))))) e2199))) (global-extend1210 (quote core) (quote set!) (lambda (e2221 r2222 w2223 s2224 mod2225) ((lambda (tmp2226) ((lambda (tmp2227) (if (if tmp2227 (apply (lambda (_2228 id2229 val2230) (id?1212 id2229)) tmp2227) #f) (apply (lambda (_2231 id2232 val2233) (let ((val2234 (chi1248 val2233 r2222 w2223 mod2225)) (n2235 (id-var-name1234 id2232 w2223))) (let ((b2236 (lookup1209 n2235 r2222 mod2225))) (let ((t2237 (binding-type1204 b2236))) (if (memv t2237 (quote (lexical))) (build-annotated1189 s2224 (list (quote set!) (binding-value1205 b2236) val2234)) (if (memv t2237 (quote (global))) (build-annotated1189 s2224 (list (quote set!) (if mod2225 (make-module-ref (cdr mod2225) n2235 (car mod2225)) (make-module-ref mod2225 n2235 (quote bare))) val2234)) (if (memv t2237 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap1240 id2232 w2223 mod2225)) (syntax-violation (quote set!) "bad set!" (source-wrap1241 e2221 w2223 s2224 mod2225))))))))) tmp2227) ((lambda (tmp2238) (if tmp2238 (apply (lambda (_2239 head2240 tail2241 val2242) (call-with-values (lambda () (syntax-type1246 head2240 r2222 (quote (())) #f #f mod2225)) (lambda (type2243 value2244 ee2245 ww2246 ss2247 modmod2248) (let ((t2249 type2243)) (if (memv t2249 (quote (module-ref))) (let ((val2250 (chi1248 val2242 r2222 w2223 mod2225))) (call-with-values (lambda () (value2244 (cons head2240 tail2241))) (lambda (id2252 mod2253) (build-annotated1189 s2224 (list (quote set!) (if mod2253 (make-module-ref (cdr mod2253) id2252 (car mod2253)) (make-module-ref mod2253 id2252 (quote bare))) val2250))))) (build-annotated1189 s2224 (cons (chi1248 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) head2240) r2222 w2223 mod2225) (map (lambda (e2254) (chi1248 e2254 r2222 w2223 mod2225)) (append tail2241 (list val2242)))))))))) tmp2238) ((lambda (_2256) (syntax-violation (quote set!) "bad set!" (source-wrap1241 e2221 w2223 s2224 mod2225))) tmp2226))) ($sc-dispatch tmp2226 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2226 (quote (any any any))))) e2221))) (global-extend1210 (quote module-ref) (quote @) (lambda (e2257) ((lambda (tmp2258) ((lambda (tmp2259) (if (if tmp2259 (apply (lambda (_2260 mod2261 id2262) (and (andmap id?1212 mod2261) (id?1212 id2262))) tmp2259) #f) (apply (lambda (_2264 mod2265 id2266) (values (syntax->datum id2266) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2265)))) tmp2259) (syntax-violation #f "source expression failed to match any pattern" tmp2258))) ($sc-dispatch tmp2258 (quote (any each-any any))))) e2257))) (global-extend1210 (quote module-ref) (quote @@) (lambda (e2268) ((lambda (tmp2269) ((lambda (tmp2270) (if (if tmp2270 (apply (lambda (_2271 mod2272 id2273) (and (andmap id?1212 mod2272) (id?1212 id2273))) tmp2270) #f) (apply (lambda (_2275 mod2276 id2277) (values (syntax->datum id2277) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) mod2276)))) tmp2270) (syntax-violation #f "source expression failed to match any pattern" tmp2269))) ($sc-dispatch tmp2269 (quote (any each-any any))))) e2268))) (global-extend1210 (quote begin) (quote begin) (quote ())) (global-extend1210 (quote define) (quote define) (quote ())) (global-extend1210 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1210 (quote eval-when) (quote eval-when) (quote ())) (global-extend1210 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2282 (lambda (x2283 keys2284 clauses2285 r2286 mod2287) (if (null? clauses2285) (build-annotated1189 #f (list (build-annotated1189 #f (quote syntax-violation)) #f "source expression failed to match any pattern" x2283)) ((lambda (tmp2288) ((lambda (tmp2289) (if tmp2289 (apply (lambda (pat2290 exp2291) (if (and (id?1212 pat2290) (andmap (lambda (x2292) (not (free-id=?1235 pat2290 x2292))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-module! set-syntax-object-wrap! set-syntax-object-expression! syntax-object-module syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application build-annotated get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))) (hygiene guile))) keys2284))) (let ((labels2293 (list (gen-label1217))) (var2294 (gen-var1260 pat2290))) (build-annotated1189 #f (list (build-annotated1189 #f (list (quote lambda) (list var2294) (chi1248 exp2291 (extend-env1206 labels2293 (list (cons (quote syntax) (cons var2294 0))) r2286) (make-binding-wrap1229 (list pat2290) labels2293 (quote (()))) mod2287))) x2283))) (gen-clause2281 x2283 keys2284 (cdr clauses2285) r2286 pat2290 #t exp2291 mod2287))) tmp2289) ((lambda (tmp2295) (if tmp2295 (apply (lambda (pat2296 fender2297 exp2298) (gen-clause2281 x2283 keys2284 (cdr clauses2285) r2286 pat2296 fender2297 exp2298 mod2287)) tmp2295) ((lambda (_2299) (syntax-violation (quote syntax-case) "invalid clause" (car clauses2285))) tmp2288))) ($sc-dispatch tmp2288 (quote (any any any)))))) ($sc-dispatch tmp2288 (quote (any any))))) (car clauses2285))))) (gen-clause2281 (lambda (x2300 keys2301 clauses2302 r2303 pat2304 fender2305 exp2306 mod2307) (call-with-values (lambda () (convert-pattern2279 pat2304 keys2301)) (lambda (p2308 pvars2309) (cond ((not (distinct-bound-ids?1238 (map car pvars2309))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat2304)) ((not (andmap (lambda (x2310) (not (ellipsis?1257 (car x2310)))) pvars2309)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat2304)) (else (let ((y2311 (gen-var1260 (quote tmp)))) (build-annotated1189 #f (list (build-annotated1189 #f (list (quote lambda) (list y2311) (let ((y2312 (build-annotated1189 #f y2311))) (build-annotated1189 #f (list (quote if) ((lambda (tmp2313) ((lambda (tmp2314) (if tmp2314 (apply (lambda () y2312) tmp2314) ((lambda (_2315) (build-annotated1189 #f (list (quote if) y2312 (build-dispatch-call2280 pvars2309 fender2305 y2312 r2303 mod2307) (build-data1190 #f #f)))) tmp2313))) ($sc-dispatch tmp2313 (quote #(atom #t))))) fender2305) (build-dispatch-call2280 pvars2309 exp2306 y2312 r2303 mod2307) (gen-syntax-case2282 x2300 keys2301 clauses2302 r2303 mod2307)))))) (if (eq? p2308 (quote any)) (build-annotated1189 #f (list (build-annotated1189 #f (quote list)) x2300)) (build-annotated1189 #f (list (build-annotated1189 #f (quote $sc-dispatch)) x2300 (build-data1190 #f p2308))))))))))))) (build-dispatch-call2280 (lambda (pvars2316 exp2317 y2318 r2319 mod2320) (let ((ids2321 (map car pvars2316)) (levels2322 (map cdr pvars2316))) (let ((labels2323 (gen-labels1218 ids2321)) (new-vars2324 (map gen-var1260 ids2321))) (build-annotated1189 #f (list (build-annotated1189 #f (quote apply)) (build-annotated1189 #f (list (quote lambda) new-vars2324 (chi1248 exp2317 (extend-env1206 labels2323 (map (lambda (var2325 level2326) (cons (quote syntax) (cons var2325 level2326))) new-vars2324 (map cdr pvars2316)) r2319) (make-binding-wrap1229 ids2321 labels2323 (quote (()))) mod2320))) y2318)))))) (convert-pattern2279 (lambda (pattern2327 keys2328) (let cvt2329 ((p2330 pattern2327) (n2331 0) (ids2332 (quote ()))) (if (id?1212 p2330) (if (bound-id-member?1239 p2330 keys2328) (values (vector (quote free-id) p2330) ids2332) (values (quote any) (cons (cons p2330 n2331) ids2332))) ((lambda (tmp2333) ((lambda (tmp2334) (if (if tmp2334 (apply (lambda (x2335 dots2336) (ellipsis?1257 dots2336)) tmp2334) #f) (apply (lambda (x2337 dots2338) (call-with-values (lambda () (cvt2329 x2337 (fx+1180 n2331 1) ids2332)) (lambda (p2339 ids2340) (values (if (eq? p2339 (quote any)) (quote each-any) (vector (quote each) p2339)) ids2340)))) tmp2334) ((lambda (tmp2341) (if tmp2341 (apply (lambda (x2342 y2343) (call-with-values (lambda () (cvt2329 y2343 n2331 ids2332)) (lambda (y2344 ids2345) (call-with-values (lambda () (cvt2329 x2342 n2331 ids2345)) (lambda (x2346 ids2347) (values (cons x2346 y2344) ids2347)))))) tmp2341) ((lambda (tmp2348) (if tmp2348 (apply (lambda () (values (quote ()) ids2332)) tmp2348) ((lambda (tmp2349) (if tmp2349 (apply (lambda (x2350) (call-with-values (lambda () (cvt2329 x2350 n2331 ids2332)) (lambda (p2352 ids2353) (values (vector (quote vector) p2352) ids2353)))) tmp2349) ((lambda (x2354) (values (vector (quote atom) (strip1259 p2330 (quote (())))) ids2332)) tmp2333))) ($sc-dispatch tmp2333 (quote #(vector each-any)))))) ($sc-dispatch tmp2333 (quote ()))))) ($sc-dispatch tmp2333 (quote (any . any)))))) ($sc-dispatch tmp2333 (quote (any any))))) p2330)))))) (lambda (e2355 r2356 w2357 s2358 mod2359) (let ((e2360 (source-wrap1241 e2355 w2357 s2358 mod2359))) ((lambda (tmp2361) ((lambda (tmp2362) (if tmp2362 (apply (lambda (_2363 val2364 key2365 m2366) (if (andmap (lambda (x2367) (and (id?1212 x2367) (not (ellipsis?1257 x2367)))) key2365) (let ((x2369 (gen-var1260 (quote tmp)))) (build-annotated1189 s2358 (list (build-annotated1189 #f (list (quote lambda) (list x2369) (gen-syntax-case2282 (build-annotated1189 #f x2369) key2365 m2366 r2356 mod2359))) (chi1248 val2364 r2356 (quote (())) mod2359)))) (syntax-violation (quote syntax-case) "invalid literals list" e2360))) tmp2362) (syntax-violation #f "source expression failed to match any pattern" tmp2361))) ($sc-dispatch tmp2361 (quote (any any each-any . each-any))))) e2360))))) (set! sc-expand (let ((m2372 (quote e)) (esew2373 (quote (eval)))) (lambda (x2374) (if (and (pair? x2374) (equal? (car x2374) noexpand1179)) (cadr x2374) (chi-top1247 x2374 (quote ()) (quote ((top))) m2372 esew2373 (cons (quote hygiene) (module-name (current-module)))))))) (set! sc-expand3 (let ((m2375 (quote e)) (esew2376 (quote (eval)))) (lambda (x2378 . rest2377) (if (and (pair? x2378) (equal? (car x2378) noexpand1179)) (cadr x2378) (chi-top1247 x2378 (quote ()) (quote ((top))) (if (null? rest2377) m2375 (car rest2377)) (if (or (null? rest2377) (null? (cdr rest2377))) esew2376 (cadr rest2377)) (cons (quote hygiene) (module-name (current-module)))))))) (set! identifier? (lambda (x2379) (nonsymbol-id?1211 x2379))) (set! datum->syntax (lambda (id2380 datum2381) (make-syntax-object1195 datum2381 (syntax-object-wrap1198 id2380) #f))) (set! syntax->datum (lambda (x2382) (strip1259 x2382 (quote (()))))) (set! generate-temporaries (lambda (ls2383) (begin (let ((x2384 ls2383)) (if (not (list? x2384)) (error-hook1186 (quote generate-temporaries) "invalid argument" x2384))) (map (lambda (x2385) (wrap1240 (gensym) (quote ((top))) #f)) ls2383)))) (set! free-identifier=? (lambda (x2386 y2387) (begin (let ((x2388 x2386)) (if (not (nonsymbol-id?1211 x2388)) (error-hook1186 (quote free-identifier=?) "invalid argument" x2388))) (let ((x2389 y2387)) (if (not (nonsymbol-id?1211 x2389)) (error-hook1186 (quote free-identifier=?) "invalid argument" x2389))) (free-id=?1235 x2386 y2387)))) (set! bound-identifier=? (lambda (x2390 y2391) (begin (let ((x2392 x2390)) (if (not (nonsymbol-id?1211 x2392)) (error-hook1186 (quote bound-identifier=?) "invalid argument" x2392))) (let ((x2393 y2391)) (if (not (nonsymbol-id?1211 x2393)) (error-hook1186 (quote bound-identifier=?) "invalid argument" x2393))) (bound-id=?1236 x2390 y2391)))) (set! syntax-violation (lambda (who2397 message2396 form2395 . subform2394) (begin (let ((x2398 who2397)) (if (not ((lambda (x2399) (or (not x2399) (string? x2399) (symbol? x2399))) x2398)) (error-hook1186 (quote syntax-violation) "invalid argument" x2398))) (let ((x2400 message2396)) (if (not (string? x2400)) (error-hook1186 (quote syntax-violation) "invalid argument" x2400))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2397 "~a: " "") "~a " (if (null? subform2394) "in ~a" "in subform `~s' of `~s'")) (let ((tail2401 (cons message2396 (map (lambda (x2402) (strip1259 x2402 (quote (())))) (append subform2394 (list form2395)))))) (if who2397 (cons who2397 tail2401) tail2401)) #f)))) (letrec ((match2407 (lambda (e2408 p2409 w2410 r2411 mod2412) (cond ((not r2411) #f) ((eq? p2409 (quote any)) (cons (wrap1240 e2408 w2410 mod2412) r2411)) ((syntax-object?1196 e2408) (match*2406 (let ((e2413 (syntax-object-expression1197 e2408))) (if (annotation? e2413) (annotation-expression e2413) e2413)) p2409 (join-wraps1231 w2410 (syntax-object-wrap1198 e2408)) r2411 (syntax-object-module1199 e2408))) (else (match*2406 (let ((e2414 e2408)) (if (annotation? e2414) (annotation-expression e2414) e2414)) p2409 w2410 r2411 mod2412))))) (match*2406 (lambda (e2415 p2416 w2417 r2418 mod2419) (cond ((null? p2416) (and (null? e2415) r2418)) ((pair? p2416) (and (pair? e2415) (match2407 (car e2415) (car p2416) w2417 (match2407 (cdr e2415) (cdr p2416) w2417 r2418 mod2419) mod2419))) ((eq? p2416 (quote each-any)) (let ((l2420 (match-each-any2404 e2415 w2417 mod2419))) (and l2420 (cons l2420 r2418)))) (else (let ((t2421 (vector-ref p2416 0))) (if (memv t2421 (quote (each))) (if (null? e2415) (match-empty2405 (vector-ref p2416 1) r2418) (let ((l2422 (match-each2403 e2415 (vector-ref p2416 1) w2417 mod2419))) (and l2422 (let collect2423 ((l2424 l2422)) (if (null? (car l2424)) r2418 (cons (map car l2424) (collect2423 (map cdr l2424)))))))) (if (memv t2421 (quote (free-id))) (and (id?1212 e2415) (free-id=?1235 (wrap1240 e2415 w2417 mod2419) (vector-ref p2416 1)) r2418) (if (memv t2421 (quote (atom))) (and (equal? (vector-ref p2416 1) (strip1259 e2415 w2417)) r2418) (if (memv t2421 (quote (vector))) (and (vector? e2415) (match2407 (vector->list e2415) (vector-ref p2416 1) w2417 r2418 mod2419))))))))))) (match-empty2405 (lambda (p2425 r2426) (cond ((null? p2425) r2426) ((eq? p2425 (quote any)) (cons (quote ()) r2426)) ((pair? p2425) (match-empty2405 (car p2425) (match-empty2405 (cdr p2425) r2426))) ((eq? p2425 (quote each-any)) (cons (quote ()) r2426)) (else (let ((t2427 (vector-ref p2425 0))) (if (memv t2427 (quote (each))) (match-empty2405 (vector-ref p2425 1) r2426) (if (memv t2427 (quote (free-id atom))) r2426 (if (memv t2427 (quote (vector))) (match-empty2405 (vector-ref p2425 1) r2426))))))))) (match-each-any2404 (lambda (e2428 w2429 mod2430) (cond ((annotation? e2428) (match-each-any2404 (annotation-expression e2428) w2429 mod2430)) ((pair? e2428) (let ((l2431 (match-each-any2404 (cdr e2428) w2429 mod2430))) (and l2431 (cons (wrap1240 (car e2428) w2429 mod2430) l2431)))) ((null? e2428) (quote ())) ((syntax-object?1196 e2428) (match-each-any2404 (syntax-object-expression1197 e2428) (join-wraps1231 w2429 (syntax-object-wrap1198 e2428)) mod2430)) (else #f)))) (match-each2403 (lambda (e2432 p2433 w2434 mod2435) (cond ((annotation? e2432) (match-each2403 (annotation-expression e2432) p2433 w2434 mod2435)) ((pair? e2432) (let ((first2436 (match2407 (car e2432) p2433 w2434 (quote ()) mod2435))) (and first2436 (let ((rest2437 (match-each2403 (cdr e2432) p2433 w2434 mod2435))) (and rest2437 (cons first2436 rest2437)))))) ((null? e2432) (quote ())) ((syntax-object?1196 e2432) (match-each2403 (syntax-object-expression1197 e2432) p2433 (join-wraps1231 w2434 (syntax-object-wrap1198 e2432)) (syntax-object-module1199 e2432))) (else #f))))) (set! $sc-dispatch (lambda (e2438 p2439) (cond ((eq? p2439 (quote any)) (list e2438)) ((syntax-object?1196 e2438) (match*2406 (let ((e2440 (syntax-object-expression1197 e2438))) (if (annotation? e2440) (annotation-expression e2440) e2440)) p2439 (syntax-object-wrap1198 e2438) (quote ()) (syntax-object-module1199 e2438))) (else (match*2406 (let ((e2441 e2438)) (if (annotation? e2441) (annotation-expression e2441) e2441)) p2439 (quote (())) (quote ()) #f))))))))
+(define with-syntax (make-syncase-macro (quote macro) (lambda (x2442) ((lambda (tmp2443) ((lambda (tmp2444) (if tmp2444 (apply (lambda (_2445 e12446 e22447) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12446 e22447))) tmp2444) ((lambda (tmp2449) (if tmp2449 (apply (lambda (_2450 out2451 in2452 e12453 e22454) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2452 (quote ()) (list out2451 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12453 e22454))))) tmp2449) ((lambda (tmp2456) (if tmp2456 (apply (lambda (_2457 out2458 in2459 e12460 e22461) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in2459) (quote ()) (list out2458 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12460 e22461))))) tmp2456) (syntax-violation #f "source expression failed to match any pattern" tmp2443))) ($sc-dispatch tmp2443 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2443 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp2443 (quote (any () any . each-any))))) x2442))))
+(define syntax-rules (make-syncase-macro (quote macro) (lambda (x2465) ((lambda (tmp2466) ((lambda (tmp2467) (if tmp2467 (apply (lambda (_2468 k2469 keyword2470 pattern2471 template2472) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k2469 (map (lambda (tmp2475 tmp2474) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2474) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp2475))) template2472 pattern2471)))))) tmp2467) (syntax-violation #f "source expression failed to match any pattern" tmp2466))) ($sc-dispatch tmp2466 (quote (any each-any . #(each ((any . any) any))))))) x2465))))
+(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x2476) ((lambda (tmp2477) ((lambda (tmp2478) (if (if tmp2478 (apply (lambda (let*2479 x2480 v2481 e12482 e22483) (andmap identifier? x2480)) tmp2478) #f) (apply (lambda (let*2485 x2486 v2487 e12488 e22489) (let f2490 ((bindings2491 (map list x2486 v2487))) (if (null? bindings2491) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e12488 e22489))) ((lambda (tmp2495) ((lambda (tmp2496) (if tmp2496 (apply (lambda (body2497 binding2498) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding2498) body2497)) tmp2496) (syntax-violation #f "source expression failed to match any pattern" tmp2495))) ($sc-dispatch tmp2495 (quote (any any))))) (list (f2490 (cdr bindings2491)) (car bindings2491)))))) tmp2478) (syntax-violation #f "source expression failed to match any pattern" tmp2477))) ($sc-dispatch tmp2477 (quote (any #(each (any any)) any . each-any))))) x2476))))
+(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x2499) ((lambda (tmp2500) ((lambda (tmp2501) (if tmp2501 (apply (lambda (_2502 var2503 init2504 step2505 e02506 e12507 c2508) ((lambda (tmp2509) ((lambda (tmp2510) (if tmp2510 (apply (lambda (step2511) ((lambda (tmp2512) ((lambda (tmp2513) (if tmp2513 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2503 init2504) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02506) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2508 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2511))))))) tmp2513) ((lambda (tmp2518) (if tmp2518 (apply (lambda (e12519 e22520) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var2503 init2504) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e02506 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e12519 e22520)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c2508 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step2511))))))) tmp2518) (syntax-violation #f "source expression failed to match any pattern" tmp2512))) ($sc-dispatch tmp2512 (quote (any . each-any)))))) ($sc-dispatch tmp2512 (quote ())))) e12507)) tmp2510) (syntax-violation #f "source expression failed to match any pattern" tmp2509))) ($sc-dispatch tmp2509 (quote each-any)))) (map (lambda (v2527 s2528) ((lambda (tmp2529) ((lambda (tmp2530) (if tmp2530 (apply (lambda () v2527) tmp2530) ((lambda (tmp2531) (if tmp2531 (apply (lambda (e2532) e2532) tmp2531) ((lambda (_2533) (syntax-violation (quote do) "bad step expression" orig-x2499 s2528)) tmp2529))) ($sc-dispatch tmp2529 (quote (any)))))) ($sc-dispatch tmp2529 (quote ())))) s2528)) var2503 step2505))) tmp2501) (syntax-violation #f "source expression failed to match any pattern" tmp2500))) ($sc-dispatch tmp2500 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x2499))))
+(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons2536 (lambda (x2540 y2541) ((lambda (tmp2542) ((lambda (tmp2543) (if tmp2543 (apply (lambda (x2544 y2545) ((lambda (tmp2546) ((lambda (tmp2547) (if tmp2547 (apply (lambda (dy2548) ((lambda (tmp2549) ((lambda (tmp2550) (if tmp2550 (apply (lambda (dx2551) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx2551 dy2548))) tmp2550) ((lambda (_2552) (if (null? dy2548) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2544) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2544 y2545))) tmp2549))) ($sc-dispatch tmp2549 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x2544)) tmp2547) ((lambda (tmp2553) (if tmp2553 (apply (lambda (stuff2554) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x2544 stuff2554))) tmp2553) ((lambda (else2555) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2544 y2545)) tmp2546))) ($sc-dispatch tmp2546 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp2546 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y2545)) tmp2543) (syntax-violation #f "source expression failed to match any pattern" tmp2542))) ($sc-dispatch tmp2542 (quote (any any))))) (list x2540 y2541)))) (quasiappend2537 (lambda (x2556 y2557) ((lambda (tmp2558) ((lambda (tmp2559) (if tmp2559 (apply (lambda (x2560 y2561) ((lambda (tmp2562) ((lambda (tmp2563) (if tmp2563 (apply (lambda () x2560) tmp2563) ((lambda (_2564) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2560 y2561)) tmp2562))) ($sc-dispatch tmp2562 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y2561)) tmp2559) (syntax-violation #f "source expression failed to match any pattern" tmp2558))) ($sc-dispatch tmp2558 (quote (any any))))) (list x2556 y2557)))) (quasivector2538 (lambda (x2565) ((lambda (tmp2566) ((lambda (x2567) ((lambda (tmp2568) ((lambda (tmp2569) (if tmp2569 (apply (lambda (x2570) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x2570))) tmp2569) ((lambda (tmp2572) (if tmp2572 (apply (lambda (x2573) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2573)) tmp2572) ((lambda (_2575) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x2567)) tmp2568))) ($sc-dispatch tmp2568 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp2568 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x2567)) tmp2566)) x2565))) (quasi2539 (lambda (p2576 lev2577) ((lambda (tmp2578) ((lambda (tmp2579) (if tmp2579 (apply (lambda (p2580) (if (= lev2577 0) p2580 (quasicons2536 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2539 (list p2580) (- lev2577 1))))) tmp2579) ((lambda (tmp2581) (if tmp2581 (apply (lambda (p2582 q2583) (if (= lev2577 0) (quasiappend2537 p2582 (quasi2539 q2583 lev2577)) (quasicons2536 (quasicons2536 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2539 (list p2582) (- lev2577 1))) (quasi2539 q2583 lev2577)))) tmp2581) ((lambda (tmp2584) (if tmp2584 (apply (lambda (p2585) (quasicons2536 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi2539 (list p2585) (+ lev2577 1)))) tmp2584) ((lambda (tmp2586) (if tmp2586 (apply (lambda (p2587 q2588) (quasicons2536 (quasi2539 p2587 lev2577) (quasi2539 q2588 lev2577))) tmp2586) ((lambda (tmp2589) (if tmp2589 (apply (lambda (x2590) (quasivector2538 (quasi2539 x2590 lev2577))) tmp2589) ((lambda (p2592) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p2592)) tmp2578))) ($sc-dispatch tmp2578 (quote #(vector each-any)))))) ($sc-dispatch tmp2578 (quote (any . any)))))) ($sc-dispatch tmp2578 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp2578 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp2578 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p2576)))) (lambda (x2593) ((lambda (tmp2594) ((lambda (tmp2595) (if tmp2595 (apply (lambda (_2596 e2597) (quasi2539 e2597 0)) tmp2595) (syntax-violation #f "source expression failed to match any pattern" tmp2594))) ($sc-dispatch tmp2594 (quote (any any))))) x2593)))))
+(define include (make-syncase-macro (quote macro) (lambda (x2598) (letrec ((read-file2599 (lambda (fn2600 k2601) (let ((p2602 (open-input-file fn2600))) (let f2603 ((x2604 (read p2602))) (if (eof-object? x2604) (begin (close-input-port p2602) (quote ())) (cons (datum->syntax k2601 x2604) (f2603 (read p2602))))))))) ((lambda (tmp2605) ((lambda (tmp2606) (if tmp2606 (apply (lambda (k2607 filename2608) (let ((fn2609 (syntax->datum filename2608))) ((lambda (tmp2610) ((lambda (tmp2611) (if tmp2611 (apply (lambda (exp2612) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp2612)) tmp2611) (syntax-violation #f "source expression failed to match any pattern" tmp2610))) ($sc-dispatch tmp2610 (quote each-any)))) (read-file2599 fn2609 k2607)))) tmp2606) (syntax-violation #f "source expression failed to match any pattern" tmp2605))) ($sc-dispatch tmp2605 (quote (any any))))) x2598)))))
+(define unquote (make-syncase-macro (quote macro) (lambda (x2614) ((lambda (tmp2615) ((lambda (tmp2616) (if tmp2616 (apply (lambda (_2617 e2618) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax->datum e2618))) tmp2616) (syntax-violation #f "source expression failed to match any pattern" tmp2615))) ($sc-dispatch tmp2615 (quote (any any))))) x2614))))
+(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x2619) ((lambda (tmp2620) ((lambda (tmp2621) (if tmp2621 (apply (lambda (_2622 e2623) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax->datum e2623))) tmp2621) (syntax-violation #f "source expression failed to match any pattern" tmp2620))) ($sc-dispatch tmp2620 (quote (any any))))) x2619))))
+(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x2624) ((lambda (tmp2625) ((lambda (tmp2626) (if tmp2626 (apply (lambda (_2627 e2628 m12629 m22630) ((lambda (tmp2631) ((lambda (body2632) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2628)) body2632)) tmp2631)) (let f2633 ((clause2634 m12629) (clauses2635 m22630)) (if (null? clauses2635) ((lambda (tmp2637) ((lambda (tmp2638) (if tmp2638 (apply (lambda (e12639 e22640) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12639 e22640))) tmp2638) ((lambda (tmp2642) (if tmp2642 (apply (lambda (k2643 e12644 e22645) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2643)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12644 e22645)))) tmp2642) ((lambda (_2648) (syntax-violation (quote case) "bad clause" x2624 clause2634)) tmp2637))) ($sc-dispatch tmp2637 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2637 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause2634) ((lambda (tmp2649) ((lambda (rest2650) ((lambda (tmp2651) ((lambda (tmp2652) (if tmp2652 (apply (lambda (k2653 e12654 e22655) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k2653)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e12654 e22655)) rest2650)) tmp2652) ((lambda (_2658) (syntax-violation (quote case) "bad clause" x2624 clause2634)) tmp2651))) ($sc-dispatch tmp2651 (quote (each-any any . each-any))))) clause2634)) tmp2649)) (f2633 (car clauses2635) (cdr clauses2635))))))) tmp2626) (syntax-violation #f "source expression failed to match any pattern" tmp2625))) ($sc-dispatch tmp2625 (quote (any any any . each-any))))) x2624))))
+(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x2659) ((lambda (tmp2660) ((lambda (tmp2661) (if tmp2661 (apply (lambda (_2662 e2663) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e2663)) (list (cons _2662 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e2663 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp2661) (syntax-violation #f "source expression failed to match any pattern" tmp2660))) ($sc-dispatch tmp2660 (quote (any any))))) x2659))))
HCoop / bpt / guile.git / blobdiff